大改，整理项目结构，完成rust ffi调用，写好tcp接口

.github/workflows/linux.yml

@@ -1,8 +1,8 @@
 # Linux 流水线：Rust 存储 + Haskell 引擎/Web/CLI 的构建与测试。
 #
 # 这里每条命令都在 WSL Debian（cargo 1.98 / GHC 9.10.3 / stack 3.11.1）上跑通过，
-# 见仓库根 README 的「构建与测试」段。IPC 用例需要 chusql-storage 可执行文件，
+# 见仓库根 README 的「构建与测试」段。Haskell 这边链接并装入 libchusql_core_storage.so，
-# 所以 Rust 先构建，Haskell 的 engine/web 用例才能真跑而不是 pending。
+# 所以 Rust 先构建，LD_LIBRARY_PATH 指向它的输出目录，Haskell 用例才能真跑而不是 pending。
 # 打包和发版资源走 .github/workflows/release.yml（tag 触发，也可手动 dispatch）。
 name: linux
 
@@ -18,6 +18,7 @@ concurrency:
 
 env:
   CARGO_TERM_COLOR: always
+  LD_LIBRARY_PATH: ${{ github.workspace }}/chusql-core/storage/target/release
 
 jobs:
   linux:
@@ -39,24 +40,20 @@ jobs:
           path: |
             ~/.cargo/registry
             ~/.cargo/git
-            chusql-storage/target
+            chusql-core/storage/target
-          key: ${{ runner.os }}-cargo-${{ hashFiles('chusql-storage/Cargo.lock') }}
+          key: ${{ runner.os }}-cargo-${{ hashFiles('chusql-core/storage/Cargo.lock') }}
           restore-keys: ${{ runner.os }}-cargo-
 
       - name: cargo build (release)
-        working-directory: chusql-storage
+        working-directory: chusql-core/storage
         run: cargo build --release
 
-      - name: cargo build (debug, IPC 用例要它)
-        working-directory: chusql-storage
-        run: cargo build --bin chusql-storage
-
       - name: cargo test
-        working-directory: chusql-storage
+        working-directory: chusql-core/storage
         run: cargo test --release
 
       - name: cargo clippy (-D warnings)
-        working-directory: chusql-storage
+        working-directory: chusql-core/storage
         run: cargo clippy --all-targets -- -D warnings
 
       # 故意不做 rustfmt 检查：仓库里没有 rustfmt.toml，历史代码也不是按当前 rustfmt 的
@@ -76,7 +73,8 @@ jobs:
         with:
           path: |
             ~/.stack
-            chusql-engine/.stack-work
+            chusql-core/engine/.stack-work
+            chusql-server/.stack-work
             chusql-web/.stack-work
             chusql-cli/.stack-work
           key: ${{ runner.os }}-stack-${{ hashFiles('**/stack.yaml', '**/stack.yaml.lock') }}
@@ -87,7 +85,11 @@ jobs:
         run: stack build --fast
 
       - name: engine tests
-        working-directory: chusql-engine
+        working-directory: chusql-core/engine
+        run: stack test --fast
+
+      - name: server tests
+        working-directory: chusql-server
         run: stack test --fast
 
       - name: web tests

.github/workflows/release.yml

@@ -1,10 +1,11 @@
-# 发版流水线：打 tag（v*）时为四个平台各出 web / cli 两个发行包，附 sha256，挂到 Release。
+# 发版流水线：打 tag（v*）时为四个平台各出一个发行包，附 sha256，挂到 Release。
 #
-# 资源命名（install.sh 按 <os>-<arch> 挑资源，见 scripts/install.sh）：
+# 资源命名（install.sh / install.ps1 按 <os>-<arch> 挑资源，见 scripts/install.sh）：
-#   chusql-web-linux-x86_64.tar.gz     chusql-cli-linux-x86_64.tar.gz
+#   chusql-linux-x86_64.tar.gz     chusql-windows-x86_64.zip
-#   chusql-web-windows-x86_64.zip      chusql-cli-windows-x86_64.zip
+#   chusql-macos-x86_64.tar.gz     chusql-macos-arm64.tar.gz
-#   chusql-web-macos-x86_64.tar.gz     chusql-cli-macos-x86_64.tar.gz
+#
-#   chusql-web-macos-arm64.tar.gz      chusql-cli-macos-arm64.tar.gz
+# 一个平台一个包，里面 Web 前端与命令行客户端两部分都在；装哪几个由包内的安装脚本
+# 当场问（非交互时用 --component / -Component 指定）。
 #
 # 装的人拿到的就是编好的二进制，不需要 GHC / Rust：
 #   curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh \
@@ -33,9 +34,9 @@ env:
 
 jobs:
   build:
-    name: ${{ matrix.platform }} / ${{ matrix.component }}
+    name: ${{ matrix.platform }}
     runs-on: ${{ matrix.os }}
-    timeout-minutes: 120
+    timeout-minutes: 150
     strategy:
       fail-fast: false
       matrix:
@@ -44,7 +45,6 @@ jobs:
           - { os: windows-latest, platform: windows-x86_64 }
           - { os: macos-13, platform: macos-x86_64 }
           - { os: macos-14, platform: macos-arm64 }
-        component: [web, cli]
     steps:
       - uses: actions/checkout@v4
 
@@ -58,8 +58,8 @@ jobs:
           path: |
             ~/.cargo/registry
             ~/.cargo/git
-            chusql-storage/target
+            chusql-core/storage/target
-          key: ${{ runner.os }}-${{ matrix.platform }}-cargo-${{ hashFiles('chusql-storage/Cargo.lock') }}
+          key: ${{ runner.os }}-${{ matrix.platform }}-cargo-${{ hashFiles('chusql-core/storage/Cargo.lock') }}
           restore-keys: ${{ runner.os }}-cargo-
 
       - name: Haskell toolchain
@@ -74,7 +74,7 @@ jobs:
         with:
           path: |
             ~/.stack
-            chusql-engine/.stack-work
+            chusql-core/engine/.stack-work
             chusql-web/.stack-work
             chusql-cli/.stack-work
           key: ${{ runner.os }}-${{ matrix.platform }}-stack-${{ hashFiles('**/stack.yaml', '**/stack.yaml.lock') }}
@@ -82,59 +82,62 @@ jobs:
 
       # ---------- 构建 ----------
       - name: build storage (Rust)
-        working-directory: chusql-storage
+        working-directory: chusql-core/storage
         run: cargo build --release
 
       - name: build web front end
-        if: matrix.component == 'web'
         working-directory: chusql-cli
         run: stack build --fast chusql-web:exe:chusql-web
 
       - name: build cli
-        if: matrix.component == 'cli'
         working-directory: chusql-cli
         run: stack build --fast chusql-cli:exe:csql
 
-      # ---------- 装配 + 打归档（原来放在一个独立的打包脚本里，那个脚本已经删掉）----------
+      - name: build tcp server
+        working-directory: chusql-cli
+        run: stack build --fast chusql-server:exe:chusql-server
+
+      # ---------- 装配 + 打归档（CI 里直接写在这里；本机打同一个包用 scripts/package.sh）----------
       # 归档里是包内容本身（bin/、scripts/、static/、install.sh 就在根上），安装脚本按这个布局找文件。
       - name: package (Unix)
         if: runner.os != 'Windows'
         shell: bash
         run: |
           set -eu
-          component='${{ matrix.component }}'
+          name="chusql-${{ matrix.platform }}"
-          name="chusql-$component-${{ matrix.platform }}"
           stage="dist/$name"
           rm -rf "$stage"
           mkdir -p "$stage/bin" "$stage/scripts"
 
-          cp chusql-storage/target/release/chusql-storage "$stage/bin/"
+          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')"
-          if [ "$component" = web ]; then front_name=chusql-web; else front_name=csql; fi
+          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
 
-          # Haskell 一般静态链接，靶目录里真有共享库就一起带上
+          # Haskell 一般静态链接，靶目录里真有共享库就一起带上；改名前的旧库（libchusql_storage.*）不能进包
-          for lib in chusql-storage/target/release/*.so chusql-storage/target/release/*.dylib; do
+          for lib in chusql-core/storage/target/release/*.so chusql-core/storage/target/release/*.dylib; do
-            [ -f "$lib" ] && cp "$lib" "$stage/bin/"
+            [ -f "$lib" ] || continue
+            case "$(basename "$lib")" in
+              libchusql_storage.*|libchusql_storage-*) continue ;;
+            esac
+            cp "$lib" "$stage/bin/"
           done
 
           cp scripts/chusql.toml scripts/init.sql "$stage/scripts/"
           cp scripts/install.ps1 scripts/install.sh "$stage/"
-          if [ "$component" = web ]; then
           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
-          fi
 
-          chmod +x "$stage/install.sh"
+          chmod +x "$stage/install.sh" "$stage/csql-web.sh"
-          if [ -f "$stage/csql-web.sh" ]; then chmod +x "$stage/csql-web.sh"; fi
 
           mkdir -p dist
           tar -czf "dist/$name.tar.gz" -C "$stage" .
@@ -146,16 +149,15 @@ jobs:
         shell: pwsh
         run: |
           $ErrorActionPreference = 'Stop'
-          $component = '${{ matrix.component }}'
+          $name = "chusql-${{ matrix.platform }}"
-          $name = "chusql-$component-${{ matrix.platform }}"
           $stage = "dist/$name"
           if (Test-Path $stage) { Remove-Item -Recurse -Force $stage }
           New-Item -ItemType Directory -Force -Path "$stage/bin", "$stage/scripts" | Out-Null
 
-          Copy-Item 'chusql-storage/target/release/chusql-storage.exe' "$stage/bin/"
+          Copy-Item 'chusql-core/storage/target/release/chusql_core_storage.dll' "$stage/bin/"
 
           $stackRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim()
-          $frontName = if ($component -eq 'web') { 'chusql-web.exe' } else { 'csql.exe' }
+          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 |
@@ -163,18 +165,19 @@ jobs:
             }
             if (-not $front -or -not (Test-Path $front)) { throw "front end binary not found: $frontName" }
             Copy-Item $front "$stage/bin/"
+          }
 
-          Get-ChildItem 'chusql-storage/target/release' -Filter '*.dll' -File -ErrorAction SilentlyContinue |
+          # 第三方 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 'scripts/chusql.toml', 'scripts/init.sql' "$stage/scripts/"
           Copy-Item 'scripts/install.ps1', 'scripts/install.sh' $stage
-          if ($component -eq 'web') {
           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
@@ -193,7 +196,7 @@ jobs:
       - name: upload
         uses: actions/upload-artifact@v4
         with:
-          name: ${{ matrix.platform }}-${{ matrix.component }}
+          name: ${{ matrix.platform }}
           path: |
             dist/*.zip
             dist/*.tar.gz

.gitignore

@@ -1,12 +1,12 @@
 # ============================================================
 # ChuSQL 单仓库 .gitignore
-#   chusql-engine/   Haskell (Stack + Cabal)
+#   chusql-core/engine/   Haskell (Stack + Cabal)
-#   chusql-storage/  Rust (Cargo)
+#   chusql-core/storage/  Rust (Cargo)
 #   chusql-web/      前端 (手写 HTML / CSS / JS，无 Node 工具链)
 # ============================================================
 
 # ------------------------------------------------------------
-# Haskell / Stack / Cabal —— chusql-engine
+# Haskell / Stack / Cabal —— chusql-core/engine
 # ------------------------------------------------------------
 .stack-work/
 dist-newstyle/
@@ -26,21 +26,24 @@ cabal.project.local
 cabal.project.local~
 
 # 锁文件要入库，不要忽略：
-#   chusql-engine/stack.yaml.lock
+#   chusql-core/engine/stack.yaml.lock
 #   cabal.project.freeze
 
 # ------------------------------------------------------------
-# Rust / Cargo —— chusql-storage
+# Rust / Cargo —— chusql-core/storage
 # ------------------------------------------------------------
 target/
 **/*.rs.bk
 
 # 运行时数据（Rust 服务默认数据目录 CHUSQL_DATA_DIR=data/），不入库
-chusql-storage/data/
+chusql-core/storage/data/
 
 # 一键启动脚本的默认数据目录与日志，不入库
 localdata/
 
+# 本机打出来的发行包（scripts/package.sh / package.ps1 的产物），不入库
+releases/
+
 # 前端 IDE 设置（字体等，由 /api/ui-settings 读写），本机专用，不入库
 scripts/chusql.ui.settings.json
 
@@ -74,7 +77,7 @@ scripts/chusql.ui.settings.json
 \#*\#
 .\#*
 agent_credientials
-
+.dsh
 # 注意：.zed/tasks.json 是本仓库共享的构建任务（stack build / run / test / repl），
 # 需要入库，所以这里不忽略 .zed/
 

.zed/tasks.json

@@ -2,7 +2,7 @@
     {
         "label": "haskell: stack build",
         "command": "stack build",
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-engine",
+        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/engine",
         "reveal": "always",
         "hide": "on_success",
         "save": "all",
@@ -10,7 +10,7 @@
     {
         "label": "haskell: stack test",
         "command": "stack test",
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-engine",
+        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/engine",
         "reveal": "always",
         "hide": "never",
         "save": "all",
@@ -18,7 +18,7 @@
     {
         "label": "haskell: stack run",
         "command": "stack run",
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-engine",
+        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/engine",
         "reveal": "always",
         "hide": "never",
         "save": "all",
@@ -26,7 +26,7 @@
     {
         "label": "haskell: stack repl",
         "command": "stack ghci",
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-engine",
+        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/engine",
         "reveal": "always",
         "hide": "never",
         "save": "all",
@@ -35,7 +35,7 @@
         "label": "rust: cargo check",
         "command": "cargo",
         "args": ["check", "--all-targets"],
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-storage",
+        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/storage",
         "reveal": "always",
         "hide": "on_success",
         "save": "all",
@@ -44,16 +44,7 @@
         "label": "rust: cargo test",
         "command": "cargo",
         "args": ["test"],
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-storage",
+        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/storage",
-        "reveal": "always",
-        "hide": "never",
-        "save": "all",
-    },
-    {
-        "label": "rust: cargo run server",
-        "command": "cargo",
-        "args": ["run", "--bin", "server"],
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-storage",
         "reveal": "always",
         "hide": "never",
         "save": "all",

AGENTS.md

@@ -14,9 +14,17 @@
 - 索引由存储层管理，优化器只判断可点查条件。
 - 优化不能改变结果语义。
 
+## 注释规范
+- 文件级：外部引用语句（Haskell `import`、Rust `use`、JS `import`、HTML 的 `<link>`/`<script>`、
+  CSS `@import`、脚本的依赖/参数区）之后写一段注释，概括本文件的功能；没有引用语句的文件写在
+  文件开头。长度不超过 3 行、合计不超过 90 字。
+- 函数级：每个函数（含 Haskell 的 `where`/`let` 内函数、Rust 的私有 `fn`）前用一行不超过
+  30 字的注释说明它做什么。
+- 只写"做什么"，不写设计理由、历史与被删掉的旧实现；那些放 `design-decisions.txt` /
+  `known-issues.txt`。
+
 ## 协作规则
 - engine / web / storage 使用规定测试入口。
-- 注释、文案保持简短。
 - 改动说明只在交流中记录。
 
 ## 当前重点

README.md

@@ -4,7 +4,7 @@
 
 优点：
 
-- 轻量：两个可执行文件加一份静态资源，解包即用，没有 Node / Python 之类的运行时依赖
+- 轻量：几个可执行文件加两个动态库、一份静态资源，解包即用，没有 Node / Python 之类的运行时依赖
 - 部署容易：Linux 与 macOS 一条命令装完并启动，Windows 解压后跑一次安装脚本
 - 配置统一：一个 `chusql.toml` 同时管住存储、Web 与命令行
 - 账号统一：Web 管理端与命令行共用同一个管理员和同一张账号表
@@ -14,16 +14,17 @@
 Linux / macOS（自动识别当前平台，取对应发行包）：
 
 ```sh
-curl -fsSL https://github.com/TheBadRoger/ChuSQL/releases/latest/download/install.sh | sh -s -- --component web
+curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh | sh -s -- --component web
 ```
 
-Windows：下载 `chusql-web-windows-x86_64.zip`，解压后在 PowerShell 里执行
+Windows：下载 `chusql-windows-x86_64.zip`，解压后在 PowerShell 里执行
 
 ```powershell
 .\install.ps1 -Component web
 ```
 
-只装命令行客户端就把 `web` 换成 `cli`，入口变成 `csql`。安装位置、目录结构与卸载方式见
+不写 `--component` 时脚本会逐个问「装 cli 吗」「装 web 吗」（默认装 `csql`、不装 Web）；只装命令行
+客户端就把 `web` 换成 `cli`，两个都要用 `both`。安装位置、目录结构与卸载方式见
 [doc/install.md](doc/install.md)。
 
 ## 启动
@@ -32,7 +33,7 @@ Windows：下载 `chusql-web-windows-x86_64.zip`，解压后在 PowerShell 里
 csql-web
 ```
 
-浏览器打开 http://127.0.0.1:7777 ，默认账号 `root`，口令是安装时给的那个。服务启动后只有系统库 `system`（里面是账号表），**没有默认工作库**：自己建一个库再用 `USE <库名>` 选中它。
+浏览器打开 http://127.0.0.1:7778 ，默认账号 `root`，口令是安装时给的那个。服务启动后只有系统库 `system`（里面是账号表），**没有默认工作库**：自己建一个库再用 `USE <库名>` 选中它。
 换口令、换端口、改数据目录都在安装时写好的 `chusql.toml` 里。
 
 ## 文档
@@ -40,6 +41,6 @@ csql-web
 | 文档                              | 内容                                                                     |
 | --------------------------------- | ------------------------------------------------------------------------ |
 | [安装与卸载](doc/install.md)      | 三种安装方式、全部安装选项、装完的目录结构、从源码安装、卸载             |
-| [配置选项](doc/config.md)         | 配置位置与优先级、全部配置键与默认值、端点规则、口令与安全               |
+| [配置选项](doc/config.md)         | 配置位置与优先级、全部配置键与默认值、数据目录、口令与安全               |
 | [命令与选项](doc/commands.md)     | `csql` 与 `chusql-web` 的选项、元命令、账号与角色权限、REST 接口         |
 | [架构与组件](doc/architecture.md) | 三个组件怎么分工、一次请求经过什么、数据落在哪                           |

benchmark/chusql-fullchain.cabal

@@ -2,16 +2,22 @@ cabal-version: 2.4
 
 name:           chusql-fullchain
 version:        1.0.0
-synopsis:       ChuSQL 全链路基准：Haskell 引擎 + Rust 存储进程一起跑
+synopsis:       ChuSQL 全链路基准：起真 server，全部请求走 TCP
+description:    以基准客户端身份起一个 chusql-server 进程（存储与引擎都在那个进程里），
+                再经 TCP JSON-lines 协议打登录、ping、catalog、查询等场景。
+                本程序不链引擎、不链 server 库，只用 TCP 客户端与协议模型。
 build-type:     Simple
 
 executable chusql-fullchain
     main-is:          Main.hs
     hs-source-dirs:   src
+    build-tool-depends: chusql-server:chusql-server
     build-depends:    base >= 4.14 && < 5
-                    , chusql-engine
+                    , chusql-core-model
+                    , chusql-interface
                     , directory
                     , filepath
                     , process
+                    , text
     default-language: Haskell2010
     ghc-options:      -O2 -Wall

benchmark/src/Main.hs

@@ -1,40 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main where
 
-import ChuSQL.Engine (runStatementM)
+import ChuSQL.Core.Protocol (QueryResult (..), TableInfo (..))
-import ChuSQL.Model (Row, Value (..))
+import ChuSQL.Interface.Link (Client, clientPing, closeClient, connectClient)
-import ChuSQL.Storage (IndexResult (..))
+import ChuSQL.Interface.Session (
-import ChuSQL.Storage.IPC (
+    Session,
-    IPCStorage (..),
+    authenticateSession,
-    Request (..),
+    catalog,
-    Response (..),
+    newSession,
-    TableInfo (..),
+    runStatement,
-    closeConnection,
+    switchDatabase,
-    doInsert,
-    doListCatalog,
-    doLookupByColumn,
-    sendRequest,
-    setPipeName,
  )
-import ChuSQL.Syntax.Parser (parseStatement)
+import Control.Concurrent (forkIO, threadDelay)
-import Control.Concurrent (threadDelay)
+import Control.Exception (IOException, bracket, evaluate, try)
-import Control.Exception (SomeException, bracket, evaluate, try)
+import Control.Monad (unless, when)
-import Control.Monad (filterM, unless, when)
+import Data.List (intercalate)
-import Data.List (intercalate, isInfixOf)
+import Data.Text (Text)
+import qualified Data.Text as T
 import GHC.Clock (getMonotonicTime)
 import System.Directory (
     createDirectoryIfMissing,
-    doesFileExist,
+    findExecutable,
     getTemporaryDirectory,
     removeDirectoryRecursive,
  )
 import System.Environment (getArgs)
-import System.Exit (exitFailure)
+import System.Exit (ExitCode (..), exitFailure)
 import System.FilePath ((</>))
 import System.Info (os)
+import System.IO (Handle, hGetLine)
 import System.Process (
-    CreateProcess (..),
+    CreateProcess (std_err, std_out),
     ProcessHandle,
-    StdStream (..),
+    StdStream (CreatePipe, NoStream),
     createProcess,
     proc,
     terminateProcess,
@@ -42,103 +41,51 @@ import System.Process (
  )
 import Text.Printf (printf)
 
--- 全链路基准：Haskell 引擎与 Rust 存储进程一起跑，语句走完整链路并打印墙上耗时。
+-- 全链路基准：客户端经 TCP 连 chusql-server，落盘到进程内 Rust 存储。
+-- 每条语句都走完整链路：解析、语义检查、提交。
+-- 对照项：ping 与 catalog。
 
--- | 找 Rust 存储进程：优先 release
+-- | 一个基准世界：真 server 进程 + 一条 TCP 会话
-findServer :: FilePath -> IO FilePath
+data Bench = Bench
-findServer "" = do
+    { bProcess :: ProcessHandle
-    let dirs =
+    , bDataDir :: FilePath
-            [ "chusql-storage/target"
+    , bClient :: Client
-            , "../chusql-storage/target"
+    , bSession :: Session
-            ]
+    }
-        modes = ["release", "debug"]
-        -- 名字跟平台走：同一个 target 目录里可能躺着一份别处交叉编译出来的 .exe，
-        -- 在 Linux 上误选它只会拿到 config file not found
-        exes = [if os == "mingw32" then "chusql-storage.exe" else "chusql-storage"]
-        candidates = [d </> m </> e | d <- dirs, m <- modes, e <- exes]
-    found <- filterM doesFileExist candidates
-    case found of
-        (p : _) -> do
-            unless ("release" `isInfixOf` p) $
-                putStrLn "!! using the debug storage binary; numbers will be slower, run: cargo build --release"
-            pure p
-        [] -> do
-            putStrLn "Rust storage binary not found. Build it first:"
-            putStrLn "    cd chusql-storage && cargo build --release"
-            exitFailure
-findServer p = do
-    ok <- doesFileExist p
-    if ok
-        then pure p
-        else do
-            putStrLn ("storage binary not found: " ++ p)
-            exitFailure
 
--- | 起存储进程并等管道可连：调参走 --config 指的那份配置文件，环境原样继承
+-- | 跑一条 SQL 文本（整条链路）
-startServer :: FilePath -> FilePath -> IO ProcessHandle
+runSql :: Bench -> String -> IO (Either Text QueryResult)
-startServer serverPath configPath = do
+runSql bench sql = runStatement (bSession bench) (T.pack sql)
-    (_, _, _, ph) <-
-        createProcess
-            (proc serverPath ["--config", configPath]){std_out = NoStream, std_err = Inherit}
-    ready <- waitReady (200 :: Int)
-    unless ready $ do
-        putStrLn "storage process was not ready within 5 s"
-        exitFailure
-    pure ph
-
--- | 轮询 ping，直到对面应答
-waitReady :: Int -> IO Bool
-waitReady 0 = pure False
-waitReady n = do
-    r <- try (sendRequest ReqPing) :: IO (Either SomeException Response)
-    case r of
-        Right RespPong -> pure True
-        _ -> threadDelay 25000 >> waitReady (n - 1)
-
--- | 停存储进程并清掉缓存连接
-stopServer :: ProcessHandle -> FilePath -> IO ()
-stopServer ph dataDir = do
-    closeConnection
-    terminateProcess ph
-    _ <- waitForProcess ph
-    _ <- try (removeDirectoryRecursive dataDir) :: IO (Either SomeException ())
-    pure ()
 
 -- | 量一次墙上耗时并强制求出行数
-timedRows :: IO (Either String [Row]) -> IO (Double, Either String Int)
+timedQuery :: Bench -> String -> IO (Double, Either Text Int)
-timedRows act = do
+timedQuery bench sql = do
     t0 <- getMonotonicTime
-    r <- act
+    r <- runSql bench sql
     n <- case r of
         Left _ -> pure (-1)
-        Right rows -> evaluate (length rows)
+        Right result -> evaluate (qrRowCount result)
     t1 <- getMonotonicTime
     pure (t1 - t0, either Left (const (Right n)) r)
 
--- | 跑一条 SQL 文本（整条链路）
-runSql :: String -> IO (Either String [Row])
-runSql sql = case parseStatement sql of
-    Left e -> pure (Left e)
-    Right stmt -> runIPCStorage (runStatementM stmt)
-
 -- | 打印一行结果
-report :: String -> Either String Int -> Double -> IO ()
+report :: String -> Either Text Int -> Double -> IO ()
 report label result dt = case result of
-    Left e -> printf "%-38s %10s   !! %s\n" label "FAILED" e
+    Left e -> printf "%-38s %10s   !! %s\n" label ("FAILED" :: String) (T.unpack e)
     Right n -> printf "%-38s %8.1f ms %8d rows\n" label (dt * 1000) n
 
 -- | 单独量一条可重复的 SQL（先预热）
-benchSql :: String -> String -> IO (Either String Int)
+benchSql :: Bench -> String -> String -> IO (Either Text Int)
-benchSql label sql = do
+benchSql bench label sql = do
-    _ <- runSql sql
+    _ <- runSql bench sql
-    (dt, r) <- timedRows (runSql sql)
+    (dt, r) <- timedQuery bench sql
     report label r dt
     pure r
 
 -- | 只跑一次的语句（重跑会报错）
-benchSqlOnce :: String -> String -> IO (Either String Int)
+benchSqlOnce :: Bench -> String -> String -> IO (Either Text Int)
-benchSqlOnce label sql = do
+benchSqlOnce bench label sql = do
-    (dt, r) <- timedRows (runSql sql)
+    (dt, r) <- timedQuery bench sql
     report label r dt
     pure r
 
@@ -157,10 +104,10 @@ orderSql u j =
         (j `mod` 50)
 
 -- | 批量插入并报平均耗时
-batchInsert :: String -> Int -> (Int -> String) -> IO (Either String ())
+batchInsert :: Bench -> String -> Int -> (Int -> String) -> IO (Either Text ())
-batchInsert label n mkSql = do
+batchInsert bench label n mkSql = do
     t0 <- getMonotonicTime
-    results <- mapM (runSql . mkSql) [1 .. n]
+    results <- mapM (runSql bench . mkSql) [1 .. n]
     t1 <- getMonotonicTime
     let total = t1 - t0
         errs = [e | Left e <- results]
@@ -173,66 +120,66 @@ batchInsert label n mkSql = do
                 (total * 1000 / fromIntegral n)
             pure (Right ())
         (e : _) -> do
-            printf "%-38s %10s   !! %s\n" label "FAILED" e
+            printf "%-38s %10s   !! %s\n" label ("FAILED" :: String) (T.unpack e)
             pure (Left e)
 
--- | 一次点查（原始 IPC，不经过引擎）
+-- | 纯 TCP 往返：只过协议层，不过引擎与存储
-benchLookup :: String -> String -> Int -> Int -> IO ()
+benchPing :: Bench -> Int -> IO ()
-benchLookup table column key times = do
+benchPing bench times = do
-    _ <- doLookupByColumn table column (VInt key)
+    _ <- clientPing (bClient bench)
     t0 <- getMonotonicTime
-    results <- mapM (const (doLookupByColumn table column (VInt key))) [1 .. times]
+    results <- mapM (const (clientPing (bClient bench))) [1 .. times]
     t1 <- getMonotonicTime
     let total = t1 - t0
-        hit = length [() | Right (IndexRows (_ : _)) <- results]
+        hits = length [() | Right _ <- results]
     printf
-        "%-38s %8.1f ms %7.3f ms/op (hits %d/%d)\n"
+        "%-38s %8.1f ms %7.3f ms/op (pongs %d/%d)\n"
-        "lookup_by_index (raw IPC, by id)"
+        ("tcp round trip (ping, no engine)" :: String)
         (total * 1000)
         (total * 1000 / fromIntegral times)
-        hit
+        hits
+        times
+
+-- | 一次点查（走语句，等于把 id 索引那一支也量进去）
+benchLookup :: Bench -> Int -> Int -> IO ()
+benchLookup bench key times = do
+    let sql = printf "SELECT name FROM users WHERE id = %d" key
+    _ <- runSql bench sql
+    t0 <- getMonotonicTime
+    results <- mapM (const (runSql bench sql)) [1 .. times]
+    t1 <- getMonotonicTime
+    let total = t1 - t0
+        hits = length [() | Right result <- results, qrRowCount result > 0]
+    printf
+        "%-38s %8.1f ms %7.3f ms/op (hits %d/%d)\n"
+        ("point lookup by id (statement, over TCP)" :: String)
+        (total * 1000)
+        (total * 1000 / fromIntegral times)
+        hits
         times
 
 -- | 量 list_catalog（只取结构，不取行）
-benchListCatalog :: Int -> IO ()
+benchCatalog :: Bench -> Int -> IO ()
-benchListCatalog n = do
+benchCatalog bench n = do
+    _ <- catalog (bSession bench)
     t0 <- getMonotonicTime
-    _ <- mapM (const doListCatalog) [1 .. n]
+    results <- mapM (const (catalog (bSession bench))) [1 .. n]
     t1 <- getMonotonicTime
     let total = t1 - t0
+        hits = length [() | Right _ <- results]
     printf
-        "%-38s %8.1f ms %7.3f ms/op\n"
+        "%-38s %8.1f ms %7.3f ms/op (%d/%d ok)\n"
-        "list_catalog (schema only)"
+        ("list_catalog (schema only, over TCP)" :: String)
         (total * 1000)
         (total * 1000 / fromIntegral n)
-
+        hits
--- | 量原始 IPC 插入（不经过引擎）
+        n
-benchRawInsert :: String -> [Row] -> IO ()
-benchRawInsert table rows = do
-    t0 <- getMonotonicTime
-    results <- mapM (\r -> doInsert table r) rows
-    t1 <- getMonotonicTime
-    let total = t1 - t0
-        n = length rows
-        errs = [e | Left e <- results]
-    case errs of
-        [] ->
-            printf
-                "%-38s %8.1f ms %7.3f ms/row\n"
-                ("raw IPC insert x " ++ show n)
-                (total * 1000)
-                (total * 1000 / fromIntegral n)
-        (e : _) -> printf "%-38s %10s   !! %s\n" "raw IPC insert" "FAILED" e
-
--- | 造一行 users 数据（给原始 IPC 用）
-userRow :: Int -> Row
-userRow i = [("id", VInt i), ("name", VStr ("user" ++ show i)), ("age", VInt (i `mod` 100))]
 
 -- | 依次跑一批语句，返回 (耗时秒, 错误清单)
-runBatch :: [String] -> IO (Double, [String])
+runBatch :: Bench -> [String] -> IO (Double, [Text])
-runBatch sqls = do
+runBatch bench sqls = do
     t0 <- getMonotonicTime
-    results <- mapM runSql sqls
+    results <- mapM (runSql bench) sqls
     t1 <- getMonotonicTime
     pure (t1 - t0, [e | Left e <- results])
 
@@ -240,6 +187,7 @@ runBatch sqls = do
 chunked :: Int -> Int -> [[Int]]
 chunked size n = go [1 .. n]
   where
+    -- | 递归切分
     go [] = []
     go xs = let (a, b) = splitAt size xs in a : go b
 
@@ -264,11 +212,11 @@ printStats i =
         )
 
 -- | 主场景
-runScenarios :: Int -> Int -> IO ()
+runScenarios :: Bench -> Int -> Int -> IO ()
-runScenarios u o = do
+runScenarios bench u o = do
     putStrLn "\n[create tables]"
-    r1 <- benchSqlOnce "CREATE TABLE users" "CREATE TABLE users (id int, name str, age int)"
+    r1 <- benchSqlOnce bench "CREATE TABLE users" "CREATE TABLE users (id int, name str, age int)"
-    r2 <- benchSqlOnce "CREATE TABLE orders" "CREATE TABLE orders (id int, user_id int, product str)"
+    r2 <- benchSqlOnce bench "CREATE TABLE orders" "CREATE TABLE orders (id int, user_id int, product str)"
     case (r1, r2) of
         (Right _, Right _) -> pure ()
         _ -> do
@@ -276,91 +224,246 @@ runScenarios u o = do
             exitFailure
 
     putStrLn "\n[write: every INSERT is a full durable commit]"
-    _ <- batchInsert (printf "%d INSERT INTO users" u) u userSql
+    _ <- batchInsert bench (printf "%d INSERT INTO users" u) u userSql
-    _ <- batchInsert (printf "%d INSERT INTO orders" o) o (orderSql u)
+    _ <- batchInsert bench (printf "%d INSERT INTO orders" o) o (orderSql u)
 
-    putStrLn "\n[breakdown: same INSERT split in two, both via raw IPC, no engine]"
+    putStrLn "\n[breakdown: protocol round trip vs one catalog call, both over TCP]"
-    _ <- benchSqlOnce "CREATE TABLE raw_users" "CREATE TABLE raw_users (id int, name str, age int)"
+    benchPing bench 200
-    benchListCatalog 200
+    benchCatalog bench 200
-    benchRawInsert "raw_users" [userRow i | i <- [1 .. u]]
 
     putStrLn "\n[read/query: full statement, including parsing and semantic checks]"
-    _ <- benchSql "SELECT * FROM users" "SELECT * FROM users"
+    _ <- benchSql bench "SELECT * FROM users" "SELECT * FROM users"
-    ageR <- benchSql "SELECT name FROM users WHERE age > 90" "SELECT name FROM users WHERE age > 90"
+    ageR <- benchSql bench "SELECT name FROM users WHERE age > 90" "SELECT name FROM users WHERE age > 90"
 
     putStrLn "\n[read/query: join]"
     joinR <-
         benchSql
+            bench
             "JOIN + WHERE (hash join)"
             "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id WHERE u.age > 90"
 
     putStrLn "\n[point lookup]"
-    benchLookup "users" "id" (u `div` 2) 100
+    benchLookup bench (u `div` 2) 100
-    _ <- benchSql "SELECT ... WHERE id = k (via Lookup)" (printf "SELECT name FROM users WHERE id = %d" (u `div` 2))
 
     putStrLn "\n[batch insert: one statement with N rows, one durable commit]"
-    _ <- benchSqlOnce "CREATE TABLE batch_t" "CREATE TABLE batch_t (id int, name str, age int)"
+    _ <- benchSqlOnce bench "CREATE TABLE batch_t" "CREATE TABLE batch_t (id int, name str, age int)"
     let groups = chunked 100 u
-    (bt, batchErrs) <- runBatch (map multiInsertSql groups)
+        perStmt = maximum (0 : map length groups)
+    (bt, batchErrs) <- runBatch bench (map multiInsertSql groups)
     case batchErrs of
         [] ->
             printf
                 "%-38s %8.1f ms %7.3f ms/row (%d rows/stmt x %d statements)\n"
-                "multi-row INSERT"
+                ("multi-row INSERT" :: String)
                 (bt * 1000)
                 (bt * 1000 / fromIntegral u)
-                (100 :: Int)
+                (perStmt :: Int)
                 (length groups)
-        (e : _) -> printf "%-38s %10s   !! %s\n" "multi-row INSERT" "FAILED" e
+        (e : _) -> printf "%-38s %10s   !! %s\n" ("multi-row INSERT" :: String) ("FAILED" :: String) (T.unpack e)
 
     putStrLn "\n[row delete: cost tracks the scan plus one commit, not the row count]"
-    _ <- benchSqlOnce "DELETE FROM users WHERE id = k (1 row)" (printf "DELETE FROM users WHERE id = %d" (u `div` 2))
+    _ <- benchSqlOnce bench "DELETE FROM users WHERE id = k (1 row)" (printf "DELETE FROM users WHERE id = %d" (u `div` 2))
-    _ <- benchSqlOnce "DELETE FROM users (all)" "DELETE FROM users"
+    _ <- benchSqlOnce bench "DELETE FROM users (all)" "DELETE FROM users"
 
     putStrLn "\n[secondary index: falls back to scan, then uses the index once built]"
-    _ <- benchSqlOnce "CREATE TABLE items" "CREATE TABLE items (id int, code int)"
+    _ <- benchSqlOnce bench "CREATE TABLE items" "CREATE TABLE items (id int, code int)"
     let itemGroups = chunked 100 o
         itemSql ids =
             "INSERT INTO items (id, code) VALUES "
                 ++ intercalate ", " [printf "(%d, %d)" i (i * 7 + 1) | i <- ids]
-    (it, itemErrs) <- runBatch (map itemSql itemGroups)
+    (it, itemErrs) <- runBatch bench (map itemSql itemGroups)
     case itemErrs of
         [] -> pure ()
-        (e : _) -> printf "  !! %s\n" e
+        (e : _) -> printf "  !! %s\n" (T.unpack e)
     printf "  (loaded %d rows into items: %.1f ms)\n" o (it * 1000)
     let targetCode = (o `div` 2) * 7 + 1
     _ <-
         benchSql
+            bench
             "SELECT ... WHERE code = k (no index)"
             (printf "SELECT id FROM items WHERE code = %d" targetCode)
-    _ <- benchSqlOnce "CREATE INDEX ON items (code)" "CREATE INDEX ON items (code)"
+    _ <- benchSqlOnce bench "CREATE INDEX ON items (code)" "CREATE INDEX ON items (code)"
     _ <-
         benchSql
+            bench
             "SELECT ... WHERE code = k (via index)"
             (printf "SELECT id FROM items WHERE code = %d" targetCode)
 
     putStrLn "\n[catalog stats]"
-    cat <- doListCatalog
+    cat <- catalog (bSession bench)
     case cat of
-        Left e -> printf "  failed to read stats: %s\n" e
+        Left e -> printf "  failed to read stats: %s\n" (T.unpack e)
         Right infos -> mapM_ printStats infos
 
     putStrLn "\n[checks]"
     let expectAge = 9 * (u `div` 100) + max 0 (u `mod` 100 - 90)
     printf
         "age > 90 matched %s (expected %d rows from the data distribution)\n"
-        (either show show ageR)
+        (either T.unpack show ageR)
         expectAge
     when (u == o) $
         printf
             "JOIN matched %s (one order per user, should equal the line above = %d)\n"
-            (either show show joinR)
+            (either T.unpack show joinR)
             expectAge
     unless (u == o) $
         putStrLn "(users and orders differ in size; no simple formula, printing only)"
-    printf "multi-row INSERT loaded %d rows (expected %d)\n" u u
+    loadedCheck <- runSql bench "SELECT id FROM batch_t"
+    printf
+        "multi-row INSERT loaded %s rows (expected %d)\n"
+        (either T.unpack (show . qrRowCount) loadedCheck)
+        u
     printf "secondary index: code = %d should find id = %d\n" targetCode (o `div` 2)
 
+-- | 基准用的库名
+benchDatabase :: String
+benchDatabase = "bench"
+
+-- | 服务端没有默认库：先开一个库，再把之后的语句都落进它
+prepareDatabase :: Session -> IO ()
+prepareDatabase session = do
+    created <- runStatement session ("CREATE DATABASE " <> T.pack benchDatabase)
+    case created of
+        Left e -> die ("cannot create the benchmark database: " ++ T.unpack e)
+        Right _ -> do
+            used <- switchDatabase session (T.pack benchDatabase)
+            case used of
+                Left e -> die ("cannot select the benchmark database: " ++ T.unpack e)
+                Right () -> pure ()
+  where
+    -- | 报错退出
+    die message = do
+        putStrLn message
+        exitFailure
+
+-- | 按平台补上 .exe 后缀
+binaryName :: String -> String
+binaryName stem = if os == "mingw32" then stem ++ ".exe" else stem
+
+-- | 在 PATH 里找 server 可执行文件
+locateServerExe :: IO FilePath
+locateServerExe = do
+    found <- findExecutable (binaryName "chusql-server")
+    case found of
+        Just path -> pure path
+        Nothing -> do
+            putStrLn "chusql-server was not found on PATH: run `stack build` first"
+            exitFailure
+
+-- | 从 server 输出里读出监听端口
+readListeningPort :: Handle -> IO Int
+readListeningPort handle = do
+    line <- hGetLine handle
+    case portFromBanner line of
+        Just port -> pure port
+        Nothing -> readListeningPort handle
+
+-- | 取一行里最后一串数字
+portFromBanner :: String -> Maybe Int
+portFromBanner line
+    | not ("listening:" `isInfixOf` line) = Nothing
+    | otherwise = case span isDigit (dropWhile (not . isDigit) (reverse line)) of
+        ([], _) -> Nothing
+        (digits, _) -> Just (read (reverse digits))
+
+-- | 判断子串是否出现
+isInfixOf :: String -> String -> Bool
+isInfixOf needle haystack = any (prefix needle) (tails haystack)
+  where
+    -- | 前缀匹配
+    prefix [] _ = True
+    prefix _ [] = False
+    prefix (x : xs) (y : ys) = x == y && prefix xs ys
+    -- | 所有后缀
+    tails [] = [[]]
+    tails s@(_ : rest) = s : tails rest
+
+-- | 判断是不是数字字符
+isDigit :: Char -> Bool
+isDigit ch = ch >= '0' && ch <= '9'
+
+-- | 把 server 的 stdout 抽干，免得管道塞满
+drainHandle :: Handle -> IO ()
+drainHandle handle = do
+    result <- try (hGetLine handle) :: IO (Either IOException String)
+    case result of
+        Left _ -> pure ()
+        Right _ -> drainHandle handle
+
+-- | 起 server、连上去、登录、开库
+startBench :: IO Bench
+startBench = do
+    bin <- locateServerExe
+    tmp <- getTemporaryDirectory
+    stamp <- getMonotonicTime
+    let name = "chusql-fullchain-" ++ show (round (stamp * 1e6) :: Int)
+        dataDir = tmp </> name
+        configPath = tmp </> (name ++ ".toml")
+        -- TOML 的普通字符串会吃反斜杠，路径统一用正斜杠
+        slashed = map (\c -> if c == '\\' then '/' else c) dataDir
+    createDirectoryIfMissing True dataDir
+    writeFile configPath (benchConfigText slashed)
+    printf "config   : %s\n" configPath
+    printf "data dir : %s\n" dataDir
+    (_, Just out, _, process) <-
+        createProcess (proc bin ["--config", configPath]){std_out = CreatePipe, std_err = NoStream}
+    port <- readListeningPort out
+    _ <- forkIO (drainHandle out)
+    printf "server   : pid launched, tcp port %d\n" port
+    linked <- connectClient "127.0.0.1" port
+    case linked of
+        Left err -> do
+            putStrLn ("cannot connect to the server: " ++ T.unpack err)
+            stopProcess process
+            exitFailure
+        Right client -> do
+            session <- newSession client
+            auth <- authenticateSession session (T.pack "admin") (T.pack "s3cret")
+            case auth of
+                Left err -> do
+                    putStrLn ("cannot sign in: " ++ T.unpack err)
+                    closeClient client
+                    stopProcess process
+                    exitFailure
+                Right () -> do
+                    prepareDatabase session
+                    pure (Bench process dataDir client session)
+
+-- | 基准用的配置：管理员凭据、随机端口、临时数据目录
+benchConfigText :: String -> String
+benchConfigText dataDir =
+    unlines
+        [ "[web]"
+        , "user = \"admin\""
+        , "password = \"s3cret\""
+        , ""
+        , "[server]"
+        , "host = \"127.0.0.1\""
+        , "port = 0"
+        , ""
+        , "[storage]"
+        , "data_dir = \"" ++ dataDir ++ "\""
+        , ""
+        , "[log]"
+        , "level = \"error\""
+        ]
+
+-- | 收摊：关会话、停 server、清数据目录
+stopBench :: Bench -> IO ()
+stopBench bench = do
+    putStrLn "\n[teardown] closing the TCP session, stopping the server, removing the data dir"
+    closeClient (bClient bench)
+    stopProcess (bProcess bench)
+    _ <- try (removeDirectoryRecursive (bDataDir bench)) :: IO (Either IOException ())
+    pure ()
+
+-- | 杀掉 server 进程
+stopProcess :: ProcessHandle -> IO ()
+stopProcess process = do
+    terminateProcess process
+    _ <- try (waitForProcess process) :: IO (Either IOException ExitCode)
+    pure ()
+
 -- | 主入口
 main :: IO ()
 main = do
@@ -368,48 +471,18 @@ main = do
     let pick i d = if length args > i then args !! i else d
         u = read (pick 0 "200") :: Int
         o = read (pick 1 "200") :: Int
-        serverArg = pick 2 ""
+    printf "full-chain benchmark: TCP client --> chusql-server --> in-process Rust storage\n"
-    serverPath <- findServer serverArg
-
-    tmp <- getTemporaryDirectory
-    stamp <- getMonotonicTime
-    let pipe = "chusql-fullchain-" ++ show (round (stamp * 1e6) :: Int)
-        dataDir = tmp </> pipe
-        configPath = tmp </> (pipe ++ ".toml")
-        -- TOML 的普通字符串会吃反斜杠，路径统一用正斜杠
-        slashed = map (\c -> if c == '\\' then '/' else c) dataDir
-    createDirectoryIfMissing True dataDir
-    writeFile
-        configPath
-        ( unlines
-            [ "[storage]"
-            , "data_dir = \"" ++ slashed ++ "\""
-            , "[server]"
-            , "pipe_name = \"" ++ pipe ++ "\""
-            , "[log]"
-            , "level = \"error\""
-            ]
-        )
-    setPipeName pipe
-
-    printf "full-chain benchmark: Haskell engine <--named pipe--> Rust storage\n"
-    printf "storage  : %s\n" serverPath
-    printf "config   : %s\n" configPath
-    printf "pipe     : %s\n" pipe
-    printf "data dir : %s\n" dataDir
     printf "dataset  : users = %d rows, orders = %d rows\n" u o
-    printf "timing   : wall clock (monotonic); every statement runs the full chain\n"
+    printf "timing   : wall clock (monotonic); every statement runs the full chain over TCP\n"
-
+    printf "note     : the client no longer links the engine or the storage library\n"
     bracket
         (do
             t1 <- getMonotonicTime
-            ph <- startServer serverPath configPath
+            bench <- startBench
             t2 <- getMonotonicTime
-            printf "\n[startup] storage ready in %.2f s\n" (t2 - t1)
+            printf "\n[startup] server up, storage ready, signed in: %.2f s\n" (t2 - t1)
-            pure ph
+            threadDelay 25000
+            pure bench
         )
-        (\ph -> do
+        stopBench
-            putStrLn "\n[teardown] stopping storage and removing the data dir"
+        (\bench -> runScenarios bench u o)
-            stopServer ph dataDir
-        )
-        (const (runScenarios u o))

benchmark/stack.yaml

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

chusql-cli/app/Main.hs

@@ -11,19 +11,11 @@ import ChuSQL.CLI.Session (
     newSession,
     switchDatabase,
  )
-import ChuSQL.Web.Auth (Credential (..))
+import ChuSQL.Interface.Auth (Credential (..))
-import ChuSQL.Web.Backend (ipcBackend)
+import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, resolveCredential, resolvePlainPassword)
-import ChuSQL.Web.Config (WebConfig (..), defaultPassword, loadWebConfigAt, resolveCredential, resolvePipeName)
+import ChuSQL.Interface.Link (Client, closeClient, connectClient)
-import ChuSQL.Web.Settings (readSettingsFile)
+import ChuSQL.Interface.Settings (readSettingsFile)
-import ChuSQL.Web.TOML (resolveConfigPath)
+import ChuSQL.Interface.TOML (resolveConfigPath)
-import ChuSQL.Web.StorageProcess (
-    StorageProcess,
-    findStorageServer,
-    startStorageProcessAt,
-    stopStorageProcess,
-    waitForStorage,
- )
-import ChuSQL.Storage.IPC (setPipeName)
 import Control.Exception (finally)
 import Control.Monad (unless)
 import Data.IORef (newIORef)
@@ -39,7 +31,7 @@ import System.Exit (exitFailure)
 import System.FilePath ((</>))
 import System.IO (hSetEncoding, stderr, stdout, utf8)
 
--- chusql-cli：与 Web 管理端并列的前端，直连存储与引擎，账号与 Web 共用。
+-- chusql-cli：与 Web 管理端并列的前端，接到拥有存储的 server 上跑 SQL，账号与 Web 共用。
 
 data Options = Options
     { optUser :: Maybe Text
@@ -48,11 +40,10 @@ data Options = Options
     , optFormat :: OutputFormat
     , optExecute :: Maybe Text
     , optHistory :: Maybe FilePath
-    , optPipe :: Maybe String
-    , optStorage :: Maybe FilePath
     , optConfig :: Maybe FilePath
     }
 
+-- | 命令行参数解析器
 optionsParser :: Parser Options
 optionsParser =
     Options
@@ -78,13 +69,13 @@ optionsParser =
             )
         <*> 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 "pipe" <> metavar "NAME" <> help "Endpoint name of the storage process (Windows named pipe, Unix socket file; default: [server] pipe_name in chusql.toml)"))
-        <*> optional (strOption (long "storage" <> metavar "SERVER" <> help "Rust storage executable to spawn when nothing answers the endpoint"))
         <*> optional (strOption (long "config" <> metavar "FILE" <> help "Config file to read (default: the fixed chusql.toml under the system config directory)"))
 
+-- | 把 --format 的取值解析成格式
 formatReader :: String -> Either String OutputFormat
 formatReader raw = maybe (Left "format must be table, json or csv") Right (parseFormat (T.pack raw))
 
+-- | 命令行界面与帮助
 parserInfo :: ParserInfo Options
 parserInfo =
     info
@@ -94,6 +85,7 @@ parserInfo =
             <> header "csql - the ChuSQL command line client"
         )
 
+-- | 解析参数、登录 server 后进入会话
 main :: IO ()
 main = do
     hSetEncoding stdout utf8
@@ -101,31 +93,29 @@ main = do
     options <- execParser parserInfo
     configPath <- resolveConfigPath (optConfig options)
     base <- loadWebConfigAt configPath
-    let settingsFile = configPath
+    saved <- readSettingsFile configPath
-    saved <- readSettingsFile settingsFile
     credential <- resolveCredential base saved
+    config <- loadServerConfigAt configPath
     let rootName = credUser credential
         userName = fromMaybe rootName (optUser options)
-        pipeName = resolvePipe options base
-    setPipeName pipeName
     password <- resolvePassword (optPromptPassword options) userName rootName saved
-    storage <- acquireStorage options pipeName settingsFile
+    connected <- connectClient (T.pack (scHost config)) (scPort config)
-    case storage of
+    case connected of
         Left message -> reportError message >> exitFailure
-        Right spawned ->
+        Right client ->
-            connect options credential settingsFile userName password
+            connect options client userName password
-                `finally` maybe (pure ()) stopStorageProcess spawned
+                `finally` closeClient client
 
--- | 接上存储，登录，然后进交互或跑单条语句
+-- | 连 server、登录，之后转入会话
-connect :: Options -> Credential -> FilePath -> Text -> Text -> IO ()
+connect :: Options -> Client -> Text -> Text -> IO ()
-connect options credential settingsFile userName password = do
+connect options client userName password = do
-    backend <- ipcBackend
+    session <- newSession client
-    session <- newSession backend credential settingsFile
     signedIn <- authenticateSession session userName password
     case signedIn of
         Left message -> reportError message >> exitFailure
         Right () -> runSession options session
 
+-- | 执行 -e 的单条语句，否则进交互循环
 runSession :: Options -> Session -> IO ()
 runSession options session = do
     formatRef <- newIORef (optFormat options)
@@ -140,7 +130,7 @@ runSession options session = do
                 historyFile <- resolveHistory (optHistory options)
                 runRepl session formatRef historyFile
 
--- | 只有 -d 明确给了一个库才切；没给就保持"未选库"（服务没有默认库）
+-- | -d 指定了库才切，否则保持未选库
 selectDatabase :: Session -> Text -> IO Bool
 selectDatabase _ wanted | T.null wanted = pure True
 selectDatabase session wanted
@@ -151,54 +141,20 @@ selectDatabase session wanted
             Left message -> reportError message >> pure False
             Right () -> pure True
 
--- | 口令：-p 强制交互输入；否则配置里的 root 明文（同 Web）> 交互输入
+-- | 决定口令是交互输入还是取自配置
 resolvePassword :: Bool -> Text -> Text -> Map.Map Text Text -> IO Text
 resolvePassword forcePrompt userName rootName saved
     | forcePrompt = promptPassword userName
-    | T.toLower userName == T.toLower rootName = pure (configuredPassword saved)
+    | T.toLower userName == T.toLower rootName = pure (resolvePlainPassword saved)
     | otherwise = promptPassword userName
-  where
-    configuredPassword values = case nonEmpty (Map.lookup "password" values) of
-        Just plain -> plain
-        Nothing -> defaultPassword
 
+-- | 交互式读取口令
 promptPassword :: Text -> IO Text
 promptPassword user = do
     entered <- runInputT defaultSettings (getPassword (Just '*') (T.unpack user <> "'s password: "))
     pure (maybe "" T.pack entered)
 
--- | 先找已经在跑的存储；--storage 给了可执行文件才自己拉一个
+-- | 取历史文件路径，没给就用默认
-acquireStorage :: Options -> String -> FilePath -> IO (Either Text (Maybe StorageProcess))
-acquireStorage options pipeName configPath = do
-    up <- waitForStorage 4
-    case optStorage options of
-        Nothing
-            | up -> pure (Right Nothing)
-            | otherwise ->
-                pure
-                    ( Left
-                        ( "no storage process answered on pipe "
-                            <> T.pack pipeName
-                            <> "; start the server first, or pass --storage <path>"
-                        )
-                    )
-        Just given
-            | up -> pure (Right Nothing)
-            | otherwise -> do
-                found <- findStorageServer (Just given)
-                case found of
-                    Left err -> pure (Left (T.pack err))
-                    Right binary -> fmap (either (Left . T.pack) (Right . Just)) (startStorageProcessAt binary pipeName configPath)
-
--- | 管名：--pipe > chusql.toml 的 [server] pipe_name（缺省 chusql-joint）
-resolvePipe :: Options -> WebConfig -> String
-resolvePipe options base = fromMaybe (resolvePipeName base) (optPipe options)
-
-nonEmpty :: Maybe Text -> Maybe Text
-nonEmpty given = case T.strip <$> given of
-    Just text | not (T.null text) -> Just text
-    _ -> Nothing
-
 resolveHistory :: Maybe FilePath -> IO (Maybe FilePath)
 resolveHistory (Just path) = pure (Just path)
 resolveHistory Nothing = do

chusql-cli/app/Repl.hs

@@ -8,9 +8,9 @@ module Repl
 
 import ChuSQL.CLI.Format (OutputFormat, formatName, renderResult, renderRows)
 import ChuSQL.CLI.Script (Meta (..), errorHint, metaHelp, parseMeta, takeStatement)
-import ChuSQL.CLI.Session (Session, accountTable, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
+import ChuSQL.CLI.Session (Session, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
-import ChuSQL.Storage.IPC (SchemaColumn (..), TableInfo (..))
+import ChuSQL.Core.Protocol (SchemaColumn (..), TableInfo (..))
-import ChuSQL.Web.Privileges (Grant (..), RoleView (..))
+import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
 import Control.Monad (forM_, when)
 import Control.Monad.IO.Class (liftIO)
 import Data.IORef (IORef, readIORef, writeIORef)
@@ -22,7 +22,7 @@ import System.IO (hIsTerminalDevice, stderr, stdin)
 
 -- 交互层：提示符、多行输入、历史、元命令与错误提示。
 
--- | 交互循环；historyPath 为 Nothing 就不落盘历史
+-- | 交互循环，没有历史文件就不落盘
 runRepl :: Session -> IORef OutputFormat -> Maybe FilePath -> IO ()
 runRepl session formatRef historyPath =
     runInputT (defaultSettings{historyFile = historyPath}) (loop session formatRef T.empty)
@@ -41,6 +41,7 @@ runStatementOnce session format sql = do
         Left message -> reportError message >> pure False
         Right answer -> TIO.putStrLn (renderResult format answer) >> pure True
 
+-- | 读一行输入，分派到元命令或语句缓冲
 loop :: Session -> IORef OutputFormat -> Text -> InputT IO ()
 loop session formatRef buffer = do
     prompt <- liftIO (promptFor session buffer)
@@ -62,7 +63,7 @@ loop session formatRef buffer = do
                         remaining <- drain session formatRef extended
                         loop session formatRef remaining
 
--- | 提示符带上当前库；续行换个样子，方便看出语句还没写完；管道输入时不出提示符
+-- | 生成提示符；续行与非终端输入另有样式
 promptFor :: Session -> Text -> IO Text
 promptFor session buffer = do
     interactive <- hIsTerminalDevice stdin
@@ -83,6 +84,7 @@ drain session formatRef buffer = case takeStatement buffer of
         when (not (T.null statement)) (runOne session formatRef statement)
         drain session formatRef rest
 
+-- | 执行一条语句并打印结果
 runOne :: Session -> IORef OutputFormat -> Text -> InputT IO ()
 runOne session formatRef statement = do
     result <- liftIO (runStatement session statement)
@@ -92,6 +94,7 @@ runOne session formatRef statement = do
             format <- liftIO (readIORef formatRef)
             outputStrLn (T.unpack (renderResult format answer))
 
+-- | 执行元命令，返回是否继续循环
 runMeta :: Session -> IORef OutputFormat -> Meta -> InputT IO Bool
 runMeta session formatRef meta = case meta of
     MetaQuit -> pure False
@@ -120,17 +123,16 @@ listDatabases session = do
         Left message -> liftIO (reportError message)
         Right names -> outputStrLn (T.unpack (renderRows ["database"] (map (: []) names)))
 
--- | \dt：表清单（base 里补上账号表）
+-- | \dt：表清单（含 server 补的账号表）
 listTables :: Session -> InputT IO ()
 listTables session = do
     answer <- liftIO (catalog session)
     case answer of
         Left message -> liftIO (reportError message)
-        Right tables -> do
+        Right tables -> outputStrLn (T.unpack (renderRows headers (map tableRow tables)))
-            allTables <- liftIO (withAccountTable session tables)
-            outputStrLn (T.unpack (renderRows headers (map tableRow allTables)))
   where
     headers = ["table", "columns", "rows", "indexes"]
+    -- | 把表信息排成一行
     tableRow info =
         [ T.pack (tiTable info)
         , tshow (length (tiColumns info))
@@ -144,14 +146,15 @@ describeTable session name = do
     answer <- liftIO (catalog session)
     case answer of
         Left message -> liftIO (reportError message)
-        Right tables -> do
+        Right tables ->
-            allTables <- liftIO (withAccountTable session tables)
+            case filter (matches name) tables of
-            case filter (matches name) allTables of
                 [] -> liftIO (reportError ("unknown table: " <> name))
                 (info : _) -> outputStrLn (T.unpack (renderRows headers (map columnRow (tiColumns info))))
   where
     headers = ["column", "type", "primary", "unique", "nullable", "auto"]
+    -- | 表名忽略大小写比较
     matches wanted info = T.toLower (T.pack (tiTable info)) == T.toLower wanted
+    -- | 把列信息排成一行
     columnRow column =
         [ T.pack (scName column)
         , T.pack (scType column)
@@ -160,6 +163,7 @@ describeTable session name = do
         , yesNo (scNullable column)
         , yesNo (scAutoIncrement column)
         ]
+    -- | 布尔值转成 yes/no
     yesNo True = "yes"
     yesNo False = "no"
 
@@ -171,22 +175,15 @@ 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
 
--- | 当前库是 system 时，把账号表也列出来（与 Web 端一致）
+-- | 用 show 转成 Text
-withAccountTable :: Session -> [TableInfo] -> IO [TableInfo]
-withAccountTable session tables = do
-    current <- sessionDatabase session
-    if current /= "system"
-        then pure tables
-        else do
-            extra <- accountTable session
-            pure (maybe tables (: tables) extra)
-
 tshow :: Show a => a -> Text
 tshow = T.pack . show

chusql-cli/chusql-cli.cabal

@@ -2,9 +2,9 @@ cabal-version: 2.4
 
 name:           chusql-cli
 version:        1.0.0
-synopsis:       ChuSQL 命令行客户端：直连引擎与存储，与 Web 管理端共用账号
+synopsis:       ChuSQL 命令行客户端：直连数据库服务，与 Web 管理端共用账号
-description:    ChuSQL 的命令行前端。直接走命名管道接 Rust 存储进程与 Haskell 引擎，
+description:    ChuSQL 的命令行前端。自己不开存储、不链引擎，所有 SQL 与会话
-                不经过 Web REST；root 凭据与 __chusql_users 表与 Web 管理端完全共用。
+                 都走 chusql-server 的 TCP 端点；账号表与权限服务与 Web 管理端完全共用。
 build-type:     Simple
 
 library
@@ -15,11 +15,9 @@ library
     build-depends:    base >= 4.14 && < 5
                     , aeson
                     , bytestring
-                    , chusql-engine
+                    , chusql-core-model
-                    , chusql-web
+                    , chusql-interface
-                    , scientific
                     , text
-                    , time
     default-language: Haskell2010
     ghc-options:      -Wall
 
@@ -28,10 +26,9 @@ executable csql
     other-modules:    Repl
     hs-source-dirs:   app
     build-depends:    base
-                    , aeson
                     , chusql-cli
-                    , chusql-engine
+                    , chusql-core-model
-                    , chusql-web
+                    , chusql-interface
                     , containers
                     , directory
                     , filepath
@@ -40,6 +37,11 @@ executable csql
                     , text
     default-language: Haskell2010
     ghc-options:      -Wall
+    -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
+    if os(linux)
+        ld-options: -Wl,-rpath,$ORIGIN
+    if os(osx)
+        ld-options: -Wl,-rpath,@loader_path
 
 test-suite chusql-cli-test
     type:             exitcode-stdio-1.0
@@ -49,8 +51,7 @@ test-suite chusql-cli-test
                     , aeson
                     , bytestring
                     , chusql-cli
-                    , chusql-engine
+                    , chusql-core-model
-                    , chusql-web
                     , hspec
                     , text
     default-language: Haskell2010

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

@@ -12,8 +12,8 @@ module ChuSQL.CLI.Format
     , displayValue
     ) where
 
-import ChuSQL.CLI.Session (QueryResult (..), queryResultJson)
+import ChuSQL.Core.Model (Value (..))
-import ChuSQL.Model (Value (..))
+import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL
 import Data.Text (Text)
@@ -25,6 +25,7 @@ import Data.Text.Encoding (decodeUtf8)
 data OutputFormat = FormatTable | FormatJson | FormatCsv
     deriving (Eq, Show)
 
+-- | 格式的对外名字
 formatName :: OutputFormat -> Text
 formatName FormatTable = "table"
 formatName FormatJson = "json"
@@ -38,6 +39,7 @@ parseFormat raw = case T.toLower (T.strip raw) of
     "csv" -> Just FormatCsv
     _ -> Nothing
 
+-- | 按格式渲染查询结果
 renderResult :: OutputFormat -> QueryResult -> Text
 renderResult FormatTable = renderTable
 renderResult FormatJson = renderJson
@@ -47,10 +49,12 @@ renderResult FormatCsv = renderCsv
 renderJson :: QueryResult -> Text
 renderJson = decodeUtf8 . BL.toStrict . A.encode . queryResultJson
 
+-- | 渲染成 CSV
 renderCsv :: QueryResult -> Text
 renderCsv result = T.unlines (header : map rowLine (qrRows result))
   where
     header = T.intercalate "," (map csvField (qrColumns result))
+    -- | 拼一行 CSV
     rowLine row = T.intercalate "," (map (csvField . csvCell) row)
 
 -- | CSV 里的空值就是空字段
@@ -64,6 +68,7 @@ csvField field
     | T.any (`elem` (",\"\n\r" :: String)) field = "\"" <> T.replace "\"" "\"\"" field <> "\""
     | otherwise = field
 
+-- | 渲染成等宽表格
 renderTable :: QueryResult -> Text
 renderTable result
     | null (qrColumns result) = "OK"
@@ -74,10 +79,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
@@ -93,6 +101,7 @@ pad width text = clipped <> T.replicate (width - T.length clipped) " "
         | width <= 3 = T.take width text
         | otherwise = T.take (width - 3) text <> "..."
 
+-- | 把值转成可显示的文本
 displayValue :: Value -> Text
 displayValue VNull = "NULL"
 displayValue (VInt n) = T.pack (show n)

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

@@ -57,15 +57,18 @@ parseMeta raw = do
         "format" -> selectFormat argument
         other -> MetaUnknown other
   where
+    -- | 拼出切库命令
     connectTo argument
         | T.null argument = MetaUnknown "c"
         | otherwise = MetaConnect argument
+    -- | 解析格式参数
     selectFormat argument = maybe (MetaUnknown "format") MetaSetFormat (parseFormat argument)
 
--- | 取出第一条以分号结束的语句与后面的残余；字符串与注释里的分号不算
+-- | 取出第一条语句，忽略引号与注释里的分号
 takeStatement :: Text -> Maybe (Text, Text)
 takeStatement = go ScanNormal [] . T.unpack
   where
+    -- | 逐字符扫描语句边界
     go _ _ [] = Nothing
     go ScanNormal acc (';' : rest) = Just (T.strip (T.pack (reverse acc)), T.pack rest)
     go ScanNormal acc ('-' : '-' : rest) = go ScanLineComment ('-' : '-' : acc) rest

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

@@ -1,270 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
+module ChuSQL.CLI.Session (module ChuSQL.Interface.Session) where
 
-module ChuSQL.CLI.Session
+import ChuSQL.Interface.Session
-    ( QueryResult (..)
-    , Session
-    , newSession
-    , sessionUser
-    , sessionIsAdmin
-    , sessionDatabase
-    , isPlainIdentifier
-    , authenticateSession
-    , switchDatabase
-    , runStatement
-    , catalog
-    , accountTable
-    , roleViews
-    , databases
-    , queryResultJson
-    ) where
 
-import ChuSQL.Model (Value (..))
+-- 命令行会话：转出前端共享的会话接口，一切请求走 server。
-import ChuSQL.Storage.IPC (TableInfo (..))
-import ChuSQL.Syntax.AST (Statement (..))
-import ChuSQL.Syntax.Parser (parseStatement)
-import ChuSQL.Web.Accounts
-import ChuSQL.Web.API (configurePasswordPolicy, systemTableInfo)
-import ChuSQL.Web.Auth (Credential, defaultSessionPolicy, newSessionStore)
-import ChuSQL.Web.Backend (Backend (..), StatementResult (..))
-import ChuSQL.Web.Privileges (PrivilegeCommand, PrivilegeError (..), Privileges, RoleView, authorize, filterTables, listRoleViews, newPrivileges, privilegeCommand, runPrivilegeCommand)
-import Data.Aeson (object, (.=))
-import qualified Data.Aeson as A
-import Data.Char (isAlpha, isAlphaNum)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Scientific (fromFloatDigits)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time.Clock (getCurrentTime)
-
--- CLI 会话：直接连存储与引擎，但账号服务与 Web 管理端是同一套
--- （同一个 root 凭据，同一张 __chusql_users）。
-
-data QueryResult = QueryResult
-    { qrColumns :: [Text]
-    , qrRows :: [[Value]]
-    , qrRowCount :: Int
-    , qrTruncated :: Bool
-    , qrDatabase :: Maybe Text
-    }
-    deriving (Eq, Show)
-
-data Session = Session
-    { ssBackend :: Backend
-    , ssAccounts :: Accounts
-    , ssPrivileges :: Privileges
-    , ssCurrent :: IORef Text
-    , ssPrincipal :: IORef (Maybe Principal)
-    }
-
--- | 开一个会话：账号与角色服务、配置策略都和 Web 端一致
-newSession :: Backend -> Credential -> FilePath -> IO Session
-newSession backend credential settingsFile = do
-    sessions <- newSessionStore getCurrentTime defaultSessionPolicy
-    accounts <- newAccounts backend sessions credential
-    privileges <- newPrivileges backend
-    configurePasswordPolicy accounts settingsFile
-    -- 服务启动后只有系统库：没 USE 之前不预设任何工作库
-    current <- newIORef ""
-    principal <- newIORef Nothing
-    pure (Session backend accounts privileges current principal)
-
--- | 当前登录的账号名
-sessionUser :: Session -> IO (Maybe Text)
-sessionUser session = fmap principalName <$> readIORef (ssPrincipal session)
-
--- | 是不是配置里的 root
-sessionIsAdmin :: Session -> IO Bool
-sessionIsAdmin session = maybe False principalIsRoot <$> readIORef (ssPrincipal session)
-
--- | 当前库
-sessionDatabase :: Session -> IO Text
-sessionDatabase = readIORef . ssCurrent
-
--- | 与解析器一致的裸标识符判断
-isPlainIdentifier :: Text -> Bool
-isPlainIdentifier name =
-    not (T.null name)
-        && T.length name <= 64
-        && (isAlpha (T.head name) || T.head name == '_')
-        && T.all (\ch -> isAlphaNum ch || ch == '_') name
-
--- | 登录：root 比配置里的凭据，普通账号查 __chusql_users
-authenticateSession :: Session -> Text -> Text -> IO (Either Text ())
-authenticateSession session user password = do
-    result <- authenticate (ssAccounts session) user password
-    case result of
-        Left err -> pure (Left (accountMessage err))
-        Right token -> do
-            who <- currentPrincipal (ssAccounts session) token
-            case who of
-                Left err -> pure (Left (accountMessage err))
-                Right principal -> do
-                    writeIORef (ssPrincipal session) (Just principal)
-                    pure (Right ())
-
--- | 换库；系统库只有 root 能进
-switchDatabase :: Session -> Text -> IO (Either Text ())
-switchDatabase session rawName
-    | not (isPlainIdentifier name) = pure (Left ("not a plain database name: " <> name))
-    | name == "system" = do
-        admin <- sessionIsAdmin session
-        if admin then go else pure (Left "the system database is only available to the administrator")
-    | otherwise = go
-  where
-    name = T.toLower (T.strip rawName)
-    go = do
-        backend <- currentBackend session
-        result <- beStatement backend ("USE " ++ T.unpack name)
-        case result of
-            Left err -> pure (Left (T.pack err))
-            Right _ -> writeIORef (ssCurrent session) name >> pure (Right ())
-
--- | 跑一条语句：USE、账号语句与角色语句在这里分流，其余交给引擎
--- （普通身份先过一遍权限判定，管理员与未登录直接放行）
-runStatement :: Session -> Text -> IO (Either Text QueryResult)
-runStatement session sql = case parseStatement (T.unpack sql) of
-    Right (UseDatabase name) -> do
-        switched <- switchDatabase session (T.pack name)
-        case switched of
-            Left err -> pure (Left err)
-            Right () -> do
-                current <- readIORef (ssCurrent session)
-                pure (Right (emptyResult (Just current)))
-    Right statement
-        | Just command <- accountCommand statement -> runAccount session command
-        | Just command <- privilegeCommand statement -> runPrivilege session command
-        | otherwise -> do
-            allowed <- authorized session statement
-            case allowed of
-                Left err -> pure (Left err)
-                Right () -> runPlain session sql
-    Left _ -> runPlain session sql
-
--- | 普通身份跑语句前的权限判定；管理员与未登录放行
-authorized :: Session -> Statement -> IO (Either Text ())
-authorized session statement = do
-    who <- readIORef (ssPrincipal session)
-    case who of
-        Just principal | not (principalIsRoot principal) -> do
-            database <- readIORef (ssCurrent session)
-            result <- authorize (ssPrivileges session) principal database statement
-            pure (either (Left . privilegeMessage) (const (Right ())) result)
-        _ -> pure (Right ())
-
--- | 落到引擎/存储层的一条语句
-runPlain :: Session -> Text -> IO (Either Text QueryResult)
-runPlain session sql = do
-    backend <- currentBackend session
-    result <- beStatement backend (T.unpack sql)
-    pure (either (Left . T.pack) (Right . resultOf) result)
-
--- | 数据字典（\dt 与 \d 用）；普通身份只看得到自己有 SELECT 的表
-catalog :: Session -> IO (Either Text [TableInfo])
-catalog session = do
-    current <- readIORef (ssCurrent session)
-    if T.null current
-        then pure (Left "no database selected")
-        else do
-            backend <- currentBackend session
-            result <- beCatalog backend
-            case result of
-                Left e -> pure (Left (T.pack e))
-                Right infos -> do
-                    who <- readIORef (ssPrincipal session)
-                    case who of
-                        Just principal | not (principalIsRoot principal) -> do
-                            allowed <- filterTables (ssPrivileges session) principal current (map (T.pack . tiTable) infos)
-                            pure (either (Left . privilegeMessage) (\names -> Right (filter (\info -> T.pack (tiTable info) `elem` names) infos)) allowed)
-                        _ -> pure (Right infos)
-
--- | 库清单（\l 用）
-databases :: Session -> IO (Either Text [Text])
-databases session = do
-    result <- beDatabases (ssBackend session)
-    pure (either (Left . T.pack) (Right . map T.pack) result)
-
--- | 系统库里的账号表：列定义与 Web 端共用一份，行数从同一套账号服务来
-accountTable :: Session -> IO (Maybe TableInfo)
-accountTable session = do
-    admin <- sessionIsAdmin session
-    if not admin
-        then pure Nothing
-        else do
-            result <- listAccounts (ssAccounts session)
-            pure (either (const Nothing) (\accounts -> Just systemTableInfo{tiRows = length accounts}) result)
-
--- | 角色总览（\dr 用）；与 Web 的 /api/roles 一样只给管理员
-roleViews :: Session -> IO (Either Text [RoleView])
-roleViews session = do
-    admin <- sessionIsAdmin session
-    if not admin
-        then pure (Left "administrator required")
-        else do
-            result <- listRoleViews (ssPrivileges session)
-            pure (either (Left . privilegeMessage) Right result)
-
--- | 当前库对应的后端
-currentBackend :: Session -> IO Backend
-currentBackend session = do
-    name <- readIORef (ssCurrent session)
-    pure (beWithDatabase (ssBackend session) (T.unpack name))
-
--- | 账号语句走账号服务，普通账号一律拒绝
-runAccount :: Session -> AccountCommand -> IO (Either Text QueryResult)
-runAccount session command = do
-    who <- readIORef (ssPrincipal session)
-    case who of
-        Nothing -> pure (Left "sign in first")
-        Just principal -> do
-            result <- runAccountCommand (ssAccounts session) principal command
-            pure (either (Left . accountMessage) (const (Right (emptyResult Nothing))) result)
-
--- | 角色语句走权限服务，普通账号一律拒绝；当前库决定授权对象的落库口径
-runPrivilege :: Session -> PrivilegeCommand -> IO (Either Text QueryResult)
-runPrivilege session command = do
-    who <- readIORef (ssPrincipal session)
-    case who of
-        Nothing -> pure (Left "sign in first")
-        Just principal -> do
-            database <- readIORef (ssCurrent session)
-            result <- runPrivilegeCommand (ssPrivileges session) principal database command
-            pure (either (Left . privilegeMessage) (const (Right (emptyResult Nothing))) result)
-
-accountMessage :: AccountError -> Text
-accountMessage (AccountError _ message) = message
-
-privilegeMessage :: PrivilegeError -> Text
-privilegeMessage (PrivilegeError _ message) = message
-
-emptyResult :: Maybe Text -> QueryResult
-emptyResult database = QueryResult [] [] 0 False database
-
-resultOf :: StatementResult -> QueryResult
-resultOf result =
-    QueryResult
-        { qrColumns = map T.pack (srColumns result)
-        , qrRows = [map (cellOf row) (srColumns result) | row <- srRows result]
-        , qrRowCount = length (srRows result)
-        , qrTruncated = False
-        , qrDatabase = Nothing
-        }
-  where
-    cellOf row name = maybe VNull id (lookup name row)
-
--- | 结果还原成 JSON（JSON 输出用）
-queryResultJson :: QueryResult -> A.Value
-queryResultJson result =
-    object
-        [ "columns" .= qrColumns result
-        , "rows" .= map (map valueToJson) (qrRows result)
-        , "rowCount" .= qrRowCount result
-        , "truncated" .= qrTruncated result
-        , "database" .= qrDatabase result
-        ]
-
-valueToJson :: Value -> A.Value
-valueToJson VNull = A.Null
-valueToJson (VInt n) = A.Number (fromIntegral n)
-valueToJson (VFloat d) = A.Number (fromFloatDigits d)
-valueToJson (VStr s) = A.String (T.pack s)
-valueToJson (VBool b) = A.Bool b

chusql-cli/stack.yaml

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

chusql-cli/test/Spec.hs

@@ -1,52 +1,31 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 
 module Main (main) where
 
 import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable)
 import ChuSQL.CLI.Script (Meta (..), errorHint, parseMeta, statementComplete, stripTerminator, takeStatement)
-import ChuSQL.CLI.Session (
+import ChuSQL.Core.Model (Value (..))
-    QueryResult (..),
+import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
-    Session,
-    authenticateSession,
-    catalog,
-    databases,
-    newSession,
-    queryResultJson,
-    roleViews,
-    runStatement,
-    sessionDatabase,
-    sessionIsAdmin,
-    switchDatabase,
- )
-import ChuSQL.Model (Database, Table (..), Value (..), pattern TInt, pattern TStr)
-import ChuSQL.Storage.IPC (TableInfo (..))
-import ChuSQL.Web.Auth (Credential (..), hashPasswordWith)
-import ChuSQL.Web.Backend (memoryBackend)
-import ChuSQL.Web.Privileges (Grant (..), RoleView (..))
-import Control.Concurrent.MVar (newMVar)
 import Data.Aeson (decode)
 import qualified Data.Aeson as A
-import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
-import Data.Either (isLeft, isRight)
-import Data.List (nub, sort)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Test.Hspec
 
--- chusql-cli 测试：输出格式、交互层纯逻辑与共享账号会话。
+-- chusql-cli 测试：只覆盖本前端的纯逻辑（输出格式、语句缓冲与元命令）。
 
+-- | 测试入口
 main :: IO ()
 main = hspec spec
 
+-- | 全部测试用例
 spec :: Spec
 spec = do
     formatSpec
     scriptSpec
-    sessionSpec
-    roleSpec
 
+-- | 输出格式的用例
 formatSpec :: Spec
 formatSpec = describe "CLI: output formats" $ do
     it "renders a boxed table and marks NULL" $
@@ -79,6 +58,7 @@ formatSpec = describe "CLI: output formats" $ do
         parseFormat "csv" `shouldBe` Just FormatCsv
         parseFormat "xml" `shouldBe` Nothing
 
+-- | 语句缓冲与元命令的用例
 scriptSpec :: Spec
 scriptSpec = do
     describe "CLI: statement buffering" $ do
@@ -117,114 +97,6 @@ scriptSpec = do
             parseMeta "\\nope" `shouldBe` Just (MetaUnknown "nope")
             parseMeta "\\f xml" `shouldBe` Just (MetaUnknown "format")
 
-sessionSpec :: Spec
-sessionSpec = describe "CLI: session over the shared account service" $ do
-    it "signs in as the configured administrator and refuses a wrong password" $ do
-        session <- cliSession
-        authenticateSession session "admin" "wrong-password" >>= \answer -> isLeft answer `shouldBe` True
-        authenticateSession session "admin" "s3cret" >>= \answer -> isRight answer `shouldBe` True
-    it "runs SQL straight through the engine" $ do
-        session <- cliSession
-        signInRoot session
-        result <- runStatement session "SELECT id, name FROM users ORDER BY id LIMIT 1"
-        fmap qrColumns result `shouldBe` Right ["id", "name"]
-        fmap qrRowCount result `shouldBe` Right 1
-    it "starts with nothing selected, lists what exists and refuses an unknown USE" $ do
-        session <- cliSession
-        authenticateSession session "admin" "s3cret" >>= (`shouldBe` Right ())
-        sessionDatabase session >>= (`shouldBe` "")
-        runStatement session "SELECT id FROM users" >>= \answer -> answer `shouldBe` Left "no database selected"
-        listed <- databases session
-        listed `shouldBe` Right ["test", "system"]
-        runStatement session "USE missing" >>= \answer -> isLeft answer `shouldBe` True
-        sessionDatabase session >>= (`shouldBe` "")
-        runStatement session "USE test" >>= \answer -> isRight answer `shouldBe` True
-        sessionDatabase session >>= (`shouldBe` "test")
-    it "keeps accounts on the same store and system administrator-only" $ do
-        session <- cliSession
-        signInRoot session
-        runStatement session "CREATE USER alice IDENTIFIED BY 'alice-password-1'" >>= \answer -> isRight answer `shouldBe` True
-        authenticateSession session "alice" "alice-password-1" >>= \answer -> isRight answer `shouldBe` True
-        sessionIsAdmin session >>= (`shouldBe` False)
-        switchDatabase session "system" >>= \answer -> isLeft answer `shouldBe` True
-        runStatement session "DROP USER admin" >>= \answer -> isLeft answer `shouldBe` True
-
-roleSpec :: Spec
-roleSpec = describe "CLI: roles and grants over the shared privilege service" $ do
-    it "runs role statements as the administrator and refuses them for anyone else" $ do
-        session <- cliSession
-        signInRoot session
-        created <- runStatement session "CREATE ROLE analyst"
-        isRight created `shouldBe` True
-        duplicate <- runStatement session "CREATE ROLE analyst"
-        duplicate `shouldBe` Left "role already exists: analyst"
-        granted <- runStatement session "GRANT SELECT ON users TO analyst"
-        isRight granted `shouldBe` True
-        tallied <- runStatement session "GRANT SELECT, INSERT, UPDATE, DELETE ON users TO analyst"
-        isRight tallied `shouldBe` True
-        views <- roleViews session
-        fmap (map roleName) views `shouldBe` Right ["analyst"]
-        fmap (sort . nub . concatMap (map grantPrivilege . roleGrants)) views `shouldBe` Right ["delete", "insert", "select", "update"]
-        fmap (sort . nub . concatMap (map grantObject . roleGrants)) views `shouldBe` Right ["test.users"]
-        unknown <- runStatement session "GRANT SELECT ON users TO nobody"
-        unknown `shouldBe` Left "unknown role: nobody"
-        dropped <- runStatement session "DROP ROLE analyst"
-        isRight dropped `shouldBe` True
-        missing <- runStatement session "GRANT SELECT ON users TO analyst"
-        missing `shouldBe` Left "unknown role: analyst"
-    it "an ordinary account only gets what a grant allows" $ do
-        session <- cliSession
-        signInRoot session
-        runStatement session "CREATE TABLE secrets (id INT)" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "CREATE ROLE reader" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "GRANT SELECT ON users TO reader" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "CREATE USER bob IDENTIFIED BY 'bob-password-1'" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "GRANT reader TO bob" >>= \answer -> isRight answer `shouldBe` True
-        authenticateSession session "bob" "bob-password-1" >>= \answer -> isRight answer `shouldBe` True
-        granted <- runStatement session "SELECT id, name FROM users"
-        fmap qrRowCount granted `shouldBe` Right 3
-        refused <- runStatement session "SELECT id FROM secrets"
-        refused `shouldBe` Left "permission denied: SELECT ON secrets"
-        write <- runStatement session "INSERT INTO users (id, name) VALUES (4, 'four')"
-        write `shouldBe` Left "permission denied: INSERT ON users"
-        admin <- runStatement session "CREATE ROLE other"
-        admin `shouldBe` Left "administrator required"
-        listed <- catalog session
-        fmap (map tiTable) listed `shouldBe` Right ["users"]
-        hidden <- roleViews session
-        hidden `shouldBe` Left "administrator required"
-    it "revoking the membership closes the door again" $ do
-        session <- cliSession
-        signInRoot session
-        runStatement session "CREATE ROLE guest" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "GRANT SELECT ON users TO guest" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "CREATE USER carol IDENTIFIED BY 'carol-password-1'" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "GRANT guest TO carol" >>= \answer -> isRight answer `shouldBe` True
-        roster <- roleViews session
-        fmap (concatMap roleMembers) roster `shouldBe` Right ["carol"]
-        authenticateSession session "carol" "carol-password-1" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "SELECT id FROM users" >>= \answer -> isRight answer `shouldBe` True
-        signInRoot session
-        runStatement session "REVOKE guest FROM carol" >>= \answer -> isRight answer `shouldBe` True
-        authenticateSession session "carol" "carol-password-1" >>= \answer -> isRight answer `shouldBe` True
-        refused <- runStatement session "SELECT id FROM users"
-        refused `shouldBe` Left "permission denied: SELECT ON users"
-
-cliSession :: IO Session
-cliSession = do
-    db <- newMVar testDb
-    newSession (memoryBackend testDatabaseName db) testCredential "chusql-test-missing.settings.json"
-
--- | 夹具库名：服务不再有默认库，这个库要显式选
-testDatabaseName :: String
-testDatabaseName = "test"
-
--- | 登录管理员并选中夹具库（未选库时连表名都解析不了）
-signInRoot :: Session -> Expectation
-signInRoot session = do
-    authenticateSession session "admin" "s3cret" >>= (`shouldBe` Right ())
-    switchDatabase session (T.pack testDatabaseName) >>= (`shouldBe` Right ())
-
 sampleResult :: QueryResult
 sampleResult =
     QueryResult
@@ -234,18 +106,3 @@ sampleResult =
         , qrTruncated = False
         , qrDatabase = Nothing
         }
-
--- | 测试库：三行 users
-testDb :: Database
-testDb =
-    [ ( "users"
-      , Table
-            "users"
-            [("id", TInt), ("name", TStr)]
-            [[("id", VInt i), ("name", VStr ("user" ++ show i))] | i <- [1 .. 3]]
-      )
-    ]
-
--- | 测试账号：迭代次数压低（跑得快），口令 `s3cret`
-testCredential :: Credential
-testCredential = Credential "admin" (hashPasswordWith 1000 (BS.replicate 16 7) "s3cret")

chusql-core/engine/app/Main.hs

@@ -1,14 +1,14 @@
 module Main where
 
-import ChuSQL.Algebra.Op (renderPlan)
+import ChuSQL.Core.Engine.Algebra.Op (renderPlan)
-import ChuSQL.Algebra.Optimize (optimize)
+import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
-import ChuSQL.Algebra.Planner (translate)
+import ChuSQL.Core.Engine.Algebra.Planner (translate)
-import ChuSQL.Engine
+import ChuSQL.Core.Engine
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
-import ChuSQL.Syntax.Parser
+import ChuSQL.Core.Engine.Syntax.Parser
 
--- 命令行演示：跑几条语句，打印结果与优化前后的计划。
+-- 命令行演示入口：跑几条语句并打印结果与优化前后的计划。
 
 users :: Table
 users =
@@ -37,7 +37,7 @@ orders =
 db :: Database
 db = [("users", users), ("orders", orders)]
 
--- | 演示入口
+-- | 跑演示语句，打印结果与优化前后的计划
 main :: IO ()
 main = do
     putStrLn "==================== Engine ====================="

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

@@ -0,0 +1,70 @@
+cabal-version: 2.4
+
+name:           chusql-core-engine
+version:        1.0.0
+synopsis:       ChuSQL 执行引擎：SQL 词法与语法分析、表达式求值
+description:    ChuSQL 服务端执行引擎。负责 SQL 词法分析与 AST 构建、
+                WHERE 条件表达式求值、关系代数运算与内存表管理。
+build-type:     Simple
+
+library
+    hs-source-dirs:   src
+    exposed-modules:  ChuSQL.Core.Engine.Algebra.Eval
+                      ChuSQL.Core.Engine.Algebra.Expr
+                      ChuSQL.Core.Engine.Algebra.Op
+                      ChuSQL.Core.Engine.Algebra.Optimize
+                      ChuSQL.Core.Engine.Algebra.Planner
+                      ChuSQL.Core.Engine.Algebra.Sort
+                      ChuSQL.Core.Engine
+                      ChuSQL.Core.Engine.Semantic
+                      ChuSQL.Core.Engine.Storage
+                      ChuSQL.Core.Engine.Storage.FFI
+                      ChuSQL.Core.Engine.Storage.IPC
+                      ChuSQL.Core.Engine.Storage.Memory
+                      ChuSQL.Core.Engine.Syntax.AST
+                      ChuSQL.Core.Engine.Syntax.Parser
+    build-depends:    base >= 4.14 && < 5
+                    , aeson
+                    , bytestring
+                    , hashable
+                    , chusql-core-model
+                    , megaparsec
+                    , parser-combinators
+                    , scientific
+                    , text
+                    , unordered-containers
+    extra-libraries:  chusql_core_storage
+    -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
+    if os(linux)
+        ld-options: -Wl,-rpath,$ORIGIN
+    if os(osx)
+        ld-options: -Wl,-rpath,@loader_path
+    default-language: Haskell2010
+    ghc-options:      -Wall
+
+executable chusql-core-engine
+    main-is:          Main.hs
+    hs-source-dirs:   app
+    build-depends:    base
+                    , chusql-core-engine
+                    , chusql-core-model
+    default-language: Haskell2010
+    ghc-options:      -Wall
+    -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
+    if os(linux)
+        ld-options: -Wl,-rpath,$ORIGIN
+    if os(osx)
+        ld-options: -Wl,-rpath,@loader_path
+
+test-suite chusql-core-engine-test
+    type:             exitcode-stdio-1.0
+    main-is:          Spec.hs
+    hs-source-dirs:   test
+    build-depends:    base
+                    , chusql-core-engine
+                    , chusql-core-model
+                    , directory
+                    , filepath
+                    , hspec
+    default-language: Haskell2010
+    ghc-options:      -Wall

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

@@ -1,18 +1,18 @@
-module ChuSQL.Engine (runStatement, runStatementM, rowsOf) where
+module ChuSQL.Core.Engine (runStatement, runStatementM, rowsOf) where
 
-import ChuSQL.Algebra.Eval (evalCondForRowM, evalExprM, evalRelOpM)
+import ChuSQL.Core.Engine.Algebra.Eval (evalCondForRowM, evalExprM, evalRelOpM)
-import ChuSQL.Algebra.Expr (evalCondForRow, evalExpr)
+import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr)
-import ChuSQL.Algebra.Optimize (optimize)
+import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
-import ChuSQL.Algebra.Planner (translate)
+import ChuSQL.Core.Engine.Algebra.Planner (translate)
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Semantic (prepare)
+import ChuSQL.Core.Engine.Semantic (prepare)
-import ChuSQL.Storage (MonadStorage (..))
+import ChuSQL.Core.Engine.Storage (MonadStorage (..))
-import ChuSQL.Storage.Memory (MemoryStorage (runMemoryStorage))
+import ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage))
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
-import ChuSQL.Syntax.Parser (parseExpression)
+import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
 import Data.Maybe (mapMaybe)
 
--- 引擎入口：语义检查 + 分发执行，以及内存实现与泛型版本。
+-- 引擎入口：检查语义、按语句分发执行，另有内存实现与泛型版本。
 
 -- | 跑一条语句（内存实现）
 runStatement :: Database -> Statement -> Either String (Database, [Row])
@@ -74,6 +74,7 @@ runStatementUncheckedM db (Delete tbl mWhere) = do
                             result <- replaceAll tbl kept
                             pure (result >> Right [])
   where
+    -- | 取行里的整数 id，取不到就报错
     rowId :: Row -> Either String Int
     rowId r = case lookup "id" r of
         Just (VInt k) -> Right k
@@ -137,7 +138,9 @@ existingRows tbl table
     | needsRows table = scan tbl
     | otherwise = pure (Right [])
   where
+    -- | 这一表有没有要判约束的列
     needsRows t = any (constraintColumn . snd) (tableCols t)
+    -- | 这一列带不带要判的约束
     constraintColumn c = columnAutoIncrement c || columnUnique c || columnPrimaryKey c
 
 -- | 插一行：补齐缺列、给自增值、收类型、查约束
@@ -150,6 +153,7 @@ buildRows table current cols rows = do
             let auto = autoColumn table
             go auto (autoStart auto current) values []
   where
+    -- | 逐行构造，最后统一查一遍约束
     go _ _ [] acc = do
         let built = reverse acc
         mapM_ (runChecks table) built
@@ -165,11 +169,13 @@ buildRow :: Table -> Maybe (String, Column) -> [String] -> Int -> [Value] -> Eit
 buildRow table auto cols counter vals = go (tableCols table) counter []
   where
     provided = zip cols vals
+    -- | 按列定义逐列补值
     go [] c acc = Right (reverse acc, c)
     go ((name, col) : rest) c acc = do
         (v, c') <- pick name col c
         v' <- coerceValue (columnType col) v
         go rest c' ((name, v') : acc)
+    -- | 决定这一列取什么值
     pick name col c
         | Just (autoName, _) <- auto
         , name == autoName
@@ -178,11 +184,13 @@ buildRow table auto cols counter vals = go (tableCols table) counter []
         | Just d <- columnDefault col = Right (d, c)
         | columnNullable col = Right (VNull, c)
         | otherwise = Left ("INSERT: column " ++ name ++ " is NOT NULL and has no default")
+    -- | 自增值跟着已有的值往前推
     bump name _ c v
         | Just (autoName, _) <- auto
         , name == autoName = max (c + 1) (valueInt v + 1)
         | otherwise = c
 
+-- | 取自增值，不是整数就当 0
 valueInt :: Value -> Int
 valueInt (VInt n) = n
 valueInt _ = 0
@@ -204,6 +212,7 @@ autoStart (Just (name, _)) rows = case [n | r <- rows, Just (VInt n) <- [lookup
 runChecks :: Table -> Row -> Either String ()
 runChecks table row = mapM_ check (tableCols table)
   where
+    -- | 查这一列的 CHECK
     check (name, col) = case columnCheck col of
         Nothing -> Right ()
         Just text -> case parseExpression text of
@@ -213,6 +222,7 @@ runChecks table row = mapM_ check (tableCols table)
                 Right True -> Right ()
                 Right False -> Left ("CHECK on " ++ name ++ " failed")
 
+-- | 只取第一行（报错提示用）
 firstLine :: String -> String
 firstLine = takeWhile (/= '\n')
 
@@ -220,6 +230,7 @@ firstLine = takeWhile (/= '\n')
 enforceNotNull :: [(String, Column)] -> [Row] -> Either String ()
 enforceNotNull cols rows = mapM_ check cols
   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")
@@ -230,8 +241,11 @@ enforceUnique :: [(String, Column)] -> [Row] -> Either String ()
 enforceUnique cols rows = mapM_ check targets
   where
     targets = [(n, c) | (n, c) <- cols, columnUnique c || columnPrimaryKey c]
+    -- | 查这一列有没有重复值
     check (name, _) = go name [] (mapMaybe (lookup name) rows)
+    -- | 逐个值比过去
     go _ _ [] = Right ()
+    -- | NULL 不算冲突，跳过
     go name seen (VNull : rest) = go name seen rest
     go name seen (v : rest)
         | v `elem` seen = Left ("UNIQUE: duplicate value in column " ++ name)
@@ -271,6 +285,7 @@ setColumn col v = map (\(k, val) -> if k == col then (k, v) else (k, val))
 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
@@ -299,6 +314,7 @@ 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
         mapM_ (runChecks table) rows
@@ -306,7 +322,7 @@ alterTable db tbl change = case lookupTable db tbl of
         enforceUnique cols rows
         Right (cols, rows)
 
--- | ADD COLUMN：老行补默认值或 NULL，自增列从 1 开始
+-- | ADD COLUMN：老行补默认值或 NULL
 addColumnTo :: (String, Column) -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
 addColumnTo (name, col) cols rows
     | name `elem` map fst cols = Left ("ADD COLUMN: column already exists: " ++ name)
@@ -338,6 +354,7 @@ retypeColumn col ty cols rows
         rows' <- mapM convert rows
         Right (map (\entry@(n, c) -> if n == col then (n, c{columnType = ty}) else entry) cols, rows')
   where
+    -- | 把这一列的老值收进新类型
     convert row = case lookup col row of
         Nothing -> Right row
         Just v -> do

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

@@ -1,21 +1,20 @@
-module ChuSQL.Algebra.Eval (evalRelOp, evalRelOpM, evalExprM, evalCondForRowM) where
+module ChuSQL.Core.Engine.Algebra.Eval (evalRelOp, evalRelOpM, evalExprM, evalCondForRowM) where
 
-import ChuSQL.Algebra.Expr (evalCondForRow, evalExpr)
+import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr)
-import ChuSQL.Algebra.Optimize (optimize, relOpCols)
+import ChuSQL.Core.Engine.Algebra.Optimize (optimize, relOpCols)
-import ChuSQL.Algebra.Op
+import ChuSQL.Core.Engine.Algebra.Op
-import ChuSQL.Algebra.Planner (translate)
+import ChuSQL.Core.Engine.Algebra.Planner (translate)
-import ChuSQL.Algebra.Sort (compareValue, sortRows)
+import ChuSQL.Core.Engine.Algebra.Sort (compareValue, sortRows)
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Storage (IndexResult (..), MonadStorage (..))
+import ChuSQL.Core.Engine.Storage (IndexResult (..), MonadStorage (..))
-import ChuSQL.Storage.Memory (runMemoryStorage)
+import ChuSQL.Core.Engine.Storage.Memory (runMemoryStorage)
-import ChuSQL.Syntax.AST (Expr (..), JoinKind (..), Subquery (..))
+import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..), Subquery (..))
 import Control.Monad (filterM, foldM)
 import qualified Data.HashMap.Strict as HM
 
--- 执行：按算子树算出结果行（Scan 阶段会加别名前缀）。
+-- 执行：按算子树算出结果行，外层行供相关子查询引用。
--- 外层行 outer 给相关子查询用：子查询里的列先在本层行里找，找不到再落到外层行。
 
--- | 只保留清单里的列，顺序按清单（SELECT 的列序就是结果的列序）
+-- | 只保留清单里的列，顺序照清单
 project :: [String] -> Row -> Row
 project ["*"] row = row
 project cs row = [(c, v) | c <- cs, Just v <- [lookup c row]]
@@ -24,6 +23,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))
 
+-- | 给一批行加别名前缀
 prefixRows :: Maybe String -> [Row] -> [Row]
 prefixRows mAlias = map (addPrefix mAlias)
 
@@ -48,6 +48,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)
@@ -57,8 +58,7 @@ rowsCols :: [Row] -> [String]
 rowsCols (r : _) = map fst r
 rowsCols [] = []
 
--- | 参与等值匹配的键：NULL 不参与匹配，整数值的浮点归一到整数
+-- | 参与等值匹配的键：NULL 不参与，整数值的浮点归一
--- （嵌套循环走 compareValues，哈希要对齐它）
 joinKey :: Value -> Maybe Value
 joinKey VNull = Nothing
 joinKey (VFloat d)
@@ -70,9 +70,11 @@ joinKey (VFloat d)
     rounded = round d :: Integer
 joinKey v = Just v
 
+-- | 取一行的连接键
 joinKeyOf :: String -> Row -> Maybe Value
 joinKeyOf c row = lookup c row >>= joinKey
 
+-- | 等值连接的两侧列名
 data EquiKeys = EquiKeys
     { ekLeft :: String
     , ekRight :: String
@@ -85,7 +87,7 @@ equiKeys lcols rcols (Eq (Col a) (Col b))
     | a /= b, b `elem` lcols, a `elem` rcols = Just (EquiKeys b a)
 equiKeys _ _ _ = Nothing
 
--- | 连接：能认出等值键就走哈希，否则退回嵌套循环；左连接没配上的左行补 NULL
+-- | 连接两批行：等值键走哈希，否则嵌套循环
 joinRowsIn ::
     (MonadStorage m) =>
     Database ->
@@ -104,7 +106,7 @@ joinRowsIn db outer kind rcols cond lrows rrows =
     -- 右表为空时行上没有列名，用算子推导出来的列名补 NULL
     ncols = if null rrows then rcols else rowsCols rrows
 
--- | 左连接里配不上的左行补右表 NULL；内连接里没有匹配就是没行
+-- | 左连接配不上的左行补 NULL，内连接丢弃
 unmatched :: JoinKind -> Row -> [String] -> [Row]
 unmatched InnerJoin _ _ = []
 unmatched LeftJoin l cols = [l ++ [(c, VNull) | c <- cols]]
@@ -114,6 +116,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 -> []
@@ -138,6 +141,7 @@ filterPairsM ::
     m (Either String [Row])
 filterPairsM db outer kind ncols cond lrows rrows = go lrows []
   where
+    -- | 逐左行配对，左连接没配上就补 NULL
     go [] acc = pure (Right (reverse acc))
     go (l : ls) acc = do
         hits <- keep l rrows []
@@ -148,6 +152,7 @@ filterPairsM db outer kind ncols cond lrows rrows = go lrows []
                         (LeftJoin, []) -> [l ++ nullRow]
                         _ -> hs
                 go ls (reverse hs' ++ acc)
+    -- | 拿一行右行去比条件
     keep _ [] acc = pure (Right (reverse acc))
     keep l (r : rs) acc = do
         ok <- evalCondForRowM db cond (l ++ r ++ outer)
@@ -157,7 +162,7 @@ filterPairsM db outer kind ncols cond lrows rrows = go lrows []
             Right False -> keep l rs acc
     nullRow = [(c, VNull) | c <- ncols]
 
--- | 索引连接：右表是裸 Scan 时逐左行点查，返回 Nothing 表示该走通用路径
+-- | 索引连接：右表是裸 Scan 时逐左行点查
 probeIndexJoin ::
     (MonadStorage m) =>
     Database ->
@@ -183,8 +188,7 @@ probeIndexJoin db outer kind mAlias t ks rcols cond l = case lookup (ekLeft ks)
                     pairs <- joinRowsIn db outer kind rcols cond [l] (prefixRows mAlias rows)
                     pure (fmap Just pairs)
 
--- | 索引按值的相等匹配，而数值比较会把 2 和 2.0 看成相等，
+-- | 列与键都不是浮点时才敢用索引
--- 所以只有非浮点列 + 非浮点键才敢用索引，保证优化不改变结果语义
 indexSafe :: Database -> String -> String -> Value -> Bool
 indexSafe db t col k = case lookupTable db t of
     Left _ -> False
@@ -192,12 +196,14 @@ indexSafe db t col k = case lookupTable db t of
         Nothing -> False
         Just c -> not (floatType (columnType c)) && not (floatValue k)
 
+-- | 是不是浮点列类型
 floatType :: ColumnType -> Bool
 floatType CFloat = True
 floatType CDouble = True
 floatType (CDecimal _ _) = True
 floatType _ = False
 
+-- | 是不是浮点值
 floatValue :: Value -> Bool
 floatValue (VFloat _) = True
 floatValue _ = False
@@ -206,12 +212,14 @@ 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)
 
 -- | 按分组键把行分组，保留分组首次出现的顺序
 groupRows :: [String] -> [Row] -> Either String [([Value], [Row])]
 groupRows 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
@@ -269,7 +277,9 @@ evalAgg outer agg rows = case agg of
     MaxOf e -> valuesOf outer e rows >>= extremeOf higher . nonNull
     _ -> Left "only COUNT, SUM, AVG, MIN and MAX can be aggregated"
   where
+    -- | 取更小的那个
     lower a b = if compareValue b a == LT then b else a
+    -- | 取更大的那个
     higher a b = if compareValue b a == GT then b else a
 
 -- | 一组的输出行：分组列 + 各聚合值
@@ -289,6 +299,7 @@ evalAggregate outer keys aggs rows = do
 filterRowsM :: (Monad m) => (Row -> m (Either String Bool)) -> [Row] -> m (Either String [Row])
 filterRowsM p = go []
   where
+    -- | 逐行留下通过条件的
     go acc [] = pure (Right (reverse acc))
     go acc (r : rs) = do
         keep <- p r
@@ -301,6 +312,7 @@ filterRowsM p = go []
 computeM :: (MonadStorage m) => Database -> Row -> [(String, Expr)] -> Row -> 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)
@@ -375,6 +387,7 @@ substSubqueries db e env = case e of
     MaxOf a -> un MaxOf a
     _ -> pure (Right e)
   where
+    -- | 递归处理两个子表达式
     bin ctor a b = do
         ra <- substSubqueries db a env
         case ra of
@@ -382,6 +395,7 @@ substSubqueries db e env = case e of
             Right a' -> do
                 rb <- substSubqueries db b env
                 pure ((ctor a') <$> rb)
+    -- | 递归处理一个子表达式
     un ctor a = do
         ra <- substSubqueries db a env
         pure (ctor <$> ra)

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

@@ -1,7 +1,7 @@
-module ChuSQL.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, aggregatesIn, hasAggregate, bareColumns, hasSubquery, inValues, threeValuedNot) where
+module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, aggregatesIn, hasAggregate, bareColumns, hasSubquery, inValues, threeValuedNot) where
 
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
 import Control.Monad (join)
 
 -- 表达式求值：三值逻辑，NULL 参与运算结果仍是 NULL。
@@ -54,7 +54,7 @@ evalExpr agg _ = Left ("aggregate functions are not allowed here: " ++ show agg)
 subqueryNeedsDatabase :: String
 subqueryNeedsDatabase = "subquery needs a database to run"
 
--- | IN 的三值逻辑：命中为真，没命中但碰到 NULL 就给 NULL，否则为假
+-- | IN 三值逻辑：命中为真，碰 NULL 得 NULL
 inValues :: Value -> [Value] -> Either String Value
 inValues VNull _ = Right VNull
 inValues v vs = do
@@ -121,6 +121,7 @@ hasSubquery e = case e of
     MaxOf a -> hasSubquery a
     _ -> False
   where
+    -- | 两个子表达式里任意一个有
     both a b = hasSubquery a || hasSubquery b
 
 -- | 表达式里出现的聚合调用（按出现顺序）
@@ -146,6 +147,7 @@ aggregatesIn e = case e of
     IsNotNull a -> aggregatesIn a
     _ -> []
   where
+    -- | 两个子表达式的聚合拼起来
     both a b = aggregatesIn a ++ aggregatesIn b
 
 -- | 表达式里有没有聚合调用
@@ -174,6 +176,7 @@ bareColumns e = case e of
     ExistsSub sq _ -> subqueryRefs sq
     _ -> []
   where
+    -- | 两个子表达式的裸列拼起来
     both a b = bareColumns a ++ bareColumns b
 
 -- | 判断条件真假：只有 TRUE 通过，NULL 当作不通过
@@ -204,6 +207,7 @@ data Arith = Arith
 liftArith :: Arith -> Expr -> Expr -> Row -> Either String Value
 liftArith ops a b row = liftBinOp go a b row
   where
+    -- | NULL 出 NULL，整数配整数走整数算术
     go VNull _ = Right VNull
     go _ VNull = Right VNull
     go (VInt x) (VInt y) = VInt <$> arithInt ops x y
@@ -217,12 +221,15 @@ asDouble (VInt n) = Just (fromIntegral n)
 asDouble (VFloat d) = Just d
 asDouble _ = Nothing
 
+-- | 加法
 addArith :: Arith
 addArith = Arith (\x y -> Right (x + y)) (\x y -> Right (x + y))
 
+-- | 减法
 subArith :: Arith
 subArith = Arith (\x y -> Right (x - y)) (\x y -> Right (x - y))
 
+-- | 乘法
 mulArith :: Arith
 mulArith = Arith (\x y -> Right (x * y)) (\x y -> Right (x * y))
 
@@ -230,10 +237,12 @@ mulArith = Arith (\x y -> Right (x * y)) (\x y -> Right (x * y))
 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)
 
@@ -246,6 +255,7 @@ liftCompare ::
     Either String Value
 liftCompare rel a b row = liftBinOp (compareValues rel) a b row
 
+-- | 比较两个值：NULL 给 NULL，其余按数、串、布尔比
 compareValues :: (Ordering -> Bool) -> Value -> Value -> Either String Value
 compareValues rel x y
     | x == VNull || y == VNull = Right VNull
@@ -263,6 +273,7 @@ liftBool ::
     Either String Value
 liftBool f = liftBinOp f
 
+-- | 逻辑与的三值真值表
 andValues :: Value -> Value -> Either String Value
 andValues (VBool False) _ = Right (VBool False)
 andValues _ (VBool False) = Right (VBool False)
@@ -272,6 +283,7 @@ andValues (VBool True) VNull = Right VNull
 andValues VNull VNull = Right VNull
 andValues _ _ = Left "type error: expected two booleans"
 
+-- | 逻辑或的三值真值表
 orValues :: Value -> Value -> Either String Value
 orValues (VBool True) _ = Right (VBool True)
 orValues _ (VBool True) = Right (VBool True)

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

@@ -1,9 +1,9 @@
-module ChuSQL.Algebra.Op (RelOp (..), renderPlan) where
+module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), renderPlan) where
 
-import ChuSQL.Model (Value)
+import ChuSQL.Core.Model (Value)
-import ChuSQL.Syntax.AST (Expr, JoinKind (..), SortDir)
+import ChuSQL.Core.Engine.Syntax.AST (Expr, JoinKind (..), SortDir)
 
--- 关系代数算子，以及把算子树渲染成文本。
+-- 关系代数算子定义与算子树文本渲染。
 
 data RelOp
     = Scan (Maybe String) String (Maybe [String])
@@ -28,6 +28,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

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

@@ -1,12 +1,12 @@
-module ChuSQL.Algebra.Optimize (optimize, pushProject, relOpCols) where
+module ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject, relOpCols) where
 
-import ChuSQL.Algebra.Expr (colsInExpr, evalExpr)
+import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr)
-import ChuSQL.Algebra.Op (RelOp (..))
+import ChuSQL.Core.Engine.Algebra.Op (RelOp (..))
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Syntax.AST (Expr (..), JoinKind (..))
+import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..))
 import Data.List (nub)
 
--- 查询优化：谓词下推 + 投影下推 + 常量折叠，跑到不动点。
+-- 查询优化：谓词下推、投影下推与常量折叠。
 
 -- | 算子会产出哪些列
 relOpCols :: Database -> RelOp -> [String]
@@ -48,6 +48,7 @@ combineConj (e : es) = Just (foldl And e es)
 partitionPred :: [String] -> [Expr] -> ([Expr], [Expr])
 partitionPred have = foldr pick ([], [])
   where
+    -- | 按列归属收到左边或右边
     pick e (yes, no)
         | colsInExpr e `isSubsetOf` have = (e : yes, no)
         | otherwise = (yes, e : no)
@@ -72,8 +73,7 @@ pushJoin db p l r c =
             Nothing -> joined
             Just p' -> Filter p' joined
 
--- | Filter 压在左连接上时，只把纯左表的谓词下推到左表；
+-- | Filter 压在左连接上时只下推纯左表的谓词
--- 右表没配上会补 NULL，右表谓词不能提前算。
 pushLeftJoin :: Database -> Expr -> RelOp -> RelOp -> Expr -> RelOp
 pushLeftJoin db p l r c =
     let (lPs, rest) = partitionPred (relOpCols db l) (splitConj p)
@@ -105,6 +105,7 @@ hasDivision e = case e of
     Or a b -> both a b
     _ -> False
   where
+    -- | 两个子表达式里任意一个有除法
     both a b = hasDivision a || hasDivision b
 
 -- | 检查子计划中可能报错的除法
@@ -216,6 +217,7 @@ rewriteNode db op = pushOne db op
 optimizeRelOp :: Database -> RelOp -> RelOp
 optimizeRelOp db = rewriteNode db . descend
   where
+    -- | 先递归处理子算子
     descend (Filter p x) = Filter p (optimizeRelOp db x)
     descend (Project cols x) = Project cols (optimizeRelOp db x)
     descend (Compute items x) = Compute items (optimizeRelOp db x)

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

@@ -1,8 +1,8 @@
-module ChuSQL.Algebra.Planner (translate) where
+module ChuSQL.Core.Engine.Algebra.Planner (translate) where
 
-import ChuSQL.Algebra.Expr (aggregatesIn)
+import ChuSQL.Core.Engine.Algebra.Expr (aggregatesIn)
-import ChuSQL.Algebra.Op
+import ChuSQL.Core.Engine.Algebra.Op
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
 
 -- 计划生成：把语句翻译成算子树。
 
@@ -23,6 +23,7 @@ source fromC mWhere = case mWhere of
 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)

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

@@ -1,10 +1,10 @@
-module ChuSQL.Algebra.Sort (sortRows, compareValue) where
+module ChuSQL.Core.Engine.Algebra.Sort (sortRows, compareValue) where
 
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
 import Data.List (sortBy)
 
--- 排序：按多列排序，每列可升可降。
+-- 排序：按多列规格排出结果行，每列可升可降。
 
 -- | 反转比较结果
 flipOrdering :: Ordering -> Ordering
@@ -41,10 +41,12 @@ compareKeys ((_, dir) : rest) (a : as) (b : bs) =
         _ -> compareKeys rest as bs
 compareKeys _ _ _ = EQ
 
--- | 排序若干行（先取键再排，避免每次比较都查列）
+-- | 按排序规格排序若干行
 sortRows :: [(String, SortDir)] -> [Row] -> [Row]
 sortRows [] rows = rows
 sortRows spec rows = map snd (sortBy cmp (map decorate rows))
   where
+    -- | 取键并带上原行
     decorate row = (sortKey spec row, row)
+    -- | 比较两个带键的行
     cmp (k1, _) (k2, _) = compareKeys spec k1 k2

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

@@ -1,9 +1,9 @@
-module ChuSQL.Semantic (check, prepare) where
+module ChuSQL.Core.Engine.Semantic (check, prepare) where
 
-import ChuSQL.Algebra.Expr (bareColumns, colsInExpr, hasAggregate)
+import ChuSQL.Core.Engine.Algebra.Expr (bareColumns, colsInExpr, hasAggregate)
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
-import ChuSQL.Syntax.Parser (parseExpression)
+import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
 import Data.Char (isAlphaNum, isAscii, toLower)
 import Data.List (intercalate, isInfixOf, isPrefixOf, nub)
 import Data.Maybe (fromMaybe)
@@ -22,8 +22,7 @@ prefixColumns mAlias cols = [(prefix ++ c, ty) | (c, ty) <- cols]
   where
     prefix = maybe "" (++ ".") mAlias
 
--- | 检查期的作用域：本层优先，外层兜底。
+-- | 检查期的作用域：本层优先，外层兜底
--- 不能把两层平铺成一个列表：同名裸列会出现两次，被误报成 ambiguous。
 data Scope = Scope
     { scopeInner :: [(String, Column)]
     , scopeOuter :: [(String, Column)]
@@ -39,7 +38,7 @@ scopeAt place scope c
             | "ambiguous column:" `isInfixOf` err -> Left err
             | otherwise -> columnAt place (scopeOuter scope) c
 
--- | 收集 FROM 能提供的列；outer 是外层作用域，给 ON 里的相关子查询用
+-- | 收集 FROM 能提供的列，含外层作用域
 checkFrom :: Database -> [(String, Column)] -> FromClause -> Either String [(String, Column)]
 checkFrom _ _ FromUnit = Right []
 checkFrom db _ (FromTable mAlias tbl) = do
@@ -52,11 +51,11 @@ checkFrom db outer (FromJoin _ left mAlias tbl cond) = do
     checkBool db "ON" (Scope env outer) cond
     Right env
 
--- | 本层作用域优先：外层已有的同名键不再重复堆进来（否则同一个键被数两次，误报 ambiguous）
+-- | 合并两层列，本层优先且不重复
 scopedEnv :: [(String, Column)] -> [(String, Column)] -> [(String, Column)]
 scopedEnv env outer = env ++ [o | o <- outer, o `notElem` env]
 
--- | 作用域摊平成一层（只用于继续往外传，查找仍走 scopeAt 的本层优先）
+-- | 把作用域摊平成一层的列清单
 scopeFlat :: Scope -> [(String, Column)]
 scopeFlat scope = scopedEnv (scopeInner scope) (scopeOuter scope)
 
@@ -73,7 +72,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)
 
--- | 保留子句名与可用列提示
+-- | 在一层里查一列，报错时带上子句名与可用列
 columnAt :: String -> [(String, Column)] -> String -> Either String (String, Column)
 columnAt place env c = case resolveColumn c env of
     Right entry -> Right entry
@@ -94,6 +93,7 @@ checkGrouping env keys items
         checkColumns "GROUP BY" env keys
         mapM_ okCol (nub (concatMap (bareColumns . snd) items))
   where
+    -- | 这一列能不能出现在分组查询里
     okCol c
         | c == allColumns = Left "SELECT: * cannot be selected together with GROUP BY"
         | c `elem` keys = Right ()
@@ -173,7 +173,7 @@ itemType place want got
     | compatible want got = Right ()
     | otherwise = Left (place ++ ": IN list item has type " ++ renderType got ++ ", expected " ++ renderType want)
 
--- | 子查询的输出列与类型（外层作用域 outerScope 可做相关引用，内层整条查一遍）
+-- | 推导子查询的输出列与类型
 inferSubqueryOutput :: Database -> Scope -> Subquery -> Either String [(String, InferredType)]
 inferSubqueryOutput db outerScope sq = case subqueryStatement sq of
     q@Select { selectCols = cols } -> do
@@ -187,6 +187,7 @@ inferSubqueryOutput db outerScope sq = case subqueryStatement sq of
     _ -> Left "subquery must be a SELECT"
   where
     enclosing = scopeFlat outerScope
+    -- | 查这一列的推导类型
     columnTypeOf env c = do
         (_, col) <- scopeAt "SELECT" (Scope env enclosing) c
         Right (c, InferType (columnType col))
@@ -222,6 +223,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
 
@@ -260,6 +262,7 @@ boolean db place env a b = do
     mapM_ (boolOperand place ta) [ta, tb]
     Right (InferType CBool)
   where
+    -- | 挨个查操作数是不是布尔
     boolOperand _ _ InferNull = Right ()
     boolOperand _ _ (InferType CBool) = Right ()
     boolOperand p other t = Left (p ++ ": operator needs TBool on both sides, got " ++ renderType other ++ " and " ++ renderType t)
@@ -453,7 +456,7 @@ 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 列引用时可用的全部列名
+-- | 检查一列定义是否合法（names 给 CHECK 用）
 checkColumnDefs :: [String] -> [(String, Column)] -> Either String ()
 checkColumnDefs names cols = do
     mapM_ (\(_, c) -> mapM_ (checkDefault c) (columnDefault c)) cols
@@ -480,11 +483,13 @@ checkDefault c v
 checkChecks :: [String] -> [(String, Column)] -> Either String ()
 checkChecks names = mapM_ checkOne
   where
+    -- | 查这一列的 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)
@@ -494,6 +499,7 @@ checkChecks names = mapM_ checkOne
 accountNameLimit :: Int
 accountNameLimit = 64
 
+-- | 检查库名是否合法
 checkDatabaseName :: String -> Either String ()
 checkDatabaseName name
     | null name || length name > 64 || not (all (\c -> isAscii c && (isAlphaNum c || c == '_')) name) = Left "invalid database name"
@@ -511,6 +517,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))
 
 -- | 建号 / 改口令：名字合法且口令不空
@@ -524,7 +531,7 @@ checkAccount name password = do
                 then Left "USER: password is too long"
                 else Right ()
 
--- | 角色名：字符规则同账号名，另外不许拿权限关键字当名字（否则 GRANT 读不出来）
+-- | 检查角色名是否合法（不许用权限关键字）
 checkRoleName :: String -> Either String ()
 checkRoleName name
     | null name = Left "ROLE: empty role name"
@@ -533,6 +540,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))
 
 -- | 权限关键字（小写，只用于比较）
@@ -554,8 +562,10 @@ 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"
 -- | 把列引用统一为执行期名字（子查询一起解析）
@@ -592,10 +602,10 @@ resolveExpr db env outer f e = case e of
     ExistsSub sq negated -> ExistsSub <$> resolveSubquery db (env ++ outer) sq <*> pure negated
     _ -> Right e
   where
+    -- | 递归处理两个子表达式
     binary ctor a b = ctor <$> resolveExpr db env outer f a <*> resolveExpr db env outer f b
 
--- | 子查询：内层整条解析一遍，外层列参与解析（相关引用）
+-- | 解析子查询，并记下它引用的外层列
--- 解析完把“引用了哪些外层列”记进 subqueryRefs：投影下推要靠它保住这些列
 resolveSubquery :: Database -> [(String, Column)] -> Subquery -> Either String Subquery
 resolveSubquery db outer sq = do
     stmt <- resolveSubqueryStatement db outer (subqueryStatement sq)
@@ -608,11 +618,12 @@ outerRefsOf db stmt = nub [c | c <- statementColumns stmt, not (inInner c)]
     inner = case checkFrom db [] (statementFrom stmt) of
         Right env -> env
         Left _ -> []
+    -- | 这一列能不能在内层解析到
     inInner c = case resolveColumn c inner of
         Right _ -> True
         Left _ -> False
 
--- | 一条语句里出现的所有列引用（含 JOIN 的 ON 和嵌套子查询的外层引用）
+-- | 一条语句里出现的所有列引用
 statementColumns :: Statement -> [String]
 statementColumns stmt = case stmt of
     Select cols fromC mWhere groupBy orderBy _ ->
@@ -621,15 +632,18 @@ statementColumns stmt = case stmt of
         concatMap (colsInExpr . snd) items ++ fromColumns fromC ++ concatMap colsInExpr mWhere ++ groupBy ++ map fst orderBy
     _ -> []
   where
+    -- | 取 FROM 里出现的列
     fromColumns FromUnit = []
     fromColumns (FromTable _ _) = []
     fromColumns (FromJoin _ l _ _ c) = fromColumns l ++ colsInExpr c
 
+-- | 取语句的 FROM 子句，没有就是 FromUnit
 statementFrom :: Statement -> FromClause
 statementFrom Select { selectFrom = fromC } = fromC
 statementFrom SelectExpr { 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)
@@ -672,14 +686,17 @@ resolveSelect db q@Select{} = resolveQuery db [] q (map (\c -> (c, Col c)) (sele
 resolveSelect db q@SelectExpr{} = resolveQuery db [] q (selectItems q)
 resolveSelect _ q = Right q
 
--- | 解析投影、条件、排序与连接引用；outer 是相关子查询能看见的外层列
+-- | 解析投影、条件、排序与连接引用
 resolveQuery :: Database -> [(String, Column)] -> Statement -> [(String, Expr)] -> Either String Statement
 resolveQuery db outer q items = do
     env <- checkFrom db outer (selectFrom q)
+    -- | 单表查询里把裸列名换成物理列名
     let physical c = case selectFrom q of
             FromTable Nothing tbl -> unqualify (Just tbl) c
             _ -> c
+        -- | 查一列并换算成物理名
         name place c = physical . fst <$> scopedColumnAt place env outer c
+        -- | 换算一个投影项
         output (_, Col c) = do
             k <- name "SELECT" c
             pure (k, Col k)

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

@@ -1,11 +1,11 @@
-module ChuSQL.Storage (
+module ChuSQL.Core.Engine.Storage (
     MonadStorage (..),
     IndexResult (..),
 ) where
 
-import ChuSQL.Model (Column, Database, Row, Table (..), Value (..))
+import ChuSQL.Core.Model (Column, Database, Row, Table (..), Value (..))
 
--- 存储层抽象：上层只认 domain 类型，不关心底层实现。
+-- 存储层抽象：MonadStorage 类与 IndexResult。
 
 data IndexResult
     = IndexRows [Row]
@@ -13,12 +13,16 @@ data IndexResult
     deriving (Show, Eq)
 
 class (Monad m) => MonadStorage m where
+    -- \| 建一个库
     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 [])
 
@@ -38,6 +42,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
@@ -53,6 +58,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
@@ -79,7 +85,7 @@ class (Monad m) => MonadStorage m where
     -- \| 删除表
     dropTable :: String -> m (Either String ())
 
-    -- \| 给某一列建索引（要求这一列整数取值唯一）
+    -- \| 给某一列建索引（id 列要求唯一）
     createIndex :: String -> String -> m (Either String ())
     createIndex _ _ = pure (Right ())
 
@@ -100,4 +106,5 @@ class (Monad m) => MonadStorage m where
     schema :: m Database
     schema = fmap (map withoutRows) snapshot
       where
+        -- | 表定义去掉所有行
         withoutRows (name, t) = (name, t {tableRows = []})

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

@@ -0,0 +1,90 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module ChuSQL.Core.Engine.Storage.FFI (
+    StorageHandle,
+    storageVersion,
+    openStorage,
+    closeStorage,
+    storageRequest,
+) where
+
+import Control.Exception (SomeException, try)
+import Data.ByteString qualified as BS
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import Data.Text.Encoding.Error (lenientDecode)
+import Foreign
+import Foreign.C
+
+-- Rust 存储库 cdylib 的 C ABI 绑定（ffi.rs），收发单行 JSON。
+
+-- | 存储实例句柄（Rust 侧的 *mut Storage）
+newtype StorageHandle = StorageHandle (Ptr ())
+
+foreign import ccall unsafe "chusql_storage_version"
+    cStorageVersion :: IO CString
+
+foreign import ccall safe "chusql_storage_open"
+    cStorageOpen :: CString -> IO (Ptr ())
+
+foreign import ccall safe "chusql_storage_close"
+    cStorageClose :: Ptr () -> IO ()
+
+foreign import ccall safe "chusql_storage_request"
+    cStorageRequest :: Ptr () -> Ptr CChar -> CSize -> Ptr (Ptr CChar) -> Ptr CSize -> IO CInt
+
+foreign import ccall unsafe "chusql_storage_free"
+    cStorageFree :: Ptr CChar -> CSize -> IO ()
+
+foreign import ccall unsafe "chusql_storage_last_error"
+    cStorageLastError :: Ptr CSize -> IO (Ptr CChar)
+
+-- | 库版本（Rust 侧的 CARGO_PKG_VERSION）
+storageVersion :: IO String
+storageVersion = cStorageVersion >>= peekCString
+
+-- | 打开存储实例，失败给错误文本
+openStorage :: Maybe FilePath -> IO (Either String StorageHandle)
+openStorage path = do
+    result <- try (withCStringOrNull path cStorageOpen) :: IO (Either SomeException (Ptr ()))
+    case result of
+        Left e -> pure (Left ("storage library call failed: " ++ show e))
+        Right ptr
+            | ptr == nullPtr -> Left <$> lastError
+            | otherwise -> pure (Right (StorageHandle ptr))
+  where
+    -- | 没有路径就传空指针，否则转成 C 字符串
+    withCStringOrNull Nothing f = f nullPtr
+    withCStringOrNull (Just s) f = withCString s f
+
+-- | 关掉存储实例
+closeStorage :: StorageHandle -> IO ()
+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
+                if code /= 0
+                    then Left <$> lastError
+                    else do
+                        outPtr <- peek outPtrRef
+                        outLen <- peek outLenRef
+                        bytes <- BS.packCStringLen (castPtr outPtr, fromIntegral outLen)
+                        cStorageFree outPtr outLen
+                        pure (Right bytes)
+
+-- | 当前线程最近一次失败的文本
+lastError :: IO String
+lastError = alloca $ \lenRef -> do
+    ptr <- cStorageLastError lenRef
+    if ptr == nullPtr
+        then pure "storage: unknown error"
+        else do
+            len <- peek lenRef
+            raw <- BS.packCStringLen (ptr, fromIntegral len)
+            pure (T.unpack (TE.decodeUtf8With lenientDecode raw))

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

@@ -0,0 +1,368 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Core.Engine.Storage.IPC (
+    IPCStorage (..),
+    Request (..),
+    Response (..),
+    Account (..),
+    SchemaColumn (..),
+    TableInfo (..),
+    StorageLink (..),
+    setStorageLink,
+    localStorageLink,
+    sendRequest,
+    sendRawRequest,
+    closeConnection,
+    setDatabaseName,
+    getDatabaseName,
+    doListTables,
+    doLookupByColumn,
+    doInsert,
+    doInsertMany,
+    doDeleteKeys,
+    doDescribeTable,
+    doDropTable,
+    doListCatalog,
+) where
+
+import ChuSQL.Core.Model
+import ChuSQL.Core.Protocol (Account (..), Request (..), Response (..), SchemaColumn (..), TableInfo (..))
+import ChuSQL.Core.Engine.Storage
+import ChuSQL.Core.Engine.Storage.FFI (closeStorage, openStorage, storageRequest)
+import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
+import Data.Aeson (eitherDecodeStrict, encode)
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BL
+import Data.Maybe (fromMaybe)
+import System.IO.Unsafe (unsafePerformIO)
+
+-- IPC 存储实现：把 MonadStorage 的操作变成发给存储库的 JSON 请求。
+
+newtype IPCStorage a = IPCStorage
+    { runIPCStorage :: IO a
+    }
+
+instance Functor IPCStorage where
+    fmap f (IPCStorage m) = IPCStorage (fmap f m)
+
+instance Applicative IPCStorage where
+    pure = IPCStorage . pure
+    IPCStorage mf <*> IPCStorage ma = IPCStorage (mf <*> ma)
+
+instance Monad IPCStorage where
+    IPCStorage m >>= k = IPCStorage $ do
+        a <- m
+        runIPCStorage (k a)
+
+-- | 一条到存储库的链路：管请求与关闭
+data StorageLink = StorageLink
+    { slRequest :: BS.ByteString -> IO (Either String BS.ByteString)
+    , slClose :: IO ()
+    }
+
+{-# NOINLINE linkRef #-}
+-- | 进程全局的存储链路
+linkRef :: MVar (Maybe StorageLink)
+linkRef = unsafePerformIO (newMVar Nothing)
+
+-- | 装入一条链路；一个进程只装一次
+setStorageLink :: StorageLink -> IO ()
+setStorageLink link = modifyMVar_ linkRef (const (pure (Just link)))
+
+-- | 打开本地的存储动态库，得到一条链路
+localStorageLink :: Maybe FilePath -> IO (Either String StorageLink)
+localStorageLink path = fmap (fmap toLink) (openStorage path)
+  where
+    -- | 把句柄包成一条链路
+    toLink handle =
+        StorageLink
+            { slRequest = storageRequest handle
+            , slClose = closeStorage handle
+            }
+
+-- | 关掉当前链路（进程退出前调用）；没有链路就什么都不做
+closeConnection :: IO ()
+closeConnection = modifyMVar_ linkRef $ \current -> do
+    case current of
+        Nothing -> pure ()
+        Just link -> slClose link
+    pure Nothing
+
+-- | 发一条请求并解码应答；链路没装就报错，不崩
+sendRequest :: Request -> IO Response
+sendRequest req = do
+    current <- readMVar linkRef
+    case current of
+        Nothing -> pure (RespError "storage not configured")
+        Just link -> do
+            raw <- slRequest link (BL.toStrict (encode req))
+            case raw of
+                Left e -> pure (RespError ("storage error: " ++ e))
+                Right bytes -> case eitherDecodeStrict (BS.dropWhileEnd (== 13) bytes) of
+                    Left e -> pure (RespError ("decode error: " ++ e))
+                    Right resp -> pure resp
+
+-- | 原样转发一条载荷给存储库
+sendRawRequest :: BS.ByteString -> IO (Either String BS.ByteString)
+sendRawRequest payload = do
+    current <- readMVar linkRef
+    case current of
+        Nothing -> pure (Left "storage not configured")
+        Just link -> slRequest link payload
+
+{-# NOINLINE databaseRef #-}
+-- | 进程全局的当前库名
+databaseRef :: MVar (Maybe String)
+databaseRef = unsafePerformIO (newMVar Nothing)
+
+-- | 设定当前库名（会话层决定，本层只记住并发给存储）
+setDatabaseName :: Maybe String -> IO ()
+setDatabaseName name = modifyMVar_ databaseRef (const (pure name))
+
+-- | 当前库名
+getDatabaseName :: IO (Maybe String)
+getDatabaseName = readMVar databaseRef
+
+
+-- | 给语句类请求盖上当前库名
+stampDatabase :: Maybe String -> Request -> Request
+stampDatabase Nothing req = req
+stampDatabase (Just db) req
+    | globalRequest req = req
+    | otherwise = ReqInDatabase db req
+
+-- | 是不是不该带库名的全局请求
+globalRequest :: Request -> Bool
+globalRequest ReqDatabase{} = True
+globalRequest ReqAllCatalog = True
+globalRequest ReqAccountsList = True
+globalRequest ReqAccountCreate{} = True
+globalRequest ReqAccountReset{} = True
+globalRequest ReqAccountLogin{} = True
+globalRequest ReqAccountDrop{} = True
+globalRequest ReqPing = True
+globalRequest _ = False
+
+-- | 发请求并把响应翻成 Either
+ask :: String -> Request -> (Response -> Maybe a) -> IO (Either String a)
+ask what req recognize = do
+    current <- getDatabaseName
+    resp <- sendRequest (stampDatabase current req)
+    pure $ case resp of
+        RespError e -> Left e
+        other -> case recognize other of
+            Just a -> Right a
+            Nothing -> Left ("unexpected response to " ++ what)
+
+-- | 只认"成了"（多数写操作都这样）
+okOnly :: Response -> Maybe ()
+okOnly RespOk = Just ()
+okOnly _ = Nothing
+
+-- | 发 Scan
+doScan :: String -> IO (Either String [Row])
+doScan t = ask "scan" (ReqScan t) $ \resp -> case resp of
+    RespRows rows -> Just rows
+    _ -> Nothing
+
+-- | 发 Insert（索引由存储层维护）
+doInsert :: String -> Row -> IO (Either String ())
+doInsert t r = ask "insert" (ReqInsert t r) okOnly
+
+-- | 发 InsertBatch：一批行一次请求
+doInsertMany :: String -> [Row] -> IO (Either String ())
+doInsertMany t rs = ask "insert_batch" (ReqInsertBatch t rs) okOnly
+
+-- | 发 DeleteKeys
+doDeleteKeys :: String -> [Int] -> IO (Either String ())
+doDeleteKeys t ks = ask "delete_keys" (ReqDeleteKeys t ks) okOnly
+
+-- | 发 ReplaceAll
+doReplaceAll :: String -> [Row] -> IO (Either String ())
+doReplaceAll t rs = ask "replace_all" (ReqReplaceAll t rs) okOnly
+
+-- | 发 ListTables
+doListTables :: IO (Either String [String])
+doListTables = ask "list_tables" ReqListTables $ \resp -> case resp of
+    RespTables ts -> Just ts
+    _ -> Nothing
+
+-- | 一次拿全库 schema
+doListCatalog :: IO (Either String [TableInfo])
+doListCatalog = ask "list_catalog" ReqListCatalog $ \resp -> case resp of
+    RespCatalog xs -> Just xs
+    _ -> Nothing
+
+-- | 按某一列的索引取一行（键可以是整数或字符串）
+doLookupByColumn :: String -> String -> Value -> IO (Either String IndexResult)
+doLookupByColumn t c k = ask "lookup_by_index" (ReqLookupByColumn t c k) $ \resp -> case resp of
+    RespRows rows -> Just (IndexRows rows)
+    RespNoIndex -> Just NoIndex
+    _ -> Nothing
+
+-- | 范围扫描：没有可用索引就回 Nothing，让上层退回扫描
+doScanRange ::
+    String ->
+    String ->
+    Maybe (Value, Bool) ->
+    Maybe (Value, Bool) ->
+    IO (Either String (Maybe [Row]))
+doScanRange t c lo hi = ask "range_by_index" (ReqRangeByIndex t c lo hi) $ \resp -> case resp of
+    RespRows rows -> Just (Just rows)
+    RespNoIndex -> Just Nothing
+    _ -> Nothing
+
+-- | 发 DescribeTable
+doDescribeTable :: String -> IO (Either String TableInfo)
+doDescribeTable t = ask "describe_table" (ReqDescribeTable t) $ \resp -> case resp of
+    RespSchema info -> Just info
+    _ -> Nothing
+
+-- | 给某一列建索引
+doCreateIndex :: String -> String -> IO (Either String ())
+doCreateIndex t c = ask "create_index" (ReqCreateIndex t c) okOnly
+
+-- | 去掉某一列的索引
+doDropIndex :: String -> String -> IO (Either String ())
+doDropIndex t c = ask "drop_index" (ReqDropIndex t c) okOnly
+
+-- | 删一列（列定义、这一列上的索引、每行里的那一格一起没）
+doDropColumn :: String -> String -> IO (Either String ())
+doDropColumn t c = ask "drop_column" (ReqDropColumn t c) okOnly
+
+-- | 发 ReplaceSchema（ALTER 用）
+doReplaceSchema :: String -> [SchemaColumn] -> [Row] -> IO (Either String ())
+doReplaceSchema t cols rs = ask "replace_schema" (ReqReplaceSchema t cols rs) okOnly
+
+-- | 发 CreateTable
+doCreateTable :: String -> [SchemaColumn] -> IO (Either String ())
+doCreateTable t cols = ask "create_table" (ReqCreateTable t cols) okOnly
+
+-- | 发 DropTable
+doDropTable :: String -> IO (Either String ())
+doDropTable t = ask "drop_table" (ReqDropTable t) okOnly
+
+-- | 线上 schema 转本地列
+schemaToColumns :: [SchemaColumn] -> [(String, Column)]
+schemaToColumns = map toColumn
+
+-- | 线上 schema 转本地 column
+toColumn :: SchemaColumn -> (String, Column)
+toColumn sc =
+    ( scName sc
+    , Column
+        { columnType = fromMaybe CStr (parseColumnType (scType sc))
+        , columnNullable = scNullable sc
+        , columnDefault = scDefault sc
+        , columnAutoIncrement = scAutoIncrement sc
+        , columnUnique = scUnique sc
+        , columnPrimaryKey = scPrimaryKey sc
+        , columnCheck = scCheck sc
+        }
+    )
+
+-- | 本地列转线上 schema
+toWire :: (String, Column) -> SchemaColumn
+toWire (n, c) =
+    SchemaColumn
+        { scName = n
+        , scType = typeName (columnType c)
+        , scNullable = columnNullable c
+        , scDefault = columnDefault c
+        , scAutoIncrement = columnAutoIncrement c
+        , scPrimaryKey = columnPrimaryKey c
+        , scUnique = columnUnique c
+        , scCheck = columnCheck c
+        }
+
+instance MonadStorage IPCStorage where
+    -- \| 建一个库
+    createDatabase name = IPCStorage (ask "create_database" (ReqDatabase "create_database" name) okOnly)
+    -- \| 删一个库
+    dropDatabase name = IPCStorage (ask "drop_database" (ReqDatabase "drop_database" name) okOnly)
+    -- \| 切当前库
+    useDatabase name = IPCStorage (ask "use_database" (ReqDatabase "use_database" name) okOnly)
+    -- \| 列出现有库
+    listDatabases = IPCStorage $ ask "list_databases" (ReqDatabase "list_databases" "") $ \resp -> case resp of
+        RespTables names -> Just names
+        _ -> Nothing
+    -- \| 发 Scan
+    scan t = IPCStorage (doScan t)
+    -- \| 只取指定列
+    scanColumns t cols = IPCStorage $ ask "scan" (ReqScanColumns t cols) $ \resp -> case resp of
+        RespRows rows -> Just [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows]
+        _ -> Nothing
+
+    -- \| 发 Insert（索引由存储层自己维护）
+    insert t r = IPCStorage (doInsert t r)
+
+    -- \| 一批行一次请求：N 行只落一次盘
+    insertMany t rs = IPCStorage (doInsertMany t rs)
+
+    -- \| 按 id 批量删行
+    deleteKeys t ks = IPCStorage (doDeleteKeys t ks)
+
+    -- \| 发 ReplaceAll
+    replaceAll t rs = IPCStorage (doReplaceAll t rs)
+
+    -- \| 按某一列的索引取一行（没有索引就回 NoIndex）
+    lookupByColumn t c k = IPCStorage (doLookupByColumn t c k)
+
+    -- \| 范围扫描（没有索引就回 Nothing）
+    scanRange t c lo hi = IPCStorage (doScanRange t c lo hi)
+
+    -- \| 发 CreateTable
+    createTable name cols = IPCStorage (doCreateTable name (map toWire cols))
+
+    -- \| ALTER：整表换列定义与全部行
+    replaceSchema name cols rows = IPCStorage (doReplaceSchema name (map toWire cols) rows)
+
+    -- \| 发 DropTable
+    dropTable name = IPCStorage (doDropTable name)
+
+    -- \| 建索引
+    createIndex t c = IPCStorage (doCreateIndex t c)
+
+    -- \| 删索引
+    dropIndex t c = IPCStorage (doDropIndex t c)
+
+    -- \| 删一列
+    dropColumn t c = IPCStorage (doDropColumn t c)
+
+    -- \| 列表 + 逐表扫描拼库
+    snapshot = IPCStorage $ do
+        result <- doListCatalog
+        case result of
+            Left _ -> pure []
+            Right xs -> mapM loadEntry xs
+      where
+        loadEntry info = do
+            rows <- doScan (tiTable info)
+            pure
+                ( tiTable info
+                , Table (tiTable info) (schemaToColumns (tiColumns info)) (either (const []) id rows)
+                )
+
+    -- \| 只问数据字典要结构，设了当前库只留它的表
+    schema = IPCStorage $ do
+        current <- getDatabaseName
+        result <- ask "all_catalogs" ReqAllCatalog $ \resp -> case resp of
+            RespCatalog infos -> Just infos
+            _ -> Nothing
+        pure $ case result of
+            Left _ -> []
+            Right xs -> concatMap (visibleTables current) xs
+
+-- | 没设库名就照单全收；设了库名只收这个库的表，键名去掉库名前缀
+visibleTables :: Maybe String -> TableInfo -> [(String, Table)]
+visibleTables current info
+    | Just db <- current =
+        if unqualify (Just db) (tiTable info) /= tiTable info
+            then [bare named]
+            else []
+    | otherwise = [bare info]
+  where
+    named = info {tiTable = unqualify current (tiTable info)}
+    -- | 组装成不带行的表
+    bare i = (tiTable i, Table (tiTable i) (schemaToColumns (tiColumns i)) [])

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

@@ -1,7 +1,7 @@
-module ChuSQL.Storage.Memory (MemoryStorage (runMemoryStorage)) where
+module ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage)) where
 
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Storage
+import ChuSQL.Core.Engine.Storage
 
 -- 内存实现：Database 上的状态，错误通道是 Either String。
 

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

@@ -1,6 +1,6 @@
-module ChuSQL.Syntax.AST (Statement (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), SortDir (..), makeSelect) where
+module ChuSQL.Core.Engine.Syntax.AST (Statement (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), SortDir (..), makeSelect) where
 
-import ChuSQL.Model (Column (..), ColumnType, Value (..))
+import ChuSQL.Core.Model (Column (..), ColumnType, Value (..))
 
 -- 语法树：语句、数据来源、条件表达式、排序方向。
 
@@ -41,11 +41,11 @@ data Statement
     | CreateRole String
     -- | 删角色：连同它的授权与成员一起删
     | DropRole String
-    -- | GRANT <权限>[, ...] ON <表|*> TO <角色>
+    -- | GRANT 权限 ON 表 TO 角色
     | GrantPrivileges [String] String String
-    -- | REVOKE <权限>[, ...] ON <表|*> FROM <角色>
+    -- | REVOKE 权限 ON 表 FROM 角色
     | RevokePrivileges [String] String String
-    -- | GRANT <角色> TO <用户>[, ...]：给用户加角色
+    -- | GRANT 角色 TO 用户：给用户加角色
     | GrantRole String [String]
     -- | REVOKE <角色> FROM <用户>[, ...]
     | RevokeRole String [String]
@@ -61,6 +61,7 @@ data JoinKind
     | LeftJoin
     deriving (Show, Eq)
 
+-- | 数据来源：单表、带连接的来源，或空
 data FromClause
     = FromTable (Maybe String) String
     | FromJoin JoinKind FromClause (Maybe String) String Expr
@@ -74,6 +75,7 @@ data Subquery = Subquery
     }
     deriving (Show, Eq)
 
+-- | 条件表达式：列、字面量、算术、比较、逻辑、聚合与子查询
 data Expr
     = Col String
     | LitNull
@@ -108,6 +110,7 @@ data Expr
     | ExistsSub Subquery Bool
     deriving (Show, Eq)
 
+-- | 排序方向：升序或降序
 data SortDir
     = Asc
     | Desc

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

@@ -1,9 +1,9 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 
-module ChuSQL.Syntax.Parser (parseStatement, parseExpression) where
+module ChuSQL.Core.Engine.Syntax.Parser (parseStatement, parseExpression) where
 
-import ChuSQL.Model (Column (..), ColumnType (..), Value (..), plainColumn)
+import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), plainColumn)
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
 import Control.Monad (void)
 import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
 import Data.Char (isAlpha, isAlphaNum, isHexDigit, isSpace, toLower, toUpper)
@@ -43,7 +43,7 @@ identifier = lexeme $ do
     rest <- many (satisfy isIdentChar)
     return (first : rest)
 
--- | 账号名：裸名字或单引号字符串（账号名允许点与短横线，字符串形式才写得出来）
+-- | 账号名：裸名字或单引号字符串
 userName :: Parser String
 userName = identifier <|> stringLit
 
@@ -154,7 +154,7 @@ existsPredicate = do
 scalarSubquery :: Parser Expr
 scalarSubquery = ScalarSub <$> between (symbol "(") (symbol ")") subquerySelect
 
--- | [NOT] IN (SELECT ...) 或 [NOT] IN (值清单)
+-- | 读 [NOT] IN：子查询或值清单
 inPredicate :: Parser (Expr -> Expr)
 inPredicate = do
     negated <- (True <$ try (keyword "not" *> keyword "in")) <|> (False <$ keyword "in")
@@ -172,7 +172,7 @@ inPredicate = do
 subquerySelect :: Parser Subquery
 subquerySelect = Subquery <$> selectStatement <*> pure []
 
--- | 聚合调用：COUNT(*) / COUNT(x) / SUM(x) / AVG(x) / MIN(x) / MAX(x)
+-- | 聚合调用：COUNT/SUM/AVG/MIN/MAX
 aggregateCall :: Parser Expr
 aggregateCall =
     choice
@@ -184,6 +184,7 @@ aggregateCall =
         , MaxOf <$> aggArg "max"
         ]
   where
+    -- | 读聚合函数的参数
     aggArg name = try (keyword name *> between (symbol "(") (symbol ")") expr)
 
 -- | 只认字面量，给 DEFAULT 用
@@ -199,6 +200,7 @@ literalValue =
         , VStr <$> stringLit
         ]
   where
+    -- | 负浮点字面量
     negateLit d = VFloat (negate d)
 
 -- | 一个排序列
@@ -230,6 +232,7 @@ assignment = do
     e <- expr
     return (col, e)
 
+-- | 保留字清单，别名不许用
 reservedWords :: [String]
 reservedWords =
     [ "select"
@@ -367,7 +370,7 @@ dropIndexStatement = do
     col <- between (symbol "(") (symbol ")") identifier
     return (DropIndex tbl col)
 
--- | 读 ALTER TABLE：加列、删列、改名、改类型、改默认值、改可空
+-- | 读 ALTER TABLE 的加列、删列、改名与改属性
 alterTableStatement :: Parser Statement
 alterTableStatement = do
     keyword "alter"
@@ -402,7 +405,7 @@ alterTableStatement = do
                 ]
         ]
 
--- | 读 CREATE USER（口令是明文，交给账号服务加盐派生）
+-- | 读 CREATE USER，口令是明文
 createUserStatement :: Parser Statement
 createUserStatement = do
     keyword "create"
@@ -418,7 +421,7 @@ identifiedBy = do
     keyword "by"
     stringLit
 
--- | 读 ALTER USER ... IDENTIFIED BY（改一个普通账号的口令）
+-- | 读 ALTER USER 改口令
 alterUserStatement :: Parser Statement
 alterUserStatement = do
     keyword "alter"
@@ -460,11 +463,11 @@ privilegeName =
         , "ALL" <$ keyword "all"
         ]
 
--- | ON 后面的授权对象：* 表示全部表，否则是一张表（可带库前缀）
+-- | ON 后面的授权对象：* 或一张表
 grantObject :: Parser String
 grantObject = ("*" <$ symbol "*") <|> tableName
 
--- | 读 GRANT：带 ON 的是给角色授权限，不带的是给用户加角色
+-- | 读 GRANT：带 ON 的授权限，不带的加角色
 grantStatement :: Parser Statement
 grantStatement = do
     keyword "grant"
@@ -554,6 +557,7 @@ decimalType = do
         Nothing -> CDecimal 10 0
         Just (p, s) -> CDecimal p s
 
+-- | DECIMAL 的精度与小数位参数
 decimalArgs :: Parser (Int, Int)
 decimalArgs = do
     p <- integer
@@ -619,6 +623,7 @@ parseStatement input =
         Left err -> Left (errorBundlePretty err)
         Right q -> Right q
   where
+    -- | 按关键字分派到各语句解析器
     statementP =
         selectStatement
             <|> try (CreateDatabase <$> (keyword "create" *> keyword "database" *> identifier))

chusql-core/engine/stack.yaml

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

chusql-core/engine/test/Spec.hs

@@ -2,32 +2,29 @@
 
 module Main where
 
-import ChuSQL.Algebra.Eval (evalRelOp)
+import ChuSQL.Core.Engine.Algebra.Eval (evalRelOp)
-import ChuSQL.Algebra.Expr (colsInExpr, evalExpr)
+import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr)
-import ChuSQL.Algebra.Op (RelOp (..), renderPlan)
+import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), renderPlan)
-import ChuSQL.Algebra.Optimize (optimize, pushProject)
+import ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject)
-import ChuSQL.Algebra.Planner (translate)
+import ChuSQL.Core.Engine.Algebra.Planner (translate)
-import ChuSQL.Engine
+import ChuSQL.Core.Engine
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Semantic (prepare)
+import ChuSQL.Core.Engine.Semantic (prepare)
-import ChuSQL.Storage (IndexResult (..), MonadStorage (..))
+import ChuSQL.Core.Engine.Storage (IndexResult (..), MonadStorage (..))
-import ChuSQL.Storage.IPC (IPCStorage (runIPCStorage), Request (ReqPing), Response (RespPong), doListTables, getPipeName, sendRequest, setPipeName)
+import ChuSQL.Core.Engine.Storage.IPC (IPCStorage (runIPCStorage), closeConnection, doListTables, getDatabaseName, localStorageLink, setDatabaseName, setStorageLink)
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
-import ChuSQL.Syntax.Parser
+import ChuSQL.Core.Engine.Syntax.Parser
-import Control.Concurrent (threadDelay)
+import Control.Exception (IOException, finally, try)
-import Control.Exception (IOException, bracket, finally, try)
 import Data.List (isInfixOf, sortOn)
 import Data.Unique (hashUnique, newUnique)
 import System.CPUTime (getCPUTime)
-import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getTemporaryDirectory, removePathForcibly)
+import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removePathForcibly)
-import System.Exit (ExitCode (..))
 import System.FilePath ((</>))
-import System.IO (Handle, IOMode (WriteMode), withFile)
-import System.Process (CreateProcess (..), ProcessHandle, StdStream (NoStream, UseHandle), createProcess, proc, terminateProcess, waitForProcess)
 import Test.Hspec
 
--- 引擎层的 hspec 测试：语法、执行、优化器与 IPC 行为。
+-- 引擎层的 hspec 测试：语法、执行、优化器与存储链路行为。
 
+-- | 测试表 users：id / name / age
 users :: Table
 users =
     Table
@@ -40,6 +37,7 @@ users =
             ]
         }
 
+-- | 测试表 orders：id/user_id/product
 orders :: Table
 orders =
     Table
@@ -52,12 +50,14 @@ orders =
             ]
         }
 
+-- | 两个测试表组成的默认库
 testDB :: Database
 testDB = [("users", users), ("orders", orders)]
 
+-- | 跑引擎层全部 hspec 用例
 main :: IO ()
 main = hspec $ do
-    describe "ChuSQL.Syntax.Parser" $ do
+    describe "ChuSQL.Core.Engine.Syntax.Parser" $ do
         it "resolves table-qualified columns inside database-qualified tables" $ do
             let db = [("sales.users", users)]
             rowsOf (parseStatement "SELECT users.name FROM sales.users WHERE users.id = 1" >>= runStatement db)
@@ -194,7 +194,7 @@ main = hspec $ do
             parseStatement "SELECT name FROM"
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Syntax.Parser (JOIN)" $ do
+    describe "ChuSQL.Core.Engine.Syntax.Parser (JOIN)" $ do
         it "parses a simple JOIN without aliases" $ do
             parseStatement "SELECT name FROM users JOIN orders ON id = user_id"
                 `shouldBe` Right
@@ -263,8 +263,10 @@ main = hspec $ do
                         (Eq (Col "u.id") (Col "o.user_id"))
                     )
 
-    describe "ChuSQL.Engine (SELECT)" $ do
+    describe "ChuSQL.Core.Engine (SELECT)" $ do
+        -- sql：在默认库上跑 SQL 取结果行
         let sql input = parseStatement input >>= rowsOf . runStatement testDB
+            -- values：只取结果里的值
             values input = fmap (map (map snd)) (sql input)
         it "skips line comments between tokens and at EOF" $ do
             sql "-- start\nSELECT name -- list\nFROM users -- end" `shouldBe` sql "SELECT name FROM users"
@@ -415,7 +417,7 @@ main = hspec $ do
             runStatement testDB (makeSelect ["nope"] "users" Nothing)
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (INSERT)" $ do
+    describe "ChuSQL.Core.Engine (INSERT)" $ do
         it "parses a simple INSERT" $ do
             parseStatement "INSERT INTO users (name, age) VALUES ('Dave', 22)"
                 `shouldBe` Right (Insert "users" ["name", "age"] [[LitStr "Dave", LitInt 22]])
@@ -464,7 +466,7 @@ main = hspec $ do
                     runStatement testDB (Insert "users" ["id", "name"] [[LitInt 1, LitStr "A"], [LitInt 2]])
                         `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (INDEX)" $ do
+    describe "ChuSQL.Core.Engine (INDEX)" $ do
         it "parses CREATE INDEX and DROP INDEX" $ do
             parseStatement "CREATE INDEX ON users (age)"
                 `shouldBe` Right (CreateIndex "users" "age")
@@ -485,7 +487,7 @@ main = hspec $ do
             rowsOf (parseStatement "DROP INDEX ON users (age)" >>= runStatement testDB)
                 `shouldBe` Right []
 
-    describe "ChuSQL.Engine (DROP COLUMN)" $ do
+    describe "ChuSQL.Core.Engine (DROP COLUMN)" $ do
         it "parses ALTER TABLE ... DROP COLUMN case-insensitively" $ do
             parseStatement "ALTER TABLE users DROP COLUMN age"
                 `shouldBe` Right (DropColumn "users" "age")
@@ -514,7 +516,7 @@ main = hspec $ do
         it "the built-in id column cannot be dropped (the UI locates a row by it)" $ do
             (parseStatement "ALTER TABLE users DROP COLUMN id" >>= runStatement testDB)
                 `shouldSatisfy` isLeft
-    describe "ChuSQL.Engine (USER)" $ do
+    describe "ChuSQL.Core.Engine (USER)" $ do
         it "parses CREATE USER / ALTER USER / DROP USER case-insensitively" $ do
             parseStatement "CREATE USER alice IDENTIFIED BY 's3cret'"
                 `shouldBe` Right (CreateUser "alice" "s3cret")
@@ -552,7 +554,7 @@ main = hspec $ do
             (parseStatement "DROP USER alice" >>= runStatement testDB)
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (ROLE)" $ do
+    describe "ChuSQL.Core.Engine (ROLE)" $ do
         it "parses CREATE ROLE / DROP ROLE case-insensitively" $ do
             parseStatement "CREATE ROLE analyst" `shouldBe` Right (CreateRole "analyst")
             parseStatement "create role analyst" `shouldBe` Right (CreateRole "analyst")
@@ -616,7 +618,7 @@ main = hspec $ do
             parseStatement "SELECT * FROM users user" `shouldSatisfy` isLeft
             parseStatement "SELECT user1 FROM users" `shouldBe` Right (Select ["user1"] (FromTable Nothing "users") Nothing [] [] Nothing)
 
-    describe "ChuSQL.Engine (DELETE)" $ do
+    describe "ChuSQL.Core.Engine (DELETE)" $ do
         it "parses DELETE with WHERE" $ do
             parseStatement "DELETE FROM users WHERE age < 18"
                 `shouldBe` Right (Delete "users" (Just (Lt (Col "age") (LitInt 18))))
@@ -646,7 +648,7 @@ main = hspec $ do
             runStatement testDB (Delete "users" (Just (Gt (Col "unknown") (LitInt 18))))
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (UPDATE)" $ do
+    describe "ChuSQL.Core.Engine (UPDATE)" $ do
         it "parses UPDATE with WHERE" $ do
             parseStatement "UPDATE users SET age = 26 WHERE name = 'Alice'"
                 `shouldBe` Right
@@ -707,7 +709,7 @@ main = hspec $ do
             runStatement testDB (Update "users" [("age", LitInt 0)] (Just (Gt (Col "unknown") (LitInt 1))))
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (ORDER BY)" $ do
+    describe "ChuSQL.Core.Engine (ORDER BY)" $ do
         it "parses ORDER BY DESC" $ do
             case parseStatement "SELECT name FROM users ORDER BY age DESC" of
                 Right q -> selectOrderBy q `shouldBe` [("age", Desc)]
@@ -757,7 +759,7 @@ main = hspec $ do
                     , [("name", VStr "Bob")]
                     ]
 
-    describe "ChuSQL.Engine (LIMIT)" $ do
+    describe "ChuSQL.Core.Engine (LIMIT)" $ do
         it "parses LIMIT" $ do
             case parseStatement "SELECT * FROM users LIMIT 2" of
                 Right q -> selectLimit q `shouldBe` Just 2
@@ -819,7 +821,7 @@ main = hspec $ do
             parseStatement "SELECT * FROM users LIMIT -1"
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (JOIN)" $ do
+    describe "ChuSQL.Core.Engine (JOIN)" $ do
         it "executes a two-table JOIN with aliases" $ do
             rowsOf (parseStatement "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id" >>= runStatement testDB)
                 `shouldBe` Right
@@ -870,7 +872,8 @@ main = hspec $ do
                 )
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (LEFT JOIN)" $ do
+    describe "ChuSQL.Core.Engine (LEFT JOIN)" $ do
+        -- sql：在默认库上跑 SQL 取结果行
         let sql input = parseStatement input >>= rowsOf . runStatement testDB
 
         it "keeps unmatched left rows and fills the right side with NULL" $ do
@@ -930,7 +933,8 @@ main = hspec $ do
                     , [("u.name", VStr "Carol"), ("o.product", VStr "Cup")]
                     ]
 
-    describe "ChuSQL.Engine (JOIN 嵌套循环)" $ do
+    describe "ChuSQL.Core.Engine (JOIN 嵌套循环)" $ do
+        -- sql：在默认库上跑 SQL 取结果行
         let sql input = parseStatement input >>= rowsOf . runStatement testDB
 
         it "keeps columns from both sides when the ON has no equi key" $ do
@@ -943,7 +947,8 @@ main = hspec $ do
                     , [("u.name", VStr "Carol"), ("o.product", VStr "Cup")]
                     ]
 
-    describe "ChuSQL.Engine (子查询)" $ do
+    describe "ChuSQL.Core.Engine (子查询)" $ do
+        -- sql：在默认库上跑 SQL 取结果行
         let sql input = parseStatement input >>= rowsOf . runStatement testDB
 
         it "IN (subquery) keeps the rows whose value the subquery returns" $ do
@@ -997,9 +1002,12 @@ main = hspec $ do
             sameResultAsUnoptimized "SELECT name FROM users WHERE id IN (SELECT user_id FROM orders)"
             sameResultAsUnoptimized "SELECT u.name FROM users u WHERE EXISTS (SELECT * FROM orders o WHERE o.user_id = u.id)"
 
-    describe "ChuSQL.Engine (聚合与 GROUP BY)" $ do
+    describe "ChuSQL.Core.Engine (聚合与 GROUP BY)" $ do
+        -- sql：在默认库上跑 SQL 取结果行
         let sql input = parseStatement input >>= rowsOf . runStatement testDB
+            -- sqlDb：在指定库上跑 SQL
             sqlDb db input = parseStatement input >>= rowsOf . runStatement db
+            -- vals：只取结果里的值
             vals input = fmap (map (map snd)) (sql input)
 
         it "counts rows without GROUP BY" $ do
@@ -1104,7 +1112,7 @@ main = hspec $ do
                     [ [("name", VStr "Carol")]
                     ]
 
-    describe "ChuSQL.Algebra.Optimize" $ do
+    describe "ChuSQL.Core.Engine.Algebra.Optimize" $ do
         it "keeps single-table WHERE results identical" $ do
             sameResultAsUnoptimized "SELECT name FROM users WHERE age > 18"
 
@@ -1285,7 +1293,7 @@ main = hspec $ do
             rowsOf (parseStatement "SELECT u.name FROM users u WHERE u.id = 1" >>= runStatement testDB)
                 `shouldBe` Right [[("u.name", VStr "Alice")]]
 
-    describe "ChuSQL.Semantic" $ do
+    describe "ChuSQL.Core.Engine.Semantic" $ do
         it "rejects an unknown column in WHERE" $ do
             (parseStatement "SELECT name FROM users WHERE nope > 18" >>= runStatement testDB)
                 `shouldSatisfy` isLeft
@@ -1386,7 +1394,7 @@ main = hspec $ do
             (parseStatement "SELECT * FROM users u JOIN orders o ON u.id = o.user_id" >>= runStatement testDB)
                 `shouldSatisfy` isRight
 
-    describe "ChuSQL.Algebra.Op" $ do
+    describe "ChuSQL.Core.Engine.Algebra.Op" $ do
         it "renders a plan as indented text" $ do
             case parseStatement "SELECT name FROM users WHERE age > 18" >>= translate of
                 Left err -> expectationFailure err
@@ -1405,12 +1413,13 @@ main = hspec $ do
                                    , "    Scan Just \"o\" \"orders\""
                                    ]
 
-    describe "ChuSQL.Storage.IPC" $ do
+    describe "ChuSQL.Core.Engine.Storage.IPC" $ do
-        it "projects scan columns and preserves constant rows over the pipe" $ do
+        it "projects scan columns and preserves constant rows" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 runIPCStorage (insertMany "projected" [[("id", VInt 1), ("name", VStr "one")], [("id", VInt 2), ("name", VNull)]]) `shouldReturn` Right ()
                 runIPCStorage (scanColumns "projected" ["name"]) `shouldReturn` Right [[("name", VStr "one")], [("name", VNull)]]
                 runIPCStorage (scanColumns "projected" []) `shouldReturn` Right [[], []]
+                -- query：解析并执行一条 SQL
                 let query sql = case parseStatement sql of
                         Left err -> expectationFailure err >> pure (Left err)
                         Right stmt -> runIPCStorage (runStatementM stmt)
@@ -1418,8 +1427,9 @@ main = hspec $ do
                 fmap (map (map snd)) result `shouldBe` Right [[VInt 1], [VInt 1]]
                 query "SELECT p.name FROM projected p ORDER BY p.id DESC" `shouldReturn` Right [[("p.name", VNull)], [("p.name", VStr "one")]]
 
-        it "recreates a dropped column without resurrecting old values over the pipe" $ do
+        it "recreates a dropped column without resurrecting old values" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
+                -- query：解析并执行一条 SQL
                 let query sql = case parseStatement sql of
                         Left err -> expectationFailure err >> pure (Left err)
                         Right stmt -> runIPCStorage (runStatementM stmt)
@@ -1433,19 +1443,19 @@ main = hspec $ do
                 query "SELECT secret FROM reused WHERE id = 1" `shouldReturn` Right [[("secret", VStr "new")]]
 
         it "scan returns rows with all three value types after insert" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 let row = [("id", VInt 7), ("name", VStr "Alice"), ("flag", VBool True)]
                 runIPCStorage (insert "users" row) `shouldReturn` Right ()
                 rows <- runIPCStorage (scan "users")
                 (map sortRow <$> rows) `shouldBe` Right [sortRow row]
 
         it "scan on a missing table returns Left" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 result <- runIPCStorage (scan "no_such_table")
                 result `shouldSatisfy` isLeft
 
         it "scan returns all 20 inserted rows in order" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 mapM_ (\i -> runIPCStorage (insert "many" [("id", VInt i)])) [1 .. 20 :: Int]
                 rows <- runIPCStorage (scan "many")
                 fmap length rows `shouldBe` Right 20
@@ -1453,15 +1463,15 @@ main = hspec $ do
                     `shouldBe` Right (sortOn show (map (Just . VInt) [1 .. 20]))
 
         it "replaceAll leaves only the new rows" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 runIPCStorage (insert "t" [("id", VInt 1)]) `shouldReturn` Right ()
                 runIPCStorage (replaceAll "t" [[("id", VInt 9)], [("id", VInt 8)]]) `shouldReturn` Right ()
                 rows <- runIPCStorage (scan "t")
                 fmap (sortOn show . map (lookup "id")) rows
                     `shouldBe` Right (sortOn show [Just (VInt 9), Just (VInt 8)])
 
-        it "lookupByColumn finds a row inserted with an id over the pipe" $ do
+        it "lookupByColumn finds a row inserted with an id" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 let row = [("id", VInt 7), ("name", VStr "Zoe")]
                 runIPCStorage (insert "keyed" row) `shouldReturn` Right ()
                 found <- runIPCStorage (lookupByColumn "keyed" "id" (VInt 7))
@@ -1469,8 +1479,8 @@ main = hspec $ do
                 missing <- runIPCStorage (lookupByColumn "keyed" "id" (VInt 8))
                 missing `shouldBe` Right (IndexRows [])
 
-        it "looks up a string index over the pipe" $ do
+        it "looks up a string index" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 runIPCStorage (insert "names" [("id", VInt 1), ("name", VStr "alice")]) `shouldReturn` Right ()
                 runIPCStorage (insert "names" [("id", VInt 2), ("name", VStr "bob")]) `shouldReturn` Right ()
                 runIPCStorage (createIndex "names" "name") `shouldReturn` Right ()
@@ -1479,8 +1489,8 @@ main = hspec $ do
                 missing <- runIPCStorage (lookupByColumn "names" "name" (VStr "dave"))
                 missing `shouldBe` Right (IndexRows [])
 
-        it "range scans an indexed column over the pipe" $ do
+        it "range scans an indexed column" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 runIPCStorage (insert "rng" [("id", VInt 1), ("code", VInt 100)]) `shouldReturn` Right ()
                 runIPCStorage (insert "rng" [("id", VInt 2), ("code", VInt 200)]) `shouldReturn` Right ()
                 runIPCStorage (insert "rng" [("id", VInt 3), ("code", VInt 300)]) `shouldReturn` Right ()
@@ -1491,8 +1501,8 @@ main = hspec $ do
                 fmap (fmap (map (lookup "id"))) open `shouldBe` Right (Just [Just (VInt 3)])
                 runIPCStorage (scanRange "rng" "nope" Nothing Nothing) `shouldReturn` Right Nothing
 
-        it "replaceAll rebuilds the index over the pipe" $ do
+        it "replaceAll rebuilds the index" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 runIPCStorage (insert "rb" [("id", VInt 1)]) `shouldReturn` Right ()
                 runIPCStorage (replaceAll "rb" [[("id", VInt 9), ("name", VStr "Zoe")]]) `shouldReturn` Right ()
                 old <- runIPCStorage (lookupByColumn "rb" "id" (VInt 1))
@@ -1502,7 +1512,7 @@ main = hspec $ do
                     `shouldBe` Just (sortRow [("id", VInt 9), ("name", VStr "Zoe")])
 
         it "snapshot lists tables and scans each one to build the database" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 runIPCStorage (insert "a" [("id", VInt 1)]) `shouldReturn` Right ()
                 runIPCStorage (insert "b" [("id", VInt 2)]) `shouldReturn` Right ()
                 db <- runIPCStorage snapshot
@@ -1511,38 +1521,31 @@ main = hspec $ do
                 map (map (lookup "id") . tableRows . snd) db `shouldBe` [[Just (VInt 1)], [Just (VInt 2)]]
 
         it "doListTables returns the tables that exist" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 runIPCStorage (insert "t1" [("id", VInt 1)]) `shouldReturn` Right ()
                 runIPCStorage (insert "t2" [("id", VInt 2)]) `shouldReturn` Right ()
                 doListTables `shouldReturn` Right ["t1", "t2"]
 
         it "rows survive a restart on the same data directory" $ do
-            located <- locateServer
+            withTestSession $ \srv -> do
-            case located of
+                withServerEnv srv $ runIPCStorage (insert "persist" [("id", VInt 42)]) `shouldReturn` Right ()
-                Left err -> pendingWith err
+                closeConnection
-                Right bin -> do
+                openSessionIn (dataDir srv)
-                    srv1 <- startServer bin
+                rows <- withServerEnv srv $ runIPCStorage (scan "persist")
-                    let dir = dataDir srv1
-                    withServerEnv srv1 $ runIPCStorage (insert "persist" [("id", VInt 42)]) `shouldReturn` Right ()
-                    stopServer srv1
-                    srv2 <- startServerAt bin dir
-                    rows <- withServerEnv srv2 $ runIPCStorage (scan "persist")
-                    stopServer srv2
-                    cleanServerDir srv1
                 (map sortRow <$> rows) `shouldBe` Right [sortRow [("id", VInt 42)]]
 
-        it "a missing server yields Left without throwing" $ do
+        it "an unusable config path yields Left without throwing" $ do
-            withPipeName "chusql-no-such-server" $ do
+            opened <- localStorageLink (Just "no/such/dir/chusql-core-storage.toml")
+            case opened of
+                Left err -> err `shouldSatisfy` (not . null)
+                Right _ -> expectationFailure "opening a missing config file should fail"
+
+        it "without a link the storage layer reports Left instead of throwing" $ do
+            closeConnection
             result <- runIPCStorage (scan "users")
             result `shouldSatisfy` isLeft
-#if !defined(mingw32_HOST_OS)
+        it "INSERT then SELECT WHERE id = k" $ do
-        it "an over-long socket path is reported instead of a raw connect failure" $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
-            withPipeName (replicate 128 'x') $ do
-                result <- runIPCStorage (scan "users")
-                show result `shouldSatisfy` isInfixOf "socket path too long"
-#endif
-        it "INSERT then SELECT WHERE id = k via IPC" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
                 _ <-
                     runIPCStorage
                         ( runStatementM
@@ -1567,13 +1570,11 @@ main = hspec $ do
                             )
                         )
                 result `shouldBe` Right [[("name", VStr "Zoe")]]
-                stopServer srv
+                -- 存储层的日志现在直接打在本进程的输出里，没有单独的 debug.log 可读；
-                logs <- readFile (dataDir srv </> "debug.log")
+                -- 「走索引而不是全表扫」由下面 CREATE INDEX 那组用例与 Rust 侧 runtime 测试覆盖。
-                logs `shouldContain` "lookup_by_index table=ipc_idx column=id key=42"
-                logs `shouldNotContain` "scan table="
 
         it "CREATE INDEX makes a query on that column use the index" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 _ <- runIPCStorage (runStatementM (CreateTable "ix_t" [("id", TInt), ("code", TInt)]))
                 _ <-
                     runIPCStorage
@@ -1599,8 +1600,8 @@ main = hspec $ do
                 fmap sortRow (indexRow fresh)
                     `shouldBe` Just (sortRow [("id", VInt 3), ("code", VInt 502)])
 
-        it "CREATE INDEX over the pipe accepts duplicates and returns every matching row" $ do
+        it "CREATE INDEX accepts duplicates and returns every matching row" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 _ <- runIPCStorage (runStatementM (CreateTable "dup_ix" [("id", TInt), ("age", TInt)]))
                 _ <-
                     runIPCStorage
@@ -1614,8 +1615,8 @@ main = hspec $ do
                     Right (IndexRows rows) -> map (lookup "id") rows `shouldBe` [Just (VInt 1), Just (VInt 2)]
                     _ -> expectationFailure "expected an indexed lookup with rows"
 
-        it "DELETE removes only the matching rows over the pipe" $ do
+        it "DELETE removes only the matching rows" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 _ <- runIPCStorage (runStatementM (CreateTable "del_t" [("id", TInt), ("name", TStr)]))
                 _ <-
                     runIPCStorage
@@ -1632,8 +1633,8 @@ main = hspec $ do
                 gone <- runIPCStorage (lookupByColumn "del_t" "id" (VInt 2))
                 gone `shouldBe` Right (IndexRows [])
 
-        it "multi-row INSERT goes over the pipe in one statement" $ do
+        it "multi-row INSERT goes in one statement" $ do
-            withTestServer $ \srv -> withServerEnv srv $ do
+            withTestSession $ \srv -> withServerEnv srv $ do
                 _ <- runIPCStorage (runStatementM (CreateTable "many_t" [("id", TInt)]))
                 _ <-
                     runIPCStorage
@@ -1676,7 +1677,7 @@ main = hspec $ do
             parseStatement "CREATE TABLE t (id)"
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (CREATE TABLE)" $ do
+    describe "ChuSQL.Core.Engine (CREATE TABLE)" $ do
         it "creates a table in memory" $ do
             case runStatement testDB (CreateTable "newt" [("id", TInt), ("name", TStr)]) of
                 Left err -> expectationFailure err
@@ -1710,8 +1711,10 @@ main = hspec $ do
             runStatement testDB (DropTable "nope")
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (NULL)" $ do
+    describe "ChuSQL.Core.Engine (NULL)" $ do
+        -- rows：在给定库上跑 SQL 取结果行
         let rows db input = parseStatement input >>= rowsOf . runStatement db
+            -- vals：只取结果里的值
             vals db input = fmap (map (map snd)) (rows db input)
             seeded = either (const testDB) fst (parseStatement "INSERT INTO users (id, name) VALUES (9, 'Nine')" >>= runStatement testDB)
 
@@ -1743,8 +1746,10 @@ main = hspec $ do
             vals seeded "SELECT age + 1 FROM users WHERE name = 'Nine'" `shouldBe` Right [[VNull]]
             vals seeded "SELECT age * 2 FROM users WHERE name = 'Nine'" `shouldBe` Right [[VNull]]
 
-    describe "ChuSQL.Engine (TYPES)" $ do
+    describe "ChuSQL.Core.Engine (TYPES)" $ do
+        -- vals：在给定库上跑 SQL 只取值
         let vals db input = fmap (map (map snd)) (parseStatement input >>= rowsOf . runStatement db)
+            -- withTable：先建表，返回新库
             withTable ddl = either (const testDB) fst (parseStatement ddl >>= runStatement testDB)
 
         it "parses every column type" $ do
@@ -1788,9 +1793,12 @@ main = hspec $ do
             runStatement db (Insert "sized" ["d"] [[LitInt 5]])
                 `shouldSatisfy` isLeft
 
-    describe "ChuSQL.Engine (CONSTRAINTS)" $ do
+    describe "ChuSQL.Core.Engine (CONSTRAINTS)" $ do
+        -- vals：在给定库上跑 SQL 只取值
         let vals db input = fmap (map (map snd)) (parseStatement input >>= rowsOf . runStatement db)
+            -- withTable：先建表，返回新库
             withTable ddl = either (const testDB) fst (parseStatement ddl >>= runStatement testDB)
+            -- step：执行一条语句，失败就返回原库
             step db input = either (const db) fst (parseStatement input >>= runStatement db)
 
         it "rejects omitting a NOT NULL column without a default" $ do
@@ -1819,10 +1827,14 @@ main = hspec $ do
                 `shouldSatisfy` either (isInfixOf "CHECK") (const False)
             vals (step db "INSERT INTO ck (age) VALUES (5)") "SELECT age FROM ck" `shouldBe` Right [[VInt 5]]
 
-    describe "ChuSQL.Engine (ALTER TABLE)" $ do
+    describe "ChuSQL.Core.Engine (ALTER TABLE)" $ do
+        -- vals：在给定库上跑 SQL 只取值
         let vals db input = fmap (map (map snd)) (parseStatement input >>= rowsOf . runStatement db)
+            -- run：在给定库上执行语句
             run db input = parseStatement input >>= runStatement db
+            -- withTable：先建表，返回新库
             withTable ddl = either (const testDB) fst (parseStatement ddl >>= runStatement testDB)
+            -- step：执行一条语句，失败就返回原库
             step db input = either (const db) fst (run db input)
 
         it "ADD COLUMN fills existing rows with the default or NULL" $ do
@@ -1865,77 +1877,18 @@ main = hspec $ do
             run nulls "ALTER TABLE nl ALTER COLUMN tag DROP NOT NULL" `shouldSatisfy` isRight
             run strict "ALTER TABLE nl2 ALTER COLUMN tag DROP NOT NULL" `shouldSatisfy` isRight
 
+-- | 每个测试表都清空行后的库
 emptyDB :: Database
 emptyDB = [(n, t{tableRows = []}) | (n, t) <- testDB]
 
-data IPCServer = IPCServer
+-- | 一次进程内存储会话：进程内直连存储动态库
-    { pipeName :: String
+data StorageSession = StorageSession
-    , dataDir :: FilePath
+    { dataDir :: FilePath
-    , processHandle :: ProcessHandle
     }
 
-locateServer :: IO (Either String FilePath)
+-- | 写一份只属于这次会话的配置：数据目录与日志级别都从文件走
-locateServer = do
+writeSessionConfig :: FilePath -> IO FilePath
-    mdir <- firstDir [".." </> "chusql-storage", "chusql-storage"]
+writeSessionConfig dir = do
-    case mdir of
-        Nothing -> pure (Left "chusql-storage directory not found (run these tests inside the repository)")
-        Just dir -> do
-            built <-
-                try (createProcess (proc "cargo" ["build", "--bin", "chusql-storage"]){cwd = Just dir, std_out = NoStream, std_err = NoStream}) ::
-                    IO (Either IOException (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-            case built of
-                Left e -> pure (Left ("cannot run cargo (Rust is required for the IPC tests): " ++ show e))
-                Right (_, _, _, ph) -> do
-                    ec <- waitForProcess ph
-                    case ec of
-                        ExitFailure n -> pure (Left ("cargo build --bin chusql-storage failed with exit code " ++ show n))
-                        ExitSuccess -> do
-                            -- 二进制名跟平台走：Linux 上没有 .exe，而 target/debug 里可能
-                            -- 残留一份别处交叉编译出来的 .exe。误选它会以 Windows 的视角
-                            -- 读配置（/tmp/x.toml 变成 C:\tmp\x.toml），报 config file not found。
-#if defined(mingw32_HOST_OS)
-                            let candidate = dir </> "target" </> "debug" </> "chusql-storage.exe"
-#else
-                            let candidate = dir </> "target" </> "debug" </> "chusql-storage"
-#endif
-                            ok <- doesFileExist candidate
-                            pure
-                                ( if ok
-                                    then Right candidate
-                                    else Left ("cargo build finished but no storage executable was found at " ++ candidate)
-                                )
-  where
-    firstDir [] = pure Nothing
-    firstDir (d : ds) = do
-        ok <- doesDirectoryExist d
-        if ok then pure (Just d) else firstDir ds
-
-startServer :: FilePath -> IO IPCServer
-startServer bin = do
-    stamp <- uniqueStamp
-    tmp <- getTemporaryDirectory
-    let dir = tmp </> "chusql-hs-IPC" </> stamp
-    createDirectoryIfMissing True dir
-    startServerAt bin dir
-
-startServerAt :: FilePath -> FilePath -> IO IPCServer
-startServerAt bin dir = do
-    stamp <- uniqueStamp
-    let name = "chusql-hs-test-" ++ stamp
-    cfgPath <- writeServerConfig dir name
-    (_, _, _, ph) <- withFile (dir </> "debug.log") WriteMode $ \logHandle ->
-        createProcess
-            (proc bin ["--config", cfgPath])
-                { std_out = UseHandle logHandle
-                , std_err = UseHandle logHandle
-                }
-    let srv = IPCServer name dir ph
-    waitUntilReady srv 100
-    pure srv
-
--- | 给存储进程写一份顺手可用的配置：管名、数据目录与日志级别都从文件走
-writeServerConfig :: FilePath -> String -> IO FilePath
-writeServerConfig dir name = do
     let cfgPath = dir ++ ".toml"
         -- TOML 的普通字符串会吃反斜杠，路径统一用正斜杠
         slashed = map (\c -> if c == '\\' then '/' else c) dir
@@ -1944,14 +1897,27 @@ writeServerConfig dir name = do
         ( unlines
             [ "[storage]"
             , "data_dir = \"" ++ slashed ++ "\""
-            , "[server]"
-            , "pipe_name = \"" ++ name ++ "\""
             , "[log]"
             , "level = \"debug\""
             ]
         )
     pure cfgPath
 
+-- | 打开一份存储，并把它装成引擎当前用的链路
+openSessionAt :: FilePath -> IO (Either String StorageSession)
+openSessionAt dir = do
+    cfgPath <- writeSessionConfig dir
+    opened <- localStorageLink (Just cfgPath)
+    case opened of
+        Left e -> pure (Left ("cannot open the chusql_core_storage library: " ++ e))
+        Right link -> do
+            setStorageLink link
+            pure (Right (StorageSession dir))
+
+-- | 用同一份数据目录再开一次（模拟重启）
+openSessionIn :: FilePath -> IO ()
+openSessionIn dir = openSessionAt dir >>= either fail (const (pure ()))
+
 -- | 每次调用都不同的后缀：CPU 时间加唯一编号
 uniqueStamp :: IO String
 uniqueStamp = do
@@ -1959,50 +1925,52 @@ uniqueStamp = do
     u <- hashUnique <$> newUnique
     pure (show cpu ++ "-" ++ show u)
 
-waitUntilReady :: IPCServer -> Int -> IO ()
+-- | 删掉会话的数据目录与配置文件
-waitUntilReady srv tries = do
+cleanSessionDir :: FilePath -> IO ()
-    probe <- try (withServerEnv srv (sendRequest ReqPing)) :: IO (Either IOException Response)
+cleanSessionDir dir = do
-    case probe of
+    _ <- try (removePathForcibly dir) :: IO (Either IOException ())
-        Right RespPong -> pure ()
+    _ <- try (removePathForcibly (dir ++ ".toml")) :: IO (Either IOException ())
-        _ | tries > 0 -> threadDelay 50000 >> waitUntilReady srv (tries - 1)
-        Right _ -> ioError (userError "server is up but the ping answer was not pong")
-        Left e -> ioError e
-
-stopServer :: IPCServer -> IO ()
-stopServer srv = do
-    _ <- try (terminateProcess (processHandle srv)) :: IO (Either IOException ())
-    _ <- try (waitForProcess (processHandle srv)) :: IO (Either IOException ExitCode)
     pure ()
 
-cleanServerDir :: IPCServer -> IO ()
+-- | 一个用例一份干净数据目录；动态库打不开则 pending
-cleanServerDir srv = do
+withTestSession :: (StorageSession -> IO ()) -> IO ()
-    _ <- try (removePathForcibly (dataDir srv)) :: IO (Either IOException ())
+withTestSession act = do
-    _ <- try (removePathForcibly (dataDir srv ++ ".toml")) :: IO (Either IOException ())
+    tmp <- getTemporaryDirectory
-    pure ()
+    stamp <- uniqueStamp
+    let dir = tmp </> "chusql-hs-IPC" </> stamp
+    createDirectoryIfMissing True dir
+    opened <- openSessionAt dir
+    case opened of
+        Left err -> cleanSessionDir dir >> pendingWith err
+        Right session -> act session `finally` (closeConnection >> cleanSessionDir dir)
 
-withTestServer :: (IPCServer -> IO ()) -> IO ()
+-- | 语句不带库名，先建好测试库再切进去
-withTestServer act = do
+withServerEnv :: StorageSession -> IO a -> IO a
-    located <- locateServer
+withServerEnv _srv act = do
-    case located of
+    oldDb <- getDatabaseName
-        Left err
+    ensureTestDatabase
-            | "cannot run cargo" `isInfixOf` err -> pendingWith err
+    setDatabaseName (Just testDatabase)
-            | otherwise -> expectationFailure err
+    act `finally` setDatabaseName oldDb
-        Right bin -> bracket (startServer bin) (\s -> stopServer s >> cleanServerDir s) act
 
-withServerEnv :: IPCServer -> IO a -> IO a
+-- | IPC 用例使用的库名
-withServerEnv srv act = do
+testDatabase :: String
-    old <- getPipeName
+testDatabase = "ipctest"
-    setPipeName (pipeName srv)
-    act `finally` setPipeName old
 
-withPipeName :: String -> IO a -> IO a
+-- | 保证测试库已存在
-withPipeName name act = do
+ensureTestDatabase :: IO ()
-    old <- getPipeName
+ensureTestDatabase = do
-    setPipeName name
+    listed <- runIPCStorage listDatabases
-    r <- act
+    case listed of
-    setPipeName old
+        Left e -> fail ("cannot list databases through the storage library: " ++ e)
-    pure r
+        Right names
+            | testDatabase `elem` names -> pure ()
+            | otherwise -> do
+                created <- runIPCStorage (createDatabase testDatabase)
+                case created of
+                    Right () -> pure ()
+                    Left e -> fail ("cannot create the test database: " ++ e)
 
+-- | 按列名把一行排序
 sortRow :: Row -> Row
 sortRow = sortOn fst
 
@@ -2011,14 +1979,17 @@ indexRow :: Either String IndexResult -> Maybe Row
 indexRow (Right (IndexRows (r : _))) = Just r
 indexRow _ = Nothing
 
+-- | 判断 Either 是 Left
 isLeft :: Either a b -> Bool
 isLeft (Left _) = True
 isLeft (Right _) = False
 
+-- | 判断 Either 是 Right
 isRight :: Either a b -> Bool
 isRight (Right _) = True
 isRight (Left _) = False
 
+-- | 断言优化前后执行结果一致
 sameResultAsUnoptimized :: String -> Expectation
 sameResultAsUnoptimized sql =
     case parseStatement sql >>= prepare testDB of
@@ -2029,6 +2000,7 @@ sameResultAsUnoptimized sql =
                 Right relOp ->
                     evalRelOp testDB (optimize testDB relOp) `shouldBe` evalRelOp testDB relOp
 
+-- | 判断谓词是否下推到 Join 左子树
 filterPushedIntoLeft :: RelOp -> Bool
 filterPushedIntoLeft (Project _ (Join _ l _ _)) = pushedIntoLeft l
 filterPushedIntoLeft _ = False
@@ -2040,6 +2012,7 @@ pushedIntoLeft (Range _ _ _ _ _) = True
 pushedIntoLeft (Project _ x) = pushedIntoLeft x
 pushedIntoLeft _ = False
 
+-- | 解析并优化 SQL，返回计划
 optimizedPlan :: String -> Either String RelOp
 optimizedPlan sql = do
     q <- parseStatement sql
@@ -2056,6 +2029,7 @@ leftJoinKinds (Sort _ x) = leftJoinKinds x
 leftJoinKinds (Limit _ x) = leftJoinKinds x
 leftJoinKinds _ = []
 
+-- | 取计划里第一个过滤条件
 firstFilterCond :: RelOp -> Maybe Expr
 firstFilterCond (Filter p _) = Just p
 firstFilterCond (Project _ x) = firstFilterCond x
@@ -2071,6 +2045,7 @@ firstFilterCond (Scan _ _ _) = Nothing
 firstFilterCond (Lookup _ _ _ _) = Nothing
 firstFilterCond (Range _ _ _ _ _) = Nothing
 
+-- | 判断计划里是否还有过滤节点
 anyFilter :: RelOp -> Bool
 anyFilter (Filter _ _) = True
 anyFilter (Project _ x) = anyFilter x
@@ -2084,6 +2059,7 @@ anyFilter (Scan _ _ _) = False
 anyFilter (Lookup _ _ _ _) = False
 anyFilter (Range _ _ _ _ _) = False
 
+-- | 去掉计划里的投影节点
 stripProjects :: RelOp -> RelOp
 stripProjects (Project _ x) = stripProjects x
 stripProjects (Compute items x) = Compute items (stripProjects x)
@@ -2097,29 +2073,35 @@ stripProjects (Scan a t _) = Scan a t Nothing
 stripProjects (Lookup a t c k) = Lookup a t c k
 stripProjects (Range a t c lo hi) = Range a t c lo hi
 
+-- | 解析并做投影下推，返回计划
 projectedPlan :: String -> Either String RelOp
 projectedPlan sql = do
     q <- parseStatement sql
     plan <- translate q
     Right (pushProject testDB ["*"] plan)
 
+-- | 取节点输出的列名
 sideCols :: RelOp -> Maybe [String]
 sideCols (Project cols _) = Just cols
 sideCols (Scan a _ cols) = fmap (map (qualify a)) cols
 sideCols _ = Nothing
 
+-- | 取 Join 左右两侧的输出列名
 joinSideCols :: RelOp -> (Maybe [String], Maybe [String])
 joinSideCols (Project _ (Join _ l r _)) = (sideCols l, sideCols r)
 joinSideCols _ = (Nothing, Nothing)
 
+-- | 数左子树里过滤节点的个数
 countFilters :: RelOp -> Int
 countFilters (Filter _ x) = 1 + countFilters x
 countFilters _ = 0
 
+-- | 取 Join 左侧过滤节点数
 leftSideFilters :: RelOp -> Maybe Int
 leftSideFilters (Project _ (Join _ l _ _)) = Just (countFilters l)
 leftSideFilters _ = Nothing
 
+-- | 去掉外层投影，返回真正的根节点
 planRoot :: RelOp -> RelOp
 planRoot (Project _ x) = planRoot x
 planRoot x = x

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

@@ -0,0 +1,21 @@
+cabal-version: 2.4
+
+name:           chusql-core-model
+version:        1.0.0
+synopsis:       ChuSQL 共用数据模型与线上协议类型
+description:    ChuSQL 各进程共用的纯数据类型：列与值的模型、存储层线上协议
+                （请求/响应/表结构与账号）以及查询结果集。这里不放任何执行
+                逻辑，前端只依赖这个包就不会把引擎链进自己的二进制。
+build-type:     Simple
+
+library
+    hs-source-dirs:   src
+    exposed-modules:  ChuSQL.Core.Model
+                      ChuSQL.Core.Protocol
+    build-depends:    base >= 4.14 && < 5
+                    , aeson
+                    , hashable
+                    , scientific
+                    , text
+    default-language: Haskell2010
+    ghc-options:      -Wall

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

@@ -1,6 +1,6 @@
 {-# LANGUAGE PatternSynonyms #-}
 
-module ChuSQL.Model
+module ChuSQL.Core.Model
     ( ColumnType (..)
     , Column (..)
     , pattern TInt
@@ -35,7 +35,7 @@ import Data.Hashable (Hashable (..))
 import Data.List (isSuffixOf, stripPrefix)
 import Data.Maybe (fromMaybe)
 
--- 数据模型：列类型、列约束、值、行、表、数据库，外加几个查表小工具。
+-- 数据模型：列类型、列约束、值、行、表、数据库，外加查表小工具。
 
 -- | 列的基础类型
 data ColumnType
@@ -70,16 +70,19 @@ data Column = Column
 plainColumn :: ColumnType -> Column
 plainColumn t = Column t True Nothing False False False Nothing
 
+-- | 普通整型列的匹配模式
 pattern TInt :: Column
 pattern TInt <- Column CInt _ _ _ _ _ _
   where
     TInt = plainColumn CInt
 
+-- | 普通字符串列的匹配模式
 pattern TStr :: Column
 pattern TStr <- Column CStr _ _ _ _ _ _
   where
     TStr = plainColumn CStr
 
+-- | 普通布尔列的匹配模式
 pattern TBool :: Column
 pattern TBool <- Column CBool _ _ _ _ _ _
   where
@@ -146,8 +149,11 @@ parseColumnType raw = case (base, args) of
     ("blob", []) -> Just CBlob
     _ -> Nothing
   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)
@@ -193,6 +199,7 @@ data TypeClass
     | BooleanClass
     deriving (Show, Eq)
 
+-- | 整型大类判断
 typeClassOf :: ColumnType -> TypeClass
 typeClassOf CInt = NumericClass
 typeClassOf CBigInt = NumericClass
@@ -216,12 +223,14 @@ assignable target source
     | typeClassOf target == TemporalClass && typeClassOf source == TextClass = True
     | otherwise = False
 
+-- | 是不是整数类型
 integerType :: ColumnType -> Bool
 integerType CInt = True
 integerType CBigInt = True
 integerType CSmallInt = True
 integerType _ = False
 
+-- | 是不是数值类型
 numericType :: ColumnType -> Bool
 numericType t = typeClassOf t == NumericClass
 
@@ -264,6 +273,7 @@ coerceValue t v = case t of
     CTimestamp -> toTimestamp v
     CBlob -> toText t v
 
+-- | 整数收进整型列
 toInt :: ColumnType -> Value -> Either String Value
 toInt _ (VInt n) = Right (VInt n)
 toInt t (VFloat d) = case properFraction d :: (Int, Double) of
@@ -272,6 +282,7 @@ toInt t (VFloat d) = case properFraction d :: (Int, Double) of
         | otherwise -> Left ("cannot put a fractional number into " ++ typeLabel t)
 toInt t _ = Left ("cannot put this value into " ++ typeLabel t)
 
+-- | 数值收进浮点列
 toFloat :: ColumnType -> Value -> Either String Value
 toFloat _ (VInt n) = Right (VFloat (fromIntegral n))
 toFloat _ (VFloat d) = Right (VFloat d)
@@ -284,29 +295,36 @@ toDecimal p s v = case v of
     VFloat d -> rounded d
     _ -> Left ("cannot put this value into " ++ typeLabel (CDecimal p s))
   where
+    -- | 缩放因子
     scale = (10 :: Double) ^ max 0 s
+    -- | 按比例四舍五入
     rounded d = Right (VFloat (fromIntegral (round (d * scale) :: Integer) / scale))
 
+-- | 字符串收进文本列
 toText :: ColumnType -> Value -> Either String Value
 toText _ (VStr s) = Right (VStr s)
 toText t _ = Left ("cannot put this value into " ++ typeLabel t)
 
+-- | 按列长度限制收字符串
 toSized :: Int -> Value -> Either String Value
 toSized n (VStr s)
     | length s <= n = Right (VStr s)
     | otherwise = Left ("value is longer than " ++ show n ++ " characters")
 toSized _ _ = Left "cannot put this value into a character column"
 
+-- | 布尔收进布尔列
 toBool :: ColumnType -> Value -> Either String Value
 toBool _ (VBool b) = Right (VBool b)
 toBool t _ = Left ("cannot put this value into " ++ typeLabel t)
 
+-- | 字符串收进日期列
 toDate :: Value -> Either String Value
 toDate (VStr s)
     | validDateText s = Right (VStr s)
     | otherwise = Left "date must look like YYYY-MM-DD"
 toDate _ = Left "date must be a string"
 
+-- | 字符串收进时间戳列
 toTimestamp :: Value -> Either String Value
 toTimestamp (VStr s)
     | validTimestampText s = Right (VStr s)
@@ -319,7 +337,7 @@ validDateText s = case splitOn '-' s of
     [y, m, d] -> allOf 4 y && allOf 2 m && allOf 2 d
     _ -> False
 
--- | YYYY-MM-DD HH:MM:SS，日期与时间之间允许空格或 T
+-- | 日期时间格式；中间允许空格或 T
 validTimestampText :: String -> Bool
 validTimestampText s = case break (\c -> c == ' ' || c == 'T') s of
     (d, _ : tm) -> validDateText d && validTimeText tm
@@ -331,10 +349,12 @@ validTimeText t = case splitOn ':' t of
     [h, m, sec] -> allOf 2 h && allOf 2 m && allOf 2 sec
     _ -> False
 
+-- | 一段字符串是不是固定长度的数字
 allOf :: Int -> String -> Bool
 allOf n s = length s == n && all isDigit s
 
 
+-- | 引擎里的一行值
 data Value
     = VNull
     | VInt Int
@@ -343,6 +363,7 @@ data Value
     | VBool Bool
     deriving (Show, Eq)
 
+-- | 值按类型打散搅拌
 instance Hashable Value where
     hashWithSalt s VNull = hashWithSalt (hashWithSalt s (0 :: Int)) ()
     hashWithSalt s (VInt n) = hashWithSalt (hashWithSalt s (1 :: Int)) n
@@ -350,8 +371,10 @@ instance Hashable Value where
     hashWithSalt s (VStr t) = hashWithSalt (hashWithSalt s (3 :: Int)) t
     hashWithSalt s (VBool b) = hashWithSalt (hashWithSalt s (4 :: Int)) b
 
+-- | 一行数据
 type Row = [(String, Value)]
 
+-- | 一张表：名字、列定义与全部行
 data Table = Table
     { tableName :: String
     , tableCols :: [(String, Column)]
@@ -359,6 +382,7 @@ data Table = Table
     }
     deriving (Show)
 
+-- | 库：库名到表的映射
 type Database = [(String, Table)]
 
 -- | 取表的列名
@@ -373,6 +397,7 @@ colType t c = lookup c (tableCols t)
 lookupTable :: Database -> String -> Either String Table
 lookupTable db t = maybe (Left ("unknown table: " ++ t)) Right (lookup t db)
 
+-- | 通配列名
 allColumns :: String
 allColumns = "*"
 
@@ -393,4 +418,5 @@ 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

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

@@ -0,0 +1,357 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Core.Protocol (
+    SchemaColumn (..),
+    Request (..),
+    Response (..),
+    TableInfo (..),
+    Account (..),
+    QueryResult (..),
+    valueToJSON,
+    valueFromJSON,
+    rowToJSON,
+    rowFromJSON,
+    queryResultJson,
+) where
+
+import ChuSQL.Core.Model (Row, Value (..))
+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.Text (Text)
+
+-- 线上协议类型：存储层请求/响应与查询结果集。
+
+-- | 数据字典里一列的线上形状
+data SchemaColumn = SchemaColumn
+    { scName :: String
+    , scType :: String
+    , scNullable :: Bool
+    , scDefault :: Maybe Value
+    , scAutoIncrement :: Bool
+    , scPrimaryKey :: Bool
+    , scUnique :: Bool
+    , scCheck :: Maybe String
+    }
+    deriving (Show, Eq)
+
+-- | 列编码成 JSON
+instance ToJSON SchemaColumn where
+    toJSON sc =
+        object
+            [ "name" .= scName sc
+            , "ty" .= scType sc
+            , "nullable" .= scNullable sc
+            , "default" .= fmap valueToJSON (scDefault sc)
+            , "auto_increment" .= scAutoIncrement sc
+            , "primary_key" .= scPrimaryKey sc
+            , "unique" .= scUnique sc
+            , "check" .= scCheck sc
+            ]
+
+-- | JSON 解回列
+instance FromJSON SchemaColumn where
+    parseJSON = withObject "SchemaColumn" $ \o -> do
+        n <- o .: "name"
+        t <- o .: "ty"
+        nullable <- o .:? "nullable" .!= True
+        defJson <- o .:? "default"
+        def <- mapM valueFromJSON defJson
+        auto <- o .:? "auto_increment" .!= False
+        pk <- o .:? "primary_key" .!= False
+        uniq <- o .:? "unique" .!= False
+        chk <- o .:? "check"
+        pure (SchemaColumn n t nullable def auto pk uniq chk)
+
+-- | 存储层请求
+data Request
+    = ReqPing
+    | ReqDatabase String String
+    | ReqAllCatalog
+    | ReqInDatabase String Request
+    | ReqAccountsList
+    | ReqAccountCreate T.Text T.Text
+    | ReqAccountReset T.Text T.Text
+    | ReqAccountLogin T.Text (Maybe T.Text)
+    | ReqAccountDrop T.Text
+    | ReqScan String
+    | ReqScanColumns String [String]
+    | ReqInsert String Row
+    | ReqInsertBatch String [Row]
+    | ReqDeleteKeys String [Int]
+    | ReqReplaceAll String [Row]
+    | ReqListTables
+    | ReqLookupByColumn String String Value
+    | ReqRangeByIndex String String (Maybe (Value, Bool)) (Maybe (Value, Bool))
+    | ReqDescribeTable String
+    | ReqCreateTable String [SchemaColumn]
+    | ReqDropTable String
+    | ReqCreateIndex String String
+    | ReqDropIndex String String
+    | ReqDropColumn String String
+    | ReqReplaceSchema String [SchemaColumn] [Row]
+    | ReqListCatalog
+
+-- | 请求编码成 JSON
+instance ToJSON Request where
+    toJSON (ReqDatabase method name) = object ["method" .= method, "database" .= name]
+    toJSON ReqAllCatalog = object ["method" .= ("all_catalogs" :: T.Text)]
+    toJSON (ReqInDatabase name req) = case toJSON req of
+        A.Object fields -> A.Object (KM.insert "database" (A.String (T.pack name)) fields)
+        other -> other
+    toJSON ReqAccountsList = object ["method" .= ("accounts_list" :: T.Text)]
+    toJSON (ReqAccountCreate u h) = object ["method" .= ("account_create" :: T.Text), "user" .= u, "password_hash" .= h]
+    toJSON (ReqAccountReset u h) = object ["method" .= ("account_reset" :: T.Text), "user" .= u, "password_hash" .= h]
+    toJSON (ReqAccountLogin u at) = object ["method" .= ("account_login" :: T.Text), "user" .= u, "at" .= at]
+    toJSON (ReqAccountDrop u) = object ["method" .= ("account_drop" :: T.Text), "user" .= u]
+    toJSON ReqPing = object ["method" .= ("ping" :: T.Text)]
+    toJSON (ReqScan t) = object ["method" .= ("scan" :: T.Text), "table" .= t]
+    toJSON (ReqScanColumns t cols) = object ["method" .= ("scan" :: T.Text), "table" .= t, "columns" .= cols]
+    toJSON (ReqInsert t r) =
+        object
+            [ "method" .= ("insert" :: T.Text)
+            , "table" .= t
+            , "row" .= rowToJSON r
+            ]
+    toJSON (ReqInsertBatch t rs) =
+        object
+            [ "method" .= ("insert_batch" :: T.Text)
+            , "table" .= t
+            , "rows" .= map rowToJSON rs
+            ]
+    toJSON (ReqDeleteKeys t ks) =
+        object
+            [ "method" .= ("delete_keys" :: T.Text)
+            , "table" .= t
+            , "keys" .= ks
+            ]
+    toJSON (ReqReplaceAll t rs) =
+        object
+            [ "method" .= ("replace_all" :: T.Text)
+            , "table" .= t
+            , "rows" .= map rowToJSON rs
+            ]
+    toJSON ReqListTables = object ["method" .= ("list_tables" :: T.Text)]
+    toJSON (ReqLookupByColumn t c k) =
+        object
+            [ "method" .= ("lookup_by_index" :: T.Text)
+            , "table" .= t
+            , "column" .= c
+            , "key" .= valueToJSON k
+            ]
+    toJSON (ReqRangeByIndex t c lo hi) =
+        object
+            [ "method" .= ("range_by_index" :: T.Text)
+            , "table" .= t
+            , "column" .= c
+            , "lo" .= fmap (valueToJSON . fst) lo
+            , "lo_inclusive" .= maybe True snd lo
+            , "hi" .= fmap (valueToJSON . fst) hi
+            , "hi_inclusive" .= maybe True snd hi
+            ]
+    toJSON (ReqDescribeTable t) =
+        object
+            [ "method" .= ("describe_table" :: T.Text)
+            , "table" .= t
+            ]
+    toJSON (ReqCreateTable t cols) =
+        object
+            [ "method" .= ("create_table" :: T.Text)
+            , "table" .= t
+            , "columns" .= cols
+            ]
+    toJSON (ReqDropTable t) =
+        object ["method" .= ("drop_table" :: T.Text), "table" .= t]
+    toJSON (ReqCreateIndex t c) =
+        object
+            [ "method" .= ("create_index" :: T.Text)
+            , "table" .= t
+            , "column" .= c
+            ]
+    toJSON (ReqDropIndex t c) =
+        object
+            [ "method" .= ("drop_index" :: T.Text)
+            , "table" .= t
+            , "column" .= c
+            ]
+    toJSON (ReqDropColumn t c) =
+        object
+            [ "method" .= ("drop_column" :: T.Text)
+            , "table" .= t
+            , "column" .= c
+            ]
+    toJSON (ReqReplaceSchema t cols rs) =
+        object
+            [ "method" .= ("replace_schema" :: T.Text)
+            , "table" .= t
+            , "columns" .= cols
+            , "rows" .= map rowToJSON rs
+            ]
+    toJSON ReqListCatalog = object ["method" .= ("list_catalog" :: T.Text)]
+
+-- | 一张表的梗概：列、行数、索引与列统计
+data TableInfo = TableInfo
+    { tiTable :: String
+    , tiColumns :: [SchemaColumn]
+    , tiRows :: Int
+    , tiIndexes :: [String]
+    , tiStats :: [(String, Int, Bool)]
+    }
+    deriving (Show, Eq)
+
+-- | 表信息编码成 JSON
+instance ToJSON TableInfo where
+    toJSON info =
+        object
+            [ "table" .= tiTable info
+            , "columns" .= tiColumns info
+            , "row_count" .= tiRows info
+            , "indexes" .= map (\name -> object ["column" .= name]) (tiIndexes info)
+            , "stats" .= map statJson (tiStats info)
+            ]
+      where
+        statJson (name, distinct, capped) =
+            object ["name" .= name, "distinct" .= distinct, "capped" .= capped]
+
+-- | JSON 解回表信息
+instance FromJSON TableInfo where
+    parseJSON = withObject "TableInfo" $ \o -> do
+        table <- o .: "table"
+        columns <- o .: "columns"
+        count <- o .: "row_count"
+        indexes <- o .:? "indexes" .!= []
+        stats <- o .:? "stats" .!= []
+        indexColumns <- mapM (\v -> withObject "IndexWire" (.: "column") v) (indexes :: [A.Value])
+        parsedStats <- mapM parseStat (stats :: [A.Value])
+        pure (TableInfo table columns count indexColumns parsedStats)
+      where
+        parseStat = withObject "ColumnStat" $ \o -> do
+            name <- o .: "name"
+            distinct <- o .: "distinct"
+            capped <- o .:? "capped" .!= False
+            pure (name, distinct, capped)
+
+-- | 一条账号记录
+data Account = Account
+    { accountId :: Integer
+    , accountUser :: T.Text
+    , accountHash :: T.Text
+    , accountRevision :: Integer
+    , accountRegisteredAt :: T.Text
+    , accountLastLoginAt :: Maybe T.Text
+    } deriving (Eq)
+
+-- | 账号的展示：只露账号名与版本号
+instance Show Account where
+    show a = "Account " ++ show (accountUser a) ++ " revision=" ++ show (accountRevision a)
+
+-- | JSON 解回账号
+instance FromJSON Account where
+    parseJSON = withObject "Account" $ \o -> Account <$> o .: "id" <*> o .: "user"
+        <*> o .: "password_hash" <*> o .: "revision"
+        <*> o .:? "registered_at" .!= "" <*> o .:? "last_login_at"
+
+-- | 账号编码成 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]
+
+-- | 存储层响应
+data Response
+    = RespPong
+    | RespAccounts [Account]
+    | RespRows [Row]
+    | RespTables [String]
+    | RespSchema TableInfo
+    | RespNoIndex
+    | RespOk
+    | RespError String
+    | RespCatalog [TableInfo]
+
+-- | JSON 解回响应
+instance FromJSON Response where
+    parseJSON = withObject "Response" $ \o -> do
+        status <- o .: "status"
+        case status :: T.Text of
+            "accounts" -> RespAccounts <$> o .: "accounts"
+            "pong" -> pure RespPong
+            "ok" -> pure RespOk
+            "no_index" -> pure RespNoIndex
+            "rows" -> RespRows <$> (o .: "rows" >>= mapM rowFromJSON)
+            "tables" -> RespTables <$> o .: "tables"
+            "error" -> RespError <$> o .: "message"
+            "schema" -> RespSchema <$> parseJSON (A.Object o)
+            "catalog" -> do
+                xs <- o .: "schemas" :: Parser [A.Value]
+                RespCatalog <$> mapM parseJSON xs
+            other -> fail ("unknown status: " ++ T.unpack other)
+
+-- | 值编码成 JSON
+valueToJSON :: Value -> A.Value
+valueToJSON VNull = A.Null
+valueToJSON (VInt n) = A.Number (fromIntegral n)
+valueToJSON (VFloat d) = A.Number (fromFloatDigits d)
+valueToJSON (VStr s) = A.String (T.pack s)
+valueToJSON (VBool b) = A.Bool b
+
+-- | JSON 解回值
+valueFromJSON :: A.Value -> Parser Value
+valueFromJSON A.Null = pure VNull
+valueFromJSON (A.Number n) =
+    case floatingOrInteger n :: Either Double Integer of
+        Right i -> pure (VInt (fromIntegral i))
+        Left d -> pure (VFloat d)
+valueFromJSON (A.String s) = pure (VStr (T.unpack s))
+valueFromJSON (A.Bool b) = pure (VBool b)
+valueFromJSON _ = fail "unsupported value type"
+
+-- | 一行编码成 JSON
+rowToJSON :: Row -> A.Value
+rowToJSON r =
+    A.Object (KM.fromList [(K.fromString k, valueToJSON v) | (k, v) <- r])
+
+-- | JSON 解回一行
+rowFromJSON :: A.Value -> Parser Row
+rowFromJSON (A.Object o) = mapM toPair (KM.toList o)
+  where
+    -- | 键值对解成一个字段
+    toPair (k, v) = do
+        val <- valueFromJSON v
+        pure (K.toString k, val)
+rowFromJSON _ = fail "row must be a JSON object"
+
+-- | 一条语句的结果集：列名与排好的行
+data QueryResult = QueryResult
+    { qrColumns :: [Text]
+    , qrRows :: [[Value]]
+    , qrRowCount :: Int
+    , qrTruncated :: Bool
+    , qrDatabase :: Maybe Text
+    }
+    deriving (Eq, Show)
+
+-- | JSON 解回结果集
+instance FromJSON QueryResult where
+    parseJSON = withObject "QueryResult" $ \o -> do
+        cols <- o .: "columns"
+        rows <- o .: "rows"
+        QueryResult cols <$> mapM (mapM valueFromJSON) rows
+            <*> o .:? "rowCount" .!= 0
+            <*> o .:? "truncated" .!= False
+            <*> o .:? "database"
+
+-- | 结果还原成 JSON（JSON 输出与 TCP 结果集共用）
+queryResultJson :: QueryResult -> A.Value
+queryResultJson result =
+    object
+        [ "columns" .= qrColumns result
+        , "rows" .= map (map valueToJSON) (qrRows result)
+        , "rowCount" .= qrRowCount result
+        , "truncated" .= qrTruncated result
+        , "database" .= qrDatabase result
+        ]

chusql-core/model/stack.yaml.lock

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

chusql-core/storage/Cargo.lock

@@ -15,22 +15,15 @@ source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "4e7648175b45a9a48536d676f68d918270699102aa8dab5496df06904c914600"
 
 [[package]]
-name = "chusql-storage"
+name = "chusql-core-storage"
 version = "0.1.0"
 dependencies = [
- "interprocess",
  "serde",
  "serde_json",
  "tempfile",
  "toml",
 ]
 
-[[package]]
-name = "doctest-file"
-version = "1.1.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "c2db04e74f0a9a93103b50e90b96024c9b2bdca8bce6a632ec71b88736d3d359"
-
 [[package]]
 name = "equivalent"
 version = "1.0.2"
@@ -80,19 +73,6 @@ dependencies = [
  "hashbrown",
 ]
 
-[[package]]
-name = "interprocess"
-version = "2.4.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "6cb02ffbf25e8ef0f4a95bff054eef75f6d1bf16919474cf2caa63b21997478a"
-dependencies = [
- "doctest-file",
- "libc",
- "recvmsg",
- "widestring",
- "windows-sys",
-]
-
 [[package]]
 name = "itoa"
 version = "1.0.18"
@@ -147,12 +127,6 @@ version = "6.0.0"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "f8dcc9c7d52a811697d2151c701e0d08956f92b0e24136cf4cf27b57a6a0d9bf"
 
-[[package]]
-name = "recvmsg"
-version = "1.0.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d3edd4d5d42c92f0a659926464d4cce56b562761267ecf0f469d85b7de384175"
-
 [[package]]
 name = "rustix"
 version = "1.1.5"
@@ -289,12 +263,6 @@ version = "1.0.26"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "d245f478577f809a851594d02313b640fb437e0bb33866753cff937863096954"
 
-[[package]]
-name = "widestring"
-version = "1.2.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "72069c3113ab32ab29e5584db3c6ec55d416895e60715417b5b883a357c3e471"
-
 [[package]]
 name = "windows-link"
 version = "0.2.1"

chusql-core/storage/Cargo.toml

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

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

@@ -29,14 +29,10 @@ pool_size = 1024
 # 要固定就写绝对路径，例如：
 # data_dir = "/srv/chusql/data"
 
-[server]
-# 命名管道名（Windows 上实际是 \\.\pipe\<这个名字>）。
-pipe_name = "chusql-joint"
-
 [log]
 # 日志等级：off / error / warn / info / debug。debug 会多打每个请求和连接。
 level = "info"
 
 # 颜色没有配置项也没有环境变量：要写的那条流是终端就着色，重定向到文件就不着色。
-# 行格式：[等级 本地日期时间] [来源] 消息；来源 core=服务自身、pipe=由管道请求触发
+# 行格式：[等级 本地日期时间] [来源] 消息；来源 core=服务自身、request=由存储请求触发
 # ERROR 加粗红、WARN 加粗橙、DEBUG 加粗不变色、INFO 不加样式

chusql-core/storage/src/btree.rs

@@ -44,36 +44,44 @@ pub fn max_order(page_size: usize) -> usize {
     page_size.saturating_sub(HEADER) / (SLOT + max_cell_bytes()) + 1
 }
 
+/// 读一个 u8
 fn read_u8(p: &Page, off: usize) -> u8 {
     p.data[off]
 }
 
+/// 写一个 u8
 fn write_u8(p: &mut Page, off: usize, v: u8) {
     p.data[off] = v;
 }
 
+/// 读一个小端 u16
 fn read_u16(p: &Page, off: usize) -> u16 {
     u16::from_le_bytes([p.data[off], p.data[off + 1]])
 }
 
+/// 写一个小端 u16
 fn write_u16(p: &mut Page, off: usize, v: u16) {
     p.data[off..off + 2].copy_from_slice(&v.to_le_bytes());
 }
 
+/// 读一个小端 u32
 fn read_u32(p: &Page, off: usize) -> u32 {
     u32::from_le_bytes([p.data[off], p.data[off + 1], p.data[off + 2], p.data[off + 3]])
 }
 
+/// 写一个小端 u32
 fn write_u32(p: &mut Page, off: usize, v: u32) {
     p.data[off..off + 4].copy_from_slice(&v.to_le_bytes());
 }
 
+/// 读一个小端 u64
 fn read_u64(p: &Page, off: usize) -> u64 {
     let mut b = [0u8; 8];
     b.copy_from_slice(&p.data[off..off + 8]);
     u64::from_le_bytes(b)
 }
 
+/// 写一个小端 u64
 fn write_u64(p: &mut Page, off: usize, v: u64) {
     p.data[off..off + 8].copy_from_slice(&v.to_le_bytes());
 }
@@ -269,16 +277,19 @@ impl DiskBTree {
         Ok(())
     }
 
+    /// 读根页页号；空树是 None
     fn root(&mut self) -> io::Result<Option<PageId>> {
         let r = self.file.with_page(META_PAGE, |p| read_u64(p, OFF_ROOT))?;
         Ok(if r == 0 { None } else { Some(r) })
     }
 
+    /// 写根页页号
     fn set_root(&mut self, r: Option<PageId>) -> io::Result<()> {
         self.file
             .update_page(META_PAGE, |p| write_u64(p, OFF_ROOT, r.unwrap_or(0)))
     }
 
+    /// 追加一个新节点页
     fn alloc(&mut self, node: &Node) -> io::Result<PageId> {
         let page = self.file.append_page()?;
         let id = page.id;
@@ -286,10 +297,12 @@ impl DiskBTree {
         Ok(id)
     }
 
+    /// 按页号读节点
     fn load(&mut self, id: PageId) -> io::Result<Node> {
         self.file.with_page(id, get_node)
     }
 
+    /// 按页号写节点
     fn store(&mut self, id: PageId, node: &Node) -> io::Result<()> {
         self.file.update_page(id, |p| put_node(p, node))?
     }
@@ -417,6 +430,7 @@ impl DiskBTree {
         self.delete_rec(root, key, value)
     }
 
+    /// 递归删一个 (key, value)
     fn delete_rec(&mut self, id: PageId, key: &[u8], value: u64) -> io::Result<bool> {
         let mut node = self.load(id)?;
         if node.kind == NODE_LEAF {
@@ -438,7 +452,7 @@ impl DiskBTree {
         self.scan(None, None)
     }
 
-    /// 范围扫描：lo / hi 都是闭区间，None 表示这一侧不限
+    /// 范围扫描：lo / hi 都是闭区间，None 表示不限
     pub fn scan(
         &mut self,
         lo: Option<&[u8]>,

chusql-core/storage/src/catalog.rs

@@ -250,7 +250,7 @@ impl Catalog {
         Ok(had_column)
     }
 
-    /// 整理完成：记住这一版已经重写过（隐藏列名要留住，防止被重新写进来）
+    /// 记住这一版已整理过（隐藏列名要留住）
     pub fn mark_compacted(&mut self, table: &str) -> io::Result<()> {
         let entry = self
             .tables
@@ -336,7 +336,7 @@ fn infer_type(v: &serde_json::Value) -> Option<String> {
     }
 }
 
-/// 旧写法与新别名都并到规范名字，参数（varchar(20)）原样保留；不认识的原样返回
+/// 类型别名统一成规范名，参数原样保留
 pub fn normalize_type(ty: &str) -> String {
     let trimmed = ty.trim();
     let (base, args) = match trimmed.find('(') {

chusql-core/storage/src/config.rs

@@ -4,15 +4,8 @@ use serde::Deserialize;
 
 use crate::log::Level;
 
-// 全局配置：只从 TOML 文件读，没写的项回退内置默认值。
+// 全局配置：只从 TOML 文件读，缺项回退内置默认值；
-//
+// 存储相关分区由本模块解析校验，其它层的分区一概不碰。
-// 这个文件是整条链路的唯一配置文件，按分区各管各的：
-// 存储只看 [page]/[btree]/[buffer]/[storage]/[server]/[log]，
-// 其他分区（例如 web 的 [web]）由对应的层自己读，这里既不校验也不关心。
-// 位置是安装时定下的固定路径，只有命令行 --config 能覆盖；没有任何环境变量通道。
-// （唯一跟环境变量有关的是路径的默认值：配置文件和默认数据目录都按平台惯例算，
-//   见 default_config_path / default_data_dir，它们只是算默认位置，不是配置通道。）
-// 读一次就关，不长期占着文件句柄。
 
 /// 配置文件名
 pub const CONFIG_FILE_NAME: &str = "chusql.toml";
@@ -26,15 +19,13 @@ pub const DATA_DIR_NAME: &str = "data";
 pub const DEFAULT_POOL_SIZE: usize = 1024;
 pub const DEFAULT_PAGE_SIZE: usize = 4096;
 pub const DEFAULT_BTREE_ORDER: usize = 4;
-pub const DEFAULT_PIPE_NAME: &str = "chusql-joint";
 pub const DEFAULT_LOG_LEVEL: &str = "info";
 
 const MIN_PAGE_SIZE: usize = 512;
 const MAX_PAGE_SIZE: usize = 65536;
 const MIN_BTREE_ORDER: usize = 3;
 
-/// 安装后的固定配置路径：Windows 用 %APPDATA%，其它平台用 XDG 惯例。
+/// 默认配置文件路径（按平台惯例）
-/// 环境变量缺失时退回相对路径 ChuSQL/chusql.toml。
 pub fn default_config_path() -> PathBuf {
     #[cfg(windows)]
     {
@@ -60,14 +51,7 @@ pub fn default_config_path() -> PathBuf {
     PathBuf::from(APP_DIR_NAME).join(CONFIG_FILE_NAME)
 }
 
-/// [storage] data_dir 没写时的默认数据目录，按各平台惯例自动切换：
+/// Windows 默认数据目录
-///
-///   Windows  %LOCALAPPDATA%\ChuSQL\data（没设就退 %APPDATA%）
-///   Unix     $XDG_DATA_HOME/chusql/data（没设就是 ~/.local/share/chusql/data）
-///
-/// 跟安装脚本的默认数据目录是同一处：install.ps1 默认装到 %LOCALAPPDATA%\ChuSQL、
-/// 数据放它下面的 data\；install.sh 默认装到 ~/.local/share/chusql、数据放它下面的 data/。
-/// 环境变量都缺时才退回相对路径（跟 default_config_path 的兜底风格一致）。
 #[cfg(windows)]
 pub fn default_data_dir() -> PathBuf {
     let local = std::env::var_os("LOCALAPPDATA").filter(|v| !v.is_empty());
@@ -81,7 +65,7 @@ pub fn default_data_dir() -> PathBuf {
     PathBuf::from(APP_DIR_NAME).join(DATA_DIR_NAME)
 }
 
-/// 见 Windows 版本的注释：这里走 XDG 惯例。
+/// Unix 默认数据目录（XDG 惯例）
 #[cfg(not(windows))]
 pub fn default_data_dir() -> PathBuf {
     let xdg = std::env::var_os("XDG_DATA_HOME").filter(|v| !v.is_empty());
@@ -107,18 +91,17 @@ pub struct Config {
     pub btree_order: usize,
     pub pool_size: usize,
     pub data_dir: PathBuf,
-    pub pipe_name: String,
     pub log_level: Level,
 }
 
 impl Default for Config {
+    /// 内置默认配置
     fn default() -> Self {
         Config {
             page_size: DEFAULT_PAGE_SIZE,
             btree_order: DEFAULT_BTREE_ORDER,
             pool_size: DEFAULT_POOL_SIZE,
             data_dir: default_data_dir(),
-            pipe_name: DEFAULT_PIPE_NAME.to_string(),
             log_level: Level::Info,
         }
     }
@@ -153,7 +136,6 @@ struct FileConfig {
     btree: Option<FileBtree>,
     buffer: Option<FileBuffer>,
     storage: Option<FileStorage>,
-    server: Option<FileServer>,
     log: Option<FileLog>,
 }
 
@@ -181,19 +163,13 @@ struct FileStorage {
     data_dir: Option<String>,
 }
 
-#[derive(Debug, Default, Deserialize)]
-#[serde(deny_unknown_fields)]
-struct FileServer {
-    pipe_name: Option<String>,
-}
-
 #[derive(Debug, Default, Deserialize)]
 #[serde(deny_unknown_fields)]
 struct FileLog {
     level: Option<String>,
 }
 
-/// 加载配置：explicit 有值就用它（读不到要报错），否则用固定安装路径（存在才读）
+/// 加载配置：显式路径优先，其次默认位置
 pub fn load(explicit: Option<&str>) -> Result<Loaded, String> {
     let explicit = explicit.map(str::trim).filter(|p| !p.is_empty());
     let path = match explicit {
@@ -249,15 +225,11 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
         &file_origin,
     );
     let (data_dir, dir_origin) = pick(
-        file.storage.and_then(|s| s.data_dir),
+        file.storage.as_ref().and_then(|s| s.data_dir.clone()),
         default_data_dir().to_string_lossy().into_owned(),
         &file_origin,
     );
-    let (pipe_name, pipe_origin) = pick(
+    // 管名已经没有了：存储不再是独立进程，管道/套接字那一层随 FFI 一起删掉
-        file.server.and_then(|s| s.pipe_name),
-        DEFAULT_PIPE_NAME.to_string(),
-        &file_origin,
-    );
     let (log_level, log_origin) = pick(
         file.log.and_then(|l| l.level),
         DEFAULT_LOG_LEVEL.to_string(),
@@ -265,7 +237,6 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
     );
 
     let data_dir = data_dir.trim().to_string();
-    let pipe_name = pipe_name.trim().to_string();
     let log_level = log_level.trim().to_string();
 
     let log_level = Level::parse(&log_level)
@@ -274,9 +245,6 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
     if data_dir.is_empty() {
         return Err("storage.data_dir must not be empty".to_string());
     }
-    if pipe_name.is_empty() {
-        return Err("server.pipe_name must not be empty".to_string());
-    }
     validate_layout(page_size, btree_order)?;
     if pool_size == 0 {
         return Err("buffer.pool_size must be at least 1".to_string());
@@ -286,7 +254,6 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
         ("btree.order", btree_order.to_string(), order_origin),
         ("buffer.pool_size", pool_size.to_string(), pool_origin),
         ("storage.data_dir", data_dir.clone(), dir_origin),
-        ("server.pipe_name", pipe_name.clone(), pipe_origin),
         ("log.level", log_level.name().to_string(), log_origin),
     ];
 
@@ -296,7 +263,6 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
             btree_order,
             pool_size,
             data_dir: PathBuf::from(data_dir),
-            pipe_name,
             log_level,
         },
         config_path: if text.is_some() { path } else { None },
@@ -341,7 +307,7 @@ fn validate_layout(page_size: usize, btree_order: usize) -> Result<(), String> {
 mod tests {
     use super::*;
 
-    /// 全局配置里别的层（例如 web）的分区不能被存储层当成错误
+    /// 别的层的分区不能被当成错误
     #[test]
     fn ignores_sections_owned_by_other_layers() {
         let text = r#"
@@ -351,8 +317,13 @@ size = 8192
 [storage]
 data_dir = "../data"
 
-[web]
+[server]
+host = "127.0.0.1"
 port = 7777
+max_message = 1048576
+
+[web]
+port = 7778
 user = "root"
 "#;
         let loaded = resolve(Some(text), Some(PathBuf::from("chusql.toml"))).unwrap();

chusql-core/storage/src/ffi.rs

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

chusql-core/storage/src/heap.rs

@@ -20,9 +20,11 @@ fn decode_row(bytes: &[u8], columns: Option<&[String]>, hidden: &HashSet<String>
     struct RowVisitor<'a>(Option<&'a [String]>, &'a HashSet<String>);
     impl<'de> Visitor<'de> for RowVisitor<'_> {
         type Value = Row;
+        /// 说明期望的输入形态
         fn expecting(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
             f.write_str("a row object")
         }
+        /// 逐字段解出一行
         fn visit_map<M: MapAccess<'de>>(self, mut map: M) -> Result<Row, M::Error> {
             let mut row = Row::new();
             while let Some(key) = map.next_key::<String>()? {
@@ -284,7 +286,7 @@ impl HeapTable {
         self.indexes.iter().any(|i| i.column == column)
     }
 
-    /// 建索引：要求这一列取值唯一
+    /// 建索引：id 列必须唯一，其余列可重复
     pub fn build_index(
         &mut self,
         column: &str,
@@ -360,10 +362,12 @@ impl HeapTable {
         }
     }
 
+    /// 设置隐藏列集合
     pub fn set_hidden_columns(&mut self, columns: HashSet<String>) {
         self.hidden_columns = columns;
     }
 
+    /// 隐藏一列并摘掉它的索引
     pub fn hide_column(&mut self, column: &str) {
         self.detach_index(column);
         self.hidden_columns.insert(column.to_string());
@@ -487,7 +491,7 @@ impl HeapTable {
         Ok(rows)
     }
 
-    /// 范围扫描：某一列有索引就走叶子链，没有索引返回 None（上层退回全表扫描）
+    /// 按索引做范围扫描；没索引返回 None
     pub fn scan_range(
         &mut self,
         column: &str,
@@ -595,6 +599,7 @@ impl HeapTable {
         self.scan_columns(None)
     }
 
+    /// 全表扫描，只解码指定列
     pub fn scan_columns(&mut self, columns: Option<&[String]>) -> io::Result<Vec<Row>> {
         Ok(self
             .scan_projected_with_positions(columns)?
@@ -608,6 +613,7 @@ impl HeapTable {
         self.scan_projected_with_positions(None)
     }
 
+    /// 全表扫描，带位置与列投影
     fn scan_projected_with_positions(&mut self, columns: Option<&[String]>) -> io::Result<Vec<(PageId, u16, Row)>> {
         let n = self.file.num_pages()?;
         let mut out = Vec::new();

chusql-core/storage/src/initsql.rs

@@ -1,8 +1,8 @@
-//! `scripts/init.sql` 的最小读取：只认 CREATE TABLE 与 CREATE INDEX。
-//! 系统库的 schema 由这份脚本声明，存储进程按它建系统表。
-
 use crate::protocol::SchemaColumn;
 
+// 读取 scripts/init.sql，只认 CREATE TABLE 与 CREATE INDEX。
+// 系统库的 schema 由这份脚本声明，进程按它建系统表。
+
 #[derive(Debug, Clone, PartialEq, Eq)]
 pub struct InitColumn {
     pub name: String,
@@ -68,7 +68,7 @@ pub fn parse(text: &str) -> Result<Vec<InitTable>, String> {
     Ok(tables)
 }
 
-/// 一行一列：`name type [NOT NULL] [AUTO_INCREMENT] [PRIMARY KEY] [UNIQUE]`
+/// 解析表定义里的列清单
 fn columns(body: &str) -> Result<Vec<InitColumn>, String> {
     let mut out = Vec::new();
     for part in split_top_level(body) {
@@ -166,8 +166,9 @@ mod tests {
     use super::*;
 
     /// 仓库里的系统库脚本必须始终能解析
-    const SYSTEM_SCHEMA: &str = include_str!("../../scripts/init.sql");
+    const SYSTEM_SCHEMA: &str = include_str!("../../../scripts/init.sql");
 
+    /// 仓库自带脚本必须能解析出账号表
     #[test]
     fn parses_the_repository_init_script() {
         let tables = parse(SYSTEM_SCHEMA).expect("scripts/init.sql must parse");
@@ -186,6 +187,7 @@ mod tests {
         assert_eq!(users.indexes, ["user"]);
     }
 
+    /// 未知语句与表级约束要报错
     #[test]
     fn rejects_unknown_statements_and_table_level_constraints() {
         assert!(parse("DROP TABLE users;").is_err());
@@ -193,6 +195,7 @@ mod tests {
         assert!(parse("CREATE INDEX missing (user);").is_err());
     }
 
+    /// 注释与空语句要被跳过
     #[test]
     fn ignores_comments_and_blank_statements() {
         let tables = parse("-- note\nCREATE TABLE t (a int NOT NULL);\n\n/* done */\n").unwrap();

chusql-core/storage/src/lib.rs

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

chusql-core/storage/src/log.rs

@@ -22,7 +22,7 @@ pub enum Level {
 #[derive(Debug, Clone, Copy, PartialEq, Eq)]
 pub enum Channel {
     Core,
-    Pipe,
+    Request,
 }
 
 impl Channel {
@@ -30,7 +30,7 @@ impl Channel {
     fn tag(self) -> &'static str {
         match self {
             Channel::Core => "core",
-            Channel::Pipe => "pipe",
+            Channel::Request => "request",
         }
     }
 }
@@ -102,7 +102,7 @@ pub fn init() {
     enable_vt();
 }
 
-/// 写出一行：warn / error 走 stderr，info / debug 走 stdout。
+/// 写出一行日志，按等级选流向
 pub fn write(channel: Channel, level: Level, args: fmt::Arguments) {
     let msg = args.to_string();
     let to_stderr = streams_to_stderr(level);
@@ -116,12 +116,12 @@ pub fn write(channel: Channel, level: Level, args: fmt::Arguments) {
     }
 }
 
-/// 这个等级写 stderr 吗：warn / error 是，info / debug 写 stdout
+/// 这个等级是否写 stderr
 fn streams_to_stderr(level: Level) -> bool {
     matches!(level, Level::Error | Level::Warn)
 }
 
-/// 是否着色：只按要写的那条流是不是终端判断，没有环境变量开关
+/// 按目标流是否终端决定是否着色
 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() })
@@ -151,6 +151,7 @@ pub struct Stamp {
 }
 
 impl fmt::Display for Stamp {
+    /// 格式化成时间戳文本
     fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
         write!(
             f,
@@ -266,8 +267,8 @@ macro_rules! log_debug {
     (core, $($arg:tt)*) => {
         $crate::log_line!($crate::log::Channel::Core, $crate::log::Level::Debug, $($arg)*)
     };
-    (pipe, $($arg:tt)*) => {
+    (request, $($arg:tt)*) => {
-        $crate::log_line!($crate::log::Channel::Pipe, $crate::log::Level::Debug, $($arg)*)
+        $crate::log_line!($crate::log::Channel::Request, $crate::log::Level::Debug, $($arg)*)
     };
 }
 
@@ -276,8 +277,8 @@ macro_rules! log_info {
     (core, $($arg:tt)*) => {
         $crate::log_line!($crate::log::Channel::Core, $crate::log::Level::Info, $($arg)*)
     };
-    (pipe, $($arg:tt)*) => {
+    (request, $($arg:tt)*) => {
-        $crate::log_line!($crate::log::Channel::Pipe, $crate::log::Level::Info, $($arg)*)
+        $crate::log_line!($crate::log::Channel::Request, $crate::log::Level::Info, $($arg)*)
     };
 }
 
@@ -286,8 +287,8 @@ macro_rules! log_warn {
     (core, $($arg:tt)*) => {
         $crate::log_line!($crate::log::Channel::Core, $crate::log::Level::Warn, $($arg)*)
     };
-    (pipe, $($arg:tt)*) => {
+    (request, $($arg:tt)*) => {
-        $crate::log_line!($crate::log::Channel::Pipe, $crate::log::Level::Warn, $($arg)*)
+        $crate::log_line!($crate::log::Channel::Request, $crate::log::Level::Warn, $($arg)*)
     };
 }
 
@@ -296,8 +297,8 @@ macro_rules! log_error {
     (core, $($arg:tt)*) => {
         $crate::log_line!($crate::log::Channel::Core, $crate::log::Level::Error, $($arg)*)
     };
-    (pipe, $($arg:tt)*) => {
+    (request, $($arg:tt)*) => {
-        $crate::log_line!($crate::log::Channel::Pipe, $crate::log::Level::Error, $($arg)*)
+        $crate::log_line!($crate::log::Channel::Request, $crate::log::Level::Error, $($arg)*)
     };
 }
 
@@ -315,6 +316,7 @@ macro_rules! log_line {
 mod tests {
     use super::*;
 
+    /// 已知日期换算要正确
     #[test]
     fn civil_from_days_known_dates() {
         assert_eq!(civil_from_days(0), (1970, 1, 1));
@@ -324,6 +326,7 @@ mod tests {
         assert_eq!(civil_from_days(19_782), (2024, 2, 29));
     }
 
+    /// 行里要有等级、时间与来源
     #[test]
     fn render_has_time_channel_and_colors() {
         let stamp = Stamp {
@@ -337,16 +340,16 @@ mod tests {
         };
 
         assert_eq!(
-            render(Level::Error, Channel::Pipe, true, &stamp, "boom"),
+            render(Level::Error, Channel::Request, true, &stamp, "boom"),
-            "[\u{1b}[1m\u{1b}[31mERROR\u{1b}[0m 2026-09-24 13:45:12.130] [pipe] boom"
+            "[\u{1b}[1m\u{1b}[31mERROR\u{1b}[0m 2026-09-24 13:45:12.130] [request] boom"
         );
         assert_eq!(
             render(Level::Warn, Channel::Core, true, &stamp, "careful"),
             "[\u{1b}[1m\u{1b}[38;5;208mWARN \u{1b}[0m 2026-09-24 13:45:12.130] [core] careful"
         );
         assert_eq!(
-            render(Level::Debug, Channel::Pipe, true, &stamp, "detail"),
+            render(Level::Debug, Channel::Request, true, &stamp, "detail"),
-            "[\u{1b}[1mDEBUG\u{1b}[0m 2026-09-24 13:45:12.130] [pipe] detail"
+            "[\u{1b}[1mDEBUG\u{1b}[0m 2026-09-24 13:45:12.130] [request] detail"
         );
         assert_eq!(
             render(Level::Info, Channel::Core, true, &stamp, "hello"),
@@ -354,6 +357,7 @@ mod tests {
         );
     }
 
+    /// warn 与 error 走 stderr
     #[test]
     fn warnings_and_errors_go_to_stderr() {
         assert!(streams_to_stderr(Level::Error));

chusql-core/storage/src/page.rs

@@ -282,6 +282,7 @@ impl PageFile {
 }
 
 impl Drop for PageFile {
+    /// 析构时把脏页写回
     fn drop(&mut self) {
         let _ = self.flush();
     }

chusql-core/storage/src/protocol.rs

@@ -38,6 +38,7 @@ pub struct SchemaColumn {
 }
 
 impl Default for SchemaColumn {
+    /// 列定义的默认值
     fn default() -> Self {
         SchemaColumn {
             name: String::new(),
@@ -52,6 +53,7 @@ impl Default for SchemaColumn {
     }
 }
 
+/// serde 里缺省为真
 fn default_true() -> bool {
     true
 }
@@ -188,6 +190,7 @@ impl Request {
     }
 }
 
+/// 是不是保留系统表名
 pub fn reserved_table(table: &str) -> bool {
     table.to_ascii_lowercase().starts_with("__chusql_")
 }

chusql-core/storage/src/runtime.rs

@@ -1,26 +1,21 @@
 use std::collections::HashMap;
-use std::io::{BufRead, BufReader, Write};
 use std::path::PathBuf;
-use std::sync::{Arc, Mutex};
 use std::sync::atomic::{AtomicBool, Ordering};
-use std::thread;
+use std::sync::{Arc, Mutex};
 
-use chusql_storage::catalog::Catalog;
+use crate::catalog::Catalog;
-use chusql_storage::config::{self, Config, Loaded};
+use crate::config::{self, Config, Loaded};
-use chusql_storage::endpoint;
+use crate::heap::HeapTable;
-use chusql_storage::heap::HeapTable;
+use crate::initsql::{self, InitColumn, InitTable};
-use chusql_storage::initsql::{self, InitColumn, InitTable};
+use crate::log;
-use chusql_storage::log;
+use crate::protocol::{
-use chusql_storage::protocol::{
     reserved_table, Account, ColumnStatWire, IndexWire, Request, Response, Row, SchemaColumn, TableSchemaWire, USERS_TABLE,
 };
-use chusql_storage::wal::{Wal, WalOp};
+use crate::wal::{Wal, WalOp};
-use chusql_storage::{log_debug, log_error, log_info, log_warn};
+use crate::{log_debug, log_error, log_info, log_warn};
-use interprocess::local_socket::prelude::*;
-use interprocess::TryClone;
 
-// 本地套接字服务：按行读写 JSON。端点地址由 endpoint 模块给出：
+// 进程内存储运行时：Haskell 侧经 ffi.rs 调进来。
-// Windows 是具名管道 \\.\pipe\<name>，Unix 是文件系统套接字 <dir>/<name>.sock。
+// request_line 的语义等同原来的「一行 JSON 请求 → 一行 JSON 响应」套接字协议。
 
 struct Server {
     cfg: Config,
@@ -360,7 +355,7 @@ impl Server {
         Ok(())
     }
 
-    /// 旧类型系统留下的数据升级到新格式：列类型名规范化、缺列的行补 null
+    /// 老数据迁移：类型名规范、缺列补 null
     fn migrate_data(&self) -> std::io::Result<()> {
         let names: Vec<String> = self
             .catalog
@@ -647,12 +642,12 @@ impl Server {
                 }
             }
             Request::Ping => {
-                log_debug!(pipe, "ping");
+                log_debug!(request, "ping");
                 Response::Pong
             }
 
             Request::Scan { table, columns } => {
-                log_debug!(pipe, "scan table={}", table);
+                log_debug!(request, "scan table={}", table);
 
                 let result = (|| {
                     if let Some(cols) = &columns {
@@ -670,7 +665,7 @@ impl Server {
                 match result {
                     Ok(rows) => Response::Rows { rows },
                     Err(e) => {
-                        log_warn!(pipe, "scan {}: {}", table, e);
+                        log_warn!(request, "scan {}: {}", table, e);
                         Response::Error {
                             message: format!("scan {}: {}", table, e),
                         }
@@ -679,13 +674,13 @@ impl Server {
             }
 
             Request::Insert { table, row } => {
-                log_debug!(pipe, "insert table={}", table);
+                log_debug!(request, "insert table={}", table);
                 let tname = table.clone();
                 let op = WalOp::Insert { table, row };
                 match self.write_via_wal(&op) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
-                        log_warn!(pipe, "insert {}: {}", tname, e);
+                        log_warn!(request, "insert {}: {}", tname, e);
                         Response::Error {
                             message: format!("insert {}: {}", tname, e),
                         }
@@ -694,13 +689,13 @@ impl Server {
             }
 
             Request::InsertBatch { table, rows } => {
-                log_debug!(pipe, "insert_batch table={} rows={}", table, rows.len());
+                log_debug!(request, "insert_batch table={} rows={}", table, rows.len());
                 let tname = table.clone();
                 let op = WalOp::InsertBatch { table, rows };
                 match self.write_via_wal(&op) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
-                        log_warn!(pipe, "insert_batch {}: {}", tname, e);
+                        log_warn!(request, "insert_batch {}: {}", tname, e);
                         Response::Error {
                             message: format!("insert_batch {}: {}", tname, e),
                         }
@@ -709,13 +704,13 @@ impl Server {
             }
 
             Request::DeleteKeys { table, keys } => {
-                log_debug!(pipe, "delete_keys table={} keys={}", table, keys.len());
+                log_debug!(request, "delete_keys table={} keys={}", table, keys.len());
                 let tname = table.clone();
                 let op = WalOp::DeleteKeys { table, keys };
                 match self.write_via_wal(&op) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
-                        log_warn!(pipe, "delete_keys {}: {}", tname, e);
+                        log_warn!(request, "delete_keys {}: {}", tname, e);
                         Response::Error {
                             message: format!("delete_keys {}: {}", tname, e),
                         }
@@ -724,12 +719,12 @@ impl Server {
             }
 
             Request::LookupByIndex { table, column, key } => {
-                log_debug!(pipe, "lookup_by_index table={} column={} key={}", table, column, key);
+                log_debug!(request, "lookup_by_index table={} column={} key={}", table, column, key);
                 let indexed =
                     match self.with_existing_table(&table, |t| Ok(t.has_index(&column))) {
                         Ok(v) => v,
                         Err(e) => {
-                            log_warn!(pipe, "lookup_by_index {}: {}", table, e);
+                            log_warn!(request, "lookup_by_index {}: {}", table, e);
                             return Response::Error {
                                 message: format!("lookup_by_index {}: {}", table, e),
                             };
@@ -752,7 +747,7 @@ impl Server {
                 match found {
                     Ok(rows) => Response::Rows { rows },
                     Err(e) => {
-                        log_warn!(pipe, "lookup_by_index {}: {}", table, e);
+                        log_warn!(request, "lookup_by_index {}: {}", table, e);
                         Response::Error {
                             message: format!("lookup_by_index {}: {}", table, e),
                         }
@@ -761,12 +756,12 @@ impl Server {
             }
 
             Request::RangeByIndex { table, column, lo, lo_inclusive, hi, hi_inclusive } => {
-                log_debug!(pipe, "range_by_index table={} column={}", table, column);
+                log_debug!(request, "range_by_index table={} column={}", table, column);
                 let indexed =
                     match self.with_existing_table(&table, |t| Ok(t.has_index(&column))) {
                         Ok(v) => v,
                         Err(e) => {
-                            log_warn!(pipe, "range_by_index {}: {}", table, e);
+                            log_warn!(request, "range_by_index {}: {}", table, e);
                             return Response::Error {
                                 message: format!("range_by_index {}: {}", table, e),
                             };
@@ -781,7 +776,7 @@ impl Server {
                     Ok(Some(rows)) => Response::Rows { rows },
                     Ok(None) => Response::NoIndex,
                     Err(e) => {
-                        log_warn!(pipe, "range_by_index {}: {}", table, e);
+                        log_warn!(request, "range_by_index {}: {}", table, e);
                         Response::Error {
                             message: format!("range_by_index {}: {}", table, e),
                         }
@@ -790,13 +785,13 @@ impl Server {
             }
 
             Request::ReplaceAll { table, rows } => {
-                log_debug!(pipe, "replace_all table={} rows={}", table, rows.len());
+                log_debug!(request, "replace_all table={} rows={}", table, rows.len());
                 let tname = table.clone();
                 let op = WalOp::ReplaceAll { table, rows };
                 match self.write_via_wal(&op) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
-                        log_warn!(pipe, "replace_all {}: {}", tname, e);
+                        log_warn!(request, "replace_all {}: {}", tname, e);
                         Response::Error {
                             message: format!("replace_all {}: {}", tname, e),
                         }
@@ -805,11 +800,11 @@ impl Server {
             }
 
             Request::ListTables => {
-                log_debug!(pipe, "list_tables");
+                log_debug!(request, "list_tables");
                 match self.list_tables() {
                     Ok(tables) => Response::Tables { tables },
                     Err(e) => {
-                        log_warn!(pipe, "list_tables: {}", e);
+                        log_warn!(request, "list_tables: {}", e);
                         Response::Error {
                             message: format!("list_tables: {}", e),
                         }
@@ -818,7 +813,7 @@ impl Server {
             }
 
             Request::ListCatalog => {
-                log_debug!(pipe, "list_catalog");
+                log_debug!(request, "list_catalog");
                 let c = self.catalog.lock().unwrap();
                 let schemas: Vec<TableSchemaWire> = c
                     .all_tables()
@@ -836,7 +831,7 @@ impl Server {
             }
 
             Request::DescribeTable { table } => {
-                log_debug!(pipe, "describe_table table={}", table);
+                log_debug!(request, "describe_table table={}", table);
                 match self.describe_table(&table) {
                     Ok((cols, count, indexes, stats)) => Response::Schema {
                         table,
@@ -846,7 +841,7 @@ impl Server {
                         stats,
                     },
                     Err(e) => {
-                        log_warn!(pipe, "describe_table {}: {}", table, e);
+                        log_warn!(request, "describe_table {}: {}", table, e);
                         Response::Error {
                             message: format!("describe_table {}: {}", table, e),
                         }
@@ -855,7 +850,7 @@ impl Server {
             }
 
             Request::CreateTable { table, columns } => {
-                log_debug!(pipe, "create_table table={} cols={}", table, columns.len());
+                log_debug!(request, "create_table table={} cols={}", table, columns.len());
 
                 {
                     let c = self.catalog.lock().unwrap();
@@ -887,7 +882,7 @@ impl Server {
             }
 
             Request::DropTable { table } => {
-                log_debug!(pipe, "drop_table table={}", table);
+                log_debug!(request, "drop_table table={}", table);
 
                 let dropped_indexes: Vec<String> = {
                     let mut c = self.catalog.lock().unwrap();
@@ -919,11 +914,11 @@ impl Server {
             }
 
             Request::CreateIndex { table, column } => {
-                log_debug!(pipe, "create_index table={} column={}", table, column);
+                log_debug!(request, "create_index table={} column={}", table, column);
                 match self.create_index(&table, &column) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
-                        log_warn!(pipe, "create_index {}({}): {}", table, column, e);
+                        log_warn!(request, "create_index {}({}): {}", table, column, e);
                         Response::Error {
                             message: format!("create_index {}({}): {}", table, column, e),
                         }
@@ -932,11 +927,11 @@ impl Server {
             }
 
             Request::DropIndex { table, column } => {
-                log_debug!(pipe, "drop_index table={} column={}", table, column);
+                log_debug!(request, "drop_index table={} column={}", table, column);
                 match self.drop_index(&table, &column) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
-                        log_warn!(pipe, "drop_index {}({}): {}", table, column, e);
+                        log_warn!(request, "drop_index {}({}): {}", table, column, e);
                         Response::Error {
                             message: format!("drop_index {}({}): {}", table, column, e),
                         }
@@ -945,11 +940,11 @@ impl Server {
             }
 
             Request::DropColumn { table, column } => {
-                log_debug!(pipe, "drop_column table={} column={}", table, column);
+                log_debug!(request, "drop_column table={} column={}", table, column);
                 match self.drop_column(&table, &column) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
-                        log_warn!(pipe, "drop_column {}({}): {}", table, column, e);
+                        log_warn!(request, "drop_column {}({}): {}", table, column, e);
                         Response::Error {
                             message: format!("drop_column {}({}): {}", table, column, e),
                         }
@@ -958,11 +953,11 @@ impl Server {
             }
 
             Request::Compact { table } => {
-                log_debug!(pipe, "compact table={}", table);
+                log_debug!(request, "compact table={}", table);
                 match self.compact_table(&table) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
-                        log_warn!(pipe, "compact {}: {}", table, e);
+                        log_warn!(request, "compact {}: {}", table, e);
                         Response::Error {
                             message: format!("compact {}: {}", table, e),
                         }
@@ -971,13 +966,13 @@ impl Server {
             }
 
             Request::ReplaceSchema { table, columns, rows } => {
-                log_debug!(pipe, "replace_schema table={} cols={}", table, columns.len());
+                log_debug!(request, "replace_schema table={} cols={}", table, columns.len());
                 let tname = table.clone();
                 let op = WalOp::ReplaceSchema { table, columns, rows };
                 match self.write_via_wal(&op) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
-                        log_warn!(pipe, "replace_schema {}: {}", tname, e);
+                        log_warn!(request, "replace_schema {}: {}", tname, e);
                         Response::Error {
                             message: format!("replace_schema {}: {}", tname, e),
                         }
@@ -1015,6 +1010,7 @@ impl Server {
     }
 }
 
+/// 账号列表转成行
 fn account_rows(accounts: &[Account]) -> std::io::Result<Vec<Row>> {
     accounts.iter().map(|a| Ok(HashMap::from([
         ("id".into(), serde_json::json!(a.id)),
@@ -1029,7 +1025,7 @@ fn account_rows(accounts: &[Account]) -> std::io::Result<Vec<Row>> {
     ]))).collect()
 }
 
-/// 系统表：列定义与索引都按 scripts/init.sql 写进数据字典
+/// 按 init.sql 把系统表写进字典
 fn declare_system_schema(catalog: &mut Catalog, rows: &[Row]) -> std::io::Result<()> {
     for table in system_schema() {
         let stats: &[Row] = if table.name == USERS_TABLE { rows } else { &[] };
@@ -1044,7 +1040,7 @@ fn declare_system_schema(catalog: &mut Catalog, rows: &[Row]) -> std::io::Result
     Ok(())
 }
 
-/// 读一行账号：新格式是平铺的列，老格式是 {id, account:"<json>"}
+/// 读一行账号（兼容老格式）
 fn decode_account_row(row: &Row) -> std::io::Result<Account> {
     if let Some(encoded) = row.get("account").and_then(serde_json::Value::as_str) {
         return serde_json::from_str(encoded).map_err(|_| std::io::Error::other("invalid account record"));
@@ -1081,7 +1077,7 @@ fn now_stamp() -> String {
     format_timestamp(seconds)
 }
 
-/// Unix 秒 → YYYY-MM-DD HH:MM:SS（UTC）
+/// Unix 秒转时间戳文本
 fn format_timestamp(seconds: i64) -> String {
     let days = seconds.div_euclid(86_400);
     let rest = seconds.rem_euclid(86_400);
@@ -1106,6 +1102,7 @@ fn civil_from_days(days: i64) -> (i64, u32, u32) {
     (if month <= 2 { year + 1 } else { year }, month, day)
 }
 
+/// 规范化并校验账号名
 fn account_name(user: &str) -> std::io::Result<String> {
     if user.is_empty() || user.len() > 64 || !user.bytes().all(|c| c.is_ascii_alphanumeric() || b"_.-".contains(&c)) {
         return Err(std::io::Error::other("invalid account name"));
@@ -1113,6 +1110,7 @@ fn account_name(user: &str) -> std::io::Result<String> {
     Ok(user.to_ascii_lowercase())
 }
 
+/// 校验口令哈希长度
 fn validate_account_hash(hash: &str) -> std::io::Result<()> {
     if hash.is_empty() || hash.len() > 256 {
         return Err(std::io::Error::other("invalid account credential"));
@@ -1120,6 +1118,7 @@ fn validate_account_hash(hash: &str) -> std::io::Result<()> {
     Ok(())
 }
 
+/// 造一条新账号记录
 fn new_account(id: i64, user: &str, password_hash: String) -> std::io::Result<Account> {
     validate_account_hash(&password_hash)?;
     Ok(Account {
@@ -1133,7 +1132,7 @@ fn new_account(id: i64, user: &str, password_hash: String) -> std::io::Result<Ac
 }
 
 /// 一张表的索引定义转线上格式
-fn index_wires(schema: &chusql_storage::catalog::TableSchema) -> Vec<IndexWire> {
+fn index_wires(schema: &crate::catalog::TableSchema) -> Vec<IndexWire> {
     let mut out = vec![IndexWire {
         column: "id".to_string(),
     }];
@@ -1148,7 +1147,7 @@ fn index_wires(schema: &chusql_storage::catalog::TableSchema) -> Vec<IndexWire>
 }
 
 /// 一张表的列统计 -> 线上格式
-fn stat_wires(schema: &chusql_storage::catalog::TableSchema) -> Vec<ColumnStatWire> {
+fn stat_wires(schema: &crate::catalog::TableSchema) -> Vec<ColumnStatWire> {
     schema
         .stats
         .iter()
@@ -1161,6 +1160,7 @@ fn stat_wires(schema: &chusql_storage::catalog::TableSchema) -> Vec<ColumnStatWi
 }
 
 impl Drop for Server {
+    /// 析构时保存数据字典
     fn drop(&mut self) {
         if let Ok(c) = self.catalog.lock() {
             let _ = c.save(self.catalog_path());
@@ -1194,6 +1194,7 @@ struct Databases {
 }
 
 impl Databases {
+    /// 装载系统库与已有的具名库
     fn new(cfg: Config) -> std::io::Result<Self> {
         // 系统库按需创建：目录、字典与系统表缺失时自动补齐。
         // 其余库只在 data/databases/<name>/ 下已存在时才装载，启动不会凭空建库。
@@ -1226,7 +1227,7 @@ impl Databases {
         Ok(Self { root: cfg, system, named: Mutex::new(named) })
     }
 
-    /// 在 data_dir/<name>/ 下开一个保留库（目录与字典、WAL 一起建起来）
+    /// 按名字打开或新建一个库
     fn open(cfg: &Config, name: &str) -> std::io::Result<Server> {
         let mut config = cfg.clone();
         config.data_dir = cfg.data_dir.join(name);
@@ -1241,6 +1242,7 @@ impl Databases {
         Ok(server)
     }
 
+    /// 库级分发：先处理库管理，再转给选中的库
     fn request(&self, mut value: serde_json::Value) -> std::io::Result<Response> {
         use std::io::Error;
         let method = value.get("method").and_then(|v| v.as_str()).unwrap_or("").to_string();
@@ -1329,6 +1331,7 @@ impl Databases {
     }
 }
 
+/// 校验库名是否合法
 fn valid_database(name: &str) -> bool {
     let lower = name.to_ascii_lowercase();
     let device = matches!(lower.as_str(), "con" | "prn" | "aux" | "nul")
@@ -1339,37 +1342,6 @@ fn valid_database(name: &str) -> bool {
         && name.as_bytes().first().is_some_and(|c| c.is_ascii_alphabetic() || *c == b'_')
 }
 
-/// 处理一条连接
-fn handle(server: &Databases, conn: LocalSocketStream) -> std::io::Result<()> {
-    let mut writer = conn.try_clone()?;
-    let reader = BufReader::new(conn);
-
-    for line in reader.lines() {
-        let line = line?;
-        if line.trim().is_empty() {
-            continue;
-        }
-
-        let resp = match serde_json::from_str::<serde_json::Value>(&line) {
-            Ok(req) => match server.request(req) {
-                Ok(response) => response,
-                Err(e) => Response::Error { message: e.to_string() },
-            },
-            Err(e) => {
-                log_warn!(pipe, "bad request line: {}", e);
-                Response::Error {
-                    message: format!("parse error: {}", e),
-                }
-            }
-        };
-
-        writeln!(writer, "{}", serde_json::to_string(&resp).unwrap())?;
-        writer.flush()?;
-    }
-    log_debug!(pipe, "connection closed");
-    Ok(())
-}
-
 /// 把配置来源打进日志
 fn log_config(loaded: &Loaded) {
     match &loaded.config_path {
@@ -1381,92 +1353,44 @@ fn log_config(loaded: &Loaded) {
     }
 }
 
-/// 命令行用法
+/// 进程内存储句柄：一个数据目录一份状态，跨线程共享（内部各自加锁）。
-fn print_usage() {
+pub struct Storage {
-    println!("chusql-storage: ChuSQL 存储服务");
+    databases: Databases,
-    println!();
-    println!("用法: chusql-storage [--config <path>]");
-    println!();
-    println!("配置文件固定位置（安装时确定，按系统惯例）:");
-    println!("  {}", config::default_config_path().display());
-    println!("该文件存在才读，不存在就用内置默认值（不是错误）。");
-    println!("--config <path> 是唯一的显式覆盖手段；文件不存在或读不了会报错退出。");
-    println!("配置分区: [page] [btree] [buffer] [storage] [server] [log]");
-    println!("--help, -h 显示本帮助。");
 }
 
-/// 解析命令行：只认 --config <path> / --config=<path> / --help / -h
+impl Storage {
-fn parse_args(args: &[String]) -> Result<Option<String>, String> {
+    /// 打开数据目录并初始化存储
-    let mut explicit = None;
+    pub fn open(config_path: Option<&str>) -> Result<Storage, String> {
-    let mut i = 0;
+        let loaded = config::load(config_path)?;
-    while i < args.len() {
-        let arg = args[i].as_str();
-        if arg == "--config" {
-            let value = args.get(i + 1).ok_or("--config needs a path")?;
-            if value.trim().is_empty() {
-                return Err("--config needs a path".to_string());
-            }
-            explicit = Some(value.clone());
-            i += 2;
-        } else if let Some(value) = arg.strip_prefix("--config=") {
-            if value.trim().is_empty() {
-                return Err("--config needs a path".to_string());
-            }
-            explicit = Some(value.to_string());
-            i += 1;
-        } else if arg == "--help" || arg == "-h" {
-            print_usage();
-            std::process::exit(0);
-        } else {
-            return Err(format!("unknown argument: {}", arg));
-        }
-    }
-    Ok(explicit)
-}
-
-/// 进程入口
-fn main() -> std::io::Result<()> {
-    let args: Vec<String> = std::env::args().skip(1).collect();
-    let explicit = match parse_args(&args) {
-        Ok(p) => p,
-        Err(e) => {
-            eprintln!("chusql-storage: {}", e);
-            eprintln!("用法: chusql-storage [--config <path>]，--help 看帮助");
-            std::process::exit(2);
-        }
-    };
-    let loaded = match config::load(explicit.as_deref()) {
-        Ok(l) => l,
-        Err(e) => {
-            log_error!(core, "config error: {}", e);
-            return Err(std::io::Error::new(std::io::ErrorKind::InvalidInput, e));
-        }
-    };
         log::init();
         log::set_level(loaded.config.log_level);
-
+        log_info!(core, "chusql-core-storage {} starting", env!("CARGO_PKG_VERSION"));
-    log_info!(core, "chusql-storage {} starting", env!("CARGO_PKG_VERSION"));
         log_config(&loaded);
-
+        let databases = Databases::new(loaded.config).map_err(|e| e.to_string())?;
-    let server = Arc::new(Databases::new(loaded.config)?);
+        Ok(Storage { databases })
-
-    let listener = endpoint::listen(&server.root.pipe_name)?;
-
-    log_info!(
-        core,
-        "listening on {}",
-        endpoint::display(&server.root.pipe_name)
-    );
-
-    for conn in listener.incoming() {
-        let conn = conn?;
-        let server = Arc::clone(&server);
-        thread::spawn(move || {
-            log_debug!(pipe, "connection accepted");
-            if let Err(e) = handle(&server, conn) {
-                log_error!(pipe, "connection error: {}", e);
     }
-        });
+
+    /// 一行请求 JSON 换一行响应 JSON
+    pub fn request_line(&self, line: &str) -> String {
+        let response = match serde_json::from_str::<serde_json::Value>(line) {
+            Ok(value) => match self.databases.request(value) {
+                Ok(response) => response,
+                Err(e) => Response::Error { message: e.to_string() },
+            },
+            Err(e) => {
+                log_warn!(core, "bad request line: {}", e);
+                Response::Error {
+                    message: format!("parse error: {}", e),
                 }
-    Ok(())
             }
+        };
+        match serde_json::to_string(&response) {
+            Ok(text) => text,
+            Err(e) => {
+                log_error!(core, "response encode failed: {}", e);
+                "{\"status\":\"error\",\"message\":\"response encode failed\"}".to_string()
+            }
+        }
+    }
+}
+

chusql-core/storage/tests/btree_test.rs

@@ -1,9 +1,10 @@
-use chusql_storage::btree::{fits_in_page, DiskBTree, MAX_KEY_BYTES};
+use chusql_core_storage::btree::{fits_in_page, DiskBTree, MAX_KEY_BYTES};
-use chusql_storage::config::{DEFAULT_BTREE_ORDER, DEFAULT_PAGE_SIZE};
+use chusql_core_storage::config::{DEFAULT_BTREE_ORDER, DEFAULT_PAGE_SIZE};
-use chusql_storage::page::DEFAULT_POOL_SIZE;
+use chusql_core_storage::page::DEFAULT_POOL_SIZE;
 
 // B+ 树测试：字节键、重复键、范围扫描、重开与配置校验。
 
+/// 按默认参数打开指定索引文件
 fn open(dir: &std::path::Path, name: &str) -> DiskBTree {
     DiskBTree::open(dir.join(name), DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap()
 }

chusql-core/storage/tests/catalog_test.rs

@@ -1,11 +1,12 @@
-use chusql_storage::catalog::Catalog;
+use chusql_core_storage::catalog::Catalog;
-use chusql_storage::protocol::Row;
+use chusql_core_storage::protocol::Row;
 use serde_json::json;
 
 // 数据字典测试：补列、去重、未知表。
 
 
 
+/// 用键值对构造一行
 fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
     let mut m = Row::new();
     for (k, v) in pairs {
@@ -85,7 +86,7 @@ fn remove_column_drops_definition_stats_and_index() {
 /// 老类型名并到新写法，参数保留，未知类型原样
 #[test]
 fn normalize_type_maps_legacy_names() {
-    use chusql_storage::catalog::normalize_type;
+    use chusql_core_storage::catalog::normalize_type;
     assert_eq!(normalize_type("integer"), "int");
     assert_eq!(normalize_type("TEXT"), "str");
     assert_eq!(normalize_type("BOOLEAN"), "bool");

chusql-core/storage/tests/config_test.rs

@@ -1,10 +1,8 @@
 use std::path::PathBuf;
 use std::sync::Mutex;
 
-use chusql_storage::config::{
+use chusql_core_storage::config::{self, Config, DEFAULT_BTREE_ORDER, DEFAULT_PAGE_SIZE, Origin};
-    self, Config, DEFAULT_BTREE_ORDER, DEFAULT_PAGE_SIZE, DEFAULT_PIPE_NAME, Origin,
+use chusql_core_storage::log::Level;
-};
-use chusql_storage::log::Level;
 
 // 配置测试：默认值、文件覆盖、环境变量彻底无效、非法值报错。
 
@@ -27,7 +25,6 @@ fn defaults_without_file() {
     assert_eq!(loaded.config.page_size, DEFAULT_PAGE_SIZE);
     assert_eq!(loaded.config.btree_order, DEFAULT_BTREE_ORDER);
     assert_eq!(loaded.config.data_dir, config::default_data_dir());
-    assert_eq!(loaded.config.pipe_name, DEFAULT_PIPE_NAME);
     assert_eq!(loaded.config.log_level, Level::Info);
 }
 
@@ -50,11 +47,11 @@ fn file_overrides_only_written_keys() {
     assert_eq!(order.2, Origin::Default);
 }
 
-/// 六项全写都生效
+/// 五项全写都生效
 #[test]
 fn file_all_keys() {
     let _guard = env_guard();
-    let text = "[page]\nsize = 8192\n[btree]\norder = 32\n[buffer]\npool_size = 128\n[storage]\ndata_dir = \"mydata\"\n[server]\npipe_name = \"mypipe\"\n[log]\nlevel = \"debug\"\n";
+    let text = "[page]\nsize = 8192\n[btree]\norder = 32\n[buffer]\npool_size = 128\n[storage]\ndata_dir = \"mydata\"\n[log]\nlevel = \"debug\"\n";
     let path = PathBuf::from("t.toml");
     let loaded = config::resolve(Some(text), Some(path.clone())).unwrap();
 
@@ -62,7 +59,6 @@ fn file_all_keys() {
     assert_eq!(loaded.config.btree_order, 32);
     assert_eq!(loaded.config.pool_size, 128);
     assert_eq!(loaded.config.data_dir, PathBuf::from("mydata"));
-    assert_eq!(loaded.config.pipe_name, "mypipe");
     assert_eq!(loaded.config.log_level, Level::Debug);
     assert!(
         loaded
@@ -72,7 +68,7 @@ fn file_all_keys() {
     );
 }
 
-/// 环境变量完全无效：这条通道已经删掉，设了 CHUSQL_* 也只认文件/内置默认
+/// 设了 CHUSQL_* 环境变量也不生效
 #[test]
 fn env_vars_are_ignored_entirely() {
     let _guard = env_guard();
@@ -102,7 +98,7 @@ fn env_vars_are_ignored_entirely() {
     }
 }
 
-/// 固定路径按系统惯例：<配置目录>/ChuSQL/chusql.toml
+/// 固定配置路径在系统配置目录的 ChuSQL 下
 #[test]
 fn default_config_path_follows_system_convention() {
     let _guard = env_guard();
@@ -121,7 +117,7 @@ fn default_config_path_follows_system_convention() {
     }
 }
 
-/// 默认数据目录也按系统惯例：Windows 落 %LOCALAPPDATA%\ChuSQL\data，Unix 落 XDG 数据目录
+/// 默认数据目录落地按系统惯例
 #[test]
 fn default_data_dir_follows_system_convention() {
     let _guard = env_guard();
@@ -170,7 +166,7 @@ fn explicit_missing_path_is_an_error() {
     assert!(err.contains("chusql-no-such-config-9f21.toml"), "got {}", err);
 }
 
-/// 不给 --config：固定路径没有文件时全用内置默认，且不报错
+/// 不给 --config 且无配置文件时用内置默认
 #[test]
 fn load_without_explicit_path_uses_builtin_defaults() {
     let _guard = env_guard();
@@ -181,12 +177,23 @@ fn load_without_explicit_path_uses_builtin_defaults() {
     } else {
         assert_eq!(loaded.config, Config::default());
         assert_eq!(loaded.config.data_dir, config::default_data_dir());
-        assert_eq!(loaded.config.pipe_name, DEFAULT_PIPE_NAME);
         assert!(loaded.origins.iter().all(|(_, _, o)| *o == Origin::Default));
         assert!(loaded.config_path.is_none());
     }
 }
 
+/// [server] 分区归别的层管；本层拼写错误要报错
+#[test]
+fn server_section_belongs_to_another_layer() {
+    let _guard = env_guard();
+    let db_server = "[server]\nhost = \"0.0.0.0\"\nport = 7778\nmax_rows = 10\n";
+    let loaded = config::resolve(Some(db_server), None).unwrap();
+    assert_eq!(loaded.config.data_dir, config::default_data_dir());
+
+    let typo = "[storage]\ndata_dirs = \"oops\"\n";
+    assert!(config::resolve(Some(typo), None).is_err());
+}
+
 /// 日志等级非法要报错
 #[test]
 fn rejects_bad_log_level() {

chusql-core/storage/tests/heap_test.rs

@@ -1,11 +1,12 @@
-use chusql_storage::config::DEFAULT_PAGE_SIZE;
+use chusql_core_storage::config::DEFAULT_PAGE_SIZE;
-use chusql_storage::heap::HeapTable;
+use chusql_core_storage::heap::HeapTable;
-use chusql_storage::page::DEFAULT_POOL_SIZE;
+use chusql_core_storage::page::DEFAULT_POOL_SIZE;
-use chusql_storage::protocol::Row;
+use chusql_core_storage::protocol::Row;
 use serde_json::json;
 
 // 堆表测试：插查、跨页、大行、重开、索引重建。
 
+/// 用键值对构造一行
 fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
     let mut m = Row::new();
     for (k, v) in pairs {
@@ -144,7 +145,7 @@ fn replace_all_rebuilds_index() {
         dir.path().join("t.db"),
         dir.path().join("t.idx"),
         DEFAULT_PAGE_SIZE,
-        chusql_storage::config::DEFAULT_BTREE_ORDER,
+        chusql_core_storage::config::DEFAULT_BTREE_ORDER,
         DEFAULT_POOL_SIZE,
     )
     .unwrap();
@@ -176,7 +177,7 @@ fn delete_by_keys_removes_rows() {
         dir.path().join("t.db"),
         dir.path().join("t.idx"),
         DEFAULT_PAGE_SIZE,
-        chusql_storage::config::DEFAULT_BTREE_ORDER,
+        chusql_core_storage::config::DEFAULT_BTREE_ORDER,
         DEFAULT_POOL_SIZE,
     )
     .unwrap();
@@ -214,7 +215,7 @@ fn insert_rows_batch() {
         dir.path().join("t.db"),
         dir.path().join("t.idx"),
         DEFAULT_PAGE_SIZE,
-        chusql_storage::config::DEFAULT_BTREE_ORDER,
+        chusql_core_storage::config::DEFAULT_BTREE_ORDER,
         DEFAULT_POOL_SIZE,
     )
     .unwrap();
@@ -234,7 +235,7 @@ fn insert_rows_batch() {
     assert!(t.insert_rows(&dup).is_err());
 }
 
-/// 第二列索引：建索引时要求唯一，建完之后插入/删除都跟着维护
+/// 第二列索引：建完插入/删除都跟着维护，值可重复
 #[test]
 fn secondary_index_is_maintained() {
     let dir = tempfile::tempdir().unwrap();
@@ -242,7 +243,7 @@ fn secondary_index_is_maintained() {
         dir.path().join("t.db"),
         dir.path().join("t.idx"),
         DEFAULT_PAGE_SIZE,
-        chusql_storage::config::DEFAULT_BTREE_ORDER,
+        chusql_core_storage::config::DEFAULT_BTREE_ORDER,
         DEFAULT_POOL_SIZE,
     )
     .unwrap();
@@ -258,7 +259,7 @@ fn secondary_index_is_maintained() {
         "code",
         &dir.path().join("t.code.idx"),
         DEFAULT_PAGE_SIZE,
-        chusql_storage::config::DEFAULT_BTREE_ORDER,
+        chusql_core_storage::config::DEFAULT_BTREE_ORDER,
         DEFAULT_POOL_SIZE,
     )
     .unwrap();
@@ -292,7 +293,7 @@ fn secondary_index_is_maintained() {
         "age",
         &dir.path().join("d.age.idx"),
         DEFAULT_PAGE_SIZE,
-        chusql_storage::config::DEFAULT_BTREE_ORDER,
+        chusql_core_storage::config::DEFAULT_BTREE_ORDER,
         DEFAULT_POOL_SIZE,
     )
     .unwrap();

chusql-core/storage/tests/page_test.rs

@@ -1,5 +1,5 @@
-use chusql_storage::config::DEFAULT_PAGE_SIZE;
+use chusql_core_storage::config::DEFAULT_PAGE_SIZE;
-use chusql_storage::page::{Page, PageFile};
+use chusql_core_storage::page::{Page, PageFile};
 
 // 页文件测试：读写、追加、覆写、页大小校验与页缓存。
 

chusql-core/storage/tests/runtime_test.rs

@@ -1,18 +1,23 @@
-use std::io::{BufRead, BufReader, Write};
+use std::cell::RefCell;
-use std::process::{Child, Command, Stdio};
+use std::sync::Arc;
-use std::thread;
-use std::time::Duration;
 
-use interprocess::local_socket::prelude::*;
+use chusql_core_storage::runtime::Storage;
-use interprocess::TryClone;
 
-// 端点集成测试：起真 server，跑协议、索引与配置（端点由 endpoint 模块统一算）。
+// 进程内存储集成测试：协议请求、索引、账号与配置。
 
+thread_local! {
+    /// 当前线程的存储实例：一个用例一个线程，用例内部按顺序起/停
+    static CURRENT: RefCell<Option<Arc<Storage>>> = const { RefCell::new(None) };
+}
+
+/// 一次会话就是当前线程的存储句柄
+struct Conn(Arc<Storage>);
+
+/// 扫描能按列投影，空列返回空行
 #[test]
 fn scan_projects_columns_and_preserves_empty_rows() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     request_ok(&mut c, serde_json::json!({"method":"create_table","table":"items","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?;
     request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"items","rows":[{"id":1,"name":"one"},{"id":2,"name":null}]}))?;
     for (columns, expected) in [
@@ -27,11 +32,11 @@ fn scan_projects_columns_and_preserves_empty_rows() -> Result<(), Box<dyn std::e
     Ok(())
 }
 
+/// 删列不改堆字节，重启后不再暴露该列
 #[test]
 fn drop_column_keeps_heap_bytes_and_hides_values_after_restart() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (server, data) = start_server();
-    let (server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     request_ok(&mut c, serde_json::json!({"method":"create_table","table":"items","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"},{"name":"age","ty":"int"}]}))?;
     request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"items","rows":[{"id":1,"name":"old","age":20},{"id":2,"name":"secret","age":30}]}))?;
     for column in ["name", "age"] {
@@ -43,8 +48,8 @@ fn drop_column_keeps_heap_bytes_and_hides_values_after_restart() -> Result<(), B
     assert_eq!(std::fs::read(&heap)?, before, "DROP COLUMN must not rewrite heap pages");
     drop(c);
     drop(server);
-    let _server = start_server_in(&pipe, data.path());
+    let _server = start_server_in(data.path());
-    let mut c = connect(&pipe)?;
+    let mut c = connect()?;
     for request in [
         serde_json::json!({"method":"scan","table":"items"}),
         serde_json::json!({"method":"range_by_index","table":"items","column":"age","lo":0}),
@@ -64,12 +69,12 @@ fn drop_column_keeps_heap_bytes_and_hides_values_after_restart() -> Result<(), B
     Ok(())
 }
 
+/// 各库字典与行互相隔离，删库不影响别库
 #[test]
 fn databases_isolate_catalog_and_rows() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (_srv, data) = start_server();
-    let (_srv, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
+    let request = |c: &mut Conn, value: serde_json::Value| -> Result<serde_json::Value, serde_json::Error> {
-    let request = |c: &mut LocalSocketStream, value: serde_json::Value| -> Result<serde_json::Value, serde_json::Error> {
         serde_json::from_str(&send(c, &value.to_string()))
     };
     for database in ["alpha", "beta"] {
@@ -90,12 +95,12 @@ fn databases_isolate_catalog_and_rows() -> Result<(), Box<dyn std::error::Error>
 }
 
 
+/// 隐藏列的 WAL 重放两次幂等，且不动堆文件
 #[test]
 fn hidden_column_wal_replays_twice_without_touching_heap() -> Result<(), Box<dyn std::error::Error>> {
-    use chusql_storage::wal::{Wal, WalOp};
+    use chusql_core_storage::wal::{Wal, WalOp};
-    let pipe = unique_pipe_name();
+    let (server, data) = start_server();
-    let (server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     request_ok(&mut c, serde_json::json!({"method":"insert","table":"items","row":{"id":1,"secret":"old"}}))?;
     drop(c);
     drop(server);
@@ -109,8 +114,8 @@ fn hidden_column_wal_replays_twice_without_touching_heap() -> Result<(), Box<dyn
         assert_eq!(wal.read()?, Some(op));
         assert!(std::fs::metadata(wal.path())?.len() < 100);
         drop(wal);
-        let server = start_server_in(&pipe, data.path());
+        let server = start_server_in(data.path());
-        let mut c = connect(&pipe)?;
+        let mut c = connect()?;
         let result: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"items"}"#))?;
         assert_eq!(result["rows"], serde_json::json!([{"id":1}]));
         let after = std::fs::read(&heap)?;
@@ -129,11 +134,11 @@ fn hidden_column_wal_replays_twice_without_touching_heap() -> Result<(), Box<dyn
     Ok(())
 }
 
+/// 删列失败时保留 WAL，重启后补做并放行
 #[test]
 fn hidden_column_failure_preserves_wal_until_recovery() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (server, data) = start_server();
-    let (server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     request_ok(&mut c, serde_json::json!({"method":"insert","table":"items","row":{"id":1,"secret":"old"}}))?;
     let index = data.path().join("databases/main/items.secret.idx");
     std::fs::create_dir(&index)?;
@@ -146,18 +151,18 @@ fn hidden_column_failure_preserves_wal_until_recovery() -> Result<(), Box<dyn st
     drop(c);
     drop(server);
     std::fs::remove_dir(index)?;
-    let _server = start_server_in(&pipe, data.path());
+    let _server = start_server_in(data.path());
-    let mut c = connect(&pipe)?;
+    let mut c = connect()?;
     let rows: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"items"}"#))?;
     assert_eq!(rows["rows"], serde_json::json!([{"id":1}]));
     Ok(())
 }
 
+/// 删带索引的列会连索引文件一起删掉
 #[test]
 fn drop_column_with_a_live_index_removes_the_index_file() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (_srv, data) = start_server();
-    let (_srv, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     request_ok(&mut c, serde_json::json!({"method":"insert","table":"items","row":{"id":1,"code":7}}))?;
     request_ok(&mut c, serde_json::json!({"method":"create_index","table":"items","column":"code"}))?;
     let index = data.path().join("databases/main/items.code.idx");
@@ -176,11 +181,11 @@ fn drop_column_with_a_live_index_removes_the_index_file() -> Result<(), Box<dyn
     Ok(())
 }
 
+/// 整理表会重写页面，清掉隐藏列字节
 #[test]
 fn compact_reclaims_hidden_column_bytes() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (server, data) = start_server();
-    let (server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     for id in 1..=3 {
         request_ok(&mut c, serde_json::json!({"method":"insert","table":"items","row":{"id":id,"secret":"padding","note":"n"}}))?;
     }
@@ -200,18 +205,18 @@ fn compact_reclaims_hidden_column_bytes() -> Result<(), Box<dyn std::error::Erro
     request_ok(&mut c, serde_json::json!({"method":"insert","table":"items","row":{"id":4,"note":"x"}}))?;
     drop(c);
     drop(server);
-    let _server = start_server_in(&pipe, data.path());
+    let _server = start_server_in(data.path());
-    let mut c = connect(&pipe)?;
+    let mut c = connect()?;
     let rows: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"items"}"#))?;
     assert_eq!(rows["rows"].as_array().map(Vec::len), Some(4), "rows survive compaction: {}", rows);
     Ok(())
 }
 
+/// 启动时自动整理带隐藏列的表
 #[test]
 fn startup_compaction_reclaims_dropped_columns() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (server, data) = start_server();
-    let (server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     request_ok(&mut c, serde_json::json!({"method":"insert","table":"items","row":{"id":1,"secret":"padding"}}))?;
     request_ok(&mut c, serde_json::json!({"method":"drop_column","table":"items","column":"secret"}))?;
     let heap = data.path().join("databases/main/items.db");
@@ -219,8 +224,8 @@ fn startup_compaction_reclaims_dropped_columns() -> Result<(), Box<dyn std::erro
     drop(c);
     drop(server);
 
-    let _server = start_server_in(&pipe, data.path());
+    let _server = start_server_in(data.path());
-    let mut c = connect(&pipe)?;
+    let mut c = connect()?;
     assert!(
         !std::fs::read(&heap)?.windows(6).any(|w| w == &b"secret"[..]),
         "startup must compact tables that still carry hidden columns"
@@ -230,11 +235,11 @@ fn startup_compaction_reclaims_dropped_columns() -> Result<(), Box<dyn std::erro
     Ok(())
 }
 
+/// 非法库名被拒；system 是唯一保留库
 #[test]
 fn databases_reject_unsafe_names_and_keep_only_system_reserved() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (_srv, data) = start_server();
-    let (_srv, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     for database in ["", "../escape", "a/b", "a.b", "CON", "__chusql_users"] {
         let response: serde_json::Value = serde_json::from_str(&send(&mut c, &serde_json::json!({"method":"create_database","database":database}).to_string()))?;
         assert_eq!(response["status"], "error", "{database}: {response}");
@@ -255,11 +260,11 @@ fn databases_reject_unsafe_names_and_keep_only_system_reserved() -> Result<(), B
     Ok(())
 }
 
+/// 账号只存在 system 库，默认工作库不存在
 #[test]
 fn system_database_owns_accounts_and_nothing_is_default() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (_srv, data) = start_server();
-    let (_srv, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     // 启动只建 system，另一个是测试自己建的 main
     let listed: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"list_databases"}"#))?;
     assert_eq!(listed["tables"], serde_json::json!(["main", "system"]));
@@ -278,12 +283,11 @@ fn system_database_owns_accounts_and_nothing_is_default() -> Result<(), Box<dyn
     Ok(())
 }
 
-/// 没选库的裸表名请求会被拒；限定名（db.table）不用选库
+/// 裸表名没选库会被拒；限定名不用选库
 #[test]
 fn unqualified_requests_need_a_selected_database() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     let response: serde_json::Value = serde_json::from_str(&send_raw(&mut c, r#"{"method":"scan","table":"items"}"#))?;
     assert_eq!(response["status"], "error", "{response}");
     assert!(response["message"].as_str().unwrap_or("").contains("no database selected"), "{response}");
@@ -298,85 +302,59 @@ fn unqualified_requests_need_a_selected_database() -> Result<(), Box<dyn std::er
 }
 
 /// 发一条请求并断言状态是 ok
-fn request_ok(c: &mut LocalSocketStream, value: serde_json::Value) -> Result<(), Box<dyn std::error::Error>> {
+fn request_ok(c: &mut Conn, value: serde_json::Value) -> Result<(), Box<dyn std::error::Error>> {
     let response: serde_json::Value = serde_json::from_str(&send(c, &value.to_string()))?;
     assert_eq!(response["status"], "ok", "{value}: {response}");
     Ok(())
 }
 
-/// 唯一管道名，避免测试互抢
+/// 一次存储实例的持有者
-fn unique_pipe_name() -> String {
+struct ServerProc;
-    let id = std::process::id();
-    let ns = std::time::SystemTime::now()
-        .duration_since(std::time::UNIX_EPOCH)
-        .unwrap()
-        .as_nanos();
-    format!("chusql-test-{}-{}", id, ns)
-}
-
-struct ServerProc(Child);
 
 impl Drop for ServerProc {
-    /// 测试结束杀掉子进程
+    /// 实例由本线程 CURRENT 管，这里不用清理
-    fn drop(&mut self) {
+    fn drop(&mut self) {}
-        let _ = self.0.kill();
-        let _ = self.0.wait();
-    }
 }
 
-/// 起 server，等管道可连
+/// 起存储，返回句柄与数据目录
-fn start_server(pipe: &str) -> (ServerProc, tempfile::TempDir) {
+fn start_server() -> (ServerProc, tempfile::TempDir) {
     let data = tempfile::tempdir().unwrap();
-    let server = start_server_in(pipe, data.path());
+    let server = start_server_in(data.path());
     (server, data)
 }
 
-fn start_server_in(pipe: &str, data: &std::path::Path) -> ServerProc {
+/// 在指定数据目录起存储并建测试库
-    let config = write_config(data, pipe);
+fn start_server_in(data: &std::path::Path) -> ServerProc {
-    let child = Command::new(env!("CARGO_BIN_EXE_chusql-storage"))
+    open_storage(&write_config(data));
-        .arg("--config")
+    create_fixture_database();
-        .arg(&config)
+    ServerProc
-        .stdout(Stdio::null())
-        .stderr(Stdio::null())
-        .spawn()
-        .expect("failed to spawn server");
-
-    let srv = ServerProc(child);
-
-    for _ in 0..100 {
-        if connect(pipe).is_ok() {
-            // 服务启动只建 system 库，测试库在这里显式建
-            create_fixture_database(pipe);
-            return srv;
-        }
-        thread::sleep(Duration::from_millis(50));
-    }
-    panic!("server did not start within 5s");
 }
 
-/// 写一份配置给子进程：管名与数据目录都走 TOML，
+/// 按配置文件打开存储，替换本线程上一个实例
-/// 路径用单引号字面量串，免得 Windows 反斜杠要转义。
+fn open_storage(config: &std::path::Path) {
-fn write_config(data: &std::path::Path, pipe: &str) -> std::path::PathBuf {
+    CURRENT.with(|slot| *slot.borrow_mut() = None);
+    let storage = Arc::new(Storage::open(Some(config.to_str().unwrap())).expect("open storage"));
+    CURRENT.with(|slot| *slot.borrow_mut() = Some(storage));
+}
+
+/// 生成只写数据目录的临时配置文件
+fn write_config(data: &std::path::Path) -> std::path::PathBuf {
     let id = std::process::id();
     let ns = std::time::SystemTime::now()
         .duration_since(std::time::UNIX_EPOCH)
         .unwrap()
         .as_nanos();
     let path = data.join(format!("chusql-{}-{}.toml", id, ns));
-    let text = format!(
+    let text = format!("[storage]\ndata_dir = '{}'\n", data.display());
-        "[server]\npipe_name = '{}'\n[storage]\ndata_dir = '{}'\n",
-        pipe,
-        data.display()
-    );
     std::fs::write(&path, text).unwrap();
     path
 }
 
+/// 命名库重启后仍在，账号仍是全局的
 #[test]
 fn named_database_survives_restart_and_accounts_stay_global() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (server, data) = start_server();
-    let (server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     for request in [
         serde_json::json!({"method":"create_database","database":"sales"}),
         serde_json::json!({"method":"create_table","database":"sales","table":"items","columns":[{"name":"id","ty":"int"}]}),
@@ -387,8 +365,8 @@ fn named_database_survives_restart_and_accounts_stay_global() -> Result<(), Box<
     }
     drop(c);
     drop(server);
-    let _restarted = start_server_in(&pipe, data.path());
+    let _restarted = start_server_in(data.path());
-    let mut c = connect(&pipe)?;
+    let mut c = connect()?;
     let rows: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"sales.items"}"#))?;
     assert_eq!(rows["rows"], serde_json::json!([{"id":7}]));
     let accounts: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"accounts_list","database":"sales"}"#))?;
@@ -398,16 +376,17 @@ fn named_database_survives_restart_and_accounts_stay_global() -> Result<(), Box<
     Ok(())
 }
 
-/// 连到指定端点的存储进程。端点规则与 server 侧共用 endpoint 模块，
+/// 连到本线程当前的存储：进程内实现就是本线程当前句柄
-/// 所以 Windows 的具名管道与 Unix 的套接字文件都由同一处决定。
+fn connect() -> std::io::Result<Conn> {
-fn connect(pipe: &str) -> std::io::Result<LocalSocketStream> {
+    CURRENT.with(|slot| slot.borrow().clone())
-    chusql_storage::endpoint::connect(pipe)
+        .map(Conn)
+        .ok_or_else(|| std::io::Error::other("storage not started"))
 }
 
-/// 测试自己的库名：服务启动只建 system 库，测试显式建这一个
+/// 测试用的库名：system 之外的库由测试自建
 const FIXTURE_DATABASE: &str = "main";
 
-/// 请求里没写库名就补上测试库：服务不再自带默认库，裸表名必须先选库
+/// 请求没写库名时补上测试库
 fn with_default_database(line: &str) -> String {
     match serde_json::from_str::<serde_json::Value>(line) {
         Ok(serde_json::Value::Object(mut object)) => {
@@ -419,36 +398,28 @@ fn with_default_database(line: &str) -> String {
 }
 
 /// 连通后显式建测试库；重启时库已存在，报错忽略
-fn create_fixture_database(pipe: &str) {
+fn create_fixture_database() {
-    if let Ok(mut stream) = connect(pipe) {
+    if let Ok(mut c) = connect() {
-        let _ = send_raw(&mut stream, &format!(r#"{{"method":"create_database","database":"{FIXTURE_DATABASE}"}}"#));
+        let _ = send_raw(&mut c, &format!(r#"{{"method":"create_database","database":"{FIXTURE_DATABASE}"}}"#));
     }
 }
 
 /// 发一行请求读一行响应（没写库名就补测试库）
-fn send(stream: &mut LocalSocketStream, line: &str) -> String {
+fn send(c: &mut Conn, line: &str) -> String {
-    send_raw(stream, &with_default_database(line))
+    send_raw(c, &with_default_database(line))
 }
 
 /// 原样发一行请求，不补库名——用来验证"没选库"的行为
-fn send_raw(stream: &mut LocalSocketStream, line: &str) -> String {
+fn send_raw(c: &mut Conn, line: &str) -> String {
-    stream.write_all(line.as_bytes()).unwrap();
+    c.0.request_line(line).trim().to_string()
-    stream.write_all(b"\n").unwrap();
-    stream.flush().unwrap();
-
-    let mut reader = BufReader::new(stream.try_clone().unwrap());
-    let mut buf = String::new();
-    reader.read_line(&mut buf).unwrap();
-    buf.trim().to_string()
 }
 
-/// ping 回 pong
+/// 只有字典登记的表才算存在，孤儿文件不算
 #[test]
 fn catalog_is_the_only_table_authority() -> std::io::Result<()> {
-    let pipe = unique_pipe_name();
+    let (_srv, data) = start_server();
-    let (_srv, data) = start_server(&pipe);
     std::fs::write(data.path().join("databases/main/orphan.db"), b"orphan")?;
-    let mut c = connect(&pipe)?;
+    let mut c = connect()?;
     for method in ["scan", "describe_table"] {
         let result = send(&mut c, &format!(r#"{{"method":"{method}","table":"orphan"}}"#));
         assert!(result.contains("unknown table"), "{result}");
@@ -458,11 +429,11 @@ fn catalog_is_the_only_table_authority() -> std::io::Result<()> {
     Ok(())
 }
 
+/// 保留系统表拒绝所有通用操作
 #[test]
 fn reserved_tables_reject_every_generic_operation() -> std::io::Result<()> {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     for method in ["scan", "insert", "insert_batch", "delete_keys", "lookup_by_index",
         "replace_all", "describe_table", "create_table", "drop_table", "create_index",
         "drop_index", "drop_column"] {
@@ -474,11 +445,11 @@ fn reserved_tables_reject_every_generic_operation() -> std::io::Result<()> {
     Ok(())
 }
 
+/// 通用接口拒绝表名与列名里的路径别名
 #[test]
 fn generic_ipc_rejects_path_aliases() -> std::io::Result<()> {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     for table in ["../__chusql_users", "__CHUSQL_USERS", "__chusql_users."] {
         let result = send(&mut c, &serde_json::json!({"method":"scan", "table":table}).to_string());
         assert!(result.contains("error"), "{result}");
@@ -488,11 +459,11 @@ fn generic_ipc_rejects_path_aliases() -> std::io::Result<()> {
     Ok(())
 }
 
+/// 账号增改删，且普通列表接口看不到账号表
 #[test]
 fn account_create_reset_drop_and_hidden_from_ordinary_api() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     assert_eq!(serde_json::from_str::<serde_json::Value>(&send(&mut c, r#"{"method":"accounts_list"}"#))?["accounts"], serde_json::json!([]));
     let create = r#"{"method":"account_create","user":"Alice","password_hash":"hash-one"}"#;
     let created: serde_json::Value = serde_json::from_str(&send(&mut c, create))?;
@@ -518,28 +489,19 @@ fn account_create_reset_drop_and_hidden_from_ordinary_api() -> Result<(), Box<dy
     Ok(())
 }
 
-fn restart_at(pipe: &str, data: &std::path::Path) -> std::io::Result<ServerProc> {
+/// 用同一份数据目录重开一次存储
-    let child = Command::new(env!("CARGO_BIN_EXE_chusql-storage"))
+fn restart_at(data: &std::path::Path) -> std::io::Result<ServerProc> {
-        .arg("--config")
+    open_storage(&write_config(data));
-        .arg(write_config(data, pipe))
+    create_fixture_database();
-        .stdout(Stdio::null()).stderr(Stdio::null()).spawn()?;
+    Ok(ServerProc)
-    let server = ServerProc(child);
-    for _ in 0..100 {
-        if connect(pipe).is_ok() {
-            create_fixture_database(pipe);
-            return Ok(server);
-        }
-        thread::sleep(Duration::from_millis(50));
-    }
-    Err(std::io::Error::other("server restart timed out"))
 }
 
+/// 账号快照 WAL 重放两次不产生重复账号
 #[test]
 fn account_snapshot_replays_twice_without_duplicating_accounts() -> Result<(), Box<dyn std::error::Error>> {
-    use chusql_storage::{protocol::Account, wal::{Wal, WalOp}};
+    use chusql_core_storage::{protocol::Account, wal::{Wal, WalOp}};
-    let pipe = unique_pipe_name();
+    let (server, data) = start_server();
-    let (server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     let initial = send(&mut c, r#"{"method":"account_create","user":"alice","password_hash":"hash-one"}"#);
     assert!(initial.contains("accounts"), "{initial}");
     let changed: serde_json::Value = serde_json::from_str(&send(&mut c,
@@ -554,8 +516,8 @@ fn account_snapshot_replays_twice_without_duplicating_accounts() -> Result<(), B
         drop(wal);
         std::fs::write(data.path().join("system/__chusql_users.idx"), b"torn index")?;
         std::fs::write(data.path().join("system/__chusql_users.db"), b"torn heap")?;
-        let restarted = restart_at(&pipe, data.path())?;
+        let restarted = restart_at(data.path())?;
-        let mut connection = connect(&pipe)?;
+        let mut connection = connect()?;
         let actual: serde_json::Value = serde_json::from_str(&send(&mut connection, r#"{"method":"accounts_list"}"#))?;
         assert_eq!(actual, changed);
         assert_eq!(std::fs::metadata(data.path().join("system/wal.log"))?.len(), 0);
@@ -565,11 +527,11 @@ fn account_snapshot_replays_twice_without_duplicating_accounts() -> Result<(), B
     Ok(())
 }
 
+/// 账号操作失败时保留 WAL 并挡住写入
 #[test]
 fn account_failure_preserves_wal_and_blocks_writes() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (server, data) = start_server();
-    let (server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     std::fs::create_dir(data.path().join("system/catalog.json.pending"))?;
     let result = send(&mut c, r#"{"method":"account_create","user":"alice","password_hash":"hash-one"}"#);
     assert!(result.contains("error"), "{result}");
@@ -583,30 +545,30 @@ fn account_failure_preserves_wal_and_blocks_writes() -> Result<(), Box<dyn std::
     drop(c);
     drop(server);
     std::fs::remove_dir(data.path().join("system/catalog.json.pending"))?;
-    let _restarted = restart_at(&pipe, data.path())?;
+    let _restarted = restart_at(data.path())?;
-    let mut c = connect(&pipe)?;
+    let mut c = connect()?;
     let recovered = send(&mut c, r#"{"method":"accounts_list"}"#);
     assert!(recovered.contains("hash-one"), "{recovered}");
     Ok(())
 }
 
+/// 账号文件已存在时拒绝建账号
 #[test]
 fn account_create_rejects_reserved_file_collision() -> std::io::Result<()> {
-    let pipe = unique_pipe_name();
+    let (_server, data) = start_server();
-    let (_server, data) = start_server(&pipe);
     std::fs::write(data.path().join("system/__chusql_users.db"), b"existing")?;
-    let mut c = connect(&pipe)?;
+    let mut c = connect()?;
     let result = send(&mut c, r#"{"method":"account_create","user":"alice","password_hash":"hash-one"}"#);
     assert!(result.contains("collision"), "{result}");
     assert_eq!(std::fs::read(data.path().join("system/__chusql_users.db"))?, b"existing");
     Ok(())
 }
 
+/// 超长密码哈希在写 WAL 之前就被拒
 #[test]
 fn oversized_account_hash_is_rejected_before_wal() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (_server, data) = start_server();
-    let (_server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     let result = send(&mut c, &serde_json::json!({"method":"account_create", "user":"alice",
         "password_hash":"a".repeat(300)}).to_string());
     assert!(result.contains("invalid account credential"), "{result}");
@@ -616,16 +578,16 @@ fn oversized_account_hash_is_rejected_before_wal() -> Result<(), Box<dyn std::er
     Ok(())
 }
 
+/// 字典里已有同名普通表时拒绝建账号
 #[test]
 fn account_create_rejects_existing_ordinary_catalog_entry() -> std::io::Result<()> {
     let data = tempfile::tempdir()?;
-    let mut catalog = chusql_storage::catalog::Catalog::default();
+    let mut catalog = chusql_core_storage::catalog::Catalog::default();
     catalog.create_table("__chusql_users", Vec::new())?;
     std::fs::create_dir(data.path().join("system"))?;
     catalog.save(data.path().join("system/catalog.json"))?;
-    let pipe = unique_pipe_name();
+    let _server = restart_at(data.path())?;
-    let _server = restart_at(&pipe, data.path())?;
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     let result = send(&mut c, r#"{"method":"account_create","user":"alice","password_hash":"hash-one"}"#);
     assert!(result.contains("collision"), "{result}");
     Ok(())
@@ -634,9 +596,8 @@ fn account_create_rejects_existing_ordinary_catalog_entry() -> std::io::Result<(
 /// 列出已建的表
 #[test]
 fn list_tables_returns_created_tables() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     send(&mut c, r#"{"method":"insert","table":"users","row":{"id":1}}"#);
     send(&mut c, r#"{"method":"insert","table":"orders","row":{"id":1}}"#);
@@ -649,9 +610,8 @@ fn list_tables_returns_created_tables() {
 /// 整表替换只剩新行
 #[test]
 fn replace_all_replaces_rows() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     send(&mut c, r#"{"method":"insert","table":"users","row":{"id":1,"name":"Alice"}}"#);
     send(&mut c, r#"{"method":"insert","table":"users","row":{"id":2,"name":"Bob"}}"#);
@@ -670,9 +630,8 @@ fn replace_all_replaces_rows() {
 /// 按 id 查（列名走默认值 `id`，老客户端不用改）
 #[test]
 fn insert_then_lookup_by_index() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     for (id, name) in [(1, "Alice"), (2, "Bob"), (3, "Carol")] {
         let req = format!(
@@ -693,9 +652,8 @@ fn insert_then_lookup_by_index() {
 /// 同一个 id 插两次要报错（索引列是唯一的）
 #[test]
 fn duplicate_id_is_rejected() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     let req = r#"{"method":"insert","table":"dup_id","row":{"id":1,"name":"A"}}"#;
     assert!(send(&mut c, req).contains(r#""status":"ok""#));
@@ -708,9 +666,8 @@ fn duplicate_id_is_rejected() {
 /// 批量插入一次全进
 #[test]
 fn insert_batch_writes_all_rows() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     let r = send(
         &mut c,
@@ -728,9 +685,8 @@ fn insert_batch_writes_all_rows() {
 /// 行级删除：行没了、索引条目也没了、别人不受影响
 #[test]
 fn delete_keys_removes_row_and_index_entry() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     for (id, name) in [(1, "Alice"), (2, "Bob"), (3, "Carol")] {
         let req = format!(
@@ -757,9 +713,8 @@ fn delete_keys_removes_row_and_index_entry() {
 /// 给第二列建索引后能按那一列查
 #[test]
 fn create_index_on_secondary_column() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     for (id, code) in [(1, 5001), (2, 5002), (3, 5003)] {
         let req = format!(
@@ -794,9 +749,8 @@ fn create_index_on_secondary_column() {
 /// 删列同时摘掉索引与行内该格
 #[test]
 fn drop_column_removes_column_index_and_values() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     for (id, code, note) in [(1, 5001, "a"), (2, 5002, "b")] {
         let req = format!(
@@ -835,12 +789,11 @@ fn drop_column_removes_column_index_and_values() {
     assert!(r.contains(r#""status":"error""#), "a missing column should error: {}", r);
 }
 
-/// 重复值列允许建索引：点查把重复的行都取回来，删一行不影响另一行；id 仍然唯一
+/// 重复值列能建索引，删一行不影响另一行；id 仍唯一
 #[test]
 fn create_index_accepts_duplicate_values() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     send(&mut c, r#"{"method":"insert","table":"dup_t","row":{"id":1,"age":30}}"#);
     send(&mut c, r#"{"method":"insert","table":"dup_t","row":{"id":2,"age":30}}"#);
@@ -865,9 +818,8 @@ fn create_index_accepts_duplicate_values() {
 /// 数据字典里的统计：不同值个数
 #[test]
 fn stats_report_distinct_values() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     for (id, age) in [(1, 30), (2, 30), (3, 41)] {
         let req = format!(
@@ -891,24 +843,11 @@ fn stats_report_distinct_values() {
 /// 重开服务后索引仍在
 #[test]
 fn lookup_survives_reopen() {
-    let pipe = unique_pipe_name();
     let data = tempfile::tempdir().unwrap();
 
     {
-        let child = Command::new(env!("CARGO_BIN_EXE_chusql-storage"))
+        let _srv = start_server_in(data.path());
-            .arg("--config")
+        let mut c = connect().unwrap();
-            .arg(write_config(data.path(), &pipe))
-            .stdout(Stdio::null())
-            .stderr(Stdio::null())
-            .spawn()
-            .unwrap();
-        let srv = ServerProc(child);
-        for _ in 0..100 {
-            if connect(&pipe).is_ok() { break; }
-            thread::sleep(Duration::from_millis(50));
-        }
-        create_fixture_database(&pipe);
-        let mut c = connect(&pipe).unwrap();
         for (id, name) in [(1, "Alice"), (2, "Bob"), (3, "Carol")] {
             let req = format!(
                 r#"{{"method":"insert","table":"persist","row":{{"id":{},"name":"{}"}},"key":{}}}"#,
@@ -916,29 +855,11 @@ fn lookup_survives_reopen() {
             );
             send(&mut c, &req);
         }
-        drop(srv);
     }
 
-    thread::sleep(Duration::from_millis(200));
+    let _srv = start_server_in(data.path());
 
-    let (_srv, _data) = {
+    let mut c = connect().unwrap();
-        let child = Command::new(env!("CARGO_BIN_EXE_chusql-storage"))
-            .arg("--config")
-            .arg(write_config(data.path(), &pipe))
-            .stdout(Stdio::null())
-            .stderr(Stdio::null())
-            .spawn()
-            .unwrap();
-        let srv = ServerProc(child);
-        for _ in 0..100 {
-            if connect(&pipe).is_ok() { break; }
-            thread::sleep(Duration::from_millis(50));
-        }
-        create_fixture_database(&pipe);
-        (srv, data)
-    };
-
-    let mut c = connect(&pipe).unwrap();
     let r = send(&mut c, r#"{"method":"lookup_by_index","table":"persist","key":2}"#);
     assert!(r.contains("Bob"), "persist lookup: {}", r);
 }
@@ -947,34 +868,19 @@ fn lookup_survives_reopen() {
 #[test]
 fn config_file_is_used() {
     let dir = tempfile::tempdir().unwrap();
-    let pipe = unique_pipe_name();
     let data_dir = dir.path().join("data");
-    let config_path = dir.path().join("chusql-storage.toml");
+    let config_path = dir.path().join("chusql-core-storage.toml");
 
     let text = format!(
-        "[server]\npipe_name = \"{}\"\n[storage]\ndata_dir = \"{}\"\n[log]\nlevel = \"debug\"\n",
+        "[storage]\ndata_dir = \"{}\"\n[log]\nlevel = \"debug\"\n",
-        pipe,
         data_dir.display().to_string().replace('\\', "/")
     );
     std::fs::write(&config_path, text).unwrap();
 
-    let child = Command::new(env!("CARGO_BIN_EXE_chusql-storage"))
+    open_storage(&config_path);
-        .arg("--config")
+    create_fixture_database();
-        .arg(&config_path)
-        .stdout(Stdio::null())
-        .stderr(Stdio::null())
-        .spawn()
-        .expect("failed to spawn server");
-    let _srv = ServerProc(child);
-    for _ in 0..100 {
-        if connect(&pipe).is_ok() {
-            break;
-        }
-        thread::sleep(Duration::from_millis(50));
-    }
-    create_fixture_database(&pipe);
 
-    let mut c = connect(&pipe).unwrap();
+    let mut c = connect().unwrap();
     assert_eq!(send(&mut c, r#"{"method":"ping"}"#), r#"{"status":"pong"}"#);
     let r = send(&mut c, r#"{"method":"insert","table":"cfg","row":{"id":1}}"#);
     assert!(r.contains(r#""status":"ok""#), "insert: {}", r);
@@ -988,9 +894,8 @@ fn config_file_is_used() {
 /// 重复建表报错
 #[test]
 fn create_table_twice_errors() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     let req = r#"{"method":"create_table","table":"dup","columns":[{"name":"id","ty":"int"}]}"#;
     let r1 = send(&mut c, req);
@@ -1004,9 +909,8 @@ fn create_table_twice_errors() {
 /// 新建空表能扫描
 #[test]
 fn scan_empty_table_after_create() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     let r = send(
         &mut c,
@@ -1019,12 +923,11 @@ fn scan_empty_table_after_create() {
     assert!(r.contains(r#""rows":[]"#), "scan: {}", r);
 }
 
-/// 建表带上约束元数据，行里能有 null；replace_schema 整表换列定义与行
+/// 约束元数据落盘；replace_schema 换列与行
 #[test]
 fn replace_schema_rewrites_columns_and_rows() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     let created = send(
         &mut c,
@@ -1061,12 +964,11 @@ fn replace_schema_rewrites_columns_and_rows() {
     assert!(r.contains(r#""tag":"a""#), "rewritten rows: {}", r);
 }
 
-/// 旧类型系统落盘的数据在启动时升级：缺的格补 null，老类型名并到新写法
+/// 启动时升级旧类型字典，缺的格补 null
 #[test]
 fn legacy_catalog_and_partial_rows_are_migrated() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (server, data) = start_server();
-    let (server, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
     request_ok(&mut c, serde_json::json!({"method":"create_table","table":"legacy_t","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"},{"name":"age","ty":"int"}]}))?;
     request_ok(&mut c, serde_json::json!({"method":"insert","table":"legacy_t","row":{"id":1,"name":"a"}}))?;
     drop(c);
@@ -1083,8 +985,8 @@ fn legacy_catalog_and_partial_rows_are_migrated() -> Result<(), Box<dyn std::err
     }
     std::fs::write(&catalog_path, serde_json::to_string_pretty(&catalog)?)?;
 
-    let _restarted = start_server_in(&pipe, data.path());
+    let _restarted = start_server_in(data.path());
-    let mut c = connect(&pipe)?;
+    let mut c = connect()?;
 
     let rows: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"legacy_t"}"#))?;
     assert_eq!(rows["rows"], serde_json::json!([{"id":1,"name":"a","age":null}]), "缺的格要补 null");
@@ -1099,12 +1001,11 @@ fn legacy_catalog_and_partial_rows_are_migrated() -> Result<(), Box<dyn std::err
     Ok(())
 }
 
-/// 账号表用新类型系统落盘：id 主键、用户名索引、注册与最近登录时间
+/// 账号表落盘类型与索引，登录盖时间戳
 #[test]
 fn account_table_uses_typed_columns_and_stamps_login() -> Result<(), Box<dyn std::error::Error>> {
-    let pipe = unique_pipe_name();
+    let (_srv, data) = start_server();
-    let (_srv, data) = start_server(&pipe);
+    let mut c = connect()?;
-    let mut c = connect(&pipe)?;
 
     let created: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"account_create","user":"alice","password_hash":"hash"}"#))?;
     assert_eq!(created["status"], "accounts", "{}", created);
@@ -1136,10 +1037,9 @@ fn account_table_uses_typed_columns_and_stamps_login() -> Result<(), Box<dyn std
 
 /// 字符串列也能建索引并按键点查
 #[test]
-fn string_index_lookup_over_the_pipe() {
+fn string_index_lookup_in_process() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     send(&mut c, r#"{"method":"insert","table":"sidx","row":{"id":1,"name":"alice"}}"#);
     send(&mut c, r#"{"method":"insert","table":"sidx","row":{"id":2,"name":"bob"}}"#);
@@ -1159,12 +1059,11 @@ fn string_index_lookup_over_the_pipe() {
     assert!(r.contains(r#""id":1"#) && r.contains(r#""id":3"#), "both rows come back: {}", r);
 }
 
-/// 范围扫描走索引叶子链，两端可开可闭，没索引回 no_index
+/// 范围扫描走索引，两端可开可闭，没索引回 no_index
 #[test]
-fn range_scan_over_the_pipe() {
+fn range_scan_in_process() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     for (id, code) in [(1, 100), (2, 200), (3, 300), (4, 400)] {
         let req = format!(
@@ -1204,10 +1103,9 @@ fn range_scan_over_the_pipe() {
 
 /// 字符串列按字节序范围扫描
 #[test]
-fn string_range_scan_over_the_pipe() {
+fn string_range_scan_in_process() {
-    let pipe = unique_pipe_name();
+    let (_srv, _data) = start_server();
-    let (_srv, _data) = start_server(&pipe);
+    let mut c = connect().unwrap();
-    let mut c = connect(&pipe).unwrap();
 
     for (id, name) in [(1, "alice"), (2, "bob"), (3, "carol"), (4, "dave")] {
         let req = format!(

chusql-core/storage/tests/wal_test.rs

@@ -1,10 +1,11 @@
-use chusql_storage::protocol::Row;
+use chusql_core_storage::protocol::Row;
-use chusql_storage::wal::{Wal, WalOp};
+use chusql_core_storage::wal::{Wal, WalOp};
 use serde_json::json;
 
 // WAL 测试：追加、读取、清空、截断尾巴。
 
 
+/// 用键值对构造一行
 fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
     let mut m = Row::new();
     for (k, v) in pairs {

chusql-engine/chusql-engine.cabal

@@ -1,58 +0,0 @@
-cabal-version: 2.4
-
-name:           chusql-engine
-version:        1.0.0
-synopsis:       ChuSQL 执行引擎：SQL 词法与语法分析、表达式求值
-description:    ChuSQL 服务端执行引擎。负责 SQL 词法分析与 AST 构建、
-                WHERE 条件表达式求值、关系代数运算与内存表管理。
-build-type:     Simple
-
-library
-    hs-source-dirs:   src
-    exposed-modules:  ChuSQL.Algebra.Eval
-                      ChuSQL.Algebra.Expr
-                      ChuSQL.Algebra.Op
-                      ChuSQL.Algebra.Optimize
-                      ChuSQL.Algebra.Planner
-                      ChuSQL.Algebra.Sort
-                      ChuSQL.Engine
-                      ChuSQL.Model
-                      ChuSQL.Semantic
-                      ChuSQL.Storage
-                      ChuSQL.Storage.IPC
-                      ChuSQL.Storage.Memory
-                      ChuSQL.Syntax.AST
-                      ChuSQL.Syntax.Parser
-    build-depends:    base >= 4.14 && < 5
-                    , aeson
-                    , bytestring
-                    , hashable
-                    , megaparsec
-                    , network
-                    , parser-combinators
-                    , scientific
-                    , text
-                    , unordered-containers
-    default-language: Haskell2010
-    ghc-options:      -Wall
-
-executable chusql-engine
-    main-is:          Main.hs
-    hs-source-dirs:   app
-    build-depends:    base
-                    , chusql-engine
-    default-language: Haskell2010
-    ghc-options:      -Wall
-
-test-suite chusql-engine-test
-    type:             exitcode-stdio-1.0
-    main-is:          Spec.hs
-    hs-source-dirs:   test
-    build-depends:    base
-                    , chusql-engine
-                    , directory
-                    , filepath
-                    , hspec
-                    , process
-    default-language: Haskell2010
-    ghc-options:      -Wall

chusql-engine/src/ChuSQL/Storage/IPC.hs

@@ -1,665 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Storage.IPC (
-    IPCStorage (..),
-    Request (..),
-    Response (..),
-    Account (..),
-    SchemaColumn (..),
-    TableInfo (..),
-    sendRequest,
-    closeConnection,
-    defaultPipeName,
-    setPipeName,
-    getPipeName,
-    doListTables,
-    doLookupByColumn,
-    doInsert,
-    doInsertMany,
-    doDeleteKeys,
-    doDescribeTable,
-    doDropTable,
-    doListCatalog,
-) where
-
-import ChuSQL.Model
-import ChuSQL.Storage
-import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar, readMVar)
-import Control.Exception (IOException, try)
-#if !defined(mingw32_HOST_OS)
-import Control.Exception (onException)
-#endif
-import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecodeStrict, encode, object, withObject, (.:), (.:?), (.!=), (.=))
-import Data.Aeson qualified as A
-import Data.Aeson.Key qualified as K
-import Data.Aeson.KeyMap qualified as KM
-import Data.Aeson.Types (Parser)
-import Data.ByteString.Char8 qualified as BSC
-import Data.ByteString.Lazy qualified as BL
-import Data.Maybe (fromMaybe)
-import Data.Scientific (floatingOrInteger, fromFloatDigits)
-import Data.Text qualified as T
-import System.IO
-import System.IO.Unsafe (unsafePerformIO)
-#if !defined(mingw32_HOST_OS)
-import Network.Socket (Family (AF_UNIX), SockAddr (SockAddrUnix), SocketType (Stream), close, connect, defaultProtocol, socket, socketToHandle)
-import System.Environment (lookupEnv)
-#endif
-
--- IPC 存储实现：每个存储方法翻成管道上的一条 JSON 请求。
--- 端点：Windows 是具名管道 \\.\pipe\<name>，Unix 是文件系统套接字 <dir>/<name>.sock。
-
-#if !defined(mingw32_HOST_OS)
--- | Unix 套接字路径的最大长度（Linux 108 含结尾 NUL，BSD 104，这里留余量）
-maxSocketPathLength :: Int
-maxSocketPathLength = 100
-#endif
-
-newtype IPCStorage a = IPCStorage
-    { runIPCStorage :: IO a
-    }
-
-instance Functor IPCStorage where
-    fmap f (IPCStorage m) = IPCStorage (fmap f m)
-
-instance Applicative IPCStorage where
-    pure = IPCStorage . pure
-    IPCStorage mf <*> IPCStorage ma = IPCStorage (mf <*> ma)
-
-instance Monad IPCStorage where
-    IPCStorage m >>= k = IPCStorage $ do
-        a <- m
-        runIPCStorage (k a)
-
-{-# NOINLINE connectionRef #-}
-connectionRef :: MVar (Maybe (FilePath, Handle))
-connectionRef = unsafePerformIO (newMVar Nothing)
-
--- | 打开端点连接：Windows 把管道当文件打开，Unix 连一个 AF_UNIX 套接字
-openPipe :: FilePath -> IO Handle
-#if defined(mingw32_HOST_OS)
-openPipe path = do
-    h <- openFile path ReadWriteMode
-    hSetBuffering h LineBuffering
-    hSetNewlineMode h noNewlineTranslation
-    pure h
-#else
-openPipe path = do
-    if length path > maxSocketPathLength
-        then ioError (userError ("socket path too long (" ++ show (length path) ++ " bytes): " ++ path))
-        else pure ()
-    sock <- socket AF_UNIX Stream defaultProtocol
-    connect sock (SockAddrUnix path) `onException` close sock
-    h <- socketToHandle sock ReadWriteMode
-    hSetBuffering h LineBuffering
-    hSetNewlineMode h noNewlineTranslation
-    pure h
-
--- | Unix 套接字目录：$XDG_RUNTIME_DIR → $TMPDIR → /tmp（与 Rust 侧同一规则）
-socketDir :: IO String
-socketDir = do
-    runtime <- fmap nonEmpty (lookupEnv "XDG_RUNTIME_DIR")
-    tmp <- fmap nonEmpty (lookupEnv "TMPDIR")
-    pure (fromMaybe "/tmp" (runtime <> tmp))
-  where
-    nonEmpty v = case v of
-        Just s | not (null s) -> Just s
-        _ -> Nothing
-#endif
-
--- | 关掉缓存里的句柄（没有就什么都不做）
-closeCached :: Maybe (FilePath, Handle) -> IO ()
-closeCached Nothing = pure ()
-closeCached (Just (_, h)) = hClose h
-
--- | 拿一个可用句柄；路径没变就复用，变了就换。
-getConnection :: FilePath -> IO Handle
-getConnection path = modifyMVar connectionRef $ \cached -> case cached of
-    Just (p, h)
-        | p == path -> pure (Just (p, h), h)
-    _ -> do
-        _ <- try (closeCached cached) :: IO (Either IOException ())
-        h <- openPipe path
-        pure (Just (path, h), h)
-
--- | 丢掉缓存的连接（出错后调用，下次会重连）
-dropConnection :: IO ()
-dropConnection = modifyMVar_ connectionRef $ \cached -> do
-    _ <- try (closeCached cached) :: IO (Either IOException ())
-    pure Nothing
-
--- | 关闭并清空连接。可选，进程退出前调用。
-closeConnection :: IO ()
-closeConnection = dropConnection
-
--- | 没配置管名时用的端点，与 chusql.toml 的 [server] pipe_name 默认值一致
-defaultPipeName :: String
-defaultPipeName = "chusql-joint"
-
-{-# NOINLINE pipeNameRef #-}
-pipeNameRef :: MVar String
-pipeNameRef = unsafePerformIO (newMVar defaultPipeName)
-
--- | 设定本进程要连的端点；配置从哪来由调用方决定（本层不读环境变量）
-setPipeName :: String -> IO ()
-setPipeName name = modifyMVar_ pipeNameRef (\_ -> pure name)
-
--- | 当前端点
-getPipeName :: IO String
-getPipeName = readMVar pipeNameRef
-
--- | 端点的完整路径
-pipePath :: IO String
-#if defined(mingw32_HOST_OS)
-pipePath = do
-    name <- getPipeName
-    pure ("\\\\.\\pipe\\" ++ name)
-#else
-pipePath = do
-    name <- getPipeName
-    dir <- socketDir
-    pure (dir ++ "/" ++ name ++ ".sock")
-#endif
-
--- | 发一条请求，管道不通就重连
-sendRequest :: Request -> IO Response
-sendRequest req = do
-    path <- pipePath
-    result <- try (roundTrip req path) :: IO (Either IOException Response)
-    case result of
-        Left e -> do
-            dropConnection
-            pure (RespError ("pipe error: " ++ show e))
-        Right r -> pure r
-
--- | 一条请求-响应往返（复用缓存里的句柄）
-roundTrip :: Request -> FilePath -> IO Response
-roundTrip req path = do
-    h <- getConnection path
-    BL.hPutStr h (encode req)
-    BSC.hPutStr h "\n"
-    hFlush h
-    line <- BSC.hGetLine h
-    let cleaned = BSC.dropWhileEnd (== '\r') line
-    case eitherDecodeStrict cleaned of
-        Left err -> pure (RespError ("decode: " ++ err))
-        Right r -> pure r
-
-data SchemaColumn = SchemaColumn
-    { scName :: String
-    , scType :: String
-    , scNullable :: Bool
-    , scDefault :: Maybe Value
-    , scAutoIncrement :: Bool
-    , scPrimaryKey :: Bool
-    , scUnique :: Bool
-    , scCheck :: Maybe String
-    }
-    deriving (Show, Eq)
-
-instance ToJSON SchemaColumn where
-    toJSON sc =
-        object
-            [ "name" .= scName sc
-            , "ty" .= scType sc
-            , "nullable" .= scNullable sc
-            , "default" .= fmap valueToJSON (scDefault sc)
-            , "auto_increment" .= scAutoIncrement sc
-            , "primary_key" .= scPrimaryKey sc
-            , "unique" .= scUnique sc
-            , "check" .= scCheck sc
-            ]
-
-instance FromJSON SchemaColumn where
-    parseJSON = withObject "SchemaColumn" $ \o -> do
-        n <- o .: "name"
-        t <- o .: "ty"
-        nullable <- o .:? "nullable" .!= True
-        defJson <- o .:? "default"
-        def <- mapM valueFromJSON defJson
-        auto <- o .:? "auto_increment" .!= False
-        pk <- o .:? "primary_key" .!= False
-        uniq <- o .:? "unique" .!= False
-        chk <- o .:? "check"
-        pure (SchemaColumn n t nullable def auto pk uniq chk)
-
-data Request
-    = ReqPing
-    | ReqDatabase String String
-    | ReqAllCatalog
-    | ReqInDatabase String Request
-    | ReqAccountsList
-    | ReqAccountCreate T.Text T.Text
-    | ReqAccountReset T.Text T.Text
-    | ReqAccountLogin T.Text (Maybe T.Text)
-    | ReqAccountDrop T.Text
-    | ReqScan String
-    | ReqScanColumns String [String]
-    | ReqInsert String Row
-    | ReqInsertBatch String [Row]
-    | ReqDeleteKeys String [Int]
-    | ReqReplaceAll String [Row]
-    | ReqListTables
-    | ReqLookupByColumn String String Value
-    | ReqRangeByIndex String String (Maybe (Value, Bool)) (Maybe (Value, Bool))
-    | ReqDescribeTable String
-    | ReqCreateTable String [SchemaColumn]
-    | ReqDropTable String
-    | ReqCreateIndex String String
-    | ReqDropIndex String String
-    | ReqDropColumn String String
-    | ReqReplaceSchema String [SchemaColumn] [Row]
-    | ReqListCatalog
-
-instance ToJSON Request where
-    toJSON (ReqDatabase method name) = object ["method" .= method, "database" .= name]
-    toJSON ReqAllCatalog = object ["method" .= ("all_catalogs" :: T.Text)]
-    toJSON (ReqInDatabase name req) = case toJSON req of
-        A.Object fields -> A.Object (KM.insert "database" (A.String (T.pack name)) fields)
-        other -> other
-    toJSON ReqAccountsList = object ["method" .= ("accounts_list" :: T.Text)]
-    toJSON (ReqAccountCreate u h) = object ["method" .= ("account_create" :: T.Text), "user" .= u, "password_hash" .= h]
-    toJSON (ReqAccountReset u h) = object ["method" .= ("account_reset" :: T.Text), "user" .= u, "password_hash" .= h]
-    toJSON (ReqAccountLogin u at) = object ["method" .= ("account_login" :: T.Text), "user" .= u, "at" .= at]
-    toJSON (ReqAccountDrop u) = object ["method" .= ("account_drop" :: T.Text), "user" .= u]
-    toJSON ReqPing = object ["method" .= ("ping" :: T.Text)]
-    toJSON (ReqScan t) = object ["method" .= ("scan" :: T.Text), "table" .= t]
-    toJSON (ReqScanColumns t cols) = object ["method" .= ("scan" :: T.Text), "table" .= t, "columns" .= cols]
-    toJSON (ReqInsert t r) =
-        object
-            [ "method" .= ("insert" :: T.Text)
-            , "table" .= t
-            , "row" .= rowToJSON r
-            ]
-    toJSON (ReqInsertBatch t rs) =
-        object
-            [ "method" .= ("insert_batch" :: T.Text)
-            , "table" .= t
-            , "rows" .= map rowToJSON rs
-            ]
-    toJSON (ReqDeleteKeys t ks) =
-        object
-            [ "method" .= ("delete_keys" :: T.Text)
-            , "table" .= t
-            , "keys" .= ks
-            ]
-    toJSON (ReqReplaceAll t rs) =
-        object
-            [ "method" .= ("replace_all" :: T.Text)
-            , "table" .= t
-            , "rows" .= map rowToJSON rs
-            ]
-    toJSON ReqListTables = object ["method" .= ("list_tables" :: T.Text)]
-    toJSON (ReqLookupByColumn t c k) =
-        object
-            [ "method" .= ("lookup_by_index" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            , "key" .= valueToJSON k
-            ]
-    toJSON (ReqRangeByIndex t c lo hi) =
-        object
-            [ "method" .= ("range_by_index" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            , "lo" .= fmap (valueToJSON . fst) lo
-            , "lo_inclusive" .= maybe True snd lo
-            , "hi" .= fmap (valueToJSON . fst) hi
-            , "hi_inclusive" .= maybe True snd hi
-            ]
-    toJSON (ReqDescribeTable t) =
-        object
-            [ "method" .= ("describe_table" :: T.Text)
-            , "table" .= t
-            ]
-    toJSON (ReqCreateTable t cols) =
-        object
-            [ "method" .= ("create_table" :: T.Text)
-            , "table" .= t
-            , "columns" .= cols
-            ]
-    toJSON (ReqDropTable t) =
-        object ["method" .= ("drop_table" :: T.Text), "table" .= t]
-    toJSON (ReqCreateIndex t c) =
-        object
-            [ "method" .= ("create_index" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            ]
-    toJSON (ReqDropIndex t c) =
-        object
-            [ "method" .= ("drop_index" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            ]
-    toJSON (ReqDropColumn t c) =
-        object
-            [ "method" .= ("drop_column" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            ]
-    toJSON (ReqReplaceSchema t cols rs) =
-        object
-            [ "method" .= ("replace_schema" :: T.Text)
-            , "table" .= t
-            , "columns" .= cols
-            , "rows" .= map rowToJSON rs
-            ]
-    toJSON ReqListCatalog = object ["method" .= ("list_catalog" :: T.Text)]
-
-data TableInfo = TableInfo
-    { tiTable :: String
-    , tiColumns :: [SchemaColumn]
-    , tiRows :: Int
-    , tiIndexes :: [String]
-    , tiStats :: [(String, Int, Bool)]
-    }
-    deriving (Show, Eq)
-
-data Account = Account
-    { accountId :: Integer
-    , accountUser :: T.Text
-    , accountHash :: T.Text
-    , accountRevision :: Integer
-    , accountRegisteredAt :: T.Text
-    , accountLastLoginAt :: Maybe T.Text
-    } deriving (Eq)
-
-instance Show Account where
-    show a = "Account " ++ show (accountUser a) ++ " revision=" ++ show (accountRevision a)
-
-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"
-
-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]
-
-data Response
-    = RespPong
-    | RespAccounts [Account]
-    | RespRows [Row]
-    | RespTables [String]
-    | RespSchema TableInfo
-    | RespNoIndex
-    | RespOk
-    | RespError String
-    | RespCatalog [TableInfo]
-
-instance FromJSON Response where
-    parseJSON = withObject "Response" $ \o -> do
-        status <- o .: "status"
-        case status :: T.Text of
-            "accounts" -> RespAccounts <$> o .: "accounts"
-            "pong" -> pure RespPong
-            "ok" -> pure RespOk
-            "no_index" -> pure RespNoIndex
-            "rows" -> RespRows <$> (o .: "rows" >>= mapM rowFromJSON)
-            "tables" -> RespTables <$> o .: "tables"
-            "error" -> RespError <$> o .: "message"
-            "schema" -> RespSchema <$> parseTable (A.Object o)
-            "catalog" -> do
-                xs <- o .: "schemas" :: Parser [A.Value]
-                RespCatalog <$> mapM parseTable xs
-            other -> fail ("unknown status: " ++ T.unpack other)
-      where
-        parseTable :: A.Value -> Parser TableInfo
-        parseTable = withObject "TableInfo" $ \o -> do
-            t <- o .: "table"
-            cols <- o .: "columns"
-            cnt <- o .: "row_count"
-            idx <- o .:? "indexes" .!= []
-            sts <- o .:? "stats" .!= []
-            idxCols <- mapM (\v -> withObject "IndexWire" (.: "column") v) (idx :: [A.Value])
-            stats <- mapM parseStat (sts :: [A.Value])
-            pure (TableInfo t cols cnt idxCols stats)
-
-        parseStat :: A.Value -> Parser (String, Int, Bool)
-        parseStat = withObject "ColumnStat" $ \o -> do
-            name <- o .: "name"
-            distinct <- o .: "distinct"
-            capped <- o .:? "capped" .!= False
-            pure (name, distinct, capped)
-
--- | 值编码成 JSON
-valueToJSON :: Value -> A.Value
-valueToJSON VNull = A.Null
-valueToJSON (VInt n) = A.Number (fromIntegral n)
-valueToJSON (VFloat d) = A.Number (fromFloatDigits d)
-valueToJSON (VStr s) = A.String (T.pack s)
-valueToJSON (VBool b) = A.Bool b
-
--- | JSON 解回值
-valueFromJSON :: A.Value -> Parser Value
-valueFromJSON A.Null = pure VNull
-valueFromJSON (A.Number n) =
-    case floatingOrInteger n :: Either Double Integer of
-        Right i -> pure (VInt (fromIntegral i))
-        Left d -> pure (VFloat d)
-valueFromJSON (A.String s) = pure (VStr (T.unpack s))
-valueFromJSON (A.Bool b) = pure (VBool b)
-valueFromJSON _ = fail "unsupported value type"
-
--- | 一行编码成 JSON
-rowToJSON :: Row -> A.Value
-rowToJSON r =
-    A.Object (KM.fromList [(K.fromString k, valueToJSON v) | (k, v) <- r])
-
--- | JSON 解回一行
-rowFromJSON :: A.Value -> Parser Row
-rowFromJSON (A.Object o) = mapM toPair (KM.toList o)
-  where
-    toPair (k, v) = do
-        val <- valueFromJSON v
-        pure (K.toString k, val)
-rowFromJSON _ = fail "row must be a JSON object"
-
--- | 发请求并把响应翻成 Either
-ask :: String -> Request -> (Response -> Maybe a) -> IO (Either String a)
-ask what req recognize = do
-    resp <- sendRequest req
-    pure $ case resp of
-        RespError e -> Left e
-        other -> case recognize other of
-            Just a -> Right a
-            Nothing -> Left ("unexpected response to " ++ what)
-
--- | 只认"成了"（多数写操作都这样）
-okOnly :: Response -> Maybe ()
-okOnly RespOk = Just ()
-okOnly _ = Nothing
-
--- | 发 Scan
-doScan :: String -> IO (Either String [Row])
-doScan t = ask "scan" (ReqScan t) $ \resp -> case resp of
-    RespRows rows -> Just rows
-    _ -> Nothing
-
--- | 发 Insert（索引由存储层维护）
-doInsert :: String -> Row -> IO (Either String ())
-doInsert t r = ask "insert" (ReqInsert t r) okOnly
-
--- | 发 InsertBatch：一批行一次请求
-doInsertMany :: String -> [Row] -> IO (Either String ())
-doInsertMany t rs = ask "insert_batch" (ReqInsertBatch t rs) okOnly
-
--- | 发 DeleteKeys
-doDeleteKeys :: String -> [Int] -> IO (Either String ())
-doDeleteKeys t ks = ask "delete_keys" (ReqDeleteKeys t ks) okOnly
-
--- | 发 ReplaceAll
-doReplaceAll :: String -> [Row] -> IO (Either String ())
-doReplaceAll t rs = ask "replace_all" (ReqReplaceAll t rs) okOnly
-
--- | 发 ListTables
-doListTables :: IO (Either String [String])
-doListTables = ask "list_tables" ReqListTables $ \resp -> case resp of
-    RespTables ts -> Just ts
-    _ -> Nothing
-
--- | 一次拿全库 schema
-doListCatalog :: IO (Either String [TableInfo])
-doListCatalog = ask "list_catalog" ReqListCatalog $ \resp -> case resp of
-    RespCatalog xs -> Just xs
-    _ -> Nothing
-
--- | 按某一列的索引取一行（键可以是整数或字符串）
-doLookupByColumn :: String -> String -> Value -> IO (Either String IndexResult)
-doLookupByColumn t c k = ask "lookup_by_index" (ReqLookupByColumn t c k) $ \resp -> case resp of
-    RespRows rows -> Just (IndexRows rows)
-    RespNoIndex -> Just NoIndex
-    _ -> Nothing
-
--- | 范围扫描：没有可用索引就回 Nothing，让上层退回扫描
-doScanRange ::
-    String ->
-    String ->
-    Maybe (Value, Bool) ->
-    Maybe (Value, Bool) ->
-    IO (Either String (Maybe [Row]))
-doScanRange t c lo hi = ask "range_by_index" (ReqRangeByIndex t c lo hi) $ \resp -> case resp of
-    RespRows rows -> Just (Just rows)
-    RespNoIndex -> Just Nothing
-    _ -> Nothing
-
--- | 发 DescribeTable
-doDescribeTable :: String -> IO (Either String TableInfo)
-doDescribeTable t = ask "describe_table" (ReqDescribeTable t) $ \resp -> case resp of
-    RespSchema info -> Just info
-    _ -> Nothing
-
--- | 给某一列建索引
-doCreateIndex :: String -> String -> IO (Either String ())
-doCreateIndex t c = ask "create_index" (ReqCreateIndex t c) okOnly
-
--- | 去掉某一列的索引
-doDropIndex :: String -> String -> IO (Either String ())
-doDropIndex t c = ask "drop_index" (ReqDropIndex t c) okOnly
-
--- | 删一列（列定义、这一列上的索引、每行里的那一格一起没）
-doDropColumn :: String -> String -> IO (Either String ())
-doDropColumn t c = ask "drop_column" (ReqDropColumn t c) okOnly
-
--- | 发 ReplaceSchema（ALTER 用）
-doReplaceSchema :: String -> [SchemaColumn] -> [Row] -> IO (Either String ())
-doReplaceSchema t cols rs = ask "replace_schema" (ReqReplaceSchema t cols rs) okOnly
-
--- | 发 CreateTable
-doCreateTable :: String -> [SchemaColumn] -> IO (Either String ())
-doCreateTable t cols = ask "create_table" (ReqCreateTable t cols) okOnly
-
--- | 发 DropTable
-doDropTable :: String -> IO (Either String ())
-doDropTable t = ask "drop_table" (ReqDropTable t) okOnly
-
--- | 线上 schema 转本地列
-schemaToColumns :: [SchemaColumn] -> [(String, Column)]
-schemaToColumns = map toColumn
-
-toColumn :: SchemaColumn -> (String, Column)
-toColumn sc =
-    ( scName sc
-    , Column
-        { columnType = fromMaybe CStr (parseColumnType (scType sc))
-        , columnNullable = scNullable sc
-        , columnDefault = scDefault sc
-        , columnAutoIncrement = scAutoIncrement sc
-        , columnUnique = scUnique sc
-        , columnPrimaryKey = scPrimaryKey sc
-        , columnCheck = scCheck sc
-        }
-    )
-
--- | 本地列转线上 schema
-toWire :: (String, Column) -> SchemaColumn
-toWire (n, c) =
-    SchemaColumn
-        { scName = n
-        , scType = typeName (columnType c)
-        , scNullable = columnNullable c
-        , scDefault = columnDefault c
-        , scAutoIncrement = columnAutoIncrement c
-        , scPrimaryKey = columnPrimaryKey c
-        , scUnique = columnUnique c
-        , scCheck = columnCheck c
-        }
-
-instance MonadStorage IPCStorage where
-    createDatabase name = IPCStorage (ask "create_database" (ReqDatabase "create_database" name) okOnly)
-    dropDatabase name = IPCStorage (ask "drop_database" (ReqDatabase "drop_database" name) okOnly)
-    useDatabase name = IPCStorage (ask "use_database" (ReqDatabase "use_database" name) okOnly)
-    listDatabases = IPCStorage $ ask "list_databases" (ReqDatabase "list_databases" "") $ \resp -> case resp of
-        RespTables names -> Just names
-        _ -> Nothing
-    -- \| 发 Scan
-    scan t = IPCStorage (doScan t)
-    scanColumns t cols = IPCStorage $ ask "scan" (ReqScanColumns t cols) $ \resp -> case resp of
-        RespRows rows -> Just [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows]
-        _ -> Nothing
-
-    -- \| 发 Insert（索引由存储层自己维护）
-    insert t r = IPCStorage (doInsert t r)
-
-    -- \| 一批行一次请求：N 行只落一次盘
-    insertMany t rs = IPCStorage (doInsertMany t rs)
-
-    -- \| 按 id 批量删行
-    deleteKeys t ks = IPCStorage (doDeleteKeys t ks)
-
-    -- \| 发 ReplaceAll
-    replaceAll t rs = IPCStorage (doReplaceAll t rs)
-
-    -- \| 按某一列的索引取一行（没有索引就回 NoIndex）
-    lookupByColumn t c k = IPCStorage (doLookupByColumn t c k)
-
-    -- \| 范围扫描（没有索引就回 Nothing）
-    scanRange t c lo hi = IPCStorage (doScanRange t c lo hi)
-
-    -- \| 发 CreateTable
-    createTable name cols = IPCStorage (doCreateTable name (map toWire cols))
-
-    -- \| ALTER：整表换列定义与全部行
-    replaceSchema name cols rows = IPCStorage (doReplaceSchema name (map toWire cols) rows)
-
-    -- \| 发 DropTable
-    dropTable name = IPCStorage (doDropTable name)
-
-    -- \| 建索引
-    createIndex t c = IPCStorage (doCreateIndex t c)
-
-    -- \| 删索引
-    dropIndex t c = IPCStorage (doDropIndex t c)
-
-    -- \| 删一列
-    dropColumn t c = IPCStorage (doDropColumn t c)
-
-    -- \| 列表 + 逐表扫描拼库
-    snapshot = IPCStorage $ do
-        result <- doListCatalog
-        case result of
-            Left _ -> pure []
-            Right xs -> mapM loadEntry xs
-      where
-        loadEntry info = do
-            rows <- doScan (tiTable info)
-            pure
-                ( tiTable info
-                , Table (tiTable info) (schemaToColumns (tiColumns info)) (either (const []) id rows)
-                )
-
-    -- \| 只问数据字典要结构，一行数据都不拉过来
-    schema = IPCStorage $ do
-        result <- ask "all_catalogs" ReqAllCatalog $ \resp -> case resp of
-            RespCatalog infos -> Just infos
-            _ -> Nothing
-        pure $ case result of
-            Left _ -> []
-            Right xs ->
-                [ (tiTable i, Table (tiTable i) (schemaToColumns (tiColumns i)) [])
-                | i <- xs
-                ]

chusql-interface/chusql-interface.cabal

@@ -0,0 +1,39 @@
+cabal-version: 2.4
+
+name:           chusql-interface
+version:        1.0.0
+synopsis:       ChuSQL 接口层：配置、口令、语句构造与 TCP 客户端
+description:    引擎无关的接口层。Web 管理端与命令行客户端都只依赖这层：
+                读同一份 chusql.toml、用同一个线上协议连到拥有存储库的
+                chusql-server，然后在客户端会话上跑 SQL、看数据字典与角色。
+                存储引擎与存储动态库一概不在这层。
+build-type:     Simple
+
+library
+    hs-source-dirs:   src
+    exposed-modules:  ChuSQL.Interface.AccountTable
+                      ChuSQL.Interface.Actions
+                      ChuSQL.Interface.Auth
+                      ChuSQL.Interface.Config
+                      ChuSQL.Interface.Link
+                      ChuSQL.Interface.Policy
+                      ChuSQL.Interface.Protocol
+                      ChuSQL.Interface.RateLimit
+                      ChuSQL.Interface.Session
+                      ChuSQL.Interface.Settings
+                      ChuSQL.Interface.TOML
+    build-depends:    base >= 4.14 && < 5
+                    , aeson
+                    , bytestring
+                    , chusql-core-model
+                    , containers
+                    , crypton
+                    , directory
+                    , filepath
+                    , memory
+                    , network
+                    , scientific
+                    , text
+                    , time
+    default-language: Haskell2010
+    ghc-options:      -Wall

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

@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Interface.AccountTable (
+    accountTableName,
+    isAccountTable,
+    passwordColumn,
+    accountColumns,
+    systemTableInfo,
+) where
+
+import ChuSQL.Core.Protocol (SchemaColumn (..), TableInfo (..))
+import Data.Text (Text)
+import qualified Data.Text as T
+
+-- 账号表（系统表 __chusql_users）的结构定义，SQL 会话与 Web 管理端共用。
+
+-- | 账号表的名字：网页里像普通表一样浏览与编辑，但写入走账号命令
+accountTableName :: String
+accountTableName = "__chusql_users"
+
+-- | 这张表是不是账号表
+isAccountTable :: Text -> Bool
+isAccountTable name = T.toLower name == T.pack accountTableName
+
+-- | 口令列：密文只在服务端产生，界面不支持排序与筛选
+passwordColumn :: String
+passwordColumn = "password"
+
+-- | 账号表的列定义与约束
+accountColumns :: [SchemaColumn]
+accountColumns =
+    [ accountColumnSpec "id" "int" False True True False
+    , accountColumnSpec "user" "varchar(64)" False False False True
+    , accountColumnSpec passwordColumn "varchar(256)" False False False False
+    , accountColumnSpec "registered_at" "timestamp" False False False False
+    , accountColumnSpec "last_login_at" "timestamp" True False False False
+    ]
+
+-- | 账号表的列（约束由账号服务管）
+accountColumnSpec :: String -> String -> Bool -> Bool -> Bool -> Bool -> SchemaColumn
+accountColumnSpec name ty nullable autoIncrement primary unique =
+    SchemaColumn name ty nullable Nothing autoIncrement primary unique Nothing
+
+-- | 账号表的结构（排序校验用）
+systemTableInfo :: TableInfo
+systemTableInfo = TableInfo accountTableName accountColumns 0 [] []

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

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Web.Actions (
+module ChuSQL.Interface.Actions (
     ColumnSpec (..),
     CreateTableSpec (..),
     isIdentifier,
@@ -24,10 +24,16 @@ module ChuSQL.Web.Actions (
     createUserSql,
     alterUserSql,
     dropUserSql,
+    createRoleSql,
+    dropRoleSql,
+    grantPrivilegesSql,
+    revokePrivilegesSql,
+    grantRoleSql,
+    revokeRoleSql,
 ) where
 
-import ChuSQL.Model (Column (..), ColumnType (..), Value (..), integerType, numericType, parseColumnType, plainColumn, typeName)
+import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), integerType, numericType, parseColumnType, plainColumn, typeName)
-import qualified ChuSQL.Model as M
+import qualified ChuSQL.Core.Model as M
 import qualified Data.Aeson as A
 import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
 import Data.List (intercalate)
@@ -38,12 +44,14 @@ import Text.Read (readMaybe)
 
 -- 把界面上的一键操作翻译成安全 SQL：标识符过白名单，值一律转义。
 
+-- | 界面上传来的一列：名字与类型名
 data ColumnSpec = ColumnSpec
     { csName :: Text
     , csType :: Text
     }
     deriving (Show, Eq)
 
+-- | 建表请求：表名 + 列
 data CreateTableSpec = CreateTableSpec
     { ctsTable :: Text
     , ctsColumns :: [ColumnSpec]
@@ -59,6 +67,7 @@ isIdentifier t =
             (c : cs) -> (isAsciiLower c || isAsciiUpper c || c == '_') && all restChar cs
             [] -> False
   where
+    -- | 标识符里其余字符的合法集
     restChar c = isAsciiLower c || isAsciiUpper c || isDigit c || c == '_'
 
 -- | 检查一个标识符，不合法就报错（带上"是表名还是列名"）
@@ -138,6 +147,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)
@@ -238,6 +248,7 @@ 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)
@@ -249,20 +260,21 @@ orderClause (Just (column, ascending)) = do
     col <- checkIdent "column" column
     pure (" ORDER BY " ++ T.unpack col ++ (if ascending then " ASC" else " DESC"))
 
--- | 账号名：与普通标识符同一套规则，另允许点与短横线（写成字符串形式）
+-- | 账号名：标识符规则另允许点与短横线
 accountName :: Text -> Either String Text
 accountName name
     | T.null name || T.length name > 64 = Left "account name is empty or too long"
     | 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)
 
 -- | 单引号字符串字面量
 quoted :: Text -> String
 quoted value = "'" ++ escapeStringLiteral (T.unpack value) ++ "'"
 
--- | 构造 CREATE USER（口令是明文，账号服务负责加盐派生）
+-- | 构造 CREATE USER
 createUserSql :: Text -> Text -> Either String String
 createUserSql name password = do
     user <- accountName name
@@ -283,3 +295,77 @@ dropUserSql :: Text -> Either String String
 dropUserSql name = do
     user <- accountName name
     pure ("DROP USER " ++ T.unpack user)
+
+-- | 角色名：与账号名同一套字符规则
+roleName :: Text -> Either String Text
+roleName name
+    | T.null name || T.length name > 64 = Left "role name is empty or too long"
+    | 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
+    | 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 定
+privilegeWords :: [Text] -> Either String [Text]
+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
+
+-- | 构造 CREATE ROLE
+createRoleSql :: Text -> Either String String
+createRoleSql name = do
+    role <- roleName name
+    pure ("CREATE ROLE " ++ T.unpack role)
+
+-- | 构造 DROP ROLE
+dropRoleSql :: Text -> Either String String
+dropRoleSql name = do
+    role <- roleName name
+    pure ("DROP ROLE " ++ T.unpack role)
+
+-- | 构造 GRANT 权限 ON 对象 TO 角色
+grantPrivilegesSql :: [Text] -> Text -> Text -> Either String String
+grantPrivilegesSql privileges object role = do
+    words' <- privilegeWords privileges
+    target <- grantObject object
+    who <- roleName role
+    pure ("GRANT " ++ T.unpack (T.intercalate ", " words') ++ " ON " ++ T.unpack target ++ " TO " ++ T.unpack who)
+
+-- | 构造 REVOKE 权限 ON 对象 FROM 角色
+revokePrivilegesSql :: [Text] -> Text -> Text -> Either String String
+revokePrivilegesSql privileges object role = do
+    words' <- privilegeWords privileges
+    target <- grantObject object
+    who <- roleName role
+    pure ("REVOKE " ++ T.unpack (T.intercalate ", " words') ++ " ON " ++ T.unpack target ++ " FROM " ++ T.unpack who)
+
+-- | 构造 GRANT <角色> TO <用户>[, ...]
+grantRoleSql :: Text -> [Text] -> Either String String
+grantRoleSql role users = do
+    who <- roleName role
+    members <- requireNonEmpty "users" users >>= mapM accountName
+    pure ("GRANT " ++ T.unpack who ++ " TO " ++ T.unpack (T.intercalate ", " members))
+
+-- | 构造 REVOKE 角色 FROM 用户
+revokeRoleSql :: Text -> [Text] -> Either String String
+revokeRoleSql role users = do
+    who <- roleName role
+    members <- requireNonEmpty "users" users >>= mapM accountName
+    pure ("REVOKE " ++ T.unpack who ++ " FROM " ++ T.unpack (T.intercalate ", " members))

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

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Web.Auth (
+module ChuSQL.Interface.Auth (
     Credential (..),
     defaultIterations,
     hashPassword,
@@ -19,6 +19,15 @@ module ChuSQL.Web.Auth (
     lookupSession,
     deleteSession,
     sessionToken,
+    PayloadStore,
+    newPayloadStore,
+    payloadPolicy,
+    setPayloadPolicy,
+    createPayloadSession,
+    lookupPayload,
+    putPayload,
+    dropPayload,
+    sweepPayloads,
 ) where
 
 import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar)
@@ -37,8 +46,9 @@ import qualified Data.Text.Encoding as TE
 import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime)
 import Text.Read (readMaybe)
 
--- 口令与 Session：口令只存 PBKDF2 编码串，会话是服务端内存状态。
+-- 口令哈希与会话仓库，服务端与 Web 管理端共用。
 
+-- | 一条账号凭据：账号名 + 编码串
 data Credential = Credential
     { credUser :: Text
     , credEncoded :: Text
@@ -115,6 +125,7 @@ verifyPassword encoded candidate = case parseHash encoded of
 hashLooksValid :: Text -> Bool
 hashLooksValid = isJust . parseHash
 
+-- | 一条会话：账号、创建/最后活动时间与账号版本号
 data Session = Session
     { sessUser :: Text
     , sessCreated :: UTCTime
@@ -122,6 +133,7 @@ data Session = Session
     , sessRevision :: Maybe Integer
     }
 
+-- | 会话过期策略：空闲上限与绝对上限
 data SessionPolicy = SessionPolicy
     { spIdleSeconds :: NominalDiffTime
     , spAbsoluteSeconds :: NominalDiffTime
@@ -131,6 +143,7 @@ data SessionPolicy = SessionPolicy
 defaultSessionPolicy :: SessionPolicy
 defaultSessionPolicy = SessionPolicy (8 * 3600) (24 * 3600)
 
+-- | 会话仓库：令牌表、时钟与策略
 data SessionStore = SessionStore
     { storeMap :: MVar (Map.Map Text Session)
     , storeClock :: IO UTCTime
@@ -170,6 +183,7 @@ sessionToken = hexEncode <$> getRandomBytes 32
 createSession :: SessionStore -> Text -> IO Text
 createSession store user = createVersionedSession store user Nothing
 
+-- | 开一条会话并记下账号版本号，返回令牌
 createVersionedSession :: SessionStore -> Text -> Maybe Integer -> IO Text
 createVersionedSession store user revision = do
     token <- sessionToken
@@ -183,6 +197,7 @@ createVersionedSession store user revision = do
 lookupSession :: SessionStore -> Text -> IO (Maybe Text)
 lookupSession store token = fmap (fmap fst) (lookupVersionedSession store token)
 
+-- | 查令牌拿回账号名与账号版本号，并刷新最后活动时间
 lookupVersionedSession :: SessionStore -> Text -> IO (Maybe (Text, Maybe Integer))
 lookupVersionedSession store token = do
     now <- storeClock store
@@ -196,3 +211,95 @@ lookupVersionedSession store token = do
 -- | 删掉一条会话（退出登录）
 deleteSession :: SessionStore -> Text -> IO ()
 deleteSession store token = modifyMVar_ (storeMap store) (pure . Map.delete token)
+
+-- | 一条带载荷的会话：账号、时间与载荷
+data StoredSession a = StoredSession
+    { psUser :: Text
+    , psCreated :: UTCTime
+    , psSeen :: UTCTime
+    , psPayload :: a
+    }
+
+-- | 带载荷的会话仓库：令牌表、时钟与策略
+data PayloadStore a = PayloadStore
+    { psStoreMap :: MVar (Map.Map Text (StoredSession a))
+    , psClock :: IO UTCTime
+    , psPolicy :: IORef SessionPolicy
+    }
+
+-- | 造一个空的带载荷仓库
+newPayloadStore :: IO UTCTime -> SessionPolicy -> IO (PayloadStore a)
+newPayloadStore clock policy = do
+    ref <- newMVar Map.empty
+    policyRef <- newIORef policy
+    pure (PayloadStore ref clock policyRef)
+
+-- | 现在用的是哪套过期策略
+payloadPolicy :: PayloadStore a -> IO SessionPolicy
+payloadPolicy = readIORef . psPolicy
+
+-- | 换一套过期策略
+setPayloadPolicy :: PayloadStore a -> SessionPolicy -> IO ()
+setPayloadPolicy store = writeIORef (psPolicy store)
+
+-- | 这条带载荷的会话过期了吗
+payloadExpired :: UTCTime -> SessionPolicy -> StoredSession a -> Bool
+payloadExpired now pol s =
+    diffUTCTime now (psSeen s) > spIdleSeconds pol
+        || diffUTCTime now (psCreated s) > spAbsoluteSeconds pol
+
+-- | 清掉过期的带载荷会话
+prunePayloads :: UTCTime -> SessionPolicy -> Map.Map Text (StoredSession a) -> Map.Map Text (StoredSession a)
+prunePayloads now pol = Map.filter (not . payloadExpired now pol)
+
+-- | 上线一条带载荷的会话，返回令牌
+createPayloadSession :: PayloadStore a -> Text -> a -> IO Text
+createPayloadSession store user payload = do
+    token <- sessionToken
+    now <- psClock store
+    pol <- payloadPolicy store
+    modifyMVar_ (psStoreMap store) $ \m ->
+        pure (Map.insert token (StoredSession user now now payload) (prunePayloads now pol m))
+    pure token
+
+-- | 查令牌并刷新最后活动时间，拿回账号名与载荷
+lookupPayload :: PayloadStore a -> Text -> IO (Maybe (Text, a))
+lookupPayload store token = do
+    now <- psClock store
+    pol <- payloadPolicy store
+    modifyMVar (psStoreMap store) $ \m -> do
+        let kept = prunePayloads now pol m
+        pure $ case Map.lookup token kept of
+            Nothing -> (kept, Nothing)
+            Just s -> (Map.insert token s{psSeen = now} kept, Just (psUser s, psPayload s))
+
+-- | 换掉载荷；会话已没了就返回 False
+putPayload :: PayloadStore a -> Text -> a -> IO Bool
+putPayload store token payload = do
+    now <- psClock store
+    pol <- payloadPolicy store
+    modifyMVar (psStoreMap store) $ \m -> do
+        let kept = prunePayloads now pol m
+        pure $ case Map.lookup token kept of
+            Nothing -> (kept, False)
+            Just s -> (Map.insert token s{psSeen = now, psPayload = payload} kept, True)
+
+-- | 摘掉会话并把载荷交还
+dropPayload :: PayloadStore a -> Text -> IO (Maybe a)
+dropPayload store token = do
+    now <- psClock store
+    pol <- payloadPolicy store
+    modifyMVar (psStoreMap store) $ \m -> do
+        let kept = prunePayloads now pol m
+        pure $ case Map.lookup token kept of
+            Nothing -> (kept, Nothing)
+            Just s -> (Map.delete token kept, Just (psPayload s))
+
+-- | 清掉过期会话并把它们的载荷交还；调用者负责关掉这些载荷
+sweepPayloads :: PayloadStore a -> IO [a]
+sweepPayloads store = do
+    now <- psClock store
+    pol <- payloadPolicy store
+    modifyMVar (psStoreMap store) $ \m -> do
+        let (gone, kept) = Map.partition (payloadExpired now pol) m
+        pure (kept, map psPayload (Map.elems gone))

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

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Web.Config (
+module ChuSQL.Interface.Config (
     WebConfig (..),
     defaultWebConfig,
     defaultUser,
@@ -12,12 +12,14 @@ module ChuSQL.Web.Config (
     staticDirCandidates,
     rootUserName,
     canonicalSettingKeys,
-    resolvePipeName,
+    resolvePlainPassword,
+    ServerConfig (..),
+    defaultServerConfig,
+    loadServerConfigAt,
 ) where
 
-import ChuSQL.Storage.IPC (defaultPipeName)
+import ChuSQL.Interface.Auth (Credential (..), hashPassword)
-import ChuSQL.Web.Auth (Credential (..), hashPassword)
+import ChuSQL.Interface.TOML (readSection)
-import ChuSQL.Web.TOML (readSection)
 import Data.Char (toLower)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
@@ -26,11 +28,7 @@ import qualified Data.Text as T
 import System.Directory (doesDirectoryExist)
 import Text.Read (readMaybe)
 
--- 运行参数：命令行 > 全局 chusql.toml 的分区 > 内置默认，不看环境变量。
+-- Web 与 server 的运行参数：命令行 > chusql.toml 分区 > 内置默认。
--- 配置文件位置是固定的（安装时定下，见 ChuSQL.Web.TOML.defaultConfigFile），
--- 想读别处的文件只能在命令行用 --config 指。
--- 自己那段是 [web]；管名与数据目录取自 [server] pipe_name / [storage] data_dir，
--- 因为它们是存储进程的事实，前端只当端点读。root 凭据只认 [web] 里的明文。
 
 -- | 默认账号名
 defaultUser :: Text
@@ -40,13 +38,12 @@ defaultUser = "root"
 defaultPassword :: Text
 defaultPassword = "chusql"
 
+-- | Web 管理端配置
 data WebConfig = WebConfig
     { wcHost :: String
     , wcPort :: Int
     , wcStaticDir :: FilePath
     , wcUser :: Text
-    , wcStorageServer :: Maybe FilePath
-    , wcPipeName :: Maybe String
     , wcDataDir :: Maybe FilePath
     , wcCookieSecure :: Bool
     , wcBodyLimit :: Int
@@ -62,16 +59,14 @@ data WebConfig = WebConfig
     }
     deriving (Show, Eq)
 
--- | 内置默认
+-- | Web 管理端参数的内置默认值
 defaultWebConfig :: WebConfig
 defaultWebConfig =
     WebConfig
         { wcHost = "127.0.0.1"
-        , wcPort = 7777
+        , wcPort = 7778
         , wcStaticDir = "static"
         , wcUser = ""
-        , wcStorageServer = Nothing
-        , wcPipeName = Nothing
         , wcDataDir = Nothing
         , wcCookieSecure = False
         , wcBodyLimit = 65536
@@ -86,12 +81,12 @@ defaultWebConfig =
         , wcSeedDemo = False
         }
 
--- | [web] 分区里的键统一成连字符写法（scripts/chusql.toml 用的是下划线）
+-- | 把设置键统一成连字符写法，重名时连字符优先
---   两种写法同时出现时，连字符（设置页写的规范形式）优先。
 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)
 
 -- | 下划线写法到连字符写法的别名
@@ -109,22 +104,20 @@ keyAliases =
     , ("max_sql_length", "max-sql-length")
     , ("password_min_length", "password-min-length")
     , ("password_classes", "password-classes")
-    , ("storage_server", "storage-server")
     ]
 
--- | 这份配置用的还是内置默认口令吗。
+-- | 这份配置用的还是内置默认口令吗
---   显式留空（password = ""）是"只允许管理员免密登录"，算已经配置过。
 usingDefaultCredentials :: Map.Map Text Text -> Bool
 usingDefaultCredentials saved = Map.notMember "password" saved
 
 -- | 设置文件里某个键的非空值
 nonEmptyValue :: Text -> Map.Map Text Text -> Maybe Text
+-- | 查一个键
 nonEmptyValue key saved = case T.strip <$> Map.lookup key saved of
     Just value | not (T.null value) -> Just value
     _ -> Nothing
 
--- | root 凭据只认设置文件里的明文：给了明文就哈希它；显式留空就是免密（空编码串）；
+-- | root 凭据：明文就哈希，留空免密，缺省用演示口令
---   没配这一项才回落到内置演示口令。
 resolveCredential :: WebConfig -> Map.Map Text Text -> IO Credential
 resolveCredential cfg saved = do
     encoded <- case Map.lookup "password" saved of
@@ -133,32 +126,29 @@ resolveCredential cfg saved = do
         Nothing -> hashPassword defaultPassword
     pure (Credential (rootUserName cfg saved) encoded)
 
--- | 管理员名字：命令行 --user > 设置文件 user > 内置默认
+-- | 管理员名字：命令行 > 设置文件 > 内置默认
 rootUserName :: WebConfig -> Map.Map Text Text -> Text
 rootUserName cfg saved
     | not (T.null (T.strip (wcUser cfg))) = T.strip (wcUser cfg)
     | otherwise = fromMaybe defaultUser (nonEmptyValue "user" saved)
 
--- | 读配置：内置默认 < [web] 分区（端点取自 [server] / [storage]）。
+-- | 读配置：默认叠上 [web] 与 [storage]
---   user / password 不在这里读：它们由 rootUserName / resolveCredential 直接看设置文件。
 loadWebConfigAt :: FilePath -> IO WebConfig
 loadWebConfigAt path = do
     raw <- readSection path "web"
-    server <- readSection path "server"
     storage <- readSection path "storage"
-    pure (withEndpoint server storage (webConfigFromSection (canonicalSettingKeys raw)))
+    pure (withStorage storage (webConfigFromSection (canonicalSettingKeys raw)))
 
--- | 端点：存储进程 bind 的管名与它用的数据目录，前端只读不改
+-- | 数据目录取自 [storage] 段
-withEndpoint :: Map.Map Text Text -> Map.Map Text Text -> WebConfig -> WebConfig
+withStorage :: Map.Map Text Text -> WebConfig -> WebConfig
-withEndpoint server storage cfg =
+withStorage storage cfg =
-    cfg
+    cfg{wcDataDir = T.unpack <$> nonEmptyValue "data_dir" storage}
-        { wcPipeName = T.unpack <$> nonEmptyValue "pipe_name" server
-        , wcDataDir = T.unpack <$> nonEmptyValue "data_dir" storage
-        }
 
--- | 实际要连的管名：配置里没有就用与存储层一致的默认值
+-- | 管理员明文口令，没配回落到演示口令，显式留空回空串
-resolvePipeName :: WebConfig -> String
+resolvePlainPassword :: Map.Map Text Text -> Text
-resolvePipeName cfg = fromMaybe defaultPipeName (wcPipeName cfg)
+resolvePlainPassword saved = case Map.lookup "password" saved of
+    Just plain -> T.strip plain
+    Nothing -> defaultPassword
 
 -- | [web] 分区里的启动参数，缺失或坏值一律回到内置默认
 webConfigFromSection :: Map.Map Text Text -> WebConfig
@@ -178,7 +168,6 @@ webConfigFromSection saved =
         , wcMaxRows = sectionInt "max-rows" saved (wcMaxRows defaultWebConfig)
         , wcMaxSqlLength = sectionInt "max-sql-length" saved (wcMaxSqlLength defaultWebConfig)
         , wcSeedDemo = sectionBool "seed" saved (wcSeedDemo defaultWebConfig)
-        , wcStorageServer = T.unpack <$> nonEmptyValue "storage-server" saved
         }
 
 -- | 分区里一个键的非空字符串值
@@ -204,7 +193,41 @@ staticDirCandidates given =
 resolveStaticDir :: FilePath -> IO (Maybe FilePath)
 resolveStaticDir given = go (staticDirCandidates given)
   where
+    -- | 逐个试
     go [] = pure Nothing
     go (d : ds) = do
         ok <- doesDirectoryExist d
         if ok then pure (Just d) else go ds
+
+-- | 服务器监听参数
+data ServerConfig = ServerConfig
+    { scHost :: String
+    , scPort :: Int
+    , scMaxMessage :: Int
+    , scMaxRows :: Int
+    }
+    deriving (Eq, Show)
+
+-- | 默认本机 7777，行 1 MiB，最多 1000 行
+defaultServerConfig :: ServerConfig
+defaultServerConfig = ServerConfig "127.0.0.1" 7777 (1024 * 1024) 1000
+
+-- | 读 [server] 段键，缺的用默认
+loadServerConfigAt :: FilePath -> IO ServerConfig
+loadServerConfigAt path = do
+    values <- readSection path "server"
+    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
+    pure
+        defaultServerConfig
+            { scHost = textOf "host" (scHost defaultServerConfig)
+            , scPort = intOf "port" (scPort defaultServerConfig)
+            , scMaxMessage = intOf "max_message" (scMaxMessage defaultServerConfig)
+            , scMaxRows = intOf "max_rows" (scMaxRows defaultServerConfig)
+            }

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

@@ -0,0 +1,221 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Interface.Link (
+    Client,
+    connectClient,
+    closeClient,
+    clientLogin,
+    clientQuery,
+    clientPing,
+    clientCatalog,
+    clientDatabases,
+    clientRoles,
+    clientAccounts,
+    clientPolicy,
+    clientReloadPolicy,
+) where
+
+import ChuSQL.Core.Protocol (Account, QueryResult (..), TableInfo (..))
+import ChuSQL.Interface.Protocol (
+    ClientRequest (..),
+    RoleView,
+    ServerResponse (..),
+    decodeResponse,
+    encodeRequest,
+    protocolVersion,
+ )
+import Control.Concurrent.MVar (MVar, newMVar, withMVar)
+import Control.Exception (IOException, try)
+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 (
+    AddrInfo (..),
+    SocketType (Stream),
+    addrAddress,
+    addrFamily,
+    connect,
+    defaultHints,
+    defaultProtocol,
+    getAddrInfo,
+    socket,
+    socketToHandle,
+ )
+import System.IO (BufferMode (LineBuffering), Handle, IOMode (ReadWriteMode), hClose, hFlush, hSetBuffering, hSetNewlineMode, noNewlineTranslation)
+import System.IO.Error (isEOFError)
+
+-- 前端到 server 的 TCP 链路：一行一条 JSON，命令行与 Web 端共用。
+
+-- | 一条已连上、已对过协议版本的连接
+data Client = Client
+    { clHandle :: Handle
+    , clLock :: MVar ()
+    }
+
+-- | 连上 server 并对协议版本，失败给人话错误
+connectClient :: Text -> Int -> IO (Either Text Client)
+connectClient host port = do
+    opened <- try (openConnection host port) :: IO (Either IOException Handle)
+    case opened of
+        Left err -> pure (Left ("cannot reach the server at " <> T.pack (address host port) <> ": " <> T.pack (describe err)))
+        Right handle -> do
+            lock <- newMVar ()
+            let client = Client handle lock
+            greeted <- request client (ReqHello protocolVersion)
+            case greeted of
+                Right (RespHello version)
+                    | version == protocolVersion -> pure (Right client)
+                    | otherwise ->
+                        giveUp handle
+                            ( "server "
+                                <> T.pack (address host port)
+                                <> " speaks protocol "
+                                <> T.pack (show version)
+                                <> ", this client needs "
+                                <> T.pack (show protocolVersion)
+                            )
+                Right (RespError code message) -> giveUp handle (code <> ": " <> message)
+                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)
+
+-- | 断开连接；重复调用不报错
+closeClient :: Client -> IO ()
+closeClient client = do
+    _ <- try (hClose (clHandle client)) :: IO (Either IOException ())
+    pure ()
+
+-- | 一行请求一行响应；同一条连接上的请求串起来发
+request :: Client -> ClientRequest -> IO (Either Text ServerResponse)
+request client message = withMVar (clLock client) $ \_ -> do
+    outcome <- try (exchange (clHandle client) message) :: IO (Either IOException (Either Text ServerResponse))
+    pure $ case outcome of
+        Left err -> Left (T.pack (describe err))
+        Right answer -> answer
+
+-- | 在句柄上发一行请求、读回一行响应
+exchange :: Handle -> ClientRequest -> IO (Either Text ServerResponse)
+exchange handle message = do
+    BLC.hPutStr handle (encodeRequest message)
+    BLC.hPutStr handle "\n"
+    hFlush handle
+    line <- BSC.hGetLine handle
+    pure (decodeResponse (BL.fromStrict line))
+
+-- | 登录；成功返回是不是管理员
+clientLogin :: Client -> Text -> Text -> IO (Either Text Bool)
+clientLogin client user password = do
+    answer <- request client (ReqLogin user password)
+    case answer of
+        Left message -> pure (Left message)
+        Right (RespLogin _ admin) -> pure (Right admin)
+        Right other -> pure (failed "login" other)
+
+-- | 跑一条语句，拿回结果集
+clientQuery :: Client -> Text -> IO (Either Text QueryResult)
+clientQuery client sql = do
+    answer <- request client (ReqQuery sql)
+    case answer of
+        Left message -> pure (Left message)
+        Right (RespResult result) -> pure (Right result)
+        Right other -> pure (failed "a query" other)
+
+-- | 探活
+clientPing :: Client -> IO (Either Text ())
+clientPing client = do
+    answer <- request client ReqPing
+    case answer of
+        Left message -> pure (Left message)
+        Right RespPong -> pure (Right ())
+        Right other -> pure (failed "a ping" other)
+
+-- | 数据字典（\\dt 与 \\d 用）
+clientCatalog :: Client -> IO (Either Text [TableInfo])
+clientCatalog client = do
+    answer <- request client ReqCatalog
+    case answer of
+        Left message -> pure (Left message)
+        Right (RespCatalog infos) -> pure (Right infos)
+        Right other -> pure (failed "a catalog" other)
+
+-- | 库清单（\\l 用）
+clientDatabases :: Client -> IO (Either Text [Text])
+clientDatabases client = do
+    answer <- request client ReqDatabases
+    case answer of
+        Left message -> pure (Left message)
+        Right (RespDatabases names) -> pure (Right names)
+        Right other -> pure (failed "a database list" other)
+
+-- | 角色总览（\\dr 用）
+clientRoles :: Client -> IO (Either Text [RoleView])
+clientRoles client = do
+    answer <- request client ReqRoles
+    case answer of
+        Left message -> pure (Left message)
+        Right (RespRoles roles) -> pure (Right roles)
+        Right other -> pure (failed "a role list" other)
+
+-- | 账号清单（\\du 与管理页用）
+clientAccounts :: Client -> IO (Either Text [Account])
+clientAccounts client = do
+    answer <- request client ReqAccounts
+    case answer of
+        Left message -> pure (Left message)
+        Right (RespAccounts accounts) -> pure (Right accounts)
+        Right other -> pure (failed "an account list" other)
+
+-- | 当前生效的口令策略（最短长度、至少几类字符）
+clientPolicy :: Client -> IO (Either Text (Int, Int))
+clientPolicy client = do
+    answer <- request client ReqPolicy
+    case answer of
+        Left message -> pure (Left message)
+        Right (RespPolicy minLength classes) -> pure (Right (minLength, classes))
+        Right other -> pure (failed "a password policy" other)
+
+-- | 让 server 重读它自己的设置文件并换上新的口令策略
+clientReloadPolicy :: Client -> IO (Either Text (Int, Int))
+clientReloadPolicy client = do
+    answer <- request client ReqReloadPolicy
+    case answer of
+        Left message -> pure (Left message)
+        Right (RespPolicy minLength classes) -> pure (Right (minLength, classes))
+        Right other -> pure (failed "a password policy reload" other)
+
+-- | 应答形状对不上时的错误，error 应答取码与说明
+failed :: Text -> ServerResponse -> Either Text a
+failed what response = case response of
+    RespError code message -> Left (code <> ": " <> message)
+    _ -> Left ("unexpected response to " <> what)
+
+-- | 建连接（套接字转成文本模式的行缓冲句柄）
+openConnection :: Text -> Int -> IO Handle
+openConnection host port = do
+    let hints = defaultHints{addrSocketType = Stream}
+    infos <- getAddrInfo (Just hints) (Just (T.unpack host)) (Just (show port))
+    case infos of
+        [] -> ioError (userError ("cannot resolve server address: " ++ address host port))
+        (info : _) -> do
+            sock <- socket (addrFamily info) Stream defaultProtocol
+            connect sock (addrAddress info)
+            handle <- socketToHandle sock ReadWriteMode
+            hSetBuffering handle LineBuffering
+            hSetNewlineMode handle noNewlineTranslation
+            pure handle
+
+-- | 把主机端口拼成地址字样
+address :: Text -> Int -> String
+address host port = T.unpack host ++ ":" ++ show port
+
+-- | 断线给人的说法：EOF 就是 server 把连接关了
+describe :: IOException -> String
+describe err
+    | isEOFError err = "the server closed the connection"
+    | otherwise = show err

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

@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Interface.Policy (
+    PasswordPolicy (..),
+    defaultPasswordPolicy,
+    passwordKeys,
+    policyFromValues,
+) where
+
+import ChuSQL.Interface.Settings (defaultOf)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.Read (readMaybe)
+
+-- 口令策略值与策略计算，服务端与 Web 管理端共用。
+
+-- | 口令策略：最短长度与至少几类字符
+data PasswordPolicy = PasswordPolicy
+    { ppMinLength :: Int
+    , ppClasses :: Int
+    }
+    deriving (Show, Eq)
+
+-- | 默认：至少 12 个字符、至少两类字符
+defaultPasswordPolicy :: PasswordPolicy
+defaultPasswordPolicy = PasswordPolicy 12 2
+
+-- | 设置文件里决定口令策略的键
+passwordKeys :: [Text]
+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))
+  where
+    -- | 取一个键的数值，缺项或空值回落到给定默认
+    number key fallback = case Map.lookup key values of
+        Nothing -> fallback
+        Just value -> fromMaybe fallback (readMaybe (T.unpack (if T.null value then defaultOf key else value)))

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

@@ -0,0 +1,248 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Interface.Protocol (
+    protocolVersion,
+    serverName,
+    ClientRequest (..),
+    ServerResponse (..),
+    decodeRequest,
+    encodeRequest,
+    encodeResponse,
+    decodeResponse,
+    Grant (..),
+    RoleView (..),
+) where
+
+import ChuSQL.Core.Protocol (Account (..), QueryResult (..), TableInfo (..), queryResultJson)
+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 qualified Data.ByteString.Char8 as BSC
+import qualified Data.ByteString.Lazy as BL
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+-- server 线上协议的编解码：一行一条 JSON（UTF-8）。
+
+-- | 一条角色授权：角色 + 具体权限 + 对象
+data Grant = Grant
+    { grantRole :: Text
+    , grantPrivilege :: Text
+    , grantObject :: Text
+    }
+    deriving (Show, Eq, Ord)
+
+-- | 一个角色的全貌
+data RoleView = RoleView
+    { roleName :: Text
+    , roleGrants :: [Grant]
+    , roleMembers :: [Text]
+    }
+    deriving (Show, Eq)
+
+-- | 一条授权转成 JSON
+instance ToJSON Grant where
+    toJSON grant =
+        object
+            [ "role" .= grantRole grant
+            , "privilege" .= grantPrivilege grant
+            , "object" .= grantObject grant
+            ]
+
+-- | 从 JSON 读一条授权
+instance FromJSON Grant where
+    parseJSON = withObject "Grant" $ \o ->
+        Grant <$> o .: "role" <*> o .: "privilege" <*> o .: "object"
+
+-- | 一个角色转成 JSON
+instance ToJSON RoleView where
+    toJSON view =
+        object
+            [ "role" .= roleName view
+            , "grants" .= roleGrants view
+            , "members" .= roleMembers view
+            ]
+
+-- | 从 JSON 读一个角色
+instance FromJSON RoleView where
+    parseJSON = withObject "RoleView" $ \o ->
+        RoleView
+            <$> o .: "role"
+            <*> o .:? "grants" .!= []
+            <*> o .:? "members" .!= []
+
+-- | 协议版本；对不上就报协议错误
+protocolVersion :: Int
+protocolVersion = 1
+
+-- | server 名字，握手时回给客户端
+serverName :: Text
+serverName = "chusql-server"
+
+-- | 客户端请求
+data ClientRequest
+    = ReqHello Int
+    | ReqLogin Text Text
+    | ReqQuery Text
+    | ReqPing
+    | ReqQuit
+    | ReqStorage Value
+    | ReqCatalog
+    | ReqDatabases
+    | ReqRoles
+    | ReqAccounts
+    | ReqPolicy
+    | ReqReloadPolicy
+    deriving (Eq, Show)
+
+-- | 线上请求的原始字段
+data WireRequest = WireRequest
+    { wrMethod :: Text
+    , wrProtocol :: Maybe Int
+    , wrUser :: Maybe Text
+    , wrPassword :: Maybe Text
+    , wrSql :: Maybe Text
+    , wrRequest :: Maybe Value
+    }
+
+-- | 从 JSON 读原始请求字段
+instance A.FromJSON WireRequest where
+    parseJSON = A.withObject "request" $ \o ->
+        WireRequest
+            <$> o A..: "method"
+            <*> o A..:? "protocol"
+            <*> o A..:? "user"
+            <*> o A..:? "password"
+            <*> o A..:? "sql"
+            <*> o A..:? "request"
+
+-- | 请求解码：方法名走 method 标签
+decodeRequest :: BSC.ByteString -> Either Text ClientRequest
+decodeRequest raw = case A.eitherDecodeStrict raw of
+    Left _ -> Left "request is not valid JSON"
+    Right wire -> case T.toLower (T.strip (wrMethod wire)) of
+        "hello" -> Right (ReqHello (fromMaybe protocolVersion (wrProtocol wire)))
+        "login" -> case (wrUser wire, wrPassword wire) of
+            (Just user, Just password) -> Right (ReqLogin user password)
+            _ -> Left "login needs both user and password"
+        "query" -> maybe (Left "query needs sql") (Right . ReqQuery) (wrSql wire)
+        "storage" -> maybe (Left "storage needs request") (Right . ReqStorage) (wrRequest wire)
+        "catalog" -> Right ReqCatalog
+        "databases" -> Right ReqDatabases
+        "roles" -> Right ReqRoles
+        "accounts" -> Right ReqAccounts
+        "policy" -> Right ReqPolicy
+        "reload-policy" -> Right ReqReloadPolicy
+        "ping" -> Right ReqPing
+        "quit" -> Right ReqQuit
+        other -> Left ("unknown method: " <> other)
+
+-- | 客户端侧的请求编码（一行一条 JSON，不带换行）
+encodeRequest :: ClientRequest -> BL.ByteString
+encodeRequest = A.encode . requestJson
+
+-- | 客户端请求转 JSON；方法名走 method 标签
+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]
+    ReqQuery sql -> object ["method" .= ("query" :: Text), "sql" .= sql]
+    ReqPing -> object ["method" .= ("ping" :: Text)]
+    ReqQuit -> object ["method" .= ("quit" :: Text)]
+    ReqStorage payload -> object ["method" .= ("storage" :: Text), "request" .= payload]
+    ReqCatalog -> object ["method" .= ("catalog" :: Text)]
+    ReqDatabases -> object ["method" .= ("databases" :: Text)]
+    ReqRoles -> object ["method" .= ("roles" :: Text)]
+    ReqAccounts -> object ["method" .= ("accounts" :: Text)]
+    ReqPolicy -> object ["method" .= ("policy" :: Text)]
+    ReqReloadPolicy -> object ["method" .= ("reload-policy" :: Text)]
+
+-- | 服务端响应
+data ServerResponse
+    = RespHello Int
+    | RespLogin Text Bool
+    | RespResult QueryResult
+    | RespPong
+    | RespBye
+    | RespError Text Text
+    | RespStorage Value
+    | RespCatalog [TableInfo]
+    | RespDatabases [Text]
+    | RespRoles [RoleView]
+    | RespAccounts [Account]
+    | RespPolicy Int Int
+    deriving (Eq, Show)
+
+-- | 响应转 JSON；结果集只多一个 status 字段
+encodeResponse :: ServerResponse -> BL.ByteString
+encodeResponse = A.encode . responseJson
+
+-- | 服务端响应转 JSON；结果集只是多一个 status 字段
+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]
+    RespPong -> object ["status" .= ("pong" :: Text)]
+    RespBye -> object ["status" .= ("bye" :: Text)]
+    RespError code message -> object ["status" .= ("error" :: Text), "code" .= code, "message" .= message]
+    RespStorage value -> object ["status" .= ("storage" :: Text), "response" .= value]
+    RespCatalog infos -> object ["status" .= ("catalog" :: Text), "schemas" .= infos]
+    RespDatabases names -> object ["status" .= ("databases" :: Text), "databases" .= names]
+    RespRoles roleList -> object ["status" .= ("roles" :: Text), "roles" .= roleList]
+    RespAccounts accountList -> object ["status" .= ("accounts" :: Text), "accounts" .= accountList]
+    RespPolicy minLength classes -> object ["status" .= ("policy" :: Text), "minLength" .= minLength, "classes" .= classes]
+    RespResult result -> case queryResultJson result of
+        A.Object fields -> A.Object (KM.insert "status" (A.String "result") fields)
+        other -> other
+
+-- | 响应解码（客户端用）
+decodeResponse :: BL.ByteString -> Either Text ServerResponse
+decodeResponse raw = case A.eitherDecode raw of
+    Left _ -> Left "response is not valid JSON"
+    Right (A.Object fields) -> case KM.lookup "status" fields of
+        Just (A.String status) -> decodeStatus status fields
+        _ -> Left "response is missing status"
+    Right _ -> Left "response is not a JSON object"
+  where
+    -- | 按 status 字段分派
+    decodeStatus status fields = case status of
+        "hello" -> Right (RespHello (intOf "protocol" fields))
+        "ok" -> Right (RespLogin (textOf "user" fields) (boolOf "admin" fields))
+        "pong" -> Right RespPong
+        "bye" -> Right RespBye
+        "error" -> Right (RespError (textOf "code" fields) (textOf "message" fields))
+        "storage" -> case KM.lookup "response" fields of
+            Just value -> Right (RespStorage value)
+            Nothing -> Left "storage response is missing response"
+        "result" -> case A.fromJSON (A.Object fields) of
+            A.Success result -> Right (RespResult result)
+            A.Error message -> Left (T.pack message)
+        "catalog" -> fromField "schemas" RespCatalog fields
+        "databases" -> fromField "databases" RespDatabases fields
+        "roles" -> fromField "roles" RespRoles fields
+        "accounts" -> fromField "accounts" RespAccounts fields
+        "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 key wrap fields = case A.fromJSON (fromMaybe A.Null (KM.lookup (AK.fromText key) fields)) of
+        A.Success value -> Right (wrap value)
+        A.Error message -> Left (T.pack message)
+
+    -- | 取一个整数字段
+    intOf key fields = case KM.lookup key fields of
+        Just (A.Number number) -> truncate number
+        _ -> 0
+
+    -- | 取一个文本字段
+    textOf key fields = case KM.lookup key fields of
+        Just (A.String text) -> text
+        _ -> ""
+
+    -- | 取一个布尔字段
+    boolOf key fields = case KM.lookup key fields of
+        Just (A.Bool flag) -> flag
+        _ -> False

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

@@ -1,4 +1,4 @@
-module ChuSQL.Web.RateLimit (
+module ChuSQL.Interface.RateLimit (
     RateLimiter,
     newRateLimiter,
     setRateLimit,
@@ -15,16 +15,19 @@ import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime)
 
 -- 登录失败限流：按用户名数一个滑动窗口里的失败次数。
 
+-- | 一个键的失败计数与窗口起点
 data Attempt = Attempt
     { attCount :: Int
     , attStart :: UTCTime
     }
 
+-- | 限流阈值：次数上限与窗口长度
 data RateLimitPolicy = RateLimitPolicy
     { rlpMax :: Int
     , rlpWindow :: NominalDiffTime
     }
 
+-- | 限流器：计数表、阈值与时钟
 data RateLimiter = RateLimiter
     { rlMap :: MVar (Map.Map Text Attempt)
     , rlPolicy :: IORef RateLimitPolicy

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

@@ -0,0 +1,110 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Interface.Session (
+    Session,
+    newSession,
+    sessionIsAdmin,
+    sessionDatabase,
+    isPlainIdentifier,
+    authenticateSession,
+    switchDatabase,
+    runStatement,
+    catalog,
+    databases,
+    roleViews,
+    accounts,
+) where
+
+import ChuSQL.Core.Protocol (Account, QueryResult (..), TableInfo)
+import ChuSQL.Interface.Link (
+    Client,
+    clientAccounts,
+    clientCatalog,
+    clientDatabases,
+    clientLogin,
+    clientQuery,
+    clientRoles,
+ )
+import ChuSQL.Interface.Protocol (RoleView)
+import Data.Char (isAlpha, isAlphaNum)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+-- 前端会话：本地记登录态与当前库，语句答案全部来自 server。
+
+-- | 一个前端会话：连接、当前库与管理员标记
+data Session = Session
+    { ssClient :: Client
+    , ssCurrent :: IORef Text
+    , ssAdmin :: IORef Bool
+    }
+
+-- | 开一个前端会话：登录之前没有管理员身份，也没有选中的库
+newSession :: Client -> IO Session
+newSession client = Session client <$> newIORef "" <*> newIORef False
+
+-- | 是不是管理员（由登录结果决定）
+sessionIsAdmin :: Session -> IO Bool
+sessionIsAdmin = readIORef . ssAdmin
+
+-- | 当前库
+sessionDatabase :: Session -> IO Text
+sessionDatabase = readIORef . ssCurrent
+
+-- | 与解析器一致的裸标识符判断
+isPlainIdentifier :: Text -> Bool
+isPlainIdentifier name =
+    not (T.null name)
+        && T.length name <= 64
+        && (isAlpha (T.head name) || T.head name == '_')
+        && T.all (\ch -> isAlphaNum ch || ch == '_') name
+
+-- | 登录：身份由 server 判定，这里只把管理员标记记下来
+authenticateSession :: Session -> Text -> Text -> IO (Either Text ())
+authenticateSession session user password = do
+    answer <- clientLogin (ssClient session) user password
+    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
+    | not (isPlainIdentifier name) = pure (Left ("not a plain database name: " <> name))
+    | otherwise = do
+        answer <- runStatement session ("USE " <> name)
+        case answer of
+            Left message -> pure (Left message)
+            Right _ -> pure (Right ())
+  where
+    -- | 规范化后的库名
+    name = T.toLower (T.strip rawName)
+
+-- | 跑一条语句；结果集里带回的当前库口径跟着一起更新
+runStatement :: Session -> Text -> IO (Either Text QueryResult)
+runStatement session sql = do
+    answer <- clientQuery (ssClient session) sql
+    case answer of
+        Left message -> pure (Left message)
+        Right result -> do
+            case qrDatabase result of
+                Just name -> writeIORef (ssCurrent session) name
+                Nothing -> pure ()
+            pure (Right result)
+
+-- | 数据字典（\\dt 与 \\d 用）
+catalog :: Session -> IO (Either Text [TableInfo])
+catalog session = clientCatalog (ssClient session)
+
+-- | 库清单（\\l 用）
+databases :: Session -> IO (Either Text [Text])
+databases session = clientDatabases (ssClient session)
+
+-- | 角色总览（\\dr 用）
+roleViews :: Session -> IO (Either Text [RoleView])
+roleViews session = clientRoles (ssClient session)
+
+-- | 账号清单（\\du 与管理页用）
+accounts :: Session -> IO (Either Text [Account])
+accounts session = clientAccounts (ssClient session)

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

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Web.Settings (
+module ChuSQL.Interface.Settings (
     SettingItem (..),
     settingCatalogue,
     findItem,
@@ -15,16 +15,16 @@ module ChuSQL.Web.Settings (
     effectiveSettings,
 ) where
 
-import ChuSQL.Web.Config (WebConfig (..), canonicalSettingKeys, defaultUser)
+import ChuSQL.Interface.Config (WebConfig (..), canonicalSettingKeys, defaultUser)
-import ChuSQL.Web.TOML (readSection, writeSection)
+import ChuSQL.Interface.TOML (readSection, writeSection)
 import Data.List (nub)
 import qualified Data.Map.Strict as Map
 import Data.Text (Text)
 import qualified Data.Text as T
 
--- Web 配置项目录，与启动脚本共用一份全局 chusql.toml；
+-- 设置目录，以及全局 chusql.toml 的读、写与校验。
--- 每个键只写在它所属的那一段里，web 不再复制存储层的键。
 
+-- | 一个可配置项
 data SettingItem = SettingItem
     { siKey :: Text
     , siLabel :: Text
@@ -38,10 +38,10 @@ data SettingItem = SettingItem
     }
     deriving (Show, Eq)
 
--- | 全部可配置项（顺序即界面里的顺序）
+-- | 全部可配置项与界面顺序
 settingCatalogue :: [SettingItem]
 settingCatalogue =
-    [ item "port" "HTTP port" "server" "int" "7777" True True
+    [ item "port" "HTTP port" "server" "int" "7778" True True
     , item "host" "Listen address" "server" "text" "127.0.0.1" True True
     , item "static-dir" "Static directory" "server" "text" "static" True True
     , item "cookie-secure" "Secure cookie (behind TLS)" "server" "bool" "0" True False
@@ -59,16 +59,18 @@ settingCatalogue =
     , item "password-min-length" "口令最短长度" "auth" "int" "12" True False
     , item "password-classes" "口令字符类别数" "auth" "int" "2" True False
     , owned "data-dir" "Data directory" "storage" "text" "" "storage" "data_dir"
-    , owned "pipe-name" "Endpoint name" "storage" "text" "" "server" "pipe_name"
     , owned "storage-page-size" "Storage page size" "storage" "int" "4096" "page" "size"
     , 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 "storage-server" "Storage server executable" "storage" "text" "" True True
     , item "seed" "Seed demo data on start" "storage" "bool" "1" True True
+    , owned "tcp-host" "TCP listen address" "network" "text" "127.0.0.1" "server" "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]，TOML 键名就是界面键名
+    -- | web 自己的键：分区写死 [web]
     item k l g kind def rootOnly restart =
         SettingItem
             { siKey = k
@@ -95,11 +97,11 @@ settingCatalogue =
             , siTomlKey = tomlKey
             }
 
--- | web 自己那段
+-- | web 自己的分区名
 webSection :: Text
 webSection = "web"
 
--- | 目录里涉及的分区（按出现顺序，去重）
+-- | 目录里涉及的分区，去重
 catalogueSections :: [Text]
 catalogueSections = nub [siSection i | i <- settingCatalogue]
 
@@ -113,7 +115,7 @@ findItem key = case [i | i <- settingCatalogue, siKey i == key] of
 isRootOnly :: Text -> Bool
 isRootOnly key = maybe False siRootOnly (findItem key)
 
--- | 只读项：root 凭据只认设置文件里的明文，网页端不能改（改文件后重启生效）
+-- | 网页端不能改的键
 lockedKeys :: [Text]
 lockedKeys = ["user", "password"]
 
@@ -140,10 +142,11 @@ liveKeys =
     , "max-sql-length"
     ]
 
--- | 读目录里用到的每个分区，摊成界面键；只有 [web] 统一成连字符写法
+-- | 读目录里用到的每个分区，摊成界面键
 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
@@ -156,10 +159,11 @@ 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 =
@@ -177,10 +181,11 @@ writeSettingsFile path values = writeSections catalogueSections
                     Left err -> pure (Left err)
                     Right () -> writeSections rest
 
--- | 把界面上传来的值合并进现有文件内容（只接受目录里有的键）
+-- | 把界面传来的值合并进现有内容，只认目录里的键
 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
@@ -189,7 +194,7 @@ applySettings current = go (Right current) . Map.toList
             Left e -> Left e
             Right () -> go (Right (Map.insert key value acc)) rest
 
--- | 按类型校验一个值（空串表示"清掉"，一律放行）
+-- | 按类型校验一个值，空串一律放行
 checkKind :: SettingItem -> Text -> Either String ()
 checkKind spec value
     | T.null (T.strip value) = Right ()
@@ -205,7 +210,7 @@ checkKind spec value
         _ -> Left (T.unpack (siKey spec) ++ " needs a boolean, got: " ++ T.unpack value)
     | otherwise = Right ()
 
--- | 一项的内置默认值（设置被清掉、也没有别处给值时用它）
+-- | 一项的内置默认值
 defaultOf :: Text -> Text
 defaultOf key = maybe "" siDefault (findItem key)
 
@@ -229,9 +234,10 @@ effectiveSettings cfg =
         , ("user", if T.null (T.strip (wcUser cfg)) then defaultUser else T.strip (wcUser cfg))
         , ("seed", boolText (wcSeedDemo cfg))
         , ("data-dir", maybe "" T.pack (wcDataDir cfg))
-        , ("pipe-name", maybe "" T.pack (wcPipeName cfg))
         ]
   where
+    -- | 数值转文本
     tshow = T.pack . show
+    -- | 布尔转 "1"/"0"
     boolText True = "1"
     boolText False = "0"

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

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Web.TOML
+module ChuSQL.Interface.TOML
     ( readSection
     , writeSection
     , defaultConfigFile
@@ -19,7 +19,6 @@ import System.Directory (XdgDirectory (XdgConfig), createDirectoryIfMissing, doe
 import System.FilePath (takeDirectory, (</>))
 
 -- 全局 chusql.toml 的最小读写：只认 [section] 与 key = value。
--- 读写都是一次性打开就关，不长期占着文件句柄，别的层随时能读同一份文件。
 
 -- | 读一个分区；文件不存在或没有这个分区都当空表
 readSection :: FilePath -> Text -> IO (Map Text Text)
@@ -44,6 +43,7 @@ writeSection path section values = do
             written <- tryWrite (TE.encodeUtf8 updated)
             pure written
   where
+    -- | 目录不存在就先建
     prepareDirectory = do
         let dir = takeDirectory path
         if null dir
@@ -51,6 +51,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)
@@ -59,6 +60,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
@@ -89,6 +91,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 = []
@@ -103,12 +106,15 @@ unquote value
     | T.length value >= 2 && T.head value == '\'' && T.last value == '\'' = T.drop 1 (T.dropEnd 1 value)
     | otherwise = 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))
+    -- | 在目标分区里就地换行
     replaceInSection = go ""
+    -- | 走到目标分区后逐行替换
     go _ [] = []
     go current (line : rest)
         | Just name <- sectionName line = line : go name rest
@@ -116,25 +122,30 @@ 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)]
          in if null missing then lines' else appendSection section missing lines'
 
+-- | 拼一行 key = value
 assignmentLine :: Text -> Text -> Text
 assignmentLine key value = key <> " = " <> quote value
 
+-- | 需要时才加引号
 quote :: Text -> Text
 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
@@ -150,14 +161,13 @@ appendSection section entries lines' =
         ++ (if null lines' || not (T.null (last lines')) then [""] else [])
         ++ ("[" <> section <> "]") : [assignmentLine key value | (key, value) <- entries]
 
--- | 全局配置文件的位置：安装时定下的固定路径，跟随系统惯例
+-- | 全局配置文件的固定路径，跟随系统惯例
--- （Windows: %APPDATA%\ChuSQL\chusql.toml；其它平台: $XDG_CONFIG_HOME 或 ~/.config 下的 ChuSQL/chusql.toml）
 defaultConfigFile :: IO FilePath
 defaultConfigFile = do
     dir <- getXdgDirectory XdgConfig "ChuSQL"
     pure (dir </> "chusql.toml")
 
--- | 定位配置文件：命令行 --config 指的是哪份就读哪份，否则用固定路径
+-- | 定位配置文件：命令行 --config 优先，否则用固定路径
 resolveConfigPath :: Maybe FilePath -> IO FilePath
 resolveConfigPath (Just path) = pure path
 resolveConfigPath Nothing = defaultConfigFile

chusql-interface/stack.yaml

@@ -0,0 +1,5 @@
+resolver: lts-24.59
+
+packages:
+- .
+- ../chusql-core/model

chusql-interface/stack.yaml.lock

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

chusql-server/app/Main.hs

@@ -0,0 +1,223 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main (main) where
+
+import ChuSQL.Core.Engine.Storage.FFI (storageVersion)
+import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, setStorageLink)
+import ChuSQL.Interface.Auth (Credential (..))
+import ChuSQL.Interface.Config (
+    WebConfig (..),
+    defaultPassword,
+    defaultUser,
+    loadWebConfigAt,
+    resolveCredential,
+    usingDefaultCredentials,
+ )
+import ChuSQL.Interface.RateLimit (newRateLimiter)
+import ChuSQL.Interface.Settings (readSettingsFile)
+import ChuSQL.Interface.TOML (resolveConfigPath)
+import ChuSQL.Server.Backend (Backend (..), ipcBackend)
+import ChuSQL.Server.TCP (
+    ServerConfig (..),
+    ServerEnv,
+    loadServerConfigAt,
+    newServerEnv,
+    runServer,
+ )
+import Control.Exception (IOException, bracket, try)
+import qualified Data.Map.Strict as Map
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Clock (getCurrentTime)
+import System.Environment (getArgs)
+import System.Exit (exitFailure)
+import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
+import Text.Read (readMaybe)
+
+-- TCP 服务器入口：解析命令行与配置，装入存储库并以一行一 JSON 的协议对外服务。
+
+data Options = Options
+    { optConfig :: Maybe FilePath
+    , optHost :: Maybe String
+    , optPort :: Maybe Int
+    , optUser :: Maybe Text
+    , optMaxMessage :: Maybe Int
+    , optMaxRows :: Maybe Int
+    , optHelp :: Bool
+    }
+
+-- | 全部选项都取默认值
+emptyOptions :: Options
+emptyOptions =
+    Options
+        { optConfig = Nothing
+        , optHost = Nothing
+        , optPort = Nothing
+        , optUser = Nothing
+        , optMaxMessage = Nothing
+        , optMaxRows = Nothing
+        , optHelp = False
+        }
+
+-- | 解析参数
+parseArgs :: [String] -> Either String Options
+parseArgs = go emptyOptions
+  where
+    -- | 逐条消费参数列表
+    go opts [] = Right opts
+    go opts ("--help" : rest) = go opts{optHelp = True} rest
+    go opts ("-h" : rest) = go opts{optHelp = True} rest
+    go opts ("--config" : v : rest) = go opts{optConfig = Just v} rest
+    go opts ("--host" : v : rest) = go opts{optHost = Just v} rest
+    go opts ("--user" : v : rest) = go opts{optUser = Just (T.pack v)} rest
+    go opts ("--port" : v : rest) = withInt "--port" v (\n -> go opts{optPort = Just n} rest)
+    go opts ("--max-message" : v : rest) = withInt "--max-message" v (\n -> go opts{optMaxMessage = Just n} rest)
+    go opts ("--max-rows" : v : rest) = withInt "--max-rows" v (\n -> go opts{optMaxRows = Just n} rest)
+    go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a)
+
+    -- | 把参数值读成整数，读不出就报错
+    withInt :: String -> String -> (Int -> Either String Options) -> Either String Options
+    withInt name v k = maybe (Left (name ++ " needs an integer, got: " ++ v)) k (readMaybe v)
+
+-- | 打印用法说明
+usage :: IO ()
+usage = do
+    putStrLn "usage: chusql-server [options]"
+    putStrLn ""
+    putStrLn "config: chusql.toml sits at a fixed place and holds every knob;"
+    putStrLn "        Windows: %APPDATA%\\ChuSQL\\chusql.toml"
+    putStrLn "        other:   $XDG_CONFIG_HOME/ChuSQL/chusql.toml (or ~/.config/ChuSQL/chusql.toml)"
+    putStrLn "        [storage] data_dir; [server] host/port/max_message/max_rows;"
+    putStrLn "        [web] user/password (administrator credentials)"
+    putStrLn ""
+    putStrLn "  --config FILE          read that config file instead"
+    putStrLn "  --host H               listen address              ([server] host, default 127.0.0.1)"
+    putStrLn "  --port N               listen port                 ([server] port, default 7777)"
+    putStrLn "  --user NAME            administrator name          ([web] user, default root)"
+    putStrLn "  --max-message N        max bytes per request line  ([server] max_message, default 1048576)"
+    putStrLn "  --max-rows N           rows returned per query     ([server] max_rows, default 1000)"
+    putStrLn ""
+    putStrLn "protocol: one JSON object per line; hello / login / query / storage / ping / quit"
+    putStrLn "  {\"method\":\"login\",\"user\":\"root\",\"password\":\"...\"} then {\"method\":\"query\",\"sql\":\"SELECT 1\"}"
+    putStrLn "  {\"method\":\"storage\",\"request\":{...}} forwards one storage request (Web and the CLI use this)"
+    putStrLn ""
+    putStrLn "storage: this process loads the chusql_core_storage library in-process and owns the data directory"
+    putStrLn ""
+    putStrLn "administrator password: user / password in the [web] section of chusql.toml, else the built-in demo"
+    putStrLn "  an empty password means the administrator signs in with no password; ordinary accounts are then refused"
+    putStrLn ("without either the demo administrator is " ++ T.unpack defaultUser ++ " / " ++ T.unpack defaultPassword)
+
+-- | 命令行覆盖管理员
+applyWebOptions :: WebConfig -> Options -> WebConfig
+applyWebOptions cfg opts =
+    cfg
+        { wcUser = orElse (optUser opts) (wcUser cfg)
+        }
+
+-- | 命令行覆盖监听配置
+applyServerOptions :: ServerConfig -> Options -> ServerConfig
+applyServerOptions config opts =
+    config
+        { scHost = orElse (optHost opts) (scHost config)
+        , scPort = orElse (optPort opts) (scPort config)
+        , scMaxMessage = orElse (optMaxMessage opts) (scMaxMessage config)
+        , scMaxRows = orElse (optMaxRows opts) (scMaxRows config)
+        }
+
+-- | 有 Just 就用它，否则用兜底值
+orElse :: Maybe a -> a -> a
+orElse (Just x) _ = x
+orElse Nothing y = y
+
+-- | 入口
+main :: IO ()
+main = do
+    hSetBuffering stdout LineBuffering
+    args <- getArgs
+    case parseArgs args of
+        Left err -> do
+            putStrLn ("bad arguments: " ++ err)
+            usage
+            exitFailure
+        Right opts
+            | optHelp opts -> usage
+            | otherwise -> run opts
+
+-- | 起服务：装入存储库并装配各服务组件
+run :: Options -> IO ()
+run opts = do
+    configPath <- resolveConfigPath (optConfig opts)
+    base <- loadWebConfigAt configPath
+    let cfg = applyWebOptions base opts
+    saved <- readSettingsFile configPath
+    cred <- resolveCredential cfg saved
+    config <- applyServerOptions <$> loadServerConfigAt configPath <*> pure opts
+    opened <- localStorageLink (Just configPath)
+    case opened of
+        Left err -> do
+            putStrLn ("cannot open the storage library: " ++ err)
+            exitFailure
+        Right link -> do
+            setStorageLink link
+            backend <- ipcBackend
+            printBanner cfg config configPath
+            checkStorage backend
+            reportCredential cred saved
+            limiter <-
+                newRateLimiter
+                    getCurrentTime
+                    (wcLoginMaxAttempts cfg)
+                    (fromIntegral (wcLoginWindow cfg))
+            env <- newServerEnv backend cred configPath config limiter
+            let announce port = putStrLn ("listening:    tcp://" ++ scHost config ++ ":" ++ show port)
+            bracket (pure link) (const closeConnection) (const (serve env announce))
+
+-- | 起 TCP 服务并处理绑定失败
+serve :: ServerEnv -> (Int -> IO ()) -> IO ()
+serve env announce = do
+    result <- try (runServer env announce) :: IO (Either IOException ())
+    case result of
+        Right () -> pure ()
+        Left e -> do
+            putStrLn ("failed to serve TCP: " ++ show e)
+            putStrLn "  the port is probably taken or reserved by the system; try another one: --port 7777"
+            exitFailure
+
+-- | 报告口令来源，用内置默认口令时告警
+reportCredential :: Credential -> Map.Map Text Text -> IO ()
+reportCredential cred saved
+    | usingDefaultCredentials saved = do
+        putStrLn ""
+        putStrLn "  !! Administrator credentials are not configured; the built-in demo password is in use:"
+        putStrLn ("  !!   user " ++ T.unpack (credUser cred) ++ " / password " ++ T.unpack defaultPassword)
+        putStrLn "  !!   set user / password in the [web] section of chusql.toml and restart"
+        putStrLn ""
+    | T.null (credEncoded cred) =
+        putStrLn ("administrator: " ++ T.unpack (credUser cred) ++ " (passwordless: only the administrator may sign in)")
+    | otherwise = putStrLn ("administrator: " ++ T.unpack (credUser cred) ++ " (credentials come from the settings file only)")
+
+-- | 探测存储是否可用，答不上 ping 就退出
+checkStorage :: Backend -> IO ()
+checkStorage backend = do
+    up <- bePing backend
+    if up
+        then putStrLn "storage:      up (the library answered ping)"
+        else do
+            putStrLn "storage:      DOWN (the storage library did not answer ping)"
+            exitFailure
+
+-- | 启动横幅
+printBanner :: WebConfig -> ServerConfig -> FilePath -> IO ()
+printBanner cfg config configPath = do
+    version <- storageVersion
+    putStrLn "================== ChuSQL Server ==================="
+    putStrLn ("config file:  " ++ configPath)
+    putStrLn ("protocol:     chusql 1 (one JSON object per line)")
+    putStrLn
+        ( "limits:       message "
+            ++ show (scMaxMessage config)
+            ++ "B, query rows "
+            ++ show (scMaxRows config)
+        )
+    putStrLn ("storage:      chusql_core_storage library " ++ version)
+    putStrLn ("data dir:     " ++ orElse (wcDataDir cfg) "(from the config file, else the default)")

chusql-server/chusql-server.cabal

@@ -0,0 +1,79 @@
+cabal-version: 2.4
+
+name:           chusql-server
+version:        1.0.0
+synopsis:       ChuSQL 数据库服务器：TCP 端点 + 自家协议 + SQL 会话
+description:    ChuSQL 的数据库服务器。负责监听 TCP、一行一条 JSON 的自家协议、
+                登录与限流，并把用户 SQL 转交给 chusql-core-engine（存储则由进程内
+                的 chusql_core_storage 动态库承担）。Web 管理端与命令行客户端都只
+                通过这条 TCP 连接访问数据库。
+build-type:     Simple
+
+library
+    hs-source-dirs:   src
+    exposed-modules:  ChuSQL.Server.Accounts
+                      ChuSQL.Server.Backend
+                      ChuSQL.Server.Policy
+                      ChuSQL.Server.Privileges
+                      ChuSQL.Server.Session
+                      ChuSQL.Server.TCP
+    build-depends:    base >= 4.14 && < 5
+                    , aeson
+                    , bytestring
+                    , chusql-core-engine
+                    , chusql-core-model
+                    , chusql-interface
+                    , containers
+                    , crypton
+                    , directory
+                    , filepath
+                    , memory
+                    , network
+                    , scientific
+                    , text
+                    , time
+                    , vector
+    default-language: Haskell2010
+    ghc-options:      -Wall
+
+executable chusql-server
+    main-is:          Main.hs
+    hs-source-dirs:   app
+    build-depends:    base
+                    , chusql-core-engine
+                    , chusql-core-model
+                    , chusql-interface
+                    , chusql-server
+                    , containers
+                    , filepath
+                    , text
+                    , time
+    default-language: Haskell2010
+    ghc-options:      -Wall -threaded
+    -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
+    if os(linux)
+        ld-options: -Wl,-rpath,$ORIGIN
+    if os(osx)
+        ld-options: -Wl,-rpath,@loader_path
+
+test-suite chusql-server-test
+    type:             exitcode-stdio-1.0
+    main-is:          Spec.hs
+    hs-source-dirs:   test
+    build-depends:    base
+                    , aeson
+                    , bytestring
+                    , chusql-core-engine
+                    , chusql-core-model
+                    , chusql-interface
+                    , chusql-server
+                    , containers
+                    , directory
+                    , filepath
+                    , hspec
+                    , network
+                    , text
+                    , time
+                    , vector
+    default-language: Haskell2010
+    ghc-options:      -Wall -threaded

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

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Web.Accounts (
+module ChuSQL.Server.Accounts (
     Accounts, AccountError (..), Principal (..), PasswordPolicy (..), defaultPasswordPolicy,
     newAccounts, accountsPolicy, setAccountsPolicy, passwordAllowed,
     rootUserName, principalName, principalIsRoot,
@@ -8,27 +8,18 @@ module ChuSQL.Web.Accounts (
     listAccounts, findAccount, AccountCommand (..), accountCommand, runAccountCommand,
 ) where
 
-import ChuSQL.Storage.IPC (Account (..), Request (..))
+import ChuSQL.Core.Engine.Storage.IPC (Account (..), Request (..))
-import ChuSQL.Syntax.AST (Statement (..))
+import ChuSQL.Core.Engine.Syntax.AST (Statement (..))
-import ChuSQL.Web.Auth
+import ChuSQL.Interface.Auth
-import ChuSQL.Web.Backend (Backend (..), currentStamp)
+import ChuSQL.Interface.Policy (PasswordPolicy (..), defaultPasswordPolicy)
+import ChuSQL.Server.Backend (Backend (..), currentStamp)
 import Control.Concurrent.MVar (MVar, newMVar, withMVar)
 import Data.Char (isAlphaNum, isAscii, isAsciiLower, isAsciiUpper, isDigit)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.Text (Text)
 import qualified Data.Text as T
 
--- 账号服务：root 来自配置，普通账号由 root 用 CREATE/ALTER/DROP USER 管，口令在这里做策略检查与 PBKDF2 派生。
+-- 账号服务：root 来自配置，普通账号由 root 用 CREATE/ALTER/DROP USER 管理，口令在此校验并派生哈希。
-
-data PasswordPolicy = PasswordPolicy
-    { ppMinLength :: Int
-    , ppClasses :: Int
-    }
-    deriving (Show, Eq)
-
--- | 默认：至少 12 个字符、至少两类字符
-defaultPasswordPolicy :: PasswordPolicy
-defaultPasswordPolicy = PasswordPolicy 12 2
 
 data AccountError = AccountError Text Text deriving (Show, Eq)
 
@@ -39,6 +30,7 @@ data Principal
     deriving (Eq)
 
 instance Show Principal where
+    -- | 身份的可读形式
     show (Root name) = "root " ++ show name
     show (Ordinary a) = "account " ++ show (accountUser a)
 
@@ -60,7 +52,7 @@ data Accounts = Accounts
     , acRoot :: Credential
     }
 
--- | 只记下配置根账号；root 不写系统表，所以启动时不需要任何持久化动作
+-- | 建账号服务，记录配置根账号
 newAccounts :: Backend -> SessionStore -> Credential -> IO Accounts
 newAccounts backend sessions credential = do
     lock <- newMVar ()
@@ -79,20 +71,24 @@ rootName = normalize . credUser . acRoot
 rootUserName :: Accounts -> Text
 rootUserName = rootName
 
+-- | 读当前生效的口令策略
 accountsPolicy :: Accounts -> IO PasswordPolicy
 accountsPolicy = readIORef . acPolicy
 
+-- | 换上一份新口令策略
 setAccountsPolicy :: Accounts -> PasswordPolicy -> IO ()
 setAccountsPolicy service = writeIORef (acPolicy service)
 
--- | 口令策略：长度 + 字符类别（历史与有效期随自助改密一起取消）
+-- | 按策略检查口令长度与字符类别
 passwordAllowed :: PasswordPolicy -> Text -> Either AccountError ()
 passwordAllowed policy password
     | T.length password < ppMinLength policy || T.length password > 256 = bad "password length does not meet policy"
     | classes < ppClasses policy = bad "password needs more character classes"
     | otherwise = Right ()
   where
+    -- | 构造一条请求错误
     bad = Left . AccountError "bad_request"
+    -- | 命中的字符类别数
     classes =
         length
             ( filter id
@@ -110,9 +106,10 @@ validateUserName name
         Left (AccountError "bad_request" "invalid account name")
     | otherwise = Right ()
   where
+    -- | 该字符是否允许使用
     allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
 
--- | 新建/改口令时的额外限制：管理员的名字保留给配置里的 root
+-- | 校验新账号名，并挡掉管理员保留名
 validateNewName :: Accounts -> Text -> Either AccountError ()
 validateNewName service name = do
     validateUserName name
@@ -137,7 +134,7 @@ storageResult (Left _) = Left storageFailure
 readAccounts :: Accounts -> IO (Either AccountError [Account])
 readAccounts service = fmap (either (const (Left storageFailure)) Right) (beAccounts (acBackend service) ReqAccountsList)
 
--- | 当前令牌对应的身份；会话版本与账号 revision 对不上就失效
+-- | 按令牌解析当前身份，版本对不上即失效
 currentUnlocked :: Accounts -> Text -> IO (Either AccountError Principal)
 currentUnlocked service token = do
     session <- lookupVersionedSession (acSessions service) token
@@ -156,11 +153,11 @@ currentUnlocked service token = do
                         then Right (Ordinary account)
                         else Left unauthorized
 
+-- | 加锁解析当前身份
 currentPrincipal :: Accounts -> Text -> IO (Either AccountError Principal)
 currentPrincipal service token = withMVar (acLock service) $ \_ -> currentUnlocked service token
 
--- | 登录：先比配置里的 root，再查系统表里的普通账号（没有切换身份的入口）。
+-- | 登录：先比 root，再查普通账号；空口令即免密
---   配置里的口令留空即"免密"：只有管理员能用空口令进来，普通账号一律拒绝。
 authenticate :: Accounts -> Text -> Text -> IO (Either AccountError Text)
 authenticate service user password = withMVar (acLock service) $ \_ ->
     if normalize user == rootName service
@@ -170,7 +167,9 @@ authenticate service user password = withMVar (acLock service) $ \_ ->
                 then pure (Left (AccountError "forbidden" "this server only accepts the administrator"))
                 else signInOrdinary
   where
+    -- | 配置里没有口令
     passwordless = T.null (credEncoded (acRoot service))
+    -- | 管理员登录
     signInRoot
         | passwordless =
             if T.null password
@@ -179,6 +178,7 @@ authenticate service user password = withMVar (acLock service) $ \_ ->
         | verifyPassword (credEncoded (acRoot service)) password =
             Right <$> createVersionedSession (acSessions service) (rootName service) Nothing
         | otherwise = pure (Left unauthorized)
+    -- | 普通账号登录
     signInOrdinary = do
         stored <- readAccounts service
         case stored of
@@ -217,7 +217,7 @@ createUser service name password = withMVar (acLock service) $ \_ -> do
             encoded <- hashPassword password
             storageResult <$> beAccounts (acBackend service) (ReqAccountCreate (normalize name) encoded)
 
--- | 改一个普通账号的口令（管理员重置，不受历史/有效期限制）
+-- | 管理员重置普通账号口令
 resetPassword :: Accounts -> Text -> Text -> IO (Either AccountError ())
 resetPassword service name password = withMVar (acLock service) $ \_ -> do
     policy <- accountsPolicy service

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

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Web.Backend (
+module ChuSQL.Server.Backend (
     StatementResult (..),
     Backend (..),
     columnsFromStatement,
@@ -20,21 +20,22 @@ module ChuSQL.Web.Backend (
     tableRefsOf,
 ) where
 
-import ChuSQL.Engine (runStatement, runStatementM)
+import ChuSQL.Core.Engine (runStatement, runStatementM)
-import ChuSQL.Model
+import ChuSQL.Core.Model
-import ChuSQL.Semantic (prepare)
+import ChuSQL.Core.Engine.Semantic (prepare)
-import ChuSQL.Storage (MonadStorage (schema))
+import ChuSQL.Core.Engine.Storage (MonadStorage (schema))
-import ChuSQL.Storage.IPC (
+import ChuSQL.Core.Engine.Storage.IPC (
     Account (..),
     IPCStorage (..),
     Request (..),
     Response (..),
     SchemaColumn (..),
     TableInfo (..),
+    sendRawRequest,
     sendRequest,
  )
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
-import ChuSQL.Syntax.Parser (parseStatement)
+import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
 import Control.Concurrent.MVar (MVar, modifyMVar, newMVar, readMVar, withMVar)
 import Data.List (nub)
 import Data.Text (Text)
@@ -44,7 +45,7 @@ import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.Text as T
 
--- 后端：跑一条语句与取数据字典，分 IPC（真存储）和内存（测试）两套。
+-- 后端抽象：跑语句、取数据字典与账号，分 IPC（真存储）和内存（测试）两套实现。
 
 data StatementResult = StatementResult
     { srColumns :: [String]
@@ -58,6 +59,8 @@ data Backend = Backend
     , beAccounts :: Request -> IO (Either String [Account])
     , beWithDatabase :: String -> Backend
     , beDatabases :: IO (Either String [String])
+    -- | 原样转发一条存储请求
+    , beStorage :: A.Value -> IO (Either String A.Value)
     }
 
 -- | 按给定列名取列，固定列顺序
@@ -67,7 +70,7 @@ columnsFromStatement db stmt = case prepare db stmt of
     Right (SelectExpr items _ _ _ _ _) -> map fst items
     _ -> []
 
--- | 走本地端点的后端（真存储：Windows 具名管道 / Unix 套接字）
+-- | 走本地存储链路的后端
 ipcBackend :: IO Backend
 ipcBackend = do
     lock <- newMVar ()
@@ -95,10 +98,22 @@ ipcBackend = do
                     RespTables names -> Right names
                     RespError err -> Left err
                     _ -> Left "unexpected database response"
+            , beStorage = \payload -> withMVar lock $ \_ -> runRaw payload
             }
     -- 没有默认库：没选库时 current 是空串，任何请求都得先选库
     pure (backend "")
   where
+    -- | 转发一条存储请求并解析响应
+    runRaw :: A.Value -> IO (Either String A.Value)
+    runRaw payload = do
+        response <- sendRawRequest (BL.toStrict (A.encode payload))
+        pure $ case response of
+            Left err -> Left err
+            Right raw -> case A.eitherDecodeStrict raw of
+                Left err -> Left ("storage response is not valid JSON: " ++ err)
+                Right value -> Right value
+
+    -- | 走存储链路跑一条语句
     runIpc :: String -> String -> IO (Either String StatementResult)
     runIpc current sql = case fmap (inDatabase current) (parseStatement sql) of
         Left e -> pure (Left e)
@@ -114,12 +129,11 @@ ipcBackend = do
                         (r : _) -> pure (map fst r)
                     pure (Right (StatementResult cols rows))
 
--- | 内存后端（测试）：状态就是一个 `Database`，名字是它代表的库
+-- | 测试用内存后端，状态是一个 Database
 memoryBackend :: String -> MVar Database -> Backend
 memoryBackend = memoryBackendWith False
 
--- | 同一份内存状态可以按普通库（trusted=False）或系统库（trusted=True）视角跑：
+-- | 构造内存后端，Bool 决定普通库还是系统库视角
---   系统库要能读写角色/授权表，普通库连看都不许看。
 memoryBackendWith :: Bool -> String -> MVar Database -> Backend
 memoryBackendWith trusted name ref =
     Backend
@@ -147,30 +161,33 @@ memoryBackendWith trusted name ref =
                     [[("account", VStr (BL.unpack (A.encode a))) ] | a <- accounts]) : filter ((/= usersTable) . fst) db, Right accounts)
         , beWithDatabase = withDatabase
         , beDatabases = pure (Right (nub [name, systemDatabaseName]))
+        , beStorage = \_ -> pure (Left "storage is not available in this backend")
         }
   where
+    -- | 按视角过滤库里的表
     scoped = if trusted then filter (not . reserved . fst) else visible
+    -- | 该视角下要隐藏的表
     hidden = if trusted then reserved else internalTable
+    -- | 取结果列名，空结果回落到解析
     colsOf db stmt rows = case rows of
         [] -> columnsFromStatement db stmt
         (r : _) -> map fst r
 
-    -- 系统库视角给权限服务用；夹具自己的库走普通视角；没选库时只放行不碰表的语句
+    -- | 按目标库名挑视角
     withDatabase target
         | target == systemDatabaseName = memoryBackendWith True name ref
         | target == name = memoryBackendWith False name ref
         | null target = noDatabaseBackend (memoryBackendWith False name ref)
         | otherwise = unavailableDatabase ("unknown database: " ++ target) (memoryBackendWith False name ref)
 
+-- | 把后端的语句与字典都改成同一条错误
 unavailableDatabase :: String -> Backend -> Backend
 unavailableDatabase message backend = backend
     { beStatement = \_ -> pure (Left message)
     , beCatalog = pure (Left message)
     }
 
--- | 没选库时的视角：不碰表的语句（USE、建库、账号与角色）照跑，
+-- | 未选库时的视角：只放行不碰表的语句
---   一旦语句里出现裸表名就报 no database selected。
---   与存储层口径一致：`db.table` 这种限定名不需要先选库。
 noDatabaseBackend :: Backend -> Backend
 noDatabaseBackend backend = backend
     { beStatement = \sql -> case parseStatement sql of
@@ -181,11 +198,11 @@ noDatabaseBackend backend = backend
     , beCatalog = pure (Left "no database selected")
     }
 
--- | Database context is an immutable request value, never shared connection state.
+-- | 给语句里的裸表名补上当前库前缀，子查询里的表名也一起改
---   子查询里出现的表名同样要带上数据库前缀，否则会落到错误的库里。
 inDatabase :: String -> Statement -> Statement
 inDatabase current = walk
   where
+    -- | 递归改写语句里的表名
     walk :: Statement -> Statement
     walk stmt = case stmt of
         q@Select{} ->
@@ -214,14 +231,16 @@ inDatabase current = walk
         AlterColumnNull t c b -> AlterColumnNull (table t) c b
         other -> other
 
+    -- | 给单个表名补库前缀，已限定或没选库就原样
     table t | '.' `elem` t || null current = t
             | otherwise = current ++ "." ++ t
 
+    -- | 改写 FROM 子句
     source FromUnit = FromUnit
     source (FromTable a t) = FromTable a (table t)
     source (FromJoin k l a t e) = FromJoin k (source l) a (table t) (expr e)
 
-    -- 表达式里的子查询也要一起改写
+    -- | 改写表达式里的子查询
     expr (ScalarSub sq) = ScalarSub (sub sq)
     expr (ExistsSub sq neg) = ExistsSub (sub sq) neg
     expr (InSub a sq neg) = InSub (expr a) (sub sq) neg
@@ -245,9 +264,10 @@ inDatabase current = walk
     expr (MaxOf a) = MaxOf (expr a)
     expr other = other
 
+    -- | 改写一个子查询
     sub sq = sq {subqueryStatement = walk (subqueryStatement sq)}
 
--- | 语句里出现的表（含 JOIN、子查询、INSERT/UPDATE/DELETE 的目标）
+-- | 语句里出现的表
 statementTables :: Statement -> [Text]
 statementTables stmt = nub (case stmt of
     Select{} ->
@@ -307,6 +327,7 @@ exprTables expr = case expr of
     MaxOf a -> exprTables a
     _ -> []
   where
+    -- | 两侧都取表名
     both a b = exprTables a ++ exprTables b
 
 -- | 一张表的线上信息（内存实现：没有索引，统计现算）
@@ -320,6 +341,7 @@ tableInfoOf (name, tbl) =
         , tiStats = [(c, distinctOf c, False) | (c, _) <- tableCols tbl]
         }
   where
+    -- | 一列的不同值个数
     distinctOf c = length (nub [v | r <- tableRows tbl, Just v <- [lookup c r]])
 
 -- | 本地列类型转线上字符串（和 IPC 那边同一套写法）
@@ -340,14 +362,14 @@ wireColumn name col =
         , scCheck = columnCheck col
         }
 
--- | 系统库：账号、角色与授权表住在这里，其中的表都是系统表，只给管理员
+-- | 系统库名，账号、角色与授权表住在这里
 systemDatabaseName :: String
 systemDatabaseName = "system"
 
 usersTable :: String
 usersTable = "__chusql_users"
 
--- | 角色与授权表：住在 system 库，名字不带 `__chusql_` 前缀（Rust 存储层拒收那个前缀）
+-- | 角色与授权表的名字，不带内部前缀
 rolesTable :: String
 rolesTable = "sys_roles"
 
@@ -360,13 +382,15 @@ membersTable = "sys_members"
 internalNames :: [String]
 internalNames = [rolesTable, grantsTable, membersTable]
 
+-- | 名字是否带内部表前缀
 reserved :: String -> Bool
 reserved = T.isPrefixOf "__chusql_" . T.toLower . T.pack
 
--- | 服务自己的内部表：目录里不出现，普通作用域读写都拒（系统作用域才放行角色/授权表）
+-- | 是不是服务自己的内部表
 internalTable :: String -> Bool
 internalTable name = reserved name || T.unpack (T.toLower (T.pack name)) `elem` internalNames
 
+-- | 去掉内部表
 visible :: Database -> Database
 visible = filter (not . internalTable . fst)
 
@@ -374,6 +398,7 @@ visible = filter (not . internalTable . fst)
 currentStamp :: IO T.Text
 currentStamp = T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" <$> getCurrentTime
 
+-- | 在内存账号表上执行一条账号请求
 memoryAccounts :: Database -> T.Text -> Request -> Either String [Account]
 memoryAccounts db stamp req = do
     accounts <- case lookup usersTable db of
@@ -395,6 +420,7 @@ memoryAccounts db stamp req = do
             _ -> Right [x | x <- accounts, accountUser x /= T.toLower u]
         _ -> Left "invalid account request"
   where
+    -- | 把一行解回账号
     decodeAccount row = case lookup "account" row of
         Just (VStr encoded) -> A.eitherDecode (BL.pack encoded)
         _ -> Left "invalid account record"

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

@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Server.Policy (
+    configurePasswordPolicy,
+    policyFromValues,
+    passwordKeys,
+) where
+
+import ChuSQL.Interface.Policy (defaultPasswordPolicy, passwordKeys, policyFromValues)
+import ChuSQL.Interface.Settings (applySettings, defaultOf, readSettingsFile)
+import ChuSQL.Server.Accounts (Accounts, setAccountsPolicy)
+import qualified Data.Map.Strict as Map
+
+-- 口令策略装配：从设置文件读 password-* 键算出生效策略，并装到账号服务上。
+
+-- | 从设置文件装口令策略，坏值报错
+configurePasswordPolicy :: Accounts -> FilePath -> IO ()
+configurePasswordPolicy accounts path = do
+    saved <- readSettingsFile path
+    let values = Map.fromList [(key, Map.findWithDefault (defaultOf key) key saved) | key <- passwordKeys]
+    case applySettings Map.empty values of
+        Left err -> ioError (userError err)
+        Right valid -> setAccountsPolicy accounts (policyFromValues defaultPasswordPolicy valid)

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

@@ -1,15 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
--- | 角色与权限服务。
+module ChuSQL.Server.Privileges (
---
---   模型：权限挂在角色上，用户通过角色成员资格继承角色权限；管理员（root）隐式全权，
---   新账号默认零权限。语句（CREATE ROLE / DROP ROLE / GRANT / REVOKE）由引擎解析并做
---   基本校验，真正落库在这里。
---
---   存储：system 库里的三张普通表（`sys_roles` / `sys_grants` / `sys_members`）。
---   起普通名字是因为 Rust 存储层拒收 `__chusql_` 前缀的表名，那条路走不通；
---   读写都借 system 作用域后端的普通 SQL，内存后端与 IPC 后端共用一套逻辑。
-module ChuSQL.Web.Privileges (
     Grant (..),
     Membership (..),
     PrivilegeCommand (..),
@@ -26,11 +17,12 @@ module ChuSQL.Web.Privileges (
     runPrivilegeCommand,
 ) where
 
-import ChuSQL.Model (Row, Value (..))
+import ChuSQL.Core.Model (Row, Value (..))
-import ChuSQL.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.AST
-import ChuSQL.Web.Accounts (Principal, principalIsRoot, principalName)
+import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalName)
-import ChuSQL.Web.Actions (sqlLiteral)
+import ChuSQL.Interface.Actions (sqlLiteral)
-import ChuSQL.Web.Backend (
+import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
+import ChuSQL.Server.Backend (
     Backend (..),
     StatementResult (..),
     exprTables,
@@ -45,18 +37,13 @@ import Data.List (intercalate, isInfixOf, nub, sort)
 import Data.Text (Text)
 import qualified Data.Text as T
 
--- | 出错口径与账号服务一致，映射由 API 层统一做
+-- 角色与权限服务：角色、授权与成员关系落在 system 库的表里，并据此判权限。
+
+-- | 出错口径与账号服务一致
 data PrivilegeError = PrivilegeError Text Text
     deriving (Show, Eq)
 
--- | 一条角色授权：角色 + 具体权限 + 对象（`*` 或 `库.表`）
+-- 一条角色授权（定义在共享协议层）
-data Grant = Grant
-    { grantRole :: Text
-    , grantPrivilege :: Text
-    , grantObject :: Text
-    }
-    deriving (Show, Eq, Ord)
-
 -- | 角色成员资格
 data Membership = Membership
     { memberRole :: Text
@@ -64,13 +51,7 @@ data Membership = Membership
     }
     deriving (Show, Eq, Ord)
 
--- | 一个角色的全貌
+-- | 一个角色的全貌：授权与成员
-data RoleView = RoleView
-    { roleName :: Text
-    , roleGrants :: [Grant]
-    , roleMembers :: [Text]
-    }
-    deriving (Show, Eq)
 
 data PrivilegeCommand
     = CreateRoleCommand Text
@@ -86,13 +67,13 @@ data Privileges = Privileges
     , pvLock :: MVar ()
     }
 
--- | 服务固定看 system 库；构造时不碰存储，第一次用才建表
+-- | 建权限服务，固定在 system 库上
 newPrivileges :: Backend -> IO Privileges
 newPrivileges base = do
     lock <- newMVar ()
     pure (Privileges (beWithDatabase base systemDatabaseName) lock)
 
--- | 语句 → 管理命令（引擎只解析与基本校验，不认的语句给 Nothing）
+-- | 语句转管理命令，不认的给 Nothing
 privilegeCommand :: Statement -> Maybe PrivilegeCommand
 privilegeCommand stmt = case stmt of
     CreateRole name -> Just (CreateRoleCommand (T.pack name))
@@ -112,13 +93,13 @@ runPrivilegeCommand service principal database command
     | needsDatabase = pure (Left (PrivilegeError "no_database" "no database selected"))
     | otherwise = withTables service (applyCommand service database command)
   where
-    -- 授权到具体对象（不是 `*`）时要把裸表名补成 `库.表`，没选库就无从补全
+    -- | 授权到具体对象时需要先选库
     needsDatabase = T.null database && case command of
         GrantPrivilegesCommand _ object _ -> T.strip object /= "*"
         RevokePrivilegesCommand _ object _ -> T.strip object /= "*"
         _ -> False
 
--- | 语句鉴权：管理员全通；普通身份按语句需要的每一项 (表, 权限) 查
+-- | 语句鉴权：管理员全通，普通身份按需查
 authorize :: Privileges -> Principal -> Text -> Statement -> IO (Either PrivilegeError ())
 authorize service principal database stmt
     | principalIsRoot principal = pure (Right ())
@@ -134,7 +115,7 @@ authorizeTables service principal database needed
         grants <- grantsOfUser service (principalName principal)
         pure (grants >>= \found -> checkAll database found needed)
 
--- | 只留下用户有 SELECT 权限的表（管理员看全部）；表清单接口用
+-- | 只留下用户有 SELECT 权的表
 filterTables :: Privileges -> Principal -> Text -> [Text] -> IO (Either PrivilegeError [Text])
 filterTables service principal database tables
     | principalIsRoot principal = pure (Right tables)
@@ -150,6 +131,7 @@ listRoleViews service = withTables service $ do
         Left err -> pure (Left err)
         Right known -> sequence <$> mapM view (sort known)
   where
+    -- | 组装一个角色的总览
     view role = do
         grants <- roleGrantsOf service role
         members <- membersOfRole service role
@@ -162,7 +144,7 @@ normalizeObject database object
     | T.any (== '.') object = T.toLower (T.strip object)
     | otherwise = normalizeUser database <> "." <> normalizeUser object
 
--- | 一条语句需要哪些 (表, 权限)；Nothing 表示管理员专属
+-- | 一条语句需要哪些 (表, 权限)
 requiredActions :: Statement -> Maybe [(Text, Text)]
 requiredActions stmt = case stmt of
     Select{} -> Just (selectNeeds (selectFrom stmt) (maybe [] (: []) (selectWhere stmt)))
@@ -173,7 +155,9 @@ requiredActions stmt = case stmt of
     Delete table cond -> Just ((T.pack table, "delete") : selectsOf (maybe [] (: []) cond))
     _ -> Nothing
   where
+    -- | FROM 子句要的 SELECT 权限
     selectNeeds source exprs = [(ref, "select") | ref <- nub (tableRefsOf source)] ++ selectsOf exprs
+    -- | 表达式里子查询要的 SELECT 权限
     selectsOf exprs = [(ref, "select") | ref <- nub (concatMap exprTables exprs)]
 
 -- | 每项 (表, 权限) 都要被某条授权覆盖
@@ -183,6 +167,7 @@ checkAll database grants needed = case [pair | pair@(table, privilege) <- needed
     ((table, privilege) : _) ->
         Left (PrivilegeError "forbidden" ("permission denied: " <> T.toUpper privilege <> " ON " <> table))
   where
+    -- | 某一项是否被授权覆盖
     covered table privilege =
         let target = normalizeObject database table
          in any
@@ -301,15 +286,18 @@ withTables service action = withMVar (pvLock service) $ \_ -> do
         Left err -> pure (Left err)
         Right () -> action
 
+-- | 确保三张内部表存在
 ensureTables :: Privileges -> IO (Either PrivilegeError ())
 ensureTables service = each tableDefs (createTable service)
   where
+    -- | 三张内部表的定义
     tableDefs =
         [ (rolesTable, "(name VARCHAR(64))")
         , (grantsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))")
         , (membersTable, "(role VARCHAR(64), member VARCHAR(64))")
         ]
 
+-- | 建一张内部表，已存在算成功
 createTable :: Privileges -> (String, String) -> IO (Either PrivilegeError ())
 createTable service (table, columns) = do
     result <- beStatement (pvBackend service) ("CREATE TABLE " ++ table ++ " " ++ columns)
@@ -341,6 +329,7 @@ cell column row = case lookup column row of
     Just (VStr value) -> T.pack value
     _ -> ""
 
+-- | 一行记录转成授权
 grantOf :: Row -> Grant
 grantOf row =
     Grant
@@ -349,19 +338,22 @@ grantOf row =
         , grantObject = T.toLower (T.strip (cell "object" row))
         }
 
+-- | 拼一条删授权的 SQL
 deleteGrantSql :: Text -> Text -> Text -> String
 deleteGrantSql role privilege object =
     "DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role
         ++ " AND privilege = " ++ literal privilege ++ " AND object = " ++ literal object
 
+-- | 拼一条插入的 SQL
 insertSql :: String -> [String] -> [Text] -> String
 insertSql table columns values =
     "INSERT INTO " ++ table ++ " (" ++ intercalate ", " columns ++ ") VALUES (" ++ intercalate ", " (map literal values) ++ ")"
 
--- | 授权里的 ALL 展开成四种具体权限（存具体权限，鉴权不做兜底）
+-- | 把 ALL 展开成四种具体权限
 expandPrivileges :: [Text] -> [Text]
 expandPrivileges privileges = nub (concatMap expand (map (T.toLower . T.strip) privileges))
   where
+    -- | 展开一条权限名
     expand "all" = ["select", "insert", "update", "delete"]
     expand other = [other]
 
@@ -374,23 +366,29 @@ each (item : rest) action = do
         Left err -> pure (Left err)
         Right () -> each rest action
 
+-- | 角色名的 SQL 字面量
 roleLiteral :: Text -> String
 roleLiteral = literal . normalizeRole
 
+-- | 文本值的 SQL 字面量
 literal :: Text -> String
 literal = sqlLiteral . VStr . T.unpack
 
+-- | 角色名统一小写去空白
 normalizeRole :: Text -> Text
 normalizeRole = T.toLower . T.strip
 
+-- | 用户名统一小写去空白
 normalizeUser :: Text -> Text
 normalizeUser = T.toLower . T.strip
 
 forbidden :: PrivilegeError
 forbidden = PrivilegeError "forbidden" "administrator required"
 
+-- | 未知角色的错误
 unknownRole :: Text -> PrivilegeError
 unknownRole role = PrivilegeError "not_found" ("unknown role: " <> role)
 
+-- | 存储错误转成权限错误
 storageError :: String -> PrivilegeError
 storageError message = PrivilegeError "storage_error" ("privilege storage: " <> T.pack message)

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

@@ -0,0 +1,327 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Server.Session
+    ( QueryResult (..)
+    , Session
+    , SessionError (..)
+    , engineErrorCode
+    , newSession
+    , sessionUser
+    , sessionIsAdmin
+    , sessionDatabase
+    , isPlainIdentifier
+    , authenticateSession
+    , authenticateSessionCoded
+    , switchDatabase
+    , runStatement
+    , runStatementCoded
+    , catalog
+    , accounts
+    , roleViews
+    , databases
+    , policyOf
+    , reloadPolicy
+    , queryResultJson
+    ) where
+
+import ChuSQL.Core.Model (Value (..))
+import ChuSQL.Core.Protocol (Account, QueryResult (..), queryResultJson)
+import ChuSQL.Core.Engine.Storage.IPC (TableInfo (..))
+import ChuSQL.Core.Engine.Syntax.AST (Statement (..))
+import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
+import ChuSQL.Interface.AccountTable (systemTableInfo)
+import ChuSQL.Interface.Auth (Credential, defaultSessionPolicy, newSessionStore)
+import ChuSQL.Server.Accounts
+import ChuSQL.Server.Backend (Backend (..), StatementResult (..))
+import ChuSQL.Server.Policy (configurePasswordPolicy)
+import ChuSQL.Server.Privileges (PrivilegeCommand, PrivilegeError (..), Privileges, RoleView, authorize, filterTables, listRoleViews, newPrivileges, privilegeCommand, runPrivilegeCommand)
+import Control.Exception (IOException, try)
+import Data.Bifunctor (first)
+import Data.Char (isAlpha, isAlphaNum)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Clock (getCurrentTime)
+
+-- SQL 会话：Web、命令行与 TCP 服务器共用的账号、权限与语句执行入口。
+
+-- | 带错误码的失败：码与 Web REST 的错误码同一个词汇表
+data SessionError = SessionError
+    { sessCode :: Text
+    , sessMessage :: Text
+    }
+    deriving (Eq, Show)
+
+-- | 引擎报错翻成错误码
+engineErrorCode :: String -> SessionError
+engineErrorCode err
+    | "no database selected" `T.isInfixOf` message = SessionError "no_database" message
+    | "unknown table" `T.isInfixOf` message = SessionError "not_found" message
+    | otherwise = SessionError "query_error" message
+  where
+    message = T.pack err
+
+data Session = Session
+    { ssBackend :: Backend
+    , ssAccounts :: Accounts
+    , ssPrivileges :: Privileges
+    , ssCurrent :: IORef Text
+    , ssPrincipal :: IORef (Maybe Principal)
+    , ssSettingsFile :: FilePath
+    }
+
+-- | 开一个会话：账号与角色服务、配置策略都和 Web 端一致
+newSession :: Backend -> Credential -> FilePath -> IO Session
+newSession backend credential settingsFile = do
+    sessions <- newSessionStore getCurrentTime defaultSessionPolicy
+    accountsService <- newAccounts backend sessions credential
+    privileges <- newPrivileges backend
+    configurePasswordPolicy accountsService settingsFile
+    -- 服务启动后只有系统库：没 USE 之前不预设任何工作库
+    current <- newIORef ""
+    principal <- newIORef Nothing
+    pure (Session backend accountsService privileges current principal settingsFile)
+
+-- | 当前生效的口令策略（只有管理员能看）
+policyOf :: Session -> IO (Either Text PasswordPolicy)
+policyOf session = do
+    admin <- sessionIsAdmin session
+    if not admin
+        then pure (Left "administrator required")
+        else Right <$> accountsPolicy (ssAccounts session)
+
+-- | 重读设置文件里的口令策略
+reloadPolicy :: Session -> IO (Either Text PasswordPolicy)
+reloadPolicy session = do
+    admin <- sessionIsAdmin session
+    if not admin
+        then pure (Left "administrator required")
+        else do
+            outcome <- try (configurePasswordPolicy (ssAccounts session) (ssSettingsFile session)) :: IO (Either IOException ())
+            case outcome of
+                Left err -> pure (Left (T.pack (show err)))
+                Right () -> policyOf session
+
+-- | 当前登录的账号名
+sessionUser :: Session -> IO (Maybe Text)
+sessionUser session = fmap principalName <$> readIORef (ssPrincipal session)
+
+-- | 是不是配置里的 root
+sessionIsAdmin :: Session -> IO Bool
+sessionIsAdmin session = maybe False principalIsRoot <$> readIORef (ssPrincipal session)
+
+-- | 当前库
+sessionDatabase :: Session -> IO Text
+sessionDatabase = readIORef . ssCurrent
+
+-- | 与解析器一致的裸标识符判断
+isPlainIdentifier :: Text -> Bool
+isPlainIdentifier name =
+    not (T.null name)
+        && T.length name <= 64
+        && (isAlpha (T.head name) || T.head name == '_')
+        && T.all (\ch -> isAlphaNum ch || ch == '_') name
+
+-- | 登录：root 比配置凭据，普通账号查系统表
+authenticateSession :: Session -> Text -> Text -> IO (Either Text ())
+authenticateSession session user password =
+    fmap (first sessMessage) (authenticateSessionCoded session user password)
+
+-- | 登录（带错误码）
+authenticateSessionCoded :: Session -> Text -> Text -> IO (Either SessionError ())
+authenticateSessionCoded session user password = do
+    result <- authenticate (ssAccounts session) user password
+    case result of
+        Left err -> pure (Left (accountErrorOf err))
+        Right token -> do
+            who <- currentPrincipal (ssAccounts session) token
+            case who of
+                Left err -> pure (Left (accountErrorOf err))
+                Right principal -> do
+                    writeIORef (ssPrincipal session) (Just principal)
+                    pure (Right ())
+
+-- | 换库；系统库只有 root 能进
+switchDatabase :: Session -> Text -> IO (Either Text ())
+switchDatabase session name =
+    fmap (first sessMessage) (switchDatabaseCoded session name)
+
+-- | 换库（带错误码）
+switchDatabaseCoded :: Session -> Text -> IO (Either SessionError ())
+switchDatabaseCoded session rawName
+    | not (isPlainIdentifier name) = pure (Left (SessionError "bad_request" ("not a plain database name: " <> name)))
+    | name == "system" = do
+        admin <- sessionIsAdmin session
+        if admin then go else pure (Left (SessionError "forbidden" "the system database is only available to the administrator"))
+    | otherwise = go
+  where
+    name = T.toLower (T.strip rawName)
+    -- | 真的切库并记下当前库
+    go = do
+        backend <- currentBackend session
+        result <- beStatement backend ("USE " ++ T.unpack name)
+        case result of
+            Left err -> pure (Left (engineErrorCode err))
+            Right _ -> writeIORef (ssCurrent session) name >> pure (Right ())
+
+-- | 跑一条语句：USE、账号与角色语句分流，其余交引擎
+runStatement :: Session -> Text -> IO (Either Text QueryResult)
+runStatement session sql = fmap (first sessMessage) (runStatementCoded session sql)
+
+-- | 跑一条语句（带错误码）
+runStatementCoded :: Session -> Text -> IO (Either SessionError QueryResult)
+runStatementCoded session sql = case parseStatement (T.unpack sql) of
+    Right (UseDatabase name) -> do
+        switched <- switchDatabaseCoded session (T.pack name)
+        case switched of
+            Left err -> pure (Left err)
+            Right () -> do
+                current <- readIORef (ssCurrent session)
+                pure (Right (emptyResult (Just current)))
+    Right statement
+        | Just command <- accountCommand statement -> runAccount session command
+        | Just command <- privilegeCommand statement -> runPrivilege session command
+        | otherwise -> do
+            allowed <- authorized session statement
+            case allowed of
+                Left err -> pure (Left err)
+                Right () -> runPlain session sql
+    Left _ -> runPlain session sql
+
+-- | 普通身份跑语句前的权限判定；管理员与未登录放行
+authorized :: Session -> Statement -> IO (Either SessionError ())
+authorized session statement = do
+    who <- readIORef (ssPrincipal session)
+    case who of
+        Just principal | not (principalIsRoot principal) -> do
+            database <- readIORef (ssCurrent session)
+            result <- authorize (ssPrivileges session) principal database statement
+            pure (either (Left . privilegeErrorOf) (const (Right ())) result)
+        _ -> pure (Right ())
+
+-- | 落到引擎/存储层的一条语句
+runPlain :: Session -> Text -> IO (Either SessionError QueryResult)
+runPlain session sql = do
+    backend <- currentBackend session
+    result <- beStatement backend (T.unpack sql)
+    pure (either (Left . engineErrorCode) (Right . resultOf) result)
+
+-- | 数据字典；普通身份只看到有 SELECT 权的表
+catalog :: Session -> IO (Either Text [TableInfo])
+catalog session = do
+    current <- readIORef (ssCurrent session)
+    if T.null current
+        then pure (Left "no database selected")
+        else do
+            backend <- currentBackend session
+            result <- beCatalog backend
+            case result of
+                Left e -> pure (Left (T.pack e))
+                Right infos -> do
+                    who <- readIORef (ssPrincipal session)
+                    visible <- case who of
+                        Just principal | not (principalIsRoot principal) -> do
+                            allowed <- filterTables (ssPrivileges session) principal current (map (T.pack . tiTable) infos)
+                            pure (either (Left . privilegeMessage) (\names -> Right (filter (\info -> T.pack (tiTable info) `elem` names) infos)) allowed)
+                        _ -> pure (Right infos)
+                    case visible of
+                        Left message -> pure (Left message)
+                        Right tables
+                            | current == "system" -> Right <$> withAccountInfo session tables
+                            | otherwise -> pure (Right tables)
+
+-- | 系统库里补上账号表
+withAccountInfo :: Session -> [TableInfo] -> IO [TableInfo]
+withAccountInfo session tables = do
+    admin <- sessionIsAdmin session
+    if not admin
+        then pure tables
+        else do
+            result <- listAccounts (ssAccounts session)
+            pure $ case result of
+                Left _ -> tables
+                Right rows -> systemTableInfo{tiRows = length rows} : tables
+
+-- | 库清单（\l 用）
+databases :: Session -> IO (Either Text [Text])
+databases session = do
+    result <- beDatabases (ssBackend session)
+    pure (either (Left . T.pack) (Right . map T.pack) result)
+
+-- | 角色总览，只给管理员
+roleViews :: Session -> IO (Either Text [RoleView])
+roleViews session = do
+    admin <- sessionIsAdmin session
+    if not admin
+        then pure (Left "administrator required")
+        else do
+            result <- listRoleViews (ssPrivileges session)
+            pure (either (Left . privilegeMessage) Right result)
+
+-- | 账号清单（\du 与账号管理页用）；只给管理员
+accounts :: Session -> IO (Either Text [Account])
+accounts session = do
+    admin <- sessionIsAdmin session
+    if not admin
+        then pure (Left "administrator required")
+        else do
+            result <- listAccounts (ssAccounts session)
+            pure (either (Left . T.pack . show) Right result)
+
+-- | 当前库对应的后端
+currentBackend :: Session -> IO Backend
+currentBackend session = do
+    name <- readIORef (ssCurrent session)
+    pure (beWithDatabase (ssBackend session) (T.unpack name))
+
+-- | 账号语句走账号服务，普通账号一律拒绝
+runAccount :: Session -> AccountCommand -> IO (Either SessionError QueryResult)
+runAccount session command = do
+    who <- readIORef (ssPrincipal session)
+    case who of
+        Nothing -> pure (Left (SessionError "unauthorized" "sign in first"))
+        Just principal -> do
+            result <- runAccountCommand (ssAccounts session) principal command
+            pure (either (Left . accountErrorOf) (const (Right (emptyResult Nothing))) result)
+
+-- | 角色语句走权限服务，普通账号拒绝
+runPrivilege :: Session -> PrivilegeCommand -> IO (Either SessionError QueryResult)
+runPrivilege session command = do
+    who <- readIORef (ssPrincipal session)
+    case who of
+        Nothing -> pure (Left (SessionError "unauthorized" "sign in first"))
+        Just principal -> do
+            database <- readIORef (ssCurrent session)
+            result <- runPrivilegeCommand (ssPrivileges session) principal database command
+            pure (either (Left . privilegeErrorOf) (const (Right (emptyResult Nothing))) result)
+
+-- | 账号错误转成会话错误
+accountErrorOf :: AccountError -> SessionError
+accountErrorOf (AccountError code message) = SessionError code message
+
+-- | 权限错误转成会话错误
+privilegeErrorOf :: PrivilegeError -> SessionError
+privilegeErrorOf (PrivilegeError code message) = SessionError code message
+
+-- | 取权限错误的文案
+privilegeMessage :: PrivilegeError -> Text
+privilegeMessage (PrivilegeError _ message) = message
+
+-- | 只带库名的空结果
+emptyResult :: Maybe Text -> QueryResult
+emptyResult database = QueryResult [] [] 0 False database
+
+-- | 存储结果转成查询结果
+resultOf :: StatementResult -> QueryResult
+resultOf result =
+    QueryResult
+        { qrColumns = map T.pack (srColumns result)
+        , qrRows = [map (cellOf row) (srColumns result) | row <- srRows result]
+        , qrRowCount = length (srRows result)
+        , qrTruncated = False
+        , qrDatabase = Nothing
+        }
+  where
+    -- | 按列名取单元格
+    cellOf row name = maybe VNull id (lookup name row)
+

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

@@ -0,0 +1,288 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Server.TCP (
+    ServerConfig (..),
+    defaultServerConfig,
+    loadServerConfigAt,
+    ServerEnv (..),
+    newServerEnv,
+    ServerHandle (..),
+    startServer,
+    runServer,
+) where
+
+import ChuSQL.Interface.Auth (Credential)
+import ChuSQL.Interface.Config (ServerConfig (..), defaultServerConfig, loadServerConfigAt)
+import ChuSQL.Interface.Policy (PasswordPolicy (..))
+import ChuSQL.Interface.Protocol (ClientRequest (..), ServerResponse (..), decodeRequest, encodeResponse, protocolVersion)
+import ChuSQL.Interface.RateLimit (RateLimiter, rateLimitBlock, rateLimitClear, rateLimitRecord)
+import ChuSQL.Server.Backend (Backend (..))
+import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), accounts, authenticateSessionCoded, catalog, databases, newSession, policyOf, reloadPolicy, roleViews, runStatementCoded, sessionIsAdmin, sessionUser)
+import Control.Concurrent (forkIO)
+import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
+import Control.Exception (IOException, try)
+import Control.Monad (void)
+import qualified Data.ByteString.Char8 as BSC
+import qualified Data.ByteString.Lazy.Char8 as BLC
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Network.Socket (
+    AddrInfo (..),
+    AddrInfoFlag (AI_PASSIVE),
+    SockAddr (SockAddrInet, SockAddrInet6),
+    Socket,
+    SocketOption (ReuseAddr),
+    SocketType (Stream),
+    accept,
+    addrAddress,
+    addrFamily,
+    bind,
+    close,
+    defaultHints,
+    defaultProtocol,
+    getAddrInfo,
+    getSocketName,
+    listen,
+    setSocketOption,
+    socket,
+    socketToHandle,
+  )
+import System.IO (BufferMode (LineBuffering), IOMode (ReadWriteMode), hClose, hFlush, hPutStrLn, hSetBuffering, hSetNewlineMode, noNewlineTranslation, stderr)
+import System.IO.Error (isEOFError)
+
+-- TCP 服务器：监听端口，一连接一会话，按一行一 JSON 收发协议消息。
+
+-- 服务器
+
+data ServerEnv = ServerEnv
+    { srvBackend :: Backend
+    , srvCredential :: Credential
+    , srvSettingsFile :: FilePath
+    , srvConfig :: ServerConfig
+    , srvLimiter :: RateLimiter
+    }
+
+-- | 组装服务器环境：每个连接再各开一个会话
+newServerEnv :: Backend -> Credential -> FilePath -> ServerConfig -> RateLimiter -> IO ServerEnv
+newServerEnv backend credential settingsFile config limiter =
+    pure (ServerEnv backend credential settingsFile config limiter)
+
+data ServerHandle = ServerHandle
+    { shPort :: Int
+    , shStop :: IO ()
+    }
+
+-- | 起监听并在线程里收连接（测试与嵌入用）
+startServer :: ServerEnv -> IO ServerHandle
+startServer env = do
+    sock <- listenSocket (scHost (srvConfig env)) (scPort (srvConfig env))
+    port <- actualPort sock
+    stopped <- newMVar False
+    _ <- forkIO (acceptLoop env sock stopped)
+    pure (ServerHandle port (stopListening sock stopped))
+
+-- | 在调用线程里收连接（可执行文件用）；绑好端口先回调一次
+runServer :: ServerEnv -> (Int -> IO ()) -> IO ()
+runServer env announce = do
+    sock <- listenSocket (scHost (srvConfig env)) (scPort (srvConfig env))
+    port <- actualPort sock
+    announce port
+    stopped <- newMVar False
+    acceptLoop env sock stopped
+
+-- | 置停止标记并关掉监听套接字
+stopListening :: Socket -> MVar Bool -> IO ()
+stopListening sock stopped = do
+    modifyMVar_ stopped (const (pure True))
+    void (try (close sock) :: IO (Either IOException ()))
+
+-- | 建监听套接字；端口 0 表示由系统分配
+listenSocket :: String -> Int -> IO Socket
+listenSocket host port = do
+    let hints = defaultHints{addrSocketType = Stream, addrFlags = [AI_PASSIVE]}
+        node = if null host then Nothing else Just host
+    infos <- getAddrInfo (Just hints) node (Just (show port))
+    case infos of
+        [] -> ioError (userError ("cannot resolve listen address: " ++ host))
+        (info : _) -> do
+            sock <- socket (addrFamily info) Stream defaultProtocol
+            setSocketOption sock ReuseAddr 1
+            bind sock (addrAddress info)
+            listen sock 128
+            pure sock
+
+-- | 系统分配端口后读回真正的端口
+actualPort :: Socket -> IO Int
+actualPort sock = do
+    address <- getSocketName sock
+    pure $ case address of
+        SockAddrInet port _ -> fromIntegral port
+        SockAddrInet6 port _ _ _ -> fromIntegral port
+        _ -> 0
+
+-- | 循环 accept，把每个连接交给独立线程
+acceptLoop :: ServerEnv -> Socket -> MVar Bool -> IO ()
+acceptLoop env sock stopped = loop
+  where
+    -- | 等下一个连接
+    loop = do
+        stop <- readMVar stopped
+        if stop
+            then pure ()
+            else do
+                accepted <- try (accept sock) :: IO (Either IOException (Socket, SockAddr))
+                case accepted of
+                    Left err -> do
+                        stopping <- readMVar stopped
+                        if stopping then pure () else hPutStrLn stderr ("accept failed: " ++ show err)
+                    Right (conn, _) -> do
+                        void (forkIO (reportConnection env conn))
+                        loop
+
+-- | 连接线程：异常写到 stderr
+reportConnection :: ServerEnv -> Socket -> IO ()
+reportConnection env conn = do
+    outcome <- try (serveConnection env conn) :: IO (Either IOException ())
+    case outcome of
+        Left err -> hPutStrLn stderr ("connection failed: " ++ show err)
+        Right () -> pure ()
+
+-- | 一个连接一个会话：一行一条 JSON，读到 EOF 就收工
+serveConnection :: ServerEnv -> Socket -> IO ()
+serveConnection env conn = do
+    h <- socketToHandle conn ReadWriteMode
+    hSetBuffering h LineBuffering
+    hSetNewlineMode h noNewlineTranslation
+    session <- newSession (srvBackend env) (srvCredential env) (srvSettingsFile env)
+    outcome <- try (loop h session) :: IO (Either IOException ())
+    case outcome of
+        Left err | not (isEOFError err) -> hPutStrLn stderr ("connection error: " ++ show err)
+        _ -> pure ()
+    void (try (hClose h) :: IO (Either IOException ()))
+  where
+    -- | 逐行读请求并应答
+    loop h session = do
+        line <- BSC.hGetLine h
+        let cleaned = BSC.dropWhileEnd (== '\r') line
+        if BSC.length cleaned > scMaxMessage (srvConfig env)
+            then send h (RespError "too_large" "request line too large") >> loop h session
+            else case decodeRequest cleaned of
+                Left message -> send h (RespError "bad_request" message) >> loop h session
+                Right request -> do
+                    (response, keepGoing) <- dispatch env session request
+                    send h response
+                    if keepGoing then loop h session else pure ()
+    -- | 发一条响应并冲缓冲
+    send h response = do
+        BLC.hPutStr h (encodeResponse response)
+        BLC.hPutStr h "\n"
+        hFlush h
+
+-- | 一条请求一条响应，quit 后停连接
+dispatch :: ServerEnv -> Session -> ClientRequest -> IO (ServerResponse, Bool)
+dispatch env session request = case request of
+    ReqHello version
+        | version == protocolVersion -> pure (RespHello protocolVersion, True)
+        | otherwise -> pure (RespError "bad_request" ("unsupported protocol version: " <> tshow version), True)
+    ReqLogin user password -> do
+        response <- login env session user password
+        pure (response, True)
+    ReqQuery sql -> do
+        who <- sessionUser session
+        response <- case who of
+            Nothing -> pure (RespError "unauthorized" "sign in first")
+            Just _
+                | T.null (T.strip sql) -> pure (RespError "bad_request" "sql must not be empty")
+                | otherwise -> do
+                    result <- runStatementCoded session sql
+                    pure $ case result of
+                        Left err -> RespError (sessCode err) (sessMessage err)
+                        Right queryResult -> RespResult (trimResult (scMaxRows (srvConfig env)) queryResult)
+        pure (response, True)
+    ReqStorage payload -> do
+        who <- sessionUser session
+        response <- case who of
+            Nothing -> pure (RespError "unauthorized" "sign in first")
+            Just _ -> do
+                admin <- sessionIsAdmin session
+                if not admin
+                    then pure (RespError "forbidden" "administrator required")
+                    else do
+                        result <- beStorage (srvBackend env) payload
+                        pure $ case result of
+                            Left err -> RespError "storage_error" (T.pack err)
+                            Right value -> RespStorage value
+        pure (response, True)
+    ReqCatalog -> do
+        response <- overSession session (catalog session) RespCatalog
+        pure (response, True)
+    ReqDatabases -> do
+        response <- overSession session (databases session) RespDatabases
+        pure (response, True)
+    ReqRoles -> do
+        response <- overSession session (roleViews session) RespRoles
+        pure (response, True)
+    ReqAccounts -> do
+        response <- overSession session (accounts session) RespAccounts
+        pure (response, True)
+    ReqPolicy -> do
+        response <- overSession session (policyOf session) policyResponse
+        pure (response, True)
+    ReqReloadPolicy -> do
+        response <- overSession session (reloadPolicy session) policyResponse
+        pure (response, True)
+    ReqPing -> pure (RespPong, True)
+    ReqQuit -> pure (RespBye, False)
+
+-- | 口令策略在线上只有两个数字：最短长度与至少几类字符
+policyResponse :: PasswordPolicy -> ServerResponse
+policyResponse (PasswordPolicy minLength classes) = RespPolicy minLength classes
+
+-- | 会话方法统一口径：没登录先挡，其余失败按码表落到响应
+overSession :: Session -> IO (Either Text a) -> (a -> ServerResponse) -> IO ServerResponse
+overSession session action wrap = do
+    who <- sessionUser session
+    case who of
+        Nothing -> pure (RespError "unauthorized" "sign in first")
+        Just _ -> do
+            result <- action
+            pure $ case result of
+                Left message -> RespError (sessionCode message) message
+                Right value -> wrap value
+
+-- | 会话层的失败文案归一到协议错误码
+sessionCode :: Text -> Text
+sessionCode message
+    | message == "no database selected" = "no_database"
+    | message == "administrator required" = "forbidden"
+    | otherwise = "query_error"
+
+-- | 登录：按账号名限流，成功清账
+login :: ServerEnv -> Session -> Text -> Text -> IO ServerResponse
+login env session user password = do
+    let key = T.toLower (T.strip user)
+    blocked <- rateLimitBlock (srvLimiter env) key
+    case blocked of
+        Just seconds -> pure (RespError "too_many_attempts" ("too many failed logins, retry in " <> tshow (ceiling seconds :: Integer) <> "s"))
+        Nothing -> do
+            result <- authenticateSessionCoded session key password
+            case result of
+                Left err -> do
+                    rateLimitRecord (srvLimiter env) key
+                    pure (RespError (sessCode err) (sessMessage err))
+                Right () -> do
+                    rateLimitClear (srvLimiter env) key
+                    who <- sessionUser session
+                    admin <- sessionIsAdmin session
+                    pure (RespLogin (fromMaybe key who) admin)
+
+-- | 按上限截行，总行数保持不变
+trimResult :: Int -> QueryResult -> QueryResult
+trimResult limit result
+    | length (qrRows result) > limit = result{qrRows = take limit (qrRows result), qrTruncated = True}
+    | otherwise = result
+
+-- | show 成 Text
+tshow :: Show a => a -> Text
+tshow = T.pack . show

chusql-server/stack.yaml

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

chusql-server/stack.yaml.lock

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

chusql-server/test/Spec.hs

@@ -0,0 +1,416 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module Main (main) where
+
+import ChuSQL.Core.Model (Database, Table (..), Value (..), pattern TInt, pattern TStr)
+import ChuSQL.Interface.Auth (Credential (..), hashPasswordWith)
+import ChuSQL.Interface.Protocol (ClientRequest (..), ServerResponse (..), decodeRequest, encodeResponse)
+import ChuSQL.Interface.RateLimit (newRateLimiter)
+import ChuSQL.Server.Backend (memoryBackend)
+import ChuSQL.Server.Session (QueryResult (..))
+import ChuSQL.Server.TCP (
+    ServerConfig (..),
+    ServerEnv,
+    ServerHandle (..),
+    defaultServerConfig,
+    loadServerConfigAt,
+    newServerEnv,
+    startServer,
+ )
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.MVar (newMVar)
+import Control.Exception (IOException, bracket, finally, try)
+import Control.Monad (void)
+import Data.Aeson (decode)
+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.Char8 as BSC
+import qualified Data.ByteString.Lazy as BL
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Vector as V
+import Data.Time.Clock (getCurrentTime)
+import Network.Socket (
+    AddrInfo (..),
+    SocketType (Stream),
+    addrAddress,
+    addrFamily,
+    connect,
+    defaultHints,
+    defaultProtocol,
+    getAddrInfo,
+    socket,
+    socketToHandle,
+    withSocketsDo,
+ )
+import System.Directory (doesFileExist, getTemporaryDirectory, removeFile)
+import System.FilePath ((</>))
+import System.IO (
+    BufferMode (LineBuffering),
+    Handle,
+    IOMode (ReadWriteMode),
+    hClose,
+    hFlush,
+    hIsEOF,
+    hSetBuffering,
+    hSetNewlineMode,
+    noNewlineTranslation,
+ )
+import System.Timeout (timeout)
+import Test.Hspec
+
+-- TCP 服务器测试：协议编解码、配置读取与真连服务器的端到端用例。
+
+-- | 测试入口
+main :: IO ()
+main = hspec spec
+
+-- | 全部用例
+spec :: Spec
+spec = do
+    tcpSpec
+    tcpServerSpec
+
+-- 夹具：内存后端装在 MVar 里，跟 Web 测试同一套表
+
+-- | 夹具库名
+testDatabaseName :: String
+testDatabaseName = "test"
+
+-- | users 5 行 + orders 1 行
+testDb :: Database
+testDb =
+    [ ( "users"
+      , Table
+            "users"
+            [("id", TInt), ("name", TStr), ("age", TInt)]
+            [ [("id", VInt i), ("name", VStr ("user" ++ show i)), ("age", VInt (20 + i))]
+            | i <- [1 .. 5]
+            ]
+      )
+    , ( "orders"
+      , Table
+            "orders"
+            [("id", TInt), ("user_id", TInt)]
+            [[("id", VInt 1), ("user_id", VInt 1)]]
+      )
+    ]
+
+-- | 测试账号：迭代次数压低（跑得快），口令 `s3cret`
+testCredential :: Credential
+testCredential = Credential "admin" (hashPasswordWith 1000 (BS.replicate 16 7) "s3cret")
+
+-- 小工具
+
+-- | 取字段
+field :: Text -> A.Value -> Maybe A.Value
+field name (A.Object o) = KM.lookup (K.fromText name) o
+field _ _ = Nothing
+
+-- | 取字段（没有给 Null）
+at :: Text -> A.Value -> A.Value
+at name value = fromMaybe A.Null (field name value)
+
+-- | 当数组看
+items :: A.Value -> [A.Value]
+items (A.Array xs) = V.toList xs
+items _ = []
+
+-- | 当文本看
+asText :: A.Value -> Text
+asText (A.String t) = t
+asText _ = ""
+
+-- | 当整数看
+asInt :: A.Value -> Int
+asInt (A.Number n) = round n
+asInt _ = -1
+
+-- | JSON 当布尔看
+asBool :: A.Value -> Bool
+asBool (A.Bool b) = b
+asBool _ = False
+
+-- | 第 i 个元素（越界给 Nothing，不用 `!!`）
+nth :: Int -> [a] -> Maybe a
+nth i xs = case drop i xs of
+    (x : _) -> Just x
+    [] -> Nothing
+
+-- | 临时 TOML
+tcpConfigPath :: String -> IO FilePath
+tcpConfigPath name = do
+    tmp <- getTemporaryDirectory
+    pure (tmp </> ("chusql-server-test-" ++ name ++ ".toml"))
+
+-- | 临时设置文件（新会话读口令策略用）
+tempSettingsPath :: String -> IO FilePath
+tempSettingsPath name = do
+    tmp <- getTemporaryDirectory
+    pure (tmp </> ("chusql-server-test-" ++ name ++ "-settings.json"))
+
+-- | 文件不存在也算成功
+removeIfExists :: FilePath -> IO ()
+removeIfExists path = do
+    there <- doesFileExist path
+    if there then void (try (removeFile path) :: IO (Either IOException ())) else pure ()
+
+-- | 起一台内存后端的测试服务器
+withTcpServer :: ServerConfig -> (ServerEnv -> ServerHandle -> IO a) -> IO a
+withTcpServer config body = do
+    db <- newMVar testDb
+    limiter <- newRateLimiter getCurrentTime 50 300
+    path <- tempSettingsPath "tcp-server"
+    removeIfExists path
+    env <- newServerEnv (memoryBackend testDatabaseName db) testCredential path config{scPort = 0} limiter
+    handle <- startServer env
+    body env handle `finally` shStop handle
+
+-- | 连上服务器并配成行缓冲句柄
+withConnection :: ServerHandle -> (Handle -> IO a) -> IO a
+withConnection handle body = bracket open closeQuietly body
+  where
+    -- | 关连接，忽略异常
+    closeQuietly h = do
+        _ <- try (hClose h) :: IO (Either IOException ())
+        pure ()
+    -- | 建连接并配成行缓冲句柄
+    open = withSocketsDo $ do
+        infos <- getAddrInfo (Just defaultHints{addrSocketType = Stream}) (Just "127.0.0.1") (Just (show (shPort handle)))
+        info <- case infos of
+            (i : _) -> pure i
+            [] -> ioError (userError "cannot resolve the test server address")
+        sock <- socket (addrFamily info) Stream defaultProtocol
+        connect sock (addrAddress info)
+        h <- socketToHandle sock ReadWriteMode
+        hSetBuffering h LineBuffering
+        hSetNewlineMode h noNewlineTranslation
+        pure h
+
+-- | 发一行收一行；服务器不回话就判失败，别把用例挂死
+tcpTalk :: Handle -> BS.ByteString -> IO A.Value
+tcpTalk h raw = do
+    BSC.hPutStr h raw
+    BSC.hPutStr h "\n"
+    hFlush h
+    line <- timeout (5 * 1000000) (BSC.hGetLine h)
+    case line of
+        Just got -> pure (fromMaybe A.Null (decode (BL.fromStrict got)))
+        Nothing -> do
+            expectationFailure "the TCP server did not answer in time"
+            pure A.Null
+
+-- | 登录一行
+tcpLogin :: Handle -> Text -> Text -> IO A.Value
+tcpLogin h user password =
+    tcpTalk h (BSC.pack ("{\"method\":\"login\",\"user\":\"" ++ T.unpack user ++ "\",\"password\":\"" ++ T.unpack password ++ "\"}"))
+
+-- | 查询一行
+tcpQuery :: Handle -> Text -> IO A.Value
+tcpQuery h sql = tcpTalk h (BSC.pack ("{\"method\":\"query\",\"sql\":\"" ++ T.unpack sql ++ "\"}"))
+
+-- | 断言对端已经收工（读到 EOF）
+tcpClosed :: Handle -> IO ()
+tcpClosed h = do
+    done <- timeout (5 * 1000000) (hIsEOF h)
+    done `shouldBe` Just True
+
+-- 用例
+
+-- | 协议与配置的用例
+tcpSpec :: Spec
+tcpSpec = do
+    describe "TCP protocol: decoding a request line" $ do
+        it "hello without a protocol number takes the current version" $
+            decodeRequest "{\"method\":\"hello\"}" `shouldBe` Right (ReqHello 1)
+        it "hello keeps the protocol number the client asked for" $
+            decodeRequest "{\"method\":\"hello\",\"protocol\":2}" `shouldBe` Right (ReqHello 2)
+        it "method names are case-insensitive" $
+            decodeRequest "{\"method\":\"PING\"}" `shouldBe` Right ReqPing
+        it "unknown extra fields are ignored" $
+            decodeRequest "{\"method\":\"quit\",\"line\":7}" `shouldBe` Right ReqQuit
+        it "login without a password is refused" $
+            decodeRequest "{\"method\":\"login\",\"user\":\"admin\"}" `shouldBe` Left "login needs both user and password"
+        it "query without sql is refused" $
+            decodeRequest "{\"method\":\"query\"}" `shouldBe` Left "query needs sql"
+        it "an unknown method is named in the error" $
+            decodeRequest "{\"method\":\"frobnicate\"}" `shouldBe` Left "unknown method: frobnicate"
+        it "a line that is not JSON is a bad request, not a crash" $
+            decodeRequest "not json" `shouldBe` Left "request is not valid JSON"
+
+    describe "TCP protocol: encoding a response" $ do
+        it "hello carries the protocol version and the server name" $ do
+            let value = fromMaybe A.Null (decode (encodeResponse (RespHello 1)))
+            asText (at "status" value) `shouldBe` "hello"
+            asText (at "server" value) `shouldBe` "chusql-server"
+            asInt (at "protocol" value) `shouldBe` 1
+        it "login reports the account and whether it is the administrator" $ do
+            let value = fromMaybe A.Null (decode (encodeResponse (RespLogin "admin" True)))
+            asText (at "user" value) `shouldBe` "admin"
+            asBool (at "admin" value) `shouldBe` True
+        it "an error carries a code and a message" $ do
+            let value = fromMaybe A.Null (decode (encodeResponse (RespError "no_database" "no database selected")))
+            asText (at "status" value) `shouldBe` "error"
+            asText (at "code" value) `shouldBe` "no_database"
+            asText (at "message" value) `shouldBe` "no database selected"
+        it "a result set is the command line JSON with a status field added" $ do
+            let sample = QueryResult ["id"] [[VInt 1]] 1 False (Just "test")
+                value = fromMaybe A.Null (decode (encodeResponse (RespResult sample)))
+            asText (at "status" value) `shouldBe` "result"
+            map asText (items (at "columns" value)) `shouldBe` ["id"]
+            asInt (at "rowCount" value) `shouldBe` 1
+            asBool (at "truncated" value) `shouldBe` False
+            asText (at "database" value) `shouldBe` "test"
+
+    describe "server config ([server] in chusql.toml)" $ do
+        it "falls back to the defaults when the file has no server section" $ do
+            path <- tcpConfigPath "server-default"
+            removeIfExists path
+            loadServerConfigAt path `shouldReturn` defaultServerConfig
+        it "reads host, port, max_message and max_rows" $ do
+            path <- tcpConfigPath "server-keys"
+            BS.writeFile path "[server]\nhost = \"0.0.0.0\"\nport = 7777\nmax_message = 4096\nmax_rows = 7\n"
+            config <- loadServerConfigAt path
+            scHost config `shouldBe` "0.0.0.0"
+            scPort config `shouldBe` 7777
+            scMaxMessage config `shouldBe` 4096
+            scMaxRows config `shouldBe` 7
+        it "keeps the HTTP, storage and page keys out of the server config" $ do
+            path <- tcpConfigPath "server-other-keys"
+            BS.writeFile path "[web]\nport = 8888\n\n[storage]\ndata_dir = \"/tmp/chusql\"\n\n[page]\nsize = 8192\n"
+            config <- loadServerConfigAt path
+            scPort config `shouldBe` scPort defaultServerConfig
+            scMaxRows config `shouldBe` scMaxRows defaultServerConfig
+
+-- | 真连 TCP 服务器的用例
+tcpServerSpec :: Spec
+tcpServerSpec = do
+    describe "TCP server: handshake and login" $ do
+        it "binds a real port when asked for port 0" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                shPort handle `shouldSatisfy` (> 0)
+        it "answers hello with the same protocol version" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    reply <- tcpTalk h "{\"method\":\"hello\",\"protocol\":1}"
+                    asText (at "status" reply) `shouldBe` "hello"
+                    asInt (at "protocol" reply) `shouldBe` 1
+        it "still answers a client that connects long after startup" $
+            -- 回归点：早先 accept 外面套 timeout 轮询，超时异常会在 accept
+            -- 返回后把刚拿到的连接丢掉，只有延迟连接的客户端能撞上
+            withTcpServer defaultServerConfig $ \_ handle -> do
+                threadDelay 400000
+                withConnection handle $ \h -> do
+                    reply <- tcpTalk h "{\"method\":\"hello\",\"protocol\":1}"
+                    asText (at "status" reply) `shouldBe` "hello"
+                    asText (at "server" reply) `shouldBe` "chusql-server"
+        it "refuses a protocol version it does not speak" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    reply <- tcpTalk h "{\"method\":\"hello\",\"protocol\":9}"
+                    asText (at "code" reply) `shouldBe` "bad_request"
+                    asText (at "message" reply) `shouldBe` "unsupported protocol version: 9"
+        it "refuses a query before login" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    reply <- tcpQuery h "select * from users"
+                    asText (at "status" reply) `shouldBe` "error"
+                    asText (at "code" reply) `shouldBe` "unauthorized"
+                    asText (at "message" reply) `shouldBe` "sign in first"
+        it "refuses a wrong password and then accepts the right one" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    bad <- tcpLogin h "admin" "wrong"
+                    asText (at "status" bad) `shouldBe` "error"
+                    asText (at "code" bad) `shouldBe` "unauthorized"
+                    good <- tcpLogin h "admin" "s3cret"
+                    asText (at "status" good) `shouldBe` "ok"
+                    asText (at "user" good) `shouldBe` "admin"
+                    asBool (at "admin" good) `shouldBe` True
+
+    describe "TCP server: SQL over the wire" $ do
+        it "USE picks a database and the result reports it" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    _ <- tcpLogin h "admin" "s3cret"
+                    reply <- tcpQuery h "use test"
+                    asText (at "status" reply) `shouldBe` "result"
+                    asText (at "database" reply) `shouldBe` "test"
+        it "SELECT returns the fixture rows" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    _ <- tcpLogin h "admin" "s3cret"
+                    _ <- tcpQuery h "use test"
+                    reply <- tcpQuery h "select * from users"
+                    asText (at "status" reply) `shouldBe` "result"
+                    map asText (items (at "columns" reply)) `shouldBe` ["id", "name", "age"]
+                    asInt (at "rowCount" reply) `shouldBe` 5
+                    let first = case map items (items (at "rows" reply)) of
+                            (r : _) -> r
+                            [] -> []
+                    length first `shouldBe` 3
+                    asInt (fromMaybe A.Null (nth 0 first)) `shouldBe` 1
+                    asText (fromMaybe A.Null (nth 1 first)) `shouldBe` "user1"
+        it "an unknown table maps to not_found" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    _ <- tcpLogin h "admin" "s3cret"
+                    _ <- tcpQuery h "use test"
+                    reply <- tcpQuery h "select * from nope"
+                    asText (at "code" reply) `shouldBe` "not_found"
+        it "a query without a selected database maps to no_database" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    _ <- tcpLogin h "admin" "s3cret"
+                    reply <- tcpQuery h "select * from users"
+                    asText (at "code" reply) `shouldBe` "no_database"
+        it "an empty sql is a bad request" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    _ <- tcpLogin h "admin" "s3cret"
+                    reply <- tcpTalk h "{\"method\":\"query\",\"sql\":\"  \"}"
+                    asText (at "code" reply) `shouldBe` "bad_request"
+                    asText (at "message" reply) `shouldBe` "sql must not be empty"
+        it "the row limit truncates the rows but keeps the total count" $
+            withTcpServer defaultServerConfig{scMaxRows = 2} $ \_ handle ->
+                withConnection handle $ \h -> do
+                    _ <- tcpLogin h "admin" "s3cret"
+                    _ <- tcpQuery h "use test"
+                    reply <- tcpQuery h "select * from users"
+                    length (items (at "rows" reply)) `shouldBe` 2
+                    asInt (at "rowCount" reply) `shouldBe` 5
+                    asBool (at "truncated" reply) `shouldBe` True
+
+    describe "TCP server: framing and lifecycle" $ do
+        it "a bad JSON line does not kill the connection" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    bad <- tcpTalk h "not json"
+                    asText (at "code" bad) `shouldBe` "bad_request"
+                    pong <- tcpTalk h "{\"method\":\"ping\"}"
+                    asText (at "status" pong) `shouldBe` "pong"
+        it "a line over the message limit is refused as too_large" $
+            withTcpServer defaultServerConfig{scMaxMessage = 32} $ \_ handle ->
+                withConnection handle $ \h -> do
+                    reply <- tcpTalk h (BSC.pack ("{\"method\":\"query\",\"sql\":\"" ++ replicate 40 'a' ++ "\"}"))
+                    asText (at "code" reply) `shouldBe` "too_large"
+        it "ping answers pong and quit closes the connection" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    pong <- tcpTalk h "{\"method\":\"ping\"}"
+                    asText (at "status" pong) `shouldBe` "pong"
+                    bye <- tcpTalk h "{\"method\":\"quit\"}"
+                    asText (at "status" bye) `shouldBe` "bye"
+                    tcpClosed h
+        it "one connection is one session" $
+            withTcpServer defaultServerConfig $ \_ handle ->
+                withConnection handle $ \h -> do
+                    reply <- tcpLogin h "admin" "s3cret"
+                    asText (at "status" reply) `shouldBe` "ok"
+                    withConnection handle $ \other -> do
+                        blocked <- tcpQuery other "select * from users"
+                        asText (at "code" blocked) `shouldBe` "unauthorized"

chusql-storage/src/endpoint.rs

@@ -1,99 +0,0 @@
-// 本地端点：Windows 上是具名管道 `\\.\pipe\<name>`，Unix/macOS 上是文件系统套接字
-// `<socket_dir>/<name>.sock`。存储进程、Haskell 前端（见 chusql-engine 的 Storage.IPC）
-// 和集成测试都用同一条规则，保证对同一个 `[server] pipe_name` 算出同一个端点。
-//
-// 用文件系统套接字而不是 Linux 抽象命名空间：抽象命名空间没有文件、跨平台不存在，
-// 而带路径的套接字两个方向都能连，Haskell 那边也能用常规 socket 连上。
-
-use interprocess::local_socket::{prelude::*, ListenerOptions};
-#[cfg(unix)]
-use interprocess::local_socket::GenericFilePath;
-#[cfg(windows)]
-use interprocess::local_socket::GenericNamespaced;
-#[cfg(unix)]
-use std::path::{Path, PathBuf};
-
-/// 端点的可读形式：Windows 是 `\\.\pipe\<name>`，Unix 是套接字文件路径。
-pub fn display(pipe_name: &str) -> String {
-    #[cfg(windows)]
-    {
-        format!("\\\\.\\pipe\\{}", pipe_name)
-    }
-    #[cfg(unix)]
-    {
-        socket_path(pipe_name).display().to_string()
-    }
-}
-
-/// Unix 端点路径：`$XDG_RUNTIME_DIR` → `$TMPDIR` → `/tmp`，文件名固定 `<pipe_name>.sock`。
-#[cfg(unix)]
-pub fn socket_path(pipe_name: &str) -> PathBuf {
-    let dir = std::env::var_os("XDG_RUNTIME_DIR")
-        .filter(|v| !v.is_empty())
-        .or_else(|| std::env::var_os("TMPDIR").filter(|v| !v.is_empty()))
-        .map(PathBuf::from)
-        .unwrap_or_else(|| PathBuf::from("/tmp"));
-    dir.join(format!("{}.sock", pipe_name))
-}
-
-/// 连到正在监听的存储进程。
-pub fn connect(pipe_name: &str) -> std::io::Result<LocalSocketStream> {
-    #[cfg(windows)]
-    {
-        let name = pipe_name
-            .to_ns_name::<GenericNamespaced>()
-            .map_err(|e| std::io::Error::other(e.to_string()))?;
-        LocalSocketStream::connect(name)
-    }
-    #[cfg(unix)]
-    {
-        let path = socket_path(pipe_name);
-        let name = path
-            .to_fs_name::<GenericFilePath>()
-            .map_err(|e| std::io::Error::other(e.to_string()))?;
-        LocalSocketStream::connect(name)
-    }
-}
-
-/// 监听端点：Windows 直接建具名管道；Unix 先探活，再清掉上次崩溃留下的残留套接字文件。
-pub fn listen(pipe_name: &str) -> std::io::Result<LocalSocketListener> {
-    #[cfg(windows)]
-    {
-        let name = pipe_name
-            .to_ns_name::<GenericNamespaced>()
-            .map_err(|e| std::io::Error::other(e.to_string()))?;
-        ListenerOptions::new().name(name).create_sync()
-    }
-    #[cfg(unix)]
-    {
-        let path = socket_path(pipe_name);
-        prepare_socket_path(&path)?;
-        let name = path
-            .to_fs_name::<GenericFilePath>()
-            .map_err(|e| std::io::Error::other(e.to_string()))?;
-        ListenerOptions::new().name(name).create_sync()
-    }
-}
-
-/// Unix：先探活的监听者，再清掉残留的套接字文件。
-#[cfg(unix)]
-fn prepare_socket_path(path: &Path) -> std::io::Result<()> {
-    match std::os::unix::net::UnixStream::connect(path) {
-        Ok(_) => Err(std::io::Error::new(
-            std::io::ErrorKind::AddrInUse,
-            format!(
-                "another storage server already listens on {}",
-                path.display()
-            ),
-        )),
-        Err(_) => {
-            if path.exists() {
-                std::fs::remove_file(path)?;
-            }
-            if let Some(parent) = path.parent() {
-                std::fs::create_dir_all(parent)?;
-            }
-            Ok(())
-        }
-    }
-}

chusql-web/app/Main.hs

@@ -3,32 +3,28 @@
 module Main (main) where
 
 import ChuSQL.Web.API (AppEnv (..), Live (..), newAppEnvAt, setLive, webApp)
-import ChuSQL.Web.Auth (Credential (..), SessionPolicy (..), newSessionStore)
+import ChuSQL.Interface.Auth (Credential (..), SessionPolicy (..), setPayloadPolicy)
-import ChuSQL.Web.Backend (Backend, ipcBackend)
+import ChuSQL.Interface.Config (
-import ChuSQL.Web.Demo (SeedReport (..), seedDemo)
+    ServerConfig (..),
-import ChuSQL.Web.Config (
     WebConfig (..),
     defaultPassword,
     defaultUser,
+    loadServerConfigAt,
     loadWebConfigAt,
     resolveCredential,
-    resolvePipeName,
+    resolvePlainPassword,
     resolveStaticDir,
+    rootUserName,
     staticDirCandidates,
     usingDefaultCredentials,
  )
-import ChuSQL.Web.RateLimit (newRateLimiter)
+import ChuSQL.Interface.Link (clientPing, closeClient, connectClient)
-import ChuSQL.Storage.IPC (setPipeName)
+import ChuSQL.Interface.RateLimit (newRateLimiter)
-import ChuSQL.Web.Settings (effectiveSettings, readSettingsFile)
+import ChuSQL.Interface.Session (authenticateSession, newSession)
-import ChuSQL.Web.TOML (resolveConfigPath)
+import ChuSQL.Interface.Settings (effectiveSettings, readSettingsFile)
-import ChuSQL.Web.StorageProcess (
+import ChuSQL.Interface.TOML (resolveConfigPath)
-    StorageProcess (..),
+import ChuSQL.Web.Demo (SeedReport (..), seedDemo)
-    findStorageServer,
+import Control.Exception (IOException, try)
-    startStorageProcess,
-    stopStorageProcess,
-    waitForStorage,
- )
-import Control.Exception (IOException, bracket, onException, try)
 import Data.Char (toLower)
 import qualified Data.Map.Strict as Map
 import Data.String (fromString)
@@ -43,14 +39,13 @@ import System.Exit (exitFailure)
 import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
 import Text.Read (readMaybe)
 
--- Web 管理端入口：读配置、备凭据、拉起存储进程，最后起 Warp。
+-- Web 管理端入口：读配置，把请求转给拥有存储的 server，最后起 Warp。
 
 data Options = Options
     { optConfig :: Maybe FilePath
     , optHost :: Maybe String
     , optPort :: Maybe Int
     , optStatic :: Maybe FilePath
-    , optStorage :: Maybe FilePath
     , optUser :: Maybe Text
     , optCookieSecure :: Maybe Bool
     , optBodyLimit :: Maybe Int
@@ -74,7 +69,6 @@ emptyOptions =
         , optHost = Nothing
         , optPort = Nothing
         , optStatic = Nothing
-        , optStorage = Nothing
         , optUser = Nothing
         , optCookieSecure = Nothing
         , optBodyLimit = Nothing
@@ -94,13 +88,13 @@ emptyOptions =
 parseArgs :: [String] -> Either String Options
 parseArgs = go emptyOptions
   where
+    -- | 逐个参数累加进 Options
     go opts [] = Right opts
     go opts ("--help" : rest) = go opts{optHelp = True} rest
     go opts ("-h" : rest) = go opts{optHelp = True} rest
     go opts ("--config" : v : rest) = go opts{optConfig = Just v} rest
     go opts ("--host" : v : rest) = go opts{optHost = Just v} rest
     go opts ("--static" : v : rest) = go opts{optStatic = Just v} rest
-    go opts ("--storage" : v : rest) = go opts{optStorage = Just v} rest
     go opts ("--user" : v : rest) = go opts{optUser = Just (T.pack v)} rest
     go opts ("--port" : v : rest) = withInt "--port" v (\n -> go opts{optPort = Just n} rest)
     go opts ("--body-limit" : v : rest) = withInt "--body-limit" v (\n -> go opts{optBodyLimit = Just n} rest)
@@ -116,13 +110,15 @@ parseArgs = go emptyOptions
     go opts ("--cookie-secure" : v : rest) = go opts{optCookieSecure = Just (isTrue v)} rest
     go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a)
 
+    -- | 解析一个整数参数
     withInt :: String -> String -> (Int -> Either String Options) -> Either String Options
     withInt name v k = maybe (Left (name ++ " needs an integer, got: " ++ v)) k (readMaybe v)
 
+    -- | 把 1/true/yes/on 认成真
     isTrue :: String -> Bool
     isTrue s = map toLower s `elem` ["1", "true", "yes", "on"]
 
--- | 帮助
+-- | 打印命令行用法
 usage :: IO ()
 usage = do
     putStrLn "usage: chusql-web [options]"
@@ -130,15 +126,14 @@ usage = do
     putStrLn "config: chusql.toml sits at a fixed place and its sections hold every knob below;"
     putStrLn "        Windows: %APPDATA%\\ChuSQL\\chusql.toml"
     putStrLn "        other:   $XDG_CONFIG_HOME/ChuSQL/chusql.toml (or ~/.config/ChuSQL/chusql.toml)"
-    putStrLn "        [web] host/port/static_dir/user/password and the limits; [server] pipe_name;"
+    putStrLn "        [web] host/port/static_dir/user/password and the limits;"
     putStrLn "        [storage] data_dir; [page] size; [btree] order; [buffer] pool_size; [log] level"
     putStrLn ""
     putStrLn "  --config FILE          read that config file instead ([web] host ...)"
     putStrLn "  --host H               listen address              ([web] host, default 127.0.0.1)"
-    putStrLn "  --port N               listen port                 ([web] port, default 7777)"
+    putStrLn "  --port N               listen port                 ([web] port, default 7778)"
     putStrLn "  --static DIR           static asset directory      ([web] static_dir, default static)"
     putStrLn "  --user NAME            administrator name          ([web] user, default root)"
-    putStrLn "  --storage SERVER       Rust storage exe to spawn   ([web] storage_server)"
     putStrLn "  --cookie-secure BOOL   add Secure to the cookie    ([web] cookie_secure, default false)"
     putStrLn "  --body-limit N         max request body bytes      ([web] body_limit, default 65536)"
     putStrLn "  --session-idle N       session idle timeout, sec   ([web] session_idle, default 28800)"
@@ -155,8 +150,10 @@ usage = do
     putStrLn "  an empty password means the administrator signs in with no password; ordinary accounts are then refused"
     putStrLn ("without either the demo administrator is " ++ T.unpack defaultUser ++ " / " ++ T.unpack defaultPassword)
     putStrLn "ordinary accounts: CREATE USER / ALTER USER / DROP USER from the SQL console (administrator only)"
-    putStrLn "storage process: [server] pipe_name says where to talk and where a spawned one listens;"
+    putStrLn "storage: the server owns the data directory and loads the chusql_core_storage library;"
-    putStrLn "  [storage] data_dir, [page] size, [btree] order, [buffer] pool_size and [log] level are its own"
+    putStrLn "  this process is a plain TCP client: every statement, lookup and account request goes to it"
+    putStrLn "  [server] host / port says where it listens; [storage] data_dir, [page] size, [btree] order,"
+    putStrLn "  [buffer] pool_size and [log] level are the server's own"
 
 -- | 命令行覆盖配置
 applyOptions :: WebConfig -> Options -> WebConfig
@@ -165,9 +162,6 @@ applyOptions cfg opts =
         { wcHost = orElse (optHost opts) (wcHost cfg)
         , wcPort = orElse (optPort opts) (wcPort cfg)
         , wcStaticDir = orElse (optStatic opts) (wcStaticDir cfg)
-        , wcStorageServer = case optStorage opts of
-            Just p -> Just p
-            Nothing -> wcStorageServer cfg
         , wcUser = orElse (optUser opts) (wcUser cfg)
         , wcCookieSecure = orElse (optCookieSecure opts) (wcCookieSecure cfg)
         , wcBodyLimit = orElse (optBodyLimit opts) (wcBodyLimit cfg)
@@ -182,21 +176,12 @@ applyOptions cfg opts =
         , wcSeedDemo = orElse (optSeedDemo opts) (wcSeedDemo cfg)
         }
   where
+    -- | 有就用新的，没有留旧值
     orElse :: Maybe a -> a -> a
     orElse (Just x) _ = x
     orElse Nothing y = y
 
--- | 配了存储进程路径就拉起来，没配就假设外面已经跑着
+-- | 程序入口
-startStorageIfWanted :: WebConfig -> FilePath -> IO (Either String (Maybe StorageProcess))
-startStorageIfWanted cfg configPath = case wcStorageServer cfg of
-    Nothing -> pure (Right Nothing)
-    Just given -> do
-        found <- findStorageServer (Just given)
-        case found of
-            Left e -> pure (Left e)
-            Right bin -> fmap (fmap Just) (startStorageProcess bin configPath)
-
--- | 入口
 main :: IO ()
 main = do
     hSetBuffering stdout LineBuffering
@@ -210,13 +195,12 @@ main = do
             | optHelp opts -> usage
             | otherwise -> run opts
 
--- | 起服务
+-- | 读配置装配环境，检查 server，起 Warp
 run :: Options -> IO ()
 run opts = do
     configPath <- resolveConfigPath (optConfig opts)
     base <- loadWebConfigAt configPath
     let cfg = applyOptions base opts
-    setPipeName (resolvePipeName cfg)
     foundStatic <- resolveStaticDir (wcStaticDir cfg)
     case foundStatic of
         Nothing -> do
@@ -224,44 +208,31 @@ run opts = do
             exitFailure
         Just staticDir -> do
             let settingsFile = configPath
+                policy = SessionPolicy (fromIntegral (wcSessionIdle cfg)) (fromIntegral (wcSessionMax cfg))
             saved <- readSettingsFile settingsFile
-            cred <- resolveCredential cfg saved
+            config <- loadServerConfigAt settingsFile
-            storage <- startStorageIfWanted cfg configPath
-            case storage of
-                Left err -> do
-                    putStrLn err
-                    exitFailure
-                Right maybeStorage -> do
-                    backend <- ipcBackend
-                    let policy =
-                            SessionPolicy
-                                (fromIntegral (wcSessionIdle cfg))
-                                (fromIntegral (wcSessionMax cfg))
-                    sessions <- newSessionStore getCurrentTime policy
             limiter <-
                 newRateLimiter
                     getCurrentTime
                     (wcLoginMaxAttempts cfg)
                     (fromIntegral (wcLoginWindow cfg))
-                    env0 <- newAppEnvAt settingsFile backend sessions cred limiter staticDir
+            env0 <- newAppEnvAt settingsFile (T.pack (scHost config)) (scPort config) limiter staticDir
-                        `onException` maybe (pure ()) stopStorageProcess maybeStorage
             let env =
                     env0
                         { aeCookieSecure = wcCookieSecure cfg
                         , aeEffective = effectiveSettings cfg
                         , aeLog = TIO.putStrLn
                         }
+            setPayloadPolicy (aeSessions env) policy
             setLive env (liveFromConfig cfg)
             app <- webApp env
-                    printBanner cfg configPath staticDir maybeStorage
+            printBanner cfg configPath staticDir
-                    reportCredential cred saved
+            reportCredential cfg saved
-                    waitForStorageReport
+            checkServer (aeServerHost env) (aeServerPort env)
-                    seedIfWanted cfg backend
+            seedIfWanted cfg saved (aeServerHost env) (aeServerPort env)
             let settings =
                     Warp.setPort (wcPort cfg) (Warp.setHost (fromString (wcHost cfg)) Warp.defaultSettings)
-                    case maybeStorage of
+            serve settings app
-                        Nothing -> serve settings app
-                        Just sp -> bracket (pure sp) stopStorageProcess (const (serve settings app))
 
 -- | 本次启动的配置摊成热改参数
 liveFromConfig :: WebConfig -> Live
@@ -291,26 +262,38 @@ serve settings app = do
             exitFailure
 
 -- | 口令是从哪来的（用了内置默认口令就明确警告）
-reportCredential :: Credential -> Map.Map Text Text -> IO ()
+reportCredential :: WebConfig -> Map.Map Text Text -> IO ()
-reportCredential cred saved
+reportCredential cfg saved = do
-    | usingDefaultCredentials saved = do
+    credential <- resolveCredential cfg saved
+    if usingDefaultCredentials saved
+        then do
             putStrLn ""
             putStrLn "  !! Administrator credentials are not configured; the built-in demo password is in use:"
-        putStrLn ("  !!   user " ++ T.unpack (credUser cred) ++ " / password " ++ T.unpack defaultPassword)
+            putStrLn ("  !!   user " ++ T.unpack (credUser credential) ++ " / password " ++ T.unpack defaultPassword)
             putStrLn "  !!   set user / password in the [web] section of chusql.toml and restart"
             putStrLn ""
-    | T.null (credEncoded cred) =
+        else
-        putStrLn ("administrator: " ++ T.unpack (credUser cred) ++ " (passwordless: only the administrator may sign in)")
+            if T.null (credEncoded credential)
-    | otherwise = putStrLn ("administrator: " ++ T.unpack (credUser cred) ++ " (credentials come from the settings file only)")
+                then putStrLn ("administrator: " ++ T.unpack (rootUserName cfg saved) ++ " (passwordless: only the administrator may sign in)")
+                else putStrLn ("administrator: " ++ T.unpack (rootUserName cfg saved) ++ " (credentials come from the settings file only)")
 
--- | 配了 seed 就补一份演示数据
+-- | 配了 seed 就以管理员身份补演示数据
-seedIfWanted :: WebConfig -> Backend -> IO ()
+seedIfWanted :: WebConfig -> Map.Map Text Text -> Text -> Int -> IO ()
-seedIfWanted cfg backend
+seedIfWanted cfg saved host port
     | not (wcSeedDemo cfg) = pure ()
     | otherwise = do
-        result <- seedDemo backend
+        opened <- connectClient host port
+        case opened of
+            Left message -> TIO.putStrLn ("demo data skipped: " <> message)
+            Right client -> do
+                session <- newSession client
+                signed <- authenticateSession session (rootUserName cfg saved) (resolvePlainPassword saved)
+                case signed of
+                    Left message -> TIO.putStrLn ("demo data skipped: " <> message)
+                    Right () -> do
+                        result <- seedDemo session
                         case result of
-            Left e -> TIO.putStrLn ("demo data skipped: " <> T.pack e)
+                            Left message -> TIO.putStrLn ("demo data skipped: " <> message)
                             Right report ->
                                 TIO.putStrLn
                                     ( "demo data: "
@@ -318,20 +301,24 @@ seedIfWanted cfg backend
                                         <> (if null (srSkipped report) then "" else ", kept " <> T.pack (unwords (srSkipped report)))
                                         <> (if null (srIndexes report) then "" else ", index on " <> T.pack (unwords (srIndexes report)))
                                     )
+                closeClient client
 
--- | 报一下存储进程通不通
+-- | ping 一次 server，报告它通不通
-waitForStorageReport :: IO ()
+checkServer :: Text -> Int -> IO ()
-waitForStorageReport = do
+checkServer host port = do
-    up <- waitForStorage 20
+    opened <- connectClient host port
-    putStrLn
+    case opened of
-        ( if up
+        Left message -> putStrLn ("storage:      DOWN (" ++ T.unpack message ++ ")")
-            then "storage:      up (endpoint answered ping)"
+        Right client -> do
-            else "storage:      DOWN (no ping reply; start the Rust storage process or pass --storage)"
+            probe <- clientPing client
-        )
+            closeClient client
+            case probe of
+                Right () -> putStrLn "storage:      up (the server answered ping)"
+                Left message -> putStrLn ("storage:      DOWN (" ++ T.unpack message ++ ")")
 
 -- | 启动横幅
-printBanner :: WebConfig -> FilePath -> FilePath -> Maybe StorageProcess -> IO ()
+printBanner :: WebConfig -> FilePath -> FilePath -> IO ()
-printBanner cfg configPath staticDir maybeStorage = do
+printBanner cfg configPath staticDir = do
     putStrLn "==================== ChuSQL Web ===================="
     putStrLn ("url:          http://" ++ wcHost cfg ++ ":" ++ show (wcPort cfg) ++ "/")
     putStrLn ("config file:  " ++ configPath)
@@ -360,6 +347,4 @@ printBanner cfg configPath staticDir maybeStorage = do
             ++ show (wcLoginWindow cfg)
             ++ "s"
         )
-    case maybeStorage of
+    putStrLn "storage:      through the server that owns the data directory"
-        Just sp -> putStrLn ("storage proc: spawned, talking on pipe " ++ spPipe sp)
-        Nothing -> putStrLn "storage proc: assumed to run elsewhere (pipe name from [server] pipe_name)"

chusql-web/chusql-web.cabal

@@ -4,37 +4,27 @@ name:           chusql-web
 version:        1.0.0
 synopsis:       ChuSQL Web 管理端：Scotty + REST API + 静态页面
 description:    ChuSQL 的浏览器管理端。负责 HTTP 交付、鉴权、静态文件，
-                以及把用户 SQL 转交给 chusql-engine（再由 IPC 打到 Rust 存储进程）。
+                并把用户的 SQL 经 TCP 转交给 chusql-server（存储由服务器进程里的
+                chusql_core_storage 动态库承担）。本进程不链引擎，也不碰存储。
+                数据库服务器与 TCP 协议在 chusql-server 包里，这里只做 HTTP 这一面。
 build-type:     Simple
 
 library
     hs-source-dirs:   src
-    exposed-modules:  ChuSQL.Web.Actions
+    exposed-modules:  ChuSQL.Web.API
-                      ChuSQL.Web.Accounts
-                      ChuSQL.Web.API
-                      ChuSQL.Web.Auth
-                      ChuSQL.Web.Backend
-                      ChuSQL.Web.Config
                       ChuSQL.Web.Demo
-                      ChuSQL.Web.Privileges
-                      ChuSQL.Web.RateLimit
                       ChuSQL.Web.Secure
-                      ChuSQL.Web.Settings
                       ChuSQL.Web.Static
-                      ChuSQL.Web.StorageProcess
-                      ChuSQL.Web.TOML
                       ChuSQL.Web.UISettings
     build-depends:    base >= 4.14 && < 5
                     , aeson
                     , bytestring
-                    , chusql-engine
+                    , chusql-core-model
+                    , chusql-interface
                     , containers
-                    , crypton
                     , directory
                     , filepath
                     , http-types
-                    , memory
-                    , process
                     , scientific
                     , scotty
                     , text
@@ -48,30 +38,32 @@ executable chusql-web
     main-is:          Main.hs
     hs-source-dirs:   app
     build-depends:    base
-                    , bytestring
+                    , chusql-interface
-                    , chusql-engine
                     , chusql-web
                     , containers
-                    , crypton
-                    , directory
-                    , filepath
-                    , http-types
-                    , memory
                     , text
                     , time
                     , wai
                     , warp
     default-language: Haskell2010
     ghc-options:      -Wall
+    -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
+    if os(linux)
+        ld-options: -Wl,-rpath,$ORIGIN
+    if os(osx)
+        ld-options: -Wl,-rpath,@loader_path
 
 test-suite chusql-web-test
     type:             exitcode-stdio-1.0
     main-is:          Spec.hs
     hs-source-dirs:   test
+    other-modules:    Gates
+    build-tool-depends: chusql-server:chusql-server
     build-depends:    base
                     , aeson
                     , bytestring
-                    , chusql-engine
+                    , chusql-core-model
+                    , chusql-interface
                     , chusql-web
                     , containers
                     , directory
@@ -88,4 +80,4 @@ test-suite chusql-web-test
                     , wai-extra
                     , warp
     default-language: Haskell2010
-    ghc-options:      -Wall
+    ghc-options:      -Wall -threaded

chusql-web/src/ChuSQL/Web/Demo.hs

@@ -10,16 +10,17 @@ module ChuSQL.Web.Demo (
     seedDemo,
 ) where
 
-import ChuSQL.Model (Value (..))
+import ChuSQL.Core.Model (Value (..))
-import ChuSQL.Storage.IPC (TableInfo (..))
+import ChuSQL.Core.Protocol (TableInfo (..))
-import ChuSQL.Web.Actions (
+import ChuSQL.Interface.Actions (
     ColumnSpec (..),
     CreateTableSpec (..),
     createIndexSql,
     createTableSql,
     insertRowsSql,
  )
-import ChuSQL.Web.Backend (Backend (..))
+import ChuSQL.Interface.Session (Session, catalog, runStatement)
+import Data.Text (Text)
 import qualified Data.Text as T
 
 -- 演示数据：三张表加一个二级索引，语句与界面走同一套拼 SQL 的代码。
@@ -75,12 +76,12 @@ data SeedReport = SeedReport
     }
     deriving (Show, Eq)
 
--- | 缺什么补什么，可反复点不重复灌
+-- | 按需灌演示数据：缺表补表、缺索引补索引
-seedDemo :: Backend -> IO (Either String SeedReport)
+seedDemo :: Session -> IO (Either Text SeedReport)
-seedDemo backend = do
+seedDemo session = do
-    catalog <- beCatalog backend
+    catalogResult <- catalog session
-    case catalog of
+    case catalogResult of
-        Left e -> pure (Left e)
+        Left message -> pure (Left message)
         Right infos -> do
             let existingTables = map tiTable infos
                 missing = [spec | spec <- demoTableSpecs, T.unpack (ctsTable spec) `notElem` existingTables]
@@ -93,34 +94,33 @@ seedDemo backend = do
                     ]
             created <- runAll (map createTableSql missing)
             case created of
-                Left e -> pure (Left e)
+                Left message -> pure (Left message)
                 Right () -> do
                     rowsDone <- runAll [insertRowsSql t rs | (t, rs) <- demoRows, t `elem` missingNames]
                     case rowsDone of
-                        Left e -> pure (Left e)
+                        Left message -> pure (Left message)
                         Right () -> do
-                            indexes <-
+                            indexes <- runAll [createIndexSql t c | (t, c) <- wantedIndexes]
-                                runAll [createIndexSql t c | (t, c) <- wantedIndexes]
+                            pure $ fmap (const (SeedReport (map T.unpack missingNames) skipped (map (T.unpack . snd) wantedIndexes))) indexes
-                            pure $
-                                fmap
-                                    (const (SeedReport (map T.unpack missingNames) skipped (map (T.unpack . snd) wantedIndexes)))
-                                    indexes
   where
-    runAll :: [Either String String] -> IO (Either String ())
+    -- | 顺序跑完一串语句，首错即停
+    runAll :: [Either String String] -> IO (Either Text ())
     runAll [] = pure (Right ())
     runAll (sql : rest) = case sql of
-        Left e -> pure (Left e)
+        Left e -> pure (Left (T.pack e))
         Right statement -> do
-            result <- beStatement backend statement
+            result <- runStatement session (T.pack statement)
             case result of
-                Left e -> pure (Left e)
+                Left message -> pure (Left message)
                 Right _ -> runAll rest
 
-    indexMissing :: [TableInfo] -> T.Text -> T.Text -> Bool
+    -- | 目录里这张表缺不缺这个索引
+    indexMissing :: [TableInfo] -> Text -> Text -> Bool
     indexMissing infos t c = case lookup (T.unpack t) [(tiTable i, tiIndexes i) | i <- infos] of
         Nothing -> True
         Just cols -> T.unpack c `notElem` cols
 
+-- | 演示用户数据
 userRecords :: [(String, Int)]
 userRecords =
     [ ("Alice", 24)
@@ -135,6 +135,7 @@ userRecords =
     , ("Judy", 29)
     ]
 
+-- | 演示订单数据
 orderRecords :: [(Int, String, Int)]
 orderRecords =
     [ (1, "Laptop", 1299)
@@ -151,6 +152,7 @@ orderRecords =
     , (9, "Lamp", 39)
     ]
 
+-- | 演示产品数据
 productRecords :: [(String, Int, Int)]
 productRecords =
     [ ("Laptop", 1001, 1299)

chusql-web/src/ChuSQL/Web/Static.hs

@@ -23,7 +23,7 @@ maxNameLength = 128
 allowedExtensions :: [String]
 allowedExtensions = [".html", ".css", ".js", ".svg", ".png", ".ico", ".ttf", ".woff2"]
 
--- | 把请求里的文件名变成安全的相对路径；不合法给 Nothing
+-- | 把请求文件名校验成安全相对路径，不合法给 Nothing
 safeRelative :: Text -> Maybe FilePath
 safeRelative t
     | T.null t = Nothing
@@ -33,6 +33,7 @@ safeRelative t
     | map toLower (takeExtension (T.unpack t)) `notElem` allowedExtensions = Nothing
     | otherwise = Just (T.unpack t)
   where
+    -- | 文件名里是否出现不允许的字符
     badChar c = not (isAsciiLower c || isAsciiUpper c || isDigit c || c `elem` ("._-" :: String))
 
 -- | 读一个静态文件；不存在（或是目录）给 Nothing

chusql-web/src/ChuSQL/Web/StorageProcess.hs

@@ -1,113 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Web.StorageProcess (
-    StorageProcess (..),
-    findStorageServer,
-    startStorageProcess,
-    startStorageProcessAt,
-    platformBinaryName,
-    storageChildArgs,
-    stopStorageProcess,
-    waitForStorage,
-) where
-
-import ChuSQL.Storage.IPC (Request (..), Response (..), closeConnection, sendRequest, setPipeName)
-import ChuSQL.Web.Config (loadWebConfigAt, resolvePipeName)
-import Control.Concurrent (threadDelay)
-import Control.Exception (SomeException, try)
-import Control.Monad (filterM)
-import System.Directory (doesFileExist)
-import System.Exit (ExitCode)
-import System.FilePath ((</>))
-import System.Info (os)
-import System.IO (Handle)
-import System.Process (
-    CreateProcess (..),
-    ProcessHandle,
-    StdStream (..),
-    createProcess,
-    proc,
-    terminateProcess,
-    waitForProcess,
- )
-
--- 拉起并管理 Rust 存储进程，起来后等管道应答 ping 再继续。
--- 调参、管名与数据目录都在全局 chusql.toml 里，孩子自己读；这里只负责起进程、
--- 用 --config 把「读哪份配置文件」告诉它，并等就绪。
-
-data StorageProcess = StorageProcess
-    { spProcess :: ProcessHandle
-    , spPipe :: String
-    }
-
--- | 可执行文件名跟平台走：Windows 带 .exe，其它平台不带。同一个 target 目录里可能
--- 同时躺着一份别处交叉编译出来的 .exe（Windows PE），在 Linux 上误选它只会拿到
--- config file not found（Windows 进程看不到 /tmp/... 这样的路径）。目标平台当参数传，
--- 两个分支都能被测试直接钉住。
-platformBinaryName :: String -> String -> FilePath
-platformBinaryName targetOs stem = if targetOs == "mingw32" then stem ++ ".exe" else stem
-
--- | 找存储进程，没有就给路径提示
-findStorageServer :: Maybe FilePath -> IO (Either String FilePath)
-findStorageServer (Just p) = do
-    ok <- doesFileExist p
-    pure (if ok then Right p else Left ("storage server not found: " ++ p))
-findStorageServer Nothing = do
-    let dirs =
-            [ "chusql-storage/target"
-            , "../chusql-storage/target"
-            , "../../chusql-storage/target"
-            , "target"
-            ]
-        modes = ["release", "debug"]
-        exes = [platformBinaryName os "chusql-storage"]
-        candidates = [d </> m </> e | d <- dirs, m <- modes, e <- exes]
-    found <- filterM doesFileExist candidates
-    pure $ case found of
-        (p : _) -> Right p
-        [] -> Left "no Rust storage server found; run `cargo build --release` in chusql-storage, or pass --storage <path>"
-
--- | 按配置文件里的管名起存储进程
-startStorageProcess :: FilePath -> FilePath -> IO (Either String StorageProcess)
-startStorageProcess bin configPath = do
-    cfg <- loadWebConfigAt configPath
-    startStorageProcessAt bin (resolvePipeName cfg) configPath
-
--- | 给存储子进程的参数：配置文件位置是固定的，唯一的显式覆盖就是写进 --config
-storageChildArgs :: FilePath -> [String]
-storageChildArgs configPath = ["--config", configPath]
-
--- | 用给定的管名起存储进程，并把本进程的端点也指到它；环境原样继承
-startStorageProcessAt :: FilePath -> String -> FilePath -> IO (Either String StorageProcess)
-startStorageProcessAt bin pipe configPath = do
-    let child = (proc bin (storageChildArgs configPath)){std_out = NoStream, std_err = Inherit}
-    started <-
-        try (createProcess child) ::
-            IO (Either SomeException (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-    case started of
-        Left e -> pure (Left ("failed to start the storage process: " ++ show e))
-        Right (_, _, _, ph) -> do
-            setPipeName pipe
-            ready <- waitForStorage (200 :: Int)
-            if ready
-                then pure (Right (StorageProcess ph pipe))
-                else do
-                    _ <- try (terminateProcess ph) :: IO (Either SomeException ())
-                    pure (Left "storage process did not become ready within 5 seconds (no ping reply on the pipe)")
-
--- | 停掉存储进程，保留数据目录
-stopStorageProcess :: StorageProcess -> IO ()
-stopStorageProcess sp = do
-    closeConnection
-    _ <- try (terminateProcess (spProcess sp)) :: IO (Either SomeException ())
-    _ <- try (waitForProcess (spProcess sp)) :: IO (Either SomeException ExitCode)
-    pure ()
-
--- | 轮询 ping 直到对面应答
-waitForStorage :: Int -> IO Bool
-waitForStorage 0 = pure False
-waitForStorage n = do
-    r <- try (sendRequest ReqPing) :: IO (Either SomeException Response)
-    case r of
-        Right RespPong -> pure True
-        _ -> threadDelay 25000 >> waitForStorage (n - 1)

chusql-web/src/ChuSQL/Web/UISettings.hs

@@ -42,15 +42,18 @@ resolveUISettingsFile = do
             ready <- firstExistingDir uiSettingsFileCandidates
             pure (maybe firstCandidate id ready)
   where
+    -- | 首选候选路径
     firstCandidate = case uiSettingsFileCandidates of
         (p : _) -> p
         [] -> "chusql.ui.settings.json"
 
+    -- | 第一个存在的候选文件
     firstExistingFile [] = pure Nothing
     firstExistingFile (p : ps) = do
         ok <- doesFileExist p
         if ok then pure (Just p) else firstExistingFile ps
 
+    -- | 目录已存在的第一个候选
     firstExistingDir [] = pure Nothing
     firstExistingDir (p : ps) = do
         let dir = takeDirectory p
@@ -61,6 +64,7 @@ resolveUISettingsFile = do
 validateUISettings :: A.Value -> Either String (Map.Map Text A.Value)
 validateUISettings (A.Object o) = Map.fromList <$> mapM checkField (KM.toList o)
   where
+    -- | 校验一个字段
     checkField (rawKey, value) =
         let key = K.toText rawKey
          in case key of
@@ -80,16 +84,20 @@ validateUISettings (A.Object o) = Map.fromList <$> mapM checkField (KM.toList o)
                 "minimap" -> pair key <$> boolValue key value
                 _ -> Left ("unknown setting: " ++ T.unpack key)
 
+    -- | 把键和值配成一对
     pair key value = (key, value)
 
 validateUISettings _ = Left "settings must be a JSON object"
 
+-- | 字体链最多几项
 fontChainMax :: Int
 fontChainMax = 10
 
+-- | 单个字体名最长多少字
 fontNameMax :: Int
 fontNameMax = 64
 
+-- | 空值占位文本最长多少字
 nullTextMax :: Int
 nullTextMax = 64
 

chusql-web/stack.yaml

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

chusql-web/static/api.js

@@ -1,12 +1,14 @@
 // REST 数据源：与 chusql-web 的 /api/* 一一对应。
-// 所有请求带 X-ChuSQL-Database 头（服务端不保存 USE 状态）；401 时广播登录事件。
+// 请求都带 X-ChuSQL-Database 头；401 时广播登录事件。
 
 export const AUTH_EVENT = 'chusql-auth-required';
 
+// 是否是普通对象。
 function isObject(value) {
   return value !== null && typeof value === 'object' && !Array.isArray(value);
 }
 
+// 发一次请求并处理错误。
 async function request(url, init, database) {
   const headers = new Headers(init && init.headers ? init.headers : undefined);
   if (database) headers.set('X-ChuSQL-Database', database);
@@ -34,6 +36,7 @@ async function request(url, init, database) {
   return body;
 }
 
+// 组装 JSON 请求参数。
 function jsonInit(method, body) {
   return {
     method,
@@ -44,12 +47,14 @@ function jsonInit(method, body) {
 
 const identifier = /^[A-Za-z_][A-Za-z0-9_]{0,63}$/;
 
+// 校验数据库名格式。
 function checkDatabaseName(name) {
   if (!identifier.test(String(name))) throw new Error('数据库名只能是字母、数字与下划线，且以字母或下划线开头。');
 }
 
 // ---------------------------------------------------------------- 会话
 
+// 读取当前会话。
 export async function currentSession() {
   const body = await request('/api/session');
   if (!isObject(body) || typeof body.user !== 'string') throw new Error('服务器返回的会话信息无法识别。');
@@ -60,16 +65,19 @@ export async function currentSession() {
   };
 }
 
+// 提交登录。
 export async function login(user, password) {
   await request('/api/login', jsonInit('POST', { user, password }));
 }
 
+// 退出登录。
 export async function logout() {
   await request('/api/logout', jsonInit('POST', {}));
 }
 
 // ---------------------------------------------------------------- 数据库
 
+// 列出数据库。
 export async function listDatabases() {
   const body = await request('/api/databases');
   if (!Array.isArray(body) || !body.every((name) => typeof name === 'string')) {
@@ -78,16 +86,18 @@ export async function listDatabases() {
   return body;
 }
 
+// 新建数据库。
 export async function createDatabase(name, database) {
   checkDatabaseName(name);
   await request('/api/databases', jsonInit('POST', { name }), database);
 }
 
+// 删除数据库。
 export async function dropDatabase(name, database) {
   await request(`/api/databases/${encodeURIComponent(name)}`, jsonInit('DELETE'), database);
 }
 
-// 切换当前库：走一条 USE 语句，服务端在响应里回带新的库名。
+// 切换当前库（发 USE 语句）。
 export async function useDatabase(name, database) {
   checkDatabaseName(name);
   return query(`USE ${name}`, database);
@@ -95,12 +105,14 @@ export async function useDatabase(name, database) {
 
 // ---------------------------------------------------------------- 表结构
 
+// 取类型基名（去掉参数）。
 function columnKind(type) {
   return String(type).split('(')[0].trim().toLowerCase();
 }
 
 const knownTypes = ['int', 'bigint', 'smallint', 'str', 'text', 'varchar', 'char', 'float', 'double', 'decimal', 'numeric', 'bool', 'date', 'timestamp', 'blob'];
 
+// 校验并规整列描述。
 function asColumns(value) {
   if (!Array.isArray(value)) throw new Error('服务器返回的列清单无法识别。');
   return value.map((entry) => {
@@ -112,6 +124,7 @@ function asColumns(value) {
   });
 }
 
+// 校验并规整表描述。
 function asTable(value) {
   if (!isObject(value) || typeof value.table !== 'string' || typeof value.rowCount !== 'number') {
     throw new Error('服务器返回的表描述无法识别。');
@@ -125,38 +138,46 @@ function asTable(value) {
   };
 }
 
+// 列出表。
 export async function listTables(database) {
   const body = await request('/api/tables', undefined, database);
   if (!Array.isArray(body)) throw new Error('服务器返回的表清单无法识别。');
   return body.map(asTable);
 }
 
+// 取单表结构。
 export async function getTable(database, table) {
   return asTable(await request(`/api/tables/${encodeURIComponent(table)}`, undefined, database));
 }
 
+// 新建表。
 export async function createTable(database, name, columns) {
   await request('/api/tables', jsonInit('POST', { name, columns }), database);
 }
 
+// 删除表。
 export async function dropTable(database, table) {
   await request(`/api/tables/${encodeURIComponent(table)}`, jsonInit('DELETE'), database);
 }
 
+// 建索引。
 export async function createIndex(database, table, column) {
   await request(`/api/tables/${encodeURIComponent(table)}/indexes`, jsonInit('POST', { column }), database);
 }
 
+// 删索引。
 export async function dropIndex(database, table, column) {
   await request(`/api/tables/${encodeURIComponent(table)}/indexes/${encodeURIComponent(column)}`, jsonInit('DELETE'), database);
 }
 
+// 删列。
 export async function dropColumn(database, table, column) {
   await request(`/api/tables/${encodeURIComponent(table)}/columns/${encodeURIComponent(column)}`, jsonInit('DELETE'), database);
 }
 
 // ---------------------------------------------------------------- 行
 
+// 分页取表数据。
 export async function fetchRows({ database, table, limit, offset, sort, dir, filters }) {
   const params = new URLSearchParams({ limit: String(limit), offset: String(offset) });
   if (sort) {
@@ -179,14 +200,17 @@ export async function fetchRows({ database, table, limit, offset, sort, dir, fil
   return { columns, rows, total: body.total };
 }
 
+// 插入一行。
 export async function insertRow(database, table, values) {
   await request(`/api/tables/${encodeURIComponent(table)}/rows`, jsonInit('POST', { values }), database);
 }
 
+// 更新一行。
 export async function updateRow(database, table, id, values) {
   await request(`/api/tables/${encodeURIComponent(table)}/rows/${encodeURIComponent(id)}`, jsonInit('PATCH', { values }), database);
 }
 
+// 删除一行。
 export async function deleteRow(database, table, id) {
   await request(`/api/tables/${encodeURIComponent(table)}/rows/${encodeURIComponent(id)}`, jsonInit('DELETE'), database);
 }
@@ -209,6 +233,7 @@ export async function commitChanges(database, changes) {
 
 // ---------------------------------------------------------------- 查询
 
+// 执行 SQL 并规整结果。
 export async function query(sql, database) {
   const started = performance.now();
   try {
@@ -231,27 +256,32 @@ export async function query(sql, database) {
   }
 }
 
+// 灌演示数据。
 export async function seedDemoData(database) {
   return request('/api/demo-data', jsonInit('POST', {}), database);
 }
 
 // ---------------------------------------------------------------- 设置
 
+// 读取服务器设置。
 export async function loadServerSettings() {
   const body = await request('/api/settings');
   if (!isObject(body) || !Array.isArray(body.items)) throw new Error('服务器返回的设置清单无法识别。');
   return body;
 }
 
+// 保存服务器设置。
 export async function saveServerSettings(values) {
   const body = await request('/api/settings', jsonInit('PUT', { values }));
   return isObject(body) ? body : { ok: true };
 }
 
+// 读取 IDE 设置。
 export async function loadUiSettings() {
   return request('/api/ui-settings');
 }
 
+// 保存 IDE 设置。
 export async function saveUiSettings(settings) {
   await request('/api/ui-settings', jsonInit('PUT', settings));
 }