Initial JS runtime and Arborix Implementation

src/Wire.hs

@@ -64,7 +64,7 @@ bundleMinorVersion = 0
 
 -- | Header magic for the portable executable-object container.
 bundleMagic :: ByteString
-bundleMagic = BS.pack [0x54, 0x52, 0x49, 0x43, 0x55, 0x42, 0x4e, 0x44] -- "TRICUBND"
+bundleMagic = BS.pack [0x41, 0x52, 0x42, 0x4f, 0x52, 0x49, 0x58, 0x00] -- "ARBORIX\0"
 
 headerLength :: Int
 headerLength = 32
@@ -83,13 +83,6 @@ compressionNone, digestSha256 :: Word16
 compressionNone = 0
 digestSha256 = 1
 
--- | Backwards compatibility for the original experimental node-list format.
-legacyMagic :: ByteString
-legacyMagic = BS.pack [0x54, 0x52, 0x49, 0x43, 0x55] -- "TRICU"
-
-legacyWireVersion :: Word8
-legacyWireVersion = 0x01
-
 -- | Closure declaration. V1 only accepts complete bundles for import.
 data ClosureMode = ClosureComplete | ClosurePartial
   deriving (Show, Eq, Ord, Generic)
@@ -200,7 +193,7 @@ instance FromJSON BundleExport where
     <$> o .: "name"
     <*> o .: "root"
     <*> o .:? "kind" .!= "term"
-    <*> o .:? "abi" .!= "tricu.abi.tree.v1"
+    <*> o .:? "abi" .!= "arborix.abi.tree.v1"
     <*> o .:? "input"
     <*> o .:? "output"
 
@@ -302,12 +295,10 @@ encodeBundle bundle =
         (fromIntegral sectionCount) 0 dirOffset
   in header <> manifestEntry <> nodesEntry <> manifestBytes <> nodeSection
 
--- | Decode portable Bundle v1 bytes, with fallback support for the previous
--- experimental TRICU node-list format.
+-- | Decode portable Bundle v1 bytes.
 decodeBundle :: ByteString -> Either String Bundle
 decodeBundle bs
   | BS.take (BS.length bundleMagic) bs == bundleMagic = decodePortableBundle bs
-  | BS.take (BS.length legacyMagic) bs == legacyMagic = decodeLegacyBundle bs
   | otherwise = Left "invalid magic"
 
 -- ---------------------------------------------------------------------------
@@ -439,20 +430,20 @@ decodeSectionEntries count bytes = reverse <$> go count bytes []
 
 defaultManifest :: [(Text, MerkleHash)] -> Int -> BundleManifest
 defaultManifest namedRoots nodeCount = BundleManifest
-  { manifestSchema = "tricu.bundle.manifest.v1"
+  { manifestSchema = "arborix.bundle.manifest.v1"
   , manifestBundleType = "tree-calculus-executable-object"
   , manifestTree = TreeSpec
       { treeCalculus = "tree-calculus.v1"
       , treeNodeHash = NodeHashSpec
           { nodeHashAlgorithm = "sha256"
-          , nodeHashDomain = "tricu.merkle.node.v1"
+          , nodeHashDomain = "arborix.merkle.node.v1"
           }
-      , treeNodePayload = "tricu.merkle.payload.v1"
+      , treeNodePayload = "arborix.merkle.payload.v1"
       }
   , manifestRuntime = RuntimeSpec
       { runtimeSemantics = "tree-calculus.v1"
       , runtimeEvaluation = "normal-order"
-      , runtimeAbi = "tricu.abi.tree.v1"
+      , runtimeAbi = "arborix.abi.tree.v1"
       , runtimeCapabilities = []
       }
   , manifestClosure = ClosureComplete
@@ -462,7 +453,7 @@ defaultManifest namedRoots nodeCount = BundleManifest
   , manifestSections = object
       [ "nodes" .= object
           [ "count" .= nodeCount
-          , "payload" .= ("tricu.merkle.payload.v1" :: Text)
+          , "payload" .= ("arborix.merkle.payload.v1" :: Text)
           ]
       ]
   , manifestMetadata = BundleMetadata
@@ -470,7 +461,7 @@ defaultManifest namedRoots nodeCount = BundleManifest
       , metadataVersion = Nothing
       , metadataDescription = Nothing
       , metadataLicense = Nothing
-      , metadataCreatedBy = Just "tricu"
+      , metadataCreatedBy = Just "arborix"
       }
   }
   where
@@ -480,7 +471,7 @@ defaultManifest namedRoots nodeCount = BundleManifest
       { exportName = name
       , exportRoot = h
       , exportKind = "term"
-      , exportAbi = "tricu.abi.tree.v1"
+      , exportAbi = "arborix.abi.tree.v1"
       , exportInput = Nothing
       , exportOutput = Nothing
       }
