commit 4c742c4d9e5093ea15e3635ca088f657bc881b3b
parent 55bc8eea789e2df778f21c2490e4e36bf0f20dd9
Author: James Eversole <james@eversole.co>
Date: Wed, 6 May 2026 17:25:42 -0500
Byte marshalling
Diffstat:
| M | src/Research.hs | | | 56 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | test/Spec.hs | | | 97 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 153 insertions(+), 0 deletions(-)
diff --git 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
@@ -44,6 +44,7 @@ tests = testGroup "Tricu Tests"
, decoding
, elimLambdaSingle
, stressElimLambda
+ , byteMarshallingTests
, wireTests
]
@@ -651,6 +652,102 @@ stressElimLambda = testCase "stress elimLambda on wide list under deep curried l
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
-- --------------------------------------------------------------------------
