ChuNa7a/ChuSQL
1
0 Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity

准备可扩展类型系统工作，更合理的JOIN查询优化算法，并行查询

Browse Source
This commit is contained in:
LIm1tZz7 committed 2026-10-03 11:56:13 +08:00
1 parent 9758439b82
commit 274b7fcdcc
75 files changed
+3828 -1789
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

chusql-web/test/Gates.hs
+26 -47
View File
@@ -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"]
chusql-web/test/Spec.hs
+60 -15
View File
@@ -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
-- 角色 -----------------------------------------------------------------------