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

chusql-bootstrap/app/Main.hs

@@ -3,22 +3,22 @@
 module Main (main) where
 
 import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
+import ChuSQL.Bootstrap (preinstalledTypes, runBootstrap)
+import ChuSQL.Core.Engine.Storage.FFI (maintainStorage)
 import ChuSQL.Interface.Auth (hashPassword)
 import ChuSQL.Interface.Config (loadWebConfigAt, rootUserName)
-import ChuSQL.Interface.Settings (readSettingsFile)
 import ChuSQL.Interface.TOML (resolveConfigPath)
 import qualified Data.Aeson as A
-import qualified Data.Aeson.KeyMap as KM
-import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy.Char8 as BL
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
+import Control.Exception (finally)
 import System.Environment (getArgs)
 import System.Exit (exitFailure)
 import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
 
--- 引导程序：建系统库与管理员账号，装完即退，留在 bin 里备用。
+-- 引导程序：初始化系统库、管理员身份与内置类型目录。
 
 data Options = Options
     { optConfig :: Maybe FilePath
@@ -26,6 +26,7 @@ data Options = Options
     , optPasswordStdin :: Bool
     , optPasswordless :: Bool
     , optHelp :: Bool
+    , optMode :: Maybe String
     }
 
 -- | 全部选项都取默认值
@@ -37,6 +38,7 @@ emptyOptions =
         , optPasswordStdin = False
         , optPasswordless = False
         , optHelp = False
+        , optMode = Nothing
         }
 
 -- | 解析参数
@@ -45,6 +47,10 @@ parseArgs = go emptyOptions
   where
     -- | 逐条消费参数列表
     go opts [] = Right opts
+    go opts (command : rest)
+        | command `elem` ["repair", "recover", "recovery", "reset"] = case optMode opts of
+            Nothing -> go opts{optMode = Just (if command == "recovery" then "recover" else command)} rest
+            Just _ -> Left "only one maintenance command is allowed"
     go opts ("--help" : rest) = go opts{optHelp = True} rest
     go opts ("-h" : rest) = go opts{optHelp = True} rest
     go opts ("--config" : v : rest) = go opts{optConfig = Just v} rest
@@ -56,19 +62,23 @@ parseArgs = go emptyOptions
 -- | 打印用法说明
 usage :: IO ()
 usage = do
-    putStrLn "usage: csql-bootstrap [options]"
+    putStrLn "usage: csql-bootstrap [repair|recover|recovery|reset] [options]"
+    putStrLn "  repair    repair structures; abort if data recovery or initialization is needed"
+    putStrLn "  recover   replay WAL and recover system metadata; recovery is an alias"
+    putStrLn "  reset     replace system identities and grants with initial defaults"
+    putStrLn "Stop all database processes first. Maintenance preserves the old system directory."
     putStrLn ""
-    putStrLn "config: chusql.toml sits at a fixed place (Windows: %APPDATA%\\ChuSQL\\chusql.toml;"
-    putStrLn "        other: $XDG_CONFIG_HOME/ChuSQL/chusql.toml), the same file the server reads"
+    putStrLn "config: settings.toml sits at a fixed place (Windows: %APPDATA%\\ChuSQL\\settings.toml;"
+    putStrLn "        other: $XDG_CONFIG_HOME/ChuSQL/settings.toml), the same file the server reads"
     putStrLn ""
     putStrLn "  --config FILE          read that config file instead"
-    putStrLn "  --user NAME            administrator name          ([web] user, default root)"
+    putStrLn "  --user NAME            administrator name          (default root)"
     putStrLn "  --password-stdin       read the administrator password from one line of stdin"
     putStrLn "  --passwordless         leave the administrator without a password"
     putStrLn ""
-    putStrLn "what it does: creates the system database, the __system_users table and the"
-    putStrLn "  administrator row, then exits. It never changes an existing account, and it"
-    putStrLn "  never deletes data, so the installer and later repairs can run it again."
+    putStrLn "what it does: initializes the system database, an enabled login superuser and"
+    putStrLn "  the preinstalled builtin type directory, then exits. Existing passwords and"
+    putStrLn "  matching type definitions are preserved; conflicting definitions fail."
 
 -- | 入口
 main :: IO ()
