From 1c4c49e68dbd0f04aaef86cbf679e960483d0f41 Mon Sep 17 00:00:00 2001
From: James Eversole <james@eversole.co>
Date: Wed, 6 May 2026 17:25:42 -0500
Subject: [PATCH] Byte marshalling

---
 src/Research.hs | 56 ++++++++++++++++++++++++++++
 test/Spec.hs    | 97 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 153 insertions(+)

diff --git a/src/Research.hs b/src/Research.hs
index 415d358..86101a3 100644
--- a/src/Research.hs
+++ b/src/Research.hs
@@ -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
diff --git a/test/Spec.hs b/test/Spec.hs
index 417266f..39f99fa 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -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
 -- --------------------------------------------------------------------------