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

Add Arborix bundle parsing and reconstruction

Browse Source 
Implement portable Arborix container, section directory, nodes section, and
Merkle DAG reconstruction utilities in tricu libraries. Add byte/list helper
fixes needed for data-first recursion, validate node payloads, duplicate hashes,
and closed child references, and expose executable loading from a root hash.

Expand binary reader coverage with portable header/section tests, nodes-section
parsing, fixture bundle parsing, and execution checks for reconstructed
id/not?/map roots. Refresh fixture bundles and remove obsolete fixtures.
This commit is contained in:
James Eversole
2026-05-07 14:21:24 -05:00
parent a002365651
commit d9f25a2b5a
11 changed files with 1176 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files

617
lib/arborix.tri
View File

@@ -4,6 +4,21 @@
!import "binary.tri" !Local
arborixMagic = [(65) (82) (66) (79) (82) (73) (88) (0)]
arborixMajorVersion = [(0) (1)]
arborixMinorVersion = [(0) (0)]
arborixManifestSectionId = [(0) (0) (0) (1)]
arborixNodesSectionId = [(0) (0) (0) (2)]
errMissingSection = 4
errUnsupportedVersion = 5
errDuplicateSection = 6
errDuplicateNode = 7
errInvalidNodePayload = 8
errMissingNode = 9
nodePayloadLeafTag = 0
nodePayloadStemTag = 1
nodePayloadForkTag = 2
readArborixMagic = (bs : expectBytes arborixMagic bs)
@@ -16,43 +31,126 @@ readArborixHeader = (bs :
(minorVersion afterMinor :
bindResult (readBytes 4 afterMinor)
(sectionCount afterSectionCount :
ok
(pair majorVersion
(pair minorVersion sectionCount))
afterSectionCount)))))
bindResult (readBytes 8 afterSectionCount)
(flags afterFlags :
bindResult (readBytes 8 afterFlags)
(dirOffset afterDirOffset :
ok
(pair majorVersion
(pair minorVersion
(pair sectionCount
(pair flags dirOffset))))
afterDirOffset)))))))
readSectionRecord = (bs :
bindResult (readBytes 2 bs)
bindResult (readBytes 4 bs)
(sectionId afterSectionId :
bindResult (readBytes 4 afterSectionId)
(offset afterOffset :
bindResult (readBytes 4 afterOffset)
(length afterLength :
ok
(pair sectionId
(pair offset length))
afterLength))))
bindResult (readBytes 2 afterSectionId)
(sectionVersion afterSectionVersion :
bindResult (readBytes 2 afterSectionVersion)
(sectionFlags afterSectionFlags :
bindResult (readBytes 2 afterSectionFlags)
(compression afterCompression :
bindResult (readBytes 2 afterCompression)
(digestAlgorithm afterDigestAlgorithm :
bindResult (readBytes 8 afterDigestAlgorithm)
(offset afterOffset :
bindResult (readBytes 8 afterOffset)
(length afterLength :
bindResult (readBytes 32 afterLength)
(digest afterDigest :
ok
(pair sectionId
(pair sectionVersion
(pair sectionFlags
(pair compression
(pair digestAlgorithm
(pair offset
(pair length digest)))))))
afterDigest)))))))))
readSectionDirectory_ = y (self sectionCount i bs acc :
readSectionDirectory_ = y (self bs sectionCount i acc :
matchBool
(ok (reverse acc) bs)
(bindResult (readSectionRecord bs)
(sectionRecord afterSectionRecord :
self sectionCount (succ i) afterSectionRecord (pair sectionRecord acc)))
self afterSectionRecord sectionCount (succ i) (pair sectionRecord acc)))
(equal? i sectionCount))
readSectionDirectory = (sectionCount bs : readSectionDirectory_ sectionCount 0 bs t)
readSectionDirectory = (sectionCount bs : readSectionDirectory_ bs sectionCount 0 t)
sectionRecordId = (sectionRecord :
matchPair
(sectionId _ : sectionId)
sectionRecord)
sectionRecordVersion = (sectionRecord :
matchPair
(_ payload :
matchPair
(sectionVersion _ : sectionVersion)
payload)
sectionRecord)
sectionRecordFlags = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(sectionFlags _ : sectionFlags)
payload2)
payload)
sectionRecord)
sectionRecordCompression = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(compression _ : compression)
payload3)
payload2)
payload)
sectionRecord)
sectionRecordDigestAlgorithm = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ payload4 :
matchPair
(digestAlgorithm _ : digestAlgorithm)
payload4)
payload3)
payload2)
payload)
sectionRecord)
sectionRecordOffset = (sectionRecord :
matchPair
(_ payload :
matchPair
(offset _ : offset)
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ payload4 :
matchPair
(_ payload5 :
matchPair
(offset _ : offset)
payload5)
payload4)
payload3)
payload2)
payload)
sectionRecord)
@@ -60,18 +158,497 @@ sectionRecordLength = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ length : length)
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ payload4 :
matchPair
(_ payload5 :
matchPair
(_ payload6 :
matchPair
(length _ : length)
payload6)
payload5)
payload4)
payload3)
payload2)
payload)
sectionRecord)
lookupSectionRecord = y (self sectionId directory :
sectionRecordDigest = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ payload4 :
matchPair
(_ payload5 :
matchPair
(_ payload6 :
matchPair
(_ digest : digest)
payload6)
payload5)
payload4)
payload3)
payload2)
payload)
sectionRecord)
lookupSectionRecord_ = y (self directory sectionId :
matchList
nothing
(sectionRecord rest :
matchBool
(just sectionRecord)
(self sectionId rest)
(self rest sectionId)
(bytesEq? sectionId (sectionRecordId sectionRecord)))
directory)
lookupSectionRecord = (sectionId directory : lookupSectionRecord_ directory sectionId)
sectionDirectoryHasId?_ = y (self directory sectionId :
matchList
false
(sectionRecord rest :
or?
(bytesEq? sectionId (sectionRecordId sectionRecord))
(self rest sectionId))
directory)
sectionDirectoryHasId? = (sectionId directory : sectionDirectoryHasId?_ directory sectionId)
sectionDirectoryHasDuplicateIds? = y (self directory :
matchList
false
(sectionRecord rest :
or?
(sectionDirectoryHasId?_ rest (sectionRecordId sectionRecord))
(self rest))
directory)
validateSectionDirectory = (directory rest :
matchBool
(err errDuplicateSection rest)
(ok directory rest)
(sectionDirectoryHasDuplicateIds? directory))
byteSlice = (offset length bytes : bytesTake length (bytesDrop offset bytes))
natMake = (bit rest :
matchBool
0
(pair bit rest)
(and? (equal? bit 0) (equal? rest 0)))
natAdd = y (self a b :
triage
b
(_ : b)
(aBit aRest :
triage
a
(_ : a)
(bBit bRest :
matchBool
(natMake 0 (succ (self aRest bRest)))
(natMake (matchBool (matchBool 0 1 bBit) (matchBool 1 0 bBit) aBit)
(self aRest bRest))
(and? (equal? aBit 1) (equal? bBit 1)))
b)
a)
natDouble = (n : matchBool 0 (pair 0 n) (equal? n 0))
natTimes256 = (n :
natDouble
(natDouble
(natDouble
(natDouble
(natDouble
(natDouble
(natDouble
(natDouble n))))))))
byteNatShiftAppend_ = y (self byte acc i :
matchBool
acc
(triage
(natMake 0 (self 0 acc (succ i)))
(_ : acc)
(bit rest : natMake bit (self rest acc (succ i)))
byte)
(equal? i 8))
byteNatShiftAppend = (byte acc : byteNatShiftAppend_ byte acc 0)
beBytesToNat = (bytes :
foldl
(acc byte : byteNatShiftAppend byte acc)
0
bytes)
u32BEBytesToNat = beBytesToNat
u64BEBytesToNat = beBytesToNat
arborixHeaderMajorVersion = (header :
matchPair
(majorVersion _ : majorVersion)
header)
arborixHeaderMinorVersion = (header :
matchPair
(_ payload :
matchPair
(minorVersion _ : minorVersion)
payload)
header)
arborixHeaderSectionCount = (header :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(sectionCount _ : sectionCount)
payload2)
payload)
header)
arborixHeaderFlags = (header :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(flags _ : flags)
payload3)
payload2)
payload)
header)
arborixHeaderDirOffset = (header :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ dirOffset : dirOffset)
payload3)
payload2)
payload)
header)
validateArborixHeader = (header rest :
matchBool
(ok header rest)
(err errUnsupportedVersion rest)
(and?
(bytesEq? arborixMajorVersion (arborixHeaderMajorVersion header))
(bytesEq? arborixMinorVersion (arborixHeaderMinorVersion header))))
readArborixContainer = (bs :
bindResult (readArborixHeader bs)
(header afterHeader :
bindResult (validateArborixHeader header afterHeader)
(validHeader afterValidHeader :
bindResult (readSectionDirectory
(u32BEBytesToNat (arborixHeaderSectionCount validHeader))
(bytesDrop (u64BEBytesToNat (arborixHeaderDirOffset validHeader)) bs))
(directory afterDirectory :
bindResult (validateSectionDirectory directory afterDirectory)
(validDirectory afterValidDirectory :
ok (pair validHeader validDirectory) afterValidDirectory)))))
sectionRecordOffsetNat = (sectionRecord :
u64BEBytesToNat (sectionRecordOffset sectionRecord))
sectionRecordLengthNat = (sectionRecord :
u64BEBytesToNat (sectionRecordLength sectionRecord))
extractSectionBytes = (sectionRecord containerBytes :
byteSlice
(sectionRecordOffsetNat sectionRecord)
(sectionRecordLengthNat sectionRecord)
containerBytes)
extractSectionBytesResult = (sectionRecord containerBytes rest :
(sectionBytes :
matchBool
(ok sectionBytes rest)
(err errUnexpectedEof rest)
(equal? (bytesLength sectionBytes) (sectionRecordLengthNat sectionRecord)))
(extractSectionBytes sectionRecord containerBytes))
lookupSectionBytes = (sectionId directory containerBytes :
triage
nothing
(sectionRecord : just (extractSectionBytes sectionRecord containerBytes))
(_ _ : nothing)
(lookupSectionRecord sectionId directory))
sectionBytesOrErr = (sectionId directory containerBytes rest :
triage
(err errMissingSection rest)
(sectionRecord : extractSectionBytesResult sectionRecord containerBytes rest)
(_ _ : err errMissingSection rest)
(lookupSectionRecord sectionId directory))
readArborixSectionBytes = (sectionId bs :
bindResult (readArborixContainer bs)
(container afterContainer :
matchPair
(_ directory : sectionBytesOrErr sectionId directory bs afterContainer)
container))
readArborixRequiredSections = (bs :
bindResult (readArborixContainer bs)
(container afterContainer :
matchPair
(_ directory :
bindResult (sectionBytesOrErr arborixManifestSectionId directory bs afterContainer)
(manifestBytes _ :
bindResult (sectionBytesOrErr arborixNodesSectionId directory bs afterContainer)
(nodesBytes _ :
ok (pair manifestBytes nodesBytes) afterContainer)))
container))
readNodeRecord = (bs :
bindResult (readBytes 32 bs)
(nodeHash afterNodeHash :
bindResult (readBytes 4 afterNodeHash)
(payloadLength afterPayloadLength :
bindResult (readBytes (u32BEBytesToNat payloadLength) afterPayloadLength)
(payload afterPayload :
ok
(pair nodeHash
(pair payloadLength payload))
afterPayload))))
nodeRecordHash = (nodeRecord :
matchPair
(nodeHash _ : nodeHash)
nodeRecord)
nodeRecordPayloadLength = (nodeRecord :
matchPair
(_ payload :
matchPair
(payloadLength _ : payloadLength)
payload)
nodeRecord)
nodeRecordPayload = (nodeRecord :
matchPair
(_ payload :
matchPair
(_ nodePayload : nodePayload)
payload)
nodeRecord)
nodePayloadKind = (nodePayload : bytesHead nodePayload)
nodePayloadHasTag? = (tag nodePayload :
triage
false
(actualTag : byteEq? actualTag tag)
(_ _ : false)
(nodePayloadKind nodePayload))
nodePayloadLeaf? = (nodePayload : bytesEq? [(0)] nodePayload)
nodePayloadStem? = (nodePayload :
and?
(nodePayloadHasTag? nodePayloadStemTag nodePayload)
(equal? (bytesLength nodePayload) 33))
nodePayloadFork? = (nodePayload :
and?
(nodePayloadHasTag? nodePayloadForkTag nodePayload)
(equal? (bytesLength nodePayload) 65))
nodePayloadValid? = (nodePayload :
or?
(nodePayloadLeaf? nodePayload)
(or?
(nodePayloadStem? nodePayload)
(nodePayloadFork? nodePayload)))
nodePayloadStemChildHash = (nodePayload : bytesTake 32 (bytesDrop 1 nodePayload))
nodePayloadForkLeftHash = (nodePayload : bytesTake 32 (bytesDrop 1 nodePayload))
nodePayloadForkRightHash = (nodePayload : bytesTake 32 (bytesDrop 33 nodePayload))
nodeRecordPayloadValid? = (nodeRecord : nodePayloadValid? (nodeRecordPayload nodeRecord))
nodeRecordsHaveInvalidPayload? = y (self nodeRecords :
matchList
false
(nodeRecord rest :
or?
(not? (nodeRecordPayloadValid? nodeRecord))
(self rest))
nodeRecords)
nodeRecordsHaveHash? = y (self nodeRecords nodeHash :
matchList
false
(nodeRecord rest :
or?
(bytesEq? nodeHash (nodeRecordHash nodeRecord))
(self rest nodeHash))
nodeRecords)
nodeRecordsHaveDuplicateHashes? = y (self nodeRecords :
matchList
false
(nodeRecord rest :
or?
(nodeRecordsHaveHash? rest (nodeRecordHash nodeRecord))
(self rest))
nodeRecords)
lookupNodeRecord_ = y (self nodeRecords nodeHash :
matchList
nothing
(nodeRecord rest :
matchBool
(just nodeRecord)
(self rest nodeHash)
(bytesEq? nodeHash (nodeRecordHash nodeRecord)))
nodeRecords)
lookupNodeRecord = (nodeHash nodeRecords : lookupNodeRecord_ nodeRecords nodeHash)
nodeRecordChildHashes = (nodeRecord :
(nodePayload :
matchBool
t
(matchBool
(pair (nodePayloadStemChildHash nodePayload) t)
(pair (nodePayloadForkLeftHash nodePayload)
(pair (nodePayloadForkRightHash nodePayload) t))
(nodePayloadStem? nodePayload))
(nodePayloadLeaf? nodePayload))
(nodeRecordPayload nodeRecord))
nodeHashPresent? = (nodeHash nodeRecords : nodeRecordsHaveHash? nodeRecords nodeHash)
nodeChildHashesPresent? = y (self childHashes nodeRecords :
matchList
true
(childHash rest :
and?
(nodeHashPresent? childHash nodeRecords)
(self rest nodeRecords))
childHashes)
nodeRecordChildrenPresent? = (nodeRecord nodeRecords :
nodeChildHashesPresent? (nodeRecordChildHashes nodeRecord) nodeRecords)
nodeRecordsClosed? = y (self nodeRecords allNodeRecords :
matchList
true
(nodeRecord rest :
and?
(nodeRecordChildrenPresent? nodeRecord allNodeRecords)
(self rest allNodeRecords))
nodeRecords)
validateNodeRecords = (nodeRecords rest :
matchBool
(err errInvalidNodePayload rest)
(matchBool
(err errDuplicateNode rest)
(matchBool
(ok nodeRecords rest)
(err errMissingNode rest)
(nodeRecordsClosed? nodeRecords nodeRecords))
(nodeRecordsHaveDuplicateHashes? nodeRecords))
(nodeRecordsHaveInvalidPayload? nodeRecords))
readNodeRecords_ = y (self bs nodeCount i acc :
matchBool
(ok (reverse acc) bs)
(bindResult (readNodeRecord bs)
(nodeRecord afterNodeRecord :
self afterNodeRecord nodeCount (succ i) (pair nodeRecord acc)))
(equal? i nodeCount))
readNodeRecords = (nodeCount bs : readNodeRecords_ bs nodeCount 0 t)
readNodesSection = (bs :
bindResult (readBytes 8 bs)
(nodeCount afterNodeCount :
bindResult (readNodeRecords (u64BEBytesToNat nodeCount) afterNodeCount)
(nodeRecords afterNodeRecords :
bindResult (validateNodeRecords nodeRecords afterNodeRecords)
(validNodeRecords afterValidNodeRecords :
ok (pair nodeCount validNodeRecords) afterValidNodeRecords))))
readNodesSectionComplete = (bs :
bindResult (readNodesSection bs)
(nodesSection afterNodesSection :
matchBool
(ok nodesSection afterNodesSection)
(err errUnexpectedBytes afterNodesSection)
(bytesNil? afterNodesSection)))
readArborixNodesSection = (bs :
bindResult (readArborixContainer bs)
(container afterContainer :
matchPair
(_ directory :
bindResult (sectionBytesOrErr arborixNodesSectionId directory bs afterContainer)
(nodesBytes _ :
bindResult (readNodesSectionComplete nodesBytes)
(nodesSection _ : ok nodesSection afterContainer)))
container))
nodesSectionCount = (nodesSection :
matchPair
(nodeCount _ : nodeCount)
nodesSection)
nodesSectionRecords = (nodesSection :
matchPair
(_ nodeRecords : nodeRecords)
nodesSection)
nodeRecordToTreeWith = (self nodeRecords nodeRecord :
(nodePayload :
matchBool
(ok t t)
(matchBool
(bindResult (self (nodePayloadStemChildHash nodePayload) nodeRecords)
(child _ : ok (t child) t))
(bindResult (self (nodePayloadForkLeftHash nodePayload) nodeRecords)
(left _ :
bindResult (self (nodePayloadForkRightHash nodePayload) nodeRecords)
(right _ : ok (pair left right) t)))
(nodePayloadStem? nodePayload))
(nodePayloadLeaf? nodePayload))
(nodeRecordPayload nodeRecord))
nodeHashToTree = y (self nodeHash nodeRecords :
triage
(err errMissingNode t)
(nodeRecord : nodeRecordToTreeWith self nodeRecords nodeRecord)
(_ _ : err errMissingNode t)
(lookupNodeRecord nodeHash nodeRecords))
readArborixTreeFromHash = (rootHash bs :
bindResult (readArborixNodesSection bs)
(nodesSection afterContainer :
bindResult (nodeHashToTree rootHash (nodesSectionRecords nodesSection))
(tree _ : ok tree afterContainer)))
readArborixExecutableFromHash = readArborixTreeFromHash