@@ -84,13 +94,13 @@ main = do
             | optHelp opts -> usage
             | otherwise -> run opts
 
--- | 读配置、算口令哈希、发一条引导请求
+-- | 读取配置和口令并完成安装引导
 run :: Options -> IO ()
+run opts | Just mode <- optMode opts = runMaintenance opts mode
 run opts = do
     configPath <- resolveConfigPath (optConfig opts)
     base <- loadWebConfigAt configPath
-    saved <- readSettingsFile configPath
-    let name = maybe (rootUserName base saved) T.pack (optUser opts)
+    let name = maybe (rootUserName base) T.pack (optUser opts)
     chosen <- readPassword opts
     case chosen of
         Left err -> do
@@ -112,35 +122,34 @@ run opts = do
                 Left err -> failWith ("cannot open the storage library: " ++ err)
                 Right link -> do
                     setStorageLink link
-                    reply <- sendRawRequest (BL.toStrict (A.encode (bootstrapRequest name encoded)))
-                    closeConnection
-                    report reply
+                    result <- runBootstrap send name encoded `finally` closeConnection
+                    case result of
+                        Left err -> failWith ("bootstrap failed: " ++ err)
+                        Right count -> do
+                            putStrLn "system catalog: ready"
+                            putStrLn "administrator identity: LOGIN SUPERUSER ENABLED"
+                            putStrLn ("preinstalled types: ready (" ++ show count ++ " definitions)")
 
--- | 引导请求：建表、插管理员行
-bootstrapRequest :: Text -> Text -> A.Value
-bootstrapRequest name encoded =
-    A.object
-        [ "method" A..= ("bootstrap_system" :: Text)
-        , "user" A..= name
-        , "password_hash" A..= encoded
-        ]
+-- | 在离线维护入口执行所选策略
+runMaintenance :: Options -> String -> IO ()
+runMaintenance opts mode = do
+    path <- resolveConfigPath (optConfig opts)
+    chosen <- if mode == "reset" || optPasswordStdin opts || optPasswordless opts then readPassword opts else pure (Right "")
+    case chosen of
+        Left err -> failWith err
+        Right plain -> do
+            encoded <- if T.null plain then pure "" else hashPassword plain
+            let request = A.object ["mode" A..= mode, "user" A..= maybe "root" id (optUser opts), "password_hash" A..= encoded, "types" A..= preinstalledTypes]
+            reply <- maintainStorage path (BL.toStrict (A.encode request))
+            case reply of
+                Left err -> failWith err
+                Right value -> BL.putStrLn (BL.fromStrict value)
 
--- | 看应答：system 就是成功，其余按错误处理
-report :: Either String BS.ByteString -> IO ()
-report (Left err) = failWith ("cannot talk to the storage library: " ++ err)
-report (Right raw) = case A.eitherDecodeStrict raw of
-    Right (A.Object fields)
-        | KM.lookup "status" fields == Just (A.String "system") ->
-            putStrLn "system catalog: ready"
-        | otherwise ->
-            failWith ("bootstrap failed: " ++ message fields)
-    Right _ -> failWith ("unexpected reply from the storage library: " ++ show raw)
-    Left err -> failWith ("the storage library answered something that is not JSON: " ++ err)
-  where
-    -- | 取错误文本
-    message fields = case KM.lookup "message" fields of
-        Just (A.String text) -> T.unpack text
-        _ -> show raw
+-- | 通过存储链路发送引导请求
+send :: A.Value -> IO (Either String A.Value)
+send request = do
+    reply <- sendRawRequest (BL.toStrict (A.encode request))
+    pure (reply >>= A.eitherDecodeStrict)
 
 -- | 读口令：stdin 一行，空行等于不设口令
 readPassword :: Options -> IO (Either String Text)

chusql-bootstrap/chusql-bootstrap.cabal

@@ -2,11 +2,20 @@ cabal-version: 2.4
 
 name:           chusql-bootstrap
 version:        1.0.0
