修bug，完善功能

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

@@ -1,57 +1,58 @@
 {-# LANGUAGE PatternSynonyms #-}
 
-module ChuSQL.Core.Model
-    ( ColumnType (..)
-    , Column (..)
-    , pattern TInt
-    , pattern TStr
-    , pattern TBool
-    , TypeClass (..)
-    , Value (..)
-    , Row
-    , TableMeta (..)
-    , Histogram (..)
-    , Table (..)
-    , TableIdentity (..)
-    , Database
-    , histogramOf
-    , histogramFor
-    , colNames
-    , colType
-    , lookupTable
-    , resolveTable
-    , lastTablePart
-    , deriveQualifier
-    , allColumns
-    , qualify
-    , unqualify
-    , resolveColumn
-    , plainColumn
-    , typeLabel
-    , typeName
-    , parseColumnType
-    , domainTableName
-    , isDomainTable
-    , typeClassOf
-    , assignable
-    , comparableTypes
-    , integerType
-    , numericType
-    , valueFits
-    , coerceValue
-    , canonicalValue
-    , compareValue
-    , valuesEqual
-    , hashValue
-    ) where
+module ChuSQL.Core.Model (
+    ColumnType (..),
+    Column (..),
+    pattern TInt,
+    pattern TStr,
+    pattern TBool,
+    TypeClass (..),
+    Value (..),
+    Row,
+    TableMeta (..),
+    Histogram (..),
+    Table (..),
+    TableIdentity (..),
+    Database,
+    histogramOf,
+    histogramFor,
+    colNames,
+    colType,
+    lookupTable,
+    resolveTable,
+    lastTablePart,
+    deriveQualifier,
+    allColumns,
+    qualify,
+    unqualify,
+    resolveColumn,
+    plainColumn,
+    typeLabel,
+    typeName,
+    parseColumnType,
+    domainTableName,
+    isDomainTable,
+    typeClassOf,
+    assignable,
+    comparableTypes,
+    hasTypeCapability,
+    integerType,
+    numericType,
+    valueFits,
+    coerceValue,
+    canonicalValue,
+    compareValue,
+    valuesEqual,
+    hashValue,
+) where
 
+import ChuSQL.Core.Runtime
+import qualified Data.ByteString.Lazy.Char8 as BS
 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
 
 -- 数据模型：列类型、列约束、值、行、表、数据库，外加查表小工具。
 
@@ -94,20 +95,20 @@ plainColumn t = Column t True Nothing False False False Nothing
 -- | 普通整型列的匹配模式
 pattern TInt :: Column
 pattern TInt <- Column CInt _ _ _ _ _ _
-  where
-    TInt = plainColumn CInt
+    where
+        TInt = plainColumn CInt
 
 -- | 普通字符串列的匹配模式
 pattern TStr :: Column
 pattern TStr <- Column CStr _ _ _ _ _ _
-  where
-    TStr = plainColumn CStr
+    where
+        TStr = plainColumn CStr
 
 -- | 普通布尔列的匹配模式
 pattern TBool :: Column
 pattern TBool <- Column CBool _ _ _ _ _ _
-  where
-    TBool = plainColumn CBool
+    where
+        TBool = plainColumn CBool
 
 -- | 错误消息里用的类型名
 typeLabel :: ColumnType -> String
@@ -192,11 +193,11 @@ parseColumnType raw
         ("blob", []) -> Just CBlob
         _ -> either (const Nothing) (Just . CRuntime . descriptorId) (parseTypeExpr raw >>= resolveType builtinTypes)
   where
-    -- | 去掉空白的类型名
+    -- \| 去掉空白的类型名
     cleaned = map toLower (filter (not . isSpace) raw)
-    -- | 基础名与参数段
+    -- \| 基础名与参数段
     (base, rest) = span (/= '(') cleaned
-    -- | 括号里的参数表
+    -- \| 括号里的参数表
     args = case stripSuffixMaybe ")" (drop 1 rest) of
         Nothing -> []
         Just inner -> map (filter (not . isSpace)) (splitOn ',' inner)
@@ -265,6 +266,8 @@ typeClassOf CRuntime{} = RuntimeClass
 
 -- | 同大类可赋值；日期/时间列接受字符串字面量
 assignable :: ColumnType -> ColumnType -> Bool
+assignable (CDomain _ base) source = assignable base source
+assignable target (CDomain _ base) = assignable target base
 assignable target source
     | source == CNull = True
     | target == source = True
@@ -284,19 +287,29 @@ integerType _ = False
 
 -- | 比较用的类型族：同大类可比，日期时间与文本互比
 comparableTypes :: ColumnType -> ColumnType -> Bool
+comparableTypes (CDomain _ base) other = comparableTypes base other
+comparableTypes other (CDomain _ base) = comparableTypes other base
 comparableTypes a b
-    | typeClassOf a == RuntimeClass || typeClassOf b == RuntimeClass = False
+    | a == CNull || b == CNull = True
+    | typeClassOf a == RuntimeClass || typeClassOf b == RuntimeClass = a == b && hasTypeCapability EqCapability a
     | otherwise = a == CNull || b == CNull || sameClass || crossTemporal
   where
-    -- | 两个类型同属一个大类
+    -- \| 两个类型同属一个大类
     sameClass = typeClassOf a == typeClassOf b
-    -- | 时间与文本放在一起比
+    -- \| 时间与文本放在一起比
     crossTemporal = (temporal a && textual b) || (textual a && temporal b)
-    -- | 是不是时间类型
+    -- \| 是不是时间类型
     temporal t = typeClassOf t == TemporalClass
-    -- | 是不是文本类型
+    -- \| 是不是文本类型
     textual t = typeClassOf t == TextClass
 
+-- | 领域沿用基础类型的已注册值运算能力
+hasTypeCapability :: TypeCapability -> ColumnType -> Bool
+hasTypeCapability capability (CDomain _ base) = hasTypeCapability capability base
+hasTypeCapability capability (CRuntime tid) =
+    either (const False) (elem capability . descriptorCapabilities) (describeType builtinTypes tid)
+hasTypeCapability _ _ = True
+
 -- | 是不是数值类型
 numericType :: ColumnType -> Bool
 numericType t = typeClassOf t == NumericClass
@@ -380,9 +393,9 @@ toDecimal p s v
         VFloat d -> rounded d
         _ -> Left ("cannot put this value into " ++ typeLabel (CDecimal p s))
   where
-    -- | 缩放因子
+    -- \| 缩放因子
     scale = (10 :: Double) ^ s
-    -- | 按比例四舍五入
+    -- \| 按比例四舍五入
     rounded d
         | isNaN d || isInfinite d || isInfinite (d * scale) = Left "decimal value is not finite or exceeds precision"
         | abs result >= (10 :: Double) ^ (p - s) = Left "decimal value exceeds precision"
@@ -443,7 +456,6 @@ validTimeText t = case splitOn ':' t of
 allOf :: Int -> String -> Bool
 allOf n s = length s == n && all isDigit s
 
-
 -- | 引擎里的一行值
 data Value
     = VNull
@@ -480,7 +492,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))
+    (VRuntime tx x, VRuntime ty y) -> compare (tx, x) (ty, y)
     (x, y) -> compare (valueRank x) (valueRank y)
 
 -- | 族的先后，只用来给异族值定序
