v26.10.2 修复bug，简化项目

chusql-core/engine/src/ChuSQL/Core/Engine.hs

@@ -32,10 +32,10 @@ runStatementM (DropDatabase name) = fmap (fmap (const [])) (dropDatabase name)
 runStatementM (UseDatabase name) = fmap (fmap (const [])) (useDatabase name)
 runStatementM ShowDatabases = fmap (fmap (map (\name -> [("database", VStr name)]))) listDatabases
 runStatementM q = do
-    db <- schema
-    case prepare db q of
+    result <- schema
+    case result >>= \db -> (,) db <$> prepare db q of
         Left err -> pure (Left err)
-        Right resolved -> runStatementUncheckedM db resolved
+        Right (db, resolved) -> runStatementUncheckedM db resolved
 
 -- | 按语句类型分发（已检查过）
 runStatementUncheckedM :: (MonadStorage m) => Database -> Statement -> m (Either String [Row])

chusql-core/engine/src/ChuSQL/Core/Engine/Parallel.hs

@@ -6,8 +6,10 @@ module ChuSQL.Core.Engine.Parallel (
 ) where
 
 import Control.Concurrent (forkIO)
-import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, takeMVar)
+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
+import Control.Concurrent.MVar (MVar, modifyMVar, newEmptyMVar, newMVar, putMVar, takeMVar)
 import Control.Exception (SomeException, throwIO, try)
+import Control.Monad (forever)
 import System.IO.Unsafe (unsafePerformIO)
 
 -- 并行执行：常驻工作线程池，结果按提交顺序收回。
@@ -16,11 +18,8 @@ import System.IO.Unsafe (unsafePerformIO)
 parallelShardLimit :: Int
 parallelShardLimit = 8
 
