Byte marshalling
This commit is contained in:
@@ -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
|
||||
|
||||
97
test/Spec.hs
97
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
|
||||
-- --------------------------------------------------------------------------
|
||||
|
||||
Reference in New Issue
Block a user