Support multiple named exports globally

Add multi-root bundle support across the toolchain:
 - `compile`: Accept multiple definition names via `-x NAME` (repeatable or
   comma-separated). Exports all requested definitions as named roots in a
   single bundle. Defaults to "main" when no names are given.
 - `export`: Accept comma-separated hashes in the positional argument and
   multiple `-n`/`names` flags. Exports all resolved roots in one bundle.
 - Server: Add `GET /bundle/roots?n=...&h=...` endpoint that resolves
   multiple stored-term names and/or raw Merkle hashes, returning a single
   bundle containing all of them as roots.
 - Wire: Export `defaultExportNames` helper for generating default export
   names when none are supplied.
 - Drop `cereal` dependency from `tricu.cabal` (no longer used).
This commit is contained in:
2026-05-06 15:30:56 -05:00
parent 7e16607d96
commit e7a6426060
5 changed files with 125 additions and 44 deletions

View File

@@ -11,11 +11,11 @@ import Lexer
import Parser import Parser
import Research import Research
import ContentStore (initContentStore, storeTerm, hashTerm) import ContentStore (initContentStore, storeTerm, hashTerm)
import Wire (exportNamedBundle) import Wire (exportNamedBundle, defaultExportNames)
import Control.Monad () import Control.Monad (forM_)
import Data.List (partition) import Data.List (partition)
import Data.Maybe (fromMaybe, mapMaybe) import Data.Maybe (mapMaybe)
import System.Environment (setEnv) import System.Environment (setEnv)
import System.FilePath (takeDirectory, normalise, (</>)) import System.FilePath (takeDirectory, normalise, (</>))
import System.Exit (die) import System.Exit (die)
@@ -164,23 +164,37 @@ nsVariable moduleName name = moduleName ++ "." ++ name
-- | Compile a tricu source file to a standalone Arborix bundle. -- | Compile a tricu source file to a standalone Arborix bundle.
-- Uses a temp content store so it does not collide with the global one. -- Uses a temp content store so it does not collide with the global one.
compileFile :: FilePath -> FilePath -> Maybe T.Text -> IO () -- Supports multiple named exports; each is stored separately in the
compileFile inputPath outputPath maybeExportName = do -- temp store so that resolveExportTarget can look them up by name.
compileFile :: FilePath -> FilePath -> [T.Text] -> IO ()
compileFile inputPath outputPath maybeNames = do
-- Evaluate the file to get the full environment -- Evaluate the file to get the full environment
env <- evaluateFile inputPath env <- evaluateFile inputPath
-- Look up the export name: prefer explicit, then fall back to "main" -- Look up each requested definition name
let name = fromMaybe "main" (T.unpack <$> maybeExportName) let defaultNames = ["main"]
case Map.lookup name env of wantedNames = if null maybeNames then defaultNames else maybeNames
Nothing -> die $ "No definition '" ++ name ++ "' found in " ++ inputPath wantedNamesUnpacked = map T.unpack wantedNames
Just term -> do compiledTerms <- mapM (\n -> case Map.lookup n env of
-- Create a temp content store Nothing -> die $ "No definition '" ++ n ++ "' found in " ++ inputPath
setEnv "TRICU_DB_PATH" "/tmp/tricu-compile.db" Just t -> return (n, t)) wantedNamesUnpacked
conn <- initContentStore let compiledMap :: Map.Map T.Text T = Map.fromList
-- Store the term in the temp store $ map (\(n,t) -> (T.pack n, t)) compiledTerms
_ <- storeTerm conn [name] term compiledNames :: [T.Text] = Map.keys compiledMap
-- Export the bundle (exportNamedBundle returns already-encoded bytes) compiledTermsList :: [T] = Map.elems compiledMap
bundleData <- exportNamedBundle conn [(T.pack name, hashTerm term)] -- Create a temp content store
BL.writeFile outputPath (BL.fromStrict bundleData) setEnv "TRICU_DB_PATH" "/tmp/tricu-compile.db"
close conn conn <- initContentStore
putStrLn $ "Compiled " ++ inputPath ++ " -> " ++ outputPath -- Store each term in the temp store under its requested name
putStrLn $ " export: " ++ name forM_ (zip compiledNames compiledTermsList) $ \(n, t) ->
storeTerm conn [T.unpack n] t
-- Generate default export names when none were supplied
let expNames = if null maybeNames
then defaultExportNames (length compiledNames)
else compiledNames
exports :: [(T.Text, MerkleHash)] = zip expNames (map hashTerm compiledTermsList)
-- Export the bundle (exportNamedBundle returns already-encoded bytes)
bundleData <- exportNamedBundle conn exports
BL.writeFile outputPath (BL.fromStrict bundleData)
close conn
putStrLn $ "Compiled " ++ inputPath ++ " -> " ++ outputPath
putStrLn $ " exports: " ++ T.unpack (T.intercalate ", " expNames)