--- | 池：待办队列与唤醒信号
-data Pool = Pool
-    { poolJobs :: MVar [IO ()]
-    , poolReady :: MVar ()
-    }
+-- | 池：工作线程共享的待办队列
+newtype Pool = Pool (Chan (IO ()))
 
 {-# NOINLINE poolRef #-}
 -- | 进程全局的池，按容量复用
@@ -31,11 +30,14 @@ poolRef = unsafePerformIO (newMVar Nothing)
 workerPool :: Int -> IO Pool
 workerPool size = modifyMVar poolRef reuse
   where
-    -- | 现有池够大就留着，否则换新的
+    -- | 复用队列并按需补充工作线程
     reuse current = case current of
-        Just (capacity, pool)
+        Just (capacity, pool@(Pool jobs))
             | capacity >= wanted -> pure (current, pool)
-        _ -> do
+            | otherwise -> do
+                sequence_ [forkIO (worker jobs) | _ <- [capacity + 1 .. wanted]]
+                pure (Just (wanted, pool), pool)
+        Nothing -> do
             pool <- startPool wanted
             pure (Just (wanted, pool), pool)
 
@@ -44,29 +46,17 @@ workerPool size = modifyMVar poolRef reuse
 
     -- | 起 wanted 个常驻线程吃队列
     startPool n = do
-        jobs <- newMVar []
-        ready <- newMVar ()
-        sequence_ [forkIO (worker jobs ready) | _ <- [1 .. n]]
-        pure (Pool jobs ready)
+        jobs <- newChan
+        sequence_ [forkIO (worker jobs) | _ <- [1 .. n]]
+        pure (Pool jobs)
 
--- | 一个工作线程：被唤醒一次就取一个待办
-worker :: MVar [IO ()] -> MVar () -> IO ()
-worker jobs ready = do
-    takeMVar ready
-    job <- modifyMVar jobs pick
-    case job of
-        Nothing -> worker jobs ready
-        Just act -> act >> worker jobs ready
-  where
-    -- | 取队首，空队列就回 Nothing
-    pick [] = pure ([], Nothing)
-    pick (j : js) = pure (js, Just j)
+-- | 一个工作线程：等待并执行队首待办
+worker :: Chan (IO ()) -> IO ()
+worker jobs = forever (readChan jobs >>= id)
 
 -- | 往池里丢一个待办
 submit :: Pool -> IO () -> IO ()
-submit pool job = do
-    modifyMVar_ (poolJobs pool) (pure . (++ [job]))
-    putMVar (poolReady pool) ()
+submit (Pool jobs) = writeChan jobs
 
 -- | 跑一个动作，结果或异常都填进格子
 fillCell :: MVar (Either SomeException a) -> IO a -> IO ()

chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Functions.hs

@@ -32,12 +32,7 @@ builtinFunctions types = do
 
 -- | 按名称和完整参数类型解析函数
 resolveFunction :: FunctionRegistry -> String -> [TypeId] -> Either String FunctionSignature
-resolveFunction (FunctionRegistry functions) name arguments =
-    case [sig | (sig, _) <- functions, map toLower (signatureName sig) == map toLower name
-              , signatureArguments sig == arguments] of
-        [sig] -> Right sig
-        [] -> Left ("no matching function signature: " ++ name)
-        _ -> Left ("ambiguous function signature: " ++ name)
+resolveFunction registry name arguments = resolveNullableFunction registry name (map Just arguments)
 
 -- | 按可空 SQL 参数解析确定签名
 resolveNullableFunction :: FunctionRegistry -> String -> [Maybe TypeId] -> Either String FunctionSignature

chusql-core/engine/src/ChuSQL/Core/Engine/Storage.hs

@@ -108,11 +108,11 @@ class (Monad m) => MonadStorage m where
     replaceSchema :: String -> [(String, Column)] -> [Row] -> m (Either String ())
 
     -- \| 取全库快照（表名 + 列 + 全部行）
-    snapshot :: m Database
+    snapshot :: m (Either String Database)
 
     -- \| 取全库结构：只要表名和列，不要行
-    schema :: m Database
-    schema = fmap (map withoutRows) snapshot
+    schema :: m (Either String Database)
+    schema = fmap (fmap (map withoutRows)) snapshot
       where
         -- | 表定义去掉所有行
         withoutRows (name, t) = (name, t {tableRows = []})

chusql-core/engine/src/ChuSQL/Core/Engine/Storage/FFI.hs

@@ -10,7 +10,8 @@ module ChuSQL.Core.Engine.Storage.FFI (
     maintainStorage,
 ) where
 
-import Control.Exception (SomeException, try)
+import Control.Concurrent (rtsSupportsBoundThreads, runInBoundThread)
+import Control.Exception (SomeException, finally, mask_, try)
 import Data.ByteString qualified as BS
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
@@ -19,6 +20,7 @@ import Foreign
 import Foreign.C
 
 -- Rust 存储库 cdylib 的 C ABI 绑定（ffi.rs），收发单行 JSON。
+-- 错误读取绑定同一 OS 线程；响应复制期间屏蔽取消并归还缓冲。
 
 -- | 存储实例句柄（Rust 侧的 *mut Storage）
 newtype StorageHandle = StorageHandle (Ptr ())
@@ -46,15 +48,8 @@ foreign import ccall safe "chusql_storage_maintenance"
 
 -- | 离线修复系统目录并返回结果
 maintainStorage :: FilePath -> BS.ByteString -> IO (Either String BS.ByteString)
-maintainStorage path payload = withCString path $ \config ->
-    BS.useAsCStringLen payload $ \(input, size) -> alloca $ \outRef -> alloca $ \lenRef -> do
-        code <- cStorageMaintenance config input (fromIntegral size) outRef lenRef
-        if code /= 0 then Left <$> lastError else do
-            output <- peek outRef
-            len <- peek lenRef
-            bytes <- BS.packCStringLen (output, fromIntegral len)
-            cStorageFree output len
-            pure (Right bytes)
+maintainStorage path payload = BS.useAsCString (TE.encodeUtf8 (T.pack path)) $ \config ->
+    callStorage (cStorageMaintenance config) payload
 
 -- | 库版本（Rust 侧的 CARGO_PKG_VERSION）
 storageVersion :: IO String
@@ -62,7 +57,7 @@ storageVersion = cStorageVersion >>= peekCString
 
 -- | 打开存储实例，失败给错误文本
 openStorage :: Maybe FilePath -> IO (Either String StorageHandle)
-openStorage path = do
+openStorage path = onStorageThread $ mask_ $ do
     result <- try (withCStringOrNull path cStorageOpen) :: IO (Either SomeException (Ptr ()))
     case result of
         Left e -> pure (Left ("storage library call failed: " ++ show e))
@@ -72,7 +67,7 @@ openStorage path = do
   where
     -- | 没有路径就传空指针，否则转成 C 字符串
     withCStringOrNull Nothing f = f nullPtr
-    withCStringOrNull (Just s) f = withCString s f
+    withCStringOrNull (Just s) f = BS.useAsCString (TE.encodeUtf8 (T.pack s)) f
 
 -- | 关掉存储实例
 closeStorage :: StorageHandle -> IO ()
@@ -80,19 +75,25 @@ closeStorage (StorageHandle handle) = cStorageClose handle
 
 -- | 一条 JSON 请求换一条 JSON 响应
 storageRequest :: StorageHandle -> BS.ByteString -> IO (Either String BS.ByteString)
-storageRequest (StorageHandle handle) payload =
-    BS.useAsCStringLen payload $ \(inPtr, inLen) ->
-        alloca $ \outPtrRef ->
-            alloca $ \outLenRef -> do
-                code <- cStorageRequest handle (castPtr inPtr) (fromIntegral inLen) outPtrRef outLenRef
-                if code /= 0
-                    then Left <$> lastError
-                    else do
-                        outPtr <- peek outPtrRef
-                        outLen <- peek outLenRef
-                        bytes <- BS.packCStringLen (castPtr outPtr, fromIntegral outLen)
-                        cStorageFree outPtr outLen
-                        pure (Right bytes)
+storageRequest (StorageHandle handle) = callStorage (cStorageRequest handle)
+
+-- | 调用存储并复制和归还响应缓冲
+callStorage :: (Ptr CChar -> CSize -> Ptr (Ptr CChar) -> Ptr CSize -> IO CInt)
+    -> BS.ByteString -> IO (Either String BS.ByteString)
+callStorage call payload = onStorageThread $ mask_ $
+    BS.useAsCStringLen payload $ \(input, size) ->
+        alloca $ \outRef -> alloca $ \lenRef -> do
+            code <- call input (fromIntegral size) outRef lenRef
+            if code /= 0 then Left <$> lastError else do
+                output <- peek outRef
+                len <- peek lenRef
+                bytes <- BS.packCStringLen (output, fromIntegral len)
+                    `finally` cStorageFree output len
+                pure (Right bytes)
+
+-- | 多线程运行时绑定存储调用线程
+onStorageThread :: IO a -> IO a
+onStorageThread = if rtsSupportsBoundThreads then runInBoundThread else id
 
 -- | 当前线程最近一次失败的文本
 lastError :: IO String

chusql-core/engine/src/ChuSQL/Core/Engine/Storage/IPC.hs

@@ -36,7 +36,8 @@ import ChuSQL.Core.Engine.Parallel (parallelShardLimit, poolRun, workerPool)
 import ChuSQL.Core.Engine.Storage
 import ChuSQL.Core.Engine.Storage.FFI (closeStorage, openStorage, storageRequest)
 import Control.Concurrent (getNumCapabilities)
-import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
+import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, putMVar, readMVar, takeMVar, withMVar)
+import Control.Exception (bracket, mask_)
 import Data.Aeson (eitherDecodeStrict, encode)
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BL
@@ -89,9 +90,33 @@ data StorageLink = StorageLink
 linkRef :: MVar (Maybe StorageLink)
 linkRef = unsafePerformIO (newMVar Nothing)
 
