James/tricu
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Full Arboricx parsing in tricu

Browse Source
This commit is contained in:
James Eversole
2026-05-09 17:43:45 -05:00
parent 6dd4c3e607
commit 2773109b87
7 changed files with 1592 additions and 651 deletions
Download Patch File Download Diff File Expand all files Collapse all files

553
test/Spec.hs
View File

@@ -49,6 +49,7 @@ tests = testGroup "Tricu Tests"
, wireTests
, byteListUtilities
, binaryReaderTests
, manifestReadingTests
]
lexer :: TestTree
@@ -2182,3 +2183,555 @@ binaryReaderTests = testGroup "Binary Reader Tests"
let env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf
]
-- ---------------------------------------------------------------------------
-- Manifest reading tests (Steps 1-9)
-- ---------------------------------------------------------------------------
-- Build a minimal manifest:
-- magic "ARBMNFST" (8) + version 1.0 (4) +
-- schema "arboricx.bundle.manifest.v1" (4+27=31) +
-- bundleType "tree-calculus-executable-object" (4+31=35) +
-- treeCalculus "tree-calculus.v1" (4+16=20) +
-- treeHashAlgorithm "sha256" (4+6=10) +
-- treeHashDomain "arboricx.merkle.node.v1" (4+23=27) +
-- treeNodePayload "arboricx.merkle.payload.v1" (4+26=30) +
-- runtimeSemantics "tree-calculus.v1" (4+16=20) +
-- runtimeEvaluation "normal-order" (4+12=16) +
-- runtimeAbi "arboricx.abi.tree.v1" (4+20=24) +
-- capabilityCount 0 (4) +
-- closure 0 (1) +
-- rootCount 1 (4) +
-- root: hash (32) + role "default" (4+7=11) = 43 +
-- exportCount 1 (4) +
-- export: name "term" (4+4=8) + root (32) + kind "term" (4+4=8) + abi "arboricx.abi.tree.v1" (4+20=24) = 72 +
-- Total core = 8+4+31+35+20+10+27+30+20+16+24+4+1+4+43+4+72 = 378 bytes
minimalManifestCoreBytes :: [Integer]
minimalManifestCoreBytes = [65,82,66,77,78,70,83,84] -- ARBMNFST magic
++ u16 1 ++ u16 0 -- version 1.0
++ lengthPrefixed "arboricx.bundle.manifest.v1" -- schema
++ lengthPrefixed "tree-calculus-executable-object" -- bundleType
++ lengthPrefixed "tree-calculus.v1" -- treeCalculus
++ lengthPrefixed "sha256" -- treeHashAlgorithm
++ lengthPrefixed "arboricx.merkle.node.v1" -- treeHashDomain
++ lengthPrefixed "arboricx.merkle.payload.v1" -- treeNodePayload
++ lengthPrefixed "tree-calculus.v1" -- runtimeSemantics
++ lengthPrefixed "normal-order" -- runtimeEvaluation
++ lengthPrefixed "arboricx.abi.tree.v1" -- runtimeAbi
++ u32 0 -- 0 capabilities
++ [0] -- closure complete
++ u32 1 -- 1 root
++ replicate 32 0 -- placeholder root hash
++ lengthPrefixed "default" -- root role
++ u32 1 -- 1 export
++ lengthPrefixed "term" -- export name
++ replicate 32 0 -- placeholder export root hash
++ lengthPrefixed "term" -- export kind
++ lengthPrefixed "arboricx.abi.tree.v1" -- export abi
lengthPrefixed :: String -> [Integer]
lengthPrefixed s = u32 (fromIntegral (length s)) ++ map (fromIntegral . fromEnum) s
-- Full manifest: core + 0 metadata + 0 extension = core + u32(0) + u32(0)
fullMinimalManifestBytes :: [Integer]
fullMinimalManifestBytes = minimalManifestCoreBytes ++ u32 0 ++ u32 0
-- Create TLV list with two entries:
-- tag 1 (package), value "my-pkg", then tag 2 (version), value "1.0"
-- then "rest" bytes
tlvForTagAndValue :: Integer -> String -> [Integer]
tlvForTagAndValue tag val =
u16 (fromIntegral tag) ++ lengthPrefixed val
-- Build a pair of (tag, value) TLV
makeTLVPair :: Integer -> String -> String
makeTLVPair tag val =
"[(pair " ++ bytesExpr [0, fromIntegral tag] ++ " "
++ bytesExpr (map (fromIntegral . fromEnum) val) ++ ")]"
exportEntryExpr :: String -> [Integer] -> String -> String -> String
exportEntryExpr name rootHashBytes kind abi =
"(pair " ++ bytesExpr (map (fromIntegral . fromEnum) name) ++ " "
++ "(pair " ++ bytesExpr rootHashBytes ++ " "
++ "(pair " ++ bytesExpr (map (fromIntegral . fromEnum) kind) ++ " "
++ bytesExpr (map (fromIntegral . fromEnum) abi) ++ ")))"
-- Build list of export entries for the test
singleExportExpr :: String
singleExportExpr =
"[" ++ exportEntryExpr "main" (replicate 32 0) "term" "arboricx.abi.tree.v1" ++ "]"
multiExportExpr :: String
multiExportExpr =
"["
++ exportEntryExpr "main" (replicate 32 0) "term" "arboricx.abi.tree.v1"
-- ++ ", "
++ exportEntryExpr "test" (replicate 32 1) "term" "arboricx.abi.tree.v1"
++ "]"
-- Helper to build a minimal valid manifest core
-- Returns a tricu expression representing the parsed core structure
buildValidCoreExpr :: String
buildValidCoreExpr =
"(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "arboricx.bundle.manifest.v1") ++ " " -- schema
++ "(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "tree-calculus-executable-object") ++ " " -- bundleType
++ "(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "tree-calculus.v1") ++ " " -- treeCalculus
++ "(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "sha256") ++ " " -- treeHashAlgorithm
++ "(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "arboricx.merkle.node.v1") ++ " " -- treeHashDomain
++ "(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "arboricx.merkle.payload.v1") ++ " " -- treeNodePayload
++ "(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "tree-calculus.v1") ++ " " -- runtimeSemantics
++ "(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "normal-order") ++ " " -- runtimeEvaluation
++ "(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "arboricx.abi.tree.v1") ++ " " -- runtimeAbi
++ "(pair "
++ "[] " -- capabilities
++ "(pair "
++ "0 " -- closure
++ "(pair "
++ "[(pair " ++ bytesExpr (replicate 32 0) ++ " "
++ bytesExpr (map (fromIntegral . fromEnum) "default") ++ ")" -- roots (1 root)
++ "] "
++ "[(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "term") ++ " "
++ "(pair " ++ bytesExpr (replicate 32 0) ++ " "
++ "(pair "
++ bytesExpr (map (fromIntegral . fromEnum) "term") ++ " "
++ bytesExpr (map (fromIntegral . fromEnum) "arboricx.abi.tree.v1") ++ ")))" -- exports (1 export)
++ "])"
++ "]"
++ "]"
++ "]"
++ "]"
++ "]"
++ "]"
++ "]"
++ "]"
++ "]"
++ "]"
++ "]"
++ "]"
++ ")"
-- Build a tricu expression that extracts a specific manifest field from
-- readArboricxBundle result and returns it as a byte-list T value.
-- The Haskell test then uses toString to convert it to a String.
extractManifestField :: ByteString -> String -> String
extractManifestField fixtureBytes fieldName =
"matchResult "
++ " (errCode rest : errCode) "
++ " (bundleResult rest : "
++ " matchPair "
++ " (validCore metadataWithExtensions : "
++ " " ++ fieldName ++ " validCore) "
++ " bundleResult) "
++ " (readArboricxBundle " ++ bytesExpr (map toInteger $ BS.unpack fixtureBytes) ++ ")"
manifestReadingTests :: TestTree
manifestReadingTests = testGroup "Manifest Reading Tests"
[
-- ------------------------------------------------------------------------
-- Step 1: readManifestMagic
-- ------------------------------------------------------------------------
testCase "readManifestMagic: accepts correct manifest magic and preserves rest" $ do
let input = "readManifestMagic ((append arboricxManifestMagic) [(1) (2)])"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT unitT (bytesT [1,2])
, testCase "readManifestMagic: rejects wrong magic" $ do
let input = "readManifestMagic [(65) (83) (66) (77) (78) (70) (83) (84)]"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT unexpectedBytesT (bytesT [65,83,66,77,78,70,83,84])
, testCase "readManifestMagic: short input returns EOF" $ do
let input = "readManifestMagic [(65) (82) (66) (77)]"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [65,82,66,77])
-- ------------------------------------------------------------------------
-- Step 2: readLengthPrefixedString
-- ------------------------------------------------------------------------
, testCase "readLengthPrefixedString: reads a 5-byte string" $ do
let input = "readLengthPrefixedString [(0) (0) (0) (5) (104) (101) (108) (108) (111) (99) (111) (110) (116) (101) (114)]"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (bytesT [104,101,108,108,111]) (bytesT [99,111,110,116,101,114])
, testCase "readLengthPrefixedString: reads an empty string" $ do
let input = "readLengthPrefixedString [(0) (0) (0) (0) (97) (98)]"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (bytesT []) (bytesT [97,98])
, testCase "readLengthPrefixedString: short payload returns EOF" $ do
let input = "readLengthPrefixedString [(0) (0) (0) (5) (104) (101) (108)]"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [104,101,108])
-- ------------------------------------------------------------------------
-- Step 3: readManifestCore (construct a minimal valid manifest)
-- ------------------------------------------------------------------------
, testCase "readManifestCore: reads a minimal valid manifest core" $ do
let input = "readManifestCore " ++ bytesExpr minimalManifestCoreBytes
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork Leaf Leaf) -> assertFailure "should be ok, not t"
(Fork _ (Fork _ rest)) -> return () -- ok case: pair true (pair value rest)
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
, testCase "readManifestCore: returns error on wrong magic" $ do
let badMagic = [65,83,66,77,78,70,83,84] ++ (drop 8 minimalManifestCoreBytes)
let input = "readManifestCore " ++ bytesExpr badMagic
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork falseT _) -> return () -- err case: pair false (pair code rest)
_ -> assertFailure $ "expected err result, got: " ++ show actualResult
-- ------------------------------------------------------------------------
-- Step 4: TLV reader
-- ------------------------------------------------------------------------
, testCase "readTLV: reads a metadata TLV entry" $ do
-- tag = u16 1 = [(0)(1)], length = u32 3 = [(0)(0)(0)(3)], value = "foo" = [102,111,111]
let input = "readTLV [(0) (1) (0) (0) (0) (3) (102) (111) (111) (99) (111) (110) (116) (114) (101) (115) (116)]"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork _ (Fork _ rest)) -> do
-- ok case: verify the value pair
let value = case result env of
(Fork _ (Fork val _)) -> case val of
(Fork tagVal _) -> tagVal
_ -> Leaf
return ()
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
, testCase "readTLV: returns EOF on empty input" $ do
let input = "readTLV []"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [])
, testCase "readTLV: returns EOF on short tag" $ do
let input = "readTLV [(0)]"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0])
, testCase "readTLVList: reads zero TLV entries" $ do
let input = "readTLVList 0 [(1) (2) (3)]"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (ofList []) (bytesT [1,2,3])
, testCase "readTLVList: reads one TLV entry and preserves rest" $ do
-- tag=1, len=3, value="foo"
let input = "readTLVList 1 [(0) (1) (0) (0) (0) (3) (102) (111) (111) (99) (111) (110) (116) (114) (101) (115) (116)]"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork _ (Fork _ rest)) -> do
-- ok: value is list with one TLV, rest should be [(99)...]
return ()
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
-- ------------------------------------------------------------------------
-- Step 5: readManifest (full parser)
-- ------------------------------------------------------------------------
, testCase "readManifest: parses a minimal manifest with no metadata" $ do
let input = "readManifest " ++ bytesExpr fullMinimalManifestBytes
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork _ (Fork _ _)) -> return () -- ok result
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
, testCase "readManifest: preserves trailing extension bytes" $ do
let input = "readManifest (append " ++ bytesExpr fullMinimalManifestBytes ++ " [(99) (111) (110) (116) (101) (110) (116) (101) (114)])"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork trueTag (Fork _ _)) | trueTag == trueT -> return ()
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
-- ------------------------------------------------------------------------
-- Step 6: lookupMetadata
-- ------------------------------------------------------------------------
, testCase "lookupMetadata: finds metadata by tag" $ do
let tlv1 = makeTLVPair 1 "my-pkg"
let tlv2 = makeTLVPair 2 "1.0"
let input = "lookupMetadata (" ++ tlv1 ++ ") " ++ bytesExpr [(0), (1)]
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= justT (bytesT [109,121,45,112,107,103])
, testCase "lookupMetadata: returns nothing for unknown tag" $ do
let tlv1 = makeTLVPair 1 "my-pkg"
let input = "lookupMetadata " ++ tlv1 ++ " " ++ bytesExpr [(0), (2)]
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= nothingT
, testCase "lookupMetadata: returns nothing for empty list" $ do
let input = "lookupMetadata [] " ++ bytesExpr [(0), (1)]
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= nothingT
-- ------------------------------------------------------------------------
-- Step 7: Export selection
-- ------------------------------------------------------------------------
-- Build export entry: (pair name (pair rootHash (pair kind abi)))
-- Test: select export by explicit name ("main")
, testCase "selectExport: finds export by explicit name" $ do
let input = "selectExport " ++ multiExportExpr ++ " " ++ bytesExpr (map (fromIntegral . fromEnum) "main")
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork _ (Fork _ _)) -> return () -- ok result
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
-- Test: selectExport prefers "main" when no explicit name
, testCase "selectExport: selects 'main' when no explicit name and 'main' exists" $ do
let input = "selectExport " ++ multiExportExpr ++ " " ++ bytesExpr []
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork _ (Fork _ _)) -> return () -- ok result
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
-- Test: selectExport selects single export when only one exists
, testCase "selectExport: auto-selects single export" $ do
let input = "selectExport " ++ singleExportExpr ++ " " ++ bytesExpr []
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork _ (Fork _ _)) -> return () -- ok result
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
-- Test: getExportNames lists all export names
, testCase "getExportNames: returns list of all export names" $ do
let input = "getExportNames " ++ multiExportExpr
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
-- Should return a list of two byte strings
case actualResult of
(Fork (Fork _ _) (Fork (Fork _ _) _)) -> return () -- list with 2 items
_ -> assertFailure $ "expected list of 2 items, got: " ++ show actualResult
-- Test: selectExport errors when multiple exports but no "main" and no explicit name
, testCase "selectExport: errors with multiple exports but no 'main'" $ do
let multiNoMain =
"["
++ exportEntryExpr "validate" (replicate 32 0) "term" "arboricx.abi.tree.v1"
++ " "
++ exportEntryExpr "test" (replicate 32 1) "term" "arboricx.abi.tree.v1"
++ "]"
let input = "selectExport " ++ multiNoMain ++ " " ++ bytesExpr []
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork falseT _) -> return () -- err result
_ -> assertFailure $ "expected err result, got: " ++ show actualResult
-- Test: selectExportOpt works with Just bytes (explicit name given)
, testCase "selectExportOpt: selects by explicit name when given" $ do
let input = "selectExportOpt " ++ multiExportExpr ++ " " ++ bytesExpr (map (fromIntegral . fromEnum) "validate")
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork _ (Fork _ _)) -> return () -- ok result
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
-- ------------------------------------------------------------------------
-- Step 8: validateManifestCore
-- ------------------------------------------------------------------------
, testCase "validateManifestCore: passes on valid core" $ do
let input = "matchResult (code rest : err code rest) (core rest : validateManifestCore core " ++ bytesExpr [(1), (2)] ++ ") (readManifestCore " ++ bytesExpr minimalManifestCoreBytes ++ ")"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork trueTag (Fork _ rest)) | trueTag == trueT -> rest @?= bytesT [1,2]
_ -> assertFailure $ "expected ok result, got: " ++ show actualResult
, testCase "validateManifestCore: fails on wrong schema" $ do
let badCoreBytes = take 16 minimalManifestCoreBytes ++ map (fromIntegral . fromEnum) "z" ++ drop 17 minimalManifestCoreBytes
let input = "matchResult (code rest : err code rest) (core rest : validateManifestCore core " ++ bytesExpr [] ++ ") (readManifestCore " ++ bytesExpr badCoreBytes ++ ")"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork falseTag _) | falseTag == falseT -> return ()
_ -> assertFailure $ "expected err result, got: " ++ show actualResult
-- ------------------------------------------------------------------------
-- Step 9: readArboricxBundle (end-to-end with real fixture)
-- ------------------------------------------------------------------------
, testCase "readArboricxBundle: parses id.arboricx fixture" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> do
let manifestBytes = bundleManifestBytes bundle
-- The manifest section should be parseable
let input = "readManifest " ++ bytesExpr (map toInteger (BS.unpack manifestBytes))
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork trueTag (Fork _ _)) | trueTag == trueT -> return ()
_ -> assertFailure $ "readManifest failed on id.arboricx manifest: " ++ show actualResult
, testCase "readArboricxBundle: end-to-end bundle parse" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
let input = "readArboricxBundle " ++ bytesExpr (map toInteger (BS.unpack fixtureBytes))
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork _ (Fork _ _)) -> return () -- ok: (pair validManifest afterManifest)
_ -> assertFailure $ "readArboricxBundle failed: " ++ show actualResult
, testCase "readArboricxBundle: rejects bundle with wrong manifest core" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
-- Modify a byte in the manifest section to invalidate it
-- The manifest starts at offset 152 in the bundle (from header dirOffset=32)
-- Section directory: 2 entries * 60 = 120 bytes, starting at offset 32
-- Manifest entry at directory offset 32: type(4) + version(2) + flags(2) + compression(2) + digestAlg(2) + offset(8) + length(8) + digest(32) = 60
-- Manifest offset = 32 + 60 = 92
-- The manifest itself starts at offset 152 (0x98)
-- Change byte at position 152+8 = 160 from 'a' (97) to 'z' (122) to break the schema string
let bs = map toInteger (BS.unpack fixtureBytes)
let modifiedBs = take 160 bs ++ [122] ++ drop 161 bs
let input = "readArboricxBundle " ++ bytesExpr modifiedBs
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let actualResult = result env
case actualResult of
(Fork falseT _) -> return () -- err result (validation failure)
_ -> assertFailure $ "expected err result, got: " ++ show actualResult
-- ------------------------------------------------------------------------
-- Comprehensive end-to-end: extract manifest fields and verify as strings
-- ------------------------------------------------------------------------
, testCase "readArboricxBundle: extracts and validates manifest schema" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
let input = extractManifestField fixtureBytes "manifestSchema"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let schemaT = result env
toString schemaT @?= Right "arboricx.bundle.manifest.v1"
, testCase "readArboricxBundle: extracts and validates bundleType" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
let input = extractManifestField fixtureBytes "manifestBundleType"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let bundleTypeT = result env
toString bundleTypeT @?= Right "tree-calculus-executable-object"
, testCase "readArboricxBundle: extracts and validates runtime evaluation" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
let input = extractManifestField fixtureBytes "manifestRuntimeEvaluation"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let evalT = result env
toString evalT @?= Right "normal-order"
, testCase "readArboricxBundle: extracts and validates runtime ABI" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
let input = extractManifestField fixtureBytes "manifestRuntimeAbi"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let abiT = result env
toString abiT @?= Right "arboricx.abi.tree.v1"
, testCase "readArboricxBundle: extracts and validates root names" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
let input = "matchResult "
++ " (errCode rest : errCode) "
++ " (bundleResult rest : "
++ " matchPair "
++ " (validCore metadataWithExtensions : "
++ " matchList "
++ " (err 99 t) " -- empty roots
++ " (rootEntry rest : "
++ " matchPair "
++ " (_ roleField : roleField) "
++ " rootEntry) "
++ " (manifestRoots validCore)) "
++ " bundleResult) "
++ " (readArboricxBundle " ++ bytesExpr (map toInteger $ BS.unpack fixtureBytes) ++ ")"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let rootRoleT = result env
-- Should find at least one root with a role (either "default" or "root")
case toString rootRoleT of
Right role -> assertBool "root role should be 'default' or 'root'"
(role == "default" || role == "root")
Left err -> assertFailure $ "failed to extract root role: " ++ err
, testCase "readArboricxBundle: extracts and validates closure" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
let input = "matchResult "
++ " (errCode rest : errCode) "
++ " (bundleResult rest : "
++ " matchPair "
++ " (validCore metadataWithExtensions : "
++ " matchPair "
++ " (closure _ : closure) "
++ " (manifestClosureByte validCore)) "
++ " bundleResult) "
++ " (readArboricxBundle " ++ bytesExpr (map toInteger $ BS.unpack fixtureBytes) ++ ")"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let closureT = result env
case toNumber closureT of
Right 0 -> return ()
Right n -> assertFailure $ "closure should be 0, got " ++ show n
Left err -> assertFailure $ "failed to extract closure: " ++ err
, testCase "readArboricxBundle: extracts and validates hash algorithm" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.arboricx"
let input = extractManifestField fixtureBytes "manifestTreeHashAlgorithm"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
let algoT = result env
toString algoT @?= Right "sha256"
]