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.Text (Text, replace)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Word (Word8)
import System.Console.CmdArgs (Data, Typeable)
import qualified Data.ByteString as BS
@@ -109,6 +110,61 @@ deserializeNode bs =
_ -> 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.
buildMerkle :: T -> Node
buildMerkle Leaf = NLeaf

View File

@@ -44,6 +44,7 @@ tests = testGroup "Tricu Tests"
, decoding
, elimLambdaSingle
, stressElimLambda
, byteMarshallingTests
, wireTests
]
@@ -650,6 +651,102 @@ stressElimLambda = testCase "stress elimLambda on wide list under deep curried l
after = result (evalTricu Map.empty out)
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
-- --------------------------------------------------------------------------