+{-# NOINLINE linkUsers #-}
+-- | 在途请求计数与空闲信号
+linkUsers :: (MVar Int, MVar ())
+linkUsers = unsafePerformIO $ (,) <$> newMVar 0 <*> newMVar ()
+
+-- | 登记请求并在结束时释放链路占用
+withStorageLink :: (Maybe StorageLink -> IO a) -> IO a
+withStorageLink = bracket enter leave
+  where
+    (users, idle) = linkUsers
+    -- | 登记当前链路的在途请求
+    enter = withMVar linkRef $ \current -> do
+        case current of
+            Nothing -> pure ()
+            Just _ -> modifyMVar_ users $ \count -> do
+                if count == 0 then takeMVar idle else pure ()
+                pure (count + 1)
+        pure current
+    -- | 最后一个请求结束后发出空闲信号
+    leave Nothing = pure ()
+    leave (Just _) = mask_ $ modifyMVar_ users $ \count -> do
+        if count == 1 then putMVar idle () else pure ()
+        pure (count - 1)
+
 -- | 装入一条链路；一个进程只装一次
 setStorageLink :: StorageLink -> IO ()
-setStorageLink link = modifyMVar_ linkRef (const (pure (Just link)))
+setStorageLink link = modifyMVar_ linkRef $ \_ -> withMVar (snd linkUsers) (const (pure (Just link)))
 
 -- | 打开本地的存储动态库，得到一条链路
 localStorageLink :: Maybe FilePath -> IO (Either String StorageLink)
@@ -106,7 +131,7 @@ localStorageLink path = fmap (fmap toLink) (openStorage path)
 
 -- | 关掉当前链路（进程退出前调用）；没有链路就什么都不做
 closeConnection :: IO ()
-closeConnection = modifyMVar_ linkRef $ \current -> do
+closeConnection = modifyMVar_ linkRef $ \current -> withMVar (snd linkUsers) $ \_ -> do
     case current of
         Nothing -> pure ()
         Just link -> slClose link
@@ -114,22 +139,19 @@ closeConnection = modifyMVar_ linkRef $ \current -> do
 
 -- | 发一条请求并解码应答；链路没装就报错，不崩
 sendRequest :: Request -> IO Response
-sendRequest req = do
-    current <- readMVar linkRef
-    case current of
-        Nothing -> pure (RespError "storage not configured")
-        Just link -> do
-            raw <- slRequest link (BL.toStrict (encode req))
-            case raw of
-                Left e -> pure (RespError ("storage error: " ++ e))
-                Right bytes -> case eitherDecodeStrict (BS.dropWhileEnd (== 13) bytes) of
-                    Left e -> pure (RespError ("decode error: " ++ e))
-                    Right resp -> pure resp
+sendRequest req = withStorageLink $ \current -> case current of
+    Nothing -> pure (RespError "storage not configured")
+    Just link -> do
+        raw <- slRequest link (BL.toStrict (encode req))
+        case raw of
+            Left e -> pure (RespError ("storage error: " ++ e))
+            Right bytes -> case eitherDecodeStrict (BS.dropWhileEnd (== 13) bytes) of
+                Left e -> pure (RespError ("decode error: " ++ e))
+                Right resp -> pure resp
 
 -- | 原样转发一条载荷给存储库
 sendRawRequest :: BS.ByteString -> IO (Either String BS.ByteString)
-sendRawRequest payload = do
-    current <- readMVar linkRef
+sendRawRequest payload = withStorageLink $ \current -> do
     case current of
         Nothing -> pure (Left "storage not configured")
         Just link -> slRequest link payload
@@ -212,10 +234,6 @@ doInsertMany env t rs = ask env "insert_batch" (ReqInsertBatch t rs) okOnly
 doDeleteKeys :: Env -> String -> [Int] -> IO (Either String ())
 doDeleteKeys env t ks = ask env "delete_keys" (ReqDeleteKeys t ks) okOnly
 
--- | 发 ReplaceAll
-doReplaceAll :: Env -> String -> [Row] -> IO (Either String ())
-doReplaceAll env t rs = ask env "replace_all" (ReqReplaceAll t rs) okOnly
-
 -- | 发 ListTables
 doListTables :: Env -> IO (Either String [String])
 doListTables env = ask env "list_tables" ReqListTables $ \resp -> case resp of
@@ -254,26 +272,6 @@ doDescribeTable env t = ask env "describe_table" (ReqDescribeTable t) $ \resp ->
     RespSchema info -> Just info
     _ -> Nothing
 
--- | 给某一列建索引
-doCreateIndex :: Env -> String -> String -> IO (Either String ())
-doCreateIndex env t c = ask env "create_index" (ReqCreateIndex t c) okOnly
-
--- | 去掉某一列的索引
-doDropIndex :: Env -> String -> String -> IO (Either String ())
-doDropIndex env t c = ask env "drop_index" (ReqDropIndex t c) okOnly
-
--- | 删一列（列定义、这一列上的索引、每行里的那一格一起没）
-doDropColumn :: Env -> String -> String -> IO (Either String ())
-doDropColumn env t c = ask env "drop_column" (ReqDropColumn t c) okOnly
-
--- | 发 ReplaceSchema（ALTER 用）
-doReplaceSchema :: Env -> String -> [SchemaColumn] -> [Row] -> IO (Either String ())
-doReplaceSchema env t cols rs = ask env "replace_schema" (ReqReplaceSchema t cols rs) okOnly
-
--- | 发 CreateTable
-doCreateTable :: Env -> String -> [SchemaColumn] -> IO (Either String ())
-doCreateTable env t cols = ask env "create_table" (ReqCreateTable t cols) okOnly
-
 -- | 发 DropTable
 doDropTable :: Env -> String -> IO (Either String ())
 doDropTable env t = ask env "drop_table" (ReqDropTable t) okOnly
@@ -350,7 +348,7 @@ instance MonadStorage IPCStorage where
     deleteKeys t ks = IPCStorage (\env -> doDeleteKeys env t ks)
 
     -- \| 发 ReplaceAll
-    replaceAll t rs = IPCStorage (\env -> doReplaceAll env t rs)
+    replaceAll t rs = IPCStorage $ \env -> ask env "replace_all" (ReqReplaceAll t rs) okOnly
 
     -- \| 按某一列的索引取一行（没有索引就回 NoIndex）
     lookupByColumn t c k = IPCStorage (\env -> doLookupByColumn env t c k)
@@ -359,45 +357,44 @@ instance MonadStorage IPCStorage where
     scanRange t c lo hi = IPCStorage (\env -> doScanRange env t c lo hi)
 
     -- \| 发 CreateTable
-    createTable name cols = IPCStorage (\env -> doCreateTable env name (map toWire cols))
+    createTable name cols = IPCStorage $ \env -> ask env "create_table" (ReqCreateTable name (map toWire cols)) okOnly
 
     -- \| ALTER：整表换列定义与全部行
-    replaceSchema name cols rows = IPCStorage (\env -> doReplaceSchema env name (map toWire cols) rows)
+    replaceSchema name cols rows = IPCStorage $ \env -> ask env "replace_schema" (ReqReplaceSchema name (map toWire cols) rows) okOnly
 
     -- \| 发 DropTable
     dropTable name = IPCStorage (\env -> doDropTable env name)
 
     -- \| 建索引
-    createIndex t c = IPCStorage (\env -> doCreateIndex env t c)
+    createIndex t c = IPCStorage $ \env -> ask env "create_index" (ReqCreateIndex t c) okOnly
 
     -- \| 删索引
-    dropIndex t c = IPCStorage (\env -> doDropIndex env t c)
+    dropIndex t c = IPCStorage $ \env -> ask env "drop_index" (ReqDropIndex t c) okOnly
 
     -- \| 删一列
-    dropColumn t c = IPCStorage (\env -> doDropColumn env t c)
+    dropColumn t c = IPCStorage $ \env -> ask env "drop_column" (ReqDropColumn t c) okOnly
 
     -- \| 列表 + 逐表扫描拼库
     snapshot = IPCStorage $ \env -> do
         result <- doListCatalog env
         case result of
-            Left _ -> pure []
-            Right xs -> mapM (loadEntry env) xs
+            Left err -> pure (Left err)
+            Right xs -> fmap sequence (mapM (loadEntry env) xs)
       where
+        -- | 读取表数据并保留扫描错误
         loadEntry env info = do
             rows <- doScan env (tiTable info)
-            pure
+            pure $ fmap (\rs ->
                 ( tiTable info
-                , Table (tiTable info) (schemaToColumns (tiColumns info)) (either (const []) id rows) (Just (metaOf info))
-                )
+                , Table (tiTable info) (schemaToColumns (tiColumns info)) rs (Just (metaOf info))
+                )) rows
 
     -- \| 只问数据字典要结构，设了当前库只留它的表
     schema = IPCStorage $ \env -> do
         result <- ask env "all_catalogs" ReqAllCatalog $ \resp -> case resp of
             RespCatalog infos -> Just infos
             _ -> Nothing