36
lib/bytes.tri
View File

@@ -14,27 +14,29 @@ byteEq? = equal?
bytesLength = length
bytesAppend = append
bytesTake_ = y (self n i remaining :
matchBool
bytesTake_ = y (self remaining n i :
matchList
t
(matchList
t
(h r : pair h (self n (succ i) r))
remaining)
(equal? i n))
(h r :
matchBool
t
(pair h (self r n (succ i)))
(equal? i n))
remaining)
bytesTake = n bytes : bytesTake_ n 0 bytes
bytesTake = n bytes : bytesTake_ bytes n 0
bytesDrop_ = y (self n i remaining :
matchBool
remaining
(matchList
t
(_ r : self n (succ i) r)
remaining)
(equal? i n))
bytesDrop_ = y (self remaining n i :
matchList
t
(_ r :
matchBool
remaining
(self r n (succ i))
(equal? i n))
remaining)
bytesDrop = n bytes : bytesDrop_ n 0 bytes
bytesDrop = n bytes : bytesDrop_ bytes n 0
bytesSplitAt = n bytes : pair (bytesTake n bytes) (bytesDrop n bytes)

8
lib/list.tri
View File

@@ -27,11 +27,11 @@ filter_ = y (self : matchList
(head tail f : matchBool (t head) id (f head) (self tail f)))
filter = f l : filter_ l f
foldl_ = y (self f l x : matchList (acc : acc) (head tail acc : self f tail (f acc head)) l x)
foldl = f x l : foldl_ f l x
foldl_ = y (self l f x : matchList (acc : acc) (head tail acc : self tail f (f acc head)) l x)
foldl = f x l : foldl_ l f x
foldr_ = y (self x f l : matchList x (head tail : f (self x f tail) head) l)
foldr = f x l : foldr_ x f l
foldr_ = y (self l f x : matchList x (head tail : f (self tail f x) head) l)
foldr = f x l : foldr_ l f x
length = y (self : matchList
0

601
test/Spec.hs
View File

@@ -12,6 +12,7 @@ import ContentStore
import Control.Exception (evaluate, try, SomeException)
import Control.Monad.IO.Class (liftIO)
import Data.Bits (xor)
import Data.Char (digitToInt)
import Data.List (isInfixOf)
import Data.Text (Text, unpack)
import Data.Word (Word8)
@@ -1051,6 +1052,104 @@ byteT = ofNumber
bytesT :: [Integer] -> T
bytesT = ofList . fmap byteT
bytesExpr :: [Integer] -> String
bytesExpr xs = "[" ++ unwords (map (\n -> "(" ++ show n ++ ")") xs) ++ "]"
u16 :: Integer -> [Integer]
u16 n = [0,n]
u32 :: Integer -> [Integer]
u32 n = [0,0,0,n]
u64 :: Integer -> [Integer]
u64 n = [0,0,0,0,0,0,0,n]
arborixHeaderBytes :: Integer -> [Integer]
arborixHeaderBytes sectionCount =
[65,82,66,79,82,73,88,0]
++ u16 1
++ u16 0
++ u32 sectionCount
++ u64 0
++ u64 32
sectionEntryBytes :: [Integer] -> Integer -> Integer -> [Integer]
sectionEntryBytes sectionType offset lengthBytes =
sectionType
++ u16 1
++ u16 1
++ u16 0
++ u16 1
++ u64 offset
++ u64 lengthBytes
++ replicate 32 0
manifestSectionIdBytes :: [Integer]
manifestSectionIdBytes = [0,0,0,1]
nodesSectionIdBytes :: [Integer]
nodesSectionIdBytes = [0,0,0,2]
hexTextBytes :: Text -> [Integer]
hexTextBytes h = go (unpack h)
where
go [] = []
go (a:b:rest) = toInteger (digitToInt a * 16 + digitToInt b) : go rest
go _ = error "odd-length hex text"
manifestEntryBytes :: Integer -> Integer -> [Integer]
manifestEntryBytes = sectionEntryBytes manifestSectionIdBytes
nodesEntryBytes :: Integer -> Integer -> [Integer]
nodesEntryBytes = sectionEntryBytes nodesSectionIdBytes
simpleContainerBytes :: [Integer] -> [Integer] -> [Integer]
simpleContainerBytes manifestBytes nodesBytes =
let manifestOffset = 152
nodesOffset = manifestOffset + fromIntegral (length manifestBytes)
in arborixHeaderBytes 2
++ manifestEntryBytes manifestOffset (fromIntegral $ length manifestBytes)
++ nodesEntryBytes nodesOffset (fromIntegral $ length nodesBytes)
++ manifestBytes
++ nodesBytes
singleSectionContainerBytes :: [Integer] -> [Integer] -> [Integer]
singleSectionContainerBytes sectionType sectionBytes =
arborixHeaderBytes 1
++ sectionEntryBytes sectionType 92 (fromIntegral $ length sectionBytes)
++ sectionBytes
arborixHeaderT :: Integer -> T
arborixHeaderT sectionCount =
pairT (bytesT [0,1])
(pairT (bytesT [0,0])
(pairT (bytesT $ u32 sectionCount)
(pairT (bytesT $ u64 0)
(bytesT $ u64 32))))
sectionRecordT :: [Integer] -> Integer -> Integer -> T
sectionRecordT sectionType offset lengthBytes =
pairT (bytesT sectionType)
(pairT (bytesT [0,1])
(pairT (bytesT [0,1])
(pairT (bytesT [0,0])
(pairT (bytesT [0,1])
(pairT (bytesT $ u64 offset)
(pairT (bytesT $ u64 lengthBytes)
(bytesT $ replicate 32 0)))))))
sectionRecordExpr :: [Integer] -> Integer -> Integer -> String
sectionRecordExpr sectionType offset lengthBytes =
"(pair " ++ bytesExpr sectionType
++ " (pair " ++ bytesExpr [0,1]
++ " (pair " ++ bytesExpr [0,1]
++ " (pair " ++ bytesExpr [0,0]
++ " (pair " ++ bytesExpr [0,1]
++ " (pair " ++ bytesExpr (u64 offset)
++ " (pair " ++ bytesExpr (u64 lengthBytes)
++ " " ++ bytesExpr (replicate 32 0)
++ ")))))))"
byteListUtilities :: TestTree
byteListUtilities = testGroup "Byte List Utility Tests"
[ testCase "isNil: empty list is nil" $ do
@@ -1249,6 +1348,24 @@ unexpectedBytesT = byteT 2
unexpectedByteT :: T
unexpectedByteT = byteT 3
missingSectionT :: T
missingSectionT = byteT 4
unsupportedVersionT :: T
unsupportedVersionT = byteT 5
duplicateSectionT :: T
duplicateSectionT = byteT 6
duplicateNodeT :: T
duplicateNodeT = byteT 7
invalidNodePayloadT :: T
invalidNodePayloadT = byteT 8
missingNodeT :: T
missingNodeT = byteT 9
binaryReaderTests :: TestTree
binaryReaderTests = testGroup "Binary Reader Tests"
[ testCase "readU8: empty input returns err" $ do
@@ -1523,25 +1640,17 @@ binaryReaderTests = testGroup "Binary Reader Tests"
-- Arborix header parsing
-- ------------------------------------------------------------------------
, testCase "readArborixHeader: parses version and section count" $ do
let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (0) (0) (1) (0) (0) (0) (0) (0) (0)]"
, testCase "readArborixHeader: parses portable header" $ do
let input = "readArborixHeader " ++ bytesExpr (arborixHeaderBytes 0)
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [0,1])
(pairT (bytesT [0,0])
(bytesT [0,0,0,0])))
(bytesT [])
result env @?= okT (arborixHeaderT 0) (bytesT [])
, testCase "readArborixHeader: preserves trailing bytes" $ do
let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (0) (0) (1) (0) (0) (0) (0) (0) (0) (9) (8)]"
let input = "readArborixHeader " ++ bytesExpr (arborixHeaderBytes 0 ++ [9,8])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [0,1])
(pairT (bytesT [0,0])
(bytesT [0,0,0,0])))
(bytesT [9,8])
result env @?= okT (arborixHeaderT 0) (bytesT [9,8])
, testCase "readArborixHeader: rejects wrong magic preserving input" $ do
let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (1) (0) (1)]"
@@ -1559,25 +1668,17 @@ binaryReaderTests = testGroup "Binary Reader Tests"
-- Arborix section directory record parsing
-- ------------------------------------------------------------------------
, testCase "readSectionRecord: parses raw section id offset and length" $ do
let input = "readSectionRecord [(0) (2) (0) (0) (0) (16) (0) (0) (0) (32)]"
, testCase "readSectionRecord: parses portable section entry" $ do
let input = "readSectionRecord " ++ bytesExpr (nodesEntryBytes 16 32)
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [0,2])
(pairT (bytesT [0,0,0,16])
(bytesT [0,0,0,32])))
(bytesT [])
result env @?= okT (sectionRecordT nodesSectionIdBytes 16 32) (bytesT [])
, testCase "readSectionRecord: preserves trailing bytes" $ do
let input = "readSectionRecord [(0) (2) (0) (0) (0) (16) (0) (0) (0) (32) (9) (8)]"
let input = "readSectionRecord " ++ bytesExpr (nodesEntryBytes 16 32 ++ [9,8])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [0,2])
(pairT (bytesT [0,0,0,16])
(bytesT [0,0,0,32])))
(bytesT [9,8])
result env @?= okT (sectionRecordT nodesSectionIdBytes 16 32) (bytesT [9,8])
, testCase "readSectionRecord: empty input returns EOF" $ do
let input = "readSectionRecord []"
@@ -1591,17 +1692,17 @@ binaryReaderTests = testGroup "Binary Reader Tests"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0])
, testCase "readSectionRecord: missing offset returns EOF preserving unread offset bytes" $ do
, testCase "readSectionRecord: missing section version returns EOF preserving unread bytes" $ do
let input = "readSectionRecord [(0) (2)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [])
result env @?= errT eofT (bytesT [0,2])
, testCase "readSectionRecord: short offset returns EOF preserving unread offset bytes" $ do
, testCase "readSectionRecord: short section version returns EOF preserving unread bytes" $ do
let input = "readSectionRecord [(0) (2) (0) (0) (0)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0,0,0])
result env @?= errT eofT (bytesT [0])
, testCase "readSectionRecord: missing length returns EOF preserving unread length bytes" $ do
let input = "readSectionRecord [(0) (2) (0) (0) (0) (16)]"
@@ -1609,11 +1710,11 @@ binaryReaderTests = testGroup "Binary Reader Tests"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [])
, testCase "readSectionRecord: short length returns EOF preserving unread length bytes" $ do
, testCase "readSectionRecord: short section flags returns EOF preserving unread bytes" $ do
let input = "readSectionRecord [(0) (2) (0) (0) (0) (16) (0) (0) (0)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0,0,0])
result env @?= errT eofT (bytesT [0])
-- ------------------------------------------------------------------------
-- Arborix section directory parsing
@@ -1626,17 +1727,13 @@ binaryReaderTests = testGroup "Binary Reader Tests"
result env @?= okT (ofList []) (bytesT [9,8])
, testCase "readSectionDirectory: reads requested records and preserves trailing bytes" $ do
let input = "readSectionDirectory 2 [(0) (1) (0) (0) (0) (10) (0) (0) (0) (20) (0) (2) (0) (0) (0) (30) (0) (0) (0) (40) (9)]"
let input = "readSectionDirectory 2 " ++ bytesExpr (manifestEntryBytes 10 20 ++ nodesEntryBytes 30 40 ++ [9])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(ofList
[ pairT (bytesT [0,1])
(pairT (bytesT [0,0,0,10])
(bytesT [0,0,0,20]))
, pairT (bytesT [0,2])
(pairT (bytesT [0,0,0,30])
(bytesT [0,0,0,40]))
[ sectionRecordT manifestSectionIdBytes 10 20
, sectionRecordT nodesSectionIdBytes 30 40
])
(bytesT [9])
@@ -1651,16 +1748,13 @@ binaryReaderTests = testGroup "Binary Reader Tests"
-- ------------------------------------------------------------------------
, testCase "lookupSectionRecord: finds record by raw section id" $ do
let input = "lookupSectionRecord [(0) (2)] [(pair [(0) (1)] (pair [(0) (0) (0) (10)] [(0) (0) (0) (20)])) (pair [(0) (2)] (pair [(0) (0) (0) (30)] [(0) (0) (0) (40)]))]"
let input = "lookupSectionRecord " ++ bytesExpr nodesSectionIdBytes ++ " [(" ++ "pair " ++ bytesExpr manifestSectionIdBytes ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,0] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr (u64 10) ++ " (pair " ++ bytesExpr (u64 20) ++ " " ++ bytesExpr (replicate 32 0) ++ "))))))" ++ ") (" ++ "pair " ++ bytesExpr nodesSectionIdBytes ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,0] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr (u64 30) ++ " (pair " ++ bytesExpr (u64 40) ++ " " ++ bytesExpr (replicate 32 0) ++ "))))))" ++ ")]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= justT
(pairT (bytesT [0,2])
(pairT (bytesT [0,0,0,30])
(bytesT [0,0,0,40])))
result env @?= justT (sectionRecordT nodesSectionIdBytes 30 40)
, testCase "lookupSectionRecord: missing section id returns nothing" $ do
let input = "lookupSectionRecord [(0) (3)] [(pair [(0) (1)] (pair [(0) (0) (0) (10)] [(0) (0) (0) (20)])) (pair [(0) (2)] (pair [(0) (0) (0) (30)] [(0) (0) (0) (40)]))]"
let input = "lookupSectionRecord " ++ bytesExpr [0,0,0,3] ++ " [(" ++ "pair " ++ bytesExpr manifestSectionIdBytes ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,0] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr (u64 10) ++ " (pair " ++ bytesExpr (u64 20) ++ " " ++ bytesExpr (replicate 32 0) ++ "))))))" ++ ") (" ++ "pair " ++ bytesExpr nodesSectionIdBytes ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,0] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr (u64 30) ++ " (pair " ++ bytesExpr (u64 40) ++ " " ++ bytesExpr (replicate 32 0) ++ "))))))" ++ ")]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= nothingT
@@ -1676,4 +1770,421 @@ binaryReaderTests = testGroup "Binary Reader Tests"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= bytesT [14,15]
-- ------------------------------------------------------------------------
-- Arborix minimal container parsing foundation
-- ------------------------------------------------------------------------
, testCase "u32BEBytesToNat: decodes zero" $ do
let input = "u32BEBytesToNat [(0) (0) (0) (0)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "u32BEBytesToNat: decodes small section count" $ do
let input = "u32BEBytesToNat [(0) (0) (0) (2)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 2
, testCase "u64BEBytesToNat: decodes small node count" $ do
let input = "u64BEBytesToNat [(0) (0) (0) (0) (0) (0) (0) (2)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 2
, testCase "u64BEBytesToNat: decodes fixture-scale offset" $ do
let input = "u64BEBytesToNat [(0) (0) (0) (0) (0) (0) (3) (214)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 982
, testCase "readArborixContainer: reads header directory and preserves payload" $ do
let input = "readArborixContainer " ++ bytesExpr (simpleContainerBytes [101,102,103] [201,202,203,204])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT
(arborixHeaderT 2)
(ofList
[ sectionRecordT manifestSectionIdBytes 152 3
, sectionRecordT nodesSectionIdBytes 155 4
]))
(bytesT [101,102,103,201,202,203,204])
, testCase "readArborixContainer: truncated directory returns EOF" $ do
let input = "readArborixContainer " ++ bytesExpr (arborixHeaderBytes 1 ++ [0,0])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0,0])
, testCase "readArborixContainer: rejects unsupported major version" $ do
let badHeader = [65,82,66,79,82,73,88,0] ++ u16 2 ++ u16 0 ++ u32 0 ++ u64 0 ++ u64 32
input = "readArborixContainer " ++ bytesExpr badHeader
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT unsupportedVersionT (bytesT [])
, testCase "readArborixContainer: rejects unsupported minor version" $ do
let badHeader = [65,82,66,79,82,73,88,0] ++ u16 1 ++ u16 1 ++ u32 0 ++ u64 0 ++ u64 32
input = "readArborixContainer " ++ bytesExpr badHeader
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT unsupportedVersionT (bytesT [])
, testCase "readArborixContainer: rejects duplicate section ids" $ do
let input = "readArborixContainer " ++ bytesExpr (arborixHeaderBytes 2 ++ manifestEntryBytes 152 1 ++ manifestEntryBytes 153 1 ++ [9])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT duplicateSectionT (bytesT [9])
, testCase "extractSectionBytes: uses raw offset and length fields" $ do
let input = "extractSectionBytes " ++ sectionRecordExpr nodesSectionIdBytes 3 4 ++ " " ++ bytesExpr [10,11,12,13,14,15,16,17]
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= bytesT [13,14,15,16]
, testCase "lookupSectionBytes: finds section and extracts raw bytes" $ do
let input = "lookupSectionBytes " ++ bytesExpr nodesSectionIdBytes ++ " [" ++ sectionRecordExpr manifestSectionIdBytes 1 2 ++ " " ++ sectionRecordExpr nodesSectionIdBytes 4 3 ++ "] " ++ bytesExpr [10,11,12,13,14,15,16,17]
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= justT (bytesT [14,15,16])
, testCase "lookupSectionBytes: missing section returns nothing" $ do
let input = "lookupSectionBytes " ++ bytesExpr [0,0,0,3] ++ " [" ++ sectionRecordExpr manifestSectionIdBytes 1 2 ++ " " ++ sectionRecordExpr nodesSectionIdBytes 4 3 ++ "] " ++ bytesExpr [10,11,12,13,14,15,16,17]
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= nothingT
, testCase "extractSectionBytesResult: rejects out-of-bounds section" $ do
let input = "extractSectionBytesResult " ++ sectionRecordExpr nodesSectionIdBytes 6 4 ++ " " ++ bytesExpr [10,11,12,13,14,15,16,17] ++ " []"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [])
, testCase "readArborixSectionBytes: extracts requested section from container" $ do
let input = "readArborixSectionBytes " ++ bytesExpr nodesSectionIdBytes ++ " " ++ bytesExpr (simpleContainerBytes [101,102,103] [201,202,203,204])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (bytesT [201,202,203,204]) (bytesT [101,102,103,201,202,203,204])
, testCase "readArborixSectionBytes: missing section returns missing-section err" $ do
let input = "readArborixSectionBytes " ++ bytesExpr nodesSectionIdBytes ++ " " ++ bytesExpr (singleSectionContainerBytes manifestSectionIdBytes [101,102,103])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT missingSectionT (bytesT [101,102,103])
, testCase "readArborixRequiredSections: extracts manifest and nodes bytes" $ do
let input = "readArborixRequiredSections " ++ bytesExpr (simpleContainerBytes [101,102,103] [201,202,203,204])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [101,102,103]) (bytesT [201,202,203,204]))
(bytesT [101,102,103,201,202,203,204])
, testCase "readArborixRequiredSections: missing nodes section returns missing-section err" $ do
let input = "readArborixRequiredSections " ++ bytesExpr (singleSectionContainerBytes manifestSectionIdBytes [101,102,103])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT missingSectionT (bytesT [101,102,103])
, testCase "readArborixRequiredSections: out-of-bounds section returns EOF" $ do
let manifestBytes = [101,102,103]
nodesBytes = [201,202,203,204]
badContainer = arborixHeaderBytes 2 ++ manifestEntryBytes 152 3 ++ nodesEntryBytes 155 9 ++ manifestBytes ++ nodesBytes
input = "readArborixRequiredSections " ++ bytesExpr badContainer
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [101,102,103,201,202,203,204])
-- ------------------------------------------------------------------------
-- Arborix raw nodes section parsing
-- ------------------------------------------------------------------------
, testCase "readNodeRecord: parses hash length and raw payload" $ do
let input = "readNodeRecord [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (3) (101) (102) (103) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [1..32])
(pairT (bytesT [0,0,0,3])
(bytesT [101,102,103])))
(bytesT [9])
, testCase "readNodeRecord: truncated payload returns EOF preserving unread payload" $ do
let input = "readNodeRecord [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (3) (101) (102)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [101,102])
, testCase "readNodesSection: parses node count and records" $ do
let input = "readNodesSection [(0) (0) (0) (0) (0) (0) (0) (1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (1) (0) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [0,0,0,0,0,0,0,1])
(ofList
[ pairT (bytesT [1..32])
(pairT (bytesT [0,0,0,1])
(bytesT [0]))
]))
(bytesT [9])
, testCase "readNodesSectionComplete: rejects trailing bytes inside nodes section" $ do
let input = "readNodesSectionComplete [(0) (0) (0) (0) (0) (0) (0) (0) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT unexpectedBytesT (bytesT [9])
, testCase "readNodesSection: rejects duplicate node hashes" $ do
let input = "readNodesSection [(0) (0) (0) (0) (0) (0) (0) (2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (1) (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (1) (0) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT duplicateNodeT (bytesT [9])
, testCase "nodePayloadValid?: accepts leaf stem and fork payload shapes" $ do
let input = "[(nodePayloadValid? [(0)]) (nodePayloadValid? [(1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)]) (nodePayloadValid? [(2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)])]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofList [trueT, trueT, trueT]
, testCase "nodePayloadValid?: rejects invalid payload shapes" $ do
let input = "[(nodePayloadValid? []) (nodePayloadValid? [(9)]) (nodePayloadValid? [(1) (1)]) (nodePayloadValid? [(2) (1) (2)])]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofList [falseT, falseT, falseT, falseT]
, testCase "node payload child accessors expose raw hashes" $ do
let input = "[(nodePayloadStemChildHash [(1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)]) (nodePayloadForkLeftHash [(2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)]) (nodePayloadForkRightHash [(2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)])]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofList [bytesT [1..32], bytesT [1..32], bytesT [33..64]]
, testCase "lookupNodeRecord: finds record by raw node hash" $ do
let input = "lookupNodeRecord [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] [(pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (1)] [(0)])) (pair [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] (pair [(0) (0) (0) (1)] [(0)]))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= justT
(pairT (bytesT [33..64])
(pairT (bytesT [0,0,0,1])
(bytesT [0])))
, testCase "nodeRecordChildHashes: extracts stem and fork references" $ do
let input = "[(nodeRecordChildHashes (pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (33)] [(1) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)]))) (nodeRecordChildHashes (pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (65)] [(2) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64) (65) (66) (67) (68) (69) (70) (71) (72) (73) (74) (75) (76) (77) (78) (79) (80) (81) (82) (83) (84) (85) (86) (87) (88) (89) (90) (91) (92) (93) (94) (95) (96)])))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofList
[ ofList [bytesT [33..64]]
, ofList [bytesT [33..64], bytesT [65..96]]
]
, testCase "readNodesSection: rejects invalid node payload shape" $ do
let input = "readNodesSection [(0) (0) (0) (0) (0) (0) (0) (1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (1) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT invalidNodePayloadT (bytesT [])
, testCase "readNodesSection: rejects missing child node" $ do
let input = "readNodesSection [(0) (0) (0) (0) (0) (0) (0) (1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (33) (1) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT missingNodeT (bytesT [9])
, testCase "readArborixNodesSection: extracts and parses raw nodes section" $ do
let nodesBytes = u64 1 ++ [1..32] ++ u32 1 ++ [0]
input = "readArborixNodesSection " ++ bytesExpr (simpleContainerBytes [101,102,103] nodesBytes)
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [0,0,0,0,0,0,0,1])
(ofList
[ pairT (bytesT [1..32])
(pairT (bytesT [0,0,0,1])
(bytesT [0]))
]))
(bytesT ([101,102,103] ++ nodesBytes))
-- ------------------------------------------------------------------------
-- Arborix node DAG reconstruction
-- ------------------------------------------------------------------------
, testCase "nodeHashToTree: reconstructs leaf node" $ do
let input = "nodeHashToTree [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] [(pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (1)] [(0)]))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT Leaf Leaf
, testCase "nodeHashToTree: reconstructs stem node" $ do
let input = "nodeHashToTree [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] [(pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (1)] [(0)])) (pair [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] (pair [(0) (0) (0) (33)] [(1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)]))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (Stem Leaf) Leaf
, testCase "nodeHashToTree: reconstructs fork node" $ do
let input = "nodeHashToTree [(65) (66) (67) (68) (69) (70) (71) (72) (73) (74) (75) (76) (77) (78) (79) (80) (81) (82) (83) (84) (85) (86) (87) (88) (89) (90) (91) (92) (93) (94) (95) (96)] [(pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (1)] [(0)])) (pair [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] (pair [(0) (0) (0) (1)] [(0)])) (pair [(65) (66) (67) (68) (69) (70) (71) (72) (73) (74) (75) (76) (77) (78) (79) (80) (81) (82) (83) (84) (85) (86) (87) (88) (89) (90) (91) (92) (93) (94) (95) (96)] (pair [(0) (0) (0) (65)] [(2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)]))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (Fork Leaf Leaf) Leaf
, testCase "readArborixTreeFromHash: reconstructs tree from bundle bytes" $ do
let nodesBytes = u64 1 ++ [1..32] ++ u32 1 ++ [0]
input = "readArborixTreeFromHash " ++ bytesExpr [1..32] ++ " " ++ bytesExpr (simpleContainerBytes [101,102,103] nodesBytes)
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT Leaf (bytesT ([101,102,103] ++ nodesBytes))
, testCase "readArborixExecutableFromHash: alias reconstructs tree" $ do
let nodesBytes = u64 1 ++ [1..32] ++ u32 1 ++ [0]
input = "readArborixExecutableFromHash " ++ bytesExpr [1..32] ++ " " ++ bytesExpr (simpleContainerBytes [101,102,103] nodesBytes)
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT Leaf (bytesT ([101,102,103] ++ nodesBytes))
, testCase "readArborixNodesSection: reads id fixture bundle" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right _ -> do
let input = "matchResult (code rest : code) (nodes rest : 0) (readArborixNodesSection "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixNodesSection: reads notQ fixture bundle" $ do
fixtureBytes <- BS.readFile "test/fixtures/notQ.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right _ -> do
let input = "matchResult (code rest : code) (nodes rest : 0) (readArborixNodesSection "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixNodesSection: reads map fixture bundle" $ do
fixtureBytes <- BS.readFile "test/fixtures/map.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right _ -> do
let input = "matchResult (code rest : code) (nodes rest : 0) (readArborixNodesSection "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixExecutableFromHash: reconstructs id fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : 0) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixExecutableFromHash: reconstructs notQ fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/notQ.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : 0) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixExecutableFromHash: reconstructs map fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/map.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : 0) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixExecutableFromHash: executes id fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : tree 42) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 42
, testCase "readArborixExecutableFromHash: executes notQ fixture on true" $ do
fixtureBytes <- BS.readFile "test/fixtures/notQ.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : tree true) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= falseT
, testCase "readArborixExecutableFromHash: executes notQ fixture on false" $ do
fixtureBytes <- BS.readFile "test/fixtures/notQ.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : tree false) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= trueT
, testCase "readArborixExecutableFromHash: executes map fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/map.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : head (tail (tree (a : (t t t)) [(t) (t) (t)]))) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf
]

BIN
test/fixtures/equalQ.tri.bundle vendored
View File

Binary file not shown.

BIN
test/fixtures/false.tri.bundle vendored
View File

Binary file not shown.

BIN
test/fixtures/id.tri.bundle vendored
View File

Binary file not shown.

BIN
test/fixtures/map.tri.bundle vendored Normal file
View File

Binary file not shown.

2
test/fixtures/notQ.tri vendored
View File

@@ -1,2 +0,0 @@
\!import "base.tri" _
main = not?

BIN
test/fixtures/notQ.tri.bundle vendored
View File

Binary file not shown.

BIN
test/fixtures/true.tri.bundle vendored
View File

Binary file not shown.