Byte marshalling

2026-05-06 17:25:42 -05:00
parent e7a6426060
commit 1c4c49e68d
2 changed files with 153 additions and 0 deletions
--- 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
 -- --------------------------------------------------------------------------