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

2026-10-02 15:07:38 +08:00
1 parent df6d348995
commit 9758439b82
@@ -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")