修复错误,优化性能,实现类型系统,优化安装卸载过程

This commit is contained in:
LIm1tZz7 committed 2026-10-05 00:15:01 +08:00
1 parent fd5f320360
commit 48eec484b7
104 files changed
+4127 -845

No files matched your search

+6 -5
View File
@@ -2,11 +2,12 @@ cabal-version: 2.4
name: chusql-interface
version: 1.0.0
synopsis: ChuSQL 接口层:配置、口令、语句构造与 TCP 客户端
description: 引擎无关的接口层。Web 管理端与命令行客户端都只依赖这层:
读同一份 chusql.toml、用同一个线上协议连到拥有存储库的
chusql-server,然后在客户端会话上跑 SQL、看数据字典与角色。
存储引擎与存储动态库一概不在这层。
synopsis: ChuSQL configuration, authentication, SQL helpers, and TCP client
description: Provides engine-independent interfaces shared by web and
command-line clients, including settings.toml configuration,
password handling, statement construction, and TCP sessions.
Supports SQL execution and catalog and role inspection through
chusql-server without linking the engine or storage library.
build-type: Simple
library
+18 -13
View File
@@ -24,7 +24,8 @@ import qualified Data.Text as T
import System.Directory (doesDirectoryExist)
import Text.Read (readMaybe)
-- Web 与 server 的运行参数:命令行 > chusql.toml 分区 > 内置默认。
-- Web 与 server 的运行参数:命令行 > settings.toml 分区 > 默认。
-- 监听地址用 listen_host;静态目录与管理员名写死,不认配置键。
-- | 默认账号名
defaultUser :: Text
@@ -37,6 +38,7 @@ data WebConfig = WebConfig
, wcStaticDir :: FilePath
, wcUser :: Text
, wcDataDir :: Maybe FilePath
, wcLogFiles :: FilePath
, wcCookieSecure :: Bool
, wcBodyLimit :: Int
, wcSessionIdle :: Int
@@ -60,6 +62,7 @@ defaultWebConfig =
, wcStaticDir = "static"
, wcUser = ""
, wcDataDir = Nothing
, wcLogFiles = "./logs"
, wcCookieSecure = False
, wcBodyLimit = 65536
, wcSessionIdle = 8 * 3600
@@ -81,11 +84,10 @@ canonicalSettingKeys saved =
-- | 取一个键的规范名
canonicalKey key = fromMaybe key (lookup key keyAliases)
-- | 下划线写法到连字符写法的别名
-- | 设置键别名:非权威写法到权威写法(多数写连字符)
keyAliases :: [(Text, Text)]
keyAliases =
[ ("static_dir", "static-dir")
, ("session_idle", "session-idle")
[ ("session_idle", "session-idle")
, ("session_max", "session-max")
, ("login_max_attempts", "login-max-attempts")
, ("login_window", "login-window")
@@ -96,6 +98,7 @@ keyAliases =
, ("max_sql_length", "max-sql-length")
, ("password_min_length", "password-min-length")
, ("password_classes", "password-classes")
, ("listen-host", "listen_host")
]
-- | 配置文件的 [web] 分节里是否还留着明文口令键
@@ -108,11 +111,11 @@ nonEmptyValue key saved = case T.strip <$> Map.lookup key saved of
Just value | not (T.null value) -> Just value
_ -> Nothing
-- | 管理员名字:命令行 > 设置文件 > 内置默认
rootUserName :: WebConfig -> Map.Map Text Text -> Text
rootUserName cfg saved
-- | 管理员名字:命令行 > 内置默认(超级用户由内部自举)
rootUserName :: WebConfig -> Text
rootUserName cfg
| not (T.null (T.strip (wcUser cfg))) = T.strip (wcUser cfg)
| otherwise = fromMaybe defaultUser (nonEmptyValue "user" saved)
| otherwise = defaultUser
-- | 读配置:默认叠上 [web] 与 [storage]
loadWebConfigAt :: FilePath -> IO WebConfig
@@ -121,18 +124,20 @@ loadWebConfigAt path = do
storage <- readSection path "storage"
pure (withStorage storage (webConfigFromSection (canonicalSettingKeys raw)))
-- | 数据目录取自 [storage] 段
-- | 数据与日志目录取自 [storage] 段
withStorage :: Map.Map Text Text -> WebConfig -> WebConfig
withStorage storage cfg =
cfg{wcDataDir = T.unpack <$> nonEmptyValue "data_dir" storage}
cfg
{ wcDataDir = T.unpack <$> nonEmptyValue "data_dir" storage
, wcLogFiles = maybe (wcLogFiles cfg) T.unpack (nonEmptyValue "log_files" storage)
}
-- | [web] 分区里的启动参数,缺失或坏值一律回到内置默认
webConfigFromSection :: Map.Map Text Text -> WebConfig
webConfigFromSection saved =
defaultWebConfig
{ wcHost = T.unpack (sectionText "host" saved (T.pack (wcHost defaultWebConfig)))
{ wcHost = T.unpack (sectionText "listen_host" saved (T.pack (wcHost defaultWebConfig)))
, wcPort = sectionInt "port" saved (wcPort defaultWebConfig)
, wcStaticDir = T.unpack (sectionText "static-dir" saved (T.pack (wcStaticDir defaultWebConfig)))
, wcCookieSecure = sectionBool "cookie-secure" saved (wcCookieSecure defaultWebConfig)
, wcBodyLimit = sectionInt "body-limit" saved (wcBodyLimit defaultWebConfig)
, wcSessionIdle = sectionInt "session-idle" saved (wcSessionIdle defaultWebConfig)
@@ -202,7 +207,7 @@ loadServerConfigAt path = do
Nothing -> fallback
pure
defaultServerConfig
{ scHost = textOf "host" (scHost defaultServerConfig)
{ scHost = textOf "listen_host" (scHost defaultServerConfig)
, scPort = intOf "port" (scPort defaultServerConfig)
, scMaxMessage = intOf "max_message" (scMaxMessage defaultServerConfig)
, scMaxRows = intOf "max_rows" (scMaxRows defaultServerConfig)
@@ -15,14 +15,14 @@ module ChuSQL.Interface.Settings (
effectiveSettings,
) where
import ChuSQL.Interface.Config (WebConfig (..), canonicalSettingKeys, defaultUser)
import ChuSQL.Interface.Config (WebConfig (..), canonicalSettingKeys)
import ChuSQL.Interface.TOML (readSection, writeSection)
import Data.List (nub)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
-- 设置目录,以及全局 chusql.toml 的读、写与校验。
-- 设置目录,以及全局 settings.toml 的读、写与校验。
-- | 一个可配置项
data SettingItem = SettingItem
@@ -42,8 +42,7 @@ data SettingItem = SettingItem
settingCatalogue :: [SettingItem]
settingCatalogue =
[ item "port" "HTTP port" "server" "int" "7778" True True
, item "host" "Listen address" "server" "text" "127.0.0.1" True True
, item "static-dir" "Static directory" "server" "text" "static" True True
, withTomlKey "listen_host" (item "listen-host" "Listen address" "server" "text" "127.0.0.1" True True)
, item "cookie-secure" "Secure cookie (behind TLS)" "server" "bool" "0" True False
, item "body-limit" "Max request body (bytes)" "limits" "int" "65536" False False
, item "session-idle" "Session idle timeout (s)" "limits" "int" "28800" False False
@@ -54,16 +53,16 @@ settingCatalogue =
, item "max-page-size" "Rows per page ceiling" "limits" "int" "500" False False
, item "max-rows" "Rows per query" "limits" "int" "1000" False False
, item "max-sql-length" "Max SQL characters" "limits" "int" "20000" False False
, item "user" "管理员账号(设置文件)" "auth" "text" "root" True True
, item "password-min-length" "口令最短长度" "auth" "int" "12" True False
, item "password-classes" "口令字符类别数" "auth" "int" "2" True False
, owned "data-dir" "Data directory" "storage" "text" "" "storage" "data_dir"
, owned "log-files" "Log directory" "storage" "text" "./logs" "storage" "log_files"
, owned "storage-page-size" "Storage page size" "storage" "int" "4096" "page" "size"
, owned "storage-btree-order" "Storage B+tree order" "storage" "int" "4" "btree" "order"
, owned "storage-buffer-pool" "Storage buffer pool pages" "storage" "int" "1024" "buffer" "pool_size"
, owned "storage-log" "Storage log level" "storage" "text" "info" "log" "level"
, item "seed" "Seed demo data on start" "storage" "bool" "1" True True
, owned "tcp-host" "TCP listen address" "network" "text" "127.0.0.1" "server" "host"
, owned "tcp-listen-host" "TCP listen address" "network" "text" "127.0.0.1" "server" "listen_host"
, owned "tcp-port" "TCP port" "network" "int" "7777" "server" "port"
, owned "tcp-max-message" "TCP max request line (bytes)" "network" "int" "1048576" "server" "max_message"
, owned "tcp-max-rows" "TCP rows per result" "network" "int" "1000" "server" "max_rows"
@@ -96,6 +95,9 @@ settingCatalogue =
, siTomlKey = tomlKey
}
-- | 换掉落盘用的键名:界面键与 TOML 键不同名时用
withTomlKey key spec = spec{siTomlKey = key}
-- | web 自己的分区名
webSection :: Text
webSection = "web"
@@ -114,9 +116,9 @@ findItem key = case [i | i <- settingCatalogue, siKey i == key] of
isRootOnly :: Text -> Bool
isRootOnly key = maybe False siRootOnly (findItem key)
-- | 网页端不能改的键
-- | 网页端不能改的键(当前没有)
lockedKeys :: [Text]
lockedKeys = ["user"]
lockedKeys = []
-- | 这项在界面上是不是只读
isLockedSetting :: Text -> Bool
@@ -218,8 +220,7 @@ effectiveSettings :: WebConfig -> Map.Map Text Text
effectiveSettings cfg =
Map.fromList
[ ("port", tshow (wcPort cfg))
, ("host", T.pack (wcHost cfg))
, ("static-dir", T.pack (wcStaticDir cfg))
, ("listen-host", T.pack (wcHost cfg))
, ("cookie-secure", boolText (wcCookieSecure cfg))
, ("body-limit", tshow (wcBodyLimit cfg))
, ("session-idle", tshow (wcSessionIdle cfg))
@@ -230,9 +231,9 @@ effectiveSettings cfg =
, ("max-page-size", tshow (wcMaxPageSize cfg))
, ("max-rows", tshow (wcMaxRows cfg))
, ("max-sql-length", tshow (wcMaxSqlLength cfg))
, ("user", if T.null (T.strip (wcUser cfg)) then defaultUser else T.strip (wcUser cfg))
, ("seed", boolText (wcSeedDemo cfg))
, ("data-dir", maybe "" T.pack (wcDataDir cfg))
, ("log-files", T.pack (wcLogFiles cfg))
]
where
-- | 数值转文本
@@ -18,7 +18,7 @@ import qualified Data.Text.Encoding as TE
import System.Directory (XdgDirectory (XdgConfig), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
import System.FilePath (takeDirectory, (</>))
-- 全局 chusql.toml 的最小读写:只认 [section] 与 key = value。
-- 全局 settings.toml 的最小读写:只认 [section] 与 key = value。
-- | 读一个分区;文件不存在或没有这个分区都当空表
readSection :: FilePath -> Text -> IO (Map Text Text)
@@ -165,7 +165,7 @@ appendSection section entries lines' =
defaultConfigFile :: IO FilePath
defaultConfigFile = do
dir <- getXdgDirectory XdgConfig "ChuSQL"
pure (dir </> "chusql.toml")
pure (dir </> "settings.toml")
-- | 定位配置文件:命令行 --config 优先,否则用固定路径
resolveConfigPath :: Maybe FilePath -> IO FilePath