Byte marshalling

This commit is contained in:
2026-05-06 17:25:42 -05:00
parent e7a6426060
commit 1c4c49e68d
2 changed files with 153 additions and 0 deletions

View File

@@ -7,6 +7,7 @@ import Data.List (intercalate)
import Data.Map () import Data.Map ()
import Data.Text (Text, replace) import Data.Text (Text, replace)
import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Word (Word8)
import System.Console.CmdArgs (Data, Typeable) import System.Console.CmdArgs (Data, Typeable)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
@@ -109,6 +110,61 @@ deserializeNode bs =
_ -> errorWithoutStackTrace "invalid merkle node payload" _ -> errorWithoutStackTrace "invalid merkle node payload"
-- ---------------------------------------------------------------------------
-- ByteString / bytestream marshalling via existing Tree Calculus conventions
-- ---------------------------------------------------------------------------
-- | Encode a single byte (Word8) as a Tree Calculus number (0..255).
ofByte :: Word8 -> T
ofByte = ofNumber . fromIntegral
-- | Decode a Tree Calculus number as a single byte (Word8).
-- Rejects values outside the range 0..255.
toByte :: T -> Either String Word8
toByte t = case toNumber t of
Left err -> Left err
Right n
| n >= 0 && n <= 255 -> Right (fromIntegral n)
| otherwise -> Left ("Byte value out of range: " ++ show n)
-- | Encode a ByteString as a Tree Calculus list of Byte trees.
ofBytes :: BS.ByteString -> T
ofBytes = ofList . map ofByte . BS.unpack
-- | Decode a Tree Calculus list of Byte trees as a ByteString.
-- Rejects non-list trees and elements that are not valid byte values (0..255).
toBytes :: T -> Either String BS.ByteString
toBytes t = case toList t of
Left err -> Left err
Right bs -> BS.pack <$> mapM toByte bs
-- | Convert a canonical Arborix node payload (ByteString) to a Tree
-- representation (a list of Byte trees).
nodePayloadToTreeBytes :: BS.ByteString -> T
nodePayloadToTreeBytes = ofBytes
-- | Convert a Tree representation of a node payload back to ByteString.
treeBytesToNodePayload :: T -> Either String BS.ByteString
treeBytesToNodePayload = toBytes
-- | Convert a MerkleHash (hex-encoded) to a Tree of its 32 raw bytes.
hashToTreeBytes :: MerkleHash -> Either String T
hashToTreeBytes h = case decode (encodeUtf8 h) of
Left _ -> Left "Invalid hex MerkleHash"
Right raw
| BS.length raw == 32 -> Right (ofBytes raw)
| otherwise -> Left "Hash raw bytes must be 32 bytes"
-- | Convert a Tree of 32 Byte trees back to a MerkleHash (hex string).
treeBytesToHash :: T -> Either String MerkleHash
treeBytesToHash t = case toList t of
Left err -> Left err
Right bytes
| length bytes == 32 -> do
raw <- BS.pack <$> mapM toByte bytes
Right $ decodeUtf8 (encode raw)
| otherwise -> Left "Expected exactly 32 byte elements for hash"
-- | Build a Merkle DAG from a Tree Calculus term. -- | Build a Merkle DAG from a Tree Calculus term.
buildMerkle :: T -> Node buildMerkle :: T -> Node
buildMerkle Leaf = NLeaf buildMerkle Leaf = NLeaf

View File

