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

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"