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

33
lib/arboricx/server.tri
View File

@@ -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 = "<!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)