-synopsis:       ChuSQL 引导程序：建系统库与管理员账号
-description:    ChuSQL 初始化引导。首次启动前建系统库、账号表与管理员行，
-                装完即退，保留在 bin 里备用。后续的 catalog 修复也走这里。
+synopsis:       ChuSQL system catalog initialization and offline maintenance
+description:    Initializes the system catalog, administrator identity, and builtin
+                type registry during installation, preserving existing passwords
+                and validating type definitions. Provides offline structure repair,
+                WAL recovery, and system catalog reset commands.
 build-type:     Simple
 
+library
+    hs-source-dirs: src
+    exposed-modules: ChuSQL.Bootstrap
+    build-depends: base >= 4.14 && < 5, aeson, chusql-core-model, text
+    default-language: Haskell2010
+    ghc-options: -Wall
+
 executable csql-bootstrap
     hs-source-dirs:   app
     main-is:          Main.hs
@@ -15,6 +24,16 @@ executable csql-bootstrap
                     , bytestring
                     , chusql-core-engine
                     , chusql-interface
+                    , chusql-bootstrap
                     , text
     default-language: Haskell2010
     ghc-options:      -Wall
+
+test-suite chusql-bootstrap-test
+    type: exitcode-stdio-1.0
+    hs-source-dirs: test
+    main-is: Spec.hs
+    build-depends: base >= 4.14 && < 5, aeson, bytestring, chusql-bootstrap,
+                   chusql-core-engine, chusql-core-model, directory, filepath, hspec, text
+    default-language: Haskell2010
+    ghc-options: -Wall

chusql-bootstrap/src/ChuSQL/Bootstrap.hs

@@ -0,0 +1,77 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Bootstrap (preinstalledTypes, runBootstrap) where
+
+import ChuSQL.Core.Model (ColumnType (..), typeName)
+import ChuSQL.Core.Protocol (Account (..))
+import qualified Data.Aeson as A
+import qualified Data.Aeson.KeyMap as KM
+import Data.Foldable (toList)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+-- 引导系统身份与预装类型，校验已有定义并保留口令。
+
+-- | 现有内置类型及其默认参数
+preinstalledTypes :: [A.Value]
+preinstalledTypes = map definition
+    [ ("int", CInt, False), ("integer", CInt, False)
+    , ("bigint", CBigInt, False), ("smallint", CSmallInt, False)
+    , ("varchar", CStr, True), ("char", CChar 1, True)
+    , ("text", CStr, False), ("str", CStr, False)
+    , ("boolean", CBool, False), ("bool", CBool, False)
+    , ("float", CFloat, False), ("real", CFloat, False), ("double", CDouble, False)
+    , ("decimal", CDecimal 10 0, True), ("numeric", CDecimal 10 0, True)
+    , ("date", CDate, False), ("timestamp", CTimestamp, False), ("blob", CBlob, False)
+    ]
+  where
+    -- | 编码类型的名称与基础表示
+    definition :: (Text, ColumnType, Bool) -> A.Value
+    definition (name, base, parameterized) = A.object
+        ["name" A..= name, "base_type" A..= typeName base, "parameterized" A..= parameterized]
+
+-- | 依次引导身份、迁移目录并预装类型
+runBootstrap :: (A.Value -> IO (Either String A.Value)) -> Text -> Text -> IO (Either String Int)
+runBootstrap send name encoded = do
+    initialized <- send (A.object ["method" A..= ("bootstrap_system" :: Text), "user" A..= name, "password_hash" A..= encoded])
+    case expect "system" initialized >>= initializedCatalog of
+        Left err -> pure (Left err)
+        Right () -> do
+            migrated <- send (A.object ["method" A..= ("identity_initialize" :: Text), "administrator" A..= name])
+            case expect "accounts" migrated >>= administrator of
+                Left err -> pure (Left err)
+                Right () -> do
+                    installed <- send (A.object ["method" A..= ("bootstrap_types" :: Text), "types" A..= preinstalledTypes])
+                    pure (expect "rows" installed >>= installedTypes)
+  where
+    -- | 确认系统目录已初始化
+    initializedCatalog fields
+        | KM.lookup "initialized" fields == Just (A.Bool True) = Right ()
+        | otherwise = Left "system catalog is not initialized"
+    -- | 确认所选引导身份可以管理系统
+    administrator fields = case KM.lookup "accounts" fields of
+        Nothing -> Left "missing identity directory"
+        Just value -> case A.fromJSON value :: A.Result [Account] of
+            A.Error _ -> Left "invalid identity directory"
+            A.Success accounts
+                | any (\a -> accountUser a == T.toLower name && accountCanLogin a && accountEnabled a && accountIsSuperuser a) accounts -> Right ()
+                | otherwise -> Left "bootstrap identity is not an enabled login superuser; existing identities were preserved"
+    -- | 确认全部预装类型存在且定义一致
+    installedTypes fields = case KM.lookup "rows" fields of
+        Just (A.Array rows)
+            | all (\definition -> any (matches definition) (toList rows)) preinstalledTypes -> Right (length rows)
+            | otherwise -> Left "preinstalled type verification failed"
+        _ -> Left "missing preinstalled type directory"
+    -- | 比对类型定义并检查持久化编号
+    matches (A.Object definition) (A.Object saved) = all (\(key, value) -> KM.lookup key saved == Just value) (KM.toList definition)
+        && case KM.lookup "id" saved of Just (A.Number n) -> n > 0; _ -> False
+    matches _ _ = False
+
+-- | 校验响应状态并返回明确错误
+expect :: Text -> Either String A.Value -> Either String (KM.KeyMap A.Value)
+expect _ (Left err) = Left err
+expect status (Right (A.Object fields))
+    | KM.lookup "status" fields == Just (A.String status) = Right fields
+    | Just (A.String err) <- KM.lookup "message" fields = Left (T.unpack err)
+    | otherwise = Left ("unexpected bootstrap response; expected " ++ T.unpack status)
+expect _ (Right _) = Left "invalid bootstrap response"