-        pure $ case result of
-            Left _ -> []
-            Right xs -> concatMap (visibleTables (envDatabase env)) xs
+        pure (fmap (concatMap (visibleTables (envDatabase env))) result)
 
 -- | 线上表信息转引擎侧统计
 metaOf :: TableInfo -> TableMeta

chusql-core/engine/src/ChuSQL/Core/Engine/Storage/Memory.hs

@@ -73,10 +73,10 @@ instance MonadStorage MemoryStorage where
                             )
 
     -- \| 原样返回当前库
-    snapshot = MemoryStorage $ \db -> Right (db, db)
+    snapshot = MemoryStorage $ \db -> Right (Right db, db)
 
     -- \| 返回实时行数与去重统计的无数据结构
-    schema = MemoryStorage $ \db -> Right (map describe db, db)
+    schema = MemoryStorage $ \db -> Right (Right (map describe db), db)
       where
         -- | 将存储数据汇总为结构统计
         describe (name, table) =

chusql-core/engine/test/NormalizationSpec.hs

@@ -26,22 +26,20 @@ spec = do
             fmap (map verdict . findings) (analyzeNormalization schema
                 (Declaration [["a", "b"]] [Dependency ["a"] ["c"]] True (Just True)))
                 `shouldBe` Right [Satisfied, Violated, Violated, Violated]
