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

chusql-bootstrap/app/Main.hs

@@ -0,0 +1,158 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main (main) where
+
+import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
+import ChuSQL.Interface.Auth (hashPassword)
+import ChuSQL.Interface.Config (loadWebConfigAt, rootUserName)
+import ChuSQL.Interface.Settings (readSettingsFile)
+import ChuSQL.Interface.TOML (resolveConfigPath)
+import qualified Data.Aeson as A
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy.Char8 as BL
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import System.Environment (getArgs)
+import System.Exit (exitFailure)
+import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
+
+-- 引导程序：建系统库与管理员账号，装完即退，留在 bin 里备用。
+
+data Options = Options
+    { optConfig :: Maybe FilePath
+    , optUser :: Maybe String
+    , optPasswordStdin :: Bool
+    , optPasswordless :: Bool
+    , optHelp :: Bool
+    }
+
+-- | 全部选项都取默认值
+emptyOptions :: Options
+emptyOptions =
+    Options
+        { optConfig = Nothing
+        , optUser = Nothing
+        , optPasswordStdin = False
+        , optPasswordless = False
+        , optHelp = False
+        }
+
+-- | 解析参数
+parseArgs :: [String] -> Either String Options
+parseArgs = go emptyOptions
+  where
+    -- | 逐条消费参数列表
+    go opts [] = Right opts
+    go opts ("--help" : rest) = go opts{optHelp = True} rest
+    go opts ("-h" : rest) = go opts{optHelp = True} rest
+    go opts ("--config" : v : rest) = go opts{optConfig = Just v} rest
+    go opts ("--user" : v : rest) = go opts{optUser = Just v} rest
+    go opts ("--password-stdin" : rest) = go opts{optPasswordStdin = True} rest
+    go opts ("--passwordless" : rest) = go opts{optPasswordless = True} rest
+    go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a)
+
+-- | 打印用法说明
+usage :: IO ()
+usage = do
+    putStrLn "usage: csql-bootstrap [options]"
+    putStrLn ""
+    putStrLn "config: chusql.toml sits at a fixed place (Windows: %APPDATA%\\ChuSQL\\chusql.toml;"
+    putStrLn "        other: $XDG_CONFIG_HOME/ChuSQL/chusql.toml), the same file the server reads"
+    putStrLn ""
+    putStrLn "  --config FILE          read that config file instead"
+    putStrLn "  --user NAME            administrator name          ([web] user, default root)"
+    putStrLn "  --password-stdin       read the administrator password from one line of stdin"
+    putStrLn "  --passwordless         leave the administrator without a password"
+    putStrLn ""
+    putStrLn "what it does: creates the system database, the __system_users table and the"
+    putStrLn "  administrator row, then exits. It never changes an existing account, and it"
+    putStrLn "  never deletes data, so the installer and later repairs can run it again."
+
+-- | 入口
+main :: IO ()
+main = do
+    hSetBuffering stdout LineBuffering
+    args <- getArgs
+    case parseArgs args of
+        Left err -> do
+            putStrLn ("bad arguments: " ++ err)
+            usage
+            exitFailure
+        Right opts
+            | optHelp opts -> usage
+            | otherwise -> run opts
+
+-- | 读配置、算口令哈希、发一条引导请求
+run :: Options -> IO ()
+run opts = do
+    configPath <- resolveConfigPath (optConfig opts)
+    base <- loadWebConfigAt configPath
+    saved <- readSettingsFile configPath
+    let name = maybe (rootUserName base saved) T.pack (optUser opts)
+    chosen <- readPassword opts
+    case chosen of
+        Left err -> do
+            putStrLn ("!! " ++ err)
+            usage
+            exitFailure
+        Right plain -> do
+            encoded <- if T.null plain then pure "" else hashPassword plain
+            putStrLn "================== ChuSQL Bootstrap ================="
+            putStrLn ("config file:   " ++ configPath)
+            putStrLn ("administrator: " ++ T.unpack name)
+            putStrLn
+                ( if T.null encoded
+                    then "password:      none yet (sign in with an empty one, then set it)"
+                    else "password:      set (stored hashed in the system table)"
+                )
+            opened <- localStorageLink (Just configPath)
+            case opened of
+                Left err -> failWith ("cannot open the storage library: " ++ err)
+                Right link -> do
+                    setStorageLink link
+                    reply <- sendRawRequest (BL.toStrict (A.encode (bootstrapRequest name encoded)))
+                    closeConnection
+                    report reply
+
+-- | 引导请求：建表、插管理员行
+bootstrapRequest :: Text -> Text -> A.Value
+bootstrapRequest name encoded =
+    A.object
+        [ "method" A..= ("bootstrap_system" :: Text)
+        , "user" A..= name
+        , "password_hash" A..= encoded
+        ]
+
+-- | 看应答：system 就是成功，其余按错误处理
+report :: Either String BS.ByteString -> IO ()
+report (Left err) = failWith ("cannot talk to the storage library: " ++ err)
+report (Right raw) = case A.eitherDecodeStrict raw of
+    Right (A.Object fields)
+        | KM.lookup "status" fields == Just (A.String "system") ->
+            putStrLn "system catalog: ready"
+        | otherwise ->
+            failWith ("bootstrap failed: " ++ message fields)
+    Right _ -> failWith ("unexpected reply from the storage library: " ++ show raw)
+    Left err -> failWith ("the storage library answered something that is not JSON: " ++ err)
+  where
+    -- | 取错误文本
+    message fields = case KM.lookup "message" fields of
+        Just (A.String text) -> T.unpack text
+        _ -> show raw
+
+-- | 读口令：stdin 一行，空行等于不设口令
+readPassword :: Options -> IO (Either String Text)
+readPassword opts
+    | optPasswordless opts = pure (Right "")
+    | optPasswordStdin opts = do
+        line <- TIO.getLine
+        pure (Right (T.dropWhileEnd (\c -> c == '\r' || c == '\n') line))
+    | otherwise = pure (Left "pass --password-stdin or --passwordless")
+
+-- | 打印错误并退出 1
+failWith :: String -> IO a
+failWith message = do
+    putStrLn ("!! " ++ message)
+    exitFailure