大改，整理项目结构，完成rust ffi调用，写好tcp接口

chusql-cli/app/Main.hs

@@ -11,19 +11,11 @@ import ChuSQL.CLI.Session (
     newSession,
     switchDatabase,
  )
-import ChuSQL.Web.Auth (Credential (..))
-import ChuSQL.Web.Backend (ipcBackend)
-import ChuSQL.Web.Config (WebConfig (..), defaultPassword, loadWebConfigAt, resolveCredential, resolvePipeName)
-import ChuSQL.Web.Settings (readSettingsFile)
-import ChuSQL.Web.TOML (resolveConfigPath)
-import ChuSQL.Web.StorageProcess (
-    StorageProcess,
-    findStorageServer,
-    startStorageProcessAt,
-    stopStorageProcess,
-    waitForStorage,
- )
-import ChuSQL.Storage.IPC (setPipeName)
+import ChuSQL.Interface.Auth (Credential (..))
+import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, resolveCredential, resolvePlainPassword)
+import ChuSQL.Interface.Link (Client, closeClient, connectClient)
+import ChuSQL.Interface.Settings (readSettingsFile)
+import ChuSQL.Interface.TOML (resolveConfigPath)
 import Control.Exception (finally)
 import Control.Monad (unless)
 import Data.IORef (newIORef)
@@ -39,7 +31,7 @@ import System.Exit (exitFailure)
 import System.FilePath ((</>))
 import System.IO (hSetEncoding, stderr, stdout, utf8)
 
--- chusql-cli：与 Web 管理端并列的前端，直连存储与引擎，账号与 Web 共用。
+-- chusql-cli：与 Web 管理端并列的前端，接到拥有存储的 server 上跑 SQL，账号与 Web 共用。
 
 data Options = Options
     { optUser :: Maybe Text
@@ -48,11 +40,10 @@ data Options = Options
     , optFormat :: OutputFormat
     , optExecute :: Maybe Text
     , optHistory :: Maybe FilePath
-    , optPipe :: Maybe String
-    , optStorage :: Maybe FilePath
     , optConfig :: Maybe FilePath
     }
 
+-- | 命令行参数解析器
 optionsParser :: Parser Options
 optionsParser =
     Options
@@ -78,13 +69,13 @@ 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 "pipe" <> metavar "NAME" <> help "Endpoint name of the storage process (Windows named pipe, Unix socket file; default: [server] pipe_name in chusql.toml)"))
-        <*> optional (strOption (long "storage" <> metavar "SERVER" <> help "Rust storage executable to spawn when nothing answers the endpoint"))
         <*> optional (strOption (long "config" <> metavar "FILE" <> help "Config file to read (default: the fixed chusql.toml under the system config directory)"))
 
+-- | 把 --format 的取值解析成格式
 formatReader :: String -> Either String OutputFormat
 formatReader raw = maybe (Left "format must be table, json or csv") Right (parseFormat (T.pack raw))
 
+-- | 命令行界面与帮助
 parserInfo :: ParserInfo Options
 parserInfo =
     info
@@ -94,6 +85,7 @@ parserInfo =
             <> header "csql - the ChuSQL command line client"
         )
 
+-- | 解析参数、登录 server 后进入会话
 main :: IO ()
 main = do
     hSetEncoding stdout utf8
@@ -101,31 +93,29 @@ main = do
     options <- execParser parserInfo
     configPath <- resolveConfigPath (optConfig options)
     base <- loadWebConfigAt configPath
-    let settingsFile = configPath
-    saved <- readSettingsFile settingsFile
+    saved <- readSettingsFile configPath
     credential <- resolveCredential base saved
+    config <- loadServerConfigAt configPath
     let rootName = credUser credential
         userName = fromMaybe rootName (optUser options)
-        pipeName = resolvePipe options base
-    setPipeName pipeName
     password <- resolvePassword (optPromptPassword options) userName rootName saved
-    storage <- acquireStorage options pipeName settingsFile
-    case storage of
+    connected <- connectClient (T.pack (scHost config)) (scPort config)
+    case connected of
         Left message -> reportError message >> exitFailure
-        Right spawned ->
-            connect options credential settingsFile userName password
-                `finally` maybe (pure ()) stopStorageProcess spawned
+        Right client ->
+            connect options client userName password
+                `finally` closeClient client
 
--- | 接上存储，登录，然后进交互或跑单条语句
-connect :: Options -> Credential -> FilePath -> Text -> Text -> IO ()
-connect options credential settingsFile userName password = do
-    backend <- ipcBackend
-    session <- newSession backend credential settingsFile
+-- | 连 server、登录，之后转入会话
+connect :: Options -> Client -> Text -> Text -> IO ()
+connect options client userName password = do
+    session <- newSession client
     signedIn <- authenticateSession session userName password
     case signedIn of
         Left message -> reportError message >> exitFailure
         Right () -> runSession options session
 
+-- | 执行 -e 的单条语句，否则进交互循环
 runSession :: Options -> Session -> IO ()
 runSession options session = do
     formatRef <- newIORef (optFormat options)
@@ -140,7 +130,7 @@ runSession options session = do
                 historyFile <- resolveHistory (optHistory options)
                 runRepl session formatRef historyFile
 