-        it "detects transitive dependencies" $ do
-            fmap (map verdict . findings) (analyzeNormalization schema
-                (Declaration [["a"]] [Dependency ["b"] ["c"]] True (Just True)))
+        it "detects transitive dependencies and a preserving split" $ do
+            let analysis = analyzeNormalization schema
+                    (Declaration [["a"]] [Dependency ["b"] ["c"]] True (Just True))
+            fmap (map verdict . findings) analysis
                 `shouldBe` Right [Satisfied, Satisfied, Violated, Violated]
-        it "distinguishes 3NF from BCNF using all candidate keys" $ do
-            fmap (map verdict . findings) (analyzeNormalization schema
-                (Declaration [["a", "b"]] [Dependency ["c"] ["b"]] True (Just True)))
-                `shouldBe` Right [Satisfied, Satisfied, Satisfied, Violated]
-        it "reports lossless decomposition that loses dependencies" $ do
-            fmap suggestions (analyzeNormalization schema
-                (Declaration [["a", "b"]] [Dependency ["c"] ["b"]] True (Just True)))
-                `shouldBe` Right [Decomposition [["b", "c"], ["a", "c"]] Satisfied Violated]
-        it "reports dependency preserving transitive split" $ do
-            fmap suggestions (analyzeNormalization schema
-                (Declaration [["a"]] [Dependency ["b"] ["c"]] True (Just True)))
+            fmap suggestions analysis
                 `shouldBe` Right [Decomposition [["b", "c"], ["a", "b"]] Satisfied Satisfied]
+        it "distinguishes 3NF from BCNF and detects dependency loss" $ do
+            let analysis = analyzeNormalization schema
+                    (Declaration [["a", "b"]] [Dependency ["c"] ["b"]] True (Just True))
+            fmap (map verdict . findings) analysis
+                `shouldBe` Right [Satisfied, Satisfied, Satisfied, Violated]
+            fmap suggestions analysis
+                `shouldBe` Right [Decomposition [["b", "c"], ["a", "c"]] Satisfied Violated]
         it "does not certify incomplete dependencies" $ do
             fmap (map verdict . findings) (analyzeNormalization schema
                 (Declaration [["a"]] [] False (Just True)))

chusql-core/engine/test/RuntimeSpec.hs

@@ -29,7 +29,6 @@ spec = do
             parseTypeExpr "MaybeInt" `shouldSatisfy` isFailure
         it "restores stable nested identities from bootstrap metadata" $ do
             let ty = tupleType [listType intType, maybeType stringType]
-            resolveType builtinTypes ty `shouldBe` resolveType builtinTypes ty
             fmap descriptorPhysical (resolveType builtinTypes ty)
                 `shouldBe` Right (Product [Sequence SignedInteger, Optional Utf8])
         it "distinguishes logical String from List Int" $

chusql-core/engine/test/Spec.hs

@@ -17,17 +17,23 @@ import ChuSQL.Core.Model
 import ChuSQL.Core.Engine.Semantic (prepare)
 import ChuSQL.Core.Engine.Storage (IndexResult (..), MonadStorage (..))
 import ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage))
-import ChuSQL.Core.Engine.Storage.IPC (IPCStorage (..), closeConnection, defaultEnv, doListTables, envForDatabase, getDatabaseName, localStorageLink, runIPCStorage, setDatabaseName, setStorageLink)
+import ChuSQL.Core.Engine.Storage.FFI (closeStorage, maintainStorage, openStorage)
+import ChuSQL.Core.Engine.Storage.IPC (IPCStorage (..), StorageLink (..), closeConnection, defaultEnv, doListTables, envForDatabase, getDatabaseName, localStorageLink, runIPCStorage, sendRawRequest, setDatabaseName, setStorageLink)
 import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Engine.Syntax.Parser
-import Control.Concurrent (threadDelay)
-import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
-import Control.Exception (ErrorCall, IOException, finally, try)
+import Control.Concurrent (forkFinally, forkIO, killThread, threadDelay)
+import Control.Concurrent.Chan (newChan, readChan, writeChan)
+import Control.Concurrent.MVar (MVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar, tryPutMVar)
+import Control.Monad (replicateM_, void)
+import Control.Exception (ErrorCall, IOException, bracket_, finally, try)
 import Data.Hashable (hash)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
 import Data.List (isInfixOf, sortOn)
 import Data.Unique (hashUnique, newUnique)
+import GHC.IO.Encoding (getForeignEncoding, latin1, setForeignEncoding)
 import System.CPUTime (getCPUTime)
-import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removePathForcibly)
+import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removePathForcibly, renameFile)
 import System.FilePath ((</>))
 import System.Timeout (timeout)
 import Test.Hspec
@@ -118,6 +124,81 @@ domainSql db (sql : rest) = do
 -- | 跑引擎层全部 hspec 用例
 main :: IO ()
 main = hspec $ do