@@ -504,7 +516,7 @@ 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))
+    VRuntime tid value -> hashWithSalt 4 (BS.unpack (encodeType tid), value)
 
 -- | 解析现有标量列的逻辑类型
 scalarTypeExpression :: ColumnType -> Maybe TypeExpr
@@ -526,14 +538,6 @@ 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
     hashWithSalt s = hashWithSalt s . hashValue
@@ -635,11 +639,11 @@ resolveTable db name = case lookup name db of
         | [(key, table)] <- suffixed -> Right (key, table)
         | otherwise -> Left (miss suffixed)
   where
-    -- | 引用里去掉库前缀的那一段
+    -- \| 引用里去掉库前缀的那一段
     bare = lastTablePart name
-    -- | schema 里以这个表名收尾的键：`sales.users` 能推出裸表名引用
+    -- \| schema 里以这个表名收尾的键：`sales.users` 能推出裸表名引用
     suffixed = [(key, table) | (key, table) <- db, ('.' : name) `isSuffixOf` key]
-    -- | 一个候选都没有就是查无此表，多于一个就是有歧义
+    -- \| 一个候选都没有就是查无此表，多于一个就是有歧义
     miss [] = "unknown table: " ++ name
     miss _ = "ambiguous table: " ++ name
 
@@ -664,6 +668,8 @@ resolveColumn name env = case [(k, v) | (k, v) <- env, matches k] of
     [] -> Left ("unknown column: " ++ name)
     _ -> Left ("ambiguous column: " ++ name)
   where