--- | 只有 -d 明确给了一个库才切；没给就保持"未选库"（服务没有默认库）
+-- | -d 指定了库才切，否则保持未选库
 selectDatabase :: Session -> Text -> IO Bool
 selectDatabase _ wanted | T.null wanted = pure True
 selectDatabase session wanted
@@ -151,54 +141,20 @@ selectDatabase session wanted
             Left message -> reportError message >> pure False
             Right () -> pure True
 
--- | 口令：-p 强制交互输入；否则配置里的 root 明文（同 Web）> 交互输入
+-- | 决定口令是交互输入还是取自配置
 resolvePassword :: Bool -> Text -> Text -> Map.Map Text Text -> IO Text
 resolvePassword forcePrompt userName rootName saved
     | forcePrompt = promptPassword userName
-    | T.toLower userName == T.toLower rootName = pure (configuredPassword saved)
+    | T.toLower userName == T.toLower rootName = pure (resolvePlainPassword saved)
     | otherwise = promptPassword userName
-  where
-    configuredPassword values = case nonEmpty (Map.lookup "password" values) of
-        Just plain -> plain
-        Nothing -> defaultPassword
 
+-- | 交互式读取口令
 promptPassword :: Text -> IO Text
 promptPassword user = do
     entered <- runInputT defaultSettings (getPassword (Just '*') (T.unpack user <> "'s password: "))
     pure (maybe "" T.pack entered)
 
--- | 先找已经在跑的存储；--storage 给了可执行文件才自己拉一个
-acquireStorage :: Options -> String -> FilePath -> IO (Either Text (Maybe StorageProcess))
-acquireStorage options pipeName configPath = do
-    up <- waitForStorage 4
-    case optStorage options of
-        Nothing
-            | up -> pure (Right Nothing)
-            | otherwise ->
-                pure
-                    ( Left
-                        ( "no storage process answered on pipe "
-                            <> T.pack pipeName
-                            <> "; start the server first, or pass --storage <path>"
-                        )
-                    )
-        Just given
-            | up -> pure (Right Nothing)
-            | otherwise -> do
-                found <- findStorageServer (Just given)
-                case found of
-                    Left err -> pure (Left (T.pack err))
-                    Right binary -> fmap (either (Left . T.pack) (Right . Just)) (startStorageProcessAt binary pipeName configPath)
-
--- | 管名：--pipe > chusql.toml 的 [server] pipe_name（缺省 chusql-joint）
-resolvePipe :: Options -> WebConfig -> String
-resolvePipe options base = fromMaybe (resolvePipeName base) (optPipe options)
-
-nonEmpty :: Maybe Text -> Maybe Text
-nonEmpty given = case T.strip <$> given of
-    Just text | not (T.null text) -> Just text
-    _ -> Nothing
-
+-- | 取历史文件路径，没给就用默认
 resolveHistory :: Maybe FilePath -> IO (Maybe FilePath)
 resolveHistory (Just path) = pure (Just path)
 resolveHistory Nothing = do

chusql-cli/app/Repl.hs

@@ -8,9 +8,9 @@ module Repl
 
 import ChuSQL.CLI.Format (OutputFormat, formatName, renderResult, renderRows)
 import ChuSQL.CLI.Script (Meta (..), errorHint, metaHelp, parseMeta, takeStatement)
