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:
@@ -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)
|
||||||
|
|||||||
40
src/Main.hs
40
src/Main.hs
@@ -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"
|
||||||
|
|||||||
@@ -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.
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user