View File

@@ -28,8 +28,8 @@ data TricuArgs
= Repl = Repl
| Evaluate { file :: [FilePath], form :: EvaluatedForm } | Evaluate { file :: [FilePath], form :: EvaluatedForm }
| TDecode { file :: [FilePath] } | TDecode { file :: [FilePath] }
| Compile { inputFile :: FilePath, outFile :: FilePath, exportNameOpt :: String } | Compile { inputFile :: FilePath, outFile :: FilePath, names :: [String] }
| Export { hash :: String, exportNameOpt :: String, outFile :: FilePath } | Export { hash :: String, exportNameOpt :: String, outFile :: FilePath, names :: [String] }
| Import { inFile :: FilePath } | Import { inFile :: FilePath }
| Serve { host :: String, port :: Int } | Serve { host :: String, port :: Int }
deriving (Show, Data, Typeable) deriving (Show, Data, Typeable)
@@ -67,11 +67,13 @@ decodeMode = TDecode
exportMode :: TricuArgs exportMode :: TricuArgs
exportMode = Export exportMode = Export
{ hash = def &= help "Full/prefix hash or stored term name to export." { hash = def &= help "Hash or stored term name(s) to export (comma-separated)."
&= name "h" &= typ "HASH_OR_NAME" &= name "h" &= typ "HASH_OR_NAME"
, exportNameOpt = def &= help "Export name to place in the bundle manifest. Defaults to the stored term name when exporting by name; otherwise defaults to root." , exportNameOpt = def &= help "Export name (legacy; use -n NAME for full control)."
&= name "n" &= typ "NAME" &= name "n" &= typ "NAME"
, outFile = def &= help "Output file path for the bundle." &= name "o" &= typ "FILE" , outFile = def &= help "Output file path for the bundle." &= name "o" &= typ "FILE"
, names = def &= help "Export name(s) for the bundle manifest (comma-separated or repeated -n)."
&= typ "NAME"
} }
&= help "Export a Merkle bundle from the content store." &= help "Export a Merkle bundle from the content store."
&= explicit &= explicit
@@ -92,8 +94,8 @@ compileMode = Compile
&= name "f" &= typ "FILE" &= name "f" &= typ "FILE"
, outFile = def &= help "Output bundle file path (.tri.bundle)." , outFile = def &= help "Output bundle file path (.tri.bundle)."
&= name "o" &= typ "FILE" &= name "o" &= typ "FILE"
, exportNameOpt = def &= help "Definition name to use as the bundle root. Defaults to 'main'." , names = def &= help "Definition name(s) to export as bundle roots (comma-separated or repeated -x). Defaults to 'main'."
&= name "x" &= typ "NAME" &= name "x" &= typ "NAME"
} }
&= help "Compile a tricu source file into a standalone Arborix portable bundle." &= help "Compile a tricu source file into a standalone Arborix portable bundle."
&= explicit &= explicit
@@ -151,13 +153,23 @@ main = do
[] -> getContents [] -> getContents
(filePath:_) -> readFile filePath (filePath:_) -> readFile filePath
putStrLn $ decodeResult $ result $ evalTricu Map.empty $ parseTricu value putStrLn $ decodeResult $ result $ evalTricu Map.empty $ parseTricu value
Export { hash = hashStr, exportNameOpt = exportNameArg, outFile = outFilePath } -> do Export { hash = hashStr, exportNameOpt = legacyName, names = namesArg, outFile = outFilePath } -> do
conn <- initContentStore conn <- initContentStore
(resolvedHash, storedNames) <- resolveExportTarget conn hashStr let hashList = T.split (== ',') (T.pack hashStr)
expName <- chooseExportName exportNameArg hashStr storedNames hashes <- mapM (\h -> do
bundleData <- exportNamedBundle conn [(expName, resolvedHash)] (resolvedHash, _) <- resolveExportTarget conn (T.unpack h)
return resolvedHash) hashList
-- Merge legacy -n and new -n (names); names wins when non-empty
let allNames = if null namesArg
then if null legacyName then [] else [legacyName]
else namesArg
let expNames = if null allNames
then defaultExportNames (length hashes)
else map T.pack allNames
let exports = zip expNames hashes
bundleData <- exportNamedBundle conn exports
BL.writeFile outFilePath (BL.fromStrict bundleData) BL.writeFile outFilePath (BL.fromStrict bundleData)
putStrLn $ "Exported bundle export " ++ unpack expName ++ " -> " ++ unpack resolvedHash ++ " to " ++ outFilePath putStrLn $ "Exported bundle with " ++ show (length exports) ++ " export(s) to " ++ outFilePath
close conn close conn
Import { inFile = importFile } -> do Import { inFile = importFile } -> do
conn <- initContentStore conn <- initContentStore
@@ -166,9 +178,9 @@ main = do
putStrLn $ "Imported " ++ show (length roots) ++ " root(s):" putStrLn $ "Imported " ++ show (length roots) ++ " root(s):"
mapM_ (\r -> putStrLn $ " " ++ unpack r) roots mapM_ (\r -> putStrLn $ " " ++ unpack r) roots
close conn close conn
Compile { inputFile = compileInputFile, outFile = compileOutFile, exportNameOpt = exportNameArg } -> Compile { inputFile = compileInputFile, outFile = compileOutFile, names = namesArg } ->
let bundleExportName = if null exportNameArg then Nothing else Just (T.pack exportNameArg) let exportNames = if null namesArg then [] else map T.pack namesArg
in compileFile compileInputFile compileOutFile bundleExportName in compileFile compileInputFile compileOutFile exportNames
Serve { host = hostStr, port = portNum } -> do Serve { host = hostStr, port = portNum } -> do
putStrLn $ "Starting Arborix bundle server on " ++ hostStr ++ ":" ++ show portNum putStrLn $ "Starting Arborix bundle server on " ++ hostStr ++ ":" ++ show portNum
putStrLn $ " GET /bundle/hash/:hash -- primary endpoint" putStrLn $ " GET /bundle/hash/:hash -- primary endpoint"

