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

Packaging: Fully static Haskell builds and webapp

Browse Source
This commit is contained in:
James Eversole
2026-05-21 15:25:26 -05:00
parent 4bf2ce56dd
commit ac90d23b46
6 changed files with 97 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
demos/interactionTrees/arboricxServer.tri
View File

@@ -6,7 +6,7 @@
-- --
-- Endpoints: -- Endpoints:
-- GET /_arboricx/health -> "OK" -- GET /_arboricx/health -> "OK"
-- POST /_arboricx/bundles -> upload bundle, returns hash -- POST /_arboricx/bundle -> upload bundle, returns hash
-- GET /_arboricx/bundle/hash/:h -> download bundle by hash -- GET /_arboricx/bundle/hash/:h -> download bundle by hash
-- --
-- Example usage: -- Example usage:

53
flake.nix
View File

@@ -16,7 +16,29 @@
haskellPackages = pkgs.haskellPackages; haskellPackages = pkgs.haskellPackages;
hsLib = pkgs.haskell.lib; hsLib = pkgs.haskell.lib;
tricuStatic = hsLib.justStaticExecutables self.packages.${system}.default; staticPkgs = pkgs.pkgsStatic;
staticHaskellPackages = staticPkgs.haskellPackages;
staticHsLib = staticPkgs.haskell.lib;
tricuMuslStatic =
staticHsLib.justStaticExecutables (
staticHsLib.dontCheck (
staticHaskellPackages.callCabal2nix packageName self {}
)
);
tricuStatic = pkgs.runCommand "${packageName}-static-upx" {
nativeBuildInputs = [ pkgs.upx ];
} ''
mkdir -p $out/bin
cp ${tricuMuslStatic}/bin/tricu $out/bin/tricu
chmod +w $out/bin/tricu
# Good compression, slower build.
upx --best --lzma $out/bin/tricu
chmod 755 $out/bin/tricu
'';
tricuPackageTests = tricuPackageTests =
haskellPackages.callCabal2nix packageName self {}; haskellPackages.callCabal2nix packageName self {};
@@ -221,6 +243,8 @@
in { in {
packages.${packageName} = tricuPackage; packages.${packageName} = tricuPackage;
packages.default = tricuPackage; packages.default = tricuPackage;
packages.tricu-static = tricuMuslStatic;
packages.tricu-static-upx = tricuStatic;
packages.tricu-bench = tricuBench; packages.tricu-bench = tricuBench;
packages.tricu-zig = tricuZig; packages.tricu-zig = tricuZig;
packages.tricu-zig-tests = tricuZigTests; packages.tricu-zig-tests = tricuZigTests;
@@ -252,20 +276,35 @@
packages.${containerPackageName} = pkgs.dockerTools.buildImage { packages.${containerPackageName} = pkgs.dockerTools.buildImage {
name = "tricu"; name = "tricu";
tag = "latest";
copyToRoot = pkgs.buildEnv { copyToRoot = pkgs.buildEnv {
name = "image-root"; name = "image-root";
paths = [ tricuStatic ]; paths = [ tricuStatic ];
pathsToLink = [ "/bin" ]; pathsToLink = [ "/bin" ];
}; };
tag = "latest";
config = { config = {
Cmd = [ Cmd = [ "/bin/tricu" ];
"/bin/tricu"
];
WorkingDir = "/app"; WorkingDir = "/app";
extraCommands = '' };
''; };
packages.arboricxServer = pkgs.dockerTools.buildImage {
name = "arboricxServer";
tag = "latest";
copyToRoot = pkgs.runCommand "arboricxServer" {} ''
mkdir -p $out/app/bin $out/app/lib $out/app/tricu-apps $out/app/store
cp ${tricuStatic}/bin/tricu $out/app/bin/
cp -r ${./lib}/* $out/app/lib/
cp ${./tricu-apps/arboricxServer.tri} $out/app/tricu-apps/arboricxServer.tri
'';
config = {
Entrypoint = [ "/app/bin/tricu" "eval" "tricu-apps/arboricxServer.tri" "--io" "--allow-read" "./store" "--allow-write" "./store" "-f" "decode" ];
WorkingDir = "/app";
ExposedPorts = { "8080/tcp" = {}; };
}; };
}; };
}); });

33
lib/arboricx/server.tri
View File

@@ -129,6 +129,15 @@ stripPrefix = (prefix input :
bundleHashPrefix = "/_arboricx/bundle/hash/" bundleHashPrefix = "/_arboricx/bundle/hash/"
-- ---------------------------------------------------------------------------
-- Landing page
-- ---------------------------------------------------------------------------
-- TODO: Let's replace in-line HTML with the ability to read and serve files
-- from a public/ folder.
htmlLandingPage = "<!DOCTYPE html><html><head><meta name='viewport' content='width=device-width, initial-scale=1'><title>Arboricx Server</title></head><body><h1>Arboricx Server</h1><p>Bundle registry</p><p><a href='https://git.eversole.co/James/tricu'>Made with Love (and trees, lots of trees)</a></p></body></html>"
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Registry routes -- Registry routes
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
@@ -154,7 +163,7 @@ putBundleRoute = (root method target body :
(hash _ : pure (createdResponse hash)) (hash _ : pure (createdResponse hash))
result)) result))
(_ : pure notFoundResponse) (_ : pure notFoundResponse)
(equal? target "/_arboricx/bundles")) (equal? target "/_arboricx/bundle"))
(_ : pure notFoundResponse) (_ : pure notFoundResponse)
(equal? method "POST")) (equal? method "POST"))
@@ -176,15 +185,19 @@ getBundleRoute = (root method target :
arboricxRouter = (root method target headers body : arboricxRouter = (root method target headers body :
lazyBool lazyBool
(_ : (_ :
lazyMaybe lazyBool
(_ : healthRoute method target) (_ : pure (htmlResponse htmlLandingPage))
(hash : (_ :
bind (getBundleByHash root hash) (result : lazyMaybe
matchResult (_ : healthRoute method target)
(errMsg _ : pure (errorResponse 404 errMsg)) (hash :
(bytes _ : pure (response 200 "application/vnd.arboricx.bundle" bytes)) bind (getBundleByHash root hash) (result :
result)) matchResult
(stripPrefix bundleHashPrefix target)) (errMsg _ : pure (errorResponse 404 errMsg))
(bytes _ : pure (response 200 "application/vnd.arboricx.bundle" bytes))
result))
(stripPrefix bundleHashPrefix target))
(equal? target "/"))
(_ : (_ :
lazyBool lazyBool
(_ : putBundleRoute root method target body) (_ : putBundleRoute root method target body)

3
lib/http.tri
View File

@@ -104,6 +104,9 @@ textResponse = (body :
jsonResponse = (body : jsonResponse = (body :
response 200 "application/json" body) response 200 "application/json" body)
htmlResponse = (body :
response 200 "text/html; charset=utf-8" body)
createdResponse = (body : createdResponse = (body :
response 201 "text/plain; charset=utf-8" body) response 201 "text/plain; charset=utf-8" body)

38
test/Spec.hs
View File

@@ -2122,42 +2122,6 @@ binaryParserTests = testGroup "Binary Parser Tests"
let input = "expectAscii \"hi\" [(104) (99)]" let input = "expectAscii \"hi\" [(104) (99)]"
env = evalTricu lib (parseTricu input) env = evalTricu lib (parseTricu input)
result env @?= parserErr (ofNumber 2) (bytesT [104, 99]) result env @?= parserErr (ofNumber 2) (bytesT [104, 99])
, testCase "u16BE decodes big-endian" $ do
lib <- evaluateFile "./lib/binary.tri"
let input = "u16BE [(1) (0)]"
env = evalTricu lib (parseTricu input)
result env @?= ofNumber 256
, testCase "u16BE zero" $ do
lib <- evaluateFile "./lib/binary.tri"
let input = "u16BE [(0) (1)]"
env = evalTricu lib (parseTricu input)
result env @?= ofNumber 1
, testCase "u16LE decodes little-endian" $ do
lib <- evaluateFile "./lib/binary.tri"
let input = "u16LE [(1) (0)]"
env = evalTricu lib (parseTricu input)
result env @?= ofNumber 1
, testCase "u16LE zero" $ do
lib <- evaluateFile "./lib/binary.tri"
let input = "u16LE [(0) (1)]"
env = evalTricu lib (parseTricu input)
result env @?= ofNumber 256
, testCase "readU16BE parses and decodes" $ do
lib <- evaluateFile "./lib/binary.tri"
let input = "readU16BE [(0) (1) (2)]"
env = evalTricu lib (parseTricu input)
result env @?= parserOk (ofNumber 1) (bytesT [2])
, testCase "readU16LE parses and decodes" $ do
lib <- evaluateFile "./lib/binary.tri"
let input = "readU16LE [(1) (0) (2)]"
env = evalTricu lib (parseTricu input)
result env @?= parserOk (ofNumber 1) (bytesT [2])
] ]
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
@@ -3577,4 +3541,4 @@ ioOkResult :: T -> T
ioOkResult val = Fork (Stem Leaf) (Fork val Leaf) ioOkResult val = Fork (Stem Leaf) (Fork val Leaf)
ioErrResult :: String -> T ioErrResult :: String -> T
ioErrResult msg = Fork Leaf (Fork (ofString msg) Leaf) ioErrResult msg = Fork Leaf (Fork (ofString msg) Leaf)

23
tricu-apps/arboricxServer.tri Normal file
View File

@@ -0,0 +1,23 @@
!import "../lib/io.tri" !Local
!import "../lib/arboricx/server.tri" !Local
-- Arboricx HTTP registry server.
-- Run with --allow-write ./store --allow-read ./store
--
-- Endpoints:
-- GET / -> HTML landing page
-- GET /_arboricx/health -> "OK"
-- POST /_arboricx/bundle -> upload bundle, returns hash
-- GET /_arboricx/bundle/hash/:h -> download bundle by hash
--
-- Example usage:
-- curl http://localhost:8080/
-- curl http://localhost:8080/_arboricx/health
-- curl -X POST --data-binary @mybundle.arboricx http://localhost:8080/_arboricx/bundles
-- curl http://localhost:8080/_arboricx/bundle/hash/<hash>
main = io (thenIO
(putStrLn "Starting Arboricx server on 0.0.0.0:8080")
(thenIO
(void (ensureStore "./store"))
(arboricxServer "./store" "0.0.0.0" 8080)))