-    -- | 裸名匹配末段，库限定名只补一层前缀
-    matches k = k == name || ('.' : name) `isSuffixOf` k
-        || (length (filter (== '.') name) == 2 && length (filter (== '.') k) == 1 && ('.' : k) `isSuffixOf` name)
+    -- \| 裸名匹配末段，库限定名只补一层前缀
+    matches k =
+        k == name
+            || ('.' : name) `isSuffixOf` k
+            || (length (filter (== '.') name) == 2 && length (filter (== '.') k) == 1 && ('.' : k) `isSuffixOf` name)

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

@@ -105,6 +105,14 @@ data Request
     | ReqDropIndex String String
     | ReqDropColumn String String
     | ReqReplaceSchema String [SchemaColumn] [Row]
+    | ReqDomainSnapshot
+    | ReqDatabaseSnapshot (Maybe String)
+    | ReqMvccBegin Bool
+    | ReqMvccLock String [TxnOp] [String]
+    | ReqMvccPreview String
+    | ReqMvccCommit String String
+    | ReqMvccRollback String
+    | ReqAlterDomain String [SchemaColumn] String
     | ReqListCatalog
     | ReqApplyTransaction [TxnOp]
 
@@ -253,6 +261,14 @@ instance ToJSON Request where
             , "columns" .= cols
             , "rows" .= map rowToJSON rs
             ]
+    toJSON (ReqMvccBegin serializable) = object ["method" .= ("mvcc_begin" :: T.Text), "serializable" .= serializable]
+    toJSON (ReqMvccLock token ops dependencies) = object ["method" .= ("mvcc_lock" :: T.Text), "transaction" .= token, "ops" .= ops, "reads" .= dependencies]
+    toJSON (ReqMvccPreview token) = object ["method" .= ("mvcc_preview" :: T.Text), "transaction" .= token]
+    toJSON (ReqMvccCommit token checkpoint) = object ["method" .= ("mvcc_commit" :: T.Text), "transaction" .= token, "checkpoint" .= checkpoint, "ops" .= ([] :: [TxnOp])]
+    toJSON (ReqMvccRollback token) = object ["method" .= ("mvcc_rollback" :: T.Text), "transaction" .= token]
+    toJSON ReqDomainSnapshot = object ["method" .= ("domain_snapshot" :: T.Text)]
+    toJSON (ReqDatabaseSnapshot checkpoint) = object ["method" .= ("database_snapshot" :: T.Text), "checkpoint" .= checkpoint]
+    toJSON (ReqAlterDomain name columns checkpoint) = object ["method" .= ("alter_domain" :: T.Text), "table" .= name, "columns" .= columns, "checkpoint" .= checkpoint]
     toJSON ReqListCatalog = object ["method" .= ("list_catalog" :: T.Text)]
     toJSON (ReqApplyTransaction ops) =
         object
@@ -418,6 +434,9 @@ data Response
     | RespOk
     | RespError String
     | RespCatalog [TableInfo]
+    | RespDomainSnapshot [TableInfo] [(String, [Row])] String
+    | RespSnapshotUnchanged String
+    | RespMvccSnapshot String [TableInfo] [(String, [Row])] String
 
 -- | JSON 解回响应
 instance FromJSON Response where
@@ -432,6 +451,17 @@ instance FromJSON Response where
             "tables" -> RespTables <$> o .: "tables"
             "error" -> RespError <$> o .: "message"
             "schema" -> RespSchema <$> parseJSON (A.Object o)
+            "snapshot_unchanged" -> RespSnapshotUnchanged <$> o .: "checkpoint"
+            "mvcc_snapshot" -> do
+                schemas <- o .: "schemas"
+                tables <- o .: "rows" :: Parser [(String, [A.Value])]
+                rows <- mapM (\(name, values) -> (,) name <$> mapM rowFromJSON values) tables
+                RespMvccSnapshot <$> o .: "transaction" <*> pure schemas <*> pure rows <*> o .: "checkpoint"
+            "domain_snapshot" -> do
+                schemas <- o .: "schemas"
+                tables <- o .: "rows" :: Parser [(String, [A.Value])]
+                rows <- mapM (\(name, values) -> (,) name <$> mapM rowFromJSON values) tables
+                RespDomainSnapshot schemas rows <$> o .: "checkpoint"
             "catalog" -> do
                 xs <- o .: "schemas" :: Parser [A.Value]
                 RespCatalog <$> mapM parseJSON xs

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