@@ -44,6 +44,7 @@ tests = testGroup "Tricu Tests"
, decoding , decoding
, elimLambdaSingle , elimLambdaSingle
, stressElimLambda , stressElimLambda
, byteMarshallingTests
, wireTests , wireTests
] ]
@@ -650,6 +651,102 @@ stressElimLambda = testCase "stress elimLambda on wide list under deep curried l
after = result (evalTricu Map.empty out) after = result (evalTricu Map.empty out)
after @?= before after @?= before
-- --------------------------------------------------------------------------
-- Byte marshalling tests
-- --------------------------------------------------------------------------
byteMarshallingTests :: TestTree
byteMarshallingTests = testGroup "Byte Marshalling Tests"
[ testCase "ofByte / toByte round-trip: 0" $ do
let w8 = (0 :: Word8)
toByte (ofByte w8) @?= Right w8
, testCase "ofByte / toByte round-trip: 1" $ do
let w8 = (1 :: Word8)
toByte (ofByte w8) @?= Right w8
, testCase "ofByte / toByte round-trip: 127" $ do
let w8 = (127 :: Word8)
toByte (ofByte w8) @?= Right w8
, testCase "ofByte / toByte round-trip: 128" $ do
let w8 = (128 :: Word8)
toByte (ofByte w8) @?= Right w8
, testCase "ofByte / toByte round-trip: 255" $ do
let w8 = (255 :: Word8)
toByte (ofByte w8) @?= Right w8
, testCase "toByte rejects value > 255" $ do
-- ofNumber 256 = Fork Leaf (Fork Leaf Leaf) — value 256
toByte (ofNumber 256) @?= Left "Byte value out of range: 256"
, testCase "toByte accepts Leaf" $ do
toByte (Leaf) @?= Right 0
, testCase "toByte rejects non-number tree" $ do
toByte (Stem Leaf) @?= Left "Invalid Tree Calculus number"
toByte (Stem (Stem Leaf)) @?= Left "Invalid Tree Calculus number"
, testCase "ofBytes / toBytes round-trip: empty ByteString" $ do
toBytes (ofBytes BS.empty) @?= Right BS.empty
, testCase "ofBytes / toBytes round-trip: [0x00]" $ do
toBytes (ofBytes (BS.pack [0x00])) @?= Right (BS.pack [0x00])
, testCase "ofBytes / toBytes round-trip: [0xff]" $ do
toBytes (ofBytes (BS.pack [0xff])) @?= Right (BS.pack [0xff])
, testCase "ofBytes / toBytes round-trip: mixed bytes" $ do
let bytes = BS.pack [0x00, 0x01, 0x7f, 0x80, 0xff, 0x41, 0x42, 0x43]
toBytes (ofBytes bytes) @?= Right bytes
, testCase "toBytes rejects non-list tree" $ do
-- Leaf is a valid list (empty), so this won't work.
-- Stem Leaf is not a list.
toBytes (Stem Leaf) @?= Left "Invalid Tree Calculus list"
, testCase "toBytes rejects list containing invalid byte (>255)" $ do
-- [ofNumber 256, ofNumber 1] — first element is > 255
let badList = ofList [ofNumber 256, ofNumber 1]
toBytes badList @?= Left "Byte value out of range: 256"
, testCase "nodePayloadToTreeBytes / treeBytesToNodePayload: Leaf payload" $ do
-- Leaf payload is 0x00 (1 byte)
let payload = BS.pack [0x00]
treeBytesToNodePayload (nodePayloadToTreeBytes payload) @?= Right payload
, testCase "nodePayloadToTreeBytes / treeBytesToNodePayload: Stem payload" $ do
-- Stem payload: 0x01 || 32-byte hash = 33 bytes
let payload = BS.pack (0x01 : replicate 32 0x42)
treeBytesToNodePayload (nodePayloadToTreeBytes payload) @?= Right payload
, testCase "nodePayloadToTreeBytes / treeBytesToNodePayload: Fork payload" $ do
-- Fork payload: 0x02 || 32-byte hash || 32-byte hash = 65 bytes
let payload = BS.pack (0x02 : replicate 64 0x42)
treeBytesToNodePayload (nodePayloadToTreeBytes payload) @?= Right payload
, testCase "hashToTreeBytes / treeBytesToHash round-trip" $ do
-- Use a known 32-byte hash (SHA256 of "")
let hashStr :: MerkleHash
hashStr = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
case hashToTreeBytes hashStr of
Left err -> assertFailure $ "hashToTreeBytes failed: " ++ err
Right tree -> treeBytesToHash tree @?= Right hashStr
, testCase "hashToTreeBytes rejects invalid hex hash" $ do
hashToTreeBytes "not-a-hash" @?= Left "Invalid hex MerkleHash"
, testCase "hashToTreeBytes rejects non-32-byte hash" $ do
-- "00" decodes to 1 byte, not 32
hashToTreeBytes "00" @?= Left "Hash raw bytes must be 32 bytes"
, testCase "treeBytesToHash rejects wrong byte count" $ do
-- Only 16 bytes, not 32
let t16 = ofBytes (BS.pack [0x41 | _ <- [1..16]])
treeBytesToHash t16 @?= Left "Expected exactly 32 byte elements for hash"
]
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- Wire module tests -- Wire module tests
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------