v26.10.1 正式版

修复部分问题，优化性能，进一步推进类型系统

chusql-core/model/chusql-core-model.cabal

@@ -13,10 +13,13 @@ library
     hs-source-dirs:   src
     exposed-modules:  ChuSQL.Core.Model
                       ChuSQL.Core.Protocol
+                      ChuSQL.Core.Runtime
     build-depends:    base >= 4.14 && < 5
                     , aeson
                     , hashable
                     , scientific
                     , text
+                    , bytestring
+                    , vector
     default-language: Haskell2010
     ghc-options:      -Wall

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

@@ -48,6 +48,8 @@ import Data.Char (isDigit, isSpace, toLower)
 import Data.Hashable (Hashable (..))
 import Data.List (isPrefixOf, isSuffixOf, stripPrefix)
 import Data.Maybe (fromMaybe, mapMaybe)
+import ChuSQL.Core.Runtime
+import qualified Data.ByteString.Lazy.Char8 as BS
 
 -- 数据模型：列类型、列约束、值、行、表、数据库，外加查表小工具。
 
@@ -68,6 +70,7 @@ data ColumnType
     | CBlob
     | CNull
     | CDomain String ColumnType
+    | CRuntime TypeId
     deriving (Show, Eq)
 
 -- | 列定义：类型 + 约束；约束全部取默认值就是普通可空列。
@@ -121,6 +124,7 @@ typeLabel CTimestamp = "TTimestamp"
 typeLabel CBlob = "TBlob"
 typeLabel CNull = "NULL"
 typeLabel (CDomain name _) = name
+typeLabel (CRuntime tid) = renderTypeExpr (typeExpression tid)
 
 -- | 线上/磁盘上的类型名
 typeName :: ColumnType -> String
@@ -139,6 +143,7 @@ typeName CTimestamp = "timestamp"
 typeName CBlob = "blob"
 typeName CNull = "null"
 typeName (CDomain name base) = "domain(" ++ name ++ "," ++ typeName base ++ ")"
+typeName (CRuntime tid) = "runtime(" ++ BS.unpack (encodeType tid) ++ ")"
 
 -- | 生成类型定义的目录键
 domainTableName :: String -> String
@@ -151,6 +156,9 @@ isDomainTable name = "__system_domain_" `isPrefixOf` map toLower name
 -- | 解析类型名，可带长度/精度参数；不认识的给 Nothing
 parseColumnType :: String -> Maybe ColumnType
 parseColumnType raw
+    | Just inner <- stripPrefix "runtime(" raw
+    , Just body <- stripSuffixMaybe ")" inner =
+        either (const Nothing) (Just . CRuntime) (decodeType builtinTypes (BS.pack body))
     | Just inner <- stripPrefix "domain(" raw
     , Just body <- stripSuffixMaybe ")" inner
     , (name, ',' : definition) <- break (== ',') body =
@@ -180,7 +188,7 @@ parseColumnType raw
         ("date", []) -> Just CDate
         ("timestamp", []) -> Just CTimestamp
         ("blob", []) -> Just CBlob
-        _ -> Nothing
+        _ -> either (const Nothing) (Just . CRuntime . descriptorId) (parseTypeExpr raw >>= resolveType builtinTypes)
   where
     -- | 去掉空白的类型名
     cleaned = map toLower (filter (not . isSpace) raw)
@@ -231,6 +239,7 @@ data TypeClass
     | TemporalClass
     | BooleanClass
     | NullClass
+    | RuntimeClass
     deriving (Show, Eq)
 
 -- | 整型大类判断
@@ -250,12 +259,15 @@ typeClassOf CTimestamp = TemporalClass
 typeClassOf CBool = BooleanClass
 typeClassOf CNull = NullClass
 typeClassOf (CDomain _ base) = typeClassOf base
+typeClassOf CRuntime{} = RuntimeClass
 
 -- | 同大类可赋值；日期/时间列接受字符串字面量
 assignable :: ColumnType -> ColumnType -> Bool
 assignable target source
     | source == CNull = True
     | target == source = True
+    | CRuntime tid <- target = Just (typeExpression tid) == scalarTypeExpression source
+    | typeClassOf target == RuntimeClass || typeClassOf source == RuntimeClass = False
     | typeClassOf target == typeClassOf source = True
     | typeClassOf target == TemporalClass && typeClassOf source == TextClass = True
     | otherwise = False
