Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ff3dbddd13 | ||
|
|
346530d5f1 | ||
|
|
8d2f65ab8d | ||
|
|
b51183a794 | ||
|
|
0475a61c66 | ||
|
|
8ce4239452 |
No files matched your search
@@ -1,8 +1,7 @@
|
||||
# 发版流水线:打 tag(v*)时为四个平台各出一个发行包,附 sha256,挂到 Release。
|
||||
# 发版流水线:构建 Windows 与 Linux 安装包,验证后上传 Release。
|
||||
#
|
||||
# 资源命名(install.sh / install.ps1 按 <os>-<arch> 挑资源,见 scripts/install.sh):
|
||||
# chusql-linux-x86_64.tar.gz chusql-windows-x86_64.zip
|
||||
# chusql-macos-x86_64.tar.gz chusql-macos-arm64.tar.gz
|
||||
#
|
||||
# 一个平台一个包,里面 Web 前端与命令行客户端两部分都在;装哪几个由包内的安装脚本
|
||||
# 当场问(非交互时用 --component / -Component 指定)。
|
||||
@@ -13,8 +12,6 @@
|
||||
# 没有对应平台的资源时,同一个脚本可以退回本地编译:
|
||||
# sh scripts/install.sh --component web --from-source
|
||||
#
|
||||
# 说明:macOS 两个 runner 会让总时长变长(每个 job 都要 cargo + stack 各编一遍);
|
||||
# 不需要 Intel mac 的包就把 macos-13 那两行删掉。
|
||||
name: release
|
||||
|
||||
on:
|
||||
@@ -29,10 +26,19 @@ on:
|
||||
permissions:
|
||||
contents: write
|
||||
|
||||
concurrency:
|
||||
group: release-${{ inputs.tag || github.ref_name }}
|
||||
cancel-in-progress: true
|
||||
|
||||
env:
|
||||
CARGO_TERM_COLOR: always
|
||||
|
||||
jobs:
|
||||
validate:
|
||||
uses: ./.github/workflows/linux.yml
|
||||
with:
|
||||
phase: release
|
||||
|
||||
build:
|
||||
name: ${{ matrix.platform }}
|
||||
runs-on: ${{ matrix.os }}
|
||||
@@ -43,10 +49,10 @@ jobs:
|
||||
include:
|
||||
- { os: ubuntu-latest, platform: linux-x86_64 }
|
||||
- { os: windows-latest, platform: windows-x86_64 }
|
||||
- { os: macos-13, platform: macos-x86_64 }
|
||||
- { os: macos-14, platform: macos-arm64 }
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
with:
|
||||
ref: ${{ inputs.tag || github.ref }}
|
||||
|
||||
# ---------- 工具链 ----------
|
||||
- name: Rust toolchain
|
||||
@@ -101,113 +107,15 @@ jobs:
|
||||
working-directory: chusql-bootstrap
|
||||
run: stack build --fast chusql-bootstrap:exe:csql-bootstrap
|
||||
|
||||
# ---------- 装配 + 打归档(CI 里直接写在这里;本机打同一个包用 scripts/package.sh)----------
|
||||
# 归档里是包内容本身(bin/、scripts/、static/、install.sh 就在根上),安装脚本按这个布局找文件。
|
||||
- name: package (Unix)
|
||||
- name: package and verify (Unix)
|
||||
if: runner.os != 'Windows'
|
||||
shell: bash
|
||||
run: |
|
||||
set -eu
|
||||
name="chusql-${{ matrix.platform }}"
|
||||
stage="dist/$name"
|
||||
rm -rf "$stage"
|
||||
mkdir -p "$stage/bin" "$stage/resources"
|
||||
run: sh scripts/package.sh --out-dir "$PWD/dist" --platform '${{ matrix.platform }}' --version '${{ inputs.tag || github.ref_name }}' --no-build
|
||||
|
||||
cp chusql-core/storage/target/release/libchusql_core_storage.* "$stage/bin/"
|
||||
|
||||
stack_root="$(cd chusql-cli && stack path --local-install-root | tail -n 1 | tr -d '\r')"
|
||||
for front_name in chusql-web chusql-server csql; do
|
||||
front="$stack_root/bin/$front_name"
|
||||
if [ ! -f "$front" ]; then
|
||||
front="$(find chusql-web/.stack-work chusql-cli/.stack-work -name "$front_name" -type f 2>/dev/null | head -n 1 || true)"
|
||||
fi
|
||||
[ -n "$front" ] && [ -f "$front" ] || { echo "front end binary not found: $front_name" >&2; exit 1; }
|
||||
cp "$front" "$stage/bin/"
|
||||
done
|
||||
|
||||
# 引导程序住在自己的工程里,安装根也单独问它要
|
||||
bootstrap_root="$(cd chusql-bootstrap && stack path --local-install-root | tail -n 1 | tr -d '\r')"
|
||||
bootstrap_bin="$bootstrap_root/bin/csql-bootstrap"
|
||||
if [ ! -f "$bootstrap_bin" ]; then
|
||||
bootstrap_bin="$(find chusql-bootstrap/.stack-work -name csql-bootstrap -type f 2>/dev/null | head -n 1 || true)"
|
||||
fi
|
||||
[ -n "$bootstrap_bin" ] && [ -f "$bootstrap_bin" ] || { echo "csql-bootstrap not found" >&2; exit 1; }
|
||||
cp "$bootstrap_bin" "$stage/bin/"
|
||||
|
||||
# Haskell 一般静态链接,靶目录里真有共享库就一起带上;改名前的旧库(libchusql_storage.*)不能进包
|
||||
for lib in chusql-core/storage/target/release/*.so chusql-core/storage/target/release/*.dylib; do
|
||||
[ -f "$lib" ] || continue
|
||||
case "$(basename "$lib")" in
|
||||
libchusql_storage.*|libchusql_storage-*) continue ;;
|
||||
esac
|
||||
cp "$lib" "$stage/bin/"
|
||||
done
|
||||
|
||||
cp resources/settings.toml.* "$stage/resources/"
|
||||
cp scripts/install.ps1 scripts/install.sh "$stage/"
|
||||
cp scripts/uninstall.ps1 scripts/uninstall.sh "$stage/"
|
||||
mkdir -p "$stage/static"
|
||||
cp -R chusql-web/static/. "$stage/static/"
|
||||
cp scripts/csql-web.sh "$stage/"
|
||||
if [ -f scripts/csql-web.ps1 ]; then cp scripts/csql-web.ps1 "$stage/"; fi
|
||||
|
||||
chmod +x "$stage/install.sh" "$stage/uninstall.sh" "$stage/csql-web.sh"
|
||||
|
||||
mkdir -p dist
|
||||
tar -czf "dist/$name.tar.gz" -C "$stage" .
|
||||
rm -rf "$stage"
|
||||
ls -l "dist/$name.tar.gz"
|
||||
|
||||
- name: package (Windows)
|
||||
- name: package and verify (Windows)
|
||||
if: runner.os == 'Windows'
|
||||
shell: pwsh
|
||||
run: |
|
||||
$ErrorActionPreference = 'Stop'
|
||||
$name = "chusql-${{ matrix.platform }}"
|
||||
$stage = "dist/$name"
|
||||
if (Test-Path $stage) { Remove-Item -Recurse -Force $stage }
|
||||
New-Item -ItemType Directory -Force -Path "$stage/bin", "$stage/resources" | Out-Null
|
||||
|
||||
Copy-Item 'chusql-core/storage/target/release/chusql_core_storage.dll' "$stage/bin/"
|
||||
|
||||
$stackRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim()
|
||||
foreach ($frontName in @('chusql-web.exe', 'chusql-server.exe', 'csql.exe')) {
|
||||
$front = Join-Path $stackRoot "bin/$frontName"
|
||||
if (-not (Test-Path $front)) {
|
||||
$front = Get-ChildItem -Path 'chusql-web/.stack-work', 'chusql-cli/.stack-work' -Recurse -Filter $frontName -File -ErrorAction SilentlyContinue |
|
||||
Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName
|
||||
}
|
||||
if (-not $front -or -not (Test-Path $front)) { throw "front end binary not found: $frontName" }
|
||||
Copy-Item $front "$stage/bin/"
|
||||
}
|
||||
|
||||
$bootstrapRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim()
|
||||
$bootstrapExe = Join-Path $bootstrapRoot 'bin/csql-bootstrap.exe'
|
||||
if (-not (Test-Path $bootstrapExe)) {
|
||||
$bootstrapExe = Get-ChildItem -Path 'chusql-bootstrap/.stack-work' -Recurse -Filter 'csql-bootstrap.exe' -File -ErrorAction SilentlyContinue |
|
||||
Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName
|
||||
}
|
||||
if (-not $bootstrapExe -or -not (Test-Path $bootstrapExe)) { throw 'csql-bootstrap.exe not found' }
|
||||
Copy-Item $bootstrapExe "$stage/bin/"
|
||||
|
||||
# 第三方 dll 才要连带上:名字带 chusql 的是本 crate 产物或改名前的残留,上面已按名拷过
|
||||
Get-ChildItem 'chusql-core/storage/target/release' -Filter '*.dll' -File -ErrorAction SilentlyContinue |
|
||||
Where-Object { $_.Name -notlike 'chusql*' } |
|
||||
ForEach-Object { Copy-Item $_.FullName "$stage/bin/" }
|
||||
|
||||
Copy-Item 'resources/settings.toml.*' "$stage/resources/"
|
||||
Copy-Item 'scripts/install.ps1', 'scripts/install.sh' $stage
|
||||
Copy-Item 'scripts/uninstall.ps1', 'scripts/uninstall.sh' $stage
|
||||
New-Item -ItemType Directory -Force -Path "$stage/static" | Out-Null
|
||||
Copy-Item 'chusql-web/static/*' "$stage/static" -Recurse
|
||||
Copy-Item 'scripts/csql-web.sh' $stage
|
||||
if (Test-Path 'scripts/csql-web.ps1') { Copy-Item 'scripts/csql-web.ps1' $stage }
|
||||
|
||||
New-Item -ItemType Directory -Force -Path dist | Out-Null
|
||||
Compress-Archive -Path "$stage/*" -DestinationPath "dist/$name.zip" -Force
|
||||
Remove-Item -Recurse -Force $stage
|
||||
Get-Item "dist/$name.zip" | Select-Object Name, Length | Format-Table
|
||||
|
||||
run: ./scripts/package.ps1 -OutDir dist -Platform '${{ matrix.platform }}' -Version '${{ inputs.tag || github.ref_name }}' -NoBuild
|
||||
- name: checksum
|
||||
shell: pwsh
|
||||
run: |
|
||||
@@ -229,9 +137,13 @@ jobs:
|
||||
|
||||
publish:
|
||||
name: publish release
|
||||
needs: build
|
||||
needs: [build, validate]
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
with:
|
||||
ref: ${{ inputs.tag || github.ref }}
|
||||
|
||||
- uses: actions/download-artifact@v4
|
||||
with:
|
||||
path: dist
|
||||
@@ -244,5 +156,8 @@ jobs:
|
||||
run: |
|
||||
set -eu
|
||||
ls -l dist
|
||||
gh release view "$TAG" >/dev/null 2>&1 || gh release create "$TAG" --title "ChuSQL $TAG" --generate-notes
|
||||
notes="docs/release-$TAG.md"
|
||||
test -f "$notes"
|
||||
gh release view "$TAG" >/dev/null 2>&1 || gh release create "$TAG" --title "ChuSQL $TAG" --notes-file "$notes" --verify-tag
|
||||
gh release edit "$TAG" --notes-file "$notes"
|
||||
gh release upload "$TAG" dist/* --clobber
|
||||
@@ -1,8 +1,13 @@
|
||||
# ChuSQL
|
||||
|
||||
[](https://github.com/TheBadRoger/ChuSQL/releases) [](https://github.com/TheBadRoger/ChuSQL/commits/main)  [](scripts/update-code-lines.ps1)
|
||||
|
||||
[](https://github.com/TheBadRoger/ChuSQL/actions/workflows/build.yml) [](https://github.com/TheBadRoger/ChuSQL/actions/workflows/linux.yml) [](https://github.com/TheBadRoger/ChuSQL/actions/workflows/gate.yml)
|
||||
<p align="center">
|
||||
<img src="https://img.shields.io/badge/Haskell-5e5086?style=flat-square" alt="Haskell">
|
||||
<img src="https://img.shields.io/badge/Rust-dea584?style=flat-square" alt="Rust">
|
||||
<a href="https://github.com/TheBadRoger/ChuSQL/actions/workflows/build.yml"><img src="https://img.shields.io/github/actions/workflow/status/TheBadRoger/ChuSQL/build.yml?branch=main&label=build&style=flat-square" alt="Build"></a>
|
||||
<a href="https://github.com/TheBadRoger/ChuSQL/actions/workflows/linux.yml"><img src="https://img.shields.io/github/actions/workflow/status/TheBadRoger/ChuSQL/linux.yml?branch=main&label=tests&style=flat-square" alt="Tests"></a>
|
||||
<a href="https://github.com/TheBadRoger/ChuSQL/releases"><img src="https://img.shields.io/github/v/release/TheBadRoger/ChuSQL?style=flat-square" alt="Release"></a>
|
||||
<br>
|
||||
</p>
|
||||
|
||||
ChuSQL 是采用 Haskell SQL 引擎与 Rust 存储层的数据库项目,提供 TCP 服务、CLI 和 Web 管理端。支持查询优化、快照事务、WAL 崩溃恢复、DOMAIN 自定义类型及用户与角色管理。
|
||||
|
||||
|
||||
@@ -32,7 +32,7 @@ import System.Environment (getArgs)
|
||||
import System.Exit (ExitCode (..), exitFailure)
|
||||
import System.FilePath ((</>))
|
||||
import System.Info (os)
|
||||
import System.IO (Handle, hGetLine)
|
||||
import System.IO (Handle, hGetLine, hSetBuffering, BufferMode (LineBuffering), stdout)
|
||||
import System.Process (
|
||||
CreateProcess (std_err, std_out),
|
||||
ProcessHandle,
|
||||
@@ -484,6 +484,7 @@ stopProcess process = do
|
||||
-- | 主入口
|
||||
main :: IO ()
|
||||
main = do
|
||||
hSetBuffering stdout LineBuffering
|
||||
args <- getArgs
|
||||
unless (length args <= 2) (ioError (userError "usage: benchmark4csql [users=10000] [orders=50000]"))
|
||||
let values = take 2 (args ++ drop (length args) ["10000", "50000"])
|
||||
@@ -588,9 +589,10 @@ pressureScenarios bench u o = do
|
||||
_ <- runSql bench "CREATE TABLE writes (id int, name str, age int)"
|
||||
_ <- batchInsert bench "200 individual durable INSERTs" 200 (\i -> printf "INSERT INTO writes (id,name,age) VALUES (%d,'w%d',%d)" i i i)
|
||||
(milliseconds, ()) <- measure $ do
|
||||
_ <- runSql bench "BEGIN"
|
||||
forM_ [201 .. 400 :: Int] $ \i -> runSql bench (printf "INSERT INTO writes (id,name,age) VALUES (%d,'w%d',%d)" i i i) >> pure ()
|
||||
_ <- runSql bench "COMMIT"
|
||||
(beginMs, _) <- measure (runSql bench "BEGIN")
|
||||
(stagedMs, ()) <- measure $ forM_ [201 .. 400 :: Int] $ \i -> runSql bench (printf "INSERT INTO writes (id,name,age) VALUES (%d,'w%d',%d)" i i i) >> pure ()
|
||||
(commitMs, _) <- measure (runSql bench "COMMIT")
|
||||
printf "TXN_PHASE begin_ms=%.3f staged_ms=%.3f commit_ms=%.3f\n" beginMs stagedMs commitMs
|
||||
pure ()
|
||||
printf "WRITE transaction200 total_ms=%.3f rows_s=%.2f\n" milliseconds (200000 / milliseconds)
|
||||
checkCount bench "writes" 400
|
||||
|
||||
@@ -81,7 +81,7 @@ ready = A.object ["status" A..= ("system" :: Text), "initialized" A..= True]
|
||||
|
||||
-- | 带最高权限属性的身份响应
|
||||
identity :: Bool -> A.Value
|
||||
identity super = A.object ["status" A..= ("accounts" :: Text), "accounts" A..= [Account 1 "root" "existing-hash" 1 "" Nothing True super True False]]
|
||||
identity super = A.object ["status" A..= ("accounts" :: Text), "accounts" A..= [Account 1 "root" "existing-hash" 1 "" Nothing True super True False False]]
|
||||
|
||||
-- | 已写入编号的类型响应
|
||||
installed :: A.Value
|
||||
|
||||
@@ -8,12 +8,14 @@ import ChuSQL.CLI.Script (stripTerminator)
|
||||
import ChuSQL.Interface.Session (
|
||||
Session,
|
||||
authenticateSession,
|
||||
authenticateSudoSession,
|
||||
isPlainIdentifier,
|
||||
newSession,
|
||||
switchDatabase,
|
||||
)
|
||||
import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, rootUserName)
|
||||
import ChuSQL.Interface.Link (Client, closeClient, connectClient)
|
||||
import ChuSQL.Interface.Sudo (SudoCredential, readSudoCredential)
|
||||
import ChuSQL.Interface.TOML (resolveConfigPath)
|
||||
import Control.Exception (finally)
|
||||
import Control.Monad (unless)
|
||||
@@ -38,6 +40,7 @@ data Options = Options
|
||||
, optExecute :: Maybe Text
|
||||
, optHistory :: Maybe FilePath
|
||||
, optConfig :: Maybe FilePath
|
||||
, optSudo :: Bool
|
||||
}
|
||||
|
||||
-- | 命令行参数解析器
|
||||
@@ -66,6 +69,7 @@ optionsParser =
|
||||
<*> optional (T.pack <$> strOption (long "execute" <> short 'e' <> metavar "SQL" <> help "Run one statement and exit"))
|
||||
<*> optional (strOption (long "history" <> metavar "FILE" <> help "SQL history file (default ~/.chusql_history)"))
|
||||
<*> optional (strOption (long "config" <> metavar "FILE" <> help "Config file to read (default: the fixed settings.toml under the system config directory)"))
|
||||
<*> switch (long "sudo" <> help "Authenticate using the local root or elevated administrator identity")
|
||||
|
||||
-- | 把 --format 的取值解析成格式
|
||||
formatReader :: String -> Either String OutputFormat
|
||||
@@ -91,20 +95,29 @@ main = do
|
||||
base <- loadWebConfigAt configPath
|
||||
config <- loadServerConfigAt configPath
|
||||
let rootName = rootUserName base
|
||||
userName = fromMaybe rootName (optUser options)
|
||||
password <- promptPassword userName
|
||||
userName = fromMaybe (if optSudo options then scSudoUser config else rootName) (optUser options)
|
||||
credential <- if optSudo options then do
|
||||
if T.null userName then reportError "sudo_auth_user is not configured" >> exitFailure else pure ()
|
||||
local <- readSudoCredential (scPort config)
|
||||
case local of
|
||||
Left message -> reportError message >> exitFailure
|
||||
Right proof -> pure (Just proof)
|
||||
else pure Nothing
|
||||
password <- if optSudo options then pure "" else promptPassword userName
|
||||
connected <- connectClient (T.pack (scHost config)) (scPort config)
|
||||
case connected of
|
||||
Left message -> reportError message >> exitFailure
|
||||
Right client ->
|
||||
connect options client userName password
|
||||
connect options client userName password credential
|
||||
`finally` closeClient client
|
||||
|
||||
-- | 连 server、登录,之后转入会话
|
||||
connect :: Options -> Client -> Text -> Text -> IO ()
|
||||
connect options client userName password = do
|
||||
connect :: Options -> Client -> Text -> Text -> Maybe SudoCredential -> IO ()
|
||||
connect options client userName password credential = do
|
||||
session <- newSession client
|
||||
signedIn <- authenticateSession session userName password
|
||||
signedIn <- case credential of
|
||||
Just proof -> authenticateSudoSession session proof userName
|
||||
Nothing -> authenticateSession session userName password
|
||||
case signedIn of
|
||||
Left message -> reportError message >> exitFailure
|
||||
Right () -> runSession options session
|
||||
|
||||
@@ -14,6 +14,7 @@ module ChuSQL.CLI.Format
|
||||
|
||||
import ChuSQL.Core.Model (Value (..))
|
||||
import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
|
||||
import ChuSQL.Core.Runtime (renderRuntimeValue)
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Text (Text)
|
||||
@@ -109,3 +110,4 @@ displayValue (VFloat d) = T.pack (show d)
|
||||
displayValue (VStr s) = T.pack s
|
||||
displayValue (VBool True) = "true"
|
||||
displayValue (VBool False) = "false"
|
||||
displayValue (VRuntime _ value) = T.pack (renderRuntimeValue value)
|
||||
@@ -2,12 +2,13 @@
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable)
|
||||
import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable, displayValue)
|
||||
import ChuSQL.CLI.History (historySettings, rememberStatement)
|
||||
import ChuSQL.CLI.Password (readPasswordInput)
|
||||
import ChuSQL.CLI.Script (Meta (..), errorHint, parseMeta, statementComplete, stripTerminator, takeStatement)
|
||||
import ChuSQL.Core.Model (Value (..))
|
||||
import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
|
||||
import ChuSQL.Core.Runtime
|
||||
import Data.Aeson (decode)
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
@@ -30,6 +31,10 @@ main = hspec spec
|
||||
-- | 全部测试用例
|
||||
spec :: Spec
|
||||
spec = do
|
||||
it "renders typed compound values without losing their wire identity" $ do
|
||||
case resolveType builtinTypes (listType intType) of
|
||||
Left err -> expectationFailure err
|
||||
Right descriptor -> displayValue (VRuntime (descriptorId descriptor) (RList [RInt 1, RInt 2])) `shouldBe` "[1, 2]"
|
||||
formatSpec
|
||||
scriptSpec
|
||||
passwordSpec
|
||||
|
||||
@@ -22,6 +22,12 @@ library
|
||||
ChuSQL.Core.Engine.Error
|
||||
ChuSQL.Core.Engine
|
||||
ChuSQL.Core.Engine.Parallel
|
||||
ChuSQL.Core.Engine.Normalization
|
||||
ChuSQL.Core.Engine.Runtime.Types
|
||||
ChuSQL.Core.Engine.Runtime.Functions
|
||||
ChuSQL.Core.Engine.Runtime.Binding
|
||||
ChuSQL.Core.Engine.Runtime.SQL
|
||||
ChuSQL.Core.Engine.Runtime.Query
|
||||
ChuSQL.Core.Engine.Semantic
|
||||
ChuSQL.Core.Engine.Storage
|
||||
ChuSQL.Core.Engine.Storage.FFI
|
||||
@@ -39,6 +45,7 @@ library
|
||||
, scientific
|
||||
, text
|
||||
, unordered-containers
|
||||
, vector
|
||||
extra-libraries: chusql_core_storage
|
||||
-- 运行期找 libchusql_core_storage.so:$ORIGIN 让二进制与动态库同目录即可
|
||||
if os(linux)
|
||||
@@ -51,6 +58,8 @@ library
|
||||
test-suite chusql-core-engine-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules: NormalizationSpec
|
||||
RuntimeSpec
|
||||
hs-source-dirs: test
|
||||
build-depends: base
|
||||
, chusql-core-engine
|
||||
@@ -59,5 +68,7 @@ test-suite chusql-core-engine-test
|
||||
, filepath
|
||||
, hashable
|
||||
, hspec
|
||||
, bytestring
|
||||
, aeson
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -threaded
|
||||
@@ -1,11 +1,10 @@
|
||||
module ChuSQL.Core.Engine (runStatement, runStatementM, rowsOf) where
|
||||
|
||||
import ChuSQL.Core.Engine.Algebra.Eval (evalCondForRowM, evalExprM, evalRelOpM)
|
||||
import ChuSQL.Core.Engine.Algebra.Eval (evalCondForRowM, evalExprM)
|
||||
import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr)
|
||||
import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
|
||||
import ChuSQL.Core.Engine.Algebra.Planner (translate)
|
||||
import ChuSQL.Core.Engine.Runtime.Query (bindQuery, executeQueryM)
|
||||
import ChuSQL.Core.Model
|
||||
import ChuSQL.Core.Engine.Semantic (prepare)
|
||||
import ChuSQL.Core.Engine.Semantic (prepare, prepareRowExpression)
|
||||
import ChuSQL.Core.Engine.Storage (MonadStorage (..))
|
||||
import ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage))
|
||||
import ChuSQL.Core.Engine.Syntax.AST
|
||||
@@ -41,13 +40,13 @@ runStatementM q = do
|
||||
-- | 按语句类型分发(已检查过)
|
||||
runStatementUncheckedM :: (MonadStorage m) => Database -> Statement -> m (Either String [Row])
|
||||
runStatementUncheckedM db q@Select{} =
|
||||
case translate q of
|
||||
case bindQuery db q of
|
||||
Left e -> pure (Left e)
|
||||
Right relOp -> evalRelOpM db (optimize db relOp)
|
||||
Right bound -> executeQueryM bound
|
||||
runStatementUncheckedM db q@SelectExpr{} =
|
||||
case translate q of
|
||||
case bindQuery db q of
|
||||
Left e -> pure (Left e)
|
||||
Right relOp -> evalRelOpM db (optimize db relOp)
|
||||
Right bound -> executeQueryM bound
|
||||
runStatementUncheckedM db (Insert tbl cols rows) =
|
||||
case lookupTable db tbl of
|
||||
Left e -> pure (Left e)
|
||||
@@ -241,7 +240,9 @@ checkPlan table = mapM parse (mapMaybe checked (tableCols table))
|
||||
-- | 解析一列的 CHECK 文本
|
||||
parse (name, text) = case parseExpression text of
|
||||
Left err -> Left ("CHECK on " ++ name ++ ": " ++ firstLine err)
|
||||
Right e -> Right (name, e)
|
||||
Right e -> do
|
||||
bound <- prepareRowExpression (tableCols table) e
|
||||
Right (name, bound)
|
||||
|
||||
-- | 执行解析好的 CHECK 条件
|
||||
runChecks :: CheckPlan -> Row -> Either String ()
|
||||
|
||||
@@ -36,6 +36,7 @@ valueLiteral (VInt n) = LitInt n
|
||||
valueLiteral (VFloat d) = LitFloat d
|
||||
valueLiteral (VStr s) = LitStr s
|
||||
valueLiteral (VBool b) = LitBool b
|
||||
valueLiteral (VRuntime tid value) = RuntimeLiteral tid value
|
||||
valueLiteral VNull = LitNull
|
||||
|
||||
-- | 点查退化成扫描时用的条件
|
||||
@@ -362,6 +363,18 @@ scalarResult rows = do
|
||||
-- | 把子查询求值成字面量;子查询的错直接往上传
|
||||
substSubqueries :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Expr)
|
||||
substSubqueries db e env = case e of
|
||||
Construct tid arguments -> do
|
||||
bound <- mapM (\argument -> substSubqueries db argument env) arguments
|
||||
pure (Construct tid <$> sequence bound)
|
||||
BoundConstruct tid arguments -> do
|
||||
bound <- mapM (\argument -> substSubqueries db argument env) arguments
|
||||
pure (BoundConstruct tid <$> sequence bound)
|
||||
FunctionCall name arguments -> do
|
||||
bound <- mapM (\argument -> substSubqueries db argument env) arguments
|
||||
pure (FunctionCall name <$> sequence bound)
|
||||
BoundFunction fid tid arguments -> do
|
||||
bound <- mapM (\argument -> substSubqueries db argument env) arguments
|
||||
pure (BoundFunction fid tid <$> sequence bound)
|
||||
ScalarSub sq -> scalarResult <$> runSubqueryRows db sq env
|
||||
InSub a sq negated -> do
|
||||
lhs <- substSubqueries db a env
|
||||
|
||||
@@ -3,6 +3,7 @@ module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, su
|
||||
import ChuSQL.Core.Model
|
||||
import ChuSQL.Core.Engine.Syntax.AST
|
||||
import ChuSQL.Core.Engine.Builtin (Operator (..), compareNode, executeOperator, inValues, threeValuedNot)
|
||||
import ChuSQL.Core.Engine.Runtime.SQL (invokeSQLFunction, constructSQLValue)
|
||||
|
||||
-- 表达式求值:三值逻辑,NULL 参与运算结果仍是 NULL。
|
||||
|
||||
@@ -10,6 +11,12 @@ import ChuSQL.Core.Engine.Builtin (Operator (..), compareNode, executeOperator,
|
||||
evalExpr :: Expr -> Row -> Either String Value
|
||||
evalExpr (Col name) row =
|
||||
maybe (Left ("unknown column: " ++ name)) Right (lookup name row)
|
||||
evalExpr (FunctionCall name _) _ = Left ("unbound function call: " ++ name)
|
||||
evalExpr (Construct _ _) _ = Left "unbound runtime constructor"
|
||||
evalExpr (BoundConstruct tid arguments) row = mapM (\argument -> evalExpr argument row) arguments >>= constructSQLValue tid
|
||||
evalExpr (RuntimeLiteral tid value) _ = coerceValue (CRuntime tid) (VRuntime tid value)
|
||||
evalExpr (BoundFunction fid tid arguments) row =
|
||||
mapM (\argument -> evalExpr argument row) arguments >>= invokeSQLFunction fid tid
|
||||
evalExpr LitNull _ = Right VNull
|
||||
evalExpr (LitInt n) _ = Right (VInt n)
|
||||
evalExpr (LitFloat d) _ = Right (VFloat d)
|
||||
@@ -63,6 +70,10 @@ quantifiedCompare op lhs vs q = case vs of
|
||||
-- | 表达式用到了哪些列
|
||||
colsInExpr :: Expr -> [String]
|
||||
colsInExpr (Col c) = [c]
|
||||
colsInExpr (Construct _ arguments) = concatMap colsInExpr arguments
|
||||
colsInExpr (BoundConstruct _ arguments) = concatMap colsInExpr arguments
|
||||
colsInExpr (FunctionCall _ arguments) = concatMap colsInExpr arguments
|
||||
colsInExpr (BoundFunction _ _ arguments) = concatMap colsInExpr arguments
|
||||
colsInExpr (Add a b) = colsInExpr a ++ colsInExpr b
|
||||
colsInExpr (Sub a b) = colsInExpr a ++ colsInExpr b
|
||||
colsInExpr (Mul a b) = colsInExpr a ++ colsInExpr b
|
||||
@@ -93,6 +104,10 @@ colsInExpr _ = []
|
||||
-- | 表达式里子查询引用的外层列
|
||||
subqueryRefsIn :: Expr -> [String]
|
||||
subqueryRefsIn e = case e of
|
||||
Construct _ arguments -> concatMap subqueryRefsIn arguments
|
||||
BoundConstruct _ arguments -> concatMap subqueryRefsIn arguments
|
||||
FunctionCall _ arguments -> concatMap subqueryRefsIn arguments
|
||||
BoundFunction _ _ arguments -> concatMap subqueryRefsIn arguments
|
||||
ScalarSub sq -> subqueryRefs sq
|
||||
InSub a sq _ -> subqueryRefsIn a ++ subqueryRefs sq
|
||||
InList a es _ -> concatMap subqueryRefsIn (a : es)
|
||||
@@ -126,6 +141,10 @@ subqueryRefsIn e = case e of
|
||||
-- | 表达式里有没有除法(除法可能报错,不能提前或延后求值)
|
||||
hasDivision :: Expr -> Bool
|
||||
hasDivision e = case e of
|
||||
Construct _ arguments -> any hasDivision arguments
|
||||
BoundConstruct _ arguments -> any hasDivision arguments
|
||||
FunctionCall _ arguments -> any hasDivision arguments
|
||||
BoundFunction _ _ arguments -> any hasDivision arguments
|
||||
Div _ _ -> True
|
||||
Neg a -> hasDivision a
|
||||
Add a b -> both a b
|
||||
@@ -148,6 +167,10 @@ hasDivision e = case e of
|
||||
-- | 表达式里有没有子查询
|
||||
hasSubquery :: Expr -> Bool
|
||||
hasSubquery e = case e of
|
||||
Construct _ arguments -> any hasSubquery arguments
|
||||
BoundConstruct _ arguments -> any hasSubquery arguments
|
||||
FunctionCall _ arguments -> any hasSubquery arguments
|
||||
BoundFunction _ _ arguments -> any hasSubquery arguments
|
||||
ScalarSub _ -> True
|
||||
InSub _ _ _ -> True
|
||||
InList a es _ -> any hasSubquery (a : es)
|
||||
@@ -181,6 +204,10 @@ hasSubquery e = case e of
|
||||
-- | 表达式里出现的聚合调用(按出现顺序)
|
||||
aggregatesIn :: Expr -> [Expr]
|
||||
aggregatesIn e = case e of
|
||||
Construct _ arguments -> concatMap aggregatesIn arguments
|
||||
BoundConstruct _ arguments -> concatMap aggregatesIn arguments
|
||||
FunctionCall _ arguments -> concatMap aggregatesIn arguments
|
||||
BoundFunction _ _ arguments -> concatMap aggregatesIn arguments
|
||||
a@CountAll -> [a]
|
||||
a@(CountOf _) -> [a]
|
||||
a@(SumOf _) -> [a]
|
||||
@@ -215,6 +242,10 @@ hasAggregate = not . null . aggregatesIn
|
||||
-- | 聚合之外的列引用(聚合参数里的列不算)
|
||||
bareColumns :: Expr -> [String]
|
||||
bareColumns e = case e of
|
||||
Construct _ arguments -> concatMap bareColumns arguments
|
||||
BoundConstruct _ arguments -> concatMap bareColumns arguments
|
||||
FunctionCall _ arguments -> concatMap bareColumns arguments
|
||||
BoundFunction _ _ arguments -> concatMap bareColumns arguments
|
||||
Col c -> [c]
|
||||
Add a b -> both a b
|
||||
Sub a b -> both a b
|
||||
|
||||
@@ -139,6 +139,7 @@ foldNode e
|
||||
Right (VFloat d) -> LitFloat d
|
||||
Right (VStr s) -> LitStr s
|
||||
Right (VBool b) -> LitBool b
|
||||
Right (VRuntime tid value) -> RuntimeLiteral tid value
|
||||
Left _ -> e
|
||||
| otherwise = e
|
||||
|
||||
@@ -149,6 +150,8 @@ foldConstants (Sub a b) = foldNode (Sub (foldConstants a) (foldConstants b))
|
||||
foldConstants (Mul a b) = foldNode (Mul (foldConstants a) (foldConstants b))
|
||||
foldConstants (Div a b) = foldNode (Div (foldConstants a) (foldConstants b))
|
||||
foldConstants (Neg a) = foldNode (Neg (foldConstants a))
|
||||
foldConstants (BoundConstruct tid arguments) = BoundConstruct tid (map foldConstants arguments)
|
||||
foldConstants (BoundFunction fid tid arguments) = foldNode (BoundFunction fid tid (map foldConstants arguments))
|
||||
foldConstants (Gt a b) = foldNode (Gt (foldConstants a) (foldConstants b))
|
||||
foldConstants (Lt a b) = foldNode (Lt (foldConstants a) (foldConstants b))
|
||||
foldConstants (Eq a b) = foldNode (Eq (foldConstants a) (foldConstants b))
|
||||
|
||||
@@ -37,6 +37,10 @@ rewriteAggs :: [(String, Expr)] -> Expr -> Expr
|
||||
rewriteAggs aggs e = case [label | (label, agg) <- aggs, agg == e] of
|
||||
(label : _) -> Col label
|
||||
[] -> case e of
|
||||
Construct tid arguments -> Construct tid (map go arguments)
|
||||
BoundConstruct tid arguments -> BoundConstruct tid (map go arguments)
|
||||
FunctionCall name arguments -> FunctionCall name (map go arguments)
|
||||
BoundFunction fid tid arguments -> BoundFunction fid tid (map go arguments)
|
||||
Add a b -> Add (go a) (go b)
|
||||
Sub a b -> Sub (go a) (go b)
|
||||
Mul a b -> Mul (go a) (go b)
|
||||
|
||||
@@ -0,0 +1,125 @@
|
||||
module ChuSQL.Core.Engine.Normalization where
|
||||
|
||||
import ChuSQL.Core.Model (Column)
|
||||
import Data.List (nub, sort, subsequences, (\\))
|
||||
|
||||
-- 只读范式分析:声明验证、阿姆斯特朗闭包、候选键与分解建议。
|
||||
|
||||
type Attributes = [String]
|
||||
data Dependency = Dependency Attributes Attributes deriving (Eq, Show)
|
||||
data Verdict = Satisfied | Violated | Insufficient deriving (Eq, Show)
|
||||
data NormalForm = NF1 | NF2 | NF3 | BCNF deriving (Eq, Show)
|
||||
data Declaration = Declaration
|
||||
{ declaredKeys :: [Attributes]
|
||||
, dependencies :: [Dependency]
|
||||
, dependenciesComplete :: Bool
|
||||
, atomicAttributes :: Maybe Bool
|
||||
} deriving (Eq, Show)
|
||||
data Finding = Finding
|
||||
{ normalForm :: NormalForm
|
||||
, verdict :: Verdict
|
||||
, witnesses :: [Dependency]
|
||||
, condition :: String
|
||||
} deriving (Eq, Show)
|
||||
data Decomposition = Decomposition
|
||||
{ relations :: [Attributes]
|
||||
, losslessJoin :: Verdict
|
||||
, dependencyPreserving :: Verdict
|
||||
} deriving (Eq, Show)
|
||||
data Analysis = Analysis
|
||||
{ candidateKeys :: [Attributes]
|
||||
, findings :: [Finding]
|
||||
, suggestions :: [Decomposition]
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- 规范化属性集合。
|
||||
canonical :: Attributes -> Attributes
|
||||
canonical = sort . nub
|
||||
|
||||
-- 判断属性集合包含关系。
|
||||
subset :: Attributes -> Attributes -> Bool
|
||||
subset xs ys = all (`elem` ys) xs
|
||||
|
||||
-- 用自反、增广和传递规则求闭包。
|
||||
attributeClosure :: [Dependency] -> Attributes -> Attributes
|
||||
attributeClosure f seed = fixed (canonical seed)
|
||||
where
|
||||
-- 迭代加入已蕴含的属性。
|
||||
fixed xs = let ys = canonical (xs ++ concat [b | Dependency a b <- f, subset a xs])
|
||||
in if xs == ys then xs else fixed ys
|
||||
|
||||
-- 判断声明是否蕴含依赖。
|
||||
implies :: [Dependency] -> Dependency -> Bool
|
||||
implies f (Dependency a b) = subset b (attributeClosure f a)
|
||||
|
||||
-- 枚举最小超键。
|
||||
keysOf :: Attributes -> [Dependency] -> [Attributes]
|
||||
keysOf attrs f = [x | x <- subsequences attrs, super x,
|
||||
all (not . super) [x \\ [a] | a <- x]]
|
||||
where
|
||||
-- 判断闭包是否覆盖关系。
|
||||
super x = subset attrs (attributeClosure f x)
|
||||
|
||||
-- 投影关系上的全部非平凡依赖。
|
||||
projectDependencies :: [Dependency] -> Attributes -> [Dependency]
|
||||
projectDependencies f attrs =
|
||||
[Dependency x [a] | x <- subsequences attrs,
|
||||
a <- attributeClosure f x, a `elem` attrs, a `notElem` x]
|
||||
|
||||
-- 验证声明并生成只读范式报告。
|
||||
analyzeNormalization :: [(String, Column)] -> Declaration -> Either String Analysis
|
||||
analyzeNormalization schema declaration
|
||||
| null attrs = Left "normalization: empty schema"
|
||||
| length attrs /= length schema = Left "normalization: duplicate columns"
|
||||
| length attrs > 12 = Left "normalization: exhaustive analysis supports at most 12 columns"
|
||||
| any invalidDependency supplied = Left "normalization: unknown or duplicate dependency attributes"
|
||||
| any invalidKey rawKeys = Left "normalization: unknown or duplicate key attributes"
|
||||
| any (`notElem` keys) normalizedKeys = Left "normalization: declared candidate key is not minimal"
|
||||
| otherwise = Right (Analysis keys results decompositions)
|
||||
where
|
||||
attrs = canonical (map fst schema)
|
||||
supplied = dependencies declaration
|
||||
rawKeys = declaredKeys declaration
|
||||
normalizedKeys = map canonical rawKeys
|
||||
f = supplied ++ [Dependency k attrs | k <- normalizedKeys]
|
||||
keys = keysOf attrs f
|
||||
prime = nub (concat keys)
|
||||
complete = dependenciesComplete declaration
|
||||
atomic = case atomicAttributes declaration of
|
||||
Just True -> Satisfied
|
||||
Just False -> Violated
|
||||
Nothing -> Insufficient
|
||||
allFDs = projectDependencies f attrs
|
||||
partial = [d | d@(Dependency x [a]) <- allFDs, a `notElem` prime,
|
||||
any (\k -> x /= k && subset x k) keys]
|
||||
third = [d | d@(Dependency x [a]) <- allFDs, a `notElem` prime,
|
||||
not (subset attrs (attributeClosure f x))]
|
||||
boyce = [d | d@(Dependency x _) <- allFDs,
|
||||
not (subset attrs (attributeClosure f x))]
|
||||
results = Finding NF1 atomic [] "attributes must have atomic domains; requires an explicit declaration" :
|
||||
[classify NF2 partial, classify NF3 third, classify BCNF boyce]
|
||||
decompositions = [split d | d <- take 1 boyce, complete, atomic == Satisfied]
|
||||
-- 校验字段集合。
|
||||
valid xs = length xs == length (canonical xs) && subset xs attrs
|
||||
-- 校验依赖声明。
|
||||
invalidDependency (Dependency a b) = not (valid a && valid b) || null b
|
||||
-- 校验候选键声明。
|
||||
invalidKey k = not (valid k)
|
||||
-- 结合声明完整性判定范式。
|
||||
classify nf ds = Finding nf status (if complete then ds else []) (rule nf)
|
||||
where
|
||||
status | atomic == Violated = Violated
|
||||
| atomic == Insufficient || not complete = Insufficient
|
||||
| null ds = Satisfied
|
||||
| otherwise = Violated
|
||||
-- 说明各范式的必要条件。
|
||||
rule NF1 = "attributes must have atomic domains"
|
||||
rule NF2 = "no nonprime attribute depends on a proper subset of any candidate key"
|
||||
rule NF3 = "each nontrivial dependency has a superkey determinant or a prime dependent"
|
||||
rule BCNF = "each nontrivial dependency has a superkey determinant"
|
||||
-- 按违反依赖生成一次无损分解。
|
||||
split (Dependency x y) = Decomposition parts Satisfied preservation
|
||||
where
|
||||
parts = [canonical (x ++ y), attrs \\ (y \\ x)]
|
||||
projected = concatMap (projectDependencies f) parts
|
||||
preservation = if all (implies projected) f then Satisfied else Violated
|
||||
@@ -0,0 +1,177 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Binding
|
||||
( Expression (..), TypedExpression, expressionType, bindExpression, evaluateExpression
|
||||
, Plan (..), TypedPlan, planSchema, bindPlan, executePlan
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import ChuSQL.Core.Engine.Runtime.Functions
|
||||
import Control.Monad (filterM)
|
||||
import Data.List (nub, sort)
|
||||
|
||||
-- 仅依据 schema 绑定表达式与查询,执行已解析的类型和函数身份。
|
||||
|
||||
-- | 表达未绑定的类型化语言
|
||||
data Expression = Literal TypeExpr RuntimeValue | Reference String | Apply String [Expression]
|
||||
| ListLiteral TypeExpr [Expression] | NothingLiteral TypeExpr | JustLiteral Expression
|
||||
| TupleLiteral [Expression] deriving (Show, Eq)
|
||||
|
||||
-- | 保存绑定后的表达式节点
|
||||
data ExpressionNode = Constant RuntimeValue | BoundReference String | BoundApply FunctionId [TypedExpression]
|
||||
| BoundList [TypedExpression] | BoundNothing | BoundJust TypedExpression | BoundTuple [TypedExpression]
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 保存表达式的确定类型
|
||||
data TypedExpression = TypedExpression TypeId ExpressionNode deriving (Show, Eq)
|
||||
|
||||
-- | 提取表达式类型身份
|
||||
expressionType :: TypedExpression -> TypeId
|
||||
expressionType (TypedExpression tid _) = tid
|
||||
|
||||
-- | 绑定类型、列与函数身份
|
||||
bindExpression :: TypeRegistry -> FunctionRegistry -> [(String, TypeId)] -> Expression -> Either String TypedExpression
|
||||
bindExpression types functions env expression = case expression of
|
||||
Literal ty value -> do
|
||||
tid <- descriptorId <$> resolveType types ty
|
||||
validateValue types tid value
|
||||
Right (TypedExpression tid (Constant value))
|
||||
Reference name -> case [tid | (key, tid) <- env, key == name] of
|
||||
[tid] -> describeType types tid >> Right (TypedExpression tid (BoundReference name))
|
||||
[] -> Left ("unknown column: " ++ name)
|
||||
_ -> Left ("ambiguous column: " ++ name)
|
||||
Apply name arguments -> do
|
||||
bound <- mapM bind arguments
|
||||
sig <- resolveFunction functions name (map expressionType bound)
|
||||
Right (TypedExpression (signatureResult sig) (BoundApply (signatureId sig) bound))
|
||||
ListLiteral child arguments -> do
|
||||
childId <- descriptorId <$> resolveType types child
|
||||
bound <- mapM bind arguments
|
||||
if all ((== childId) . expressionType) bound
|
||||
then compound (listType child) (BoundList bound)
|
||||
else Left "list element type mismatch"
|
||||
NothingLiteral child -> compound (maybeType child) BoundNothing
|
||||
JustLiteral argument -> do
|
||||
bound <- bind argument
|
||||
compound (maybeType (typeExpression (expressionType bound))) (BoundJust bound)
|
||||
TupleLiteral arguments -> do
|
||||
bound <- mapM bind arguments
|
||||
compound (tupleType (map (typeExpression . expressionType) bound)) (BoundTuple bound)
|
||||
where
|
||||
-- | 绑定当前作用域的子表达式
|
||||
bind = bindExpression types functions env
|
||||
-- | 校验并构造复合表达式
|
||||
compound ty node = do
|
||||
tid <- descriptorId <$> resolveType types ty
|
||||
Right (TypedExpression tid node)
|
||||
|
||||
-- | 执行已绑定表达式并校验输出
|
||||
evaluateExpression :: TypeRegistry -> FunctionRegistry -> [(String, RuntimeValue)] -> TypedExpression -> Either String RuntimeValue
|
||||
evaluateExpression types functions row (TypedExpression tid node) = do
|
||||
value <- case node of
|
||||
Constant v -> Right v
|
||||
BoundReference name -> case [v | (key, v) <- row, key == name] of
|
||||
[v] -> Right v
|
||||
[] -> Left ("missing bound column: " ++ name)
|
||||
_ -> Left ("duplicate bound column: " ++ name)
|
||||
BoundApply fid arguments -> mapM evaluate arguments >>= invokeFunction types functions fid
|
||||
BoundList arguments -> RList <$> mapM evaluate arguments
|
||||
BoundNothing -> Right (RMaybe Nothing)
|
||||
BoundJust argument -> RMaybe . Just <$> evaluate argument
|
||||
BoundTuple arguments -> RTuple <$> mapM evaluate arguments
|
||||
validateValue types tid value
|
||||
Right value
|
||||
where
|
||||
-- | 执行当前行的子表达式
|
||||
evaluate = evaluateExpression types functions row
|
||||
|
||||
-- | 表达未绑定的关系计划
|
||||
data Plan = TableScan String | SingleRow | Projection [(String, Expression)] Plan
|
||||
| Selection Expression Plan deriving (Show, Eq)
|
||||
|
||||
-- | 保存绑定后的关系节点
|
||||
data PlanNode = BoundScan String | BoundSingleRow | BoundProjection [(String, TypedExpression)] TypedPlan
|
||||
| BoundSelection TypedExpression TypedPlan deriving (Show, Eq)
|
||||
|
||||
-- | 保存输出 schema 和关系节点
|
||||
data TypedPlan = TypedPlan [(String, TypeId)] PlanNode deriving (Show, Eq)
|
||||
|
||||
-- | 提取计划的输出 schema
|
||||
planSchema :: TypedPlan -> [(String, TypeId)]
|
||||
planSchema (TypedPlan output _) = output
|
||||
|
||||
-- | 使用目录 schema 绑定查询计划
|
||||
bindPlan :: TypeRegistry -> FunctionRegistry -> [(String, [(String, TypeExpr)])] -> Plan -> Either String TypedPlan
|
||||
bindPlan types functions catalog plan = case plan of
|
||||
TableScan name -> case [columns | (key, columns) <- catalog, key == name] of
|
||||
[columns] -> do
|
||||
uniqueNames (map fst columns)
|
||||
bound <- mapM bindColumn columns
|
||||
Right (TypedPlan bound (BoundScan name))
|
||||
[] -> Left ("unknown table: " ++ name)
|
||||
_ -> Left ("ambiguous table: " ++ name)
|
||||
SingleRow -> Right (TypedPlan [] BoundSingleRow)
|
||||
Projection items source -> do
|
||||
child <- bind source
|
||||
uniqueNames (map fst items)
|
||||
bound <- mapM (bindItem (planSchema child)) items
|
||||
Right (TypedPlan [(name, expressionType value) | (name, value) <- bound] (BoundProjection bound child))
|
||||
Selection condition source -> do
|
||||
child <- bind source
|
||||
predicate <- bindExpression types functions (planSchema child) condition
|
||||
bool <- descriptorId <$> resolveType types boolType
|
||||
if expressionType predicate == bool
|
||||
then Right (TypedPlan (planSchema child) (BoundSelection predicate child))
|
||||
else Left "selection predicate must be Bool"
|
||||
where
|
||||
-- | 绑定子计划
|
||||
bind = bindPlan types functions catalog
|
||||
-- | 解析 schema 列的类型身份
|
||||
bindColumn (name, ty) = do
|
||||
tid <- descriptorId <$> resolveType types ty
|
||||
Right (name, tid)
|
||||
-- | 绑定投影项
|
||||
bindItem env (name, value) = do
|
||||
bound <- bindExpression types functions env value
|
||||
Right (name, bound)
|
||||
|
||||
-- | 拒绝重复输出列
|
||||
uniqueNames :: [String] -> Either String ()
|
||||
uniqueNames names
|
||||
| nub names == names = Right ()
|
||||
| otherwise = Left "duplicate schema column"
|
||||
|
||||
-- | 执行绑定计划并校验存储返回值
|
||||
executePlan :: TypeRegistry -> FunctionRegistry -> (String -> Either String [[(String, RuntimeValue)]])
|
||||
-> TypedPlan -> Either String [[(String, RuntimeValue)]]
|
||||
executePlan types functions scan (TypedPlan output node) = do
|
||||
rows <- case node of
|
||||
BoundScan name -> scan name
|
||||
BoundSingleRow -> Right [[]]
|
||||
BoundProjection items child -> do
|
||||
input <- executePlan types functions scan child
|
||||
mapM (project items) input
|
||||
BoundSelection condition child -> do
|
||||
input <- executePlan types functions scan child
|
||||
filterM (keep condition) input
|
||||
mapM_ (validateRow output) rows
|
||||
Right [[(name, value) | (name, _) <- output, Just value <- [lookup name row]] | row <- rows]
|
||||
where
|
||||
-- | 计算一行的投影项
|
||||
project items row = mapM (projectItem row) items
|
||||
-- | 计算命名输出项
|
||||
projectItem row (name, expression) = do
|
||||
value <- evaluateExpression types functions row expression
|
||||
Right (name, value)
|
||||
-- | 计算选择条件
|
||||
keep condition row = do
|
||||
value <- evaluateExpression types functions row condition
|
||||
case value of
|
||||
RBool result -> Right result
|
||||
_ -> Left "bound predicate returned a non-Bool value"
|
||||
-- | 校验存储行的完整 schema
|
||||
validateRow columns row
|
||||
| sort (map fst row) /= sort (map fst columns) = Left "storage row schema mismatch"
|
||||
| otherwise = mapM_ (validateColumn row) columns
|
||||
-- | 按列名校验返回值的类型
|
||||
validateColumn row (name, tid) = case lookup name row of
|
||||
Just value -> validateValue types tid value
|
||||
Nothing -> Left ("missing bound column: " ++ name)
|
||||
@@ -0,0 +1,83 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Functions
|
||||
( FunctionId (..), FunctionSignature (..), FunctionRegistry
|
||||
, builtinFunctions, resolveFunction, resolveNullableFunction, functionSignature, invokeFunction
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import Data.Char (toLower)
|
||||
|
||||
-- 内建函数的固定身份、签名解析和类型化调用。
|
||||
|
||||
-- | 标识稳定的内建函数
|
||||
newtype FunctionId = FunctionId Int deriving (Show, Eq, Ord)
|
||||
|
||||
-- | 描述已解析的函数签名
|
||||
data FunctionSignature = FunctionSignature
|
||||
{ signatureId :: FunctionId, signatureName :: String
|
||||
, signatureArguments :: [TypeId], signatureResult :: TypeId
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- | 保存函数签名和实现
|
||||
newtype FunctionRegistry = FunctionRegistry [(FunctionSignature, [RuntimeValue] -> Either String RuntimeValue)]
|
||||
|
||||
-- | 从内建元数据恢复函数注册表
|
||||
builtinFunctions :: TypeRegistry -> Either String FunctionRegistry
|
||||
builtinFunctions types = do
|
||||
int <- descriptorId <$> resolveType types intType
|
||||
bool <- descriptorId <$> resolveType types boolType
|
||||
string <- descriptorId <$> resolveType types stringType
|
||||
Right (FunctionRegistry
|
||||
[(FunctionSignature (FunctionId 1) "length" [string] int, stringLength)
|
||||
,(FunctionSignature (FunctionId 2) "not" [bool] bool, booleanNot)])
|
||||
|
||||
-- | 按名称和完整参数类型解析函数
|
||||
resolveFunction :: FunctionRegistry -> String -> [TypeId] -> Either String FunctionSignature
|
||||
resolveFunction (FunctionRegistry functions) name arguments =
|
||||
case [sig | (sig, _) <- functions, map toLower (signatureName sig) == map toLower name
|
||||
, signatureArguments sig == arguments] of
|
||||
[sig] -> Right sig
|
||||
[] -> Left ("no matching function signature: " ++ name)
|
||||
_ -> Left ("ambiguous function signature: " ++ name)
|
||||
|
||||
-- | 按可空 SQL 参数解析确定签名
|
||||
resolveNullableFunction :: FunctionRegistry -> String -> [Maybe TypeId] -> Either String FunctionSignature
|
||||
resolveNullableFunction (FunctionRegistry functions) name arguments =
|
||||
case [sig | (sig, _) <- functions, map toLower (signatureName sig) == map toLower name
|
||||
, length arguments == length (signatureArguments sig)
|
||||
, and (zipWith matches arguments (signatureArguments sig))] of
|
||||
[sig] -> Right sig
|
||||
[] -> Left ("no matching function signature: " ++ name)
|
||||
_ -> Left ("ambiguous function signature: " ++ name)
|
||||
where
|
||||
-- | 匹配具体参数或未定型 NULL
|
||||
matches Nothing _ = True
|
||||
matches (Just supplied) expected = supplied == expected
|
||||
|
||||
-- | 按固定身份查找函数签名
|
||||
functionSignature :: FunctionRegistry -> FunctionId -> Either String FunctionSignature
|
||||
functionSignature (FunctionRegistry functions) fid = case [sig | (sig, _) <- functions, signatureId sig == fid] of
|
||||
[sig] -> Right sig
|
||||
_ -> Left ("unknown function identity: " ++ show fid)
|
||||
|
||||
-- | 校验参数并执行已解析的函数
|
||||
invokeFunction :: TypeRegistry -> FunctionRegistry -> FunctionId -> [RuntimeValue] -> Either String RuntimeValue
|
||||
invokeFunction types (FunctionRegistry functions) fid values =
|
||||
case [(sig, implementation) | (sig, implementation) <- functions, signatureId sig == fid] of
|
||||
[(sig, implementation)]
|
||||
| length values == length (signatureArguments sig) -> do
|
||||
sequence_ (zipWith (validateValue types) (signatureArguments sig) values)
|
||||
result <- implementation values
|
||||
validateValue types (signatureResult sig) result
|
||||
Right result
|
||||
| otherwise -> Left "function argument count mismatch"
|
||||
_ -> Left ("unknown function identity: " ++ show fid)
|
||||
|
||||
-- | 计算字符串字符个数
|
||||
stringLength :: [RuntimeValue] -> Either String RuntimeValue
|
||||
stringLength [RString text] = Right (RInt (length text))
|
||||
stringLength _ = Left "length expects String"
|
||||
|
||||
-- | 计算布尔取反
|
||||
booleanNot :: [RuntimeValue] -> Either String RuntimeValue
|
||||
booleanNot [RBool value] = Right (RBool (not value))
|
||||
booleanNot _ = Left "not expects Bool"
|
||||
@@ -0,0 +1,65 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Query
|
||||
( BoundQuery, QueryType (..), queryTypes, bindQuery, executeQueryM
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Engine.Algebra.Eval (evalRelOpM)
|
||||
import ChuSQL.Core.Engine.Algebra.Op (RelOp)
|
||||
import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
|
||||
import ChuSQL.Core.Engine.Algebra.Planner (translate)
|
||||
import ChuSQL.Core.Engine.Semantic (prepare, querySchema)
|
||||
import ChuSQL.Core.Engine.Syntax.AST (Statement)
|
||||
import ChuSQL.Core.Engine.Storage (MonadStorage)
|
||||
import ChuSQL.Core.Engine.Runtime.SQL (sqlType)
|
||||
import ChuSQL.Core.Engine.Runtime.Types (TypeId)
|
||||
import ChuSQL.Core.Model
|
||||
|
||||
-- SQL 查询绑定边界:保存解析后的类型、函数身份及输出 schema。
|
||||
|
||||
-- | 保存运行时或兼容列类型
|
||||
data QueryType = RuntimeType TypeId | CompatibilityType ColumnType | NullType deriving (Show, Eq)
|
||||
|
||||
-- | 保存仅由 schema 绑定的执行计划
|
||||
data BoundQuery = BoundQuery Database [(String, Column)] [(String, QueryType)] RelOp
|
||||
|
||||
-- | 查询绑定计划的输出类型身份
|
||||
queryTypes :: BoundQuery -> [(String, QueryType)]
|
||||
queryTypes (BoundQuery _ _ types _) = types
|
||||
|
||||
-- | 绑定 SQL 查询并优化确定的计划
|
||||
bindQuery :: Database -> Statement -> Either String BoundQuery
|
||||
bindQuery catalog statement = do
|
||||
let schemaOnly = [(name, table {tableRows = []}) | (name, table) <- catalog]
|
||||
resolved <- prepare schemaOnly statement
|
||||
columns <- querySchema schemaOnly resolved
|
||||
plan <- translate resolved
|
||||
types <- mapM typeOf columns
|
||||
Right (BoundQuery schemaOnly columns types (optimize schemaOnly plan))
|
||||
where
|
||||
-- | 解析输出列的运行时身份
|
||||
typeOf (name, column) = do
|
||||
ty <- bindingType (columnType column)
|
||||
Right (name, ty)
|
||||
-- | 保留阶段外类型的兼容表示
|
||||
bindingType CNull = Right NullType
|
||||
bindingType CDate = Right (CompatibilityType CDate)
|
||||
bindingType CTimestamp = Right (CompatibilityType CTimestamp)
|
||||
bindingType CBlob = Right (CompatibilityType CBlob)
|
||||
bindingType ty@(CDomain _ base)
|
||||
| typeClassOf base == TemporalClass || base == CBlob = Right (CompatibilityType ty)
|
||||
bindingType ty = RuntimeType <$> sqlType ty
|
||||
|
||||
-- | 执行绑定查询并校验输出类型
|
||||
executeQueryM :: MonadStorage m => BoundQuery -> m (Either String [Row])
|
||||
executeQueryM (BoundQuery catalog columns _ plan) = do
|
||||
result <- evalRelOpM catalog plan
|
||||
pure (result >>= mapM validateRow)
|
||||
where
|
||||
-- | 校验完整输出行而不重新解析函数
|
||||
validateRow row
|
||||
| map fst row /= map fst columns = Left "bound query output schema mismatch"
|
||||
| otherwise = mapM validateColumn (zip columns row)
|
||||
-- | 校验输出列的物理值
|
||||
validateColumn ((name, column), (_, value))
|
||||
| columnType column == CNull, value == VNull = Right (name, value)
|
||||
| valueFits (columnType column) value = Right (name, value)
|
||||
| otherwise = Left ("bound query output type mismatch: " ++ name)
|
||||
@@ -0,0 +1,92 @@
|
||||
module ChuSQL.Core.Engine.Runtime.SQL (resolveSQLFunction, sqlResultType, invokeSQLFunction, sqlType, constructSQLValue) where
|
||||
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import ChuSQL.Core.Engine.Runtime.Functions
|
||||
import ChuSQL.Core.Model (ColumnType (..), Value (..))
|
||||
|
||||
-- SQL 现有标量表示与已解析运行时函数之间的类型边界。
|
||||
|
||||
-- | 解析 SQL 标量调用的固定签名
|
||||
resolveSQLFunction :: String -> [Maybe ColumnType] -> Either String FunctionSignature
|
||||
resolveSQLFunction name arguments = do
|
||||
functions <- builtinFunctions builtinTypes
|
||||
types <- mapM (traverse sqlType) arguments
|
||||
resolveNullableFunction functions name types
|
||||
|
||||
-- | 解析现有标量列的逻辑类型
|
||||
sqlType :: ColumnType -> Either String TypeId
|
||||
sqlType (CDomain _ base) = sqlType base
|
||||
sqlType (CRuntime tid) = describeType builtinTypes tid >> Right tid
|
||||
sqlType ty = do
|
||||
expression <- case ty of
|
||||
CInt -> Right intType
|
||||
CBigInt -> Right intType
|
||||
CSmallInt -> Right intType
|
||||
CFloat -> Right doubleType
|
||||
CDouble -> Right doubleType
|
||||
CDecimal{} -> Right doubleType
|
||||
CBool -> Right boolType
|
||||
CStr -> Right stringType
|
||||
CVarchar{} -> Right stringType
|
||||
CChar{} -> Right stringType
|
||||
_ -> Left ("unsupported runtime function argument type: " ++ show ty)
|
||||
descriptorId <$> resolveType builtinTypes expression
|
||||
|
||||
-- | 将函数输出类型映射为 SQL schema
|
||||
sqlResultType :: TypeId -> Either String ColumnType
|
||||
sqlResultType tid
|
||||
| typeExpression tid == intType = Right CInt
|
||||
| typeExpression tid == doubleType = Right CDouble
|
||||
| typeExpression tid == boolType = Right CBool
|
||||
| typeExpression tid == stringType = Right CStr
|
||||
| otherwise = Left "runtime function result needs a composite SQL representation"
|
||||
|
||||
-- | 执行固定身份的 SQL 标量函数
|
||||
invokeSQLFunction :: FunctionId -> TypeId -> [Value] -> Either String Value
|
||||
invokeSQLFunction fid expected values = do
|
||||
functions <- builtinFunctions builtinTypes
|
||||
sig <- functionSignature functions fid
|
||||
if signatureResult sig /= expected then Left "bound function result identity mismatch"
|
||||
else if length values /= length (signatureArguments sig) then Left "function argument count mismatch"
|
||||
else do
|
||||
sequence_ (zipWith validateArgument (signatureArguments sig) values)
|
||||
if VNull `elem` values then Right VNull else do
|
||||
arguments <- mapM runtimeValue values
|
||||
result <- invokeFunction builtinTypes functions fid arguments
|
||||
sqlValue result
|
||||
where
|
||||
-- | 校验具体参数并保留 SQL NULL
|
||||
validateArgument _ VNull = Right ()
|
||||
validateArgument tid value = runtimeValue value >>= validateValue builtinTypes tid
|
||||
|
||||
-- | 转换现有 SQL 标量值
|
||||
runtimeValue :: Value -> Either String RuntimeValue
|
||||
runtimeValue (VInt n) = Right (RInt n)
|
||||
runtimeValue (VFloat n) = Right (RDouble n)
|
||||
runtimeValue (VBool b) = Right (RBool b)
|
||||
runtimeValue (VStr text) = Right (RString text)
|
||||
runtimeValue (VRuntime tid value) = validateValue builtinTypes tid value >> Right value
|
||||
runtimeValue VNull = Left "untyped SQL NULL has no runtime scalar value"
|
||||
|
||||
-- | 转换运行时标量结果
|
||||
sqlValue :: RuntimeValue -> Either String Value
|
||||
sqlValue (RInt n) = Right (VInt n)
|
||||
sqlValue (RDouble n) = Right (VFloat n)
|
||||
sqlValue (RBool b) = Right (VBool b)
|
||||
sqlValue (RString text) = Right (VStr text)
|
||||
sqlValue _ = Left "composite runtime result has no SQL scalar representation"
|
||||
|
||||
-- | 按已解析构造器生成类型化值
|
||||
constructSQLValue :: TypeId -> [Value] -> Either String Value
|
||||
constructSQLValue tid values = do
|
||||
arguments <- mapM runtimeValue values
|
||||
value <- case typeExpression tid of
|
||||
TypeApply (TypeConstructorId 5) [_] -> Right (RList arguments)
|
||||
TypeApply (TypeConstructorId 6) [_] -> case arguments of
|
||||
[] -> Right (RMaybe Nothing)
|
||||
[argument] -> Right (RMaybe (Just argument))
|
||||
_ -> Left "Maybe constructor expects zero or one argument"
|
||||
TypeApply (TypeConstructorId 7) _ -> Right (RTuple arguments)
|
||||
_ -> Left "type is not a composite constructor"
|
||||
validateValue builtinTypes tid value
|
||||
Right (VRuntime tid value)
|
||||
@@ -0,0 +1,5 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Types (module ChuSQL.Core.Runtime) where
|
||||
|
||||
import ChuSQL.Core.Runtime
|
||||
|
||||
-- 导出共享的运行时类型身份和物理编码契约。
|
||||
@@ -1,9 +1,12 @@
|
||||
module ChuSQL.Core.Engine.Semantic (check, prepare) where
|
||||
module ChuSQL.Core.Engine.Semantic (check, prepare, prepareRowExpression, querySchema) where
|
||||
|
||||
import ChuSQL.Core.Engine.Algebra.Expr (bareColumns, colsInExpr, hasAggregate)
|
||||
import ChuSQL.Core.Model
|
||||
import ChuSQL.Core.Engine.Syntax.AST
|
||||
import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
|
||||
import ChuSQL.Core.Engine.Runtime.Functions (FunctionSignature (..), builtinFunctions, functionSignature)
|
||||
import ChuSQL.Core.Engine.Runtime.SQL (resolveSQLFunction, sqlResultType, sqlType)
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import Data.Char (isAlphaNum, isAscii, toLower)
|
||||
import Data.List (intercalate, isInfixOf, isPrefixOf, isSuffixOf, nub)
|
||||
|
||||
@@ -21,6 +24,12 @@ prefixColumns mAlias cols = [(prefix ++ c, ty) | (c, ty) <- cols]
|
||||
where
|
||||
prefix = maybe "" (++ ".") mAlias
|
||||
|
||||
-- | 从 schema 推导查询输出列
|
||||
querySchema :: Database -> Statement -> Either String [(String, Column)]
|
||||
querySchema db statement = do
|
||||
columns <- inferSubqueryOutput db (Scope [] []) (Subquery statement [])
|
||||
Right [(name, plainColumn (derivedType ty)) | (name, ty) <- columns]
|
||||
|
||||
-- | 检查期的作用域:本层优先,外层兜底
|
||||
data Scope = Scope
|
||||
{ scopeInner :: [(String, Column)]
|
||||
@@ -103,6 +112,7 @@ checkGrouping env keys items
|
||||
| null keys && not (any (hasAggregate . snd) items) = Right ()
|
||||
| otherwise = do
|
||||
checkColumns "GROUP BY" env keys
|
||||
mapM_ (checkRuntimeColumn "GROUP BY" env) keys
|
||||
mapM_ okCol (nub (concatMap (bareColumns . snd) items))
|
||||
where
|
||||
-- | 这一列能不能出现在分组查询里
|
||||
@@ -127,6 +137,23 @@ inferExpr _ _ _ (LitBool _) = Right (InferType CBool)
|
||||
inferExpr _ _ _ (LitDate _) = Right (InferType CDate)
|
||||
inferExpr _ _ _ (LitTimestamp _) = Right (InferType CTimestamp)
|
||||
inferExpr _ _ _ (LitBlob _) = Right (InferType CBlob)
|
||||
inferExpr db place env (Construct ty arguments) = InferType . CRuntime <$> inferConstruction db place env ty arguments
|
||||
inferExpr db place env (BoundConstruct tid arguments) = do
|
||||
inferred <- inferConstruction db place env (typeExpression tid) arguments
|
||||
if inferred == tid then Right (InferType (CRuntime tid)) else Left "constructor result identity mismatch"
|
||||
inferExpr _ _ _ (RuntimeLiteral tid value) = validateValue builtinTypes tid value >> Right (InferType (CRuntime tid))
|
||||
inferExpr db place env (FunctionCall name arguments) = do
|
||||
inferred <- mapM (inferExpr db place env) arguments
|
||||
sig <- resolveSQLFunction name (map inferredArgument inferred)
|
||||
InferType <$> sqlResultType (signatureResult sig)
|
||||
inferExpr db place env (BoundFunction fid tid arguments) = do
|
||||
functions <- builtinFunctions builtinTypes
|
||||
expected <- functionSignature functions fid
|
||||
inferred <- mapM (inferExpr db place env) arguments
|
||||
resolved <- resolveSQLFunction (signatureName expected) (map inferredArgument inferred)
|
||||
if signatureId resolved == fid && signatureResult resolved == tid
|
||||
then InferType <$> sqlResultType tid
|
||||
else Left "bound function signature identity mismatch"
|
||||
inferExpr db place env (Add a b) = arithmetic db place env a b
|
||||
inferExpr db place env (Sub a b) = arithmetic db place env a b
|
||||
inferExpr db place env (Mul a b) = arithmetic db place env a b
|
||||
@@ -160,8 +187,8 @@ inferExpr db place env (AvgOf a) = do
|
||||
InferType x
|
||||
| numericType x -> Right (InferType CFloat)
|
||||
| otherwise -> Left (place ++ ": AVG needs a number, got " ++ typeLabel x)
|
||||
inferExpr db place env (MinOf a) = aggregateArg db place env a
|
||||
inferExpr db place env (MaxOf a) = aggregateArg db place env a
|
||||
inferExpr db place env (MinOf a) = aggregateArg db place env a >>= requireOrdering "MIN"
|
||||
inferExpr db place env (MaxOf a) = aggregateArg db place env a >>= requireOrdering "MAX"
|
||||
inferExpr db place env (ScalarSub sq) = do
|
||||
cols <- inferSubqueryOutput db env sq
|
||||
case cols of
|
||||
@@ -386,18 +413,18 @@ ddlTargets statement = case statement of
|
||||
-- | 从 schema 解析列上的命名类型
|
||||
resolveDomainTypes :: Database -> Statement -> Either String Statement
|
||||
resolveDomainTypes db statement = case statement of
|
||||
CreateDomain name base -> CreateDomain name <$> resolveType base
|
||||
CreateDomain name base -> CreateDomain name <$> resolveDomainType base
|
||||
CreateTable name cols -> CreateTable name <$> mapM resolveColumnType cols
|
||||
AddColumn name col -> AddColumn name <$> resolveColumnType col
|
||||
AlterColumnType name col ty -> AlterColumnType name col <$> resolveType ty
|
||||
AlterColumnType name col ty -> AlterColumnType name col <$> resolveDomainType ty
|
||||
_ -> Right statement
|
||||
where
|
||||
-- | 解析一列的类型
|
||||
resolveColumnType (name, col) = do
|
||||
ty <- resolveType (columnType col)
|
||||
ty <- resolveDomainType (columnType col)
|
||||
Right (name, col {columnType = ty})
|
||||
-- | 从类型目录取基础类型
|
||||
resolveType = resolveWith []
|
||||
resolveDomainType = resolveWith []
|
||||
-- | 递归解析类型并拒绝循环定义
|
||||
resolveWith seen (CDomain name _)
|
||||
| map toLower name `elem` seen = Left ("cyclic domain definition: " ++ name)
|
||||
@@ -427,6 +454,7 @@ checkResolvedWith db outer q = case q of
|
||||
checkColumns "SELECT" full cols
|
||||
checkGrouping full groupBy (map (\c -> (c, Col c)) cols)
|
||||
checkColumns "ORDER BY" full (map fst orderBy)
|
||||
mapM_ (checkRuntimeColumn "ORDER BY" full . fst) orderBy
|
||||
mapM_ (checkNoAggregate "WHERE") mWhere
|
||||
mapM_ (checkBool db "WHERE" full) mWhere
|
||||
SelectExpr items fromC mWhere groupBy orderBy _ -> do
|
||||
@@ -434,7 +462,7 @@ checkResolvedWith db outer q = case q of
|
||||
let full = Scope env outer
|
||||
mapM_ (\item -> () <$ inferExpr db "SELECT" full (snd item)) items
|
||||
checkGrouping full groupBy (items ++ [(c, Col c) | (c, _) <- orderBy, c `notElem` map fst items])
|
||||
mapM_ (checkOrder full items . fst) orderBy
|
||||
mapM_ (checkOrder db full items . fst) orderBy
|
||||
mapM_ (checkNoAggregate "WHERE") mWhere
|
||||
mapM_ (checkBool db "WHERE" full) mWhere
|
||||
Insert tbl cols rows -> do
|
||||
@@ -468,7 +496,7 @@ checkResolvedWith db outer q = case q of
|
||||
CreateIndex tbl col -> do
|
||||
t <- lookupTable db tbl
|
||||
if col `elem` tableCols' t
|
||||
then Right ()
|
||||
then checkRuntimeColumn "CREATE INDEX" (Scope (tableCols t) []) col
|
||||
else Left ("CREATE INDEX: unknown column: " ++ col)
|
||||
DropIndex tbl col -> do
|
||||
t <- lookupTable db tbl
|
||||
@@ -581,14 +609,22 @@ checkColumnDefs names cols = do
|
||||
mapM_ (checkTypeParameters . columnType . snd) cols
|
||||
mapM_ (\(_, c) -> mapM_ (checkDefault c) (columnDefault c)) cols
|
||||
mapM_ (\(_, c) -> checkAutoIncrement c) cols
|
||||
mapM_ checkRuntimeKey cols
|
||||
if length [() | (_, c) <- cols, columnAutoIncrement c] > 1
|
||||
then Left "CREATE TABLE: at most one AUTO_INCREMENT column is allowed"
|
||||
else Right ()
|
||||
checkChecks names cols
|
||||
where
|
||||
-- | 拒绝缺少能力实现的运行时键
|
||||
checkRuntimeKey (_, column)
|
||||
| typeClassOf (columnType column) == RuntimeClass
|
||||
, columnUnique column || columnPrimaryKey column = Left "runtime type key capability is not registered"
|
||||
| otherwise = Right ()
|
||||
|
||||
-- | 校验列类型的长度和精度参数
|
||||
checkTypeParameters :: ColumnType -> Either String ()
|
||||
checkTypeParameters (CDomain _ base) = checkTypeParameters base
|
||||
checkTypeParameters (CRuntime tid) = () <$ describeType builtinTypes tid
|
||||
checkTypeParameters CNull = Left "NULL is only valid as an inferred query output"
|
||||
checkTypeParameters (CDecimal p s)
|
||||
| p <= 0 || p > 308 || s < 0 || s > p = Left "invalid decimal precision or scale"
|
||||
@@ -707,6 +743,17 @@ resolveExpr ::
|
||||
Expr ->
|
||||
Either String Expr
|
||||
resolveExpr db env outer f e = case e of
|
||||
Construct ty arguments -> do
|
||||
tid <- inferConstruction db "constructor" (Scope env outer) ty arguments
|
||||
bound <- mapM (resolveExpr db env outer f) arguments
|
||||
Right (BoundConstruct tid bound)
|
||||
BoundConstruct tid arguments -> BoundConstruct tid <$> mapM (resolveExpr db env outer f) arguments
|
||||
FunctionCall name arguments -> do
|
||||
inferred <- mapM (inferExpr db "function" (Scope env outer)) arguments
|
||||
sig <- resolveSQLFunction name (map inferredArgument inferred)
|
||||
bound <- mapM (resolveExpr db env outer f) arguments
|
||||
Right (BoundFunction (signatureId sig) (signatureResult sig) bound)
|
||||
BoundFunction fid tid arguments -> BoundFunction fid tid <$> mapM (resolveExpr db env outer f) arguments
|
||||
Col c -> Col <$> f c
|
||||
Add a b -> binary Add a b
|
||||
Sub a b -> binary Sub a b
|
||||
@@ -739,6 +786,36 @@ resolveExpr db env outer f e = case e of
|
||||
-- | 递归处理两个子表达式
|
||||
binary ctor a b = ctor <$> resolveExpr db env outer f a <*> resolveExpr db env outer f b
|
||||
|
||||
-- | 校验具体构造器和参数逻辑类型
|
||||
inferConstruction :: Database -> String -> Scope -> TypeExpr -> [Expr] -> Either String TypeId
|
||||
inferConstruction db place env ty@(TypeApply cid parameters) arguments = do
|
||||
descriptor <- resolveType builtinTypes ty
|
||||
expected <- case (cid, parameters) of
|
||||
(TypeConstructorId 5, [child]) -> Right (replicate (length arguments) child)
|
||||
(TypeConstructorId 6, [child]) | length arguments <= 1 -> Right (replicate (length arguments) child)
|
||||
(TypeConstructorId 7, fields) | length fields == length arguments -> Right fields
|
||||
_ -> Left "composite constructor argument count mismatch"
|
||||
inferred <- mapM (inferExpr db place env) arguments
|
||||
supplied <- mapM argumentIdentity inferred
|
||||
required <- mapM (fmap descriptorId . resolveType builtinTypes) expected
|
||||
if supplied == required then Right (descriptorId descriptor) else Left "composite constructor argument type mismatch"
|
||||
where
|
||||
-- | 解析非空参数的逻辑类型身份
|
||||
argumentIdentity InferNull = Left "SQL NULL needs Maybe construction inside a runtime value"
|
||||
argumentIdentity (InferType column) = sqlType column
|
||||
|
||||
-- | 使用单行 schema 绑定表达式
|
||||
prepareRowExpression :: [(String, Column)] -> Expr -> Either String Expr
|
||||
prepareRowExpression columns expression = do
|
||||
bound <- resolveExpr [] columns [] (nameIn columns "expression") expression
|
||||
_ <- inferExpr [] "expression" (Scope columns []) bound
|
||||
Right bound
|
||||
|
||||
-- | 将推导类型转换为可空参数类型
|
||||
inferredArgument :: InferredType -> Maybe ColumnType
|
||||
inferredArgument InferNull = Nothing
|
||||
inferredArgument (InferType ty) = Just ty
|
||||
|
||||
-- | 解析子查询,并记下它引用的外层列
|
||||
resolveSubquery :: Database -> [(String, Column)] -> Subquery -> Either String Subquery
|
||||
resolveSubquery db outer sq = do
|
||||
@@ -822,12 +899,25 @@ resolveSelect db q@SelectExpr{} = resolveQuery db [] q (selectItems q)
|
||||
resolveSelect _ q = Right q
|
||||
|
||||
-- | 检查排序输出别名或来源列
|
||||
checkOrder :: Scope -> [(String, Expr)] -> String -> Either String ()
|
||||
checkOrder env items column = case [e | (label, e) <- items, label == column] of
|
||||
[] -> checkColumns "ORDER BY" env [column]
|
||||
[_] -> Right ()
|
||||
checkOrder :: Database -> Scope -> [(String, Expr)] -> String -> Either String ()
|
||||
checkOrder db env items column = case [e | (label, e) <- items, label == column] of
|
||||
[] -> checkRuntimeColumn "ORDER BY" env column
|
||||
[expression] -> () <$ (inferExpr db "ORDER BY" env expression >>= requireOrdering "ORDER BY")
|
||||
_ -> Left ("ORDER BY: ambiguous projection alias: " ++ column)
|
||||
|
||||
-- | 校验列已有排序能力
|
||||
checkRuntimeColumn :: String -> Scope -> String -> Either String ()
|
||||
checkRuntimeColumn place env column = do
|
||||
(_, definition) <- scopeAt place env column
|
||||
() <$ requireOrdering place (InferType (columnType definition))
|
||||
|
||||
-- | 拒绝尚未注册能力的复合类型
|
||||
requireOrdering :: String -> InferredType -> Either String InferredType
|
||||
requireOrdering place inferred@(InferType ty)
|
||||
| typeClassOf ty == RuntimeClass = Left (place ++ ": runtime type capability is not registered")
|
||||
| otherwise = Right inferred
|
||||
requireOrdering _ inferred = Right inferred
|
||||
|
||||
-- | 解析投影、条件、排序与连接引用
|
||||
resolveQuery :: Database -> [(String, Column)] -> Statement -> [(String, Expr)] -> Either String Statement
|
||||
resolveQuery db outer q items = do
|
||||
|
||||
@@ -1,6 +1,8 @@
|
||||
module ChuSQL.Core.Engine.Syntax.AST (Statement (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), Quantifier (..), CompareOp (..), SortDir (..), makeSelect) where
|
||||
|
||||
import ChuSQL.Core.Model (Column (..), ColumnType, Value (..))
|
||||
import ChuSQL.Core.Engine.Runtime.Types (TypeId, TypeExpr, RuntimeValue)
|
||||
import ChuSQL.Core.Engine.Runtime.Functions (FunctionId)
|
||||
|
||||
-- 语法树:语句、数据来源、条件表达式、排序方向。
|
||||
|
||||
@@ -112,6 +114,11 @@ data CompareOp
|
||||
-- | 条件表达式:列、字面量、算术、比较、逻辑、聚合与子查询
|
||||
data Expr
|
||||
= Col String
|
||||
| FunctionCall String [Expr]
|
||||
| BoundFunction FunctionId TypeId [Expr]
|
||||
| Construct TypeExpr [Expr]
|
||||
| BoundConstruct TypeId [Expr]
|
||||
| RuntimeLiteral TypeId RuntimeValue
|
||||
| LitNull
|
||||
| LitInt Int
|
||||
| LitFloat Double
|
||||
|
||||
@@ -5,6 +5,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, compareNode)
|
||||
import ChuSQL.Core.Engine.Syntax.AST
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
|
||||
import Data.Char (isAlpha, isAlphaNum, isHexDigit, isSpace, toLower, toUpper)
|
||||
@@ -167,6 +168,8 @@ atom =
|
||||
, LitInt <$> integer
|
||||
, LitStr <$> stringLit
|
||||
, try aggregateCall
|
||||
, try constructorCall
|
||||
, try scalarFunctionCall
|
||||
, try existsPredicate
|
||||
, Col <$> qualifiedName
|
||||
, try scalarSubquery
|
||||
@@ -202,6 +205,33 @@ inPredicate = do
|
||||
subquerySelect :: Parser Subquery
|
||||
subquerySelect = Subquery <$> queryStatement <*> pure []
|
||||
|
||||
-- | 读取带具体类型参数的构造器
|
||||
constructorCall :: Parser Expr
|
||||
constructorCall = do
|
||||
cid <- (TypeConstructorId 5 <$ keyword "list") <|> (TypeConstructorId 6 <$ keyword "maybe")
|
||||
<|> (TypeConstructorId 7 <$ keyword "tuple")
|
||||
arguments <- between (symbol "<") (symbol ">") (sepBy runtimeTypeP (symbol ","))
|
||||
values <- between (symbol "(") (symbol ")") (sepBy expr (symbol ","))
|
||||
pure (Construct (TypeApply cid arguments) values)
|
||||
|
||||
-- | 解析运行时逻辑类型语法
|
||||
runtimeTypeP :: Parser TypeExpr
|
||||
runtimeTypeP = choice
|
||||
[ intType <$ keyword "int", doubleType <$ keyword "double", boolType <$ keyword "bool"
|
||||
, stringType <$ keyword "string", stringType <$ keyword "str", stringType <$ keyword "text"
|
||||
, listType <$> between (symbol "[") (symbol "]") runtimeTypeP
|
||||
, listType <$> (keyword "list" *> runtimeTypeP)
|
||||
, maybeType <$> (keyword "maybe" *> runtimeTypeP)
|
||||
, tupleType <$> between (symbol "(") (symbol ")") (sepBy runtimeTypeP (symbol ","))
|
||||
]
|
||||
|
||||
-- | 读取待绑定的标量函数调用
|
||||
scalarFunctionCall :: Parser Expr
|
||||
scalarFunctionCall = do
|
||||
name <- identifier
|
||||
arguments <- between (symbol "(") (symbol ")") (sepBy expr (symbol ","))
|
||||
pure (FunctionCall name arguments)
|
||||
|
||||
-- | 聚合调用:名称与节点都由内置函数表给出
|
||||
aggregateCall :: Parser Expr
|
||||
aggregateCall = choice (countAll : map named builtinNames)
|
||||
@@ -480,7 +510,9 @@ alterUserStatement = do
|
||||
-- | 读身份属性开关
|
||||
identityAttribute :: Parser (String, Bool)
|
||||
identityAttribute = choice
|
||||
[ ("system_catalog_manager", True) <$ keyword "system_catalog_manager"
|
||||
[ ("allow_sudo_auth", True) <$ keyword "allow_sudo_auth"
|
||||
, ("allow_sudo_auth", False) <$ keyword "noallow_sudo_auth"
|
||||
, ("system_catalog_manager", True) <$ keyword "system_catalog_manager"
|
||||
, ("system_catalog_manager", False) <$ keyword "nosystem_catalog_manager"
|
||||
, ("login", True) <$ keyword "login", ("login", False) <$ keyword "nologin"
|
||||
, ("superuser", True) <$ keyword "superuser", ("superuser", False) <$ keyword "nosuperuser"
|
||||
@@ -525,12 +557,16 @@ privilegeName =
|
||||
, "INSERT" <$ keyword "insert"
|
||||
, "UPDATE" <$ keyword "update"
|
||||
, "DELETE" <$ keyword "delete"
|
||||
, "CONNECT" <$ keyword "connect"
|
||||
, "CREATE" <$ keyword "create"
|
||||
, "ALL" <$ keyword "all"
|
||||
]
|
||||
|
||||
-- | ON 后面的授权对象:* 或一张表
|
||||
grantObject :: Parser String
|
||||
grantObject = ("*" <$ symbol "*") <|> tableName
|
||||
grantObject = try (("database:" ++) <$> (keyword "database" *> identifier))
|
||||
<|> try ((++ ".*") <$> (identifier <* symbol "." <* symbol "*"))
|
||||
<|> ("*" <$ symbol "*") <|> (optional (keyword "table") *> tableName)
|
||||
|
||||
-- | 可选的 WITH GRANT OPTION
|
||||
grantOption :: Parser Bool
|
||||
@@ -597,7 +633,8 @@ sizeParen = try (between (symbol "(") (symbol ")") integer)
|
||||
columnTypeP :: Parser ColumnType
|
||||
columnTypeP =
|
||||
choice
|
||||
[ keyword "integer" >> pure CInt
|
||||
[ try runtimeColumnType
|
||||
, keyword "integer" >> pure CInt
|
||||
, keyword "int" >> pure CInt
|
||||
, keyword "bigint" >> pure CBigInt
|
||||
, keyword "smallint" >> pure CSmallInt
|
||||
@@ -619,6 +656,20 @@ columnTypeP =
|
||||
, (\name -> CDomain (map toLower name) CStr) <$> identifier
|
||||
]
|
||||
|
||||
-- | 解析复合列的稳定类型身份
|
||||
runtimeColumnType :: Parser ColumnType
|
||||
runtimeColumnType = do
|
||||
expression <- choice
|
||||
[ listType <$> between (symbol "[") (symbol "]") runtimeTypeP
|
||||
, listType <$> (keyword "list" *> runtimeTypeP)
|
||||
, maybeType <$> (keyword "maybe" *> runtimeTypeP)
|
||||
, tupleType <$> between (symbol "(") (symbol ")") (sepBy runtimeTypeP (symbol ","))
|
||||
, stringType <$ keyword "string"
|
||||
]
|
||||
case resolveType builtinTypes expression of
|
||||
Left err -> fail err
|
||||
Right descriptor -> pure (CRuntime (descriptorId descriptor))
|
||||
|
||||
-- | DECIMAL 的精度与小数位
|
||||
decimalType :: Parser ColumnType
|
||||
decimalType = do
|
||||
@@ -744,6 +795,10 @@ expandClause env fromC = case fromC of
|
||||
-- | 表达式里的子查询也要展开
|
||||
expandExpr :: [(String, Statement)] -> Expr -> Either String Expr
|
||||
expandExpr env e = case e of
|
||||
Construct tid arguments -> Construct tid <$> mapM go arguments
|
||||
BoundConstruct tid arguments -> BoundConstruct tid <$> mapM go arguments
|
||||
FunctionCall name arguments -> FunctionCall name <$> mapM go arguments
|
||||
BoundFunction fid tid arguments -> BoundFunction fid tid <$> mapM go arguments
|
||||
Add a b -> Add <$> go a <*> go b
|
||||
Sub a b -> Sub <$> go a <*> go b
|
||||
Mul a b -> Mul <$> go a <*> go b
|
||||
|
||||
@@ -0,0 +1,70 @@
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
module NormalizationSpec (spec) where
|
||||
|
||||
import ChuSQL.Core.Engine.Normalization
|
||||
import ChuSQL.Core.Model (pattern TInt)
|
||||
import Test.Hspec
|
||||
|
||||
-- 范式分析回归:公理闭包、候选键、信息不足与分解性质。
|
||||
|
||||
-- 执行范式检查回归。
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "Armstrong normalization" $ do
|
||||
it "computes reflexivity, augmentation and transitivity" $ do
|
||||
attributeClosure [Dependency ["a"] ["b"], Dependency ["b"] ["c"]] ["a"]
|
||||
`shouldBe` ["a", "b", "c"]
|
||||
implies [Dependency ["a"] ["b"]] (Dependency ["a", "c"] ["b", "c"])
|
||||
`shouldBe` True
|
||||
attributeClosure [] ["a"] `shouldBe` ["a"]
|
||||
it "accepts BCNF with a declared key" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [["a"]] [] True (Just True)))
|
||||
`shouldBe` Right (replicate 4 Satisfied)
|
||||
it "detects partial dependencies of composite keys" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [["a", "b"]] [Dependency ["a"] ["c"]] True (Just True)))
|
||||
`shouldBe` Right [Satisfied, Violated, Violated, Violated]
|
||||
it "detects transitive dependencies" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [["a"]] [Dependency ["b"] ["c"]] True (Just True)))
|
||||
`shouldBe` Right [Satisfied, Satisfied, Violated, Violated]
|
||||
it "distinguishes 3NF from BCNF using all candidate keys" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [["a", "b"]] [Dependency ["c"] ["b"]] True (Just True)))
|
||||
`shouldBe` Right [Satisfied, Satisfied, Satisfied, Violated]
|
||||
it "reports lossless decomposition that loses dependencies" $ do
|
||||
fmap suggestions (analyzeNormalization schema
|
||||
(Declaration [["a", "b"]] [Dependency ["c"] ["b"]] True (Just True)))
|
||||
`shouldBe` Right [Decomposition [["b", "c"], ["a", "c"]] Satisfied Violated]
|
||||
it "reports dependency preserving transitive split" $ do
|
||||
fmap suggestions (analyzeNormalization schema
|
||||
(Declaration [["a"]] [Dependency ["b"] ["c"]] True (Just True)))
|
||||
`shouldBe` Right [Decomposition [["b", "c"], ["a", "b"]] Satisfied Satisfied]
|
||||
it "does not certify incomplete dependencies" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [["a"]] [] False (Just True)))
|
||||
`shouldBe` Right [Satisfied, Insufficient, Insufficient, Insufficient]
|
||||
it "requires an atomicity declaration" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [] [] True Nothing)) `shouldBe` Right (replicate 4 Insufficient)
|
||||
it "propagates a declared 1NF violation" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [] [] True (Just False))) `shouldBe` Right (replicate 4 Violated)
|
||||
it "rejects unknown attributes" $ do
|
||||
analyzeNormalization schema (Declaration [] [Dependency ["z"] ["a"]] True (Just True))
|
||||
`shouldBe` Left "normalization: unknown or duplicate dependency attributes"
|
||||
it "rejects nonminimal declared candidate keys" $ do
|
||||
analyzeNormalization schema (Declaration [["a", "b"]]
|
||||
[Dependency ["a"] ["b", "c"]] True (Just True))
|
||||
`shouldBe` Left "normalization: declared candidate key is not minimal"
|
||||
it "includes the empty candidate key for constant relations" $ do
|
||||
fmap candidateKeys (analyzeNormalization schema
|
||||
(Declaration [] [Dependency [] ["a", "b", "c"]] True (Just True))) `shouldBe` Right [[]]
|
||||
it "rejects excessive exhaustive searches" $ do
|
||||
analyzeNormalization [(show n, TInt) | n <- [1 :: Int .. 13]]
|
||||
(Declaration [] [] True (Just True))
|
||||
`shouldBe` Left "normalization: exhaustive analysis supports at most 12 columns"
|
||||
where
|
||||
schema = [("a", TInt), ("b", TInt), ("c", TInt)]
|
||||
@@ -0,0 +1,222 @@
|
||||
module RuntimeSpec (spec) where
|
||||
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import ChuSQL.Core.Engine.Runtime.Functions
|
||||
import ChuSQL.Core.Engine.Runtime.Binding
|
||||
import qualified ChuSQL.Core.Engine.Runtime.Query as Query
|
||||
import ChuSQL.Core.Engine (rowsOf, runStatement)
|
||||
import ChuSQL.Core.Engine.Semantic (prepare)
|
||||
import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
|
||||
import ChuSQL.Core.Engine.Syntax.AST (Expr (..), Statement (..))
|
||||
import qualified ChuSQL.Core.Model as SQL
|
||||
import ChuSQL.Core.Protocol (valueToJSON, valueFromJSON)
|
||||
import Data.Aeson.Types (parseEither)
|
||||
import Data.Hashable (hash)
|
||||
import qualified Data.ByteString.Lazy.Char8 as BS
|
||||
import Test.Hspec
|
||||
|
||||
-- 运行时类型、函数绑定、物理编码和类型化查询测试。
|
||||
|
||||
-- | 检查运行时类型基础契约
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "runtime type registry" $ do
|
||||
it "keeps a fixed identity encoding across releases" $ withType (listType intType) $ \tid ->
|
||||
encodeType tid `shouldBe` BS.pack "[1,[5,[[1,[]]]]]"
|
||||
it "parses nested Haskell-style type expressions" $
|
||||
parseTypeExpr "(Int, [Maybe String])" `shouldBe` Right (tupleType [intType, listType (maybeType stringType)])
|
||||
it "rejects constructor names without a token boundary" $
|
||||
parseTypeExpr "MaybeInt" `shouldSatisfy` isFailure
|
||||
it "restores stable nested identities from bootstrap metadata" $ do
|
||||
let ty = tupleType [listType intType, maybeType stringType]
|
||||
resolveType builtinTypes ty `shouldBe` resolveType builtinTypes ty
|
||||
fmap descriptorPhysical (resolveType builtinTypes ty)
|
||||
`shouldBe` Right (Product [Sequence SignedInteger, Optional Utf8])
|
||||
it "distinguishes logical String from List Int" $
|
||||
fmap descriptorId (resolveType builtinTypes stringType)
|
||||
`shouldNotBe` fmap descriptorId (resolveType builtinTypes (listType intType))
|
||||
it "rejects unknown constructors" $
|
||||
resolveType builtinTypes (TypeApply (TypeConstructorId 99) []) `shouldSatisfy` isFailure
|
||||
it "rejects unapplied List" $
|
||||
resolveType builtinTypes (TypeApply (TypeConstructorId 5) []) `shouldSatisfy` isFailure
|
||||
it "rejects arguments to Int" $
|
||||
resolveType builtinTypes (TypeApply (TypeConstructorId 1) [intType]) `shouldSatisfy` isFailure
|
||||
describe "runtime encoding" $ do
|
||||
it "round trips nested lists, optional values and tuples" $ do
|
||||
let ty = tupleType [listType (maybeType intType), stringType, doubleType, boolType]
|
||||
value = RTuple [RList [RMaybe Nothing, RMaybe (Just (RInt 42))], RString "你好", RDouble 1.25, RBool True]
|
||||
withType ty $ \tid -> do
|
||||
(encodeValue builtinTypes tid value >>= decodeValue builtinTypes tid) `shouldBe` Right value
|
||||
decodeType builtinTypes (encodeType tid) `shouldBe` Right tid
|
||||
it "round trips the empty tuple" $ withType (tupleType []) $ \tid ->
|
||||
(encodeValue builtinTypes tid (RTuple []) >>= decodeValue builtinTypes tid) `shouldBe` Right (RTuple [])
|
||||
it "rejects mismatched list elements" $ withType (listType intType) $ \tid ->
|
||||
encodeValue builtinTypes tid (RList [RString "bad"]) `shouldSatisfy` isFailure
|
||||
it "rejects tuple arity mismatch" $ withType (tupleType [intType]) $ \tid ->
|
||||
encodeValue builtinTypes tid (RTuple []) `shouldSatisfy` isFailure
|
||||
it "rejects non-finite floating point values" $ withType doubleType $ \tid ->
|
||||
encodeValue builtinTypes tid (RDouble (1 / 0)) `shouldSatisfy` isFailure
|
||||
it "rejects unsupported type encoding versions" $
|
||||
decodeType builtinTypes (BS.pack "[2,[1,[]]]") `shouldSatisfy` isFailure
|
||||
it "rejects overflowed constructor identities" $
|
||||
decodeType builtinTypes (BS.pack "[1,[18446744073709551617,[]]]") `shouldSatisfy` isFailure
|
||||
it "rejects fractional integer payloads" $ withType intType $ \tid ->
|
||||
decodeValue builtinTypes tid (BS.pack "[1,[1,[]],1.5]") `shouldSatisfy` isFailure
|
||||
it "rejects encoded identity mismatch" $ withType intType $ \tid ->
|
||||
decodeValue builtinTypes tid (BS.pack "[1,[4,[]],\"x\"]") `shouldSatisfy` isFailure
|
||||
describe "runtime binder and executor" $ do
|
||||
it "resolves case-insensitive length to a stable FunctionId" $ withFunctions $ \functions ->
|
||||
withType stringType $ \string -> withType intType $ \int ->
|
||||
resolveFunction functions "LENGTH" [string]
|
||||
`shouldBe` Right (FunctionSignature (FunctionId 1) "length" [string] int)
|
||||
it "binds and executes nested calls" $ withFunctions $ \functions -> do
|
||||
let expression = Apply "not" [Apply "not" [Literal boolType (RBool True)]]
|
||||
(bindExpression builtinTypes functions [] expression >>= evaluateExpression builtinTypes functions [])
|
||||
`shouldBe` Right (RBool True)
|
||||
it "rejects a wrong function argument type during binding" $ withFunctions $ \functions ->
|
||||
bindExpression builtinTypes functions [] (Apply "length" [Literal intType (RInt 1)]) `shouldSatisfy` isFailure
|
||||
it "rejects unknown function identities" $ withFunctions $ \functions ->
|
||||
invokeFunction builtinTypes functions (FunctionId 99) [] `shouldSatisfy` isFailure
|
||||
it "rejects wrong runtime argument types" $ withFunctions $ \functions ->
|
||||
invokeFunction builtinTypes functions (FunctionId 1) [RInt 1] `shouldSatisfy` isFailure
|
||||
it "binds empty List and Nothing using explicit element types" $ withFunctions $ \functions -> do
|
||||
let expression = TupleLiteral [ListLiteral intType [], NothingLiteral stringType]
|
||||
(bindExpression builtinTypes functions [] expression >>= evaluateExpression builtinTypes functions [])
|
||||
`shouldBe` Right (RTuple [RList [], RMaybe Nothing])
|
||||
it "rejects mixed logical list types" $ withFunctions $ \functions ->
|
||||
bindExpression builtinTypes functions [] (ListLiteral intType [Literal doubleType (RDouble 1)]) `shouldSatisfy` isFailure
|
||||
it "binds queries using schema without reading storage" $ withFunctions $ \functions -> do
|
||||
let catalog = [("items", [("name", stringType), ("enabled", boolType)])]
|
||||
query = Projection [("size", Apply "length" [Reference "name"])]
|
||||
(Selection (Reference "enabled") (TableScan "items"))
|
||||
scan name = if name == "items" then Right
|
||||
[[("name", RString "甲乙"), ("enabled", RBool True)]
|
||||
,[("name", RString "hidden"), ("enabled", RBool False)]] else Left "unknown storage table"
|
||||
(bindPlan builtinTypes functions catalog query >>= executePlan builtinTypes functions scan)
|
||||
`shouldBe` Right [[("size", RInt 2)]]
|
||||
it "uses catalog existence even when storage could return rows" $ withFunctions $ \functions ->
|
||||
bindPlan builtinTypes functions [] (TableScan "missing") `shouldSatisfy` isFailure
|
||||
it "rejects non-boolean filters" $ withFunctions $ \functions ->
|
||||
bindPlan builtinTypes functions [] (Selection (Literal intType (RInt 1)) SingleRow) `shouldSatisfy` isFailure
|
||||
it "rejects schema drift returned by storage" $ withFunctions $ \functions ->
|
||||
(bindPlan builtinTypes functions [("t", [("x", intType)])] (TableScan "t")
|
||||
>>= executePlan builtinTypes functions (const (Right [[("x", RString "wrong")]]))) `shouldSatisfy` isFailure
|
||||
it "propagates storage failures" $ withFunctions $ \functions ->
|
||||
(bindPlan builtinTypes functions [("t", [])] (TableScan "t")
|
||||
>>= executePlan builtinTypes functions (const (Left "storage unavailable"))) `shouldBe` Left "storage unavailable"
|
||||
describe "SQL runtime functions" $ do
|
||||
it "binds the SQL entry point to output TypeIds" $ withType intType $ \tid -> do
|
||||
let result = parseStatement "SELECT length('abc') AS size" >>= Query.bindQuery []
|
||||
fmap Query.queryTypes result `shouldBe` Right [("size", Query.RuntimeType tid)]
|
||||
it "retains compatibility for existing temporal SQL types" $ do
|
||||
let result = parseStatement "SELECT DATE '2026-10-05' AS today" >>= Query.bindQuery []
|
||||
fmap Query.queryTypes result `shouldBe` Right [("today", Query.CompatibilityType SQL.CDate)]
|
||||
it "rejects composite ordering without an Ord implementation" $
|
||||
sql "SELECT LIST<Int>(1) AS xs ORDER BY xs" `shouldSatisfy` isFailure
|
||||
it "rejects composite extrema without an Ord implementation" $
|
||||
sql "SELECT MIN(LIST<Int>(1))" `shouldSatisfy` isFailure
|
||||
it "rejects unique runtime columns without a key implementation" $
|
||||
(parseStatement "CREATE TABLE keyed (xs [Int] UNIQUE)" >>= runStatement []) `shouldSatisfy` isFailure
|
||||
it "rejects primary runtime keys without a key implementation" $
|
||||
(parseStatement "CREATE TABLE keyed (xs [Int] PRIMARY KEY)" >>= runStatement []) `shouldSatisfy` isFailure
|
||||
it "constructs nested compound values in SQL" $ withType (listType (maybeType intType)) $ \tid ->
|
||||
sql "SELECT LIST<Maybe Int>(MAYBE<Int>(), MAYBE<Int>(42))"
|
||||
`shouldBe` Right [[SQL.VRuntime tid (RList [RMaybe Nothing, RMaybe (Just (RInt 42))])]]
|
||||
it "constructs heterogeneous tuples with stable type identity" $ withType (tupleType [intType, stringType]) $ \tid ->
|
||||
sql "SELECT TUPLE<Int, String>(1, 'a')" `shouldBe` Right [[SQL.VRuntime tid (RTuple [RInt 1, RString "a"])]]
|
||||
it "rejects constructor argument type mismatch" $
|
||||
sql "SELECT LIST<Int>('bad')" `shouldSatisfy` isFailure
|
||||
it "rejects constructor arity mismatch" $
|
||||
sql "SELECT MAYBE<Int>(1, 2)" `shouldSatisfy` isFailure
|
||||
it "rejects SQL NULL inside a typed compound value" $
|
||||
sql "SELECT LIST<Int>(NULL)" `shouldSatisfy` isFailure
|
||||
it "round trips typed runtime values through the shared wire protocol" $
|
||||
withType (maybeType (listType intType)) $ \tid -> do
|
||||
let value = SQL.VRuntime tid (RMaybe (Just (RList [RInt 1, RInt 2])))
|
||||
parseEither valueFromJSON (valueToJSON value) `shouldBe` Right value
|
||||
it "round trips typed schema identities through catalog type names" $
|
||||
withType (tupleType [intType, listType stringType]) $ \tid ->
|
||||
SQL.parseColumnType (SQL.typeName (SQL.CRuntime tid)) `shouldBe` Just (SQL.CRuntime tid)
|
||||
it "keeps hashing consistent for signed floating zero" $ withType (listType doubleType) $ \tid -> do
|
||||
let positive = SQL.VRuntime tid (RList [RDouble 0])
|
||||
negative = SQL.VRuntime tid (RList [RDouble (-0)])
|
||||
positive `shouldBe` negative
|
||||
hash positive `shouldBe` hash negative
|
||||
it "creates and writes compound columns through SQL" $ do
|
||||
let result = do
|
||||
create <- parseStatement "CREATE TABLE composite (xs [Int], opt Maybe String, pair (Int, String))"
|
||||
(db, _) <- runStatement [] create
|
||||
insert <- parseStatement "INSERT INTO composite (xs, opt, pair) VALUES (LIST<Int>(1, 2), MAYBE<String>(), TUPLE<Int, String>(3, 'x'))"
|
||||
(updated, _) <- runStatement db insert
|
||||
select <- parseStatement "SELECT xs, opt, pair FROM composite"
|
||||
rowsOf (runStatement updated select)
|
||||
result `shouldSatisfy` either (const False) ((== 1) . length)
|
||||
it "stores logical String with the generic runtime encoding" $ do
|
||||
let result = do
|
||||
create <- parseStatement "CREATE TABLE strings (text String)"
|
||||
(db, _) <- runStatement [] create
|
||||
insert <- parseStatement "INSERT INTO strings (text) VALUES ('abc')"
|
||||
(updated, _) <- runStatement db insert
|
||||
select <- parseStatement "SELECT length(text) FROM strings"
|
||||
map (map snd) <$> rowsOf (runStatement updated select)
|
||||
result `shouldBe` Right [[SQL.VInt 3]]
|
||||
it "runs length and not through resolved identities" $
|
||||
sql "SELECT length('你好'), not(TRUE)" `shouldBe` Right [[SQL.VInt 2, SQL.VBool False]]
|
||||
it "preserves nullable SQL function semantics" $
|
||||
sql "SELECT length(NULL), not(NULL)" `shouldBe` Right [[SQL.VNull, SQL.VNull]]
|
||||
it "binds calls before execution" $ do
|
||||
let bound = parseStatement "SELECT length('abc')" >>= prepare []
|
||||
case bound of
|
||||
Right SelectExpr {selectItems = [(_, BoundFunction (FunctionId 1) _ [_])]} -> pure ()
|
||||
_ -> expectationFailure (show bound)
|
||||
it "rejects unknown SQL functions before scanning" $
|
||||
sql "SELECT missing('abc')" `shouldSatisfy` isFailure
|
||||
it "rejects wrong argument count" $
|
||||
sql "SELECT length('a', 'b')" `shouldSatisfy` isFailure
|
||||
it "rejects wrong SQL argument type" $
|
||||
sql "SELECT length(1)" `shouldSatisfy` isFailure
|
||||
it "finds references inside calls for projection pushdown" $
|
||||
sql "SELECT length(name) FROM t WHERE not(enabled)" `shouldBe` Right [[SQL.VInt 3]]
|
||||
it "rewrites aggregates nested in calls" $
|
||||
sql "SELECT length(MIN(name)) FROM t" `shouldBe` Right [[SQL.VInt 2]]
|
||||
it "executes subqueries nested in function arguments" $
|
||||
sql "SELECT length((SELECT MIN(name) FROM t))" `shouldBe` Right [[SQL.VInt 2]]
|
||||
it "expands CTEs inside function arguments" $
|
||||
sql "WITH names AS (SELECT name FROM t) SELECT length((SELECT MIN(name) FROM names))"
|
||||
`shouldBe` Right [[SQL.VInt 2]]
|
||||
it "binds CHECK functions using the row schema" $ do
|
||||
let result = do
|
||||
statement <- parseStatement "CREATE TABLE checked (name TEXT CHECK (length(name) > 1))"
|
||||
(db, _) <- runStatement [] statement
|
||||
insert <- parseStatement "INSERT INTO checked (name) VALUES ('abc')"
|
||||
runStatement db insert
|
||||
result `shouldSatisfy` either (const False) (const True)
|
||||
|
||||
-- | 通过正式入口执行测试 SQL
|
||||
sql :: String -> Either String [[SQL.Value]]
|
||||
sql source = do
|
||||
statement <- parseStatement source
|
||||
rows <- rowsOf (runStatement database statement)
|
||||
Right (map (map snd) rows)
|
||||
where
|
||||
-- | 提供函数调用测试表
|
||||
database = [("t", SQL.Table "t" [("name", SQL.plainColumn SQL.CStr), ("enabled", SQL.plainColumn SQL.CBool)]
|
||||
[[("name", SQL.VStr "ab"), ("enabled", SQL.VBool True)]
|
||||
,[("name", SQL.VStr "xyz"), ("enabled", SQL.VBool False)]] Nothing)]
|
||||
|
||||
-- | 判断结果是否明确失败
|
||||
isFailure :: Either a b -> Bool
|
||||
isFailure (Left _) = True
|
||||
isFailure _ = False
|
||||
|
||||
-- | 准备已解析类型身份
|
||||
withType :: TypeExpr -> (TypeId -> Expectation) -> Expectation
|
||||
withType ty action = case resolveType builtinTypes ty of
|
||||
Left err -> expectationFailure err
|
||||
Right descriptor -> action (descriptorId descriptor)
|
||||
|
||||
-- | 准备内建函数注册表
|
||||
withFunctions :: (FunctionRegistry -> Expectation) -> Expectation
|
||||
withFunctions action = case builtinFunctions builtinTypes of
|
||||
Left err -> expectationFailure err
|
||||
Right functions -> action functions
|
||||
@@ -31,6 +31,8 @@ import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, remove
|
||||
import System.FilePath ((</>))
|
||||
import System.Timeout (timeout)
|
||||
import Test.Hspec
|
||||
import qualified NormalizationSpec
|
||||
import qualified RuntimeSpec
|
||||
|
||||
-- 引擎层的 hspec 测试:语法、执行、优化器与存储链路行为。
|
||||
|
||||
@@ -116,7 +118,12 @@ domainSql db (sql : rest) = do
|
||||
-- | 跑引擎层全部 hspec 用例
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
NormalizationSpec.spec
|
||||
RuntimeSpec.spec
|
||||
describe "identity syntax" $ do
|
||||
it "parses independent sudo authentication switches" $ do
|
||||
parseStatement "ALTER USER worker ALLOW_SUDO_AUTH" `shouldBe` Right (AlterIdentity "worker" [("allow_sudo_auth", True)])
|
||||
parseStatement "ALTER ROLE worker NOALLOW_SUDO_AUTH" `shouldBe` Right (AlterIdentity "worker" [("allow_sudo_auth", False)])
|
||||
it "parses role and user attributes with their aliases" $ do
|
||||
parseStatement "ALTER ROLE worker LOGIN SUPERUSER ENABLED" `shouldBe` Right (AlterIdentity "worker" [("login", True), ("superuser", True), ("enabled", True)])
|
||||
parseStatement "ALTER USER worker NOLOGIN NOSUPERUSER DISABLED" `shouldBe` Right (AlterIdentity "worker" [("login", False), ("superuser", False), ("enabled", False)])
|
||||
@@ -1056,6 +1063,16 @@ main = hspec $ do
|
||||
parseStatement "GRANT SELECT ON users TO analyst WITH"
|
||||
`shouldSatisfy` isLeft
|
||||
|
||||
it "parses database scopes, explicit tables and qualified wildcards" $ do
|
||||
parseStatement "GRANT CONNECT, CREATE ON DATABASE sales TO analyst"
|
||||
`shouldBe` Right (GrantPrivileges ["CONNECT", "CREATE"] "database:sales" "analyst" False)
|
||||
parseStatement "REVOKE CONNECT ON DATABASE sales FROM PUBLIC"
|
||||
`shouldBe` Right (RevokePrivileges ["CONNECT"] "database:sales" "PUBLIC")
|
||||
parseStatement "GRANT SELECT ON TABLE sales.orders TO analyst"
|
||||
`shouldBe` Right (GrantPrivileges ["SELECT"] "sales.orders" "analyst" False)
|
||||
parseStatement "REVOKE ALL ON sales.* FROM analyst"
|
||||
`shouldBe` Right (RevokePrivileges ["ALL"] "sales.*" "analyst")
|
||||
|
||||
it "parses REVOKE symmetrically" $ do
|
||||
parseStatement "REVOKE SELECT ON users FROM analyst"
|
||||
`shouldBe` Right (RevokePrivileges ["SELECT"] "users" "analyst")
|
||||
@@ -2077,6 +2094,27 @@ main = hspec $ do
|
||||
]
|
||||
|
||||
describe "ChuSQL.Core.Engine.Storage.IPC" $ do
|
||||
it "persists runtime type identities and nested values across restart" $ do
|
||||
withTestSession $ \srv -> do
|
||||
-- | 解析并通过真实存储执行 SQL
|
||||
let query source = case parseStatement source of
|
||||
Left err -> expectationFailure err >> pure (Left err)
|
||||
Right statement -> runIPCStorage (runStatementM statement)
|
||||
originalRows <- withServerEnv srv $ do
|
||||
query "CREATE TABLE compound (id Int, xs [Int], opt Maybe String, pair (Int, String), text String)" `shouldReturn` Right []
|
||||
query "INSERT INTO compound (id, xs, opt, pair, text) VALUES (1, LIST<Int>(1, 2), MAYBE<String>('x'), TUPLE<Int, String>(3, 'y'), 'abc')" `shouldReturn` Right []
|
||||
query "SELECT xs, opt, pair, length(text) FROM compound"
|
||||
originalRows `shouldSatisfy` isRight
|
||||
closeConnection
|
||||
openSessionIn (dataDir srv)
|
||||
reloadedRows <- withServerEnv srv $ query "SELECT xs, opt, pair, length(text) FROM compound"
|
||||
reloadedRows `shouldBe` originalRows
|
||||
withServerEnv srv $ do
|
||||
query "INSERT INTO compound (xs) VALUES (LIST<String>('wrong'))" >>= (`shouldSatisfy` isLeft)
|
||||
query "UPDATE compound SET xs = LIST<Int>(9) WHERE id = 1" `shouldReturn` Right []
|
||||
updated <- query "SELECT xs FROM compound WHERE id = 1"
|
||||
updated `shouldSatisfy` isRight
|
||||
|
||||
it "projects scan columns and preserves constant rows" $ do
|
||||
withTestSession $ \srv -> withServerEnv srv $ do
|
||||
runIPCStorage (insertMany "projected" [[("id", VInt 1), ("name", VStr "one")], [("id", VInt 2), ("name", VNull)]]) `shouldReturn` Right ()
|
||||
|
||||
@@ -13,10 +13,13 @@ library
|
||||
hs-source-dirs: src
|
||||
exposed-modules: ChuSQL.Core.Model
|
||||
ChuSQL.Core.Protocol
|
||||
ChuSQL.Core.Runtime
|
||||
build-depends: base >= 4.14 && < 5
|
||||
, aeson
|
||||
, hashable
|
||||
, scientific
|
||||
, text
|
||||
, bytestring
|
||||
, vector
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
@@ -48,6 +48,8 @@ import Data.Char (isDigit, isSpace, toLower)
|
||||
import Data.Hashable (Hashable (..))
|
||||
import Data.List (isPrefixOf, isSuffixOf, stripPrefix)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import ChuSQL.Core.Runtime
|
||||
import qualified Data.ByteString.Lazy.Char8 as BS
|
||||
|
||||
-- 数据模型:列类型、列约束、值、行、表、数据库,外加查表小工具。
|
||||
|
||||
@@ -68,6 +70,7 @@ data ColumnType
|
||||
| CBlob
|
||||
| CNull
|
||||
| CDomain String ColumnType
|
||||
| CRuntime TypeId
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 列定义:类型 + 约束;约束全部取默认值就是普通可空列。
|
||||
@@ -121,6 +124,7 @@ typeLabel CTimestamp = "TTimestamp"
|
||||
typeLabel CBlob = "TBlob"
|
||||
typeLabel CNull = "NULL"
|
||||
typeLabel (CDomain name _) = name
|
||||
typeLabel (CRuntime tid) = renderTypeExpr (typeExpression tid)
|
||||
|
||||
-- | 线上/磁盘上的类型名
|
||||
typeName :: ColumnType -> String
|
||||
@@ -139,6 +143,7 @@ typeName CTimestamp = "timestamp"
|
||||
typeName CBlob = "blob"
|
||||
typeName CNull = "null"
|
||||
typeName (CDomain name base) = "domain(" ++ name ++ "," ++ typeName base ++ ")"
|
||||
typeName (CRuntime tid) = "runtime(" ++ BS.unpack (encodeType tid) ++ ")"
|
||||
|
||||
-- | 生成类型定义的目录键
|
||||
domainTableName :: String -> String
|
||||
@@ -151,6 +156,9 @@ isDomainTable name = "__system_domain_" `isPrefixOf` map toLower name
|
||||
-- | 解析类型名,可带长度/精度参数;不认识的给 Nothing
|
||||
parseColumnType :: String -> Maybe ColumnType
|
||||
parseColumnType raw
|
||||
| Just inner <- stripPrefix "runtime(" raw
|
||||
, Just body <- stripSuffixMaybe ")" inner =
|
||||
either (const Nothing) (Just . CRuntime) (decodeType builtinTypes (BS.pack body))
|
||||
| Just inner <- stripPrefix "domain(" raw
|
||||
, Just body <- stripSuffixMaybe ")" inner
|
||||
, (name, ',' : definition) <- break (== ',') body =
|
||||
@@ -180,7 +188,7 @@ parseColumnType raw
|
||||
("date", []) -> Just CDate
|
||||
("timestamp", []) -> Just CTimestamp
|
||||
("blob", []) -> Just CBlob
|
||||
_ -> Nothing
|
||||
_ -> either (const Nothing) (Just . CRuntime . descriptorId) (parseTypeExpr raw >>= resolveType builtinTypes)
|
||||
where
|
||||
-- | 去掉空白的类型名
|
||||
cleaned = map toLower (filter (not . isSpace) raw)
|
||||
@@ -231,6 +239,7 @@ data TypeClass
|
||||
| TemporalClass
|
||||
| BooleanClass
|
||||
| NullClass
|
||||
| RuntimeClass
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 整型大类判断
|
||||
@@ -250,12 +259,15 @@ typeClassOf CTimestamp = TemporalClass
|
||||
typeClassOf CBool = BooleanClass
|
||||
typeClassOf CNull = NullClass
|
||||
typeClassOf (CDomain _ base) = typeClassOf base
|
||||
typeClassOf CRuntime{} = RuntimeClass
|
||||
|
||||
-- | 同大类可赋值;日期/时间列接受字符串字面量
|
||||
assignable :: ColumnType -> ColumnType -> Bool
|
||||
assignable target source
|
||||
| source == CNull = True
|
||||
| target == source = True
|
||||
| CRuntime tid <- target = Just (typeExpression tid) == scalarTypeExpression source
|
||||
| typeClassOf target == RuntimeClass || typeClassOf source == RuntimeClass = False
|
||||
| typeClassOf target == typeClassOf source = True
|
||||
| typeClassOf target == TemporalClass && typeClassOf source == TextClass = True
|
||||
| otherwise = False
|
||||
@@ -270,7 +282,9 @@ integerType _ = False
|
||||
|
||||
-- | 比较用的类型族:同大类可比,日期时间与文本互比
|
||||
comparableTypes :: ColumnType -> ColumnType -> Bool
|
||||
comparableTypes a b = a == CNull || b == CNull || sameClass || crossTemporal
|
||||
comparableTypes a b
|
||||
| typeClassOf a == RuntimeClass || typeClassOf b == RuntimeClass = False
|
||||
| otherwise = a == CNull || b == CNull || sameClass || crossTemporal
|
||||
where
|
||||
-- | 两个类型同属一个大类
|
||||
sameClass = typeClassOf a == typeClassOf b
|
||||
@@ -288,6 +302,10 @@ numericType t = typeClassOf t == NumericClass
|
||||
-- | 值能不能放进这一列(先不看可空)
|
||||
valueFits :: ColumnType -> Value -> Bool
|
||||
valueFits (CDomain _ base) value = valueFits base value
|
||||
valueFits (CRuntime expected) (VRuntime supplied value) = expected == supplied && validateValue builtinTypes expected value == Right ()
|
||||
valueFits (CRuntime expected) value = case scalarRuntimeValue value of
|
||||
Just runtime -> validateValue builtinTypes expected runtime == Right ()
|
||||
Nothing -> value == VNull
|
||||
valueFits _ VNull = True
|
||||
valueFits CInt (VInt _) = True
|
||||
valueFits CBigInt (VInt _) = True
|
||||
@@ -326,6 +344,15 @@ coerceValue t v = case t of
|
||||
CBlob -> toText t v
|
||||
CNull -> Left "a NULL output cannot contain a non-NULL value"
|
||||
CDomain _ base -> coerceValue base v
|
||||
CRuntime expected -> case v of
|
||||
VRuntime supplied value | supplied == expected -> do
|
||||
validateValue builtinTypes expected value
|
||||
Right v
|
||||
_ -> case scalarRuntimeValue v of
|
||||
Just value -> do
|
||||
validateValue builtinTypes expected value
|
||||
Right (VRuntime expected value)
|
||||
Nothing -> Left "runtime value type identity mismatch"
|
||||
|
||||
-- | 整数收进整型列
|
||||
toInt :: ColumnType -> Value -> Either String Value
|
||||
@@ -422,6 +449,7 @@ data Value
|
||||
| VFloat Double
|
||||
| VStr String
|
||||
| VBool Bool
|
||||
| VRuntime TypeId RuntimeValue
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 值的比较关键字:整值浮点折成整数
|
||||
@@ -450,6 +478,7 @@ compareValue a b = case (canonicalValue a, canonicalValue b) of
|
||||
(VFloat x, VFloat y) -> compare x y
|
||||
(VStr x, VStr y) -> compare x y
|
||||
(VBool x, VBool y) -> compare x y
|
||||
(VRuntime tx x, VRuntime ty y) -> compare (encodeType tx, show (canonicalRuntime x)) (encodeType ty, show (canonicalRuntime y))
|
||||
(x, y) -> compare (valueRank x) (valueRank y)
|
||||
|
||||
-- | 族的先后,只用来给异族值定序
|
||||
@@ -459,6 +488,7 @@ valueRank (VInt _) = 1
|
||||
valueRank (VFloat _) = 1
|
||||
valueRank (VStr _) = 2
|
||||
valueRank (VBool _) = 3
|
||||
valueRank VRuntime{} = 4
|
||||
|
||||
-- | 相等语义:比较关键字相同即相等,与 hashValue 配套
|
||||
valuesEqual :: Value -> Value -> Bool
|
||||
@@ -472,6 +502,35 @@ hashValue v = case canonicalValue v of
|
||||
VFloat d -> hashWithSalt 1 d
|
||||
VStr t -> hashWithSalt 2 t
|
||||
VBool b -> hashWithSalt 3 b
|
||||
VRuntime tid value -> hashWithSalt 4 (BS.unpack (encodeType tid), show (canonicalRuntime value))
|
||||
|
||||
-- | 解析现有标量列的逻辑类型
|
||||
scalarTypeExpression :: ColumnType -> Maybe TypeExpr
|
||||
scalarTypeExpression (CDomain _ base) = scalarTypeExpression base
|
||||
scalarTypeExpression CInt = Just intType
|
||||
scalarTypeExpression CBigInt = Just intType
|
||||
scalarTypeExpression CSmallInt = Just intType
|
||||
scalarTypeExpression CDouble = Just doubleType
|
||||
scalarTypeExpression CFloat = Just doubleType
|
||||
scalarTypeExpression CBool = Just boolType
|
||||
scalarTypeExpression CStr = Just stringType
|
||||
scalarTypeExpression _ = Nothing
|
||||
|
||||
-- | 转换现有标量值
|
||||
scalarRuntimeValue :: Value -> Maybe RuntimeValue
|
||||
scalarRuntimeValue (VInt n) = Just (RInt n)
|
||||
scalarRuntimeValue (VFloat n) = Just (RDouble n)
|
||||
scalarRuntimeValue (VBool b) = Just (RBool b)
|
||||
scalarRuntimeValue (VStr text) = Just (RString text)
|
||||
scalarRuntimeValue _ = Nothing
|
||||
|
||||
-- | 统一复合值中的浮点零关键字
|
||||
canonicalRuntime :: RuntimeValue -> RuntimeValue
|
||||
canonicalRuntime (RDouble n) | n == 0 = RDouble 0
|
||||
canonicalRuntime (RList values) = RList (map canonicalRuntime values)
|
||||
canonicalRuntime (RMaybe value) = RMaybe (fmap canonicalRuntime value)
|
||||
canonicalRuntime (RTuple values) = RTuple (map canonicalRuntime values)
|
||||
canonicalRuntime value = value
|
||||
|
||||
-- | 值按类型打散搅拌
|
||||
instance Hashable Value where
|
||||
|
||||
@@ -16,6 +16,7 @@ module ChuSQL.Core.Protocol (
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Model (Histogram (..), Row, Value (..))
|
||||
import ChuSQL.Core.Runtime (builtinTypes, runtimeToJSON, runtimeFromJSON)
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.:?), (.!=), (.=))
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.Key as K
|
||||
@@ -78,7 +79,7 @@ data Request
|
||||
| ReqIdentityInitialize T.Text
|
||||
| ReqRoleCreate T.Text
|
||||
| ReqCatalogManage Request
|
||||
| ReqIdentityAlter T.Text (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
|
||||
| ReqIdentityAlter T.Text (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
|
||||
| ReqAccountCreate T.Text T.Text
|
||||
| ReqAccountReset T.Text T.Text
|
||||
| ReqAccountLogin T.Text (Maybe T.Text)
|
||||
@@ -142,8 +143,8 @@ instance ToJSON Request where
|
||||
toJSON ReqAccountsList = object ["method" .= ("accounts_list" :: T.Text)]
|
||||
toJSON (ReqIdentityInitialize u) = object ["method" .= ("identity_initialize" :: T.Text), "administrator" .= u]
|
||||
toJSON (ReqRoleCreate u) = object ["method" .= ("role_create" :: T.Text), "user" .= u]
|
||||
toJSON (ReqIdentityAlter u login super enabled manager) = object ["method" .= ("identity_alter" :: T.Text), "user" .= u,
|
||||
"can_login" .= login, "is_superuser" .= super, "enabled" .= enabled, "system_catalog_manager" .= manager]
|
||||
toJSON (ReqIdentityAlter u login super enabled manager sudo) = object ["method" .= ("identity_alter" :: T.Text), "user" .= u,
|
||||
"can_login" .= login, "is_superuser" .= super, "enabled" .= enabled, "system_catalog_manager" .= manager, "allow_sudo_auth" .= sudo]
|
||||
toJSON (ReqAccountCreate u h) = object ["method" .= ("account_create" :: T.Text), "user" .= u, "password_hash" .= h]
|
||||
toJSON (ReqAccountReset u h) = object ["method" .= ("account_reset" :: T.Text), "user" .= u, "password_hash" .= h]
|
||||
toJSON (ReqAccountLogin u at) = object ["method" .= ("account_login" :: T.Text), "user" .= u, "at" .= at]
|
||||
@@ -316,6 +317,7 @@ data Account = Account
|
||||
, accountIsSuperuser :: Bool
|
||||
, accountEnabled :: Bool
|
||||
, accountSystemCatalogManager :: Bool
|
||||
, accountAllowSudoAuth :: Bool
|
||||
} deriving (Eq)
|
||||
|
||||
-- | 账号的展示:只露账号名与版本号
|
||||
@@ -327,14 +329,14 @@ instance FromJSON Account where
|
||||
parseJSON = withObject "Account" $ \o -> Account <$> o .: "id" <*> o .: "user"
|
||||
<*> o .: "password_hash" <*> o .: "revision"
|
||||
<*> o .:? "registered_at" .!= "" <*> o .:? "last_login_at"
|
||||
<*> o .:? "can_login" .!= True <*> o .:? "is_superuser" .!= False <*> o .:? "enabled" .!= True <*> o .:? "system_catalog_manager" .!= False
|
||||
<*> o .:? "can_login" .!= True <*> o .:? "is_superuser" .!= False <*> o .:? "enabled" .!= True <*> o .:? "system_catalog_manager" .!= False <*> o .:? "allow_sudo_auth" .!= False
|
||||
|
||||
-- | 账号编码成 JSON
|
||||
instance ToJSON Account where
|
||||
toJSON a = object ["id" .= accountId a, "user" .= accountUser a,
|
||||
"password_hash" .= accountHash a, "revision" .= accountRevision a,
|
||||
"registered_at" .= accountRegisteredAt a, "last_login_at" .= accountLastLoginAt a,
|
||||
"can_login" .= accountCanLogin a, "is_superuser" .= accountIsSuperuser a, "enabled" .= accountEnabled a, "system_catalog_manager" .= accountSystemCatalogManager a]
|
||||
"can_login" .= accountCanLogin a, "is_superuser" .= accountIsSuperuser a, "enabled" .= accountEnabled a, "system_catalog_manager" .= accountSystemCatalogManager a, "allow_sudo_auth" .= accountAllowSudoAuth a]
|
||||
|
||||
-- | 存储层响应
|
||||
data Response
|
||||
@@ -373,6 +375,7 @@ valueToJSON (VInt n) = A.Number (fromIntegral n)
|
||||
valueToJSON (VFloat d) = A.Number (fromFloatDigits d)
|
||||
valueToJSON (VStr s) = A.String (T.pack s)
|
||||
valueToJSON (VBool b) = A.Bool b
|
||||
valueToJSON (VRuntime tid value) = object ["__chusql_runtime_v1" .= runtimeToJSON tid value]
|
||||
|
||||
-- | JSON 解回值
|
||||
valueFromJSON :: A.Value -> Parser Value
|
||||
@@ -383,6 +386,9 @@ valueFromJSON (A.Number n) =
|
||||
Left d -> pure (VFloat d)
|
||||
valueFromJSON (A.String s) = pure (VStr (T.unpack s))
|
||||
valueFromJSON (A.Bool b) = pure (VBool b)
|
||||
valueFromJSON (A.Object fields)
|
||||
| KM.size fields == 1, Just payload <- KM.lookup "__chusql_runtime_v1" fields =
|
||||
either fail (pure . uncurry VRuntime) (runtimeFromJSON builtinTypes payload)
|
||||
valueFromJSON _ = fail "unsupported value type"
|
||||
|
||||
-- | 一行编码成 JSON
|
||||
|
||||
@@ -0,0 +1,293 @@
|
||||
module ChuSQL.Core.Runtime
|
||||
( TypeConstructorId (..), TypeId, TypeExpr (..), Kind (..)
|
||||
, TypeRegistry, TypeDescriptor (..), PhysicalType (..), RuntimeValue (..)
|
||||
, builtinTypes, resolveType, describeType, typeExpression
|
||||
, intType, doubleType, boolType, stringType, listType, maybeType, tupleType, renderTypeExpr, parseTypeExpr, renderRuntimeValue
|
||||
, validateValue, encodeValue, decodeValue, encodeType, decodeType, runtimeToJSON, runtimeFromJSON
|
||||
) where
|
||||
|
||||
import Data.Aeson (Value (..), eitherDecode, encode)
|
||||
import Data.Aeson.Types (Parser, parseEither)
|
||||
import qualified Data.ByteString.Lazy as BS
|
||||
import Data.Scientific (floatingOrInteger)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Data.Char (isAlphaNum, toLower)
|
||||
import qualified Text.ParserCombinators.ReadP as P
|
||||
|
||||
-- 运行时类型身份、构造器注册及版本化物理编码。
|
||||
|
||||
-- | 标识稳定的类型构造器
|
||||
newtype TypeConstructorId = TypeConstructorId Int deriving (Show, Eq, Ord)
|
||||
|
||||
-- | 表达逻辑类型应用
|
||||
data TypeExpr = TypeApply TypeConstructorId [TypeExpr] deriving (Show, Eq, Ord)
|
||||
|
||||
-- | 标识完整的类型实例
|
||||
newtype TypeId = TypeId TypeExpr deriving (Show, Eq, Ord)
|
||||
|
||||
-- | 描述构造器参数个数
|
||||
data Kind = TypeKind | TypeArrow Kind Kind | ProductKind deriving (Show, Eq)
|
||||
|
||||
-- | 描述独立的物理表示
|
||||
data PhysicalType = SignedInteger | FloatingPoint | Boolean | Utf8 | Sequence PhysicalType
|
||||
| Optional PhysicalType | Product [PhysicalType] deriving (Show, Eq)
|
||||
|
||||
-- | 保存类型实例描述
|
||||
data TypeDescriptor = TypeDescriptor
|
||||
{ descriptorId :: TypeId, descriptorName :: String, descriptorPhysical :: PhysicalType
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- | 保存构造器元数据
|
||||
newtype TypeRegistry = TypeRegistry [(TypeConstructorId, String, Kind)] deriving (Show, Eq)
|
||||
|
||||
-- | 表达运行时值
|
||||
data RuntimeValue = RInt Int | RDouble Double | RBool Bool | RString String
|
||||
| RList [RuntimeValue] | RMaybe (Maybe RuntimeValue) | RTuple [RuntimeValue]
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 恢复固定编号的内建构造器
|
||||
builtinTypes :: TypeRegistry
|
||||
builtinTypes = TypeRegistry
|
||||
[(TypeConstructorId 1, "Int", TypeKind), (TypeConstructorId 2, "Double", TypeKind)
|
||||
,(TypeConstructorId 3, "Bool", TypeKind), (TypeConstructorId 4, "String", TypeKind)
|
||||
,(TypeConstructorId 5, "List", TypeArrow TypeKind TypeKind)
|
||||
,(TypeConstructorId 6, "Maybe", TypeArrow TypeKind TypeKind)
|
||||
,(TypeConstructorId 7, "Tuple", ProductKind)]
|
||||
|
||||
-- | 构造整数类型表达式
|
||||
intType :: TypeExpr
|
||||
intType = TypeApply (TypeConstructorId 1) []
|
||||
|
||||
-- | 构造浮点类型表达式
|
||||
doubleType :: TypeExpr
|
||||
doubleType = TypeApply (TypeConstructorId 2) []
|
||||
|
||||
-- | 构造布尔类型表达式
|
||||
boolType :: TypeExpr
|
||||
boolType = TypeApply (TypeConstructorId 3) []
|
||||
|
||||
-- | 构造字符串类型表达式
|
||||
stringType :: TypeExpr
|
||||
stringType = TypeApply (TypeConstructorId 4) []
|
||||
|
||||
-- | 构造列表类型表达式
|
||||
listType :: TypeExpr -> TypeExpr
|
||||
listType t = TypeApply (TypeConstructorId 5) [t]
|
||||
|
||||
-- | 构造可选类型表达式
|
||||
maybeType :: TypeExpr -> TypeExpr
|
||||
maybeType t = TypeApply (TypeConstructorId 6) [t]
|
||||
|
||||
-- | 构造元组类型表达式
|
||||
tupleType :: [TypeExpr] -> TypeExpr
|
||||
tupleType = TypeApply (TypeConstructorId 7)
|
||||
|
||||
-- | 渲染内建逻辑类型语法
|
||||
renderTypeExpr :: TypeExpr -> String
|
||||
renderTypeExpr ty@(TypeApply cid arguments) = case (cid, arguments) of
|
||||
(TypeConstructorId 1, []) -> "Int"
|
||||
(TypeConstructorId 2, []) -> "Double"
|
||||
(TypeConstructorId 3, []) -> "Bool"
|
||||
(TypeConstructorId 4, []) -> "String"
|
||||
(TypeConstructorId 5, [child]) -> "[" ++ renderTypeExpr child ++ "]"
|
||||
(TypeConstructorId 6, [child]) -> "Maybe " ++ renderTypeExpr child
|
||||
(TypeConstructorId 7, fields) -> "(" ++ joinTypes fields ++ ")"
|
||||
_ -> show ty
|
||||
where
|
||||
-- | 连接元组字段类型
|
||||
joinTypes [] = ""
|
||||
joinTypes [field] = renderTypeExpr field
|
||||
joinTypes (field : fields) = renderTypeExpr field ++ ", " ++ joinTypes fields
|
||||
|
||||
-- | 解析完整的内建逻辑类型文本
|
||||
parseTypeExpr :: String -> Either String TypeExpr
|
||||
parseTypeExpr source = case P.readP_to_S (P.skipSpaces *> expression <* P.skipSpaces <* P.eof) source of
|
||||
[(ty, "")] -> Right ty
|
||||
_ -> Left "invalid runtime type expression"
|
||||
where
|
||||
-- | 解析类型原子和构造器应用
|
||||
expression = (intType <$ token "int") P.<++ (doubleType <$ token "double")
|
||||
P.<++ (boolType <$ token "bool") P.<++ (stringType <$ token "string")
|
||||
P.<++ (listType <$> between "[" "]" expression)
|
||||
P.<++ (listType <$> (token "list" *> expression))
|
||||
P.<++ (maybeType <$> (token "maybe" *> expression))
|
||||
P.<++ (tupleType <$> between "(" ")" (P.sepBy expression (symbol ",")))
|
||||
-- | 解析具有名称边界的类型关键字
|
||||
token word = do
|
||||
_ <- mapM character word
|
||||
rest <- P.look
|
||||
case rest of
|
||||
c : _ | isAlphaNum c || c == '_' -> P.pfail
|
||||
_ -> P.skipSpaces
|
||||
-- | 不区分大小写匹配关键字字符
|
||||
character c = P.satisfy ((== c) . toLower)
|
||||
-- | 解析类型分隔符
|
||||
symbol text = P.string text <* P.skipSpaces
|
||||
-- | 解析括号包围的类型
|
||||
between open close = P.between (symbol open) (symbol close)
|
||||
|
||||
-- | 渲染运行时值的可读文本
|
||||
renderRuntimeValue :: RuntimeValue -> String
|
||||
renderRuntimeValue (RInt n) = show n
|
||||
renderRuntimeValue (RDouble n) = show n
|
||||
renderRuntimeValue (RBool b) = show b
|
||||
renderRuntimeValue (RString text) = show text
|
||||
renderRuntimeValue (RList values) = "[" ++ joinValues values ++ "]"
|
||||
renderRuntimeValue (RMaybe Nothing) = "Nothing"
|
||||
renderRuntimeValue (RMaybe (Just value)) = "Just (" ++ renderRuntimeValue value ++ ")"
|
||||
renderRuntimeValue (RTuple values) = "(" ++ joinValues values ++ ")"
|
||||
|
||||
-- | 连接复合值的字段文本
|
||||
joinValues :: [RuntimeValue] -> String
|
||||
joinValues [] = ""
|
||||
joinValues [value] = renderRuntimeValue value
|
||||
joinValues (value : values) = renderRuntimeValue value ++ ", " ++ joinValues values
|
||||
|
||||
-- | 提取身份中的逻辑类型
|
||||
typeExpression :: TypeId -> TypeExpr
|
||||
typeExpression (TypeId t) = t
|
||||
|
||||
-- | 解析类型实例并校验 kind
|
||||
resolveType :: TypeRegistry -> TypeExpr -> Either String TypeDescriptor
|
||||
resolveType registry@(TypeRegistry constructors) expression@(TypeApply cid args) = do
|
||||
(name, kind) <- case [(n, k) | (c, n, k) <- constructors, c == cid] of
|
||||
[entry] -> Right entry
|
||||
_ -> Left ("unknown type constructor: " ++ show cid)
|
||||
children <- mapM (resolveType registry) args
|
||||
physical <- case (cid, kind, map descriptorPhysical children) of
|
||||
(TypeConstructorId 1, TypeKind, []) -> Right SignedInteger
|
||||
(TypeConstructorId 2, TypeKind, []) -> Right FloatingPoint
|
||||
(TypeConstructorId 3, TypeKind, []) -> Right Boolean
|
||||
(TypeConstructorId 4, TypeKind, []) -> Right Utf8
|
||||
(TypeConstructorId 5, TypeArrow TypeKind TypeKind, [child]) -> Right (Sequence child)
|
||||
(TypeConstructorId 6, TypeArrow TypeKind TypeKind, [child]) -> Right (Optional child)
|
||||
(TypeConstructorId 7, ProductKind, fields) -> Right (Product fields)
|
||||
_ -> Left ("invalid type constructor application: " ++ name)
|
||||
Right (TypeDescriptor (TypeId expression) name physical)
|
||||
|
||||
-- | 按身份查询类型描述
|
||||
describeType :: TypeRegistry -> TypeId -> Either String TypeDescriptor
|
||||
describeType registry = resolveType registry . typeExpression
|
||||
|
||||
-- | 校验逻辑类型对应的值
|
||||
validateValue :: TypeRegistry -> TypeId -> RuntimeValue -> Either String ()
|
||||
validateValue registry tid value = do
|
||||
descriptor <- describeType registry tid
|
||||
validatePhysical (descriptorPhysical descriptor) value
|
||||
|
||||
-- | 校验值的物理结构
|
||||
validatePhysical :: PhysicalType -> RuntimeValue -> Either String ()
|
||||
validatePhysical SignedInteger RInt{} = Right ()
|
||||
validatePhysical FloatingPoint (RDouble n)
|
||||
| not (isNaN n || isInfinite n) = Right ()
|
||||
validatePhysical Boolean RBool{} = Right ()
|
||||
validatePhysical Utf8 RString{} = Right ()
|
||||
validatePhysical (Sequence child) (RList values) = mapM_ (validatePhysical child) values
|
||||
validatePhysical (Optional _) (RMaybe Nothing) = Right ()
|
||||
validatePhysical (Optional child) (RMaybe (Just value)) = validatePhysical child value
|
||||
validatePhysical (Product fields) (RTuple values)
|
||||
| length fields == length values = sequence_ (zipWith validatePhysical fields values)
|
||||
validatePhysical physical _ = Left ("value does not fit physical type: " ++ show physical)
|
||||
|
||||
-- | 编码带版本与类型身份的值
|
||||
encodeValue :: TypeRegistry -> TypeId -> RuntimeValue -> Either String BS.ByteString
|
||||
encodeValue registry tid value = do
|
||||
validateValue registry tid value
|
||||
Right (encode (runtimeToJSON tid value))
|
||||
|
||||
-- | 表达协议中的类型化值封装
|
||||
runtimeToJSON :: TypeId -> RuntimeValue -> Value
|
||||
runtimeToJSON tid value = array [Number 1, typeJson (typeExpression tid), valueJson value]
|
||||
|
||||
-- | 解析并校验协议类型化值
|
||||
runtimeFromJSON :: TypeRegistry -> Value -> Either String (TypeId, RuntimeValue)
|
||||
runtimeFromJSON registry json = do
|
||||
(expression, payload) <- parseEither parseEnvelope json
|
||||
descriptor <- resolveType registry expression
|
||||
value <- parseEither (parseValue (descriptorPhysical descriptor)) payload
|
||||
validateValue registry (descriptorId descriptor) value
|
||||
Right (descriptorId descriptor, value)
|
||||
|
||||
-- | 解码并校验版本和类型身份
|
||||
decodeValue :: TypeRegistry -> TypeId -> BS.ByteString -> Either String RuntimeValue
|
||||
decodeValue registry expected bytes = do
|
||||
json <- eitherDecode bytes
|
||||
(expression, payload) <- parseEither parseEnvelope json
|
||||
descriptor <- resolveType registry expression
|
||||
if descriptorId descriptor /= expected then Left "encoded value type identity mismatch" else do
|
||||
value <- parseEither (parseValue (descriptorPhysical descriptor)) payload
|
||||
validateValue registry expected value
|
||||
Right value
|
||||
|
||||
-- | 编码版本化类型身份
|
||||
encodeType :: TypeId -> BS.ByteString
|
||||
encodeType tid = encode (array [Number 1, typeJson (typeExpression tid)])
|
||||
|
||||
-- | 解码并解析类型身份
|
||||
decodeType :: TypeRegistry -> BS.ByteString -> Either String TypeId
|
||||
decodeType registry bytes = do
|
||||
json <- eitherDecode bytes
|
||||
expression <- parseEither parseTypeEnvelope json
|
||||
descriptorId <$> resolveType registry expression
|
||||
|
||||
-- | 生成 JSON 数组
|
||||
array :: [Value] -> Value
|
||||
array = Array . V.fromList
|
||||
|
||||
-- | 编码构造器应用
|
||||
typeJson :: TypeExpr -> Value
|
||||
typeJson (TypeApply (TypeConstructorId cid) args) = array [Number (fromIntegral cid), array (map typeJson args)]
|
||||
|
||||
-- | 解析构造器应用
|
||||
parseTypeJson :: Value -> Parser TypeExpr
|
||||
parseTypeJson (Array values) = case V.toList values of
|
||||
[Number n, Array args] -> case floatingOrInteger n :: Either Double Integer of
|
||||
Right cid | cid > 0, cid <= fromIntegral (maxBound :: Int) -> TypeApply (TypeConstructorId (fromInteger cid)) <$> mapM parseTypeJson (V.toList args)
|
||||
_ -> fail "invalid type constructor identity"
|
||||
_ -> fail "invalid type expression"
|
||||
parseTypeJson _ = fail "invalid type expression"
|
||||
|
||||
-- | 解析类型版本封装
|
||||
parseTypeEnvelope :: Value -> Parser TypeExpr
|
||||
parseTypeEnvelope (Array values) = case V.toList values of
|
||||
[Number 1, expression] -> parseTypeJson expression
|
||||
_ -> fail "unsupported type encoding version or invalid envelope"
|
||||
parseTypeEnvelope _ = fail "invalid type envelope"
|
||||
|
||||
-- | 解析值版本封装
|
||||
parseEnvelope :: Value -> Parser (TypeExpr, Value)
|
||||
parseEnvelope (Array values) = case V.toList values of
|
||||
[Number 1, expression, payload] -> do
|
||||
ty <- parseTypeJson expression
|
||||
pure (ty, payload)
|
||||
_ -> fail "unsupported value encoding version or invalid envelope"
|
||||
parseEnvelope _ = fail "invalid value envelope"
|
||||
|
||||
-- | 编码物理值
|
||||
valueJson :: RuntimeValue -> Value
|
||||
valueJson (RInt n) = Number (fromIntegral n)
|
||||
valueJson (RDouble n) = Number (realToFrac n)
|
||||
valueJson (RBool b) = Bool b
|
||||
valueJson (RString s) = String (T.pack s)
|
||||
valueJson (RList values) = array (map valueJson values)
|
||||
valueJson (RMaybe Nothing) = array []
|
||||
valueJson (RMaybe (Just value)) = array [valueJson value]
|
||||
valueJson (RTuple values) = array (map valueJson values)
|
||||
|
||||
-- | 按物理描述解析值
|
||||
parseValue :: PhysicalType -> Value -> Parser RuntimeValue
|
||||
parseValue SignedInteger (Number n) = case floatingOrInteger n :: Either Double Integer of
|
||||
Right i | i >= fromIntegral (minBound :: Int), i <= fromIntegral (maxBound :: Int) -> pure (RInt (fromInteger i))
|
||||
_ -> fail "integer is fractional or out of range"
|
||||
parseValue FloatingPoint (Number n) = pure (RDouble (realToFrac n))
|
||||
parseValue Boolean (Bool b) = pure (RBool b)
|
||||
parseValue Utf8 (String s) = pure (RString (T.unpack s))
|
||||
parseValue (Sequence child) (Array values) = RList <$> mapM (parseValue child) (V.toList values)
|
||||
parseValue (Optional child) (Array values) = case V.toList values of
|
||||
[] -> pure (RMaybe Nothing)
|
||||
[value] -> RMaybe . Just <$> parseValue child value
|
||||
_ -> fail "invalid optional value"
|
||||
parseValue (Product fields) (Array values)
|
||||
| length fields == V.length values = RTuple <$> sequence (zipWith parseValue fields (V.toList values))
|
||||
parseValue _ _ = fail "invalid physical value"
|
||||
@@ -34,6 +34,8 @@ pub struct ColumnStat {
|
||||
|
||||
#[derive(Debug, Clone, Default, Serialize, Deserialize)]
|
||||
pub struct TableSchema {
|
||||
#[serde(default)]
|
||||
pub object_id: u64,
|
||||
#[serde(default)]
|
||||
pub system: bool,
|
||||
pub columns: Vec<SchemaColumn>,
|
||||
@@ -51,6 +53,10 @@ pub struct TableSchema {
|
||||
|
||||
#[derive(Debug, Default, Serialize, Deserialize)]
|
||||
pub struct Catalog {
|
||||
#[serde(default)]
|
||||
pub database_id: u64,
|
||||
#[serde(default)]
|
||||
pub object_high_water: u64,
|
||||
#[serde(default)]
|
||||
pub identity_high_water: i64,
|
||||
tables: BTreeMap<String, TableSchema>,
|
||||
@@ -68,7 +74,36 @@ impl Catalog {
|
||||
if bytes.is_empty() {
|
||||
return Ok(Catalog::default());
|
||||
}
|
||||
serde_json::from_slice(&bytes).map_err(io::Error::other)
|
||||
let mut catalog: Self = serde_json::from_slice(&bytes).map_err(io::Error::other)?;
|
||||
catalog.upgrade_object_ids()?;
|
||||
Ok(catalog)
|
||||
}
|
||||
|
||||
/// 补齐旧目录对象编号并校验唯一性
|
||||
fn upgrade_object_ids(&mut self) -> io::Result<()> {
|
||||
self.object_high_water = self.object_high_water.max(self.database_id);
|
||||
let mut ids = BTreeSet::new();
|
||||
for schema in self.tables.values() {
|
||||
if schema.object_id != 0 && !ids.insert(schema.object_id) {
|
||||
return Err(io::Error::other("duplicate catalog object id"));
|
||||
}
|
||||
self.object_high_water = self.object_high_water.max(schema.object_id);
|
||||
}
|
||||
for schema in self.tables.values_mut() {
|
||||
if schema.object_id == 0 {
|
||||
self.object_high_water = self.object_high_water.checked_add(1)
|
||||
.ok_or_else(|| io::Error::other("catalog object id exhausted"))?;
|
||||
schema.object_id = self.object_high_water;
|
||||
}
|
||||
}
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 分配不复用的对象编号
|
||||
pub fn reserve_object_id(&mut self) -> io::Result<u64> {
|
||||
self.object_high_water = self.object_high_water.checked_add(1)
|
||||
.ok_or_else(|| io::Error::other("catalog object id exhausted"))?;
|
||||
Ok(self.object_high_water)
|
||||
}
|
||||
|
||||
/// 返回所有表的 (表名, schema)。
|
||||
@@ -106,15 +141,28 @@ impl Catalog {
|
||||
|
||||
/// 建表;已存在报错
|
||||
pub fn create_table(&mut self, table: &str, columns: Vec<SchemaColumn>) -> io::Result<()> {
|
||||
self.create_table_with_id(table, columns, None)
|
||||
}
|
||||
|
||||
/// 按日志中的编号建立表
|
||||
pub fn create_table_with_id(&mut self, table: &str, columns: Vec<SchemaColumn>, object_id: Option<u64>) -> io::Result<()> {
|
||||
if self.tables.contains_key(table) {
|
||||
return Err(io::Error::new(
|
||||
io::ErrorKind::AlreadyExists,
|
||||
format!("table already exists: {}", table),
|
||||
));
|
||||
}
|
||||
let object_id = match object_id {
|
||||
Some(id) if id == 0 || self.tables.values().any(|schema| schema.object_id == id) => {
|
||||
return Err(io::Error::other("invalid catalog object id"));
|
||||
}
|
||||
Some(id) => { self.object_high_water = self.object_high_water.max(id); id }
|
||||
None => self.reserve_object_id()?,
|
||||
};
|
||||
self.tables.insert(
|
||||
table.to_string(),
|
||||
TableSchema {
|
||||
object_id,
|
||||
system: false,
|
||||
columns,
|
||||
dropped_columns: BTreeSet::new(),
|
||||
@@ -188,6 +236,18 @@ impl Catalog {
|
||||
let entry = self.tables.entry(table.to_string()).or_default();
|
||||
entry.stats.clear();
|
||||
entry.row_count = 0;
|
||||
for row in rows {
|
||||
for (name, value) in row {
|
||||
if let Some(x) = value.as_f64() {
|
||||
let stat = entry.stats.entry(name.clone()).or_default();
|
||||
stat.lo = Some(stat.lo.map_or(x, |lo| lo.min(x)));
|
||||
stat.hi = Some(stat.hi.map_or(x, |hi| hi.max(x)));
|
||||
if stat.hist.is_empty() {
|
||||
stat.hist = vec![0; HIST_BUCKETS];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
let mut changed = false;
|
||||
for row in rows {
|
||||
|
||||
@@ -25,6 +25,8 @@ pub struct Account {
|
||||
pub is_superuser: bool,
|
||||
#[serde(default)]
|
||||
pub system_catalog_manager: bool,
|
||||
#[serde(default)]
|
||||
pub allow_sudo_auth: bool,
|
||||
#[serde(default = "default_true")]
|
||||
pub enabled: bool,
|
||||
#[serde(default)]
|
||||
@@ -96,7 +98,7 @@ pub enum Request {
|
||||
AccountsList,
|
||||
IdentityInitialize { administrator: String },
|
||||
RoleCreate { user: String },
|
||||
IdentityAlter { user: String, can_login: Option<bool>, is_superuser: Option<bool>, enabled: Option<bool>, system_catalog_manager: Option<bool> },
|
||||
IdentityAlter { user: String, can_login: Option<bool>, is_superuser: Option<bool>, enabled: Option<bool>, system_catalog_manager: Option<bool>, allow_sudo_auth: Option<bool> },
|
||||
AccountCreate { user: String, password_hash: String },
|
||||
AccountReset { user: String, password_hash: String },
|
||||
AccountLogin {
|
||||
@@ -305,11 +307,16 @@ pub enum Response {
|
||||
},
|
||||
Error { message: String },
|
||||
Catalog { schemas: Vec<TableSchemaWire> },
|
||||
Object { database_id: u64, object_id: Option<u64> },
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone, Serialize, Deserialize)]
|
||||
pub struct TableSchemaWire {
|
||||
pub table: String,
|
||||
#[serde(default)]
|
||||
pub database_id: u64,
|
||||
#[serde(default)]
|
||||
pub object_id: u64,
|
||||
pub columns: Vec<SchemaColumn>,
|
||||
#[serde(default)]
|
||||
pub row_count: u64,
|
||||
|
||||
@@ -30,10 +30,48 @@ struct Server {
|
||||
type TableDescription = (Vec<SchemaColumn>, u64, Vec<IndexWire>, Vec<ColumnStatWire>);
|
||||
|
||||
impl Server {
|
||||
/// 读取受保护的对象权限快照
|
||||
fn object_acl_read(&self) -> std::io::Result<Vec<Row>> {
|
||||
if !self.table_exists("__system_object_acl")? { return Ok(Vec::new()); }
|
||||
let rows = self.with_existing_table("__system_object_acl", |table| table.scan())?;
|
||||
let mut payload = String::new();
|
||||
for (index, row) in rows.iter().enumerate() {
|
||||
if row.get("id").and_then(|value| value.as_u64()) != Some(index as u64 + 1) {
|
||||
return Err(std::io::Error::other("invalid object ACL chunk sequence"));
|
||||
}
|
||||
payload.push_str(row.get("payload").and_then(|value| value.as_str())
|
||||
.ok_or_else(|| std::io::Error::other("invalid object ACL chunk"))?);
|
||||
}
|
||||
if rows.is_empty() { return Err(std::io::Error::other("empty object ACL snapshot")); }
|
||||
Ok(vec![serde_json::from_value(serde_json::json!({"id":1,"payload":payload})).map_err(std::io::Error::other)?])
|
||||
}
|
||||
|
||||
/// 比较并原子替换对象权限快照
|
||||
fn object_acl_replace(&self, expected: Option<&str>, payload: &str) -> std::io::Result<()> {
|
||||
let rows = self.object_acl_read()?;
|
||||
let current = rows.first().and_then(|row| row.get("payload")).and_then(|value| value.as_str());
|
||||
if current != expected { return Err(std::io::Error::other("object ACL changed concurrently")); }
|
||||
let _: serde_json::Value = serde_json::from_str(payload).map_err(std::io::Error::other)?;
|
||||
let mut ops = Vec::new();
|
||||
if !self.table_exists("__system_object_acl")? {
|
||||
ops.push(WalOp::CreateTable { table: "__system_object_acl".into(),
|
||||
columns: vec![SchemaColumn { name: "id".into(), ty: "int".into(), ..Default::default() },
|
||||
SchemaColumn { name: "payload".into(), ty: "str".into(), ..Default::default() }], object_id: None });
|
||||
}
|
||||
let chars: Vec<char> = payload.chars().collect();
|
||||
let rows = chars.chunks(256).enumerate().map(|(index, chunk)| {
|
||||
serde_json::from_value(serde_json::json!({"id":index + 1,"payload":chunk.iter().collect::<String>()}))
|
||||
.map_err(std::io::Error::other)
|
||||
}).collect::<std::io::Result<Vec<Row>>>()?;
|
||||
ops.push(WalOp::ReplaceAll { table: "__system_object_acl".into(), rows });
|
||||
self.group_via_wal(&ops)
|
||||
}
|
||||
|
||||
/// 新建服务器状态
|
||||
fn new(cfg: Config) -> std::io::Result<Self> {
|
||||
std::fs::create_dir_all(&cfg.data_dir)?;
|
||||
let catalog = Catalog::load(cfg.data_dir.join("catalog.json"))?;
|
||||
catalog.save(cfg.data_dir.join("catalog.json"))?;
|
||||
let wal = Wal::new(cfg.data_dir.join("wal.log"));
|
||||
Ok(Server {
|
||||
cfg,
|
||||
@@ -306,11 +344,11 @@ impl Server {
|
||||
let _ = std::fs::remove_file(self.index_path(table, column));
|
||||
Ok(())
|
||||
}
|
||||
WalOp::CreateTable { table, columns } => {
|
||||
WalOp::CreateTable { table, columns, object_id } => {
|
||||
self.with_table(table, |_t| Ok(()))?;
|
||||
let mut c = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
|
||||
c.create_table(table, columns.clone())?;
|
||||
if table == TYPES_TABLE { c.mark_system(table)?; }
|
||||
c.create_table_with_id(table, columns.clone(), *object_id)?;
|
||||
if table == TYPES_TABLE || table == "__system_object_acl" { c.mark_system(table)?; }
|
||||
c.save(self.catalog_path())
|
||||
}
|
||||
WalOp::DropTable { table } => {
|
||||
@@ -506,12 +544,22 @@ impl Server {
|
||||
fn group_via_wal(&self, ops: &[WalOp]) -> std::io::Result<()> {
|
||||
std::fs::create_dir_all(&self.cfg.data_dir)?;
|
||||
let wal = &self.wal;
|
||||
let commit_lsn = wal.append_group(ops)?;
|
||||
let mut ops = std::borrow::Cow::Borrowed(ops);
|
||||
if ops.iter().any(|op| matches!(op, WalOp::CreateTable { object_id: None, .. })) {
|
||||
let mut catalog = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
|
||||
for op in ops.to_mut() {
|
||||
if let WalOp::CreateTable { object_id, .. } = op
|
||||
&& object_id.is_none() {
|
||||
*object_id = Some(catalog.reserve_object_id()?);
|
||||
}
|
||||
}
|
||||
}
|
||||
let commit_lsn = wal.append_group(&ops)?;
|
||||
self.recovery_required.store(true, Ordering::Release);
|
||||
for op in ops {
|
||||
for op in ops.iter() {
|
||||
self.apply_op(op)?;
|
||||
}
|
||||
for op in ops {
|
||||
for op in ops.iter() {
|
||||
self.flush_op_tables(op)?;
|
||||
}
|
||||
self.flush_all_tables()?;
|
||||
@@ -639,7 +687,16 @@ impl Server {
|
||||
let c = self.catalog.lock().unwrap();
|
||||
Ok(c.describe(table).is_some_and(|s| !s.columns.iter().any(|col| &col.name == column)))
|
||||
}
|
||||
WalOp::CreateTable { table, .. } => self.table_exists(table),
|
||||
WalOp::CreateTable { table, object_id, .. } => {
|
||||
let catalog = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
|
||||
match catalog.describe(table) {
|
||||
Some(schema) if object_id.is_some_and(|id| id != schema.object_id) => {
|
||||
Err(std::io::Error::other("WAL catalog object id mismatch"))
|
||||
}
|
||||
Some(_) => Ok(true),
|
||||
None => Ok(false),
|
||||
}
|
||||
}
|
||||
WalOp::DropTable { table } => Ok(!self.table_exists(table)?
|
||||
&& !self.table_path(table).exists()
|
||||
&& !self.index_path(table, "id").exists()),
|
||||
@@ -1063,11 +1120,11 @@ impl Server {
|
||||
Request::CatalogManage { command } => {
|
||||
let target = match command.as_ref() {
|
||||
Request::AccountCreate { user, .. } | Request::AccountReset { user, .. } | Request::AccountDrop { user }
|
||||
| Request::IdentityAlter { user, is_superuser: None, system_catalog_manager: None, .. } => Some(account_name(user)?),
|
||||
| Request::IdentityAlter { user, is_superuser: None, system_catalog_manager: None, allow_sudo_auth: None, .. } => Some(account_name(user)?),
|
||||
Request::AccountsList => None,
|
||||
_ => return Err(Error::other("superuser required for this catalog operation")),
|
||||
};
|
||||
if accounts.iter().any(|a| target.as_ref() == Some(&a.user) && (a.is_superuser || a.system_catalog_manager)) {
|
||||
if accounts.iter().any(|a| target.as_ref() == Some(&a.user) && (a.is_superuser || a.system_catalog_manager || a.allow_sudo_auth)) {
|
||||
return Err(Error::other("superuser required to manage privileged identities"));
|
||||
}
|
||||
*command
|
||||
@@ -1116,10 +1173,13 @@ impl Server {
|
||||
}
|
||||
let unified = self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?.describe(IDENTITIES_TABLE).is_some();
|
||||
if !accounts.is_empty() { require_superuser(&accounts)?; }
|
||||
if unified && previous == accounts { return Ok(accounts); }
|
||||
let sudo_column = self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?.describe(IDENTITIES_TABLE)
|
||||
.is_some_and(|schema| schema.columns.iter().any(|column| column.name == "allow_sudo_auth"));
|
||||
if unified && sudo_column && previous == accounts { return Ok(accounts); }
|
||||
}
|
||||
Request::AccountCreate { user, password_hash } => {
|
||||
let name = account_name(&user)?;
|
||||
if name == "public" { return Err(Error::other("public is reserved for default privileges")); }
|
||||
if accounts.iter().any(|a| a.user == name) {
|
||||
return Err(Error::new(ErrorKind::AlreadyExists, "account already exists"));
|
||||
}
|
||||
@@ -1129,6 +1189,7 @@ impl Server {
|
||||
}
|
||||
Request::RoleCreate { user } => {
|
||||
let name = account_name(&user)?;
|
||||
if name == "public" { return Err(Error::other("public is reserved for default privileges")); }
|
||||
if accounts.iter().any(|a| a.user == name) { return Err(Error::new(ErrorKind::AlreadyExists, "identity already exists")); }
|
||||
let id = accounts.iter().map(|a| a.id).max().unwrap_or(0).max(self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?.identity_high_water)
|
||||
.checked_add(1).ok_or_else(|| Error::other("account id exhausted"))?;
|
||||
@@ -1136,13 +1197,14 @@ impl Server {
|
||||
role.can_login = false;
|
||||
accounts.push(role);
|
||||
}
|
||||
Request::IdentityAlter { user, can_login, is_superuser, enabled, system_catalog_manager } => {
|
||||
Request::IdentityAlter { user, can_login, is_superuser, enabled, system_catalog_manager, allow_sudo_auth } => {
|
||||
let name = account_name(&user)?;
|
||||
let account = accounts.iter_mut().find(|a| a.user == name).ok_or_else(|| Error::new(ErrorKind::NotFound, "unknown account"))?;
|
||||
account.can_login = can_login.unwrap_or(account.can_login);
|
||||
account.is_superuser = is_superuser.unwrap_or(account.is_superuser);
|
||||
account.enabled = enabled.unwrap_or(account.enabled);
|
||||
account.system_catalog_manager = system_catalog_manager.unwrap_or(account.system_catalog_manager);
|
||||
account.allow_sudo_auth = allow_sudo_auth.unwrap_or(account.allow_sudo_auth);
|
||||
account.revision = account.revision.checked_add(1).ok_or_else(|| Error::other("account revision exhausted"))?;
|
||||
if had_superuser { require_superuser(&accounts)?; }
|
||||
}
|
||||
@@ -1226,7 +1288,7 @@ impl Server {
|
||||
}
|
||||
if existing.is_some() && original == rows { return Ok(rows); }
|
||||
let mut ops = Vec::new();
|
||||
if existing.is_none() { ops.push(WalOp::CreateTable { table: TYPES_TABLE.into(), columns }); }
|
||||
if existing.is_none() { ops.push(WalOp::CreateTable { table: TYPES_TABLE.into(), columns, object_id: None }); }
|
||||
ops.push(WalOp::ReplaceAll { table: TYPES_TABLE.into(), rows: rows.clone() });
|
||||
self.recovery_required.store(true, Ordering::Release);
|
||||
self.group_via_wal(&ops)?;
|
||||
@@ -1499,6 +1561,8 @@ impl Server {
|
||||
.filter(|(name, _)| !blocked_table(name))
|
||||
.map(|(name, ts)| TableSchemaWire {
|
||||
table: name.to_string(),
|
||||
database_id: c.database_id,
|
||||
object_id: ts.object_id,
|
||||
columns: ts.columns.clone(),
|
||||
row_count: ts.row_count,
|
||||
indexes: index_wires(ts),
|
||||
@@ -1543,7 +1607,7 @@ impl Server {
|
||||
};
|
||||
}
|
||||
let tname = table.clone();
|
||||
let op = WalOp::CreateTable { table, columns };
|
||||
let op = WalOp::CreateTable { table, columns, object_id: None };
|
||||
match self.write_via_wal(&op) {
|
||||
Ok(()) => Response::Ok,
|
||||
Err(e) => {
|
||||
@@ -1733,6 +1797,7 @@ fn identity_rows(accounts: &[Account]) -> std::io::Result<Vec<Row>> {
|
||||
("can_login".into(), serde_json::json!(a.can_login)),
|
||||
("is_superuser".into(), serde_json::json!(a.is_superuser)),
|
||||
("system_catalog_manager".into(), serde_json::json!(a.system_catalog_manager)),
|
||||
("allow_sudo_auth".into(), serde_json::json!(a.allow_sudo_auth)),
|
||||
("enabled".into(), serde_json::json!(a.enabled)),
|
||||
("identity_version".into(), serde_json::json!(a.identity_version)),
|
||||
("registered_at".into(), serde_json::Value::String(a.registered_at.clone())),
|
||||
@@ -1764,6 +1829,7 @@ fn identity_columns() -> Vec<SchemaColumn> {
|
||||
SchemaColumn { name: "can_login".into(), ty: "bool".into(), nullable: false, ..Default::default() },
|
||||
SchemaColumn { name: "is_superuser".into(), ty: "bool".into(), nullable: false, ..Default::default() },
|
||||
SchemaColumn { name: "system_catalog_manager".into(), ty: "bool".into(), nullable: false, ..Default::default() },
|
||||
SchemaColumn { name: "allow_sudo_auth".into(), ty: "bool".into(), nullable: false, ..Default::default() },
|
||||
SchemaColumn { name: "enabled".into(), ty: "bool".into(), nullable: false, ..Default::default() },
|
||||
SchemaColumn { name: "identity_version".into(), ty: "int".into(), nullable: false, ..Default::default() },
|
||||
SchemaColumn { name: "registered_at".into(), ty: "timestamp".into(),
|
||||
@@ -1805,6 +1871,10 @@ fn decode_account_row(row: &Row) -> std::io::Result<Account> {
|
||||
can_login: row.get("can_login").and_then(serde_json::Value::as_bool).unwrap_or(true),
|
||||
is_superuser: row.get("is_superuser").and_then(serde_json::Value::as_bool).unwrap_or(false),
|
||||
system_catalog_manager: row.get("system_catalog_manager").and_then(serde_json::Value::as_bool).unwrap_or(false),
|
||||
allow_sudo_auth: match row.get("allow_sudo_auth") {
|
||||
None => false,
|
||||
Some(value) => value.as_bool().ok_or_else(|| std::io::Error::other("invalid sudo authentication attribute"))?,
|
||||
},
|
||||
enabled: row.get("enabled").and_then(serde_json::Value::as_bool).unwrap_or(true),
|
||||
identity_version: row.get("identity_version").and_then(serde_json::Value::as_u64).unwrap_or(0) as u8,
|
||||
})
|
||||
@@ -1880,6 +1950,7 @@ fn new_account(id: i64, user: &str, password_hash: String) -> std::io::Result<Ac
|
||||
can_login: true,
|
||||
is_superuser: false,
|
||||
system_catalog_manager: false,
|
||||
allow_sudo_auth: false,
|
||||
enabled: true,
|
||||
identity_version: 1,
|
||||
})
|
||||
@@ -2019,7 +2090,37 @@ impl Databases {
|
||||
named.insert(name, Arc::new(server));
|
||||
}
|
||||
}
|
||||
Ok(Self { root: cfg, system, named: Mutex::new(named) })
|
||||
{
|
||||
let mut catalog = system.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
|
||||
let mut ids = HashSet::new();
|
||||
if catalog.database_id != 0 { ids.insert(catalog.database_id); }
|
||||
for server in named.values() {
|
||||
let id = server.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?.database_id;
|
||||
if id != 0 && !ids.insert(id) { return Err(std::io::Error::other("duplicate database object id")); }
|
||||
catalog.object_high_water = catalog.object_high_water.max(id);
|
||||
}
|
||||
if catalog.database_id == 0 { catalog.database_id = catalog.reserve_object_id()?; }
|
||||
catalog.save(system.catalog_path())?;
|
||||
}
|
||||
let databases = Self { root: cfg, system, named: Mutex::new(named) };
|
||||
{
|
||||
let named = databases.named.lock().map_err(|_| std::io::Error::other("database lock poisoned"))?;
|
||||
for server in named.values() { databases.assign_database_id(server)?; }
|
||||
}
|
||||
Ok(databases)
|
||||
}
|
||||
|
||||
/// 为数据库持久化不复用的编号
|
||||
fn assign_database_id(&self, server: &Server) -> std::io::Result<()> {
|
||||
let mut catalog = server.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
|
||||
if catalog.database_id == 0 {
|
||||
let mut system = self.system.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
|
||||
let id = system.reserve_object_id()?;
|
||||
system.save(self.system.catalog_path())?;
|
||||
catalog.database_id = id;
|
||||
catalog.save(server.catalog_path())?;
|
||||
}
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 按名字打开或新建一个库
|
||||
@@ -2049,6 +2150,42 @@ impl Databases {
|
||||
if !name.is_empty() && !valid_database(&name) { return Err(Error::other("invalid database name")); }
|
||||
let mut named = self.named.lock().map_err(|_| Error::other("database lock poisoned"))?;
|
||||
match method.as_str() {
|
||||
"object_acl_read" => {
|
||||
drop(named);
|
||||
let _gate = self.system.gate.read().map_err(|_| Error::other("database gate poisoned"))?;
|
||||
if self.system.recovery_required.load(Ordering::Acquire) { return Err(Error::other("recovery required")); }
|
||||
return Ok(Response::Rows { rows: self.system.object_acl_read()? });
|
||||
}
|
||||
"object_acl_replace" => {
|
||||
drop(named);
|
||||
let _gate = self.system.gate.write().map_err(|_| Error::other("database gate poisoned"))?;
|
||||
if self.system.recovery_required.load(Ordering::Acquire) { return Err(Error::other("recovery required")); }
|
||||
let expected = match value.get("expected") {
|
||||
None | Some(serde_json::Value::Null) => None,
|
||||
Some(serde_json::Value::String(value)) => Some(value.as_str()),
|
||||
_ => return Err(Error::other("invalid expected ACL payload")),
|
||||
};
|
||||
let payload = value.get("payload").and_then(|value| value.as_str()).ok_or_else(|| Error::other("missing ACL payload"))?;
|
||||
self.system.object_acl_replace(expected, payload)?;
|
||||
return Ok(Response::Ok);
|
||||
}
|
||||
"resolve_object" => {
|
||||
let server = if name == SYSTEM_DATABASE { &self.system }
|
||||
else { named.get(&name).ok_or_else(|| Error::other("unknown database"))? };
|
||||
let _gate = server.gate.read().map_err(|_| Error::other("database gate poisoned"))?;
|
||||
if server.recovery_required.load(Ordering::Acquire) { return Err(Error::other("recovery required")); }
|
||||
let catalog = server.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?;
|
||||
let object_id = match value.get("table") {
|
||||
None => None,
|
||||
Some(serde_json::Value::String(table)) if !blocked_table(table) => {
|
||||
let schema = catalog.describe(table).ok_or_else(|| Error::other("unknown table"))?;
|
||||
if schema.object_id == 0 { return Err(Error::other("missing catalog object id")); }
|
||||
Some(schema.object_id)
|
||||
}
|
||||
_ => return Err(Error::other("invalid object table")),
|
||||
};
|
||||
return Ok(Response::Object { database_id: catalog.database_id, object_id });
|
||||
}
|
||||
"all_catalogs" => {
|
||||
let servers: Vec<(String, Arc<Server>)> =
|
||||
std::iter::once((SYSTEM_DATABASE.to_string(), Arc::clone(&self.system)))
|
||||
@@ -2082,6 +2219,7 @@ impl Databases {
|
||||
cfg.data_dir = cfg.data_dir.join("databases").join(&name);
|
||||
std::fs::create_dir(&cfg.data_dir)?;
|
||||
let server = Server::new(cfg)?;
|
||||
self.assign_database_id(&server)?;
|
||||
server.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?.save(server.catalog_path())?;
|
||||
named.insert(name, Arc::new(server));
|
||||
return Ok(Response::Ok);
|
||||
@@ -2215,7 +2353,11 @@ fn maintenance_candidate(cfg: Config, mode: &str, user: &str, hash: &str, types:
|
||||
}
|
||||
let repair = mode == "repair";
|
||||
let catalog_path = cfg.data_dir.join("catalog.json");
|
||||
let schemas = maintenance_schemas();
|
||||
let mut schemas = maintenance_schemas();
|
||||
if cfg.data_dir.join("__system_object_acl.db").is_file() {
|
||||
schemas.push(("__system_object_acl", vec![SchemaColumn { name: "id".into(), ty: "int".into(), ..Default::default() },
|
||||
SchemaColumn { name: "payload".into(), ty: "str".into(), ..Default::default() }]));
|
||||
}
|
||||
let mut missing_data = Vec::new();
|
||||
let mut catalog = match Catalog::load(&catalog_path) {
|
||||
Ok(catalog) => catalog,
|
||||
|
||||
@@ -61,6 +61,7 @@ pub enum WalOp {
|
||||
CreateTable {
|
||||
table: String,
|
||||
columns: Vec<SchemaColumn>,
|
||||
object_id: Option<u64>,
|
||||
},
|
||||
DropTable {
|
||||
table: String,
|
||||
@@ -92,6 +93,8 @@ struct ReplaceSchemaPayload {
|
||||
#[derive(Debug, Serialize, Deserialize)]
|
||||
struct CreateTablePayload {
|
||||
columns: Vec<SchemaColumn>,
|
||||
#[serde(default)]
|
||||
object_id: Option<u64>,
|
||||
}
|
||||
|
||||
pub struct Wal {
|
||||
@@ -416,10 +419,10 @@ fn encode(op: &WalOp, lsn: u64) -> io::Result<Vec<u8>> {
|
||||
.map_err(io::Error::other)?;
|
||||
(OP_REPLACE_SCHEMA, table.clone(), p)
|
||||
}
|
||||
WalOp::CreateTable { table, columns } => (
|
||||
WalOp::CreateTable { table, columns, object_id } => (
|
||||
OP_CREATE_TABLE,
|
||||
table.clone(),
|
||||
serde_json::to_vec(&CreateTablePayload { columns: columns.clone() })
|
||||
serde_json::to_vec(&CreateTablePayload { columns: columns.clone(), object_id: *object_id })
|
||||
.map_err(io::Error::other)?,
|
||||
),
|
||||
WalOp::DropTable { table } => (OP_DROP_TABLE, table.clone(), Vec::new()),
|
||||
@@ -536,6 +539,7 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
|
||||
WalOp::CreateTable {
|
||||
table,
|
||||
columns: p.columns,
|
||||
object_id: p.object_id,
|
||||
}
|
||||
}
|
||||
OP_DROP_TABLE => WalOp::DropTable { table },
|
||||
|
||||
@@ -4,6 +4,55 @@ use serde_json::json;
|
||||
|
||||
// 数据字典测试:补列、去重、未知表。
|
||||
|
||||
/// 表删除重建和重载均保留编号规则
|
||||
#[test]
|
||||
fn object_ids_survive_reload_and_are_not_reused() {
|
||||
let dir = tempfile::tempdir().unwrap();
|
||||
let path = dir.path().join("catalog.json");
|
||||
let mut catalog = Catalog::default();
|
||||
catalog.create_table("t", vec![]).unwrap();
|
||||
let old = catalog.describe("t").unwrap().object_id;
|
||||
assert_ne!(old, 0);
|
||||
catalog.save(&path).unwrap();
|
||||
let mut catalog = Catalog::load(&path).unwrap();
|
||||
assert_eq!(catalog.describe("t").unwrap().object_id, old);
|
||||
catalog.drop_table("t").unwrap();
|
||||
catalog.save(&path).unwrap();
|
||||
let mut catalog = Catalog::load(&path).unwrap();
|
||||
catalog.create_table("t", vec![]).unwrap();
|
||||
assert!(catalog.describe("t").unwrap().object_id > old);
|
||||
}
|
||||
|
||||
/// 旧目录迁移保留已有编号并拒绝重复
|
||||
#[test]
|
||||
fn legacy_object_ids_upgrade_without_collisions() {
|
||||
let dir = tempfile::tempdir().unwrap();
|
||||
let path = dir.path().join("catalog.json");
|
||||
std::fs::write(&path, json!({"tables": {
|
||||
"a": {"columns": [], "object_id": 42},
|
||||
"b": {"columns": []}
|
||||
}}).to_string()).unwrap();
|
||||
let catalog = Catalog::load(&path).unwrap();
|
||||
assert_eq!(catalog.describe("a").unwrap().object_id, 42);
|
||||
assert_eq!(catalog.describe("b").unwrap().object_id, 43);
|
||||
catalog.save(&path).unwrap();
|
||||
assert_eq!(Catalog::load(&path).unwrap().describe("b").unwrap().object_id, 43);
|
||||
std::fs::write(&path, json!({"tables": {
|
||||
"a": {"columns": [], "object_id": 42},
|
||||
"b": {"columns": [], "object_id": 42}
|
||||
}}).to_string()).unwrap();
|
||||
assert!(Catalog::load(&path).unwrap_err().to_string().contains("duplicate"));
|
||||
}
|
||||
|
||||
/// 编号耗尽明确失败且不建立对象
|
||||
#[test]
|
||||
fn exhausted_object_ids_fail_without_creating_table() {
|
||||
let mut catalog = Catalog::default();
|
||||
catalog.object_high_water = u64::MAX;
|
||||
assert!(catalog.create_table("t", vec![]).is_err());
|
||||
assert!(catalog.describe("t").is_none());
|
||||
}
|
||||
|
||||
|
||||
|
||||
/// 用键值对构造一行
|
||||
@@ -154,6 +203,28 @@ fn capped_distinct_keeps_histogram_and_other_columns_accurate() {
|
||||
assert_eq!(catalog.describe("t").unwrap().stats["id"].distinct, 4000);
|
||||
}
|
||||
|
||||
/// 重建直方图不受行顺序影响
|
||||
#[test]
|
||||
fn rebuilt_histogram_has_exact_buckets_in_any_order() {
|
||||
let rows: Vec<Row> = (0..160).map(|n| row(&[("v", json!(n))])).collect();
|
||||
let mut forward = Catalog::default();
|
||||
forward.rebuild_stats("t", &rows);
|
||||
let mut reverse = Catalog::default();
|
||||
let reversed: Vec<Row> = rows.iter().rev().cloned().collect();
|
||||
reverse.rebuild_stats("t", &reversed);
|
||||
let stat = &forward.describe("t").unwrap().stats["v"];
|
||||
assert_eq!(stat.hist, vec![10; 16]);
|
||||
assert_eq!(stat.hist, reverse.describe("t").unwrap().stats["v"].hist);
|
||||
forward.record_insert("t", &row(&[("v", json!(10000))]));
|
||||
forward.record_delete("t", &[row(&[("v", json!(10000))])]);
|
||||
forward.rebuild_stats("t", &rows[80..]);
|
||||
let repaired = &forward.describe("t").unwrap().stats["v"];
|
||||
assert_eq!(repaired.lo, Some(80.0));
|
||||
assert_eq!(repaired.hi, Some(159.0));
|
||||
assert_eq!(repaired.hist, vec![5; 16]);
|
||||
assert_eq!(forward.describe("t").unwrap().row_count, 80);
|
||||
}
|
||||
|
||||
/// 老类型名并到新写法,参数保留,未知类型原样
|
||||
#[test]
|
||||
fn normalize_type_maps_legacy_names() {
|
||||
|
||||
@@ -5,11 +5,165 @@ use chusql_core_storage::runtime::Storage;
|
||||
|
||||
// 进程内存储集成测试:协议请求、索引、账号与配置。
|
||||
|
||||
/// 权限快照支持跨页文本并拒绝旧版本覆盖
|
||||
#[test]
|
||||
fn object_acl_snapshots_are_private_and_compare_versions() -> Result<(), Box<dyn std::error::Error>> {
|
||||
let (server, data) = start_server();
|
||||
let mut c = connect()?;
|
||||
let payload = serde_json::json!({"grants": "权限\"\\".repeat(4000)}).to_string();
|
||||
request_ok(&mut c, serde_json::json!({"method":"object_acl_replace","expected":null,"payload":payload}))?;
|
||||
let current: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"object_acl_read"}"#))?;
|
||||
assert_eq!(current["rows"][0]["payload"], payload);
|
||||
let conflict = send(&mut c, r#"{"method":"object_acl_replace","expected":null,"payload":"{}"}"#);
|
||||
assert!(conflict.contains("changed concurrently"), "{conflict}");
|
||||
assert!(send(&mut c, r#"{"method":"scan","database":"system","table":"__system_object_acl"}"#).contains("reserved system table"));
|
||||
assert!(!send(&mut c, r#"{"method":"all_catalogs"}"#).contains("__system_object_acl"));
|
||||
drop(c);
|
||||
drop(server);
|
||||
let _restarted = restart_at(data.path())?;
|
||||
let mut c = connect()?;
|
||||
let reloaded: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"object_acl_read"}"#))?;
|
||||
assert_eq!(reloaded, current);
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 权限并发替换只能有一个版本提交
|
||||
#[test]
|
||||
fn concurrent_object_acl_replacement_preserves_one_winner() -> Result<(), Box<dyn std::error::Error>> {
|
||||
let (_server, _data) = start_server();
|
||||
let mut c = connect()?;
|
||||
let workers: Vec<_> = (0..8).map(|index| {
|
||||
let storage = Arc::clone(&c.0);
|
||||
std::thread::spawn(move || storage.request_line(&serde_json::json!({
|
||||
"method":"object_acl_replace","expected":null,"payload":serde_json::json!({"winner":index}).to_string()
|
||||
}).to_string()))
|
||||
}).collect();
|
||||
let replies: Vec<serde_json::Value> = workers.into_iter().map(|worker| serde_json::from_str(&worker.join().unwrap()).unwrap()).collect();
|
||||
assert_eq!(replies.iter().filter(|reply| reply["status"] == "ok").count(), 1);
|
||||
assert_eq!(replies.iter().filter(|reply| reply["message"].as_str().is_some_and(|message| message.contains("changed concurrently"))).count(), 7);
|
||||
let loaded: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"object_acl_read"}"#))?;
|
||||
assert!(serde_json::from_str::<serde_json::Value>(loaded["rows"][0]["payload"].as_str().unwrap())?["winner"].is_number());
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 权限快照落盘失败后重放完整替换
|
||||
#[test]
|
||||
fn object_acl_commit_failure_replays_the_complete_snapshot() -> Result<(), Box<dyn std::error::Error>> {
|
||||
let (server, data) = start_server();
|
||||
let mut c = connect()?;
|
||||
let pending = data.path().join("system/catalog.json.pending");
|
||||
std::fs::create_dir(&pending)?;
|
||||
let failed = send(&mut c, r#"{"method":"object_acl_replace","expected":null,"payload":"{\"version\":1}"}"#);
|
||||
assert!(failed.contains("error"), "{failed}");
|
||||
assert!(send(&mut c, r#"{"method":"object_acl_read"}"#).contains("recovery required"));
|
||||
drop(c);
|
||||
drop(server);
|
||||
std::fs::remove_dir(pending)?;
|
||||
let _restarted = restart_at(data.path())?;
|
||||
let mut c = connect()?;
|
||||
let loaded: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"object_acl_read"}"#))?;
|
||||
assert_eq!(loaded["rows"][0]["payload"], "{\"version\":1}");
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 对象编号区分跨库同名及删除重建
|
||||
#[test]
|
||||
fn object_identity_tracks_database_and_table_incarnations() -> Result<(), Box<dyn std::error::Error>> {
|
||||
let (server, data) = start_server();
|
||||
let mut c = connect()?;
|
||||
request_ok(&mut c, serde_json::json!({"method":"create_database","database":"other"}))?;
|
||||
for database in ["main", "other"] {
|
||||
request_ok(&mut c, serde_json::json!({"method":"create_table","database":database,"table":"items","columns":[{"name":"id","ty":"int"}]}))?;
|
||||
}
|
||||
let old: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"main","table":"items"}"#))?;
|
||||
let other: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"other","table":"items"}"#))?;
|
||||
assert_eq!(old["status"], "object");
|
||||
assert_ne!(old["database_id"], other["database_id"]);
|
||||
assert!(old["object_id"].as_u64().unwrap() > 0);
|
||||
let catalog: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"list_catalog","database":"main"}"#))?;
|
||||
let info = catalog["schemas"].as_array().unwrap().iter().find(|entry| entry["table"] == "items").unwrap();
|
||||
assert_eq!(info["database_id"], old["database_id"]);
|
||||
assert_eq!(info["object_id"], old["object_id"]);
|
||||
drop(c);
|
||||
drop(server);
|
||||
let restarted = restart_at(data.path())?;
|
||||
let mut c = connect()?;
|
||||
let stable: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"main","table":"items"}"#))?;
|
||||
assert_eq!(stable, old);
|
||||
request_ok(&mut c, serde_json::json!({"method":"drop_table","database":"main","table":"items"}))?;
|
||||
assert!(send(&mut c, r#"{"method":"resolve_object","database":"main","table":"items"}"#).contains("unknown table"));
|
||||
request_ok(&mut c, serde_json::json!({"method":"create_table","database":"main","table":"items","columns":[{"name":"id","ty":"int"}]}))?;
|
||||
let new: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"main","table":"items"}"#))?;
|
||||
assert_eq!(new["database_id"], old["database_id"]);
|
||||
assert_ne!(new["object_id"], old["object_id"]);
|
||||
request_ok(&mut c, serde_json::json!({"method":"drop_database","database":"other"}))?;
|
||||
request_ok(&mut c, serde_json::json!({"method":"create_database","database":"other"}))?;
|
||||
let new_database: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"other"}"#))?;
|
||||
assert_ne!(new_database["database_id"], other["database_id"]);
|
||||
assert!(new_database["object_id"].is_null());
|
||||
drop(c);
|
||||
drop(restarted);
|
||||
Ok(())
|
||||
}
|
||||
|
||||
thread_local! {
|
||||
/// 当前线程的存储实例:一个用例一个线程,用例内部按顺序起/停
|
||||
static CURRENT: RefCell<Option<Arc<Storage>>> = const { RefCell::new(None) };
|
||||
}
|
||||
|
||||
/// 建表应用失败后按日志恢复原编号
|
||||
#[test]
|
||||
fn object_id_survives_committed_create_recovery() -> Result<(), Box<dyn std::error::Error>> {
|
||||
use chusql_core_storage::wal::{Wal, WalOp};
|
||||
let (server, data) = start_server();
|
||||
let mut c = connect()?;
|
||||
let directory = data.path().join("databases/main");
|
||||
let pending = directory.join("catalog.json.pending");
|
||||
std::fs::create_dir(&pending)?;
|
||||
assert!(send(&mut c, r#"{"method":"create_table","table":"recovered","columns":[{"name":"id","ty":"int"}]}"#).contains("error"));
|
||||
assert!(send(&mut c, r#"{"method":"resolve_object","database":"main","table":"recovered"}"#).contains("recovery required"));
|
||||
let wal = Wal::new(directory.join("wal.log"));
|
||||
let scan = wal.read_all()?;
|
||||
let id = scan.records.iter().find_map(|(_, op)| match op {
|
||||
WalOp::CreateTable { table, object_id, .. } if table == "recovered" => *object_id,
|
||||
_ => None,
|
||||
}).unwrap();
|
||||
drop(wal);
|
||||
drop(c);
|
||||
drop(server);
|
||||
std::fs::remove_dir(pending)?;
|
||||
let _restarted = restart_at(data.path())?;
|
||||
let mut c = connect()?;
|
||||
let resolved: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"main","table":"recovered"}"#))?;
|
||||
assert_eq!(resolved["object_id"], id);
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 并发建表分配互不重复的编号
|
||||
#[test]
|
||||
fn concurrent_table_creation_allocates_distinct_object_ids() -> Result<(), Box<dyn std::error::Error>> {
|
||||
let (_server, _data) = start_server();
|
||||
let mut c = connect()?;
|
||||
let workers: Vec<_> = (0..16).map(|index| {
|
||||
let storage = Arc::clone(&c.0);
|
||||
std::thread::spawn(move || storage.request_line(&serde_json::json!({
|
||||
"method":"create_table", "database":"main", "table":format!("concurrent_{index}"),
|
||||
"columns":[{"name":"id","ty":"int"}]
|
||||
}).to_string()))
|
||||
}).collect();
|
||||
for worker in workers {
|
||||
let result: serde_json::Value = serde_json::from_str(&worker.join().unwrap())?;
|
||||
assert_eq!(result["status"], "ok");
|
||||
}
|
||||
let response: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"list_catalog","database":"main"}"#))?;
|
||||
let ids: std::collections::HashSet<_> = response["schemas"].as_array().unwrap().iter()
|
||||
.filter(|schema| schema["table"].as_str().unwrap().starts_with("concurrent_"))
|
||||
.map(|schema| schema["object_id"].as_u64().unwrap()).collect();
|
||||
assert_eq!(ids.len(), 16);
|
||||
assert!(!ids.contains(&0));
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 定点写入检查舍入和整批原子拒绝
|
||||
#[test]
|
||||
fn decimal_writes_enforce_precision_before_wal() -> Result<(), Box<dyn std::error::Error>> {
|
||||
@@ -246,6 +400,66 @@ fn legacy_account_wal_migrates_without_promoting_other_names() -> Result<(), Box
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 读取并校验身份命令响应
|
||||
fn account_response(c: &mut Conn, request: serde_json::Value) -> Result<serde_json::Value, Box<dyn std::error::Error>> {
|
||||
let response: serde_json::Value = serde_json::from_str(&send(c, &request.to_string()))?;
|
||||
assert_eq!(response["status"], "accounts", "{response}");
|
||||
Ok(response)
|
||||
}
|
||||
|
||||
/// 本机认证开关独立持久化并推进会话版本
|
||||
#[test]
|
||||
fn sudo_auth_is_independent_revocable_and_persistent() -> Result<(), Box<dyn std::error::Error>> {
|
||||
let (server, data) = start_server();
|
||||
let mut c = connect()?;
|
||||
let original = account_response(&mut c, serde_json::json!({"method":"account_create","user":"local_user","password_hash":"hash"}))?;
|
||||
let created = original["accounts"].as_array().unwrap().iter().find(|a| a["user"] == "local_user").unwrap();
|
||||
assert_eq!(created["allow_sudo_auth"], false);
|
||||
let changed = account_response(&mut c, serde_json::json!({"method":"identity_alter","user":"local_user","allow_sudo_auth":true}))?;
|
||||
let local = changed["accounts"].as_array().unwrap().iter().find(|a| a["user"] == "local_user").unwrap();
|
||||
assert_eq!(local["allow_sudo_auth"], true);
|
||||
assert_eq!(local["is_superuser"], false);
|
||||
assert_eq!(local["system_catalog_manager"], false);
|
||||
assert_eq!(local["revision"], 2);
|
||||
for command in [
|
||||
serde_json::json!({"method":"identity_alter","user":"local_user","allow_sudo_auth":false}),
|
||||
serde_json::json!({"method":"account_reset","user":"local_user","password_hash":"other"}),
|
||||
serde_json::json!({"method":"identity_alter","user":"root","allow_sudo_auth":true}),
|
||||
] {
|
||||
let denied = send(&mut c, &serde_json::json!({"method":"catalog_manage","command":command}).to_string());
|
||||
assert!(denied.contains("superuser required"), "{denied}");
|
||||
}
|
||||
drop(c);
|
||||
drop(server);
|
||||
let _restarted = restart_at(data.path())?;
|
||||
let mut c = connect()?;
|
||||
assert_eq!(account_response(&mut c, serde_json::json!({"method":"accounts_list"}))?, changed);
|
||||
let revoked = account_response(&mut c, serde_json::json!({"method":"identity_alter","user":"local_user","allow_sudo_auth":false}))?;
|
||||
let local = revoked["accounts"].as_array().unwrap().iter().find(|a| a["user"] == "local_user").unwrap();
|
||||
assert_eq!(local["allow_sudo_auth"], false);
|
||||
assert_eq!(local["revision"], 3);
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 升级缺失本机认证列的旧目录
|
||||
#[test]
|
||||
fn sudo_auth_upgrades_old_identity_schema() -> Result<(), Box<dyn std::error::Error>> {
|
||||
let (server, data) = start_server();
|
||||
drop(server);
|
||||
CURRENT.with(|slot| *slot.borrow_mut() = None);
|
||||
let path = data.path().join("system/catalog.json");
|
||||
let mut catalog: serde_json::Value = serde_json::from_slice(&std::fs::read(&path)?)?;
|
||||
catalog["tables"]["__system_identities"]["columns"].as_array_mut().unwrap().retain(|column| column["name"] != "allow_sudo_auth");
|
||||
std::fs::write(&path, serde_json::to_vec(&catalog)?)?;
|
||||
let _restarted = restart_at(data.path())?;
|
||||
let mut c = connect()?;
|
||||
let upgraded = account_response(&mut c, serde_json::json!({"method":"identity_initialize","administrator":"root"}))?;
|
||||
assert!(upgraded["accounts"].as_array().unwrap().iter().all(|a| a["allow_sudo_auth"] == false));
|
||||
let catalog: serde_json::Value = serde_json::from_slice(&std::fs::read(&path)?)?;
|
||||
assert!(catalog["tables"]["__system_identities"]["columns"].as_array().unwrap().iter().any(|column| column["name"] == "allow_sudo_auth"));
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 身份属性重启保留且禁止删除最后管理员
|
||||
#[test]
|
||||
fn identity_attributes_survive_restart_and_protect_superuser() -> Result<(), Box<dyn std::error::Error>> {
|
||||
@@ -1691,6 +1905,7 @@ fn create_table_replays_after_restart() -> Result<(), Box<dyn std::error::Error>
|
||||
drop(server);
|
||||
|
||||
let group = vec![WalOp::CreateTable {
|
||||
object_id: None,
|
||||
table: "m4_create".into(),
|
||||
columns: vec![
|
||||
SchemaColumn {
|
||||
@@ -1835,6 +2050,7 @@ fn already_applied_create_table_is_skipped_on_restart() -> Result<(), Box<dyn st
|
||||
|
||||
let wal = Wal::new(data.path().join("databases/main/wal.log"));
|
||||
wal.append_group(&[WalOp::CreateTable {
|
||||
object_id: None,
|
||||
table: "m4_done".into(),
|
||||
columns: vec![SchemaColumn {
|
||||
name: "id".into(),
|
||||
@@ -1995,6 +2211,36 @@ fn create_index_accepts_duplicate_values() {
|
||||
assert!(r.contains(r#""status":"error""#), "the id index stays unique: {}", r);
|
||||
}
|
||||
|
||||
/// 重启修复统计并保持点查范围结果
|
||||
#[test]
|
||||
fn restart_rebuilds_stale_stats_without_changing_index_results() -> Result<(), Box<dyn std::error::Error>> {
|
||||
let (server, data) = start_server();
|
||||
let mut c = connect()?;
|
||||
let rows: Vec<serde_json::Value> = (0..160).map(|id| serde_json::json!({"id":id,"v":id})).collect();
|
||||
request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"rebuilt","rows":rows}))?;
|
||||
request_ok(&mut c, serde_json::json!({"method":"create_index","table":"rebuilt","column":"v"}))?;
|
||||
let point: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"lookup_by_index","table":"rebuilt","column":"v","key":80}"#))?;
|
||||
let range: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"range_by_index","table":"rebuilt","column":"v","lo":80,"hi":89}"#))?;
|
||||
let scan: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"rebuilt"}"#))?;
|
||||
drop(c);
|
||||
drop(server);
|
||||
let path = data.path().join("databases/main/catalog.json");
|
||||
let mut catalog: serde_json::Value = serde_json::from_slice(&std::fs::read(&path)?)?;
|
||||
catalog["tables"]["rebuilt"]["row_count"] = serde_json::json!(9999);
|
||||
catalog["tables"]["rebuilt"]["stats"] = serde_json::json!({});
|
||||
std::fs::write(&path, serde_json::to_vec(&catalog)?)?;
|
||||
let _restarted = restart_at(data.path())?;
|
||||
let mut c = connect()?;
|
||||
assert_eq!(serde_json::from_str::<serde_json::Value>(&send(&mut c, r#"{"method":"lookup_by_index","table":"rebuilt","column":"v","key":80}"#))?, point);
|
||||
assert_eq!(serde_json::from_str::<serde_json::Value>(&send(&mut c, r#"{"method":"range_by_index","table":"rebuilt","column":"v","lo":80,"hi":89}"#))?, range);
|
||||
assert_eq!(serde_json::from_str::<serde_json::Value>(&send(&mut c, r#"{"method":"scan","table":"rebuilt"}"#))?, scan);
|
||||
let schema: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"describe_table","table":"rebuilt"}"#))?;
|
||||
assert_eq!(schema["row_count"], 160);
|
||||
let stat = schema["stats"].as_array().unwrap().iter().find(|stat| stat["name"] == "v").unwrap();
|
||||
assert_eq!(stat["hist"], serde_json::json!([10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10]));
|
||||
Ok(())
|
||||
}
|
||||
|
||||
/// 数据字典里的统计:不同值个数
|
||||
#[test]
|
||||
fn stats_report_distinct_values() {
|
||||
@@ -2264,9 +2510,9 @@ fn account_table_uses_typed_columns_and_stamps_login() -> Result<(), Box<dyn std
|
||||
let entry = &catalog["tables"]["__system_identities"];
|
||||
let columns = entry["columns"].as_array().ok_or("missing columns")?;
|
||||
let names: Vec<&str> = columns.iter().map(|col| col["name"].as_str().unwrap_or("")).collect();
|
||||
assert_eq!(names, vec!["id", "user", "can_login", "is_superuser", "system_catalog_manager", "enabled", "identity_version", "registered_at", "last_login_at", "revision"]);
|
||||
assert_eq!(names, vec!["id", "user", "can_login", "is_superuser", "system_catalog_manager", "allow_sudo_auth", "enabled", "identity_version", "registered_at", "last_login_at", "revision"]);
|
||||
let types: Vec<&str> = columns.iter().map(|col| col["ty"].as_str().unwrap_or("")).collect();
|
||||
assert_eq!(types, vec!["int", "varchar(64)", "bool", "bool", "bool", "bool", "int", "timestamp", "timestamp", "int"]);
|
||||
assert_eq!(types, vec!["int", "varchar(64)", "bool", "bool", "bool", "bool", "bool", "int", "timestamp", "timestamp", "int"]);
|
||||
assert_eq!(columns[0]["primary_key"], true, "id 是主键");
|
||||
assert_eq!(columns[0]["nullable"], false);
|
||||
assert_eq!(columns[1]["unique"], true, "用户名唯一");
|
||||
|
||||
@@ -4,6 +4,29 @@ use serde_json::json;
|
||||
|
||||
// WAL 测试:追加、读取、清空、截断尾巴、LSN 与提交标记。
|
||||
|
||||
/// 建表编号完整往返且兼容旧载荷
|
||||
#[test]
|
||||
fn create_table_ids_round_trip_and_legacy_payloads_decode() {
|
||||
let dir = tempfile::tempdir().unwrap();
|
||||
let path = dir.path().join("wal.log");
|
||||
let wal = Wal::new(&path);
|
||||
let op = WalOp::CreateTable { table: "t".into(), columns: vec![], object_id: Some(42) };
|
||||
wal.append(&op).unwrap();
|
||||
assert_eq!(wal.read_all().unwrap().records[0].1, op);
|
||||
drop(wal);
|
||||
let mut body = 1_u64.to_le_bytes().to_vec();
|
||||
body.push(11);
|
||||
body.extend_from_slice(&1_u16.to_le_bytes());
|
||||
body.extend_from_slice(b"t");
|
||||
body.extend_from_slice(br#"{"columns":[]}"#);
|
||||
let mut frame = (body.len() as u32).to_le_bytes().to_vec();
|
||||
frame.extend_from_slice(&body);
|
||||
std::fs::write(&path, frame).unwrap();
|
||||
let wal = Wal::new(&path);
|
||||
assert_eq!(wal.read_all().unwrap().records[0].1,
|
||||
WalOp::CreateTable { table: "t".into(), columns: vec![], object_id: None });
|
||||
}
|
||||
|
||||
|
||||
/// 用键值对构造一行
|
||||
fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
|
||||
|
||||
@@ -0,0 +1,179 @@
|
||||
#ifdef _WIN32
|
||||
#define _WIN32_WINNT 0x0600
|
||||
#include <windows.h>
|
||||
#include <sddl.h>
|
||||
#include <stdio.h>
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#include <fcntl.h>
|
||||
#include <sys/stat.h>
|
||||
#include <errno.h>
|
||||
#include <stdio.h>
|
||||
#endif
|
||||
#include <string.h>
|
||||
|
||||
/* 创建、读取和清理仅本机提升身份可访问的认证凭据。 */
|
||||
|
||||
#ifdef _WIN32
|
||||
/* 检查当前提升令牌的管理员成员资格。 */
|
||||
int chusql_sudo_privileged(void) {
|
||||
SID_IDENTIFIER_AUTHORITY authority = SECURITY_NT_AUTHORITY;
|
||||
PSID administrators = NULL;
|
||||
BOOL member = FALSE;
|
||||
if (!AllocateAndInitializeSid(&authority, 2, SECURITY_BUILTIN_DOMAIN_RID,
|
||||
DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &administrators)) return 0;
|
||||
if (!CheckTokenMembership(NULL, administrators, &member)) member = FALSE;
|
||||
FreeSid(administrators);
|
||||
return member != FALSE;
|
||||
}
|
||||
|
||||
/* 生成系统保护目录中的端口专属路径。 */
|
||||
static int credential_path(int port, wchar_t *directory, wchar_t *file) {
|
||||
wchar_t base[MAX_PATH];
|
||||
UINT length = GetSystemDirectoryW(base, MAX_PATH);
|
||||
if (!length || length >= MAX_PATH - 80 || port < 1 || port > 65535) return ERROR_INVALID_PARAMETER;
|
||||
swprintf(directory, MAX_PATH, L"%ls\\config\\ChuSQL-Sudo-%d", base, port);
|
||||
swprintf(file, MAX_PATH, L"%ls\\credential", directory);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* 排除重解析目录与凭据文件。 */
|
||||
static int plain_path(const wchar_t *path, int directory) {
|
||||
DWORD attributes = GetFileAttributesW(path);
|
||||
return attributes != INVALID_FILE_ATTRIBUTES && !(attributes & FILE_ATTRIBUTE_REPARSE_POINT)
|
||||
&& (!!(attributes & FILE_ATTRIBUTE_DIRECTORY) == directory);
|
||||
}
|
||||
|
||||
/* 用管理员与系统专属访问列表创建凭据。 */
|
||||
int chusql_sudo_create(int port, const char *secret) {
|
||||
wchar_t directory[MAX_PATH], file[MAX_PATH];
|
||||
PSECURITY_DESCRIPTOR descriptor = NULL;
|
||||
SECURITY_ATTRIBUTES attributes = {sizeof(SECURITY_ATTRIBUTES), NULL, FALSE};
|
||||
DWORD written = 0, error;
|
||||
HANDLE handle;
|
||||
if (!chusql_sudo_privileged()) return ERROR_ACCESS_DENIED;
|
||||
error = credential_path(port, directory, file);
|
||||
if (error) return (int)error;
|
||||
if (!ConvertStringSecurityDescriptorToSecurityDescriptorW(
|
||||
L"D:P(A;OICI;FA;;;BA)(A;OICI;FA;;;SY)", SDDL_REVISION_1, &descriptor, NULL)) return (int)GetLastError();
|
||||
attributes.lpSecurityDescriptor = descriptor;
|
||||
if (!CreateDirectoryW(directory, &attributes)) {
|
||||
error = GetLastError(); LocalFree(descriptor); return (int)error;
|
||||
}
|
||||
handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_READ, &attributes, CREATE_NEW,
|
||||
FILE_ATTRIBUTE_NORMAL | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
|
||||
LocalFree(descriptor);
|
||||
if (handle == INVALID_HANDLE_VALUE) {
|
||||
error = GetLastError(); RemoveDirectoryW(directory); return (int)error;
|
||||
}
|
||||
error = 0;
|
||||
if (!WriteFile(handle, secret, 64, &written, NULL) || written != 64 || !FlushFileBuffers(handle))
|
||||
error = GetLastError() ? GetLastError() : ERROR_WRITE_FAULT;
|
||||
if (!CloseHandle(handle) && !error) error = GetLastError();
|
||||
if (error) { DeleteFileW(file); RemoveDirectoryW(directory); }
|
||||
return (int)error;
|
||||
}
|
||||
|
||||
/* 从系统保护目录读取本机凭据。 */
|
||||
int chusql_sudo_read(int port, char *secret) {
|
||||
wchar_t directory[MAX_PATH], file[MAX_PATH];
|
||||
DWORD received = 0, error;
|
||||
LARGE_INTEGER size;
|
||||
HANDLE handle;
|
||||
if (!chusql_sudo_privileged()) return ERROR_ACCESS_DENIED;
|
||||
error = credential_path(port, directory, file);
|
||||
if (error) return (int)error;
|
||||
if (!plain_path(directory, 1) || !plain_path(file, 0)) return ERROR_ACCESS_DENIED;
|
||||
handle = CreateFileW(file, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
|
||||
FILE_ATTRIBUTE_NORMAL | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
|
||||
if (handle == INVALID_HANDLE_VALUE) return (int)GetLastError();
|
||||
error = 0;
|
||||
if (!GetFileSizeEx(handle, &size) || size.QuadPart != 64
|
||||
|| !ReadFile(handle, secret, 64, &received, NULL) || received != 64) error = ERROR_INVALID_DATA;
|
||||
if (!CloseHandle(handle) && !error) error = GetLastError();
|
||||
return (int)error;
|
||||
}
|
||||
|
||||
/* 删除本次服务启动创建的凭据目录。 */
|
||||
int chusql_sudo_remove(int port) {
|
||||
wchar_t directory[MAX_PATH], file[MAX_PATH];
|
||||
int error = credential_path(port, directory, file);
|
||||
if (error) return error;
|
||||
if (!chusql_sudo_privileged()) return ERROR_ACCESS_DENIED;
|
||||
if (!DeleteFileW(file)) return (int)GetLastError();
|
||||
return RemoveDirectoryW(directory) ? 0 : (int)GetLastError();
|
||||
}
|
||||
#else
|
||||
/* 检查当前进程的有效 root 身份。 */
|
||||
int chusql_sudo_privileged(void) { return geteuid() == 0; }
|
||||
|
||||
/* 打开 root 专属目录并验证所有权与权限。 */
|
||||
static int credential_directory(int port) {
|
||||
char path[96];
|
||||
struct stat status;
|
||||
int fd;
|
||||
if (port < 1 || port > 65535) { errno = EINVAL; return -1; }
|
||||
snprintf(path, sizeof(path), "/var/run/chusql-sudo-%d", port);
|
||||
fd = open(path, O_RDONLY | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC);
|
||||
if (fd < 0) return -1;
|
||||
if (fstat(fd, &status) || status.st_uid != 0 || (status.st_mode & 0777) != 0700) {
|
||||
close(fd); errno = EACCES; return -1;
|
||||
}
|
||||
return fd;
|
||||
}
|
||||
|
||||
/* 在 root 专属目录中独占创建凭据。 */
|
||||
int chusql_sudo_create(int port, const char *secret) {
|
||||
char path[96];
|
||||
int dir, fd, error = 0;
|
||||
if (!chusql_sudo_privileged()) return EACCES;
|
||||
if (port < 1 || port > 65535) return EINVAL;
|
||||
snprintf(path, sizeof(path), "/var/run/chusql-sudo-%d", port);
|
||||
if (mkdir(path, 0700)) return errno;
|
||||
dir = credential_directory(port);
|
||||
if (dir < 0) { error = errno; rmdir(path); return error; }
|
||||
fd = openat(dir, "credential", O_WRONLY | O_CREAT | O_EXCL | O_NOFOLLOW | O_CLOEXEC, 0600);
|
||||
if (fd < 0) error = errno;
|
||||
else {
|
||||
if (write(fd, secret, 64) != 64 || fsync(fd)) error = errno ? errno : EIO;
|
||||
if (close(fd) && !error) error = errno;
|
||||
}
|
||||
if (error) unlinkat(dir, "credential", 0);
|
||||
if (close(dir) && !error) error = errno;
|
||||
if (error) rmdir(path);
|
||||
return error;
|
||||
}
|
||||
|
||||
/* 验证 root 文件所有权后读取凭据。 */
|
||||
int chusql_sudo_read(int port, char *secret) {
|
||||
struct stat status;
|
||||
int dir, fd, error = 0;
|
||||
if (!chusql_sudo_privileged()) return EACCES;
|
||||
dir = credential_directory(port);
|
||||
if (dir < 0) return errno;
|
||||
fd = openat(dir, "credential", O_RDONLY | O_NOFOLLOW | O_CLOEXEC);
|
||||
if (fd < 0) error = errno;
|
||||
else {
|
||||
if (fstat(fd, &status) || !S_ISREG(status.st_mode) || status.st_uid != 0
|
||||
|| (status.st_mode & 0777) != 0600 || status.st_size != 64 || status.st_nlink != 1) error = EACCES;
|
||||
else if (read(fd, secret, 64) != 64) error = errno ? errno : EIO;
|
||||
if (close(fd) && !error) error = errno;
|
||||
}
|
||||
if (close(dir) && !error) error = errno;
|
||||
return error;
|
||||
}
|
||||
|
||||
/* 删除本次服务启动创建的凭据目录。 */
|
||||
int chusql_sudo_remove(int port) {
|
||||
char path[96];
|
||||
int dir, error = 0;
|
||||
if (!chusql_sudo_privileged()) return EACCES;
|
||||
dir = credential_directory(port);
|
||||
if (dir < 0) return errno;
|
||||
if (unlinkat(dir, "credential", 0)) error = errno;
|
||||
if (close(dir) && !error) error = errno;
|
||||
snprintf(path, sizeof(path), "/var/run/chusql-sudo-%d", port);
|
||||
if (!error && rmdir(path)) error = errno;
|
||||
return error;
|
||||
}
|
||||
#endif
|
||||
@@ -21,6 +21,7 @@ library
|
||||
ChuSQL.Interface.Protocol
|
||||
ChuSQL.Interface.RateLimit
|
||||
ChuSQL.Interface.Session
|
||||
ChuSQL.Interface.Sudo
|
||||
ChuSQL.Interface.Settings
|
||||
ChuSQL.Interface.TOML
|
||||
build-depends: base >= 4.14 && < 5
|
||||
@@ -36,5 +37,8 @@ library
|
||||
, scientific
|
||||
, text
|
||||
, time
|
||||
c-sources: cbits/sudo_credential.c
|
||||
if os(windows)
|
||||
extra-libraries: advapi32
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
@@ -34,6 +34,9 @@ module ChuSQL.Interface.Actions (
|
||||
|
||||
import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), integerType, numericType, parseColumnType, plainColumn, typeName)
|
||||
import qualified ChuSQL.Core.Model as M
|
||||
import ChuSQL.Core.Runtime
|
||||
import ChuSQL.Core.Protocol (valueFromJSON)
|
||||
import Data.Aeson.Types (parseEither)
|
||||
import qualified Data.Aeson as A
|
||||
import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
|
||||
import Data.List (intercalate)
|
||||
@@ -88,24 +91,50 @@ columnTypeOf = fmap plainColumn . parseColumnType . T.unpack . T.strip
|
||||
|
||||
-- | 本地类型转线上名字
|
||||
columnTypeName :: Column -> Text
|
||||
columnTypeName = T.pack . typeName . columnType
|
||||
columnTypeName column = T.pack $ case columnType column of
|
||||
CRuntime tid -> renderTypeExpr (typeExpression tid)
|
||||
ty -> typeName ty
|
||||
|
||||
-- | 字符串字面量转义:单引号翻倍(引擎的词法器就是这么折回去的)
|
||||
escapeStringLiteral :: String -> String
|
||||
escapeStringLiteral = concatMap (\c -> if c == '\'' then "''" else [c])
|
||||
|
||||
-- | 值转 SQL 字面量
|
||||
sqlLiteral :: Value -> String
|
||||
sqlLiteral VNull = "NULL"
|
||||
sqlLiteral (VInt n) = show n
|
||||
sqlLiteral (VFloat d) = show d
|
||||
sqlLiteral (VStr s) = "'" ++ escapeStringLiteral s ++ "'"
|
||||
sqlLiteral (VBool True) = "TRUE"
|
||||
sqlLiteral (VBool False) = "FALSE"
|
||||
sqlLiteral :: Value -> Either String String
|
||||
sqlLiteral VNull = Right "NULL"
|
||||
sqlLiteral (VInt n) = Right (show n)
|
||||
sqlLiteral (VFloat d)
|
||||
| isNaN d || isInfinite d = Left "SQL floating literal must be finite"
|
||||
| otherwise = Right (show d)
|
||||
sqlLiteral (VStr s) = Right ("'" ++ escapeStringLiteral s ++ "'")
|
||||
sqlLiteral (VBool True) = Right "TRUE"
|
||||
sqlLiteral (VBool False) = Right "FALSE"
|
||||
sqlLiteral (VRuntime tid value) = do
|
||||
validateValue builtinTypes tid value
|
||||
runtimeLiteral (typeExpression tid) value
|
||||
|
||||
-- | 渲染类型化构造器的 SQL 字面量
|
||||
runtimeLiteral :: TypeExpr -> RuntimeValue -> Either String String
|
||||
runtimeLiteral _ (RInt n) = Right (show n)
|
||||
runtimeLiteral _ (RDouble n) = Right (show n)
|
||||
runtimeLiteral _ (RBool b) = Right (if b then "TRUE" else "FALSE")
|
||||
runtimeLiteral _ (RString text) = Right ("'" ++ escapeStringLiteral text ++ "'")
|
||||
runtimeLiteral (TypeApply (TypeConstructorId 5) [child]) (RList values) = do
|
||||
items <- mapM (runtimeLiteral child) values
|
||||
Right ("LIST<" ++ renderTypeExpr child ++ ">(" ++ intercalate ", " items ++ ")")
|
||||
runtimeLiteral (TypeApply (TypeConstructorId 6) [child]) (RMaybe value) = do
|
||||
item <- maybe (Right "") (runtimeLiteral child) value
|
||||
Right ("MAYBE<" ++ renderTypeExpr child ++ ">(" ++ item ++ ")")
|
||||
runtimeLiteral (TypeApply (TypeConstructorId 7) fields) (RTuple values)
|
||||
| length fields == length values = do
|
||||
items <- sequence (zipWith runtimeLiteral fields values)
|
||||
Right ("TUPLE<" ++ intercalate ", " (map renderTypeExpr fields) ++ ">(" ++ intercalate ", " items ++ ")")
|
||||
runtimeLiteral _ _ = Left "runtime value does not match its type expression"
|
||||
|
||||
-- | JSON 值按列类型转成引擎的值;类型对不上就报错
|
||||
coerceValue :: Column -> A.Value -> Either String Value
|
||||
coerceValue col v = case v of
|
||||
A.Object _ -> parseEither valueFromJSON v >>= M.coerceValue t
|
||||
A.Null -> Right VNull
|
||||
A.Bool b -> M.coerceValue t (VBool b)
|
||||
A.Number n -> case floatingOrInteger n :: Either Double Integer of
|
||||
@@ -186,13 +215,14 @@ insertRowSql table row = do
|
||||
tbl <- checkIdent "table" table
|
||||
cols <- requireNonEmpty "values" row
|
||||
names <- mapM (checkIdent "column" . T.pack . fst) cols
|
||||
literals <- mapM (sqlLiteral . snd) cols
|
||||
pure
|
||||
( "INSERT INTO "
|
||||
++ T.unpack tbl
|
||||
++ " ("
|
||||
++ intercalate ", " (map T.unpack names)
|
||||
++ ") VALUES ("
|
||||
++ intercalate ", " (map (sqlLiteral . snd) cols)
|
||||
++ intercalate ", " literals
|
||||
++ ")"
|
||||
)
|
||||
|
||||
@@ -208,14 +238,15 @@ insertRowsSql table rows = do
|
||||
let widths = map length rs
|
||||
if any (/= length first) widths
|
||||
then Left "all rows must have the same columns"
|
||||
else
|
||||
else do
|
||||
literals <- mapM (mapM (sqlLiteral . snd)) rs
|
||||
pure
|
||||
( "INSERT INTO "
|
||||
++ T.unpack tbl
|
||||
++ " ("
|
||||
++ intercalate ", " (map T.unpack names)
|
||||
++ ") VALUES "
|
||||
++ intercalate ", " ["(" ++ intercalate ", " (map (sqlLiteral . snd) r) ++ ")" | r <- rs]
|
||||
++ intercalate ", " ["(" ++ intercalate ", " values ++ ")" | values <- literals]
|
||||
)
|
||||
|
||||
-- | 构造按 id 改行的 UPDATE 语句
|
||||
@@ -223,8 +254,14 @@ updateRowSql :: Text -> Int -> [(String, Value)] -> Either String String
|
||||
updateRowSql table key assigns = do
|
||||
tbl <- checkIdent "table" table
|
||||
cols <- requireNonEmpty "values" assigns
|
||||
sets <- mapM (\(n, v) -> (\c -> T.unpack c ++ " = " ++ sqlLiteral v) <$> checkIdent "column" (T.pack n)) cols
|
||||
sets <- mapM assignment cols
|
||||
pure ("UPDATE " ++ T.unpack tbl ++ " SET " ++ intercalate ", " sets ++ " WHERE id = " ++ show key)
|
||||
where
|
||||
-- | 校验列名并编码赋值
|
||||
assignment (name, value) = do
|
||||
column <- checkIdent "column" (T.pack name)
|
||||
literal <- sqlLiteral value
|
||||
Right (T.unpack column ++ " = " ++ literal)
|
||||
|
||||
-- | 按 id 删一行,存储层原地删
|
||||
deleteRowSql :: Text -> Int -> Either String String
|
||||
@@ -251,7 +288,8 @@ whereClause filters = case filters of
|
||||
-- | 一个等值条件
|
||||
term (column, value) = do
|
||||
col <- checkIdent "column" column
|
||||
pure (T.unpack col ++ " = " ++ sqlLiteral value)
|
||||
literal <- sqlLiteral value
|
||||
pure (T.unpack col ++ " = " ++ literal)
|
||||
|
||||
-- | 拼 ORDER BY 子句,无排序给空串
|
||||
orderClause :: Maybe (Text, Bool) -> Either String String
|
||||
@@ -309,6 +347,8 @@ roleName name
|
||||
-- | 授权对象:`*`,或长度不超过 128 的裸表名/`库.表`
|
||||
grantObject :: Text -> Either String Text
|
||||
grantObject object
|
||||
| "database:" `T.isPrefixOf` T.toLower object = ("DATABASE " <>) <$> checkIdent "database" (T.drop 9 object)
|
||||
| ".*" `T.isSuffixOf` object = (<> ".*") <$> checkIdent "database" (T.dropEnd 2 object)
|
||||
| T.strip object == "*" = Right "*"
|
||||
| T.null object || T.length object > 128 = Left "object name is empty or too long"
|
||||
| not (T.all allowed object) = Left ("object name may only contain ASCII letters, digits, dot, dash or underscore: " ++ T.unpack object)
|
||||
|
||||
@@ -186,12 +186,13 @@ data ServerConfig = ServerConfig
|
||||
, scPort :: Int
|
||||
, scMaxMessage :: Int
|
||||
, scMaxRows :: Int
|
||||
, scSudoUser :: Text
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | 默认本机 7777,行 1 MiB,最多 1000 行
|
||||
defaultServerConfig :: ServerConfig
|
||||
defaultServerConfig = ServerConfig "127.0.0.1" 7777 (1024 * 1024) 1000
|
||||
defaultServerConfig = ServerConfig "127.0.0.1" 7777 (1024 * 1024) 1000 ""
|
||||
|
||||
-- | 读 [server] 段键,缺的用默认
|
||||
loadServerConfigAt :: FilePath -> IO ServerConfig
|
||||
@@ -211,4 +212,5 @@ loadServerConfigAt path = do
|
||||
, scPort = intOf "port" (scPort defaultServerConfig)
|
||||
, scMaxMessage = intOf "max_message" (scMaxMessage defaultServerConfig)
|
||||
, scMaxRows = intOf "max_rows" (scMaxRows defaultServerConfig)
|
||||
, scSudoUser = T.toLower (T.pack (textOf "sudo_auth_user" ""))
|
||||
}
|
||||
@@ -5,6 +5,7 @@ module ChuSQL.Interface.Link (
|
||||
connectClient,
|
||||
closeClient,
|
||||
clientLogin,
|
||||
clientSudoLogin,
|
||||
clientQuery,
|
||||
clientPing,
|
||||
clientCatalog,
|
||||
@@ -15,6 +16,7 @@ module ChuSQL.Interface.Link (
|
||||
clientReloadPolicy,
|
||||
) where
|
||||
|
||||
import ChuSQL.Interface.Sudo (SudoCredential, sudoProof, isLocalPeer)
|
||||
import ChuSQL.Core.Protocol (Account, QueryResult (..), TableInfo (..))
|
||||
import ChuSQL.Interface.Protocol (
|
||||
ClientRequest (..),
|
||||
@@ -40,6 +42,7 @@ import Network.Socket (
|
||||
defaultHints,
|
||||
defaultProtocol,
|
||||
getAddrInfo,
|
||||
getPeerName,
|
||||
socket,
|
||||
socketToHandle,
|
||||
)
|
||||
@@ -52,17 +55,18 @@ import System.IO.Error (isEOFError)
|
||||
data Client = Client
|
||||
{ clHandle :: Handle
|
||||
, clLock :: MVar ()
|
||||
, clLocal :: Bool
|
||||
}
|
||||
|
||||
-- | 连上 server 并对协议版本,失败给人话错误
|
||||
connectClient :: Text -> Int -> IO (Either Text Client)
|
||||
connectClient host port = do
|
||||
opened <- try (openConnection host port) :: IO (Either IOException Handle)
|
||||
opened <- try (openConnection host port) :: IO (Either IOException (Handle, Bool))
|
||||
case opened of
|
||||
Left err -> pure (Left ("cannot reach the server at " <> T.pack (address host port) <> ": " <> T.pack (describe err)))
|
||||
Right handle -> do
|
||||
Right (handle, local) -> do
|
||||
lock <- newMVar ()
|
||||
let client = Client handle lock
|
||||
let client = Client handle lock local
|
||||
greeted <- request client (ReqHello protocolVersion)
|
||||
case greeted of
|
||||
Right (RespHello version)
|
||||
@@ -117,6 +121,26 @@ clientLogin client user password = do
|
||||
Right (RespLogin _ admin) -> pure (Right admin)
|
||||
Right other -> pure (failed "login" other)
|
||||
|
||||
-- 验证一次性挑战并用本机身份登录。
|
||||
clientSudoLogin :: Client -> SudoCredential -> Text -> IO (Either Text Bool)
|
||||
clientSudoLogin client _ _ | not (clLocal client) = pure (Left "sudo authentication requires a local server")
|
||||
clientSudoLogin client credential user = withMVar (clLock client) $ \_ -> do
|
||||
outcome <- try authenticate :: IO (Either IOException (Either Text Bool))
|
||||
pure $ either (Left . T.pack . describe) id outcome
|
||||
where
|
||||
-- 在同一连接连续交换挑战与证明。
|
||||
authenticate = do
|
||||
challenge <- exchange (clHandle client) ReqSudoChallenge
|
||||
case challenge of
|
||||
Right (RespSudoChallenge nonce) | T.length nonce == 64 -> do
|
||||
answer <- exchange (clHandle client) (ReqSudoLogin user (sudoProof credential nonce user))
|
||||
pure $ case answer of
|
||||
Left message -> Left message
|
||||
Right (RespLogin _ admin) -> Right admin
|
||||
Right other -> failed "sudo login" other
|
||||
Right other -> pure (failed "sudo challenge" other)
|
||||
Left message -> pure (Left message)
|
||||
|
||||
-- | 跑一条语句,拿回结果集
|
||||
clientQuery :: Client -> Text -> IO (Either Text QueryResult)
|
||||
clientQuery client sql = do
|
||||
@@ -196,7 +220,7 @@ failed what response = case response of
|
||||
_ -> Left ("unexpected response to " <> what)
|
||||
|
||||
-- | 建连接(套接字转成文本模式的行缓冲句柄)
|
||||
openConnection :: Text -> Int -> IO Handle
|
||||
openConnection :: Text -> Int -> IO (Handle, Bool)
|
||||
openConnection host port = do
|
||||
let hints = defaultHints{addrSocketType = Stream}
|
||||
infos <- getAddrInfo (Just hints) (Just (T.unpack host)) (Just (show port))
|
||||
@@ -205,10 +229,11 @@ openConnection host port = do
|
||||
(info : _) -> do
|
||||
sock <- socket (addrFamily info) Stream defaultProtocol
|
||||
connect sock (addrAddress info)
|
||||
peer <- getPeerName sock
|
||||
handle <- socketToHandle sock ReadWriteMode
|
||||
hSetBuffering handle LineBuffering
|
||||
hSetNewlineMode handle noNewlineTranslation
|
||||
pure handle
|
||||
pure (handle, isLocalPeer peer)
|
||||
|
||||
-- | 把主机端口拼成地址字样
|
||||
address :: Text -> Int -> String
|
||||
|
||||
@@ -91,6 +91,8 @@ serverName = "chusql-server"
|
||||
data ClientRequest
|
||||
= ReqHello Int
|
||||
| ReqLogin Text Text
|
||||
| ReqSudoChallenge
|
||||
| ReqSudoLogin Text Text
|
||||
| ReqQuery Text
|
||||
| ReqPing
|
||||
| ReqQuit
|
||||
@@ -109,6 +111,7 @@ data WireRequest = WireRequest
|
||||
, wrProtocol :: Maybe Int
|
||||
, wrUser :: Maybe Text
|
||||
, wrPassword :: Maybe Text
|
||||
, wrProof :: Maybe Text
|
||||
, wrSql :: Maybe Text
|
||||
, wrRequest :: Maybe Value
|
||||
}
|
||||
@@ -121,6 +124,7 @@ instance A.FromJSON WireRequest where
|
||||
<*> o A..:? "protocol"
|
||||
<*> o A..:? "user"
|
||||
<*> o A..:? "password"
|
||||
<*> o A..:? "proof"
|
||||
<*> o A..:? "sql"
|
||||
<*> o A..:? "request"
|
||||
|
||||
@@ -133,6 +137,10 @@ decodeRequest raw = case A.eitherDecodeStrict raw of
|
||||
"login" -> case (wrUser wire, wrPassword wire) of
|
||||
(Just user, Just password) -> Right (ReqLogin user password)
|
||||
_ -> Left "login needs both user and password"
|
||||
"sudo_challenge" -> Right ReqSudoChallenge
|
||||
"sudo_login" -> case (wrUser wire, wrProof wire) of
|
||||
(Just user, Just proof) -> Right (ReqSudoLogin user proof)
|
||||
_ -> Left "sudo_login needs both user and proof"
|
||||
"query" -> maybe (Left "query needs sql") (Right . ReqQuery) (wrSql wire)
|
||||
"storage" -> maybe (Left "storage needs request") (Right . ReqStorage) (wrRequest wire)
|
||||
"catalog" -> Right ReqCatalog
|
||||
@@ -154,6 +162,8 @@ requestJson :: ClientRequest -> Value
|
||||
requestJson request = case request of
|
||||
ReqHello version -> object ["method" .= ("hello" :: Text), "protocol" .= version]
|
||||
ReqLogin user password -> object ["method" .= ("login" :: Text), "user" .= user, "password" .= password]
|
||||
ReqSudoChallenge -> object ["method" .= ("sudo_challenge" :: Text)]
|
||||
ReqSudoLogin user proof -> object ["method" .= ("sudo_login" :: Text), "user" .= user, "proof" .= proof]
|
||||
ReqQuery sql -> object ["method" .= ("query" :: Text), "sql" .= sql]
|
||||
ReqPing -> object ["method" .= ("ping" :: Text)]
|
||||
ReqQuit -> object ["method" .= ("quit" :: Text)]
|
||||
@@ -169,6 +179,7 @@ requestJson request = case request of
|
||||
data ServerResponse
|
||||
= RespHello Int
|
||||
| RespLogin Text Bool
|
||||
| RespSudoChallenge Text
|
||||
| RespResult QueryResult
|
||||
| RespPong
|
||||
| RespBye
|
||||
@@ -190,6 +201,7 @@ responseJson :: ServerResponse -> Value
|
||||
responseJson response = case response of
|
||||
RespHello version -> object ["status" .= ("hello" :: Text), "protocol" .= version, "server" .= serverName]
|
||||
RespLogin user admin -> object ["status" .= ("ok" :: Text), "user" .= user, "admin" .= admin]
|
||||
RespSudoChallenge challenge -> object ["status" .= ("sudo_challenge" :: Text), "challenge" .= challenge]
|
||||
RespPong -> object ["status" .= ("pong" :: Text)]
|
||||
RespBye -> object ["status" .= ("bye" :: Text)]
|
||||
RespError code message -> object ["status" .= ("error" :: Text), "code" .= code, "message" .= message]
|
||||
@@ -216,6 +228,7 @@ decodeResponse raw = case A.eitherDecode raw of
|
||||
decodeStatus status fields = case status of
|
||||
"hello" -> Right (RespHello (intOf "protocol" fields))
|
||||
"ok" -> Right (RespLogin (textOf "user" fields) (boolOf "admin" fields))
|
||||
"sudo_challenge" -> fromField "challenge" RespSudoChallenge fields
|
||||
"pong" -> Right RespPong
|
||||
"bye" -> Right RespBye
|
||||
"error" -> Right (RespError (textOf "code" fields) (textOf "message" fields))
|
||||
|
||||
@@ -7,6 +7,7 @@ module ChuSQL.Interface.Session (
|
||||
sessionDatabase,
|
||||
isPlainIdentifier,
|
||||
authenticateSession,
|
||||
authenticateSudoSession,
|
||||
switchDatabase,
|
||||
runStatement,
|
||||
catalog,
|
||||
@@ -22,9 +23,11 @@ import ChuSQL.Interface.Link (
|
||||
clientCatalog,
|
||||
clientDatabases,
|
||||
clientLogin,
|
||||
clientSudoLogin,
|
||||
clientQuery,
|
||||
clientRoles,
|
||||
)
|
||||
import ChuSQL.Interface.Sudo (SudoCredential)
|
||||
import ChuSQL.Interface.Protocol (RoleView)
|
||||
import Data.Char (isAlpha, isAlphaNum)
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
@@ -68,6 +71,14 @@ authenticateSession session user password = do
|
||||
Left message -> pure (Left message)
|
||||
Right admin -> writeIORef (ssAdmin session) admin >> pure (Right ())
|
||||
|
||||
-- 用受保护本机凭据登录并记录身份。
|
||||
authenticateSudoSession :: Session -> SudoCredential -> Text -> IO (Either Text ())
|
||||
authenticateSudoSession session credential user = do
|
||||
answer <- clientSudoLogin (ssClient session) credential user
|
||||
case answer of
|
||||
Left message -> pure (Left message)
|
||||
Right admin -> writeIORef (ssAdmin session) admin >> pure (Right ())
|
||||
|
||||
-- | 换库:名字先按解析器规矩校验,由 server 执行 USE
|
||||
switchDatabase :: Session -> Text -> IO (Either Text ())
|
||||
switchDatabase session rawName
|
||||
|
||||
@@ -0,0 +1,108 @@
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ChuSQL.Interface.Sudo (
|
||||
SudoCredential, createSudoCredential, removeSudoCredential,
|
||||
readSudoCredential, sudoProof, verifySudoProof, sudoChallenge, sudoPrivileged,
|
||||
newSudoCredential, isLocalPeer, validSudoChallenge,
|
||||
) where
|
||||
|
||||
import Crypto.Hash (SHA256)
|
||||
import Crypto.MAC.HMAC (HMAC, hmac)
|
||||
import Crypto.Random (getRandomBytes)
|
||||
import qualified Data.ByteArray as BA
|
||||
import Data.ByteArray.Encoding (Base (Base16), convertToBase)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Char (isHexDigit)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import Data.Time.Clock (UTCTime, diffUTCTime)
|
||||
import Foreign.C.String (CString)
|
||||
import Foreign.C.Types (CInt (..))
|
||||
import Foreign.Marshal.Alloc (allocaBytes)
|
||||
import Network.Socket (SockAddr (..), hostAddressToTuple, hostAddress6ToTuple)
|
||||
|
||||
-- 用系统保护凭据与一次性挑战验证本机提升身份。
|
||||
|
||||
newtype SudoCredential = SudoCredential BS.ByteString
|
||||
|
||||
-- 隐藏本机凭据的诊断内容。
|
||||
instance Show SudoCredential where
|
||||
show _ = "SudoCredential <redacted>"
|
||||
|
||||
-- 检查当前进程的操作系统提升身份。
|
||||
foreign import ccall unsafe "chusql_sudo_privileged" nativePrivileged :: IO CInt
|
||||
-- 创建操作系统保护的本机凭据。
|
||||
foreign import ccall safe "chusql_sudo_create" nativeCreate :: CInt -> CString -> IO CInt
|
||||
-- 读取操作系统保护的本机凭据。
|
||||
foreign import ccall safe "chusql_sudo_read" nativeRead :: CInt -> CString -> IO CInt
|
||||
-- 清理本次服务启动的凭据。
|
||||
foreign import ccall safe "chusql_sudo_remove" nativeRemove :: CInt -> IO CInt
|
||||
|
||||
-- 判断当前进程是否以提升身份运行。
|
||||
sudoPrivileged :: IO Bool
|
||||
sudoPrivileged = (/= 0) <$> nativePrivileged
|
||||
|
||||
-- 生成随机挑战和服务实例凭据。
|
||||
sudoChallenge :: IO Text
|
||||
sudoChallenge = TE.decodeUtf8 . convertToBase Base16 <$> (getRandomBytes 32 :: IO BS.ByteString)
|
||||
|
||||
-- 创建本次服务实例的受保护凭据。
|
||||
createSudoCredential :: Int -> IO SudoCredential
|
||||
createSudoCredential port = do
|
||||
credential@(SudoCredential secret) <- newSudoCredential
|
||||
status <- BS.useAsCString secret (nativeCreate (fromIntegral port))
|
||||
if status == 0 then pure credential
|
||||
else ioError (userError (T.unpack (nativeError "create" status)))
|
||||
|
||||
-- 生成独立服务实例的随机凭据。
|
||||
newSudoCredential :: IO SudoCredential
|
||||
newSudoCredential = SudoCredential . TE.encodeUtf8 <$> sudoChallenge
|
||||
|
||||
-- 判断内核报告的连接地址是否为回环。
|
||||
isLocalPeer :: SockAddr -> Bool
|
||||
isLocalPeer (SockAddrInet _ host) = let (first, _, _, _) = hostAddressToTuple host in first == 127
|
||||
isLocalPeer (SockAddrInet6 _ _ host _) = case hostAddress6ToTuple host of
|
||||
(0, 0, 0, 0, 0, 0, 0, 1) -> True
|
||||
(0, 0, 0, 0, 0, 65535, high, _) -> high >= 32512 && high <= 32767
|
||||
_ -> False
|
||||
isLocalPeer _ = False
|
||||
|
||||
-- 校验挑战有效期及其账号绑定证明。
|
||||
validSudoChallenge :: SudoCredential -> UTCTime -> Maybe (Text, UTCTime) -> Text -> Text -> Bool
|
||||
validSudoChallenge credential now challenge user proof = case challenge of
|
||||
Just (nonce, issued) -> diffUTCTime now issued >= 0 && diffUTCTime now issued <= 60
|
||||
&& verifySudoProof credential nonce user proof
|
||||
Nothing -> False
|
||||
|
||||
-- 删除本次服务实例的受保护凭据。
|
||||
removeSudoCredential :: Int -> IO ()
|
||||
removeSudoCredential port = do
|
||||
status <- nativeRemove (fromIntegral port)
|
||||
if status == 0 then pure () else ioError (userError (T.unpack (nativeError "remove" status)))
|
||||
|
||||
-- 验证操作系统身份并读取本机凭据。
|
||||
readSudoCredential :: Int -> IO (Either Text SudoCredential)
|
||||
readSudoCredential port = allocaBytes 64 $ \buffer -> do
|
||||
status <- nativeRead (fromIntegral port) buffer
|
||||
if status /= 0 then pure (Left (nativeError "read" status)) else do
|
||||
secret <- BS.packCStringLen (buffer, 64)
|
||||
pure $ if BS.all (isHexDigit . toEnum . fromIntegral) secret
|
||||
then Right (SudoCredential secret) else Left "invalid sudo credential"
|
||||
|
||||
-- 计算绑定挑战与目标账号的认证证明。
|
||||
sudoProof :: SudoCredential -> Text -> Text -> Text
|
||||
sudoProof (SudoCredential secret) challenge user = TE.decodeUtf8 (convertToBase Base16 digest)
|
||||
where
|
||||
digest = hmac secret (TE.encodeUtf8 ("chusql-sudo-v1:" <> challenge <> ":" <> T.toLower (T.strip user))) :: HMAC SHA256
|
||||
|
||||
-- 按固定长度常量时间比对认证证明。
|
||||
verifySudoProof :: SudoCredential -> Text -> Text -> Text -> Bool
|
||||
verifySudoProof credential challenge user proof = T.length proof == 64
|
||||
&& BA.constEq (TE.encodeUtf8 (sudoProof credential challenge user)) (TE.encodeUtf8 proof)
|
||||
|
||||
-- 将原生错误转换为明确诊断。
|
||||
nativeError :: Text -> CInt -> Text
|
||||
nativeError operation status = "sudo credential " <> operation <> " failed (OS error "
|
||||
<> T.pack (show status) <> "); requires root or an elevated administrator; stale credential directories must be removed after stopping the server"
|
||||
@@ -0,0 +1,60 @@
|
||||
import ctypes
|
||||
import os
|
||||
from pathlib import Path
|
||||
import subprocess
|
||||
import sys
|
||||
|
||||
# 验证 Unix 本机凭据的所有权、权限及符号链接拒绝。
|
||||
|
||||
# 执行本机凭据安全回归。
|
||||
def main():
|
||||
library = ctypes.CDLL(sys.argv[1])
|
||||
port = int(sys.argv[2])
|
||||
library.chusql_sudo_create.argtypes = [ctypes.c_int, ctypes.c_char_p]
|
||||
library.chusql_sudo_read.argtypes = [ctypes.c_int, ctypes.c_void_p]
|
||||
secret = b'a' * 64
|
||||
buffer = ctypes.create_string_buffer(64)
|
||||
if len(sys.argv) > 3:
|
||||
assert library.chusql_sudo_privileged() == 0
|
||||
assert library.chusql_sudo_create(port, secret) != 0
|
||||
assert library.chusql_sudo_read(port, buffer) != 0
|
||||
print('non-root creation and reading refused')
|
||||
return
|
||||
assert library.chusql_sudo_privileged() == 1
|
||||
assert library.chusql_sudo_create(port, secret) == 0
|
||||
directory = Path(f'/var/run/chusql-sudo-{port}')
|
||||
file = directory / 'credential'
|
||||
try:
|
||||
assert directory.stat().st_uid == 0
|
||||
assert directory.stat().st_mode & 0o777 == 0o700
|
||||
assert file.stat().st_mode & 0o777 == 0o600
|
||||
assert library.chusql_sudo_read(port, buffer) == 0
|
||||
assert buffer.raw == secret
|
||||
assert library.chusql_sudo_create(port, secret) != 0
|
||||
subprocess.run([sys.executable, __file__, sys.argv[1], str(port), '--deny'],
|
||||
user=65534, group=65534, check=True)
|
||||
file.chmod(0o644)
|
||||
assert library.chusql_sudo_read(port, buffer) != 0
|
||||
file.chmod(0o600)
|
||||
file.rename(directory / 'original')
|
||||
file.symlink_to(directory / 'original')
|
||||
assert library.chusql_sudo_read(port, buffer) != 0
|
||||
file.unlink()
|
||||
(directory / 'original').rename(file)
|
||||
file.write_bytes(secret + b'extra')
|
||||
assert library.chusql_sudo_read(port, buffer) != 0
|
||||
file.write_bytes(secret)
|
||||
os.chown(file, 65534, 65534)
|
||||
assert library.chusql_sudo_read(port, buffer) != 0
|
||||
os.chown(file, 0, 0)
|
||||
directory.chmod(0o755)
|
||||
assert library.chusql_sudo_read(port, buffer) != 0
|
||||
directory.chmod(0o700)
|
||||
finally:
|
||||
assert library.chusql_sudo_remove(port) == 0
|
||||
assert not directory.exists()
|
||||
print('root round trip, duplicate, permissions, ownership, symlink and cleanup passed')
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
main()
|
||||
@@ -16,6 +16,8 @@ library
|
||||
ChuSQL.Server.Catalog
|
||||
ChuSQL.Server.Policy
|
||||
ChuSQL.Server.Privileges
|
||||
ChuSQL.Server.ObjectACL
|
||||
ChuSQL.Server.Security
|
||||
ChuSQL.Server.Session
|
||||
ChuSQL.Server.TCP
|
||||
build-depends: base >= 4.14 && < 5
|
||||
|
||||
@@ -4,7 +4,7 @@ module ChuSQL.Server.Accounts (
|
||||
Accounts, AccountError (..), Principal (..), PasswordPolicy (..), defaultPasswordPolicy,
|
||||
newAccounts, accountsPolicy, setAccountsPolicy, passwordAllowed,
|
||||
ensureRootAccount, administratorPasswordless, rootUserName, principalName, principalIsRoot, principalIsCatalogManager,
|
||||
authenticate, currentPrincipal,
|
||||
authenticate, authenticateSudo, currentPrincipal,
|
||||
listAccounts, findAccount, AccountCommand (..), accountCommand, runAccountCommand,
|
||||
) where
|
||||
|
||||
@@ -153,7 +153,7 @@ ensureRootAccount backend name = do
|
||||
| otherwise -> do
|
||||
created <- beAccounts backend (ReqAccountCreate (normalize name) "")
|
||||
case created of
|
||||
Right _ -> storageResult <$> beAccounts backend (ReqIdentityAlter (normalize name) Nothing (Just True) Nothing Nothing)
|
||||
Right _ -> storageResult <$> beAccounts backend (ReqIdentityAlter (normalize name) Nothing (Just True) Nothing Nothing Nothing)
|
||||
Left "account already exists" -> pure (Right ())
|
||||
Left _ -> pure (Left storageFailure)
|
||||
|
||||
@@ -219,6 +219,21 @@ authenticate service user password = withMVar (acLock service) $ \_ -> do
|
||||
Left _ -> pure (Left storageFailure)
|
||||
Right _ -> Right <$> createVersionedSession (acSessions service) (accountUser a) (Just (accountRevision a))
|
||||
|
||||
-- 为已验证的本机身份创建独立登录会话。
|
||||
authenticateSudo :: Accounts -> Text -> IO (Either AccountError Text)
|
||||
authenticateSudo service user = withMVar (acLock service) $ \_ -> do
|
||||
stored <- readAccounts (acBackend service)
|
||||
case stored of
|
||||
Left err -> pure (Left err)
|
||||
Right accounts -> case filter ((== normalize user) . accountUser) accounts of
|
||||
[a] | accountEnabled a && accountCanLogin a && accountAllowSudoAuth 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))
|
||||
_ -> pure (Left unauthorized)
|
||||
|
||||
-- | 系统表里的账号清单(含管理员)
|
||||
listAccounts :: Accounts -> IO (Either AccountError [Account])
|
||||
listAccounts service = withMVar (acLock service) $ \_ -> fmap (fmap (filter (\a -> accountCanLogin a || not (T.null (accountHash a))))) (readAccounts (acBackend service))
|
||||
@@ -295,7 +310,7 @@ runAccountCommand service principal command = withMVar (acLock service) $ \_ ->
|
||||
case identities of
|
||||
Left err -> pure (Left err)
|
||||
Right accounts
|
||||
| any (\a -> accountUser a == normalize (target command) && (accountIsSuperuser a || accountSystemCatalogManager a)) accounts
|
||||
| any (\a -> accountUser a == normalize (target command) && (accountIsSuperuser a || accountSystemCatalogManager a || accountAllowSudoAuth a)) accounts
|
||||
|| privilegedChange command -> pure (Left (AccountError "forbidden" "superuser required to manage privileged identities"))
|
||||
| otherwise -> execute
|
||||
| otherwise = execute
|
||||
@@ -305,12 +320,13 @@ runAccountCommand service principal command = withMVar (acLock service) $ \_ ->
|
||||
target (DropAccount name) = name
|
||||
target (AlterAccountAttributes name _) = name
|
||||
-- | 判断是否修改特权属性
|
||||
privilegedChange (AlterAccountAttributes _ attributes) = any (\(key, _) -> key `elem` ["superuser", "system_catalog_manager"]) attributes
|
||||
privilegedChange (AlterAccountAttributes _ attributes) = any (\(key, _) -> key `elem` ["superuser", "system_catalog_manager", "allow_sudo_auth"]) attributes
|
||||
privilegedChange _ = False
|
||||
-- | 执行已授权的身份命令
|
||||
execute = executeWith (if principalIsRoot principal then service else service{acBackend = (acBackend service){beAccounts = \request -> beAccounts (acBackend service) (ReqCatalogManage request)}})
|
||||
-- | 通过受限存储请求执行管理操作
|
||||
executeWith managed = case command of
|
||||
CreateAccount name _ | normalize name == "public" -> pure (Left (AccountError "bad_request" "public is reserved for default privileges"))
|
||||
CreateAccount name password -> createUser managed name password
|
||||
ResetAccountPassword name password -> resetPassword managed name password
|
||||
DropAccount name -> dropUser managed name
|
||||
@@ -318,4 +334,4 @@ runAccountCommand service principal command = withMVar (acLock service) $ \_ ->
|
||||
| length (nub (map fst attributes)) /= length attributes -> pure (Left (AccountError "bad_request" "duplicate identity attribute"))
|
||||
| otherwise ->
|
||||
storageResult <$> beAccounts (acBackend managed) (ReqIdentityAlter (normalize name)
|
||||
(lookup "login" attributes) (lookup "superuser" attributes) (lookup "enabled" attributes) (lookup "system_catalog_manager" attributes))
|
||||
(lookup "login" attributes) (lookup "superuser" attributes) (lookup "enabled" attributes) (lookup "system_catalog_manager" attributes) (lookup "allow_sudo_auth" attributes))
|
||||
@@ -172,7 +172,7 @@ memoryBackendWith trusted name ref =
|
||||
Left e -> pure (db, Left e)
|
||||
Right (db', rows)
|
||||
| any (\(key, _) -> hidden key && not (domainKey key)) db' -> pure (db, Left "reserved system table")
|
||||
| otherwise -> pure (mergeScoped db db', Right (StatementResult (colsOf (scoped db) stmt rows) rows))
|
||||
| otherwise -> pure (syncMemoryObjects name (mergeScoped db db'), Right (StatementResult (colsOf (scoped db) stmt rows) rows))
|
||||
, beCatalog = do
|
||||
db <- readMVar ref
|
||||
pure (Right (map tableInfoOf (filter (not . internalTable . fst) (scoped db))))
|
||||
@@ -186,7 +186,7 @@ memoryBackendWith trusted name ref =
|
||||
Right previous -> pure (case req of ReqAccountsList -> db; ReqCatalogManage ReqAccountsList -> db; _ -> storeMemoryIdentities db previous accounts, Right accounts)
|
||||
, beWithDatabase = withDatabase
|
||||
, beDatabases = pure (Right (nub [name, systemDatabaseName]))
|
||||
, beStorage = \_ -> pure (Left "storage is not available in this backend")
|
||||
, beStorage = memorySecurityRequest name ref
|
||||
, beSnapshot = Right . scoped <$> readMVar ref
|
||||
, beApplyTransaction = \ops -> modifyMVar ref $ \db -> case applyTransactionMemory ops (scoped db) of
|
||||
Left err -> pure (db, Left err)
|
||||
@@ -224,6 +224,52 @@ memoryBackendWith trusted name ref =
|
||||
| null target = noDatabaseBackend (memoryBackendWith False name ref)
|
||||
| otherwise = unavailableDatabase ("unknown database: " ++ target) (memoryBackendWith False name ref)
|
||||
|
||||
-- 更新内存夹具的稳定表编号。
|
||||
syncMemoryObjects :: String -> Database -> Database
|
||||
syncMemoryObjects database db = (registry, Table registry [("name", TStr), ("id", TInt)] records Nothing) : filter ((/= registry) . fst) db
|
||||
where
|
||||
registry = "__system_object_ids"
|
||||
previous = [(key, identifier) | row <- maybe [] tableRows (lookup registry db), Just (VStr key) <- [lookup "name" row], Just (VInt identifier) <- [lookup "id" row]]
|
||||
keys = [if '.' `elem` key then key else database ++ "." ++ key | (key, _) <- db, not (internalTable (lastTablePart key))]
|
||||
retained = [(key, identifier) | (key, identifier) <- previous, key `elem` keys]
|
||||
high = maximum (0 : map snd previous)
|
||||
added = zip [key | key <- keys, key `notElem` map fst retained] [high + 1 ..]
|
||||
records = [[("name", VStr key), ("id", VInt identifier)] | (key, identifier) <- ("__high_water", high + length added) : retained ++ added]
|
||||
|
||||
-- 执行内存夹具的权限快照协议。
|
||||
memorySecurityRequest :: String -> MVar Database -> A.Value -> IO (Either String A.Value)
|
||||
memorySecurityRequest database ref payload = modifyMVar ref $ \original -> do
|
||||
let db = syncMemoryObjects database original
|
||||
pure $ case operation db of
|
||||
Left err -> (original, Left err)
|
||||
Right (next, value) -> (next, Right value)
|
||||
where
|
||||
-- 读取协议文本字段。
|
||||
field key = case payload of
|
||||
A.Object fields -> case KM.lookup key fields of
|
||||
Just (A.String value) -> Just value
|
||||
_ -> Nothing
|
||||
_ -> Nothing
|
||||
-- 解析并执行一条权限请求。
|
||||
operation db = case field "method" of
|
||||
Just "resolve_object" -> do
|
||||
selected <- maybe (Left "missing database") Right (field "database")
|
||||
if selected `notElem` [T.pack database, "system"] then Left "unknown database" else do
|
||||
identifier <- case field "table" of
|
||||
Nothing -> Right A.Null
|
||||
Just table -> case [number | row <- maybe [] tableRows (lookup "__system_object_ids" db), lookup "name" row == Just (VStr (T.unpack (selected <> "." <> table))), Just (VInt number) <- [lookup "id" row]] of
|
||||
[number] -> Right (A.toJSON number)
|
||||
_ -> Left "unknown table"
|
||||
Right (db, A.object ["status" A..= ("object" :: Text), "database_id" A..= (if selected == "system" then (2 :: Int) else 1), "object_id" A..= identifier])
|
||||
Just "object_acl_read" -> Right (db, A.object ["status" A..= ("rows" :: Text), "rows" A..= [A.object ["id" A..= (1 :: Int), "payload" A..= value] | row <- maybe [] tableRows (lookup acl db), Just (VStr value) <- [lookup "payload" row]]])
|
||||
Just "object_acl_replace" -> do
|
||||
let previous = case lookup acl db of Nothing -> Nothing; Just table -> case tableRows table of [[("payload", VStr value)]] -> Just (T.pack value); _ -> Just "invalid ACL"
|
||||
if previous /= field "expected" then Left "object ACL changed concurrently" else do
|
||||
value <- maybe (Left "missing ACL payload") Right (field "payload")
|
||||
Right ((acl, Table acl [("payload", TStr)] [[("payload", VStr (T.unpack value))]] Nothing) : filter ((/= acl) . fst) db, A.object ["status" A..= ("ok" :: Text)])
|
||||
_ -> Left "storage is not available in this backend"
|
||||
acl = "__system_object_acl"
|
||||
|
||||
-- | 把后端的语句与字典都改成同一条错误
|
||||
unavailableDatabase :: String -> Backend -> Backend
|
||||
unavailableDatabase message backend = backend
|
||||
@@ -468,6 +514,10 @@ currentStamp = T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" <$> get
|
||||
-- | 在内存账号表上执行一条账号请求
|
||||
memoryAccounts :: Database -> T.Text -> Request -> Either String [Account]
|
||||
memoryAccounts db stamp req = do
|
||||
case req of
|
||||
ReqAccountCreate name _ | T.toLower name == "public" -> Left "public is reserved for default privileges"
|
||||
ReqRoleCreate name | T.toLower name == "public" -> Left "public is reserved for default privileges"
|
||||
_ -> Right ()
|
||||
stored <- case lookup "__system_identities" db of
|
||||
Just table -> mapM decodeCredential (tableRows table)
|
||||
Nothing -> case lookup usersTable db of
|
||||
@@ -482,28 +532,29 @@ memoryAccounts db stamp req = do
|
||||
ReqAccountCreate name _ -> Just name
|
||||
ReqAccountReset name _ -> Just name
|
||||
ReqAccountDrop name -> Just name
|
||||
ReqIdentityAlter name _ Nothing _ Nothing -> Just name
|
||||
ReqIdentityAlter name _ Nothing _ Nothing Nothing -> Just name
|
||||
_ -> Nothing
|
||||
allowed = case command of ReqAccountsList -> True; ReqAccountCreate{} -> True; ReqAccountReset{} -> True; ReqAccountDrop{} -> True; ReqIdentityAlter _ _ Nothing _ Nothing -> True; _ -> False
|
||||
if not allowed || any (\a -> target == Just (accountUser a) && (accountIsSuperuser a || accountSystemCatalogManager a)) accounts
|
||||
allowed = case command of ReqAccountsList -> True; ReqAccountCreate{} -> True; ReqAccountReset{} -> True; ReqAccountDrop{} -> True; ReqIdentityAlter _ _ Nothing _ Nothing Nothing -> True; _ -> False
|
||||
if not allowed || any (\a -> target == Just (accountUser a) && (accountIsSuperuser a || accountSystemCatalogManager a || accountAllowSudoAuth a)) accounts
|
||||
then Left "superuser required to manage privileged identities" else memoryAccounts db stamp command
|
||||
ReqAccountsList -> Right accounts
|
||||
ReqIdentityInitialize admin
|
||||
| any (`elem` map accountUser accounts) legacyNames || length (nub legacyNames) /= length legacyNames -> Left "identity name collision"
|
||||
| otherwise -> Right ([if legacyIdentity a && accountUser a == T.toLower admin then a{accountIsSuperuser = True} else a | a <- accounts] ++
|
||||
[Account (highWater + offset) role "" 1 stamp Nothing False False True False | (offset, role) <- zip [1..] legacyNames])
|
||||
[Account (highWater + offset) role "" 1 stamp Nothing False False True False False | (offset, role) <- zip [1..] legacyNames])
|
||||
ReqRoleCreate u
|
||||
| any ((== T.toLower u) . accountUser) accounts -> Left "identity already exists"
|
||||
| otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) "" 1 stamp Nothing False False True False])
|
||||
ReqIdentityAlter u login super enabled manager -> case filter ((== T.toLower u) . accountUser) accounts of
|
||||
| otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) "" 1 stamp Nothing False False True False False])
|
||||
ReqIdentityAlter u login super enabled manager sudo -> case filter ((== T.toLower u) . accountUser) accounts of
|
||||
[_] -> preserveSuper [if accountUser a == T.toLower u then a{accountCanLogin = maybe (accountCanLogin a) id login,
|
||||
accountIsSuperuser = maybe (accountIsSuperuser a) id super, accountEnabled = maybe (accountEnabled a) id enabled,
|
||||
accountSystemCatalogManager = maybe (accountSystemCatalogManager a) id manager,
|
||||
accountAllowSudoAuth = maybe (accountAllowSudoAuth a) id sudo,
|
||||
accountRevision = accountRevision a + 1} else a | a <- accounts] accounts
|
||||
_ -> Left "unknown account"
|
||||
ReqAccountCreate u h
|
||||
| any ((== T.toLower u) . accountUser) accounts -> Left "account already exists"
|
||||
| otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) h 1 stamp Nothing True False True False])
|
||||
| otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) h 1 stamp Nothing True False True False False])
|
||||
ReqAccountReset u h -> case filter ((== T.toLower u) . accountUser) accounts of
|
||||
[_] -> Right [if accountUser x == T.toLower u then x{accountHash = h, accountRevision = accountRevision x + 1} else x | x <- accounts]
|
||||
_ -> Left "unknown account"
|
||||
|
||||
@@ -25,7 +25,7 @@ module ChuSQL.Server.Catalog
|
||||
|
||||
import ChuSQL.Core.Model (Row, Value (..))
|
||||
import ChuSQL.Core.Protocol (Account (..), Request (..))
|
||||
import ChuSQL.Interface.Actions (sqlLiteral)
|
||||
import ChuSQL.Interface.Actions (escapeStringLiteral)
|
||||
import ChuSQL.Interface.Protocol (Grant (..))
|
||||
import ChuSQL.Server.Backend (Backend (..), StatementResult (..), grantsTable, membersTable, optionsTable, rolesTable)
|
||||
import Control.Concurrent.MVar (MVar, newMVar, withMVar)
|
||||
@@ -213,4 +213,4 @@ roleLiteral = literal . normalizeRole
|
||||
|
||||
-- | 文本值的 SQL 字面量
|
||||
literal :: Text -> String
|
||||
literal = sqlLiteral . VStr . T.unpack
|
||||
literal text = "'" ++ escapeStringLiteral (T.unpack text) ++ "'"
|
||||
@@ -0,0 +1,410 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ChuSQL.Server.ObjectACL
|
||||
( objectAuthorize, objectGrant, objectRevoke, objectViews, objectClaim
|
||||
, objectReconcile, objectAffected, objectOwner, objectConnect, objectPrepareCreate, objectUsers
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Protocol (Account (..), TableInfo (..))
|
||||
import ChuSQL.Interface.Protocol (Grant (..))
|
||||
import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalName)
|
||||
import ChuSQL.Server.Backend (Backend (..))
|
||||
import ChuSQL.Server.Catalog (Catalog, readIdentities, readMembers, readGrants, readGrantOptions)
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.Key as K
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.ByteString.Lazy.Char8 as BL
|
||||
import Data.List (nub)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
-- 稳定对象权限目录:保存所有者、授予来源并计算有效授权链。
|
||||
|
||||
data Target = Target { targetDatabase :: Text, targetTable :: Maybe Text, targetKind :: Text, targetName :: Text }
|
||||
deriving (Eq, Show, Generic)
|
||||
instance ToJSON Target
|
||||
instance FromJSON Target
|
||||
|
||||
data Edge = Edge { edgeRole :: Text, edgeGrantor :: Text, edgeTarget :: Target, edgePrivilege :: Text, edgeOption :: Bool, edgeRoot :: Bool }
|
||||
deriving (Eq, Show, Generic)
|
||||
instance ToJSON Edge
|
||||
instance FromJSON Edge
|
||||
|
||||
data Owner = Owner { ownerRole :: Text, ownerTarget :: Target }
|
||||
deriving (Eq, Show, Generic)
|
||||
instance ToJSON Owner
|
||||
instance FromJSON Owner
|
||||
|
||||
data Pending = Pending { pendingRole :: Text, pendingDatabase :: Text, pendingName :: Text }
|
||||
deriving (Eq, Show, Generic)
|
||||
instance ToJSON Pending
|
||||
instance FromJSON Pending
|
||||
|
||||
data ACL = ACL { aclVersion :: Int, aclEdges :: [Edge], aclOwners :: [Owner], aclClosed :: [Text], aclPending :: [Pending] }
|
||||
deriving (Eq, Show, Generic)
|
||||
instance ToJSON ACL
|
||||
instance FromJSON ACL where
|
||||
-- 读取权限快照并兼容无声明的旧记录。
|
||||
parseJSON = A.withObject "ACL" $ \fields -> ACL <$> fields A..: "aclVersion" <*> fields A..: "aclEdges"
|
||||
<*> fields A..: "aclOwners" <*> fields A..: "aclClosed" <*> (fields A..:? "aclPending" A..!= [])
|
||||
|
||||
data Context = Context { contextIdentities :: [Account], contextMembers :: [(Text, Text)], contextTargets :: [Target] }
|
||||
|
||||
-- 解析存储响应并保留明确错误。
|
||||
request :: Backend -> A.Value -> IO (Either String A.Value)
|
||||
request backend payload = fmap (>>= response) (beStorage backend payload)
|
||||
where
|
||||
-- 检查响应状态。
|
||||
response value@(A.Object fields) = case KM.lookup "status" fields of
|
||||
Just (A.String "error") -> case KM.lookup "message" fields of Just (A.String message) -> Left (T.unpack message); _ -> Left "invalid storage error"
|
||||
Just (A.String _) -> Right value
|
||||
_ -> Left "invalid storage response"
|
||||
response _ = Left "invalid storage response"
|
||||
|
||||
-- 从响应取必需字段。
|
||||
field :: Text -> A.Value -> Either String A.Value
|
||||
field name (A.Object fields) = maybe (Left ("missing field: " ++ T.unpack name)) Right (KM.lookup (K.fromText name) fields)
|
||||
field _ _ = Left "invalid storage object"
|
||||
|
||||
-- 将存储编号规范为文本。
|
||||
identifier :: A.Value -> Either String Text
|
||||
identifier (A.Number number) | number > 0 = Right (T.pack (BL.unpack (A.encode (A.Number number))))
|
||||
identifier _ = Left "invalid object identifier"
|
||||
|
||||
-- 按 catalog 解析数据库或表对象。
|
||||
resolve :: Backend -> Text -> Text -> IO (Either String Target)
|
||||
resolve backend database raw = do
|
||||
let object = T.toLower (T.strip raw)
|
||||
(selected, table, kind, label) =
|
||||
if "database:" `T.isPrefixOf` object then (T.drop 9 object, Nothing, "database", object)
|
||||
else if object == "*" || ".*" `T.isSuffixOf` object then
|
||||
let scope = if object == "*" then database else T.dropEnd 2 object
|
||||
in (scope, Nothing, "tables", scope <> ".*")
|
||||
else case T.splitOn "." object of
|
||||
[name] -> (database, Just name, "table", database <> "." <> name)
|
||||
[db, name] -> (db, Just name, "table", object)
|
||||
_ -> ("", Just "", "table", object)
|
||||
if T.null selected then pure (Left "no database selected") else do
|
||||
result <- request backend (A.object (["method" A..= ("resolve_object" :: Text), "database" A..= selected] ++ maybe [] (\name -> ["table" A..= name]) table))
|
||||
pure $ do
|
||||
value <- result
|
||||
dbId <- field "database_id" value >>= identifier
|
||||
tableId <- case table of Nothing -> Right Nothing; Just _ -> Just <$> (field "object_id" value >>= identifier)
|
||||
if selected == "system" then Left "system objects cannot be granted" else Right (Target dbId tableId kind label)
|
||||
|
||||
-- 展开当前 catalog 中的稳定业务对象。
|
||||
targets :: Backend -> IO (Either String [Target])
|
||||
targets backend = do
|
||||
names <- beDatabases backend
|
||||
case names of
|
||||
Left err -> pure (Left err)
|
||||
Right databases -> fmap (fmap concat . sequence) $ mapM one (filter (/= "system") databases)
|
||||
where
|
||||
-- 展开一个数据库和它的表。
|
||||
one name = do
|
||||
database <- resolve backend "" ("database:" <> T.pack name)
|
||||
catalog <- beCatalog (beWithDatabase backend name)
|
||||
case catalog of
|
||||
Left err -> pure (Left err)
|
||||
Right infos -> do
|
||||
tables <- mapM (resolve backend (T.pack name) . T.pack . tableNameOf) infos
|
||||
pure ((:) <$> database <*> sequence tables)
|
||||
-- 取数据字典的表名。
|
||||
tableNameOf = tiTable
|
||||
|
||||
-- 读取身份、成员边和对象字典。
|
||||
context :: Backend -> Catalog -> IO (Either String Context)
|
||||
context backend catalog = do
|
||||
identities <- readIdentities catalog
|
||||
members <- readMembers catalog
|
||||
objects <- targets backend
|
||||
pure (Context <$> identities <*> members <*> objects)
|
||||
|
||||
-- 查找身份的稳定编号。
|
||||
roleId :: Context -> Text -> Either String Text
|
||||
roleId env name = case [T.pack (show (accountId account)) | account <- contextIdentities env, accountUser account == T.toLower name] of
|
||||
[value] -> Right value
|
||||
[] | T.toLower (T.strip name) == "public" -> Right "public"
|
||||
_ -> Left ("unknown role: " ++ T.unpack name)
|
||||
|
||||
-- 从编号查回公开身份名。
|
||||
roleName :: Context -> Text -> Text
|
||||
roleName _ "public" = "public"
|
||||
roleName env value = case [accountUser account | account <- contextIdentities env, T.pack (show (accountId account)) == value] of name : _ -> name; [] -> ""
|
||||
|
||||
-- 判断身份当前是否贡献权限。
|
||||
active :: Context -> Text -> Bool
|
||||
active _ "0" = True
|
||||
active _ "public" = True
|
||||
active env value = any (\account -> T.pack (show (accountId account)) == value && accountEnabled account) (contextIdentities env)
|
||||
|
||||
-- 判断稳定身份是否仍存在。
|
||||
knownRole :: Context -> Text -> Bool
|
||||
knownRole env value = value `elem` ["0", "public"] || any (\account -> T.pack (show (accountId account)) == value) (contextIdentities env)
|
||||
|
||||
-- 展开一个身份继承的有效角色编号。
|
||||
roles :: Context -> Text -> [Text]
|
||||
roles env value = nub ("public" : go [value])
|
||||
where
|
||||
pairs = [(parent, child) | (parentName, childName) <- contextMembers env, Right parent <- [roleId env parentName], Right child <- [roleId env childName], active env parent, active env child]
|
||||
-- 展开成员关系的向上闭包。
|
||||
go known = let more = [parent | (parent, child) <- pairs, child `elem` known, parent `notElem` known]
|
||||
in if null more then known else go (nub (known ++ more))
|
||||
|
||||
-- 判断一个对象范围是否覆盖目标。
|
||||
covers :: Target -> Target -> Bool
|
||||
covers source target = targetDatabase source == targetDatabase target &&
|
||||
(targetKind source == "tables" && targetKind target `elem` ["tables", "table"] || targetKind source == targetKind target && targetTable source == targetTable target)
|
||||
|
||||
-- 判断稳定对象当前是否存在。
|
||||
exists :: Context -> Target -> Bool
|
||||
exists env target = any same (contextTargets env)
|
||||
where
|
||||
-- 核对数据库或表的稳定编号。
|
||||
same current = targetDatabase current == targetDatabase target &&
|
||||
(targetKind target == "tables" && targetKind current == "database" || targetKind current == targetKind target && targetTable current == targetTable target)
|
||||
|
||||
-- 判断身份是否拥有指定对象。
|
||||
owns :: Context -> ACL -> Text -> Target -> Bool
|
||||
owns env acl identity target = any (\owner -> ownerRole owner `elem` roles env identity && ownerTarget owner == target && active env (ownerRole owner)) (aclOwners acl)
|
||||
|
||||
-- 计算仍有合法授予来源的授权闭包。
|
||||
effective :: Context -> ACL -> ACL
|
||||
effective env acl = acl {aclOwners = owners, aclEdges = grow roots, aclClosed = [value | value <- aclClosed acl, any (\target -> targetKind target == "database" && targetDatabase target == value) (contextTargets env)]}
|
||||
where
|
||||
owners = [owner | owner <- aclOwners acl, knownRole env (ownerRole owner), exists env (ownerTarget owner)]
|
||||
candidates = [edge | edge <- aclEdges acl, knownRole env (edgeRole edge), knownRole env (edgeGrantor edge), exists env (edgeTarget edge)]
|
||||
roots = [edge | edge <- candidates, edgeRoot edge]
|
||||
-- 从独立授予根展开转授权链。
|
||||
grow known = let more = [edge | edge <- candidates, edge `notElem` known, supported known edge]
|
||||
in if null more then known else grow (known ++ more)
|
||||
-- 检查授予者的所有权或有效转授权。
|
||||
supported known edge = active env (edgeGrantor edge) && (owns env acl{aclOwners = owners} (edgeGrantor edge) (edgeTarget edge) || any (\source -> active env (edgeRole source) && edgeOption source && edgeRole source `elem` roles env (edgeGrantor edge) && edgePrivilege source == edgePrivilege edge && covers (edgeTarget source) (edgeTarget edge)) known)
|
||||
|
||||
-- 读取并校验权限快照。
|
||||
readACL :: Backend -> IO (Either String (Maybe Text, Maybe ACL))
|
||||
readACL backend = do
|
||||
result <- request backend (A.object ["method" A..= ("object_acl_read" :: Text)])
|
||||
pure $ do
|
||||
value <- result
|
||||
rows <- field "rows" value
|
||||
case rows of
|
||||
A.Array values -> case foldr (:) [] values of
|
||||
[] -> Right (Nothing, Nothing)
|
||||
[row] -> do
|
||||
payload <- field "payload" row
|
||||
case payload of
|
||||
A.String text -> case A.eitherDecodeStrict (TE.encodeUtf8 text) of
|
||||
Left err -> Left ("invalid object ACL: " ++ err)
|
||||
Right acl | aclVersion acl == 1 -> Right (Just text, Just acl)
|
||||
Right _ -> Left "unsupported object ACL version"
|
||||
_ -> Left "invalid object ACL payload"
|
||||
_ -> Left "invalid object ACL rows"
|
||||
_ -> Left "invalid object ACL rows"
|
||||
|
||||
-- 原子写入权限快照并检查并发版本。
|
||||
writeACL :: Backend -> Maybe Text -> ACL -> IO (Either String ())
|
||||
writeACL backend expected acl = fmap (fmap (const ())) $ request backend (A.object ["method" A..= ("object_acl_replace" :: Text), "expected" A..= expected, "payload" A..= TE.decodeUtf8 (BL.toStrict (A.encode acl))])
|
||||
|
||||
-- 将旧名称授权一次性绑定到现存对象。
|
||||
migrate :: Backend -> Catalog -> Context -> IO (Either String ACL)
|
||||
migrate backend catalog env = do
|
||||
grants <- readGrants catalog
|
||||
options <- readGrantOptions catalog
|
||||
case (,) <$> grants <*> options of
|
||||
Left err -> pure (Left err)
|
||||
Right (rows, optionRows) -> fmap (fmap (\edges -> ACL 1 (concat edges) [] [] []) . sequence) (mapM (one optionRows) rows)
|
||||
where
|
||||
-- 转换一条旧授权记录。
|
||||
one options grant = case roleId env (grantRole grant) of
|
||||
Left _ -> pure (Right [])
|
||||
Right identity -> do
|
||||
objects <- if grantObject grant == "*" then pure (Right [target | target <- contextTargets env, targetKind target == "table"])
|
||||
else fmap (fmap (: [])) (resolve backend "" (grantObject grant))
|
||||
let option = any (\row -> grantRole row == grantRole grant && grantPrivilege row == grantPrivilege grant && grantObject row == grantObject grant) options
|
||||
pure $ case objects of
|
||||
Left "unknown table" -> Right []
|
||||
Left "unknown database" -> Right []
|
||||
Left err -> Left err
|
||||
Right found -> Right [Edge identity "0" target (grantPrivilege grant) option True | target <- found]
|
||||
|
||||
-- 取得迁移完成且来源有效的权限快照。
|
||||
load :: Backend -> Catalog -> IO (Either String (Context, Maybe Text, ACL))
|
||||
load backend catalog = do
|
||||
env <- context backend catalog
|
||||
stored <- readACL backend
|
||||
case (,) <$> env <*> stored of
|
||||
Left err -> pure (Left err)
|
||||
Right (current, (previous, Just acl)) | null (aclPending acl) -> pure (Right (current, previous, effective current acl))
|
||||
Right (current, (previous, Just acl)) -> do
|
||||
let recovered = [Owner (pendingRole pending) target | pending <- aclPending acl, target <- contextTargets current,
|
||||
targetKind target == "table", targetDatabase target == pendingDatabase pending, targetName target == pendingName pending]
|
||||
next = acl{aclPending = [], aclOwners = recovered ++ [owner | owner <- aclOwners acl, ownerTarget owner `notElem` map ownerTarget recovered]}
|
||||
written <- writeACL backend previous (effective current next)
|
||||
case written of Left err -> pure (Left err); Right () -> load backend catalog
|
||||
Right (current, (previous, Nothing)) -> do
|
||||
migrated <- migrate backend catalog current
|
||||
case migrated of
|
||||
Left err -> pure (Left err)
|
||||
Right acl -> do
|
||||
written <- writeACL backend previous acl
|
||||
case written of
|
||||
Left "object ACL changed concurrently" -> load backend catalog
|
||||
Left err -> pure (Left err)
|
||||
Right () -> load backend catalog
|
||||
|
||||
-- 检查作用域权限或所有权。
|
||||
allowed :: Context -> ACL -> Text -> Target -> Text -> Bool -> Bool
|
||||
allowed env acl identity target privilege option = owns env acl identity target ||
|
||||
(not option && privilege == "connect" && targetKind target == "database" && targetDatabase target `notElem` aclClosed acl) ||
|
||||
any (\edge -> active env (edgeRole edge) && edgeRole edge `elem` roles env identity && edgePrivilege edge == privilege && covers (edgeTarget edge) target && (not option || edgeOption edge)) (aclEdges acl)
|
||||
|
||||
-- 按对象类型展开和校验权限名称。
|
||||
privileges :: Target -> [Text] -> Either String [Text]
|
||||
privileges target names =
|
||||
if all (`elem` supported) expanded then Right expanded else Left "invalid privilege for object scope"
|
||||
where
|
||||
supported = if targetKind target == "database" then ["connect", "create"] else ["select", "insert", "update", "delete"]
|
||||
expanded = nub (concatMap (\name -> if name == "all" then supported else [name]) (map T.toLower names))
|
||||
|
||||
-- 检查一组稳定对象上的业务权限。
|
||||
objectAuthorize :: Backend -> Catalog -> Principal -> Text -> [(Text, Text)] -> IO (Either String ())
|
||||
objectAuthorize backend catalog principal database needed = do
|
||||
loaded <- load backend catalog
|
||||
objects <- mapM (resolve backend database . fst) needed
|
||||
pure $ do
|
||||
(env, _, acl) <- loaded
|
||||
found <- sequence objects
|
||||
identity <- roleId env (principalName principal)
|
||||
if active env identity then Right () else Left "permission denied: disabled identity"
|
||||
case [(name, privilege) | ((name, privilege), target) <- zip needed found, not (allowed env acl identity target privilege False)] of
|
||||
[] -> Right ()
|
||||
(name, privilege) : _ -> Left ("permission denied: " ++ T.unpack (T.toUpper privilege <> " ON " <> name))
|
||||
|
||||
-- 检查数据库连接权限。
|
||||
objectConnect :: Backend -> Catalog -> Principal -> Text -> IO (Either String ())
|
||||
objectConnect backend catalog principal database = objectAuthorize backend catalog principal "" [("database:" <> database, "connect")]
|
||||
|
||||
-- 授予权限并记录授予者的稳定身份。
|
||||
objectGrant :: Backend -> Catalog -> Principal -> Text -> [Text] -> Text -> Text -> Bool -> IO (Either String ())
|
||||
objectGrant backend catalog principal database names object role option = do
|
||||
loaded <- load backend catalog
|
||||
resolved <- resolve backend database object
|
||||
case (,) <$> loaded <*> resolved of
|
||||
Left err -> pure (Left err)
|
||||
Right ((env, previous, acl), target) -> case do
|
||||
recipient <- roleId env role
|
||||
items <- privileges target names
|
||||
grantor <- if principalIsRoot principal then Right (either (const "0") id (roleId env (principalName principal))) else roleId env (principalName principal)
|
||||
case [item | item <- items, not (principalIsRoot principal), not (allowed env acl grantor target item True)] of
|
||||
item : _ -> Left ("grant option required: " ++ T.unpack (T.toUpper item <> " ON " <> object))
|
||||
[] -> Right (recipient, grantor, items) of
|
||||
Left err -> pure (Left err)
|
||||
Right (recipient, grantor, items) -> do
|
||||
let edges = [Edge recipient grantor target item option (principalIsRoot principal) | item <- items]
|
||||
remaining = [edge | edge <- aclEdges acl, not (any (same edge) edges)]
|
||||
promoted = [edge {edgeOption = edgeOption edge || any (\old -> same old edge && edgeOption old) (aclEdges acl)} | edge <- edges]
|
||||
writeACL backend previous acl{aclEdges = remaining ++ promoted, aclClosed = if recipient == "public" && "connect" `elem` items then filter (/= targetDatabase target) (aclClosed acl) else aclClosed acl}
|
||||
where
|
||||
-- 比较同一授予来源的授权键。
|
||||
same one other = edgeRole one == edgeRole other && edgeGrantor one == edgeGrantor other && edgeTarget one == edgeTarget other && edgePrivilege one == edgePrivilege other
|
||||
|
||||
-- 撤销授权并收敛失去来源的下游授权。
|
||||
objectRevoke :: Backend -> Catalog -> Principal -> Text -> [Text] -> Text -> Text -> IO (Either String ())
|
||||
objectRevoke backend catalog principal database names object role = do
|
||||
loaded <- load backend catalog
|
||||
resolved <- resolve backend database object
|
||||
case (,) <$> loaded <*> resolved of
|
||||
Left err -> pure (Left err)
|
||||
Right ((env, previous, acl), target) -> case (,) <$> roleId env role <*> privileges target names of
|
||||
Left err -> pure (Left err)
|
||||
Right (recipient, items) -> do
|
||||
let grantor = either (const "") id (roleId env (principalName principal))
|
||||
manager = principalIsRoot principal || owns env acl grantor target
|
||||
-- 选择本次可撤销的授予来源。
|
||||
matches edge = edgeRole edge == recipient && edgeTarget edge == target && edgePrivilege edge `elem` items && (manager || edgeGrantor edge == grantor)
|
||||
next = acl{aclEdges = filter (not . matches) (aclEdges acl), aclClosed = if recipient == "public" && "connect" `elem` items then nub (targetDatabase target : aclClosed acl) else aclClosed acl}
|
||||
if recipient == "public" && "connect" `elem` items && not manager then pure (Left "administrator required")
|
||||
else writeACL backend previous (effective env next)
|
||||
|
||||
-- 返回公开名称形式的有效授权。
|
||||
objectViews :: Backend -> Catalog -> Text -> IO (Either String [Grant])
|
||||
objectViews backend catalog role = do
|
||||
loaded <- load backend catalog
|
||||
pure $ do
|
||||
(env, _, acl) <- loaded
|
||||
identity <- roleId env role
|
||||
let mine = [edge | edge <- aclEdges acl, edgeRole edge == identity]
|
||||
Right (nub [Grant role (edgePrivilege edge) (targetName (edgeTarget edge)) (any (\other -> edgeTarget other == edgeTarget edge && edgePrivilege other == edgePrivilege edge && edgeOption other) mine) | edge <- mine])
|
||||
|
||||
-- 登记新对象的创建者为所有者。
|
||||
objectClaim :: Backend -> Catalog -> Principal -> Text -> Text -> IO (Either String ())
|
||||
objectClaim backend catalog principal database object = do
|
||||
loaded <- load backend catalog
|
||||
resolved <- resolve backend database object
|
||||
case (,) <$> loaded <*> resolved of
|
||||
Left err -> pure (Left err)
|
||||
Right ((env, previous, acl), target) -> case roleId env (principalName principal) of
|
||||
Left err -> pure (Left err)
|
||||
Right identity -> writeACL backend previous acl{aclOwners = Owner identity target : filter ((/= target) . ownerTarget) (aclOwners acl)}
|
||||
|
||||
-- 在建表前持久化创建者声明。
|
||||
objectPrepareCreate :: Backend -> Catalog -> Principal -> Text -> Text -> IO (Either String ())
|
||||
objectPrepareCreate backend catalog principal database raw = do
|
||||
loaded <- load backend catalog
|
||||
parent <- resolve backend "" ("database:" <> database)
|
||||
case (,) <$> loaded <*> parent of
|
||||
Left err -> pure (Left err)
|
||||
Right ((env, previous, acl), target) -> case roleId env (principalName principal) of
|
||||
Left err -> pure (Left err)
|
||||
Right identity -> do
|
||||
let name = if "." `T.isInfixOf` raw then T.toLower raw else database <> "." <> T.toLower raw
|
||||
if any ((== name) . targetName) (contextTargets env) then pure (Right ())
|
||||
else writeACL backend previous acl{aclPending = [Pending identity (targetDatabase target) name]}
|
||||
|
||||
-- 清理失效身份、成员来源和已删除对象。
|
||||
objectReconcile :: Backend -> Catalog -> IO (Either String ())
|
||||
objectReconcile backend catalog = do
|
||||
loaded <- load backend catalog
|
||||
case loaded of Left err -> pure (Left err); Right (_, previous, acl) -> writeACL backend previous acl
|
||||
|
||||
-- 列出对象权限变更需失效的身份。
|
||||
objectAffected :: Backend -> Catalog -> [Text] -> IO (Either String [Text])
|
||||
objectAffected backend catalog names = do
|
||||
loaded <- load backend catalog
|
||||
pure $ do
|
||||
(env, _, acl) <- loaded
|
||||
let edges = [(roleName env (edgeGrantor edge), roleName env (edgeRole edge)) | edge <- aclEdges acl] ++ contextMembers env
|
||||
-- 展开成员和转授权的受影响身份。
|
||||
walk seen = let more = [child | (parent, child) <- edges, parent `elem` seen, child `notElem` seen, not (T.null child)]
|
||||
in if null more then seen else walk (nub (seen ++ more))
|
||||
let normalized = map (T.toLower . T.strip) names
|
||||
Right (if "public" `elem` normalized then nub (walk normalized ++ map accountUser (filter (not . accountIsSuperuser) (contextIdentities env))) else walk normalized)
|
||||
|
||||
-- 检查稳定对象的所有者权限。
|
||||
objectOwner :: Backend -> Catalog -> Principal -> Text -> Text -> IO (Either String ())
|
||||
objectOwner backend catalog principal database object = do
|
||||
loaded <- load backend catalog
|
||||
resolved <- resolve backend database object
|
||||
pure $ do
|
||||
(env, _, acl) <- loaded
|
||||
target <- resolved
|
||||
identity <- roleId env (principalName principal)
|
||||
if owns env acl identity target then Right () else Left "object owner required"
|
||||
|
||||
-- 展开删除对象时需失效的授权身份。
|
||||
objectUsers :: Backend -> Catalog -> Text -> Text -> IO (Either String [Text])
|
||||
objectUsers backend catalog database object = do
|
||||
loaded <- load backend catalog
|
||||
resolved <- resolve backend database object
|
||||
case (,) <$> loaded <*> resolved of
|
||||
Left err -> pure (Left err)
|
||||
Right ((env, _, acl), target) -> do
|
||||
let related = [edgeRole edge | edge <- aclEdges acl, if targetKind target == "database" then targetDatabase (edgeTarget edge) == targetDatabase target else covers (edgeTarget edge) target]
|
||||
++ [ownerRole owner | owner <- aclOwners acl, ownerTarget owner == target]
|
||||
result <- objectAffected backend catalog (nub (map (roleName env) related))
|
||||
pure (fmap (filter (\name -> not (any (\account -> accountUser account == name && accountIsSuperuser account) (contextIdentities env)))) result)
|
||||
@@ -1,445 +1,233 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ChuSQL.Server.Privileges (
|
||||
Grant (..),
|
||||
Membership (..),
|
||||
PrivilegeCommand (..),
|
||||
PrivilegeError (..),
|
||||
Privileges,
|
||||
RoleView (..),
|
||||
affectedAccounts,
|
||||
authorize,
|
||||
authorizeTables,
|
||||
filterTables,
|
||||
listRoleViews,
|
||||
newPrivileges,
|
||||
normalizeObject,
|
||||
privilegeCommand,
|
||||
runPrivilegeCommand,
|
||||
module ChuSQL.Server.Privileges
|
||||
( Grant (..), Membership (..), PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView (..)
|
||||
, affectedAccounts, authorize, authorizeTables, authorizeConnect, filterTables, listRoleViews
|
||||
, newPrivileges, normalizeObject, privilegeCommand, runPrivilegeCommand, claimObject, prepareObject, reconcileObjects, affectedObject
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Engine.Syntax.AST
|
||||
import ChuSQL.Core.Protocol (Account (..))
|
||||
import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalIsCatalogManager, principalName)
|
||||
import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
|
||||
import ChuSQL.Server.Backend (
|
||||
Backend (..),
|
||||
exprTables,
|
||||
systemDatabaseName,
|
||||
tableRefsOf,
|
||||
)
|
||||
import ChuSQL.Server.Catalog (
|
||||
Catalog,
|
||||
addGrant,
|
||||
addGrantOption,
|
||||
addMember,
|
||||
dropRole,
|
||||
eachAction,
|
||||
insertRole,
|
||||
newCatalog,
|
||||
normalizeObject,
|
||||
normalizeRole,
|
||||
normalizeUser,
|
||||
readGrantOptions,
|
||||
readGrants,
|
||||
readMembers,
|
||||
readRoleNames,
|
||||
readIdentities,
|
||||
removeGrant,
|
||||
removeGrantOption,
|
||||
removeMember,
|
||||
withCatalogLock,
|
||||
ensureCatalog,
|
||||
)
|
||||
import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalIsCatalogManager)
|
||||
import ChuSQL.Server.Backend (Backend (..), exprTables, tableRefsOf, systemDatabaseName)
|
||||
import ChuSQL.Server.Catalog
|
||||
import qualified ChuSQL.Server.ObjectACL as OA
|
||||
import Data.List (nub, sort)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
-- 角色与权限服务:角色、授权与成员关系落在 system 库的表里,并据此判权限。
|
||||
-- 权限服务:稳定对象授权、角色继承与受影响会话展开。
|
||||
|
||||
-- | 出错口径与账号服务一致
|
||||
data PrivilegeError = PrivilegeError Text Text
|
||||
deriving (Show, Eq)
|
||||
data PrivilegeError = PrivilegeError Text Text deriving (Show, Eq)
|
||||
data Membership = Membership { memberRole :: Text, memberUser :: Text } deriving (Show, Eq, Ord)
|
||||
data PrivilegeCommand = CreateRoleCommand Text | DropRoleCommand Text
|
||||
| GrantPrivilegesCommand [Text] Text Text Bool | RevokePrivilegesCommand [Text] Text Text
|
||||
| GrantRoleCommand Text [Text] | RevokeRoleCommand Text [Text] deriving (Show, Eq)
|
||||
data Privileges = Privileges { pvCatalog :: Catalog, pvBackend :: Backend }
|
||||
|
||||
-- 一条角色授权(定义在共享协议层)
|
||||
-- | 角色成员资格
|
||||
data Membership = Membership
|
||||
{ memberRole :: Text
|
||||
, memberUser :: Text
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- | 一个角色的全貌:授权与成员
|
||||
|
||||
data PrivilegeCommand
|
||||
= CreateRoleCommand Text
|
||||
| DropRoleCommand Text
|
||||
| GrantPrivilegesCommand [Text] Text Text Bool
|
||||
| RevokePrivilegesCommand [Text] Text Text
|
||||
| GrantRoleCommand Text [Text]
|
||||
| RevokeRoleCommand Text [Text]
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Privileges = Privileges
|
||||
{ pvCatalog :: Catalog
|
||||
}
|
||||
|
||||
-- | 建权限服务,固定在 system 库上
|
||||
-- 创建权限目录服务。
|
||||
newPrivileges :: Backend -> IO Privileges
|
||||
newPrivileges base = Privileges <$> newCatalog (beWithDatabase base systemDatabaseName)
|
||||
newPrivileges backend = do
|
||||
directory <- newCatalog (beWithDatabase backend systemDatabaseName)
|
||||
pure (Privileges directory backend)
|
||||
|
||||
-- | 语句转管理命令,不认的给 Nothing
|
||||
-- 将管理语句转换为权限命令。
|
||||
privilegeCommand :: Statement -> Maybe PrivilegeCommand
|
||||
privilegeCommand stmt = case stmt of
|
||||
privilegeCommand statement = case statement of
|
||||
CreateRole name -> Just (CreateRoleCommand (T.pack name))
|
||||
DropRole name -> Just (DropRoleCommand (T.pack name))
|
||||
GrantPrivileges privs obj role withOption ->
|
||||
Just (GrantPrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role) withOption)
|
||||
RevokePrivileges privs obj role ->
|
||||
Just (RevokePrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role))
|
||||
GrantPrivileges items object role option -> Just (GrantPrivilegesCommand (map (T.toLower . T.pack) items) (T.pack object) (T.pack role) option)
|
||||
RevokePrivileges items object role -> Just (RevokePrivilegesCommand (map (T.toLower . T.pack) items) (T.pack object) (T.pack role))
|
||||
GrantRole role members -> Just (GrantRoleCommand (T.pack role) (map T.pack members))
|
||||
RevokeRole role members -> Just (RevokeRoleCommand (T.pack role) (map T.pack members))
|
||||
_ -> Nothing
|
||||
|
||||
-- | 执行管理命令:管理员全通,普通身份只能转授自己拿到的权限
|
||||
-- 执行角色管理或有来源记录的对象授权。
|
||||
runPrivilegeCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
|
||||
runPrivilegeCommand service principal database command
|
||||
| needsDatabase = pure (Left (PrivilegeError "no_database" "no database selected"))
|
||||
| principalIsRoot principal = withTables service (applyCommand service database command)
|
||||
| principalIsCatalogManager principal = case command of
|
||||
CreateRoleCommand{} -> withTables service (applyCommand service database command)
|
||||
DropRoleCommand{} -> pure (Left forbidden)
|
||||
_ -> withTables service (delegateCommand service principal database command)
|
||||
| otherwise = withTables service (delegateCommand service principal database command)
|
||||
where
|
||||
-- | 授权到具体对象时需要先选库
|
||||
needsDatabase = T.null database && case command of
|
||||
GrantPrivilegesCommand _ object _ _ -> T.strip object /= "*"
|
||||
RevokePrivilegesCommand _ object _ -> T.strip object /= "*"
|
||||
_ -> False
|
||||
|
||||
-- | 一条命令会影响的账号:角色连它的成员一起展开,账号名原样留下
|
||||
affectedAccounts :: Privileges -> PrivilegeCommand -> IO [Text]
|
||||
affectedAccounts service command = do
|
||||
known <- roleNames service
|
||||
runPrivilegeCommand service principal database command = withTables service $ case command of
|
||||
GrantPrivilegesCommand items object role option -> catalog (OA.objectGrant backend directory principal database items object role option)
|
||||
RevokePrivilegesCommand items object role -> catalog (OA.objectRevoke backend directory principal database items object role)
|
||||
CreateRoleCommand role
|
||||
| principalIsCatalogManager principal -> do
|
||||
known <- catalog (readRoleNames directory)
|
||||
case known of
|
||||
Left _ -> pure (direct command)
|
||||
Right roles -> walk roles [] (direct command)
|
||||
Left err -> pure (Left err)
|
||||
Right names | normalizeRole role `elem` names -> pure (Left (PrivilegeError "conflict" ("role already exists: " <> role)))
|
||||
| normalizeRole role == "public" -> pure (Left (PrivilegeError "bad_request" "public is reserved for default privileges"))
|
||||
| otherwise -> catalog (insertRole directory role)
|
||||
DropRoleCommand role
|
||||
| principalIsRoot principal -> after (catalog (dropRole directory role))
|
||||
GrantRoleCommand role members
|
||||
| principalIsRoot principal -> do
|
||||
known <- catalog (readRoleNames directory)
|
||||
edges <- catalog (readMembers directory)
|
||||
case (,) <$> known <*> edges of
|
||||
Left err -> pure (Left err)
|
||||
Right (names, pairs) -> case validateMembers names pairs role members of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> eachAction members $ \member -> if (normalizeRole role, normalizeUser member) `elem` pairs then pure (Right ()) else catalog (addMember directory role member)
|
||||
RevokeRoleCommand role members
|
||||
| principalIsRoot principal -> after (eachAction members (\member -> catalog (removeMember directory role member)))
|
||||
_ -> pure (Left forbidden)
|
||||
where
|
||||
-- | 命令直接点到的名字
|
||||
direct cmd = case cmd of
|
||||
backend = pvBackend service
|
||||
directory = pvCatalog service
|
||||
-- 清理成员或身份变更失效的授权链。
|
||||
after action = do
|
||||
result <- action
|
||||
case result of Left err -> pure (Left err); Right () -> catalog (OA.objectReconcile backend directory)
|
||||
|
||||
-- 在写入前校验全部成员和循环依赖。
|
||||
validateMembers :: [Text] -> [(Text, Text)] -> Text -> [Text] -> Either PrivilegeError ()
|
||||
validateMembers names pairs role members
|
||||
| parent `notElem` names = Left (PrivilegeError "not_found" ("unknown role: " <> role))
|
||||
| any ((`notElem` names) . normalizeUser) members = Left (PrivilegeError "not_found" "unknown role member")
|
||||
| otherwise = foldMembers pairs members
|
||||
where
|
||||
parent = normalizeRole role
|
||||
-- 逐项加入候选成员边并检查闭包。
|
||||
foldMembers _ [] = Right ()
|
||||
foldMembers edges (member : rest)
|
||||
| child `elem` closureUp edges [parent] = Left (PrivilegeError "conflict" ("role membership would create a cycle: " <> parent <> " and " <> child))
|
||||
| otherwise = foldMembers ((parent, child) : edges) rest
|
||||
where child = normalizeUser member
|
||||
|
||||
-- 展开角色的继承闭包。
|
||||
closureUp :: [(Text, Text)] -> [Text] -> [Text]
|
||||
closureUp edges known = let more = [parent | (parent, child) <- edges, child `elem` known, parent `notElem` known]
|
||||
in if null more then known else closureUp edges (nub (known ++ more))
|
||||
|
||||
-- 展开成员和转授权变更影响的全部身份。
|
||||
affectedAccounts :: Privileges -> PrivilegeCommand -> IO (Either PrivilegeError [Text])
|
||||
affectedAccounts service command = withTables service (catalog (OA.objectAffected (pvBackend service) (pvCatalog service) direct))
|
||||
where
|
||||
direct = case command of
|
||||
CreateRoleCommand _ -> []
|
||||
DropRoleCommand role -> [role]
|
||||
GrantPrivilegesCommand _ _ role _ -> [role]
|
||||
RevokePrivilegesCommand _ _ role -> [role]
|
||||
GrantRoleCommand _ members -> members
|
||||
RevokeRoleCommand _ members -> members
|
||||
-- | 是角色就接着往下走它的成员,走过的名字不再走第二遍
|
||||
walk _ seen [] = pure (reverse seen)
|
||||
walk roles seen (name : rest)
|
||||
| name `elem` seen = walk roles seen rest
|
||||
| normalizeRole name `elem` roles = do
|
||||
members <- membersOfRole service name
|
||||
case members of
|
||||
Left _ -> walk roles (name : seen) rest
|
||||
Right found -> walk roles (name : seen) (found ++ rest)
|
||||
| otherwise = walk roles (name : seen) rest
|
||||
|
||||
-- | 语句鉴权:管理员全通,普通身份按需查
|
||||
-- 检查 SQL 的对象作用域权限。
|
||||
authorize :: Privileges -> Principal -> Text -> Statement -> IO (Either PrivilegeError ())
|
||||
authorize service principal database stmt
|
||||
authorize service principal database statement
|
||||
| principalIsRoot principal = pure (Right ())
|
||||
| otherwise = case requiredActions stmt of
|
||||
Nothing -> pure (Left forbidden)
|
||||
Just needed -> authorizeTables service principal database needed
|
||||
| otherwise = case statement of
|
||||
CreateTable{} -> authorizeTables service principal database [("database:" <> database, "create")]
|
||||
DropDatabase name -> owner ("database:" <> T.pack name)
|
||||
DropTable name -> owner (T.pack name)
|
||||
CreateIndex name _ -> owner (T.pack name)
|
||||
DropIndex name _ -> owner (T.pack name)
|
||||
DropColumn name _ -> owner (T.pack name)
|
||||
AddColumn name _ -> owner (T.pack name)
|
||||
RenameColumn name _ _ -> owner (T.pack name)
|
||||
AlterColumnType name _ _ -> owner (T.pack name)
|
||||
AlterColumnDefault name _ _ -> owner (T.pack name)
|
||||
AlterColumnNull name _ _ -> owner (T.pack name)
|
||||
ShowDomains -> authorizeConnect service principal database
|
||||
ShowDatabases -> pure (Right ())
|
||||
_ -> case requiredActions statement of Nothing -> pure (Left forbidden); Just needed -> authorizeTables service principal database needed
|
||||
where
|
||||
-- 检查结构操作的对象所有权。
|
||||
owner object = withTables service (catalog (OA.objectOwner (pvBackend service) (pvCatalog service) principal database object))
|
||||
|
||||
-- | 直接查一组 (表, 权限):一键接口用这个
|
||||
-- 检查数据库的 CONNECT 权限。
|
||||
authorizeConnect :: Privileges -> Principal -> Text -> IO (Either PrivilegeError ())
|
||||
authorizeConnect service principal database
|
||||
| principalIsRoot principal = pure (Right ())
|
||||
| otherwise = withTables service (catalog (OA.objectConnect (pvBackend service) (pvCatalog service) principal database))
|
||||
|
||||
-- 检查 CONNECT 和表上的业务权限。
|
||||
authorizeTables :: Privileges -> Principal -> Text -> [(Text, Text)] -> IO (Either PrivilegeError ())
|
||||
authorizeTables service principal database needed
|
||||
| principalIsRoot principal = pure (Right ())
|
||||
| T.null database && any (not . T.isPrefixOf "database:" . fst) needed = pure (Left (PrivilegeError "no_database" "no database selected"))
|
||||
| otherwise = withTables service $ do
|
||||
grants <- grantsOfUser service (principalName principal)
|
||||
pure (grants >>= \found -> checkAll database found needed)
|
||||
connected <- if T.null database then pure (Right ()) else catalog (OA.objectConnect (pvBackend service) (pvCatalog service) principal database)
|
||||
case connected of Left err -> pure (Left err); Right () -> catalog (OA.objectAuthorize (pvBackend service) (pvCatalog service) principal database needed)
|
||||
|
||||
-- | 只留下用户有 SELECT 权的表
|
||||
-- 仅返回拥有 SELECT 权限的表名。
|
||||
filterTables :: Privileges -> Principal -> Text -> [Text] -> IO (Either PrivilegeError [Text])
|
||||
filterTables service principal database tables
|
||||
| principalIsRoot principal = pure (Right tables)
|
||||
| otherwise = withTables service $ do
|
||||
grants <- grantsOfUser service (principalName principal)
|
||||
pure ((\found -> [table | table <- tables, checkAll database found [(table, "select")] == Right ()]) <$> grants)
|
||||
| otherwise = do
|
||||
connected <- authorizeConnect service principal database
|
||||
case connected of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> do
|
||||
results <- mapM (\table -> authorizeTables service principal database [(table, "select")]) tables
|
||||
pure $ case [err | Left err@(PrivilegeError code _) <- results, code /= "forbidden"] of
|
||||
err : _ -> Left err
|
||||
[] -> Right [table | (table, Right ()) <- zip tables results]
|
||||
|
||||
-- | 角色总览(REST 与测试用)
|
||||
-- 返回角色的有效对象授权和直接成员。
|
||||
listRoleViews :: Privileges -> IO (Either PrivilegeError [RoleView])
|
||||
listRoleViews service = withTables service $ do
|
||||
names <- fmap (fmap (map accountUser . filter (not . accountCanLogin))) (catalog (readIdentities (pvCatalog service)))
|
||||
case names of
|
||||
names <- catalog (readIdentities (pvCatalog service))
|
||||
members <- catalog (readMembers (pvCatalog service))
|
||||
case (,) <$> names <*> members of
|
||||
Left err -> pure (Left err)
|
||||
Right known -> sequence <$> mapM view (sort known)
|
||||
Right (identities, pairs) -> fmap sequence $ mapM (view pairs) (sort (map accountUser (filter (not . accountCanLogin) identities)))
|
||||
where
|
||||
-- | 组装一个角色的总览
|
||||
view role = do
|
||||
grants <- roleGrantsOf service role
|
||||
members <- membersOfRole service role
|
||||
pure (RoleView role <$> grants <*> members)
|
||||
-- 组装一个角色的公开权限视图。
|
||||
view members name = do
|
||||
grants <- catalog (OA.objectViews (pvBackend service) (pvCatalog service) name)
|
||||
pure ((\rows -> RoleView name rows [member | (role, member) <- members, role == name]) <$> grants)
|
||||
|
||||
-- | 一条语句需要哪些 (表, 权限)
|
||||
-- 登记创建对象的所有者。
|
||||
claimObject :: Privileges -> Principal -> Text -> Text -> IO (Either PrivilegeError ())
|
||||
claimObject service principal database object = withTables service (catalog (OA.objectClaim (pvBackend service) (pvCatalog service) principal database object))
|
||||
|
||||
-- 持久化即将建表的所有者声明。
|
||||
prepareObject :: Privileges -> Principal -> Text -> Text -> IO (Either PrivilegeError ())
|
||||
prepareObject service principal database object = withTables service (catalog (OA.objectPrepareCreate (pvBackend service) (pvCatalog service) principal database object))
|
||||
|
||||
-- 获取删除对象影响的授权身份。
|
||||
affectedObject :: Privileges -> Text -> Text -> IO (Either PrivilegeError [Text])
|
||||
affectedObject service database object = withTables service (catalog (OA.objectUsers (pvBackend service) (pvCatalog service) database object))
|
||||
|
||||
-- 清理身份或对象删除后的权限记录。
|
||||
reconcileObjects :: Privileges -> IO (Either PrivilegeError ())
|
||||
reconcileObjects service = withTables service (catalog (OA.objectReconcile (pvBackend service) (pvCatalog service)))
|
||||
|
||||
-- 收集数据语句及子查询所需的表权限。
|
||||
requiredActions :: Statement -> Maybe [(Text, Text)]
|
||||
requiredActions stmt = case stmt of
|
||||
Select{} -> Just (selectNeeds (selectFrom stmt) (maybe [] (: []) (selectWhere stmt)))
|
||||
SelectExpr{} ->
|
||||
Just (selectNeeds (selectFrom stmt) (maybe [] (: []) (selectWhere stmt) ++ map snd (selectItems stmt)))
|
||||
requiredActions statement = case statement of
|
||||
Select{} -> Just (selectNeeds (selectFrom statement) (maybe [] (: []) (selectWhere statement)))
|
||||
SelectExpr{} -> Just (selectNeeds (selectFrom statement) (maybe [] (: []) (selectWhere statement) ++ map snd (selectItems statement)))
|
||||
Insert table _ rows -> Just ((T.pack table, "insert") : selectsOf (concat rows))
|
||||
Update table assigns cond -> Just ((T.pack table, "update") : selectsOf (map snd assigns ++ maybe [] (: []) cond))
|
||||
Delete table cond -> Just ((T.pack table, "delete") : selectsOf (maybe [] (: []) cond))
|
||||
Update table assignments condition -> Just ((T.pack table, "update") : selectsOf (map snd assignments ++ maybe [] (: []) condition))
|
||||
Delete table condition -> Just ((T.pack table, "delete") : selectsOf (maybe [] (: []) condition))
|
||||
_ -> Nothing
|
||||
where
|
||||
-- | FROM 子句要的 SELECT 权限
|
||||
selectNeeds source exprs = [(ref, "select") | ref <- nub (tableRefsOf source)] ++ selectsOf exprs
|
||||
-- | 表达式里子查询要的 SELECT 权限
|
||||
selectsOf exprs = [(ref, "select") | ref <- nub (concatMap exprTables exprs)]
|
||||
-- 收集来源树和表达式的读取权限。
|
||||
selectNeeds source expressions = [(ref, "select") | ref <- nub (tableRefsOf source)] ++ selectsOf expressions
|
||||
-- 收集表达式中子查询的读取权限。
|
||||
selectsOf expressions = [(ref, "select") | ref <- nub (concatMap exprTables expressions)]
|
||||
|
||||
-- | 每项 (表, 权限) 都要被某条授权覆盖
|
||||
checkAll :: Text -> [Grant] -> [(Text, Text)] -> Either PrivilegeError ()
|
||||
checkAll database grants needed = checkCovered database grants needed "permission denied: "
|
||||
|
||||
-- | 转授权要查 grant option,报错口径与普通鉴权分开
|
||||
checkOptions :: Text -> [Grant] -> [(Text, Text)] -> Either PrivilegeError ()
|
||||
checkOptions database grants needed = checkCovered database grants needed "grant option required: "
|
||||
|
||||
-- | 覆盖检查的公共实现
|
||||
checkCovered :: Text -> [Grant] -> [(Text, Text)] -> Text -> Either PrivilegeError ()
|
||||
checkCovered database grants needed prefix = case [pair | pair@(table, privilege) <- needed, not (covered table privilege)] of
|
||||
[] -> Right ()
|
||||
((table, privilege) : _) ->
|
||||
Left (PrivilegeError "forbidden" (prefix <> T.toUpper privilege <> " ON " <> table))
|
||||
where
|
||||
-- | 某一项是否被授权覆盖
|
||||
covered table privilege =
|
||||
let target = normalizeObject database table
|
||||
in any
|
||||
(\grant -> (grantObject grant == "*" || grantObject grant == target) && grantPrivilege grant == privilege)
|
||||
grants
|
||||
|
||||
-- | 一个用户实际能用的授权:含角色继承
|
||||
grantsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
|
||||
grantsOfUser service user = do
|
||||
members <- catalog (readMembers (pvCatalog service))
|
||||
grants <- catalog (readGrants (pvCatalog service))
|
||||
options <- catalog (readGrantOptions (pvCatalog service))
|
||||
roles <- catalog (readIdentities (pvCatalog service))
|
||||
pure $ do
|
||||
memberRows <- members
|
||||
grantRows <- grants
|
||||
optionRows <- options
|
||||
identities <- roles
|
||||
let known = map accountUser (filter accountEnabled identities)
|
||||
disabled = map accountUser (filter (not . accountEnabled) identities)
|
||||
activeMembers = [(role, member) | (role, member) <- memberRows, role `elem` known, member `notElem` disabled]
|
||||
edges = roleEdges activeMembers known
|
||||
mine = if normalizeUser user `elem` disabled then [] else closureUp edges
|
||||
(normalizeUser user : [role | (role, member) <- activeMembers, member == normalizeUser user])
|
||||
pure [grant | grant <- grantRows ++ optionRows, grantRole grant `elem` mine]
|
||||
|
||||
-- | 一个用户手里的 grant option,只有这些能再转授
|
||||
optionsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
|
||||
optionsOfUser service user = fmap (fmap (filter grantable)) (grantsOfUser service user)
|
||||
|
||||
-- | 角色到角色的成员边:父角色在前
|
||||
roleEdges :: [(Text, Text)] -> [Text] -> [(Text, Text)]
|
||||
roleEdges members roles = [pair | pair@(_, child) <- members, child `elem` roles]
|
||||
|
||||
-- | 向上闭包:这群角色直接或间接所属的全部角色
|
||||
closureUp :: [(Text, Text)] -> [Text] -> [Text]
|
||||
closureUp edges = go
|
||||
where
|
||||
-- | 展开一轮,没有再新增就停
|
||||
go known =
|
||||
let more = [parent | (parent, child) <- edges, child `elem` known, parent `notElem` known]
|
||||
in if null more then known else go (known ++ more)
|
||||
|
||||
-- | 一个角色挂着的授权,带 grant option 的会标出来
|
||||
roleGrantsOf :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
|
||||
roleGrantsOf service role = do
|
||||
grants <- catalog (readGrants (pvCatalog service))
|
||||
options <- catalog (readGrantOptions (pvCatalog service))
|
||||
pure (do
|
||||
rows <- grants
|
||||
optionRows <- options
|
||||
let mine = filter (\grant -> grantRole grant == normalizeRole role) rows
|
||||
pure (markOptions mine optionRows))
|
||||
|
||||
-- | 给授权标上有没有对应的 grant option
|
||||
markOptions :: [Grant] -> [Grant] -> [Grant]
|
||||
markOptions grants options = [grant {grantable = hasOption grant} | grant <- grants]
|
||||
where
|
||||
-- | 有没有一条同角色同权限同对象的 option
|
||||
hasOption grant = any (same grant) options
|
||||
-- | 两条授权指向同一处
|
||||
same one other =
|
||||
grantRole one == grantRole other
|
||||
&& grantPrivilege one == grantPrivilege other
|
||||
&& grantObject one == grantObject other
|
||||
|
||||
-- | 角色名清单(统一小写)
|
||||
roleNames :: Privileges -> IO (Either PrivilegeError [Text])
|
||||
roleNames service = catalog (readRoleNames (pvCatalog service))
|
||||
|
||||
-- | 一个角色的直接成员:用户与子角色
|
||||
membersOfRole :: Privileges -> Text -> IO (Either PrivilegeError [Text])
|
||||
membersOfRole service role = do
|
||||
members <- catalog (readMembers (pvCatalog service))
|
||||
pure (map snd . filter (\(name, _) -> name == normalizeRole role) <$> members)
|
||||
|
||||
-- | 角色必须存在,否则命令不落地
|
||||
requireRole :: Privileges -> Text -> IO (Either PrivilegeError ())
|
||||
requireRole service role = do
|
||||
known <- roleNames service
|
||||
pure $ case known of
|
||||
Left err -> Left err
|
||||
Right names
|
||||
| normalizeRole role `elem` names -> Right ()
|
||||
| otherwise -> Left (unknownRole role)
|
||||
|
||||
-- | 真正落库(表已经保证存在)
|
||||
applyCommand :: Privileges -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
|
||||
applyCommand service database command = case command of
|
||||
CreateRoleCommand role -> do
|
||||
known <- roleNames service
|
||||
case known of
|
||||
Left err -> pure (Left err)
|
||||
Right names
|
||||
| normalizeRole role `elem` names -> pure (Left (PrivilegeError "conflict" ("role already exists: " <> role)))
|
||||
| otherwise -> catalog (insertRole (pvCatalog service) role)
|
||||
DropRoleCommand role -> do
|
||||
allowed <- requireRole service role
|
||||
case allowed of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> catalog (dropRole (pvCatalog service) role)
|
||||
GrantPrivilegesCommand privileges object role withOption -> do
|
||||
allowed <- requireRole service role
|
||||
case allowed of
|
||||
Left err -> pure (Left err)
|
||||
Right () ->
|
||||
eachAction (expandPrivileges privileges) $ \privilege ->
|
||||
grantOne service withOption role privilege (normalizeObject database object)
|
||||
RevokePrivilegesCommand privileges object role -> do
|
||||
allowed <- requireRole service role
|
||||
case allowed of
|
||||
Left err -> pure (Left err)
|
||||
Right () ->
|
||||
eachAction (expandPrivileges privileges) $ \privilege ->
|
||||
revokeOne service role privilege (normalizeObject database object)
|
||||
GrantRoleCommand role members -> do
|
||||
allowed <- requireRole service role
|
||||
case allowed of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> do
|
||||
known <- roleNames service
|
||||
case known of
|
||||
Left err -> pure (Left err)
|
||||
Right roles -> eachAction members (grantMember service roles role)
|
||||
RevokeRoleCommand role users -> do
|
||||
allowed <- requireRole service role
|
||||
case allowed of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> eachAction users $ \user -> catalog (removeMember (pvCatalog service) role user)
|
||||
|
||||
-- | 落一条授权,带 grant option 的再落一条转授权
|
||||
grantOne :: Privileges -> Bool -> Text -> Text -> Text -> IO (Either PrivilegeError ())
|
||||
grantOne service withOption role privilege object = do
|
||||
written <- catalog (addGrant (pvCatalog service) role privilege object)
|
||||
case written of
|
||||
Left err -> pure (Left err)
|
||||
Right ()
|
||||
| withOption -> catalog (addGrantOption (pvCatalog service) role privilege object)
|
||||
| otherwise -> pure (Right ())
|
||||
|
||||
-- | 收一条授权,连同它的 grant option
|
||||
revokeOne :: Privileges -> Text -> Text -> Text -> IO (Either PrivilegeError ())
|
||||
revokeOne service role privilege object = do
|
||||
dropped <- catalog (removeGrant (pvCatalog service) role privilege object)
|
||||
case dropped of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> catalog (removeGrantOption (pvCatalog service) role privilege object)
|
||||
|
||||
-- | 普通身份转授权:只放行 GRANT
|
||||
delegateCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
|
||||
delegateCommand service principal database command = case command of
|
||||
GrantPrivilegesCommand _ _ role _ -> do
|
||||
allowed <- requireRole service role
|
||||
case allowed of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> do
|
||||
owned <- optionsOfUser service (principalName principal)
|
||||
case owned >>= \found -> checkOptions database found needed of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> applyCommand service database command
|
||||
_ -> pure (Left forbidden)
|
||||
where
|
||||
-- | 命令里每个 (对象, 权限) 都要对得上
|
||||
needed = case command of
|
||||
GrantPrivilegesCommand privileges object _ _ -> [(object, privilege) | privilege <- expandPrivileges privileges]
|
||||
_ -> []
|
||||
|
||||
-- | 加一条成员边:名字是角色就查环,否则当用户加
|
||||
grantMember :: Privileges -> [Text] -> Text -> Text -> IO (Either PrivilegeError ())
|
||||
grantMember service roles role member = do
|
||||
current <- membersOfRole service role
|
||||
case current of
|
||||
Left err -> pure (Left err)
|
||||
Right known
|
||||
| normalizeUser member `elem` known -> pure (Right ())
|
||||
| normalizeRole member `notElem` roles -> catalog (addMember (pvCatalog service) role member)
|
||||
| otherwise -> do
|
||||
edges <- membershipEdges service
|
||||
case edges of
|
||||
Left err -> pure (Left err)
|
||||
Right pairs
|
||||
| normalizeRole member `elem` closureUp pairs [normalizeRole role] ->
|
||||
pure (Left (cycleMember role member))
|
||||
| otherwise -> catalog (addMember (pvCatalog service) role member)
|
||||
|
||||
-- | 只保留两端都是角色的成员边
|
||||
membershipEdges :: Privileges -> IO (Either PrivilegeError [(Text, Text)])
|
||||
membershipEdges service = do
|
||||
members <- catalog (readMembers (pvCatalog service))
|
||||
roles <- roleNames service
|
||||
pure (roleEdges <$> members <*> roles)
|
||||
|
||||
-- | 全程持锁,先保证系统表存在再跑动作
|
||||
-- 持目录锁并确保旧权限表存在。
|
||||
withTables :: Privileges -> IO (Either PrivilegeError a) -> IO (Either PrivilegeError a)
|
||||
withTables service action = withCatalogLock (pvCatalog service) $ do
|
||||
ready <- ensureCatalog (pvCatalog service)
|
||||
case ready of
|
||||
Left err -> pure (Left (storageError err))
|
||||
Right () -> action
|
||||
case ready of Left err -> pure (Left (storageError err)); Right () -> action
|
||||
|
||||
-- | 目录操作转成权限错误
|
||||
-- 将目录结果转换为权限错误。
|
||||
catalog :: IO (Either String a) -> IO (Either PrivilegeError a)
|
||||
catalog action = fmap (either (Left . storageError) Right) action
|
||||
|
||||
-- | 把 ALL 展开成四种具体权限
|
||||
expandPrivileges :: [Text] -> [Text]
|
||||
expandPrivileges privileges = nub (concatMap expand (map (T.toLower . T.strip) privileges))
|
||||
-- 分类稳定对象目录的明确错误。
|
||||
storageError :: String -> PrivilegeError
|
||||
storageError message = PrivilegeError code (T.pack message)
|
||||
where
|
||||
-- | 展开一条权限名
|
||||
expand "all" = ["select", "insert", "update", "delete"]
|
||||
expand other = [other]
|
||||
code | message == "no database selected" = "no_database"
|
||||
| any (`T.isPrefixOf` T.pack message) ["permission denied:", "grant option required:", "object owner required", "administrator required", "system objects cannot be granted"] = "forbidden"
|
||||
| any (`T.isPrefixOf` T.pack message) ["unknown role:", "unknown table", "unknown database"] = "not_found"
|
||||
| message == "object ACL changed concurrently" = "conflict"
|
||||
| message == "invalid privilege for object scope" = "bad_request"
|
||||
| message == "the last enabled login superuser cannot be removed" = "bad_request"
|
||||
| otherwise = "storage_error"
|
||||
|
||||
forbidden :: PrivilegeError
|
||||
forbidden = PrivilegeError "forbidden" "administrator required"
|
||||
|
||||
-- | 未知角色的错误
|
||||
unknownRole :: Text -> PrivilegeError
|
||||
unknownRole role = PrivilegeError "not_found" ("unknown role: " <> role)
|
||||
|
||||
-- | 角色成员成环的错误
|
||||
cycleMember :: Text -> Text -> PrivilegeError
|
||||
cycleMember role member =
|
||||
PrivilegeError "conflict" ("role membership would create a cycle: " <> normalizeRole role <> " and " <> normalizeRole member)
|
||||
|
||||
-- | 存储错误转成权限错误
|
||||
storageError :: String -> PrivilegeError
|
||||
storageError "the last enabled login superuser cannot be removed" = PrivilegeError "bad_request" "the last enabled login superuser cannot be removed"
|
||||
storageError message = PrivilegeError "storage_error" ("privilege storage: " <> T.pack message)
|
||||
@@ -0,0 +1,35 @@
|
||||
module ChuSQL.Server.Security (readSecurity, writeSecurity) where
|
||||
|
||||
import Control.Concurrent.MVar
|
||||
import Control.Exception (bracket_, mask_)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
||||
-- 共享权限门:查询并行读取,权限和对象变更独占执行。
|
||||
|
||||
{-# NOINLINE securityGate #-}
|
||||
securityGate :: (MVar (), MVar (), MVar Int)
|
||||
securityGate = unsafePerformIO $ do
|
||||
turn <- newMVar ()
|
||||
room <- newMVar ()
|
||||
readers <- newMVar 0
|
||||
pure (turn, room, readers)
|
||||
|
||||
-- 并行执行权限稳定期间的查询。
|
||||
readSecurity :: IO a -> IO a
|
||||
readSecurity = bracket_ enter leave
|
||||
where
|
||||
(turn, room, readers) = securityGate
|
||||
-- 登记共享读取者。
|
||||
enter = withMVar turn $ \_ -> modifyMVar_ readers $ \count -> do
|
||||
if count == 0 then takeMVar room else pure ()
|
||||
pure (count + 1)
|
||||
-- 释放最后一个共享读取者。
|
||||
leave = mask_ $ modifyMVar_ readers $ \count -> do
|
||||
if count == 1 then putMVar room () else pure ()
|
||||
pure (count - 1)
|
||||
|
||||
-- 独占执行权限或对象变更。
|
||||
writeSecurity :: IO a -> IO a
|
||||
writeSecurity action = withMVar turn $ \_ -> withMVar room (const action)
|
||||
where
|
||||
(turn, room, _) = securityGate
|
||||
@@ -13,9 +13,11 @@ module ChuSQL.Server.Session
|
||||
, isPlainIdentifier
|
||||
, authenticateSession
|
||||
, authenticateSessionCoded
|
||||
, authenticateSudoSessionCoded
|
||||
, switchDatabase
|
||||
, runStatement
|
||||
, runStatementCoded
|
||||
, runStorageCoded
|
||||
, catalog
|
||||
, accounts
|
||||
, roleViews
|
||||
@@ -37,14 +39,19 @@ import ChuSQL.Interface.Auth (defaultSessionPolicy, newSessionStore)
|
||||
import ChuSQL.Server.Accounts
|
||||
import ChuSQL.Server.Backend (Backend (..), StatementResult (..), columnsFromStatement, scopeDdl)
|
||||
import ChuSQL.Server.Policy (configurePasswordPolicy)
|
||||
import ChuSQL.Server.Privileges (PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView, affectedAccounts, authorize, filterTables, listRoleViews, newPrivileges, privilegeCommand, runPrivilegeCommand)
|
||||
import ChuSQL.Server.Privileges (PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView, affectedAccounts, affectedObject, authorize, authorizeConnect, claimObject, prepareObject, reconcileObjects, filterTables, listRoleViews, newPrivileges, privilegeCommand, runPrivilegeCommand)
|
||||
import ChuSQL.Server.Security (readSecurity, writeSecurity)
|
||||
import Control.Exception (IOException, try)
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Char (isAlpha, isAlphaNum)
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Data.Maybe (isJust)
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.IntSet as IS
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
|
||||
-- SQL 会话:Web、命令行与 TCP 服务器共用的账号、权限与语句执行入口。
|
||||
@@ -66,6 +73,7 @@ data Session = Session
|
||||
, ssPrivileges :: Privileges
|
||||
, ssCurrent :: IORef Text
|
||||
, ssPrincipal :: IORef (Maybe Principal)
|
||||
, ssIdentityStamp :: IORef (Maybe (Integer, Integer))
|
||||
, ssSettingsFile :: FilePath
|
||||
, ssTransaction :: IORef (Maybe Transaction)
|
||||
, ssChanged :: [Text] -> IO ()
|
||||
@@ -75,7 +83,9 @@ data Session = Session
|
||||
data Transaction = Transaction
|
||||
{ txBase :: Database
|
||||
, txStaged :: Database
|
||||
, txSavepoints :: [(String, Database)]
|
||||
, txSavepoints :: [(String, Database, [Statement])]
|
||||
, txStatements :: [Statement]
|
||||
, txObjects :: [(String, A.Value)]
|
||||
}
|
||||
|
||||
-- | 开一个会话:账号与角色服务、配置策略都和 Web 端一致
|
||||
@@ -92,8 +102,9 @@ newSessionWith backend name settingsFile changed = do
|
||||
-- 服务启动后只有系统库:没 USE 之前不预设任何工作库
|
||||
current <- newIORef ""
|
||||
principal <- newIORef Nothing
|
||||
identityStamp <- newIORef Nothing
|
||||
transaction <- newIORef Nothing
|
||||
pure (Session backend accountsService privileges current principal settingsFile transaction changed)
|
||||
pure (Session backend accountsService privileges current principal identityStamp settingsFile transaction changed)
|
||||
|
||||
-- | 当前生效的口令策略(只有管理员能看)
|
||||
policyOf :: Session -> IO (Either Text PasswordPolicy)
|
||||
@@ -142,7 +153,7 @@ authenticateSession session user password =
|
||||
|
||||
-- | 登录(带错误码)
|
||||
authenticateSessionCoded :: Session -> Text -> Text -> IO (Either SessionError ())
|
||||
authenticateSessionCoded session user password = do
|
||||
authenticateSessionCoded session user password = readSecurity $ do
|
||||
result <- authenticate (ssAccounts session) user password
|
||||
case result of
|
||||
Left err -> pure (Left (accountErrorOf err))
|
||||
@@ -150,14 +161,39 @@ authenticateSessionCoded session user password = do
|
||||
who <- currentPrincipal (ssAccounts session) token
|
||||
case who of
|
||||
Left err -> pure (Left (accountErrorOf err))
|
||||
Right principal -> do
|
||||
Right principal -> storePrincipal session principal
|
||||
|
||||
-- 登录已通过本机凭据校验的映射账号。
|
||||
authenticateSudoSessionCoded :: Session -> Text -> IO (Either SessionError ())
|
||||
authenticateSudoSessionCoded session user = readSecurity $ do
|
||||
result <- authenticateSudo (ssAccounts session) user
|
||||
case result of
|
||||
Left err -> pure (Left (accountErrorOf err))
|
||||
Right token -> do
|
||||
who <- currentPrincipal (ssAccounts session) token
|
||||
case who of
|
||||
Left err -> pure (Left (accountErrorOf err))
|
||||
Right principal -> storePrincipal session principal
|
||||
|
||||
-- 绑定身份版本并清理旧登录的事务。
|
||||
storePrincipal :: Session -> Principal -> IO (Either SessionError ())
|
||||
storePrincipal session principal = do
|
||||
result <- findAccount (ssAccounts session) (principalName principal)
|
||||
case result of
|
||||
Left err -> pure (Left (accountErrorOf err))
|
||||
Right account -> do
|
||||
writeIORef (ssPrincipal session) (Just principal)
|
||||
writeIORef (ssIdentityStamp session) (Just (accountId account, accountRevision account))
|
||||
writeIORef (ssTransaction session) Nothing
|
||||
writeIORef (ssCurrent session) ""
|
||||
pure (Right ())
|
||||
|
||||
-- | 换库;系统库只有 root 能进
|
||||
switchDatabase :: Session -> Text -> IO (Either Text ())
|
||||
switchDatabase session name =
|
||||
fmap (first sessMessage) (switchDatabaseCoded session name)
|
||||
readSecurity $ do
|
||||
valid <- validatePrincipal session
|
||||
case valid of Left err -> pure (Left (sessMessage err)); Right () -> fmap (first sessMessage) (switchDatabaseCoded session name)
|
||||
|
||||
-- | 换库(带错误码)
|
||||
switchDatabaseCoded :: Session -> Text -> IO (Either SessionError ())
|
||||
@@ -171,6 +207,13 @@ switchDatabaseCoded session rawName
|
||||
name = T.toLower (T.strip rawName)
|
||||
-- | 真的切库并记下当前库
|
||||
go = do
|
||||
who <- readIORef (ssPrincipal session)
|
||||
allowed <- case who of
|
||||
Just principal | name /= "system" -> authorizeConnect (ssPrivileges session) principal name
|
||||
_ -> pure (Right ())
|
||||
case allowed of
|
||||
Left err -> pure (Left (privilegeErrorOf err))
|
||||
Right () -> do
|
||||
backend <- currentBackend session
|
||||
result <- beStatement backend ("USE " ++ T.unpack name)
|
||||
case result of
|
||||
@@ -183,7 +226,43 @@ runStatement session sql = fmap (first sessMessage) (runStatementCoded session s
|
||||
|
||||
-- | 跑一条语句(带错误码)
|
||||
runStatementCoded :: Session -> Text -> IO (Either SessionError QueryResult)
|
||||
runStatementCoded session sql = case parseStatement (T.unpack sql) of
|
||||
runStatementCoded session sql = gate $ do
|
||||
valid <- validatePrincipal session
|
||||
case valid of Left err -> pure (Left err); Right () -> runStatementUnlocked session sql
|
||||
where
|
||||
gate = case parseStatement (T.unpack sql) of
|
||||
Right statement | transactionDdl statement || isJust (accountCommand statement) || isJust (privilegeCommand statement) -> writeSecurity
|
||||
_ -> readSecurity
|
||||
|
||||
-- 在权限门内检查并执行管理员存储请求。
|
||||
runStorageCoded :: Session -> A.Value -> IO (Either SessionError A.Value)
|
||||
runStorageCoded session payload = writeSecurity $ do
|
||||
valid <- validatePrincipal session
|
||||
who <- readIORef (ssPrincipal session)
|
||||
case valid of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> case who of
|
||||
Nothing -> pure (Left (SessionError "unauthorized" "sign in first"))
|
||||
Just principal | not (principalIsRoot principal) -> pure (Left (SessionError "forbidden" "administrator required"))
|
||||
Just _ -> fmap (first (SessionError "storage_error" . T.pack)) (beStorage (ssBackend session) payload)
|
||||
|
||||
-- 检查登录身份的当前版本和启用状态。
|
||||
validatePrincipal :: Session -> IO (Either SessionError ())
|
||||
validatePrincipal session = do
|
||||
who <- readIORef (ssPrincipal session)
|
||||
stamp <- readIORef (ssIdentityStamp session)
|
||||
case who of
|
||||
Just principal -> do
|
||||
result <- findAccount (ssAccounts session) (principalName principal)
|
||||
pure $ case result of
|
||||
Left err -> Left (accountErrorOf err)
|
||||
Right current | stamp == Just (accountId current, accountRevision current) && accountEnabled current && accountCanLogin current && (not (principalIsRoot principal) || accountIsSuperuser current) -> Right ()
|
||||
_ -> Left (SessionError "unauthorized" "session identity has changed")
|
||||
_ -> pure (Right ())
|
||||
|
||||
-- 在共享权限门内分发会话语句。
|
||||
runStatementUnlocked :: Session -> Text -> IO (Either SessionError QueryResult)
|
||||
runStatementUnlocked session sql = case parseStatement (T.unpack sql) of
|
||||
Right (UseDatabase name) -> do
|
||||
existing <- readIORef (ssTransaction session)
|
||||
case existing of
|
||||
@@ -215,7 +294,7 @@ runStatementCoded session sql = case parseStatement (T.unpack sql) of
|
||||
Left err -> pure (Left err)
|
||||
Right ()
|
||||
| isJust transaction && transactionData statement -> runInTransaction session statement
|
||||
| otherwise -> runPlain session sql
|
||||
| otherwise -> runObjectStatement session statement sql
|
||||
Left _ -> runPlain session sql
|
||||
|
||||
-- | 事务里不许改结构,会话层直接拦下
|
||||
@@ -250,6 +329,12 @@ transactionData statement = case statement of
|
||||
-- | 开事务:把当前库整库做一份快照当起点
|
||||
beginTransaction :: Session -> IO (Either SessionError QueryResult)
|
||||
beginTransaction session = do
|
||||
allowed <- sessionConnectAllowed session
|
||||
case allowed of Left err -> pure (Left err); Right () -> beginAuthorized session
|
||||
|
||||
-- 在连接权限复核后建立事务快照。
|
||||
beginAuthorized :: Session -> IO (Either SessionError QueryResult)
|
||||
beginAuthorized session = do
|
||||
current <- readIORef (ssCurrent session)
|
||||
existing <- readIORef (ssTransaction session)
|
||||
case existing of
|
||||
@@ -262,7 +347,11 @@ beginTransaction session = do
|
||||
case snapshotResult of
|
||||
Left err -> pure (Left (engineErrorCode err))
|
||||
Right db -> do
|
||||
writeIORef (ssTransaction session) (Just (Transaction db db []))
|
||||
objects <- snapshotObjectIds session (map fst db)
|
||||
case objects of
|
||||
Left err -> pure (Left err)
|
||||
Right ids -> do
|
||||
writeIORef (ssTransaction session) (Just (Transaction db db [] [] ids))
|
||||
pure (Right (emptyResult (Just current)))
|
||||
|
||||
-- | 提交:把快照差分交给存储层应用,成功才结束事务
|
||||
@@ -273,20 +362,56 @@ commitTransaction session = do
|
||||
case existing of
|
||||
Nothing -> pure (Left (SessionError "query_error" "no transaction in progress"))
|
||||
Just transaction -> do
|
||||
connected <- sessionConnectAllowed session
|
||||
permissions <- mapM (authorized session) (txStatements transaction)
|
||||
identities <- snapshotObjectIds session (map fst (txBase transaction))
|
||||
case connected >> sequence permissions >> identities of
|
||||
Left err -> pure (Left err)
|
||||
Right ids | ids /= txObjects transaction -> pure (Left (SessionError "serialization_failure" "transaction object identity changed"))
|
||||
| otherwise -> commitAuthorized session current transaction
|
||||
|
||||
-- 对象和权限复核后提交事务差分。
|
||||
commitAuthorized :: Session -> Text -> Transaction -> IO (Either SessionError QueryResult)
|
||||
commitAuthorized session current transaction = do
|
||||
backend <- currentBackend session
|
||||
liveResult <- beSnapshot backend
|
||||
case liveResult of
|
||||
Left err -> pure (Left (engineErrorCode err))
|
||||
Right live -> case transactionConflict (txBase transaction) (txStaged transaction) live of
|
||||
Right live -> let diffs = transactionDiffs (txBase transaction) (txStaged transaction) live in case transactionConflict diffs of
|
||||
Just msg -> pure (Left (SessionError "serialization_failure" (T.pack msg)))
|
||||
Nothing -> do
|
||||
applied <- beApplyTransaction backend (transactionOps (txBase transaction) (txStaged transaction) live)
|
||||
applied <- beApplyTransaction backend (transactionOps diffs)
|
||||
case applied of
|
||||
Left err -> pure (Left (engineErrorCode err))
|
||||
Right () -> do
|
||||
writeIORef (ssTransaction session) Nothing
|
||||
pure (Right (emptyResult (Just current)))
|
||||
|
||||
-- 检查当前数据库连接权限。
|
||||
sessionConnectAllowed :: Session -> IO (Either SessionError ())
|
||||
sessionConnectAllowed session = do
|
||||
database <- readIORef (ssCurrent session)
|
||||
who <- readIORef (ssPrincipal session)
|
||||
case who of
|
||||
Just principal | not (principalIsRoot principal), not (T.null database) -> fmap (first privilegeErrorOf) (authorizeConnect (ssPrivileges session) principal database)
|
||||
_ -> pure (Right ())
|
||||
|
||||
-- 保存事务使用的 catalog 对象编号。
|
||||
snapshotObjectIds :: Session -> [String] -> IO (Either SessionError [(String, A.Value)])
|
||||
snapshotObjectIds session names = do
|
||||
database <- readIORef (ssCurrent session)
|
||||
if database == "system" then pure (Right []) else do
|
||||
results <- mapM (one database) (filter (not . T.isPrefixOf "__system_" . T.pack) names)
|
||||
pure (sequence results)
|
||||
where
|
||||
-- 解析一个快照表的稳定对象编号。
|
||||
one database name = do
|
||||
result <- beStorage (ssBackend session) (A.object ["method" A..= ("resolve_object" :: Text), "database" A..= database, "table" A..= name])
|
||||
pure $ case result of
|
||||
Left err -> Left (SessionError "serialization_failure" (T.pack err))
|
||||
Right value@(A.Object fields) | KM.lookup "status" fields == Just (A.String "object") -> Right (name, value)
|
||||
Right _ -> Left (SessionError "serialization_failure" "transaction object no longer exists")
|
||||
|
||||
-- | 回滚:快照丢掉,存储层没被改过
|
||||
rollbackTransaction :: Session -> IO (Either SessionError QueryResult)
|
||||
rollbackTransaction session = do
|
||||
@@ -306,7 +431,7 @@ savepointTransaction session name = do
|
||||
case existing of
|
||||
Nothing -> pure (Left (SessionError "query_error" "no transaction in progress"))
|
||||
Just transaction -> do
|
||||
let stack = txSavepoints transaction ++ [(T.unpack name, txStaged transaction)]
|
||||
let stack = txSavepoints transaction ++ [(T.unpack name, txStaged transaction, txStatements transaction)]
|
||||
writeIORef (ssTransaction session) (Just transaction {txSavepoints = stack})
|
||||
pure (Right (emptyResult (Just current)))
|
||||
|
||||
@@ -320,10 +445,10 @@ rollbackToSavepoint session name = do
|
||||
Just transaction -> case savepointIndex name (txSavepoints transaction) of
|
||||
Nothing -> pure (Left (SessionError "query_error" ("no such savepoint: " <> name)))
|
||||
Just index -> do
|
||||
let (_, staged) = txSavepoints transaction !! index
|
||||
let (_, staged, statements) = txSavepoints transaction !! index
|
||||
writeIORef
|
||||
(ssTransaction session)
|
||||
(Just transaction {txStaged = staged, txSavepoints = take (index + 1) (txSavepoints transaction)})
|
||||
(Just transaction {txStaged = staged, txStatements = statements, txSavepoints = take (index + 1) (txSavepoints transaction)})
|
||||
pure (Right (emptyResult (Just current)))
|
||||
|
||||
-- | 释放保存点:该保存点与它之后的保存点一起丢掉
|
||||
@@ -340,9 +465,9 @@ releaseSavepoint session name = do
|
||||
pure (Right (emptyResult (Just current)))
|
||||
|
||||
-- | 最近一次同名保存点的下标
|
||||
savepointIndex :: Text -> [(String, Database)] -> Maybe Int
|
||||
savepointIndex :: Text -> [(String, Database, [Statement])] -> Maybe Int
|
||||
savepointIndex name entries =
|
||||
case [index | (index, (label, _)) <- zip [0 ..] entries, T.pack label == name] of
|
||||
case [index | (index, (label, _, _)) <- zip [0 ..] entries, T.pack label == name] of
|
||||
[] -> Nothing
|
||||
hits -> Just (last hits)
|
||||
|
||||
@@ -356,7 +481,7 @@ runInTransaction session statement = do
|
||||
Just transaction -> case scopeDdl (T.unpack current) statement >>= Engine.runStatement (txStaged transaction) of
|
||||
Left err -> pure (Left (engineErrorCode err))
|
||||
Right (staged, rows) -> do
|
||||
writeIORef (ssTransaction session) (Just transaction {txStaged = staged})
|
||||
writeIORef (ssTransaction session) (Just transaction {txStaged = staged, txStatements = statement : txStatements transaction})
|
||||
pure (Right (resultOfStaged (txStaged transaction) statement rows))
|
||||
|
||||
-- | 事务内的结果集:空结果回落到解析出来的列名
|
||||
@@ -376,8 +501,8 @@ data TableDiff = TableDiff
|
||||
}
|
||||
|
||||
-- | 提交差分:相对快照列出要删、要写与要替换的行
|
||||
transactionOps :: Database -> Database -> Database -> [TxnOp]
|
||||
transactionOps base staged live = concatMap opsOf (transactionDiffs base staged live)
|
||||
transactionOps :: [(String, TableDiff)] -> [TxnOp]
|
||||
transactionOps = concatMap opsOf
|
||||
where
|
||||
-- | 一张表的请求:先删后写
|
||||
opsOf (name, diff) =
|
||||
@@ -386,9 +511,9 @@ transactionOps base staged live = concatMap opsOf (transactionDiffs base staged
|
||||
++ [TxnReplace name rows | Just rows <- [tdReplace diff]]
|
||||
|
||||
-- | 提交前校验:本事务动过的行是否已被别人改掉
|
||||
transactionConflict :: Database -> Database -> Database -> Maybe String
|
||||
transactionConflict base staged live =
|
||||
case [msg | (_, diff) <- transactionDiffs base staged live, Just msg <- [tdConflict diff]] of
|
||||
transactionConflict :: [(String, TableDiff)] -> Maybe String
|
||||
transactionConflict diffs =
|
||||
case [msg | (_, diff) <- diffs, Just msg <- [tdConflict diff]] of
|
||||
(msg : _) -> Just msg
|
||||
[] -> Nothing
|
||||
|
||||
@@ -401,9 +526,8 @@ transactionDiffs base staged live = [(name, diffFor name) | name <- names]
|
||||
|
||||
-- | 一张表的差异
|
||||
diffFor name
|
||||
| all (isJust . rowKey) (baseRows ++ stagedRows) = keyedDiff
|
||||
-- 没动过这张表:别人改成什么样都不关本事务
|
||||
| stagedRows == baseRows = emptyDiff
|
||||
| all (isJust . rowKey) (baseRows ++ stagedRows) = keyedDiff
|
||||
-- 动过,库里还是基线:整表替换
|
||||
| liveRows == baseRows = emptyDiff {tdReplace = Just stagedRows}
|
||||
| otherwise = emptyDiff {tdConflict = Just ("write conflict on table " ++ name)}
|
||||
@@ -412,27 +536,30 @@ transactionDiffs base staged live = [(name, diffFor name) | name <- names]
|
||||
stagedRows = rowsOf name staged
|
||||
liveRows = rowsOf name live
|
||||
|
||||
baseByKey = [(k, r) | r <- baseRows, Just k <- [rowKey r]]
|
||||
liveByKey = [(k, r) | r <- liveRows, Just k <- [rowKey r]]
|
||||
stagedByKey = [(k, r) | r <- stagedRows, Just k <- [rowKey r]]
|
||||
baseByKey = keyedRows baseRows
|
||||
liveByKey = keyedRows liveRows
|
||||
stagedByKey = keyedRows stagedRows
|
||||
stagedEntries = [(k, r) | r <- stagedRows, Just k <- [rowKey r]]
|
||||
|
||||
-- 本事务动过的键:内容改过、新增,或者删掉
|
||||
written = [k | (k, r) <- stagedByKey, lookup k baseByKey /= Just r]
|
||||
removed = [k | (k, _) <- baseByKey, not (any ((== k) . fst) stagedByKey)]
|
||||
written = [k | (k, r) <- stagedEntries, IM.lookup k baseByKey /= Just r]
|
||||
writtenSet = IS.fromList written
|
||||
removed = [k | r <- baseRows, Just k <- [rowKey r], IM.notMember k stagedByKey]
|
||||
removedSet = IS.fromList removed
|
||||
touched = written ++ removed
|
||||
|
||||
-- 两边都删了算一致;其余只要跟基线不一样就是冲突
|
||||
victims =
|
||||
[ k
|
||||
| k <- touched
|
||||
, lookup k liveByKey /= lookup k baseByKey
|
||||
, not (k `elem` removed && lookup k liveByKey == Nothing)
|
||||
, IM.lookup k liveByKey /= IM.lookup k baseByKey
|
||||
, not (IS.member k removedSet && IM.notMember k liveByKey)
|
||||
]
|
||||
|
||||
keyedDiff =
|
||||
emptyDiff
|
||||
{ tdDeletes = [k | k <- touched, isJust (lookup k liveByKey)]
|
||||
, tdWrites = [r | (k, r) <- stagedByKey, k `elem` written]
|
||||
{ tdDeletes = [k | k <- touched, IM.member k liveByKey]
|
||||
, tdWrites = [r | (k, r) <- stagedEntries, IS.member k writtenSet]
|
||||
, tdConflict = case victims of
|
||||
(k : _) -> Just ("write conflict on table " ++ name ++ ", id " ++ show k)
|
||||
[] -> Nothing
|
||||
@@ -447,6 +574,10 @@ transactionDiffs base staged live = [(name, diffFor name) | name <- names]
|
||||
-- | 库里某张表的行
|
||||
rowsOf name db = maybe [] tableRows (lookup name db)
|
||||
|
||||
-- | 按整数 id 建立保留首行的查找表
|
||||
keyedRows :: [Row] -> IM.IntMap Row
|
||||
keyedRows rows = IM.fromListWith (\_ earlier -> earlier) [(key, row) | row <- rows, Just key <- [rowKey row]]
|
||||
|
||||
-- | 行 id:只有整数 id 才认,跟存储层删行的口径一致
|
||||
rowKey :: Row -> Maybe Int
|
||||
rowKey row = case lookup "id" row of
|
||||
@@ -471,9 +602,64 @@ runPlain session sql = do
|
||||
result <- beStatement backend (T.unpack sql)
|
||||
pure (either (Left . engineErrorCode) (Right . resultOf) result)
|
||||
|
||||
-- 执行对象结构变更并维护所有者和授权。
|
||||
runObjectStatement :: Session -> Statement -> Text -> IO (Either SessionError QueryResult)
|
||||
runObjectStatement session statement sql = do
|
||||
who <- readIORef (ssPrincipal session)
|
||||
database <- readIORef (ssCurrent session)
|
||||
prepared <- case (who, statement) of
|
||||
(Just principal, CreateTable name _) | database /= "system" -> prepareObject (ssPrivileges session) principal database (T.pack name)
|
||||
_ -> pure (Right ())
|
||||
affected <- case statement of
|
||||
DropTable name | database /= "system" -> affectedObject (ssPrivileges session) database (T.pack name)
|
||||
DropDatabase name | name /= "system" -> affectedObject (ssPrivileges session) "" ("database:" <> T.pack name)
|
||||
_ -> pure (Right [])
|
||||
case prepared >> affected of
|
||||
Left err -> pure (Left (privilegeErrorOf err))
|
||||
Right names -> do
|
||||
result <- runPreparedObject session statement sql
|
||||
notifyChanged session names
|
||||
pure result
|
||||
|
||||
-- 执行已登记创建声明的对象变更。
|
||||
runPreparedObject :: Session -> Statement -> Text -> IO (Either SessionError QueryResult)
|
||||
runPreparedObject session statement sql = do
|
||||
result <- runPlain session sql
|
||||
case result of
|
||||
Left err -> case statement of
|
||||
CreateTable{} -> do
|
||||
cleaned <- reconcileObjects (ssPrivileges session)
|
||||
pure $ case cleaned of
|
||||
Left failure -> Left (SessionError "storage_error" (sessMessage err <> "; creator intent cleanup failed: " <> privilegeMessage failure))
|
||||
Right () -> Left err
|
||||
_ -> pure (Left err)
|
||||
Right value -> do
|
||||
who <- readIORef (ssPrincipal session)
|
||||
database <- readIORef (ssCurrent session)
|
||||
maintained <- case (who, statement) of
|
||||
(Just principal, CreateTable name _) | database /= "system" -> claimObject (ssPrivileges session) principal database (T.pack name)
|
||||
(Just principal, CreateDatabase name) -> claimObject (ssPrivileges session) principal "" ("database:" <> T.pack name)
|
||||
(_, DropTable{}) -> reconcileObjects (ssPrivileges session)
|
||||
(_, DropDatabase{}) -> reconcileObjects (ssPrivileges session)
|
||||
_ -> pure (Right ())
|
||||
case maintained of
|
||||
Right () -> pure (Right value)
|
||||
Left err -> do
|
||||
cleanup <- case statement of
|
||||
CreateTable name _ -> runPlain session ("DROP TABLE " <> T.pack name)
|
||||
CreateDatabase name -> runPlain session ("DROP DATABASE " <> T.pack name)
|
||||
_ -> pure (Right value)
|
||||
pure $ case cleanup of
|
||||
Left failure -> Left (SessionError "storage_error" (privilegeMessage err <> "; object cleanup failed: " <> sessMessage failure))
|
||||
Right _ -> Left (privilegeErrorOf err)
|
||||
|
||||
-- | 数据字典;普通身份只看到有 SELECT 权的表
|
||||
catalog :: Session -> IO (Either Text [TableInfo])
|
||||
catalog session = do
|
||||
catalog session = withReadSession session (catalogUnlocked session)
|
||||
|
||||
-- 在权限共享门内读取可见表目录。
|
||||
catalogUnlocked :: Session -> IO (Either Text [TableInfo])
|
||||
catalogUnlocked session = do
|
||||
current <- readIORef (ssCurrent session)
|
||||
if T.null current
|
||||
then pure (Left "no database selected")
|
||||
@@ -509,13 +695,31 @@ withAccountInfo session tables = do
|
||||
|
||||
-- | 库清单(\l 用)
|
||||
databases :: Session -> IO (Either Text [Text])
|
||||
databases session = do
|
||||
databases session = withReadSession session $ do
|
||||
result <- beDatabases (ssBackend session)
|
||||
pure (either (Left . T.pack) (Right . map T.pack) result)
|
||||
who <- readIORef (ssPrincipal session)
|
||||
case (result, who) of
|
||||
(Left err, _) -> pure (Left (T.pack err))
|
||||
(Right names, Just principal) | not (principalIsRoot principal) -> do
|
||||
checks <- mapM (check principal . T.pack) names
|
||||
pure $ case [err | Left err@(PrivilegeError code _) <- checks, code /= "forbidden"] of
|
||||
err : _ -> Left (privilegeMessage err)
|
||||
[] -> Right [T.pack name | (name, Right ()) <- zip names checks]
|
||||
(Right names, _) -> pure (Right (map T.pack names))
|
||||
where
|
||||
-- 检查业务库连接或系统目录管理权限。
|
||||
check principal "system" = pure (if principalIsCatalogManager principal then Right () else Left (PrivilegeError "forbidden" "system catalog manager required"))
|
||||
check principal name = authorizeConnect (ssPrivileges session) principal name
|
||||
|
||||
-- 在共享权限门内复核会话并读取接口。
|
||||
withReadSession :: Session -> IO (Either Text a) -> IO (Either Text a)
|
||||
withReadSession session action = readSecurity $ do
|
||||
valid <- validatePrincipal session
|
||||
case valid of Left err -> pure (Left (sessMessage err)); Right () -> action
|
||||
|
||||
-- | 角色总览,只给管理员
|
||||
roleViews :: Session -> IO (Either Text [RoleView])
|
||||
roleViews session = do
|
||||
roleViews session = withReadSession session $ do
|
||||
admin <- sessionIsAdmin session
|
||||
if not admin
|
||||
then pure (Left "administrator required")
|
||||
@@ -525,7 +729,7 @@ roleViews session = do
|
||||
|
||||
-- | 账号清单(\du 与账号管理页用);只给管理员
|
||||
accounts :: Session -> IO (Either Text [Account])
|
||||
accounts session = do
|
||||
accounts session = withReadSession session $ do
|
||||
admin <- sessionIsAdmin session
|
||||
if not admin
|
||||
then pure (Left "administrator required")
|
||||
@@ -547,9 +751,9 @@ showIdentities session = do
|
||||
result <- beAccounts (ssBackend session) ReqAccountsList
|
||||
pure $ case result of
|
||||
Left err -> Left (SessionError "storage_error" (T.pack err))
|
||||
Right identities -> Right (QueryResult ["id", "name", "can_login", "is_superuser", "enabled", "system_catalog_manager", "created_at"]
|
||||
Right identities -> Right (QueryResult ["id", "name", "can_login", "is_superuser", "enabled", "system_catalog_manager", "allow_sudo_auth", "created_at"]
|
||||
[[VInt (fromInteger (accountId a)), VStr (T.unpack (accountUser a)), VBool (accountCanLogin a),
|
||||
VBool (accountIsSuperuser a), VBool (accountEnabled a), VBool (accountSystemCatalogManager a), VStr (T.unpack (accountRegisteredAt a))] | a <- identities]
|
||||
VBool (accountIsSuperuser a), VBool (accountEnabled a), VBool (accountSystemCatalogManager a), VBool (accountAllowSudoAuth a), VStr (T.unpack (accountRegisteredAt a))] | a <- identities]
|
||||
(length identities) False Nothing)
|
||||
|
||||
-- | 执行身份管理并通知受影响会话
|
||||
@@ -562,13 +766,17 @@ runAccount session command = do
|
||||
affected <- case command of
|
||||
AlterAccountAttributes name _ -> affectedAccounts (ssPrivileges session) (DropRoleCommand name)
|
||||
DropAccount name -> affectedAccounts (ssPrivileges session) (DropRoleCommand name)
|
||||
_ -> pure (accountCommandUsers command)
|
||||
_ -> pure (Right (accountCommandUsers command))
|
||||
case affected of
|
||||
Left err -> pure (Left (privilegeErrorOf err))
|
||||
Right names -> do
|
||||
result <- runAccountCommand (ssAccounts session) principal command
|
||||
case result of
|
||||
Left err -> pure (Left (accountErrorOf err))
|
||||
Right () -> do
|
||||
notifyChanged session affected
|
||||
pure (Right (emptyResult Nothing))
|
||||
cleaned <- reconcileObjects (ssPrivileges session)
|
||||
notifyChanged session names
|
||||
pure (either (Left . privilegeErrorOf) (const (Right (emptyResult Nothing))) cleaned)
|
||||
|
||||
-- | 一条账号命令影响的账号
|
||||
accountCommandUsers :: AccountCommand -> [Text]
|
||||
@@ -588,11 +796,14 @@ runPrivilege session command = do
|
||||
database <- readIORef (ssCurrent session)
|
||||
-- 受影响账号要趁命令落地之前算:删角色之后成员就查不到了
|
||||
affected <- affectedAccounts (ssPrivileges session) command
|
||||
case affected of
|
||||
Left err -> pure (Left (privilegeErrorOf err))
|
||||
Right names -> do
|
||||
result <- runPrivilegeCommand (ssPrivileges session) principal database command
|
||||
case result of
|
||||
Left err -> pure (Left (privilegeErrorOf err))
|
||||
Right () -> do
|
||||
notifyChanged session affected
|
||||
notifyChanged session names
|
||||
pure (Right (emptyResult Nothing))
|
||||
|
||||
-- | 通知变更:把受影响的账号交给会话的变更钩子
|
||||
|
||||
@@ -11,19 +11,24 @@ module ChuSQL.Server.TCP (
|
||||
ServerHandle (..),
|
||||
startServer,
|
||||
runServer,
|
||||
isLocalPeer,
|
||||
) where
|
||||
|
||||
import ChuSQL.Interface.Config (ServerConfig (..), defaultServerConfig, loadServerConfigAt)
|
||||
import ChuSQL.Interface.Sudo (SudoCredential, createSudoCredential, removeSudoCredential, sudoChallenge, validSudoChallenge, isLocalPeer)
|
||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||
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.Core.Protocol (Account (..), Request (ReqIdentityInitialize))
|
||||
import ChuSQL.Server.Backend (Backend (..))
|
||||
import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), accounts, authenticateSessionCoded, catalog, databases, newSessionWith, policyOf, reloadPolicy, roleViews, runStatementCoded, sessionIsAdmin, sessionUser)
|
||||
import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), accounts, authenticateSessionCoded, authenticateSudoSessionCoded, isPlainIdentifier, catalog, databases, newSessionWith, policyOf, reloadPolicy, roleViews, runStatementCoded, runStorageCoded, sessionIsAdmin, sessionUser)
|
||||
import ChuSQL.Server.Security (writeSecurity)
|
||||
import ChuSQL.Server.Privileges (newPrivileges, reconcileObjects)
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
|
||||
import Control.Exception (IOException, finally, try)
|
||||
import Control.Exception (IOException, bracket, finally, onException, try)
|
||||
import Control.Monad (filterM, void)
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import qualified Data.ByteString.Lazy.Char8 as BLC
|
||||
@@ -48,6 +53,7 @@ import Network.Socket (
|
||||
defaultProtocol,
|
||||
getAddrInfo,
|
||||
getSocketName,
|
||||
getPeerName,
|
||||
listen,
|
||||
setSocketOption,
|
||||
socket,
|
||||
@@ -64,6 +70,8 @@ import System.IO.Error (isEOFError)
|
||||
data LiveEntry = LiveEntry
|
||||
{ leWho :: IORef (Maybe Text)
|
||||
, leDropped :: IORef Bool
|
||||
, leLocal :: Bool
|
||||
, leChallenge :: IORef (Maybe (Text, UTCTime))
|
||||
}
|
||||
|
||||
-- | 在线连接登记:自增编号到连接条目
|
||||
@@ -77,8 +85,8 @@ newLiveConnections :: IO LiveConnections
|
||||
newLiveConnections = LiveConnections <$> newIORef 0 <*> newMVar Map.empty
|
||||
|
||||
-- | 新建一条连接条目
|
||||
newLiveEntry :: IO LiveEntry
|
||||
newLiveEntry = LiveEntry <$> newIORef Nothing <*> newIORef False
|
||||
newLiveEntry :: Bool -> IO LiveEntry
|
||||
newLiveEntry local = LiveEntry <$> newIORef Nothing <*> newIORef False <*> pure local <*> newIORef Nothing
|
||||
|
||||
-- | 登记一条连接,返回注销动作
|
||||
registerConnection :: LiveConnections -> LiveEntry -> IO (IO ())
|
||||
@@ -112,6 +120,7 @@ data ServerEnv = ServerEnv
|
||||
, srvConfig :: ServerConfig
|
||||
, srvLimiter :: RateLimiter
|
||||
, srvLive :: LiveConnections
|
||||
, srvSudo :: MVar (Maybe (Int, Text, SudoCredential))
|
||||
}
|
||||
|
||||
-- | 组装服务器环境:每个连接再各开一个会话
|
||||
@@ -124,7 +133,13 @@ newServerEnv backend rootName settingsFile config limiter = do
|
||||
| any (\a -> accountEnabled a && accountCanLogin a && accountIsSuperuser a) identities -> pure ()
|
||||
| otherwise -> ioError (userError "identity migration failed: no enabled login superuser; stop all processes and try csql-bootstrap recover --config <settings.toml>; reset replaces system identities and grants")
|
||||
live <- newLiveConnections
|
||||
pure (ServerEnv backend rootName settingsFile config limiter live)
|
||||
privileges <- newPrivileges backend
|
||||
recovered <- writeSecurity (reconcileObjects privileges)
|
||||
case recovered of
|
||||
Left err -> ioError (userError ("object privilege recovery failed: " ++ show err))
|
||||
Right () -> pure ()
|
||||
sudo <- newMVar Nothing
|
||||
pure (ServerEnv backend rootName settingsFile config limiter live sudo)
|
||||
|
||||
data ServerHandle = ServerHandle
|
||||
{ shPort :: Int
|
||||
@@ -136,18 +151,42 @@ startServer :: ServerEnv -> IO ServerHandle
|
||||
startServer env = do
|
||||
sock <- listenSocket (scHost (srvConfig env)) (scPort (srvConfig env))
|
||||
port <- actualPort sock
|
||||
enableSudo env port `onException` close sock
|
||||
stopped <- newMVar False
|
||||
_ <- forkIO (acceptLoop env sock stopped)
|
||||
pure (ServerHandle port (stopListening sock stopped))
|
||||
pure (ServerHandle port (stopListening sock stopped `finally` disableSudo env))
|
||||
|
||||
-- | 在调用线程里收连接(可执行文件用);绑好端口先回调一次
|
||||
runServer :: ServerEnv -> (Int -> IO ()) -> IO ()
|
||||
runServer env announce = do
|
||||
sock <- listenSocket (scHost (srvConfig env)) (scPort (srvConfig env))
|
||||
runServer env announce = bracket (listenSocket (scHost (srvConfig env)) (scPort (srvConfig env))) close $ \sock -> do
|
||||
port <- actualPort sock
|
||||
enableSudo env port
|
||||
(do
|
||||
announce port
|
||||
stopped <- newMVar False
|
||||
acceptLoop env sock stopped
|
||||
acceptLoop env sock stopped) `finally` disableSudo env
|
||||
|
||||
-- 为显式配置的本机身份映射创建凭据。
|
||||
enableSudo :: ServerEnv -> Int -> IO ()
|
||||
enableSudo env port
|
||||
| T.null user = pure ()
|
||||
| not (isPlainIdentifier user) = ioError (userError "sudo_auth_user must be a plain identity name")
|
||||
| otherwise = modifyMVar_ (srvSudo env) $ \current -> case current of
|
||||
Just _ -> ioError (userError "sudo authentication is already running")
|
||||
Nothing -> do
|
||||
credential <- createSudoCredential port
|
||||
hPutStrLn stderr ("sudo_auth enabled: local elevated identity -> " ++ T.unpack user)
|
||||
pure (Just (port, user, credential))
|
||||
where
|
||||
user = scSudoUser (srvConfig env)
|
||||
|
||||
-- 清理本次服务实例的本机认证凭据。
|
||||
disableSudo :: ServerEnv -> IO ()
|
||||
disableSudo env = modifyMVar_ (srvSudo env) $ \current -> do
|
||||
case current of
|
||||
Nothing -> pure ()
|
||||
Just (port, _, _) -> removeSudoCredential port
|
||||
pure Nothing
|
||||
|
||||
-- | 置停止标记并关掉监听套接字
|
||||
stopListening :: Socket -> MVar Bool -> IO ()
|
||||
@@ -209,10 +248,11 @@ reportConnection env conn = do
|
||||
-- | 一个连接一个会话:一行一条 JSON,读到 EOF 就收工
|
||||
serveConnection :: ServerEnv -> Socket -> IO ()
|
||||
serveConnection env conn = do
|
||||
peer <- getPeerName conn
|
||||
h <- socketToHandle conn ReadWriteMode
|
||||
hSetBuffering h LineBuffering
|
||||
hSetNewlineMode h noNewlineTranslation
|
||||
entry <- newLiveEntry
|
||||
entry <- newLiveEntry (isLocalPeer peer)
|
||||
unregister <- registerConnection (srvLive env) entry
|
||||
session <- newSessionWith (srvBackend env) (srvRootName env) (srvSettingsFile env) (\names -> void (dropConnectionsOf (srvLive env) names))
|
||||
outcome <- try (loop h session entry `finally` unregister) :: IO (Either IOException ())
|
||||
@@ -250,11 +290,25 @@ dispatch env session entry request = case request of
|
||||
| version == protocolVersion -> pure (RespHello protocolVersion, True)
|
||||
| otherwise -> pure (RespError "bad_request" ("unsupported protocol version: " <> tshow version), True)
|
||||
ReqLogin user password -> do
|
||||
writeIORef (leChallenge entry) Nothing
|
||||
response <- login env session user password
|
||||
case response of
|
||||
RespLogin who _ -> writeIORef (leWho entry) (Just who)
|
||||
_ -> pure ()
|
||||
pure (response, True)
|
||||
ReqSudoChallenge -> do
|
||||
configured <- readMVar (srvSudo env)
|
||||
who <- sessionUser session
|
||||
case configured of
|
||||
Just _ | leLocal entry && who == Nothing -> do
|
||||
nonce <- sudoChallenge
|
||||
now <- getCurrentTime
|
||||
writeIORef (leChallenge entry) (Just (nonce, now))
|
||||
pure (RespSudoChallenge nonce, True)
|
||||
_ -> pure (RespError "forbidden" "local sudo authentication is unavailable", True)
|
||||
ReqSudoLogin user proof -> do
|
||||
response <- sudoLogin env session entry user proof
|
||||
pure (response, True)
|
||||
ReqQuery sql -> do
|
||||
who <- sessionUser session
|
||||
response <- case who of
|
||||
@@ -268,17 +322,9 @@ dispatch env session entry request = case request of
|
||||
Right queryResult -> RespResult (trimResult (scMaxRows (srvConfig env)) queryResult)
|
||||
pure (response, True)
|
||||
ReqStorage payload -> do
|
||||
who <- sessionUser session
|
||||
response <- case who of
|
||||
Nothing -> pure (RespError "unauthorized" "sign in first")
|
||||
Just _ -> do
|
||||
admin <- sessionIsAdmin session
|
||||
if not admin
|
||||
then pure (RespError "forbidden" "administrator required")
|
||||
else do
|
||||
result <- beStorage (srvBackend env) payload
|
||||
pure $ case result of
|
||||
Left err -> RespError "storage_error" (T.pack err)
|
||||
result <- runStorageCoded session payload
|
||||
let response = case result of
|
||||
Left err -> RespError (sessCode err) (sessMessage err)
|
||||
Right value -> RespStorage value
|
||||
pure (response, True)
|
||||
ReqCatalog -> do
|
||||
@@ -302,6 +348,45 @@ dispatch env session entry request = case request of
|
||||
ReqPing -> pure (RespPong, True)
|
||||
ReqQuit -> pure (RespBye, False)
|
||||
|
||||
-- 消费一次性证明并登录本机映射账号。
|
||||
sudoLogin :: ServerEnv -> Session -> LiveEntry -> Text -> Text -> IO ServerResponse
|
||||
sudoLogin env session entry user proof = do
|
||||
challenge <- atomicModifyIORef' (leChallenge entry) (\value -> (Nothing, value))
|
||||
configured <- readMVar (srvSudo env)
|
||||
now <- getCurrentTime
|
||||
who <- sessionUser session
|
||||
let key = T.toLower (T.strip user)
|
||||
mapped = maybe "" (\(_, name, _) -> name) configured
|
||||
valid = leLocal entry && who == Nothing && key == mapped
|
||||
&& case configured of
|
||||
Just (_, _, credential) -> validSudoChallenge credential now challenge key proof
|
||||
Nothing -> False
|
||||
blocked <- rateLimitBlock (srvLimiter env) key
|
||||
response <- case blocked of
|
||||
Just _ -> pure (RespError "too_many_attempts" "too many failed sudo logins")
|
||||
Nothing | not valid -> do
|
||||
rateLimitRecord (srvLimiter env) key
|
||||
pure (RespError "unauthorized" "sudo authentication refused")
|
||||
Nothing -> do
|
||||
result <- authenticateSudoSessionCoded session key
|
||||
case result of
|
||||
Left err -> do
|
||||
rateLimitRecord (srvLimiter env) key
|
||||
pure (RespError (sessCode err) (sessMessage err))
|
||||
Right () -> do
|
||||
rateLimitClear (srvLimiter env) key
|
||||
writeIORef (leWho entry) (Just key)
|
||||
admin <- sessionIsAdmin session
|
||||
pure (RespLogin key admin)
|
||||
hPutStrLn stderr ("sudo_auth attempt: mapped_user=" ++ T.unpack mapped
|
||||
++ " local=" ++ show (leLocal entry) ++ " result=" ++ auditResult response)
|
||||
pure response
|
||||
where
|
||||
-- 提取不包含凭据的认证审计结果。
|
||||
auditResult RespLogin{} = "accepted"
|
||||
auditResult (RespError code _) = T.unpack code
|
||||
auditResult _ = "refused"
|
||||
|
||||
-- | 口令策略在线上只有两个数字:最短长度与至少几类字符
|
||||
policyResponse :: PasswordPolicy -> ServerResponse
|
||||
policyResponse (PasswordPolicy minLength classes) = RespPolicy minLength classes
|
||||
|
||||
@@ -5,18 +5,22 @@ module Main (main) where
|
||||
|
||||
import ChuSQL.Core.Engine.Storage.IPC (
|
||||
Account (..),
|
||||
Request (ReqAccountReset, ReqAccountsList),
|
||||
Request (ReqAccountCreate, ReqAccountReset, ReqAccountsList, ReqIdentityAlter),
|
||||
TableInfo (..),
|
||||
closeConnection,
|
||||
localStorageLink,
|
||||
setStorageLink,
|
||||
)
|
||||
import ChuSQL.Core.Engine.Syntax.AST (Statement)
|
||||
import Data.IORef (newIORef, readIORef, writeIORef)
|
||||
import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
|
||||
import ChuSQL.Core.Model (Database, Histogram (..), Row, Table (..), Value (..), pattern TInt, pattern TStr)
|
||||
import ChuSQL.Interface.Auth (hashPasswordWith)
|
||||
import ChuSQL.Interface.Protocol (ClientRequest (..), Grant (..), RoleView (..), ServerResponse (..), decodeRequest, encodeResponse)
|
||||
import ChuSQL.Interface.RateLimit (newRateLimiter)
|
||||
import ChuSQL.Interface.Link (connectClient, closeClient, clientSudoLogin, clientQuery)
|
||||
import ChuSQL.Interface.Sudo (SudoCredential, newSudoCredential, sudoProof, verifySudoProof, validSudoChallenge,
|
||||
createSudoCredential, removeSudoCredential, readSudoCredential, sudoPrivileged)
|
||||
import ChuSQL.Server.Accounts (Principal (..), ensureRootAccount)
|
||||
import ChuSQL.Server.Backend (Backend (..), StatementResult (..), ipcBackend, memoryBackend)
|
||||
import ChuSQL.Server.Privileges (
|
||||
@@ -25,24 +29,30 @@ import ChuSQL.Server.Privileges (
|
||||
Privileges,
|
||||
affectedAccounts,
|
||||
authorize,
|
||||
authorizeConnect,
|
||||
claimObject,
|
||||
prepareObject,
|
||||
listRoleViews,
|
||||
newPrivileges,
|
||||
runPrivilegeCommand,
|
||||
)
|
||||
import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), newSession, runStatementCoded)
|
||||
import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), newSession, runStatementCoded, runStorageCoded, authenticateSessionCoded)
|
||||
import ChuSQL.Server.TCP (
|
||||
ServerConfig (..),
|
||||
ServerEnv,
|
||||
ServerEnv (..),
|
||||
ServerHandle (..),
|
||||
defaultServerConfig,
|
||||
loadServerConfigAt,
|
||||
newServerEnv,
|
||||
startServer,
|
||||
isLocalPeer,
|
||||
)
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
|
||||
import Control.Concurrent.MVar (MVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, takeMVar)
|
||||
import System.Timeout (timeout)
|
||||
import Control.Exception (IOException, bracket, finally, try)
|
||||
import Control.Monad (void)
|
||||
import Data.List (sort)
|
||||
import Data.Aeson (decode)
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.Key as K
|
||||
@@ -54,9 +64,12 @@ import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import Data.Time.Clock (addUTCTime, getCurrentTime)
|
||||
import Network.Socket (
|
||||
AddrInfo (..),
|
||||
SockAddr (..),
|
||||
tupleToHostAddress,
|
||||
tupleToHostAddress6,
|
||||
SocketType (Stream),
|
||||
addrAddress,
|
||||
addrFamily,
|
||||
@@ -81,7 +94,6 @@ import System.IO (
|
||||
hSetNewlineMode,
|
||||
noNewlineTranslation,
|
||||
)
|
||||
import System.Timeout (timeout)
|
||||
import Test.Hspec hiding (after, before)
|
||||
|
||||
-- TCP 服务器测试:协议编解码、配置读取与真连服务器的端到端用例。
|
||||
@@ -93,9 +105,119 @@ main = hspec spec
|
||||
-- | 全部用例
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "sudo authentication" $ do
|
||||
it "defaults to disabled and rejects unconfigured TCP authentication" $
|
||||
withTcpServer defaultServerConfig $ \_ handle -> withConnection handle $ \client -> do
|
||||
scSudoUser defaultServerConfig `shouldBe` ""
|
||||
challenge <- tcpTalk client "{\"method\":\"sudo_challenge\"}"
|
||||
at "code" challenge `shouldBe` A.String "forbidden"
|
||||
denied <- tcpTalk client "{\"method\":\"sudo_login\",\"user\":\"admin\",\"proof\":\"fake\"}"
|
||||
at "code" denied `shouldBe` A.String "unauthorized"
|
||||
it "loads an explicit normalized local identity mapping" $ do
|
||||
path <- tempSettingsPath "sudo-config"
|
||||
writeFile path (unlines ["[server]", "sudo_auth_user = " ++ show ("Local_User" :: String)])
|
||||
config <- loadServerConfigAt path `finally` removeIfExists path
|
||||
scSudoUser config `shouldBe` "local_user"
|
||||
it "supports the client challenge and login exchange" $
|
||||
withTestSudo $ \_ handle credential -> do
|
||||
connected <- connectClient "127.0.0.1" (shPort handle)
|
||||
case connected of
|
||||
Left message -> expectationFailure (T.unpack message)
|
||||
Right client -> (do
|
||||
clientSudoLogin client credential "local_user" >>= (`shouldBe` Right False)
|
||||
result <- clientQuery client "select 1"
|
||||
result `shouldSatisfy` isRightResult) `finally` closeClient client
|
||||
it "only treats kernel loopback addresses as local" $ do
|
||||
isLocalPeer (SockAddrInet 7777 (tupleToHostAddress (127, 0, 0, 1))) `shouldBe` True
|
||||
isLocalPeer (SockAddrInet 7777 (tupleToHostAddress (192, 168, 1, 2))) `shouldBe` False
|
||||
isLocalPeer (SockAddrInet6 7777 0 (tupleToHostAddress6 (0,0,0,0,0,0,0,1)) 0) `shouldBe` True
|
||||
isLocalPeer (SockAddrInet6 7777 0 (tupleToHostAddress6 (0,0,0,0,0,65535,32512,1)) 0) `shouldBe` True
|
||||
isLocalPeer (SockAddrInet6 7777 0 (tupleToHostAddress6 (0,0,0,0,0,65535,49320,1)) 0) `shouldBe` False
|
||||
it "binds proofs to the instance, challenge, account and expiration" $ do
|
||||
credential <- newSudoCredential
|
||||
other <- newSudoCredential
|
||||
now <- getCurrentTime
|
||||
let proof = sudoProof credential "nonce" "local_user"
|
||||
verifySudoProof credential "nonce" "LOCAL_USER" proof `shouldBe` True
|
||||
verifySudoProof other "nonce" "local_user" proof `shouldBe` False
|
||||
verifySudoProof credential "other" "local_user" proof `shouldBe` False
|
||||
verifySudoProof credential "nonce" "admin" proof `shouldBe` False
|
||||
validSudoChallenge credential now (Just ("nonce", addUTCTime (-61) now)) "local_user" proof `shouldBe` False
|
||||
validSudoChallenge credential now (Just ("nonce", addUTCTime 1 now)) "local_user" proof `shouldBe` False
|
||||
validSudoChallenge credential now Nothing "local_user" proof `shouldBe` False
|
||||
it "requires an OS elevated identity to provision or read credentials" $ do
|
||||
privileged <- sudoPrivileged
|
||||
if privileged then do
|
||||
bracket (createSudoCredential 65534) (const (removeSudoCredential 65534)) $ \credential -> do
|
||||
stored <- readSudoCredential 65534
|
||||
case stored of
|
||||
Left message -> expectationFailure (T.unpack message)
|
||||
Right restored -> sudoProof restored "native" "local_user" `shouldBe` sudoProof credential "native" "local_user"
|
||||
duplicate <- try (createSudoCredential 65534) :: IO (Either IOException SudoCredential)
|
||||
duplicate `shouldSatisfy` isLeftResult
|
||||
else do
|
||||
created <- try (createSudoCredential 65534) :: IO (Either IOException SudoCredential)
|
||||
created `shouldSatisfy` isLeftResult
|
||||
readSudoCredential 65534 >>= (`shouldSatisfy` isLeftResult)
|
||||
it "logs in an ordinary mapped identity without elevating its privileges" $
|
||||
withTestSudo $ \_ handle credential -> withConnection handle $ \client -> do
|
||||
answer <- tcpSudo client credential "local_user"
|
||||
at "status" answer `shouldBe` A.String "ok"
|
||||
at "admin" answer `shouldBe` A.Bool False
|
||||
denied <- tcpQuery client "create database forbidden"
|
||||
at "code" denied `shouldBe` A.String "forbidden"
|
||||
it "rejects a forged proof and consumes its challenge" $
|
||||
withTestSudo $ \_ handle credential -> withConnection handle $ \client -> do
|
||||
nonce <- tcpTalk client "{\"method\":\"sudo_challenge\"}"
|
||||
denied <- tcpTalk client "{\"method\":\"sudo_login\",\"user\":\"local_user\",\"proof\":\"forged\"}"
|
||||
at "code" denied `shouldBe` A.String "unauthorized"
|
||||
replay <- tcpSudoProof client "local_user" (sudoProof credential (asText (at "challenge" nonce)) "local_user")
|
||||
at "code" replay `shouldBe` A.String "unauthorized"
|
||||
it "rejects proof reuse on another connection and account mapping" $
|
||||
withTestSudo $ \_ handle credential -> withConnection handle $ \first -> withConnection handle $ \second -> do
|
||||
nonce <- tcpTalk first "{\"method\":\"sudo_challenge\"}"
|
||||
let proof = sudoProof credential (asText (at "challenge" nonce)) "local_user"
|
||||
replay <- tcpSudoProof second "local_user" proof
|
||||
at "code" replay `shouldBe` A.String "unauthorized"
|
||||
mismatch <- tcpSudo first credential "admin"
|
||||
at "code" mismatch `shouldBe` A.String "unauthorized"
|
||||
it "revokes the attribute and drops existing sudo sessions" $
|
||||
withTestSudo $ \_ handle credential -> withConnection handle $ \admin -> withConnection handle $ \client -> do
|
||||
_ <- tcpLogin admin testRootName testRootPassword
|
||||
_ <- tcpSudo client credential "local_user"
|
||||
changed <- tcpQuery admin "alter user local_user noallow_sudo_auth"
|
||||
at "status" changed `shouldBe` A.String "result"
|
||||
expired <- tcpQuery client "select 1"
|
||||
at "code" expired `shouldBe` A.String "unauthorized"
|
||||
tcpClosed client
|
||||
withConnection handle $ \fresh -> do
|
||||
denied <- tcpSudo fresh credential "local_user"
|
||||
at "code" denied `shouldBe` A.String "unauthorized"
|
||||
it "rejects disabled and NOLOGIN identities" $
|
||||
withTestSudo $ \_ handle credential -> withConnection handle $ \admin -> do
|
||||
_ <- tcpLogin admin testRootName testRootPassword
|
||||
mapM_ (checkSudoDisabled admin handle credential)
|
||||
["alter user local_user disabled", "alter user local_user enabled nologin"]
|
||||
it "does not inherit sudo authentication from a role" $
|
||||
withTestSudo $ \_ handle credential -> withConnection handle $ \admin -> do
|
||||
_ <- tcpLogin admin testRootName testRootPassword
|
||||
_ <- tcpQuery admin "create role sudo_role"
|
||||
_ <- tcpQuery admin "alter role sudo_role allow_sudo_auth"
|
||||
_ <- tcpQuery admin "grant sudo_role to local_user"
|
||||
_ <- tcpQuery admin "alter user local_user noallow_sudo_auth"
|
||||
withConnection handle $ \client -> do
|
||||
denied <- tcpSudo client credential "local_user"
|
||||
at "code" denied `shouldBe` A.String "unauthorized"
|
||||
it "keeps password login independent of the sudo attribute" $
|
||||
withTestSudo $ \_ handle _ -> withConnection handle $ \client -> do
|
||||
denied <- tcpLogin client "local_user" ""
|
||||
at "code" denied `shouldBe` A.String "unauthorized"
|
||||
accepted <- tcpLogin client "local_user" "Local-Pass123!"
|
||||
at "status" accepted `shouldBe` A.String "ok"
|
||||
tcpSpec
|
||||
tcpServerSpec
|
||||
privilegeSpec
|
||||
objectPrivilegeSpec
|
||||
transactionSpec
|
||||
ipcConcurrencySpec
|
||||
identitySpec
|
||||
@@ -118,7 +240,7 @@ identitySpec = describe "unified identities" $ do
|
||||
switched <- tcpQuery manager "use system"
|
||||
asText (at "status" switched) `shouldBe` "result"
|
||||
mapM_ (\sql -> tcpQuery manager sql >>= \reply -> asText (at "code" reply) `shouldBe` "forbidden")
|
||||
["alter user manager superuser", "alter user managed system_catalog_manager", "alter user admin identified by 'Another-Pass123!'", "create database forbidden"]
|
||||
["alter user manager superuser", "alter user managed system_catalog_manager", "alter user managed allow_sudo_auth", "alter user admin identified by 'Another-Pass123!'", "create database forbidden"]
|
||||
it "does not inherit catalog management through role membership" $ withTcpServer defaultServerConfig $ \_ handle ->
|
||||
withConnection handle $ \admin -> withConnection handle $ \worker -> do
|
||||
_ <- tcpLogin admin "admin" "s3cret"
|
||||
@@ -139,7 +261,7 @@ identitySpec = describe "unified identities" $ do
|
||||
other <- tcpQuery h "create role alice"
|
||||
asText (at "code" other) `shouldBe` "conflict"
|
||||
shown <- tcpQuery h "show roles"
|
||||
map asText (items (at "columns" shown)) `shouldBe` ["id", "name", "can_login", "is_superuser", "enabled", "system_catalog_manager", "created_at"]
|
||||
map asText (items (at "columns" shown)) `shouldBe` ["id", "name", "can_login", "is_superuser", "enabled", "system_catalog_manager", "allow_sudo_auth", "created_at"]
|
||||
asInt (at "rowCount" shown) `shouldBe` 3
|
||||
reader <- tcpQuery h "alter role reader login nologin"
|
||||
asText (at "code" reader) `shouldBe` "bad_request"
|
||||
@@ -697,7 +819,7 @@ tcpServerSpec = do
|
||||
|
||||
-- | 一个普通账号
|
||||
testAccount :: Account
|
||||
testAccount = Account 0 "alice" "" 0 "" Nothing True False True False
|
||||
testAccount = Account 0 "alice" "" 0 "" Nothing True False True False False
|
||||
|
||||
-- | 权限用例传的当前库名
|
||||
testDatabase :: Text
|
||||
@@ -707,7 +829,10 @@ testDatabase = T.pack testDatabaseName
|
||||
withPrivileges :: (Privileges -> Principal -> IO a) -> IO a
|
||||
withPrivileges body = do
|
||||
db <- newMVar testDb
|
||||
service <- newPrivileges (memoryBackend testDatabaseName db)
|
||||
let backend = memoryBackend testDatabaseName db
|
||||
_ <- beAccounts backend (ReqAccountCreate "alice" "hash")
|
||||
_ <- beAccounts backend (ReqAccountCreate "bob" "hash")
|
||||
service <- newPrivileges backend
|
||||
body service (Root testRootName)
|
||||
|
||||
-- | 解析一条 SQL,失败就丢掉用例
|
||||
@@ -747,7 +872,7 @@ privilegeSpec = describe "server privileges" $ do
|
||||
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 "*")
|
||||
fmap (concatMap (map grantObject) . map roleGrants) views `shouldBe` Right (replicate 4 "test.*")
|
||||
|
||||
it "revokes a privilege again" $ withPrivileges $ \service root -> do
|
||||
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
|
||||
@@ -919,12 +1044,12 @@ privilegeSpec = describe "server privileges" $ do
|
||||
_ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "inner" ["reader"])
|
||||
_ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"])
|
||||
directly <- affectedAccounts service (RevokeRoleCommand "inner" ["bob"])
|
||||
directly `shouldMatchList` ["bob"]
|
||||
fmap sort directly `shouldBe` Right ["bob"]
|
||||
granted <- affectedAccounts service (GrantRoleCommand "writer" ["inner"])
|
||||
granted `shouldMatchList` ["inner", "reader", "alice"]
|
||||
fmap sort granted `shouldBe` Right (sort ["inner", "reader", "alice"])
|
||||
dropped <- affectedAccounts service (DropRoleCommand "inner")
|
||||
dropped `shouldMatchList` ["inner", "reader", "alice"]
|
||||
affectedAccounts service (CreateRoleCommand "other") `shouldReturn` []
|
||||
fmap sort dropped `shouldBe` Right (sort ["inner", "reader", "alice"])
|
||||
affectedAccounts service (CreateRoleCommand "other") `shouldReturn` Right []
|
||||
|
||||
it "keeps the role tables on the real storage" $ withIpcStorage $ do
|
||||
base <- ipcBackend
|
||||
@@ -944,6 +1069,7 @@ privilegeSpec = describe "server privileges" $ do
|
||||
|
||||
it "inherits a role on the real storage" $ withIpcStorage $ do
|
||||
base <- ipcBackend
|
||||
seedPrivilegeObjects base
|
||||
service <- newPrivileges base
|
||||
_ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "reader")
|
||||
_ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "writer")
|
||||
@@ -955,6 +1081,7 @@ privilegeSpec = describe "server privileges" $ do
|
||||
|
||||
it "keeps a grant option on the real storage" $ withIpcStorage $ do
|
||||
base <- ipcBackend
|
||||
seedPrivilegeObjects base
|
||||
service <- newPrivileges base
|
||||
_ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "reader")
|
||||
_ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "writer")
|
||||
@@ -968,6 +1095,239 @@ privilegeSpec = describe "server privileges" $ do
|
||||
fmap (map roleGrants) after `shouldBe` Right [[Grant "reader" "select" "test.users" True], [Grant "writer" "select" "test.users" False]]
|
||||
|
||||
-- 真存储夹具:一个用例一份数据目录,跑完关链路删干净
|
||||
-- 创建独立的对象授权内存夹具。
|
||||
withObjectPrivileges :: (Backend -> Privileges -> Principal -> IO ()) -> IO ()
|
||||
withObjectPrivileges body = do
|
||||
db <- newMVar testDb
|
||||
let backend = memoryBackend testDatabaseName db
|
||||
mapM_ (\name -> beAccounts backend (ReqAccountCreate name "hash") >>= either (fail . show) (const (pure ()))) ["alice", "bob", "carol"]
|
||||
service <- newPrivileges backend
|
||||
body backend service (Root testRootName)
|
||||
|
||||
-- 验证对象作用域、授权来源和外部入口。
|
||||
objectPrivilegeSpec :: Spec
|
||||
objectPrivilegeSpec = describe "stable object privileges" $ do
|
||||
it "migrates old table grants once and ignores later legacy writes" $ withObjectPrivileges $ \backend service _ -> do
|
||||
let system = beWithDatabase backend "system"
|
||||
mustRun (beStatement system "CREATE TABLE __system_grants (role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))")
|
||||
mustRun (beStatement system "INSERT INTO __system_grants (role, privilege, object) VALUES ('alice', 'select', 'test.users')")
|
||||
authorizeSql service (Ordinary testAccount) "SELECT * FROM users" `shouldReturn` Right ()
|
||||
mustRun (beStatement system "INSERT INTO __system_grants (role, privilege, object) VALUES ('bob', 'select', 'test.users')")
|
||||
authorizeSql service (Ordinary testAccount{accountUser = "bob"}) "SELECT * FROM users" `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
it "recovers a durable creator intent after table creation and cancels absent objects" $ withIpcStorage $ do
|
||||
backend <- ipcBackend
|
||||
seedPrivilegeObjects backend
|
||||
service <- newPrivileges backend
|
||||
prepareObject service (Ordinary testAccount) "test" "recovered_owned" `shouldReturn` Right ()
|
||||
mustRun (beStatement (beWithDatabase backend "test") "CREATE TABLE recovered_owned (id INT)")
|
||||
closeConnection
|
||||
dir <- ipcDataDir
|
||||
opened <- localStorageLink (Just (dir ++ ".toml"))
|
||||
link <- either fail pure opened
|
||||
setStorageLink link
|
||||
fresh <- ipcBackend >>= newPrivileges
|
||||
authorizeSql fresh (Ordinary testAccount) "SELECT * FROM recovered_owned" `shouldReturn` Right ()
|
||||
prepareObject fresh (Ordinary testAccount) "test" "never_created" `shouldReturn` Right ()
|
||||
authorizeSql fresh (Ordinary testAccount) "SELECT * FROM recovered_owned" `shouldReturn` Right ()
|
||||
mustRun (beStatement (beWithDatabase backend "test") "CREATE TABLE never_created (id INT)")
|
||||
authorizeSql fresh (Ordinary testAccount) "SELECT * FROM never_created" `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON never_created")
|
||||
it "holds authorization through a concurrent query and orders revocation after it" $ withObjectPrivileges $ \backend service root -> do
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "alice" False) `shouldReturn` Right ()
|
||||
_ <- beAccounts backend (ReqAccountCreate testRootName (testPasswordHash testRootPassword))
|
||||
_ <- beAccounts backend (ReqIdentityAlter testRootName Nothing (Just True) Nothing Nothing Nothing)
|
||||
_ <- beAccounts backend (ReqAccountReset "alice" (testPasswordHash "Alice-Secret-1234"))
|
||||
started <- newEmptyMVar
|
||||
release <- newEmptyMVar
|
||||
finished <- newEmptyMVar
|
||||
revoked <- newEmptyMVar
|
||||
let slow = backend{beWithDatabase = \name -> (beWithDatabase backend name){beStatement = \sql -> do
|
||||
if sql == "SELECT * FROM users" then putMVar started () >> takeMVar release else pure ()
|
||||
beStatement (beWithDatabase backend name) sql}}
|
||||
settings <- tempSettingsPath "permission-race"
|
||||
reader <- newSession slow testRootName settings
|
||||
admin <- newSession backend testRootName settings
|
||||
authenticateSessionCoded reader "alice" "Alice-Secret-1234" `shouldReturn` Right ()
|
||||
authenticateSessionCoded admin testRootName testRootPassword `shouldReturn` Right ()
|
||||
_ <- mustSql reader "USE test"
|
||||
_ <- mustSql admin "USE test"
|
||||
_ <- forkIO (runStatementCoded reader "SELECT * FROM users" >>= putMVar finished)
|
||||
takeMVar started
|
||||
_ <- forkIO (runStatementCoded admin "REVOKE SELECT ON users FROM alice" >>= putMVar revoked)
|
||||
blocked <- timeout 100000 (takeMVar revoked)
|
||||
case blocked of Nothing -> pure (); Just _ -> expectationFailure "revocation raced past an authorized query"
|
||||
putMVar release ()
|
||||
takeMVar finished >>= either (expectationFailure . show) (const (pure ()))
|
||||
takeMVar revoked >>= either (expectationFailure . show) (const (pure ()))
|
||||
result <- runStatementCoded reader "SELECT * FROM users"
|
||||
case result of Left err -> sessCode err `shouldBe` "forbidden"; Right _ -> expectationFailure "revoked privilege remained active"
|
||||
it "requires existing objects and validates database privilege scope" $ withObjectPrivileges $ \_ service root -> do
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "missing" "alice" False)
|
||||
`shouldReturn` Left (PrivilegeError "not_found" "unknown table")
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "database:test" "alice" False)
|
||||
`shouldReturn` Left (PrivilegeError "bad_request" "invalid privilege for object scope")
|
||||
it "applies PUBLIC CONNECT defaults and explicit inherited connections" $ withObjectPrivileges $ \_ service root -> do
|
||||
authorizeConnect service (Ordinary testAccount) "test" `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root "" (RevokePrivilegesCommand ["connect"] "database:test" "public") `shouldReturn` Right ()
|
||||
authorizeConnect service (Ordinary testAccount) "test" `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: CONNECT ON database:test")
|
||||
runPrivilegeCommand service root "" (CreateRoleCommand "connector") `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root "" (GrantPrivilegesCommand ["connect"] "database:test" "connector" False) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root "" (GrantRoleCommand "connector" ["alice"]) `shouldReturn` Right ()
|
||||
authorizeConnect service (Ordinary testAccount) "test" `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root "" (GrantPrivilegesCommand ["connect"] "database:test" "public" False) `shouldReturn` Right ()
|
||||
it "grants CREATE without granting existing table access" $ withObjectPrivileges $ \_ service root -> do
|
||||
runPrivilegeCommand service root "" (GrantPrivilegesCommand ["create"] "database:test" "alice" False) `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "CREATE TABLE owned (id INT)" `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "SELECT * FROM users" `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
it "gives table owners management and delegation without giving database management" $ withObjectPrivileges $ \_ service root -> do
|
||||
claimObject service (Ordinary testAccount) testDatabase "users" `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "DROP TABLE users" `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "INSERT INTO users (id) VALUES (10)" `shouldReturn` Right ()
|
||||
runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "bob" False) `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "DROP DATABASE test" `shouldReturn` Left (PrivilegeError "forbidden" "object owner required")
|
||||
runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "alice") `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "SELECT * FROM users" `shouldReturn` Right ()
|
||||
it "cascades multihop delegations after the source grant is revoked" $ withObjectPrivileges $ \_ service root -> do
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "alice" True) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "bob" True) `shouldReturn` Right ()
|
||||
let bob = Ordinary testAccount{accountUser = "bob"}
|
||||
runPrivilegeCommand service bob testDatabase (GrantPrivilegesCommand ["select"] "users" "carol" False) `shouldReturn` Right ()
|
||||
affectedAccounts service (RevokePrivilegesCommand ["select"] "users" "alice") `shouldReturn` Right ["alice", "bob", "carol"]
|
||||
runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "alice") `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount{accountUser = "carol"}) "SELECT * FROM users"
|
||||
`shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
it "keeps an independent source when another delegation chain is revoked" $ withObjectPrivileges $ \_ service root -> do
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "alice" True) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "bob" False) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "bob" False) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "alice") `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount{accountUser = "bob"}) "SELECT * FROM users" `shouldReturn` Right ()
|
||||
it "removes delegations whose grantor loses an inherited source" $ withObjectPrivileges $ \_ service root -> do
|
||||
runPrivilegeCommand service root testDatabase (CreateRoleCommand "delegator") `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "delegator" True) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root testDatabase (GrantRoleCommand "delegator" ["alice"]) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "bob" False) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root testDatabase (RevokeRoleCommand "delegator" ["alice"]) `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount{accountUser = "bob"}) "SELECT * FROM users" `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
it "does not preserve circular delegation after its last independent root is revoked" $ withObjectPrivileges $ \_ service root -> do
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "alice" True) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "bob" True) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service (Ordinary testAccount{accountUser = "bob"}) testDatabase (GrantPrivilegesCommand ["select"] "users" "alice" True) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "alice") `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount{accountUser = "bob"}) "SELECT * FROM users" `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
it "never transfers a dropped table's grant to a same-name replacement" $ withObjectPrivileges $ \backend service root -> do
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "alice" False) `shouldReturn` Right ()
|
||||
mustRun (beStatement backend "DROP TABLE users")
|
||||
mustRun (beStatement backend "CREATE TABLE users (id INT)")
|
||||
authorizeSql service (Ordinary testAccount) "SELECT * FROM users" `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
it "does not let disabled grantors keep downstream grants alive" $ withObjectPrivileges $ \backend service root -> do
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "alice" True) `shouldReturn` Right ()
|
||||
runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "bob" False) `shouldReturn` Right ()
|
||||
changed <- beAccounts backend (ReqIdentityAlter "alice" Nothing Nothing (Just False) Nothing Nothing)
|
||||
either expectationFailure (const (pure ())) changed
|
||||
authorizeSql service (Ordinary testAccount{accountUser = "bob"}) "SELECT * FROM users" `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
it "preserves dormant direct grants and ownership across unrelated ACL writes" $ withObjectPrivileges $ \backend service root -> do
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "alice" False) `shouldReturn` Right ()
|
||||
mustRun (beStatement backend "CREATE TABLE owned (id INT)")
|
||||
claimObject service (Ordinary testAccount) testDatabase "owned" `shouldReturn` Right ()
|
||||
changed <- beAccounts backend (ReqIdentityAlter "alice" Nothing Nothing (Just False) Nothing Nothing)
|
||||
either expectationFailure (const (pure ())) changed
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "bob" False) `shouldReturn` Right ()
|
||||
enabled <- beAccounts backend (ReqIdentityAlter "alice" Nothing Nothing (Just True) Nothing Nothing)
|
||||
either expectationFailure (const (pure ())) enabled
|
||||
authorizeSql service (Ordinary testAccount) "SELECT * FROM users" `shouldReturn` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "DROP TABLE owned" `shouldReturn` Right ()
|
||||
it "keeps same-name tables in separate database scopes and persists the ACL" $ withIpcStorage $ do
|
||||
backend <- ipcBackend
|
||||
seedPrivilegeObjects backend
|
||||
mustRun (beStatement backend "CREATE DATABASE other")
|
||||
mustRun (beStatement (beWithDatabase backend "other") "CREATE TABLE users (id INT)")
|
||||
service <- newPrivileges backend
|
||||
runPrivilegeCommand service (Root testRootName) "test" (GrantPrivilegesCommand ["select"] "users" "alice" False) `shouldReturn` Right ()
|
||||
statement <- parseOrFail "SELECT * FROM users"
|
||||
authorize service (Ordinary testAccount) "other" statement `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
closeConnection
|
||||
dir <- ipcDataDir
|
||||
opened <- localStorageLink (Just (dir ++ ".toml"))
|
||||
link <- either fail pure opened
|
||||
setStorageLink link
|
||||
fresh <- ipcBackend >>= newPrivileges
|
||||
authorize fresh (Ordinary testAccount) "test" statement `shouldReturn` Right ()
|
||||
authorize fresh (Ordinary testAccount) "other" statement `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
it "checks CONNECT and CREATE through TCP and assigns ownership to the creator" $
|
||||
withTcpServer defaultServerConfig $ \_ handle -> withConnection handle $ \admin -> do
|
||||
_ <- tcpLogin admin "admin" "s3cret"
|
||||
_ <- tcpQuery admin "CREATE USER object_owner IDENTIFIED BY 'Owner-Secret-1234'"
|
||||
tcpQuery admin "REVOKE CONNECT ON DATABASE test FROM PUBLIC" >>= \reply -> at "status" reply `shouldBe` A.String "result"
|
||||
withConnection handle $ \client -> do
|
||||
_ <- tcpLogin client "object_owner" "Owner-Secret-1234"
|
||||
tcpQuery client "USE test" >>= \reply -> at "code" reply `shouldBe` A.String "forbidden"
|
||||
_ <- tcpQuery admin "GRANT CONNECT, CREATE ON DATABASE test TO object_owner"
|
||||
withConnection handle $ \client -> do
|
||||
_ <- tcpLogin client "object_owner" "Owner-Secret-1234"
|
||||
tcpQuery client "USE test" >>= \reply -> at "status" reply `shouldBe` A.String "result"
|
||||
tcpQuery client "CREATE TABLE owned_probe (id INT)" >>= \reply -> at "status" reply `shouldBe` A.String "result"
|
||||
tcpQuery client "INSERT INTO owned_probe (id) VALUES (1)" >>= \reply -> at "status" reply `shouldBe` A.String "result"
|
||||
tcpQuery client "SELECT * FROM users" >>= \reply -> at "code" reply `shouldBe` A.String "forbidden"
|
||||
tcpTalk client "{\"method\":\"storage\",\"request\":{\"method\":\"scan\",\"database\":\"test\",\"table\":\"users\"}}" >>= \reply -> at "code" reply `shouldBe` A.String "forbidden"
|
||||
it "disconnects downstream TCP grantees and protects staged commits after revocation" $
|
||||
withTcpServer defaultServerConfig $ \_ handle -> withConnection handle $ \admin -> do
|
||||
_ <- tcpLogin admin "admin" "s3cret"
|
||||
_ <- tcpQuery admin "USE test"
|
||||
_ <- tcpQuery admin "CREATE USER source_user IDENTIFIED BY 'Source-Secret-1234'"
|
||||
_ <- tcpQuery admin "CREATE USER target_user IDENTIFIED BY 'Target-Secret-1234'"
|
||||
_ <- tcpQuery admin "GRANT SELECT, UPDATE ON users TO source_user WITH GRANT OPTION"
|
||||
withConnection handle $ \source -> do
|
||||
_ <- tcpLogin source "source_user" "Source-Secret-1234"
|
||||
_ <- tcpQuery source "USE test"
|
||||
_ <- tcpQuery source "GRANT SELECT, UPDATE ON users TO target_user"
|
||||
withConnection handle $ \target -> do
|
||||
_ <- tcpLogin target "target_user" "Target-Secret-1234"
|
||||
_ <- tcpQuery target "USE test"
|
||||
_ <- tcpQuery target "BEGIN"
|
||||
_ <- tcpQuery target "UPDATE users SET age = 90 WHERE id = 1"
|
||||
_ <- tcpQuery admin "REVOKE UPDATE ON users FROM source_user"
|
||||
tcpQuery target "COMMIT" >>= \reply -> at "code" reply `shouldBe` A.String "unauthorized"
|
||||
tcpClosed target
|
||||
reply <- tcpQuery admin "SELECT age FROM users WHERE id = 1"
|
||||
map items (items (at "rows" reply)) `shouldBe` [[A.Number 21]]
|
||||
it "rejects a stale local transaction after a granted object is replaced" $ withObjectPrivileges $ \backend service root -> do
|
||||
runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["all"] "users" "alice" False) `shouldReturn` Right ()
|
||||
_ <- beAccounts backend (ReqAccountReset "alice" (testPasswordHash "Alice-Secret-1234"))
|
||||
settings <- tempSettingsPath "object-transaction"
|
||||
_ <- beAccounts backend (ReqAccountCreate testRootName (testPasswordHash testRootPassword))
|
||||
_ <- beAccounts backend (ReqIdentityAlter testRootName Nothing (Just True) Nothing Nothing Nothing)
|
||||
session <- newSession backend testRootName settings
|
||||
authenticateSessionCoded session "alice" "Alice-Secret-1234" `shouldReturn` Right ()
|
||||
_ <- mustSql session "USE test"
|
||||
_ <- mustSql session "BEGIN"
|
||||
_ <- mustSql session "UPDATE users SET age = 90 WHERE id = 1"
|
||||
mustRun (beStatement backend "DROP TABLE users")
|
||||
mustRun (beStatement backend "CREATE TABLE users (id INT, name VARCHAR(32), age INT)")
|
||||
result <- runStatementCoded session "COMMIT"
|
||||
case result of Left err -> sessCode err `shouldBe` "forbidden"; Right _ -> expectationFailure "stale transaction committed"
|
||||
it "checks the current administrator identity before executing a raw storage request" $ withObjectPrivileges $ \backend _ _ -> do
|
||||
_ <- beAccounts backend (ReqAccountCreate testRootName (testPasswordHash testRootPassword))
|
||||
_ <- beAccounts backend (ReqIdentityAlter testRootName Nothing (Just True) Nothing Nothing Nothing)
|
||||
_ <- beAccounts backend (ReqAccountCreate "spare_admin" "hash")
|
||||
_ <- beAccounts backend (ReqIdentityAlter "spare_admin" Nothing (Just True) Nothing Nothing Nothing)
|
||||
executed <- newIORef False
|
||||
let guarded = backend{beStorage = \_ -> writeIORef executed True >> pure (Right A.Null)}
|
||||
settings <- tempSettingsPath "raw-storage-identity"
|
||||
session <- newSession guarded testRootName settings
|
||||
authenticateSessionCoded session testRootName testRootPassword `shouldReturn` Right ()
|
||||
changed <- beAccounts backend (ReqIdentityAlter testRootName Nothing (Just False) Nothing Nothing Nothing)
|
||||
either expectationFailure (const (pure ())) changed
|
||||
result <- runStorageCoded session (A.object ["method" A..= ("ping" :: Text)])
|
||||
case result of Left err -> sessCode err `shouldBe` "unauthorized"; Right _ -> expectationFailure "stale administrator executed storage request"
|
||||
readIORef executed `shouldReturn` False
|
||||
|
||||
-- 为权限测试创建真实对象和登录身份。
|
||||
seedPrivilegeObjects :: Backend -> IO ()
|
||||
seedPrivilegeObjects backend = do
|
||||
mustRun (beStatement backend "CREATE DATABASE test")
|
||||
mustRun (beStatement (beWithDatabase backend "test") "CREATE TABLE users (id INT)")
|
||||
result <- beAccounts backend (ReqAccountCreate "alice" "hash")
|
||||
case result of Left err -> expectationFailure err; Right _ -> pure ()
|
||||
|
||||
-- | 本次用例的数据目录(用例串行跑,固定名够用)
|
||||
ipcDataDir :: IO FilePath
|
||||
@@ -1058,6 +1418,27 @@ intValues rows = [n | row <- rows, Just (VInt n) <- [nth 0 row]]
|
||||
-- | 显式事务用例
|
||||
transactionSpec :: Spec
|
||||
transactionSpec = describe "server transactions" $ do
|
||||
it "preserves concurrent changes in a large untouched table" $ withTwoSessions $ \first second -> do
|
||||
_ <- mustSql first "CREATE TABLE untouched (id INT, value INT)"
|
||||
let values = T.intercalate "," [T.pack ("(" ++ show key ++ ",0)") | key <- [1 .. 5000 :: Int]]
|
||||
_ <- mustSql first ("INSERT INTO untouched (id,value) VALUES " <> values)
|
||||
_ <- mustSql first "BEGIN"
|
||||
_ <- mustSql first "UPDATE users SET age = 77 WHERE id = 1"
|
||||
_ <- mustSql second "UPDATE untouched SET value = 9 WHERE id = 5000"
|
||||
_ <- mustSql first "COMMIT"
|
||||
sessionAge first 1 `shouldReturn` Just 77
|
||||
result <- mustSql first "SELECT value FROM untouched WHERE id = 5000"
|
||||
qrRows result `shouldBe` [[VInt 9]]
|
||||
|
||||
it "preserves staged row order for unsorted integer ids" $ withMemorySession $ \session -> do
|
||||
_ <- mustSql session "CREATE TABLE keys (id INT, value INT)"
|
||||
_ <- mustSql session "INSERT INTO keys (id,value) VALUES (7,0),(-3,0),(4,0)"
|
||||
_ <- mustSql session "BEGIN"
|
||||
_ <- mustSql session "UPDATE keys SET value = 1"
|
||||
_ <- mustSql session "COMMIT"
|
||||
result <- mustSql session "SELECT id FROM keys"
|
||||
qrRows result `shouldBe` [[VInt 7], [VInt (-3)], [VInt 4]]
|
||||
|
||||
it "filters qualified memory tables and preserves other databases on writes" $ do
|
||||
let local = Table "users" [("id", TInt)] [[("id", VInt 1)]] Nothing
|
||||
otherTable = Table "users" [("id", TInt)] [[("id", VInt 2)]] Nothing
|
||||
@@ -1504,3 +1885,46 @@ ipcConcurrencySpec = describe "server backend on the real storage" $ do
|
||||
intColumn "id" rows `shouldBe` [1]
|
||||
intColumn "age" rows `shouldBe` [31]
|
||||
|
||||
|
||||
-- 判断明确错误返回。
|
||||
isLeftResult :: Either a b -> Bool
|
||||
isLeftResult (Left _) = True
|
||||
isLeftResult _ = False
|
||||
|
||||
-- 启动带独立本机认证凭据的测试会话。
|
||||
withTestSudo :: (ServerEnv -> ServerHandle -> SudoCredential -> IO a) -> IO a
|
||||
withTestSudo body = withTcpServer defaultServerConfig $ \env handle -> do
|
||||
credential <- newSudoCredential
|
||||
withConnection handle $ \admin -> do
|
||||
_ <- tcpLogin admin testRootName testRootPassword
|
||||
created <- tcpQuery admin "create user local_user identified by 'Local-Pass123!'"
|
||||
at "status" created `shouldBe` A.String "result"
|
||||
enabled <- tcpQuery admin "alter user local_user allow_sudo_auth"
|
||||
at "status" enabled `shouldBe` A.String "result"
|
||||
modifyMVar_ (srvSudo env) (const (pure (Just (0, "local_user", credential))))
|
||||
body env handle credential `finally` modifyMVar_ (srvSudo env) (const (pure Nothing))
|
||||
|
||||
-- 交换本机挑战并提交账号绑定证明。
|
||||
tcpSudo :: Handle -> SudoCredential -> Text -> IO A.Value
|
||||
tcpSudo client credential user = do
|
||||
challenge <- tcpTalk client "{\"method\":\"sudo_challenge\"}"
|
||||
tcpSudoProof client user (sudoProof credential (asText (at "challenge" challenge)) user)
|
||||
|
||||
-- 发送本机认证证明。
|
||||
tcpSudoProof :: Handle -> Text -> Text -> IO A.Value
|
||||
tcpSudoProof client user proof = tcpTalk client (BL.toStrict (A.encode (A.object
|
||||
["method" A..= ("sudo_login" :: Text), "user" A..= user, "proof" A..= proof])))
|
||||
|
||||
-- 验证身份禁用或取消登录后拒绝本机认证。
|
||||
checkSudoDisabled :: Handle -> ServerHandle -> SudoCredential -> Text -> IO ()
|
||||
checkSudoDisabled admin handle credential sql = do
|
||||
changed <- tcpQuery admin sql
|
||||
at "status" changed `shouldBe` A.String "result"
|
||||
withConnection handle $ \client -> do
|
||||
denied <- tcpSudo client credential "local_user"
|
||||
at "code" denied `shouldBe` A.String "unauthorized"
|
||||
|
||||
-- 判断明确成功返回。
|
||||
isRightResult :: Either a b -> Bool
|
||||
isRightResult (Right _) = True
|
||||
isRightResult _ = False
|
||||
@@ -20,6 +20,7 @@ library
|
||||
, aeson
|
||||
, bytestring
|
||||
, chusql-core-model
|
||||
, chusql-core-engine
|
||||
, chusql-interface
|
||||
, containers
|
||||
, directory
|
||||
|
||||
@@ -21,7 +21,9 @@ module ChuSQL.Web.API (
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Model (Row, Value (..))
|
||||
import ChuSQL.Core.Protocol (Account (..), QueryResult (..), SchemaColumn (..), TableInfo (..))
|
||||
import ChuSQL.Core.Engine.Syntax.AST (Statement (BeginTransaction, CommitTransaction, RollbackTransaction))
|
||||
import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
|
||||
import ChuSQL.Core.Protocol (Account (..), QueryResult (..), SchemaColumn (..), TableInfo (..), valueToJSON)
|
||||
import ChuSQL.Interface.AccountTable (accountColumns, accountTableName, isAccountTable, passwordColumn, systemTableInfo)
|
||||
import ChuSQL.Interface.Actions (
|
||||
ColumnSpec (..),
|
||||
@@ -108,16 +110,19 @@ import ChuSQL.Web.UISettings (
|
||||
writeUISettings,
|
||||
)
|
||||
import Control.Concurrent.MVar (MVar, modifyMVar, newMVar, withMVar)
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Exception (IOException, try)
|
||||
import Control.Monad (forever, when)
|
||||
import Data.Aeson (FromJSON (..), eitherDecode, object, withObject, (.:), (.=))
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.Key as K
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)
|
||||
import Data.List (nub, sortBy)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Set as Set
|
||||
import Data.Maybe (catMaybes, fromMaybe)
|
||||
import Data.Scientific (fromFloatDigits)
|
||||
import Data.Text (Text)
|
||||
@@ -176,6 +181,7 @@ data AppEnv = AppEnv
|
||||
, aeUISettingsFile :: FilePath
|
||||
, aeEffective :: Map.Map Text Text
|
||||
, aeLog :: Text -> IO ()
|
||||
, aeReaperStarted :: IORef Bool
|
||||
}
|
||||
|
||||
-- | 一条网页会话:TCP 连接、登录状态与账号名
|
||||
@@ -184,6 +190,12 @@ data WebSession = WebSession
|
||||
, wsSession :: Session
|
||||
, wsUser :: Text
|
||||
, wsAdmin :: Bool
|
||||
, wsEditor :: Session
|
||||
, wsEditorClient :: Client
|
||||
, wsEdit :: IORef (Maybe (Text, Text))
|
||||
, wsEditReceipt :: IORef (Maybe (Text, A.Value, A.Value))
|
||||
, wsEditEnded :: IORef (Set.Set Text)
|
||||
, wsConsole :: IORef (Maybe (Text, Text))
|
||||
}
|
||||
|
||||
-- | 会话 Cookie 名
|
||||
@@ -201,6 +213,7 @@ newAppEnvAt :: FilePath -> Text -> Int -> RateLimiter -> FilePath -> IO AppEnv
|
||||
newAppEnvAt settingsFile host port limiter staticDir = do
|
||||
sessions <- newPayloadStore getCurrentTime defaultSessionPolicy
|
||||
liveRef <- newIORef defaultLive
|
||||
reaperStarted <- newIORef False
|
||||
uiSettingsFile <- resolveUISettingsFileSafe
|
||||
pure
|
||||
AppEnv
|
||||
@@ -215,6 +228,7 @@ newAppEnvAt settingsFile host port limiter staticDir = do
|
||||
, aeUISettingsFile = uiSettingsFile
|
||||
, aeEffective = Map.empty
|
||||
, aeLog = const (pure ())
|
||||
, aeReaperStarted = reaperStarted
|
||||
}
|
||||
|
||||
-- | 系统库:账号表住在这里,只有管理员能进
|
||||
@@ -256,6 +270,12 @@ liveBodyLimit env = lvBodyLimit <$> readLive env
|
||||
-- | 组装 WAI 应用:路由外套四层中间件
|
||||
webApp :: AppEnv -> IO Application
|
||||
webApp env = do
|
||||
started <- atomicModifyIORef' (aeReaperStarted env) (\old -> (True, old))
|
||||
when (not started) $ do
|
||||
_ <- forkIO $ forever $ do
|
||||
threadDelay 60000000
|
||||
sweepWebSessions env
|
||||
pure ()
|
||||
inner <- scottyApp (routes env)
|
||||
locks <- newMVar Map.empty
|
||||
pure (securityHeaders (sameOriginOnly (bodyLimitDynamic (liveBodyLimit env) (serializeSessions locks inner))))
|
||||
@@ -318,6 +338,10 @@ routes env = do
|
||||
post "/api/roles/:name/members" (withDatabase env addRoleMemberH)
|
||||
delete "/api/roles/:name/members/:user" (withDatabase env removeRoleMemberH)
|
||||
post "/api/query" (withDatabase env queryH)
|
||||
post "/api/query/rollback" (rollbackConsoleH env)
|
||||
post "/api/edit/begin" (beginEditH env)
|
||||
post "/api/edit/commit" (commitEditH env)
|
||||
post "/api/edit/rollback" (rollbackEditH env)
|
||||
notFound (notFoundH env)
|
||||
|
||||
-- | 先认会话,再按请求头切本会话的库
|
||||
@@ -331,7 +355,18 @@ withDatabase env action = do
|
||||
if chosen == systemDatabase && not (wsAdmin ws)
|
||||
then reply403 "the system database is only available to the administrator"
|
||||
else do
|
||||
ready <- liftIO (if T.null chosen then pure (Right ()) else switchDatabase (wsSession ws) chosen)
|
||||
editing <- header "X-ChuSQL-Edit"
|
||||
req <- request
|
||||
let snapshotRead = editing /= Nothing && requestMethod req == "GET" && take 2 (pathInfo req) == ["api", "tables"]
|
||||
console <- liftIO (readIORef (wsConsole ws))
|
||||
caller <- consoleOwner
|
||||
case console of
|
||||
Just (owner, database) | not snapshotRead &&
|
||||
(pathInfo req /= ["api", "query"] || caller /= owner || (not (T.null chosen) && chosen /= database)) ->
|
||||
apiError "conflict" "another SQL console owns this connection transaction; commit or rollback there first"
|
||||
_ -> pure ()
|
||||
current <- liftIO (sessionDatabase (wsSession ws))
|
||||
ready <- liftIO (if T.null chosen || chosen == current || snapshotRead then pure (Right ()) else switchDatabase (wsSession ws) chosen)
|
||||
case ready of
|
||||
Left message -> serverError message
|
||||
Right () -> action env
|
||||
@@ -347,11 +382,31 @@ requireDatabaseName ws = do
|
||||
-- | 取本请求的会话,没有令牌就 401
|
||||
requireSession :: AppEnv -> ActionM WebSession
|
||||
requireSession env = do
|
||||
liftIO (sweepWebSessions env)
|
||||
token <- requestSessionToken >>= maybe (apiError "unauthorized" "sign in first") pure
|
||||
found <- liftIO (lookupPayload (aeSessions env) token)
|
||||
case found of
|
||||
Nothing -> apiError "unauthorized" "sign in first"
|
||||
Just (_, ws) -> pure ws
|
||||
Just (_, ws) -> do
|
||||
editHeader <- fmap TL.toStrict <$> header "X-ChuSQL-Edit"
|
||||
req <- request
|
||||
case editHeader of
|
||||
Just editId | requestMethod req == "GET" && take 2 (pathInfo req) == ["api", "tables"] -> do
|
||||
active <- liftIO (readIORef (wsEdit ws))
|
||||
database <- maybe "" (T.toLower . TL.toStrict) <$> header "X-ChuSQL-Database"
|
||||
case active of
|
||||
Just (owner, name) | owner == editId && name == database ->
|
||||
pure ws {wsSession = wsEditor ws, wsClient = wsEditorClient ws}
|
||||
_ -> apiError "conflict" "the editing snapshot is no longer available; rollback and reload"
|
||||
_ -> pure ws
|
||||
|
||||
-- | 关闭网页会话的两个服务端连接。
|
||||
closeWebSession :: WebSession -> IO ()
|
||||
closeWebSession ws = endEdit ws >> writeIORef (wsConsole ws) Nothing >> closeClient (wsEditorClient ws) >> closeClient (wsClient ws)
|
||||
|
||||
-- | 清理过期会话与未提交快照。
|
||||
sweepWebSessions :: AppEnv -> IO ()
|
||||
sweepWebSessions env = sweepPayloads (aeSessions env) >>= mapM_ closeWebSession
|
||||
|
||||
-- | 管理员专属操作
|
||||
requireAdminSession :: AppEnv -> ActionM WebSession
|
||||
@@ -388,7 +443,7 @@ createDatabaseH env = do
|
||||
-- | 删除数据库;系统库 system 一律拒绝。
|
||||
dropDatabaseH :: AppEnv -> ActionM ()
|
||||
dropDatabaseH env = do
|
||||
ws <- requireAdminSession env
|
||||
ws <- requireSession env
|
||||
name <- pathParam "name"
|
||||
if reservedDatabase name
|
||||
then reply400 "bad_request" "the system database cannot be dropped"
|
||||
@@ -443,8 +498,7 @@ healthH = json (object ["status" .= ("ok" :: Text)])
|
||||
-- | 探活:回进程与存储状态,顺带清理过期会话
|
||||
statusH :: AppEnv -> ActionM ()
|
||||
statusH env = do
|
||||
expired <- liftIO (sweepPayloads (aeSessions env))
|
||||
liftIO (mapM_ (closeClient . wsClient) expired)
|
||||
liftIO (sweepWebSessions env)
|
||||
opened <- liftIO (connectClient (aeServerHost env) (aeServerPort env))
|
||||
case opened of
|
||||
Left message -> json (object ["status" .= ("ok" :: Text), "storage" .= ("down" :: Text), "detail" .= message])
|
||||
@@ -504,7 +558,21 @@ openSession env user password = do
|
||||
else serverError message
|
||||
Right () -> do
|
||||
admin <- liftIO (sessionIsAdmin session)
|
||||
token <- liftIO (createPayloadSession (aeSessions env) user (WebSession client session user admin))
|
||||
openedEditor <- liftIO (connectClient (aeServerHost env) (aeServerPort env))
|
||||
editorClient <- case openedEditor of
|
||||
Left message -> liftIO (closeClient client) >> serverError message
|
||||
Right connected -> pure connected
|
||||
editor <- liftIO (newSession editorClient)
|
||||
editorSigned <- liftIO (authenticateSession editor user password)
|
||||
case editorSigned of
|
||||
Left message -> liftIO (closeClient editorClient >> closeClient client) >> serverError message
|
||||
Right () -> pure ()
|
||||
edit <- liftIO (newIORef Nothing)
|
||||
receipt <- liftIO (newIORef Nothing)
|
||||
ended <- liftIO (newIORef Set.empty)
|
||||
console <- liftIO (newIORef Nothing)
|
||||
liftIO (sweepWebSessions env)
|
||||
token <- liftIO (createPayloadSession (aeSessions env) user (WebSession client session user admin editor editorClient edit receipt ended console))
|
||||
liftIO (rateLimitClear (aeLimiter env) user)
|
||||
setHeader "Set-Cookie" (TL.fromStrict (sessionCookie env token (Just (lvSessionMax live))))
|
||||
liftIO (aeLog env ("sign-in ok user=" <> user))
|
||||
@@ -513,6 +581,7 @@ openSession env user password = do
|
||||
-- | 退出:收掉会话与连接,清除 Cookie
|
||||
logoutH :: AppEnv -> ActionM ()
|
||||
logoutH env = do
|
||||
liftIO (sweepWebSessions env)
|
||||
token <- requestSessionToken
|
||||
case token of
|
||||
Nothing -> pure ()
|
||||
@@ -520,7 +589,7 @@ logoutH env = do
|
||||
gone <- liftIO (dropPayload (aeSessions env) t)
|
||||
case gone of
|
||||
Nothing -> pure ()
|
||||
Just ws -> liftIO (closeClient (wsClient ws))
|
||||
Just ws -> liftIO (closeWebSession ws)
|
||||
setHeader "Set-Cookie" (TL.fromStrict (sessionCookie env "" (Just 0)))
|
||||
status status204
|
||||
|
||||
@@ -1036,7 +1105,6 @@ createTableH :: AppEnv -> ActionM ()
|
||||
createTableH env = do
|
||||
ws <- requireSession env
|
||||
_ <- requireDatabaseName ws
|
||||
adminOnly ws
|
||||
withJsonObject env $ \o -> case decodeCreateTable o of
|
||||
Left err -> reply400 "bad_request" err
|
||||
Right spec -> case createTableSql spec of
|
||||
@@ -1048,7 +1116,6 @@ dropTableH :: AppEnv -> ActionM ()
|
||||
dropTableH env = do
|
||||
ws <- requireSession env
|
||||
_ <- requireDatabaseName ws
|
||||
adminOnly ws
|
||||
name <- pathParam "t"
|
||||
account <- accountRoute ws name
|
||||
if account
|
||||
@@ -1117,7 +1184,6 @@ createIndexH :: AppEnv -> ActionM ()
|
||||
createIndexH env = do
|
||||
ws <- requireSession env
|
||||
_ <- requireDatabaseName ws
|
||||
adminOnly ws
|
||||
name <- pathParam "t"
|
||||
account <- accountRoute ws name
|
||||
if account
|
||||
@@ -1137,7 +1203,6 @@ dropIndexH :: AppEnv -> ActionM ()
|
||||
dropIndexH env = do
|
||||
ws <- requireSession env
|
||||
_ <- requireDatabaseName ws
|
||||
adminOnly ws
|
||||
name <- pathParam "t"
|
||||
column <- pathParam "col"
|
||||
account <- accountRoute ws name
|
||||
@@ -1156,7 +1221,6 @@ dropColumnH :: AppEnv -> ActionM ()
|
||||
dropColumnH env = do
|
||||
ws <- requireSession env
|
||||
_ <- requireDatabaseName ws
|
||||
adminOnly ws
|
||||
name <- pathParam "t"
|
||||
column <- pathParam "col"
|
||||
account <- accountRoute ws name
|
||||
@@ -1233,7 +1297,7 @@ dropRoleH env = do
|
||||
-- | 给角色加权限
|
||||
grantRoleH :: AppEnv -> ActionM ()
|
||||
grantRoleH env = do
|
||||
ws <- requireAdminSession env
|
||||
ws <- requireSession env
|
||||
role <- pathParam "name"
|
||||
withJsonObject env $ \o -> case grantFields o of
|
||||
Left err -> reply400 "bad_request" err
|
||||
@@ -1243,7 +1307,7 @@ grantRoleH env = do
|
||||
-- | 收角色的权限
|
||||
revokeRoleH :: AppEnv -> ActionM ()
|
||||
revokeRoleH env = do
|
||||
ws <- requireAdminSession env
|
||||
ws <- requireSession env
|
||||
role <- pathParam "name"
|
||||
withJsonObject env $ \o -> case grantFields o of
|
||||
Left err -> reply400 "bad_request" err
|
||||
@@ -1418,7 +1482,219 @@ columnTypeText cols name = case [c | c <- cols, scName c == T.unpack name] of
|
||||
(c : _) -> T.pack (scType c)
|
||||
[] -> ""
|
||||
|
||||
-- | 查询接口:校验请求体后执行 SQL
|
||||
-- | 校验编辑事务的页面与数据库标识。
|
||||
editIdentity :: A.Object -> Either Text (Text, Text)
|
||||
editIdentity o = do
|
||||
owner <- textField "id" o
|
||||
database <- textField "database" o
|
||||
if T.null owner || T.length owner > 128 || not (isPlainIdentifier database)
|
||||
then Left "invalid edit identity or database"
|
||||
else Right (owner, T.toLower database)
|
||||
|
||||
-- | 开始或确认同一页面的编辑快照。
|
||||
beginEditH :: AppEnv -> ActionM ()
|
||||
beginEditH env = do
|
||||
ws <- requireSession env
|
||||
withJsonObject env $ \o -> case editIdentity o of
|
||||
Left message -> reply400 "bad_request" message
|
||||
Right identity@(owner, database) -> do
|
||||
when (database == systemDatabase) (apiError "bad_request" "system identities cannot be edited in a data transaction")
|
||||
active <- liftIO (readIORef (wsEdit ws))
|
||||
ended <- liftIO (readIORef (wsEditEnded ws))
|
||||
case active of
|
||||
Just existing | existing == identity -> json (object ["state" .= ("active" :: Text), "id" .= owner])
|
||||
Just _ -> apiError "conflict" "another page owns the editing transaction"
|
||||
Nothing | Set.member owner ended -> apiError "conflict" "this editing transaction has already ended"
|
||||
Nothing -> do
|
||||
switched <- liftIO (switchDatabase (wsEditor ws) database)
|
||||
either serverError pure switched
|
||||
begun <- liftIO (runStatement (wsEditor ws) "BEGIN")
|
||||
either serverError (const (pure ())) begun
|
||||
saved <- liftIO (runStatement (wsEditor ws) "SAVEPOINT web_edit_base")
|
||||
case saved of
|
||||
Left message -> do
|
||||
liftIO (closeClient (wsEditorClient ws))
|
||||
serverError message
|
||||
Right _ -> do
|
||||
liftIO (writeIORef (wsEdit ws) (Just identity))
|
||||
json (object ["state" .= ("active" :: Text), "id" .= owner])
|
||||
|
||||
-- | 确认当前页面仍持有编辑事务。
|
||||
requireEdit :: WebSession -> (Text, Text) -> ActionM ()
|
||||
requireEdit ws identity = do
|
||||
active <- liftIO (readIORef (wsEdit ws))
|
||||
when (active /= Just identity) (apiError "conflict" "editing transaction is stale; rollback and reload")
|
||||
|
||||
-- | 结束事务并禁止旧页面标识重新使用。
|
||||
endEdit :: WebSession -> IO ()
|
||||
endEdit ws = do
|
||||
active <- readIORef (wsEdit ws)
|
||||
case active of
|
||||
Nothing -> pure ()
|
||||
Just (owner, _) -> atomicModifyIORef' (wsEditEnded ws) (\ended -> (Set.insert owner ended, ()))
|
||||
writeIORef (wsEdit ws) Nothing
|
||||
|
||||
-- | 按表结构生成一条编辑语句。
|
||||
editStatement :: [TableInfo] -> A.Value -> Either Text Text
|
||||
editStatement infos (A.Object o) = do
|
||||
name <- textField "table" o
|
||||
operation <- textField "op" o
|
||||
when (isAccountTable name) (Left "system identities cannot be edited in a data transaction")
|
||||
info <- maybe (Left ("table not found: " <> name)) Right (findTable name infos)
|
||||
sql <- case operation of
|
||||
"insert" -> do
|
||||
row <- valuesField o >>= readRowValues False (tiColumns info)
|
||||
either (Left . T.pack) Right (insertRowSql name row)
|
||||
"update" -> do
|
||||
key <- editRowKey o
|
||||
values <- case KM.lookup "set" o of
|
||||
Just (A.Object assigns) -> Right assigns
|
||||
_ -> Left "update requires a set object"
|
||||
row <- readRowValues False (tiColumns info) values
|
||||
either (Left . T.pack) Right (updateRowSql name key row)
|
||||
"delete" -> do
|
||||
key <- editRowKey o
|
||||
either (Left . T.pack) Right (deleteRowSql name key)
|
||||
_ -> Left "unknown edit operation"
|
||||
pure (T.pack sql)
|
||||
editStatement _ _ = Left "each change must be an object"
|
||||
|
||||
-- | 读取行编辑的整数主键。
|
||||
editRowKey :: A.Object -> Either Text Int
|
||||
editRowKey o = case KM.lookup "pk" o of
|
||||
Just (A.String rawKey) -> maybe (Left "invalid row id") Right (readMaybe (T.unpack rawKey))
|
||||
Just rawKey -> case A.fromJSON rawKey of
|
||||
A.Success key -> Right key
|
||||
A.Error _ -> Left "invalid row id"
|
||||
Nothing -> Left "missing row id"
|
||||
|
||||
-- | 顺序执行编辑集并定位首个错误。
|
||||
runEditStatements :: Session -> Int -> [Text] -> IO (Either (Int, Text) ())
|
||||
runEditStatements _ _ [] = pure (Right ())
|
||||
runEditStatements session index (sql : rest) = do
|
||||
result <- runStatement session sql
|
||||
case result of
|
||||
Left message -> pure (Left (index, message))
|
||||
Right _ -> runEditStatements session (index + 1) rest
|
||||
|
||||
-- | 返回明确的事务失败状态。
|
||||
editFailure :: Text -> Text -> Maybe Int -> Bool -> ActionM ()
|
||||
editFailure stateName message index reload = do
|
||||
let code = errorCodeOf message
|
||||
status (if code == "unauthorized" then status401 else if reload || code == "serialization_failure" then status409 else statusOf code)
|
||||
json (object ["ok" .= False, "applied" .= (0 :: Int), "state" .= stateName,
|
||||
"reloadRequired" .= reload, "error" .= code, "message" .= message,
|
||||
"errors" .= [object ["index" .= index, "message" .= message]]])
|
||||
|
||||
-- | 回退提交失败的暂存语句并保留快照。
|
||||
resetEditAfterFailure :: WebSession -> Maybe Int -> Text -> ActionM ()
|
||||
resetEditAfterFailure ws index message = do
|
||||
reset <- liftIO (runStatement (wsEditor ws) "ROLLBACK TO SAVEPOINT web_edit_base")
|
||||
case reset of
|
||||
Right _ -> editFailure "active" message index False
|
||||
Left resetError -> do
|
||||
liftIO (endEdit ws >> closeClient (wsEditorClient ws))
|
||||
editFailure "lost" (message <> "; rollback failed: " <> resetError) index True
|
||||
|
||||
-- | 原子提交跨表编辑集并缓存成功回执。
|
||||
commitEditH :: AppEnv -> ActionM ()
|
||||
commitEditH env = do
|
||||
ws <- requireSession env
|
||||
withJsonObject env $ \o -> case (editIdentity o, KM.lookup "changes" o) of
|
||||
(Right identity@(owner, _), Just (A.Array entries)) -> do
|
||||
receipt <- liftIO (readIORef (wsEditReceipt ws))
|
||||
case receipt of
|
||||
Just (old, submitted, result) | old == owner && submitted == A.Object o -> json result
|
||||
Just (old, _, _) | old == owner -> apiError "conflict" "transaction already committed with a different edit set"
|
||||
_ -> do
|
||||
requireEdit ws identity
|
||||
found <- liftIO (catalog (wsEditor ws))
|
||||
infos <- case found of
|
||||
Left message -> do
|
||||
when (errorCodeOf message == "unauthorized") (liftIO (endEdit ws >> closeWebSession ws))
|
||||
serverError message
|
||||
Right tables -> pure tables
|
||||
case mapM (editStatement infos) (V.toList entries) of
|
||||
Left message -> editFailure "active" ("bad_request: " <> message) Nothing False
|
||||
Right statements -> do
|
||||
reset <- liftIO (runStatement (wsEditor ws) "ROLLBACK TO SAVEPOINT web_edit_base")
|
||||
case reset of
|
||||
Left message -> do
|
||||
liftIO (endEdit ws >> closeClient (wsEditorClient ws))
|
||||
editFailure "lost" message Nothing True
|
||||
finish
|
||||
Right _ -> pure ()
|
||||
staged <- liftIO (runEditStatements (wsEditor ws) 0 statements)
|
||||
case staged of
|
||||
Left (index, message) -> resetEditAfterFailure ws (Just index) message
|
||||
Right () -> do
|
||||
committed <- liftIO (runStatement (wsEditor ws) "COMMIT")
|
||||
case committed of
|
||||
Right _ -> do
|
||||
let result = object ["ok" .= True, "applied" .= V.length entries, "state" .= ("committed" :: Text)]
|
||||
liftIO (endEdit ws >> writeIORef (wsEditReceipt ws) (Just (owner, A.Object o, result)))
|
||||
json result
|
||||
Left message | errorCodeOf message == "serialization_failure" -> do
|
||||
rolledBack <- liftIO (runStatement (wsEditor ws) "ROLLBACK")
|
||||
liftIO (endEdit ws)
|
||||
case rolledBack of
|
||||
Right _ -> editFailure "rolled_back" message Nothing True
|
||||
Left err -> do
|
||||
liftIO (closeClient (wsEditorClient ws))
|
||||
editFailure "lost" (message <> "; rollback failed: " <> err) Nothing True
|
||||
Left message | errorCodeOf message `elem` ["query_error", "bad_request", "forbidden"] -> resetEditAfterFailure ws Nothing message
|
||||
Left message -> do
|
||||
liftIO (endEdit ws >> closeClient (wsEditorClient ws))
|
||||
editFailure "lost" (message <> "; commit outcome requires reload") Nothing True
|
||||
_ -> reply400 "bad_request" "expected edit identity and a changes array"
|
||||
|
||||
-- | 撤销页面持有的编辑事务。
|
||||
rollbackEditH :: AppEnv -> ActionM ()
|
||||
rollbackEditH env = do
|
||||
ws <- requireSession env
|
||||
withJsonObject env $ \o -> case editIdentity o of
|
||||
Left message -> reply400 "bad_request" message
|
||||
Right identity -> do
|
||||
active <- liftIO (readIORef (wsEdit ws))
|
||||
case active of
|
||||
Nothing -> do
|
||||
receipt <- liftIO (readIORef (wsEditReceipt ws))
|
||||
let stateName = case receipt of
|
||||
Just (owner, _, _) | owner == fst identity -> "committed" :: Text
|
||||
_ -> "rolled_back"
|
||||
json (object ["state" .= stateName])
|
||||
Just _ -> do
|
||||
requireEdit ws identity
|
||||
result <- liftIO (runStatement (wsEditor ws) "ROLLBACK")
|
||||
liftIO (endEdit ws)
|
||||
case result of
|
||||
Left message -> liftIO (closeClient (wsEditorClient ws)) >> serverError message
|
||||
Right _ -> json (object ["state" .= ("rolled_back" :: Text)])
|
||||
|
||||
-- | 读取 SQL 控制台的请求所有者。
|
||||
consoleOwner :: ActionM Text
|
||||
consoleOwner = do
|
||||
owner <- maybe "legacy" TL.toStrict <$> header "X-ChuSQL-Console"
|
||||
if T.null owner || T.length owner > 128 then apiError "bad_request" "invalid console identity" else pure owner
|
||||
|
||||
-- | 回滚关闭页面或标签的控制台事务。
|
||||
rollbackConsoleH :: AppEnv -> ActionM ()
|
||||
rollbackConsoleH env = do
|
||||
ws <- requireSession env
|
||||
withJsonObject env $ \o -> case textField "console" o of
|
||||
Left message -> reply400 "bad_request" message
|
||||
Right owner -> do
|
||||
active <- liftIO (readIORef (wsConsole ws))
|
||||
case active of
|
||||
Nothing -> status status204
|
||||
Just (existing, _) | existing /= owner -> apiError "conflict" "another console owns this transaction"
|
||||
Just _ -> do
|
||||
result <- liftIO (runStatement (wsSession ws) "ROLLBACK")
|
||||
case result of
|
||||
Left message -> serverError message
|
||||
Right _ -> liftIO (writeIORef (wsConsole ws) Nothing) >> status status204
|
||||
|
||||
-- | 查询接口:校验请求体后执行 SQL。
|
||||
queryH :: AppEnv -> ActionM ()
|
||||
queryH env = do
|
||||
ws <- requireSession env
|
||||
@@ -1447,6 +1723,15 @@ executeSql ws live sql = do
|
||||
case result of
|
||||
Left message -> serverError message
|
||||
Right res -> do
|
||||
owner <- consoleOwner
|
||||
case parseStatement (T.unpack sql) of
|
||||
Right BeginTransaction -> do
|
||||
database <- liftIO (sessionDatabase (wsSession ws))
|
||||
liftIO (writeIORef (wsConsole ws) (Just (owner, database)))
|
||||
Right CommitTransaction -> liftIO (writeIORef (wsConsole ws) Nothing)
|
||||
Right RollbackTransaction -> liftIO (writeIORef (wsConsole ws) Nothing)
|
||||
_ -> pure ()
|
||||
transaction <- liftIO (readIORef (wsConsole ws))
|
||||
let shown = take (lvMaxRows live) (qrRows res)
|
||||
json
|
||||
( object
|
||||
@@ -1455,6 +1740,7 @@ executeSql ws live sql = do
|
||||
, "rowCount" .= qrRowCount res
|
||||
, "truncated" .= (qrTruncated res || qrRowCount res > lvMaxRows live)
|
||||
, "database" .= qrDatabase res
|
||||
, "transaction" .= (transaction /= Nothing)
|
||||
]
|
||||
)
|
||||
|
||||
@@ -1516,6 +1802,7 @@ valueJson (VInt n) = A.Number (fromIntegral n)
|
||||
valueJson (VFloat d) = A.Number (fromFloatDigits d)
|
||||
valueJson (VStr s) = A.String (T.pack s)
|
||||
valueJson (VBool b) = A.Bool b
|
||||
valueJson value@VRuntime{} = valueToJSON value
|
||||
|
||||
-- | 一张表的线上信息:列、行数、索引与统计
|
||||
tableInfoJson :: TableInfo -> A.Value
|
||||
|
||||
@@ -2,6 +2,9 @@
|
||||
// 请求都带 X-ChuSQL-Database 头;401 时广播登录事件。
|
||||
|
||||
export const AUTH_EVENT = 'chusql-auth-required';
|
||||
let editing = null;
|
||||
let consoleTransaction = null;
|
||||
const pageOwner = [...crypto.getRandomValues(new Uint8Array(16))].map((byte) => byte.toString(16).padStart(2, '0')).join('');
|
||||
|
||||
// 是否是普通对象。
|
||||
function isObject(value) {
|
||||
@@ -12,6 +15,9 @@ function isObject(value) {
|
||||
async function request(url, init, database) {
|
||||
const headers = new Headers(init && init.headers ? init.headers : undefined);
|
||||
if (database) headers.set('X-ChuSQL-Database', database);
|
||||
if (editing && editing.database === database && url.startsWith('/api/tables') && (!init || init.method === 'GET')) {
|
||||
headers.set('X-ChuSQL-Edit', editing.id);
|
||||
}
|
||||
let response;
|
||||
try {
|
||||
response = await fetch(url, { credentials: 'same-origin', ...(init ?? {}), headers });
|
||||
@@ -31,7 +37,10 @@ async function request(url, init, database) {
|
||||
const message = isObject(body) && typeof body.message === 'string'
|
||||
? body.message
|
||||
: `请求失败(HTTP ${response.status})。`;
|
||||
throw new Error(message);
|
||||
const error = new Error(message);
|
||||
error.result = body;
|
||||
error.code = body?.error;
|
||||
throw error;
|
||||
}
|
||||
return body;
|
||||
}
|
||||
@@ -215,33 +224,68 @@ export async function deleteRow(database, table, id) {
|
||||
await request(`/api/tables/${encodeURIComponent(table)}/rows/${encodeURIComponent(id)}`, jsonInit('DELETE'), database);
|
||||
}
|
||||
|
||||
// 逐条提交,遇到第一条失败就停,返回已经成功了几条。
|
||||
export async function commitChanges(database, changes) {
|
||||
let applied = 0;
|
||||
for (const [index, change] of changes.entries()) {
|
||||
// 为页面开启固定数据库的编辑快照。
|
||||
export async function beginEdit(id, database) {
|
||||
await request('/api/edit/begin', jsonInit('POST', { id, database }));
|
||||
editing = { id, database };
|
||||
}
|
||||
|
||||
// 在服务端事务中原子提交编辑集。
|
||||
export async function commitChanges(id, database, changes) {
|
||||
try {
|
||||
if (change.op === 'insert') await insertRow(database, change.table, change.values);
|
||||
else if (change.op === 'delete') await deleteRow(database, change.table, change.pk);
|
||||
else await updateRow(database, change.table, change.pk, change.set);
|
||||
applied += 1;
|
||||
const result = await request('/api/edit/commit', jsonInit('POST', { id, database, changes }));
|
||||
if (!isObject(result) || result.ok !== true || result.state !== 'committed') throw new Error('服务器未返回可确认的提交结果。');
|
||||
editing = null;
|
||||
return result;
|
||||
} catch (error) {
|
||||
return { ok: false, applied, errors: [{ index, message: error instanceof Error ? error.message : String(error) }] };
|
||||
if (isObject(error.result) && typeof error.result.state === 'string') return error.result;
|
||||
return { ok: false, applied: 0, state: error.result ? 'lost' : 'unknown',
|
||||
reloadRequired: Boolean(error.result), message: error.message };
|
||||
}
|
||||
}
|
||||
return { ok: true, applied };
|
||||
|
||||
// 回滚编辑快照并清除本地事务标识。
|
||||
export async function rollbackEdit(id, database) {
|
||||
const result = await request('/api/edit/rollback', jsonInit('POST', { id, database }));
|
||||
editing = null;
|
||||
return result;
|
||||
}
|
||||
|
||||
// 忘记已失效的登录会话编辑标识。
|
||||
export function forgetEdit() {
|
||||
editing = null;
|
||||
consoleTransaction = null;
|
||||
}
|
||||
|
||||
// 标签关闭时回滚它持有的控制台事务。
|
||||
export async function rollbackConsole(tabId) {
|
||||
if (!consoleTransaction || consoleTransaction.console !== `${pageOwner}:${tabId ?? 'default'}`) return;
|
||||
await request('/api/query/rollback', jsonInit('POST', { console: consoleTransaction.console }));
|
||||
consoleTransaction = null;
|
||||
}
|
||||
|
||||
// 页面离开时请求清理控制台事务。
|
||||
export function closeConsoleOnPagehide() {
|
||||
if (consoleTransaction) {
|
||||
navigator.sendBeacon('/api/query/rollback', new Blob([JSON.stringify({ console: consoleTransaction.console })], { type: 'application/json' }));
|
||||
}
|
||||
}
|
||||
|
||||
// ---------------------------------------------------------------- 查询
|
||||
|
||||
// 执行 SQL 并规整结果。
|
||||
export async function query(sql, database) {
|
||||
export async function query(sql, database, tabId) {
|
||||
const started = performance.now();
|
||||
try {
|
||||
const body = await request('/api/query', jsonInit('POST', { sql }), database);
|
||||
const console = `${pageOwner}:${tabId ?? 'default'}`;
|
||||
const init = jsonInit('POST', { sql });
|
||||
init.headers['X-ChuSQL-Console'] = console;
|
||||
const body = await request('/api/query', init, database);
|
||||
if (!isObject(body) || !Array.isArray(body.columns) || !Array.isArray(body.rows)) {
|
||||
throw new Error('服务器返回的查询结果无法识别。');
|
||||
}
|
||||
const durationMs = performance.now() - started;
|
||||
consoleTransaction = body.transaction === true ? { console, database } : null;
|
||||
return {
|
||||
type: body.columns.length ? 'rows' : 'affected',
|
||||
columns: body.columns,
|
||||
@@ -249,6 +293,7 @@ export async function query(sql, database) {
|
||||
affected: typeof body.rowCount === 'number' ? body.rowCount : 0,
|
||||
truncated: body.truncated === true,
|
||||
database: typeof body.database === 'string' ? body.database : undefined,
|
||||
transactionActive: body.transaction === true,
|
||||
durationMs,
|
||||
};
|
||||
} catch (error) {
|
||||
|
||||
@@ -46,6 +46,12 @@ const state = {
|
||||
tabs: [],
|
||||
activeId: undefined,
|
||||
changes: createEmptyChangeSet(),
|
||||
edit: null,
|
||||
editStarting: null,
|
||||
editAttempt: null,
|
||||
editBusy: false,
|
||||
editNeedsReload: false,
|
||||
editUncertain: null,
|
||||
insertSeq: 0,
|
||||
messages: [],
|
||||
tabSeq: 0,
|
||||
@@ -301,8 +307,8 @@ function renderSidebar() {
|
||||
<section class="side-section">
|
||||
<div class="side-title">变更</div>
|
||||
<div class="side-row">
|
||||
<button data-action="commit"${count ? '' : ' disabled'}>提交 ${count}</button>
|
||||
<button data-action="rollback"${count ? '' : ' disabled'}>撤销</button>
|
||||
<button data-action="commit"${count && !state.editBusy && !state.editNeedsReload ? '' : ' disabled'}>提交 ${count}</button>
|
||||
<button data-action="rollback"${(state.edit || state.editAttempt) && !state.editBusy ? '' : ' disabled'}>撤销</button>
|
||||
</div>
|
||||
</section>`;
|
||||
}
|
||||
@@ -364,7 +370,9 @@ function renderTableTab(el, tab) {
|
||||
}
|
||||
const columns = data.columns;
|
||||
const keyColumn = columns.find((column) => column.name === 'id');
|
||||
const editable = Boolean(keyColumn);
|
||||
const editable = Boolean(keyColumn) && tab.table !== accountsTable && Boolean(state.edit)
|
||||
&& data.editId === state.edit.id && !data.loading
|
||||
&& !state.editBusy && !state.editNeedsReload && !state.editUncertain;
|
||||
const filters = data.filters ?? {};
|
||||
const count = changeCount(state.changes);
|
||||
|
||||
@@ -413,8 +421,8 @@ function renderTableTab(el, tab) {
|
||||
<button data-action="insert-row"${editable ? '' : ' disabled'}>+ 新增行</button>
|
||||
<button data-action="delete-selected"${editable && (tab.selected?.size ?? 0) ? '' : ' disabled'}>删除选中</button>
|
||||
<span class="sep"></span>
|
||||
<button class="primary" data-action="commit"${count ? '' : ' disabled'}>提交 (${count})</button>
|
||||
<button data-action="rollback"${count ? '' : ' disabled'}>撤销</button>
|
||||
<button class="primary" data-action="commit"${count && !state.editBusy && !state.editNeedsReload ? '' : ' disabled'}>提交 (${count})</button>
|
||||
<button data-action="rollback"${(state.edit || state.editAttempt) && !state.editBusy ? '' : ' disabled'}>撤销</button>
|
||||
<span class="sep"></span>
|
||||
<button data-action="reload-table">刷新</button>
|
||||
<span class="flex-spacer"></span>
|
||||
@@ -438,7 +446,7 @@ function renderTableTab(el, tab) {
|
||||
${data.rows.length || stagedInserts.length ? '' : '<p class="empty">这张表没有数据。</p>'}
|
||||
</div>
|
||||
${data.loading ? '<div class="grid-loading">加载中…</div>' : ''}
|
||||
${editable ? '' : '<p class="notice">这张表没有 id 列,只能浏览。</p>'}
|
||||
${editable ? '' : '<p class="notice">当前表或事务状态仅允许浏览;系统身份请通过 SQL 管理。</p>'}
|
||||
</div>`;
|
||||
}
|
||||
|
||||
@@ -650,8 +658,8 @@ function renderBottom() {
|
||||
<button class="${state.bottomTab === 'changes' ? 'active' : ''}" data-action="bottom-tab" data-tab="changes">待提交变更 (${count})</button>
|
||||
<button class="${state.bottomTab === 'messages' ? 'active' : ''}" data-action="bottom-tab" data-tab="messages">消息 (${state.messages.length})</button>
|
||||
<span class="flex-spacer"></span>
|
||||
<button data-action="commit"${count ? '' : ' disabled'}>提交全部</button>
|
||||
<button data-action="rollback"${count ? '' : ' disabled'}>撤销全部</button>
|
||||
<button data-action="commit"${count && !state.editBusy && !state.editNeedsReload ? '' : ' disabled'}>提交全部</button>
|
||||
<button data-action="rollback"${(state.edit || state.editAttempt) && !state.editBusy ? '' : ' disabled'}>撤销全部</button>
|
||||
<button data-action="copy-sql"${count ? '' : ' disabled'}>复制 SQL</button>
|
||||
</div>
|
||||
<div class="bottom-body">${state.bottomTab === 'changes' ? changeList : messages}</div>`;
|
||||
@@ -694,19 +702,36 @@ async function loadWorkspace() {
|
||||
|
||||
// 切换当前数据库。
|
||||
async function switchDatabase(name) {
|
||||
if (state.editBusy || state.editStarting) return;
|
||||
if (name === state.database) return;
|
||||
if (changeCount(state.changes) > 0) {
|
||||
log('warn', '请先提交或撤销当前库的修改,再切换数据库。');
|
||||
renderSidebar();
|
||||
return;
|
||||
}
|
||||
const previousEdit = state.edit ?? state.editAttempt;
|
||||
state.editBusy = true;
|
||||
afterChange();
|
||||
try {
|
||||
if (previousEdit) await api.rollbackEdit(previousEdit.id, previousEdit.database);
|
||||
} catch (error) {
|
||||
state.editBusy = false;
|
||||
fail(error);
|
||||
afterChange();
|
||||
return;
|
||||
}
|
||||
state.edit = null;
|
||||
state.editAttempt = null;
|
||||
const result = await api.query(`USE ${name}`, state.database);
|
||||
state.editBusy = false;
|
||||
if (result.type === 'error') {
|
||||
fail(new Error(result.message));
|
||||
renderSidebar();
|
||||
return;
|
||||
}
|
||||
state.database = result.database ?? name;
|
||||
state.tabs = state.tabs.filter((entry) => entry.kind !== 'table');
|
||||
state.activeId = state.tabs[0]?.id;
|
||||
log('info', `已切换到数据库 ${state.database}`);
|
||||
await loadWorkspace();
|
||||
renderEditor();
|
||||
@@ -732,10 +757,12 @@ async function openTable(database, name) {
|
||||
|
||||
// 加载表标签的一页数据。
|
||||
async function loadTableData(tab) {
|
||||
if (state.editBusy || state.editNeedsReload || state.editUncertain) return;
|
||||
const data = tab.data;
|
||||
data.loading = true;
|
||||
renderEditor();
|
||||
try {
|
||||
if (tab.table !== accountsTable) await ensureEdit(tab.database);
|
||||
const meta = await api.getTable(tab.database, tab.table);
|
||||
const filters = Object.entries(data.filters ?? {})
|
||||
.filter(([, expression]) => String(expression).trim().length > 0)
|
||||
@@ -756,6 +783,7 @@ async function loadTableData(tab) {
|
||||
data.offset = offset;
|
||||
data.pageSize = pageSize;
|
||||
data.error = null;
|
||||
data.editId = state.edit?.id;
|
||||
// 服务端做等值过滤,界面上的 like / 比较表达式再在本地收敛一次
|
||||
data.rows = filters.length
|
||||
? page.rows.filter((row) => filters.every((filter) => matchesFilter(row[filter.column], filter.expression)))
|
||||
@@ -770,6 +798,28 @@ async function loadTableData(tab) {
|
||||
}
|
||||
}
|
||||
|
||||
// 在首个数据表加载时固定编辑快照。
|
||||
async function ensureEdit(database) {
|
||||
if (database !== state.database) throw new Error('请切换到表所属数据库后重新打开。');
|
||||
if (state.edit) {
|
||||
if (state.edit.database !== database) throw new Error('请先撤销当前数据库的编辑事务。');
|
||||
return;
|
||||
}
|
||||
if (!state.editStarting) {
|
||||
const edit = state.editAttempt ?? { id: [...crypto.getRandomValues(new Uint8Array(16))].map((byte) => byte.toString(16).padStart(2, '0')).join(''), database };
|
||||
if (edit.database !== database) throw new Error('请先撤销之前的编辑快照,再切换数据库。');
|
||||
state.editAttempt = edit;
|
||||
const session = state.session;
|
||||
state.editStarting = api.beginEdit(edit.id, database).then(() => {
|
||||
if (state.session !== session) throw new Error('登录会话已更换,请重新加载。');
|
||||
state.edit = edit;
|
||||
state.editAttempt = null;
|
||||
})
|
||||
.finally(() => { state.editStarting = null; });
|
||||
}
|
||||
await state.editStarting;
|
||||
}
|
||||
|
||||
// 重新加载所有表标签。
|
||||
async function reloadOpenTables() {
|
||||
for (const tab of state.tabs) {
|
||||
@@ -790,6 +840,7 @@ function unstageRow(table, pk) {
|
||||
|
||||
// 暂存单元格修改。
|
||||
function stageUpdate(table, database, pk, column, oldValue, newValue) {
|
||||
if (!canEdit(database)) return;
|
||||
if (oldValue === newValue) state.changes.updates.delete(changeKey(table, pk, column));
|
||||
else state.changes.updates.set(changeKey(table, pk, column), { table, database, pk, column, oldValue, newValue });
|
||||
afterChange();
|
||||
@@ -797,6 +848,7 @@ function stageUpdate(table, database, pk, column, oldValue, newValue) {
|
||||
|
||||
// 暂存新增行。
|
||||
function stageInsert(table, database, values) {
|
||||
if (!canEdit(database)) return;
|
||||
state.insertSeq += 1;
|
||||
const tempId = `new-${state.insertSeq}`;
|
||||
state.changes.inserts.set(insertKey(table, tempId), { table, database, tempId, values });
|
||||
@@ -805,6 +857,7 @@ function stageInsert(table, database, values) {
|
||||
|
||||
// 暂存删除行。
|
||||
function stageDelete(table, database, pk, row) {
|
||||
if (!canEdit(database)) return;
|
||||
unstageRow(table, pk);
|
||||
state.changes.deletes.set(deleteKey(table, pk), { table, database, pk, row });
|
||||
afterChange();
|
||||
@@ -819,6 +872,7 @@ function afterChange() {
|
||||
|
||||
// 撤下一条暂存变更。
|
||||
function removeStaged(key) {
|
||||
if (!canEdit(state.database)) return;
|
||||
if (state.changes.updates.has(key)) state.changes.updates.delete(key);
|
||||
else if (state.changes.inserts.has(key)) state.changes.inserts.delete(key);
|
||||
else if (state.changes.deletes.has(key)) state.changes.deletes.delete(key);
|
||||
@@ -826,48 +880,70 @@ function removeStaged(key) {
|
||||
}
|
||||
|
||||
// 撤销全部暂存变更。
|
||||
function rollbackAll() {
|
||||
async function rollbackAll() {
|
||||
if (state.editBusy || state.editStarting) return;
|
||||
state.editBusy = true;
|
||||
afterChange();
|
||||
try {
|
||||
const edit = state.edit ?? state.editAttempt;
|
||||
const result = edit ? await api.rollbackEdit(edit.id, edit.database) : null;
|
||||
state.edit = null;
|
||||
state.editAttempt = null;
|
||||
state.editNeedsReload = false;
|
||||
state.editUncertain = null;
|
||||
state.changes = createEmptyChangeSet();
|
||||
for (const tab of state.tabs) if (tab.selected) tab.selected.clear();
|
||||
log('info', '已撤销全部待提交变更。');
|
||||
log('info', result?.state === 'committed' ? '先前提交已成功,现重新加载数据。' : '已回滚编辑事务,重新加载数据。');
|
||||
state.editBusy = false;
|
||||
await loadWorkspace();
|
||||
await reloadOpenTables();
|
||||
} catch (error) {
|
||||
state.editNeedsReload = true;
|
||||
fail(error);
|
||||
} finally {
|
||||
state.editBusy = false;
|
||||
afterChange();
|
||||
}
|
||||
}
|
||||
|
||||
// 检查编辑事务与页面操作状态。
|
||||
function canEdit(database) {
|
||||
return Boolean(state.edit) && state.edit.database === database && !state.editBusy
|
||||
&& !state.editNeedsReload && !state.editUncertain;
|
||||
}
|
||||
|
||||
// 提交全部暂存变更。
|
||||
async function commitAll() {
|
||||
const payload = toCommitPayload(state.changes);
|
||||
if (state.editBusy || state.editStarting) return;
|
||||
if (state.editNeedsReload || !state.edit) {
|
||||
fail(new Error('编辑快照已失效,请撤销并重新加载后编辑。'));
|
||||
return;
|
||||
}
|
||||
const payload = state.editUncertain ?? toCommitPayload(state.changes);
|
||||
if (!payload.length) {
|
||||
log('info', '没有待提交的变更。');
|
||||
return;
|
||||
}
|
||||
const database = state.database;
|
||||
const result = await api.commitChanges(database, payload);
|
||||
state.editBusy = true;
|
||||
afterChange();
|
||||
const edit = state.edit;
|
||||
const result = await api.commitChanges(edit.id, edit.database, payload);
|
||||
if (state.edit !== edit) { state.editBusy = false; return; }
|
||||
if (result.ok) {
|
||||
state.edit = null;
|
||||
state.editUncertain = null;
|
||||
state.changes = createEmptyChangeSet();
|
||||
for (const tab of state.tabs) if (tab.selected) tab.selected.clear();
|
||||
log('info', `已提交 ${result.applied} 条变更。`);
|
||||
setStatus(`已提交 ${result.applied} 条变更`);
|
||||
} else {
|
||||
const failed = result.errors?.[0];
|
||||
// 成功的部分不再保留,失败的那条留在面板上等修正
|
||||
state.changes = createEmptyChangeSet();
|
||||
payload.slice(result.applied).forEach((change) => {
|
||||
if (change.op === 'insert') {
|
||||
state.insertSeq += 1;
|
||||
const tempId = `new-${state.insertSeq}`;
|
||||
state.changes.inserts.set(insertKey(change.table, tempId), { table: change.table, database, tempId, values: change.values });
|
||||
} else if (change.op === 'delete') {
|
||||
state.changes.deletes.set(deleteKey(change.table, change.pk), { table: change.table, database, pk: change.pk, row: {} });
|
||||
} else {
|
||||
for (const [column, value] of Object.entries(change.set)) {
|
||||
state.changes.updates.set(changeKey(change.table, change.pk, column), {
|
||||
table: change.table, database, pk: change.pk, column, oldValue: undefined, newValue: value,
|
||||
});
|
||||
}
|
||||
}
|
||||
});
|
||||
log('error', `提交在第 ${(failed?.index ?? 0) + 1} 条失败:${failed?.message ?? '未知错误'}(已成功 ${result.applied} 条)`);
|
||||
state.editNeedsReload = result.reloadRequired === true;
|
||||
state.editUncertain = result.state === 'unknown' ? payload : null;
|
||||
log('error', `${result.message ?? '提交失败'}(事务状态:${result.state})。${state.editNeedsReload
|
||||
? result.state === 'lost' ? '连接已失效,请重新登录,确认数据后重新编辑。' : '请撤销并重新加载,禁止覆盖其他会话修改。' : state.editUncertain
|
||||
? '结果尚未确认,编辑已冻结;再次提交仅查询同一提交结果。' : '全部修改已回退,编辑内容保留,可修正后重试。'}`);
|
||||
}
|
||||
state.editBusy = false;
|
||||
await loadWorkspace();
|
||||
await reloadOpenTables();
|
||||
afterChange();
|
||||
@@ -877,10 +953,31 @@ async function commitAll() {
|
||||
|
||||
// 运行 SQL 并展示结果。
|
||||
async function runSql(tab) {
|
||||
if (state.editBusy || state.editStarting || state.editUncertain || state.editNeedsReload) return;
|
||||
if (changeCount(state.changes)) {
|
||||
log('warn', '请先提交或撤销表格修改,再运行 SQL。');
|
||||
return;
|
||||
}
|
||||
const sql = String(tab.sql ?? '').trim();
|
||||
if (!sql) return;
|
||||
state.editBusy = true;
|
||||
afterChange();
|
||||
const previousEdit = state.edit ?? state.editAttempt;
|
||||
if (previousEdit) {
|
||||
try {
|
||||
await api.rollbackEdit(previousEdit.id, previousEdit.database);
|
||||
state.edit = null;
|
||||
state.editAttempt = null;
|
||||
} catch (error) {
|
||||
state.editBusy = false;
|
||||
fail(error);
|
||||
afterChange();
|
||||
return;
|
||||
}
|
||||
}
|
||||
setStatus('执行中…');
|
||||
const result = await api.query(sql, tab.database);
|
||||
const result = await api.query(sql, tab.database, tab.id);
|
||||
state.editBusy = false;
|
||||
tab.result = result;
|
||||
if (result.type === 'error') {
|
||||
log('error', result.message ?? '执行失败');
|
||||
@@ -888,6 +985,7 @@ async function runSql(tab) {
|
||||
} else {
|
||||
if (result.database && result.database !== state.database) {
|
||||
state.database = result.database;
|
||||
state.tabs = state.tabs.filter((entry) => entry.kind !== 'table');
|
||||
tab.database = result.database;
|
||||
await loadWorkspace();
|
||||
}
|
||||
@@ -897,10 +995,12 @@ async function runSql(tab) {
|
||||
} else {
|
||||
log('info', `语句影响 ${result.affected ?? 0} 行`);
|
||||
setStatus(`影响 ${result.affected ?? 0} 行`);
|
||||
if (!result.transactionActive) {
|
||||
await loadWorkspace();
|
||||
await reloadOpenTables();
|
||||
}
|
||||
}
|
||||
}
|
||||
renderEditor();
|
||||
}
|
||||
|
||||
@@ -912,15 +1012,22 @@ function activateTab(id) {
|
||||
const tab = activeTab();
|
||||
if (tab?.kind === 'sql') tab.database = state.database;
|
||||
if (tab?.kind === 'settings' && !state.serverSettings) void loadServerSettings();
|
||||
if (tab?.kind === 'table' && !state.edit && tab.table !== accountsTable) void loadTableData(tab);
|
||||
renderTabs();
|
||||
}
|
||||
|
||||
// 关闭指定标签。
|
||||
function closeTabById(id) {
|
||||
if (state.tabs.find((tab) => tab.id === id)?.kind === 'sql') {
|
||||
void api.rollbackConsole(id).catch(fail);
|
||||
}
|
||||
const closed = closeTab(state.tabs, id, state.activeId);
|
||||
state.tabs = closed.tabs;
|
||||
state.activeId = closed.activeId;
|
||||
renderTabs();
|
||||
if (!state.tabs.some((tab) => tab.kind === 'table') && !changeCount(state.changes) && (state.edit || state.editAttempt)) {
|
||||
void rollbackAll();
|
||||
}
|
||||
}
|
||||
|
||||
// 新开一个查询标签。
|
||||
@@ -1066,6 +1173,10 @@ function deleteSelected(tab) {
|
||||
|
||||
// 就地编辑单元格:提交或放弃。
|
||||
function beginCellEdit(cell, options) {
|
||||
if (/^runtime\(\[1,\[[567],/.test(String(options.type))) {
|
||||
setStatus('复合值请通过 SQL 控制台修改');
|
||||
return;
|
||||
}
|
||||
if (cell.querySelector('input')) return;
|
||||
const input = document.createElement('input');
|
||||
input.className = 'cell-input';
|
||||
@@ -1292,6 +1403,7 @@ function onClick(event) {
|
||||
const target = event.target.closest('[data-action]');
|
||||
if (!target) return;
|
||||
const action = target.dataset.action;
|
||||
if (state.editBusy || state.editStarting) return;
|
||||
const tab = activeTab();
|
||||
|
||||
// 没有选库时,需要当前库的动作先拦下来(服务端也会拒,这里给人话)
|
||||
@@ -1305,13 +1417,19 @@ function onClick(event) {
|
||||
void (async () => {
|
||||
try {
|
||||
await api.logout();
|
||||
} catch {
|
||||
// 退出失败也要回到登录页
|
||||
} catch (error) {
|
||||
fail(error);
|
||||
return;
|
||||
}
|
||||
state.session = null;
|
||||
state.tabs = [];
|
||||
state.activeId = undefined;
|
||||
state.changes = createEmptyChangeSet();
|
||||
state.edit = null;
|
||||
state.editAttempt = null;
|
||||
state.editNeedsReload = false;
|
||||
state.editUncertain = null;
|
||||
api.forgetEdit();
|
||||
renderLogin('已退出登录。', 'info');
|
||||
})();
|
||||
return;
|
||||
@@ -1450,7 +1568,7 @@ function onClick(event) {
|
||||
void commitAll();
|
||||
return;
|
||||
case 'rollback':
|
||||
rollbackAll();
|
||||
void rollbackAll();
|
||||
return;
|
||||
case 'copy-sql': {
|
||||
const text = changesSql(state.changes).join('\n');
|
||||
@@ -1493,10 +1611,12 @@ function onClick(event) {
|
||||
if (!meta || !row) return;
|
||||
const staged = state.changes.updates.get(changeKey(tab.table, pk, column));
|
||||
const oldValue = staged ? staged.oldValue : row[column.name];
|
||||
const editId = state.edit?.id;
|
||||
beginCellEdit(target, {
|
||||
type: meta.type,
|
||||
currentValue: staged ? staged.newValue : row[column.name],
|
||||
commit: (value) => {
|
||||
if (state.edit?.id !== editId) return;
|
||||
if (value === undefined) renderEditor();
|
||||
else stageUpdate(tab.table, tab.database, pk, column, oldValue, value);
|
||||
},
|
||||
@@ -1513,6 +1633,7 @@ function onClick(event) {
|
||||
type: meta ? meta.type : 'str',
|
||||
currentValue: insert.values[column],
|
||||
commit: (value) => {
|
||||
if (!canEdit(tab.database)) return;
|
||||
if (value === undefined) renderEditor();
|
||||
else {
|
||||
insert.values[column] = value;
|
||||
@@ -1617,9 +1738,33 @@ window.addEventListener(AUTH_EVENT, () => {
|
||||
state.session = null;
|
||||
state.tabs = [];
|
||||
state.activeId = undefined;
|
||||
state.changes = createEmptyChangeSet();
|
||||
state.edit = null;
|
||||
state.editAttempt = null;
|
||||
state.editStarting = null;
|
||||
state.editUncertain = null;
|
||||
state.editNeedsReload = false;
|
||||
api.forgetEdit();
|
||||
renderLogin('会话已过期,请重新登录。', 'warn');
|
||||
});
|
||||
|
||||
// 离开页面时请求回滚仍持有的编辑快照。
|
||||
window.addEventListener('pagehide', () => {
|
||||
api.closeConsoleOnPagehide();
|
||||
const edit = state.edit ?? state.editAttempt;
|
||||
if (edit && !state.editBusy) {
|
||||
navigator.sendBeacon('/api/edit/rollback', new Blob([JSON.stringify(edit)], { type: 'application/json' }));
|
||||
}
|
||||
});
|
||||
|
||||
// 未提交或结果未知时提示页面关闭。
|
||||
window.addEventListener('beforeunload', (event) => {
|
||||
if (changeCount(state.changes) || state.editBusy) {
|
||||
event.preventDefault();
|
||||
event.returnValue = '';
|
||||
}
|
||||
});
|
||||
|
||||
root.addEventListener('click', onClick);
|
||||
root.addEventListener('change', onChange);
|
||||
root.addEventListener('submit', onSubmit);
|
||||
|
||||
@@ -23,6 +23,8 @@ export const accountsTable = '__system_users';
|
||||
// 值转 SQL 字面量(字符串加引号转义)。
|
||||
export function sqlLiteral(value) {
|
||||
if (value === null || value === undefined) return 'NULL';
|
||||
const runtime = runtimeEnvelope(value);
|
||||
if (runtime) return runtimeValueText(runtime[1], runtime[2], true);
|
||||
if (typeof value === 'number' || typeof value === 'boolean') return String(value);
|
||||
return `'${String(value).replaceAll("'", "''")}'`;
|
||||
}
|
||||
@@ -235,6 +237,11 @@ export function isBooleanType(type) {
|
||||
|
||||
// 类型的显示名。
|
||||
export function typeLabel(type) {
|
||||
if (String(type).startsWith('runtime(') && String(type).endsWith(')')) {
|
||||
const envelope = JSON.parse(String(type).slice(8, -1));
|
||||
if (!Array.isArray(envelope) || envelope.length !== 2 || envelope[0] !== 1) throw new Error('Unsupported runtime type encoding');
|
||||
return runtimeTypeText(envelope[1]);
|
||||
}
|
||||
const kind = columnKind(type);
|
||||
const label = typeLabels[kind];
|
||||
const args = String(type).includes('(') ? String(type).slice(String(type).indexOf('(')) : '';
|
||||
@@ -247,6 +254,8 @@ export function typeLabel(type) {
|
||||
// 单元格显示文本(空值用占位文本)。
|
||||
export function cellText(value, nullText) {
|
||||
if (value === null || value === undefined) return nullText;
|
||||
const runtime = runtimeEnvelope(value);
|
||||
if (runtime) return runtimeValueText(runtime[1], runtime[2], false);
|
||||
if (typeof value === 'boolean') return value ? 'true' : 'false';
|
||||
return String(value);
|
||||
}
|
||||
@@ -254,9 +263,60 @@ export function cellText(value, nullText) {
|
||||
// 编辑框里回填的文本(null 给空串)。
|
||||
export function editText(value) {
|
||||
if (value === null || value === undefined) return '';
|
||||
const runtime = runtimeEnvelope(value);
|
||||
if (runtime && runtime[1][0] <= 4) return String(runtime[2]);
|
||||
if (runtime) return runtimeValueText(runtime[1], runtime[2], false);
|
||||
return String(value);
|
||||
}
|
||||
|
||||
// 读取版本化运行时值封装。
|
||||
function runtimeEnvelope(value) {
|
||||
if (!value || typeof value !== 'object' || !Object.hasOwn(value, '__chusql_runtime_v1')) return null;
|
||||
const envelope = value.__chusql_runtime_v1;
|
||||
if (!Array.isArray(envelope) || envelope.length !== 3 || envelope[0] !== 1) throw new Error('Unsupported runtime value encoding');
|
||||
return envelope;
|
||||
}
|
||||
|
||||
// 渲染运行时类型的 SQL 语法。
|
||||
function runtimeTypeText(type) {
|
||||
if (!Array.isArray(type) || type.length !== 2 || !Array.isArray(type[1])) throw new Error('Invalid runtime type identity');
|
||||
const [id, args] = type;
|
||||
if (!Number.isInteger(id)) throw new Error('Invalid runtime constructor identity');
|
||||
if (id >= 1 && id <= 4 && args.length === 0) return ['Int', 'Double', 'Bool', 'String'][id - 1];
|
||||
if (id === 5 && args.length === 1) return `[${runtimeTypeText(args[0])}]`;
|
||||
if (id === 6 && args.length === 1) return `Maybe ${runtimeTypeText(args[0])}`;
|
||||
if (id === 7) return `(${args.map(runtimeTypeText).join(', ')})`;
|
||||
throw new Error('Unknown runtime type identity');
|
||||
}
|
||||
|
||||
// 渲染复合值或对应的 SQL 构造器。
|
||||
function runtimeValueText(type, value, sql) {
|
||||
runtimeTypeText(type);
|
||||
const [id, args] = type;
|
||||
if (id === 1 || id === 2) {
|
||||
if (typeof value !== 'number' || !Number.isFinite(value)) throw new Error('Invalid runtime numeric value');
|
||||
if (id === 1 && !Number.isInteger(value)) throw new Error('Invalid runtime integer value');
|
||||
const text = String(value);
|
||||
return sql && id === 2 && !/[.eE]/.test(text) ? `${text}.0` : text;
|
||||
}
|
||||
if (id === 3 && typeof value === 'boolean') return sql ? (value ? 'TRUE' : 'FALSE') : String(value);
|
||||
if (id === 4 && typeof value === 'string') return sql ? sqlLiteral(value) : JSON.stringify(value);
|
||||
if (!Array.isArray(value)) throw new Error('Invalid runtime compound value');
|
||||
if (id === 5) {
|
||||
const items = value.map((item) => runtimeValueText(args[0], item, sql)).join(', ');
|
||||
return sql ? `LIST<${runtimeTypeText(args[0])}>(${items})` : `[${items}]`;
|
||||
}
|
||||
if (id === 6 && value.length <= 1) {
|
||||
const item = value.length ? runtimeValueText(args[0], value[0], sql) : '';
|
||||
return sql ? `MAYBE<${runtimeTypeText(args[0])}>(${item})` : (value.length ? `Just (${item})` : 'Nothing');
|
||||
}
|
||||
if (id === 7 && value.length === args.length) {
|
||||
const items = value.map((item, index) => runtimeValueText(args[index], item, sql)).join(', ');
|
||||
return sql ? `TUPLE<${args.map(runtimeTypeText).join(', ')}>(${items})` : `(${items})`;
|
||||
}
|
||||
throw new Error('Runtime value type mismatch');
|
||||
}
|
||||
|
||||
// 编辑框文本转提交值(空串当 null)。
|
||||
export function parseEdited(raw, type) {
|
||||
const text = String(raw ?? '').trim();
|
||||
|
||||
@@ -179,7 +179,8 @@ gateSpec = do
|
||||
-- 静态目录与管理员名都不再写进配置:前者写死 static,后者由 --user 给(默认 root);
|
||||
-- 监听地址是活的配置项([server] listen_host / [web] listen_host),模板里可以留空靠内置默认
|
||||
template `shouldSatisfy` (not . T.isInfixOf "static_dir =")
|
||||
template `shouldSatisfy` (not . T.isInfixOf "user =")
|
||||
template `shouldSatisfy` (not . any ((== "user") . T.strip . fst . T.breakOn "=") . T.lines)
|
||||
template `shouldSatisfy` T.isInfixOf ("sudo_auth_user = " <> T.pack (show ("" :: String)))
|
||||
-- 管道传输退休后,两侧都不该再算套接字路径、也不该再认管名。
|
||||
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")
|
||||
@@ -202,28 +203,28 @@ gateSpec = do
|
||||
-- 仓库里没有 rustfmt.toml,历史代码不是按当前 rustfmt 排的:格式化不是门禁
|
||||
pipeline `shouldSatisfy` (not . T.isInfixOf "cargo fmt")
|
||||
-- 装的人不该被要求装两个工具链:发版流水线出预编译包,install.sh 按同一套平台标签去取。
|
||||
-- 流水线里装配与打归档是直接写的(两个平台各一段);本机要打同一个包用 scripts/ 下的
|
||||
-- package.sh 与它的 PowerShell 版,两边的布局必须一致。
|
||||
-- 发布流水线调用共享打包脚本,校验归档及安装结果。
|
||||
it "the release pipeline publishes one archive per platform, tagged the way install.sh looks it up" $ do
|
||||
release <- readUtf8 (".." </> ".github" </> "workflows" </> "release.yml")
|
||||
release `shouldSatisfy` T.isInfixOf "linux-x86_64"
|
||||
release `shouldSatisfy` T.isInfixOf "macos-arm64"
|
||||
release `shouldSatisfy` T.isInfixOf "macos-x86_64"
|
||||
release `shouldSatisfy` (not . T.isInfixOf "platform: macos")
|
||||
T.count "platform:" release `shouldBe` 2
|
||||
release `shouldSatisfy` T.isInfixOf "windows-x86_64"
|
||||
release `shouldSatisfy` T.isInfixOf "cargo build --release"
|
||||
release `shouldSatisfy` T.isInfixOf "stack build --fast chusql-web:exe:chusql-web"
|
||||
release `shouldSatisfy` T.isInfixOf "stack build --fast chusql-cli:exe:csql"
|
||||
release `shouldSatisfy` T.isInfixOf "tar -czf"
|
||||
release `shouldSatisfy` T.isInfixOf "Compress-Archive"
|
||||
release `shouldSatisfy` T.isInfixOf "sh scripts/package.sh"
|
||||
release `shouldSatisfy` T.isInfixOf "./scripts/package.ps1"
|
||||
release `shouldSatisfy` (not . T.isInfixOf "--no-verify")
|
||||
release `shouldSatisfy` (not . T.isInfixOf "-NoVerify")
|
||||
release `shouldSatisfy` T.isInfixOf "scripts/install.sh"
|
||||
release `shouldSatisfy` (not . T.isInfixOf "package.ps1")
|
||||
release `shouldSatisfy` T.isInfixOf "sha256"
|
||||
release `shouldSatisfy` T.isInfixOf "gh release upload"
|
||||
-- 四个平台各一个包,名字里没有组件那一层:一个包里 web 与 cli 都有;
|
||||
-- 两个平台各一个包,名字里没有组件那一层:一个包里 web 与 cli 都有;
|
||||
-- 矩阵里也不该再出现 web / cli 这一维(那样又会产出两个按组件命名的资产)
|
||||
release `shouldSatisfy` T.isInfixOf "name: ${{ matrix.platform }}"
|
||||
release `shouldSatisfy` T.isInfixOf "name=\"chusql-${{ matrix.platform }}\""
|
||||
release `shouldSatisfy` T.isInfixOf "name = \"chusql-${{ matrix.platform }}\""
|
||||
release `shouldSatisfy` T.isInfixOf "--platform '${{ matrix.platform }}'"
|
||||
release `shouldSatisfy` T.isInfixOf "-Platform '${{ matrix.platform }}'"
|
||||
release `shouldSatisfy` (not . T.isInfixOf "matrix.component")
|
||||
release `shouldSatisfy` (not . T.isInfixOf "component: [web, cli]")
|
||||
it "no layer looks for a storage executable or a pipe name any more" $ do
|
||||
|
||||
@@ -3,8 +3,12 @@
|
||||
module Main (main) where
|
||||
|
||||
import ChuSQL.Interface.Link (closeClient, connectClient)
|
||||
import ChuSQL.Interface.Auth (SessionPolicy (..), defaultSessionPolicy, lookupPayload, setPayloadPolicy)
|
||||
import ChuSQL.Interface.RateLimit (newRateLimiter)
|
||||
import ChuSQL.Interface.Session (authenticateSession, newSession, runStatement)
|
||||
import qualified ChuSQL.Interface.Actions as Actions
|
||||
import qualified ChuSQL.Core.Model as Model
|
||||
import ChuSQL.Core.Runtime
|
||||
import ChuSQL.Interface.Settings (
|
||||
applySettings,
|
||||
defaultOf,
|
||||
@@ -17,6 +21,7 @@ import ChuSQL.Interface.Settings (
|
||||
)
|
||||
import ChuSQL.Web.API (
|
||||
AppEnv (..),
|
||||
WebSession (..),
|
||||
Live (..),
|
||||
defaultLive,
|
||||
isIdentifier,
|
||||
@@ -27,8 +32,9 @@ import ChuSQL.Web.API (
|
||||
)
|
||||
import ChuSQL.Web.Static (contentTypeOf, safeRelative)
|
||||
import ChuSQL.Web.UISettings (validateUISettings)
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Exception (IOException, bracket, try)
|
||||
import Control.Concurrent (forkFinally, forkIO)
|
||||
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
|
||||
import Control.Exception (IOException, bracket, throwIO, try)
|
||||
import Control.Monad (when)
|
||||
import Data.Aeson (encode, object, (.=))
|
||||
import qualified Data.Aeson as A
|
||||
@@ -39,6 +45,7 @@ import qualified Data.ByteString.Char8 as BSC
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Char (isDigit)
|
||||
import Data.List (isInfixOf)
|
||||
import Data.IORef (readIORef)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
@@ -511,6 +518,17 @@ stopServer world = do
|
||||
-- | 纯函数用例
|
||||
unitSpec :: Spec
|
||||
unitSpec = describe "pure helpers" $ do
|
||||
it "rejects malformed runtime values before producing write SQL" $ do
|
||||
case resolveType builtinTypes (listType intType) of
|
||||
Left err -> expectationFailure err
|
||||
Right descriptor ->
|
||||
Actions.insertRowSql "t" [("xs", Model.VRuntime (descriptorId descriptor) (RList [RString "wrong"]))]
|
||||
`shouldSatisfy` either (const True) (const False)
|
||||
it "escapes nested runtime string literals" $ do
|
||||
case resolveType builtinTypes (listType stringType) of
|
||||
Left err -> expectationFailure err
|
||||
Right descriptor -> Actions.sqlLiteral (Model.VRuntime (descriptorId descriptor) (RList [RString "a'b"]))
|
||||
`shouldBe` Right "LIST<String>('a''b')"
|
||||
it "parses the session cookie out of a Cookie header" $ do
|
||||
parseCookieHeader sessionCookieName "a=1; chusql_session=abc123; b=2" `shouldBe` Just "abc123"
|
||||
parseCookieHeader sessionCookieName "other=1" `shouldBe` Nothing
|
||||
@@ -835,17 +853,54 @@ accountSpec env = describe "the account table (system database, admin only)" $ d
|
||||
roleSpec :: AppEnv -> Spec
|
||||
roleSpec env = describe "roles and grants" $ do
|
||||
withApp (webApp env) $ do
|
||||
it "uses database scopes and owner permissions through REST and rejects private data" $ do
|
||||
admin <- adminHeaders
|
||||
ensureDatabase admin testDatabaseName
|
||||
ensureAccount admin "acl_web_owner" "Owner-Secret-1234"
|
||||
ensureAccount admin "acl_web_reader" "Reader-Secret-1234"
|
||||
ensureTable admin "acl_private" (encode (object ["name" .= ("acl_private" :: Text), "columns" .= [column "id" "int"]]))
|
||||
permission <- postAs admin "/api/roles/acl_web_owner/grants" (encode (object ["object" .= ("database:" <> testDatabaseName), "privileges" .= (["connect", "create"] :: [Text])]))
|
||||
expectStatusWith "database object grant" permission 200
|
||||
owner <- ordinaryHeaders "acl_web_owner" "Owner-Secret-1234"
|
||||
created <- postAs (withDb testDatabaseName owner) "/api/tables" (encode (object ["name" .= ("acl_owned" :: Text), "columns" .= [column "id" "int"]]))
|
||||
expectStatusWith "owner creates table" created 200
|
||||
denied <- testSql owner "SELECT * FROM acl_private"
|
||||
expectStatusWith "private table denied" denied 403
|
||||
grantDenied <- postAs (withDb testDatabaseName owner) "/api/roles/acl_web_reader/grants" (encode (object ["object" .= (testDatabaseName <> ".acl_private"), "privileges" .= (["select"] :: [Text])]))
|
||||
expectStatusWith "missing grant option" grantDenied 403
|
||||
delegated <- postAs (withDb testDatabaseName owner) "/api/roles/acl_web_reader/grants" (encode (object ["object" .= (testDatabaseName <> ".acl_owned"), "privileges" .= (["select"] :: [Text])]))
|
||||
expectStatusWith "owner delegates via REST" delegated 200
|
||||
reader <- ordinaryHeaders "acl_web_reader" "Reader-Secret-1234"
|
||||
visible <- testSql reader "SELECT * FROM acl_owned"
|
||||
expectStatusWith "delegated query" visible 200
|
||||
revoked <- testSql admin "REVOKE SELECT ON acl_owned FROM acl_web_reader"
|
||||
expectStatusWith "root revokes owner delegation" revoked 200
|
||||
invalidated <- testSql reader "SELECT * FROM acl_owned"
|
||||
expectStatusWith "revoked Web session" invalidated 401
|
||||
it "filters database visibility after PUBLIC CONNECT is revoked" $ do
|
||||
admin <- adminHeaders
|
||||
ensureDatabase admin "acl_closed"
|
||||
ensureAccount admin "acl_web_guest" "Guest-Secret-1234"
|
||||
closed <- postAs admin "/api/query" (encode (object ["sql" .= ("REVOKE CONNECT ON DATABASE acl_closed FROM PUBLIC" :: Text)]))
|
||||
expectStatusWith "close default connection" closed 200
|
||||
guest <- ordinaryHeaders "acl_web_guest" "Guest-Secret-1234"
|
||||
listed <- getAs guest "/api/databases"
|
||||
expectStatusWith "filtered database list" listed 200
|
||||
check (("acl_closed" `elem` map asText (items (jsonBody listed))) `shouldBe` False)
|
||||
refused <- getAs (withDb "acl_closed" guest) "/api/tables"
|
||||
expectStatusWith "CONNECT denied through Web" refused 403
|
||||
it "creates a role, grants a privilege, adds a member and drops it" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
ensureAccount hs "bob" "bob-Secret-123456"
|
||||
ensureTable (withDb testDatabaseName hs) "grant_probe" (encode (object ["name" .= ("grant_probe" :: Text), "columns" .= [column "id" "int"]]))
|
||||
created <- postAs hs "/api/roles" (encode (object ["name" .= ("analyst" :: Text)]))
|
||||
expectStatusWith "create role" created 200
|
||||
granted <-
|
||||
postAs
|
||||
hs
|
||||
"/api/roles/analyst/grants"
|
||||
(encode (object ["object" .= testDatabaseName, "privileges" .= (["select"] :: [Text])]))
|
||||
(encode (object ["object" .= (testDatabaseName <> ".grant_probe"), "privileges" .= (["select"] :: [Text])]))
|
||||
expectStatusWith "grant privilege" granted 200
|
||||
member <- postAs hs "/api/roles/analyst/members" (encode (object ["user" .= ("bob" :: Text)]))
|
||||
expectStatusWith "add member" member 200
|
||||
@@ -865,13 +920,14 @@ roleSpec env = describe "roles and grants" $ do
|
||||
it "carries the grant option through the API" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
ensureTable (withDb testDatabaseName hs) "grant_option_probe" (encode (object ["name" .= ("grant_option_probe" :: Text), "columns" .= [column "id" "int"]]))
|
||||
created <- postAs hs "/api/roles" (encode (object ["name" .= ("passer" :: Text)]))
|
||||
expectStatusWith "create passer" created 200
|
||||
granted <-
|
||||
postAs
|
||||
(withDb testDatabaseName hs)
|
||||
"/api/roles/passer/grants"
|
||||
(encode (object ["object" .= testDatabaseName, "privileges" .= (["select"] :: [Text]), "grantOption" .= True]))
|
||||
(encode (object ["object" .= (testDatabaseName <> ".grant_option_probe"), "privileges" .= (["select"] :: [Text]), "grantOption" .= True]))
|
||||
expectStatusWith "grant with option" granted 200
|
||||
listed <- getAs hs "/api/roles"
|
||||
expectStatusWith "list roles" listed 200
|
||||
@@ -890,6 +946,16 @@ roleSpec env = describe "roles and grants" $ do
|
||||
querySpec :: AppEnv -> Spec
|
||||
querySpec env = describe "the SQL console" $ do
|
||||
withApp (webApp env) $ do
|
||||
it "returns typed compound values through HTTP and TCP" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
result <- testSql hs "SELECT LIST<Int>(1, 2), length('abc')"
|
||||
expectStatusWith "typed SQL values" result 200
|
||||
let value = maybe A.Null id (nth 0 (firstRow result))
|
||||
envelope = at "__chusql_runtime_v1" value
|
||||
check (arrayLen envelope `shouldBe` 3)
|
||||
check (asInt (maybe A.Null id (nth 0 (items envelope))) `shouldBe` 1)
|
||||
check (asInt (maybe A.Null id (nth 1 (firstRow result))) `shouldBe` 3)
|
||||
it "runs DDL and DML and returns positional rows" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
@@ -916,9 +982,230 @@ querySpec env = describe "the SQL console" $ do
|
||||
ensureDatabase hs testDatabaseName
|
||||
res <- postAs (withDb testDatabaseName hs) "/api/query" (encode (object ["sql" .= ("SELEC nonsense" :: Text)]))
|
||||
expectStatusWith "syntax error" res 400
|
||||
it "redacts credentials from malformed SQL responses" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
let secret = "Web-Secret-DoNotEcho123!" :: Text
|
||||
res <- postAs (withDb testDatabaseName hs) "/api/query" (encode (object ["sql" .= ("CREATE USER broken IDENTIFIED BY '" <> secret <> "' trailing")]))
|
||||
expectStatusWith "credential syntax error" res 400
|
||||
check (BSC.isInfixOf "Web-Secret-DoNotEcho123!" (BL.toStrict (WT.simpleBody res)) `shouldBe` False)
|
||||
check (BSC.isInfixOf "redacted" (BL.toStrict (WT.simpleBody res)) `shouldBe` True)
|
||||
|
||||
-- IDE 设置 -------------------------------------------------------------------
|
||||
|
||||
-- | 发出编辑事务控制请求。
|
||||
editRequest :: [Header] -> BS.ByteString -> Text -> [A.Value] -> TestSession WT.SResponse
|
||||
editRequest hs path owner changes = postAs hs path (encode (object
|
||||
["id" .= owner, "database" .= testDatabaseName, "changes" .= changes]))
|
||||
|
||||
-- | 在测试库执行一条 SQL。
|
||||
testSql :: [Header] -> Text -> TestSession WT.SResponse
|
||||
testSql hs sql = postAs (withDb testDatabaseName hs) "/api/query" (encode (object ["sql" .= sql]))
|
||||
|
||||
-- | 生成整数行插入编辑。
|
||||
editInsert :: Text -> Int -> A.Value
|
||||
editInsert table key = object ["op" .= ("insert" :: Text), "table" .= table,
|
||||
"values" .= object ["id" .= key, "value" .= key]]
|
||||
|
||||
-- | 验证编辑原子性、隔离与失效清理。
|
||||
editSpec :: AppEnv -> Spec
|
||||
editSpec env = describe "web editing transactions" $ withApp (webApp env) $ do
|
||||
it "commits across tables atomically and deduplicates successful retries" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
madeA <- testSql hs "CREATE TABLE edit_atomic_a (id int PRIMARY KEY, value int)"
|
||||
expectStatusWith "create first table" madeA 200
|
||||
madeB <- testSql hs "CREATE TABLE edit_atomic_b (id int PRIMARY KEY, value int)"
|
||||
expectStatusWith "create second table" madeB 200
|
||||
begun <- editRequest hs "/api/edit/begin" "atomic" []
|
||||
expectStatusWith "begin" begun 200
|
||||
let changes = [editInsert "edit_atomic_a" 1, editInsert "edit_atomic_b" 2]
|
||||
committed <- editRequest hs "/api/edit/commit" "atomic" changes
|
||||
expectStatusWith "commit" committed 200
|
||||
check (at "applied" (jsonBody committed) `shouldBe` A.Number 2)
|
||||
duplicate <- editRequest hs "/api/edit/commit" "atomic" changes
|
||||
expectStatusWith "duplicate commit" duplicate 200
|
||||
check (jsonBody duplicate `shouldBe` jsonBody committed)
|
||||
changed <- editRequest hs "/api/edit/commit" "atomic" [editInsert "edit_atomic_a" 9]
|
||||
expectStatusWith "changed duplicate" changed 409
|
||||
rowsA <- testSql hs "SELECT * FROM edit_atomic_a"
|
||||
rowsB <- testSql hs "SELECT * FROM edit_atomic_b"
|
||||
check (asInt (at "rowCount" (jsonBody rowsA)) `shouldBe` 1)
|
||||
check (asInt (at "rowCount" (jsonBody rowsB)) `shouldBe` 1)
|
||||
it "rolls back a mid-batch constraint error to the savepoint and permits correction" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
made <- testSql hs "CREATE TABLE edit_constraints (id int PRIMARY KEY, value int)"
|
||||
expectStatusWith "create table" made 200
|
||||
begun <- editRequest hs "/api/edit/begin" "constraints" []
|
||||
expectStatusWith "begin" begun 200
|
||||
failed <- editRequest hs "/api/edit/commit" "constraints" [editInsert "edit_constraints" 1, editInsert "edit_constraints" 1]
|
||||
expectStatusWith "constraint failure" failed 400
|
||||
check (at "state" (jsonBody failed) `shouldBe` A.String "active")
|
||||
check (at "applied" (jsonBody failed) `shouldBe` A.Number 0)
|
||||
visible <- testSql hs "SELECT * FROM edit_constraints"
|
||||
check (asInt (at "rowCount" (jsonBody visible)) `shouldBe` 0)
|
||||
snapshot <- getAs (("X-ChuSQL-Edit", "constraints") : withDb testDatabaseName hs) "/api/tables/edit_constraints/rows"
|
||||
expectStatusWith "snapshot after failure" snapshot 200
|
||||
check (asInt (at "total" (jsonBody snapshot)) `shouldBe` 0)
|
||||
corrected <- editRequest hs "/api/edit/commit" "constraints" [editInsert "edit_constraints" 2]
|
||||
expectStatusWith "corrected replay" corrected 200
|
||||
visibleAgain <- testSql hs "SELECT id FROM edit_constraints"
|
||||
check (firstRow visibleAgain `shouldBe` [A.Number 2])
|
||||
it "preserves the initial snapshot and rejects a conflicting external update" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
made <- testSql hs "CREATE TABLE edit_conflicts (id int PRIMARY KEY, value int)"
|
||||
expectStatusWith "create table" made 200
|
||||
seeded <- testSql hs "INSERT INTO edit_conflicts (id, value) VALUES (1, 10)"
|
||||
expectStatusWith "seed row" seeded 200
|
||||
begun <- editRequest hs "/api/edit/begin" "conflicts" []
|
||||
expectStatusWith "begin" begun 200
|
||||
observer <- adminHeaders
|
||||
updated <- testSql observer "UPDATE edit_conflicts SET value = 20 WHERE id = 1"
|
||||
expectStatusWith "concurrent update" updated 200
|
||||
snapshot <- getAs (("X-ChuSQL-Edit", "conflicts") : withDb testDatabaseName hs) "/api/tables/edit_conflicts/rows"
|
||||
check (firstRow snapshot `shouldBe` [A.Number 1, A.Number 10])
|
||||
let change = object ["op" .= ("update" :: Text), "table" .= ("edit_conflicts" :: Text),
|
||||
"pk" .= (1 :: Int), "set" .= object ["value" .= (30 :: Int)]]
|
||||
failed <- editRequest hs "/api/edit/commit" "conflicts" [change]
|
||||
expectStatusWith "serialization conflict" failed 409
|
||||
check (at "reloadRequired" (jsonBody failed) `shouldBe` A.Bool True)
|
||||
live <- testSql observer "SELECT value FROM edit_conflicts"
|
||||
check (firstRow live `shouldBe` [A.Number 20])
|
||||
retried <- editRequest hs "/api/edit/commit" "conflicts" [change]
|
||||
expectStatusWith "stale retry" retried 409
|
||||
reopened <- editRequest hs "/api/edit/begin" "conflicts" []
|
||||
expectStatusWith "stale begin" reopened 409
|
||||
it "binds editing to one page and database and makes rollback idempotent" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
begun <- editRequest hs "/api/edit/begin" "owner" []
|
||||
expectStatusWith "begin" begun 200
|
||||
repeated <- editRequest hs "/api/edit/begin" "owner" []
|
||||
expectStatusWith "repeated begin" repeated 200
|
||||
otherPage <- editRequest hs "/api/edit/begin" "intruder" []
|
||||
expectStatusWith "another page" otherPage 409
|
||||
otherDatabase <- postAs hs "/api/edit/commit" (encode (object
|
||||
["id" .= ("owner" :: Text), "database" .= ("system" :: Text), "changes" .= ([] :: [A.Value])]))
|
||||
expectStatusWith "another database" otherDatabase 409
|
||||
forged <- getAs (("X-ChuSQL-Edit", "intruder") : withDb testDatabaseName hs) "/api/tables"
|
||||
expectStatusWith "another page snapshot" forged 409
|
||||
rolled <- editRequest hs "/api/edit/rollback" "owner" []
|
||||
expectStatusWith "rollback" rolled 200
|
||||
duplicate <- editRequest hs "/api/edit/rollback" "owner" []
|
||||
expectStatusWith "repeated rollback" duplicate 200
|
||||
stale <- editRequest hs "/api/edit/begin" "owner" []
|
||||
expectStatusWith "ended identity" stale 409
|
||||
it "keeps SQL-console transactions separate from grid editing" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
made <- testSql hs "CREATE TABLE edit_console (id int PRIMARY KEY, value int)"
|
||||
expectStatusWith "create table" made 200
|
||||
consoleBegin <- testSql hs "BEGIN"
|
||||
expectStatusWith "console begin" consoleBegin 200
|
||||
consoleWrite <- testSql hs "INSERT INTO edit_console (id, value) VALUES (1, 1)"
|
||||
expectStatusWith "console write" consoleWrite 200
|
||||
begun <- editRequest hs "/api/edit/begin" "console" []
|
||||
expectStatusWith "editor begin" begun 200
|
||||
committed <- editRequest hs "/api/edit/commit" "console" [editInsert "edit_console" 2]
|
||||
expectStatusWith "editor commit" committed 200
|
||||
consoleRollback <- testSql hs "ROLLBACK"
|
||||
expectStatusWith "console rollback" consoleRollback 200
|
||||
live <- testSql hs "SELECT id FROM edit_console"
|
||||
check (firstRow live `shouldBe` [A.Number 2])
|
||||
it "drops the editing connection on logout and rejects the old transaction after login" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
begun <- editRequest hs "/api/edit/begin" "logout" []
|
||||
expectStatusWith "begin" begun 200
|
||||
gone <- postAs hs "/api/logout" "{}"
|
||||
expectStatusWith "logout" gone 204
|
||||
rejected <- editRequest hs "/api/edit/commit" "logout" []
|
||||
expectStatusWith "old cookie" rejected 401
|
||||
newHs <- adminHeaders
|
||||
stale <- editRequest newHs "/api/edit/commit" "logout" []
|
||||
expectStatusWith "old transaction on new connection" stale 409
|
||||
it "rejects system identity transactions" $ do
|
||||
hs <- adminHeaders
|
||||
res <- postAs hs "/api/edit/begin" (encode (object ["id" .= ("identities" :: Text), "database" .= ("system" :: Text)]))
|
||||
expectStatusWith "identity transaction" res 400
|
||||
it "invalidates editing when the account loses its permission" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
made <- testSql hs "CREATE TABLE edit_permissions (id int PRIMARY KEY, value int)"
|
||||
expectStatusWith "create table" made 200
|
||||
ensureAccount hs "edit_user" "Editor-Secret-1234"
|
||||
granted <- testSql hs "GRANT SELECT, INSERT ON edit_permissions TO edit_user"
|
||||
expectStatusWith "grant editing" granted 200
|
||||
editor <- ordinaryHeaders "edit_user" "Editor-Secret-1234"
|
||||
begun <- editRequest editor "/api/edit/begin" "permissions" []
|
||||
expectStatusWith "begin" begun 200
|
||||
revoked <- testSql hs "REVOKE INSERT ON edit_permissions FROM edit_user"
|
||||
expectStatusWith "revoke insert" revoked 200
|
||||
rejected <- editRequest editor "/api/edit/commit" "permissions" [editInsert "edit_permissions" 1]
|
||||
expectStatusWith "invalidated editor" rejected 401
|
||||
live <- testSql hs "SELECT * FROM edit_permissions"
|
||||
check (asInt (at "rowCount" (jsonBody live)) `shouldBe` 0)
|
||||
it "restricts an SQL transaction to its owning console and blocks unrelated REST writes" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
let owner = ("X-ChuSQL-Console", "page:console-a") : hs
|
||||
intruder = ("X-ChuSQL-Console", "page:console-b") : hs
|
||||
begun <- testSql owner "/* owner */ BEGIN"
|
||||
expectStatusWith "console begin" begun 200
|
||||
rejected <- testSql intruder "ROLLBACK"
|
||||
expectStatusWith "other console rollback" rejected 409
|
||||
rest <- postAs (withDb testDatabaseName hs) "/api/tables" (encode (object
|
||||
["name" .= ("edit_rest_intruder" :: Text), "columns" .= [column "id" "int"]]))
|
||||
expectStatusWith "REST write inside console transaction" rest 409
|
||||
closed <- postAs hs "/api/query/rollback" (encode (object ["console" .= ("page:console-a" :: Text)]))
|
||||
expectStatusWith "close owning console" closed 204
|
||||
next <- testSql intruder "SELECT 1"
|
||||
expectStatusWith "other console after rollback" next 200
|
||||
it "cleans the editing snapshot when its web session expires" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
begun <- editRequest hs "/api/edit/begin" "expires" []
|
||||
expectStatusWith "begin" begun 200
|
||||
let token = fromMaybe "" (lookup "Cookie" hs >>= parseCookieHeader sessionCookieName . TE.decodeUtf8)
|
||||
stored <- liftIO (lookupPayload (aeSessions env) token)
|
||||
app <- getState
|
||||
res <- liftIO $ bracket
|
||||
(setPayloadPolicy (aeSessions env) (SessionPolicy (-1) 86400))
|
||||
(const (setPayloadPolicy (aeSessions env) defaultSessionPolicy))
|
||||
(const (editFromApp app hs "expires" []))
|
||||
expectStatusWith "expired commit" res 401
|
||||
case stored of
|
||||
Nothing -> check (expectationFailure "missing live web session")
|
||||
Just (_, ws) -> check (readIORef (wsEdit ws) >>= (`shouldBe` Nothing))
|
||||
it "serializes duplicate HTTP commits and applies the edit set once" $ do
|
||||
hs <- adminHeaders
|
||||
ensureDatabase hs testDatabaseName
|
||||
made <- testSql hs "CREATE TABLE edit_double_click (id int PRIMARY KEY, value int)"
|
||||
expectStatusWith "create table" made 200
|
||||
begun <- editRequest hs "/api/edit/begin" "double-click" []
|
||||
expectStatusWith "begin" begun 200
|
||||
app <- getState
|
||||
results <- liftIO $ do
|
||||
first <- newEmptyMVar
|
||||
second <- newEmptyMVar
|
||||
_ <- forkFinally (editFromApp app hs "double-click" [editInsert "edit_double_click" 1]) (putMVar first)
|
||||
_ <- forkFinally (editFromApp app hs "double-click" [editInsert "edit_double_click" 1]) (putMVar second)
|
||||
mapM (either throwIO pure) =<< sequence [takeMVar first, takeMVar second]
|
||||
mapM_ (\res -> expectStatusWith "duplicate concurrent commit" res 200) results
|
||||
live <- testSql hs "SELECT * FROM edit_double_click"
|
||||
check (asInt (at "rowCount" (jsonBody live)) `shouldBe` 1)
|
||||
|
||||
-- | 从独立请求上下文提交编辑事务。
|
||||
editFromApp :: Wai.Application -> [Header] -> Text -> [A.Value] -> IO WT.SResponse
|
||||
editFromApp app hs owner changes = WT.runSession send app
|
||||
where
|
||||
-- | 构造带 Cookie 的原子提交请求。
|
||||
send = WT.srequest (WT.SRequest
|
||||
(WT.setPath WT.defaultRequest {Wai.requestMethod = methodPost, Wai.requestHeaders = jsonHeaders hs} "/api/edit/commit")
|
||||
(encode (object ["id" .= owner, "database" .= testDatabaseName, "changes" .= changes])))
|
||||
|
||||
-- | IDE 设置用例
|
||||
uiSettingsSpec :: AppEnv -> Spec
|
||||
uiSettingsSpec env = describe "IDE settings" $ do
|
||||
@@ -1000,7 +1287,25 @@ main = do
|
||||
limitedEnv <- liveEnv limitedWorld staticDir 1
|
||||
hspec (spec staticDir env limitedEnv)
|
||||
|
||||
-- | 汇总挂载全部用例组
|
||||
-- | 执行前端事务状态回归。
|
||||
frontendSpec :: Spec
|
||||
frontendSpec = describe "browser transaction state" $ do
|
||||
it "passes the Node runtime value suite" $ do
|
||||
node <- findExecutable "node"
|
||||
case node of
|
||||
Nothing -> expectationFailure "Node.js is required for runtime value tests"
|
||||
Just executable -> do
|
||||
(exitCode, output, errors) <- readProcessWithExitCode executable ["test/runtime-values.mjs"] ""
|
||||
when (exitCode /= ExitSuccess) (expectationFailure (output ++ errors))
|
||||
it "passes the Node frontend transaction suite" $ do
|
||||
node <- findExecutable "node"
|
||||
case node of
|
||||
Nothing -> expectationFailure "Node.js is required for frontend transaction tests"
|
||||
Just executable -> do
|
||||
(exitCode, output, errors) <- readProcessWithExitCode executable ["--test", "--test-reporter=tap", "test/transactions.mjs"] ""
|
||||
when (exitCode /= ExitSuccess) (expectationFailure (output ++ errors))
|
||||
|
||||
-- | 汇总挂载全部用例组。
|
||||
spec :: FilePath -> AppEnv -> AppEnv -> Spec
|
||||
spec staticDir env limitedEnv = do
|
||||
unitSpec
|
||||
@@ -1013,6 +1318,8 @@ spec staticDir env limitedEnv = do
|
||||
accountSpec env
|
||||
roleSpec env
|
||||
querySpec env
|
||||
editSpec env
|
||||
frontendSpec
|
||||
uiSettingsSpec env
|
||||
e2eSpec env
|
||||
rateLimitSpec limitedEnv
|
||||
@@ -0,0 +1,20 @@
|
||||
import assert from 'node:assert/strict';
|
||||
import { readFile } from 'node:fs/promises';
|
||||
|
||||
// 检查前端复合值显示、SQL 生成和编码错误。
|
||||
|
||||
const source = await readFile(new URL('../static/core.js', import.meta.url), 'utf8');
|
||||
const { cellText, sqlLiteral, typeLabel, editText } = await import(`data:text/javascript;base64,${Buffer.from(source).toString('base64')}`);
|
||||
const typeInt = [1, []];
|
||||
const typeString = [4, []];
|
||||
const nested = { __chusql_runtime_v1: [1, [5, [[6, [typeInt]]]], [[], [42]]] };
|
||||
assert.equal(cellText(nested, 'NULL'), '[Nothing, Just (42)]');
|
||||
assert.equal(sqlLiteral(nested), 'LIST<Maybe Int>(MAYBE<Int>(), MAYBE<Int>(42))');
|
||||
assert.equal(sqlLiteral({ __chusql_runtime_v1: [1, [7, [typeInt, typeString]], [1, "a'b"]] }), "TUPLE<Int, String>(1, 'a''b')");
|
||||
assert.equal(sqlLiteral({ __chusql_runtime_v1: [1, [5, [[2, []]]], [1]] }), 'LIST<Double>(1.0)');
|
||||
assert.throws(() => cellText({ __chusql_runtime_v1: [2, typeInt, 1] }, 'NULL'), /encoding/);
|
||||
assert.throws(() => sqlLiteral({ __chusql_runtime_v1: [1, [7, [typeInt]], [1, 2]] }), /mismatch/);
|
||||
assert.equal(typeLabel('runtime([1,[5,[[1,[]]]]])'), '[Int]');
|
||||
assert.equal(editText({ __chusql_runtime_v1: [1, typeString, 'abc'] }), 'abc');
|
||||
assert.throws(() => sqlLiteral({ __chusql_runtime_v1: [1, typeInt, 1.5] }), /integer/);
|
||||
console.log('runtime values: 9 assertions passed');
|
||||
@@ -0,0 +1,175 @@
|
||||
import assert from 'node:assert/strict';
|
||||
import { readFile } from 'node:fs/promises';
|
||||
import { beforeEach, test } from 'node:test';
|
||||
import * as api from '../static/api.js';
|
||||
import { createEmptyChangeSet } from '../static/core.js';
|
||||
|
||||
// 验证页面编辑状态、原子请求、断线重试与关闭清理。
|
||||
|
||||
const listeners = new Map();
|
||||
globalThis.window = { addEventListener: (name, callback) => listeners.set(name, callback), dispatchEvent: () => {} };
|
||||
globalThis.document = { getElementById: (id) => id === 'root' ? { addEventListener() {} } : null };
|
||||
let source = await readFile(new URL('../static/app.js', import.meta.url), 'utf8');
|
||||
source = source.replaceAll("'./api.js'", JSON.stringify(new URL('../static/api.js', import.meta.url).href))
|
||||
.replaceAll("'./core.js'", JSON.stringify(new URL('../static/core.js', import.meta.url).href))
|
||||
.replace('void boot();', 'export { state, commitAll, rollbackAll, stageUpdate, removeStaged, ensureEdit, runSql };');
|
||||
const app = await import(`data:text/javascript;base64,${Buffer.from(source).toString('base64')}`);
|
||||
let calls;
|
||||
let commitResponse;
|
||||
|
||||
// 生成 JSON HTTP 响应。
|
||||
function response(body, status = 200) {
|
||||
return new Response(JSON.stringify(body), { status, headers: { 'Content-Type': 'application/json' } });
|
||||
}
|
||||
|
||||
// 重置页面与模拟服务端。
|
||||
beforeEach(() => {
|
||||
calls = [];
|
||||
commitResponse = () => response({ ok: true, applied: 1, state: 'committed' });
|
||||
api.forgetEdit();
|
||||
Object.assign(app.state, { database: 'test', databases: ['test'], tabs: [], activeId: undefined,
|
||||
view: 'workbench', session: { user: 'admin' }, edit: { id: 'page', database: 'test' },
|
||||
editBusy: false, editStarting: null, editAttempt: null, editNeedsReload: false, editUncertain: null,
|
||||
changes: createEmptyChangeSet(), messages: [] });
|
||||
globalThis.fetch = async (url, init) => {
|
||||
calls.push({ url, init, body: init.body ? JSON.parse(init.body) : undefined });
|
||||
if (url === '/api/edit/commit') return commitResponse();
|
||||
if (url === '/api/databases') return response(['test']);
|
||||
if (url === '/api/tables') return response([]);
|
||||
return response({ state: 'active' });
|
||||
};
|
||||
});
|
||||
|
||||
// 检查整批修改只发送一次提交请求。
|
||||
test('all table edits use one atomic request and clear only after success', async () => {
|
||||
app.stageUpdate('first', 'test', 1, 'value', 10, 20);
|
||||
app.stageUpdate('second', 'test', 2, 'value', 20, 30);
|
||||
await app.commitAll();
|
||||
const committed = calls.filter((call) => call.url === '/api/edit/commit');
|
||||
assert.equal(committed.length, 1);
|
||||
assert.equal(committed[0].body.changes.length, 2);
|
||||
assert.equal(app.state.changes.updates.size, 0);
|
||||
assert.equal(app.state.edit, null);
|
||||
assert.equal(calls.some((call) => call.init.method === 'PATCH'), false);
|
||||
});
|
||||
|
||||
// 检查失败保留可修正的完整编辑集。
|
||||
test('constraint failure retains all edits and permits local undo before replay', async () => {
|
||||
app.stageUpdate('first', 'test', 1, 'value', 10, 20);
|
||||
app.stageUpdate('second', 'test', 2, 'value', 20, 30);
|
||||
commitResponse = () => response({ ok: false, applied: 0, state: 'active', message: 'constraint', reloadRequired: false }, 400);
|
||||
await app.commitAll();
|
||||
assert.equal(app.state.changes.updates.size, 2);
|
||||
assert.equal(app.state.editNeedsReload, false);
|
||||
app.removeStaged([...app.state.changes.updates.keys()][0]);
|
||||
assert.equal(app.state.changes.updates.size, 1);
|
||||
assert.equal(calls.some((call) => call.init.method === 'PATCH'), false);
|
||||
});
|
||||
|
||||
// 检查冲突禁止再次提交直到回滚。
|
||||
test('serialization conflict freezes edits and requires rollback and reload', async () => {
|
||||
app.stageUpdate('first', 'test', 1, 'value', 10, 20);
|
||||
commitResponse = () => response({ ok: false, state: 'rolled_back', reloadRequired: true, message: 'conflict' }, 409);
|
||||
await app.commitAll();
|
||||
await app.commitAll();
|
||||
assert.equal(calls.filter((call) => call.url === '/api/edit/commit').length, 1);
|
||||
assert.equal(app.state.changes.updates.size, 1);
|
||||
app.stageUpdate('first', 'test', 1, 'value', 10, 40);
|
||||
assert.equal([...app.state.changes.updates.values()][0].newValue, 20);
|
||||
await app.rollbackAll();
|
||||
assert.equal(app.state.changes.updates.size, 0);
|
||||
assert.equal(app.state.editNeedsReload, false);
|
||||
assert.equal(calls.some((call) => call.url === '/api/edit/rollback'), true);
|
||||
});
|
||||
|
||||
// 检查断线后冻结载荷并使用同一提交标识。
|
||||
test('an uncertain response retries the same payload without allowing edits', async () => {
|
||||
app.stageUpdate('first', 'test', 1, 'value', 10, 20);
|
||||
commitResponse = () => { throw new Error('connection lost'); };
|
||||
await app.commitAll();
|
||||
assert.ok(app.state.editUncertain);
|
||||
app.stageUpdate('first', 'test', 1, 'value', 10, 99);
|
||||
commitResponse = () => response({ ok: true, applied: 1, state: 'committed' });
|
||||
await app.commitAll();
|
||||
const committed = calls.filter((call) => call.url === '/api/edit/commit');
|
||||
assert.deepEqual(committed[0].body, committed[1].body);
|
||||
assert.equal(app.state.editUncertain, null);
|
||||
});
|
||||
|
||||
// 检查并发点击只有一个正在提交的请求。
|
||||
test('duplicate clicks cannot submit concurrently', async () => {
|
||||
app.stageUpdate('first', 'test', 1, 'value', 10, 20);
|
||||
await Promise.all([app.commitAll(), app.commitAll()]);
|
||||
assert.equal(calls.filter((call) => call.url === '/api/edit/commit').length, 1);
|
||||
});
|
||||
|
||||
// 检查快照读取带页面标识且普通 SQL 无标识。
|
||||
test('snapshot headers are attached only to table reads', async () => {
|
||||
await api.beginEdit('page', 'test');
|
||||
await api.listTables('test');
|
||||
globalThis.fetch = async (url, init) => {
|
||||
calls.push({ url, init });
|
||||
return response({ columns: [], rows: [], rowCount: 0 });
|
||||
};
|
||||
await api.query('SELECT 1', 'test');
|
||||
assert.equal(calls.find((call) => call.url === '/api/tables').init.headers.get('X-ChuSQL-Edit'), 'page');
|
||||
assert.equal(calls.find((call) => call.url === '/api/query').init.headers.has('X-ChuSQL-Edit'), false);
|
||||
});
|
||||
|
||||
// 检查页面离开时发送回滚请求。
|
||||
test('page close sends a rollback beacon for its own transaction', async () => {
|
||||
let beacon;
|
||||
Object.defineProperty(globalThis, 'navigator', { configurable: true, value: { sendBeacon: (url, body) => { beacon = { url, body }; } } });
|
||||
listeners.get('pagehide')();
|
||||
assert.equal(beacon.url, '/api/edit/rollback');
|
||||
assert.deepEqual(JSON.parse(await beacon.body.text()), { id: 'page', database: 'test' });
|
||||
});
|
||||
|
||||
// 检查 BEGIN 回包断线后仍使用同一标识。
|
||||
test('a lost BEGIN response keeps its identity for an idempotent retry', async () => {
|
||||
app.state.edit = null;
|
||||
globalThis.fetch = async (url, init) => {
|
||||
calls.push({ url, init, body: JSON.parse(init.body) });
|
||||
if (calls.length === 1) throw new Error('begin response lost');
|
||||
return response({ state: 'active' });
|
||||
};
|
||||
await assert.rejects(app.ensureEdit('test'));
|
||||
assert.ok(app.state.editAttempt);
|
||||
await app.ensureEdit('test');
|
||||
assert.deepEqual(calls[0].body, calls[1].body);
|
||||
assert.equal(app.state.edit.id, calls[0].body.id);
|
||||
});
|
||||
|
||||
// 检查每个 SQL 标签使用独立所有者标识。
|
||||
test('console transaction cleanup only applies to its owning tab', async () => {
|
||||
globalThis.fetch = async (url, init) => {
|
||||
calls.push({ url, init, body: JSON.parse(init.body) });
|
||||
return response({ columns: [], rows: [], rowCount: 0, transaction: true });
|
||||
};
|
||||
await api.query('BEGIN', 'test', 'first');
|
||||
const owner = calls[0].init.headers.get('X-ChuSQL-Console');
|
||||
assert.ok(owner.endsWith(':first'));
|
||||
await api.rollbackConsole('second');
|
||||
assert.equal(calls.length, 1);
|
||||
await api.rollbackConsole('first');
|
||||
assert.equal(calls[1].url, '/api/query/rollback');
|
||||
assert.equal(calls[1].body.console, owner);
|
||||
});
|
||||
|
||||
// 检查 SQL 回滚等待期间不能继续编辑旧快照。
|
||||
test('edits are locked while SQL releases the previous snapshot', async () => {
|
||||
let release;
|
||||
globalThis.fetch = async (url, init) => {
|
||||
calls.push({ url, init });
|
||||
if (url === '/api/edit/rollback') return new Promise((resolve) => { release = () => resolve(response({ state: 'rolled_back' })); });
|
||||
return response({ columns: ['value'], rows: [[1]], rowCount: 1 });
|
||||
};
|
||||
const job = app.runSql({ id: 'query', database: 'test', sql: 'SELECT 1' });
|
||||
assert.equal(app.state.editBusy, true);
|
||||
app.stageUpdate('first', 'test', 1, 'value', 10, 20);
|
||||
assert.equal(app.state.changes.updates.size, 0);
|
||||
release();
|
||||
await job;
|
||||
assert.equal(app.state.editBusy, false);
|
||||
assert.equal(app.state.edit, null);
|
||||
});
|
||||
@@ -40,6 +40,8 @@ Web / CLI / 其他客户端
|
||||
- 每条 TCP 连接拥有独立会话,当前数据库和事务互不影响。
|
||||
- 读请求可并行,写请求由存储层协调。
|
||||
- Web 与 CLI 共享服务端的权限和执行规则,不直接读写数据目录。
|
||||
- Web 登录会话分别持有普通 API / SQL 连接与表格编辑连接,编辑事务按页面标识固定数据库。表格读取携带编辑标识时使用该事务快照;普通查询不进入编辑事务。
|
||||
- 同一 Web Cookie 的请求串行执行。编辑提交以固定保存点重放本地编辑集,失败整体回退;成功回执按提交标识去重。SQL 控制台事务另按页面与标签标识限制连接访问。
|
||||
|
||||
## SQL 查询处理
|
||||
|
||||
@@ -97,15 +99,136 @@ Web / CLI / 其他客户端
|
||||
| 机制 | 行为 |
|
||||
| --- | --- |
|
||||
| 角色继承 | 沿成员关系取得权限并集;拒绝自继承与环 |
|
||||
| 表级授权 | 支持 SELECT、INSERT、UPDATE、DELETE 和 ALL |
|
||||
| 对象授权 | 数据库 CONNECT / CREATE,表 SELECT / INSERT / UPDATE / DELETE;ALL 按作用域展开 |
|
||||
| 转授权 | WITH GRANT OPTION 允许将持有的权限授予其他身份 |
|
||||
| 撤销 | 管理员撤销权限及对应转授权能力;当前不级联撤销已转授权限 |
|
||||
| 对象名称 | 授权前补全为库.表,检查与持久化使用同一名称 |
|
||||
| 撤销 | 授予者撤销自身来源;所有者或最高权限身份管理对象授权,级联清理无合法来源的下游 |
|
||||
| 稳定对象 | catalog 分配数据库及表编号,授权与所有者绑定对象和身份编号,删除后不复用 |
|
||||
| 所有者 | 建表者获得表所有权;启用角色可继承所有权,数据库所有权不隐含他人表的数据权限 |
|
||||
|
||||
对象权限目录 __system_object_acl 对普通语句和存储请求隐藏。权限快照按字符分块,在系统库写锁内比较版本并通过同一 WAL 组替换;服务启动恢复建表前持久化的创建者声明,旧名称授权只迁移一次到现存稳定对象。
|
||||
|
||||
类型目录说明见 [types.md](types.md),身份字段与权限边界见 [users-and-roles.md](users-and-roles.md)。
|
||||
|
||||
## 权限变更与会话失效
|
||||
|
||||
账号、属性和授权变化会标记受影响的在线连接。角色变化先展开成员关系,确定涉及的登录身份。
|
||||
账号、属性和授权变化会标记受影响的在线连接。角色变化先展开成员及转授权来源关系,确定涉及的登录身份。共享读写门允许查询并行,并将授权及对象结构变更与查询排序;事务提交再次验证权限和稳定对象编号。
|
||||
|
||||
TCP 连接在下一次请求时返回 unauthorized 并关闭;空闲连接不被强行中断。权限逐条查询,避免继续使用旧授权。Web 会话还通过账号版本校验,口令或身份变更使旧凭据失效。
|
||||
|
||||
## 查询引擎扩展设计(尚未实现)
|
||||
|
||||
按 bound IR → 子查询物化 / 递归 CTE 推进;DOMAIN 约束见[类型文档](types.md#domain-约束设计尚未实现)。以下设计尚未实施,当前能力见前文;实施状态以 project-plan.txt 为准。
|
||||
|
||||
### bound IR
|
||||
|
||||
#### 列与作用域绑定
|
||||
|
||||
保留语法 AST 用于解析和诊断;语义检查产出独立 `BoundStatement`,规划、优化及执行逐步只接收它。列引用绑定为作用域编号、来源编号、列编号和类型,保留原始位置用于诊断;相关列明确标记所属外层作用域,不再通过字符串补限定名辨认身份。
|
||||
|
||||
#### 表达式类型与错误语义
|
||||
|
||||
表达式节点携带结果类型、nullable、已解析运算符/函数标识和显式转换。没有证据证明安全时 `may_error` 为 true;优化不得删除或提前求值可能报错的表达式。未定型 NULL 只参与推导,最后绑定到上下文类型;不允许流入存储 schema。DOMAIN 身份保留在类型节点中,比较可以用底层语义,赋值需经过领域校验。
|
||||
|
||||
#### schema 与对象版本
|
||||
|
||||
绑定仅使用 schema,不能扫描数据或打开索引。catalog 解析对象后提供 schema 与版本;执行前再次验证稳定对象编号和 schema 版本。统计独立附着,不纳入绑定身份。内存存储使用与磁盘相同的绑定规则。
|
||||
|
||||
#### 实施与验收
|
||||
|
||||
迁移顺序为查询表达式 → RelOp 输入 → 写语句和约束;过渡适配器单向转换且仅位于边界,不维护两套优化规则。验收用现有查询全集并补同名遮蔽、相关列、别名、NULL/DOMAIN 和错误时序回归;既有可观察顺序保持。
|
||||
|
||||
### 通用子查询物化
|
||||
|
||||
#### 惰性执行与缓存身份
|
||||
|
||||
引入查询内 `LazyMaterialize` 算子:首次实际需要时执行,保留结果行序与重复;非相关查询每语句一次,相关查询按 bound IR 外层列绑定值缓存。缓存键沿用规范值相等、NULL 与领域底层语义,并绑定子计划和执行视图;不能跨语句、会话或权限版本复用。
|
||||
|
||||
#### 求值语义
|
||||
|
||||
首版只物化已证明确定且无副作用的子计划;可能报错的表达式保持现有首次使用和短路路径,无法证明错误时序相同的改写禁用。空输入不触发子查询,标量多行仍在实际消费时报错。ANY/ALL、IN、EXISTS 各自保留三值及空集规则,不能用集合去重替代结果。
|
||||
|
||||
#### 预算与回退
|
||||
|
||||
预算同时限制单缓存、查询总缓存和相关键数量;超过预算时在执行该次子计划前选择不缓存的原路径,不能重跑已执行一半的计划。磁盘溢写作为后续阶段,需明确临时目录、类型编码、权限及取消清理。EXPLAIN 展示物化范围与估算,运行统计不泄露缓存行值。
|
||||
|
||||
#### 验收条件
|
||||
|
||||
验收比较启用/禁用的结果多重集、行序、首次错误、空输入、NULL、重复外层绑定、多次 CTE 引用、预算及取消;不确定函数不可复用。
|
||||
|
||||
### 递归 CTE
|
||||
|
||||
#### 首版语法范围
|
||||
|
||||
保留现有非递归 WITH 行为;新增 WITH RECURSIVE 走绑定作用域,不在解析期无限展开。首版仅单一自引用、锚点 UNION ALL 递归项;自引用只能出现在递归项 FROM,锚点不可引用自身。互递归、多个自引用、递归项聚合/排序/LIMIT、外连接及非单调子查询明确拒绝。UNION 去重递归留后续设计,不能冒用 UNION ALL。
|
||||
|
||||
#### 类型绑定与迭代
|
||||
|
||||
锚点和递归项输出列数相同;显式列名唯一,先由锚点确定类型,再校验递归项可赋值转换,不按运行数据扩宽。无法给锚点 NULL 定型时要求显式类型。执行用 worktable,递归项仅读取上一轮 delta,按轮次和每轮既有行序追加输出,保留 UNION ALL 重复。
|
||||
|
||||
#### 资源预算与终止
|
||||
|
||||
拟定默认深度 1000、累计行数 100000、内存 64 MiB,并受服务端上限限制;达到任一预算返回 resource_limit,不返回截断结果。深度定义为递归项执行轮数;delta 为空正常终止。外层 LIMIT 首版不作为终止证明,先完整执行递归再消费,避免隐藏循环/错误。取消释放所有 worktable。
|
||||
|
||||
#### 验收条件
|
||||
|
||||
验收覆盖零轮、多轮、重复路径、循环超限、NULL/类型冲突、空锚点、名称遮蔽、非法自引用和查询取消。EXPLAIN 明确递归与预算。
|
||||
|
||||
## 存储与事务扩展设计(尚未实现)
|
||||
|
||||
先引入稳定行编号和 MVCC,再实施跨页 compact 与并行写。前置条件是新页格式、版本化 WAL、离线升级工具及恢复验收。
|
||||
|
||||
新格式必须标版本,旧二进制拒绝打开。旧数据在保留备份的停服副本上升级、校验后发布,不混用新旧写入路径。每阶段先运行改动模块的规定测试入口,全量门禁由所有者运行;性能数据不能代替语义、恢复或权限验收。
|
||||
|
||||
### 行版本 MVCC
|
||||
|
||||
#### 身份与可见性
|
||||
|
||||
引入库内单调 row_id,独立于用户 `id`、主键及物理槽号;删除不复用。每版本包含 row_id、版本编号、创建/结束提交序号与前版本定位,未提交版本只在事务私有工作集内。读视图固定 snapshot_csn,选取创建序号不大于快照且结束序号大于快照的版本,再合并自身修改。提交序号与 WAL LSN 分离,映射随提交记录持久化。
|
||||
|
||||
每连接仍只允许一个事务,保持快照隔离和保存点语义;不声称可串行化,写偏斜仍可能发生。写集记录读取的基线版本,提交验证该版本仍为最新;同 row_id 更新/删除冲突返回 serialization_failure。唯一键冲突在当前已提交状态和本次写集联合检查,不能仅用开始快照验证。无业务 id 的表也按 row_id 提交,不再整表替换。
|
||||
|
||||
索引键定位 row_id,索引查询再按快照检查版本;更新键保留旧键候选直到所有活跃快照不再需要,不能只索引最新值。扫描先保持旧格式导入的行序,更新不改 row_id 的扫描位置,新插入按持久化序号排序;不得借 MVCC 无意改变现有无 ORDER BY 输出。
|
||||
|
||||
#### 提交、恢复与回收
|
||||
|
||||
首版仍串行提交:验证 → 分配 CSN → WAL 记录版本变化及提交 → fsync → 应用 → 统一发布可见 CSN。读者仅获取已完整应用的可见序号;持久化提交后应用失败继续采用 recovery_required 封闭请求,不能把已提交组当作失败撤销。不引入未提交脏页,因此首版保持 redo-only;若将来允许提前刷未提交页,必须另行设计 undo/状态恢复。
|
||||
|
||||
保存点记录私有写集边界与不可变根,回退不撤销其他事务版本。活跃快照登记器包括流式扫描和物化消费者;最老快照决定旧版本回收界线。回收同时处理 heap 和索引,读定位有 pin,取消/断线可靠注销。长事务受现有寿命及新增保留空间预算限制,不能为了回收静默推进其快照。
|
||||
|
||||
升级在停服副本中为旧行分配 row_id、初始版本和顺序,重建索引,验证行数/值/约束后切换;不得把重复业务 id 合并。新 WAL 与页格式显式版本化,截断仍遵循已刷盘检查点,不顺带改成页 LSN 检查点。
|
||||
|
||||
#### 验收条件
|
||||
|
||||
验收包含重复/缺失业务 id、旧快照与键更新、删除重插、保存点、唯一并发冲突、写偏斜边界、长读回收、断线及提交每个持久化边界的崩溃恢复;复测 BEGIN/COMMIT 的传输和比较成本。
|
||||
|
||||
### 跨页 compact
|
||||
|
||||
#### 定位与影子页
|
||||
|
||||
使用 row_id 到版本位置的存储内部定位映射,索引不保存可失效的页/槽定位。首版在表维护独占锁下进行,等待该表读 pin 释放;其他表仍可运行。以快照回收界线保留所有可能可见版本,按既有逻辑扫描顺序打包到影子页和定位映射,随后 WAL 记录并原子切换文件代次。
|
||||
|
||||
#### 恢复与旧版本保护
|
||||
|
||||
旧代次直到无读引用且新代次检查点完成才删除;提交前崩溃丢弃影子文件,提交后重放切换。映射缺失、重复 row_id/版本和校验失败明确报错,不返回缺行扫描。隐藏列一并按当前 schema 改写,旧快照需要的结构不得提前删除。跨页整理不改变对象编号、行编号、值或输出顺序。
|
||||
|
||||
#### 验收条件
|
||||
|
||||
验收验证前后全量扫描和索引点/范围查一致、快照旧版本、隐藏列、页损坏、空间不足、取消与文件切换崩溃;记录回收页数及 IO,不能只比较耗时。
|
||||
|
||||
### 并行写
|
||||
|
||||
#### 实施顺序与锁范围
|
||||
|
||||
先允许事务私有写集准备并行,继续保留短串行 WAL/CSN 发布;第二阶段按稳定表编号与 row_id 排序取得写锁、唯一键锁。DDL/维护使用库结构锁,跨表事务必须一次取得完整锁集,禁止边执行边任意升级。权限读门在执行和最终复查期间保持现有语义;目录及 ACL 修改仍单独排序。
|
||||
|
||||
#### 唯一键锁与取消
|
||||
|
||||
唯一键锁使用与值相等一致的规范编码,缺主键也使用 row_id 锁。等待有取消与超时,超时返回明确错误且保持/回退事务遵循现有错误分类;固定锁序避免内部锁环,不承诺支持任意用户锁或死锁自动重试。
|
||||
|
||||
#### 提交发布顺序
|
||||
|
||||
允许不同表/行的验证和页面准备并行,但同一页短 latch、catalog 高水位、索引节点和 WAL 写入仍保护。发布 CSN 必须按提交顺序形成连续已应用前缀,后提交不能跨过未完成组而对读者可见。group commit 为后续性能阶段,不能改变每组原子性和持久化失败语义。
|
||||
|
||||
#### 验收条件
|
||||
|
||||
验收覆盖同表不同行、同一行、唯一键冲突、跨表相反顺序、DDL/compact/撤权竞争、超时取消和 WAL 故障;用确定同步点断言并发结果,再单独测吞吐与等待时间。
|
||||
@@ -1,7 +0,0 @@
|
||||
# README 徽章
|
||||
|
||||
所有徽章都是本地 SVG,采用统一的深色标签、彩色值区和圆角样式。
|
||||
|
||||
执行 `pwsh -File scripts/update-code-lines.ps1` 可重新生成全部徽章。代码行数包含代码、测试、注释和空行,排除 Git 忽略的构建工件;行数与提交编号是生成时的本地快照。
|
||||
|
||||
发布徽章链接 GitHub 版本列表。构建、测试和门禁徽章提供实时状态页面入口,本地图片显示 `view status` 或 `manual status`,不保存或宣称实时通过状态。门禁由所有者手动触发。
|
||||
@@ -1,6 +0,0 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" width="160" height="24" viewBox="0 0 160 24" role="img" aria-label="build: view status">
|
||||
<title>Open the build workflow for live status; this local badge is a navigation link.</title>
|
||||
<defs><clipPath id="rounded"><rect width="160" height="24" rx="5"/></clipPath></defs>
|
||||
<g clip-path="url(#rounded)"><rect width="160" height="24" fill="#1e293b"/><rect x="59" width="101" height="24" fill="#0369a1"/></g>
|
||||
<g fill="#fff" text-anchor="middle" font-family="Verdana,DejaVu Sans,sans-serif" font-size="11"><text x="29.5" y="16">build</text><text x="109.5" y="16">view status</text></g>
|
||||
</svg>
|
||||
|
Before Width: | Height: | Size: 634 B |
@@ -1,6 +0,0 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" width="139" height="24" viewBox="0 0 139 24" role="img" aria-label="commit: fd5f320">
|
||||
<title>Local HEAD snapshot when the badges were generated; open commit history for latest updates.</title>
|
||||
<defs><clipPath id="rounded"><rect width="139" height="24" rx="5"/></clipPath></defs>
|
||||
<g clip-path="url(#rounded)"><rect width="139" height="24" fill="#1e293b"/><rect x="66" width="73" height="24" fill="#475569"/></g>
|
||||
<g fill="#fff" text-anchor="middle" font-family="Verdana,DejaVu Sans,sans-serif" font-size="11"><text x="33" y="16">commit</text><text x="102.5" y="16">fd5f320</text></g>
|
||||
</svg>
|
||||
|
Before Width: | Height: | Size: 637 B |
@@ -1,6 +0,0 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" width="167" height="24" viewBox="0 0 167 24" role="img" aria-label="gate: manual status">
|
||||
<title>Open the owner-triggered gate workflow for status; this local badge is a navigation link.</title>
|
||||
<defs><clipPath id="rounded"><rect width="167" height="24" rx="5"/></clipPath></defs>
|
||||
<g clip-path="url(#rounded)"><rect width="167" height="24" fill="#1e293b"/><rect x="52" width="115" height="24" fill="#b45309"/></g>
|
||||
<g fill="#fff" text-anchor="middle" font-family="Verdana,DejaVu Sans,sans-serif" font-size="11"><text x="26" y="16">gate</text><text x="109.5" y="16">manual status</text></g>
|
||||
</svg>
|
||||
|
Before Width: | Height: | Size: 644 B |
@@ -1,6 +0,0 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" width="209" height="24" viewBox="0 0 209 24" role="img" aria-label="languages: Haskell + Rust">
|
||||
<title>ChuSQL implementation languages: Haskell and Rust.</title>
|
||||
<defs><clipPath id="rounded"><rect width="209" height="24" rx="5"/></clipPath></defs>
|
||||
<g clip-path="url(#rounded)"><rect width="209" height="24" fill="#1e293b"/><rect x="87" width="122" height="24" fill="#6d28d9"/></g>
|
||||
<g fill="#fff" text-anchor="middle" font-family="Verdana,DejaVu Sans,sans-serif" font-size="11"><text x="43.5" y="16">languages</text><text x="148" y="16">Haskell + Rust</text></g>
|
||||
</svg>
|
||||
|
Before Width: | Height: | Size: 617 B |
@@ -1,6 +0,0 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" width="174" height="24" viewBox="0 0 174 24" role="img" aria-label="source lines: 37,149">
|
||||
<title>Physical source lines; includes tests, comments and blank lines.</title>
|
||||
<defs><clipPath id="rounded"><rect width="174" height="24" rx="5"/></clipPath></defs>
|
||||
<g clip-path="url(#rounded)"><rect width="174" height="24" fill="#1e293b"/><rect x="108" width="66" height="24" fill="#0369a1"/></g>
|
||||
<g fill="#fff" text-anchor="middle" font-family="Verdana,DejaVu Sans,sans-serif" font-size="11"><text x="54" y="16">source lines</text><text x="141" y="16">37,149</text></g>
|
||||
</svg>
|
||||
|
Before Width: | Height: | Size: 619 B |
@@ -1,6 +0,0 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" width="139" height="24" viewBox="0 0 139 24" role="img" aria-label="release: browse">
|
||||
<title>Open GitHub releases to view published versions.</title>
|
||||
<defs><clipPath id="rounded"><rect width="139" height="24" rx="5"/></clipPath></defs>
|
||||
<g clip-path="url(#rounded)"><rect width="139" height="24" fill="#1e293b"/><rect x="73" width="66" height="24" fill="#6d28d9"/></g>
|
||||
<g fill="#fff" text-anchor="middle" font-family="Verdana,DejaVu Sans,sans-serif" font-size="11"><text x="36.5" y="16">release</text><text x="106" y="16">browse</text></g>
|
||||
</svg>
|
||||
|
Before Width: | Height: | Size: 594 B |
@@ -1,6 +0,0 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" width="160" height="24" viewBox="0 0 160 24" role="img" aria-label="tests: view status">
|
||||
<title>Open the test workflow for live status; this local badge is a navigation link.</title>
|
||||
<defs><clipPath id="rounded"><rect width="160" height="24" rx="5"/></clipPath></defs>
|
||||
<g clip-path="url(#rounded)"><rect width="160" height="24" fill="#1e293b"/><rect x="59" width="101" height="24" fill="#0369a1"/></g>
|
||||
<g fill="#fff" text-anchor="middle" font-family="Verdana,DejaVu Sans,sans-serif" font-size="11"><text x="29.5" y="16">tests</text><text x="109.5" y="16">view status</text></g>
|
||||
</svg>
|
||||
|
Before Width: | Height: | Size: 633 B |
@@ -45,6 +45,7 @@ csql [options]
|
||||
| `-f, --format FORMAT` | 输出格式:`table`、`json` 或 `csv` |
|
||||
| `-e, --execute SQL` | 执行一条 SQL 后退出 |
|
||||
| `--history FILE` | 指定历史记录文件 |
|
||||
| `--sudo` | 使用本机 root / 提升管理员身份认证;需配置映射并启用身份属性,见 [用户与角色](users-and-roles.md#本机-sudo-认证) |
|
||||
| `--config FILE` | 指定配置文件 |
|
||||
| `-h, --help` | 显示帮助 |
|
||||
|
||||
@@ -99,6 +100,18 @@ chusql-web [options]
|
||||
|
||||
静态资源目录固定为 `static`。其余请求大小、会话、登录限制、分页等参数通常通过 `settings.toml` 配置即可。
|
||||
|
||||
### 表格编辑与事务
|
||||
|
||||
首次打开业务数据表时建立编辑快照。同一页面内、同一数据库的跨表修改统一暂存;“提交全部”在服务端事务中执行,全部成功才持久化。逐项撤销只移除本地编辑项,下次提交从原快照重放剩余编辑;“撤销全部”执行 ROLLBACK 并重新加载表和统计。
|
||||
|
||||
途中发生约束错误时,整批语句退回编辑保存点,完整编辑内容仍可修正。写写冲突不会覆盖其他会话,必须撤销并重新加载后重新编辑。提交响应断线时冻结编辑集;再次点击提交使用同一标识确认或重试同一批修改,已成功的提交不会重复执行。
|
||||
|
||||
编辑事务绑定登录会话、页面和数据库;待提交修改存在时,先提交或撤销才能换库或运行 SQL。关闭最后一个表标签且没有待提交修改时释放快照。关闭页面会请求回滚,退出登录会关闭连接并丢弃快照;若页面断线、回滚请求未送达,后台每分钟按配置的会话空闲与最长寿命清理连接。重新登录不能继续旧事务。
|
||||
|
||||
SQL 控制台使用另一条服务端连接;SQL 的 BEGIN / COMMIT / ROLLBACK 绑定发起它的页面与查询标签。事务尚未结束时,其他控制台和普通 REST 写操作不能占用该连接;关闭所属查询标签或页面时请求回滚。系统身份修改不支持数据事务,账号表只读,使用 SQL 用户与角色命令管理。
|
||||
|
||||
Web 模块测试入口为 `stack test chusql-web --fast`,其中同时运行 `node --test test/transactions.mjs`;测试环境需要 Node.js。
|
||||
|
||||
## chusql-server
|
||||
|
||||
基本用法:
|
||||
|
||||
@@ -53,6 +53,8 @@ ChuSQL 使用统一配置文件 `settings.toml`。默认位置:
|
||||
| `max_message` | `1048576` | 单条请求最大大小(字节) |
|
||||
| `max_rows` | `1000` | 单次查询最大返回行数 |
|
||||
|
||||
本机 sudo 认证额外使用 `[server] sudo_auth_user`,默认空字符串,表示关闭。设置为一个已启用 `ALLOW_SUDO_AUTH` 的数据库身份后,必须以 Unix root 或 Windows 提升后的管理员运行 `chusql-server`。这是明确的本机身份映射,与启动参数 `--user` 和最高权限属性分别设置。配置变更后重启服务生效,Web 设置页面不提供此项。操作步骤见 [用户与角色](users-and-roles.md#本机-sudo-认证)。
|
||||
|
||||
修改 Server 相关配置后需要重启 `chusql-server`。
|
||||
|
||||
## 账号与安全
|
||||
|
||||
@@ -33,6 +33,17 @@ ChuSQL 支持三种安装方式:
|
||||
|
||||
完成系统目录初始化后,安装程序默认会启动 `chusql-server`;如不希望自动启动,可使用 `--no-start`(Windows 为 `-NoStart`)。
|
||||
|
||||
Linux 默认注册 `chusql-server.service` 为当前操作系统用户的 systemd 服务,并启用 linger 和开机启动,无需登录即可运行,异常退出后自动重启。需要可用的 systemd 用户会话;若启用 linger 时权限不足,按安装提示执行 `sudo loginctl enable-linger "$(id -un)"` 后重试。数据库管理员 `--user` 与运行服务的操作系统用户是两个独立身份。
|
||||
|
||||
`--no-start` 仅跳过本次启动,仍启用开机启动。非 systemd 环境可使用 `--no-service` 跳过服务注册,此时保留原有后台启动方式。
|
||||
|
||||
```sh
|
||||
systemctl --user status chusql-server.service
|
||||
systemctl --user restart chusql-server.service
|
||||
systemctl --user stop chusql-server.service
|
||||
journalctl --user -u chusql-server.service
|
||||
```
|
||||
|
||||
## 包内安装
|
||||
|
||||
解压发行包后,在包根目录执行:
|
||||
@@ -56,6 +67,7 @@ Windows:
|
||||
| `--data-dir DIR` | `-DataDir` | 指定数据目录 |
|
||||
| `--user NAME` | `-RootUser` | 指定管理员账号名 |
|
||||
| `--no-start` | `-NoStart` | 安装后不自动启动服务 |
|
||||
| `--no-service` | — | 跳过 Linux 服务注册和开机启动 |
|
||||
| `--version TAG` | `-Version` | 指定发行版本 |
|
||||
| `--list-versions` | `-ListVersions` | 列出可安装版本 |
|
||||
| `--from-source` | — | 从源码构建并安装 |
|
||||
@@ -108,3 +120,9 @@ Windows:
|
||||
```
|
||||
|
||||
如需保留数据,可使用 `--keep-data`(Windows 为 `-KeepData`);如需保留配置,可使用 `--keep-config`(Windows 为 `-KeepConfig`)。
|
||||
|
||||
Linux 卸载时会停止服务、取消开机启动并移除服务文件。用户的 linger 设置保留,其他用户服务仍可使用它。
|
||||
|
||||
## 发布真实性与后续签名方案
|
||||
|
||||
当前 SHA256 校验用于检测产物损坏,发布签名尚未实现。密钥管理、可信根、轮换、在线与离线验证的设计见[发布签名与验证](release-signing.md);设计中的验证器和签名安装流程目前不可用。
|
||||
@@ -0,0 +1,143 @@
|
||||
# 数据库范式分析与迁移
|
||||
|
||||
引擎模块 `ChuSQL.Core.Engine.Normalization` 提供只读范式分析。输入只有 schema 与用户声明,不读取样本数据,不访问或修改存储。
|
||||
|
||||
## 接口与示例
|
||||
|
||||
```haskell
|
||||
analyzeNormalization
|
||||
:: [(String, Column)]
|
||||
-> Declaration
|
||||
-> Either String Analysis
|
||||
```
|
||||
|
||||
调用示例:
|
||||
|
||||
```haskell
|
||||
analyzeNormalization [("student", TInt), ("course", TInt), ("name", TStr)]
|
||||
(Declaration
|
||||
{ declaredKeys = [["student", "course"]]
|
||||
, dependencies = [Dependency ["student"] ["name"]]
|
||||
, dependenciesComplete = True
|
||||
, atomicAttributes = Just True
|
||||
})
|
||||
```
|
||||
|
||||
这个声明违反 2NF、3NF、BCNF:非主属性 `name` 依赖复合候选键的真子集 `student`。
|
||||
|
||||
报告的 `witnesses` 给出相关字段,`condition` 给出范式条件。建议分为 `(student, name)` 与 `(course, student)`,无损连接并保持声明依赖。
|
||||
|
||||
## 声明与输入校验
|
||||
|
||||
`declaredKeys` 中每个键作为决定全部字段的依赖加入公理推导;检查器验证其最小性,并枚举所有最小超键。空键允许表达只有一行的关系约束。
|
||||
|
||||
字段名称使用 schema 中的确切名称,不自行处理 SQL 标识符解析。以下输入返回明确错误:
|
||||
|
||||
- 未知字段或重复字段。
|
||||
- 空依赖右部。
|
||||
- 非最小候选键。
|
||||
- 空 schema。
|
||||
|
||||
## 公理推导与范式条件
|
||||
|
||||
属性闭包以输入属性实现自反性,逐轮加入已满足左部的依赖右部,得到阿姆斯特朗增广和传递规则蕴含的闭包。检查器枚举字段子集及其闭包,检查完整的依赖投影。
|
||||
|
||||
| 范式 | 检查条件 |
|
||||
| --- | --- |
|
||||
| 1NF | 根据用户声明判断领域值原子性。 |
|
||||
| 2NF | 检查所有候选键的部分依赖。 |
|
||||
| 3NF | 检查非超键左部与非主属性右部。 |
|
||||
| BCNF | 检查非超键左部。 |
|
||||
|
||||
理论定义可参考[数据库课程讲义](https://documents.uow.edu.au/~jrg/235/slides/03databasenormalization/03databasenormalization.html)。
|
||||
|
||||
## 信息完整性与判定
|
||||
|
||||
### 领域值原子性
|
||||
|
||||
`atomicAttributes` 是用户关于领域值原子性的声明:
|
||||
|
||||
| 声明值 | 1NF 判定 |
|
||||
| --- | --- |
|
||||
| `Just True` | 满足。 |
|
||||
| `Just False` | 违反。 |
|
||||
| `Nothing` | 信息不足。 |
|
||||
|
||||
schema 类型不证明业务意义上的原子性。不满足 1NF 时更高范式也判违反;原子性未知时更高范式信息不足。
|
||||
|
||||
### 依赖完整性
|
||||
|
||||
只有 `dependenciesComplete = True` 才对更高范式给出满足或违反结论。这表示用户承诺给出了完整业务依赖的一个覆盖,而非必须列出所有推导依赖。完整的空依赖集有效。
|
||||
|
||||
未承诺完整时,更高范式返回 `Insufficient`,不输出违反证据或分解建议。此时 `candidateKeys` 仅是相对已知声明求得的键,不能视为完整业务候选键清单。
|
||||
|
||||
分析始终以声明为条件,不能证明数据库实际数据满足声明。
|
||||
|
||||
## 分解建议
|
||||
|
||||
分解建议仅针对第一条 BCNF 违反依赖 `X -> Y`,输出两个子关系:
|
||||
|
||||
- `X ∪ Y`
|
||||
- `R − (Y − X)`
|
||||
|
||||
该二元分解由依赖保证无损;依赖保持通过两个子关系的完整依赖投影之并是否蕴含原依赖集判定。
|
||||
|
||||
建议只是一轮分解,子关系可能仍需继续分析,不承诺一次达到 BCNF。依赖不保持时需跨关系检查原约束。
|
||||
|
||||
## 第一阶段限制
|
||||
|
||||
- 最多接受 12 列,超过返回错误,避免指数枚举无界增长。
|
||||
- 仅提供 Haskell 只读 API。
|
||||
- CLI / Web 入口和自动迁移尚未实现。
|
||||
|
||||
## 后续入口设计(尚未实现)
|
||||
|
||||
以下 TCP、CLI 和 Web 接口尚未实现,拟议命令与端点目前不可用。实施状态以 project-plan.txt 为准。
|
||||
|
||||
### 协议与鉴权
|
||||
|
||||
在 `ChuSQL.Interface.Protocol` 增加专用客户端请求 `normalization_analyze`,由 server 调用 engine API;不经最高权限专用的原始 `ReqStorage` 入口。请求包含 `api_version=1`、数据库与表标识、声明,以及可选的预期对象编号和 schema 指纹。server 在现有权限读门内以 catalog 解析现存对象,检查 CONNECT 与 SELECT;系统对象拒绝访问。事务内取该连接的 schema 快照,返回视图来源和对象编号,不能混入其他连接的快照。
|
||||
|
||||
声明字段固定为 `declared_keys`、`dependencies`(`lhs` / `rhs`)、`dependencies_complete`、`atomic_attributes`。完整性缺省 false,原子性缺省 null;不把 PRIMARY KEY、UNIQUE 或样本自动当作完整业务依赖。前端可以展示实际 schema 约束供用户选择,确认后才成为声明。候选键的 nullable 与 SQL UNIQUE 语义单独提示,不自动证明经典关系模型的键。
|
||||
|
||||
响应包含对象编号、schema 指纹、规范化声明、候选键、四项 findings 和一次分解建议。稳定标签使用 `1nf/2nf/3nf/bcnf`、`satisfied/violated/insufficient`;条件说明与机器字段分开。所有结论标明“以声明为条件”,无损连接标签不代表现有 SQL 数据或袋语义已经验证。
|
||||
|
||||
字段名称必须与返回 schema 的确切列名一致;对象名称使用现有标识符规则,数据库限定名必须与请求数据库一致。指纹只覆盖列名、类型和约束等语义结构,排除行数与直方图;定义确定性编码并同时绑定稳定对象编号,避免同名重建复用报告。
|
||||
|
||||
拒绝未知协议版本、未知字段、重复字段、空右部、非最小声明键、空 schema 和超过 12 列。拟定请求上限 64 KiB、依赖条数 256、键声明 256;预算超限返回明确错误,不截断后给出完整报告。分析在有界工作队列运行,取消或超时释放权限读门与会话资源;输出也受传输预算约束,超限返回错误。实施时用最坏 12 列声明确定默认时间预算。
|
||||
|
||||
### CLI 与 Web
|
||||
|
||||
CLI 拟议元命令为 `\normalize TABLE --declaration FILE --format text|json`,通过当前登录连接和工作库请求。声明文件为 UTF-8 JSON,错误写 stderr;成功分析退出码 0,即使结论违反或信息不足;协议、权限、输入与运行错误退出非零。批处理增加独立 `--normalize` 模式,与 `--execute` 互斥,不把元命令发给 SQL 解析器。
|
||||
|
||||
Web 拟议 `POST /api/normalization/analyze`,复用登录、CSRF 和 Cookie 串行规则。入口位于表结构页:展示 schema、编辑声明、提交分析、显示证据和分解字段列表。完整性与原子性不预先勾选;没有自动执行分解按钮。编辑页分析必须携带既有页面事务标识,不能自动开启另一事务。对象或 schema 改变返回冲突并要求重新分析。
|
||||
|
||||
### 入口验收
|
||||
|
||||
验收覆盖 engine 报告的协议往返、CLI 文本/JSON 同值、Web 与 TCP 越权、跨库同名、删表重建、事务快照、超限及取消。沿用现有 14 项算法回归,不复制算法到客户端。
|
||||
|
||||
## 数据迁移设计(尚未实现)
|
||||
|
||||
先实现只读入口,再在 [DOMAIN 约束](types.md#domain-约束设计尚未实现)、依赖目录和原子结构发布具备后实施迁移。
|
||||
|
||||
### 规划条件
|
||||
|
||||
迁移首版限定单业务表、二元分解、显式目标名,保留原表,不自动改名或删除。请求必须引用报告对象编号、schema 指纹及声明摘要;报告本身不是执行授权。要求来源 SELECT、数据库 CREATE;切换旧表需要来源所有权。每个目标取得新编号和执行者所有权,原 ACL 不自动复制。
|
||||
|
||||
经典 FD 与无损分解适用于关系集合,当前 SQL 保留重复行且有 NULL。首版只接受所有参与字段 NOT NULL、全行无重复且声明确实成立的数据;否则明确拒绝,不能通过 DISTINCT 悄悄丢行。候选键也必须验证唯一和非空,包括空键最多一行。FD 验证按引擎规范值相等规则分组,禁止使用文本序列化代替值比较。
|
||||
|
||||
目标数据为各字段投影的集合。验证每条声明 FD、全部候选键、目标约束及两目标连接与来源的完整多重集相等;无损性理论证明和实际重建检查均须通过。若投影依赖不能保持所有原依赖,首版拒绝迁移;后续有跨表约束执行器后再开放,不只弹提示继续。
|
||||
|
||||
### 结构依赖与发布
|
||||
|
||||
规划器枚举索引、默认值、CHECK、DOMAIN 引用、外键及其他已登记依赖,逐项生成保留或拒绝理由。单目标可表达的约束绑定后迁移;跨目标 CHECK、无法保存的索引/唯一约束及任何无法枚举的受支持依赖阻止发布。不得根据 SQL 文本替换列名。客户端保存的任意 SQL 无法枚举,保留来源表可避免静默改坏;首版不提供透明替换。
|
||||
|
||||
执行流程为 prepare → validate → publish:prepare 创建不对业务 catalog 可见的暂存对象;validate 固定来源视图并生成目标、验证重建;publish 在短结构锁内复查身份、权限、对象编号、schema 与数据版本,原子登记全部目标。来源变化返回 serialization_failure,不自动重试。暂存对象需要空间预算、作业编号和取消清理。
|
||||
|
||||
现有事务禁止 DDL,不能拼接 CREATE/INSERT 伪装成原子迁移。实施前必须加入包含 catalog、页文件、索引和所有权声明的迁移 WAL 发布组;提交前暂存文件可清理,提交后故障进入 recovery_required 并重放到完整目标组。对象编号可以跳号但不得复用。恢复仅依据作业状态与 WAL 清理暂存对象,不能按名称猜测。
|
||||
|
||||
后续替换来源需独立设计:稳定对象引用、授权重绑定、完整依赖图与原子交换。保留原对象及其编号直到该方案验收;当前阶段不提供多轮自动 BCNF 化。
|
||||
|
||||
### 迁移验收
|
||||
|
||||
验收包含重复/NULL/不成立 FD 的拒绝、依赖不保持、跨目标约束、并发修改、撤权、名称占用、取消、空间不足,以及每个 WAL/文件发布边界的崩溃恢复;失败不得留下部分可见目标。
|
||||
@@ -103,6 +103,8 @@ stack exec -- benchmark4csql 10000 50000
|
||||
|
||||
## 性能瓶颈分析
|
||||
|
||||
本节描述首次基准时的实现;事务差分优化后的结果见文末复测。
|
||||
|
||||
### 1. 事务提交的整库差分是首要排查点
|
||||
|
||||
本次 200 条事务 INSERT 比 200 次独立持久化 INSERT 慢约 60 倍。事务阶段开始时,数据库已有 10,000 用户、50,000 订单及 5,000 宽行,事务只修改 writes 表。事务内一次 400 行 UPDATE 仅耗时 0.5 ms,说明不能将整个事务阶段的 67.55 秒简单归因于 SQL 更新计算或 fsync。
|
||||
@@ -132,3 +134,23 @@ stack exec -- benchmark4csql 10000 50000
|
||||
## 使用范围
|
||||
|
||||
这是单机回环、主要为热缓存、管理员身份的单次基准,不是生产容量承诺。未覆盖远程网络、鉴权角色开销、崩溃恢复耗时、并发写冲突或大型宽表。七次读采样和单次写测量不足以建立统计置信区间,后续优化应使用相同参数、多次独立运行和分阶段 profile 比较。
|
||||
|
||||
## 2026-10-05 事务差分优化复测
|
||||
|
||||
使用相同机器、优化构建及 10,000 用户、50,000 订单规模运行完整基准,所有场景及结果校验通过(`BENCHMARK_OK`)。日志为 `logs/repair-txn-performance.log`。
|
||||
|
||||
COMMIT 跳过未修改表,以 IntMap / IntSet 查询整数键差分,冲突检查与操作生成共享差分;保持原行顺序及重复 id 的首行查找语义。
|
||||
|
||||
| 指标 | 耗时(ms) |
|
||||
| --- | ---: |
|
||||
| 200 次独立持久化 INSERT | 1,134.7 |
|
||||
| 事务 200 条 INSERT 总计 | 687.355 |
|
||||
| BEGIN | 269.806 |
|
||||
| 事务内 200 条 INSERT | 41.129 |
|
||||
| COMMIT | 376.345 |
|
||||
|
||||
事务总耗时从首次的 67,549.539 ms 降至 687.355 ms,约快 98 倍,吞吐从 2.96 升至 290.97 行/秒;本次事务写入约比逐条持久化快 1.65 倍。两次独立运行未建立统计置信区间,倍数仅描述这两次测量。
|
||||
|
||||
BEGIN 与 COMMIT 仍获取整库快照,合计约占事务总耗时的 94%;COMMIT 计时也包含差分、冲突检查和持久化,不能全部归因于快照。整库快照传输、修改表比较及刷盘仍需进一步分阶段测量。
|
||||
|
||||
20 个不同绑定的相关 EXISTS 平均 2,135.218 ms(首次 2,061.770 ms),该瓶颈仍存在,本轮没有改变子查询执行方式。
|
||||
@@ -0,0 +1,31 @@
|
||||
# 发布签名与验证设计
|
||||
|
||||
本文定义尚未实现的发行安全方案。当前操作见[安装文档](install.md),实施状态以 project-plan.txt 为准。先实现离线验证,再接入在线安装;该工作可独立于查询和存储扩展推进。
|
||||
|
||||
## 选择与信任入口
|
||||
|
||||
采用标准 TUF root/targets/snapshot/timestamp 元数据和 Ed25519 签名,使用经过维护的实现与标准测试向量,不自行定义签名 JSON 规范。Ed25519 算法依据 [RFC 8032](https://datatracker.ietf.org/doc/rfc8032/),角色、轮换、版本及过期验证依据 [TUF 规范](https://theupdateframework.github.io/specification/v1.0.36/)。SHA256 保留为产物散列,签名覆盖其可信元数据来源。
|
||||
|
||||
可信初始 root 随独立取得的安装器/验证器发布,记录版本与公钥;不能从同一个未认证下载响应接受任意公钥。首次下载安装器仍依赖用户可信取得该安装器这一入口,不能宣称脚本内公钥解决首次下载脚本被替换。升级客户端保存可信元数据的版本与过期状态,拒绝回退、混配和过期;状态缺失不等同于已完成反回退验证。
|
||||
|
||||
targets 绑定确切文件名、长度、SHA256、平台/架构、版本、提交号、组件清单与最低数据格式要求。snapshot 固定元数据版本/散列,timestamp 指向 snapshot。禁止通配匹配产物、跨平台替代和同版本静默覆盖;签名通过后才允许解包或执行 bootstrap。
|
||||
|
||||
## 密钥与发布操作
|
||||
|
||||
root 使用离线 2-of-3 阈值密钥,分开保管及加密备份;CI 不持有 root 私钥。targets 发布密钥限定于受保护发布环境,仅受信任标签与人工发布流程可调用;PR 构建、普通日志、构建缓存和发行包均不能读取私钥。snapshot/timestamp 使用独立在线密钥,权限和有效期按角色设置;拟定 targets/snapshot 30 天、timestamp 7 天、root 1 年,并通过到期监控续签。
|
||||
|
||||
轮换 root 按连续版本发布,同时满足旧 root 与新 root 阈值;离线备份定期做恢复演练。在线密钥泄露时停止发布,用 root 撤销并更换受影响角色密钥,重新生成元数据;所有 root 信任丢失时需要经独立可信渠道重新引导,不能靠损坏的 root 自证恢复。
|
||||
|
||||
发布顺序为构建与模块/所有者门禁 → 装配确切产物 → 计算散列 → 签 targets/snapshot → 上传产物和版本化元数据 → 最后发布 timestamp。任何产物字节变化均需重新签署。签名不证明构建内容正确,平台真机验收仍单列。
|
||||
|
||||
## 安装与兼容性
|
||||
|
||||
新增小型跨平台验证器,打包随安装器提供;验证器不可作为首个未验证的临时下载再立即执行。在线安装先验证元数据链、版本、有效期与目标平台,再下载并验长度/散列,之后才解包。签名缺失、密钥未知、元数据过期、系统时间无法可信校验等均明确失败,不降级成仅 SHA256。
|
||||
|
||||
本地离线安装使用随包 root 链、targets 和 snapshot 验证真实性与完整性;缺少在线 timestamp 时明确说明不能证明最新版本。离线模式必须显式选择且不联网;已有可信版本仍禁止回退,元数据过期仍失败,需要重新取得有效离线元数据。历史无签名包不纳入新安装器的可信安装路径。
|
||||
|
||||
系统原生代码签名分别设计接入 Windows Authenticode 和 macOS Developer ID/notarization;TUF 不能替代操作系统签名,第一阶段也不声称消除 SmartScreen/Gatekeeper 提示。Linux $ORIGIN、在线下载与 macOS 发行继续按现有实机待办验收。
|
||||
|
||||
## 验收条件
|
||||
|
||||
验收覆盖合法包、字节篡改、错误平台、截断、签名替换、重复键/非法元数据、未知密钥、过期、回退、元数据混配、连续 root 轮换/阈值不足、撤销、断网离线、下载中断与私钥日志检查;三平台从干净安装目录验证拒绝路径不会执行包内程序。
|
||||
@@ -0,0 +1,15 @@
|
||||
# ChuSQL v26.10.1
|
||||
|
||||
ChuSQL 是一个以 SQL 为主要接口的关系数据库,由 Haskell 查询引擎和 Rust 存储层组成。服务端管理数据与用户会话,用户可通过命令行客户端或浏览器中的 Web 界面访问。
|
||||
|
||||
这是 ChuSQL 的第一个正式发布版,提供建表、数据增删改查、连接、聚合、子查询和 CTE,以及索引、查询优化、事务、保存点、WAL 崩溃恢复和用户/角色授权。
|
||||
|
||||
本版还提供运行时类型与函数基础:支持 String、List、Maybe、Tuple 等类型,以及 length、not 函数;复合值可通过 SQL 构造、查询和持久化,CLI 与 Web 均可显示。
|
||||
|
||||
发行包支持 Windows x86_64 和 Linux x86_64,包含数据库服务端、初始化工具、CLI、Web 界面和安装/卸载脚本。下载下方压缩包,使用包内 install.ps1(Windows)或 install.sh(Linux)安装,可选择 CLI 或 Web 组件,无需自行安装 Haskell 或 Rust 工具链。每个包附 SHA256 校验文件。
|
||||
|
||||
安装与操作说明:[安装指南](https://github.com/TheBadRoger/ChuSQL/blob/v26.10.1/docs/install.md)、[SQL 语法](https://github.com/TheBadRoger/ChuSQL/blob/v26.10.1/docs/syntax.md)、[运行时类型](https://github.com/TheBadRoger/ChuSQL/blob/v26.10.1/docs/runtime-types.md)。
|
||||
|
||||
首版适合学习、开发和小规模内部应用试点。事务采用整库内存快照,同库写入串行;DECIMAL 使用浮点表示;尚无运行时类型的完整比较/索引能力。关键业务上线前应完成真实负载测试及备份恢复演练。升级已有数据前请备份,并避免用旧二进制打开新增类型的数据。
|
||||
|
||||
本版已通过所有者全量门禁;发布流程要求 Linux 测试与两个平台的发行包安装验证全部成功后上传正式下载包。
|
||||
@@ -0,0 +1,65 @@
|
||||
# 运行时类型与函数基础
|
||||
|
||||
阶段 A 提供固定身份的内建类型、函数注册表、schema 驱动的绑定和类型化查询入口。
|
||||
完整 capability、运算符注册、转换、用户 ADT 与 Extension 留在后续阶段。
|
||||
|
||||
## SQL 使用
|
||||
|
||||
```sql
|
||||
CREATE TABLE typed_values (
|
||||
id Int,
|
||||
name String,
|
||||
numbers [Int],
|
||||
label Maybe String,
|
||||
pair (Int, String)
|
||||
);
|
||||
|
||||
INSERT INTO typed_values (id, name, numbers, label, pair)
|
||||
VALUES (1, 'abc', LIST<Int>(1, 2), MAYBE<String>(), TUPLE<Int, String>(3, 'x'));
|
||||
|
||||
SELECT length(name), numbers, label, pair FROM typed_values;
|
||||
|
||||
UPDATE typed_values SET numbers = LIST<Int>(9), label = MAYBE<String>('ready') WHERE id = 1;
|
||||
|
||||
SELECT LIST<Maybe Int>(MAYBE<Int>(), MAYBE<Int>(42));
|
||||
SELECT not(TRUE), length('你好');
|
||||
```
|
||||
|
||||
类型语法支持 `Int`、`Double`、`Bool`、`String`、`[a]` / `List a`、`Maybe a` 和 `(a, b, ...)`。
|
||||
构造器中的类型参数是完整逻辑类型;空列表和 Nothing 也有确定类型。
|
||||
`MAYBE<a>()` 表示 Nothing,`MAYBE<a>(value)` 表示 Just;不能用 SQL NULL 代替复合值内部的 Nothing。
|
||||
SQL 可空列仍接受 NULL,和 Maybe 的 Nothing 保持区别。
|
||||
构造器按完整类型校验,不隐式转换 List 的元素类型。
|
||||
|
||||
内建签名为 `length :: String -> Int` 和 `not :: Bool -> Bool`,名称不区分大小写。
|
||||
SQL 参数为 NULL 时结果为 NULL;具体非空参数仍校验类型。
|
||||
尚无运行时 Eq / Ord / Hash 字典,复合类型的比较、排序、分组、极值和索引不会自动取得能力。
|
||||
Web 显示复合值及 SQL 构造器预览,复合字段通过 SQL 控制台修改。
|
||||
|
||||
## 身份与编码
|
||||
|
||||
`ChuSQL.Core.Runtime` 是共享模型中的权威定义;Engine 模块导出同一组身份。
|
||||
内建构造器编号固定为 Int=1、Double=2、Bool=3、String=4、List=5、Maybe=6、Tuple=7。
|
||||
TypeId 包含已校验的完整构造器应用,比较和恢复不依赖注册顺序或随机哈希。
|
||||
FunctionId 固定为 length=1、not=2;内建元数据可直接重建注册表。
|
||||
|
||||
逻辑 TypeExpr 与 PhysicalType 分开;List、Maybe、Tuple 使用递归 sequence、optional、product 表示。
|
||||
schema 保存版本化的 TypeId,协议值保存版本、类型身份和 payload;包括 String 在内的运行时值共用编码。
|
||||
Rust 的通用行、目录和 WAL 路径保存该表示,读取时由共享模型验证版本、类型、元素和字段个数。
|
||||
未知版本、身份溢出、类型不符、非有限浮点数及损坏 payload 明确返回错误。
|
||||
内建类型不可删除,复合类型的依赖完整包含在 TypeExpr 中。
|
||||
旧标量 schema 和协议继续读取;包含运行时类型的数据不能交给不支持该编码的旧客户端。
|
||||
|
||||
## 绑定与执行
|
||||
|
||||
`Runtime.Binding` 提供独立的 TypedExpression 和 TypedPlan,绑定只接受 catalog schema。
|
||||
表达式和计划构造器隐藏,调用者必须经过 Binder;执行使用已解析的 TypeId / FunctionId,并校验存储行。
|
||||
该 API 覆盖单行、表扫描、投影和过滤,可构造嵌套复合值及函数调用。
|
||||
|
||||
SQL SELECT 通过 `Runtime.Query.bindQuery` 生成不可直接构造的 BoundQuery,再由 `executeQueryM` 执行。
|
||||
绑定计划保存输出 schema 与类型身份;现有 RelOp 作为关系执行和优化的兼容桥,输出按位置校验,保留重复别名。
|
||||
类型化函数和构造器节点也进入 INSERT、UPDATE、CHECK、聚合参数和子查询。
|
||||
日期、时间戳、Blob 等阶段 A 外的类型保留明确的 CompatibilityType。
|
||||
旧 ColumnType 和运算符实现尚未整体移除;统一 capability、cast 和 rewrite 将在后续阶段收拢。
|
||||
|
||||
测试覆盖稳定编码、kind / 参数校验、共享协议、SQL 调用和复合列、实际存储重载、HTTP/TCP 与客户端显示。
|
||||
@@ -136,13 +136,21 @@ REVOKE reviewer FROM alice;
|
||||
DROP ROLE analyst;
|
||||
```
|
||||
|
||||
当前表级权限包括:`SELECT`、`INSERT`、`UPDATE`、`DELETE` 和 `ALL`。
|
||||
表级权限包括 `SELECT`、`INSERT`、`UPDATE`、`DELETE`;数据库权限包括 `CONNECT`、`CREATE`。`ALL` 按对象类型展开。未限定的表名及 `*` 使用当前数据库,`库名.表名` 和 `库名.*` 可指定其他数据库;系统对象不能通过业务 GRANT 授权。
|
||||
|
||||
```sql
|
||||
REVOKE CONNECT ON DATABASE sales FROM PUBLIC;
|
||||
GRANT CONNECT, CREATE ON DATABASE sales TO analyst;
|
||||
GRANT SELECT ON TABLE sales.orders TO reviewer WITH GRANT OPTION;
|
||||
GRANT SELECT ON sales.* TO analyst;
|
||||
REVOKE SELECT ON sales.orders FROM reviewer;
|
||||
```
|
||||
|
||||
角色可以互相继承:`GRANT analyst TO reviewer` 让 `reviewer` 成为 `analyst` 的成员并取得其授权;继承会沿成员关系传递,成环的授权被拒绝(报 `conflict`),自继承同样拒绝。用户也可以直接接受表级授权或作为其他角色的成员。
|
||||
|
||||
管理员拥有完整权限;数据库、表、索引等结构管理操作仅允许管理员执行。
|
||||
最高权限身份拥有完整权限。数据库默认向 PUBLIC 开放 CONNECT,不默认授予 CREATE 或数据权限。具有数据库 CREATE 的身份可建表,并成为新表所有者;表所有者可管理表、字段及索引,并授予该表权限。数据库所有者可删除自己的数据库,创建数据库与管理 DOMAIN 仍要求最高权限。
|
||||
|
||||
`GRANT ... WITH GRANT OPTION` 让拿到的授权可以再转授:普通身份只有手里那条授权带 grant option 时才能执行 `GRANT`,报错是 `grant option required: <权限> ON <表>`;`REVOKE` 仍然只允许管理员,收回授权会连它的 grant option 一起收掉,且不会级联收回别人转授出去的授权。转授权随角色继承一起传递。
|
||||
`GRANT ... WITH GRANT OPTION` 允许再转授;所有者也可授予自身对象的权限。普通授予者可撤销自己的授予,所有者及最高权限身份可撤销对象上的其他授予。撤销时收回相应 grant option,并级联清理失去合法来源的下游授权;仍有独立来源的授权保留。转授权能力随启用的角色继承,循环转授不能独立维持权限。REVOKE 不移除所有者的隐含权限。
|
||||
|
||||
系统目录访问还受目录管理属性控制,具体能力见 [用户与角色](users-and-roles.md)。
|
||||
|
||||
@@ -152,4 +160,6 @@ DROP ROLE analyst;
|
||||
```sql
|
||||
ALTER USER alice SYSTEM_CATALOG_MANAGER;
|
||||
ALTER USER alice NOSYSTEM_CATALOG_MANAGER;
|
||||
ALTER USER alice ALLOW_SUDO_AUTH;
|
||||
ALTER USER alice NOALLOW_SUDO_AUTH;
|
||||
```
|
||||
@@ -46,3 +46,23 @@ DOMAIN 按数据库保存,保留名称并复用基础类型的校验与运算
|
||||
该目录是受保护的系统元数据,普通 SQL 不直接展示或修改它。类型执行语义由引擎实现,不能通过手工增加目录行获得新的基础类型。安装登记不会创建任何预定义 DOMAIN;DOMAIN 定义另存于各工作库的 catalog。
|
||||
|
||||
首次安装完成管理员初始化后登记类型。重复引导保留一致的记录并补齐缺失项;同名定义冲突会报错,停止安装启动流程,不覆盖现有定义。
|
||||
|
||||
## DOMAIN 约束设计(尚未实现)
|
||||
|
||||
以下约束与 ALTER 能力是后续设计,当前 DOMAIN 仍只提供类型命名。实施依赖 [bound IR](architecture.md#bound-ir),先固化类型、列身份与表达式求值规则。
|
||||
|
||||
### 约束与默认值语义
|
||||
|
||||
定义扩展为基础类型引用、可选 DEFAULT、NOT NULL、命名 CHECK 及定义版本。CHECK 只接受绑定的单值 `VALUE` 表达式和确定性内置函数,禁止子查询、表引用和自定义副作用函数;CHECK 的 false 拒绝,unknown 允许,NOT NULL 独立拒绝 NULL。嵌套领域从底层向外校验,约束取交集;显式列默认优先,否则使用最近外层有定义的领域默认,只在省略列值时使用,不替换显式 NULL。
|
||||
|
||||
### 引擎与存储校验
|
||||
|
||||
server/engine 负责绑定;Rust 存储根据版本化约束 IR 在全部写入口再次验证,包含批写、原始请求和迁移。两层必须共享运算符标识、类型及 NULL 规则并用相同测试向量验证;不能让 Rust 重新解析 SQL 或只依赖客户端验证。解析诊断不得吞错。
|
||||
|
||||
### 结构变更与持久化
|
||||
|
||||
首版仅支持 CREATE 带约束与 ALTER 添加经全量验证的约束、修改默认;不支持 NOT VALID 或 CASCADE。ALTER 在稳定 schema/数据视图中校验所有直接和间接使用列,短锁发布前复查版本;失败不改变定义。类型定义、依赖版本和受影响 schema 同一 WAL 组提交。现有 DOMAIN 空目录表升级为明确版本元数据,旧编码读入并转换,拒绝无法解析的定义。
|
||||
|
||||
### 验收条件
|
||||
|
||||
验收覆盖嵌套默认优先级、三值 CHECK、NULL、批写全回退、领域改变并发写、循环/间接依赖、内存事务提交与 WAL 重放。新约束加入既有事务后,提交必须按最新定义重新验证或报 schema 冲突。
|
||||
@@ -10,6 +10,7 @@ ChuSQL 的用户和角色共用一套身份目录及名称空间。用户是允
|
||||
| --- | --- | --- |
|
||||
| `can_login` | `true` | 可以使用账号及口令登录 |
|
||||
| `is_superuser` | `true` | 具有系统管理及数据访问的最高权限 |
|
||||
| `allow_sudo_auth` | `false` | 允许经本机提升身份验证后免数据库口令登录;不赋予权限 |
|
||||
| `system_catalog_manager` | `false` | 独立目录管理属性;SUPERUSER 本身已具有有效目录管理能力 |
|
||||
| `enabled` | `true` | 身份处于启用状态 |
|
||||
|
||||
@@ -29,9 +30,9 @@ ChuSQL 的用户和角色共用一套身份目录及名称空间。用户是允
|
||||
|
||||
身份创建与修改语法见 [SQL 语法](syntax.md#账号与权限)。
|
||||
|
||||
`ALTER USER` 与 `ALTER ROLE` 的属性、口令修改语法通用。可使用 `LOGIN / NOLOGIN`、`SUPERUSER / NOSUPERUSER`、`ENABLED / DISABLED`、`SYSTEM_CATALOG_MANAGER / NOSYSTEM_CATALOG_MANAGER`;同一条语句不能重复指定同一属性。
|
||||
`ALTER USER` 与 `ALTER ROLE` 的属性、口令修改语法通用。可使用 `LOGIN / NOLOGIN`、`SUPERUSER / NOSUPERUSER`、`ENABLED / DISABLED`、`SYSTEM_CATALOG_MANAGER / NOSYSTEM_CATALOG_MANAGER`、`ALLOW_SUDO_AUTH / NOALLOW_SUDO_AUTH`;同一条语句不能重复指定同一属性。
|
||||
|
||||
SUPERUSER 可设置目录管理属性。该属性默认为 false,不经成员关系继承;只有自身启用且允许登录的身份能使用它。目录管理者可以进入 system 库、查看身份目录、创建普通身份、修改普通身份属性与口令及删除普通用户身份。它不能管理 SUPERUSER 或其他目录管理者,不能授予这两个特权属性,不能执行 `DROP ROLE`,也不会因此获得创建业务数据库、直接修改系统表或读取业务数据的权限。受限身份变更在存储写锁内再次检查目标权限。
|
||||
SUPERUSER 可设置目录管理属性。该属性默认为 false,不经成员关系继承;只有自身启用且允许登录的身份能使用它。目录管理者可以进入 system 库、查看身份目录、创建普通身份、修改普通身份属性与口令及删除普通用户身份。它不能管理 SUPERUSER、其他目录管理者或启用 sudo 认证的身份,不能授予这三个特权属性,不能执行 `DROP ROLE`,也不会因此获得创建业务数据库、直接修改系统表或读取业务数据的权限。受限身份变更在存储写锁内再次检查目标权限。
|
||||
|
||||
## 全部身份及凭据字段
|
||||
|
||||
@@ -44,6 +45,7 @@ SUPERUSER 可设置目录管理属性。该属性默认为 false,不经成员
|
||||
| `can_login` | 是否允许直接登录;仅允许登录仍不足以保证登录成功,还需启用及正确口令 | `LOGIN / NOLOGIN` |
|
||||
| `is_superuser` | 是否具有最高权限;不通过角色成员关系继承 | `SUPERUSER / NOSUPERUSER` |
|
||||
| `system_catalog_manager` | 是否具有受限的系统目录管理能力;不继承、不替代数据访问授权 | `SYSTEM_CATALOG_MANAGER / NOSYSTEM_CATALOG_MANAGER`,仅 SUPERUSER 可设置 |
|
||||
| `allow_sudo_auth` | 是否接受受信任本机提升身份认证;默认 false,不继承,不改变业务权限 | `ALLOW_SUDO_AUTH / NOALLOW_SUDO_AUTH`,仅 SUPERUSER 可设置 |
|
||||
| `enabled` | 是否启用身份;禁用后不能登录,也不再贡献角色继承权限 | `ENABLED / DISABLED` |
|
||||
| `identity_version` | 身份目录格式与旧数据迁移标记;旧记录可为 0,当前统一身份格式为 1 | 系统维护;不是会话版本 |
|
||||
| `registered_at` | 身份创建时间;旧记录缺失时由迁移补齐 | 系统记录 |
|
||||
@@ -55,7 +57,68 @@ SUPERUSER 可设置目录管理属性。该属性默认为 false,不经成员
|
||||
| `id` | 对应身份目录中的编号 |
|
||||
| `password_hash` | 口令哈希,不是明文口令;通过口令修改命令更新 |
|
||||
|
||||
内部账号协议可将身份字段和 `password_hash` 合并为账号对象,但哈希不属于公开的角色展示内容。`SHOW ROLES` 展示全部身份的编号、名称、登录能力、最高权限、启用状态、目录管理属性和创建时间,不返回口令哈希,也不展示全部内部字段。系统表由身份管理接口维护,不应直接修改。
|
||||
内部账号协议可将身份字段和 `password_hash` 合并为账号对象,但哈希不属于公开的角色展示内容。`SHOW ROLES` 展示全部身份的编号、名称、登录能力、最高权限、启用状态、目录管理属性、sudo 认证开关和创建时间,不返回口令哈希,也不展示全部内部字段。系统表由身份管理接口维护,不应直接修改。
|
||||
|
||||
## 本机 sudo 认证
|
||||
|
||||
此入口适用于 Linux、macOS 和 Windows,默认关闭。Unix 有效 UID 0(通常通过 sudo 获得)映射到 `[server] sudo_auth_user`;Windows 提升令牌中的 Administrators 成员映射到同一配置身份。不会使用客户端上报的操作系统用户名、`SUDO_USER`、数据库用户名或角色属性作为操作系统身份凭据。
|
||||
|
||||
先用数据库 SUPERUSER 配置目标身份,例如:
|
||||
|
||||
```sql
|
||||
ALTER USER local_operator ALLOW_SUDO_AUTH;
|
||||
```
|
||||
|
||||
目标身份仍需 `LOGIN` 与 `ENABLED`;按需要另行授予业务权限。即使它是普通身份,sudo 登录也只获得该身份已有的权限。`SUPERUSER` 和 `SYSTEM_CATALOG_MANAGER` 不会隐含允许 sudo 登录。
|
||||
|
||||
在服务端与 CLI 使用的配置中显式设置映射:
|
||||
|
||||
```toml
|
||||
[server]
|
||||
sudo_auth_user = "local_operator"
|
||||
```
|
||||
|
||||
停止原服务后,以 Unix root 或 Windows 提升后的管理员重启 `chusql-server`,使用受管理员保护的配置文件、数据目录和程序路径。以相同提升身份运行 CLI;Unix 示例:
|
||||
|
||||
```sh
|
||||
sudo csql --config /absolute/path/settings.toml --sudo -e "SELECT 1"
|
||||
```
|
||||
|
||||
Windows 在提升的终端中运行 `csql --config C:\absolute\path\settings.toml --sudo -e "SELECT 1"`。`--sudo` 不读取数据库口令,省略 `--user` 时使用配置映射。显式指定其他账号也不能绕过服务端映射。普通 TCP/CLI 口令登录与 Web 登录保持原有口令认证;远程连接无法请求此入口,CLI 也校验实际连接对端为回环地址。
|
||||
|
||||
服务启动时产生独立随机凭据。Unix 放在 `/var/run/chusql-sudo-<实际端口>/credential`,目录 root 所有且为 0700,文件为 0600;Windows 放在系统目录的 `config\ChuSQL-Sudo-<实际端口>\credential`,使用不继承的 Administrators / SYSTEM 专属 DACL。读取入口检查当前进程提升身份;Unix 还验证文件所有权、权限和类型,拒绝链接,Windows 拒绝重解析路径。凭据不会传输到网络,CLI 使用 HMAC-SHA256 回应绑定连接、账号和服务实例的一次性随机挑战;挑战 60 秒后过期,每次认证尝试都会消费挑战,失败按账号限流。
|
||||
|
||||
服务端在 stderr 记录启用映射和认证结果,不记录凭据或证明。成功登录更新身份目录的 `last_login_at`。`ALTER USER local_operator NOALLOW_SUDO_AUTH`、`DISABLED`、`NOLOGIN`、修改口令或删除身份都会使既有连接在下一次请求时失效。映射配置清空并重启服务后,本机入口关闭。
|
||||
|
||||
正常停止服务时清理凭据。异常退出可能留下端口专属目录;再次启用会明确报错,不读取或覆盖旧凭据。确认对应服务已停止后,由提升身份清理该目录再启动;不要把凭据复制到普通账号可访问的目录。
|
||||
|
||||
## 对象授权
|
||||
|
||||
业务授权绑定数据库编号与表编号,身份与所有者绑定身份编号。删除后重建同名数据库、表或身份会获得新编号,旧授权不会随名称恢复。对象存在性以 catalog 为准;不同数据库的同名表互不共享授权。
|
||||
|
||||
| 对象范围 | 权限 | 默认与所有者能力 |
|
||||
| --- | --- | --- |
|
||||
| DATABASE 库名 | CONNECT、CREATE | PUBLIC 默认 CONNECT;CREATE 允许建表;数据库所有者可管理该数据库 |
|
||||
| TABLE 库名.表名 | SELECT、INSERT、UPDATE、DELETE | 默认无数据权限;表所有者拥有四项数据权限、结构管理及转授权能力 |
|
||||
| 库名.* | 四项表级数据权限 | 覆盖该数据库内现有及未来的表;不包含数据库 CREATE |
|
||||
|
||||
`ALL` 按对象范围展开。未限定表名与 `*` 绑定当前数据库。数据库所有权不自动赋予其他身份所建表的数据权限;启用的所有者角色可以通过成员关系贡献所有权,最高权限属性仍不继承。创建数据库及管理 DOMAIN 仍要求 SUPERUSER;所有权不能通过 REVOKE 移除,当前没有所有权转移命令。
|
||||
|
||||
```sql
|
||||
REVOKE CONNECT ON DATABASE sales FROM PUBLIC;
|
||||
GRANT CONNECT, CREATE ON DATABASE sales TO analyst;
|
||||
GRANT SELECT ON TABLE sales.orders TO reader WITH GRANT OPTION;
|
||||
GRANT SELECT ON sales.* TO analyst;
|
||||
REVOKE SELECT ON sales.orders FROM reader;
|
||||
```
|
||||
|
||||
PUBLIC 是所有身份共享的虚拟角色,不能新建同名用户或角色。已有同名旧身份仍按真实身份编号解析,删除该身份后才使用虚拟 PUBLIC。撤销 PUBLIC CONNECT 会关闭数据库的默认连接权限,其他显式 CONNECT 或数据库所有权仍有效;重新授予会恢复默认连接权限。
|
||||
|
||||
每次授予记录授予者。普通身份须持有有效 grant option 或对象所有权,可撤销自己的授予;所有者和 SUPERUSER 可撤销对象上的其他来源。撤销、删除身份或成员变更会清理失去合法来源的转授权链;其他独立来源保留,循环转授不能维持失去根来源的权限。禁用身份暂停权限贡献,保留所有权及管理员直接授权;失去启用授予者的下游转授权会被清理。
|
||||
|
||||
旧名称授权在首次启动时一次性绑定现存对象和身份编号。旧记录不含授予者,迁移为管理来源;旧全局 `*` 仅转换成当时现存表的明确授权,不扩展到未来对象。已经不存在的对象和身份记录被清理。迁移后不再读取旧名称授权作为鉴权依据。
|
||||
|
||||
权限快照位于受保护系统目录,经 WAL 原子保存;普通存储请求不能访问该目录。SQL、TCP 和 Web 使用同一服务端检查;TCP 原始存储入口仅允许 SUPERUSER。查询与授权变更通过共享读写锁排序,建表前持久化创建者声明供重启恢复所有权。事务提交重新检查权限和稳定对象编号,权限撤销或对象替换后不能提交旧事务。
|
||||
|
||||
## 属性、授权与会话的关系
|
||||
|
||||
|
||||
@@ -35,6 +35,9 @@ port = 7777
|
||||
max_message = 1048576
|
||||
# Maximum number of rows returned by a query through the database server.
|
||||
max_rows = 1000
|
||||
# Local elevated OS identity mapping; empty disables sudo authentication.
|
||||
# Requires ALLOW_SUDO_AUTH on the identity and an elevated server process.
|
||||
sudo_auth_user = ""
|
||||
|
||||
[log]
|
||||
# Diagnostic verbosity: off, error, warn, info or debug.
|
||||
|
||||
@@ -35,6 +35,9 @@ port = 7777
|
||||
max_message = 1048576
|
||||
# Maximum number of rows returned by a query through the database server.
|
||||
max_rows = 1000
|
||||
# Local elevated OS identity mapping; empty disables sudo authentication.
|
||||
# Requires ALLOW_SUDO_AUTH on the identity and an elevated server process.
|
||||
sudo_auth_user = ""
|
||||
|
||||
[log]
|
||||
# Diagnostic verbosity: off, error, warn, info or debug.
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
set -eu
|
||||
|
||||
# ChuSQL 安装脚本(Linux/macOS):装 cli/web、写全局配置、
|
||||
# 改 PATH、跑 csql-bootstrap 建系统目录、最后拉起服务。
|
||||
# 改 PATH、初始化系统目录,Linux 注册开机启动服务。
|
||||
|
||||
default_repo='TheBadRoger/ChuSQL'
|
||||
|
||||
@@ -42,6 +42,7 @@ usage: ./install.sh [--component web|cli|both] [options]
|
||||
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
|
||||
--no-service skip Linux systemd registration and boot autostart
|
||||
|
||||
where the files come from:
|
||||
(default) a package next to this script, else the newest GitHub release
|
||||
@@ -71,6 +72,7 @@ root_user='root'
|
||||
keep_package='no'
|
||||
password_arg=''
|
||||
no_start='no'
|
||||
no_service='no'
|
||||
repo="$default_repo"
|
||||
version='latest'
|
||||
url_arg=''
|
||||
@@ -90,6 +92,7 @@ while [ $# -gt 0 ]; do
|
||||
--keep-package) keep_package='yes'; shift ;;
|
||||
--password) password_arg="${2:-}"; shift 2 ;;
|
||||
--no-start) no_start='yes'; shift ;;
|
||||
--no-service) no_service='yes'; shift ;;
|
||||
--url) url_arg="${2:-}"; shift 2 ;;
|
||||
--repo) repo="${2:-}"; shift 2 ;;
|
||||
--version) version="${2:-}"; shift 2 ;;
|
||||
@@ -617,8 +620,23 @@ echo " root user $root_user (password asked above, kept out of settings.toml)"
|
||||
|
||||
# ---- 释放文件 ----
|
||||
# 包是合在一起的(web 和 cli 都在),这里按这次的选择逐个释放:没选的组件不落地
|
||||
service_file="${XDG_CONFIG_HOME:-$HOME/.config}/systemd/user/chusql-server.service"
|
||||
use_service='no'
|
||||
if [ "$(uname -s)" = 'Linux' ] && [ "$no_service" = 'no' ]; then
|
||||
command -v systemctl >/dev/null 2>&1 || fail 'systemd is required; use --no-service to opt out'
|
||||
command -v loginctl >/dev/null 2>&1 || fail 'loginctl is required for boot autostart'
|
||||
systemctl --user show-environment >/dev/null || fail 'cannot connect to user systemd; run in a login session or use --no-service'
|
||||
loginctl enable-linger "$(id -un)" || fail 'cannot enable boot autostart; run sudo loginctl enable-linger for this OS user and retry'
|
||||
use_service='yes'
|
||||
if [ -f "$service_file" ]; then
|
||||
systemctl --user stop chusql-server.service || fail 'cannot stop the existing service'
|
||||
fi
|
||||
fi
|
||||
step 'Installing files'
|
||||
mkdir -p "$install_dir/bin" "$log_dir" "$data_dir"
|
||||
install_dir=$(CDPATH= cd -- "$install_dir" && pwd)
|
||||
data_dir=$(CDPATH= cd -- "$data_dir" && pwd)
|
||||
log_dir=$(CDPATH= cd -- "$log_dir" && pwd)
|
||||
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
|
||||
@@ -646,6 +664,8 @@ step 'Writing settings.toml'
|
||||
config_dir="${XDG_CONFIG_HOME:-$HOME/.config}/ChuSQL"
|
||||
config_file="$config_dir/settings.toml"
|
||||
mkdir -p "$config_dir"
|
||||
config_dir=$(CDPATH= cd -- "$config_dir" && pwd)
|
||||
config_file="$config_dir/settings.toml"
|
||||
sed -e "s|@DATA_DIR@|$(printf '%s' "$data_dir" | sed 's/[\&|]/\\&/g')|g" \
|
||||
-e "s|@LOG_DIR@|$(printf '%s' "$log_dir" | sed 's/[\&|]/\\&/g')|g" \
|
||||
"$pack/resources/settings.toml.linux" > "$config_file"
|
||||
@@ -714,7 +734,46 @@ fi
|
||||
# ---- 拉起服务 ----
|
||||
server_bin="$install_dir/bin/chusql-server"
|
||||
server_pid=''
|
||||
if [ "$use_service" = 'yes' ]; then
|
||||
step 'Registering the systemd service and boot autostart'
|
||||
for service_arg in "$install_dir" "$server_bin" "$config_file" "$root_user"; do
|
||||
case "$service_arg" in
|
||||
*"
|
||||
"*) fail 'service arguments must not contain newlines' ;;
|
||||
esac
|
||||
done
|
||||
mkdir -p "$(dirname "$service_file")"
|
||||
# 转义 systemd 双引号参数与变量符号。
|
||||
unit_quote() {
|
||||
printf '%s' "$1" | sed 's/\\/\\\\/g; s/"/\\"/g; s/%/%%/g'
|
||||
}
|
||||
cat > "$service_file" <<EOF
|
||||
[Unit]
|
||||
Description=ChuSQL database server
|
||||
|
||||
[Service]
|
||||
Type=simple
|
||||
WorkingDirectory="$(unit_quote "$install_dir")"
|
||||
ExecStart=:"$(unit_quote "$server_bin")" --config "$(unit_quote "$config_file")" --user "$(unit_quote "$root_user")"
|
||||
Restart=on-failure
|
||||
RestartSec=5
|
||||
StandardOutput=journal
|
||||
StandardError=journal
|
||||
|
||||
[Install]
|
||||
WantedBy=default.target
|
||||
EOF
|
||||
systemctl --user daemon-reload || fail 'cannot reload systemd units'
|
||||
systemctl --user enable chusql-server.service || fail 'cannot enable boot autostart'
|
||||
if [ "$no_start" = 'yes' ]; then
|
||||
note '--no-start: boot autostart enabled; the server was not started'
|
||||
else
|
||||
systemctl --user restart chusql-server.service || fail 'cannot start chusql-server.service'
|
||||
sleep 1
|
||||
systemctl --user is-active --quiet chusql-server.service || fail 'the server stopped; run journalctl --user -u chusql-server.service'
|
||||
note 'server running under systemd'
|
||||
fi
|
||||
elif [ "$no_start" = 'yes' ]; then
|
||||
note '--no-start: the server was not started'
|
||||
else
|
||||
step 'Starting the server'
|
||||
@@ -739,7 +798,11 @@ if [ "$want_cli" = 'yes' ]; then
|
||||
fi
|
||||
echo " start with $start_with"
|
||||
echo " tcp server $server_bin (listens on [server] listen_host/port, defaults 127.0.0.1:7777)"
|
||||
if [ -n "$server_pid" ]; then
|
||||
if [ "$use_service" = 'yes' ]; then
|
||||
echo ' service chusql-server.service (boot autostart enabled)'
|
||||
echo ' manage systemctl --user status|start|stop|restart chusql-server.service'
|
||||
echo ' logs journalctl --user -u chusql-server.service'
|
||||
elif [ -n "$server_pid" ]; then
|
||||
echo " running pid $server_pid (stop it with: kill $server_pid)"
|
||||
else
|
||||
echo " start it $server_bin --config \"$config_file\" --user $root_user"
|
||||
|
||||
@@ -119,10 +119,11 @@ verify_package() {
|
||||
rm -rf "$vtmp"
|
||||
Fail "$name: the archive does not unpack"
|
||||
fi
|
||||
if ! ( cd "$vtmp/pkg" && HOME="$vtmp/home" CHUSQL_ADMIN_PASSWORD='verify-package' \
|
||||
if ! ( cd "$vtmp/pkg" && HOME="$vtmp/home" XDG_CONFIG_HOME="$vtmp/home/.config" \
|
||||
XDG_STATE_HOME="$vtmp/home/.local/state" CHUSQL_ADMIN_PASSWORD='verify-package' \
|
||||
sh install.sh --component "$comp" \
|
||||
--install-dir "$vtmp/opt" --data-dir "$vtmp/data" --user root \
|
||||
--no-start ) \
|
||||
--no-start --no-service ) \
|
||||
>"$vtmp/log" 2>&1; then
|
||||
sed -n '1,120p' "$vtmp/log" >&2
|
||||
rm -rf "$vtmp"
|
||||
@@ -188,8 +189,13 @@ Step "Packing $name"
|
||||
rm -rf "$out_dir/.stage"
|
||||
mkdir -p "$stage/bin" "$stage/resources"
|
||||
|
||||
cp "$repo_root/chusql-core/storage/target/release/"libchusql_core_storage.* "$stage/bin/" \
|
||||
|| Fail "chusql-core/storage/target/release/libchusql_core_storage.* is not built (run without --no-build)"
|
||||
case "$platform" in
|
||||
linux-*) storage_name=libchusql_core_storage.so ;;
|
||||
macos-*) storage_name=libchusql_core_storage.dylib ;;
|
||||
*) Fail "unsupported Unix platform: $platform" ;;
|
||||
esac
|
||||
cp "$repo_root/chusql-core/storage/target/release/$storage_name" "$stage/bin/" \
|
||||
|| Fail "$storage_name is not built (run without --no-build)"
|
||||
|
||||
stack_root=$(cd "$repo_root/chusql-cli" && stack path --local-install-root | tail -n 1 | tr -d '\r')
|
||||
for front_name in chusql-web chusql-server csql; do
|
||||
|
||||
@@ -94,6 +94,13 @@ if [ "$assume_yes" = 'no' ]; then
|
||||
fi
|
||||
|
||||
step 'Stopping the service'
|
||||
service_file="${XDG_CONFIG_HOME:-$HOME/.config}/systemd/user/chusql-server.service"
|
||||
if [ "$(uname -s)" = 'Linux' ] && [ -f "$service_file" ]; then
|
||||
command -v systemctl >/dev/null 2>&1 || fail 'systemctl is required to remove the service'
|
||||
systemctl --user disable --now chusql-server.service || fail 'cannot stop and disable chusql-server.service'
|
||||
rm -f "$service_file"
|
||||
systemctl --user daemon-reload || fail 'cannot reload systemd units'
|
||||
fi
|
||||
stop_by_path "$install_dir/bin/chusql-server"
|
||||
stop_by_path "$install_dir/bin/chusql-web"
|
||||
|
||||
|
||||
@@ -1,55 +0,0 @@
|
||||
param([string]$Root = (Split-Path -Parent $PSScriptRoot))
|
||||
|
||||
$ErrorActionPreference = 'Stop'
|
||||
|
||||
# 统计物理行数并生成 README 统一风格的本地 SVG 徽章。
|
||||
|
||||
# 生成带文字和色块的本地徽章。
|
||||
function Write-Badge([string]$Directory, [string]$Name, [string]$Label, [string]$Value, [string]$Color, [string]$Description) {
|
||||
$leftWidth = [int]($Label.Length * 7 + 24)
|
||||
$rightWidth = [int]($Value.Length * 7 + 24)
|
||||
$width = $leftWidth + $rightWidth
|
||||
$leftCenter = $leftWidth / 2
|
||||
$rightCenter = $leftWidth + $rightWidth / 2
|
||||
$safeLabel = [Security.SecurityElement]::Escape($Label)
|
||||
$safeValue = [Security.SecurityElement]::Escape($Value)
|
||||
$safeDescription = [Security.SecurityElement]::Escape($Description)
|
||||
$svg = @"
|
||||
<svg xmlns="http://www.w3.org/2000/svg" width="$width" height="24" viewBox="0 0 $width 24" role="img" aria-label="$safeLabel`: $safeValue">
|
||||
<title>$safeDescription</title>
|
||||
<defs><clipPath id="rounded"><rect width="$width" height="24" rx="5"/></clipPath></defs>
|
||||
<g clip-path="url(#rounded)"><rect width="$width" height="24" fill="#1e293b"/><rect x="$leftWidth" width="$rightWidth" height="24" fill="$Color"/></g>
|
||||
<g fill="#fff" text-anchor="middle" font-family="Verdana,DejaVu Sans,sans-serif" font-size="11"><text x="$leftCenter" y="16">$safeLabel</text><text x="$rightCenter" y="16">$safeValue</text></g>
|
||||
</svg>
|
||||
"@
|
||||
Set-Content -LiteralPath (Join-Path $Directory "$Name.svg") -Value $svg -Encoding utf8
|
||||
}
|
||||
|
||||
Push-Location -LiteralPath $Root
|
||||
try {
|
||||
$paths = @(& git ls-files --cached --others --exclude-standard)
|
||||
if ($LASTEXITCODE -ne 0) { throw 'git ls-files failed' }
|
||||
$lines = 0
|
||||
$files = 0
|
||||
foreach ($path in ($paths | Sort-Object -Unique)) {
|
||||
if ($path -notmatch '\.(hs|rs|js|css|html|ps1|sh)$') { continue }
|
||||
if (-not (Test-Path -LiteralPath $path -PathType Leaf)) { continue }
|
||||
$lines += @(Get-Content -LiteralPath $path).Count
|
||||
$files++
|
||||
}
|
||||
$label = $lines.ToString('N0', [Globalization.CultureInfo]::InvariantCulture)
|
||||
$badgeDir = Join-Path $Root 'docs/badges'
|
||||
[IO.Directory]::CreateDirectory($badgeDir) | Out-Null
|
||||
$revision = & git rev-parse --short HEAD
|
||||
if ($LASTEXITCODE -ne 0) { throw 'git rev-parse failed' }
|
||||
Write-Badge $badgeDir 'lines' 'source lines' $label '#0369a1' 'Physical source lines; includes tests, comments and blank lines.'
|
||||
Write-Badge $badgeDir 'release' 'release' 'browse' '#6d28d9' 'Open GitHub releases to view published versions.'
|
||||
Write-Badge $badgeDir 'commit' 'commit' $revision '#475569' 'Local HEAD snapshot when the badges were generated; open commit history for latest updates.'
|
||||
Write-Badge $badgeDir 'languages' 'languages' 'Haskell + Rust' '#6d28d9' 'ChuSQL implementation languages: Haskell and Rust.'
|
||||
Write-Badge $badgeDir 'build' 'build' 'view status' '#0369a1' 'Open the build workflow for live status; this local badge is a navigation link.'
|
||||
Write-Badge $badgeDir 'tests' 'tests' 'view status' '#0369a1' 'Open the test workflow for live status; this local badge is a navigation link.'
|
||||
Write-Badge $badgeDir 'gate' 'gate' 'manual status' '#b45309' 'Open the owner-triggered gate workflow for status; this local badge is a navigation link.'
|
||||
Write-Output "source_lines=$lines source_files=$files"
|
||||
} finally {
|
||||
Pop-Location
|
||||
}
|
||||