@@ -529,59 +520,7 @@ decodeNodeEntries count bs = go count bs Map.empty
                 Left $ "duplicate node entry: " ++ unpack h
               go (n - 1) after (Map.insert h payload acc)
 
--- ---------------------------------------------------------------------------
--- Legacy bundle decoding (read-only compatibility)
--- ---------------------------------------------------------------------------
 
-decodeLegacyBundle :: ByteString -> Either String Bundle
-decodeLegacyBundle bs
-  | BS.length bs < 14 = Left "bundle too short"
-  | BS.take 5 bs /= legacyMagic = Left "invalid legacy magic"
-  | BS.index bs 5 /= legacyWireVersion =
-      Left $ "unsupported legacy wire version: " ++ show (BS.index bs 5)
-  | otherwise = do
-      (rootCount, rest) <- decode32be "root_count" $ BS.drop 6 bs
-      (nodeCount, rest') <- decode32be "node_count" rest
-      let rootBytesLen = fromIntegral rootCount * 32
-      if BS.length rest' < rootBytesLen
-        then Left "bundle truncated in root hashes"
-        else do
-          let rawRoots = BS.take rootBytesLen rest'
-              afterRoots = BS.drop rootBytesLen rest'
-              roots =
-                [ rawToMerkleHash (BS.take 32 (BS.drop (i * 32) rawRoots))
-                | i <- [0 :: Int .. fromIntegral rootCount - 1]
-                ]
-              namedRoots = zip (defaultExportNames $ length roots) roots
-          nodes <- decodeLegacyNodeEntries nodeCount afterRoots
-          let manifest = defaultManifest namedRoots (Map.size nodes)
-          return Bundle
-            { bundleVersion = 1
-            , bundleRoots = roots
-            , bundleNodes = nodes
-            , bundleManifest = manifest
-            , bundleManifestBytes = BL.toStrict (encode manifest)
-            }
-
-decodeLegacyNodeEntries :: Word32 -> ByteString -> Either String (Map MerkleHash ByteString)
-decodeLegacyNodeEntries count bs = fst <$> go count bs Map.empty
-  where
-    go 0 rest acc = Right (acc, rest)
-    go n bytes acc
-      | BS.length bytes < 36 =
-          Left "not enough bytes for node entry header (hash + length)"
-      | otherwise = do
-          let (hashBytes, rest) = BS.splitAt 32 bytes
-          (plen, rest') <- decode32be "payload_len" rest
-          let payloadLen = fromIntegral plen
-          if BS.length rest' < payloadLen
-            then Left "payload extends beyond legacy bundle end"
-            else do
-              let (payload, after) = BS.splitAt payloadLen rest'
-                  h = rawToMerkleHash hashBytes
-              when (Map.member h acc) $
-                Left $ "duplicate node entry: " ++ unpack h
-              go (n - 1) after (Map.insert h payload acc)
 
 -- ---------------------------------------------------------------------------
 -- Bundle verification
@@ -611,7 +550,7 @@ verifyBundle bundle = do
 
 verifyManifest :: BundleManifest -> Either String ()
 verifyManifest manifest = do
-  when (manifestSchema manifest /= "tricu.bundle.manifest.v1") $
+  when (manifestSchema manifest /= "arborix.bundle.manifest.v1") $
     Left $ "unsupported manifest schema: " ++ unpack (manifestSchema manifest)
   when (manifestBundleType manifest /= "tree-calculus-executable-object") $
     Left $ "unsupported bundle type: " ++ unpack (manifestBundleType manifest)
@@ -622,13 +561,13 @@ verifyManifest manifest = do
     Left $ "unsupported calculus: " ++ unpack (treeCalculus treeSpec)
   when (nodeHashAlgorithm hashSpec /= "sha256") $
     Left $ "unsupported node hash algorithm: " ++ unpack (nodeHashAlgorithm hashSpec)
-  when (nodeHashDomain hashSpec /= "tricu.merkle.node.v1") $
+  when (nodeHashDomain hashSpec /= "arborix.merkle.node.v1") $
     Left $ "unsupported node hash domain: " ++ unpack (nodeHashDomain hashSpec)
-  when (treeNodePayload treeSpec /= "tricu.merkle.payload.v1") $
+  when (treeNodePayload treeSpec /= "arborix.merkle.payload.v1") $
     Left $ "unsupported node payload: " ++ unpack (treeNodePayload treeSpec)
   when (runtimeSemantics runtimeSpec /= "tree-calculus.v1") $
     Left $ "unsupported runtime semantics: " ++ unpack (runtimeSemantics runtimeSpec)
-  when (runtimeAbi runtimeSpec /= "tricu.abi.tree.v1") $
+  when (runtimeAbi runtimeSpec /= "arborix.abi.tree.v1") $
     Left $ "unsupported runtime ABI: " ++ unpack (runtimeAbi runtimeSpec)
   unless (null $ runtimeCapabilities runtimeSpec) $
     Left "host/runtime capabilities are not supported by bundle v1"