From 17b6c872f2ab570c94c81a61ac605d5041c1498d Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 2 Apr 2026 21:00:32 +0000 Subject: [PATCH] Server cleanup: extract app-specific config into SX MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Phase 1 Step 2 of architecture roadmap. The OCaml HTTP server is now generic — all sx_docs-specific values (layout components, path prefix, title, warmup paths, handler prefixes, CSS/JS, client libs) move into sx/sx/app-config.sx as a __app-config dict. Server reads config at startup with hardcoded defaults as fallback, so it works with no config, partial config, or full config. Removed: 9 demo data stubs, stepper cookie cache logic, page-functions.sx directory heuristic. Added: 29-test server config test suite covering standard, custom, no-config, and minimal-config scenarios. Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/bin/sx_server.ml | 139 ++++++++++++------- sx/sx/app-config.sx | 1 + tests/test_server_config.sh | 255 +++++++++++++++++++++++++++++++++++ web/request-handler.sx | 30 +++-- 4 files changed, 364 insertions(+), 61 deletions(-) create mode 100644 sx/sx/app-config.sx create mode 100755 tests/test_server_config.sh diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 0874c496..47696138 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -146,16 +146,35 @@ let io_counter = ref 0 let _request_cookies = Sx_scope.request_cookies let _scope_stacks = Sx_scope.scope_stacks +(* ── App config ─────────────────────────────────────────────────────── *) +(* Populated from __app-config dict after SX files load. *) +let _app_config : (string, value) Hashtbl.t option ref = ref None +let _defpage_paths : string list ref = ref [] + +let get_app_config key default = + match !_app_config with + | Some d -> (match Hashtbl.find_opt d key with Some v -> v | None -> default) + | None -> default + +let get_app_str key default = + match get_app_config key (String default) with String s -> s | _ -> default + +let get_app_list key default = + match get_app_config key Nil with + | List l | ListRef { contents = l } -> + List.filter_map (function String s -> Some s | _ -> None) l + | _ -> default + (** Helpers safe to defer — pure functions whose results are only used as rendering output (inlined into SX wire format), not in control flow. *) -let batchable_helpers = [ +let batchable_helpers = ref [ "highlight"; "component-source" ] let is_batchable name args = name = "helper" && match args with - | String h :: _ -> List.mem h batchable_helpers + | String h :: _ -> List.mem h !batchable_helpers | _ -> false (** Read an io-response from stdin, discarding stale messages from old epochs. *) @@ -1615,7 +1634,8 @@ let http_render_page env path headers = let page_ast = match Hashtbl.find_opt d "page-ast" with Some v -> v | _ -> Nil in let page_ast = if page_ast = Nil then error_page_ast "Page returned empty content" else page_ast in begin - let wrapped = List [Symbol "~layouts/doc"; Keyword "path"; String nav_path; page_ast] in + let inner_layout = get_app_str "inner-layout" "~layouts/doc" in + let wrapped = List [Symbol inner_layout; Keyword "path"; String nav_path; page_ast] in if is_ajax then begin (* AJAX: return SX wire format (aser output) with text/sx content type *) let body_result = @@ -1628,7 +1648,8 @@ let http_render_page env path headers = Some body_str end else begin (* Full page: aser → SSR → shell *) - let full_ast = List [Symbol "~shared:layout/app-body"; Keyword "content"; wrapped] in + let outer_layout = get_app_str "outer-layout" "~shared:layout/app-body" in + let full_ast = List [Symbol outer_layout; Keyword "content"; wrapped] in let page_source = serialize_value full_ast in let t1 = Unix.gettimeofday () in let body_result = @@ -1650,7 +1671,7 @@ let http_render_page env path headers = let t3 = Unix.gettimeofday () in let get_shell name = try env_get env ("__shell-" ^ name) with _ -> Nil in let shell_args = [ - Keyword "title"; String "SX"; Keyword "csrf"; String ""; + Keyword "title"; String (get_app_str "title" "SX"); Keyword "csrf"; String ""; Keyword "page-sx"; String page_source; Keyword "body-html"; String body_html; Keyword "component-defs"; get_shell "component-defs"; @@ -1666,7 +1687,8 @@ let http_render_page env path headers = Keyword "init-sx"; get_shell "init-sx"; Keyword "meta-html"; String ""; ] in - let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in + let shell_sym = get_app_str "shell" "~shared:shell/sx-page-shell" in + let shell_call = List (Symbol shell_sym :: shell_args) in let html = if env_has env "render-to-html" then let render_call = List [Symbol "render-to-html"; @@ -1769,11 +1791,8 @@ let http_inject_shell_statics env static_dir sx_sxc = let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found -> Filename.dirname (Filename.dirname static_dir) in let templates_dir = project_dir ^ "/shared/sx/templates" in - let client_libs = [ - templates_dir ^ "/tw-layout.sx"; - templates_dir ^ "/tw-type.sx"; - templates_dir ^ "/tw.sx"; - ] in + let client_lib_names = get_app_list "client-libs" ["tw-layout.sx"; "tw-type.sx"; "tw.sx"] in + let client_libs = List.map (fun name -> templates_dir ^ "/" ^ name) client_lib_names in List.iter (fun path -> if Sys.file_exists path then begin let src = In_channel.with_open_text path In_channel.input_all in @@ -1809,9 +1828,9 @@ let http_inject_shell_statics env static_dir sx_sxc = let platform_hash = file_hash (static_dir ^ "/wasm/sx-platform-2.js") in let sxbc_hash = sxbc_combined_hash (static_dir ^ "/wasm") in (* Read CSS for inline injection *) - let tw_css = read_css_file (static_dir ^ "/styles/tw.css") in - let basics_css = read_css_file (static_dir ^ "/styles/basics.css") in - let sx_css = basics_css ^ "\n" ^ tw_css in + let css_file_names = get_app_list "css-files" ["basics.css"; "tw.css"] in + let sx_css = String.concat "\n" (List.map (fun name -> + read_css_file (static_dir ^ "/styles/" ^ name)) css_file_names) in ignore (env_bind env "__shell-component-defs" (String component_defs)); ignore (env_bind env "__shell-component-hash" (String component_hash)); (* Build minimal pages-sx from defpage definitions in loaded .sx files. @@ -1840,11 +1859,13 @@ let http_inject_shell_statics env static_dir sx_sxc = | Some v -> serialize_value v | _ -> "" in let has_data = match extract_kw "data" rest with | Some _ -> true | None -> false in - if path_val <> "" then + if path_val <> "" then begin + _defpage_paths := path_val :: !_defpage_paths; Buffer.add_string pages_buf (Printf.sprintf "{:name \"%s\" :path \"%s\" :auth \"public\" :has-data %s :content \"%s\"}\n" name path_val (if has_data then "true" else "false") (escape_sx_string content_val)) + end | _ -> () ) exprs with _ -> () @@ -1864,16 +1885,17 @@ let http_inject_shell_statics env static_dir sx_sxc = ignore (env_bind env "__shell-sxbc-hash" (String sxbc_hash)); ignore (env_bind env "__shell-inline-css" Nil); ignore (env_bind env "__shell-inline-head-js" Nil); - (* init-sx: trigger client-side render when sx-root is empty (SSR failed). - The boot code hydrates existing islands but doesn't do fresh render. - This script forces a render from page-sx after boot completes. *) - ignore (env_bind env "__shell-init-sx" (String + (* init-sx: trigger client-side render when sx-root is empty (SSR failed). *) + let default_init_sx = "document.addEventListener('sx:boot-done', function() { \ var root = document.getElementById('sx-root'); \ if (root && !root.innerHTML.trim() && typeof SX !== 'undefined' && SX.renderPage) { \ SX.renderPage(); \ } \ - });")); + });" in + let init_sx = match get_app_config "init-script" (Keyword "default") with + | String s -> s | _ -> default_init_sx in + ignore (env_bind env "__shell-init-sx" (String init_sx)); Printf.eprintf "[sx-http] Shell statics: defs=%d hash=%s css=%d wasm=%s platform=%s sxbc=%s\n%!" (String.length component_defs) component_hash (String.length sx_css) wasm_hash platform_hash sxbc_hash @@ -2292,17 +2314,7 @@ let http_setup_page_helpers env = with _ -> String (";; component " ^ name ^ " not found")) | _ -> raise (Eval_error "component-source: expected (name)")); - (* Stub remaining demo/action helpers that need real IO *) - let stub name = bind name (fun _args -> Nil) in - stub "run-spec-tests"; - stub "run-modular-tests"; - stub "streaming-demo-data"; - stub "affinity-demo-data"; - stub "optimistic-demo-data"; - stub "action:add-demo-item"; - stub "offline-demo-data"; - stub "prove-data"; - stub "page-helpers-demo-data" + ignore bind (* suppress unused warning *) let http_mode port = let env = make_server_env () in @@ -2325,11 +2337,16 @@ let http_mode port = let shared_sx = try Sys.getenv "SX_SHARED_DIR" with Not_found -> project_dir ^ "/shared/sx/templates" in let sx_sx = try Sys.getenv "SX_COMPONENTS_DIR" with Not_found -> - (* Docker: /app/sx, dev: /project/sx/sx *) let docker_path = project_dir ^ "/sx" in let dev_path = project_dir ^ "/sx/sx" in - if Sys.file_exists (docker_path ^ "/page-functions.sx") then docker_path - else dev_path in + if Sys.file_exists docker_path && Sys.is_directory docker_path + && not (Sys.file_exists (docker_path ^ "/sx")) (* avoid matching parent of sx/sx *) + then docker_path + else if Sys.file_exists dev_path && Sys.is_directory dev_path then dev_path + else begin + Printf.eprintf "[sx-http] WARNING: no components dir at %s or %s\n%!" docker_path dev_path; + docker_path + end in (* Expose project paths to SX helpers *) ignore (env_bind env "_project-dir" (String project_dir)); ignore (env_bind env "_spec-dir" (String spec_base)); @@ -2387,6 +2404,15 @@ let http_mode port = load_dir sx_sx; let t1 = Unix.gettimeofday () in Printf.eprintf "[sx-http] All files loaded in %.3fs\n%!" (t1 -. t0); + (* Extract app config from __app-config dict *) + (try match env_get env "__app-config" with + | Dict d -> + _app_config := Some d; + batchable_helpers := get_app_list "batchable-helpers" ["highlight"; "component-source"]; + Printf.eprintf "[sx-http] App config loaded: title=%s prefix=%s\n%!" + (get_app_str "title" "?") (get_app_str "path-prefix" "?") + | _ -> Printf.eprintf "[sx-http] WARNING: __app-config is not a dict\n%!" + with _ -> Printf.eprintf "[sx-http] No __app-config found, using defaults\n%!"); (* SSR overrides — rebind browser-only functions AFTER .sx files load. effect and register-in-scope are no-ops on the server; the SX definitions from signals.sx are replaced so effect bodies never execute during SSR. *) @@ -2497,14 +2523,15 @@ let http_mode port = Printf.eprintf "[cache] %s → not found\n%!" path in - (* Pre-warm + cache all key pages *) - let _warmup_paths = ["/sx/"; "/sx/(geography)"; "/sx/(language)"; "/sx/(applications)"; - "/sx/(geography.(reactive.(examples)))"; - "/sx/(applications.(sxtp))"; "/sx/(geography.(cek))"; - "/sx/(geography.(reactive))"; "/sx/(geography.(hypermedia))"; - ] in + (* Pre-warm + cache key pages — from config or just homepage *) + let warmup_paths = match get_app_config "warmup-paths" (Keyword "auto") with + | Keyword "auto" -> [get_app_str "path-prefix" "/sx/"] + | List l | ListRef { contents = l } -> + List.filter_map (function String s -> Some s | _ -> None) l + | _ -> [get_app_str "path-prefix" "/sx/"] + in let t_warm = Unix.gettimeofday () in - List.iter cache_response _warmup_paths; + List.iter cache_response warmup_paths; let n_cached = Hashtbl.length response_cache in Printf.eprintf "[sx-http] Pre-warmed %d pages in %.3fs\n%!" n_cached (Unix.gettimeofday () -. t_warm); @@ -2619,13 +2646,21 @@ let http_mode port = | None -> ()) ) (String.split_on_char ';' cookie_str) | None -> ()); + let app_prefix = get_app_str "path-prefix" "/sx/" in + let app_prefix_bare = if String.length app_prefix > 1 + && app_prefix.[String.length app_prefix - 1] = '/' + then String.sub app_prefix 0 (String.length app_prefix - 1) else app_prefix in + let app_home = get_app_str "home-path" app_prefix in + let debug_prefix = app_prefix ^ "_debug/" in + let debug_prefix_len = String.length debug_prefix in if path = "/" then begin - write_response fd (http_redirect "/sx/"); true + write_response fd (http_redirect app_home); true end else (* Debug endpoint — runs on main thread, no render worker *) let raw_decoded = url_decode raw_path in - if String.length path > 11 && String.sub path 0 11 = "/sx/_debug/" then begin - let cmd = String.sub raw_decoded 11 (String.length raw_decoded - 11) in + if String.length path > debug_prefix_len + && String.sub path 0 debug_prefix_len = debug_prefix then begin + let cmd = String.sub raw_decoded debug_prefix_len (String.length raw_decoded - debug_prefix_len) in let query_start = try String.index cmd '?' with Not_found -> String.length cmd in let action = String.sub cmd 0 query_start in let query = if query_start < String.length cmd - 1 @@ -2676,8 +2711,10 @@ let http_mode port = else if String.sub s i (String.length sub) = sub then true else has_sub s sub (i + 1) in has_sub path "(api." 0 in - let is_sx = path = "/sx/" || path = "/sx" - || (String.length path > 4 && String.sub path 0 4 = "/sx/") in + let app_prefix_len = String.length app_prefix in + let is_sx = path = app_prefix || path = app_prefix_bare + || (String.length path > app_prefix_len + && String.sub path 0 app_prefix_len = app_prefix) in if is_sx && is_handler_path then begin (* Handler dispatch — slug + path param extraction, method-based lookup, param binding *) let response = @@ -2706,8 +2743,9 @@ let http_mode port = let req_method = String.uppercase_ascii !_req_method in let try_key k = try let v = env_get env k in if v <> Nil then Some (k, v) else None with _ -> None in - (* Try multiple handler name patterns: ex-slug, reactive-slug, slug *) - let prefixes = ["handler:ex-" ^ slug; "handler:reactive-" ^ slug; "handler:" ^ slug] in + let handler_prefix_list = get_app_list "handler-prefixes" + ["handler:ex-"; "handler:reactive-"; "handler:"] in + let prefixes = List.map (fun p -> p ^ slug) handler_prefix_list in let suffixes = match req_method with | "POST" -> List.concat_map (fun base -> [base; base ^ "-save"; base ^ "-submit"]) prefixes | "PUT" | "PATCH" -> List.concat_map (fun base -> [base; base ^ "-put"; base ^ "-save"]) prefixes @@ -2763,10 +2801,7 @@ let http_mode port = in write_response fd response; true end else if is_sx then begin - let has_stepper_cookie = Hashtbl.mem _request_cookies "sx-home-stepper" in - let cache_key = if is_ajax then "ajax:" ^ path - else if has_stepper_cookie then path ^ ":step=" ^ (try Hashtbl.find _request_cookies "sx-home-stepper" with Not_found -> "") - else path in + let cache_key = if is_ajax then "ajax:" ^ path else path in match Hashtbl.find_opt response_cache cache_key with | Some cached -> write_response fd cached; true | None -> diff --git a/sx/sx/app-config.sx b/sx/sx/app-config.sx new file mode 100644 index 00000000..86579a23 --- /dev/null +++ b/sx/sx/app-config.sx @@ -0,0 +1 @@ +(define __app-config {:handler-prefixes (list "handler:ex-" "handler:reactive-" "handler:") :shell "~shared:shell/sx-page-shell" :inner-layout "~layouts/doc" :outer-layout "~shared:layout/app-body" :css-files (list "basics.css" "tw.css") :warmup-paths (list "/sx/" "/sx/(geography)" "/sx/(language)" "/sx/(applications)" "/sx/(geography.(reactive.(examples)))" "/sx/(applications.(sxtp))" "/sx/(geography.(cek))" "/sx/(geography.(reactive))" "/sx/(geography.(hypermedia))") :batchable-helpers (list "highlight" "component-source") :title "SX" :init-script :default :home-path "/sx/" :path-prefix "/sx/" :client-libs (list "tw-layout.sx" "tw-type.sx" "tw.sx")}) diff --git a/tests/test_server_config.sh b/tests/test_server_config.sh new file mode 100755 index 00000000..376860ff --- /dev/null +++ b/tests/test_server_config.sh @@ -0,0 +1,255 @@ +#!/usr/bin/env bash +# Test suite for SX HTTP server app config handling. +# Starts the server with different __app-config values and verifies behavior. +set -euo pipefail + +cd "$(dirname "$0")/.." +PROJECT_DIR="$(pwd)" +SERVER="hosts/ocaml/_build/default/bin/sx_server.exe" +BASE_PORT=8090 +PASS=0 +FAIL=0 +ERRORS="" +SERVER_PID="" +CURRENT_PORT="" + +# ── Helpers ────────────────────────────────────────────────────────── + +TMP_DIR=$(mktemp -d) + +cleanup() { + if [ -n "${SERVER_PID:-}" ] && kill -0 "$SERVER_PID" 2>/dev/null; then + kill "$SERVER_PID" 2>/dev/null + wait "$SERVER_PID" 2>/dev/null || true + fi + rm -rf "$TMP_DIR" +} +trap cleanup EXIT + +start_server() { + local port="$1" + local extra_env="${2:-}" + CURRENT_PORT="$port" + # Kill anything on this port + kill $(lsof -ti :"$port") 2>/dev/null || true + sleep 1 + # Start server + eval "$extra_env SX_PROJECT_DIR=$PROJECT_DIR $SERVER --http $port" \ + > "$TMP_DIR/stdout" 2> "$TMP_DIR/stderr" & + SERVER_PID=$! + # Wait for "Listening" message + local tries=0 + while ! grep -q "Listening" "$TMP_DIR/stderr" 2>/dev/null; do + sleep 1 + tries=$((tries + 1)) + if [ $tries -gt 120 ]; then + echo "TIMEOUT waiting for server on port $port" + cat "$TMP_DIR/stderr" + return 1 + fi + if ! kill -0 "$SERVER_PID" 2>/dev/null; then + echo "Server died during startup on port $port" + cat "$TMP_DIR/stderr" + return 1 + fi + done + echo " (server ready on port $port)" +} + +stop_server() { + if [ -n "${SERVER_PID:-}" ] && kill -0 "$SERVER_PID" 2>/dev/null; then + kill "$SERVER_PID" 2>/dev/null + wait "$SERVER_PID" 2>/dev/null || true + sleep 1 + fi + SERVER_PID="" +} + +url() { echo "http://localhost:$CURRENT_PORT$1"; } + +assert_status() { + local desc="$1" path="$2" expected="$3" + shift 3 + local actual + actual=$(curl -s -o /dev/null -w "%{http_code}" "$@" "$(url "$path")" 2>/dev/null) + if [ "$actual" = "$expected" ]; then + PASS=$((PASS + 1)) + echo " PASS: $desc" + else + FAIL=$((FAIL + 1)) + ERRORS="$ERRORS\n FAIL: $desc — expected $expected, got $actual" + echo " FAIL: $desc — expected $expected, got $actual" + fi +} + +assert_redirect() { + local desc="$1" path="$2" expected_path="$3" + local actual + actual=$(curl -s -o /dev/null -w "%{redirect_url}" "$(url "$path")" 2>/dev/null) + local expected="http://localhost:$CURRENT_PORT$expected_path" + if [ "$actual" = "$expected" ]; then + PASS=$((PASS + 1)) + echo " PASS: $desc" + else + FAIL=$((FAIL + 1)) + ERRORS="$ERRORS\n FAIL: $desc — expected → $expected, got → $actual" + echo " FAIL: $desc — expected → $expected_path, got → $actual" + fi +} + +assert_body_contains() { + local desc="$1" path="$2" expected="$3" + shift 3 + curl -s "$@" "$(url "$path")" > "$TMP_DIR/body" 2>/dev/null + if grep -qF "$expected" "$TMP_DIR/body"; then + PASS=$((PASS + 1)) + echo " PASS: $desc" + else + FAIL=$((FAIL + 1)) + local size=$(wc -c < "$TMP_DIR/body") + ERRORS="$ERRORS\n FAIL: $desc — body ($size bytes) missing '$expected'" + echo " FAIL: $desc — body ($size bytes) missing '$expected'" + fi +} + +assert_stderr_contains() { + local desc="$1" expected="$2" + if grep -qF "$expected" "$TMP_DIR/stderr" 2>/dev/null; then + PASS=$((PASS + 1)) + echo " PASS: $desc" + else + FAIL=$((FAIL + 1)) + ERRORS="$ERRORS\n FAIL: $desc — stderr missing '$expected'" + echo " FAIL: $desc — stderr missing '$expected'" + fi +} + +assert_stderr_not_contains() { + local desc="$1" expected="$2" + if grep -qF "$expected" "$TMP_DIR/stderr" 2>/dev/null; then + FAIL=$((FAIL + 1)) + ERRORS="$ERRORS\n FAIL: $desc — stderr should NOT contain '$expected'" + echo " FAIL: $desc — stderr should NOT contain '$expected'" + else + PASS=$((PASS + 1)) + echo " PASS: $desc" + fi +} + +# ── Setup ──────────────────────────────────────────────────────────── + +if [ ! -x "$SERVER" ]; then + echo "ERROR: Server binary not found at $SERVER" + echo "Run: cd hosts/ocaml && eval \$(opam env) && dune build" + exit 1 +fi + +echo "=== SX HTTP Server Config Tests ===" +echo "" + +# ── Test Group 1: Default config (standard app-config.sx) ─────────── + +echo "── Group 1: Standard config ──" +start_server $((BASE_PORT + 1)) + +assert_stderr_contains "config loaded" "App config loaded: title=SX prefix=/sx/" +assert_stderr_contains "warmup ran 9 pages" "Pre-warmed 9 pages" +assert_stderr_not_contains "no stepper cookie refs" "sx-home-stepper" + +assert_status "homepage 200" "/sx/" 200 +assert_status "AJAX homepage 200" "/sx/" 200 -H "sx-request: true" +assert_status "geography 200" "/sx/(geography)" 200 +assert_status "language 200" "/sx/(language)" 200 +assert_status "applications 200" "/sx/(applications)" 200 +assert_redirect "root → /sx/" "/" "/sx/" +assert_status "handler 200" "/sx/(api.spec-detail)?name=render-to-html" 200 +assert_status "static 200" "/static/styles/tw.css" 200 +assert_status "debug 200" "/sx/_debug/eval?expr=(%2B%201%202)" 200 +assert_status "unknown 404" "/nope" 404 + +assert_body_contains "title is SX" "/sx/" "SX" +assert_body_contains "AJAX returns SX wire format" "/sx/" "sx-swap-oob" -H "sx-request: true" +assert_body_contains "debug eval result" "/sx/_debug/eval?expr=(%2B%201%202)" "3" + +stop_server +echo "" + +# ── Test Group 2: Custom title + minimal warmup ───────────────────── + +echo "── Group 2: Custom title ──" +mkdir -p "$TMP_DIR/custom-sx" +cp -r "$PROJECT_DIR/sx/sx/"* "$TMP_DIR/custom-sx/" +cat > "$TMP_DIR/custom-sx/app-config.sx" << 'SXEOF' +(define __app-config + {:title "My Custom App" + :path-prefix "/sx/" + :home-path "/sx/" + :inner-layout "~layouts/doc" + :outer-layout "~shared:layout/app-body" + :shell "~shared:shell/sx-page-shell" + :client-libs (list "tw-layout.sx" "tw-type.sx" "tw.sx") + :css-files (list "basics.css" "tw.css") + :batchable-helpers (list "highlight" "component-source") + :handler-prefixes (list "handler:ex-" "handler:reactive-" "handler:") + :warmup-paths (list "/sx/") + :init-script :default}) +SXEOF + +start_server $((BASE_PORT + 2)) "SX_COMPONENTS_DIR=$TMP_DIR/custom-sx" + +assert_stderr_contains "custom title in log" "App config loaded: title=My Custom App" +assert_stderr_contains "warmup 1 page" "Pre-warmed 1 pages" +assert_status "homepage works" "/sx/" 200 +assert_body_contains "custom title in HTML" "/sx/" "My Custom App" + +stop_server +echo "" + +# ── Test Group 3: No config (missing __app-config) ────────────────── + +echo "── Group 3: No app config (defaults) ──" +mkdir -p "$TMP_DIR/noconfig-sx" +cp -r "$PROJECT_DIR/sx/sx/"* "$TMP_DIR/noconfig-sx/" +rm -f "$TMP_DIR/noconfig-sx/app-config.sx" + +start_server $((BASE_PORT + 3)) "SX_COMPONENTS_DIR=$TMP_DIR/noconfig-sx" + +assert_stderr_contains "defaults fallback" "No __app-config found, using defaults" +assert_status "homepage without config" "/sx/" 200 +assert_redirect "root redirect without config" "/" "/sx/" +assert_body_contains "default title" "/sx/" "SX" + +stop_server +echo "" + +# ── Test Group 4: Minimal config (only title) ─────────────────────── + +echo "── Group 4: Minimal config ──" +mkdir -p "$TMP_DIR/minimal-sx" +cp -r "$PROJECT_DIR/sx/sx/"* "$TMP_DIR/minimal-sx/" +cat > "$TMP_DIR/minimal-sx/app-config.sx" << 'SXEOF' +(define __app-config {:title "Bare"}) +SXEOF + +start_server $((BASE_PORT + 4)) "SX_COMPONENTS_DIR=$TMP_DIR/minimal-sx" + +assert_stderr_contains "minimal config log" "App config loaded: title=Bare" +assert_status "homepage with minimal config" "/sx/" 200 +assert_body_contains "bare title" "/sx/" "Bare" +# Defaults should still work for everything not specified +assert_redirect "default redirect" "/" "/sx/" +assert_status "default debug" "/sx/_debug/eval?expr=1" 200 + +stop_server +echo "" + +# ── Summary ────────────────────────────────────────────────────────── + +echo "=== Results: $PASS passed, $FAIL failed ===" +if [ $FAIL -gt 0 ]; then + echo -e "\nFailures:$ERRORS" + exit 1 +else + echo "All tests passed." + exit 0 +fi diff --git a/web/request-handler.sx b/web/request-handler.sx index ca11b072..88e35b13 100644 --- a/web/request-handler.sx +++ b/web/request-handler.sx @@ -2,14 +2,18 @@ sx-url-to-expr (fn (path) - (cond - (or (= path "/") (= path "/sx/") (= path "/sx")) - "home" - (starts-with? path "/sx/") - (join " " (split (slice path 4 (len path)) ".")) - (starts-with? path "/") - (join " " (split (slice path 1 (len path)) ".")) - :else path))) + (let + ((prefix (cek-try (fn () (or (dict-get __app-config :path-prefix) "/sx/")) (fn (e) "/sx/"))) + (prefix-len (len prefix)) + (prefix-bare (slice prefix 0 (- prefix-len 1)))) + (cond + (or (= path "/") (= path prefix) (= path prefix-bare)) + "home" + (starts-with? path prefix) + (join " " (split (slice path prefix-len (len path)) ".")) + (starts-with? path "/") + (join " " (split (slice path 1 (len path)) ".")) + :else path)))) (define sx-auto-quote @@ -52,5 +56,13 @@ (nil? page-ast) nil (let - ((nav-path (if (and (>= (len path) 4) (= (slice path 0 4) "/sx/")) path (str "/sx" path)))) + ((prefix (cek-try (fn () (or (dict-get __app-config :path-prefix) "/sx/")) (fn (e) "/sx/"))) + (prefix-len (len prefix)) + (nav-path + (if + (and + (>= (len path) prefix-len) + (= (slice path 0 prefix-len) prefix)) + path + (str (slice prefix 0 (- prefix-len 1)) path)))) {:page-ast page-ast :nav-path nav-path :is-ajax is-ajax})))))