From ac90d23b46d42e9552972ca38365eb9afad16f5d Mon Sep 17 00:00:00 2001 From: James Eversole Date: Thu, 21 May 2026 15:25:26 -0500 Subject: [PATCH] Packaging: Fully static Haskell builds and webapp --- demos/interactionTrees/arboricxServer.tri | 2 +- flake.nix | 53 ++++++++++++++++++++--- lib/arboricx/server.tri | 33 +++++++++----- lib/http.tri | 3 ++ test/Spec.hs | 38 +--------------- tricu-apps/arboricxServer.tri | 23 ++++++++++ 6 files changed, 97 insertions(+), 55 deletions(-) create mode 100644 tricu-apps/arboricxServer.tri diff --git a/demos/interactionTrees/arboricxServer.tri b/demos/interactionTrees/arboricxServer.tri index c6d1acb..9741c5d 100644 --- 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 index d2085f8..fe85045 100644 --- 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" ]; }; - tag = "latest"; + config = { - Cmd = [ - "/bin/tricu" - ]; + Cmd = [ "/bin/tricu" ]; 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" = {}; }; }; }; }); diff --git a/lib/arboricx/server.tri b/lib/arboricx/server.tri index 7b31756..5b546dc 100644 --- a/lib/arboricx/server.tri +++ b/lib/arboricx/server.tri @@ -129,6 +129,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 = "Arboricx Server

Arboricx Server

Bundle registry

Made with Love (and trees, lots of trees)

" + -- --------------------------------------------------------------------------- -- 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 index e23360d..cb10579 100644 --- 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 index a0144a0..8e64f03 100644 --- 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 new file mode 100644 index 0000000..1465241 --- /dev/null +++ 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/ + +main = io (thenIO + (putStrLn "Starting Arboricx server on 0.0.0.0:8080") + (thenIO + (void (ensureStore "./store")) + (arboricxServer "./store" "0.0.0.0" 8080)))