@@ -270,7 +282,9 @@ integerType _ = False
 
 -- | 比较用的类型族：同大类可比，日期时间与文本互比
 comparableTypes :: ColumnType -> ColumnType -> Bool
-comparableTypes a b = a == CNull || b == CNull || sameClass || crossTemporal
+comparableTypes a b
+    | typeClassOf a == RuntimeClass || typeClassOf b == RuntimeClass = False
+    | otherwise = a == CNull || b == CNull || sameClass || crossTemporal
   where
     -- | 两个类型同属一个大类
     sameClass = typeClassOf a == typeClassOf b
@@ -288,6 +302,10 @@ numericType t = typeClassOf t == NumericClass
 -- | 值能不能放进这一列（先不看可空）
 valueFits :: ColumnType -> Value -> Bool
 valueFits (CDomain _ base) value = valueFits base value
+valueFits (CRuntime expected) (VRuntime supplied value) = expected == supplied && validateValue builtinTypes expected value == Right ()
+valueFits (CRuntime expected) value = case scalarRuntimeValue value of
+    Just runtime -> validateValue builtinTypes expected runtime == Right ()
+    Nothing -> value == VNull
 valueFits _ VNull = True
 valueFits CInt (VInt _) = True
 valueFits CBigInt (VInt _) = True
@@ -326,6 +344,15 @@ coerceValue t v = case t of
     CBlob -> toText t v
     CNull -> Left "a NULL output cannot contain a non-NULL value"
     CDomain _ base -> coerceValue base v
+    CRuntime expected -> case v of
+        VRuntime supplied value | supplied == expected -> do
+            validateValue builtinTypes expected value
+            Right v
+        _ -> case scalarRuntimeValue v of
+            Just value -> do
+                validateValue builtinTypes expected value
+                Right (VRuntime expected value)
+            Nothing -> Left "runtime value type identity mismatch"
 
 -- | 整数收进整型列
 toInt :: ColumnType -> Value -> Either String Value
@@ -422,6 +449,7 @@ data Value
     | VFloat Double
     | VStr String
     | VBool Bool
+    | VRuntime TypeId RuntimeValue
     deriving (Show, Eq)
 
 -- | 值的比较关键字：整值浮点折成整数
@@ -450,6 +478,7 @@ compareValue a b = case (canonicalValue a, canonicalValue b) of
     (VFloat x, VFloat y) -> compare x y
     (VStr x, VStr y) -> compare x y
     (VBool x, VBool y) -> compare x y
+    (VRuntime tx x, VRuntime ty y) -> compare (encodeType tx, show (canonicalRuntime x)) (encodeType ty, show (canonicalRuntime y))
     (x, y) -> compare (valueRank x) (valueRank y)
 
 -- | 族的先后，只用来给异族值定序
@@ -459,6 +488,7 @@ valueRank (VInt _) = 1
 valueRank (VFloat _) = 1
 valueRank (VStr _) = 2
 valueRank (VBool _) = 3
+valueRank VRuntime{} = 4
 
 -- | 相等语义：比较关键字相同即相等，与 hashValue 配套
 valuesEqual :: Value -> Value -> Bool
@@ -472,6 +502,35 @@ hashValue v = case canonicalValue v of
     VFloat d -> hashWithSalt 1 d
     VStr t -> hashWithSalt 2 t
     VBool b -> hashWithSalt 3 b
