From e7a64260606f9f686c09a1fd6723b909ee1b7366 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Wed, 6 May 2026 15:30:56 -0500 Subject: [PATCH] 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). --- src/FileEval.hs | 56 ++++++++++++++++++++++++--------------- src/Main.hs | 40 ++++++++++++++++++---------- src/Server.hs | 70 ++++++++++++++++++++++++++++++++++++++++++++----- src/Wire.hs | 1 + tricu.cabal | 2 -- 5 files changed, 125 insertions(+), 44 deletions(-) diff --git a/src/FileEval.hs b/src/FileEval.hs index 68e7eb9..f19e783 100644 --- a/src/FileEval.hs +++ b/src/FileEval.hs @@ -11,11 +11,11 @@ import Lexer import Parser import Research 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.Maybe (fromMaybe, mapMaybe) +import Data.Maybe (mapMaybe) import System.Environment (setEnv) import System.FilePath (takeDirectory, normalise, ()) import System.Exit (die) @@ -164,23 +164,37 @@ nsVariable moduleName name = moduleName ++ "." ++ name -- | Compile a tricu source file to a standalone Arborix bundle. -- Uses a temp content store so it does not collide with the global one. -compileFile :: FilePath -> FilePath -> Maybe T.Text -> IO () -compileFile inputPath outputPath maybeExportName = do +-- Supports multiple named exports; each is stored separately in the +-- 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 env <- evaluateFile inputPath - -- Look up the export name: prefer explicit, then fall back to "main" - let name = fromMaybe "main" (T.unpack <$> maybeExportName) - case Map.lookup name env of - Nothing -> die $ "No definition '" ++ name ++ "' found in " ++ inputPath - Just term -> do - -- Create a temp content store - setEnv "TRICU_DB_PATH" "/tmp/tricu-compile.db" - conn <- initContentStore - -- Store the term in the temp store - _ <- storeTerm conn [name] term - -- Export the bundle (exportNamedBundle returns already-encoded bytes) - bundleData <- exportNamedBundle conn [(T.pack name, hashTerm term)] - BL.writeFile outputPath (BL.fromStrict bundleData) - close conn - putStrLn $ "Compiled " ++ inputPath ++ " -> " ++ outputPath - putStrLn $ " export: " ++ name + -- Look up each requested definition name + let defaultNames = ["main"] + wantedNames = if null maybeNames then defaultNames else maybeNames + wantedNamesUnpacked = map T.unpack wantedNames + compiledTerms <- mapM (\n -> case Map.lookup n env of + Nothing -> die $ "No definition '" ++ n ++ "' found in " ++ inputPath + Just t -> return (n, t)) wantedNamesUnpacked + let compiledMap :: Map.Map T.Text T = Map.fromList + $ map (\(n,t) -> (T.pack n, t)) compiledTerms + compiledNames :: [T.Text] = Map.keys compiledMap + compiledTermsList :: [T] = Map.elems compiledMap + -- Create a temp content store + setEnv "TRICU_DB_PATH" "/tmp/tricu-compile.db" + conn <- initContentStore + -- Store each term in the temp store under its requested 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) diff --git a/src/Main.hs b/src/Main.hs index cc104c7..64aac81 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -28,8 +28,8 @@ data TricuArgs = Repl | Evaluate { file :: [FilePath], form :: EvaluatedForm } | TDecode { file :: [FilePath] } - | Compile { inputFile :: FilePath, outFile :: FilePath, exportNameOpt :: String } - | Export { hash :: String, exportNameOpt :: String, outFile :: FilePath } + | Compile { inputFile :: FilePath, outFile :: FilePath, names :: [String] } + | Export { hash :: String, exportNameOpt :: String, outFile :: FilePath, names :: [String] } | Import { inFile :: FilePath } | Serve { host :: String, port :: Int } deriving (Show, Data, Typeable) @@ -67,11 +67,13 @@ decodeMode = TDecode exportMode :: TricuArgs 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" - , 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" , 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." &= explicit @@ -92,8 +94,8 @@ compileMode = Compile &= name "f" &= typ "FILE" , outFile = def &= help "Output bundle file path (.tri.bundle)." &= name "o" &= typ "FILE" - , exportNameOpt = def &= help "Definition name to use as the bundle root. Defaults to 'main'." - &= name "x" &= typ "NAME" + , names = def &= help "Definition name(s) to export as bundle roots (comma-separated or repeated -x). Defaults to 'main'." + &= name "x" &= typ "NAME" } &= help "Compile a tricu source file into a standalone Arborix portable bundle." &= explicit @@ -151,13 +153,23 @@ main = do [] -> getContents (filePath:_) -> readFile filePath 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 - (resolvedHash, storedNames) <- resolveExportTarget conn hashStr - expName <- chooseExportName exportNameArg hashStr storedNames - bundleData <- exportNamedBundle conn [(expName, resolvedHash)] + let hashList = T.split (== ',') (T.pack hashStr) + hashes <- mapM (\h -> do + (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) - putStrLn $ "Exported bundle export " ++ unpack expName ++ " -> " ++ unpack resolvedHash ++ " to " ++ outFilePath + putStrLn $ "Exported bundle with " ++ show (length exports) ++ " export(s) to " ++ outFilePath close conn Import { inFile = importFile } -> do conn <- initContentStore @@ -166,9 +178,9 @@ main = do putStrLn $ "Imported " ++ show (length roots) ++ " root(s):" mapM_ (\r -> putStrLn $ " " ++ unpack r) roots close conn - Compile { inputFile = compileInputFile, outFile = compileOutFile, exportNameOpt = exportNameArg } -> - let bundleExportName = if null exportNameArg then Nothing else Just (T.pack exportNameArg) - in compileFile compileInputFile compileOutFile bundleExportName + Compile { inputFile = compileInputFile, outFile = compileOutFile, names = namesArg } -> + let exportNames = if null namesArg then [] else map T.pack namesArg + in compileFile compileInputFile compileOutFile exportNames Serve { host = hostStr, port = portNum } -> do putStrLn $ "Starting Arborix bundle server on " ++ hostStr ++ ":" ++ show portNum putStrLn $ " GET /bundle/hash/:hash -- primary endpoint" diff --git a/src/Server.hs b/src/Server.hs index ad93100..795f701 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -7,16 +7,20 @@ import ContentStore (initContentStore, nameToTerm, hashToTerm, listStoredTerms, import Database.SQLite.Simple (close) 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.Wai import Network.Wai.Handler.Warp (defaultSettings, runSettings, setHost, setPort) import Data.String (fromString) import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) -import Data.Char (isHexDigit) +import Data.Text.Encoding (encodeUtf8, decodeUtf8) +import Data.Char (isHexDigit, toLower) +import Data.ByteString.Char8 (unpack) import Data.ByteString.Lazy (fromStrict) - import qualified Data.Text as T -- | Start an HTTP server that serves Arborix bundles from the @@ -30,10 +34,11 @@ import qualified Data.Text as T -- -- Endpoints -- --------- --- GET /health - 200 "ok" --- GET /bundle/name/:name - export by stored term name --- GET /bundle/hash/:hash - export by full Merkle hash --- GET /terms - plain-text listing (debug) +-- GET /health - 200 "ok" +-- GET /bundle/name/:name - export single term by name +-- GET /bundle/hash/:hash - export single term by hash +-- GET /bundle/roots?n=...&h=... - export multiple roots (n=name, h=hash) +-- GET /terms - plain-text listing (debug) -- runServer :: String -> Int -> IO () runServer hostStr port = @@ -49,6 +54,9 @@ app request respond = case (requestMethod request, pathInfo request) of ("GET", ["health"]) -> respond $ healthResponse + ("GET", ["bundle", "roots"]) -> + rootsHandler request respond + ("GET", ["bundle", "name", nameText]) -> do body <- nameHandler nameText respond body @@ -76,6 +84,54 @@ app request respond = case (requestMethod request, pathInfo request) of healthResponse :: Response 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=@ — one or more stored term names (resolved via nameToTerm) +-- - @h=@ — 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 -- Resolve a stored term name, export it as an Arborix bundle, -- and return the raw bundle bytes. diff --git a/src/Wire.hs b/src/Wire.hs index bbc781d..e9bdfcc 100644 --- a/src/Wire.hs +++ b/src/Wire.hs @@ -17,6 +17,7 @@ module Wire , exportBundle , exportNamedBundle , importBundle + , defaultExportNames ) where import ContentStore (getNodeMerkle, loadTree, putMerkleNode, storeTerm) diff --git a/tricu.cabal b/tricu.cabal index e1cbbda..8e97dfa 100644 --- a/tricu.cabal +++ b/tricu.cabal @@ -42,7 +42,6 @@ executable tricu , base16-bytestring , base64-bytestring , bytestring - , cereal , cmdargs , containers , cryptonite @@ -96,7 +95,6 @@ test-suite tricu-tests , base16-bytestring , base64-bytestring , bytestring - , cereal , cmdargs , containers , cryptonite