-import ChuSQL.CLI.Session (Session, accountTable, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
-import ChuSQL.Storage.IPC (SchemaColumn (..), TableInfo (..))
-import ChuSQL.Web.Privileges (Grant (..), RoleView (..))
+import ChuSQL.CLI.Session (Session, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
+import ChuSQL.Core.Protocol (SchemaColumn (..), TableInfo (..))
+import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
 import Control.Monad (forM_, when)
 import Control.Monad.IO.Class (liftIO)
 import Data.IORef (IORef, readIORef, writeIORef)
@@ -22,7 +22,7 @@ import System.IO (hIsTerminalDevice, stderr, stdin)
 
 -- 交互层：提示符、多行输入、历史、元命令与错误提示。
 
--- | 交互循环；historyPath 为 Nothing 就不落盘历史
+-- | 交互循环，没有历史文件就不落盘
 runRepl :: Session -> IORef OutputFormat -> Maybe FilePath -> IO ()
 runRepl session formatRef historyPath =
     runInputT (defaultSettings{historyFile = historyPath}) (loop session formatRef T.empty)
@@ -41,6 +41,7 @@ runStatementOnce session format sql = do
         Left message -> reportError message >> pure False
         Right answer -> TIO.putStrLn (renderResult format answer) >> pure True
 
+-- | 读一行输入，分派到元命令或语句缓冲
 loop :: Session -> IORef OutputFormat -> Text -> InputT IO ()
 loop session formatRef buffer = do
     prompt <- liftIO (promptFor session buffer)
@@ -62,7 +63,7 @@ loop session formatRef buffer = do
                         remaining <- drain session formatRef extended
                         loop session formatRef remaining
 
--- | 提示符带上当前库；续行换个样子，方便看出语句还没写完；管道输入时不出提示符
+-- | 生成提示符；续行与非终端输入另有样式
 promptFor :: Session -> Text -> IO Text
 promptFor session buffer = do
     interactive <- hIsTerminalDevice stdin
@@ -83,6 +84,7 @@ drain session formatRef buffer = case takeStatement buffer of
         when (not (T.null statement)) (runOne session formatRef statement)
         drain session formatRef rest
 
+-- | 执行一条语句并打印结果
 runOne :: Session -> IORef OutputFormat -> Text -> InputT IO ()
 runOne session formatRef statement = do
     result <- liftIO (runStatement session statement)
@@ -92,6 +94,7 @@ runOne session formatRef statement = do
             format <- liftIO (readIORef formatRef)
             outputStrLn (T.unpack (renderResult format answer))
 
+-- | 执行元命令，返回是否继续循环
 runMeta :: Session -> IORef OutputFormat -> Meta -> InputT IO Bool
 runMeta session formatRef meta = case meta of
     MetaQuit -> pure False
@@ -120,17 +123,16 @@ listDatabases session = do
         Left message -> liftIO (reportError message)
         Right names -> outputStrLn (T.unpack (renderRows ["database"] (map (: []) names)))
 
--- | \dt：表清单（base 里补上账号表）
+-- | \dt：表清单（含 server 补的账号表）
 listTables :: Session -> InputT IO ()
 listTables session = do
     answer <- liftIO (catalog session)
     case answer of
         Left message -> liftIO (reportError message)
-        Right tables -> do
-            allTables <- liftIO (withAccountTable session tables)
-            outputStrLn (T.unpack (renderRows headers (map tableRow allTables)))
+        Right tables -> outputStrLn (T.unpack (renderRows headers (map tableRow tables)))
   where
     headers = ["table", "columns", "rows", "indexes"]
+    -- | 把表信息排成一行
     tableRow info =
         [ T.pack (tiTable info)
         , tshow (length (tiColumns info))
@@ -144,14 +146,15 @@ describeTable session name = do
     answer <- liftIO (catalog session)
     case answer of
         Left message -> liftIO (reportError message)
-        Right tables -> do
-            allTables <- liftIO (withAccountTable session tables)
-            case filter (matches name) allTables of
+        Right tables ->
+            case filter (matches name) tables of
                 [] -> liftIO (reportError ("unknown table: " <> name))
                 (info : _) -> outputStrLn (T.unpack (renderRows headers (map columnRow (tiColumns info))))
   where
     headers = ["column", "type", "primary", "unique", "nullable", "auto"]
+    -- | 表名忽略大小写比较
     matches wanted info = T.toLower (T.pack (tiTable info)) == T.toLower wanted
+    -- | 把列信息排成一行
     columnRow column =
         [ T.pack (scName column)
         , T.pack (scType column)
@@ -160,6 +163,7 @@ describeTable session name = do
         , yesNo (scNullable column)
         , yesNo (scAutoIncrement column)
         ]
+    -- | 布尔值转成 yes/no
     yesNo True = "yes"
     yesNo False = "no"
 
@@ -171,22 +175,15 @@ listRoles session = do
         Left message -> liftIO (reportError message)
         Right roles -> outputStrLn (T.unpack (renderRows ["role", "grants", "members"] (map roleRow roles)))
   where
+    -- | 把角色信息排成一行
     roleRow view =
         [ roleName view
         , if null (roleGrants view) then "-" else T.intercalate ", " (map grantText (roleGrants view))
         , if null (roleMembers view) then "-" else T.intercalate ", " (roleMembers view)
         ]
+    -- | 拼一条授权说明
     grantText grant = grantPrivilege grant <> " on " <> grantObject grant
 
--- | 当前库是 system 时，把账号表也列出来（与 Web 端一致）
-withAccountTable :: Session -> [TableInfo] -> IO [TableInfo]
-withAccountTable session tables = do
-    current <- sessionDatabase session
-    if current /= "system"
-        then pure tables
-        else do
-            extra <- accountTable session
-            pure (maybe tables (: tables) extra)
-
+-- | 用 show 转成 Text
 tshow :: Show a => a -> Text
 tshow = T.pack . show

chusql-cli/chusql-cli.cabal

@@ -2,9 +2,9 @@ cabal-version: 2.4
 
 name:           chusql-cli
 version:        1.0.0
-synopsis:       ChuSQL 命令行客户端：直连引擎与存储，与 Web 管理端共用账号
-description:    ChuSQL 的命令行前端。直接走命名管道接 Rust 存储进程与 Haskell 引擎，
-                不经过 Web REST；root 凭据与 __chusql_users 表与 Web 管理端完全共用。
+synopsis:       ChuSQL 命令行客户端：直连数据库服务，与 Web 管理端共用账号
+description:    ChuSQL 的命令行前端。自己不开存储、不链引擎，所有 SQL 与会话
+                 都走 chusql-server 的 TCP 端点；账号表与权限服务与 Web 管理端完全共用。
 build-type:     Simple
 
 library
@@ -15,11 +15,9 @@ library
     build-depends:    base >= 4.14 && < 5
                     , aeson
                     , bytestring
-                    , chusql-engine
-                    , chusql-web
-                    , scientific
+                    , chusql-core-model
+                    , chusql-interface
                     , text
-                    , time
     default-language: Haskell2010
     ghc-options:      -Wall
 
@@ -28,10 +26,9 @@ executable csql
     other-modules:    Repl
     hs-source-dirs:   app
     build-depends:    base
-                    , aeson
                     , chusql-cli
-                    , chusql-engine
-                    , chusql-web
+                    , chusql-core-model
+                    , chusql-interface
                     , containers
                     , directory
                     , filepath
@@ -40,6 +37,11 @@ executable csql
                     , text
     default-language: Haskell2010
     ghc-options:      -Wall
+    -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
+    if os(linux)
+        ld-options: -Wl,-rpath,$ORIGIN
+    if os(osx)
+        ld-options: -Wl,-rpath,@loader_path
 
 test-suite chusql-cli-test
     type:             exitcode-stdio-1.0
@@ -49,8 +51,7 @@ test-suite chusql-cli-test
                     , aeson
                     , bytestring
                     , chusql-cli
-                    , chusql-engine
-                    , chusql-web
+                    , chusql-core-model
                     , hspec
                     , text
     default-language: Haskell2010

chusql-cli/src/ChuSQL/CLI/Format.hs

@@ -12,8 +12,8 @@ module ChuSQL.CLI.Format
     , displayValue
     ) where
 
-import ChuSQL.CLI.Session (QueryResult (..), queryResultJson)
-import ChuSQL.Model (Value (..))
+import ChuSQL.Core.Model (Value (..))
+import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL
 import Data.Text (Text)
@@ -25,6 +25,7 @@ import Data.Text.Encoding (decodeUtf8)
 data OutputFormat = FormatTable | FormatJson | FormatCsv
     deriving (Eq, Show)
 
+-- | 格式的对外名字
 formatName :: OutputFormat -> Text
 formatName FormatTable = "table"
 formatName FormatJson = "json"
@@ -38,6 +39,7 @@ parseFormat raw = case T.toLower (T.strip raw) of
     "csv" -> Just FormatCsv
     _ -> Nothing
 
+-- | 按格式渲染查询结果
 renderResult :: OutputFormat -> QueryResult -> Text
 renderResult FormatTable = renderTable
 renderResult FormatJson = renderJson
@@ -47,10 +49,12 @@ renderResult FormatCsv = renderCsv
 renderJson :: QueryResult -> Text
 renderJson = decodeUtf8 . BL.toStrict . A.encode . queryResultJson
 
+-- | 渲染成 CSV
 renderCsv :: QueryResult -> Text
 renderCsv result = T.unlines (header : map rowLine (qrRows result))
   where
     header = T.intercalate "," (map csvField (qrColumns result))
+    -- | 拼一行 CSV
     rowLine row = T.intercalate "," (map (csvField . csvCell) row)
 
 -- | CSV 里的空值就是空字段
@@ -64,6 +68,7 @@ csvField field
     | T.any (`elem` (",\"\n\r" :: String)) field = "\"" <> T.replace "\"" "\"\"" field <> "\""
     | otherwise = field
 
+-- | 渲染成等宽表格
 renderTable :: QueryResult -> Text
 renderTable result
     | null (qrColumns result) = "OK"
@@ -74,10 +79,13 @@ renderRows :: [Text] -> [[Text]] -> Text
 renderRows columns rawRows = T.unlines (border : headerLine : border : body ++ [border, summary])
   where
     widths = [columnWidth index | index <- [0 .. length columns - 1]]
+    -- | 一列的显示宽度，有上限
     columnWidth index =
         min maxColumnWidth (maximum (T.length (columns !! index) : [T.length (cellAt row index) | row <- rawRows]))
     maxColumnWidth = 64
+    -- | 取某行某列，缺的当空
     cellAt row index = if index < length row then row !! index else ""
+    -- | 拼一行带竖线的表行
     cellLine cells = "| " <> T.intercalate " | " (zipWith pad widths (cells ++ repeat "")) <> " |"
     headerLine = cellLine columns
     body = map cellLine rawRows
@@ -93,6 +101,7 @@ pad width text = clipped <> T.replicate (width - T.length clipped) " "
         | width <= 3 = T.take width text
         | otherwise = T.take (width - 3) text <> "..."
 
+-- | 把值转成可显示的文本
 displayValue :: Value -> Text
 displayValue VNull = "NULL"
 displayValue (VInt n) = T.pack (show n)

chusql-cli/src/ChuSQL/CLI/Script.hs

@@ -57,15 +57,18 @@ parseMeta raw = do
         "format" -> selectFormat argument
         other -> MetaUnknown other
   where
+    -- | 拼出切库命令
     connectTo argument
         | T.null argument = MetaUnknown "c"
         | otherwise = MetaConnect argument
+    -- | 解析格式参数
     selectFormat argument = maybe (MetaUnknown "format") MetaSetFormat (parseFormat argument)
 
--- | 取出第一条以分号结束的语句与后面的残余；字符串与注释里的分号不算
+-- | 取出第一条语句，忽略引号与注释里的分号
 takeStatement :: Text -> Maybe (Text, Text)
 takeStatement = go ScanNormal [] . T.unpack
   where
+    -- | 逐字符扫描语句边界
     go _ _ [] = Nothing
     go ScanNormal acc (';' : rest) = Just (T.strip (T.pack (reverse acc)), T.pack rest)
     go ScanNormal acc ('-' : '-' : rest) = go ScanLineComment ('-' : '-' : acc) rest

chusql-cli/src/ChuSQL/CLI/Session.hs

@@ -1,270 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
+module ChuSQL.CLI.Session (module ChuSQL.Interface.Session) where
 
-module ChuSQL.CLI.Session
-    ( QueryResult (..)
-    , Session
-    , newSession
-    , sessionUser
-    , sessionIsAdmin
-    , sessionDatabase
-    , isPlainIdentifier
-    , authenticateSession
-    , switchDatabase
-    , runStatement
-    , catalog
-    , accountTable
-    , roleViews
-    , databases
-    , queryResultJson
-    ) where
+import ChuSQL.Interface.Session
 
-import ChuSQL.Model (Value (..))
-import ChuSQL.Storage.IPC (TableInfo (..))
-import ChuSQL.Syntax.AST (Statement (..))
-import ChuSQL.Syntax.Parser (parseStatement)
-import ChuSQL.Web.Accounts
-import ChuSQL.Web.API (configurePasswordPolicy, systemTableInfo)
-import ChuSQL.Web.Auth (Credential, defaultSessionPolicy, newSessionStore)
-import ChuSQL.Web.Backend (Backend (..), StatementResult (..))
-import ChuSQL.Web.Privileges (PrivilegeCommand, PrivilegeError (..), Privileges, RoleView, authorize, filterTables, listRoleViews, newPrivileges, privilegeCommand, runPrivilegeCommand)
-import Data.Aeson (object, (.=))
-import qualified Data.Aeson as A
-import Data.Char (isAlpha, isAlphaNum)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Scientific (fromFloatDigits)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time.Clock (getCurrentTime)
-
--- CLI 会话：直接连存储与引擎，但账号服务与 Web 管理端是同一套
--- （同一个 root 凭据，同一张 __chusql_users）。
-
-data QueryResult = QueryResult
-    { qrColumns :: [Text]
-    , qrRows :: [[Value]]
-    , qrRowCount :: Int
-    , qrTruncated :: Bool
-    , qrDatabase :: Maybe Text
-    }
-    deriving (Eq, Show)
-
-data Session = Session
-    { ssBackend :: Backend
-    , ssAccounts :: Accounts
-    , ssPrivileges :: Privileges
-    , ssCurrent :: IORef Text
-    , ssPrincipal :: IORef (Maybe Principal)
-    }
-
--- | 开一个会话：账号与角色服务、配置策略都和 Web 端一致
-newSession :: Backend -> Credential -> FilePath -> IO Session
-newSession backend credential settingsFile = do
-    sessions <- newSessionStore getCurrentTime defaultSessionPolicy
-    accounts <- newAccounts backend sessions credential
-    privileges <- newPrivileges backend
-    configurePasswordPolicy accounts settingsFile
-    -- 服务启动后只有系统库：没 USE 之前不预设任何工作库
-    current <- newIORef ""
-    principal <- newIORef Nothing
-    pure (Session backend accounts privileges current principal)
-
--- | 当前登录的账号名
-sessionUser :: Session -> IO (Maybe Text)
-sessionUser session = fmap principalName <$> readIORef (ssPrincipal session)
-
--- | 是不是配置里的 root
-sessionIsAdmin :: Session -> IO Bool
-sessionIsAdmin session = maybe False principalIsRoot <$> readIORef (ssPrincipal session)
-
--- | 当前库
-sessionDatabase :: Session -> IO Text
-sessionDatabase = readIORef . ssCurrent
-
--- | 与解析器一致的裸标识符判断
-isPlainIdentifier :: Text -> Bool
-isPlainIdentifier name =
-    not (T.null name)
-        && T.length name <= 64
-        && (isAlpha (T.head name) || T.head name == '_')
-        && T.all (\ch -> isAlphaNum ch || ch == '_') name
-
--- | 登录：root 比配置里的凭据，普通账号查 __chusql_users
-authenticateSession :: Session -> Text -> Text -> IO (Either Text ())
-authenticateSession session user password = do
-    result <- authenticate (ssAccounts session) user password
-    case result of
-        Left err -> pure (Left (accountMessage err))
-        Right token -> do
-            who <- currentPrincipal (ssAccounts session) token
-            case who of
-                Left err -> pure (Left (accountMessage err))
-                Right principal -> do
-                    writeIORef (ssPrincipal session) (Just principal)
-                    pure (Right ())
-
--- | 换库；系统库只有 root 能进
-switchDatabase :: Session -> Text -> IO (Either Text ())
-switchDatabase session rawName
-    | not (isPlainIdentifier name) = pure (Left ("not a plain database name: " <> name))
-    | name == "system" = do
-        admin <- sessionIsAdmin session
-        if admin then go else pure (Left "the system database is only available to the administrator")
-    | otherwise = go
-  where
-    name = T.toLower (T.strip rawName)
-    go = do
-        backend <- currentBackend session
-        result <- beStatement backend ("USE " ++ T.unpack name)
-        case result of
-            Left err -> pure (Left (T.pack err))
-            Right _ -> writeIORef (ssCurrent session) name >> pure (Right ())
-
--- | 跑一条语句：USE、账号语句与角色语句在这里分流，其余交给引擎
--- （普通身份先过一遍权限判定，管理员与未登录直接放行）
-runStatement :: Session -> Text -> IO (Either Text QueryResult)
-runStatement session sql = case parseStatement (T.unpack sql) of
-    Right (UseDatabase name) -> do
-        switched <- switchDatabase session (T.pack name)
-        case switched of
-            Left err -> pure (Left err)
-            Right () -> do
-                current <- readIORef (ssCurrent session)
-                pure (Right (emptyResult (Just current)))
-    Right statement
-        | Just command <- accountCommand statement -> runAccount session command
-        | Just command <- privilegeCommand statement -> runPrivilege session command
-        | otherwise -> do
-            allowed <- authorized session statement
-            case allowed of
-                Left err -> pure (Left err)
-                Right () -> runPlain session sql
-    Left _ -> runPlain session sql
-
--- | 普通身份跑语句前的权限判定；管理员与未登录放行
-authorized :: Session -> Statement -> IO (Either Text ())
-authorized session statement = do
-    who <- readIORef (ssPrincipal session)
-    case who of
-        Just principal | not (principalIsRoot principal) -> do
-            database <- readIORef (ssCurrent session)
-            result <- authorize (ssPrivileges session) principal database statement
-            pure (either (Left . privilegeMessage) (const (Right ())) result)
-        _ -> pure (Right ())
-
--- | 落到引擎/存储层的一条语句
-runPlain :: Session -> Text -> IO (Either Text QueryResult)
-runPlain session sql = do
-    backend <- currentBackend session
-    result <- beStatement backend (T.unpack sql)
-    pure (either (Left . T.pack) (Right . resultOf) result)
-
--- | 数据字典（\dt 与 \d 用）；普通身份只看得到自己有 SELECT 的表
-catalog :: Session -> IO (Either Text [TableInfo])
-catalog session = do
-    current <- readIORef (ssCurrent session)
-    if T.null current
-        then pure (Left "no database selected")
-        else do
-            backend <- currentBackend session
-            result <- beCatalog backend
-            case result of
-                Left e -> pure (Left (T.pack e))
-                Right infos -> do
-                    who <- readIORef (ssPrincipal session)
-                    case who of
-                        Just principal | not (principalIsRoot principal) -> do
-                            allowed <- filterTables (ssPrivileges session) principal current (map (T.pack . tiTable) infos)
-                            pure (either (Left . privilegeMessage) (\names -> Right (filter (\info -> T.pack (tiTable info) `elem` names) infos)) allowed)
-                        _ -> pure (Right infos)
-
--- | 库清单（\l 用）
-databases :: Session -> IO (Either Text [Text])
-databases session = do
-    result <- beDatabases (ssBackend session)
-    pure (either (Left . T.pack) (Right . map T.pack) result)
-
--- | 系统库里的账号表：列定义与 Web 端共用一份，行数从同一套账号服务来
-accountTable :: Session -> IO (Maybe TableInfo)
-accountTable session = do
-    admin <- sessionIsAdmin session
-    if not admin
-        then pure Nothing
-        else do
-            result <- listAccounts (ssAccounts session)
-            pure (either (const Nothing) (\accounts -> Just systemTableInfo{tiRows = length accounts}) result)
-
--- | 角色总览（\dr 用）；与 Web 的 /api/roles 一样只给管理员
-roleViews :: Session -> IO (Either Text [RoleView])
-roleViews session = do
-    admin <- sessionIsAdmin session
-    if not admin
-        then pure (Left "administrator required")
-        else do
-            result <- listRoleViews (ssPrivileges session)
-            pure (either (Left . privilegeMessage) Right result)
-
--- | 当前库对应的后端
-currentBackend :: Session -> IO Backend
-currentBackend session = do
-    name <- readIORef (ssCurrent session)
-    pure (beWithDatabase (ssBackend session) (T.unpack name))
-
--- | 账号语句走账号服务，普通账号一律拒绝
-runAccount :: Session -> AccountCommand -> IO (Either Text QueryResult)
-runAccount session command = do
-    who <- readIORef (ssPrincipal session)
-    case who of
-        Nothing -> pure (Left "sign in first")
-        Just principal -> do
-            result <- runAccountCommand (ssAccounts session) principal command
-            pure (either (Left . accountMessage) (const (Right (emptyResult Nothing))) result)
-
--- | 角色语句走权限服务，普通账号一律拒绝；当前库决定授权对象的落库口径
-runPrivilege :: Session -> PrivilegeCommand -> IO (Either Text QueryResult)
-runPrivilege session command = do
-    who <- readIORef (ssPrincipal session)
-    case who of
-        Nothing -> pure (Left "sign in first")
-        Just principal -> do
-            database <- readIORef (ssCurrent session)
-            result <- runPrivilegeCommand (ssPrivileges session) principal database command
-            pure (either (Left . privilegeMessage) (const (Right (emptyResult Nothing))) result)
-
-accountMessage :: AccountError -> Text
-accountMessage (AccountError _ message) = message
-
-privilegeMessage :: PrivilegeError -> Text
-privilegeMessage (PrivilegeError _ message) = message
-
-emptyResult :: Maybe Text -> QueryResult
-emptyResult database = QueryResult [] [] 0 False database
-
-resultOf :: StatementResult -> QueryResult
-resultOf result =
-    QueryResult
-        { qrColumns = map T.pack (srColumns result)
-        , qrRows = [map (cellOf row) (srColumns result) | row <- srRows result]
-        , qrRowCount = length (srRows result)
-        , qrTruncated = False
-        , qrDatabase = Nothing
-        }
-  where
-    cellOf row name = maybe VNull id (lookup name row)
-
--- | 结果还原成 JSON（JSON 输出用）
-queryResultJson :: QueryResult -> A.Value
-queryResultJson result =
-    object
-        [ "columns" .= qrColumns result
-        , "rows" .= map (map valueToJson) (qrRows result)
-        , "rowCount" .= qrRowCount result
-        , "truncated" .= qrTruncated result
-        , "database" .= qrDatabase result
-        ]
-
-valueToJson :: Value -> A.Value
-valueToJson VNull = A.Null
-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
+-- 命令行会话：转出前端共享的会话接口，一切请求走 server。

chusql-cli/stack.yaml

@@ -1,6 +1,12 @@
 resolver: lts-24.59
 
+extra-lib-dirs:
+    - ../chusql-core/storage/target/release
+
 packages:
     - .
-    - ../chusql-engine
+    - ../chusql-core/engine
+    - ../chusql-server
     - ../chusql-web
+    - ../chusql-core/model
+    - ../chusql-interface

chusql-cli/test/Spec.hs

@@ -1,52 +1,31 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 
 module Main (main) where
 
 import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable)
 import ChuSQL.CLI.Script (Meta (..), errorHint, parseMeta, statementComplete, stripTerminator, takeStatement)
-import ChuSQL.CLI.Session (
-    QueryResult (..),
-    Session,
-    authenticateSession,
-    catalog,
-    databases,
-    newSession,
-    queryResultJson,
-    roleViews,
-    runStatement,
-    sessionDatabase,
-    sessionIsAdmin,
-    switchDatabase,
- )
-import ChuSQL.Model (Database, Table (..), Value (..), pattern TInt, pattern TStr)
-import ChuSQL.Storage.IPC (TableInfo (..))
-import ChuSQL.Web.Auth (Credential (..), hashPasswordWith)
-import ChuSQL.Web.Backend (memoryBackend)
-import ChuSQL.Web.Privileges (Grant (..), RoleView (..))
-import Control.Concurrent.MVar (newMVar)
+import ChuSQL.Core.Model (Value (..))
+import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
 import Data.Aeson (decode)
 import qualified Data.Aeson as A
-import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
-import Data.Either (isLeft, isRight)
-import Data.List (nub, sort)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Test.Hspec
 
--- chusql-cli 测试：输出格式、交互层纯逻辑与共享账号会话。
+-- chusql-cli 测试：只覆盖本前端的纯逻辑（输出格式、语句缓冲与元命令）。
 
+-- | 测试入口
 main :: IO ()
 main = hspec spec
 
+-- | 全部测试用例
 spec :: Spec
 spec = do
     formatSpec
     scriptSpec
-    sessionSpec
-    roleSpec
 
+-- | 输出格式的用例
 formatSpec :: Spec
 formatSpec = describe "CLI: output formats" $ do
     it "renders a boxed table and marks NULL" $
@@ -79,6 +58,7 @@ formatSpec = describe "CLI: output formats" $ do
         parseFormat "csv" `shouldBe` Just FormatCsv
         parseFormat "xml" `shouldBe` Nothing
 
+-- | 语句缓冲与元命令的用例
 scriptSpec :: Spec
 scriptSpec = do
     describe "CLI: statement buffering" $ do
@@ -117,114 +97,6 @@ scriptSpec = do
             parseMeta "\\nope" `shouldBe` Just (MetaUnknown "nope")
             parseMeta "\\f xml" `shouldBe` Just (MetaUnknown "format")
 
-sessionSpec :: Spec
-sessionSpec = describe "CLI: session over the shared account service" $ do
-    it "signs in as the configured administrator and refuses a wrong password" $ do
-        session <- cliSession
-        authenticateSession session "admin" "wrong-password" >>= \answer -> isLeft answer `shouldBe` True
-        authenticateSession session "admin" "s3cret" >>= \answer -> isRight answer `shouldBe` True
-    it "runs SQL straight through the engine" $ do
-        session <- cliSession
-        signInRoot session
-        result <- runStatement session "SELECT id, name FROM users ORDER BY id LIMIT 1"
-        fmap qrColumns result `shouldBe` Right ["id", "name"]
-        fmap qrRowCount result `shouldBe` Right 1
-    it "starts with nothing selected, lists what exists and refuses an unknown USE" $ do
-        session <- cliSession
-        authenticateSession session "admin" "s3cret" >>= (`shouldBe` Right ())
-        sessionDatabase session >>= (`shouldBe` "")
-        runStatement session "SELECT id FROM users" >>= \answer -> answer `shouldBe` Left "no database selected"
-        listed <- databases session
-        listed `shouldBe` Right ["test", "system"]
-        runStatement session "USE missing" >>= \answer -> isLeft answer `shouldBe` True
-        sessionDatabase session >>= (`shouldBe` "")
-        runStatement session "USE test" >>= \answer -> isRight answer `shouldBe` True
-        sessionDatabase session >>= (`shouldBe` "test")
-    it "keeps accounts on the same store and system administrator-only" $ do
-        session <- cliSession
-        signInRoot session
-        runStatement session "CREATE USER alice IDENTIFIED BY 'alice-password-1'" >>= \answer -> isRight answer `shouldBe` True
-        authenticateSession session "alice" "alice-password-1" >>= \answer -> isRight answer `shouldBe` True
-        sessionIsAdmin session >>= (`shouldBe` False)
-        switchDatabase session "system" >>= \answer -> isLeft answer `shouldBe` True
-        runStatement session "DROP USER admin" >>= \answer -> isLeft answer `shouldBe` True
-
-roleSpec :: Spec
-roleSpec = describe "CLI: roles and grants over the shared privilege service" $ do
-    it "runs role statements as the administrator and refuses them for anyone else" $ do
-        session <- cliSession
-        signInRoot session
-        created <- runStatement session "CREATE ROLE analyst"
-        isRight created `shouldBe` True
-        duplicate <- runStatement session "CREATE ROLE analyst"
-        duplicate `shouldBe` Left "role already exists: analyst"
-        granted <- runStatement session "GRANT SELECT ON users TO analyst"
-        isRight granted `shouldBe` True
-        tallied <- runStatement session "GRANT SELECT, INSERT, UPDATE, DELETE ON users TO analyst"
-        isRight tallied `shouldBe` True
-        views <- roleViews session
-        fmap (map roleName) views `shouldBe` Right ["analyst"]
-        fmap (sort . nub . concatMap (map grantPrivilege . roleGrants)) views `shouldBe` Right ["delete", "insert", "select", "update"]
-        fmap (sort . nub . concatMap (map grantObject . roleGrants)) views `shouldBe` Right ["test.users"]
-        unknown <- runStatement session "GRANT SELECT ON users TO nobody"
-        unknown `shouldBe` Left "unknown role: nobody"
-        dropped <- runStatement session "DROP ROLE analyst"
-        isRight dropped `shouldBe` True
-        missing <- runStatement session "GRANT SELECT ON users TO analyst"
-        missing `shouldBe` Left "unknown role: analyst"
-    it "an ordinary account only gets what a grant allows" $ do
-        session <- cliSession
-        signInRoot session
-        runStatement session "CREATE TABLE secrets (id INT)" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "CREATE ROLE reader" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "GRANT SELECT ON users TO reader" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "CREATE USER bob IDENTIFIED BY 'bob-password-1'" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "GRANT reader TO bob" >>= \answer -> isRight answer `shouldBe` True
-        authenticateSession session "bob" "bob-password-1" >>= \answer -> isRight answer `shouldBe` True
-        granted <- runStatement session "SELECT id, name FROM users"
-        fmap qrRowCount granted `shouldBe` Right 3
-        refused <- runStatement session "SELECT id FROM secrets"
-        refused `shouldBe` Left "permission denied: SELECT ON secrets"
-        write <- runStatement session "INSERT INTO users (id, name) VALUES (4, 'four')"
-        write `shouldBe` Left "permission denied: INSERT ON users"
-        admin <- runStatement session "CREATE ROLE other"
-        admin `shouldBe` Left "administrator required"
-        listed <- catalog session
-        fmap (map tiTable) listed `shouldBe` Right ["users"]
-        hidden <- roleViews session
-        hidden `shouldBe` Left "administrator required"
-    it "revoking the membership closes the door again" $ do
-        session <- cliSession
-        signInRoot session
-        runStatement session "CREATE ROLE guest" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "GRANT SELECT ON users TO guest" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "CREATE USER carol IDENTIFIED BY 'carol-password-1'" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "GRANT guest TO carol" >>= \answer -> isRight answer `shouldBe` True
-        roster <- roleViews session
-        fmap (concatMap roleMembers) roster `shouldBe` Right ["carol"]
-        authenticateSession session "carol" "carol-password-1" >>= \answer -> isRight answer `shouldBe` True
-        runStatement session "SELECT id FROM users" >>= \answer -> isRight answer `shouldBe` True
-        signInRoot session
-        runStatement session "REVOKE guest FROM carol" >>= \answer -> isRight answer `shouldBe` True
-        authenticateSession session "carol" "carol-password-1" >>= \answer -> isRight answer `shouldBe` True
-        refused <- runStatement session "SELECT id FROM users"
-        refused `shouldBe` Left "permission denied: SELECT ON users"
-
-cliSession :: IO Session
-cliSession = do
-    db <- newMVar testDb
-    newSession (memoryBackend testDatabaseName db) testCredential "chusql-test-missing.settings.json"
-
--- | 夹具库名：服务不再有默认库，这个库要显式选
-testDatabaseName :: String
-testDatabaseName = "test"
-
--- | 登录管理员并选中夹具库（未选库时连表名都解析不了）
-signInRoot :: Session -> Expectation
-signInRoot session = do
-    authenticateSession session "admin" "s3cret" >>= (`shouldBe` Right ())
-    switchDatabase session (T.pack testDatabaseName) >>= (`shouldBe` Right ())
-
 sampleResult :: QueryResult
 sampleResult =
     QueryResult
@@ -234,18 +106,3 @@ sampleResult =
         , qrTruncated = False
         , qrDatabase = Nothing
         }
-
--- | 测试库：三行 users
-testDb :: Database
-testDb =
-    [ ( "users"
-      , Table
-            "users"
-            [("id", TInt), ("name", TStr)]
-            [[("id", VInt i), ("name", VStr ("user" ++ show i))] | i <- [1 .. 3]]
-      )
-    ]
-
--- | 测试账号：迭代次数压低（跑得快），口令 `s3cret`
-testCredential :: Credential
-testCredential = Credential "admin" (hashPasswordWith 1000 (BS.replicate 16 7) "s3cret")