chusql-bootstrap/test/Spec.hs

@@ -0,0 +1,134 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main (main) where
+
+import ChuSQL.Bootstrap (preinstalledTypes, runBootstrap)
+import ChuSQL.Core.Protocol (Account (..))
+import ChuSQL.Core.Model (columnType, typeName)
+import ChuSQL.Core.Engine.Syntax.AST (Statement (CreateTable))
+import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
+import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
+import Control.Exception (finally)
+import qualified Data.Aeson as A
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.ByteString.Lazy as BL
+import Data.IORef (newIORef, readIORef, modifyIORef')
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Unique (hashUnique, newUnique)
+import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removePathForcibly)
+import System.FilePath ((</>))
+import Test.Hspec
+
+-- 引导测试：身份属性、类型清单、错误停止与真实持久化。
+
+-- | 执行引导模块测试
+main :: IO ()
+main = hspec $ do
+    describe "bootstrap plan" $ do
+        it "registers every builtin alias with its parser defaults" $ mapM_ checkDefinition preinstalledTypes
+        it "initializes identities before installing types" $ do
+            (send, requests) <- mock [Right ready, Right (identity True), Right installed]
+            runBootstrap send "root" "new-hash" `shouldReturn` Right 18
+            calls <- requests
+            map (field "method") calls `shouldBe` map A.String ["bootstrap_system", "identity_initialize", "bootstrap_types"]
+        mapM_ (\(title, replies, err) -> it title (expectBootstrapFailure replies err))
+            [ ("stops on storage errors", [Left "storage unavailable"], "storage unavailable")
+            , ("rejects an uninitialized system response", [Right (A.object ["status" A..= ("system" :: Text), "initialized" A..= False])], "system catalog is not initialized")
+            , ("preserves a demoted identity and stops before type installation", [Right ready, Right (identity False)], "bootstrap identity is not an enabled login superuser; existing identities were preserved")
+            , ("reports type definition conflicts explicitly", [Right ready, Right (identity True), Right (A.object ["status" A..= ("error" :: Text), "message" A..= ("type conflict" :: Text)])], "type conflict")
+            , ("refuses incomplete type registration", [Right ready, Right (identity True), Right (A.object ["status" A..= ("rows" :: Text), "rows" A..= ([] :: [A.Value])])], "preinstalled type verification failed")
+            ]
+    describe "bootstrap on real storage" $ do
+        it "creates root and eighteen types before any server starts" $ withStorage $ do
+            runBootstrap transport "root" "original-hash" `shouldReturn` Right 18
+            result <- transport (A.object ["method" A..= ("accounts_list" :: Text)])
+            case result of
+                Left err -> expectationFailure err
+                Right value -> case A.fromJSON (field "accounts" value) :: A.Result [Account] of
+                    A.Error err -> expectationFailure err
+                    A.Success [account] -> do
+                        accountUser account `shouldBe` "root"
+                        accountCanLogin account `shouldBe` True
+                        accountEnabled account `shouldBe` True
+                        accountIsSuperuser account `shouldBe` True
+                        accountHash account `shouldBe` "original-hash"
+                    A.Success _ -> expectationFailure "unexpected identities"
+        it "keeps the existing password and type definitions on rerun" $ withStorage $ do
+            runBootstrap transport "root" "original-hash" `shouldReturn` Right 18
+            first <- transport (A.object ["method" A..= ("accounts_list" :: Text)])
+            runBootstrap transport "root" "replacement-hash" `shouldReturn` Right 18
+            transport (A.object ["method" A..= ("accounts_list" :: Text)]) `shouldReturn` first
+
+-- | 校验引导错误及停止请求的位置
+expectBootstrapFailure :: [Either String A.Value] -> String -> Expectation
+expectBootstrapFailure replies err = do
+    (send, requests) <- mock replies
+    runBootstrap send "root" "hash" `shouldReturn` Left err
+    fmap length requests `shouldReturn` length replies
+
+-- | 校验预装定义与 SQL 默认类型一致
+checkDefinition :: A.Value -> IO ()
+checkDefinition value = case (field "name" value, field "base_type" value) of
+    (A.String name, A.String base) -> case parseStatement ("CREATE TABLE seeded (value " ++ T.unpack name ++ ")") of
+        Right (CreateTable _ [(_, column)]) -> T.pack (typeName (columnType column)) `shouldBe` base
+        other -> expectationFailure (show other)
+    _ -> expectationFailure "invalid builtin definition"
+
+-- | 系统目录的成功响应
+ready :: A.Value
+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]]
+
+-- | 已写入编号的类型响应
+installed :: A.Value
+installed = A.object ["status" A..= ("rows" :: Text), "rows" A..= map numbered (zip [1 :: Int ..] preinstalledTypes)]
+  where
+    -- | 给预装定义添加持久化编号
+    numbered (n, A.Object fields) = A.Object (KM.insert "id" (A.toJSON n) fields)
+    numbered (_, value) = value
+
+-- | 读取响应中的一个字段
+field :: A.Key -> A.Value -> A.Value
+field key (A.Object fields) = maybe A.Null id (KM.lookup key fields)
+field _ _ = A.Null
+
+-- | 记录请求并返回指定响应
+mock :: [Either String A.Value] -> IO (A.Value -> IO (Either String A.Value), IO [A.Value])
+mock replies = do
+    calls <- newIORef []
+    queuedReplies <- newIORef replies
+    let
+        -- | 消费一条模拟响应
+        send request = do
+            modifyIORef' calls (++ [request])
+            remaining <- readIORef queuedReplies
+            case remaining of
+                [] -> pure (Left "unexpected request")
+                reply : rest -> modifyIORef' queuedReplies (const rest) >> pure reply
+    pure (send, readIORef calls)
+
+-- | 通过动态库存储链路发送请求
+transport :: A.Value -> IO (Either String A.Value)
+transport request = do
+    reply <- sendRawRequest (BL.toStrict (A.encode request))
+    pure (reply >>= A.eitherDecodeStrict)
+
+-- | 在独立临时目录运行真实引导
+withStorage :: IO () -> IO ()
+withStorage action = do
+    tmp <- getTemporaryDirectory
+    unique <- hashUnique <$> newUnique
+    let directory = tmp </> ("chusql-bootstrap-" ++ show unique)
+        config = directory </> "settings.toml"
+    createDirectoryIfMissing True directory
+    writeFile config ("[storage]\ndata_dir = \"" ++ map (\c -> if c == '\\' then '/' else c) directory ++ "\"\n")
+    opened <- localStorageLink (Just config)
+    case opened of
+        Left err -> removePathForcibly directory >> expectationFailure err
+        Right link -> do
+            setStorageLink link
+            action `finally` (closeConnection >> removePathForcibly directory)