+    describe "Storage read failures" $ do
+        it "propagates catalog failures through snapshot, schema and SQL" $ do
+            setStorageLink StorageLink
+                { slRequest = \_ -> pure (Right (BSC.pack "{\"status\":\"error\",\"message\":\"catalog unavailable\"}"))
+                , slClose = pure ()
+                }
+            flip finally closeConnection $ do
+                fmap (fmap (map fst)) (runIPCStorage snapshot) `shouldReturn` Left "catalog unavailable"
+                fmap (fmap (map fst)) (runIPCStorage schema) `shouldReturn` Left "catalog unavailable"
+                runIPCStorage (runStatementM (CreateTable "blocked" [("id", TInt)]))
+                    `shouldReturn` Left "catalog unavailable"
+
+        it "rejects the entire snapshot when a table scan fails" $ do
+            setStorageLink StorageLink
+                { slRequest = \payload -> pure $ Right $ BSC.pack $
+                    if BSC.pack "list_catalog" `BS.isInfixOf` payload
+                        then "{\"status\":\"catalog\",\"schemas\":[{\"table\":\"broken\",\"columns\":[],\"row_count\":1}]}"
+                        else "{\"status\":\"error\",\"message\":\"data page unreadable\"}"
+                , slClose = pure ()
+                }
+            (fmap (fmap (map fst)) (runIPCStorage snapshot) `shouldReturn` Left "data page unreadable") `finally` closeConnection
+
+    describe "Storage lifecycle and cancellation" $ do
+        it "waits for concurrent requests before closing the storage link" $ do
+            started <- newChan
+            release <- newEmptyMVar
+            finished <- newChan
+            closing <- newEmptyMVar
+            closed <- newEmptyMVar
+            setStorageLink StorageLink
+                { slRequest = \_ -> writeChan started () >> readMVar release >> pure (Right BS.empty)
+                , slClose = putMVar closed ()
+                }
+            flip finally (void (tryPutMVar release ()) >> closeConnection) $ do
+                replicateM_ 2 (void (forkIO (sendRawRequest BS.empty >>= writeChan finished)))
+                timeout 1000000 (replicateM_ 2 (readChan started)) `shouldReturn` Just ()
+                void (forkIO (putMVar closing () >> closeConnection))
+                takeMVar closing
+                timeout 100000 (readMVar closed) `shouldReturn` Nothing
+                putMVar release ()
+                replicateM_ 2 (timeout 1000000 (readChan finished) `shouldReturn` Just (Right BS.empty))
+                timeout 1000000 (readMVar closed) `shouldReturn` Just ()
+                sendRawRequest BS.empty `shouldReturn` Left "storage not configured"
+                closeConnection
+
+        it "keeps the pool usable after cancellation while all workers are busy" $ do
+            pool <- workerPool 4
+            started <- newChan
+            release <- newEmptyMVar
+            finished <- newEmptyMVar
+            void (forkIO (poolRun pool (replicate 4 (writeChan started () >> readMVar release)) >> putMVar finished ()))
+            flip finally (void (tryPutMVar release ())) $ do
+                timeout 1000000 (replicateM_ 4 (readChan started)) `shouldReturn` Just ()
+                replicateM_ 2 (timeout 100000 (poolRun pool (replicate 3 (pure ()))) `shouldReturn` Nothing)
+                putMVar release ()
+                timeout 1000000 (takeMVar finished) `shouldReturn` Just ()
+                timeout 1000000 (poolRun pool [pure ()]) `shouldReturn` Just [()]
+
+        it "releases the storage link when an in-flight request is cancelled" $ do
+            started <- newEmptyMVar
+            release <- newEmptyMVar
+            finished <- newEmptyMVar
+            closed <- newEmptyMVar
+            setStorageLink StorageLink
+                { slRequest = \_ -> putMVar started () >> takeMVar release >> pure (Right BS.empty)
+                , slClose = putMVar closed ()
+                }
+            thread <- forkFinally (sendRawRequest BS.empty) (const (putMVar finished ()))
+            flip finally (killThread thread >> closeConnection) $ do
+                timeout 1000000 (takeMVar started) `shouldReturn` Just ()
+                killThread thread
+                timeout 1000000 (takeMVar finished) `shouldReturn` Just ()
+                timeout 1000000 closeConnection `shouldReturn` Just ()
+                readMVar closed `shouldReturn` ()
+
     NormalizationSpec.spec
     RuntimeSpec.spec
     describe "identity syntax" $ do
@@ -1772,9 +1853,10 @@ main = hspec $ do
             sameResultAsUnoptimized "SELECT d.name FROM (SELECT name, age FROM users) d WHERE d.age > 20 ORDER BY d.name"
 
         it "supplies memory schema statistics without exposing rows" $ do
-            case runMemoryStorage (schema :: MemoryStorage Database) testDB of
+            case runMemoryStorage schema testDB of
                 Left err -> expectationFailure err
-                Right (structures, _) -> do
+                Right (Left err, _) -> expectationFailure err
+                Right (Right structures, _) -> do
                     map (tableRows . snd) structures `shouldBe` [[], []]
                     fmap (fmap metaRowCount . tableMeta) (lookup "users" structures) `shouldBe` Just (Just 3)
 
@@ -2094,6 +2176,51 @@ main = hspec $ do
                                    ]
 
     describe "ChuSQL.Core.Engine.Storage.IPC" $ do
