diff --git a/.github/workflows/linux.yml b/.github/workflows/linux.yml index be1378d..9e822bb 100644 --- a/.github/workflows/linux.yml +++ b/.github/workflows/linux.yml @@ -74,6 +74,7 @@ jobs: path: | ~/.stack chusql-core/engine/.stack-work + chusql-bootstrap/.stack-work chusql-server/.stack-work chusql-web/.stack-work chusql-cli/.stack-work @@ -84,6 +85,10 @@ jobs: working-directory: chusql-cli run: stack build --fast + - name: bootstrap build + working-directory: chusql-bootstrap + run: stack build --fast + - name: engine tests working-directory: chusql-core/engine run: stack test --fast diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index d510807..10b3e15 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -97,6 +97,10 @@ jobs: working-directory: chusql-cli run: stack build --fast chusql-server:exe:chusql-server + - name: build bootstrap program + working-directory: chusql-bootstrap + run: stack build --fast chusql-bootstrap:exe:csql-bootstrap + # ---------- 装配 + 打归档(CI 里直接写在这里;本机打同一个包用 scripts/package.sh)---------- # 归档里是包内容本身(bin/、scripts/、static/、install.sh 就在根上),安装脚本按这个布局找文件。 - name: package (Unix) @@ -121,6 +125,15 @@ jobs: cp "$front" "$stage/bin/" done + # 引导程序住在自己的工程里,安装根也单独问它要 + bootstrap_root="$(cd chusql-bootstrap && stack path --local-install-root | tail -n 1 | tr -d '\r')" + bootstrap_bin="$bootstrap_root/bin/csql-bootstrap" + if [ ! -f "$bootstrap_bin" ]; then + bootstrap_bin="$(find chusql-bootstrap/.stack-work -name csql-bootstrap -type f 2>/dev/null | head -n 1 || true)" + fi + [ -n "$bootstrap_bin" ] && [ -f "$bootstrap_bin" ] || { echo "csql-bootstrap not found" >&2; exit 1; } + cp "$bootstrap_bin" "$stage/bin/" + # Haskell 一般静态链接,靶目录里真有共享库就一起带上;改名前的旧库(libchusql_storage.*)不能进包 for lib in chusql-core/storage/target/release/*.so chusql-core/storage/target/release/*.dylib; do [ -f "$lib" ] || continue @@ -130,14 +143,15 @@ jobs: cp "$lib" "$stage/bin/" done - cp scripts/chusql.toml scripts/init.sql "$stage/scripts/" + cp scripts/chusql.toml "$stage/scripts/" cp scripts/install.ps1 scripts/install.sh "$stage/" + cp scripts/uninstall.ps1 scripts/uninstall.sh "$stage/" mkdir -p "$stage/static" cp -R chusql-web/static/. "$stage/static/" cp scripts/csql-web.sh "$stage/" if [ -f scripts/csql-web.ps1 ]; then cp scripts/csql-web.ps1 "$stage/"; fi - chmod +x "$stage/install.sh" "$stage/csql-web.sh" + chmod +x "$stage/install.sh" "$stage/uninstall.sh" "$stage/csql-web.sh" mkdir -p dist tar -czf "dist/$name.tar.gz" -C "$stage" . @@ -167,13 +181,23 @@ jobs: Copy-Item $front "$stage/bin/" } + $bootstrapRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim() + $bootstrapExe = Join-Path $bootstrapRoot 'bin/csql-bootstrap.exe' + if (-not (Test-Path $bootstrapExe)) { + $bootstrapExe = Get-ChildItem -Path 'chusql-bootstrap/.stack-work' -Recurse -Filter 'csql-bootstrap.exe' -File -ErrorAction SilentlyContinue | + Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName + } + if (-not $bootstrapExe -or -not (Test-Path $bootstrapExe)) { throw 'csql-bootstrap.exe not found' } + Copy-Item $bootstrapExe "$stage/bin/" + # 第三方 dll 才要连带上:名字带 chusql 的是本 crate 产物或改名前的残留,上面已按名拷过 Get-ChildItem 'chusql-core/storage/target/release' -Filter '*.dll' -File -ErrorAction SilentlyContinue | Where-Object { $_.Name -notlike 'chusql*' } | ForEach-Object { Copy-Item $_.FullName "$stage/bin/" } - Copy-Item 'scripts/chusql.toml', 'scripts/init.sql' "$stage/scripts/" + Copy-Item 'scripts/chusql.toml' "$stage/scripts/" Copy-Item 'scripts/install.ps1', 'scripts/install.sh' $stage + Copy-Item 'scripts/uninstall.ps1', 'scripts/uninstall.sh' $stage New-Item -ItemType Directory -Force -Path "$stage/static" | Out-Null Copy-Item 'chusql-web/static/*' "$stage/static" -Recurse Copy-Item 'scripts/csql-web.sh' $stage diff --git a/.gitignore b/.gitignore index c1e7d33..f4b5322 100644 --- a/.gitignore +++ b/.gitignore @@ -94,3 +94,4 @@ plandocs/ Thumbs.db ehthumbs.db desktop.ini +AGENTS.md diff --git a/README.md b/README.md index 8d66260..b2dec76 100644 --- a/README.md +++ b/README.md @@ -1,46 +1,41 @@ # ChuSQL -本项目是一个简单的数据库项目,服务端采用 Haskell 和 Rust 联合编写,采取 B/S 模式,管理客户端运行在浏览器网页上。 +本项目是一个简单的数据库项目,服务端采用 Haskell 和 Rust 联合编写 -优点: +## 快速开始 -- 轻量:几个可执行文件加两个动态库、一份静态资源,解包即用,没有 Node / Python 之类的运行时依赖 -- 部署容易:Linux 与 macOS 一条命令装完并启动,Windows 解压后跑一次安装脚本 -- 配置统一:一个 `chusql.toml` 同时管住存储、Web 与命令行 -- 账号统一:Web 管理端与命令行共用同一个管理员和同一张账号表 +### 安装 -## 安装 - -Linux / macOS(自动识别当前平台,取对应发行包): +Linux / macOS: ```sh curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh | sh -s -- --component web ``` -Windows:下载 `chusql-windows-x86_64.zip`,解压后在 PowerShell 里执行 +Windows(PowerShell 里下下来再跑;也有下载 zip 解压的包内安装): ```powershell -.\install.ps1 -Component web +irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1" +& "$env:TEMP\install.ps1" -Component web ``` -不写 `--component` 时脚本会逐个问「装 cli 吗」「装 web 吗」(默认装 `csql`、不装 Web);只装命令行 -客户端就把 `web` 换成 `cli`,两个都要用 `both`。安装位置、目录结构与卸载方式见 -[doc/install.md](doc/install.md)。 +### 启动 -## 启动 +```sh +csql +``` + +启动CLI界面,或 ```sh csql-web ``` -浏览器打开 http://127.0.0.1:7778 ,默认账号 `root`,口令是安装时给的那个。服务启动后只有系统库 `system`(里面是账号表),**没有默认工作库**:自己建一个库再用 `USE <库名>` 选中它。 -换口令、换端口、改数据目录都在安装时写好的 `chusql.toml` 里。 +启动web界面,默认通过7778端口访问 -## 文档 +## 更多参考文档 -| 文档 | 内容 | -| --------------------------------- | ------------------------------------------------------------------------ | -| [安装与卸载](doc/install.md) | 三种安装方式、全部安装选项、装完的目录结构、从源码安装、卸载 | -| [配置选项](doc/config.md) | 配置位置与优先级、全部配置键与默认值、数据目录、口令与安全 | -| [命令与选项](doc/commands.md) | `csql` 与 `chusql-web` 的选项、元命令、账号与角色权限、REST 接口 | -| [架构与组件](doc/architecture.md) | 三个组件怎么分工、一次请求经过什么、数据落在哪 | +- [安装与卸载](docs/install.md) +- [配置选项](docs/config.md) +- [命令与选项](docs/commands.md) +- [架构与组件](docs/architecture.md) diff --git a/benchmark/chusql-fullchain.cabal b/chusql-benchmark/chusql-benchmark.cabal similarity index 88% rename from benchmark/chusql-fullchain.cabal rename to chusql-benchmark/chusql-benchmark.cabal index a40aa25..2f96e65 100644 --- a/benchmark/chusql-fullchain.cabal +++ b/chusql-benchmark/chusql-benchmark.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 -name: chusql-fullchain +name: chusql-benchmark version: 1.0.0 synopsis: ChuSQL 全链路基准:起真 server,全部请求走 TCP description: 以基准客户端身份起一个 chusql-server 进程(存储与引擎都在那个进程里), @@ -8,10 +8,11 @@ description: 以基准客户端身份起一个 chusql-server 进程(存储 本程序不链引擎、不链 server 库,只用 TCP 客户端与协议模型。 build-type: Simple -executable chusql-fullchain +executable chusql-benchmark main-is: Main.hs hs-source-dirs: src build-tool-depends: chusql-server:chusql-server + , chusql-bootstrap:csql-bootstrap build-depends: base >= 4.14 && < 5 , chusql-core-model , chusql-interface diff --git a/benchmark/src/Main.hs b/chusql-benchmark/src/Main.hs similarity index 94% rename from benchmark/src/Main.hs rename to chusql-benchmark/src/Main.hs index 8313e3b..c464ab5 100644 --- a/benchmark/src/Main.hs +++ b/chusql-benchmark/src/Main.hs @@ -36,6 +36,7 @@ import System.Process ( StdStream (CreatePipe, NoStream), createProcess, proc, + readProcessWithExitCode, terminateProcess, waitForProcess, ) @@ -350,6 +351,16 @@ locateServerExe = do putStrLn "chusql-server was not found on PATH: run `stack build` first" exitFailure +-- | 在 PATH 里找引导程序(server 需要先引导) +locateBootstrapExe :: IO FilePath +locateBootstrapExe = do + found <- findExecutable (binaryName "csql-bootstrap") + case found of + Just path -> pure path + Nothing -> do + putStrLn "csql-bootstrap was not found on PATH: run `stack build` first" + exitFailure + -- | 从 server 输出里读出监听端口 readListeningPort :: Handle -> IO Int readListeningPort handle = do @@ -396,7 +407,7 @@ startBench = do bin <- locateServerExe tmp <- getTemporaryDirectory stamp <- getMonotonicTime - let name = "chusql-fullchain-" ++ show (round (stamp * 1e6) :: Int) + let name = "chusql-benchmark-" ++ show (round (stamp * 1e6) :: Int) dataDir = tmp name configPath = tmp (name ++ ".toml") -- TOML 的普通字符串会吃反斜杠,路径统一用正斜杠 @@ -405,6 +416,13 @@ startBench = do writeFile configPath (benchConfigText slashed) printf "config : %s\n" configPath printf "data dir : %s\n" dataDir + bootstrap <- locateBootstrapExe + (bootCode, bootOut, bootErr) <- readProcessWithExitCode bootstrap ["--config", configPath, "--passwordless"] "" + case bootCode of + ExitSuccess -> printf "bootstrap: system catalog ready\n" + _ -> do + putStrLn ("the bootstrap program failed (exit " ++ show bootCode ++ "): " ++ bootOut ++ bootErr) + exitFailure (_, Just out, _, process) <- createProcess (proc bin ["--config", configPath]){std_out = CreatePipe, std_err = NoStream} port <- readListeningPort out @@ -418,7 +436,7 @@ startBench = do exitFailure Right client -> do session <- newSession client - auth <- authenticateSession session (T.pack "admin") (T.pack "s3cret") + auth <- authenticateSession session (T.pack "admin") (T.pack "") case auth of Left err -> do putStrLn ("cannot sign in: " ++ T.unpack err) @@ -429,13 +447,12 @@ startBench = 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\"" diff --git a/chusql-benchmark/stack.yaml b/chusql-benchmark/stack.yaml new file mode 100644 index 0000000..67fb2c7 --- /dev/null +++ b/chusql-benchmark/stack.yaml @@ -0,0 +1,12 @@ +resolver: lts-24.59 + +extra-lib-dirs: + - ../chusql-core/storage/target/release + +packages: + - . + - ../chusql-core/engine + - ../chusql-core/model + - ../chusql-interface + - ../chusql-server + - ../chusql-bootstrap diff --git a/benchmark/stack.yaml.lock b/chusql-benchmark/stack.yaml.lock similarity index 100% rename from benchmark/stack.yaml.lock rename to chusql-benchmark/stack.yaml.lock diff --git a/chusql-bootstrap/app/Main.hs b/chusql-bootstrap/app/Main.hs new file mode 100644 index 0000000..1b91901 --- /dev/null +++ b/chusql-bootstrap/app/Main.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink) +import ChuSQL.Interface.Auth (hashPassword) +import ChuSQL.Interface.Config (loadWebConfigAt, rootUserName) +import ChuSQL.Interface.Settings (readSettingsFile) +import ChuSQL.Interface.TOML (resolveConfigPath) +import qualified Data.Aeson as A +import qualified Data.Aeson.KeyMap as KM +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy.Char8 as BL +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Environment (getArgs) +import System.Exit (exitFailure) +import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout) + +-- 引导程序:建系统库与管理员账号,装完即退,留在 bin 里备用。 + +data Options = Options + { optConfig :: Maybe FilePath + , optUser :: Maybe String + , optPasswordStdin :: Bool + , optPasswordless :: Bool + , optHelp :: Bool + } + +-- | 全部选项都取默认值 +emptyOptions :: Options +emptyOptions = + Options + { optConfig = Nothing + , optUser = Nothing + , optPasswordStdin = False + , optPasswordless = False + , 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 ("--user" : v : rest) = go opts{optUser = Just v} rest + go opts ("--password-stdin" : rest) = go opts{optPasswordStdin = True} rest + go opts ("--passwordless" : rest) = go opts{optPasswordless = True} rest + go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a) + +-- | 打印用法说明 +usage :: IO () +usage = do + putStrLn "usage: csql-bootstrap [options]" + putStrLn "" + putStrLn "config: chusql.toml sits at a fixed place (Windows: %APPDATA%\\ChuSQL\\chusql.toml;" + putStrLn " other: $XDG_CONFIG_HOME/ChuSQL/chusql.toml), the same file the server reads" + putStrLn "" + putStrLn " --config FILE read that config file instead" + putStrLn " --user NAME administrator name ([web] user, default root)" + putStrLn " --password-stdin read the administrator password from one line of stdin" + putStrLn " --passwordless leave the administrator without a password" + putStrLn "" + putStrLn "what it does: creates the system database, the __system_users table and the" + putStrLn " administrator row, then exits. It never changes an existing account, and it" + putStrLn " never deletes data, so the installer and later repairs can run it again." + +-- | 入口 +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 + saved <- readSettingsFile configPath + let name = maybe (rootUserName base saved) T.pack (optUser opts) + chosen <- readPassword opts + case chosen of + Left err -> do + putStrLn ("!! " ++ err) + usage + exitFailure + Right plain -> do + encoded <- if T.null plain then pure "" else hashPassword plain + putStrLn "================== ChuSQL Bootstrap =================" + putStrLn ("config file: " ++ configPath) + putStrLn ("administrator: " ++ T.unpack name) + putStrLn + ( if T.null encoded + then "password: none yet (sign in with an empty one, then set it)" + else "password: set (stored hashed in the system table)" + ) + opened <- localStorageLink (Just configPath) + case opened of + Left err -> failWith ("cannot open the storage library: " ++ err) + Right link -> do + setStorageLink link + reply <- sendRawRequest (BL.toStrict (A.encode (bootstrapRequest name encoded))) + closeConnection + report reply + +-- | 引导请求:建表、插管理员行 +bootstrapRequest :: Text -> Text -> A.Value +bootstrapRequest name encoded = + A.object + [ "method" A..= ("bootstrap_system" :: Text) + , "user" A..= name + , "password_hash" A..= encoded + ] + +-- | 看应答:system 就是成功,其余按错误处理 +report :: Either String BS.ByteString -> IO () +report (Left err) = failWith ("cannot talk to the storage library: " ++ err) +report (Right raw) = case A.eitherDecodeStrict raw of + Right (A.Object fields) + | KM.lookup "status" fields == Just (A.String "system") -> + putStrLn "system catalog: ready" + | otherwise -> + failWith ("bootstrap failed: " ++ message fields) + Right _ -> failWith ("unexpected reply from the storage library: " ++ show raw) + Left err -> failWith ("the storage library answered something that is not JSON: " ++ err) + where + -- | 取错误文本 + message fields = case KM.lookup "message" fields of + Just (A.String text) -> T.unpack text + _ -> show raw + +-- | 读口令:stdin 一行,空行等于不设口令 +readPassword :: Options -> IO (Either String Text) +readPassword opts + | optPasswordless opts = pure (Right "") + | optPasswordStdin opts = do + line <- TIO.getLine + pure (Right (T.dropWhileEnd (\c -> c == '\r' || c == '\n') line)) + | otherwise = pure (Left "pass --password-stdin or --passwordless") + +-- | 打印错误并退出 1 +failWith :: String -> IO a +failWith message = do + putStrLn ("!! " ++ message) + exitFailure diff --git a/chusql-bootstrap/chusql-bootstrap.cabal b/chusql-bootstrap/chusql-bootstrap.cabal new file mode 100644 index 0000000..30a0185 --- /dev/null +++ b/chusql-bootstrap/chusql-bootstrap.cabal @@ -0,0 +1,20 @@ +cabal-version: 2.4 + +name: chusql-bootstrap +version: 1.0.0 +synopsis: ChuSQL 引导程序:建系统库与管理员账号 +description: ChuSQL 初始化引导。首次启动前建系统库、账号表与管理员行, + 装完即退,保留在 bin 里备用。后续的 catalog 修复也走这里。 +build-type: Simple + +executable csql-bootstrap + hs-source-dirs: app + main-is: Main.hs + build-depends: base >= 4.14 && < 5 + , aeson + , bytestring + , chusql-core-engine + , chusql-interface + , text + default-language: Haskell2010 + ghc-options: -Wall diff --git a/benchmark/stack.yaml b/chusql-bootstrap/stack.yaml similarity index 88% rename from benchmark/stack.yaml rename to chusql-bootstrap/stack.yaml index acfb0d8..83e06af 100644 --- a/benchmark/stack.yaml +++ b/chusql-bootstrap/stack.yaml @@ -8,4 +8,3 @@ packages: - ../chusql-core/engine - ../chusql-core/model - ../chusql-interface - - ../chusql-server diff --git a/chusql-bootstrap/stack.yaml.lock b/chusql-bootstrap/stack.yaml.lock new file mode 100644 index 0000000..e3f9041 --- /dev/null +++ b/chusql-bootstrap/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 diff --git a/chusql-cli/app/Main.hs b/chusql-cli/app/Main.hs index 1a608d8..cd1a282 100644 --- a/chusql-cli/app/Main.hs +++ b/chusql-cli/app/Main.hs @@ -11,15 +11,13 @@ import ChuSQL.CLI.Session ( newSession, switchDatabase, ) -import ChuSQL.Interface.Auth (Credential (..)) -import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, resolveCredential, resolvePlainPassword) +import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, rootUserName) import ChuSQL.Interface.Link (Client, closeClient, connectClient) import ChuSQL.Interface.Settings (readSettingsFile) import ChuSQL.Interface.TOML (resolveConfigPath) import Control.Exception (finally) import Control.Monad (unless) import Data.IORef (newIORef) -import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -35,7 +33,6 @@ import System.IO (hSetEncoding, stderr, stdout, utf8) data Options = Options { optUser :: Maybe Text - , optPromptPassword :: Bool , optDatabase :: Text , optFormat :: OutputFormat , optExecute :: Maybe Text @@ -48,7 +45,6 @@ optionsParser :: Parser Options optionsParser = Options <$> optional (T.pack <$> strOption (long "user" <> short 'u' <> metavar "USER" <> help "Sign in as this account (default: the configured administrator)")) - <*> switch (long "password" <> short 'p' <> help "Always ask for the password, ignoring the configured one") <*> ( T.pack <$> strOption ( long "database" @@ -94,11 +90,10 @@ main = do configPath <- resolveConfigPath (optConfig options) base <- loadWebConfigAt configPath saved <- readSettingsFile configPath - credential <- resolveCredential base saved config <- loadServerConfigAt configPath - let rootName = credUser credential + let rootName = rootUserName base saved userName = fromMaybe rootName (optUser options) - password <- resolvePassword (optPromptPassword options) userName rootName saved + password <- promptPassword userName connected <- connectClient (T.pack (scHost config)) (scPort config) case connected of Left message -> reportError message >> exitFailure @@ -141,14 +136,7 @@ selectDatabase session wanted Left message -> reportError message >> pure False Right () -> pure True --- | 决定口令是交互输入还是取自配置 -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 (resolvePlainPassword saved) - | otherwise = promptPassword userName - --- | 交互式读取口令 +-- | 交互式读取口令;直接回车表示空口令 promptPassword :: Text -> IO Text promptPassword user = do entered <- runInputT defaultSettings (getPassword (Just '*') (T.unpack user <> "'s password: ")) diff --git a/chusql-cli/src/ChuSQL/CLI/Script.hs b/chusql-cli/src/ChuSQL/CLI/Script.hs index e8c5957..90b7778 100644 --- a/chusql-cli/src/ChuSQL/CLI/Script.hs +++ b/chusql-cli/src/ChuSQL/CLI/Script.hs @@ -100,7 +100,7 @@ errorHint message | "unknown column" `T.isInfixOf` lowered = Just "run \\d to see the columns of a table" | "unknown database" `T.isInfixOf` lowered = Just "run \\l to list the databases" | "syntax" `T.isInfixOf` lowered = Just "one statement at a time, and every statement ends with a semicolon" - | "invalid user name or password" `T.isInfixOf` lowered = Just "check --user and the password" + | "invalid user name or password" `T.isInfixOf` lowered = Just "check --user and the password; an empty password works only while the account has none" | "sign in first" `T.isInfixOf` lowered = Just "the session expired, restart the CLI" | "too many failed sign-in attempts" `T.isInfixOf` lowered = Just "wait a few minutes before trying again" | otherwise = Nothing diff --git a/chusql-core/engine/app/Main.hs b/chusql-core/engine/app/Main.hs deleted file mode 100644 index 054bdf8..0000000 --- a/chusql-core/engine/app/Main.hs +++ /dev/null @@ -1,82 +0,0 @@ -module Main where - -import ChuSQL.Core.Engine.Algebra.Op (renderPlan) -import ChuSQL.Core.Engine.Algebra.Optimize (optimize) -import ChuSQL.Core.Engine.Algebra.Planner (translate) -import ChuSQL.Core.Engine -import ChuSQL.Core.Model -import ChuSQL.Core.Engine.Syntax.AST -import ChuSQL.Core.Engine.Syntax.Parser - --- 命令行演示入口:跑几条语句并打印结果与优化前后的计划。 - -users :: Table -users = - Table - { tableName = "users" - , tableCols = [("id", TInt), ("name", TStr), ("age", TInt)] - , tableRows = - [ [("id", VInt 1), ("name", VStr "Alice"), ("age", VInt 25)] - , [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)] - , [("id", VInt 3), ("name", VStr "Carol"), ("age", VInt 30)] - ] - } - -orders :: Table -orders = - Table - { tableName = "orders" - , tableCols = [("id", TInt), ("user_id", TInt), ("product", TStr)] - , tableRows = - [ [("id", VInt 1), ("user_id", VInt 1), ("product", VStr "Book")] - , [("id", VInt 2), ("user_id", VInt 2), ("product", VStr "Pen")] - , [("id", VInt 3), ("user_id", VInt 1), ("product", VStr "Cup")] - ] - } - -db :: Database -db = [("users", users), ("orders", orders)] - --- | 跑演示语句,打印结果与优化前后的计划 -main :: IO () -main = do - putStrLn "==================== Engine =====================" - let q1 = makeSelect ["name"] "users" (Just (Gt (Col "age") (LitInt 18))) - print (rowsOf (runStatement db q1)) - - let q2 = makeSelect ["*"] "users" Nothing - print (rowsOf (runStatement db q2)) - - let q3 = makeSelect ["name"] "nonexistent" Nothing - print (rowsOf (runStatement db q3)) - - let q4 = - makeSelect - ["name"] - "users" - ( Just - ( Or - (Lt (Col "age") (LitInt 18)) - (Gt (Col "age") (LitInt 30)) - ) - ) - print (rowsOf (runStatement db q4)) - - let parsed = parseStatement "SELECT name FROM users WHERE age > 18 AND name = 'Alice'" - print (rowsOf (parsed >>= runStatement db)) - - putStrLn "\n==================== Optimizer =====================" - let planSql = - "SELECT u.name, o.product FROM users u \ - \JOIN orders o ON u.id = o.user_id WHERE u.age > 18" - case parseStatement planSql of - Left err -> putStrLn err - Right query -> case translate query of - Left err -> putStrLn err - Right plan -> do - putStrLn "--- plan before optimization ---" - putStrLn (renderPlan plan) - putStrLn "--- plan after optimization ---" - putStrLn (renderPlan (optimize db plan)) - putStrLn "--- rows ---" - print (rowsOf (runStatement db query)) diff --git a/chusql-core/engine/chusql-core-engine.cabal b/chusql-core/engine/chusql-core-engine.cabal index 4c64516..2808478 100644 --- a/chusql-core/engine/chusql-core-engine.cabal +++ b/chusql-core/engine/chusql-core-engine.cabal @@ -9,13 +9,18 @@ build-type: Simple library hs-source-dirs: src - exposed-modules: ChuSQL.Core.Engine.Algebra.Eval + exposed-modules: ChuSQL.Core.Engine.Algebra.Cost + ChuSQL.Core.Engine.Algebra.Eval ChuSQL.Core.Engine.Algebra.Expr + ChuSQL.Core.Engine.Algebra.JoinOrder ChuSQL.Core.Engine.Algebra.Op ChuSQL.Core.Engine.Algebra.Optimize ChuSQL.Core.Engine.Algebra.Planner ChuSQL.Core.Engine.Algebra.Sort + ChuSQL.Core.Engine.Builtin + ChuSQL.Core.Engine.Error ChuSQL.Core.Engine + ChuSQL.Core.Engine.Parallel ChuSQL.Core.Engine.Semantic ChuSQL.Core.Engine.Storage ChuSQL.Core.Engine.Storage.FFI @@ -42,20 +47,6 @@ library 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 @@ -65,6 +56,7 @@ test-suite chusql-core-engine-test , chusql-core-model , directory , filepath + , hashable , hspec default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -threaded diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine.hs b/chusql-core/engine/src/ChuSQL/Core/Engine.hs index 504c3b2..588114a 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine.hs @@ -11,6 +11,7 @@ import ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage)) import ChuSQL.Core.Engine.Syntax.AST import ChuSQL.Core.Engine.Syntax.Parser (parseExpression) import Data.Maybe (mapMaybe) +import qualified Data.HashSet as HS -- 引擎入口:检查语义、按语句分发执行,另有内存实现与泛型版本。 @@ -86,13 +87,15 @@ runStatementUncheckedM db (Update tbl assigns mWhere) = rowsResult <- scan tbl case rowsResult of Left err -> pure (Left err) - Right rows -> do - newRows <- mapM (updateRowM db table mWhere assigns) rows - case sequence newRows of - Left err -> pure (Left err) - Right rs -> do - result <- replaceAll tbl rs - pure (result >> Right []) + Right rows -> case checkPlan table of + Left err -> pure (Left err) + Right plan -> do + newRows <- mapM (updateRowM db table plan mWhere assigns) rows + case sequence newRows of + Left err -> pure (Left err) + Right rs -> do + result <- replaceAll tbl rs + pure (result >> Right []) runStatementUncheckedM _ (CreateTable name cols) = do result <- createTable name cols pure (result >> Right []) @@ -156,7 +159,8 @@ buildRows table current cols rows = do -- | 逐行构造,最后统一查一遍约束 go _ _ [] acc = do let built = reverse acc - mapM_ (runChecks table) built + plan <- checkPlan table + mapM_ (runChecks plan) built enforceNotNull (tableCols table) built enforceUnique (tableCols table) (current ++ built) Right built @@ -208,19 +212,29 @@ autoStart (Just (name, _)) rows = case [n | r <- rows, Just (VInt n) <- [lookup [] -> 1 ns -> maximum ns + 1 --- | 执行 CHECK 约束 -runChecks :: Table -> Row -> Either String () -runChecks table row = mapM_ check (tableCols table) +-- | 一次解析出来的 CHECK 条件 +type CheckPlan = [(String, Expr)] + +-- | 把表上的 CHECK 文本解析成条件,每语句只解析一次 +checkPlan :: Table -> Either String CheckPlan +checkPlan table = mapM parse (mapMaybe checked (tableCols table)) where - -- | 查这一列的 CHECK - check (name, col) = case columnCheck col of - Nothing -> Right () - Just text -> case parseExpression text of - Left err -> Left ("CHECK on " ++ name ++ ": " ++ firstLine err) - Right e -> case evalCondForRow e row of - Left err -> Left ("CHECK on " ++ name ++ ": " ++ err) - Right True -> Right () - Right False -> Left ("CHECK on " ++ name ++ " failed") + -- | 只挑出带 CHECK 文本的列 + checked (name, col) = (,) name <$> columnCheck col + -- | 解析一列的 CHECK 文本 + parse (name, text) = case parseExpression text of + Left err -> Left ("CHECK on " ++ name ++ ": " ++ firstLine err) + Right e -> Right (name, e) + +-- | 执行解析好的 CHECK 条件 +runChecks :: CheckPlan -> Row -> Either String () +runChecks plan row = mapM_ check plan + where + -- | 跑一条 CHECK + check (name, e) = case evalCondForRow e row of + Left err -> Left ("CHECK on " ++ name ++ ": " ++ err) + Right True -> Right () + Right False -> Left ("CHECK on " ++ name ++ " failed") -- | 只取第一行(报错提示用) firstLine :: String -> String @@ -242,18 +256,18 @@ 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) + check (name, _) = go name HS.empty (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) - | otherwise = go name (v : seen) rest + | HS.member (canonicalValue v) seen = Left ("UNIQUE: duplicate value in column " ++ name) + | otherwise = go name (HS.insert (canonicalValue v) seen) rest -- | UPDATE 的一行(条件与赋值都可能带子查询) -updateRowM :: (MonadStorage m) => Database -> Table -> Maybe Expr -> [(String, Expr)] -> Row -> m (Either String Row) -updateRowM db table cond asgns row = do +updateRowM :: (MonadStorage m) => Database -> Table -> CheckPlan -> Maybe Expr -> [(String, Expr)] -> Row -> m (Either String Row) +updateRowM db table plan cond asgns row = do keep <- case cond of Nothing -> pure (Right True) Just e -> evalCondForRowM db e row @@ -262,7 +276,7 @@ updateRowM db table cond asgns row = do Right False -> pure (Right row) Right True -> do row' <- applyUpdatesM db table asgns row - pure (row' >>= \r -> runChecks table r >> Right r) + pure (row' >>= \r -> runChecks plan r >> Right r) -- | 依次求值、收类型并覆盖列(表达式可以带子查询) applyUpdatesM :: (MonadStorage m) => Database -> Table -> [(String, Expr)] -> Row -> m (Either String Row) @@ -316,8 +330,9 @@ alterTable db tbl change = case lookupTable db tbl of where -- | 改完再统一查一遍约束 checkAltered (cols, rows) = do - let table = Table tbl cols rows - mapM_ (runChecks table) rows + let table = Table tbl cols rows Nothing + plan <- checkPlan table + mapM_ (runChecks plan) rows enforceNotNull cols rows enforceUnique cols rows Right (cols, rows) diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Cost.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Cost.hs new file mode 100644 index 0000000..bdcdd7e --- /dev/null +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Cost.hs @@ -0,0 +1,31 @@ +module ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf, probeCost, pointRows, rangeRows, indexCheaper) where + +import ChuSQL.Core.Model + +-- 统计与成本估算:行数、列级不同值数与索引探路页数。 + +-- | 表统计,拿不到就是 Nothing +tableMetaOf :: Database -> String -> Maybe TableMeta +tableMetaOf db t = lookup t db >>= tableMeta + +-- | 索引探路的页数:B+Tree 高度 +probeCost :: Int -> Int +probeCost rows = max 1 (ceiling (logBase 2 (fromIntegral (max 2 rows) :: Double))) + +-- | 等值点查的估算命中行数:行数除以该列不同值数 +pointRows :: TableMeta -> String -> Int +pointRows m col = case [d | (c, d, _) <- metaDistinct m, c == col, d > 1] of + (d : _) -> max 1 (rows `div` d) + [] -> rows + where + rows = max 0 (metaRowCount m) + +-- | 范围扫描的估算命中行数:没有直方图,按四分之一算 +rangeRows :: TableMeta -> Int +rangeRows m = max 0 (metaRowCount m) `div` 4 + +-- | 有索引且探路加命中比全表扫便宜 +indexCheaper :: TableMeta -> String -> Int -> Bool +indexCheaper m col est = col `elem` metaIndexes m && probeCost rows + est < rows + where + rows = max 0 (metaRowCount m) diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Eval.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Eval.hs index 00504b1..752c56a 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Eval.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Eval.hs @@ -1,15 +1,17 @@ module ChuSQL.Core.Engine.Algebra.Eval (evalRelOp, evalRelOpM, evalExprM, evalCondForRowM) where +import ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf) import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr) -import ChuSQL.Core.Engine.Algebra.Optimize (optimize, relOpCols) +import ChuSQL.Core.Engine.Algebra.Optimize (optimize) import ChuSQL.Core.Engine.Algebra.Op import ChuSQL.Core.Engine.Algebra.Planner (translate) -import ChuSQL.Core.Engine.Algebra.Sort (compareValue, sortRows) +import ChuSQL.Core.Engine.Algebra.Sort (sortRows) +import ChuSQL.Core.Engine.Builtin (aggregateArg, builtinOfExpr, invokeBuiltin, unsupportedAggregate) import ChuSQL.Core.Model import ChuSQL.Core.Engine.Storage (IndexResult (..), MonadStorage (..)) import ChuSQL.Core.Engine.Storage.Memory (runMemoryStorage) import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..), Subquery (..)) -import Control.Monad (filterM, foldM) +import Control.Monad (filterM) import qualified Data.HashMap.Strict as HM -- 执行:按算子树算出结果行,外层行供相关子查询引用。 @@ -58,17 +60,10 @@ rowsCols :: [Row] -> [String] rowsCols (r : _) = map fst r rowsCols [] = [] --- | 参与等值匹配的键:NULL 不参与,整数值的浮点归一 +-- | 参与等值匹配的键:NULL 不参与,整值浮点归一 joinKey :: Value -> Maybe Value joinKey VNull = Nothing -joinKey (VFloat d) - | not (isNaN d) - , not (isInfinite d) - , fromIntegral (rounded :: Integer) == d = - Just (VInt (fromIntegral rounded)) - where - rounded = round d :: Integer -joinKey v = Just v +joinKey v = Just (canonicalValue v) -- | 取一行的连接键 joinKeyOf :: String -> Row -> Maybe Value @@ -230,57 +225,13 @@ groupRows keys rows = go rows (HM.empty, []) valuesOf :: Row -> Expr -> [Row] -> Either String [Value] valuesOf outer e rows = mapM (evalExpr e . (++ outer)) rows --- | 去掉 NULL -nonNull :: [Value] -> [Value] -nonNull = filter (/= VNull) - --- | 数值相加:整数配整数还是整数 -addValue :: Value -> Value -> Either String Value -addValue (VInt a) (VInt b) = Right (VInt (a + b)) -addValue (VInt a) (VFloat b) = Right (VFloat (fromIntegral a + b)) -addValue (VFloat a) (VInt b) = Right (VFloat (a + fromIntegral b)) -addValue (VFloat a) (VFloat b) = Right (VFloat (a + b)) -addValue _ _ = Left "type error: expected two numbers" - --- | 能当数用的值 -numberOf :: Value -> Either String Double -numberOf (VInt n) = Right (fromIntegral n) -numberOf (VFloat d) = Right d -numberOf _ = Left "type error: expected a number" - --- | 一组值里的极值(NULL 已经先剔掉) -extremeOf :: (Value -> Value -> Value) -> [Value] -> Either String Value -extremeOf _ [] = Right VNull -extremeOf pick (x : xs) = Right (foldl pick x xs) - --- | 一个聚合算子在一组行上的结果 +-- | 一个聚合算子在一组行上的结果,统一走内置函数权威 evalAgg :: Row -> Expr -> [Row] -> Either String Value -evalAgg outer agg rows = case agg of - CountAll -> Right (VInt (length rows)) - CountOf e -> do - vs <- valuesOf outer e rows - Right (VInt (length (nonNull vs))) - SumOf e -> do - vs <- valuesOf outer e rows - case nonNull vs of - [] -> Right VNull - xs -> foldM addValue (VInt 0) xs - AvgOf e -> do - vs <- valuesOf outer e rows - case nonNull vs of - [] -> Right VNull - xs -> do - total <- foldM addValue (VInt 0) xs - sumOf <- numberOf total - Right (VFloat (sumOf / fromIntegral (length xs))) - MinOf e -> valuesOf outer e rows >>= extremeOf lower . nonNull - 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 +evalAgg outer agg rows = case builtinOfExpr agg of + Nothing -> Left unsupportedAggregate + Just builtin -> do + vs <- maybe (Right []) (\e -> valuesOf outer e rows) (aggregateArg agg) + invokeBuiltin builtin (length rows) vs -- | 一组的输出行:分组列 + 各聚合值 oneGroup :: Row -> [String] -> [(String, Expr)] -> ([Value], [Row]) -> Either String Row @@ -429,8 +380,8 @@ evalRelOpIn db outer (Compute items op) = do evalRelOpIn db outer (Aggregate keys aggs op) = do rows <- evalRelOpIn db outer op pure (rows >>= evalAggregate outer keys aggs) -evalRelOpIn _ _ (Scan mAlias tbl cols) = do - res <- maybe (scan tbl) (scanColumns tbl) cols +evalRelOpIn db _ (Scan mAlias tbl cols) = do + res <- scanTable db tbl cols pure (fmap (prefixRows mAlias) res) evalRelOpIn db outer (Lookup mAlias tbl col k) = do res <- lookupByColumn tbl col k @@ -487,8 +438,23 @@ scanFiltered :: String -> Expr -> m (Either String [Row]) -scanFiltered _ outer mAlias tbl cond = do - res <- scan tbl +scanFiltered db outer mAlias tbl cond = do + res <- scanTable db tbl Nothing pure $ do rows <- res filterM (evalCondForRow cond . (++ outer)) (prefixRows mAlias rows) + +-- | 行数到阈值才值得并行分片 +parallelRowThreshold :: Int +parallelRowThreshold = 1000 + +-- | 表够大且存储支持并行时按分片扫,否则顺序扫 +scanTable :: (MonadStorage m) => Database -> String -> Maybe [String] -> m (Either String [Row]) +scanTable db tbl cols = do + width <- parallelShards + if width > 1 && rows >= parallelRowThreshold + then scanShards width tbl cols + else maybe (scan tbl) (scanColumns tbl) cols + where + -- | 统计里的行数,没有统计算 0 + rows = maybe 0 metaRowCount (tableMetaOf db tbl) diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Expr.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Expr.hs index 7354e0c..ca10b1d 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Expr.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Expr.hs @@ -1,8 +1,8 @@ -module ChuSQL.Core.Engine.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, hasDivision, inValues, threeValuedNot) where import ChuSQL.Core.Model import ChuSQL.Core.Engine.Syntax.AST -import Control.Monad (join) +import ChuSQL.Core.Engine.Builtin (Operator (..), executeOperator, inValues, threeValuedNot) -- 表达式求值:三值逻辑,NULL 参与运算结果仍是 NULL。 @@ -18,22 +18,18 @@ evalExpr (LitBool b) _ = Right (VBool b) evalExpr (LitDate s) _ = Right (VStr s) evalExpr (LitTimestamp s) _ = Right (VStr s) evalExpr (LitBlob s) _ = Right (VStr s) -evalExpr (Add a b) row = liftArith addArith a b row -evalExpr (Sub a b) row = liftArith subArith a b row -evalExpr (Mul a b) row = liftArith mulArith a b row -evalExpr (Div a b) row = liftArith divArith a b row +evalExpr (Add a b) row = liftOperator OpAdd a b row +evalExpr (Sub a b) row = liftOperator OpSub a b row +evalExpr (Mul a b) row = liftOperator OpMul a b row +evalExpr (Div a b) row = liftOperator OpDiv a b row evalExpr (Neg a) row = do v <- evalExpr a row - case v of - VNull -> Right VNull - VInt n -> Right (VInt (negate n)) - VFloat d -> Right (VFloat (negate d)) - _ -> Left "type error: expected a number" -evalExpr (Gt a b) row = liftCompare (> EQ) a b row -evalExpr (Lt a b) row = liftCompare (< EQ) a b row -evalExpr (Eq a b) row = liftCompare (== EQ) a b row -evalExpr (And a b) row = liftBool andValues a b row -evalExpr (Or a b) row = liftBool orValues a b row + executeOperator OpNeg [v] +evalExpr (Gt a b) row = liftOperator OpGt a b row +evalExpr (Lt a b) row = liftOperator OpLt a b row +evalExpr (Eq a b) row = liftOperator OpEq a b row +evalExpr (And a b) row = liftOperator OpAnd a b row +evalExpr (Or a b) row = liftOperator OpOr a b row evalExpr (IsNull a) row = do v <- evalExpr a row Right (VBool (v == VNull)) @@ -54,21 +50,6 @@ evalExpr agg _ = Left ("aggregate functions are not allowed here: " ++ show agg) subqueryNeedsDatabase :: String subqueryNeedsDatabase = "subquery needs a database to run" --- | IN 三值逻辑:命中为真,碰 NULL 得 NULL -inValues :: Value -> [Value] -> Either String Value -inValues VNull _ = Right VNull -inValues v vs = do - results <- mapM (compareValues (== EQ) v) vs - Right $ - if VBool True `elem` results - then VBool True - else if VNull `elem` results then VNull else VBool False - --- | NOT 的三值取反 -threeValuedNot :: Value -> Value -threeValuedNot (VBool b) = VBool (not b) -threeValuedNot _ = VNull - -- | 表达式用到了哪些列 colsInExpr :: Expr -> [String] colsInExpr (Col c) = [c] @@ -95,6 +76,24 @@ colsInExpr (InList a es _) = colsInExpr a ++ concatMap colsInExpr es colsInExpr (ExistsSub sq _) = subqueryRefs sq colsInExpr _ = [] +-- | 表达式里有没有除法(除法可能报错,不能提前或延后求值) +hasDivision :: Expr -> Bool +hasDivision e = case e of + Div _ _ -> True + Neg a -> hasDivision a + Add a b -> both a b + Sub a b -> both a b + Mul a b -> both a b + Gt a b -> both a b + Lt a b -> both a b + Eq a b -> both a b + And a b -> both a b + Or a b -> both a b + _ -> False + where + -- | 两个子表达式里任意一个有除法 + both a b = hasDivision a || hasDivision b + -- | 表达式里有没有子查询 hasSubquery :: Expr -> Bool hasSubquery e = case e of @@ -188,107 +187,9 @@ evalCondForRow e row = do VNull -> Right False _ -> Left "type error: WHERE condition must be a boolean" --- | 把二元运算提升到 Either -liftBinOp :: - (Value -> Value -> Either String Value) -> - Expr -> - Expr -> - Row -> - Either String Value -liftBinOp f a b row = join (f <$> evalExpr a row <*> evalExpr b row) - --- | 整数算术与浮点算术成对出现 -data Arith = Arith - { arithInt :: Int -> Int -> Either String Int - , arithFloat :: Double -> Double -> Either String Double - } - --- | 一边是 NULL 就出 NULL,两边都是整数就出整数 -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 - go x y = case (asDouble x, asDouble y) of - (Just p, Just q) -> VFloat <$> arithFloat ops p q - _ -> Left "type error: expected two numbers" - --- | 能当数用的值 -asDouble :: Value -> Maybe Double -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)) - --- | 整数除法向零截断,溢出返回错误;浮点除法不能除以零 -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) - --- | 比较:任一侧是 NULL 就给 NULL -liftCompare :: - (Ordering -> Bool) -> - Expr -> - Expr -> - Row -> - 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 - | Just p <- asDouble x, Just q <- asDouble y = Right (VBool (rel (compare p q))) - | (VStr p, VStr q) <- (x, y) = Right (VBool (rel (compare p q))) - | (VBool p, VBool q) <- (x, y) = Right (VBool (rel (compare p q))) - | otherwise = Left "type error: cannot compare these values" - --- | 布尔二元运算 -liftBool :: - (Value -> Value -> Either String Value) -> - Expr -> - Expr -> - Row -> - 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) -andValues (VBool True) (VBool True) = Right (VBool True) -andValues VNull (VBool True) = Right VNull -andValues (VBool True) VNull = Right VNull -andValues VNull VNull = Right VNull -andValues _ _ = Left "type error: expected two booleans" - --- | 逻辑或的三值真值表 -orValues :: Value -> Value -> Either String Value -orValues (VBool True) _ = Right (VBool True) -orValues _ (VBool True) = Right (VBool True) -orValues (VBool False) (VBool False) = Right (VBool False) -orValues VNull (VBool False) = Right VNull -orValues (VBool False) VNull = Right VNull -orValues VNull VNull = Right VNull -orValues _ _ = Left "type error: expected two booleans" +-- | 二元运算节点统一走运算符权威 +liftOperator :: Operator -> Expr -> Expr -> Row -> Either String Value +liftOperator op a b row = do + x <- evalExpr a row + y <- evalExpr b row + executeOperator op [x, y] diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/JoinOrder.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/JoinOrder.hs new file mode 100644 index 0000000..47953b5 --- /dev/null +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/JoinOrder.hs @@ -0,0 +1,197 @@ +module ChuSQL.Core.Engine.Algebra.JoinOrder (reorderJoins) where + +import ChuSQL.Core.Engine.Algebra.Cost (pointRows, rangeRows, tableMetaOf) +import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, hasDivision) +import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols) +import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..)) +import ChuSQL.Core.Model +import Data.List (partition) + +-- 内连接链顺序优化:按统计估算中间结果,只在行序不可观察处重排。 + +-- | 重排入口:顶层行序可观察 +reorderJoins :: Database -> RelOp -> RelOp +reorderJoins db = pass db False + +-- | 往下带“行序是否不可观察”,可观察时不动内连接 +pass :: Database -> Bool -> RelOp -> RelOp +pass db _ (Sort spec x) = Sort spec (pass db True x) +pass db _ (Limit n x) = Limit n (pass db False x) +pass db _ (Aggregate keys aggs x) = Aggregate keys aggs (pass db False x) +pass db free (Project cols x) = Project cols (pass db free x) +pass db free (Compute items x) = Compute items (pass db free x) +pass db free (Filter p x) = Filter p (pass db free x) +pass db free (Join kind l r c) + | free + , Just (leaves, conds) <- innerChain (Join kind l r c) + , length leaves > 1 + , Just order <- cheaperOrder db leaves conds = + rebuildChain db (map (pass db free) order) conds + | otherwise = Join kind (pass db free l) (pass db free r) c +pass _ _ op = op + +-- | 把内连接链拆成叶子与条件,遇到外连接就放弃 +innerChain :: RelOp -> Maybe ([RelOp], [Expr]) +innerChain (Join InnerJoin l r c) = do + (ls, lcs) <- innerChain l + (rs, rcs) <- innerChain r + pure (ls ++ rs, lcs ++ rcs ++ [c]) +innerChain (Join _ _ _ _) = Nothing +innerChain op = Just ([op], []) + +-- | 叶子算子的估算行数,拿不到统计就是 Nothing +leafRows :: Database -> RelOp -> Maybe Int +leafRows db op = case op of + Scan _ t _ -> rowCountOf db t + Lookup _ t c _ -> pointRows <$> tableMetaOf db t <*> pure c + Range _ t _ _ _ -> rangeRows <$> tableMetaOf db t + Filter p x -> scaleRows db p x <$> leafRows db x + Project _ x -> leafRows db x + _ -> Nothing + +-- | 表统计里的行数 +rowCountOf :: Database -> String -> Maybe Int +rowCountOf db t = metaRowCount <$> tableMetaOf db t + +-- | 过滤之后的大致行数:等值看不同值数,其他按四分之一 +scaleRows :: Database -> Expr -> RelOp -> Int -> Int +scaleRows db p x rows = case p of + Eq (Col k) _ -> case distinctOf db x k of + Just d | d > 1 -> max 1 (rows `div` d) + _ -> quarter + Gt _ _ -> quarter + Lt _ _ -> quarter + And a b -> max 1 (min (scaleRows db a x rows) (scaleRows db b x rows)) + _ -> quarter + where + quarter = max 1 (rows `div` 4) + +-- | 叶子对应的别名与表名 +leafSource :: RelOp -> Maybe (Maybe String, String) +leafSource (Scan a t _) = Just (a, t) +leafSource (Lookup a t _ _) = Just (a, t) +leafSource (Range a t _ _ _) = Just (a, t) +leafSource (Filter _ x) = leafSource x +leafSource (Project _ x) = leafSource x +leafSource _ = Nothing + +-- | 某列在叶子统计里的不同值数 +distinctOf :: Database -> RelOp -> String -> Maybe Int +distinctOf db leaf col = do + (alias, t) <- leafSource leaf + m <- tableMetaOf db t + num <- lookup (unqualify alias col) [(c, n) | (c, n, _) <- metaDistinct m] + pure num + +-- | 若干叶子里某列最大的不同值数 +distinctOn :: Database -> [RelOp] -> String -> Maybe Int +distinctOn db leaves col = case [d | leaf <- leaves, Just d <- [distinctOf db leaf col]] of + [] -> Nothing + ds -> Just (maximum ds) + +-- | 两侧等值键里较大的不同值数 +keyDistinct :: Database -> [RelOp] -> RelOp -> [Expr] -> Maybe Int +keyDistinct db have x conds = case [v | Eq (Col a) (Col b) <- conds, Just v <- [pair a b]] of + (v : _) -> Just v + [] -> Nothing + where + haveCols = concatMap (relOpCols db) have + xCols = relOpCols db x + -- | 这一对列是不是两侧之间的等值键 + pair a b + | a `elem` haveCols, b `elem` xCols = bigger (distinctOn db have a) (distinctOf db x b) + | b `elem` haveCols, a `elem` xCols = bigger (distinctOn db have b) (distinctOf db x a) + | otherwise = Nothing + -- | 两个可选统计取大的那个 + bigger (Just a) (Just b) = Just (max a b) + bigger (Just a) Nothing = Just a + bigger Nothing (Just b) = Just b + bigger Nothing Nothing = Nothing + +-- | 一次连接之后的大致行数 +stepRows :: Database -> [RelOp] -> Int -> RelOp -> [Expr] -> Int +stepRows db have acc x conds = case keyDistinct db have x conds of + Just v | v > 1 -> max 1 (acc * rows `div` v) + _ -> acc * rows + where + rows = maybe 1 id (leafRows db x) + +-- | 一批叶子按给定顺序连接,累加每一步的中间结果 +chainCost :: Database -> [RelOp] -> [Expr] -> Int +chainCost db (l : ls) conds = go [l] (maybe 1 id (leafRows db l)) ls + where + -- | 逐步接上后面的叶子 + go _ _ [] = 0 + go have acc (x : xs) = + let card = stepRows db have acc x conds + in card + go (have ++ [x]) card xs +chainCost _ [] _ = 0 + +-- | 贪心扩展一个顺序:每次挑中间结果最小的下一张 +growOrder :: Database -> [RelOp] -> [Expr] -> [Int] -> [Int] -> [Int] +growOrder db leaves conds have rest = case rest of + [] -> have + _ -> + let next = pick rest + in growOrder db leaves conds (have ++ [next]) (filter (/= next) rest) + where + -- | 候选里成本最低的那个,同价取序号小的 + pick (i : is) = foldl cheaper i is + pick [] = 0 + cheaper i j = if costOf j < costOf i then j else i + -- | 这个前缀的估算成本 + costOf i = chainCost db [leaves !! k | k <- have ++ [i]] conds + +-- | 每个起点贪心一遍,取最便宜的顺序 +bestOrder :: Database -> [RelOp] -> [Expr] -> [RelOp] +bestOrder db leaves conds = pick (map start [0 .. n - 1]) + where + n = length leaves + -- | 从第 i 张表开始的贪心顺序 + start i = [leaves !! k | k <- growOrder db leaves conds [i] (filter (/= i) [0 .. n - 1])] + -- | 成本最低的那个 + pick (o : os) = foldl cheaper o os + pick [] = [] + cheaper o o' = if cost o' < cost o then o' else o + -- | 一个顺序的估算成本 + cost o = chainCost db o conds + +-- | 统计齐全、没有除法且确实更省时给出新顺序 +cheaperOrder :: Database -> [RelOp] -> [Expr] -> Maybe [RelOp] +cheaperOrder db leaves conds + | any hasDivision conds = Nothing + | any unknown leaves = Nothing + | bestCost < textCost = Just best + | otherwise = Nothing + where + -- | 这个叶子是不是拿不到统计 + unknown x = case leafRows db x of + Just _ -> False + Nothing -> True + best = bestOrder db leaves conds + bestCost = chainCost db best conds + textCost = chainCost db leaves conds + +-- | 按新顺序重建左深链,条件挂到两侧都齐的那一步 +rebuildChain :: Database -> [RelOp] -> [Expr] -> RelOp +rebuildChain db (l : ls) conds = go (relOpCols db l) l ls conds + where + -- | 逐个接上后面的叶子 + go _ acc [] rest = applyConds rest acc + go have acc (x : xs) rest = + let have' = have ++ relOpCols db x + (now, later) = partition (\c -> colsInExpr c `subsetOf` have') rest + in go have' (Join InnerJoin acc x (conjOf now)) xs later + -- | 若干条件用 AND 串起来 + conjOf [] = LitBool True + conjOf (c : cs) = foldl And c cs +rebuildChain _ [] _ = Unit + +-- | 挂不上去的条件套成 Filter +applyConds :: [Expr] -> RelOp -> RelOp +applyConds [] op = op +applyConds (c : cs) op = Filter c (applyConds cs op) + +-- | 条件的列是不是都在可用列里 +subsetOf :: [String] -> [String] -> Bool +subsetOf need have = all (`elem` have) need diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Op.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Op.hs index 663776f..d22cd20 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Op.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Op.hs @@ -1,9 +1,9 @@ -module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), renderPlan) where +module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols, renderPlan) where -import ChuSQL.Core.Model (Value) +import ChuSQL.Core.Model import ChuSQL.Core.Engine.Syntax.AST (Expr, JoinKind (..), SortDir) --- 关系代数算子定义与算子树文本渲染。 +-- 关系代数算子定义、输出列推导与算子树文本渲染。 data RelOp = Scan (Maybe String) String (Maybe [String]) @@ -19,6 +19,27 @@ data RelOp | Join JoinKind RelOp RelOp Expr deriving (Show, Eq) +-- | 算子会产出哪些列 +relOpCols :: Database -> RelOp -> [String] +relOpCols _ Unit = [] +relOpCols _ (Compute items _) = map fst items +relOpCols _ (Aggregate keys aggs _) = keys ++ map fst aggs +relOpCols _ (Scan mAlias _ (Just cols)) = map (qualify mAlias) cols +relOpCols db (Scan mAlias tbl Nothing) = + case lookup tbl db of + Nothing -> [] + Just t -> map (prefix ++) (colNames t) + where + prefix = maybe "" (++ ".") mAlias +relOpCols db (Lookup mAlias tbl _ _) = relOpCols db (Scan mAlias tbl Nothing) +relOpCols db (Range mAlias tbl _ _ _) = relOpCols db (Scan mAlias tbl Nothing) +relOpCols db (Filter _ x) = relOpCols db x +relOpCols _ (Project ["*"] _) = ["*"] +relOpCols _ (Project cols _) = cols +relOpCols db (Sort _ x) = relOpCols db x +relOpCols db (Limit _ x) = relOpCols db x +relOpCols db (Join _ l r _) = relOpCols db l ++ relOpCols db r + -- | 连接的显示名 kindLabel :: JoinKind -> String kindLabel InnerJoin = "Join" diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Optimize.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Optimize.hs index 510fac3..1ae7fee 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Optimize.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Optimize.hs @@ -1,33 +1,14 @@ -module ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject, relOpCols) where +module ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject) where -import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr) -import ChuSQL.Core.Engine.Algebra.Op (RelOp (..)) +import ChuSQL.Core.Engine.Algebra.Cost (indexCheaper, pointRows, rangeRows, tableMetaOf) +import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr, hasDivision) +import ChuSQL.Core.Engine.Algebra.JoinOrder (reorderJoins) +import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols) import ChuSQL.Core.Model import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..)) import Data.List (nub) --- 查询优化:谓词下推、投影下推与常量折叠。 - --- | 算子会产出哪些列 -relOpCols :: Database -> RelOp -> [String] -relOpCols _ Unit = [] -relOpCols _ (Compute items _) = map fst items -relOpCols _ (Aggregate keys aggs _) = keys ++ map fst aggs -relOpCols _ (Scan mAlias _ (Just cols)) = map (qualify mAlias) cols -relOpCols db (Scan mAlias tbl Nothing) = - case lookup tbl db of - Nothing -> [] - Just t -> map (prefix ++) (colNames t) - where - prefix = maybe "" (++ ".") mAlias -relOpCols db (Lookup mAlias tbl _ _) = relOpCols db (Scan mAlias tbl Nothing) -relOpCols db (Range mAlias tbl _ _ _) = relOpCols db (Scan mAlias tbl Nothing) -relOpCols db (Filter _ x) = relOpCols db x -relOpCols _ (Project ["*"] _) = ["*"] -relOpCols _ (Project cols _) = cols -relOpCols db (Sort _ x) = relOpCols db x -relOpCols db (Limit _ x) = relOpCols db x -relOpCols db (Join _ l r _) = relOpCols db l ++ relOpCols db r +-- 查询优化:谓词下推、投影下推、常量折叠、扫描方式与连接顺序选择。 -- | need 是否都在 have 里 isSubsetOf :: [String] -> [String] -> Bool @@ -90,24 +71,6 @@ pushOne _ (Filter p (Sort spec x)) | not (hasDivision p) = Sort spec (Filter p x) pushOne _ op = op --- | 除法可能报错,不能提前或延后求值 -hasDivision :: Expr -> Bool -hasDivision e = case e of - Div _ _ -> True - Neg a -> hasDivision a - Add a b -> both a b - Sub a b -> both a b - Mul a b -> both a b - Gt a b -> both a b - Lt a b -> both a b - Eq a b -> both a b - And a b -> both a b - Or a b -> both a b - _ -> False - where - -- | 两个子表达式里任意一个有除法 - both a b = hasDivision a || hasDivision b - -- | 检查子计划中可能报错的除法 planHasDivision :: RelOp -> Bool planHasDivision (Filter p x) = hasDivision p || planHasDivision x @@ -183,24 +146,38 @@ foldConstants (And a b) = foldNode (And (foldConstants a) (foldConstants b)) foldConstants (Or a b) = foldNode (Or (foldConstants a) (foldConstants b)) foldConstants e = e +-- | 点查值不值得改写;没有统计就按老规矩改 +worthLookup :: Database -> String -> String -> Bool +worthLookup db t col = case tableMetaOf db t of + Nothing -> True + Just m -> indexCheaper m col (pointRows m col) + +-- | 范围扫描值不值得改写;没有统计就按老规矩改 +worthRange :: Database -> String -> String -> Bool +worthRange db t col = case tableMetaOf db t of + Nothing -> True + Just m -> indexCheaper m col (rangeRows m) + -- | 单节点重写 rewriteNode :: Database -> RelOp -> RelOp -rewriteNode _ (Filter (Eq (Col k) (LitInt v)) (Scan mAlias t Nothing)) = - Lookup mAlias t (unqualify mAlias k) (VInt v) -rewriteNode _ (Filter (Eq (Col k) (LitStr v)) (Scan mAlias t Nothing)) = - Lookup mAlias t (unqualify mAlias k) (VStr v) -rewriteNode _ (Filter (And (Gt (Col k1) (LitInt lo)) (Lt (Col k2) (LitInt hi))) (Scan mAlias t Nothing)) - | k1 == k2 = Range mAlias t (unqualify mAlias k1) (Just (VInt lo, False)) (Just (VInt hi, False)) -rewriteNode _ (Filter (And (Gt (Col k1) (LitStr lo)) (Lt (Col k2) (LitStr hi))) (Scan mAlias t Nothing)) - | k1 == k2 = Range mAlias t (unqualify mAlias k1) (Just (VStr lo, False)) (Just (VStr hi, False)) -rewriteNode _ (Filter (Gt (Col k) (LitInt v)) (Scan mAlias t Nothing)) = - Range mAlias t (unqualify mAlias k) (Just (VInt v, False)) Nothing -rewriteNode _ (Filter (Gt (Col k) (LitStr v)) (Scan mAlias t Nothing)) = - Range mAlias t (unqualify mAlias k) (Just (VStr v, False)) Nothing -rewriteNode _ (Filter (Lt (Col k) (LitInt v)) (Scan mAlias t Nothing)) = - Range mAlias t (unqualify mAlias k) Nothing (Just (VInt v, False)) -rewriteNode _ (Filter (Lt (Col k) (LitStr v)) (Scan mAlias t Nothing)) = - Range mAlias t (unqualify mAlias k) Nothing (Just (VStr v, False)) +rewriteNode db (Filter (Eq (Col k) (LitInt v)) (Scan mAlias t Nothing)) + | worthLookup db t (unqualify mAlias k) = Lookup mAlias t (unqualify mAlias k) (VInt v) +rewriteNode db (Filter (Eq (Col k) (LitStr v)) (Scan mAlias t Nothing)) + | worthLookup db t (unqualify mAlias k) = Lookup mAlias t (unqualify mAlias k) (VStr v) +rewriteNode db (Filter (And (Gt (Col k1) (LitInt lo)) (Lt (Col k2) (LitInt hi))) (Scan mAlias t Nothing)) + | k1 == k2 && worthRange db t (unqualify mAlias k1) = + Range mAlias t (unqualify mAlias k1) (Just (VInt lo, False)) (Just (VInt hi, False)) +rewriteNode db (Filter (And (Gt (Col k1) (LitStr lo)) (Lt (Col k2) (LitStr hi))) (Scan mAlias t Nothing)) + | k1 == k2 && worthRange db t (unqualify mAlias k1) = + Range mAlias t (unqualify mAlias k1) (Just (VStr lo, False)) (Just (VStr hi, False)) +rewriteNode db (Filter (Gt (Col k) (LitInt v)) (Scan mAlias t Nothing)) + | worthRange db t (unqualify mAlias k) = Range mAlias t (unqualify mAlias k) (Just (VInt v, False)) Nothing +rewriteNode db (Filter (Gt (Col k) (LitStr v)) (Scan mAlias t Nothing)) + | worthRange db t (unqualify mAlias k) = Range mAlias t (unqualify mAlias k) (Just (VStr v, False)) Nothing +rewriteNode db (Filter (Lt (Col k) (LitInt v)) (Scan mAlias t Nothing)) + | worthRange db t (unqualify mAlias k) = Range mAlias t (unqualify mAlias k) Nothing (Just (VInt v, False)) +rewriteNode db (Filter (Lt (Col k) (LitStr v)) (Scan mAlias t Nothing)) + | worthRange db t (unqualify mAlias k) = Range mAlias t (unqualify mAlias k) Nothing (Just (VStr v, False)) rewriteNode db (Filter p (Join kind l r c)) | not (hasDivision p || planHasDivision (Join kind l r c)) = case kind of @@ -235,4 +212,4 @@ optimizePredicates db op = -- | 优化总入口 optimize :: Database -> RelOp -> RelOp -optimize db op = pushProject db ["*"] (optimizePredicates db op) +optimize db op = pushProject db ["*"] (reorderJoins db (optimizePredicates db op)) diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Sort.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Sort.hs index c7a25bf..aab6e78 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Sort.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Sort.hs @@ -12,19 +12,6 @@ flipOrdering LT = GT flipOrdering GT = LT flipOrdering EQ = EQ --- | 比较两个值:NULL 最小,数值跨整数与小数比较 -compareValue :: Value -> Value -> Ordering -compareValue VNull VNull = EQ -compareValue VNull _ = LT -compareValue _ VNull = GT -compareValue (VInt a) (VInt b) = compare a b -compareValue (VFloat a) (VFloat b) = compare a b -compareValue (VInt a) (VFloat b) = compare (fromIntegral a) b -compareValue (VFloat a) (VInt b) = compare a (fromIntegral b) -compareValue (VStr a) (VStr b) = compare a b -compareValue (VBool a) (VBool b) = compare a b -compareValue _ _ = EQ - -- | 取出排序键(按 spec 顺序,每行只查一次) sortKey :: [(String, SortDir)] -> Row -> [Maybe Value] sortKey spec row = [lookup col row | (col, _) <- spec] diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Builtin.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Builtin.hs new file mode 100644 index 0000000..f7eb90a --- /dev/null +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Builtin.hs @@ -0,0 +1,282 @@ +module ChuSQL.Core.Engine.Builtin + ( Builtin (..) + , builtinNames + , resolveBuiltin + , builtinName + , invokeBuiltin + , builtinOfExpr + , builtinNode + , aggregateArg + , unsupportedAggregate + , Operator (..) + , operatorOfExpr + , operatorSymbol + , executeOperator + , threeValuedNot + , inValues + ) where + +import ChuSQL.Core.Model (Value (..), compareValue) +import ChuSQL.Core.Engine.Syntax.AST (Expr (..)) +import Control.Monad (foldM) +import Data.Char (toLower) + +-- 内置函数与运算符的唯一权威:名称解析和求值都只在这里实现一次。 + +-- | 内置聚合函数 +data Builtin = BCountAll | BCount | BSum | BAvg | BMin | BMax + deriving (Show, Eq, Enum, Bounded) + +-- | 名字到内置函数的对照表,解析只认这张表 +builtinNames :: [(String, Builtin)] +builtinNames = + [ ("count", BCount) + , ("sum", BSum) + , ("avg", BAvg) + , ("min", BMin) + , ("max", BMax) + ] + +-- | 按名字解析内置函数,名字不分大小写 +resolveBuiltin :: String -> Maybe Builtin +resolveBuiltin name = lookup (map toLower name) builtinNames + +-- | 内置函数在 SQL 里的名字 +builtinName :: Builtin -> String +builtinName BCountAll = "count" +builtinName b = case [n | (n, x) <- builtinNames, x == b] of + (n : _) -> n + [] -> "count" + +-- | 在一组上调用内置函数:给出行数与各行的参数值 +invokeBuiltin :: Builtin -> Int -> [Value] -> Either String Value +invokeBuiltin BCountAll rows _ = Right (VInt rows) +invokeBuiltin BCount _ vs = Right (VInt (length (nonNull vs))) +invokeBuiltin BSum _ vs = case nonNull vs of + [] -> Right VNull + xs -> foldM addValue (VInt 0) xs +invokeBuiltin BAvg _ vs = case nonNull vs of + [] -> Right VNull + xs -> do + total <- foldM addValue (VInt 0) xs + sumValue <- numberOf total + Right (VFloat (sumValue / fromIntegral (length xs))) +invokeBuiltin BMin _ vs = extremeOf lower (nonNull vs) +invokeBuiltin BMax _ vs = extremeOf higher (nonNull vs) + +-- | 去掉 NULL +nonNull :: [Value] -> [Value] +nonNull = filter (/= VNull) + +-- | 聚合节点对应的内置函数;其余节点给 Nothing +builtinOfExpr :: Expr -> Maybe Builtin +builtinOfExpr CountAll = Just BCountAll +builtinOfExpr (CountOf _) = Just BCount +builtinOfExpr (SumOf _) = Just BSum +builtinOfExpr (AvgOf _) = Just BAvg +builtinOfExpr (MinOf _) = Just BMin +builtinOfExpr (MaxOf _) = Just BMax +builtinOfExpr _ = Nothing + +-- | 内置函数对应的 AST 节点 +builtinNode :: Builtin -> Expr -> Expr +builtinNode BCountAll _ = CountAll +builtinNode BCount e = CountOf e +builtinNode BSum e = SumOf e +builtinNode BAvg e = AvgOf e +builtinNode BMin e = MinOf e +builtinNode BMax e = MaxOf e + +-- | 聚合调用的参数表达式,COUNT(*) 没有参数 +aggregateArg :: Expr -> Maybe Expr +aggregateArg (CountOf x) = Just x +aggregateArg (SumOf x) = Just x +aggregateArg (AvgOf x) = Just x +aggregateArg (MinOf x) = Just x +aggregateArg (MaxOf x) = Just x +aggregateArg _ = Nothing + +-- | 只支持这几个聚合函数 +unsupportedAggregate :: String +unsupportedAggregate = "only COUNT, SUM, AVG, MIN and MAX can be aggregated" + +-- | 数值相加:整数配整数还是整数 +addValue :: Value -> Value -> Either String Value +addValue (VInt a) (VInt b) = Right (VInt (a + b)) +addValue (VInt a) (VFloat b) = Right (VFloat (fromIntegral a + b)) +addValue (VFloat a) (VInt b) = Right (VFloat (a + fromIntegral b)) +addValue (VFloat a) (VFloat b) = Right (VFloat (a + b)) +addValue _ _ = Left "type error: expected two numbers" + +-- | 能当数用的值 +numberOf :: Value -> Either String Double +numberOf (VInt n) = Right (fromIntegral n) +numberOf (VFloat d) = Right d +numberOf _ = Left "type error: expected a number" + +-- | 一组值里的极值,空组给 NULL +extremeOf :: (Value -> Value -> Value) -> [Value] -> Either String Value +extremeOf _ [] = Right VNull +extremeOf pick (x : xs) = Right (foldl pick x xs) + +-- | 取更小的那个 +lower :: Value -> Value -> Value +lower a b = if compareValue b a == LT then b else a + +-- | 取更大的那个 +higher :: Value -> Value -> Value +higher a b = if compareValue b a == GT then b else a + +-- | 运算符:AST 里的每个运算节点对应一个 +data Operator + = OpAdd + | OpSub + | OpMul + | OpDiv + | OpNeg + | OpGt + | OpLt + | OpEq + | OpAnd + | OpOr + deriving (Show, Eq, Enum, Bounded) + +-- | 运算符的 SQL 写法 +operatorSymbol :: Operator -> String +operatorSymbol OpAdd = "+" +operatorSymbol OpSub = "-" +operatorSymbol OpMul = "*" +operatorSymbol OpDiv = "/" +operatorSymbol OpNeg = "-" +operatorSymbol OpGt = ">" +operatorSymbol OpLt = "<" +operatorSymbol OpEq = "=" +operatorSymbol OpAnd = "AND" +operatorSymbol OpOr = "OR" + +-- | 运算节点对应的运算符;其余节点给 Nothing +operatorOfExpr :: Expr -> Maybe Operator +operatorOfExpr (Add _ _) = Just OpAdd +operatorOfExpr (Sub _ _) = Just OpSub +operatorOfExpr (Mul _ _) = Just OpMul +operatorOfExpr (Div _ _) = Just OpDiv +operatorOfExpr (Neg _) = Just OpNeg +operatorOfExpr (Gt _ _) = Just OpGt +operatorOfExpr (Lt _ _) = Just OpLt +operatorOfExpr (Eq _ _) = Just OpEq +operatorOfExpr (And _ _) = Just OpAnd +operatorOfExpr (Or _ _) = Just OpOr +operatorOfExpr _ = Nothing + +-- | 运算符求值:算错个数是内部错误 +executeOperator :: Operator -> [Value] -> Either String Value +executeOperator op vs = case (op, vs) of + (OpNeg, [x]) -> evalNeg x + (OpGt, [x, y]) -> compareValues (== GT) x y + (OpLt, [x, y]) -> compareValues (< EQ) x y + (OpEq, [x, y]) -> compareValues (== EQ) x y + (OpAnd, [x, y]) -> andValues x y + (OpOr, [x, y]) -> orValues x y + (_, [x, y]) | Just a <- arithOf op -> evalArith a x y + _ -> Left ("internal error: wrong operand count for operator " ++ operatorSymbol op) + +-- | 取负 +evalNeg :: Value -> Either String Value +evalNeg VNull = Right VNull +evalNeg (VInt n) = Right (VInt (negate n)) +evalNeg (VFloat d) = Right (VFloat (negate d)) +evalNeg _ = Left "type error: expected a number" + +-- | 整数算术与浮点算术成对出现 +data Arith = Arith + { arithInt :: Int -> Int -> Either String Int + , arithFloat :: Double -> Double -> Either String Double + } + +-- | 二元算术运算符对应的实现 +arithOf :: Operator -> Maybe Arith +arithOf OpAdd = Just (Arith (\x y -> Right (x + y)) (\x y -> Right (x + y))) +arithOf OpSub = Just (Arith (\x y -> Right (x - y)) (\x y -> Right (x - y))) +arithOf OpMul = Just (Arith (\x y -> Right (x * y)) (\x y -> Right (x * y))) +arithOf OpDiv = Just divArith +arithOf _ = Nothing + +-- | 一边是 NULL 就出 NULL,两边都是整数就出整数 +evalArith :: Arith -> Value -> Value -> Either String Value +evalArith _ VNull _ = Right VNull +evalArith _ _ VNull = Right VNull +evalArith ops (VInt x) (VInt y) = VInt <$> arithInt ops x y +evalArith ops x y = case (asDouble x, asDouble y) of + (Just p, Just q) -> VFloat <$> arithFloat ops p q + _ -> Left "type error: expected two numbers" + +-- | 整数除法向零截断,溢出返回错误;浮点除法不能除以零 +divArith :: Arith +divArith = Arith intDiv floatDiv + where + -- | 整数除法:除零与溢出都报错 + intDiv _ 0 = Left "division by zero" + intDiv x y + | x == minBound && y == -1 = Left "integer division overflow" + | otherwise = Right (x `quot` y) + -- | 浮点除法:不能除以零 + floatDiv _ 0 = Left "division by zero" + floatDiv x y = Right (x / y) + +-- | 能当数用的值 +asDouble :: Value -> Maybe Double +asDouble (VInt n) = Just (fromIntegral n) +asDouble (VFloat d) = Just d +asDouble _ = Nothing + +-- | 比较两个值:NULL 给 NULL,其余按全序比 +compareValues :: (Ordering -> Bool) -> Value -> Value -> Either String Value +compareValues rel x y + | x == VNull || y == VNull = Right VNull + | comparableValue x y = Right (VBool (rel (compareValue x y))) + | otherwise = Left "type error: cannot compare these values" + +-- | 两个值是否落在可以用全序比较的同一族里 +comparableValue :: Value -> Value -> Bool +comparableValue (VInt _) (VFloat _) = True +comparableValue (VFloat _) (VInt _) = True +comparableValue (VInt _) (VInt _) = True +comparableValue (VFloat _) (VFloat _) = True +comparableValue (VStr _) (VStr _) = True +comparableValue (VBool _) (VBool _) = True +comparableValue _ _ = False + +-- | 逻辑与的三值真值表 +andValues :: Value -> Value -> Either String Value +andValues (VBool False) _ = Right (VBool False) +andValues _ (VBool False) = Right (VBool False) +andValues (VBool True) (VBool True) = Right (VBool True) +andValues VNull (VBool True) = Right VNull +andValues (VBool True) VNull = Right VNull +andValues VNull VNull = Right VNull +andValues _ _ = Left "type error: expected two booleans" + +-- | 逻辑或的三值真值表 +orValues :: Value -> Value -> Either String Value +orValues (VBool True) _ = Right (VBool True) +orValues _ (VBool True) = Right (VBool True) +orValues (VBool False) (VBool False) = Right (VBool False) +orValues VNull (VBool False) = Right VNull +orValues (VBool False) VNull = Right VNull +orValues VNull VNull = Right VNull +orValues _ _ = Left "type error: expected two booleans" + +-- | NOT 的三值取反 +threeValuedNot :: Value -> Value +threeValuedNot (VBool b) = VBool (not b) +threeValuedNot _ = VNull + +-- | IN 三值逻辑:命中为真,碰 NULL 得 NULL +inValues :: Value -> [Value] -> Either String Value +inValues VNull _ = Right VNull +inValues v vs = do + results <- mapM (\x -> executeOperator OpEq [v, x]) vs + Right $ + if VBool True `elem` results + then VBool True + else if VNull `elem` results then VNull else VBool False diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Error.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Error.hs new file mode 100644 index 0000000..e33a6bc --- /dev/null +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Error.hs @@ -0,0 +1,74 @@ +module ChuSQL.Core.Engine.Error + ( ErrorCategory (..) + , ErrorRule (..) + , errorRules + , errorCategory + , errorCode + , errorLike + , accountErrorCode + ) where + +import Data.List (isInfixOf) + +-- 引擎与存储错误文本的唯一分类表和协议错误码表 + +-- | 错误大类 +data ErrorCategory + = NoDatabaseError + | PermissionError + | CatalogError + | TypeError + | StorageError + | ProtocolError + | UnknownError + deriving (Eq, Show) + +-- | 一条识别规则:命中文本片段就算这一类,并给出协议错误码 +data ErrorRule = ErrorRule + { ruleMarker :: String + , ruleCategory :: ErrorCategory + , ruleCode :: String + } + +-- | 唯一的错误识别表,顺序即优先级 +errorRules :: [ErrorRule] +errorRules = + [ ErrorRule "no database selected" NoDatabaseError "no_database" + , ErrorRule "administrator required" PermissionError "forbidden" + , ErrorRule "unknown table" CatalogError "not_found" + , ErrorRule "unknown column" CatalogError "query_error" + , ErrorRule "unknown database" CatalogError "not_found" + , ErrorRule "unknown role" CatalogError "not_found" + , ErrorRule "unknown account" CatalogError "not_found" + , ErrorRule "unknown index" CatalogError "query_error" + , ErrorRule "unknown user" CatalogError "query_error" + , ErrorRule "permission denied" PermissionError "query_error" + , ErrorRule "already exists" CatalogError "query_error" + , ErrorRule "type error" TypeError "query_error" + , ErrorRule "cannot put this value into" TypeError "query_error" + , ErrorRule "division by zero" TypeError "query_error" + , ErrorRule "overflow" TypeError "query_error" + , ErrorRule "storage" StorageError "query_error" + , ErrorRule "storage library call failed" StorageError "query_error" + , ErrorRule "unsupported protocol" ProtocolError "query_error" + ] + +-- | 命中的第一条规则 +errorLike :: String -> Maybe ErrorRule +errorLike message = case [r | r <- errorRules, ruleMarker r `isInfixOf` message] of + [] -> Nothing + (r : _) -> Just r + +-- | 错误文本属于哪一大类 +errorCategory :: String -> ErrorCategory +errorCategory message = maybe UnknownError ruleCategory (errorLike message) + +-- | 错误文本对应的协议错误码 +errorCode :: String -> String +errorCode message = maybe "query_error" ruleCode (errorLike message) + +-- | 账号服务对外的错误码 +accountErrorCode :: String -> String +accountErrorCode "account already exists" = "conflict" +accountErrorCode "unknown account" = "not_found" +accountErrorCode _ = "storage_error" diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Parallel.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Parallel.hs new file mode 100644 index 0000000..402369a --- /dev/null +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Parallel.hs @@ -0,0 +1,82 @@ +module ChuSQL.Core.Engine.Parallel ( + parallelShardLimit, + Pool, + workerPool, + poolRun, +) where + +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, takeMVar) +import Control.Exception (SomeException, throwIO, try) +import System.IO.Unsafe (unsafePerformIO) + +-- 并行执行:常驻工作线程池,结果按提交顺序收回。 + +-- | 单次并行扫描最多切几片 +parallelShardLimit :: Int +parallelShardLimit = 8 + +-- | 池:待办队列与唤醒信号 +data Pool = Pool + { poolJobs :: MVar [IO ()] + , poolReady :: MVar () + } + +{-# NOINLINE poolRef #-} +-- | 进程全局的池,按容量复用 +poolRef :: MVar (Maybe (Int, Pool)) +poolRef = unsafePerformIO (newMVar Nothing) + +-- | 按容量取池,不够就新建一个 +workerPool :: Int -> IO Pool +workerPool size = modifyMVar poolRef reuse + where + -- | 现有池够大就留着,否则换新的 + reuse current = case current of + Just (capacity, pool) + | capacity >= wanted -> pure (current, pool) + _ -> do + pool <- startPool wanted + pure (Just (wanted, pool), pool) + + -- | 池的线程数至少一个 + wanted = max 1 size + + -- | 起 wanted 个常驻线程吃队列 + startPool n = do + jobs <- newMVar [] + ready <- newMVar () + sequence_ [forkIO (worker jobs ready) | _ <- [1 .. n]] + pure (Pool jobs ready) + +-- | 一个工作线程:被唤醒一次就取一个待办 +worker :: MVar [IO ()] -> MVar () -> IO () +worker jobs ready = do + takeMVar ready + job <- modifyMVar jobs pick + case job of + Nothing -> worker jobs ready + Just act -> act >> worker jobs ready + where + -- | 取队首,空队列就回 Nothing + pick [] = pure ([], Nothing) + pick (j : js) = pure (js, Just j) + +-- | 往池里丢一个待办 +submit :: Pool -> IO () -> IO () +submit pool job = do + modifyMVar_ (poolJobs pool) (pure . (++ [job])) + putMVar (poolReady pool) () + +-- | 跑一个动作,结果或异常都填进格子 +fillCell :: MVar (Either SomeException a) -> IO a -> IO () +fillCell cell act = try act >>= putMVar cell + +-- | 并发跑一批动作,按输入顺序返回结果与异常 +poolRun :: Pool -> [IO a] -> IO [a] +poolRun _ [] = pure [] +poolRun pool actions = do + cells <- mapM (const newEmptyMVar) actions + sequence_ [submit pool (fillCell cell act) | (cell, act) <- zip cells actions] + outcomes <- mapM takeMVar cells + mapM (either throwIO pure) outcomes diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs index 96511ce..b897d49 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs @@ -243,16 +243,11 @@ comparison db place env a b = do then Right (InferType CBool) else Left (place ++ ": both sides of = must have the same type, got " ++ renderType ta ++ " and " ++ renderType tb) --- | 两类能不能比 +-- | 两类能不能比,类型族规则来自 Model compatible :: InferredType -> InferredType -> Bool compatible InferNull _ = True compatible _ InferNull = True -compatible (InferType a) (InferType b) - | numericType a && numericType b = True - | typeClassOf a == typeClassOf b = True - | typeClassOf a == TemporalClass && typeClassOf b == TextClass = True - | typeClassOf b == TemporalClass && typeClassOf a == TextClass = True - | otherwise = False +compatible (InferType a) (InferType b) = comparableTypes a b -- | 逻辑运算两边的类型检查 boolean :: Database -> String -> Scope -> Expr -> Expr -> Either String InferredType diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Storage.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Storage.hs index 1960fe1..a2291ce 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Storage.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Storage.hs @@ -35,6 +35,14 @@ class (Monad m) => MonadStorage m where result <- scan t pure (fmap (map (\row -> [(c, v) | c <- cols, Just v <- [lookup c row]])) result) + -- \| 本存储能用的并行分片数;不支持并行的存储返回 1 + parallelShards :: m Int + parallelShards = pure 1 + + -- \| 按分片并行扫描并按分片序拼接;默认退回顺序扫描 + scanShards :: Int -> String -> Maybe [String] -> m (Either String [Row]) + scanShards _ t cols = maybe (scan t) (scanColumns t) cols + -- \| 追加一行 insert :: String -> Row -> m (Either String ()) diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Storage/IPC.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Storage/IPC.hs index 9b174a2..ad0f81b 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Storage/IPC.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Storage/IPC.hs @@ -28,8 +28,10 @@ module ChuSQL.Core.Engine.Storage.IPC ( import ChuSQL.Core.Model import ChuSQL.Core.Protocol (Account (..), Request (..), Response (..), SchemaColumn (..), TableInfo (..)) +import ChuSQL.Core.Engine.Parallel (parallelShardLimit, poolRun, workerPool) import ChuSQL.Core.Engine.Storage import ChuSQL.Core.Engine.Storage.FFI (closeStorage, openStorage, storageRequest) +import Control.Concurrent (getNumCapabilities) import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar) import Data.Aeson (eitherDecodeStrict, encode) import Data.ByteString qualified as BS @@ -166,6 +168,18 @@ doScan t = ask "scan" (ReqScan t) $ \resp -> case resp of RespRows rows -> Just rows _ -> Nothing +-- | 发带投影的 Scan +doScanColumns :: String -> [String] -> IO (Either String [Row]) +doScanColumns t cols = ask "scan" (ReqScanColumns t cols) $ \resp -> case resp of + RespRows rows -> Just [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows] + _ -> Nothing + +-- | 发分片 Scan:只取第 shard 片 +doScanShard :: String -> Maybe [String] -> Int -> Int -> IO (Either String [Row]) +doScanShard t cols shard shards = ask "scan_shard" (ReqScanShard t cols shard shards) $ \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 @@ -290,9 +304,20 @@ instance MonadStorage IPCStorage where -- \| 发 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 + scanColumns t cols = IPCStorage (doScanColumns t cols) + + -- \| 并行分片数:按 RTS 能力数,封顶在 parallelShardLimit + parallelShards = IPCStorage $ do + caps <- getNumCapabilities + pure (max 1 (min parallelShardLimit caps)) + + -- \| 分片并行扫,再按分片序拼接 + scanShards width t cols + | width <= 1 = IPCStorage (maybe (doScan t) (doScanColumns t) cols) + | otherwise = IPCStorage $ do + pool <- workerPool width + parts <- poolRun pool [doScanShard t cols shard width | shard <- [0 .. width - 1]] + pure (fmap concat (sequence parts)) -- \| 发 Insert(索引由存储层自己维护) insert t r = IPCStorage (doInsert t r) @@ -341,7 +366,7 @@ instance MonadStorage IPCStorage where rows <- doScan (tiTable info) pure ( tiTable info - , Table (tiTable info) (schemaToColumns (tiColumns info)) (either (const []) id rows) + , Table (tiTable info) (schemaToColumns (tiColumns info)) (either (const []) id rows) (Just (metaOf info)) ) -- \| 只问数据字典要结构,设了当前库只留它的表 @@ -354,6 +379,10 @@ instance MonadStorage IPCStorage where Left _ -> [] Right xs -> concatMap (visibleTables current) xs +-- | 线上表信息转引擎侧统计 +metaOf :: TableInfo -> TableMeta +metaOf info = TableMeta (tiRows info) (tiStats info) (tiIndexes info) + -- | 没设库名就照单全收;设了库名只收这个库的表,键名去掉库名前缀 visibleTables :: Maybe String -> TableInfo -> [(String, Table)] visibleTables current info @@ -365,4 +394,4 @@ visibleTables current info where named = info {tiTable = unqualify current (tiTable info)} -- | 组装成不带行的表 - bare i = (tiTable i, Table (tiTable i) (schemaToColumns (tiColumns i)) []) + bare i = (tiTable i, Table (tiTable i) (schemaToColumns (tiColumns i)) [] (Just (metaOf i))) diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Storage/Memory.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Storage/Memory.hs index 3e0eb07..aa1f942 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Storage/Memory.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Storage/Memory.hs @@ -44,7 +44,7 @@ instance MonadStorage MemoryStorage where createTable name cols = MemoryStorage $ \db -> if any ((== name) . fst) db then Right (Left ("table already exists: " ++ name), db) - else Right (Right (), db ++ [(name, Table name cols [])]) + else Right (Right (), db ++ [(name, Table name cols [] Nothing)]) -- \| 删表;不存在报错 dropTable name = MemoryStorage $ \db -> diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs index 2a3d605..6bb3ac2 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs @@ -3,6 +3,7 @@ module ChuSQL.Core.Engine.Syntax.Parser (parseStatement, parseExpression) where import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), plainColumn) +import ChuSQL.Core.Engine.Builtin (Builtin (..), builtinName, builtinNames, builtinNode) import ChuSQL.Core.Engine.Syntax.AST import Control.Monad (void) import Control.Monad.Combinators.Expr (Operator (..), makeExprParser) @@ -172,18 +173,14 @@ inPredicate = do subquerySelect :: Parser Subquery subquerySelect = Subquery <$> selectStatement <*> pure [] --- | 聚合调用:COUNT/SUM/AVG/MIN/MAX +-- | 聚合调用:名称与节点都由内置函数表给出 aggregateCall :: Parser Expr -aggregateCall = - choice - [ CountAll <$ try (keyword "count" *> between (symbol "(") (symbol ")") (symbol "*")) - , CountOf <$> aggArg "count" - , SumOf <$> aggArg "sum" - , AvgOf <$> aggArg "avg" - , MinOf <$> aggArg "min" - , MaxOf <$> aggArg "max" - ] +aggregateCall = choice (countAll : map named builtinNames) where + -- | COUNT(*),没有参数 + countAll = CountAll <$ try (keyword (builtinName BCountAll) *> between (symbol "(") (symbol ")") (symbol "*")) + -- | 表里每一个带参数的内置函数 + named (name, builtin) = builtinNode builtin <$> aggArg name -- | 读聚合函数的参数 aggArg name = try (keyword name *> between (symbol "(") (symbol ")") expr) diff --git a/chusql-core/engine/test/Spec.hs b/chusql-core/engine/test/Spec.hs index e498789..c03c5bc 100644 --- a/chusql-core/engine/test/Spec.hs +++ b/chusql-core/engine/test/Spec.hs @@ -2,24 +2,32 @@ module Main where -import ChuSQL.Core.Engine.Algebra.Eval (evalRelOp) +import ChuSQL.Core.Engine.Algebra.Eval (evalRelOp, evalRelOpM) import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr) import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), renderPlan) import ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject) import ChuSQL.Core.Engine.Algebra.Planner (translate) +import ChuSQL.Core.Engine.Algebra.Sort (sortRows) +import ChuSQL.Core.Engine.Builtin +import ChuSQL.Core.Engine.Error import ChuSQL.Core.Engine +import ChuSQL.Core.Engine.Parallel (poolRun, workerPool) import ChuSQL.Core.Model import ChuSQL.Core.Engine.Semantic (prepare) import ChuSQL.Core.Engine.Storage (IndexResult (..), MonadStorage (..)) import ChuSQL.Core.Engine.Storage.IPC (IPCStorage (runIPCStorage), closeConnection, doListTables, getDatabaseName, localStorageLink, setDatabaseName, setStorageLink) import ChuSQL.Core.Engine.Syntax.AST import ChuSQL.Core.Engine.Syntax.Parser -import Control.Exception (IOException, finally, try) +import Control.Concurrent (threadDelay) +import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar) +import Control.Exception (ErrorCall, IOException, finally, try) +import Data.Hashable (hash) import Data.List (isInfixOf, sortOn) import Data.Unique (hashUnique, newUnique) import System.CPUTime (getCPUTime) import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removePathForcibly) import System.FilePath (()) +import System.Timeout (timeout) import Test.Hspec -- 引擎层的 hspec 测试:语法、执行、优化器与存储链路行为。 @@ -35,6 +43,7 @@ users = , [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)] , [("id", VInt 3), ("name", VStr "Carol"), ("age", VInt 30)] ] + , tableMeta = Nothing } -- | 测试表 orders:id/user_id/product @@ -48,12 +57,51 @@ orders = , [("id", VInt 2), ("user_id", VInt 2), ("product", VStr "Pen")] , [("id", VInt 3), ("user_id", VInt 1), ("product", VStr "Cup")] ] + , tableMeta = Nothing } -- | 两个测试表组成的默认库 testDB :: Database testDB = [("users", users), ("orders", orders)] +-- | 连接链测试表 a:6 行,id 各不相同 +chainA :: Table +chainA = + Table + { tableName = "a" + , tableCols = [("id", TInt), ("name", TStr)] + , tableRows = [[("id", VInt n), ("name", VStr ("a" ++ show n))] | n <- [1 .. 6]] + , tableMeta = Just (TableMeta 6 [("id", 6, False)] ["id"]) + } + +-- | 连接链测试表 b:4 行,a_id 各不相同 +chainB :: Table +chainB = + Table + { tableName = "b" + , tableCols = [("id", TInt), ("a_id", TInt)] + , tableRows = [[("id", VInt n), ("a_id", VInt n)] | n <- [1 .. 4]] + , tableMeta = Just (TableMeta 4 [("id", 4, False), ("a_id", 4, False)] ["id"]) + } + +-- | 连接链测试表 c:2 行,b_id 各不相同 +chainC :: Table +chainC = + Table + { tableName = "c" + , tableCols = [("id", TInt), ("b_id", TInt)] + , tableRows = [[("id", VInt n), ("b_id", VInt n)] | n <- [1, 2]] + , tableMeta = Just (TableMeta 2 [("id", 2, False), ("b_id", 2, False)] ["id"]) + } + +-- | 三张表组成的连接链测试库 +chainDB :: Database +chainDB = [("a", chainA), ("b", chainB), ("c", chainC)] + +-- | 同一个连接链测试库,但没有统计 +chainDBWithoutStats :: Database +chainDBWithoutStats = [(n, t { tableMeta = Nothing }) | (n, t) <- chainDB] + -- | 跑引擎层全部 hspec 用例 main :: IO () main = hspec $ do @@ -1161,6 +1209,47 @@ main = hspec $ do fmap firstFilterCond (optimizedPlan "SELECT name FROM users WHERE 1 > 2") `shouldBe` Right (Just (LitBool False)) + it "picks the index only when the statistics make it cheaper" $ do + let stat rows distinct indexes = TableMeta rows [(c, d, False) | (c, d) <- distinct] indexes + dbWith m = [("users", Table "users" [("id", TInt), ("name", TStr)] [] (Just m))] + unknown = [("users", Table "users" [("id", TInt), ("name", TStr)] [] Nothing)] + point = Filter (Eq (Col "id") (LitInt 1)) (Scan Nothing "users" Nothing) + range = Filter (Gt (Col "id") (LitInt 5)) (Scan Nothing "users" Nothing) + -- 索引在、点查命中一行:改写 + optimize (dbWith (stat 10000 [("id", 10000)] ["id"])) point + `shouldBe` Lookup Nothing "users" "id" (VInt 1) + -- 拿不到统计:保持原有改写行为 + optimize unknown point `shouldBe` Lookup Nothing "users" "id" (VInt 1) + -- 没有索引:不改写,省掉一次白跑的存储层查询 + optimize (dbWith (stat 10000 [("id", 10000)] [])) point `shouldBe` point + -- 有索引但整列一个值:点查等于全表,全表扫更便宜 + optimize (dbWith (stat 10000 [("name", 1)] ["name"])) (Filter (Eq (Col "name") (LitStr "a")) (Scan Nothing "users" Nothing)) + `shouldBe` Filter (Eq (Col "name") (LitStr "a")) (Scan Nothing "users" Nothing) + -- 范围扫描同理 + optimize (dbWith (stat 10000 [("id", 10000)] ["id"])) range + `shouldBe` Range Nothing "users" "id" (Just (VInt 5, False)) Nothing + optimize (dbWith (stat 10000 [("id", 10000)] [])) range `shouldBe` range + + it "reorders an inner join chain only when the statistics say it is cheaper" $ do + let sql = + "SELECT a.name FROM a JOIN b ON a.id = b.a_id JOIN c ON b.id = c.b_id ORDER BY a.name" + unordered = "SELECT a.name FROM a JOIN b ON a.id = b.a_id JOIN c ON b.id = c.b_id" + -- 统计说先接最小的 c 更省:文本顺序 a / b / c 换成一个更便宜的顺序 + fmap planTables (optimizedPlanIn chainDB sql) `shouldBe` Right ["b", "c", "a"] + -- 拿不到统计:保持文本顺序 + fmap planTables (optimizedPlanIn chainDBWithoutStats sql) `shouldBe` Right ["a", "b", "c"] + -- 行序可观察(没有 ORDER BY):不动顺序 + fmap planTables (optimizedPlanIn chainDB unordered) `shouldBe` Right ["a", "b", "c"] + + it "keeps an inner join chain result identical when it reorders it" $ do + let sql = + "SELECT a.name FROM a JOIN b ON a.id = b.a_id JOIN c ON b.id = c.b_id ORDER BY a.name" + case parseStatement sql >>= prepare chainDB of + Left err -> expectationFailure err + Right q -> case translate q of + Left err -> expectationFailure err + Right relOp -> evalRelOp chainDB (optimize chainDB relOp) `shouldBe` evalRelOp chainDB relOp + it "removes a filter whose predicate folds to true" $ do fmap anyFilter (optimizedPlan "SELECT name FROM users WHERE 1 = 1") `shouldBe` Right False @@ -1600,6 +1689,24 @@ main = hspec $ do fmap sortRow (indexRow fresh) `shouldBe` Just (sortRow [("id", VInt 3), ("code", VInt 502)]) + it "schema carries the row count, index list and column statistics" $ do + withTestSession $ \srv -> withServerEnv srv $ do + _ <- runIPCStorage (runStatementM (CreateTable "meta_t" [("id", TInt), ("code", TInt)])) + _ <- + runIPCStorage + ( runStatementM + (Insert "meta_t" ["id", "code"] [[LitInt 1, LitInt 500], [LitInt 2, LitInt 501]]) + ) + _ <- runIPCStorage (runStatementM (CreateIndex "meta_t" "code")) + db <- runIPCStorage schema + case lookup "meta_t" db of + Nothing -> expectationFailure "meta_t missing from schema" + Just t -> do + fmap metaRowCount (tableMeta t) `shouldBe` Just 2 + fmap metaIndexes (tableMeta t) `shouldBe` Just ["id", "code"] + fmap (sortOn fst . map (\(c, d, _) -> (c, d)) . metaDistinct) (tableMeta t) + `shouldBe` Just [("code", 2), ("id", 2)] + it "CREATE INDEX accepts duplicates and returns every matching row" $ do withTestSession $ \srv -> withServerEnv srv $ do _ <- runIPCStorage (runStatementM (CreateTable "dup_ix" [("id", TInt), ("age", TInt)])) @@ -1662,7 +1769,7 @@ main = hspec $ do `shouldBe` Right (makeSelect ["*"] "t" (Just (Eq (Col "flag") (LitBool True)))) it "inserts and reads back a boolean column end-to-end" $ do - let db = [("t", Table "t" [("id", TInt), ("flag", TBool)] [])] + let db = [("t", Table "t" [("id", TInt), ("flag", TBool)] [] Nothing)] case runStatement db (Insert "t" ["id", "flag"] [[LitInt 1, LitBool True]]) of Left e -> expectationFailure e Right (db', _) -> @@ -1877,6 +1984,206 @@ 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 + describe "ChuSQL.Core.Model (值语义唯一权威)" $ do + it "treats an integral float and an int as the same value" $ do + valuesEqual (VInt 1) (VFloat 1.0) `shouldBe` True + compareValue (VInt 1) (VFloat 1.0) `shouldBe` EQ + hash (VInt 1) `shouldBe` hash (VFloat 1.0) + hashValue (VInt 1) `shouldBe` hashValue (VFloat 1.0) + + it "keeps null, text and boolean in their own buckets" $ do + hash VNull `shouldNotBe` hash (VInt 0) + hash (VInt 1) `shouldNotBe` hash (VStr "1") + hash (VStr "a") `shouldNotBe` hash (VBool True) + + it "orders null below every value and compares across families" $ do + compareValue VNull (VInt minBound) `shouldBe` LT + compareValue (VInt maxBound) VNull `shouldBe` GT + compareValue VNull VNull `shouldBe` EQ + compareValue (VInt 1) (VStr "a") `shouldBe` LT + compareValue (VStr "a") (VBool True) `shouldBe` LT + compareValue (VBool True) VNull `shouldBe` GT + + it "propagates null through comparisons" $ do + evalExpr (Eq (Col "v") LitNull) [("v", VInt 1)] `shouldBe` Right VNull + evalExpr (Gt LitNull (LitInt 1)) [] `shouldBe` Right VNull + + it "uses one comparability rule and one canonical form" $ do + comparableTypes CInt CFloat `shouldBe` True + assignable CInt CFloat `shouldBe` True + assignable CStr CInt `shouldBe` False + comparableTypes CInt CStr `shouldBe` False + comparableTypes CStr CDate `shouldBe` True + canonicalValue (VFloat 3.0) `shouldBe` VInt 3 + canonicalValue (VFloat 3.5) `shouldBe` VFloat 3.5 + + describe "比较语义统一(排序 / 聚合 / 哈希连接)" $ do + -- vals:在给定库上跑 SQL 只取值 + let vals db input = fmap (map (map snd)) (parseStatement input >>= rowsOf . runStatement db) + -- seed:建一张两列空表 + seed name = case parseStatement ("CREATE TABLE " ++ name ++ " (id int, v int)") >>= runStatement emptyDB of + Left e -> error e + Right (db, _) -> db + -- ins:插入一行,失败直接判测试失败 + ins db input = case parseStatement input >>= runStatement db of + Left e -> error e + Right (db', _) -> db' + rows3 = + ins + (ins (ins (seed "m") "INSERT INTO m (id, v) VALUES (1, 2)") "INSERT INTO m (id, v) VALUES (2, 1)") + "INSERT INTO m (id, v) VALUES (3, 2)" + withNull = + ins + (ins (ins (seed "m2") "INSERT INTO m2 (id, v) VALUES (1, 2)") "INSERT INTO m2 (id) VALUES (2)") + "INSERT INTO m2 (id, v) VALUES (3, 1)" + + it "sorts with the same rule that aggregates use" $ do + map (map snd) (sortRows [("v", Asc)] [[("v", VFloat 1.5)], [("v", VNull)], [("v", VInt 1)]]) + `shouldBe` [[VNull], [VInt 1], [VFloat 1.5]] + vals rows3 "SELECT v FROM m ORDER BY v, id" `shouldBe` Right [[VInt 1], [VInt 2], [VInt 2]] + vals rows3 "SELECT v FROM m ORDER BY v DESC, id" `shouldBe` Right [[VInt 2], [VInt 2], [VInt 1]] + vals rows3 "SELECT MIN(v), MAX(v) FROM m" `shouldBe` Right [[VInt 1, VInt 2]] + + it "sorts the catalog names that are unknown into one code" $ do + errorCode "unknown database: d" `shouldBe` "not_found" + errorCode "unknown role: r" `shouldBe` "not_found" + errorCode "unknown account" `shouldBe` "not_found" + + it "puts null first when sorting and skips it in aggregates" $ do + vals withNull "SELECT v FROM m2 ORDER BY v" `shouldBe` Right [[VNull], [VInt 1], [VInt 2]] + vals withNull "SELECT MIN(v), MAX(v), SUM(v), COUNT(v), COUNT(*) FROM m2" + `shouldBe` Right [[VInt 1, VInt 2, VInt 3, VInt 2, VInt 3]] + + it "uses 1 and 1.0 as one key in predicates and unique columns" $ do + let one = ins (seed "f1") "INSERT INTO f1 (id, v) VALUES (1, 1)" + vals one "SELECT id FROM f1 WHERE v = 1.0" `shouldBe` Right [[VInt 1]] + vals one "SELECT id FROM f1 WHERE v = 1" `shouldBe` Right [[VInt 1]] + let uniqueTable = case parseStatement "CREATE TABLE uq (id int, v int UNIQUE)" >>= runStatement emptyDB of + Left e -> error e + Right (db, _) -> db + seeded = ins uniqueTable "INSERT INTO uq (id, v) VALUES (1, 1)" + case parseStatement "INSERT INTO uq (id, v) VALUES (2, 1.0)" >>= runStatement seeded of + Left err -> err `shouldBe` "UNIQUE: duplicate value in column v" + Right _ -> expectationFailure "1.0 must clash with 1 on a unique column" + + describe "ChuSQL.Core.Engine.Builtin (解析与调用唯一入口)" $ do + it "resolves aggregate names case-insensitively" $ do + resolveBuiltin "COUNT" `shouldBe` Just BCount + resolveBuiltin "Sum" `shouldBe` Just BSum + resolveBuiltin "median" `shouldBe` Nothing + map fst builtinNames `shouldBe` ["count", "sum", "avg", "min", "max"] + + it "invokes every aggregate from one place" $ do + invokeBuiltin BCountAll 3 [] `shouldBe` Right (VInt 3) + invokeBuiltin BCount 3 [VInt 1, VNull, VInt 2] `shouldBe` Right (VInt 2) + invokeBuiltin BSum 0 [] `shouldBe` Right VNull + invokeBuiltin BSum 3 [VInt 1, VNull, VInt 2] `shouldBe` Right (VInt 3) + invokeBuiltin BAvg 2 [VInt 1, VInt 3] `shouldBe` Right (VFloat 2) + invokeBuiltin BMin 2 [VNull, VInt 4] `shouldBe` Right (VInt 4) + invokeBuiltin BMax 2 [VNull, VInt 4] `shouldBe` Right (VInt 4) + + it "maps names to syntax nodes in one table" $ do + builtinOfExpr CountAll `shouldBe` Just BCountAll + builtinNode BCount (Col "age") `shouldBe` CountOf (Col "age") + builtinNode BAvg (Col "age") `shouldBe` AvgOf (Col "age") + aggregateArg (SumOf (Col "age")) `shouldBe` Just (Col "age") + aggregateArg CountAll `shouldBe` Nothing + unsupportedAggregate `shouldBe` "only COUNT, SUM, AVG, MIN and MAX can be aggregated" + + it "exposes one operator table and one executor" $ do + operatorSymbol <$> operatorOfExpr (Add (LitInt 1) (LitInt 2)) `shouldBe` Just "+" + operatorSymbol <$> operatorOfExpr (And (LitBool True) (LitBool False)) `shouldBe` Just "AND" + executeOperator OpAdd [VInt 1, VInt 2] `shouldBe` Right (VInt 3) + executeOperator OpDiv [VInt 1, VInt 0] `shouldBe` Left "division by zero" + executeOperator OpNeg [VFloat 2] `shouldBe` Right (VFloat (-2)) + executeOperator OpEq [VInt 1, VFloat 1.0] `shouldBe` Right (VBool True) + executeOperator OpGt [VNull, VInt 1] `shouldBe` Right VNull + executeOperator OpAnd [VBool True, VNull] `shouldBe` Right VNull + executeOperator OpOr [VBool True, VNull] `shouldBe` Right (VBool True) + executeOperator OpAdd [VInt 1] `shouldSatisfy` isLeft + executeOperator OpNeg [VInt 1, VInt 2] `shouldSatisfy` isLeft + + it "keeps null comparisons three-valued" $ do + inValues VNull [VInt 1] `shouldBe` Right VNull + inValues (VInt 1) [VInt 1, VNull] `shouldBe` Right (VBool True) + inValues (VInt 2) [VInt 1, VNull] `shouldBe` Right VNull + threeValuedNot VNull `shouldBe` VNull + threeValuedNot (VBool True) `shouldBe` VBool False + + describe "ChuSQL.Core.Engine.Parallel (分片调度与分片选择)" $ do + it "keeps the submission order of finished jobs" $ do + pool <- workerPool 4 + results <- poolRun pool [delayed 30000 (1 :: Int), delayed 1000 2, delayed 20000 3] + results `shouldBe` [1, 2, 3] + + it "dispatches every job without waiting for the slow one" $ do + pool <- workerPool 4 + finished <- timeout 800000 (poolRun pool (replicate 4 (delayed 300000 ()))) + finished `shouldBe` Just (replicate 4 ()) + + it "rethrows job failures in the submission order" $ do + pool <- workerPool 4 + let failed = error "first bad job" :: IO () + later = error "second bad job" :: IO () + outcome <- try (poolRun pool (pure () : failed : [later])) :: IO (Either ErrorCall [()]) + case outcome of + Left err -> show err `shouldContain` "first bad job" + Right _ -> expectationFailure "poolRun returned instead of rethrowing the job failure" + + it "scans a small table in one sequential request" $ do + probe <- newProbe users 4 + let op = Scan Nothing "users" Nothing + runProbeStorage (evalRelOpM testDB op) probe `shouldReturn` evalRelOp testDB op + recordedCalls probe `shouldReturn` ["scan:users"] + + it "splits a large table into the available shards" $ do + probe <- newProbe bigTable 4 + let op = Scan Nothing "big" Nothing + runProbeStorage (evalRelOpM bigDB op) probe `shouldReturn` evalRelOp bigDB op + recordedCalls probe `shouldReturn` ["scan_shards:4:big"] + + it "projects columns through the shard path" $ do + probe <- newProbe bigTable 3 + let op = Scan Nothing "big" (Just ["name"]) + runProbeStorage (evalRelOpM bigDB op) probe `shouldReturn` evalRelOp bigDB op + recordedCalls probe `shouldReturn` ["scan_shards:3:big"] + + it "reads shards of one table through the wire" $ do + withTestSession $ \srv -> withServerEnv srv $ do + let rows = [[("id", VInt i), ("name", VStr ("n" ++ show i))] | i <- [1 .. 400 :: Int]] + runIPCStorage (insertMany "wide" rows) `shouldReturn` Right () + whole <- runIPCStorage (scan "wide") + fmap length whole `shouldBe` Right 400 + shardRows <- runIPCStorage (scanShards 4 "wide" Nothing) + shardRows `shouldBe` whole + projected <- runIPCStorage (scanShards 4 "wide" (Just ["name"])) + fmap (map (map fst)) projected `shouldBe` Right (map (const ["name"]) rows) + fmap (concatMap (map snd)) projected + `shouldBe` Right (map (VStr . ("n" ++) . show) [1 .. 400 :: Int]) + + describe "ChuSQL.Core.Engine.Error (错误分类唯一入口)" $ do + it "maps messages to wire codes without changing them" $ do + errorCode "no database selected" `shouldBe` "no_database" + errorCode "administrator required" `shouldBe` "forbidden" + errorCode "unknown table: t" `shouldBe` "not_found" + errorCode "unknown column: c" `shouldBe` "query_error" + errorCode "type error: expected two numbers" `shouldBe` "query_error" + errorCode "something else" `shouldBe` "query_error" + + it "keeps the account service codes in the same module" $ do + accountErrorCode "account already exists" `shouldBe` "conflict" + accountErrorCode "unknown account" `shouldBe` "not_found" + accountErrorCode "disk gone" `shouldBe` "storage_error" + + it "classifies the same messages into categories" $ do + errorCategory "no database selected" `shouldBe` NoDatabaseError + errorCategory "administrator required" `shouldBe` PermissionError + errorCategory "unknown table: t" `shouldBe` CatalogError + errorCategory "type error: expected two numbers" `shouldBe` TypeError + errorCategory "storage library call failed: x" `shouldBe` StorageError + errorCategory "unsupported protocol version" `shouldBe` ProtocolError + errorCategory "something else" `shouldBe` UnknownError + -- | 每个测试表都清空行后的库 emptyDB :: Database emptyDB = [(n, t{tableRows = []}) | (n, t) <- testDB] @@ -1984,6 +2291,94 @@ isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft (Right _) = False +-- | 延时后返回一个值 +delayed :: Int -> a -> IO a +delayed micros value = threadDelay micros >> pure value + +-- | 造一个记录调用序列的探针 +newProbe :: Table -> Int -> IO Probe +newProbe table width = do + calls <- newMVar [] + pure Probe {probeTable = table, probeCalls = calls, probeWidth = width} + +-- | 记一条存储调用 +recordCall :: Probe -> String -> IO () +recordCall probe name = modifyMVar_ (probeCalls probe) (\calls -> pure (calls ++ [name])) + +-- | 取回调用序列 +recordedCalls :: Probe -> IO [String] +recordedCalls = readMVar . probeCalls + +-- | 按列投影(空清单保留行) +projectColumns :: [String] -> [Row] -> [Row] +projectColumns cols = map (\row -> [(c, v) | c <- cols, Just v <- [lookup c row]]) + +-- | 按行数切成连续分片 +rowShards :: Int -> [a] -> [[a]] +rowShards width rows + | width <= 1 = [rows] + | otherwise = go rows + where + -- | 每片行数 + chunk = (length rows + width - 1) `div` width + -- | 反复切出前一片 + go rest + | null rest = [] + | otherwise = let (part, more) = splitAt chunk rest in part : go more + +-- | 声明 1000 行的大表 +bigTable :: Table +bigTable = users {tableName = "big", tableMeta = Just (TableMeta 1000 [("id", 1000, False)] ["id"])} + +-- | 只装大表的库 +bigDB :: Database +bigDB = [("big", bigTable)] + +-- | 记录存储调用、按行分片的假存储 +data Probe = Probe + { probeTable :: Table + , probeCalls :: MVar [String] + , probeWidth :: Int + } + +-- | 探针单子 +newtype ProbeStorage a = ProbeStorage {runProbeStorage :: Probe -> IO a} + +instance Functor ProbeStorage where + fmap f (ProbeStorage act) = ProbeStorage (fmap f . act) + +instance Applicative ProbeStorage where + pure value = ProbeStorage (\_ -> pure value) + ProbeStorage fn <*> ProbeStorage act = ProbeStorage (\probe -> fn probe <*> act probe) + +instance Monad ProbeStorage where + ProbeStorage act >>= next = + ProbeStorage (\probe -> act probe >>= \value -> runProbeStorage (next value) probe) + +instance MonadStorage ProbeStorage where + scan table = ProbeStorage $ \probe -> do + recordCall probe ("scan:" ++ table) + pure (Right (tableRows (probeTable probe))) + + scanColumns table columns = ProbeStorage $ \probe -> do + recordCall probe ("scan_columns:" ++ table) + pure (Right (projectColumns columns (tableRows (probeTable probe)))) + + parallelShards = ProbeStorage (pure . probeWidth) + + scanShards width table columns = ProbeStorage $ \probe -> do + recordCall probe ("scan_shards:" ++ show width ++ ":" ++ table) + let rows = maybe id projectColumns columns (tableRows (probeTable probe)) + pure (Right (concat (rowShards width rows))) + + insert _ _ = ProbeStorage (\_ -> pure (Left "probe: insert is not supported")) + replaceAll _ _ = ProbeStorage (\_ -> pure (Left "probe: replaceAll is not supported")) + createTable _ _ = ProbeStorage (\_ -> pure (Left "probe: createTable is not supported")) + dropTable _ = ProbeStorage (\_ -> pure (Left "probe: dropTable is not supported")) + dropColumn _ _ = ProbeStorage (\_ -> pure (Left "probe: dropColumn is not supported")) + replaceSchema _ _ _ = ProbeStorage (\_ -> pure (Left "probe: replaceSchema is not supported")) + snapshot = ProbeStorage (\_ -> pure []) + -- | 判断 Either 是 Right isRight :: Either a b -> Bool isRight (Right _) = True @@ -2018,6 +2413,27 @@ optimizedPlan sql = do q <- parseStatement sql optimize testDB <$> translate q +-- | 在给定库上解析并优化 SQL,返回计划 +optimizedPlanIn :: Database -> String -> Either String RelOp +optimizedPlanIn db sql = do + q <- parseStatement sql + optimize db <$> translate q + +-- | 计划里出现的表名(先序) +planTables :: RelOp -> [String] +planTables op = case op of + Scan _ t _ -> [t] + Lookup _ t _ _ -> [t] + Range _ t _ _ _ -> [t] + Filter _ x -> planTables x + Project _ x -> planTables x + Compute _ x -> planTables x + Aggregate _ _ x -> planTables x + Sort _ x -> planTables x + Limit _ x -> planTables x + Join _ l r _ -> planTables l ++ planTables r + Unit -> [] + -- | 计划里每个 Join 节点是不是 LEFT JOIN(先序) leftJoinKinds :: RelOp -> [Bool] leftJoinKinds (Join kind l r _) = (kind == LeftJoin) : (leftJoinKinds l ++ leftJoinKinds r) diff --git a/chusql-core/model/src/ChuSQL/Core/Model.hs b/chusql-core/model/src/ChuSQL/Core/Model.hs index 4be7cd0..4998ca7 100644 --- a/chusql-core/model/src/ChuSQL/Core/Model.hs +++ b/chusql-core/model/src/ChuSQL/Core/Model.hs @@ -9,6 +9,7 @@ module ChuSQL.Core.Model , TypeClass (..) , Value (..) , Row + , TableMeta (..) , Table (..) , Database , colNames @@ -24,10 +25,15 @@ module ChuSQL.Core.Model , parseColumnType , typeClassOf , assignable + , comparableTypes , integerType , numericType , valueFits , coerceValue + , canonicalValue + , compareValue + , valuesEqual + , hashValue ) where import Data.Char (isDigit, isSpace, toLower) @@ -230,6 +236,19 @@ integerType CBigInt = True integerType CSmallInt = True integerType _ = False +-- | 比较用的类型族:同大类可比,日期时间与文本互比 +comparableTypes :: ColumnType -> ColumnType -> Bool +comparableTypes a b = sameClass || crossTemporal + where + -- | 两个类型同属一个大类 + sameClass = typeClassOf a == typeClassOf b + -- | 时间与文本放在一起比 + crossTemporal = (temporal a && textual b) || (textual a && temporal b) + -- | 是不是时间类型 + temporal t = typeClassOf t == TemporalClass + -- | 是不是文本类型 + textual t = typeClassOf t == TextClass + -- | 是不是数值类型 numericType :: ColumnType -> Bool numericType t = typeClassOf t == NumericClass @@ -363,22 +382,76 @@ data Value | VBool Bool deriving (Show, Eq) +-- | 值的比较关键字:整值浮点折成整数 +canonicalValue :: Value -> Value +canonicalValue (VFloat d) + | wholeDouble d = VInt (truncate d) +canonicalValue v = v + +-- | 浮点是不是能精确折成整数的整值 +wholeDouble :: Double -> Bool +wholeDouble d = + not (isNaN d) + && not (isInfinite d) + && abs d <= 9007199254740992 + && d == fromIntegral (truncate d :: Int) + +-- | 值的全序:NULL 最小,数值跨类型比大小,异族按族的先后 +compareValue :: Value -> Value -> Ordering +compareValue a b = case (canonicalValue a, canonicalValue b) of + (VNull, VNull) -> EQ + (VNull, _) -> LT + (_, VNull) -> GT + (VInt x, VInt y) -> compare x y + (VInt x, VFloat y) -> compare (fromIntegral x) y + (VFloat x, VInt y) -> compare x (fromIntegral y) + (VFloat x, VFloat y) -> compare x y + (VStr x, VStr y) -> compare x y + (VBool x, VBool y) -> compare x y + (x, y) -> compare (valueRank x) (valueRank y) + +-- | 族的先后,只用来给异族值定序 +valueRank :: Value -> Int +valueRank VNull = 0 +valueRank (VInt _) = 1 +valueRank (VFloat _) = 1 +valueRank (VStr _) = 2 +valueRank (VBool _) = 3 + +-- | 相等语义:比较关键字相同即相等,与 hashValue 配套 +valuesEqual :: Value -> Value -> Bool +valuesEqual a b = canonicalValue a == canonicalValue b + +-- | 值的关键字哈希,与 valuesEqual 用同一套关键字 +hashValue :: Value -> Int +hashValue v = case canonicalValue v of + VNull -> hashWithSalt 0 (0 :: Int) + VInt n -> hashWithSalt 1 n + VFloat d -> hashWithSalt 1 d + VStr t -> hashWithSalt 2 t + VBool b -> hashWithSalt 3 b + -- | 值按类型打散搅拌 instance Hashable Value where - hashWithSalt s VNull = hashWithSalt (hashWithSalt s (0 :: Int)) () - hashWithSalt s (VInt n) = hashWithSalt (hashWithSalt s (1 :: Int)) n - hashWithSalt s (VFloat d) = hashWithSalt (hashWithSalt s (2 :: Int)) d - hashWithSalt s (VStr t) = hashWithSalt (hashWithSalt s (3 :: Int)) t - hashWithSalt s (VBool b) = hashWithSalt (hashWithSalt s (4 :: Int)) b + hashWithSalt s = hashWithSalt s . hashValue -- | 一行数据 type Row = [(String, Value)] --- | 一张表:名字、列定义与全部行 +-- | 一张表的统计:行数、各列不同值数(capped 表示只数到上限)、有索引的列 +data TableMeta = TableMeta + { metaRowCount :: Int + , metaDistinct :: [(String, Int, Bool)] + , metaIndexes :: [String] + } + deriving (Show) + +-- | 一张表:名字、列定义与全部行;meta 为存储层统计,拿不到是 Nothing data Table = Table { tableName :: String , tableCols :: [(String, Column)] , tableRows :: [Row] + , tableMeta :: Maybe TableMeta } deriving (Show) diff --git a/chusql-core/model/src/ChuSQL/Core/Protocol.hs b/chusql-core/model/src/ChuSQL/Core/Protocol.hs index a6bdddd..6f812f1 100644 --- a/chusql-core/model/src/ChuSQL/Core/Protocol.hs +++ b/chusql-core/model/src/ChuSQL/Core/Protocol.hs @@ -80,6 +80,7 @@ data Request | ReqAccountDrop T.Text | ReqScan String | ReqScanColumns String [String] + | ReqScanShard String (Maybe [String]) Int Int | ReqInsert String Row | ReqInsertBatch String [Row] | ReqDeleteKeys String [Int] @@ -111,6 +112,14 @@ instance ToJSON Request where toJSON ReqPing = object ["method" .= ("ping" :: T.Text)] toJSON (ReqScan t) = object ["method" .= ("scan" :: T.Text), "table" .= t] toJSON (ReqScanColumns t cols) = object ["method" .= ("scan" :: T.Text), "table" .= t, "columns" .= cols] + toJSON (ReqScanShard t cols shard shards) = + object + [ "method" .= ("scan_shard" :: T.Text) + , "table" .= t + , "columns" .= cols + , "shard" .= shard + , "shards" .= shards + ] toJSON (ReqInsert t r) = object [ "method" .= ("insert" :: T.Text) diff --git a/chusql-core/storage/src/heap.rs b/chusql-core/storage/src/heap.rs index 77ff28a..19a1e7f 100644 --- a/chusql-core/storage/src/heap.rs +++ b/chusql-core/storage/src/heap.rs @@ -73,14 +73,25 @@ fn unpack_position(v: u64) -> (PageId, u16) { (v >> 16, (v & 0xFFFF) as u16) } -/// 取行里某一列的整数值(不是整数就没有) -fn row_int(row: &Row, column: &str) -> Option { - match row.get(column) { - Some(serde_json::Value::Number(n)) => n.as_i64(), +/// 数值里取整数,整值浮点折成整数 +pub(crate) fn scalar_int(v: &serde_json::Value) -> Option { + match v { + serde_json::Value::Number(n) => n.as_i64().or_else(|| { + let f = n.as_f64()?; + if f.fract() != 0.0 || f.abs() > 9_007_199_254_740_992.0 { + return None; + } + Some(f as i64) + }), _ => None, } } +/// 取行里某一列的整数值(不是整数就没有) +fn row_int(row: &Row, column: &str) -> Option { + row.get(column).and_then(scalar_int) +} + /// i64 键 → 8 字节大端(保序,负数也在前) fn key_of(value: i64) -> [u8; 8] { (value as u64 ^ (1u64 << 63)).to_be_bytes() @@ -89,7 +100,7 @@ fn key_of(value: i64) -> [u8; 8] { /// JSON 值 → 索引键字节(与写索引时同一套编码) fn value_key(v: &serde_json::Value) -> Option> { match v { - serde_json::Value::Number(n) => n.as_i64().map(|k| key_of(k).to_vec()), + serde_json::Value::Number(_) => scalar_int(v).map(|k| key_of(k).to_vec()), serde_json::Value::String(s) => Some(s.as_bytes().to_vec()), serde_json::Value::Bool(b) => Some(vec![u8::from(*b)]), _ => None, @@ -613,11 +624,41 @@ impl HeapTable { self.scan_projected_with_positions(None) } + /// 分片扫描,只取 [from, to) 页区间内的行 + pub fn scan_columns_pages( + &mut self, + columns: Option<&[String]>, + from: PageId, + to: PageId, + ) -> io::Result> { + Ok(self + .scan_pages_with_positions(columns, from, to)? + .into_iter() + .map(|(_, _, r)| r) + .collect()) + } + + /// 当前页数 + pub fn num_pages(&mut self) -> io::Result { + self.file.num_pages() + } + /// 全表扫描,带位置与列投影 fn scan_projected_with_positions(&mut self, columns: Option<&[String]>) -> io::Result> { + let n = self.file.num_pages()?; + self.scan_pages_with_positions(columns, 0, n) + } + + /// 扫描 [from, to) 页区间,带位置与列投影 + fn scan_pages_with_positions( + &mut self, + columns: Option<&[String]>, + from: PageId, + to: PageId, + ) -> io::Result> { let n = self.file.num_pages()?; let mut out = Vec::new(); - for i in 0..n { + for i in from..to.min(n) { let tuples = self.file.with_page(i, |p| { let mut v = Vec::new(); for slot in HeapPage::iter_slots(p) { diff --git a/chusql-core/storage/src/initsql.rs b/chusql-core/storage/src/initsql.rs deleted file mode 100644 index 13c2037..0000000 --- a/chusql-core/storage/src/initsql.rs +++ /dev/null @@ -1,206 +0,0 @@ -use crate::protocol::SchemaColumn; - -// 读取 scripts/init.sql,只认 CREATE TABLE 与 CREATE INDEX。 -// 系统库的 schema 由这份脚本声明,进程按它建系统表。 - -#[derive(Debug, Clone, PartialEq, Eq)] -pub struct InitColumn { - pub name: String, - pub ty: String, - pub nullable: bool, - pub auto_increment: bool, - pub primary_key: bool, - pub unique: bool, -} - -#[derive(Debug, Clone, PartialEq, Eq)] -pub struct InitTable { - pub name: String, - pub columns: Vec, - pub indexes: Vec, -} - -impl InitColumn { - /// 转成数据字典里的列 - pub fn to_schema(&self) -> SchemaColumn { - SchemaColumn { - name: self.name.clone(), - ty: self.ty.clone(), - nullable: self.nullable, - default: None, - auto_increment: self.auto_increment, - primary_key: self.primary_key, - unique: self.unique, - check: None, - } - } -} - -/// 解析整份脚本;不认识的语句直接报错,避免悄悄漏建表 -pub fn parse(text: &str) -> Result, String> { - let mut tables: Vec = Vec::new(); - for statement in statements(text) { - let words = statement.split_whitespace().collect::>(); - let head = |index: usize| words.get(index).map(|word| word.to_ascii_uppercase()); - match (head(0).as_deref(), head(1).as_deref()) { - (Some("CREATE"), Some("TABLE")) => { - let name = clean_name(words.get(2).ok_or("CREATE TABLE needs a name")?); - let body = statement.split_once('(').ok_or("CREATE TABLE needs a column list")?.1; - let inner = body.rsplit_once(')').map(|(inner, _)| inner).unwrap_or(body); - tables.push(InitTable { name, columns: columns(inner)?, indexes: Vec::new() }); - } - (Some("CREATE"), Some("INDEX")) => { - let table = clean_name(words.get(2).ok_or("CREATE INDEX needs a table")?); - let column = statement - .split_once('(') - .and_then(|(_, rest)| rest.split_once(')')) - .map(|(column, _)| clean_name(column)) - .ok_or("CREATE INDEX needs a column")?; - let entry = tables - .iter_mut() - .find(|entry| entry.name.eq_ignore_ascii_case(&table)) - .ok_or_else(|| format!("CREATE INDEX on unknown table: {table}"))?; - entry.indexes.push(column); - } - _ => return Err(format!("unsupported statement: {}", statement.trim())), - } - } - Ok(tables) -} - -/// 解析表定义里的列清单 -fn columns(body: &str) -> Result, String> { - let mut out = Vec::new(); - for part in split_top_level(body) { - let words = part.split_whitespace().collect::>(); - if words.is_empty() { - continue; - } - let keyword = words[0].to_ascii_uppercase(); - if matches!(keyword.as_str(), "PRIMARY" | "UNIQUE" | "KEY" | "CONSTRAINT" | "INDEX" | "CHECK" | "FOREIGN") { - return Err(format!("table-level constraint is not supported: {}", part.trim())); - } - let name = clean_name(words[0]); - let ty = words - .get(1) - .ok_or_else(|| format!("column {name} needs a type"))? - .to_string(); - let upper = part.to_ascii_uppercase(); - out.push(InitColumn { - name, - ty, - nullable: !upper.contains("NOT NULL"), - auto_increment: upper.contains("AUTO_INCREMENT"), - primary_key: upper.contains("PRIMARY KEY"), - unique: upper.contains("UNIQUE"), - }); - } - Ok(out) -} - -/// 按顶层的逗号切开(类型里的括号不算) -fn split_top_level(body: &str) -> Vec { - let mut parts = Vec::new(); - let mut current = String::new(); - let mut depth = 0; - for ch in body.chars() { - match ch { - '(' => { - depth += 1; - current.push(ch); - } - ')' => { - depth -= 1; - current.push(ch); - } - ',' if depth == 0 => { - parts.push(std::mem::take(&mut current)); - } - _ => current.push(ch), - } - } - if !current.trim().is_empty() { - parts.push(current); - } - parts -} - -/// 去掉反引号与空白 -fn clean_name(raw: &str) -> String { - raw.trim().trim_matches('`').trim_matches('"').trim().to_string() -} - -/// 去掉注释后按分号切开 -fn statements(text: &str) -> Vec { - let mut cleaned = String::new(); - let mut chars = text.chars().peekable(); - while let Some(ch) = chars.next() { - if ch == '-' && chars.peek() == Some(&'-') { - for next in chars.by_ref() { - if next == '\n' { - cleaned.push('\n'); - break; - } - } - } else if ch == '/' && chars.peek() == Some(&'*') { - chars.next(); - while let Some(next) = chars.next() { - if next == '*' && chars.peek() == Some(&'/') { - chars.next(); - break; - } - } - } else { - cleaned.push(ch); - } - } - cleaned - .split(';') - .map(|statement| statement.trim().to_string()) - .filter(|statement| !statement.is_empty()) - .collect() -} - -#[cfg(test)] -mod tests { - use super::*; - - /// 仓库里的系统库脚本必须始终能解析 - 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"); - let users = tables - .iter() - .find(|table| table.name == "__chusql_users") - .expect("init.sql must declare the account table"); - let names: Vec<&str> = users.columns.iter().map(|column| column.name.as_str()).collect(); - assert_eq!(names, ["id", "user", "password_hash", "registered_at", "last_login_at", "revision"]); - assert_eq!(users.columns[0].ty, "int"); - assert!(users.columns[0].primary_key && users.columns[0].auto_increment && !users.columns[0].nullable); - assert_eq!(users.columns[1].ty, "varchar(64)"); - assert!(users.columns[1].unique); - assert_eq!(users.columns[4].ty, "timestamp"); - assert!(users.columns[4].nullable); - assert_eq!(users.indexes, ["user"]); - } - - /// 未知语句与表级约束要报错 - #[test] - fn rejects_unknown_statements_and_table_level_constraints() { - assert!(parse("DROP TABLE users;").is_err()); - assert!(parse("CREATE TABLE t (id int, PRIMARY KEY (id));").is_err()); - 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(); - assert_eq!(tables.len(), 1); - assert_eq!(tables[0].columns[0].name, "a"); - assert!(!tables[0].columns[0].nullable); - } -} diff --git a/chusql-core/storage/src/lib.rs b/chusql-core/storage/src/lib.rs index e1e58f9..017fcdd 100644 --- a/chusql-core/storage/src/lib.rs +++ b/chusql-core/storage/src/lib.rs @@ -5,7 +5,6 @@ pub mod catalog; pub mod config; pub mod ffi; pub mod heap; -pub mod initsql; pub mod log; pub mod page; pub mod protocol; diff --git a/chusql-core/storage/src/protocol.rs b/chusql-core/storage/src/protocol.rs index bc20fd4..cb6be70 100644 --- a/chusql-core/storage/src/protocol.rs +++ b/chusql-core/storage/src/protocol.rs @@ -5,7 +5,7 @@ use std::collections::HashMap; pub type Row = HashMap; -pub const USERS_TABLE: &str = "__chusql_users"; +pub const USERS_TABLE: &str = "__system_users"; #[derive(Debug, Clone, Serialize, Deserialize, PartialEq, Eq)] pub struct Account { @@ -83,12 +83,28 @@ pub enum Request { at: Option, }, AccountDrop { user: String }, + /// 引导系统目录:建系统表,给了 user 就同时补首个管理员 + BootstrapSystem { + #[serde(default)] + user: Option, + #[serde(default)] + password_hash: Option, + }, + SystemStatus, Ping, Scan { table: String, #[serde(default)] columns: Option>, }, + /// 分片扫描:第 shard 片只读总页数按 shards 均分后的那一段 + ScanShard { + table: String, + #[serde(default)] + columns: Option>, + shard: u32, + shards: u32, + }, Insert { table: String, row: Row, @@ -174,7 +190,8 @@ impl Request { /// 普通表操作的统一访问边界 pub fn table(&self) -> Option<&str> { match self { - Self::Scan { table, .. } | Self::Insert { table, .. } + Self::Scan { table, .. } | Self::ScanShard { table, .. } + | Self::Insert { table, .. } | Self::InsertBatch { table, .. } | Self::DeleteKeys { table, .. } | Self::LookupByIndex { table, .. } | Self::ReplaceAll { table, .. } | Self::RangeByIndex { table, .. } @@ -185,14 +202,14 @@ impl Request { | Self::ReplaceSchema { table, .. } => Some(table), Self::Ping | Self::ListTables | Self::ListCatalog | Self::AccountsList | Self::AccountCreate { .. } | Self::AccountReset { .. } | Self::AccountLogin { .. } - | Self::AccountDrop { .. } => None, + | Self::AccountDrop { .. } | Self::BootstrapSystem { .. } | Self::SystemStatus => None, } } } /// 是不是保留系统表名 pub fn reserved_table(table: &str) -> bool { - table.to_ascii_lowercase().starts_with("__chusql_") + table.to_ascii_lowercase().starts_with("__system_") } /// 没写 column 时按 `id` 算 @@ -219,6 +236,8 @@ pub enum Response { }, NoIndex, Ok, + /// 系统目录状态 + System { initialized: bool }, Error { message: String }, Catalog { schemas: Vec }, } diff --git a/chusql-core/storage/src/runtime.rs b/chusql-core/storage/src/runtime.rs index b299d0f..808a194 100644 --- a/chusql-core/storage/src/runtime.rs +++ b/chusql-core/storage/src/runtime.rs @@ -1,12 +1,11 @@ -use std::collections::HashMap; +use std::collections::{HashMap, HashSet}; use std::path::PathBuf; use std::sync::atomic::{AtomicBool, Ordering}; -use std::sync::{Arc, Mutex}; +use std::sync::{Arc, Mutex, RwLock}; use crate::catalog::Catalog; use crate::config::{self, Config, Loaded}; -use crate::heap::HeapTable; -use crate::initsql::{self, InitColumn, InitTable}; +use crate::heap::{scalar_int, HeapTable}; use crate::log; use crate::protocol::{ reserved_table, Account, ColumnStatWire, IndexWire, Request, Response, Row, SchemaColumn, TableSchemaWire, USERS_TABLE, @@ -21,6 +20,7 @@ struct Server { cfg: Config, tables: Mutex>>>, write_lock: Mutex<()>, + gate: RwLock<()>, catalog: Mutex, wal: Wal, recovery_required: AtomicBool, @@ -38,6 +38,7 @@ impl Server { cfg, tables: Mutex::new(HashMap::new()), write_lock: Mutex::new(()), + gate: RwLock::new(()), catalog: Mutex::new(catalog), wal, recovery_required: AtomicBool::new(false), @@ -127,6 +128,56 @@ impl Server { f(&mut guard) } + /// 请求带列名时逐个查字典 + fn check_columns(&self, table: &str, columns: Option<&[String]>) -> std::io::Result<()> { + let Some(cols) = columns else { + return Ok(()); + }; + let c = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?; + let schema = c + .describe(table) + .ok_or_else(|| std::io::Error::other(format!("unknown table: {table}")))?; + for col in cols { + if !schema.columns.iter().any(|c| &c.name == col) { + return Err(std::io::Error::other(format!("unknown column: {col}"))); + } + } + Ok(()) + } + + /// 分片只读扫描:独立句柄读一段连续页,不经表锁 + fn scan_shard( + &self, + table: &str, + columns: Option<&[String]>, + shard: u32, + shards: u32, + ) -> std::io::Result> { + if shards == 0 || shard >= shards { + return Err(std::io::Error::other("invalid shard range")); + } + if !self.table_exists(table)? { + return Err(std::io::Error::new( + std::io::ErrorKind::NotFound, + format!("unknown table: {}", table), + )); + } + let hidden: HashSet = self + .catalog + .lock() + .map_err(|_| std::io::Error::other("catalog lock poisoned"))? + .describe(table) + .map(|s| s.dropped_columns.iter().cloned().collect()) + .unwrap_or_default(); + let mut t = HeapTable::open(self.table_path(table), self.cfg.page_size, self.cfg.pool_size)?; + t.set_hidden_columns(hidden); + let n = t.num_pages()?; + let chunk = n.div_ceil(u64::from(shards)); + let from = u64::from(shard).saturating_mul(chunk).min(n); + let to = u64::from(shard + 1).saturating_mul(chunk).min(n); + t.scan_columns_pages(columns, from, to) + } + /// 表不存在就报错 fn with_existing_table( &self, @@ -528,6 +579,88 @@ impl Server { Ok(()) } + /// 账号表是否已登记为系统表 + fn account_table_ready(&self) -> std::io::Result { + use std::io::{Error, ErrorKind}; + let registered = { + let c = self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?; + c.describe(USERS_TABLE).map(|schema| schema.system) + }; + match registered { + Some(true) => Ok(true), + Some(false) => Err(Error::new(ErrorKind::AlreadyExists, "reserved account table collision")), + None => { + if self.table_path(USERS_TABLE).exists() || self.index_path(USERS_TABLE, "id").exists() { + Err(Error::new(ErrorKind::AlreadyExists, "reserved account file collision")) + } else { + Ok(false) + } + } + } + } + + /// 系统目录里账号表已登记 + fn system_initialized(&self) -> bool { + self.catalog + .lock() + .map(|c| c.describe(USERS_TABLE).is_some_and(|schema| schema.system)) + .unwrap_or(false) + } + + /// 读账号表;表没登记或数据文件缺失都算错 + fn load_accounts(&self) -> std::io::Result> { + use std::io::Error; + if !self.table_path(USERS_TABLE).exists() { + return Err(Error::other("missing account data")); + } + let mut accounts: Vec = self + .with_existing_table(USERS_TABLE, |t| t.scan())? + .iter() + .map(decode_account_row) + .collect::>()?; + for account in accounts.iter_mut() { + normalize_account(account); + } + Ok(accounts) + } + + /// 引导系统目录:建账号表,空表才补管理员 + fn bootstrap_system(&self, user: Option<&str>, password_hash: Option<&str>) -> std::io::Result> { + use std::io::Error; + let _guard = self.write_lock.lock().map_err(|_| Error::other("write lock poisoned"))?; + if self.recovery_required.load(Ordering::Acquire) { + return Err(Error::other("storage recovery required")); + } + let initialized = self.account_table_ready()?; + let mut accounts = if initialized { self.load_accounts()? } else { Vec::new() }; + let mut changed = !initialized; + if let Some(user) = user { + let name = account_name(user)?; + // 表里已经有行就不再补人:引导程序只在空表上播种, + // 免得有人拿 storage 透传绕过账号接口往里塞一个已知口令的账号 + if accounts.is_empty() && !accounts.iter().any(|a| a.user == name) { + let id = accounts.iter().map(|a| a.id).max().unwrap_or(0) + .checked_add(1).ok_or_else(|| Error::other("account id exhausted"))?; + accounts.push(new_account(id, &name, password_hash.unwrap_or_default().to_string())?); + changed = true; + } + } + if !changed { + return Ok(accounts); + } + for row in account_rows(&accounts)? { + HeapTable::encode_row(&row, self.cfg.page_size)?; + } + let op = WalOp::Accounts { accounts: accounts.clone() }; + self.recovery_required.store(true, Ordering::Release); + self.wal.truncate()?; + self.wal.append(&op)?; + self.apply_op(&op)?; + self.wal.clear()?; + self.recovery_required.store(false, Ordering::Release); + Ok(accounts) + } + /// 账号读写共享串行持久化边界 fn accounts_request(&self, request: Request) -> std::io::Result> { use std::io::{Error, ErrorKind}; @@ -535,31 +668,10 @@ impl Server { if self.recovery_required.load(Ordering::Acquire) { return Err(Error::other("storage recovery required")); } - let initialized = { - let c = self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?; - match c.describe(USERS_TABLE) { - Some(schema) if schema.system => true, - Some(_) => return Err(Error::new(ErrorKind::AlreadyExists, "reserved account table collision")), - None => false, - } - }; - if !initialized && (self.table_path(USERS_TABLE).exists() || self.index_path(USERS_TABLE, "id").exists()) { - return Err(Error::new(ErrorKind::AlreadyExists, "reserved account file collision")); + if !self.account_table_ready()? { + return Err(Error::other("system catalog is not initialized; run csql-bootstrap")); } - let mut accounts: Vec = if initialized { - if !self.table_path(USERS_TABLE).exists() { - return Err(Error::other("missing account data")); - } - let mut loaded: Vec = self - .with_existing_table(USERS_TABLE, |t| t.scan())? - .iter() - .map(decode_account_row) - .collect::>()?; - for account in loaded.iter_mut() { - normalize_account(account); - } - loaded - } else { Vec::new() }; + let mut accounts = self.load_accounts()?; match request { Request::AccountsList => return Ok(accounts), Request::AccountCreate { user, password_hash } => { @@ -609,8 +721,27 @@ impl Server { Ok(accounts) } - /// 一条请求翻成一条响应 + /// 一条请求翻成一条响应:先过读/写门再分发 fn handle_request(&self, req: Request) -> Response { + if concurrent_read(&req) { + match self.gate.read() { + Ok(_read) => self.dispatch(req), + Err(_) => Response::Error { + message: "storage read gate poisoned".into(), + }, + } + } else { + match self.gate.write() { + Ok(_write) => self.dispatch(req), + Err(_) => Response::Error { + message: "storage write gate poisoned".into(), + }, + } + } + } + + /// 持门后分发一条请求 + fn dispatch(&self, req: Request) -> Response { let _ddl_guard = if matches!(req, Request::CreateTable { .. } | Request::DropTable { .. } | Request::CreateIndex { .. } | Request::DropIndex { .. }) { match self.write_lock.lock() { @@ -641,6 +772,13 @@ impl Server { Err(e) => Response::Error { message: e.to_string() }, } } + Request::BootstrapSystem { user, password_hash } => { + match self.bootstrap_system(user.as_deref(), password_hash.as_deref()) { + Ok(_) => Response::System { initialized: true }, + Err(e) => Response::Error { message: e.to_string() }, + } + } + Request::SystemStatus => Response::System { initialized: self.system_initialized() }, Request::Ping => { log_debug!(request, "ping"); Response::Pong @@ -650,15 +788,7 @@ impl Server { log_debug!(request, "scan table={}", table); let result = (|| { - if let Some(cols) = &columns { - let c = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?; - let schema = c.describe(&table).ok_or_else(|| std::io::Error::other(format!("unknown table: {table}")))?; - for col in cols { - if !schema.columns.iter().any(|c| &c.name == col) { - return Err(std::io::Error::other(format!("unknown column: {col}"))); - } - } - } + self.check_columns(&table, columns.as_deref())?; self.with_existing_table(&table, |t| t.scan_columns(columns.as_deref())) })(); @@ -673,6 +803,30 @@ impl Server { } } + Request::ScanShard { + table, + columns, + shard, + shards, + } => { + log_debug!(request, "scan_shard table={} shard={}/{}", table, shard, shards); + + let result = (|| { + self.check_columns(&table, columns.as_deref())?; + self.scan_shard(&table, columns.as_deref(), shard, shards) + })(); + + match result { + Ok(rows) => Response::Rows { rows }, + Err(e) => { + log_warn!(request, "scan {} shard {}/{}: {}", table, shard, shards, e); + Response::Error { + message: format!("scan {}: {}", table, e), + } + } + } + } + Request::Insert { table, row } => { log_debug!(request, "insert table={}", table); let tname = table.clone(); @@ -733,7 +887,7 @@ impl Server { if !indexed { return Response::NoIndex; } - let found = match key.as_i64() { + let found = match scalar_int(&key) { Some(k) => self.with_table(&table, |t| t.get_all_by_column_key(&column, k)), None => match key.as_str() { Some(s) => self.with_table(&table, |t| t.get_all_by_string_key(&column, s)), @@ -1025,18 +1179,31 @@ fn account_rows(accounts: &[Account]) -> std::io::Result> { ]))).collect() } -/// 按 init.sql 把系统表写进字典 +/// 系统库的账号表结构:引导模块按这份定义建表 +fn users_columns() -> Vec { + vec![ + SchemaColumn { name: "id".into(), ty: "int".into(), nullable: false, + auto_increment: true, primary_key: true, ..Default::default() }, + SchemaColumn { name: "user".into(), ty: "varchar(64)".into(), nullable: false, + unique: true, ..Default::default() }, + SchemaColumn { name: "password_hash".into(), ty: "varchar(256)".into(), + nullable: false, ..Default::default() }, + SchemaColumn { name: "registered_at".into(), ty: "timestamp".into(), + nullable: false, ..Default::default() }, + SchemaColumn { name: "last_login_at".into(), ty: "timestamp".into(), + ..Default::default() }, + SchemaColumn { name: "revision".into(), ty: "int".into(), nullable: false, + ..Default::default() }, + ] +} + +/// 把系统表写进字典 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 { &[] }; - catalog.rebuild_stats(&table.name, stats); - catalog.set_columns(&table.name, table.columns.iter().map(InitColumn::to_schema).collect())?; - catalog.rebuild_stats(&table.name, stats); - catalog.mark_system(&table.name)?; - for index in &table.indexes { - catalog.add_index(&table.name, index)?; - } - } + catalog.rebuild_stats(USERS_TABLE, rows); + catalog.set_columns(USERS_TABLE, users_columns())?; + catalog.rebuild_stats(USERS_TABLE, rows); + catalog.mark_system(USERS_TABLE)?; + catalog.add_index(USERS_TABLE, "user")?; Ok(()) } @@ -1110,9 +1277,9 @@ fn account_name(user: &str) -> std::io::Result { Ok(user.to_ascii_lowercase()) } -/// 校验口令哈希长度 +/// 校验口令哈希长度,空串表示免密 fn validate_account_hash(hash: &str) -> std::io::Result<()> { - if hash.is_empty() || hash.len() > 256 { + if hash.len() > 256 { return Err(std::io::Error::other("invalid account credential")); } Ok(()) @@ -1172,15 +1339,6 @@ impl Drop for Server { /// 别的库一律要显式建(没有默认工作库)。 const SYSTEM_DATABASE: &str = "system"; -/// 系统库的表结构来自这份脚本(编译期嵌进来) -const SYSTEM_SCHEMA_SQL: &str = include_str!("../../../scripts/init.sql"); - -/// 系统库 schema:脚本缺表或多表都按它来 -fn system_schema() -> &'static [InitTable] { - static TABLES: std::sync::OnceLock> = std::sync::OnceLock::new(); - TABLES.get_or_init(|| initsql::parse(SYSTEM_SCHEMA_SQL).unwrap_or_else(|e| panic!("scripts/init.sql: {e}"))) -} - /// 保留库:不能建、不能删。 fn reserved_database(name: &str) -> bool { name == SYSTEM_DATABASE @@ -1322,7 +1480,8 @@ impl Databases { let request: Request = serde_json::from_value(value).map_err(Error::other)?; let global = matches!(request, Request::AccountsList | Request::AccountCreate { .. } | Request::AccountReset { .. } | Request::AccountLogin { .. } - | Request::AccountDrop { .. } | Request::Ping); + | Request::AccountDrop { .. } | Request::BootstrapSystem { .. } + | Request::SystemStatus | Request::Ping); let server = if global { &self.system } else if selected.is_empty() { return Err(Error::other("no database selected")); } else if selected == SYSTEM_DATABASE { &self.system } @@ -1331,6 +1490,17 @@ impl Databases { } } +/// 只读表页的请求可与其它读并发,其余独占 +fn concurrent_read(req: &Request) -> bool { + matches!( + req, + Request::Scan { .. } + | Request::ScanShard { .. } + | Request::LookupByIndex { .. } + | Request::RangeByIndex { .. } + ) +} + /// 校验库名是否合法 fn valid_database(name: &str) -> bool { let lower = name.to_ascii_lowercase(); diff --git a/chusql-core/storage/tests/runtime_test.rs b/chusql-core/storage/tests/runtime_test.rs index 11fec16..45b9fe4 100644 --- a/chusql-core/storage/tests/runtime_test.rs +++ b/chusql-core/storage/tests/runtime_test.rs @@ -32,6 +32,190 @@ fn scan_projects_columns_and_preserves_empty_rows() -> Result<(), Box Result<(), Box> { + let (_srv, data) = start_server(); + let mut c = connect()?; + request_ok(&mut c, serde_json::json!({"method":"create_table","table":"wide","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?; + let rows: Vec = (1..=1200) + .map(|i| serde_json::json!({"id": i, "name": format!("row-{i:04}")})) + .collect(); + request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"wide","rows":rows}))?; + let heap_bytes = std::fs::metadata(data.path().join("databases/main/wide.db"))?.len(); + assert!(heap_bytes > 4 * 4096, "分片要有意义得多页,实际只有 {heap_bytes} 字节"); + let whole: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"wide"}"#))?; + let all = whole["rows"].as_array().expect("rows").clone(); + assert_eq!(all.len(), 1200); + for shards in [1, 3, 4, 7, 16] { + let mut merged = Vec::new(); + for shard in 0..shards { + let request = serde_json::json!({"method":"scan_shard","table":"wide","shard":shard,"shards":shards}); + let part: serde_json::Value = serde_json::from_str(&send(&mut c, &request.to_string()))?; + assert_eq!(part["status"], "rows", "shards={shards} shard={shard}: {part}"); + merged.extend(part["rows"].as_array().expect("rows").iter().cloned()); + } + assert_eq!( + serde_json::Value::Array(merged), + serde_json::Value::Array(all.clone()), + "{shards} 个分片拼接后必须与整表同序" + ); + } + Ok(()) +} + +/// 分片扫描支持投影与空列,越界分片和未知名都明确报错 +#[test] +fn scan_shard_projects_columns_and_rejects_bad_ranges() -> Result<(), Box> { + let (_srv, _data) = start_server(); + let mut c = connect()?; + 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 [ + (serde_json::json!(["name"]), serde_json::json!([{"name":"one"},{"name":null}])), + (serde_json::json!([]), serde_json::json!([{},{}])), + ] { + let mut merged = Vec::new(); + for shard in 0..3 { + let request = serde_json::json!({"method":"scan_shard","table":"items","columns":columns,"shard":shard,"shards":3}); + let part: serde_json::Value = serde_json::from_str(&send(&mut c, &request.to_string()))?; + assert_eq!(part["status"], "rows", "{part}"); + merged.extend(part["rows"].as_array().expect("rows").iter().cloned()); + } + assert_eq!(serde_json::Value::Array(merged), expected); + } + request_ok(&mut c, serde_json::json!({"method":"create_table","table":"blank","columns":[{"name":"id","ty":"int"}]}))?; + for (line, why) in [ + (r#"{"method":"scan_shard","table":"blank","shard":0,"shards":4}"#, "空表"), + (r#"{"method":"scan_shard","table":"items","shard":3,"shards":3}"#, "分片号越界"), + (r#"{"method":"scan_shard","table":"items","shard":0,"shards":0}"#, "分片数为零"), + (r#"{"method":"scan_shard","table":"missing","shard":0,"shards":2}"#, "未知表"), + (r#"{"method":"scan_shard","table":"items","columns":["missing"],"shard":0,"shards":2}"#, "未知列"), + ] { + let result: serde_json::Value = serde_json::from_str(&send(&mut c, line))?; + if why == "空表" { + assert_eq!(result["rows"], serde_json::json!([]), "{line}"); + } else { + assert_eq!(result["status"], "error", "{why}: {line} -> {result}"); + } + } + Ok(()) +} + +/// 多线程并发分片读同一实例,各分片结果与整表一致 +#[test] +fn concurrent_shard_reads_share_one_instance() -> Result<(), Box> { + let (_srv, _data) = start_server(); + let mut c = connect()?; + request_ok(&mut c, serde_json::json!({"method":"create_table","table":"wide","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?; + let rows: Vec = (1..=600) + .map(|i| serde_json::json!({"id": i, "name": format!("row-{i:04}")})) + .collect(); + request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"wide","rows":rows}))?; + + let storage = CURRENT.with(|slot| slot.borrow().as_ref().cloned().expect("storage opened")); + let shards = 4; + let parts = std::thread::scope(|scope| { + let handles: Vec<_> = (0..shards) + .map(|shard| { + let storage = Arc::clone(&storage); + scope.spawn(move || { + let request = format!( + r#"{{"method":"scan_shard","database":"{FIXTURE_DATABASE}","table":"wide","shard":{shard},"shards":{shards}}}"# + ); + let mut rows = Vec::new(); + for _ in 0..4 { + let reply = storage.request_line(&request); + let value: serde_json::Value = serde_json::from_str(&reply).expect("json"); + assert_eq!(value["status"], "rows", "{reply}"); + rows = value["rows"].as_array().expect("rows").clone(); + } + rows + }) + }) + .collect(); + handles + .into_iter() + .map(|h| h.join().expect("worker thread")) + .collect::>() + }); + + let whole: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"wide"}"#))?; + let merged: Vec = parts.into_iter().flatten().collect(); + assert_eq!(merged.len(), 600, "并发分片不能丢行"); + assert_eq!(serde_json::Value::Array(merged), whole["rows"]); + Ok(()) +} + +/// 分片读与同表写并发时读者只看到一致快照 +#[test] +fn concurrent_shard_reads_exclude_writers() -> Result<(), Box> { + let (_srv, _data) = start_server(); + let mut c = connect()?; + request_ok(&mut c, serde_json::json!({"method":"create_table","table":"wide","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?; + let rows: Vec = (1..=400) + .map(|i| serde_json::json!({"id": i, "name": format!("row-{i:04}")})) + .collect(); + request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"wide","rows":rows}))?; + + let storage = CURRENT.with(|slot| slot.borrow().as_ref().cloned().expect("storage opened")); + let shards = 3; + let inserted = 20; + std::thread::scope(|scope| { + let writer = { + let storage = Arc::clone(&storage); + scope.spawn(move || { + for i in 401..=400 + inserted { + let request = format!( + r#"{{"method":"insert","database":"{FIXTURE_DATABASE}","table":"wide","row":{{"id":{i},"name":"row-{i:04}"}}}}"# + ); + let reply = storage.request_line(&request); + let value: serde_json::Value = serde_json::from_str(&reply).expect("json"); + assert_eq!(value["status"], "ok", "{reply}"); + } + }) + }; + let readers: Vec<_> = (0..3) + .map(|_| { + let storage = Arc::clone(&storage); + scope.spawn(move || { + let mut seen = Vec::new(); + for _ in 0..8 { + let mut total = 0usize; + for shard in 0..shards { + let request = format!( + r#"{{"method":"scan_shard","database":"{FIXTURE_DATABASE}","table":"wide","shard":{shard},"shards":{shards}}}"# + ); + let reply = storage.request_line(&request); + let value: serde_json::Value = serde_json::from_str(&reply).expect("json"); + assert_eq!(value["status"], "rows", "{reply}"); + total += value["rows"].as_array().expect("rows").len(); + } + seen.push(total); + } + seen + }) + }) + .collect(); + for reader in readers { + let seen: Vec = reader.join().expect("reader thread"); + assert!( + seen.iter().all(|n| (400..=400 + inserted).contains(n)), + "分片读看到越界行数: {seen:?}" + ); + assert!( + seen.windows(2).all(|pair| pair[0] <= pair[1]), + "并发写时快照行数倒退: {seen:?}" + ); + } + writer.join().expect("writer thread"); + }); + + let whole: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"wide"}"#))?; + assert_eq!(whole["rows"].as_array().expect("rows").len(), 400 + inserted); + Ok(()) +} + /// 删列不改堆字节,重启后不再暴露该列 #[test] fn drop_column_keeps_heap_bytes_and_hides_values_after_restart() -> Result<(), Box> { @@ -240,7 +424,7 @@ fn startup_compaction_reclaims_dropped_columns() -> Result<(), Box Result<(), Box> { let (_srv, data) = start_server(); let mut c = connect()?; - for database in ["", "../escape", "a/b", "a.b", "CON", "__chusql_users"] { + for database in ["", "../escape", "a/b", "a.b", "CON", "__system_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}"); } @@ -270,7 +454,7 @@ fn system_database_owns_accounts_and_nothing_is_default() -> Result<(), Box (ServerProc, tempfile::TempDir) { (server, data) } -/// 在指定数据目录起存储并建测试库 +/// 在指定数据目录起存储、引导系统目录并建测试库 fn start_server_in(data: &std::path::Path) -> ServerProc { open_storage(&write_config(data)); + bootstrap_system(); create_fixture_database(); ServerProc } @@ -371,7 +556,7 @@ fn named_database_survives_restart_and_accounts_stay_global() -> Result<(), Box< 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"}"#))?; assert_eq!(accounts["status"], "accounts"); - let hidden: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"sales.__chusql_users"}"#))?; + let hidden: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"sales.__system_users"}"#))?; assert_eq!(hidden["status"], "error"); Ok(()) } @@ -404,6 +589,15 @@ fn create_fixture_database() { } } +/// 引导系统目录:建账号表,不塞账号 +fn bootstrap_system() { + let reply = CURRENT.with(|slot| { + let storage = slot.borrow().as_ref().cloned().expect("storage opened"); + storage.request_line(r#"{"method":"bootstrap_system"}"#) + }); + assert!(reply.contains(r#""status":"system""#), "{reply}"); +} + /// 发一行请求读一行响应(没写库名就补测试库) fn send(c: &mut Conn, line: &str) -> String { send_raw(c, &with_default_database(line)) @@ -437,7 +631,7 @@ fn reserved_tables_reject_every_generic_operation() -> std::io::Result<()> { 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"] { - let request = serde_json::json!({"method": method, "table": "__chusql_users", + let request = serde_json::json!({"method": method, "table": "__system_users", "column": "id", "key": 1, "keys": [], "row": {"id": 1}, "rows": [], "columns": []}); let result = send(&mut c, &request.to_string()); assert!(result.contains("reserved system table"), "{method}: {result}"); @@ -450,11 +644,11 @@ fn reserved_tables_reject_every_generic_operation() -> std::io::Result<()> { fn generic_ipc_rejects_path_aliases() -> std::io::Result<()> { let (_srv, _data) = start_server(); let mut c = connect()?; - for table in ["../__chusql_users", "__CHUSQL_USERS", "__chusql_users."] { + for table in ["../__system_users", "__SYSTEM_USERS", "__system_users."] { let result = send(&mut c, &serde_json::json!({"method":"scan", "table":table}).to_string()); assert!(result.contains("error"), "{result}"); } - let result = send(&mut c, r#"{"method":"create_index","table":"business","column":"../__chusql_users"}"#); + let result = send(&mut c, r#"{"method":"create_index","table":"business","column":"../__system_users"}"#); assert!(result.contains("invalid column name"), "{result}"); Ok(()) } @@ -484,7 +678,7 @@ fn account_create_reset_drop_and_hidden_from_ordinary_api() -> Result<(), Box Result<(), Box std::io::Result { open_storage(&write_config(data)); + bootstrap_system(); create_fixture_database(); Ok(ServerProc) } @@ -514,8 +709,8 @@ fn account_snapshot_replays_twice_without_duplicating_accounts() -> Result<(), B wal.truncate()?; wal.append(&WalOp::Accounts { accounts: accounts.clone() })?; 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")?; + std::fs::write(data.path().join("system/__system_users.idx"), b"torn index")?; + std::fs::write(data.path().join("system/__system_users.db"), b"torn heap")?; let restarted = restart_at(data.path())?; let mut connection = connect()?; let actual: serde_json::Value = serde_json::from_str(&send(&mut connection, r#"{"method":"accounts_list"}"#))?; @@ -555,12 +750,13 @@ fn account_failure_preserves_wal_and_blocks_writes() -> Result<(), Box std::io::Result<()> { - let (_server, data) = start_server(); - std::fs::write(data.path().join("system/__chusql_users.db"), b"existing")?; + let data = tempfile::tempdir()?; + open_storage(&write_config(data.path())); + std::fs::write(data.path().join("system/__system_users.db"), b"existing")?; 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"); + assert_eq!(std::fs::read(data.path().join("system/__system_users.db"))?, b"existing"); Ok(()) } @@ -578,21 +774,98 @@ fn oversized_account_hash_is_rejected_before_wal() -> Result<(), Box std::io::Result<()> { + let (_server, _data) = start_server(); + let mut c = connect()?; + let created: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"account_create","user":"root","password_hash":""}"#))?; + assert_eq!(created["accounts"][0]["password_hash"], serde_json::json!("")); + let listed = send(&mut c, r#"{"method":"accounts_list"}"#); + assert!(listed.contains("root"), "{listed}"); + Ok(()) +} + /// 字典里已有同名普通表时拒绝建账号 #[test] fn account_create_rejects_existing_ordinary_catalog_entry() -> std::io::Result<()> { let data = tempfile::tempdir()?; let mut catalog = chusql_core_storage::catalog::Catalog::default(); - catalog.create_table("__chusql_users", Vec::new())?; + catalog.create_table("__system_users", Vec::new())?; std::fs::create_dir(data.path().join("system"))?; catalog.save(data.path().join("system/catalog.json"))?; - let _server = restart_at(data.path())?; + open_storage(&write_config(data.path())); let mut c = connect()?; let result = send(&mut c, r#"{"method":"account_create","user":"alice","password_hash":"hash-one"}"#); assert!(result.contains("collision"), "{result}"); Ok(()) } +/// 没引导过就不能动账号 +#[test] +fn account_requests_require_bootstrap() -> std::io::Result<()> { + let data = tempfile::tempdir()?; + open_storage(&write_config(data.path())); + let mut c = connect()?; + let status = send(&mut c, r#"{"method":"system_status"}"#); + assert!(status.contains(r#""initialized":false"#), "{status}"); + for request in [r#"{"method":"accounts_list"}"#, + r#"{"method":"account_create","user":"alice","password_hash":"hash-one"}"#] { + let result = send(&mut c, request); + assert!(result.contains("csql-bootstrap"), "{request}: {result}"); + } + Ok(()) +} + +/// 引导幂等:再跑一次不改已有管理员的口令 +#[test] +fn bootstrap_is_idempotent_and_keeps_the_password() -> std::io::Result<()> { + let data = tempfile::tempdir()?; + open_storage(&write_config(data.path())); + let mut c = connect()?; + let created = send(&mut c, r#"{"method":"bootstrap_system","user":"root","password_hash":"hash-one"}"#); + assert!(created.contains(r#""initialized":true"#), "{created}"); + let again = send(&mut c, r#"{"method":"bootstrap_system","user":"root","password_hash":"hash-two"}"#); + assert!(again.contains(r#""initialized":true"#), "{again}"); + let listed = send(&mut c, r#"{"method":"accounts_list"}"#); + assert!(listed.contains("hash-one"), "{listed}"); + assert!(!listed.contains("hash-two"), "{listed}"); + assert_eq!(std::fs::metadata(data.path().join("system/wal.log"))?.len(), 0); + Ok(()) +} + +/// 引导程序不给已经播过种的表塞新账号 +#[test] +fn bootstrap_does_not_add_an_account_to_a_seeded_table() -> std::io::Result<()> { + let data = tempfile::tempdir()?; + open_storage(&write_config(data.path())); + let mut c = connect()?; + send(&mut c, r#"{"method":"bootstrap_system","user":"root","password_hash":"hash-one"}"#); + let sneaky = send(&mut c, r#"{"method":"bootstrap_system","user":"eve","password_hash":"raw-hash"}"#); + assert!(sneaky.contains(r#""initialized":true"#), "{sneaky}"); + let listed = send(&mut c, r#"{"method":"accounts_list"}"#); + assert!(!listed.contains("eve"), "{listed}"); + assert!(listed.contains("hash-one"), "{listed}"); + Ok(()) +} + +/// 空表还能被重新播种:先只建表,再补管理员 +#[test] +fn bootstrap_seeds_an_empty_account_table() -> std::io::Result<()> { + let data = tempfile::tempdir()?; + open_storage(&write_config(data.path())); + let mut c = connect()?; + let bare = send(&mut c, r#"{"method":"bootstrap_system"}"#); + assert!(bare.contains(r#""initialized":true"#), "{bare}"); + let empty = send(&mut c, r#"{"method":"accounts_list"}"#); + assert!(empty.contains(r#""accounts":[]"#), "{empty}"); + let seeded = send(&mut c, r#"{"method":"bootstrap_system","user":"root","password_hash":"hash-again"}"#); + assert!(seeded.contains(r#""initialized":true"#), "{seeded}"); + let listed = send(&mut c, r#"{"method":"accounts_list"}"#); + assert!(listed.contains("hash-again"), "{listed}"); + Ok(()) +} + /// 列出已建的表 #[test] fn list_tables_returns_created_tables() { @@ -663,6 +936,38 @@ fn duplicate_id_is_rejected() { assert!(r.contains("duplicate value on the id index"), "got: {}", r); } +/// 整值浮点与整数是同一个索引键 +#[test] +fn integral_float_uses_the_same_index_key() -> Result<(), Box> { + let (_srv, _data) = start_server(); + let mut c = connect()?; + request_ok(&mut c, serde_json::json!({"method":"create_table","table":"float_id","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?; + request_ok(&mut c, serde_json::json!({"method":"insert","table":"float_id","row":{"id":7,"name":"A"}}))?; + + let found: serde_json::Value = serde_json::from_str(&send( + &mut c, + r#"{"method":"lookup_by_index","table":"float_id","key":7.0}"#, + ))?; + assert_eq!( + found["rows"], + serde_json::json!([{"id":7,"name":"A"}]), + "lookup by 7.0: {}", + found + ); + + let dup: serde_json::Value = serde_json::from_str(&send( + &mut c, + r#"{"method":"insert","table":"float_id","row":{"id":7.0,"name":"B"}}"#, + ))?; + assert_eq!(dup["status"], "error", "7.0 must clash with 7: {}", dup); + assert!( + dup["message"].as_str().unwrap_or("").contains("duplicate value on the id index"), + "got: {}", + dup + ); + Ok(()) +} + /// 批量插入一次全进 #[test] fn insert_batch_writes_all_rows() { @@ -878,6 +1183,7 @@ fn config_file_is_used() { std::fs::write(&config_path, text).unwrap(); open_storage(&config_path); + bootstrap_system(); create_fixture_database(); let mut c = connect().unwrap(); @@ -1016,7 +1322,7 @@ fn account_table_uses_typed_columns_and_stamps_login() -> Result<(), Box = columns.iter().map(|col| col["name"].as_str().unwrap_or("")).collect(); assert_eq!(names, vec!["id", "user", "password_hash", "registered_at", "last_login_at", "revision"]); diff --git a/chusql-interface/src/ChuSQL/Interface/AccountTable.hs b/chusql-interface/src/ChuSQL/Interface/AccountTable.hs index 97f7d1d..a668cb3 100644 --- a/chusql-interface/src/ChuSQL/Interface/AccountTable.hs +++ b/chusql-interface/src/ChuSQL/Interface/AccountTable.hs @@ -12,11 +12,11 @@ import ChuSQL.Core.Protocol (SchemaColumn (..), TableInfo (..)) import Data.Text (Text) import qualified Data.Text as T --- 账号表(系统表 __chusql_users)的结构定义,SQL 会话与 Web 管理端共用。 +-- 账号表(系统表 __system_users)的结构定义,SQL 会话与 Web 管理端共用。 -- | 账号表的名字:网页里像普通表一样浏览与编辑,但写入走账号命令 accountTableName :: String -accountTableName = "__chusql_users" +accountTableName = "__system_users" -- | 这张表是不是账号表 isAccountTable :: Text -> Bool diff --git a/chusql-interface/src/ChuSQL/Interface/Config.hs b/chusql-interface/src/ChuSQL/Interface/Config.hs index 8d1bf76..64f2128 100644 --- a/chusql-interface/src/ChuSQL/Interface/Config.hs +++ b/chusql-interface/src/ChuSQL/Interface/Config.hs @@ -4,21 +4,17 @@ module ChuSQL.Interface.Config ( WebConfig (..), defaultWebConfig, defaultUser, - defaultPassword, - usingDefaultCredentials, loadWebConfigAt, - resolveCredential, + legacyPasswordKey, resolveStaticDir, staticDirCandidates, rootUserName, canonicalSettingKeys, - resolvePlainPassword, ServerConfig (..), defaultServerConfig, loadServerConfigAt, ) where -import ChuSQL.Interface.Auth (Credential (..), hashPassword) import ChuSQL.Interface.TOML (readSection) import Data.Char (toLower) import qualified Data.Map.Strict as Map @@ -34,10 +30,6 @@ import Text.Read (readMaybe) defaultUser :: Text defaultUser = "root" --- | 默认口令(只为方便本地测试;生产/对外必须覆盖) -defaultPassword :: Text -defaultPassword = "chusql" - -- | Web 管理端配置 data WebConfig = WebConfig { wcHost :: String @@ -106,26 +98,16 @@ keyAliases = , ("password_classes", "password-classes") ] --- | 这份配置用的还是内置默认口令吗 -usingDefaultCredentials :: Map.Map Text Text -> Bool -usingDefaultCredentials saved = Map.notMember "password" saved +-- | 配置文件的 [web] 分节里是否还留着明文口令键 +legacyPasswordKey :: FilePath -> IO Bool +legacyPasswordKey path = Map.member "password" <$> readSection path "web" -- | 设置文件里某个键的非空值 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 凭据:明文就哈希,留空免密,缺省用演示口令 -resolveCredential :: WebConfig -> Map.Map Text Text -> IO Credential -resolveCredential cfg saved = do - encoded <- case Map.lookup "password" saved of - Just plain | not (T.null (T.strip plain)) -> hashPassword (T.strip plain) - Just _ -> pure "" - Nothing -> hashPassword defaultPassword - pure (Credential (rootUserName cfg saved) encoded) - -- | 管理员名字:命令行 > 设置文件 > 内置默认 rootUserName :: WebConfig -> Map.Map Text Text -> Text rootUserName cfg saved @@ -144,12 +126,6 @@ withStorage :: Map.Map Text Text -> WebConfig -> WebConfig withStorage storage cfg = cfg{wcDataDir = T.unpack <$> nonEmptyValue "data_dir" storage} --- | 管理员明文口令,没配回落到演示口令,显式留空回空串 -resolvePlainPassword :: Map.Map Text Text -> Text -resolvePlainPassword saved = case Map.lookup "password" saved of - Just plain -> T.strip plain - Nothing -> defaultPassword - -- | [web] 分区里的启动参数,缺失或坏值一律回到内置默认 webConfigFromSection :: Map.Map Text Text -> WebConfig webConfigFromSection saved = diff --git a/chusql-interface/src/ChuSQL/Interface/Settings.hs b/chusql-interface/src/ChuSQL/Interface/Settings.hs index 21b3b93..6e02d72 100644 --- a/chusql-interface/src/ChuSQL/Interface/Settings.hs +++ b/chusql-interface/src/ChuSQL/Interface/Settings.hs @@ -55,7 +55,6 @@ settingCatalogue = , item "max-rows" "Rows per query" "limits" "int" "1000" False False , item "max-sql-length" "Max SQL characters" "limits" "int" "20000" False False , item "user" "管理员账号(设置文件)" "auth" "text" "root" True True - , item "password" "管理员口令(设置文件,明文)" "auth" "secret" "" True True , 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" @@ -117,7 +116,7 @@ isRootOnly key = maybe False siRootOnly (findItem key) -- | 网页端不能改的键 lockedKeys :: [Text] -lockedKeys = ["user", "password"] +lockedKeys = ["user"] -- | 这项在界面上是不是只读 isLockedSetting :: Text -> Bool diff --git a/chusql-server/app/Main.hs b/chusql-server/app/Main.hs index 6417984..467422a 100644 --- a/chusql-server/app/Main.hs +++ b/chusql-server/app/Main.hs @@ -4,18 +4,17 @@ 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, + legacyPasswordKey, loadWebConfigAt, - resolveCredential, - usingDefaultCredentials, + rootUserName, ) import ChuSQL.Interface.RateLimit (newRateLimiter) import ChuSQL.Interface.Settings (readSettingsFile) import ChuSQL.Interface.TOML (resolveConfigPath) +import ChuSQL.Server.Accounts (administratorPasswordless) import ChuSQL.Server.Backend (Backend (..), ipcBackend) import ChuSQL.Server.TCP ( ServerConfig (..), @@ -25,10 +24,12 @@ import ChuSQL.Server.TCP ( runServer, ) import Control.Exception (IOException, bracket, try) -import qualified Data.Map.Strict as Map +import qualified Data.Aeson as A +import qualified Data.Aeson.KeyMap as KM import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) +import GHC.Conc (getNumProcessors, setNumCapabilities) import System.Environment (getArgs) import System.Exit (exitFailure) import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout) @@ -88,7 +89,7 @@ usage = do 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 " [web] user (administrator name; the password lives in the system table)" putStrLn "" putStrLn " --config FILE read that config file instead" putStrLn " --host H listen address ([server] host, default 127.0.0.1)" @@ -103,9 +104,11 @@ usage = do 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) + putStrLn "administrator password: lives in the __system_users system table, never in chusql.toml" + putStrLn (" the [web] user key only picks the administrator name (default " ++ T.unpack defaultUser ++ ")") + putStrLn "" + putStrLn "first run: the installer calls csql-bootstrap, which creates the system catalog" + putStrLn " {\"method\":\"system_status\"} tells whether that happened; without it the server stops" -- | 命令行覆盖管理员 applyWebOptions :: WebConfig -> Options -> WebConfig @@ -129,9 +132,11 @@ orElse :: Maybe a -> a -> a orElse (Just x) _ = x orElse Nothing y = y --- | 入口 +-- | 入口:开够能力数,分片扫描才真并行 main :: IO () main = do + caps <- getNumProcessors + setNumCapabilities (max 1 (min 8 caps)) hSetBuffering stdout LineBuffering args <- getArgs case parseArgs args of @@ -150,7 +155,8 @@ run opts = do base <- loadWebConfigAt configPath let cfg = applyWebOptions base opts saved <- readSettingsFile configPath - cred <- resolveCredential cfg saved + legacy <- legacyPasswordKey configPath + let rootName = rootUserName cfg saved config <- applyServerOptions <$> loadServerConfigAt configPath <*> pure opts opened <- localStorageLink (Just configPath) case opened of @@ -162,13 +168,14 @@ run opts = do backend <- ipcBackend printBanner cfg config configPath checkStorage backend - reportCredential cred saved + checkInitialized backend + reportCredential backend rootName legacy limiter <- newRateLimiter getCurrentTime (wcLoginMaxAttempts cfg) (fromIntegral (wcLoginWindow cfg)) - env <- newServerEnv backend cred configPath config limiter + env <- newServerEnv backend rootName configPath config limiter let announce port = putStrLn ("listening: tcp://" ++ scHost config ++ ":" ++ show port) bracket (pure link) (const closeConnection) (const (serve env announce)) @@ -183,18 +190,37 @@ serve env announce = do 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)") +-- | 系统目录没引导过就不许起服务 +checkInitialized :: Backend -> IO () +checkInitialized backend = do + status <- beStorage backend (A.object ["method" A..= ("system_status" :: Text)]) + case status of + Right value + | statusInitialized value -> putStrLn "system: ready (the catalog is initialized)" + _ -> do + putStrLn "!! the system catalog is not initialized; run the bootstrap program first:" + putStrLn "!! csql-bootstrap --config --password-stdin" + exitFailure + where + -- | 应答里的 initialized 是不是 true + statusInitialized (A.Object fields) = KM.lookup "initialized" fields == Just (A.Bool True) + statusInitialized _ = False + +-- | 报告管理员账号状态:配置里还留着明文口令、或还没设口令都提醒 +reportCredential :: Backend -> Text -> Bool -> IO () +reportCredential backend rootName legacy = do + putStrLn ("administrator: " ++ T.unpack rootName) + if legacy + then do + putStrLn " !! the [web] section still carries a plaintext password key; it is ignored now" + putStrLn " !! remove it: the administrator password lives in the __system_users system table" + else pure () + passwordless <- administratorPasswordless backend rootName + if passwordless + then do + putStrLn " !! the administrator has no password yet: sign in with an empty password, then set one" + putStrLn " !! ALTER USER root IDENTIFIED BY '...' (or use the account page in the Web UI)" + else pure () -- | 探测存储是否可用,答不上 ping 就退出 checkStorage :: Backend -> IO () diff --git a/chusql-server/chusql-server.cabal b/chusql-server/chusql-server.cabal index 36c9a3a..d804d62 100644 --- a/chusql-server/chusql-server.cabal +++ b/chusql-server/chusql-server.cabal @@ -13,6 +13,7 @@ library hs-source-dirs: src exposed-modules: ChuSQL.Server.Accounts ChuSQL.Server.Backend + ChuSQL.Server.Catalog ChuSQL.Server.Policy ChuSQL.Server.Privileges ChuSQL.Server.Session @@ -40,6 +41,7 @@ executable chusql-server main-is: Main.hs hs-source-dirs: app build-depends: base + , aeson , chusql-core-engine , chusql-core-model , chusql-interface diff --git a/chusql-server/src/ChuSQL/Server/Accounts.hs b/chusql-server/src/ChuSQL/Server/Accounts.hs index 3b14bd7..b8cfb56 100644 --- a/chusql-server/src/ChuSQL/Server/Accounts.hs +++ b/chusql-server/src/ChuSQL/Server/Accounts.hs @@ -3,11 +3,12 @@ module ChuSQL.Server.Accounts ( Accounts, AccountError (..), Principal (..), PasswordPolicy (..), defaultPasswordPolicy, newAccounts, accountsPolicy, setAccountsPolicy, passwordAllowed, - rootUserName, principalName, principalIsRoot, + ensureRootAccount, administratorPasswordless, rootUserName, principalName, principalIsRoot, authenticate, currentPrincipal, listAccounts, findAccount, AccountCommand (..), accountCommand, runAccountCommand, ) where +import ChuSQL.Core.Engine.Error (accountErrorCode) import ChuSQL.Core.Engine.Storage.IPC (Account (..), Request (..)) import ChuSQL.Core.Engine.Syntax.AST (Statement (..)) import ChuSQL.Interface.Auth @@ -19,11 +20,11 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Text (Text) import qualified Data.Text as T --- 账号服务:root 来自配置,普通账号由 root 用 CREATE/ALTER/DROP USER 管理,口令在此校验并派生哈希。 +-- 账号服务:管理员是系统表里名字固定的那一行,口令哈希存在表里,普通账号由管理员用 CREATE/ALTER/DROP USER 管理。 data AccountError = AccountError Text Text deriving (Show, Eq) --- | 当前身份:配置里的管理员,或系统表里的一个普通账号 +-- | 当前身份:名字固定的管理员,或系统表里的一个普通账号 data Principal = Root Text | Ordinary Account @@ -39,7 +40,7 @@ principalName :: Principal -> Text principalName (Root name) = name principalName (Ordinary a) = accountUser a --- | 是不是配置里的管理员 +-- | 是不是名字固定的管理员 principalIsRoot :: Principal -> Bool principalIsRoot (Root _) = True principalIsRoot (Ordinary _) = False @@ -49,23 +50,23 @@ data Accounts = Accounts , acSessions :: SessionStore , acLock :: MVar () , acPolicy :: IORef PasswordPolicy - , acRoot :: Credential + , acRootName :: Text } --- | 建账号服务,记录配置根账号 -newAccounts :: Backend -> SessionStore -> Credential -> IO Accounts -newAccounts backend sessions credential = do +-- | 建账号服务,记下管理员名字 +newAccounts :: Backend -> SessionStore -> Text -> IO Accounts +newAccounts backend sessions name = do lock <- newMVar () policy <- newIORef defaultPasswordPolicy - pure (Accounts backend sessions lock policy credential) + pure (Accounts backend sessions lock policy (normalize name)) -- | 账号名统一小写去空白 normalize :: Text -> Text normalize = T.toLower . T.strip --- | 配置里的管理员叫什么 +-- | 管理员叫什么 rootName :: Accounts -> Text -rootName = normalize . credUser . acRoot +rootName = acRootName -- | 管理员名字(界面显示用) rootUserName :: Accounts -> Text @@ -123,16 +124,42 @@ storageFailure = AccountError "storage_error" "account storage unavailable" unauthorized :: AccountError unauthorized = AccountError "unauthorized" "invalid account or session" --- | 存储侧报错翻成账号错误 +-- | 存储侧报错翻成账号错误,码统一由引擎错误表给出 storageResult :: Either String [Account] -> Either AccountError () storageResult (Right _) = Right () -storageResult (Left "account already exists") = Left (AccountError "conflict" "account already exists") -storageResult (Left "unknown account") = Left (AccountError "not_found" "unknown account") -storageResult (Left _) = Left storageFailure +storageResult (Left message) = Left (AccountError code text) + where + -- | 认得的码原样用,其余存储细节不外泄 + code = T.pack (accountErrorCode message) + text = if code == failureCode then failureText else T.pack message + AccountError failureCode failureText = storageFailure --- | 读系统表里的普通账号 -readAccounts :: Accounts -> IO (Either AccountError [Account]) -readAccounts service = fmap (either (const (Left storageFailure)) Right) (beAccounts (acBackend service) ReqAccountsList) +-- | 读系统表里的账号 +readAccounts :: Backend -> IO (Either AccountError [Account]) +readAccounts backend = fmap (either (const (Left storageFailure)) Right) (beAccounts backend ReqAccountsList) + +-- | 表里没有管理员那一行就补一行空哈希,表示还没设口令 +ensureRootAccount :: Backend -> Text -> IO (Either AccountError ()) +ensureRootAccount backend name = do + stored <- readAccounts backend + case stored of + Left err -> pure (Left err) + Right accounts + | any ((== normalize name) . accountUser) accounts -> pure (Right ()) + | otherwise -> do + created <- beAccounts backend (ReqAccountCreate (normalize name) "") + pure $ case created of + Right _ -> Right () + Left "account already exists" -> Right () + Left _ -> Left storageFailure + +-- | 管理员是不是还没设口令 +administratorPasswordless :: Backend -> Text -> IO Bool +administratorPasswordless backend name = do + stored <- readAccounts backend + pure $ case stored of + Right accounts -> any (\a -> accountUser a == normalize name && T.null (accountHash a)) accounts + Left _ -> False -- | 按令牌解析当前身份,版本对不上即失效 currentUnlocked :: Accounts -> Text -> IO (Either AccountError Principal) @@ -140,66 +167,63 @@ currentUnlocked service token = do session <- lookupVersionedSession (acSessions service) token case session of Nothing -> pure (Left unauthorized) - Just (user, revision) - | user == rootName service && revision == Nothing -> pure (Right (Root (rootName service))) - | otherwise -> do - stored <- readAccounts service - pure $ do - accounts <- stored - account <- case filter ((== user) . accountUser) accounts of - [a] -> Right a - _ -> Left unauthorized - if revision == Just (accountRevision account) - then Right (Ordinary account) - else Left unauthorized + Just (user, revision) -> do + stored <- readAccounts (acBackend service) + pure $ do + accounts <- stored + account <- case filter ((== user) . accountUser) accounts of + [a] -> Right a + _ -> Left unauthorized + if revision == Just (accountRevision account) + then Right (if user == rootName service then Root user else Ordinary account) + else Left unauthorized -- | 加锁解析当前身份 currentPrincipal :: Accounts -> Text -> IO (Either AccountError Principal) currentPrincipal service token = withMVar (acLock service) $ \_ -> currentUnlocked service token --- | 登录:先比 root,再查普通账号;空口令即免密 +-- | 登录:比哈希,管理员未设口令时只收空口令 authenticate :: Accounts -> Text -> Text -> IO (Either AccountError Text) -authenticate service user password = withMVar (acLock service) $ \_ -> - if normalize user == rootName service - then signInRoot - else - if passwordless - then pure (Left (AccountError "forbidden" "this server only accepts the administrator")) - else signInOrdinary +authenticate service user password = withMVar (acLock service) $ \_ -> do + stored <- readAccounts (acBackend service) + case stored of + Left err -> pure (Left err) + Right accounts + | name == rootName service -> signInRoot accounts + | unset accounts -> pure (Left ordinaryRefused) + | otherwise -> signInOrdinary accounts where - -- | 配置里没有口令 - passwordless = T.null (credEncoded (acRoot service)) + name = normalize user + ordinaryRefused = AccountError "forbidden" "this server only accepts the administrator" + -- | 管理员那一行还没设口令(或压根不在表里) + unset accounts = case filter ((== rootName service) . accountUser) accounts of + [a] -> T.null (accountHash a) + _ -> True -- | 管理员登录 - signInRoot - | passwordless = - if T.null password - then Right <$> createVersionedSession (acSessions service) (rootName service) Nothing - else pure (Left unauthorized) - | verifyPassword (credEncoded (acRoot service)) password = - Right <$> createVersionedSession (acSessions service) (rootName service) Nothing - | otherwise = pure (Left unauthorized) + signInRoot accounts = case filter ((== rootName service) . accountUser) accounts of + [a] | T.null (accountHash a) && T.null password -> issue a + [a] | not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a + _ -> pure (Left unauthorized) -- | 普通账号登录 - signInOrdinary = do - stored <- readAccounts service - case stored of - Left err -> pure (Left err) - Right accounts -> case filter ((== normalize user) . accountUser) accounts of - [a] | verifyPassword (accountHash a) password -> do - stamp <- currentStamp - written <- beAccounts (acBackend service) (ReqAccountLogin (accountUser a) (Just stamp)) - case written of - Left _ -> pure (Left storageFailure) - Right _ -> Right <$> createVersionedSession (acSessions service) (accountUser a) (Just (accountRevision a)) - _ -> pure (Left unauthorized) + signInOrdinary accounts = case filter ((== name) . accountUser) accounts of + [a] | not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a + _ -> pure (Left unauthorized) + -- | 记一次登录再发会话 + issue a = do + stamp <- currentStamp + written <- beAccounts (acBackend service) (ReqAccountLogin (accountUser a) (Just stamp)) + case written of + Left _ -> pure (Left storageFailure) + Right _ -> Right <$> createVersionedSession (acSessions service) (accountUser a) (Just (accountRevision a)) --- | 系统表里的普通账号清单(root 专用) +-- | 系统表里的账号清单(含管理员) listAccounts :: Accounts -> IO (Either AccountError [Account]) -listAccounts service = withMVar (acLock service) $ \_ -> readAccounts service +listAccounts service = withMVar (acLock service) $ \_ -> readAccounts (acBackend service) --- | 按用户名找一个普通账号 +-- | 按用户名找一个账号 findAccount :: Accounts -> Text -> IO (Either AccountError Account) findAccount service name = withMVar (acLock service) $ \_ -> do - stored <- readAccounts service + stored <- readAccounts (acBackend service) pure $ do accounts <- stored case filter ((== normalize name) . accountUser) accounts of @@ -217,22 +241,26 @@ 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 - case validateNewName service name >> passwordAllowed policy password of + let admin = normalize name == rootName service + checked = if admin then validateUserName name else validateNewName service name >> passwordAllowed policy password + case checked of Left err -> pure (Left err) Right () -> do - encoded <- hashPassword password + encoded <- if admin && T.null password then pure "" else hashPassword password storageResult <$> beAccounts (acBackend service) (ReqAccountReset (normalize name) encoded) -- | 删一个普通账号 dropUser :: Accounts -> Text -> IO (Either AccountError ()) dropUser service name = withMVar (acLock service) $ \_ -> - case validateUserName name of - Left err -> pure (Left err) - Right () -> storageResult <$> beAccounts (acBackend service) (ReqAccountDrop (normalize name)) + if normalize name == rootName service + then pure (Left (AccountError "bad_request" "the administrator cannot be dropped")) + else case validateUserName name of + Left err -> pure (Left err) + Right () -> storageResult <$> beAccounts (acBackend service) (ReqAccountDrop (normalize name)) -- | 账号管理命令:SQL 语句与一键接口在这上面汇合 data AccountCommand diff --git a/chusql-server/src/ChuSQL/Server/Backend.hs b/chusql-server/src/ChuSQL/Server/Backend.hs index a985bd1..728a8c4 100644 --- a/chusql-server/src/ChuSQL/Server/Backend.hs +++ b/chusql-server/src/ChuSQL/Server/Backend.hs @@ -158,7 +158,7 @@ memoryBackendWith trusted name ref = modifyMVar ref $ \db -> case memoryAccounts db stamp req of Left err -> pure (db, Left err) Right accounts -> pure ((usersTable, Table usersTable [("account", TStr)] - [[("account", VStr (BL.unpack (A.encode a))) ] | a <- accounts]) : filter ((/= usersTable) . fst) db, Right accounts) + [[("account", VStr (BL.unpack (A.encode a))) ] | a <- accounts] Nothing) : filter ((/= usersTable) . fst) db, Right accounts) , beWithDatabase = withDatabase , beDatabases = pure (Right (nub [name, systemDatabaseName])) , beStorage = \_ -> pure (Left "storage is not available in this backend") @@ -367,7 +367,7 @@ systemDatabaseName :: String systemDatabaseName = "system" usersTable :: String -usersTable = "__chusql_users" +usersTable = "__system_users" -- | 角色与授权表的名字,不带内部前缀 rolesTable :: String @@ -384,7 +384,7 @@ internalNames = [rolesTable, grantsTable, membersTable] -- | 名字是否带内部表前缀 reserved :: String -> Bool -reserved = T.isPrefixOf "__chusql_" . T.toLower . T.pack +reserved = T.isPrefixOf "__system_" . T.toLower . T.pack -- | 是不是服务自己的内部表 internalTable :: String -> Bool diff --git a/chusql-server/src/ChuSQL/Server/Catalog.hs b/chusql-server/src/ChuSQL/Server/Catalog.hs new file mode 100644 index 0000000..3850146 --- /dev/null +++ b/chusql-server/src/ChuSQL/Server/Catalog.hs @@ -0,0 +1,189 @@ +module ChuSQL.Server.Catalog + ( Catalog + , newCatalog + , normalizeRole + , normalizeUser + , normalizeObject + , withCatalog + , withCatalogLock + , ensureCatalog + , eachAction + , readRoleNames + , insertRole + , dropRole + , readGrants + , addGrant + , removeGrant + , readMembers + , addMember + , removeMember + ) where + +import ChuSQL.Core.Model (Row, Value (..)) +import ChuSQL.Interface.Actions (sqlLiteral) +import ChuSQL.Interface.Protocol (Grant (..)) +import ChuSQL.Server.Backend (Backend (..), StatementResult (..), grantsTable, membersTable, rolesTable) +import Control.Concurrent.MVar (MVar, newMVar, withMVar) +import Data.List (intercalate, isInfixOf) +import Data.Text (Text) +import qualified Data.Text as T + +-- 内部目录(系统表)的唯一访问入口,调用方不拼 SQL + +-- | 三张系统表的读写都在这里,外面只认下面这些操作 +data Catalog = Catalog + { catBackend :: Backend + , catLock :: MVar () + } + +-- | 建一个目录句柄 +newCatalog :: Backend -> IO Catalog +newCatalog backend = Catalog backend <$> newMVar () + +-- | 角色名统一小写去空白 +normalizeRole :: Text -> Text +normalizeRole = T.toLower . T.strip + +-- | 用户名统一小写去空白 +normalizeUser :: Text -> Text +normalizeUser = T.toLower . T.strip + +-- | 授权对象落库口径:`*` 原样,裸表名按当前库补全 +normalizeObject :: Text -> Text -> Text +normalizeObject database object + | T.strip object == T.pack "*" = T.pack "*" + | T.any (== '.') object = T.toLower (T.strip object) + | otherwise = normalizeUser database <> T.pack "." <> normalizeUser object + +-- | 加锁跑一段目录动作 +withCatalogLock :: Catalog -> IO a -> IO a +withCatalogLock catalog action = withMVar (catLock catalog) (const action) + +-- | 建表后跑一段目录动作 +withCatalog :: Catalog -> IO (Either String a) -> IO (Either String a) +withCatalog catalog action = withCatalogLock catalog $ do + ready <- ensureCatalog catalog + case ready of + Left err -> pure (Left err) + Right () -> action + +-- | 确保三张系统表存在,已存在算成功 +ensureCatalog :: Catalog -> IO (Either String ()) +ensureCatalog catalog = eachAction tableDefs (createTable catalog) + where + -- | 三张系统表的定义 + tableDefs = + [ (rolesTable, "(name VARCHAR(64))") + , (grantsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))") + , (membersTable, "(role VARCHAR(64), member VARCHAR(64))") + ] + +-- | 建一张系统表,已存在算成功 +createTable :: Catalog -> (String, String) -> IO (Either String ()) +createTable catalog (table, columns) = do + result <- beStatement (catBackend catalog) ("CREATE TABLE " ++ table ++ " " ++ columns) + pure $ case result of + Right _ -> Right () + Left err + | "exists" `isInfixOf` err -> Right () + | otherwise -> Left err + +-- | 跑一条系统表写语句 +exec :: Catalog -> String -> IO (Either String ()) +exec catalog sql = fmap (either Left (const (Right ()))) (beStatement (catBackend catalog) sql) + +-- | 读一张系统表 +readRows :: Catalog -> String -> IO (Either String [Row]) +readRows catalog table = fmap (fmap srRows) (beStatement (catBackend catalog) ("SELECT * FROM " ++ table)) + +-- | 角色名清单 +readRoleNames :: Catalog -> IO (Either String [Text]) +readRoleNames catalog = fmap (fmap (map (normalizeRole . cell "name"))) (readRows catalog rolesTable) + +-- | 新建一个角色 +insertRole :: Catalog -> Text -> IO (Either String ()) +insertRole catalog role = exec catalog (insertSql rolesTable ["name"] [normalizeRole role]) + +-- | 删掉一个角色,连同它的授权与成员 +dropRole :: Catalog -> Text -> IO (Either String ()) +dropRole catalog role = do + first <- exec catalog ("DELETE FROM " ++ rolesTable ++ " WHERE name = " ++ roleLiteral role) + second <- exec catalog ("DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role) + third <- exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role) + pure (sequence_ [first, second, third]) + +-- | 全部授权 +readGrants :: Catalog -> IO (Either String [Grant]) +readGrants catalog = fmap (fmap (map grantOf)) (readRows catalog grantsTable) + +-- | 记一条授权,同名的先清掉 +addGrant :: Catalog -> Text -> Text -> Text -> IO (Either String ()) +addGrant catalog role privilege object = do + cleared <- removeGrant catalog role privilege object + case cleared of + Left err -> pure (Left err) + Right () -> exec catalog (insertSql grantsTable ["role", "privilege", "object"] [normalizeRole role, privilege, object]) + +-- | 取消一条授权 +removeGrant :: Catalog -> Text -> Text -> Text -> IO (Either String ()) +removeGrant catalog role privilege object = exec catalog (deleteGrantSql role privilege object) + +-- | 全部成员关系 +readMembers :: Catalog -> IO (Either String [(Text, Text)]) +readMembers catalog = fmap (fmap (map memberOf)) (readRows catalog membersTable) + +-- | 记一条成员关系 +addMember :: Catalog -> Text -> Text -> IO (Either String ()) +addMember catalog role user = exec catalog (insertSql membersTable ["role", "member"] [normalizeRole role, normalizeUser user]) + +-- | 取消一条成员关系 +removeMember :: Catalog -> Text -> Text -> IO (Either String ()) +removeMember catalog role user = + exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role ++ " AND member = " ++ literal (normalizeUser user)) + +-- | 一串动作挨着跑,遇到第一个错误就停 +eachAction :: [a] -> (a -> IO (Either e ())) -> IO (Either e ()) +eachAction [] _ = pure (Right ()) +eachAction (item : rest) action = do + result <- action item + case result of + Left err -> pure (Left err) + Right () -> eachAction rest action + +-- | 行里取一列文本 +cell :: String -> Row -> Text +cell column row = case lookup column row of + Just (VStr value) -> T.pack value + _ -> T.empty + +-- | 一行授权记录 +grantOf :: Row -> Grant +grantOf row = + Grant + { grantRole = normalizeRole (cell "role" row) + , grantPrivilege = T.toLower (T.strip (cell "privilege" row)) + , grantObject = T.toLower (T.strip (cell "object" row)) + } + +-- | 一行成员关系 +memberOf :: Row -> (Text, Text) +memberOf row = (normalizeRole (cell "role" row), normalizeUser (cell "member" row)) + +-- | 拼一条删授权的语句 +deleteGrantSql :: Text -> Text -> Text -> String +deleteGrantSql role privilege object = + "DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role + ++ " AND privilege = " ++ literal privilege ++ " AND object = " ++ literal object + +-- | 拼一条插入语句 +insertSql :: String -> [String] -> [Text] -> String +insertSql table columns values = + "INSERT INTO " ++ table ++ " (" ++ intercalate ", " columns ++ ") VALUES (" ++ intercalate ", " (map literal values) ++ ")" + +-- | 角色名的 SQL 字面量 +roleLiteral :: Text -> String +roleLiteral = literal . normalizeRole + +-- | 文本值的 SQL 字面量 +literal :: Text -> String +literal = sqlLiteral . VStr . T.unpack diff --git a/chusql-server/src/ChuSQL/Server/Privileges.hs b/chusql-server/src/ChuSQL/Server/Privileges.hs index 90bc4e0..1f84ed4 100644 --- a/chusql-server/src/ChuSQL/Server/Privileges.hs +++ b/chusql-server/src/ChuSQL/Server/Privileges.hs @@ -17,23 +17,35 @@ module ChuSQL.Server.Privileges ( runPrivilegeCommand, ) where -import ChuSQL.Core.Model (Row, Value (..)) import ChuSQL.Core.Engine.Syntax.AST import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalName) -import ChuSQL.Interface.Actions (sqlLiteral) import ChuSQL.Interface.Protocol (Grant (..), RoleView (..)) import ChuSQL.Server.Backend ( Backend (..), - StatementResult (..), exprTables, - grantsTable, - membersTable, - rolesTable, systemDatabaseName, tableRefsOf, ) -import Control.Concurrent.MVar (MVar, newMVar, withMVar) -import Data.List (intercalate, isInfixOf, nub, sort) +import ChuSQL.Server.Catalog ( + Catalog, + addGrant, + addMember, + dropRole, + eachAction, + insertRole, + newCatalog, + normalizeObject, + normalizeRole, + normalizeUser, + readGrants, + readMembers, + readRoleNames, + removeGrant, + removeMember, + withCatalogLock, + ensureCatalog, + ) +import Data.List (nub, sort) import Data.Text (Text) import qualified Data.Text as T @@ -63,15 +75,12 @@ data PrivilegeCommand deriving (Show, Eq) data Privileges = Privileges - { pvBackend :: Backend - , pvLock :: MVar () + { pvCatalog :: Catalog } -- | 建权限服务,固定在 system 库上 newPrivileges :: Backend -> IO Privileges -newPrivileges base = do - lock <- newMVar () - pure (Privileges (beWithDatabase base systemDatabaseName) lock) +newPrivileges base = Privileges <$> newCatalog (beWithDatabase base systemDatabaseName) -- | 语句转管理命令,不认的给 Nothing privilegeCommand :: Statement -> Maybe PrivilegeCommand @@ -137,13 +146,6 @@ listRoleViews service = withTables service $ do members <- membersOfRole service role pure (RoleView role <$> grants <*> members) --- | 授权对象落库口径:`*` 原样,裸表名按当前库补全 -normalizeObject :: Text -> Text -> Text -normalizeObject database object - | T.strip object == "*" = "*" - | T.any (== '.') object = T.toLower (T.strip object) - | otherwise = normalizeUser database <> "." <> normalizeUser object - -- | 一条语句需要哪些 (表, 权限) requiredActions :: Statement -> Maybe [(Text, Text)] requiredActions stmt = case stmt of @@ -177,34 +179,29 @@ checkAll database grants needed = case [pair | pair@(table, privilege) <- needed -- | 一个用户实际能用的授权:他所属角色身上的那些 grantsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant]) grantsOfUser service user = do - members <- readRows service membersTable - rows <- readRows service grantsTable + members <- catalog (readMembers (pvCatalog service)) + grants <- catalog (readGrants (pvCatalog service)) pure $ do memberRows <- members - grantRows <- rows - let mine = [normalizeRole (cell "role" row) | row <- memberRows, normalizeUser (cell "member" row) == normalizeUser user] - pure [grantOf row | row <- grantRows, normalizeRole (cell "role" row) `elem` mine] + grantRows <- grants + let mine = [role | (role, member) <- memberRows, member == normalizeUser user] + pure [grant | grant <- grantRows, grantRole grant `elem` mine] -- | 一个角色挂着的授权 roleGrantsOf :: Privileges -> Text -> IO (Either PrivilegeError [Grant]) roleGrantsOf service role = do - rows <- readRows service grantsTable - pure $ fmap (map grantOf . filter (\row -> normalizeRole (cell "role" row) == normalizeRole role)) rows + grants <- catalog (readGrants (pvCatalog service)) + pure (filter (\grant -> grantRole grant == normalizeRole role) <$> grants) -- | 角色名清单(统一小写) roleNames :: Privileges -> IO (Either PrivilegeError [Text]) -roleNames service = do - rows <- readRows service rolesTable - pure (map (normalizeRole . cell "name") <$> rows) +roleNames service = catalog (readRoleNames (pvCatalog service)) -- | 一个角色的成员清单 membersOfRole :: Privileges -> Text -> IO (Either PrivilegeError [Text]) membersOfRole service role = do - rows <- readRows service membersTable - pure $ - fmap - (map (normalizeUser . cell "member") . filter (\row -> normalizeRole (cell "role" row) == normalizeRole role)) - rows + members <- catalog (readMembers (pvCatalog service)) + pure (map snd . filter (\(name, _) -> name == normalizeRole role) <$> members) -- | 角色必须存在,否则命令不落地 requireRole :: Privileges -> Text -> IO (Either PrivilegeError ()) @@ -225,129 +222,55 @@ applyCommand service database command = case command of Left err -> pure (Left err) Right names | normalizeRole role `elem` names -> pure (Left (PrivilegeError "conflict" ("role already exists: " <> role))) - | otherwise -> exec service (insertSql rolesTable ["name"] [normalizeRole role]) + | otherwise -> catalog (insertRole (pvCatalog service) role) DropRoleCommand role -> do allowed <- requireRole service role case allowed of Left err -> pure (Left err) - Right () -> do - first <- exec service ("DELETE FROM " ++ rolesTable ++ " WHERE name = " ++ roleLiteral role) - second <- exec service ("DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role) - third <- exec service ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role) - pure (sequence_ [first, second, third]) + Right () -> catalog (dropRole (pvCatalog service) role) GrantPrivilegesCommand privileges object role -> do allowed <- requireRole service role case allowed of Left err -> pure (Left err) - Right () -> each (expandPrivileges privileges) $ \privilege -> do - let target = normalizeObject database object - cleared <- exec service (deleteGrantSql role privilege target) - case cleared of - Left err -> pure (Left err) - Right () -> - exec service (insertSql grantsTable ["role", "privilege", "object"] [normalizeRole role, privilege, target]) + Right () -> + eachAction (expandPrivileges privileges) $ \privilege -> + catalog (addGrant (pvCatalog service) role privilege (normalizeObject database object)) RevokePrivilegesCommand privileges object role -> do allowed <- requireRole service role case allowed of Left err -> pure (Left err) Right () -> - each (expandPrivileges privileges) $ \privilege -> - exec service (deleteGrantSql role privilege (normalizeObject database object)) + eachAction (expandPrivileges privileges) $ \privilege -> + catalog (removeGrant (pvCatalog service) role privilege (normalizeObject database object)) GrantRoleCommand role users -> do allowed <- requireRole service role case allowed of Left err -> pure (Left err) Right () -> - each users $ \user -> do + eachAction users $ \user -> do known <- membersOfRole service role case known of Left err -> pure (Left err) Right members | normalizeUser user `elem` members -> pure (Right ()) - | otherwise -> - exec service (insertSql membersTable ["role", "member"] [normalizeRole role, normalizeUser user]) + | otherwise -> catalog (addMember (pvCatalog service) role user) RevokeRoleCommand role users -> do allowed <- requireRole service role case allowed of Left err -> pure (Left err) - Right () -> - each users $ \user -> - exec - service - ( "DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role - ++ " AND member = " ++ literal (normalizeUser user) - ) + Right () -> eachAction users $ \user -> catalog (removeMember (pvCatalog service) role user) --- | 建表只在第一次用时做;已经有了就算成功 +-- | 全程持锁,先保证系统表存在再跑动作 withTables :: Privileges -> IO (Either PrivilegeError a) -> IO (Either PrivilegeError a) -withTables service action = withMVar (pvLock service) $ \_ -> do - ready <- ensureTables service +withTables service action = withCatalogLock (pvCatalog service) $ do + ready <- ensureCatalog (pvCatalog service) case ready of - Left err -> pure (Left err) + Left err -> pure (Left (storageError 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) - pure $ case result of - Right _ -> Right () - Left err - | "exists" `isInfixOf` err -> Right () - | otherwise -> Left (storageError err) - --- | 跑一条内部写语句 -exec :: Privileges -> String -> IO (Either PrivilegeError ()) -exec service sql = do - result <- beStatement (pvBackend service) sql - pure $ case result of - Left err -> Left (storageError err) - Right _ -> Right () - --- | 读一张内部表 -readRows :: Privileges -> String -> IO (Either PrivilegeError [Row]) -readRows service table = do - result <- beStatement (pvBackend service) ("SELECT * FROM " ++ table) - pure $ case result of - Left err -> Left (storageError err) - Right res -> Right (srRows res) - --- | 行里取一列文本 -cell :: String -> Row -> Text -cell column row = case lookup column row of - Just (VStr value) -> T.pack value - _ -> "" - --- | 一行记录转成授权 -grantOf :: Row -> Grant -grantOf row = - Grant - { grantRole = normalizeRole (cell "role" row) - , grantPrivilege = T.toLower (T.strip (cell "privilege" 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) ++ ")" +-- | 目录操作转成权限错误 +catalog :: IO (Either String a) -> IO (Either PrivilegeError a) +catalog action = fmap (either (Left . storageError) Right) action -- | 把 ALL 展开成四种具体权限 expandPrivileges :: [Text] -> [Text] @@ -357,31 +280,6 @@ expandPrivileges privileges = nub (concatMap expand (map (T.toLower . T.strip) p expand "all" = ["select", "insert", "update", "delete"] expand other = [other] --- | 一串动作挨着跑,遇到第一个错误就停 -each :: [a] -> (a -> IO (Either PrivilegeError ())) -> IO (Either PrivilegeError ()) -each [] _ = pure (Right ()) -each (item : rest) action = do - result <- action item - case result of - 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" diff --git a/chusql-server/src/ChuSQL/Server/Session.hs b/chusql-server/src/ChuSQL/Server/Session.hs index a8dda41..6c1103c 100644 --- a/chusql-server/src/ChuSQL/Server/Session.hs +++ b/chusql-server/src/ChuSQL/Server/Session.hs @@ -27,10 +27,11 @@ module ChuSQL.Server.Session import ChuSQL.Core.Model (Value (..)) import ChuSQL.Core.Protocol (Account, QueryResult (..), queryResultJson) import ChuSQL.Core.Engine.Storage.IPC (TableInfo (..)) +import qualified ChuSQL.Core.Engine.Error as E 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.Interface.Auth (defaultSessionPolicy, newSessionStore) import ChuSQL.Server.Accounts import ChuSQL.Server.Backend (Backend (..), StatementResult (..)) import ChuSQL.Server.Policy (configurePasswordPolicy) @@ -54,12 +55,7 @@ data SessionError = SessionError -- | 引擎报错翻成错误码 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 +engineErrorCode err = SessionError (T.pack (E.errorCode err)) (T.pack err) data Session = Session { ssBackend :: Backend @@ -71,10 +67,10 @@ data Session = Session } -- | 开一个会话:账号与角色服务、配置策略都和 Web 端一致 -newSession :: Backend -> Credential -> FilePath -> IO Session -newSession backend credential settingsFile = do +newSession :: Backend -> Text -> FilePath -> IO Session +newSession backend name settingsFile = do sessions <- newSessionStore getCurrentTime defaultSessionPolicy - accountsService <- newAccounts backend sessions credential + accountsService <- newAccounts backend sessions name privileges <- newPrivileges backend configurePasswordPolicy accountsService settingsFile -- 服务启动后只有系统库:没 USE 之前不预设任何工作库 @@ -106,7 +102,7 @@ reloadPolicy session = do 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) diff --git a/chusql-server/src/ChuSQL/Server/TCP.hs b/chusql-server/src/ChuSQL/Server/TCP.hs index 6c369b4..f6ae675 100644 --- a/chusql-server/src/ChuSQL/Server/TCP.hs +++ b/chusql-server/src/ChuSQL/Server/TCP.hs @@ -11,11 +11,11 @@ module ChuSQL.Server.TCP ( 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 qualified ChuSQL.Core.Engine.Error as E 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) @@ -57,16 +57,16 @@ import System.IO.Error (isEOFError) data ServerEnv = ServerEnv { srvBackend :: Backend - , srvCredential :: Credential + , srvRootName :: Text , 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) +newServerEnv :: Backend -> Text -> FilePath -> ServerConfig -> RateLimiter -> IO ServerEnv +newServerEnv backend rootName settingsFile config limiter = + pure (ServerEnv backend rootName settingsFile config limiter) data ServerHandle = ServerHandle { shPort :: Int @@ -154,7 +154,7 @@ serveConnection env conn = do h <- socketToHandle conn ReadWriteMode hSetBuffering h LineBuffering hSetNewlineMode h noNewlineTranslation - session <- newSession (srvBackend env) (srvCredential env) (srvSettingsFile env) + session <- newSession (srvBackend env) (srvRootName 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) @@ -253,10 +253,7 @@ overSession session action wrap = do -- | 会话层的失败文案归一到协议错误码 sessionCode :: Text -> Text -sessionCode message - | message == "no database selected" = "no_database" - | message == "administrator required" = "forbidden" - | otherwise = "query_error" +sessionCode = T.pack . E.errorCode . T.unpack -- | 登录:按账号名限流,成功清账 login :: ServerEnv -> Session -> Text -> Text -> IO ServerResponse diff --git a/chusql-server/test/Spec.hs b/chusql-server/test/Spec.hs index 0cfaeb1..ff20890 100644 --- a/chusql-server/test/Spec.hs +++ b/chusql-server/test/Spec.hs @@ -3,11 +3,23 @@ module Main (main) where +import ChuSQL.Core.Engine.Storage.IPC (Account (..), Request (ReqAccountReset)) +import ChuSQL.Core.Engine.Syntax.Parser (parseStatement) 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.Auth (hashPasswordWith) +import ChuSQL.Interface.Protocol (ClientRequest (..), Grant (..), RoleView (..), ServerResponse (..), decodeRequest, encodeResponse) import ChuSQL.Interface.RateLimit (newRateLimiter) -import ChuSQL.Server.Backend (memoryBackend) +import ChuSQL.Server.Accounts (Principal (..), ensureRootAccount) +import ChuSQL.Server.Backend (Backend (..), memoryBackend) +import ChuSQL.Server.Privileges ( + PrivilegeCommand (..), + PrivilegeError (..), + Privileges, + authorize, + listRoleViews, + newPrivileges, + runPrivilegeCommand, + ) import ChuSQL.Server.Session (QueryResult (..)) import ChuSQL.Server.TCP ( ServerConfig (..), @@ -74,6 +86,7 @@ spec :: Spec spec = do tcpSpec tcpServerSpec + privilegeSpec -- 夹具:内存后端装在 MVar 里,跟 Web 测试同一套表 @@ -91,18 +104,28 @@ testDb = [ [("id", VInt i), ("name", VStr ("user" ++ show i)), ("age", VInt (20 + i))] | i <- [1 .. 5] ] + Nothing ) , ( "orders" , Table "orders" [("id", TInt), ("user_id", TInt)] [[("id", VInt 1), ("user_id", VInt 1)]] + Nothing ) ] --- | 测试账号:迭代次数压低(跑得快),口令 `s3cret` -testCredential :: Credential -testCredential = Credential "admin" (hashPasswordWith 1000 (BS.replicate 16 7) "s3cret") +-- | 测试管理员名字 +testRootName :: Text +testRootName = "admin" + +-- | 测试管理员口令 +testRootPassword :: Text +testRootPassword = "s3cret" + +-- | 口令哈希:迭代次数压低,跑得快 +testPasswordHash :: Text -> Text +testPasswordHash raw = hashPasswordWith 1000 (BS.replicate 16 7) raw -- 小工具 @@ -159,14 +182,23 @@ removeIfExists path = do there <- doesFileExist path if there then void (try (removeFile path) :: IO (Either IOException ())) else pure () --- | 起一台内存后端的测试服务器 +-- | 起一台内存后端的测试服务器:管理员已设口令 `s3cret` withTcpServer :: ServerConfig -> (ServerEnv -> ServerHandle -> IO a) -> IO a -withTcpServer config body = do +withTcpServer = withTcpServerAs (Just testRootPassword) + +-- | 起内存后端测试服务器;Nothing 表示首启未设口令 +withTcpServerAs :: Maybe Text -> ServerConfig -> (ServerEnv -> ServerHandle -> IO a) -> IO a +withTcpServerAs password 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 + let backend = memoryBackend testDatabaseName db + _ <- ensureRootAccount backend testRootName + case password of + Nothing -> pure () + Just raw -> void (beAccounts backend (ReqAccountReset testRootName (testPasswordHash raw))) + env <- newServerEnv backend testRootName path config{scPort = 0} limiter handle <- startServer env body env handle `finally` shStop handle @@ -321,6 +353,14 @@ tcpServerSpec = do asText (at "status" reply) `shouldBe` "error" asText (at "code" reply) `shouldBe` "unauthorized" asText (at "message" reply) `shouldBe` "sign in first" + it "signs the administrator in with an empty password until one is set" $ + withTcpServerAs Nothing defaultServerConfig $ \_ handle -> + withConnection handle $ \h -> do + wrong <- tcpLogin h "admin" "nope" + asText (at "code" wrong) `shouldBe` "unauthorized" + good <- tcpLogin h "admin" "" + asText (at "status" good) `shouldBe` "ok" + asBool (at "admin" good) `shouldBe` True it "refuses a wrong password and then accepts the right one" $ withTcpServer defaultServerConfig $ \_ handle -> withConnection handle $ \h -> do @@ -414,3 +454,94 @@ tcpServerSpec = do withConnection handle $ \other -> do blocked <- tcpQuery other "select * from users" asText (at "code" blocked) `shouldBe` "unauthorized" + +-- 权限服务夹具:内存后端上的系统库视角 + +-- | 一个普通账号 +testAccount :: Account +testAccount = Account 0 "alice" "" 0 "" Nothing + +-- | 权限用例传的当前库名 +testDatabase :: Text +testDatabase = T.pack testDatabaseName + +-- | 一个空的权限服务加管理员身份 +withPrivileges :: (Privileges -> Principal -> IO a) -> IO a +withPrivileges body = do + db <- newMVar testDb + service <- newPrivileges (memoryBackend testDatabaseName db) + body service (Root testRootName) + +-- | 权限与目录 API 用例 +privilegeSpec :: Spec +privilegeSpec = describe "server privileges" $ do + it "creates a role and lists it" $ withPrivileges $ \service root -> do + created <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + created `shouldBe` Right () + views <- listRoleViews service + fmap (map roleName) views `shouldBe` Right ["reader"] + + it "refuses a role that already exists" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + again <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + again `shouldBe` Left (PrivilegeError "conflict" "role already exists: reader") + + it "grants a privilege on a table and shows it in the role view" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + granted <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader") + granted `shouldBe` Right () + views <- listRoleViews service + fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users"]] + + it "expands ALL and keeps a star object as is" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["all"] "*" "reader") + views <- listRoleViews service + fmap (concatMap (map grantPrivilege) . map roleGrants) views + `shouldBe` Right ["select", "insert", "update", "delete"] + fmap (concatMap (map grantObject) . map roleGrants) views `shouldBe` Right (replicate 4 "*") + + it "revokes a privilege again" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader") + _ <- runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "reader") + views <- listRoleViews service + fmap (map roleGrants) views `shouldBe` Right [[]] + + it "adds and removes members" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"]) + _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice", "bob"]) + views <- listRoleViews service + fmap (map roleMembers) views `shouldBe` Right [["alice", "bob"]] + _ <- runPrivilegeCommand service root testDatabase (RevokeRoleCommand "reader" ["alice"]) + remaining <- listRoleViews service + fmap (map roleMembers) remaining `shouldBe` Right [["bob"]] + + it "drops a role together with its grants and members" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader") + _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"]) + dropped <- runPrivilegeCommand service root testDatabase (DropRoleCommand "reader") + dropped `shouldBe` Right () + views <- listRoleViews service + views `shouldBe` Right [] + + it "refuses a command on a role that does not exist" $ withPrivileges $ \service root -> do + missing <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "ghost") + missing `shouldBe` Left (PrivilegeError "not_found" "unknown role: ghost") + + it "refuses a table grant without a selected database" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + refused <- runPrivilegeCommand service root "" (GrantPrivilegesCommand ["select"] "users" "reader") + refused `shouldBe` Left (PrivilegeError "no_database" "no database selected") + + it "refuses a non-administrator" $ withPrivileges $ \service _ -> do + refused <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (CreateRoleCommand "reader") + refused `shouldBe` Left (PrivilegeError "forbidden" "administrator required") + + it "authorizes the administrator on any statement" $ withPrivileges $ \service root -> + case parseStatement "SELECT * FROM users" of + Left err -> expectationFailure err + Right stmt -> authorize service root testDatabase stmt `shouldReturn` Right () + diff --git a/chusql-web/app/Main.hs b/chusql-web/app/Main.hs index 8a09389..aa26c8e 100644 --- a/chusql-web/app/Main.hs +++ b/chusql-web/app/Main.hs @@ -3,20 +3,17 @@ module Main (main) where import ChuSQL.Web.API (AppEnv (..), Live (..), newAppEnvAt, setLive, webApp) -import ChuSQL.Interface.Auth (Credential (..), SessionPolicy (..), setPayloadPolicy) +import ChuSQL.Interface.Auth (SessionPolicy (..), setPayloadPolicy) import ChuSQL.Interface.Config ( ServerConfig (..), WebConfig (..), - defaultPassword, defaultUser, loadServerConfigAt, loadWebConfigAt, - resolveCredential, - resolvePlainPassword, + legacyPasswordKey, resolveStaticDir, rootUserName, staticDirCandidates, - usingDefaultCredentials, ) import ChuSQL.Interface.Link (clientPing, closeClient, connectClient) import ChuSQL.Interface.RateLimit (newRateLimiter) @@ -126,7 +123,7 @@ 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;" + putStrLn " [web] host/port/static_dir/user (administrator name) 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 ...)" @@ -146,9 +143,9 @@ usage = do putStrLn " --max-sql-length N max SQL characters ([web] max_sql_length, default 20000)" putStrLn " --seed BOOL load demo data when the db is empty ([web] seed, default false)" putStrLn "" - putStrLn "administrator password: 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) + putStrLn "administrator password: lives in the __system_users system table, never in chusql.toml" + putStrLn " the installer always sets one; an account whose hash is still empty signs in with an empty password" + putStrLn (" the [web] user key only picks the administrator name (default " ++ T.unpack defaultUser ++ ")") putStrLn "ordinary accounts: CREATE USER / ALTER USER / DROP USER from the SQL console (administrator only)" putStrLn "storage: the server owns the data directory and loads the chusql_core_storage library;" putStrLn " this process is a plain TCP client: every statement, lookup and account request goes to it" @@ -210,6 +207,7 @@ run opts = do let settingsFile = configPath policy = SessionPolicy (fromIntegral (wcSessionIdle cfg)) (fromIntegral (wcSessionMax cfg)) saved <- readSettingsFile settingsFile + legacy <- legacyPasswordKey settingsFile config <- loadServerConfigAt settingsFile limiter <- newRateLimiter @@ -227,7 +225,7 @@ run opts = do setLive env (liveFromConfig cfg) app <- webApp env printBanner cfg configPath staticDir - reportCredential cfg saved + reportCredential cfg saved legacy checkServer (aeServerHost env) (aeServerPort env) seedIfWanted cfg saved (aeServerHost env) (aeServerPort env) let settings = @@ -261,23 +259,17 @@ serve settings app = do putStrLn " on Windows: netsh interface ipv4 show excludedportrange protocol=tcp" exitFailure --- | 口令是从哪来的(用了内置默认口令就明确警告) -reportCredential :: WebConfig -> Map.Map Text Text -> IO () -reportCredential cfg saved = do - credential <- resolveCredential cfg saved - if usingDefaultCredentials saved +-- | 报告管理员账号状态:配置里还留着明文口令键就提醒 +reportCredential :: WebConfig -> Map.Map Text Text -> Bool -> IO () +reportCredential cfg saved legacy = do + putStrLn ("administrator: " ++ T.unpack (rootUserName cfg saved)) + if legacy then do - putStrLn "" - putStrLn " !! Administrator credentials are not configured; the built-in demo password is in use:" - putStrLn (" !! user " ++ T.unpack (credUser credential) ++ " / password " ++ T.unpack defaultPassword) - putStrLn " !! set user / password in the [web] section of chusql.toml and restart" - putStrLn "" - else - if T.null (credEncoded credential) - 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)") + putStrLn " !! the [web] section still carries a plaintext password key; it is ignored now" + putStrLn " !! remove it: the administrator password lives in the __system_users system table" + else pure () --- | 配了 seed 就以管理员身份补演示数据 +-- | 配了 seed 就补演示数据(管理员已设口令时跳过) seedIfWanted :: WebConfig -> Map.Map Text Text -> Text -> Int -> IO () seedIfWanted cfg saved host port | not (wcSeedDemo cfg) = pure () @@ -287,9 +279,9 @@ seedIfWanted cfg saved host port Left message -> TIO.putStrLn ("demo data skipped: " <> message) Right client -> do session <- newSession client - signed <- authenticateSession session (rootUserName cfg saved) (resolvePlainPassword saved) + signed <- authenticateSession session (rootUserName cfg saved) "" case signed of - Left message -> TIO.putStrLn ("demo data skipped: " <> message) + Left message -> TIO.putStrLn ("demo data skipped: " <> message <> " (set the administrator password after seeding)") Right () -> do result <- seedDemo session case result of diff --git a/chusql-web/chusql-web.cabal b/chusql-web/chusql-web.cabal index e8e2d61..fd65adf 100644 --- a/chusql-web/chusql-web.cabal +++ b/chusql-web/chusql-web.cabal @@ -59,6 +59,7 @@ test-suite chusql-web-test hs-source-dirs: test other-modules: Gates build-tool-depends: chusql-server:chusql-server + , chusql-bootstrap:csql-bootstrap build-depends: base , aeson , bytestring diff --git a/chusql-web/stack.yaml b/chusql-web/stack.yaml index 8e0303f..6496a0a 100644 --- a/chusql-web/stack.yaml +++ b/chusql-web/stack.yaml @@ -7,5 +7,6 @@ packages: - . - ../chusql-core/engine - ../chusql-server + - ../chusql-bootstrap - ../chusql-core/model - ../chusql-interface diff --git a/chusql-web/static/core.js b/chusql-web/static/core.js index 4754eae..30d3320 100644 --- a/chusql-web/static/core.js +++ b/chusql-web/static/core.js @@ -18,7 +18,7 @@ export function escapeHtml(value) { const identifierPattern = /^[A-Za-z_][A-Za-z0-9_]*$/; // 账号表:在 system 库里像普通表一样浏览,写入会翻译成账号命令。 -export const accountsTable = '__chusql_users'; +export const accountsTable = '__system_users'; // 值转 SQL 字面量(字符串加引号转义)。 export function sqlLiteral(value) { diff --git a/chusql-web/test/Gates.hs b/chusql-web/test/Gates.hs index 5619adc..1d5d61d 100644 --- a/chusql-web/test/Gates.hs +++ b/chusql-web/test/Gates.hs @@ -73,8 +73,9 @@ gateSpec = do installer `shouldSatisfy` T.isInfixOf "Get-ResponseText" installer `shouldSatisfy` T.isInfixOf "-is [byte[]]" installer `shouldSatisfy` T.isInfixOf "ConvertFrom-Json" - -- 装什么由人当场选:逐个问、问答用英文、默认装 csql 不装 Web,选完才问管理员口令。 - -- 提问顺序固定:先 cli 后 web。两个脚本文案必须一致,改一个就得改另一个。 + -- 装什么由人当场选:逐个问、问答用英文、默认装 csql 不装 Web。管理员口令不在配置里, + -- 装机时是必答项:有终端就当场问两遍,没有就给 --password / -Password 或 + -- CHUSQL_ADMIN_PASSWORD,口令只经 stdin 传给 csql-bootstrap。两个脚本必须一致。 it "both installers ask which components to install, in the same words" $ do sh <- readUtf8 (".." "scripts" "install.sh") ps <- readUtf8 (".." "scripts" "install.ps1") @@ -84,13 +85,21 @@ gateSpec = do ( \src -> do src `shouldSatisfy` T.isInfixOf cliAsk src `shouldSatisfy` T.isInfixOf webAsk - src `shouldSatisfy` T.isInfixOf "Root password for" + src `shouldSatisfy` T.isInfixOf "The administrator account is " + src `shouldSatisfy` T.isInfixOf " the password cannot be empty" + src `shouldSatisfy` T.isInfixOf "the two entries differ, try again" + src `shouldSatisfy` T.isInfixOf "--password-stdin" + src `shouldSatisfy` T.isInfixOf "CHUSQL_ADMIN_PASSWORD" + -- 管理员不能没有口令:两个脚本都不许再留空口令这条路 + src `shouldSatisfy` (not . T.isInfixOf "passwordless") -- cli 的问题必须出现在 web 之前(文档里的用法示例也按这个顺序写) T.length (fst (T.breakOn cliAsk src)) `shouldSatisfy` (< T.length (fst (T.breakOn webAsk src))) ) [sh, ps] + sh `shouldSatisfy` T.isInfixOf "--password PASSWORD" sh `shouldSatisfy` T.isInfixOf "--interactive" sh `shouldSatisfy` T.isInfixOf "both" + ps `shouldSatisfy` T.isInfixOf "-Password" ps `shouldSatisfy` T.isInfixOf "-Interactive" ps `shouldSatisfy` T.isInfixOf "both" -- 到底装的哪个版本要打出来:latest 解析来的和显式指定的,两处都得有。 @@ -107,6 +116,9 @@ gateSpec = do src `shouldSatisfy` T.isInfixOf "releases" src `shouldSatisfy` T.isInfixOf "install.sh" src `shouldSatisfy` T.isInfixOf "install.ps1" + -- 卸载脚本跟安装脚本同路进包:装完就得能在包根上卸干净 + src `shouldSatisfy` T.isInfixOf "uninstall.sh" + src `shouldSatisfy` T.isInfixOf "uninstall.ps1" ) [sh, ps] sh `shouldSatisfy` T.isInfixOf "tar -czf" @@ -137,10 +149,10 @@ gateSpec = do launcher <- readUtf8 (".." "scripts" "csql-web.sh") launcher `shouldSatisfy` T.isInfixOf "cd \"$home_dir\"" launcher `shouldSatisfy` T.isInfixOf "chusql-server" - -- 默认数据目录按平台惯例算,四处必须说同一件事:Rust 代码、配置示例、模板、文档。 + -- 默认数据目录按平台惯例算,三处必须说同一件事:Rust 代码、配置示例、模板。 -- 跟安装脚本装的位置也是一处:Windows 装到 %LOCALAPPDATA%\ChuSQL、Unix 装到 ~/.local/share/chusql, -- 数据都放在它下面的 data/ 里。 - it "the default data dir follows the platform, and code, template and docs agree" $ do + it "the default data dir follows the platform, and code and template agree" $ do rust <- readUtf8 (".." "chusql-core" "storage" "src" "config.rs") rust `shouldSatisfy` T.isInfixOf "default_data_dir" rust `shouldSatisfy` T.isInfixOf "LOCALAPPDATA" @@ -157,10 +169,6 @@ gateSpec = do -- 模板那行是安装时被 sed / -replace 替换的占位,必须保持能生效 template `shouldSatisfy` T.isInfixOf "\ndata_dir = " template `shouldSatisfy` T.isInfixOf "%LOCALAPPDATA%" - - configDoc <- readUtf8 (".." "doc" "config.md") - configDoc `shouldSatisfy` T.isInfixOf "%LOCALAPPDATA%\\ChuSQL\\data" - configDoc `shouldSatisfy` T.isInfixOf "chusql/data" -- 管道传输退休后,两侧都不该再算套接字路径、也不该再认管名。 it "neither side computes a socket path or a pipe name any more" $ do haskellIpc <- readUtf8 (".." "chusql-core" "engine" "src" "ChuSQL" "Core" "Engine" "Storage" "IPC.hs") @@ -209,7 +217,7 @@ gateSpec = do release `shouldSatisfy` (not . T.isInfixOf "component: [web, cli]") it "no layer looks for a storage executable or a pipe name any more" $ do engine <- readUtf8 (".." "chusql-core" "engine" "test" "Spec.hs") - bench <- readUtf8 (".." "benchmark" "src" "Main.hs") + bench <- readUtf8 (".." "chusql-benchmark" "src" "Main.hs") template <- readUtf8 (".." "scripts" "chusql.toml") mapM_ (\src -> src `shouldSatisfy` (not . T.isInfixOf "pipe_name")) @@ -223,47 +231,18 @@ gateSpec = do (".." "chusql-server" "src" "ChuSQL" "Server" "StorageProcess.hs") moduleGone `shouldBe` False - -- 细节分到 doc/ 下四份,README 只留面向用户的关键内容;链接断了或者文档没了,等于没写。 - describe "Documentation (doc/)" $ do - it "the README keeps only the essentials and links the split documents" $ do + -- 文档只做结构约束:四篇在、README 能链到它们。正文怎么写、写多长都不校验, + -- 免得以后精简文档反而过不了门禁。 + describe "Documentation (docs/)" $ do + it "the README links the split documents" $ do readme <- readUtf8 (".." "README.md") mapM_ - (\target -> readme `shouldSatisfy` T.isInfixOf ("doc/" <> target <> ".md")) + (\target -> readme `shouldSatisfy` T.isInfixOf ("docs/" <> target <> ".md")) ["install", "config", "commands", "architecture"] - -- 安装选项与配置键的长表已经搬走,不该在 README 里再长回来 - readme `shouldSatisfy` (not . T.isInfixOf "--from-source") - readme `shouldSatisfy` (not . T.isInfixOf "pool_size") - -- 仓库布局这类开发者信息属于 doc/architecture.md,不属于 README - readme `shouldSatisfy` (not . T.isInfixOf "chusql-engine/") - it "each split document covers what its name promises" $ do - let expectations = - [ ("install", ["install.sh", "install.ps1", "--component", "--install-dir", "--from-source", "--version", "--list-versions", "-Component", "-Version", "-ListVersions", "-Interactive", "CHUSQL_GITHUB_TOKEN", "rm -rf"]) - , ("config", ["[web]", "[page]", "data_dir", "host", "port"]) - , ("commands", ["csql", "--format", "\\dt", "CREATE ROLE", "GRANT", "/api/roles"]) - , ("architecture", ["chusql-core", "chusql-server", "chusql-web", "csql", "data_dir", "CREATE DATABASE"]) - ] - mapM_ - ( \(name, needles) -> do - doc <- readUtf8 (".." "doc" name <> ".md") - mapM_ (\needle -> doc `shouldSatisfy` T.isInfixOf needle) needles - ) - expectations - -- doc/ 只写面向用户的内容:构建、测试、打包这些开发流程不进文档 - it "the split documents stay user-facing (no build, test or packaging recipes)" $ do - let developerOnly = - [ "package.ps1" - , "stack build" - , "stack test" - , "cargo build" - , "cargo test" - , "cargo clippy" - , ".stack-work" - , ".github/workflows" - , "smoke-linux.sh" - ] + it "the split documents exist and are not empty" $ do mapM_ ( \name -> do - doc <- readUtf8 (".." "doc" name <> ".md") - mapM_ (\needle -> doc `shouldSatisfy` (not . T.isInfixOf needle)) developerOnly + doc <- readUtf8 (".." "docs" name <> ".md") + doc `shouldSatisfy` (not . T.null) ) ["install", "config", "commands", "architecture"] diff --git a/chusql-web/test/Spec.hs b/chusql-web/test/Spec.hs index b24c937..154a7ad 100644 --- a/chusql-web/test/Spec.hs +++ b/chusql-web/test/Spec.hs @@ -2,7 +2,9 @@ module Main (main) where +import ChuSQL.Interface.Link (closeClient, connectClient) import ChuSQL.Interface.RateLimit (newRateLimiter) +import ChuSQL.Interface.Session (authenticateSession, newSession, runStatement) import ChuSQL.Interface.Settings ( applySettings, defaultOf, @@ -66,6 +68,7 @@ import System.Directory ( removeFile, removePathForcibly, ) +import System.Environment (lookupEnv) import System.Exit (ExitCode (..)) import System.FilePath (()) import System.Info (os) @@ -76,6 +79,7 @@ import System.Process ( StdStream (CreatePipe, NoStream), createProcess, proc, + readProcessWithExitCode, terminateProcess, waitForProcess, ) @@ -222,7 +226,7 @@ ensureAccount hs user password = do created <- postAs (withDb "system" hs) - "/api/tables/__chusql_users/rows" + "/api/tables/__system_users/rows" (encode (object ["values" .= object ["user" .= user, "password" .= password]])) check (statusCode (WT.simpleStatus created) `shouldSatisfy` (`elem` [200, 409])) @@ -376,19 +380,38 @@ startLiveWorld label = do config = root "chusql.toml" createDirectoryIfMissing True dataDir writeFile config (serverConfigText dataDir) + seedSystemCatalog config (_, Just out, _, process) <- createProcess (proc bin ["--config", config]){std_out = CreatePipe, std_err = NoStream} port <- readListeningPort out _ <- forkIO (drainHandle out) + setAdminPassword port pure (LiveWorld process port config dataDir) +-- | 首启的管理员还没有口令:先用空口令登录,再按业务流程设一个 +setAdminPassword :: Int -> IO () +setAdminPassword port = do + opened <- connectClient "127.0.0.1" port + case opened of + Left err -> fail ("fixture server refused the connection: " ++ T.unpack err) + Right client -> do + session <- newSession client + signed <- authenticateSession session adminUser "" + case signed of + Left err -> fail ("fixture administrator cannot sign in: " ++ T.unpack err) + Right () -> do + changed <- runStatement session ("ALTER USER " <> adminUser <> " IDENTIFIED BY '" <> adminPassword <> "'") + case changed of + Left err -> fail ("fixture administrator keeps no password: " ++ T.unpack err) + Right _ -> pure () + closeClient client + -- | 生成夹具 server 的配置文本 serverConfigText :: FilePath -> String serverConfigText dataDir = unlines [ "[web]" , "user = \"" ++ T.unpack adminUser ++ "\"" - , "password = \"" ++ T.unpack adminPassword ++ "\"" , "password-min-length = 8" , "password-classes = 2" , "" @@ -439,6 +462,28 @@ locateServerExe = do Just path -> pure path Nothing -> fail "chusql-server was not found on PATH: run `stack build` first" +-- | 全新的数据目录还没有系统目录:先跑引导程序建表并补一个免密管理员, +-- server 才肯启动(未引导的目录会被它拒绝)。 +seedSystemCatalog :: FilePath -> IO () +seedSystemCatalog config = do + bootstrap <- locateBootstrapExe + (code, out, errOut) <- readProcessWithExitCode bootstrap ["--config", config, "--passwordless"] "" + case code of + ExitSuccess -> pure () + _ -> fail ("the fixture bootstrap program failed (exit " ++ show code ++ "): " ++ out ++ errOut) + +-- | 找引导程序:先环境变量,再 PATH +locateBootstrapExe :: IO FilePath +locateBootstrapExe = do + fromEnv <- lookupEnv "CHUSQL_BOOTSTRAP_EXE" + case fromEnv of + Just path -> pure path + Nothing -> do + found <- findExecutable (binaryName "csql-bootstrap") + case found of + Just path -> pure path + Nothing -> fail "csql-bootstrap was not found on PATH: run `stack build` first" + -- | 构造指向真 server 的 Web 环境 liveEnv :: LiveWorld -> FilePath -> Int -> IO AppEnv liveEnv world staticDir attempts = do @@ -491,7 +536,7 @@ unitSpec = describe "pure helpers" $ do it "round-trips settings through a real TOML file" $ do path <- tempFilePath "settings" removeIfExists path - writeSettingsFile path (Map.fromList [("rows-per-page", "50"), ("user", "admin"), ("password", "s3cret")]) + writeSettingsFile path (Map.fromList [("rows-per-page", "50"), ("user", "admin")]) >>= (`shouldSatisfy` isRightE) values <- readSettingsFile path Map.lookup "rows-per-page" values `shouldBe` Just "50" @@ -500,8 +545,8 @@ unitSpec = describe "pure helpers" $ do applySettings Map.empty (Map.fromList [("nope", "1")]) `shouldSatisfy` isLeftE applySettings Map.empty (Map.fromList [("password-min-length", "3")]) `shouldSatisfy` isLeftE applySettings Map.empty (Map.fromList [("password-min-length", "12")]) `shouldSatisfy` isRightE - it "marks root credentials as locked and lists the live keys" $ do - isLockedSetting "password" `shouldBe` True + it "marks the administrator name as locked and lists the live keys" $ do + isLockedSetting "user" `shouldBe` True isLockedSetting "rows-per-page" `shouldBe` False ("rows-per-page" `elem` liveKeys) `shouldBe` True length settingCatalogue `shouldSatisfy` (> 20) @@ -589,7 +634,7 @@ gatingSpec env = describe "gate keeping" $ do it "rejects the account table outside the system database" $ do hs <- adminHeaders ensureDatabase hs testDatabaseName - res <- getAs (withDb testDatabaseName hs) "/api/tables/__chusql_users/rows" + res <- getAs (withDb testDatabaseName hs) "/api/tables/__system_users/rows" expectStatusWith "account table outside system" res 400 it "rejects role management without a cookie" $ do res <- getAs [] "/api/roles" @@ -703,7 +748,7 @@ settingsSpec env = describe "settings and password policy" $ do let entries = items (at "items" (jsonBody res)) check (length entries `shouldSatisfy` (> 20)) check (asText (at "value" (headEntry "rows-per-page" entries)) `shouldBe` "25") - check (at "locked" (headEntry "password" entries) `shouldBe` A.Bool True) + check (at "locked" (headEntry "user" entries) `shouldBe` A.Bool True) it "writes a setting, makes the server reload the policy, and reports it applied" $ do hs <- adminHeaders res <- @@ -728,12 +773,12 @@ settingsSpec env = describe "settings and password policy" $ do values <- liftIO (readSettingsFile (aeSettingsFile env)) check (Map.lookup "password-min-length" values `shouldBe` Just "16") check (Map.lookup "user" values `shouldBe` Just adminUser) - it "refuses unknown settings and the locked root credentials" $ do + it "refuses unknown settings and the locked administrator name" $ do hs <- adminHeaders unknown <- putAs hs "/api/settings" (encode (object ["values" .= object ["nope" .= ("1" :: Text)]])) expectStatusWith "unknown setting" unknown 400 - locked <- putAs hs "/api/settings" (encode (object ["values" .= object ["password" .= ("hacked" :: Text)]])) - expectStatusWith "locked credential" locked 403 + locked <- putAs hs "/api/settings" (encode (object ["values" .= object ["user" .= ("hacked" :: Text)]])) + expectStatusWith "locked administrator name" locked 403 -- 账号表 --------------------------------------------------------------------- @@ -745,14 +790,14 @@ accountSpec env = describe "the account table (system database, admin only)" $ d hs <- adminHeaders res <- getAs (withDb "system" hs) "/api/tables" expectStatusWith "system tables" res 200 - check (("__chusql_users" `elem` map (asText . at "table") (items (jsonBody res))) `shouldBe` True) + check (("__system_users" `elem` map (asText . at "table") (items (jsonBody res))) `shouldBe` True) it "creates an account, changes its password, signs in as it and drops it" $ do hs <- adminHeaders ensureAccount hs "alice" "alice-Secret-1234" duplicate <- postAs (withDb "system" hs) - "/api/tables/__chusql_users/rows" + "/api/tables/__system_users/rows" (encode (object ["values" .= object ["user" .= ("alice" :: Text), "password" .= ("alice-Secret-9999" :: Text)]])) expectStatusWith "duplicate account" duplicate 409 alice <- ordinaryHeaders "alice" "alice-Secret-1234" @@ -764,14 +809,14 @@ accountSpec env = describe "the account table (system database, admin only)" $ d changed <- patchAs (withDb "system" hs) - "/api/tables/__chusql_users/rows/alice" + "/api/tables/__system_users/rows/alice" (encode (object ["values" .= object ["password" .= ("alice-Secret-5678" :: Text)]])) expectStatusWith "change password" changed 200 _ <- ordinaryHeaders "alice" "alice-Secret-5678" - dropped <- deleteAs (withDb "system" hs) "/api/tables/__chusql_users/rows/alice" + dropped <- deleteAs (withDb "system" hs) "/api/tables/__system_users/rows/alice" expectStatusWith "drop account" dropped 200 it "refuses account writes without a cookie" $ do - res <- getAs (withDb "system" []) "/api/tables/__chusql_users/rows" + res <- getAs (withDb "system" []) "/api/tables/__system_users/rows" expectStatusWith "account rows without a cookie" res 401 -- 角色 ----------------------------------------------------------------------- diff --git a/doc/architecture.md b/doc/architecture.md deleted file mode 100644 index d76c0a3..0000000 --- a/doc/architecture.md +++ /dev/null @@ -1,79 +0,0 @@ -# 架构与组件 - -ChuSQL 由三个面向用户的程序、几个共享库与一份配置组成: - -| 组件 | 作用 | -| ------------------------------- | -------------------------------------------------------------------- | -| `chusql-server` | 数据库服务:进程内装入引擎与存储动态库、独占数据目录,对外只开一个 TCP 端口 | -| `chusql-web` | Web 管理端:浏览器里的数据库 IDE,自己开 HTTP 端口,后端经 TCP 连 `chusql-server` | -| `csql` | 命令行客户端,经 TCP 连 `chusql-server` | -| `chusql-core/engine`(库) | SQL 解析、语义检查、优化与执行,链进 `chusql-server` | -| `chusql-core/storage`(动态库) | 存储:页面与索引、WAL、崩溃恢复 | -| `chusql-interface`(库) | 接口层:线上协议、配置与设置、口令与限流、语句构造、TCP 客户端与会话,`chusql-web` 与 `csql` 共用 | -| `chusql-core/model`(库) | 共享类型:表与列、结果集、权限枚举 | - -安装时把可执行文件与存储动态库(`libchusql_core_storage.so` / `chusql_core_storage.dll`)放进同一个目录, -进程按 exe 所在目录就能找到库。 - -## 数据流 - -浏览器、`csql` 或别的程序 → TCP → `chusql-server` → 同一进程里调 `chusql-core/engine` -(经 FFI 再调 `chusql-core/storage` 动态库)→ 磁盘。 - -**数据目录只有 `chusql-server` 一个进程碰**:`chusql-web` 与 `csql` 自己不开存储,它们把 SQL 与数据字典请求 -交给 TCP 服务执行,拿到结果再渲染。因此库文件同一时刻只有一个持有者;进程内的并发先用一把锁串起来, -完整事务与 MVCC 见后续计划。 - -`chusql-web` 是「自己开 HTTP 服务、同时又是 `chusql-server` 的 TCP 客户端」:浏览器只跟 Web 说话, -Web 后端在需要认证、鉴权、读数据或改数据的时候,才把请求发给 `chusql-server`。 - -三种用法共用同一份 [`chusql.toml`](config.md)、同一个管理员账号与同一张账号表——任意一端改的账号与权限, -另外两端立刻生效。 - -## 一次请求经过什么 - -1. 浏览器、命令行或别的程序发起 SQL; -2. 解析与语义检查(表/列是否存在、类型是否匹配、权限是否足够)在 `chusql-server` 里完成,不合格的语句不会落到磁盘; -3. 合格语句经 FFI 交给同一进程里的存储库; -4. 存储库读写页面与索引,写之前先记 WAL; -5. 结果原路返回。 - -## 数据在哪里 - -数据都在 `[storage] data_dir` 下。不写这个键就按平台惯例:Windows `%LOCALAPPDATA%\ChuSQL\data`, -Linux / macOS `${XDG_DATA_HOME:-~/.local/share}/chusql/data`。 - -| 目录 | 内容 | -| --------------------- | ---------------------------- | -| `system/` | 系统库:账号表与角色授权表 | -| `databases/<库名>/` | 各自建的库 | - -服务启动后只建 `system`,**没有默认工作库**;其余库由你自己 `CREATE DATABASE` 创建。 - -## TCP 数据库服务(`chusql-server`) - -给别的程序用的接口:一条 TCP 连接一条 SQL 会话,请求和应答都是**一行一个 JSON 对象**,编码 UTF-8。 - -| 请求 | 字段 | 应答 `status` | -| --------------- | --------------------------- | ---------------------------------------------------------------- | -| `hello` | `protocol`(可选,默认 1) | `hello`:带 `protocol`、`server` | -| `login` | `user`、`password` | `ok`:带 `user`、`admin` | -| `query` | `sql` | `result`:带 `columns`、`rows`、`rowCount`、`truncated`、`database` | -| `catalog` | — | `catalog`:带 `schemas`(表与列) | -| `databases` | — | `databases`:带库名列表 | -| `roles` | — | `roles`:带角色与授权视图 | -| `accounts` | — | `accounts`:带账号表(仅管理员) | -| `policy` | — | `policy`:带 `minLength`、`classes`(仅管理员) | -| `reload-policy` | — | `policy`:重新读设置里的口令策略(仅管理员) | -| `storage` | `request`(存储层的原始请求) | `storage`:带 `response`(存储层的原始应答,仅管理员) | -| `ping` | — | `pong` | -| `quit` | — | `bye`,随后连接关闭 | - -方法名大小写不敏感,认不出的字段忽略。任何一端出错都回 `{"status":"error","code":...,"message":...}` -且**连接不断**,客户端可以接着发下一条;`code` 取值有 `bad_request`(协议号不符、SQL 为空、行太长)、 -`unauthorized`(没登录就查询、口令不对)、`forbidden`、`too_many_attempts`(登录失败被限流)、 -`too_large`、`no_database`、`not_found`、`query_error`、`conflict`、`storage_error`。 - -登录之前只能 `hello` / `ping` / `quit`;`storage`、`accounts`、`policy`、`reload-policy` 与系统库只对管理员开放。 -每条连接各有一份会话,数据库选择(`USE <库>`)不跨连接。监听参数在 `[server]` 分区(见 [config.md](config.md)), -默认只听本机 `127.0.0.1:7777`。 diff --git a/doc/commands.md b/doc/commands.md deleted file mode 100644 index d99314b..0000000 --- a/doc/commands.md +++ /dev/null @@ -1,165 +0,0 @@ -# 命令与选项 - -## 一共有几个可执行文件 - -| 命令 | 作用 | 选项 | -| ---- | ---- | ---- | -| `chusql-server` | 数据库服务:装入引擎与存储动态库、独占数据目录,对外是 TCP | 见「`chusql-server` 选项」 | -| `chusql-web` | Web 管理端:REST 接口 + 浏览器里的数据库 IDE | 见「`chusql-web` 选项」 | -| `csql` | 命令行客户端,连数据库服务的 TCP 端点 | 见「`csql` 选项」 | -| `csql-web` | 一键启动器:按配置拉起 Web 服务,日志写 `/logs` | 无选项(`host`/`port` 从配置读) | - -四个命令共用同一份 [`chusql.toml`](config.md);`--config` 都是用来临时读另一份配置的。 - -## `csql` 选项 - - csql [options] - -| 选项 | 默认 | 说明 | -| ---- | ---- | ---- | -| `-u, --user USER` | 配置里的管理员 | 用这个账号登录 | -| `-p, --password` | — | 强制交互输入口令,忽略配置里的 | -| `-d, --database DB` | 不选(启动后没有默认库) | 登录后直接选中哪个库 | -| `-f, --format FORMAT` | `table` | 输出格式:`table` / `json` / `csv` | -| `-e, --execute SQL` | — | 跑一条语句就退出(脚本化用) | -| `--history FILE` | `~/.chusql_history` | 历史文件位置 | -| `--config FILE` | 固定位置的 `chusql.toml` | 读另一份配置 | -| `-h, --help` | — | 帮助 | - -脚本化示例: - - csql -e "SELECT count(*) FROM orders" -f json - csql -u analyst -p -d sales -f csv -e "SELECT * FROM orders LIMIT 5" - -## 交互模式 - -- 提示符 `chusql>`;语句以**分号**结尾,可以跨多行;上下键翻历史(默认存 `~/.chusql_history`)。 -- 退出码:语句出错时非 0,方便在脚本里判断。 - -### 元命令 - -| 元命令 | 作用 | -| ------ | ---- | -| `\q` `\quit` | 退出 | -| `\?` `\h` `\help` | 帮助 | -| `\l` `\list` | 列出数据库 | -| `\dt` `\d` | 列出当前库的表 | -| `\d <表>` | 看表结构 | -| `\dr` `\roles` | 角色总览:授权对象与成员(管理员专属,等价于 Web 的 `GET /api/roles`) | -| `\c <库>` | 切换数据库 | -| `\f` `\format ` | 切换输出格式:`table` / `json` / `csv` | - -普通身份用 `\dt` 时只会看到自己有 `SELECT` 权限的表,系统表永远不出现。 - -## 账号与权限 - -账号:root(配置里的 `user` / `password` 决定,见 [config.md](config.md))是管理员,其余都是普通账号, -默认**零权限**,只能看到被授权的表。系统库 `system`(账号表在里面)只有管理员能进。 - -服务启动后**只有系统库**,没有任何默认工作库:自己 `CREATE DATABASE shop` 再 `USE shop`。 -没选库时只有"限定名"语句能跑(`SELECT * FROM shop.items`),裸表名(`SELECT * FROM items`)会报 -`no database selected`——先把库选上。 - - CREATE USER alice IDENTIFIED BY 'secret'; -- 普通账号,口令是明文,服务端加盐派生 - ALTER USER alice IDENTIFIED BY 'new-secret'; -- 改口令 - DROP USER alice; - -`CREATE USER` / `ALTER USER` / `DROP USER` 只有管理员能执行(Web 端在 SQL 控制台,命令行直接跑)。 - -权限按**角色**给,三句话: - - CREATE ROLE analyst; -- 建角色(平的角色,不可继承) - GRANT SELECT, INSERT ON orders TO analyst; -- 授权:对象可以是表名或 * - GRANT analyst TO alice; -- 把角色给账号 - REVOKE INSERT ON orders FROM analyst; -- 收回权限 - REVOKE analyst FROM alice; -- 收回角色 - DROP ROLE analyst; - -| 权限 | 覆盖 | -| ---- | ---- | -| `SELECT` | `SELECT`(含 JOIN、投影、`WHERE` 里的子查询) | -| `INSERT` | `INSERT`(含 `VALUES` 里的子查询) | -| `UPDATE` | `UPDATE`(含赋值与 `WHERE` 里的子查询) | -| `DELETE` | `DELETE`(含 `WHERE` 里的子查询) | -| `ALL` | 上面四种,等价于逐条授权 | - -- 对象写 `*` 表示当前库里所有表;写表名时按**当前库**限定(在 `sales` 库执行 `GRANT ... ON orders` - 授权的是 `sales.orders`),换库要重新授权。 -- 管理员(root)隐式拥有全部权限,不用授权;DDL(建表、建索引等)一律只有管理员能做。 -- 角色语句本身只有管理员能跑;普通账号跑 `\dr` / `GET /api/roles` 会被拒(`administrator required`)。 -- 授权变更立即生效;已经登录的会话不会被踢下线。 -- 当前限制:没有列级授权,没有 `WITH GRANT OPTION`,角色不可继承,也没有自助查询(普通账号不能自己 - 看自己的授权,得问管理员)。 - -Web 端对应的接口是 `/api/roles` 系列(`GET` 列表、`POST` 建角色、`DELETE /api/roles/:name` 删角色、 -`POST/DELETE /api/roles/:name/grants` 授权/收权、`POST/DELETE /api/roles/:name/members[/:user]` 成员), -全部管理员专属。 - -## `chusql-web` 选项 - - chusql-web [options] - -| 选项 | 对应配置键 | 默认 | -| ---- | ---------- | ---- | -| `--config FILE` | — | 固定位置的 `chusql.toml` | -| `--host H` | `[web] host` | `127.0.0.1` | -| `--port N` | `[web] port` | `7778` | -| `--static DIR` | `[web] static_dir` | `static` | -| `--user NAME` | `[web] user` | `root` | -| `--cookie-secure BOOL` | `[web] cookie_secure` | `false` | -| `--body-limit N` | `[web] body_limit` | `65536` | -| `--session-idle N` | `[web] session_idle` | `28800` | -| `--session-max N` | `[web] session_max` | `86400` | -| `--login-max-attempts N` | `[web] login_max_attempts` | `5` | -| `--login-window N` | `[web] login_window` | `300` | -| `--page-size N` | `[web] rows_per_page` | `25` | -| `--max-page-size N` | `[web] max_page_size` | `500` | -| `--max-rows N` | `[web] max_rows` | `1000` | -| `--max-sql-length N` | `[web] max_sql_length` | `20000` | -| `--seed BOOL` | `[web] seed` | `false` | -| `-h, --help` | — | 帮助 | - -REST 接口(界面的一键操作全走结构化接口): - -| 分组 | 接口 | -| ---- | ---- | -| 探活(无需登录) | `GET /api/health`、`GET /api/status` | -| 会话 | `POST /api/login`、`POST /api/logout`、`GET /api/session` | -| 设置 | `GET`/`PUT /api/settings`、`GET`/`PUT /api/ui-settings` | -| 库 | `GET`/`POST /api/databases`、`DELETE /api/databases/:name` | -| 表 | `GET`/`POST /api/tables`、`GET`/`DELETE /api/tables/:t` | -| 行 | `GET`/`POST /api/tables/:t/rows`、`PATCH`/`DELETE /api/tables/:t/rows/:id` | -| 索引与列 | `POST /api/tables/:t/indexes`、`DELETE /api/tables/:t/indexes/:col`、`DELETE /api/tables/:t/columns/:col` | -| 演示数据 | `POST /api/demo-data` | -| SQL 控制台 | `POST /api/query`(`CREATE USER` / `CREATE ROLE` / `GRANT` 也在这里跑) | -| 角色 | `GET`/`POST /api/roles`、`DELETE /api/roles/:name`、`POST`/`DELETE /api/roles/:name/grants`、`POST`/`DELETE /api/roles/:name/members[/:user]` | - -除探活、登录和首页(`GET /`、`GET /static/:file`)外都要带会话 Cookie。选库用 `X-ChuSQL-Database` 头: -**不带这个头就是"没选库"**,此时只有限定名语句(`db.table`)能跑,裸表名会得到 400 `no_database`; -`GET /api/databases` 和 `POST`/`DELETE /api/databases/:name` 不需要选库。普通身份碰 `system` 库一律 403。 - -## `chusql-server` 选项 - - chusql-server [options] - -| 选项 | 对应配置键 | 默认 | -| ---- | ---------- | ---- | -| `--config FILE` | — | 固定位置的 `chusql.toml` | -| `--host H` | `[server] host` | `127.0.0.1` | -| `--port N` | `[server] port` | `7777` | -| `--user NAME` | `[web] user` | `root` | -| `--max-message N` | `[server] max_message` | `1048576` | -| `--max-rows N` | `[server] max_rows` | `1000` | -| `-h, --help` | — | 帮助 | - -启动后打印实际监听地址,它同时是数据目录的唯一持有者:Web 与 `csql` 不开存储,把存储请求交给它转发。 -客户端按**一行一个 JSON** 说话,方法与错误码见 -[architecture.md](architecture.md) 的「TCP 数据库服务」;用 `nc` 手敲一个会话是这样: - - {"method":"hello","protocol":1} - {"method":"login","user":"root","password":"..."} - {"method":"query","sql":"USE test"} - {"method":"query","sql":"SELECT * FROM users"} - {"method":"quit"} - -对话里每条 SQL 走的是和 Web、`csql` 同一套解析与权限检查,账号与库选择互不共享。 diff --git a/doc/config.md b/doc/config.md deleted file mode 100644 index eb3a24c..0000000 --- a/doc/config.md +++ /dev/null @@ -1,110 +0,0 @@ -# 配置选项 - -## 文件在哪 - -整条链路(数据库服务 / Web / 命令行)共用一份 `chusql.toml`,位置固定,**没有环境变量可以覆盖**: - -| 平台 | 路径 | -| ------------ | ---- | -| Windows | `%APPDATA%\ChuSQL\chusql.toml`(`APPDATA` 没设时退到相对路径 `ChuSQL\chusql.toml`) | -| Linux / macOS | `$XDG_CONFIG_HOME/ChuSQL/chusql.toml`,没设就是 `~/.config/ChuSQL/chusql.toml`(`HOME` 也没有才退相对路径 `ChuSQL/chusql.toml`) | - -安装脚本就是把 [`scripts/chusql.toml`](../scripts/chusql.toml) 这份模板写到上面的位置,并把安装时给的 -`user` / `password` / `data_dir` 填进去。想临时读另一份文件,`chusql-server`、`chusql-web`、`csql` -都认 `--config `(启动器 `csql-web` 没有选项,只读固定路径)。 - -优先级:**命令行选项 > 配置文件 > 内置默认**,也就是配置文件写什么,命令行随时能盖掉 -(选项表见 [commands.md](commands.md))。 - -## 分区归属 - -| 分区 | 谁读 | -| ---- | ---- | -| `[page]` `[btree]` `[buffer]` `[storage]` `[log]` | 存储层 `chusql-core/storage`(由 `chusql-server` 装入的动态库) | -| `[server]` | TCP 数据库服务 `chusql-server`(监听地址、端口、单行上限、结果行数上限) | -| `[web]` | Web 服务 `chusql-web` 与命令行 `csql`(账号、会话、限流、分页上限、静态目录) | - -数据目录只有一份配置:`chusql-server` 读它来落盘,别的进程不碰。 - -## 存储的分区 - -| 键 | 默认 | 说明 | -| -- | ---- | ---- | -| `[page] size` | `4096` | 页大小(字节) | -| `[btree] order` | `4` | B+ 树阶 | -| `[buffer] pool_size` | `1024` | 缓冲池页数 | -| `[storage] data_dir` | Windows `%LOCALAPPDATA%\ChuSQL\data`,Linux / macOS `${XDG_DATA_HOME:-~/.local/share}/chusql/data` | 数据落哪(模板里那行是安装时替换的占位) | -| `[log] level` | `info` | 日志级别 | - -数据目录跟着平台惯例走,跟安装脚本装的位置是同一处(Windows 装到 `%LOCALAPPDATA%\ChuSQL`、Unix 装到 -`~/.local/share/chusql`,数据放在它下面的 `data/`);`LOCALAPPDATA`/`XDG_DATA_HOME`/`HOME` 都没有时才退相对路径。 -要固定就写绝对路径。 - -存储层没有自己的命令行选项:它是 `chusql-server` 进程内装入的动态库。 - -## `[web]` 分区 - -| 键 | 命令行(`chusql-web`) | 默认 | 说明 | -| -- | ---------------------- | ---- | ---- | -| `host` | `--host` | `127.0.0.1` | 监听地址 | -| `port` | `--port` | `7778` | 监听端口 | -| `static_dir` | `--static` | `static` | 静态资源目录(候选:给定值、`static`、`chusql-web/static`、`../chusql-web/static`、`../static`,取第一个存在的) | -| `user` | `--user` | 配置文件缺失时 `root` | 管理员账号名 | -| `password` | — | 文件里**没有**这一项时用内置演示口令 `root` / `chusql` | 管理员口令(明文,启动时哈希;见「口令与安全」) | -| `cookie_secure` | `--cookie-secure` | `false` | 给会话 Cookie 加 `Secure`(HTTPS 部署时开) | -| `body_limit` | `--body-limit` | `65536` | 请求体上限(字节) | -| `session_idle` | `--session-idle` | `28800` | 会话空闲超时(秒) | -| `session_max` | `--session-max` | `86400` | 会话最大存活(秒) | -| `login_max_attempts` | `--login-max-attempts` | `5` | 连续失败几次后限流 | -| `login_window` | `--login-window` | `300` | 限流窗口(秒) | -| `rows_per_page` | `--page-size` | `25` | 默认每页行数 | -| `max_page_size` | `--max-page-size` | `500` | 每页行数上限 | -| `max_rows` | `--max-rows` | `1000` | 单次查询返回行数上限 | -| `max_sql_length` | `--max-sql-length` | `20000` | SQL 字符数上限 | -| `seed` | `--seed` | `false` | 库为空时灌演示数据 | -| `password_min_length` | — | `12` | 普通账号口令最短长度(允许 8–256) | -| `password_classes` | — | `2` | 口令至少包含几类字符(允许 1–4:小写/大写/数字/符号) | - -### 键名两种写法都认 - -模板 `scripts/chusql.toml` 用下划线,Web 设置页写的是连字符(规范形式)。两种写法同时出现时**连字符优先**: - - [web] - rows_per_page = 25 # 模板写法 - rows-per-page = 50 # 设置页写法,生效 - -对应关系:`static_dir`→`static-dir`、`session_idle`→`session-idle`、`session_max`→`session-max`、 -`login_max_attempts`→`login-max-attempts`、`login_window`→`login-window`、`body_limit`→`body-limit`、 -`rows_per_page`→`rows-per-page`、`max_page_size`→`max-page-size`、`max_rows`→`max-rows`、 -`max_sql_length`→`max-sql-length`、 -`password_min_length`→`password-min-length`、`password_classes`→`password-classes`。 -`host`、`port`、`user`、`password`、`seed` 只有一种写法。 - -## `[server]` 分区 - -TCP 数据库服务 `chusql-server` 的监听参数。单独一段:别层的进程不认这一段,也不需要认。 - -| 键 | 命令行(`chusql-server`) | 默认 | 说明 | -| -- | ------------------------- | ---- | ---- | -| `host` | `--host` | `127.0.0.1` | 监听地址 | -| `port` | `--port` | `7777` | 监听端口;写 `0` 让系统分配,实际端口打在启动横幅里 | -| `max_message` | `--max-message` | `1048576` | 单行请求上限(字节),超了回 `too_large` | -| `max_rows` | `--max-rows` | `1000` | 单次查询返回行数上限,超了截断并置 `truncated` | - -这四项改完要重启 `chusql-server` 才生效(Web 设置页也把它们标成需要重启)。 - -## 口令与安全 - -- `password` 给了明文 → 启动时哈希;**显式留空**(`password = ""`)= 只允许管理员免密登录,普通账号一律拒绝登录; -- **整个文件里没有 `password` 这一项** → 回落到内置演示口令 `root` / `chusql`(仅用于本机试用,正式部署请写死); -- 普通账号由管理员在 SQL 控制台用 `CREATE USER` / `ALTER USER` / `DROP USER` 管理,口令受 - `password_min_length` / `password_classes` 约束; -- 生产部署建议:`host = 127.0.0.1`(或放在反向代理后)、`cookie_secure = true`、给管理员设口令, - 并且别把数据目录放在共享盘上。 - -## 改配置的两种途径 - -1. 直接编辑 `chusql.toml`(新值在下次启动生效); -2. Web 设置页(`/api/settings`)按分区把改动写回同一份文件——它会写成连字符形式。 - -每一项都带注释的模板在 [`scripts/chusql.toml`](../scripts/chusql.toml)。 diff --git a/doc/install.md b/doc/install.md deleted file mode 100644 index 508642d..0000000 --- a/doc/install.md +++ /dev/null @@ -1,151 +0,0 @@ -# 安装与卸载 - -发行包里的程序是编好的:**装的人不需要 GHC,也不需要 Rust**。没有对应平台的发行包、或者要改代码时, -走「从源码安装」。 - -## 三种安装方式 - -| 方式 | 适用 | 命令 | -| -------- | -------------------------- | -------------------------------------------------------- | -| 在线安装 | 有网络,装最新发行版 | `curl -fsSL .../scripts/install.sh \| sh -s -- --component web` | -| 包内安装 | 手里已有归档(离线、内网) | 解压后在包根跑 `./install.sh --component web` | -| 源码安装 | 没有对应平台资源,或要改代码 | `./install.sh --component web --from-source` | - -Linux / macOS 用 `install.sh`,Windows 用 `install.ps1`;一个平台的发行包里 Web 管理端和命令行 -客户端 `csql` 都有。`--component web` / `cli` / `both` 直接指定装哪几个;不写就**逐个问** -(英文提示,回答 `y` / `n`,直接回车取方括号里的默认值): - - Install the command line client (csql)? [Y/n] - Install the web front end (browser UI)? [y/N] - -默认装 `csql`、不装 Web;可以都装、可以只装一个,也可以两个都不选(那就只装存储库 -`libchusql_core_storage.so` / `chusql_core_storage.dll` 和 `chusql-server`)。**没选的组件一个文件都不会释放**。选完再提示设置管理员的初始口令 -(`--password` / `-RootPassword` 给了就不问)。没有终端、又在跑脚本(比如 `curl | sh`)时问不了, -那时必须显式给 `--component`。 - -## 一、发行包 - -归档由项目在打 tag 时按平台构建上传,名字是 `chusql--`,并附 `.sha256`。一个归档里 -Web 和 cli 两部分都有,装哪几个由包内脚本当场问: - -| 平台 | 资源名 | -| -------------- | ---------------------------------------------------------- | -| Linux x86_64 | `chusql-linux-x86_64.tar.gz` | -| Windows x86_64 | `chusql-windows-x86_64.zip` | -| macOS | `chusql-macos-x86_64.tar.gz`、`chusql-macos-arm64.tar.gz` | - -### 在线安装 - -一行命令:脚本自己按 `uname` 挑资源、校验 sha256、解包、释放、写配置、加 PATH,最后清掉临时包: - - curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh \ - | sh -s -- --component web - -仓库与版本可以改: - - sh -s -- --component cli --repo OWNER/NAME --version v0.3.0 - -`--version` 不写就是 `latest`:脚本先问 GitHub API 要 release 列表,挑**最新的、正式版、且确实带本平台归档** -的那个;列表里一个都不合适就不猜。预发布版(prerelease)不会自动选中——要装就显式写 tag。先看有哪些版本: - - sh -s -- --list-versions - -自建站点(GitHub Enterprise、镜像)用环境变量换基地址,取包和查版本都跟着走: - - CHUSQL_GITHUB_BASE=https://git.example.com sh -s -- --component web - -查版本用的接口未认证时限制 60 次/小时,超了会自动退回 GitHub 的 `latest` 重定向(还能装,但挑不了"最新正式版")。 -CI 里或装得频繁时给个 token,两个脚本都认(`GITHUB_TOKEN` 也可以): - - CHUSQL_GITHUB_TOKEN=ghp_xxx sh -s -- --list-versions - -Windows 是同一套玩法,`install.ps1` 自己下 zip、校验 sha256、解包: - - irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile install.ps1 - .\install.ps1 -Component web - .\install.ps1 -ListVersions - .\install.ps1 -Component cli -Repo OWNER/NAME -Version v0.3.0 - -在线模式只在脚本旁边没有包时才走:`bin\chusql_core_storage.dll` 在脚本旁边就是包内安装,不碰网络。 - -### 指定归档 - -不碰网络下载逻辑,直接指一个归档(本地路径、`file://` 或任意 URL): - - ./install.sh --component web --url dist/chusql-linux-x86_64.tar.gz - ./install.sh --component cli --url https://example.com/chusql-linux-x86_64.tar.gz - -### 包内安装 - -解压发行包后在包根目录直接跑安装脚本,就是最常见的本地安装: - - ./install.sh --component web --user root --password '...' # Linux / macOS - ./install.ps1 -Component web -RootUser root -RootPassword '...' # Windows - -不给 `--component` 就是交互模式,脚本一个个问: - - ./install.sh - .\install.ps1 - -Windows 的 `install.ps1` 两种模式都支持(包内 + 在线),只有源码模式没有——要改代码就在仓库里编。 - -## 二、安装选项 - -| `install.sh` | `install.ps1` | 默认 | 说明 | -| ----------------------- | ---------------- | --------------- | ---- | -| `--component web\|cli\|both` | `-Component` | 逐个问(没有终端时必填) | 装哪个前端 | -| `--interactive` | `-Interactive` | 有终端就问 | 强制从标准输入收答案(`curl \| sh`、自动化里用) | -| `--install-dir DIR` | `-InstallDir` | Linux/macOS `$HOME/.local/share/chusql`;Windows `%LOCALAPPDATA%\ChuSQL` | 程序装到哪 | -| `--data-dir DIR` | `-DataDir` | `/data` | 数据落哪 | -| `--user NAME` | `-RootUser` | `root` | 管理员账号名 | -| `--password PW` | `-RootPassword` | 空 | 管理员口令;留空=只允许管理员免密登录 | -| `--keep-package` | `-KeepPackage` | 否 | 装完不删安装包 | -| `--url URL\|PATH` | — | — | 从这个归档装(只有 `install.sh` 有;Windows 直接解压 zip 走包内安装) | -| `--repo OWNER/NAME` | `-Repo` | `TheBadRoger/ChuSQL` | 从哪个仓库取发行包 | -| `--version TAG` | `-Version` | `latest` | 下载模式是 release tag(`latest`=最新的、带本平台包的正式版),源码模式是 git ref | -| `--list-versions` | `-ListVersions` | — | 列出仓库里的发行 tag(预发布带标记),然后退出 | -| `--from-source` | — | — | 从源码编译安装 | -| `--source-dir DIR` | — | — | 用本地 checkout 编译,不克隆 | - -## 三、从源码安装 - -需要 `git` + `cargo` + `stack` + `ghc`;Linux 上还要 zlib 开发头(`apt-get install zlib1g-dev`): - - ./install.sh --component web --from-source # 克隆仓库再编 - ./install.sh --component web --from-source --source-dir ../ChuSQL # 用本地 checkout - -编完之后的释放、写配置、加 PATH 与包内安装完全相同,启动方式也一样。 - -## 四、装完是什么样 - -以 Linux、`--component web`、默认目录为例(选了 cli 就多一份 `bin/csql` 和一个 `csql` 命令入口): - -| 位置 | 内容 | -| ---- | ---- | -| `~/.local/share/chusql/bin/` | `libchusql_core_storage.so`(一定装)、`chusql-server`(一定装,TCP 数据库服务)、`chusql-web`(选了 Web 才有)、`csql`(选了 cli 才有) | -| `~/.local/share/chusql/static/` | Web 前端静态资源(选 Web 才有) | -| `~/.local/share/chusql/csql-web`、`csql-web.sh` | 启动器与命令入口(选 Web 才有;cli 则是 `csql`) | -| `~/.local/share/chusql/init.sql` | 初始化脚本 | -| `~/.local/share/chusql/logs/` | 日志 | -| `~/.local/share/chusql/data/` | 数据目录(Windows 是 `%LOCALAPPDATA%\ChuSQL\data`;可在 `[storage] data_dir` 改) | -| `~/.config/ChuSQL/chusql.toml` | 全局配置(Windows:`%APPDATA%\ChuSQL\chusql.toml`) | -| `~/.profile` | 追加一段 `# ChuSQL` 标记 + `PATH` 输出(Windows 改的是用户级 PATH) | - -装完开新终端: - - csql-web # 起 Web 前端,默认 http://127.0.0.1:7778 - csql # 进命令行 - chusql-server # 起 TCP 数据库服务,默认 127.0.0.1:7777(客户端连接方式见 commands.md) - -口令留空时只有管理员能进。账号与权限见 [commands.md](commands.md),配置项见 [config.md](config.md)。 - -## 五、卸载 - -没有卸载脚本,手工三步(位置按上面的表): - - rm -rf ~/.local/share/chusql # 程序与数据(数据另存过就只删程序目录) - rm -f ~/.config/ChuSQL/chusql.toml # 全局配置 - # 再编辑 ~/.profile,删掉 "# ChuSQL" 那三行 - -Windows:删 `%LOCALAPPDATA%\ChuSQL` 与 `%APPDATA%\ChuSQL\chusql.toml`,再到「环境变量」里把安装目录 -从用户 PATH 移除。 diff --git a/docs/architecture.md b/docs/architecture.md new file mode 100644 index 0000000..1e5a640 --- /dev/null +++ b/docs/architecture.md @@ -0,0 +1,52 @@ +# 架构与组件 + +ChuSQL 采用客户端 / 服务端架构。数据库文件仅由 `chusql-server` 直接访问,其他组件通过网络接口与数据库服务通信。 + +## 主要组件 + +| 组件 | 作用 | +| --- | --- | +| `chusql-server` | 数据库服务,负责 SQL 执行、权限检查、事务与数据访问 | +| `chusql-web` | Web 管理端,通过数据库服务访问数据 | +| `csql` | 命令行客户端,通过数据库服务执行 SQL | +| `chusql-core/engine` | SQL 解析、语义检查、优化与执行 | +| `chusql-core/storage` | 页面、索引、日志与持久化存储 | + +## 数据流 + +典型访问路径为: + +```text +Web / CLI / 其他客户端 + ↓ + TCP + ↓ +chusql-server + ↓ + SQL 引擎与存储层 + ↓ + 磁盘 +``` + +所有 SQL 和权限检查均由数据库服务统一处理。Web 和 CLI 不直接访问数据目录,因此多个客户端可以同时连接同一数据库服务。 + +## 数据目录 + +数据保存在 `[storage] data_dir` 指定的位置,主要包含: + +| 目录 | 内容 | +| --- | --- | +| `system/` | 系统数据库,包括账号和权限等系统信息 | +| `databases/<数据库名>/` | 用户创建的数据库 | + +安装完成后只有系统数据库,不自动创建业务数据库。业务数据库需通过 `CREATE DATABASE` 创建。 + +## 数据库服务 + +`chusql-server` 默认监听 `127.0.0.1:7777`,客户端建立连接后完成登录、数据库选择和 SQL 执行。 + +每条连接拥有独立会话状态,例如当前数据库选择不会影响其他连接。 + +系统数据库及部分管理操作仅允许管理员访问。 + +服务监听地址、端口和请求限制可在 `chusql.toml` 的 `[server]` 分区中配置。 diff --git a/docs/commands.md b/docs/commands.md new file mode 100644 index 0000000..eb21cfb --- /dev/null +++ b/docs/commands.md @@ -0,0 +1,127 @@ +# 命令与选项 + +ChuSQL 的主要用户命令如下: + +| 命令 | 作用 | +| --- | --- | +| `chusql-server` | 启动数据库服务 | +| `chusql-web` | 启动 Web 管理端 | +| `csql` | 启动命令行客户端 | +| `csql-web` | 按配置启动 Web 管理端 | + +各组件默认使用同一份 `chusql.toml`。需要临时使用其他配置时,可通过 `--config FILE` 指定。 + +## csql + +基本用法: + +```sh +csql [options] +``` + +常用选项: + +| 选项 | 说明 | +| --- | --- | +| `-u, --user USER` | 指定登录账号 | +| `-d, --database DB` | 登录后选择数据库 | +| `-f, --format FORMAT` | 输出格式:`table`、`json` 或 `csv` | +| `-e, --execute SQL` | 执行一条 SQL 后退出 | +| `--history FILE` | 指定历史记录文件 | +| `--config FILE` | 指定配置文件 | +| `-h, --help` | 显示帮助 | + +示例: + +```sh +csql -d sales -e "SELECT * FROM orders LIMIT 5" +csql -f json -e "SELECT count(*) FROM orders" +``` + +### 交互模式 + +SQL 语句以分号结束,可跨多行输入。 + +常用元命令: + +| 命令 | 作用 | +| --- | --- | +| `\q` | 退出 | +| `\?` | 查看帮助 | +| `\l` | 列出数据库 | +| `\dt` | 列出当前数据库中的表 | +| `\d <表>` | 查看表结构 | +| `\c <库>` | 切换数据库 | +| `\f <格式>` | 修改输出格式 | +| `\dr` | 查看角色与授权信息(管理员) | + +## 账号与权限 + +默认管理员账号为 `root`。普通账号创建后默认不拥有数据访问权限,需要管理员通过角色进行授权。 + +常用账号命令: + +```sql +CREATE USER alice IDENTIFIED BY 'password'; +ALTER USER alice IDENTIFIED BY 'new-password'; +DROP USER alice; +``` + +常用角色和授权命令: + +```sql +CREATE ROLE analyst; +GRANT SELECT ON orders TO analyst; +GRANT analyst TO alice; +REVOKE SELECT ON orders FROM analyst; +REVOKE analyst FROM alice; +DROP ROLE analyst; +``` + +当前表级权限包括:`SELECT`、`INSERT`、`UPDATE`、`DELETE` 和 `ALL`。 + +管理员拥有完整权限;数据库、表、索引等结构管理操作仅允许管理员执行。 + +系统数据库 `system` 仅允许管理员访问。 + +## chusql-web + +基本用法: + +```sh +chusql-web [options] +``` + +常用选项: + +| 选项 | 说明 | +| --- | --- | +| `--host H` | 监听地址 | +| `--port N` | 监听端口 | +| `--static DIR` | 静态资源目录 | +| `--user NAME` | 管理员账号名 | +| `--config FILE` | 指定配置文件 | +| `-h, --help` | 显示帮助 | + +其余请求大小、会话、登录限制、分页等参数通常通过 `chusql.toml` 配置即可。 + +## chusql-server + +基本用法: + +```sh +chusql-server [options] +``` + +常用选项: + +| 选项 | 说明 | +| --- | --- | +| `--host H` | 数据库服务监听地址 | +| `--port N` | 数据库服务监听端口 | +| `--max-message N` | 单条请求大小上限 | +| `--max-rows N` | 单次查询返回行数上限 | +| `--config FILE` | 指定配置文件 | +| `-h, --help` | 显示帮助 | + +`chusql-server` 是数据目录的唯一直接访问者。Web、CLI 及其他客户端均通过数据库服务访问数据。 diff --git a/docs/config.md b/docs/config.md new file mode 100644 index 0000000..4b4eb53 --- /dev/null +++ b/docs/config.md @@ -0,0 +1,76 @@ +# 配置选项 + +ChuSQL 使用统一配置文件 `chusql.toml`。默认位置: + +| 平台 | 路径 | +| --- | --- | +| Windows | `%APPDATA%\ChuSQL\chusql.toml` | +| Linux / macOS | `$XDG_CONFIG_HOME/ChuSQL/chusql.toml`;未设置时为 `~/.config/ChuSQL/chusql.toml` | + +`chusql-server`、`chusql-web` 和 `csql` 均可通过 `--config ` 临时指定其他配置文件。配置优先级为:**命令行参数 > 配置文件 > 内置默认值**。 + +## 存储配置 + +| 配置项 | 默认值 | 说明 | +| --- | --- | --- | +| `[page] size` | `4096` | 数据页大小(字节) | +| `[btree] order` | `4` | B+ 树阶数 | +| `[buffer] pool_size` | `1024` | 缓冲池页数 | +| `[storage] data_dir` | 平台默认数据目录 | 数据文件保存位置 | +| `[log] level` | `info` | 日志级别 | + +数据目录仅由 `chusql-server` 访问。生产环境建议使用绝对路径。 + +## Web 配置 + +| 配置项 | 默认值 | 说明 | +| --- | --- | --- | +| `host` | `127.0.0.1` | Web 服务监听地址 | +| `port` | `7778` | Web 服务端口 | +| `static_dir` | `static` | 静态资源目录 | +| `user` | `root` | 管理员账号名 | +| `cookie_secure` | `false` | HTTPS 部署时应启用 | +| `body_limit` | `65536` | 请求体大小上限(字节) | +| `session_idle` | `28800` | 会话空闲超时(秒) | +| `session_max` | `86400` | 会话最大存活时间(秒) | +| `login_max_attempts` | `5` | 登录失败限制阈值 | +| `login_window` | `300` | 登录限制统计窗口(秒) | +| `rows_per_page` | `25` | 默认分页大小 | +| `max_page_size` | `500` | 最大分页大小 | +| `max_rows` | `1000` | 单次查询最大返回行数 | +| `max_sql_length` | `20000` | SQL 最大字符数 | +| `seed` | `false` | 空库时是否写入演示数据 | +| `password_min_length` | `12` | 普通账号最短口令长度 | +| `password_classes` | `2` | 口令至少包含的字符类别数 | + +## Server 配置 + +| 配置项 | 默认值 | 说明 | +| --- | --- | --- | +| `host` | `127.0.0.1` | 数据库服务监听地址 | +| `port` | `7777` | 数据库服务端口 | +| `max_message` | `1048576` | 单条请求最大大小(字节) | +| `max_rows` | `1000` | 单次查询最大返回行数 | + +修改 Server 相关配置后需要重启 `chusql-server`。 + +## 账号与安全 + +账号口令不保存在配置文件中,而保存在系统数据库中。管理员口令在安装或系统引导时设置,之后可通过 SQL 或 Web 管理界面修改。 + +系统目录未完成初始化时,`chusql-server` 将拒绝启动并提示运行 `csql-bootstrap`。 + +对外部署时建议: + +- 数据库服务仅监听受控网络接口; +- Web 服务通过 HTTPS 或反向代理提供; +- HTTPS 环境启用 `cookie_secure`。 + +## 修改配置 + +配置可通过以下方式修改: + +1. 直接编辑 `chusql.toml`; +2. 通过 Web 设置页面修改。 + +大多数配置在相关服务下次启动时生效。 diff --git a/docs/install.md b/docs/install.md new file mode 100644 index 0000000..927fed9 --- /dev/null +++ b/docs/install.md @@ -0,0 +1,110 @@ +# 安装与卸载 + +发行包已经包含编译后的程序,普通用户安装时无需安装 GHC 或 Rust 工具链。 + +## 在线安装 + +Linux / macOS: + +```sh +curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh | sh -s -- --component web +``` + +Windows PowerShell: + +```powershell +irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1" +& "$env:TEMP\install.ps1" -Component web +``` + +## 安装方式 + +ChuSQL 支持三种安装方式: + +| 方式 | 适用场景 | +| --- | --- | +| 在线安装 | 有网络,希望安装发行版本 | +| 包内安装 | 已下载发行包,或处于离线环境 | +| 源码安装 | 当前平台没有发行包,或需要自行修改源码 | + +安装时可以选择 Web 管理端、命令行客户端,或同时安装两者。数据库服务及核心组件会按需安装。 + +安装过程中必须为管理员账号设置口令。口令不会以明文写入配置文件。 + +完成系统目录初始化后,安装程序默认会启动 `chusql-server`;如不希望自动启动,可使用 `--no-start`(Windows 为 `-NoStart`)。 + +## 包内安装 + +解压发行包后,在包根目录执行: + +```sh +./install.sh --component web +``` + +Windows: + +```powershell +.\install.ps1 -Component web +``` + +## 常用安装选项 + +| Linux / macOS | Windows | 说明 | +| --- | --- | --- | +| `--component web\|cli\|both` | `-Component` | 选择安装组件 | +| `--install-dir DIR` | `-InstallDir` | 指定安装目录 | +| `--data-dir DIR` | `-DataDir` | 指定数据目录 | +| `--user NAME` | `-RootUser` | 指定管理员账号名 | +| `--no-start` | `-NoStart` | 安装后不自动启动服务 | +| `--version TAG` | `-Version` | 指定发行版本 | +| `--list-versions` | `-ListVersions` | 列出可安装版本 | +| `--from-source` | — | 从源码构建并安装 | + +自动化安装时建议通过环境变量提供管理员口令,避免口令出现在 shell 历史中。 + +## 从源码安装 + +源码安装需要 `git`、`cargo`、`stack` 和 `ghc`;部分 Linux 环境还需要 zlib 开发包。 + +```sh +./install.sh --component web --from-source +``` + +源码构建完成后的配置、初始化和启动流程与发行包安装一致。 + +## 安装完成后 + +默认安装包含以下主要内容: + +- `chusql-server`:数据库服务; +- `csql`:命令行客户端; +- `chusql-web`:Web 管理端; +- `csql-bootstrap`:系统目录初始化工具; +- `chusql.toml`:全局配置文件; +- 数据目录与日志目录。 + +常用命令: + +```sh +chusql-server +csql +csql-web +``` + +管理员使用安装时设置的口令登录。 + +## 卸载 + +Linux / macOS: + +```sh +./uninstall.sh --yes +``` + +Windows: + +```powershell +.\uninstall.ps1 -Yes +``` + +如需保留数据,可使用 `--keep-data`(Windows 为 `-KeepData`);如需保留配置,可使用 `--keep-config`(Windows 为 `-KeepConfig`)。 diff --git a/scripts/chusql.toml b/scripts/chusql.toml index 04fba01..c2d9f81 100644 --- a/scripts/chusql.toml +++ b/scripts/chusql.toml @@ -3,7 +3,7 @@ # 整条链路共用这一份文件,按分区各管各的,互不影响: # 数据库服务:[server](TCP 监听地址、端口、单行上限、单次结果行数上限) # —— 只有它装入 chusql_core_storage 动态库并独占数据目录 -# Web / 命令行:[web](账号口令、会话、分页上限、静态目录),都经 [server] 走 +# Web / 命令行:[web](账号名、会话、分页上限、静态目录),都经 [server] 走 # 数据目录在 [storage] data_dir;这一行是安装时会替换的占位: # 不写就按平台惯例(Windows %LOCALAPPDATA%\ChuSQL\data, # Unix ${XDG_DATA_HOME:-$HOME/.local/share}/chusql/data)。 @@ -41,9 +41,9 @@ level = "info" host = "127.0.0.1" port = 7778 static_dir = "static" -# 管理员账号与口令。口令留空表示"只允许管理员免密登录",普通账号一律不能登录。 +# 管理员账号名。口令存在系统表 __system_users 里,不写进这份文件; +# 首启为空口令,登录后用 ALTER USER 或在 Web 账号页设置。 user = "root" -password = "" # 会话与登录限流 session_idle = 28800 session_max = 86400 diff --git a/scripts/init.sql b/scripts/init.sql deleted file mode 100644 index 9e9881b..0000000 --- a/scripts/init.sql +++ /dev/null @@ -1,16 +0,0 @@ --- ChuSQL 系统库 schema。 --- --- 系统库(system)不存在就自动建,里面的表都是系统表;这份脚本是它们唯一的定义, --- 存储进程启动时按它声明表结构(见 chusql-core/storage/src/initsql.rs)。 --- 这里只描述"应该长什么样",不包含任何历史数据搬迁。 - -CREATE TABLE __chusql_users ( - id int NOT NULL AUTO_INCREMENT PRIMARY KEY, - user varchar(64) NOT NULL UNIQUE, - password_hash varchar(256) NOT NULL, - registered_at timestamp NOT NULL, - last_login_at timestamp, - revision int NOT NULL -); - -CREATE INDEX __chusql_users (user); diff --git a/scripts/install.ps1 b/scripts/install.ps1 index e8137eb..61d8742 100644 --- a/scripts/install.ps1 +++ b/scripts/install.ps1 @@ -4,18 +4,19 @@ param( [string]$InstallDir = '', [string]$DataDir = '', [string]$RootUser = 'root', - [string]$RootPassword = '', + [string]$Password = '', [string]$Version = 'latest', [string]$Repo = 'TheBadRoger/ChuSQL', [switch]$ListVersions, [switch]$Interactive, - [switch]$KeepPackage + [switch]$KeepPackage, + [switch]$NoStart ) $ErrorActionPreference = 'Stop' -# Windows 安装脚本:从包内或 GitHub 发行版装 cli/web, -# 写全局配置、改用户 PATH,装完删除安装包。 +# Windows 安装脚本:装 cli/web、写全局配置、改用户 PATH、 +# 跑 csql-bootstrap 建系统目录、最后拉起服务。 $script:tempDir = '' @@ -131,13 +132,18 @@ function Ask-YesNo([string]$prompt, [bool]$defaultYes) { } } -# 读取隐藏输入的密码。 +# 读口令:终端里不回显;-Interactive 时从 stdin 逐行读。 function Ask-Secret([string]$prompt) { - if ($askFromStdin) { return (Ask-Line $prompt) } + if ($askFromStdin) { + Write-Host $prompt -NoNewline + $line = [Console]::In.ReadLine() + if ($null -eq $line) { return '' } + return $line + } $secure = Read-Host $prompt -AsSecureString - $bstr = [System.Runtime.InteropServices.Marshal]::SecureStringToBSTR($secure) - try { return [System.Runtime.InteropServices.Marshal]::PtrToStringBSTR($bstr) } - finally { [System.Runtime.InteropServices.Marshal]::ZeroFreeBSTR($bstr) } + $ptr = [System.Runtime.InteropServices.Marshal]::SecureStringToBSTR($secure) + try { return [System.Runtime.InteropServices.Marshal]::PtrToStringBSTR($ptr) } + finally { [System.Runtime.InteropServices.Marshal]::ZeroFreeBSTR($ptr) } } $wantWeb = $false @@ -159,18 +165,30 @@ if (-not $Component) { } } -if (-not $PSBoundParameters.ContainsKey('RootPassword') -and $canPrompt) { +# 管理员口令是装机必答项:交互时当场设,非交互时给 -Password 或 +# CHUSQL_ADMIN_PASSWORD。口令只经 stdin 传给 csql-bootstrap,不落 chusql.toml。 +$adminPassword = "$env:CHUSQL_ADMIN_PASSWORD" +if ($Password) { $adminPassword = $Password } +if ($canPrompt) { Write-Host '' Write-Host ('The administrator account is "{0}".' -f $RootUser) - $firstPassword = Ask-Secret ('Root password for {0} (empty means no password) []:' -f $RootUser) - if ($firstPassword) { - $againPassword = Ask-Secret 'Repeat the root password:' - if ($firstPassword -ne $againPassword) { Fail 'the two passwords do not match' } - Write-Host 'root password set' - } else { - Write-Host 'no root password: administrator-only sign-in' + while ($true) { + $first = Ask-Secret ' Password: ' + if ($first.Length -eq 0) { + Write-Host ' the password cannot be empty' + continue + } + $second = Ask-Secret ' Repeat it: ' + if ($first -ne $second) { + Write-Host ' the two entries differ, try again' + continue + } + $adminPassword = $first + break } - $RootPassword = $firstPassword +} +if ($adminPassword.Length -eq 0) { + Fail 'no administrator password: pass -Password or set CHUSQL_ADMIN_PASSWORD' } $wanted = @() @@ -263,6 +281,7 @@ if (-not (Test-Path (Join-Path $pack 'bin\chusql_core_storage.dll'))) { $storageLib = Join-Path $pack 'bin\chusql_core_storage.dll' if (-not (Test-Path $storageLib)) { Fail "package is incomplete: bin\chusql_core_storage.dll not found in $pack" } if (-not (Test-Path (Join-Path $pack 'bin\chusql-server.exe'))) { Fail 'package is incomplete: bin\chusql-server.exe not found' } +if (-not (Test-Path (Join-Path $pack 'bin\csql-bootstrap.exe'))) { Fail 'package is incomplete: bin\csql-bootstrap.exe not found' } if ($wantWeb) { if (-not (Test-Path (Join-Path $pack 'bin\chusql-web.exe'))) { Fail 'package is incomplete: bin\chusql-web.exe not found' } if (-not (Test-Path (Join-Path $pack 'static'))) { Fail 'package is incomplete: static\ not found' } @@ -279,7 +298,7 @@ Say (" components {0}" -f $componentLabel) if ($downloaded) { Say (" release {0}" -f $Version) } Say (" install to {0}" -f $InstallDir) Say (" data dir {0}" -f $DataDir) -Say (" root user {0}{1}" -f $RootUser, $(if ($RootPassword) { '' } else { ' (no password: administrator-only sign-in)' })) +Say (" root user {0} (password asked above, kept out of chusql.toml)" -f $RootUser) # ---- 释放文件 ---- # 包是合在一起的(web 和 cli 都在),这里按这次的选择逐个释放:没选的组件不落地 @@ -287,6 +306,7 @@ Step 'Installing files' New-Item -ItemType Directory -Force -Path (Join-Path $InstallDir 'bin'), (Join-Path $InstallDir 'logs'), $DataDir | Out-Null Copy-Item $storageLib (Join-Path $InstallDir 'bin') -Force Copy-Item (Join-Path $pack 'bin\chusql-server.exe') (Join-Path $InstallDir 'bin') -Force +Copy-Item (Join-Path $pack 'bin\csql-bootstrap.exe') (Join-Path $InstallDir 'bin') -Force Get-ChildItem (Join-Path $pack 'bin') -Filter '*.dll' -File -ErrorAction SilentlyContinue | ForEach-Object { Copy-Item $_.FullName (Join-Path $InstallDir 'bin') -Force } if ($wantCli) { @@ -310,12 +330,22 @@ $configDir = if ($env:APPDATA) { Join-Path $env:APPDATA 'ChuSQL' } else { Join-P $configFile = Join-Path $configDir 'chusql.toml' $toml = Get-Content -Path $template -Raw -Encoding UTF8 $toml = $toml -replace '(?m)^(\s*user\s*=\s*).*$', "`$1`"$RootUser`"" -$toml = $toml -replace '(?m)^(\s*password\s*=\s*).*$', "`$1`"$RootPassword`"" $toml = $toml -replace '(?m)^(\s*data_dir\s*=\s*).*$', "`$1`"$($DataDir -replace '\\', '/')`"" New-Item -ItemType Directory -Force -Path $configDir | Out-Null Set-Content -Path $configFile -Value $toml -Encoding UTF8 Say (" config file {0}" -f $configFile) -Copy-Item (Join-Path $pack 'scripts\init.sql') $InstallDir -Force -ErrorAction SilentlyContinue + +# ---- 引导系统目录 ---- +# csql-bootstrap 建 system 数据库和 __system_users 表,口令只走 stdin,不进 chusql.toml +Step 'Creating the system catalog' +$bootstrap = Join-Path $InstallDir 'bin\csql-bootstrap.exe' +$bootstrapArgs = @('--config', $configFile, '--user', $RootUser) +$bootstrapArgs += '--password-stdin' +$bootstrapOutput = $adminPassword | & $bootstrap @bootstrapArgs 2>&1 +$bootstrapOutput | ForEach-Object { Say (" {0}" -f $_) } +if ($LASTEXITCODE -ne 0) { + Fail ("the bootstrap program failed (exit {0}); the system catalog is not ready" -f $LASTEXITCODE) +} # ---- 命令入口 ---- Step 'Creating commands' @@ -365,6 +395,27 @@ if (-not $KeepPackage) { Say ("kept the downloaded package: {0}" -f $tempDir) } +Step 'Starting the server' +$serverPath = Join-Path $InstallDir 'bin\chusql-server.exe' +$serverPid = 0 +if ($NoStart) { + Say ' -NoStart: the server was not started' +} else { + $serverLog = Join-Path $InstallDir 'logs\server.err.log' + $serverProc = Start-Process -FilePath $serverPath ` + -ArgumentList @('--config', $configFile) ` + -WorkingDirectory $InstallDir -WindowStyle Hidden -PassThru ` + -RedirectStandardOutput (Join-Path $InstallDir 'logs\server.log') ` + -RedirectStandardError $serverLog + Start-Sleep -Milliseconds 1200 + if ($serverProc.HasExited) { + Fail ("the server stopped right away (exit {0}); look at {1}" -f $serverProc.ExitCode, $serverLog) + } + $serverPid = $serverProc.Id + Say (" server running, pid {0}" -f $serverPid) + Say (" log {0}" -f $serverLog) +} + Step 'Done' Say (" chusql.toml {0}" -f $configFile) Say (" data {0}" -f $DataDir) @@ -372,4 +423,9 @@ $startWith = @() if ($wantWeb) { $startWith += 'csql-web' } if ($wantCli) { $startWith += 'csql' } Say (" start with {0}" -f ($startWith -join ', ')) -Say (" tcp server {0} (listens on [server] host/port, defaults 127.0.0.1:7777)" -f (Join-Path $InstallDir 'bin\chusql-server.exe')) +Say (" tcp server {0} (listens on [server] host/port, defaults 127.0.0.1:7777)" -f $serverPath) +if ($serverPid -gt 0) { + Say (" running pid {0} (stop it with: Stop-Process -Id {0})" -f $serverPid) +} else { + Say (" start it {0} --config `"{1}`"" -f $serverPath, $configFile) +} diff --git a/scripts/install.sh b/scripts/install.sh index f76de47..fbe0a85 100644 --- a/scripts/install.sh +++ b/scripts/install.sh @@ -1,8 +1,8 @@ #!/bin/sh set -eu -# ChuSQL 安装脚本(Linux/macOS):从包内、发行版或源码装 cli/web, -# 写全局配置、改 PATH,装完删除安装包。 +# ChuSQL 安装脚本(Linux/macOS):装 cli/web、写全局配置、 +# 改 PATH、跑 csql-bootstrap 建系统目录、最后拉起服务。 default_repo='TheBadRoger/ChuSQL' @@ -28,16 +28,20 @@ usage: ./install.sh [--component web|cli|both] [options] asks (English, y/n), command line client first: command line client (csql)? default yes [Y/n] web front end (browser UI)? default no [y/N] + it then asks whether to give the administrator account a + password (default no); that password goes straight into the + system catalog and is never written to chusql.toml --interactive ask even when there is no terminal; the answers are read from stdin (one per line) --install-dir DIR where to install (default: $HOME/.local/share/chusql) --data-dir DIR where to keep data (default: /data) --user NAME administrator name (default: root) - --password PW administrator password, empty means no password - (administrator-only sign-in). Leave it out and the - installer asks for it, twice, with the echo off. --keep-package do not delete the downloaded/extracted package + --password VALUE password of the administrator account (required when + there is no terminal to ask on; shows up in the shell + history, so CHUSQL_ADMIN_PASSWORD is safer) + --no-start do not start the server after installing where the files come from: (default) a package next to this script, else the newest GitHub release @@ -51,6 +55,8 @@ where the files come from: -h, --help this text environment: + CHUSQL_ADMIN_PASSWORD password of the administrator account, same as + --password CHUSQL_GITHUB_BASE GitHub base URL: GitHub Enterprise, a mirror, or a local test fixture (default: https://github.com) CHUSQL_GITHUB_TOKEN token for the version API (or GITHUB_TOKEN); without @@ -62,8 +68,9 @@ component='' install_dir='' data_dir='' root_user='root' -root_password='' keep_package='no' +password_arg='' +no_start='no' repo="$default_repo" version='latest' url_arg='' @@ -71,7 +78,6 @@ from_source='no' source_dir='' list_versions='no' interactive_flag='no' -password_given='no' want_web='no' want_cli='no' @@ -81,8 +87,9 @@ while [ $# -gt 0 ]; do --install-dir) install_dir="${2:-}"; shift 2 ;; --data-dir) data_dir="${2:-}"; shift 2 ;; --user) root_user="${2:-}"; shift 2 ;; - --password) root_password="${2:-}"; password_given='yes'; shift 2 ;; --keep-package) keep_package='yes'; shift ;; + --password) password_arg="${2:-}"; shift 2 ;; + --no-start) no_start='yes'; shift ;; --url) url_arg="${2:-}"; shift 2 ;; --repo) repo="${2:-}"; shift 2 ;; --version) version="${2:-}"; shift 2 ;; @@ -148,27 +155,6 @@ read_line() { # -> $line(读到空行也算成功) fi } -read_secret() { # read_secret PROMPT -> 值写到 stdout(提示和换行都走 stderr,回显关掉) - printf '%s' "$1" >&2 - if [ "$answers" = 'stdin' ]; then - IFS= read -r secret_line || secret_line='' - else - saved='' - if command -v stty >/dev/null 2>&1; then - saved=$(stty -g < "$answers" 2>/dev/null) || saved='' - stty -echo < "$answers" 2>/dev/null || true - fi - IFS= read -r secret_line < "$answers" || secret_line='' - if [ -n "$saved" ]; then - stty "$saved" < "$answers" 2>/dev/null || true - elif command -v stty >/dev/null 2>&1; then - stty echo < "$answers" 2>/dev/null || true - fi - fi - printf '\n' >&2 - printf '%s' "$secret_line" -} - ask_yes_no() { # ask_yes_no PROMPT DEFAULT(y|n) -> $reply = yes|no while :; do printf '%s ' "$1" >&2 @@ -183,6 +169,24 @@ ask_yes_no() { # ask_yes_no PROMPT DEFAULT(y|n) -> $reply = yes|no done } +# 读一行口令 -> $line;从终端读时关掉回显(-interactive 从 stdin 读,没法关)。 +read_secret() { + if [ "$answers" = 'stdin' ]; then + read_line + return 0 + fi + _saved=$(stty -g < "$answers" 2>/dev/null) || _saved='' + stty -echo < "$answers" 2>/dev/null || true + read_line + if [ -n "$_saved" ]; then + stty "$_saved" < "$answers" 2>/dev/null || true + else + stty echo < "$answers" 2>/dev/null || true + fi + printf '\n' >&2 + return 0 +} + if [ "$component" = '' ] && [ "$list_versions" = 'no' ]; then if [ "$can_prompt" = 'no' ]; then fail '--component is required (web, cli or both) when there is no terminal to ask on' @@ -198,18 +202,36 @@ if [ "$component" = '' ] && [ "$list_versions" = 'no' ]; then fi fi -if [ "$list_versions" = 'no' ] && [ "$password_given" = 'no' ] && [ "$can_prompt" = 'yes' ]; then - echo - echo "The administrator account is $root_user." - first=$(read_secret "Root password for $root_user (empty means no password) []: ") - if [ -n "$first" ]; then - again=$(read_secret 'Repeat the root password: ') - [ "$first" = "$again" ] || fail 'the two passwords do not match' - echo 'root password set' >&2 - else - echo 'no root password: administrator-only sign-in' >&2 +# 管理员口令是装机必答项:交互时当场设,非交互时给 --password 或 +# CHUSQL_ADMIN_PASSWORD。口令只经 stdin 传给 csql-bootstrap,不落 chusql.toml。 +admin_password="${CHUSQL_ADMIN_PASSWORD:-}" +if [ "$list_versions" = 'no' ]; then + if [ -n "$password_arg" ]; then + admin_password="$password_arg" + fi + if [ "$can_prompt" = 'yes' ]; then + echo + echo "The administrator account is $root_user." + while :; do + printf ' Password: ' >&2 + read_secret + admin_password="$line" + if [ -z "$admin_password" ]; then + echo ' the password cannot be empty' >&2 + continue + fi + printf ' Repeat it: ' >&2 + read_secret + if [ "$line" != "$admin_password" ]; then + echo ' the two entries differ, try again' >&2 + continue + fi + break + done + fi + if [ -z "$admin_password" ]; then + fail 'no administrator password: pass --password PASSWORD or set CHUSQL_ADMIN_PASSWORD' fi - root_password="$first" fi # 选中的组件:空格分隔的清单,外加一个显示名(cli 或 web,两个就是 cli+web) @@ -484,7 +506,7 @@ if [ "$from_source" = 'yes' ]; then pack="$tmp/stage" mkdir -p "$pack/bin" "$pack/scripts" cp "$storage_lib" "$pack/bin/" - cp "$src/scripts/chusql.toml" "$src/scripts/init.sql" "$pack/scripts/" + cp "$src/scripts/chusql.toml" "$pack/scripts/" cp "$src/scripts/install.sh" "$pack/" for comp in $wanted; do if [ "$comp" = 'web' ]; then @@ -518,6 +540,14 @@ if [ "$from_source" = 'yes' ]; then [ -n "$server_root" ] || fail 'cannot ask stack for --local-install-root' [ -f "$server_root/bin/chusql-server" ] || fail "chusql-server not found after the build: $server_root/bin/chusql-server" cp "$server_root/bin/chusql-server" "$pack/bin/" + + # 引导程序独立成工程:建 system 目录不依赖服务本身,坏了还能单独重跑 + step 'Building the bootstrap program (stack build --fast chusql-bootstrap:exe:csql-bootstrap)' + ( cd "$src/chusql-bootstrap" && stack build --fast chusql-bootstrap:exe:csql-bootstrap ) || fail 'stack build failed in chusql-bootstrap' + bootstrap_root=$( cd "$src/chusql-bootstrap" && stack path --local-install-root 2>/dev/null | tr -d '\r' ) + [ -n "$bootstrap_root" ] || fail 'cannot ask stack for --local-install-root' + [ -f "$bootstrap_root/bin/csql-bootstrap" ] || fail "csql-bootstrap not found after the build: $bootstrap_root/bin/csql-bootstrap" + cp "$bootstrap_root/bin/csql-bootstrap" "$pack/bin/" elif [ -n "$url_arg" ]; then # ---------- 指定 URL / 本地归档 ---------- new_tmp @@ -567,6 +597,7 @@ fi # ---- 校验包内容 ---- ls "$pack/bin/"libchusql_core_storage.* >/dev/null 2>&1 || fail "package is incomplete: bin/libchusql_core_storage.* not found in $pack" [ -f "$pack/bin/chusql-server" ] || fail "package is incomplete: bin/chusql-server not found in $pack" +[ -f "$pack/bin/csql-bootstrap" ] || fail "package is incomplete: bin/csql-bootstrap not found in $pack" if [ "$want_web" = 'yes' ]; then [ -f "$pack/bin/chusql-web" ] || fail 'package is incomplete: bin/chusql-web not found' [ -d "$pack/static" ] || fail 'package is incomplete: static/ not found' @@ -581,17 +612,14 @@ echo " version $version" echo " components $component_label" echo " install to $install_dir" echo " data dir $data_dir" -if [ -n "$root_password" ]; then - echo " root user $root_user" -else - echo " root user $root_user (no password: administrator-only sign-in)" -fi +echo " root user $root_user (password asked above, kept out of chusql.toml)" # ---- 释放文件 ---- # 包是合在一起的(web 和 cli 都在),这里按这次的选择逐个释放:没选的组件不落地 step 'Installing files' mkdir -p "$install_dir/bin" "$install_dir/logs" "$data_dir" cp "$pack/bin/chusql-server" "$install_dir/bin/" +cp "$pack/bin/csql-bootstrap" "$install_dir/bin/" for lib in "$pack/bin/"libchusql_core_storage.*; do if [ -f "$lib" ]; then cp "$lib" "$install_dir/bin/"; fi done @@ -618,11 +646,17 @@ config_dir="${XDG_CONFIG_HOME:-$HOME/.config}/ChuSQL" config_file="$config_dir/chusql.toml" mkdir -p "$config_dir" sed -e "s|^\(user[[:space:]]*=[[:space:]]*\).*|\1\"$root_user\"|" \ - -e "s|^\(password[[:space:]]*=[[:space:]]*\).*|\1\"$root_password\"|" \ -e "s|^\(data_dir[[:space:]]*=[[:space:]]*\).*|\1\"$data_dir\"|" \ "$pack/scripts/chusql.toml" > "$config_file" echo " config file $config_file" -if [ -f "$pack/scripts/init.sql" ]; then cp "$pack/scripts/init.sql" "$install_dir/"; fi + +# ---- 引导系统目录 ---- +# csql-bootstrap 建 system 数据库和 __system_users 表;口令只走 stdin,不进 chusql.toml +step 'Creating the system catalog' +bootstrap="$install_dir/bin/csql-bootstrap" +[ -n "$admin_password" ] || fail 'the administrator password is required' +printf '%s\n' "$admin_password" | "$bootstrap" --config "$config_file" --user "$root_user" --password-stdin || + fail 'the bootstrap program failed; the system catalog is not ready' # ---- 命令入口 ---- step 'Creating commands' @@ -676,6 +710,24 @@ else echo " package kept at $pack" fi +# ---- 拉起服务 ---- +server_bin="$install_dir/bin/chusql-server" +server_pid='' +if [ "$no_start" = 'yes' ]; then + note '--no-start: the server was not started' +else + step 'Starting the server' + mkdir -p "$install_dir/logs" + nohup "$server_bin" --config "$config_file" > "$install_dir/logs/server.log" 2> "$install_dir/logs/server.err.log" & + server_pid=$! + sleep 1 + if ! kill -0 "$server_pid" 2>/dev/null; then + fail "the server stopped right away; look at $install_dir/logs/server.err.log" + fi + note "server running, pid $server_pid" + note "log $install_dir/logs/server.err.log" +fi + step 'Done' echo " chusql.toml $config_file" echo " data $data_dir" @@ -685,4 +737,9 @@ if [ "$want_cli" = 'yes' ]; then if [ -n "$start_with" ]; then start_with="$start_with, csql"; else start_with='csql'; fi fi echo " start with $start_with" -echo " tcp server $install_dir/bin/chusql-server (listens on [server] host/port, defaults 127.0.0.1:7777)" +echo " tcp server $server_bin (listens on [server] host/port, defaults 127.0.0.1:7777)" +if [ -n "$server_pid" ]; then + echo " running pid $server_pid (stop it with: kill $server_pid)" +else + echo " start it $server_bin --config \"$config_file\"" +fi diff --git a/scripts/package.ps1 b/scripts/package.ps1 index 09871fd..5da3180 100644 --- a/scripts/package.ps1 +++ b/scripts/package.ps1 @@ -49,11 +49,14 @@ function Assert-Stage([string]$stage) { 'bin\csql.exe', 'bin\chusql-web.exe', 'bin\chusql-server.exe', + 'bin\csql-bootstrap.exe', 'static\index.html', 'csql-web.ps1', 'scripts\chusql.toml', 'install.ps1', - 'install.sh' + 'install.sh', + 'uninstall.ps1', + 'uninstall.sh' ) foreach ($rel in $must) { if (-not (Test-Path (Join-Path $stage $rel))) { @@ -61,7 +64,7 @@ function Assert-Stage([string]$stage) { } } # bin 里带 chusql 名字的文件只能是已知产物;改名前的残留或别的垃圾都算装配错误 - $known = @('chusql_core_storage.dll', 'chusql-server.exe', 'chusql-web.exe') + $known = @('chusql_core_storage.dll', 'chusql-server.exe', 'chusql-web.exe', 'csql-bootstrap.exe') $unknown = @(Get-ChildItem (Join-Path $stage 'bin') -Filter 'chusql*' -File -ErrorAction SilentlyContinue | Where-Object { $known -notcontains $_.Name }) if ($unknown.Count -gt 0) { @@ -91,7 +94,7 @@ function Test-Installed([string]$name, [string]$comp) { $pwsh = Join-Path $PSHOME 'pwsh.exe' if (-not (Test-Path $pwsh)) { $pwsh = 'powershell' } & $pwsh -NoProfile -File (Join-Path $pkg 'install.ps1') -Component $comp -InstallDir $opt ` - -DataDir $data -RootUser root -RootPassword package-check *>&1 | Out-File -FilePath $log -Encoding UTF8 + -DataDir $data -RootUser root -Password 'verify-package' -NoStart *>&1 | Out-File -FilePath $log -Encoding UTF8 if ($LASTEXITCODE -ne 0) { Get-Content $log | Select-Object -First 120 | Write-Host Fail "$name`: installing the $comp part from the package failed (log above)" @@ -100,7 +103,8 @@ function Test-Installed([string]$name, [string]$comp) { $checks = @( (Join-Path $opt 'bin\chusql_core_storage.dll'), (Join-Path $opt 'bin\chusql-server.exe'), - (Join-Path $opt 'init.sql'), + (Join-Path $opt 'bin\csql-bootstrap.exe'), + (Join-Path $data 'system\catalog.json'), (Join-Path $appdata 'ChuSQL\chusql.toml') ) $forbidden = @() @@ -162,6 +166,13 @@ if (-not $NoBuild) { if ($LASTEXITCODE -ne 0) { Fail "stack build --fast $target failed" } } finally { Pop-Location } } + + Step 'Building chusql-bootstrap:exe:csql-bootstrap (Haskell)' + Push-Location (Join-Path $repoRoot 'chusql-bootstrap') + try { + & stack build --fast chusql-bootstrap:exe:csql-bootstrap + if ($LASTEXITCODE -ne 0) { Fail 'stack build --fast csql-bootstrap failed' } + } finally { Pop-Location } } # ---------- 装配 + 打归档 ---------- @@ -194,13 +205,26 @@ try { Copy-Item $front (Join-Path $stage 'bin') } + # 引导程序住在自己的工程里,安装根也单独问它要 + Push-Location (Join-Path $repoRoot 'chusql-bootstrap') + try { $bootstrapRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim() } finally { Pop-Location } + $bootstrapExe = Join-Path $bootstrapRoot 'bin/csql-bootstrap.exe' + if (-not (Test-Path $bootstrapExe)) { + $bootstrapExe = Get-ChildItem -Path (Join-Path $repoRoot 'chusql-bootstrap\.stack-work') ` + -Recurse -Filter 'csql-bootstrap.exe' -File -ErrorAction SilentlyContinue | + Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName + } + if (-not $bootstrapExe -or -not (Test-Path $bootstrapExe)) { Fail 'csql-bootstrap.exe is not built (run without -NoBuild)' } + Copy-Item $bootstrapExe (Join-Path $stage 'bin') + # 第三方 dll 才要连带上:名字带 chusql 的是本 crate 产物或改名前的残留,上面已按名拷过 Get-ChildItem (Join-Path $repoRoot 'chusql-core\storage\target\release') -Filter '*.dll' -File -ErrorAction SilentlyContinue | Where-Object { $_.Name -notlike 'chusql*' } | ForEach-Object { Copy-Item $_.FullName (Join-Path $stage 'bin') } - Copy-Item (Join-Path $repoRoot 'scripts\chusql.toml'), (Join-Path $repoRoot 'scripts\init.sql') (Join-Path $stage 'scripts') + Copy-Item (Join-Path $repoRoot 'scripts\chusql.toml') (Join-Path $stage 'scripts') Copy-Item (Join-Path $repoRoot 'scripts\install.ps1'), (Join-Path $repoRoot 'scripts\install.sh') $stage + Copy-Item (Join-Path $repoRoot 'scripts\uninstall.ps1'), (Join-Path $repoRoot 'scripts\uninstall.sh') $stage New-Item -ItemType Directory -Force -Path (Join-Path $stage 'static') | Out-Null Copy-Item (Join-Path $repoRoot 'chusql-web\static\*') (Join-Path $stage 'static') -Recurse Copy-Item (Join-Path $repoRoot 'scripts\csql-web.sh') $stage diff --git a/scripts/package.sh b/scripts/package.sh index 9b4f1a2..da744aa 100644 --- a/scripts/package.sh +++ b/scripts/package.sh @@ -90,16 +90,19 @@ check_stage() { [ -f "$stage/bin/csql" ] || Fail 'bin/csql is missing from the package' [ -f "$stage/bin/chusql-web" ] || Fail 'bin/chusql-web is missing from the package' [ -f "$stage/bin/chusql-server" ] || Fail 'bin/chusql-server is missing from the package' + [ -f "$stage/bin/csql-bootstrap" ] || Fail 'bin/csql-bootstrap is missing from the package' [ -f "$stage/static/index.html" ] || Fail 'static/index.html is missing from the package' [ -f "$stage/csql-web.sh" ] || Fail 'csql-web.sh is missing from the package' [ -f "$stage/scripts/chusql.toml" ] || Fail 'scripts/chusql.toml is missing from the package' [ -f "$stage/install.sh" ] || Fail 'install.sh is missing from the package' [ -f "$stage/install.ps1" ] || Fail 'install.ps1 is missing from the package' + [ -f "$stage/uninstall.sh" ] || Fail 'uninstall.sh is missing from the package' + [ -f "$stage/uninstall.ps1" ] || Fail 'uninstall.ps1 is missing from the package' # bin 里带 chusql 名字的文件只能是已知产物;改名前的残留或别的垃圾都算装配错误 for f in "$stage"/bin/chusql* "$stage"/bin/libchusql*; do [ -e "$f" ] || continue case "$(basename "$f")" in - libchusql_core_storage.so|libchusql_core_storage.dylib|libchusql_core_storage.dll|chusql-server|chusql-web) ;; + libchusql_core_storage.so|libchusql_core_storage.dylib|libchusql_core_storage.dll|chusql-server|chusql-web|csql-bootstrap) ;; *) Fail "unexpected artifact in bin/: $(basename "$f")" ;; esac done @@ -116,8 +119,10 @@ verify_package() { rm -rf "$vtmp" Fail "$name: the archive does not unpack" fi - if ! ( cd "$vtmp/pkg" && HOME="$vtmp/home" sh install.sh --component "$comp" \ - --install-dir "$vtmp/opt" --data-dir "$vtmp/data" --user root --password package-check ) \ + if ! ( cd "$vtmp/pkg" && HOME="$vtmp/home" CHUSQL_ADMIN_PASSWORD='verify-package' \ + sh install.sh --component "$comp" \ + --install-dir "$vtmp/opt" --data-dir "$vtmp/data" --user root \ + --no-start ) \ >"$vtmp/log" 2>&1; then sed -n '1,120p' "$vtmp/log" >&2 rm -rf "$vtmp" @@ -126,7 +131,8 @@ verify_package() { ok=yes ls "$vtmp/opt/bin/"libchusql_core_storage.* >/dev/null 2>&1 || ok=no [ -f "$vtmp/opt/bin/chusql-server" ] || ok=no - [ -f "$vtmp/opt/init.sql" ] || ok=no + [ -f "$vtmp/opt/bin/csql-bootstrap" ] || ok=no + [ -f "$vtmp/data/system/catalog.json" ] || ok=no [ -f "$vtmp/home/.config/ChuSQL/chusql.toml" ] || ok=no grep -q "data_dir = \"$vtmp/data\"" "$vtmp/home/.config/ChuSQL/chusql.toml" || ok=no if [ "$comp" = web ]; then @@ -164,6 +170,8 @@ if [ "$build" = yes ]; then ( cd "$repo_root/chusql-cli" && stack build --fast chusql-cli:exe:csql ) Step 'Building the TCP database server (Haskell)' ( cd "$repo_root/chusql-cli" && stack build --fast chusql-server:exe:chusql-server ) + Step 'Building the bootstrap program (Haskell)' + ( cd "$repo_root/chusql-bootstrap" && stack build --fast chusql-bootstrap:exe:csql-bootstrap ) fi # ---------- 装配 + 打归档 ---------- @@ -191,6 +199,15 @@ for front_name in chusql-web chusql-server csql; do cp "$front" "$stage/bin/" done +# 引导程序住在自己的工程里,安装根也单独问它要 +bootstrap_root=$(cd "$repo_root/chusql-bootstrap" && stack path --local-install-root | tail -n 1 | tr -d '\r') +bootstrap_bin="$bootstrap_root/bin/csql-bootstrap" +if [ ! -f "$bootstrap_bin" ]; then + bootstrap_bin=$(find "$repo_root/chusql-bootstrap/.stack-work" -name csql-bootstrap -type f 2>/dev/null | head -n 1 || true) +fi +[ -n "$bootstrap_bin" ] && [ -f "$bootstrap_bin" ] || Fail 'csql-bootstrap is not built (run without --no-build)' +cp "$bootstrap_bin" "$stage/bin/" + # Haskell 一般静态链接,靶目录里真有共享库就一起带上;改名前的旧库(libchusql_storage.*)不能进包 for lib in "$repo_root"/chusql-core/storage/target/release/*.so "$repo_root"/chusql-core/storage/target/release/*.dylib; do [ -f "$lib" ] || continue @@ -200,13 +217,13 @@ for lib in "$repo_root"/chusql-core/storage/target/release/*.so "$repo_root"/chu cp "$lib" "$stage/bin/" done -cp "$repo_root/scripts/chusql.toml" "$repo_root/scripts/init.sql" "$stage/scripts/" -cp "$repo_root/scripts/install.sh" "$repo_root/scripts/install.ps1" "$stage/" +cp "$repo_root/scripts/chusql.toml" "$stage/scripts/" +cp "$repo_root/scripts/install.sh" "$repo_root/scripts/install.ps1" "$repo_root/scripts/uninstall.sh" "$repo_root/scripts/uninstall.ps1" "$stage/" mkdir -p "$stage/static" cp -R "$repo_root"/chusql-web/static/. "$stage/static/" cp "$repo_root/scripts/csql-web.sh" "$stage/" if [ -f "$repo_root/scripts/csql-web.ps1" ]; then cp "$repo_root/scripts/csql-web.ps1" "$stage/"; fi -chmod +x "$stage/install.sh" "$stage/csql-web.sh" +chmod +x "$stage/install.sh" "$stage/uninstall.sh" "$stage/csql-web.sh" check_stage "$stage" diff --git a/scripts/uninstall.ps1 b/scripts/uninstall.ps1 new file mode 100644 index 0000000..9b3378e --- /dev/null +++ b/scripts/uninstall.ps1 @@ -0,0 +1,102 @@ +[CmdletBinding()] +param( + [string]$InstallDir = '', + [string]$DataDir = '', + [switch]$KeepData, + [switch]$KeepConfig, + [switch]$Yes +) + +$ErrorActionPreference = 'Stop' + +# Windows 卸载脚本:停服务、删程序与配置、从用户 PATH 摘掉安装目录。 +# 数据目录默认一起删,-KeepData 保留。 + +# 打印步骤标题。 +function Step([string]$msg) { Write-Host ''; Write-Host "==> $msg" -ForegroundColor Cyan } +# 打印一行输出。 +function Say([string]$msg) { Write-Host $msg } +# 报错退出。 +function Fail([string]$msg) { Write-Host "!! $msg" -ForegroundColor Red; exit 1 } + +if (-not $InstallDir) { $InstallDir = Join-Path $env:LOCALAPPDATA 'ChuSQL' } +if (-not $DataDir) { $DataDir = Join-Path $InstallDir 'data' } +$InstallDir = [System.IO.Path]::GetFullPath($InstallDir) +$DataDir = [System.IO.Path]::GetFullPath($DataDir) +$configDir = if ($env:APPDATA) { Join-Path $env:APPDATA 'ChuSQL' } else { Join-Path $InstallDir 'config' } +$configFile = Join-Path $configDir 'chusql.toml' + +if (-not $Yes) { + if ([Console]::IsInputRedirected) { + Fail 'no terminal: rerun with -Yes to confirm' + } + Say 'ChuSQL uninstaller' + Say (" install dir {0}" -f $InstallDir) + Say (" data dir {0}" -f $DataDir) + if ($KeepData) { Say ' data kept' } + $answer = (Read-Host 'Remove it? [y/N]').Trim() + if ($answer -notmatch '^(y|yes)$') { + Say 'nothing was removed' + exit 0 + } +} + +Step 'Stopping the service' +$running = @(Get-Process -Name 'chusql-server', 'chusql-web' -ErrorAction SilentlyContinue | + Where-Object { + try { $_.Path -and $_.Path.StartsWith($InstallDir, [StringComparison]::OrdinalIgnoreCase) } + catch { $false } + }) +foreach ($proc in $running) { + Stop-Process -Id $proc.Id -Force -ErrorAction SilentlyContinue + Say (" stopped {0} (pid {1})" -f $proc.ProcessName, $proc.Id) +} +if ($running.Count -eq 0) { Say ' nothing was running' } + +Step 'Removing files' +if (-not (Test-Path $InstallDir)) { + Say (" not found: {0}" -f $InstallDir) +} elseif ($KeepData) { + Get-ChildItem -LiteralPath $InstallDir -Force | ForEach-Object { + if ($_.FullName -eq $DataDir) { + Say (" kept data: {0}" -f $_.FullName) + } else { + Remove-Item -LiteralPath $_.FullName -Recurse -Force -ErrorAction SilentlyContinue + } + } + Say (" kept {0} (data only)" -f $InstallDir) +} else { + Remove-Item -LiteralPath $InstallDir -Recurse -Force + if (-not $DataDir.StartsWith($InstallDir, [StringComparison]::OrdinalIgnoreCase)) { + Remove-Item -LiteralPath $DataDir -Recurse -Force -ErrorAction SilentlyContinue + } + Say (" removed {0}" -f $InstallDir) +} + +Step 'Removing chusql.toml' +if ($KeepConfig) { + Say (" kept config: {0}" -f $configFile) +} else { + if (Test-Path $configFile) { + Remove-Item -LiteralPath $configFile -Force + Say (" removed config: {0}" -f $configFile) + } else { + Say (" no config file: {0}" -f $configFile) + } + if (Test-Path $configDir) { Remove-Item -LiteralPath $configDir -Force -ErrorAction SilentlyContinue } +} + +Step 'Removing the PATH entry' +$userPath = [Environment]::GetEnvironmentVariable('Path', 'User') +if (-not $userPath) { $userPath = '' } +$entries = @($userPath -split ';' | Where-Object { $_ }) +$updated = @($entries | Where-Object { $_ -ne $InstallDir }) +if ($updated.Count -ne $entries.Count) { + [Environment]::SetEnvironmentVariable('Path', ($updated -join ';'), 'User') + Say (" removed {0} from the user PATH" -f $InstallDir) +} else { + Say ' the user PATH has no install directory' +} + +Step 'Done' +Say ' open a new terminal: the old PATH stays in the current one' diff --git a/scripts/uninstall.sh b/scripts/uninstall.sh new file mode 100644 index 0000000..1b679c9 --- /dev/null +++ b/scripts/uninstall.sh @@ -0,0 +1,148 @@ +#!/bin/sh +set -eu + +# ChuSQL 卸载脚本(Linux/macOS):停服务、删程序与配置、 +# 从 .profile 摘掉 PATH 段。数据目录默认一起删。 + +install_dir='' +data_dir='' +keep_data='no' +keep_config='no' +assume_yes='no' + +usage() { + cat <<'EOF' +Uninstall ChuSQL (Linux/macOS). + +Usage: uninstall.sh [options] + + --install-dir DIR program directory (default: $HOME/.local/share/chusql) + --data-dir DIR data directory (default: /data) + --keep-data keep the data directory, remove programs only + --keep-config keep chusql.toml + --yes do not ask (required when there is no terminal) + -h, --help show this help +EOF +} + +step() { echo "== $1"; } +note() { echo " $1"; } +fail() { + echo "!! $1" >&2 + exit 1 +} + +# 停掉命令行里带这个路径的进程 +stop_by_path() { + target=$1 + [ -n "$target" ] || return 0 + pids=$(ps -eo pid=,args= 2>/dev/null | + awk -v t="$target" '{ pid = $1; $1 = ""; sub(/^ +/, ""); if (index($0, t) == 1) print pid }' || true) + [ -n "$pids" ] || return 0 + for pid in $pids; do + kill "$pid" 2>/dev/null || true + done + note "stopped: $pids" + sleep 1 + for pid in $pids; do + kill -9 "$pid" 2>/dev/null || true + done +} + +# 问一句 y/n,不是 y 就当没同意 +ask_yes_no() { + printf '%s ' "$1" >&2 + answer='' + IFS= read -r answer || answer='' + case "$answer" in + y | Y | yes | YES | Yes) return 0 ;; + *) return 1 ;; + esac +} + +while [ $# -gt 0 ]; do + case "$1" in + -h | --help) usage; exit 0 ;; + --install-dir) install_dir="${2:-}"; shift 2 ;; + --data-dir) data_dir="${2:-}"; shift 2 ;; + --keep-data) keep_data='yes'; shift ;; + --keep-config) keep_config='yes'; shift ;; + --yes) assume_yes='yes'; shift ;; + *) fail "unknown option: $1 (try --help)" ;; + esac +done + +install_dir=${install_dir:-$HOME/.local/share/chusql} +data_dir=${data_dir:-$install_dir/data} +config_dir="${XDG_CONFIG_HOME:-$HOME/.config}/ChuSQL" +config_file="$config_dir/chusql.toml" +profile="$HOME/.profile" + +if [ "$assume_yes" = 'no' ]; then + echo 'ChuSQL uninstaller' + echo " install dir $install_dir" + echo " data dir $data_dir" + if [ "$keep_data" = 'yes' ]; then echo ' data kept'; fi + if [ -t 0 ]; then + ask_yes_no 'Remove it? [y/N]' || { + echo 'nothing was removed' + exit 0 + } + else + fail 'no terminal: rerun with --yes to confirm' + fi +fi + +step 'Stopping the service' +stop_by_path "$install_dir/bin/chusql-server" +stop_by_path "$install_dir/bin/chusql-web" + +step 'Removing files' +if [ ! -d "$install_dir" ]; then + note "not found: $install_dir" +elif [ "$keep_data" = 'yes' ]; then + for entry in "$install_dir"/*; do + [ -e "$entry" ] || continue + if [ "$entry" = "$data_dir" ]; then + note "kept data: $entry" + continue + fi + rm -rf "$entry" + done + note "kept $install_dir (data only)" +else + rm -rf "$install_dir" + case "$data_dir" in + "$install_dir" | "$install_dir"/*) ;; + *) rm -rf "$data_dir" ;; + esac + note "removed $install_dir" +fi + +step 'Removing chusql.toml' +if [ "$keep_config" = 'yes' ]; then + note "kept config: $config_file" +else + rm -f "$config_file" + rmdir "$config_dir" 2>/dev/null || true + note "removed config: $config_file" +fi + +step 'Removing the PATH entry' +marker='# ChuSQL' +if [ ! -f "$profile" ]; then + note "no $profile" +elif grep -q "^$marker" "$profile"; then + tmp="$profile.chusql-uninstall" + awk -v m="$marker" ' + skip > 0 { skip--; next } + index($0, m) == 1 { skip = 2; next } + { print } + ' "$profile" >"$tmp" && mv "$tmp" "$profile" + note "removed the $marker block from $profile" +else + note "no $marker block in $profile" +fi + +step 'Done' +note 'open a new terminal: the old PATH stays in the current one'