View File

@@ -7,16 +7,20 @@ import ContentStore (initContentStore, nameToTerm, hashToTerm, listStoredTerms,
import Database.SQLite.Simple (close) import Database.SQLite.Simple (close)
import Wire (exportNamedBundle) import Wire (exportNamedBundle)
import Control.Monad (when)
import Data.Maybe (catMaybes)
import Control.Monad (void)
import Network.HTTP.Types (Header, Status, status200, status400, status404, status405, hContentType) import Network.HTTP.Types (Header, Status, status200, status400, status404, status405, hContentType)
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp (defaultSettings, runSettings, setHost, setPort) import Network.Wai.Handler.Warp (defaultSettings, runSettings, setHost, setPort)
import Data.String (fromString) import Data.String (fromString)
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Char (isHexDigit) import Data.Char (isHexDigit, toLower)
import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy (fromStrict) import Data.ByteString.Lazy (fromStrict)
import qualified Data.Text as T import qualified Data.Text as T
-- | Start an HTTP server that serves Arborix bundles from the -- | Start an HTTP server that serves Arborix bundles from the
@@ -30,10 +34,11 @@ import qualified Data.Text as T
-- --
-- Endpoints -- Endpoints
-- --------- -- ---------
-- GET /health - 200 "ok" -- GET /health - 200 "ok"
-- GET /bundle/name/:name - export by stored term name -- GET /bundle/name/:name - export single term by name
-- GET /bundle/hash/:hash - export by full Merkle hash -- GET /bundle/hash/:hash - export single term by hash
-- GET /terms - plain-text listing (debug) -- GET /bundle/roots?n=...&h=... - export multiple roots (n=name, h=hash)
-- GET /terms - plain-text listing (debug)
-- --
runServer :: String -> Int -> IO () runServer :: String -> Int -> IO ()
runServer hostStr port = runServer hostStr port =
@@ -49,6 +54,9 @@ app request respond = case (requestMethod request, pathInfo request) of
("GET", ["health"]) -> ("GET", ["health"]) ->
respond $ healthResponse respond $ healthResponse
("GET", ["bundle", "roots"]) ->
rootsHandler request respond
("GET", ["bundle", "name", nameText]) -> do ("GET", ["bundle", "name", nameText]) -> do
body <- nameHandler nameText body <- nameHandler nameText
respond body respond body
@@ -76,6 +84,54 @@ app request respond = case (requestMethod request, pathInfo request) of
healthResponse :: Response healthResponse :: Response
healthResponse = responseLBS status200 [] "ok" healthResponse = responseLBS status200 [] "ok"
-- | GET /bundle/roots?n=root&n=helper&h=abc123...
-- Resolve multiple named roots (by stored term name or raw hash)
-- and return a single bundle containing all of them.
--
-- Query parameters:
-- - @n=<name>@ — one or more stored term names (resolved via nameToTerm)
-- - @h=<hash>@ — one or more full Merkle hashes (validated as 16-64 hex chars)
--
-- The bundle manifest receives all resolved (name, hash) pairs as roots
-- and exports. The node section is the union of all reachable nodes.
rootsHandler :: Request -> (Response -> IO a) -> IO a
rootsHandler request respond = do
conn <- initContentStore
let qs = queryString request
nParams = catMaybes [v | (k, v) <- qs, map toLower (unpack k) == "n"]
hParams = catMaybes [v | (k, v) <- qs, map toLower (unpack k) == "h"]
-- Resolve 'n' params to (name, hash) pairs
nResults <- mapM (\nVal -> do
stored <- nameToTerm conn (decodeUtf8 nVal)
case stored of
Nothing -> return Nothing
Just t -> return $ Just (decodeUtf8 nVal, termHash t)) nParams
let namedHashesFromN = catMaybes nResults
-- Validate 'h' params and build (name, hash) pairs
namedHashesFromH <- mapM (\hVal -> do
let raw = T.pack (dropWhile (=='#') (T.unpack (decodeUtf8 hVal)))
if T.all isHexDigit raw && T.length raw >= 16
then do
stored <- hashToTerm conn raw
let names = maybe "root" firstOrRoot (termNames <$> stored)
return $ Just (names, raw)
else return Nothing)
hParams
let allNamedHashes = namedHashesFromN ++ catMaybes namedHashesFromH
-- Require at least one root
when (null allNamedHashes) $ do
let resp = responseLBS status400 [] "400 Bad Request: at least one n= or h= parameter required"
close conn
void $ respond resp
-- Build and return the bundle
bundleData <- exportNamedBundle conn allNamedHashes
let firstHash = snd (head allNamedHashes)
cd = T.pack "attachment; filename=roots.bundle"
close conn
respond $ responseLBS status200
(bundleHeaders firstHash cd)
(fromStrict bundleData)
-- | GET /bundle/name/:name -- | GET /bundle/name/:name
-- Resolve a stored term name, export it as an Arborix bundle, -- Resolve a stored term name, export it as an Arborix bundle,
-- and return the raw bundle bytes. -- and return the raw bundle bytes.

View File

@@ -17,6 +17,7 @@ module Wire
, exportBundle , exportBundle
, exportNamedBundle , exportNamedBundle
, importBundle , importBundle
, defaultExportNames
) where ) where
import ContentStore (getNodeMerkle, loadTree, putMerkleNode, storeTerm) import ContentStore (getNodeMerkle, loadTree, putMerkleNode, storeTerm)

View File

@@ -42,7 +42,6 @@ executable tricu
, base16-bytestring , base16-bytestring
, base64-bytestring , base64-bytestring
, bytestring , bytestring
, cereal
, cmdargs , cmdargs
, containers , containers
, cryptonite , cryptonite
@@ -96,7 +95,6 @@ test-suite tricu-tests
, base16-bytestring , base16-bytestring
, base64-bytestring , base64-bytestring
, bytestring , bytestring
, cereal
, cmdargs , cmdargs
, containers , containers
, cryptonite , cryptonite