+        it "uses UTF-8 config paths regardless of the foreign string encoding" $ do
+            tmp <- getTemporaryDirectory
+            stamp <- uniqueStamp
+            let dir = tmp </> ("chusql-utf8-" ++ stamp)
+                config = dir </> "settings-é.toml"
+            createDirectoryIfMissing True dir
+            flip finally (cleanSessionDir dir) $ do
+                original <- writeSessionConfig dir
+                renameFile original config
+                encoding <- getForeignEncoding
+                bracket_ (setForeignEncoding latin1) (setForeignEncoding encoding) $ do
+                    opened <- openStorage (Just config)
+                    case opened of
+                        Left err -> expectationFailure err
+                        Right handle -> closeStorage handle
+                    maintainStorage config (BSC.pack "{\"mode\":\"unknown\"}") `shouldReturn` Left "invalid maintenance mode"
+
+        it "preserves each worker's storage open error" $ do
+            tmp <- getTemporaryDirectory
+            stamp <- uniqueStamp
+            pool <- workerPool 4
+            let paths = [tmp </> ("missing-ffi-" ++ stamp ++ "-" ++ show n) | n <- [1 .. 16 :: Int]]
+                -- | 检查打开失败并归还意外成功的句柄
+                checkOpen path = do
+                    opened <- openStorage (Just path)
+                    case opened of
+                        Left err -> do
+                            err `shouldContain` "config file not found"
+                            err `shouldContain` path
+                        Right handle -> closeStorage handle >> expectationFailure "expected missing config error"
+            poolRun pool (map checkOpen paths) >> pure ()
+
+        it "returns FFI input errors from workers and remains usable" $ do
+            withTestSession $ \srv -> do
+                pool <- workerPool 4
+                -- | 检查无效 UTF-8 的请求与维护错误
+                let checkErrors = do
+                        requested <- sendRawRequest (BS.pack [255])
+                        requested `shouldSatisfy` either (isInfixOf "request is not valid UTF-8") (const False)
+                        maintained <- maintainStorage (dataDir srv ++ ".toml") (BS.pack [255])
+                        maintained `shouldSatisfy` either (isInfixOf "invalid utf-8") (const False)
+                poolRun pool (replicate 16 checkErrors) >> pure ()
+                sendRawRequest (BSC.pack "{\"method\":\"ping\"}")
+                    `shouldReturn` Right (BSC.pack "{\"status\":\"pong\"}")
+
         it "persists runtime type identities and nested values across restart" $ do
             withTestSession $ \srv -> do
                 -- | 解析并通过真实存储执行 SQL
@@ -2143,42 +2270,21 @@ main = hspec $ do
                 query "SELECT secret FROM reused" `shouldReturn` Right [[("secret", VStr "new")]]
                 query "SELECT secret FROM reused WHERE id = 1" `shouldReturn` Right [[("secret", VStr "new")]]
 
-        it "scan returns rows with all three value types after insert" $ do
+        it "scans stored value types and reports missing tables" $ do
             withTestSession $ \srv -> withServerEnv srv $ do
                 let row = [("id", VInt 7), ("name", VStr "Alice"), ("flag", VBool True)]
                 runIPCStorage (insert "users" row) `shouldReturn` Right ()
                 rows <- runIPCStorage (scan "users")
                 (map sortRow <$> rows) `shouldBe` Right [sortRow row]
-
-        it "scan on a missing table returns Left" $ do
-            withTestSession $ \srv -> withServerEnv srv $ do
                 result <- runIPCStorage (scan "no_such_table")
                 result `shouldSatisfy` isLeft
 
         it "scan returns all 20 inserted rows in order" $ do
             withTestSession $ \srv -> withServerEnv srv $ do
-                mapM_ (\i -> runIPCStorage (insert "many" [("id", VInt i)])) [1 .. 20 :: Int]
+                runIPCStorage (insertMany "many" [[("id", VInt i)] | i <- [1 .. 20 :: Int]]) `shouldReturn` Right ()
                 rows <- runIPCStorage (scan "many")
                 fmap length rows `shouldBe` Right 20
-                fmap (sortOn show . map (lookup "id")) rows
-                    `shouldBe` Right (sortOn show (map (Just . VInt) [1 .. 20]))
-
-        it "replaceAll leaves only the new rows" $ do
-            withTestSession $ \srv -> withServerEnv srv $ do
-                runIPCStorage (insert "t" [("id", VInt 1)]) `shouldReturn` Right ()
-                runIPCStorage (replaceAll "t" [[("id", VInt 9)], [("id", VInt 8)]]) `shouldReturn` Right ()
-                rows <- runIPCStorage (scan "t")
-                fmap (sortOn show . map (lookup "id")) rows
-                    `shouldBe` Right (sortOn show [Just (VInt 9), Just (VInt 8)])
-
-        it "lookupByColumn finds a row inserted with an id" $ do
-            withTestSession $ \srv -> withServerEnv srv $ do
-                let row = [("id", VInt 7), ("name", VStr "Zoe")]
-                runIPCStorage (insert "keyed" row) `shouldReturn` Right ()
-                found <- runIPCStorage (lookupByColumn "keyed" "id" (VInt 7))
-                fmap sortRow (indexRow found) `shouldBe` Just (sortRow row)
-                missing <- runIPCStorage (lookupByColumn "keyed" "id" (VInt 8))
-                missing `shouldBe` Right (IndexRows [])
+                fmap (map (lookup "id")) rows `shouldBe` Right (map (Just . VInt) [1 .. 20])
 
         it "looks up a string index" $ do
             withTestSession $ \srv -> withServerEnv srv $ do
@@ -2202,21 +2308,27 @@ main = hspec $ do
                 fmap (fmap (map (lookup "id"))) open `shouldBe` Right (Just [Just (VInt 3)])
                 runIPCStorage (scanRange "rng" "nope" Nothing Nothing) `shouldReturn` Right Nothing
 
-        it "replaceAll rebuilds the index" $ do
+        it "looks up inserted ids and replaces rows with rebuilt indexes" $ do
             withTestSession $ \srv -> withServerEnv srv $ do
