Byte marshalling
This commit is contained in:
@@ -7,6 +7,7 @@ import Data.List (intercalate)
|
|||||||
import Data.Map ()
|
import Data.Map ()
|
||||||
import Data.Text (Text, replace)
|
import Data.Text (Text, replace)
|
||||||
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
|
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
|
||||||
|
import Data.Word (Word8)
|
||||||
import System.Console.CmdArgs (Data, Typeable)
|
import System.Console.CmdArgs (Data, Typeable)
|
||||||
|
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
@@ -109,6 +110,61 @@ deserializeNode bs =
|
|||||||
|
|
||||||
_ -> errorWithoutStackTrace "invalid merkle node payload"
|
_ -> 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.
|
-- | Build a Merkle DAG from a Tree Calculus term.
|
||||||
buildMerkle :: T -> Node
|
buildMerkle :: T -> Node
|
||||||
buildMerkle Leaf = NLeaf
|
buildMerkle Leaf = NLeaf
|
||||||
|
|||||||
97
test/Spec.hs
97
test/Spec.hs
@@ -44,6 +44,7 @@ tests = testGroup "Tricu Tests"
|
|||||||
, decoding
|
, decoding
|
||||||
, elimLambdaSingle
|
, elimLambdaSingle
|
||||||
, stressElimLambda
|
, stressElimLambda
|
||||||
|
, byteMarshallingTests
|
||||||
, wireTests
|
, wireTests
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -650,6 +651,102 @@ stressElimLambda = testCase "stress elimLambda on wide list under deep curried l
|
|||||||
after = result (evalTricu Map.empty out)
|
after = result (evalTricu Map.empty out)
|
||||||
after @?= before
|
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
|
-- Wire module tests
|
||||||
-- --------------------------------------------------------------------------
|
-- --------------------------------------------------------------------------
|
||||||
|
|||||||
Reference in New Issue
Block a user