@@ -1,19 +1,45 @@
-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
+module ChuSQL.Core.Runtime (
+    TypeConstructorId (..),
+    TypeId,
+    TypeExpr (..),
+    Kind (..),
+    TypeRegistry,
+    TypeDescriptor (..),
+    TypeCapability (..),
+    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 Control.Monad (zipWithM, zipWithM_)
 import Data.Aeson (Value (..), eitherDecode, encode)
 import Data.Aeson.Types (Parser, parseEither)
 import qualified Data.ByteString.Lazy as BS
+import Data.Char (isAlphaNum, toLower)
+import Data.Hashable (Hashable (..))
 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
 
 -- 运行时类型身份、构造器注册及版本化物理编码。
@@ -31,30 +57,66 @@ 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 PhysicalType
+    = SignedInteger
+    | FloatingPoint
+    | Boolean
+    | Utf8
+    | Sequence PhysicalType
+    | Optional PhysicalType
+    | Product [PhysicalType]
+    deriving (Show, Eq)
+
+-- | 类型实例可提供的值运算
+data TypeCapability = EqCapability | OrdCapability | HashCapability deriving (Show, Eq)
 
 -- | 保存类型实例描述
 data TypeDescriptor = TypeDescriptor
-    { descriptorId :: TypeId, descriptorName :: String, descriptorPhysical :: PhysicalType
-    } deriving (Show, Eq)
+    { descriptorId :: TypeId
+    , descriptorName :: String
+    , descriptorPhysical :: PhysicalType
+    , descriptorCapabilities :: [TypeCapability]
+    }
+    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)
+data RuntimeValue
+    = RInt Int
+    | RDouble Double
+    | RBool Bool
+    | RString String
+    | RList [RuntimeValue]
+    | RMaybe (Maybe RuntimeValue)
+    | RTuple [RuntimeValue]
+    deriving (Show, Eq, Ord)
+
+-- | 递归哈希结构并统一浮点正负零
+instance Hashable RuntimeValue where
+    -- \| 根据构造器和子值混合哈希
+    hashWithSalt salt value = case value of
+        RInt n -> hashWithSalt (hashWithSalt salt (1 :: Int)) n
+        RDouble n -> hashWithSalt (hashWithSalt salt (2 :: Int)) (if n == 0 then 0 else n)
+        RBool flag -> hashWithSalt (hashWithSalt salt (3 :: Int)) flag
+        RString text -> hashWithSalt (hashWithSalt salt (4 :: Int)) text
+        RList values -> hashWithSalt (hashWithSalt salt (5 :: Int)) values
+        RMaybe optional -> hashWithSalt (hashWithSalt salt (6 :: Int)) optional
+        RTuple values -> hashWithSalt (hashWithSalt salt (7 :: Int)) values
 
 -- | 恢复固定编号的内建构造器
 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)]
+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
@@ -96,7 +158,7 @@ renderTypeExpr ty@(TypeApply cid arguments) = case (cid, arguments) of
     (TypeConstructorId 7, fields) -> "(" ++ joinTypes fields ++ ")"
     _ -> show ty
   where
-    -- | 连接元组字段类型
+    -- \| 连接元组字段类型
     joinTypes [] = ""
     joinTypes [field] = renderTypeExpr field
     joinTypes (field : fields) = renderTypeExpr field ++ ", " ++ joinTypes fields
@@ -107,25 +169,28 @@ parseTypeExpr source = case P.readP_to_S (P.skipSpaces *> expression <* P.skipSp
     [(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 ",")))
-    -- | 解析具有名称边界的类型关键字
+    -- \| 解析类型原子和构造器应用
+    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)
 
 -- | 渲染运行时值的可读文本
@@ -165,7 +230,12 @@ resolveType registry@(TypeRegistry constructors) expression@(TypeApply cid args)
         (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)
+    let capabilities =
+            [ capability
+            | capability <- [EqCapability, OrdCapability, HashCapability]
+            , all (elem capability . descriptorCapabilities) children
+            ]
+    Right (TypeDescriptor (TypeId expression) name physical capabilities)
 
 -- | 按身份查询类型描述
 describeType :: TypeRegistry -> TypeId -> Either String TypeDescriptor
@@ -216,10 +286,12 @@ 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
+    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