-                runIPCStorage (insert "rb" [("id", VInt 1)]) `shouldReturn` Right ()
-                runIPCStorage (replaceAll "rb" [[("id", VInt 9), ("name", VStr "Zoe")]]) `shouldReturn` Right ()
+                let original = [("id", VInt 1), ("name", VStr "Alice")]
+                    replacement = [("id", VInt 9), ("name", VStr "Zoe")]
+                runIPCStorage (insert "rb" original) `shouldReturn` Right ()
+                found <- runIPCStorage (lookupByColumn "rb" "id" (VInt 1))
+                fmap sortRow (indexRow found) `shouldBe` Just (sortRow original)
+                runIPCStorage (lookupByColumn "rb" "id" (VInt 8)) `shouldReturn` Right (IndexRows [])
+                runIPCStorage (replaceAll "rb" [replacement, [("id", VInt 8)]]) `shouldReturn` Right ()
+                rows <- runIPCStorage (scan "rb")
+                fmap (map sortRow) rows `shouldBe` Right [sortRow replacement, [("id", VInt 8)]]
                 old <- runIPCStorage (lookupByColumn "rb" "id" (VInt 1))
                 old `shouldBe` Right (IndexRows [])
                 new <- runIPCStorage (lookupByColumn "rb" "id" (VInt 9))
-                fmap sortRow (indexRow new)
-                    `shouldBe` Just (sortRow [("id", VInt 9), ("name", VStr "Zoe")])
+                fmap sortRow (indexRow new) `shouldBe` Just (sortRow replacement)
 
         it "snapshot lists tables and scans each one to build the database" $ do
             withTestSession $ \srv -> withServerEnv srv $ do
                 runIPCStorage (insert "a" [("id", VInt 1)]) `shouldReturn` Right ()
                 runIPCStorage (insert "b" [("id", VInt 2)]) `shouldReturn` Right ()
-                db <- runIPCStorage snapshot
+                Right db <- runIPCStorage snapshot
                 map fst db `shouldBe` ["a", "b"]
                 map (length . tableRows . snd) db `shouldBe` [1, 1]
                 map (map (lookup "id") . tableRows . snd) db `shouldBe` [[Just (VInt 1)], [Just (VInt 2)]]
@@ -2346,7 +2458,7 @@ main = hspec $ do
                             (Insert "meta_t" ["id", "code"] [[LitInt 1, LitInt 500], [LitInt 2, LitInt 501]])
                         )
                 _ <- runIPCStorage (runStatementM (CreateIndex "meta_t" "code"))
-                db <- runIPCStorage schema
+                Right db <- runIPCStorage schema
                 case lookup "meta_t" db of
                     Nothing -> expectationFailure "meta_t missing from schema"
                     Just t -> do
@@ -2857,6 +2969,19 @@ main = hspec $ do
             errorCategory "unsupported protocol version" `shouldBe` ProtocolError
             errorCategory "something else" `shouldBe` UnknownError
 
+    describe "Worker pool capacity" $ do
+        it "grows the existing queue so old references use the additional workers" $ do
+            original <- workerPool 4
+            _ <- workerPool 8
+            started <- newChan
+            release <- newEmptyMVar
+            finished <- newEmptyMVar
+            void (forkIO (poolRun original (replicate 8 (writeChan started () >> readMVar release)) >> putMVar finished ()))
+            flip finally (void (tryPutMVar release ())) $ do
+                timeout 1000000 (replicateM_ 8 (readChan started)) `shouldReturn` Just ()
+                putMVar release ()
+                timeout 1000000 (takeMVar finished) `shouldReturn` Just ()
+
 -- | 每个测试表都清空行后的库
 emptyDB :: Database
 emptyDB = [(n, t{tableRows = []}) | (n, t) <- testDB]
@@ -2912,7 +3037,7 @@ cleanSessionDir dir = do
     _ <- try (removePathForcibly (dir ++ ".toml")) :: IO (Either IOException ())
     pure ()
 
--- | 一个用例一份干净数据目录；动态库打不开则 pending
+-- | 每例独立目录，存储打开失败则测试失败
 withTestSession :: (StorageSession -> IO ()) -> IO ()
 withTestSession act = do
     tmp <- getTemporaryDirectory
@@ -2921,7 +3046,7 @@ withTestSession act = do
     createDirectoryIfMissing True dir
     opened <- openSessionAt dir
     case opened of
-        Left err -> cleanSessionDir dir >> pendingWith err
+        Left err -> cleanSessionDir dir >> expectationFailure err
         Right session -> act session `finally` (closeConnection >> cleanSessionDir dir)
 
 -- | 语句不带库名，先建好测试库再切进去
@@ -3050,7 +3175,7 @@ instance MonadStorage ProbeStorage where
     dropTable _ = ProbeStorage (\_ -> pure (Left "probe: dropTable is not supported"))
     dropColumn _ _ = ProbeStorage (\_ -> pure (Left "probe: dropColumn is not supported"))
     replaceSchema _ _ _ = ProbeStorage (\_ -> pure (Left "probe: replaceSchema is not supported"))
-    snapshot = ProbeStorage (\_ -> pure [])
+    snapshot = ProbeStorage (\_ -> pure (Right []))
 
 -- | 判断 Either 是 Right
 isRight :: Either a b -> Bool
@@ -3271,7 +3396,7 @@ instance MonadStorage Counting where
     -- \| 换结构：走内存实现
     replaceSchema name cols rows = memory (memReplaceSchema name cols rows)
     -- \| 快照：把当前库原样交出去
-    snapshot = Counting $ \db -> Right (db, db, [])
+    snapshot = Counting $ \db -> Right (Right db, db, [])
 
 -- | 解析一条 SQL 并在计数存储上跑，返回结果与扫描过的表
 countedRun :: String -> (Either String [Row], [String])