+    VRuntime tid value -> hashWithSalt 4 (BS.unpack (encodeType tid), show (canonicalRuntime value))
+
+-- | 解析现有标量列的逻辑类型
+scalarTypeExpression :: ColumnType -> Maybe TypeExpr
+scalarTypeExpression (CDomain _ base) = scalarTypeExpression base
+scalarTypeExpression CInt = Just intType
+scalarTypeExpression CBigInt = Just intType
+scalarTypeExpression CSmallInt = Just intType
+scalarTypeExpression CDouble = Just doubleType
+scalarTypeExpression CFloat = Just doubleType
+scalarTypeExpression CBool = Just boolType
+scalarTypeExpression CStr = Just stringType
+scalarTypeExpression _ = Nothing
+
+-- | 转换现有标量值
+scalarRuntimeValue :: Value -> Maybe RuntimeValue
+scalarRuntimeValue (VInt n) = Just (RInt n)
+scalarRuntimeValue (VFloat n) = Just (RDouble n)
+scalarRuntimeValue (VBool b) = Just (RBool b)
+scalarRuntimeValue (VStr text) = Just (RString text)
+scalarRuntimeValue _ = Nothing
+
+-- | 统一复合值中的浮点零关键字
+canonicalRuntime :: RuntimeValue -> RuntimeValue
+canonicalRuntime (RDouble n) | n == 0 = RDouble 0
+canonicalRuntime (RList values) = RList (map canonicalRuntime values)
+canonicalRuntime (RMaybe value) = RMaybe (fmap canonicalRuntime value)
+canonicalRuntime (RTuple values) = RTuple (map canonicalRuntime values)
+canonicalRuntime value = value
 
 -- | 值按类型打散搅拌
 instance Hashable Value where

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

@@ -16,6 +16,7 @@ module ChuSQL.Core.Protocol (
 ) where
 
 import ChuSQL.Core.Model (Histogram (..), Row, Value (..))
+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
@@ -78,7 +79,7 @@ data Request
     | ReqIdentityInitialize T.Text
     | ReqRoleCreate T.Text
     | ReqCatalogManage Request
-    | ReqIdentityAlter T.Text (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
+    | ReqIdentityAlter T.Text (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
     | ReqAccountCreate T.Text T.Text
     | ReqAccountReset T.Text T.Text
     | ReqAccountLogin T.Text (Maybe T.Text)
@@ -142,8 +143,8 @@ instance ToJSON Request where
     toJSON ReqAccountsList = object ["method" .= ("accounts_list" :: T.Text)]
     toJSON (ReqIdentityInitialize u) = object ["method" .= ("identity_initialize" :: T.Text), "administrator" .= u]
     toJSON (ReqRoleCreate u) = object ["method" .= ("role_create" :: T.Text), "user" .= u]
-    toJSON (ReqIdentityAlter u login super enabled manager) = object ["method" .= ("identity_alter" :: T.Text), "user" .= u,
-        "can_login" .= login, "is_superuser" .= super, "enabled" .= enabled, "system_catalog_manager" .= manager]
+    toJSON (ReqIdentityAlter u login super enabled manager sudo) = object ["method" .= ("identity_alter" :: T.Text), "user" .= u,
+        "can_login" .= login, "is_superuser" .= super, "enabled" .= enabled, "system_catalog_manager" .= manager, "allow_sudo_auth" .= sudo]
     toJSON (ReqAccountCreate u h) = object ["method" .= ("account_create" :: T.Text), "user" .= u, "password_hash" .= h]
     toJSON (ReqAccountReset u h) = object ["method" .= ("account_reset" :: T.Text), "user" .= u, "password_hash" .= h]
     toJSON (ReqAccountLogin u at) = object ["method" .= ("account_login" :: T.Text), "user" .= u, "at" .= at]
@@ -316,6 +317,7 @@ data Account = Account
     , accountIsSuperuser :: Bool
     , accountEnabled :: Bool
     , accountSystemCatalogManager :: Bool
+    , accountAllowSudoAuth :: Bool
     } deriving (Eq)
 
 -- | 账号的展示：只露账号名与版本号
@@ -327,14 +329,14 @@ instance FromJSON Account where
     parseJSON = withObject "Account" $ \o -> Account <$> o .: "id" <*> o .: "user"
         <*> o .: "password_hash" <*> o .: "revision"
         <*> o .:? "registered_at" .!= "" <*> o .:? "last_login_at"
-        <*> o .:? "can_login" .!= True <*> o .:? "is_superuser" .!= False <*> o .:? "enabled" .!= True <*> o .:? "system_catalog_manager" .!= False
+        <*> o .:? "can_login" .!= True <*> o .:? "is_superuser" .!= False <*> o .:? "enabled" .!= True <*> o .:? "system_catalog_manager" .!= False <*> o .:? "allow_sudo_auth" .!= False
 
 -- | 账号编码成 JSON
 instance ToJSON Account where
     toJSON a = object ["id" .= accountId a, "user" .= accountUser a,
         "password_hash" .= accountHash a, "revision" .= accountRevision a,
         "registered_at" .= accountRegisteredAt a, "last_login_at" .= accountLastLoginAt a,
-        "can_login" .= accountCanLogin a, "is_superuser" .= accountIsSuperuser a, "enabled" .= accountEnabled a, "system_catalog_manager" .= accountSystemCatalogManager a]
+        "can_login" .= accountCanLogin a, "is_superuser" .= accountIsSuperuser a, "enabled" .= accountEnabled a, "system_catalog_manager" .= accountSystemCatalogManager a, "allow_sudo_auth" .= accountAllowSudoAuth a]
 
 -- | 存储层响应
 data Response
