commit efc03614ad227f8c1cba6f2280361a14bfa7ea0f
parent cce9daa362be71139db57ee795c4d2b7f524cf48
Author: James Eversole <james@eversole.co>
Date: Thu, 21 May 2026 15:25:26 -0500
Packaging: Fully static Haskell builds and webapp
Diffstat:
6 files changed, 96 insertions(+), 55 deletions(-)
diff --git a/demos/interactionTrees/arboricxServer.tri b/demos/interactionTrees/arboricxServer.tri
@@ -6,7 +6,7 @@
--
-- Endpoints:
-- 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
--
-- Example usage:
diff --git a/flake.nix b/flake.nix
@@ -16,7 +16,29 @@
haskellPackages = pkgs.haskellPackages;
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 =
haskellPackages.callCabal2nix packageName self {};
@@ -221,6 +243,8 @@
in {
packages.${packageName} = tricuPackage;
packages.default = tricuPackage;
+ packages.tricu-static = tricuMuslStatic;
+ packages.tricu-static-upx = tricuStatic;
packages.tricu-bench = tricuBench;
packages.tricu-zig = tricuZig;
packages.tricu-zig-tests = tricuZigTests;
@@ -252,20 +276,35 @@
packages.${containerPackageName} = pkgs.dockerTools.buildImage {
name = "tricu";
+ tag = "latest";
copyToRoot = pkgs.buildEnv {
name = "image-root";
paths = [ tricuStatic ];
pathsToLink = [ "/bin" ];
};
+
+ config = {
+ Cmd = [ "/bin/tricu" ];
+ WorkingDir = "/app";
+ };
+ };
+
+ 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 = {
- Cmd = [
- "/bin/tricu"
- ];
+ Entrypoint = [ "/app/bin/tricu" "eval" "tricu-apps/arboricxServer.tri" "--io" "--allow-read" "./store" "--allow-write" "./store" "-f" "decode" ];
WorkingDir = "/app";
- extraCommands = ''
- '';
+ ExposedPorts = { "8080/tcp" = {}; };
};
};
});
diff --git a/lib/arboricx/server.tri b/lib/arboricx/server.tri
@@ -130,6 +130,15 @@ stripPrefix = (prefix input :
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
-- ---------------------------------------------------------------------------
@@ -154,7 +163,7 @@ putBundleRoute = (root method target body :
(hash _ : pure (createdResponse hash))
result))
(_ : pure notFoundResponse)
- (equal? target "/_arboricx/bundles"))
+ (equal? target "/_arboricx/bundle"))
(_ : pure notFoundResponse)
(equal? method "POST"))
@@ -176,15 +185,19 @@ getBundleRoute = (root method target :
arboricxRouter = (root method target headers body :
lazyBool
(_ :
- lazyMaybe
- (_ : healthRoute method target)
- (hash :
- bind (getBundleByHash root hash) (result :
- matchResult
- (errMsg _ : pure (errorResponse 404 errMsg))
- (bytes _ : pure (response 200 "application/vnd.arboricx.bundle" bytes))
- result))
- (stripPrefix bundleHashPrefix target))
+ lazyBool
+ (_ : pure (htmlResponse htmlLandingPage))
+ (_ :
+ lazyMaybe
+ (_ : healthRoute method target)
+ (hash :
+ bind (getBundleByHash root hash) (result :
+ matchResult
+ (errMsg _ : pure (errorResponse 404 errMsg))
+ (bytes _ : pure (response 200 "application/vnd.arboricx.bundle" bytes))
+ result))
+ (stripPrefix bundleHashPrefix target))
+ (equal? target "/"))
(_ :
lazyBool
(_ : putBundleRoute root method target body)
diff --git a/lib/http.tri b/lib/http.tri
@@ -104,6 +104,9 @@ textResponse = (body :
jsonResponse = (body :
response 200 "application/json" body)
+htmlResponse = (body :
+ response 200 "text/html; charset=utf-8" body)
+
createdResponse = (body :
response 201 "text/plain; charset=utf-8" body)
diff --git a/test/Spec.hs b/test/Spec.hs
@@ -2122,42 +2122,6 @@ binaryParserTests = testGroup "Binary Parser Tests"
let input = "expectAscii \"hi\" [(104) (99)]"
env = evalTricu lib (parseTricu input)
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)
ioErrResult :: String -> T
-ioErrResult msg = Fork Leaf (Fork (ofString msg) Leaf)
-\ No newline at end of file
+ioErrResult msg = Fork Leaf (Fork (ofString msg) Leaf)
diff --git a/tricu-apps/arboricxServer.tri b/tricu-apps/arboricxServer.tri
@@ -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)))
