修复bug

chusql-core/model/src/ChuSQL/Core/Model.hs

@@ -12,6 +12,7 @@ module ChuSQL.Core.Model
     , TableMeta (..)
     , Histogram (..)
     , Table (..)
+    , TableIdentity (..)
     , Database
     , histogramOf
     , histogramFor
@@ -48,6 +49,7 @@ import Data.Char (isDigit, isSpace, toLower)
 import Data.Hashable (Hashable (..))
 import Data.List (isPrefixOf, isSuffixOf, stripPrefix)
 import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Word (Word64)
 import ChuSQL.Core.Runtime
 import qualified Data.ByteString.Lazy.Char8 as BS
 
@@ -556,12 +558,17 @@ data TableMeta = TableMeta
     }
     deriving (Show)
 
--- | 一张表：名字、列定义与全部行；meta 为存储层统计，拿不到是 Nothing
+-- | 保存持久化数据库与表编号
+data TableIdentity = TableIdentity Word64 Word64 deriving (Show, Eq)
+
+-- | 一张表：列、行、统计与独立对象身份
 data Table = Table
     { tableName :: String
     , tableCols :: [(String, Column)]
     , tableRows :: [Row]
     , tableMeta :: Maybe TableMeta
+    , tableIdentity :: Maybe TableIdentity
+    , tableSchemaVersion :: Maybe Word64
     }
     deriving (Show)
 

chusql-core/model/src/ChuSQL/Core/Protocol.hs

@@ -15,16 +15,18 @@ module ChuSQL.Core.Protocol (
     queryResultJson,
 ) where
 
-import ChuSQL.Core.Model (Histogram (..), Row, Value (..))
+import ChuSQL.Core.Model (Histogram (..), Row, Value (..), TableIdentity (..))
 import ChuSQL.Core.Runtime (builtinTypes, runtimeToJSON, runtimeFromJSON)
 import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.:?), (.!=), (.=))
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Key as K
 import qualified Data.Aeson.KeyMap as KM
 import Data.Aeson.Types (Parser)
-import Data.Scientific (floatingOrInteger, fromFloatDigits)
+import Data.Scientific (floatingOrInteger, fromFloatDigits, base10Exponent)
 import qualified Data.Text as T
 import Data.Text (Text)
+import Data.Word (Word64)
+import Text.Read (readMaybe)
 
 -- 线上协议类型：存储层请求/响应与查询结果集。
 
@@ -255,6 +257,8 @@ data TableInfo = TableInfo
     , tiIndexes :: [String]
     , tiStats :: [(String, Int, Bool)]
     , tiHistograms :: [(String, Histogram)]
+    , tiIdentity :: Maybe TableIdentity
+    , tiSchemaVersion :: Maybe Word64
     }
     deriving (Show, Eq)
 
@@ -267,6 +271,9 @@ instance ToJSON TableInfo where
             , "row_count" .= tiRows info
             , "indexes" .= map (\name -> object ["column" .= name]) (tiIndexes info)
             , "stats" .= map (statJson (tiHistograms info)) (tiStats info)
+            , "database_id" .= fmap (\(TableIdentity database _) -> show database) (tiIdentity info)
+            , "object_id" .= fmap (\(TableIdentity _ table) -> show table) (tiIdentity info)
+            , "schema_version" .= fmap show (tiSchemaVersion info)
             ]
       where
         statJson hists (name, distinct, capped) =
@@ -276,6 +283,16 @@ instance ToJSON TableInfo where
             histFields Nothing = []
             histFields (Just h) = ["lo" .= histLow h, "hi" .= histHigh h, "hist" .= histBuckets h]
 
+-- | 解码精确且有界的对象编号
+parseObjectNumber :: A.Value -> Parser Word64
+parseObjectNumber (A.String value)
+    | not (T.null value), T.length value <= 20, T.all (\c -> c >= '0' && c <= '9') value
+    , Just number <- (readMaybe (T.unpack value) :: Maybe Integer)
+    , number <= toInteger (maxBound :: Word64) = pure (fromInteger number)
+parseObjectNumber value@(A.Number number)
+    | base10Exponent number >= -20, base10Exponent number <= 20 = A.parseJSON value
+parseObjectNumber _ = fail "invalid table object identity"
+
 -- | 线上直方图还原；区间或桶缺了就当作没有
 histogramFromWire :: Maybe Double -> Maybe Double -> [Int] -> Maybe Histogram
 histogramFromWire (Just low) (Just high) counts
@@ -292,9 +309,18 @@ instance FromJSON TableInfo where
         stats <- o .:? "stats" .!= []
         indexColumns <- mapM (\v -> withObject "IndexWire" (.: "column") v) (indexes :: [A.Value])
         parsed <- mapM parseStat (stats :: [A.Value])
+        database <- o .:? "database_id" >>= traverse parseObjectNumber
+        tableId <- o .:? "object_id" >>= traverse parseObjectNumber
+        version <- o .:? "schema_version" >>= traverse parseObjectNumber
+        identity <- case (database, tableId) of
+            (Nothing, Nothing) -> pure Nothing
+            (Just _, Just 0) -> pure Nothing
+            (Just databaseId, Just objectId) | objectId > 0 -> pure (Just (TableIdentity databaseId objectId))
+            _ -> fail ("incomplete table object identity: " ++ show (database, tableId))
         let parsedStats = [(name, distinct, capped) | (name, distinct, capped, _) <- parsed]
             parsedHistograms = [(name, h) | (name, _, _, Just h) <- parsed]
-        pure (TableInfo table columns count indexColumns parsedStats parsedHistograms)
+        pure (TableInfo table columns count indexColumns parsedStats parsedHistograms identity
+            (version >>= \v -> if v == 0 then Nothing else Just v))
       where
         parseStat = withObject "ColumnStat" $ \o -> do
             name <- o .: "name"