@@ -373,6 +375,7 @@ 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
+valueToJSON (VRuntime tid value) = object ["__chusql_runtime_v1" .= runtimeToJSON tid value]
 
 -- | JSON 解回值
 valueFromJSON :: A.Value -> Parser Value
@@ -383,6 +386,9 @@ valueFromJSON (A.Number n) =
         Left d -> pure (VFloat d)
 valueFromJSON (A.String s) = pure (VStr (T.unpack s))
 valueFromJSON (A.Bool b) = pure (VBool b)
+valueFromJSON (A.Object fields)
+    | KM.size fields == 1, Just payload <- KM.lookup "__chusql_runtime_v1" fields =
+        either fail (pure . uncurry VRuntime) (runtimeFromJSON builtinTypes payload)
 valueFromJSON _ = fail "unsupported value type"
 
 -- | 一行编码成 JSON

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

@@ -0,0 +1,293 @@
+module ChuSQL.Core.Runtime
+    ( TypeConstructorId (..), TypeId, TypeExpr (..), Kind (..)
+    , TypeRegistry, TypeDescriptor (..), PhysicalType (..), RuntimeValue (..)
+    , builtinTypes, resolveType, describeType, typeExpression
+    , intType, doubleType, boolType, stringType, listType, maybeType, tupleType, renderTypeExpr, parseTypeExpr, renderRuntimeValue
+    , validateValue, encodeValue, decodeValue, encodeType, decodeType, runtimeToJSON, runtimeFromJSON
+    ) where
+
+import Data.Aeson (Value (..), eitherDecode, encode)
+import Data.Aeson.Types (Parser, parseEither)
+import qualified Data.ByteString.Lazy as BS
+import Data.Scientific (floatingOrInteger)
+import qualified Data.Text as T
+import qualified Data.Vector as V
+import Data.Char (isAlphaNum, toLower)
+import qualified Text.ParserCombinators.ReadP as P
+
+-- 运行时类型身份、构造器注册及版本化物理编码。
+
+-- | 标识稳定的类型构造器
+newtype TypeConstructorId = TypeConstructorId Int deriving (Show, Eq, Ord)
+
+-- | 表达逻辑类型应用
+data TypeExpr = TypeApply TypeConstructorId [TypeExpr] deriving (Show, Eq, Ord)
+
+-- | 标识完整的类型实例
+newtype TypeId = TypeId TypeExpr deriving (Show, Eq, Ord)
+
+-- | 描述构造器参数个数
+data Kind = TypeKind | TypeArrow Kind Kind | ProductKind deriving (Show, Eq)
+
+-- | 描述独立的物理表示
+data PhysicalType = SignedInteger | FloatingPoint | Boolean | Utf8 | Sequence PhysicalType
+    | Optional PhysicalType | Product [PhysicalType] deriving (Show, Eq)
+
+-- | 保存类型实例描述
+data TypeDescriptor = TypeDescriptor
+    { descriptorId :: TypeId, descriptorName :: String, descriptorPhysical :: PhysicalType
+    } deriving (Show, Eq)
+
+-- | 保存构造器元数据
+newtype TypeRegistry = TypeRegistry [(TypeConstructorId, String, Kind)] deriving (Show, Eq)
+
+-- | 表达运行时值
+data RuntimeValue = RInt Int | RDouble Double | RBool Bool | RString String
+    | RList [RuntimeValue] | RMaybe (Maybe RuntimeValue) | RTuple [RuntimeValue]
+    deriving (Show, Eq)
+
+-- | 恢复固定编号的内建构造器
+builtinTypes :: TypeRegistry
+builtinTypes = TypeRegistry
+    [(TypeConstructorId 1, "Int", TypeKind), (TypeConstructorId 2, "Double", TypeKind)
+    ,(TypeConstructorId 3, "Bool", TypeKind), (TypeConstructorId 4, "String", TypeKind)
+    ,(TypeConstructorId 5, "List", TypeArrow TypeKind TypeKind)
+    ,(TypeConstructorId 6, "Maybe", TypeArrow TypeKind TypeKind)
+    ,(TypeConstructorId 7, "Tuple", ProductKind)]
+
+-- | 构造整数类型表达式
+intType :: TypeExpr
+intType = TypeApply (TypeConstructorId 1) []
+
+-- | 构造浮点类型表达式
+doubleType :: TypeExpr
+doubleType = TypeApply (TypeConstructorId 2) []
+
+-- | 构造布尔类型表达式
+boolType :: TypeExpr
+boolType = TypeApply (TypeConstructorId 3) []
+
+-- | 构造字符串类型表达式
+stringType :: TypeExpr
+stringType = TypeApply (TypeConstructorId 4) []
+
+-- | 构造列表类型表达式
+listType :: TypeExpr -> TypeExpr
+listType t = TypeApply (TypeConstructorId 5) [t]
+
+-- | 构造可选类型表达式
+maybeType :: TypeExpr -> TypeExpr
+maybeType t = TypeApply (TypeConstructorId 6) [t]
+
+-- | 构造元组类型表达式
+tupleType :: [TypeExpr] -> TypeExpr
+tupleType = TypeApply (TypeConstructorId 7)
+
+-- | 渲染内建逻辑类型语法
+renderTypeExpr :: TypeExpr -> String
+renderTypeExpr ty@(TypeApply cid arguments) = case (cid, arguments) of
+    (TypeConstructorId 1, []) -> "Int"
+    (TypeConstructorId 2, []) -> "Double"
+    (TypeConstructorId 3, []) -> "Bool"
+    (TypeConstructorId 4, []) -> "String"
+    (TypeConstructorId 5, [child]) -> "[" ++ renderTypeExpr child ++ "]"
+    (TypeConstructorId 6, [child]) -> "Maybe " ++ renderTypeExpr child
+    (TypeConstructorId 7, fields) -> "(" ++ joinTypes fields ++ ")"
+    _ -> show ty
+  where
+    -- | 连接元组字段类型
+    joinTypes [] = ""
+    joinTypes [field] = renderTypeExpr field
+    joinTypes (field : fields) = renderTypeExpr field ++ ", " ++ joinTypes fields
+
+-- | 解析完整的内建逻辑类型文本
+parseTypeExpr :: String -> Either String TypeExpr
+parseTypeExpr source = case P.readP_to_S (P.skipSpaces *> expression <* P.skipSpaces <* P.eof) source of
+    [(ty, "")] -> Right ty
+    _ -> Left "invalid runtime type expression"
+  where
+    -- | 解析类型原子和构造器应用
+    expression = (intType <$ token "int") P.<++ (doubleType <$ token "double")
+        P.<++ (boolType <$ token "bool") P.<++ (stringType <$ token "string")
+        P.<++ (listType <$> between "[" "]" expression)
+        P.<++ (listType <$> (token "list" *> expression))
+        P.<++ (maybeType <$> (token "maybe" *> expression))
+        P.<++ (tupleType <$> between "(" ")" (P.sepBy expression (symbol ",")))
+    -- | 解析具有名称边界的类型关键字
+    token word = do
+        _ <- mapM character word
+        rest <- P.look
+        case rest of
+            c : _ | isAlphaNum c || c == '_' -> P.pfail
+            _ -> P.skipSpaces
+    -- | 不区分大小写匹配关键字字符
+    character c = P.satisfy ((== c) . toLower)
+    -- | 解析类型分隔符
+    symbol text = P.string text <* P.skipSpaces
+    -- | 解析括号包围的类型
+    between open close = P.between (symbol open) (symbol close)
+
+-- | 渲染运行时值的可读文本
+renderRuntimeValue :: RuntimeValue -> String
+renderRuntimeValue (RInt n) = show n
+renderRuntimeValue (RDouble n) = show n
+renderRuntimeValue (RBool b) = show b
+renderRuntimeValue (RString text) = show text
+renderRuntimeValue (RList values) = "[" ++ joinValues values ++ "]"
+renderRuntimeValue (RMaybe Nothing) = "Nothing"
+renderRuntimeValue (RMaybe (Just value)) = "Just (" ++ renderRuntimeValue value ++ ")"
+renderRuntimeValue (RTuple values) = "(" ++ joinValues values ++ ")"
+
+-- | 连接复合值的字段文本
+joinValues :: [RuntimeValue] -> String
+joinValues [] = ""
+joinValues [value] = renderRuntimeValue value
+joinValues (value : values) = renderRuntimeValue value ++ ", " ++ joinValues values
+
+-- | 提取身份中的逻辑类型
+typeExpression :: TypeId -> TypeExpr
+typeExpression (TypeId t) = t
+
+-- | 解析类型实例并校验 kind
+resolveType :: TypeRegistry -> TypeExpr -> Either String TypeDescriptor
+resolveType registry@(TypeRegistry constructors) expression@(TypeApply cid args) = do
+    (name, kind) <- case [(n, k) | (c, n, k) <- constructors, c == cid] of
+        [entry] -> Right entry
+        _ -> Left ("unknown type constructor: " ++ show cid)
+    children <- mapM (resolveType registry) args
+    physical <- case (cid, kind, map descriptorPhysical children) of
+        (TypeConstructorId 1, TypeKind, []) -> Right SignedInteger
+        (TypeConstructorId 2, TypeKind, []) -> Right FloatingPoint
+        (TypeConstructorId 3, TypeKind, []) -> Right Boolean
+        (TypeConstructorId 4, TypeKind, []) -> Right Utf8
+        (TypeConstructorId 5, TypeArrow TypeKind TypeKind, [child]) -> Right (Sequence child)
+        (TypeConstructorId 6, TypeArrow TypeKind TypeKind, [child]) -> Right (Optional child)
+        (TypeConstructorId 7, ProductKind, fields) -> Right (Product fields)
+        _ -> Left ("invalid type constructor application: " ++ name)
+    Right (TypeDescriptor (TypeId expression) name physical)
+
+-- | 按身份查询类型描述
+describeType :: TypeRegistry -> TypeId -> Either String TypeDescriptor
+describeType registry = resolveType registry . typeExpression
+
+-- | 校验逻辑类型对应的值
+validateValue :: TypeRegistry -> TypeId -> RuntimeValue -> Either String ()
+validateValue registry tid value = do
+    descriptor <- describeType registry tid
+    validatePhysical (descriptorPhysical descriptor) value
+
+-- | 校验值的物理结构
+validatePhysical :: PhysicalType -> RuntimeValue -> Either String ()
+validatePhysical SignedInteger RInt{} = Right ()
+validatePhysical FloatingPoint (RDouble n)
+    | not (isNaN n || isInfinite n) = Right ()
+validatePhysical Boolean RBool{} = Right ()
+validatePhysical Utf8 RString{} = Right ()
+validatePhysical (Sequence child) (RList values) = mapM_ (validatePhysical child) values
+validatePhysical (Optional _) (RMaybe Nothing) = Right ()
+validatePhysical (Optional child) (RMaybe (Just value)) = validatePhysical child value
+validatePhysical (Product fields) (RTuple values)
+    | length fields == length values = sequence_ (zipWith validatePhysical fields values)
+validatePhysical physical _ = Left ("value does not fit physical type: " ++ show physical)
+
+-- | 编码带版本与类型身份的值
+encodeValue :: TypeRegistry -> TypeId -> RuntimeValue -> Either String BS.ByteString
+encodeValue registry tid value = do
+    validateValue registry tid value
+    Right (encode (runtimeToJSON tid value))
+
+-- | 表达协议中的类型化值封装
+runtimeToJSON :: TypeId -> RuntimeValue -> Value
+runtimeToJSON tid value = array [Number 1, typeJson (typeExpression tid), valueJson value]
+
+-- | 解析并校验协议类型化值
+runtimeFromJSON :: TypeRegistry -> Value -> Either String (TypeId, RuntimeValue)
+runtimeFromJSON registry json = do
+    (expression, payload) <- parseEither parseEnvelope json
+    descriptor <- resolveType registry expression
+    value <- parseEither (parseValue (descriptorPhysical descriptor)) payload
+    validateValue registry (descriptorId descriptor) value
+    Right (descriptorId descriptor, value)
+
+-- | 解码并校验版本和类型身份
+decodeValue :: TypeRegistry -> TypeId -> BS.ByteString -> Either String RuntimeValue
+decodeValue registry expected bytes = do
+    json <- eitherDecode bytes
+    (expression, payload) <- parseEither parseEnvelope json
+    descriptor <- resolveType registry expression
+    if descriptorId descriptor /= expected then Left "encoded value type identity mismatch" else do
+        value <- parseEither (parseValue (descriptorPhysical descriptor)) payload
+        validateValue registry expected value
+        Right value
+
+-- | 编码版本化类型身份
+encodeType :: TypeId -> BS.ByteString
+encodeType tid = encode (array [Number 1, typeJson (typeExpression tid)])
+
+-- | 解码并解析类型身份
+decodeType :: TypeRegistry -> BS.ByteString -> Either String TypeId
+decodeType registry bytes = do
+    json <- eitherDecode bytes
+    expression <- parseEither parseTypeEnvelope json
+    descriptorId <$> resolveType registry expression
+
+-- | 生成 JSON 数组
+array :: [Value] -> Value
+array = Array . V.fromList
+
+-- | 编码构造器应用
+typeJson :: TypeExpr -> Value
+typeJson (TypeApply (TypeConstructorId cid) args) = array [Number (fromIntegral cid), array (map typeJson args)]
+
+-- | 解析构造器应用
+parseTypeJson :: Value -> Parser TypeExpr
+parseTypeJson (Array values) = case V.toList values of
+    [Number n, Array args] -> case floatingOrInteger n :: Either Double Integer of
+        Right cid | cid > 0, cid <= fromIntegral (maxBound :: Int) -> TypeApply (TypeConstructorId (fromInteger cid)) <$> mapM parseTypeJson (V.toList args)
+        _ -> fail "invalid type constructor identity"
+    _ -> fail "invalid type expression"
+parseTypeJson _ = fail "invalid type expression"
+
+-- | 解析类型版本封装
+parseTypeEnvelope :: Value -> Parser TypeExpr
+parseTypeEnvelope (Array values) = case V.toList values of
+    [Number 1, expression] -> parseTypeJson expression
+    _ -> fail "unsupported type encoding version or invalid envelope"
+parseTypeEnvelope _ = fail "invalid type envelope"
+
+-- | 解析值版本封装
+parseEnvelope :: Value -> Parser (TypeExpr, Value)
+parseEnvelope (Array values) = case V.toList values of
+    [Number 1, expression, payload] -> do
+        ty <- parseTypeJson expression
+        pure (ty, payload)
+    _ -> fail "unsupported value encoding version or invalid envelope"
+parseEnvelope _ = fail "invalid value envelope"
+
+-- | 编码物理值
+valueJson :: RuntimeValue -> Value
+valueJson (RInt n) = Number (fromIntegral n)
+valueJson (RDouble n) = Number (realToFrac n)
+valueJson (RBool b) = Bool b
+valueJson (RString s) = String (T.pack s)
+valueJson (RList values) = array (map valueJson values)
+valueJson (RMaybe Nothing) = array []
+valueJson (RMaybe (Just value)) = array [valueJson value]
+valueJson (RTuple values) = array (map valueJson values)
+
+-- | 按物理描述解析值
+parseValue :: PhysicalType -> Value -> Parser RuntimeValue
+parseValue SignedInteger (Number n) = case floatingOrInteger n :: Either Double Integer of
+    Right i | i >= fromIntegral (minBound :: Int), i <= fromIntegral (maxBound :: Int) -> pure (RInt (fromInteger i))
+    _ -> fail "integer is fractional or out of range"
+parseValue FloatingPoint (Number n) = pure (RDouble (realToFrac n))
+parseValue Boolean (Bool b) = pure (RBool b)
+parseValue Utf8 (String s) = pure (RString (T.unpack s))
+parseValue (Sequence child) (Array values) = RList <$> mapM (parseValue child) (V.toList values)
+parseValue (Optional child) (Array values) = case V.toList values of
+    [] -> pure (RMaybe Nothing)
+    [value] -> RMaybe . Just <$> parseValue child value
+    _ -> fail "invalid optional value"
+parseValue (Product fields) (Array values)
+    | length fields == V.length values = RTuple <$> sequence (zipWith parseValue fields (V.toList values))
+parseValue _ _ = fail "invalid physical value"