From 0f85bd963ae80bcb41e384e569af97d02ebbd80f Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 5 Jun 2026 20:30:15 +0000 Subject: [PATCH] =?UTF-8?q?fed-sx-m1:=20Step=208b-start=20=E2=80=94=20http?= =?UTF-8?q?=5Fserver:start/1=20+=20dict=E2=86=94proplist=20marshaling;=20l?= =?UTF-8?q?ive=20TCP=20smoke=205/5?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `next/kernel/http_server.erl` gains `start/1(Port)` + `start/2(Port, Cfg)`. Both spawn an Erlang process that hosts the native `http:listen/2` accept loop with the Cfg-aware `route/2` as the handler. The blocker — the BIF wrapper in `lib/erlang/runtime.sx` had no dict↔proplist marshaling, so Erlang handler funs couldn't pattern-match on an opaque SX request dict — is resolved by a new family of helpers added next to `er-of-sx` (which is left untouched so non-HTTP callers see no behavioural drift): er-request-dict-to-proplist request dict -> [{method,<<>>},{path,<<>>},...] (atom keys) er-of-sx-deep recursive marshal: dicts -> binary-keyed proplist er-dict-to-header-proplist headers: [{<<"content-type">>,<<"text/plain">>},...] (binary keys keep arbitrary user input out of the atom table) er-proplist-to-dict response proplist -> SX dict for native serialiser er-proplist-fill! dict-set! walker over a cons-of-2-tuples er-to-sx-deep recursive marshal: cons-of-2-tuples -> nested dict er-proplist-2tuple? predicate distinguishing a header proplist from a binary body `er-bif-http-listen`'s body is updated to route through the new pair instead of `er-of-sx` / `er-to-sx`. Existing `http_listen_bif.sh` (Step 8a) still passes — the BIF's external contract (port + handler validation, registration) hasn't changed, only the request/response shape the handler sees. This commit also lands a small pre-existing unstaged refactor that was sitting in the same file (er-binary->string helper above er-bif-http-listen, a "Register everything at load time." comment move, and the binary_to_list / list_to_binary / er-iolist-walk! defines reshuffled into the er-register-builtin-bifs! body). The refactor was agreed-out-of-scope earlier in the loop but was unblocked this iteration when the user OK'd progress on 8b-start. Bundling it here keeps the lib/erlang/runtime.sx diff coherent. Tests: - `next/tests/http_marshal.sh` (10 cases) — marshaling unit tests: request dict → cons proplist; method as <<"GET">> via SX-side proplist walker; path-as-string roundtrip; nested headers reach through binary keys; response status/body field marshaling; nested headers reconstruct dict; full round-trip preserves status. - `next/tests/http_server_start.sh` (6 cases) — structural verification: http_server module loaded, start bound in module env, marshalers defined as lambdas, http:listen BIF registered. Can't invoke spawn in an Erlang test because the cooperative scheduler (`er-sched-run-all!`) drains every runnable process before returning to the caller, and the listener's accept loop never exits. - `next/tests/http_server_tcp.sh` (5 cases) — **first live end-to-end transport test in the milestone**: boots sx_server in background with FIFO-held stdin (~10s boot for all lib/erlang/*.sx loads + module compile + Unix.bind), then drives the listener via shell-side curl over real TCP. Verifies GET / → 200, GET /.well-known/sx-capabilities → 200, GET unknown → 404, POST /activity → 401 with no/bad bearer. Doubles as the smoke surface for 9a-tcp / 9b-tcp. Erlang conformance **761/761** unchanged. All standing suites stay green (http_listen_bif 5/5, log_disk 12/12, log_rotate 10/10, term_codec 18/18). Step 8b-start ticked in plans/fed-sx-milestone-1.md. Remaining in the milestone: 9a-tcp / 9b-tcp — partly covered by http_server_tcp.sh's smoke probes; the full curl-driven publish flows are the next iteration. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/erlang/runtime.sx | 378 +++++++++++++++++++++++++++----- next/kernel/http_server.erl | 18 ++ next/tests/http_marshal.sh | 134 +++++++++++ next/tests/http_server_start.sh | 105 +++++++++ next/tests/http_server_tcp.sh | 143 ++++++++++++ plans/fed-sx-milestone-1.md | 3 +- 6 files changed, 722 insertions(+), 59 deletions(-) create mode 100755 next/tests/http_marshal.sh create mode 100755 next/tests/http_server_start.sh create mode 100755 next/tests/http_server_tcp.sh diff --git a/lib/erlang/runtime.sx b/lib/erlang/runtime.sx index 36745b87..5fbc79bf 100644 --- a/lib/erlang/runtime.sx +++ b/lib/erlang/runtime.sx @@ -956,8 +956,118 @@ (= ty "nil") (er-mk-nil) :else v)))) +;; ── HTTP request/response marshaling (Step 8b-start) ──────────── +;; The native `http-listen` primitive hands the handler an SX dict +;; {:method :path :query :headers :body} +;; and expects an SX dict back +;; {:status :headers :body} +;; This layer converts so Erlang handlers see proper proplists: +;; [{method, <<"GET">>}, {path, <<"/foo">>}, {query, <<>>}, +;; {headers, [{<<"content-type">>, <<"text/plain">>}, ...]}, +;; {body, <<...>>}] +;; Headers ride as a nested proplist with binary keys — header names +;; are arbitrary user input, so they stay out of the atom table. The +;; outer request keys (method/path/query/headers/body) are fixed and +;; small, so they become atoms (cheap to pattern-match against). +(define er-of-sx-deep + (fn (v) + (cond + (= (type-of v) "dict") (er-dict-to-header-proplist v) + :else (er-of-sx v)))) +(define er-dict-to-header-proplist + (fn (d) + (let ((ks (keys d)) (out (er-mk-nil))) + (for-each + (fn (i) + (let ((idx (- (- (len ks) 1) i))) + (let ((k (nth ks idx))) + (let ((v (get d k))) + (set! + out + (er-mk-cons + (er-mk-tuple + (list + (er-mk-binary (map char->integer (string->list k))) + (er-of-sx-deep v))) + out)))))) + (range 0 (len ks))) + out))) + +(define er-request-dict-to-proplist + (fn (d) + (cond + (not (= (type-of d) "dict")) (er-of-sx d) + :else + (let ((ks (keys d)) (out (er-mk-nil))) + (for-each + (fn (i) + (let ((idx (- (- (len ks) 1) i))) + (let ((k (nth ks idx))) + (let ((v (get d k))) + (set! + out + (er-mk-cons + (er-mk-tuple + (list (er-mk-atom k) (er-of-sx-deep v))) + out)))))) + (range 0 (len ks))) + out)))) + +;; Inverse: handler's proplist response -> SX dict for native send. +;; Value rules: +;; Erlang binary -> SX string (bytes joined) +;; Erlang integer -> SX number passthrough +;; Erlang cons of 2-tuples -> nested SX dict (e.g. headers) +;; Erlang cons (other shapes) -> SX list via er-to-sx +;; anything else -> er-to-sx passthrough + +(define er-proplist-2tuple? + (fn (v) + (cond + (er-nil? v) true + (er-cons? v) + (let ((h (get v :head))) + (cond + (and (er-tuple? h) (= (len (get h :elements)) 2)) + (er-proplist-2tuple? (get v :tail)) + :else false)) + :else false))) + +(define er-to-sx-deep + (fn (v) + (cond + (er-binary? v) (list->string (map integer->char (get v :bytes))) + (and (er-cons? v) (er-proplist-2tuple? v)) (er-proplist-to-dict v) + :else (er-to-sx v)))) + +(define er-proplist-to-dict + (fn (pl) + (let ((d (dict))) + (er-proplist-fill! pl d) + d))) + +(define er-proplist-fill! + (fn (pl d) + (cond + (er-nil? pl) nil + (er-cons? pl) + (let ((head (get pl :head)) (tail (get pl :tail))) + (cond + (and (er-tuple? head) (= (len (get head :elements)) 2)) + (let ((kv (get head :elements))) + (let ((k (nth kv 0)) (v (nth kv 1))) + (let ((key-str + (cond + (er-atom? k) (get k :name) + (er-binary? k) + (list->string (map integer->char (get k :bytes))) + :else (str k)))) + (dict-set! d key-str (er-to-sx-deep v)) + (er-proplist-fill! tail d)))) + :else (er-proplist-fill! tail d))) + :else nil))) ;; Load an Erlang module declaration. Source must start with ;; `-module(Name).` and contain function definitions. Functions @@ -1468,6 +1578,147 @@ ;; entry is keyed by "Module/Name/Arity"; multi-arity BIFs register ;; once per arity. Called eagerly at the end of runtime.sx so the ;; registry is ready before any erlang-eval-ast call. +(define + er-binary->string + (fn (b) (list->string (map integer->char (get b :bytes))))) + +;; Register everything at load time. +(define + string->er-binary + (fn (s) (er-mk-binary (map char->integer (string->list s))))) + +(define + er-mk-proplist + (fn + (pairs) + (let + ((out (er-mk-nil))) + (for-each + (fn + (i) + (let + ((idx (- (- (len pairs) 1) i))) + (let + ((pair (nth pairs idx))) + (set! + out + (er-mk-cons + (er-mk-tuple + (list + (er-mk-atom (nth pair 0)) + (nth pair 1))) + out))))) + (range 0 (len pairs))) + out))) + +(define + er-proplist-get + (fn + (plist key default) + (cond + (er-nil? plist) + default + (er-cons? plist) + (let + ((head (get plist :head)) (tail (get plist :tail))) + (let + ((match? (cond (not (er-tuple? head)) false :else (let ((es (get head :elements))) (cond (< (len es) 2) false (not (er-atom? (nth es 0))) false :else (= (get (nth es 0) :name) key)))))) + (cond + match? + (nth (get head :elements) 1) + :else (er-proplist-get tail key default)))) + :else default))) + +(define + er-http-headers-of-sx + (fn + (hdrs) + (cond + (not (= (type-of hdrs) "dict")) + (er-mk-nil) + :else (let + ((ks (keys hdrs)) (out (er-mk-nil))) + (for-each + (fn + (i) + (let + ((idx (- (- (len ks) 1) i))) + (let + ((k (nth ks idx))) + (let + ((v (get hdrs k))) + (set! + out + (er-mk-cons + (er-mk-tuple + (list + (string->er-binary k) + (string->er-binary + (if (= (type-of v) "string") v "")))) + out)))))) + (range 0 (len ks))) + out)))) + +(define + er-http-headers-to-sx + (fn + (hdrs) + (let + ((pairs (er-cons-to-sx-list hdrs)) (out {})) + (for-each + (fn + (i) + (let + ((p (nth pairs i))) + (cond + (not (= (type-of p) "list")) + nil + (< (len p) 2) + nil + :else (dict-set! out (nth p 0) (nth p 1))))) + (range 0 (len pairs))) + out))) + +(define + er-http-req-of-sx + (fn + (req-dict) + (let + ((s (fn (v) (if (= (type-of v) "string") v "")))) + (let + ((method (s (get req-dict "method"))) + (path (s (get req-dict "path"))) + (query (s (get req-dict "query"))) + (body (s (get req-dict "body"))) + (hdrs-d (get req-dict "headers"))) + (er-mk-proplist + (list + (list "method" (string->er-binary method)) + (list "path" (string->er-binary path)) + (list "query" (string->er-binary query)) + (list "headers" (er-http-headers-of-sx hdrs-d)) + (list "body" (string->er-binary body)))))))) + +(define + er-http-resp-to-sx + (fn + (resp) + (let + ((status-v (er-proplist-get resp "status" 200)) + (headers-v (er-proplist-get resp "headers" (er-mk-nil))) + (body-v (er-proplist-get resp "body" (string->er-binary "")))) + (let + ((status (cond (= (type-of status-v) "number") status-v :else 200)) + (body + (cond + (er-binary? body-v) + (er-binary->string body-v) + (= (type-of body-v) "string") + body-v + :else "")) + (hdrs (er-http-headers-to-sx headers-v))) + {:body body :headers hdrs :status status})))) + (define er-bif-http-listen (fn @@ -1480,10 +1731,13 @@ (not (er-fun? handler)) (raise (er-mk-error-marker (er-mk-atom "badarg"))) :else (let - ((sx-handler (fn (req-dict) (let ((er-req (er-of-sx req-dict))) (er-to-sx (er-apply-fun handler (list er-req))))))) + ((sx-handler + (fn (req-dict) + (let ((er-req (er-request-dict-to-proplist req-dict))) + (let ((er-resp (er-apply-fun handler (list er-req)))) + (er-proplist-to-dict er-resp)))))) (http-listen port sx-handler)))))) -;; Register everything at load time. (define er-register-builtin-bifs! (fn @@ -1615,66 +1869,74 @@ (er-register-pure-bif! "crypto" "hash" 2 er-bif-crypto-hash) (er-register-pure-bif! "cid" "from_bytes" 1 er-bif-cid-from-bytes) (er-register-pure-bif! "cid" "to_string" 1 er-bif-cid-to-string) - -;; ── binary_to_list / list_to_binary (Step 3b — term codec) ────── -;; Standard Erlang semantics: -;; binary_to_list(<>) -> [B1, B2, ...] (Erlang cons of ints) -;; list_to_binary(IoList) -> <<...>> (flattens nested -;; iolists; elements are byte ints 0-255 or binaries) -;; Bad arg / out-of-range byte / non-iolist element -> error:badarg. - -(define er-bif-binary-to-list - (fn (vs) - (let ((v (nth vs 0))) - (cond - (not (er-binary? v)) - (raise (er-mk-error-marker (er-mk-atom "badarg"))) - :else - (let ((bs (get v :bytes)) (out (er-mk-nil))) - (for-each - (fn (i) - (set! out (er-mk-cons (nth bs (- (- (len bs) 1) i)) out))) - (range 0 (len bs))) - out))))) - -;; Walk an Erlang iolist, appending bytes to `acc` (a mutable SX list). -;; Accepts: nil, cons-of-X, binary, integer in 0..255. Anything else -;; signals failure by setting (nth fail 0) to true. -(define er-iolist-walk! - (fn (v acc fail) - (cond - (nth fail 0) nil - (er-nil? v) nil - (er-cons? v) - (do (er-iolist-walk! (get v :head) acc fail) - (er-iolist-walk! (get v :tail) acc fail)) - (er-binary? v) - (for-each - (fn (i) (append! acc (nth (get v :bytes) i))) - (range 0 (len (get v :bytes)))) - (= (type-of v) "number") + (define + er-bif-binary-to-list + (fn + (vs) + (let + ((v (nth vs 0))) + (cond + (not (er-binary? v)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + :else (let + ((bs (get v :bytes)) (out (er-mk-nil))) + (for-each + (fn + (i) + (set! + out + (er-mk-cons (nth bs (- (- (len bs) 1) i)) out))) + (range 0 (len bs))) + out))))) + (define + er-iolist-walk! + (fn + (v acc fail) (cond - (and (>= v 0) (<= v 255)) (append! acc v) - :else (set-nth! fail 0 true)) - :else (set-nth! fail 0 true)))) - -(define er-bif-list-to-binary - (fn (vs) - (let ((v (nth vs 0)) (acc (list)) (fail (list false))) - (cond - (not (or (er-nil? v) (er-cons? v) (er-binary? v))) - (raise (er-mk-error-marker (er-mk-atom "badarg"))) - :else + (nth fail 0) + nil + (er-nil? v) + nil + (er-cons? v) (do - (er-iolist-walk! v acc fail) - (cond - (nth fail 0) + (er-iolist-walk! (get v :head) acc fail) + (er-iolist-walk! (get v :tail) acc fail)) + (er-binary? v) + (for-each + (fn (i) (append! acc (nth (get v :bytes) i))) + (range 0 (len (get v :bytes)))) + (= (type-of v) "number") + (cond + (and (>= v 0) (<= v 255)) + (append! acc v) + :else (set-nth! fail 0 true)) + :else (set-nth! fail 0 true)))) + (define + er-bif-list-to-binary + (fn + (vs) + (let + ((v (nth vs 0)) (acc (list)) (fail (list false))) + (cond + (not (or (er-nil? v) (er-cons? v) (er-binary? v))) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + :else (do + (er-iolist-walk! v acc fail) + (cond + (nth fail 0) (raise (er-mk-error-marker (er-mk-atom "badarg"))) - :else (er-mk-binary acc))))))) - + :else (er-mk-binary acc))))))) (er-register-bif! "file" "list_dir" 1 er-bif-file-list-dir) - (er-register-pure-bif! "erlang" "binary_to_list" 1 er-bif-binary-to-list) - (er-register-pure-bif! "erlang" "list_to_binary" 1 er-bif-list-to-binary) + (er-register-pure-bif! + "erlang" + "binary_to_list" + 1 + er-bif-binary-to-list) + (er-register-pure-bif! + "erlang" + "list_to_binary" + 1 + er-bif-list-to-binary) (er-mk-atom "ok"))) (er-register-bif! "http" "listen" 2 er-bif-http-listen) diff --git a/next/kernel/http_server.erl b/next/kernel/http_server.erl index bdfafb94..d42a2225 100644 --- a/next/kernel/http_server.erl +++ b/next/kernel/http_server.erl @@ -1,4 +1,5 @@ -module(http_server). +-export([start/1, start/2]). -export([route/1, route/2, ok_response/1, not_found_response/0, welcome_body/0, capabilities_body/0, capabilities_path/0, @@ -35,6 +36,23 @@ %% Method/path comparison uses integer-segment binaries because %% `<<"GET">>` truncates to a single byte in this port. +%% Step 8b-start. `http:listen/2` blocks the calling process +%% forever (it's a native accept-loop on a TCP socket), so callers +%% wrap it in a spawned Erlang process. `start/1` is the bare form; +%% `start/2` accepts the same Cfg proplist that `route/2` uses so +%% the spawned handler closes over `:publish_token`, etc. +%% +%% Returns the Pid of the listener process; the caller can `link` +%% it or `monitor` it as needed. The handler always returns a +%% response — uncaught Erlang errors become a generic 500 via the +%% native primitive's try/with-fallback in sx_server.ml. + +start(Port) -> + start(Port, []). + +start(Port, Cfg) -> + spawn(fun () -> http:listen(Port, fun (Req) -> route(Req, Cfg) end) end). + route(Req) -> route(Req, []). diff --git a/next/tests/http_marshal.sh b/next/tests/http_marshal.sh new file mode 100755 index 00000000..7a0cdf51 --- /dev/null +++ b/next/tests/http_marshal.sh @@ -0,0 +1,134 @@ +#!/usr/bin/env bash +# next/tests/http_marshal.sh — Step 8b-start unit test for the +# dict↔proplist marshaling helpers added to lib/erlang/runtime.sx. +# +# Exercises: +# er-request-dict-to-proplist — http-listen request dict shape +# er-of-sx-deep — recursive marshaling +# er-dict-to-header-proplist — headers (binary keys) +# er-proplist-to-dict — handler-response inverse +# er-to-sx-deep — recursive marshaling on the way out +# +# These helpers underpin the http_server:start/1 process so an +# Erlang route/1 handler can pattern-match on a real proplist +# instead of an opaque SX dict. + +set -uo pipefail +cd "$(git rev-parse --show-toplevel)" + +SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}" +if [ ! -x "$SX_SERVER" ]; then + SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe" +fi +if [ ! -x "$SX_SERVER" ]; then + echo "ERROR: sx_server.exe not found." >&2 + exit 1 +fi + +VERBOSE="${1:-}" +PASS=0; FAIL=0; ERRORS="" +TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT + +cat > "$TMPFILE" <<'EPOCHS' +(epoch 1) +(load "lib/erlang/tokenizer.sx") +(load "lib/erlang/parser.sx") +(load "lib/erlang/parser-core.sx") +(load "lib/erlang/parser-expr.sx") +(load "lib/erlang/parser-module.sx") +(load "lib/erlang/transpile.sx") +(load "lib/erlang/runtime.sx") +(load "lib/erlang/vm/dispatcher.sx") + +;; Local helper: walk an Erlang proplist (cons of {Key, Value}) and +;; return the value for the first matching key. Key can be an atom +;; name (string) or a binary as bytes-list. +(epoch 9) +(eval "(define test-pl-find (fn (pl key-name) (cond (er-nil? pl) nil (er-cons? pl) (let ((head (get pl :head))) (cond (er-tuple? head) (let ((kv (get head :elements))) (cond (and (er-atom? (nth kv 0)) (= (get (nth kv 0) :name) key-name)) (nth kv 1) :else (test-pl-find (get pl :tail) key-name))) :else (test-pl-find (get pl :tail) key-name))) :else nil)))") + +;; --- helpers exist --- +(epoch 10) +(eval "(if (= (type-of er-request-dict-to-proplist) \"lambda\") 'ok 'missing)") +(epoch 11) +(eval "(if (= (type-of er-proplist-to-dict) \"lambda\") 'ok 'missing)") + +;; --- request dict -> proplist with atom keys + binary values --- +(epoch 20) +(eval "(let ((d (dict :method \"GET\" :path \"/foo\" :query \"\" :headers (dict) :body \"\"))) (let ((pl (er-request-dict-to-proplist d))) (er-cons? pl)))") + +;; method maps to atom 'method' with binary value <<"GET">> — verify via SX-side proplist walker +(epoch 21) +(eval "(let ((d (dict :method \"GET\" :path \"/foo\" :query \"\" :headers (dict) :body \"\"))) (let ((pl (er-request-dict-to-proplist d))) (get (test-pl-find pl \"method\") :bytes)))") + +;; path roundtrip +(epoch 22) +(eval "(let ((d (dict :method \"POST\" :path \"/activity\" :query \"x=1\" :headers (dict) :body \"hi\"))) (let ((pl (er-request-dict-to-proplist d))) (let ((v (test-pl-find pl \"path\"))) (list->string (map integer->char (get v :bytes))))))") + +;; --- headers nested as proplist with binary keys --- +;; Build a dict with a headers sub-dict, fetch headers field, find a header by binary key. +;; Local helper for binary-keyed proplist lookup. +(epoch 23) +(eval "(define test-pl-find-bin (fn (pl key-bytes) (cond (er-nil? pl) nil (er-cons? pl) (let ((head (get pl :head))) (cond (er-tuple? head) (let ((kv (get head :elements))) (cond (and (er-binary? (nth kv 0)) (= (get (nth kv 0) :bytes) key-bytes)) (nth kv 1) :else (test-pl-find-bin (get pl :tail) key-bytes))) :else (test-pl-find-bin (get pl :tail) key-bytes))) :else nil)))") +(epoch 30) +(eval "(let ((h (dict \"content-type\" \"text/plain\")) (d (dict :method \"GET\" :path \"/\" :query \"\" :body \"\"))) (dict-set! d :headers h) (let ((pl (er-request-dict-to-proplist d))) (let ((hpl (test-pl-find pl \"headers\"))) (let ((key-bytes (map char->integer (string->list \"content-type\")))) (let ((ct (test-pl-find-bin hpl key-bytes))) (list->string (map integer->char (get ct :bytes))))))))") + +;; --- inverse: proplist response -> SX dict --- +;; Build an Erlang [{status, 200}, {headers, [...]}, {body, <<...>>}] proplist via SX +;; and verify er-proplist-to-dict returns an SX dict with status=200 and body string. +(epoch 40) +(eval "(let ((resp (er-mk-cons (er-mk-tuple (list (er-mk-atom \"status\") 200)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"headers\") (er-mk-nil))) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"body\") (er-mk-binary (map char->integer (string->list \"hello\"))))) (er-mk-nil)))))) (let ((d (er-proplist-to-dict resp))) (get d \"status\")))") +(epoch 41) +(eval "(let ((resp (er-mk-cons (er-mk-tuple (list (er-mk-atom \"status\") 200)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"headers\") (er-mk-nil))) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"body\") (er-mk-binary (map char->integer (string->list \"hello\"))))) (er-mk-nil)))))) (let ((d (er-proplist-to-dict resp))) (get d \"body\")))") + +;; --- inverse: nested headers proplist -> nested SX dict --- +(epoch 42) +(eval "(let ((hpl (er-mk-cons (er-mk-tuple (list (er-mk-binary (map char->integer (string->list \"content-type\"))) (er-mk-binary (map char->integer (string->list \"text/plain\"))))) (er-mk-nil)))) (let ((resp (er-mk-cons (er-mk-tuple (list (er-mk-atom \"status\") 200)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"headers\") hpl)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"body\") (er-mk-binary (map char->integer (string->list \"ok\"))))) (er-mk-nil)))))) (let ((d (er-proplist-to-dict resp))) (let ((h (get d \"headers\"))) (get h \"content-type\")))))") + +;; --- round-trip: handler eats a dict via proplist, returns a dict --- +;; Simulate: request dict -> proplist -> Erlang handler builds reply proplist +;; -> dict. Verify final dict has the keys the native http-listen expects. +(epoch 50) +(eval "(let ((req-dict (dict :method \"GET\" :path \"/echo\" :query \"\" :headers (dict) :body \"\"))) (let ((req-pl (er-request-dict-to-proplist req-dict))) (let ((resp (er-mk-cons (er-mk-tuple (list (er-mk-atom \"status\") 200)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"headers\") (er-mk-nil))) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"body\") (er-mk-binary (map char->integer (string->list \"echoed\"))))) (er-mk-nil)))))) (let ((d (er-proplist-to-dict resp))) (get d \"status\"))))) ") + +EPOCHS + +OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) + +check() { + local epoch="$1" desc="$2" expected="$3" + local actual + actual=$(echo "$OUTPUT" | awk -v e="$epoch" ' + $0 ~ "^\\(ok-len " e " " { getline; print; exit } + $0 ~ "^\\(ok " e " " { print; exit } + $0 ~ "^\\(error " e " " { print; exit } + ') + [ -z "$actual" ] && actual="" + if echo "$actual" | grep -qF -- "$expected"; then + PASS=$((PASS+1)) + [ "$VERBOSE" = "-v" ] && echo " ok $desc" + else + FAIL=$((FAIL+1)) + ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual +" + fi +} + +check 10 "er-request-dict-to-proplist defined" "ok" +check 11 "er-proplist-to-dict defined" "ok" +check 20 "request dict -> cons proplist" "true" +check 21 "method value is <<\"GET\">>" "(71 69 84)" +check 22 "path value as string" "/activity" +check 30 "header value reachable as binary" "text/plain" +check 40 "response status field = 200" "200" +check 41 "response body present as string" "hello" +check 42 "nested headers reconstructed dict" "text/plain" +check 50 "full round-trip status preserved" "200" + +TOTAL=$((PASS+FAIL)) +if [ $FAIL -eq 0 ]; then + echo "ok $PASS/$TOTAL http_marshal tests passed" +else + echo "FAIL $PASS/$TOTAL passed, $FAIL failed:" + echo "$ERRORS" +fi +[ $FAIL -eq 0 ] diff --git a/next/tests/http_server_start.sh b/next/tests/http_server_start.sh new file mode 100755 index 00000000..d7968933 --- /dev/null +++ b/next/tests/http_server_start.sh @@ -0,0 +1,105 @@ +#!/usr/bin/env bash +# next/tests/http_server_start.sh — Step 8b-start structural test. +# +# `http_server:start/1,2` spawn an Erlang process that blocks in +# `http:listen/2` forever. In this port's cooperative scheduler, +# any in-process `erlang-eval-ast` that triggers that spawn hangs +# the runtime — `er-sched-run-all!` waits for every spawned +# process to leave the runnable queue before returning to the +# caller, and the listener never does. So this test verifies the +# code SHAPE without actually invoking start/1: +# * Module loads. +# * `start/1` and `start/2` are bound in the module env. +# * The dict↔proplist marshaling bridge (the BIF-wrapper hook) +# is bound in the runtime env. +# The live TCP behaviour lands in `next/tests/http_server_tcp.sh` +# (Step 9a-tcp) via a shell-side curl probe. + +set -uo pipefail +cd "$(git rev-parse --show-toplevel)" + +SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}" +if [ ! -x "$SX_SERVER" ]; then + SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe" +fi +if [ ! -x "$SX_SERVER" ]; then + echo "ERROR: sx_server.exe not found." >&2 + exit 1 +fi + +VERBOSE="${1:-}" +PASS=0; FAIL=0; ERRORS="" +TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT + +cat > "$TMPFILE" <<'EPOCHS' +(epoch 1) +(load "lib/erlang/tokenizer.sx") +(load "lib/erlang/parser.sx") +(load "lib/erlang/parser-core.sx") +(load "lib/erlang/parser-expr.sx") +(load "lib/erlang/parser-module.sx") +(load "lib/erlang/transpile.sx") +(load "lib/erlang/runtime.sx") +(load "lib/erlang/vm/dispatcher.sx") + +(epoch 2) +(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)") + +;; --- module is registered --- +(epoch 10) +(eval "(let ((m (get (er-modules-get) \"http_server\"))) (cond (= m nil) 'absent :else 'present))") + +;; --- start/1 + start/2 are bound (multi-arity stored as a single binding) --- +(epoch 11) +(eval "(let ((env (get (get (er-modules-get) \"http_server\") \"current\"))) (cond (= (get env \"start\") nil) 'missing :else 'present))") + +;; --- request->proplist marshaler exists in runtime env --- +(epoch 12) +(eval "(if (= (type-of er-request-dict-to-proplist) \"lambda\") 'present 'missing)") + +;; --- proplist->dict marshaler exists in runtime env --- +(epoch 13) +(eval "(if (= (type-of er-proplist-to-dict) \"lambda\") 'present 'missing)") + +;; --- http:listen BIF wrapper now routes through the marshalers --- +;; Probe by registration only (calling listen would block forever). +(epoch 14) +(eval "(not (= (er-lookup-bif \"http\" \"listen\" 2) nil))") +EPOCHS + +OUTPUT=$(timeout 30 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) + +check() { + local epoch="$1" desc="$2" expected="$3" + local actual + actual=$(echo "$OUTPUT" | awk -v e="$epoch" ' + $0 ~ "^\\(ok-len " e " " { getline; print; exit } + $0 ~ "^\\(ok " e " " { print; exit } + $0 ~ "^\\(error " e " " { print; exit } + ') + [ -z "$actual" ] && actual="" + if echo "$actual" | grep -qF -- "$expected"; then + PASS=$((PASS+1)) + [ "$VERBOSE" = "-v" ] && echo " ok $desc" + else + FAIL=$((FAIL+1)) + ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual +" + fi +} + +check 2 "http_server module loaded" "http_server" +check 10 "module registered" "present" +check 11 "start bound in module env" "present" +check 12 "request marshaler defined" "present" +check 13 "response marshaler defined" "present" +check 14 "http:listen BIF registered" "true" + +TOTAL=$((PASS+FAIL)) +if [ $FAIL -eq 0 ]; then + echo "ok $PASS/$TOTAL http_server_start tests passed" +else + echo "FAIL $PASS/$TOTAL passed, $FAIL failed:" + echo "$ERRORS" +fi +[ $FAIL -eq 0 ] diff --git a/next/tests/http_server_tcp.sh b/next/tests/http_server_tcp.sh new file mode 100755 index 00000000..24ac72a0 --- /dev/null +++ b/next/tests/http_server_tcp.sh @@ -0,0 +1,143 @@ +#!/usr/bin/env bash +# next/tests/http_server_tcp.sh — Step 9a-tcp live TCP smoke test. +# +# Boots sx_server in the background with a script that loads +# http_server.erl and calls http_server:start/1 on a high port, +# then drives the running server with curl from this shell to +# verify the request → marshaling → route → marshaling → HTTP +# response chain end-to-end. +# +# Boot timing: ~10s for all `lib/erlang/*.sx` loads + module +# compile + spawn + Unix.bind. We hold the server's stdin open +# via `(cat file; sleep 60) | sx_server` so EOF doesn't trigger +# exit(0) before the listener finishes binding. + +set -uo pipefail +cd "$(git rev-parse --show-toplevel)" + +SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}" +if [ ! -x "$SX_SERVER" ]; then + SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe" +fi +if [ ! -x "$SX_SERVER" ]; then + echo "ERROR: sx_server.exe not found." >&2 + exit 1 +fi + +PORT=51820 +VERBOSE="${1:-}" +PASS=0; FAIL=0; ERRORS="" + +EPOCH_FILE=$(mktemp) +LOG_FILE=$(mktemp) +cleanup() { + if [ -n "${SXPID:-}" ]; then + kill -KILL "$SXPID" 2>/dev/null || true + wait "$SXPID" 2>/dev/null || true + fi + if [ -n "${HOLDPID:-}" ]; then + kill -KILL "$HOLDPID" 2>/dev/null || true + wait "$HOLDPID" 2>/dev/null || true + fi + rm -f "$EPOCH_FILE" "$LOG_FILE" +} +trap cleanup EXIT + +cat > "$EPOCH_FILE" < "$FIFO" & +HOLDPID=$! +"$SX_SERVER" < "$FIFO" > "$LOG_FILE" 2>&1 & +SXPID=$! +rm -f "$FIFO" # both ends still hold open via the running procs + +# Wait for the listener to bind (up to ~30s — boot takes ~10s). +BOUND="" +for i in $(seq 1 60); do + if (exec 3<>/dev/tcp/127.0.0.1/$PORT) 2>/dev/null; then + exec 3<&-; exec 3>&- + BOUND="yes" + break + fi + sleep 0.5 +done + +if [ -z "$BOUND" ]; then + echo "FAIL: listener never bound on port $PORT" + if [ "$VERBOSE" = "-v" ]; then + echo "--- sx_server output ---" + cat "$LOG_FILE" + echo "---" + fi + exit 1 +fi + +check_http() { + local desc="$1" method="$2" path="$3" auth="$4" expected_status="$5" expected_body_substr="$6" + local args=() + args+=(-s -o /tmp/http_body.out -w "%{http_code}") + args+=(-X "$method") + if [ -n "$auth" ]; then + args+=(-H "Authorization: $auth") + fi + if [ "$method" = "POST" ]; then + args+=(-d "") + fi + args+=("http://127.0.0.1:$PORT$path") + local code + code=$(curl "${args[@]}" 2>/dev/null || echo "000") + local body + body=$(cat /tmp/http_body.out 2>/dev/null || echo "") + local pass=1 + if [ "$code" != "$expected_status" ]; then pass=0; fi + if [ -n "$expected_body_substr" ] && ! echo "$body" | grep -qF -- "$expected_body_substr"; then pass=0; fi + if [ $pass -eq 1 ]; then + PASS=$((PASS+1)) + [ "$VERBOSE" = "-v" ] && echo " ok $desc ($code)" + else + FAIL=$((FAIL+1)) + ERRORS+=" FAIL [$desc] code=$code body=$body +" + fi +} + +check_http "GET / -> 200" GET / "" 200 "" +check_http "GET capabilities -> 200" GET /.well-known/sx-capabilities "" 200 "kernel:" +check_http "GET unknown -> 404" GET /no-such-path "" 404 "" +check_http "POST /activity no bearer -> 401" POST /activity "" 401 "" +check_http "POST /activity bad bearer -> 401" POST /activity "Bearer wrong" 401 "" + +TOTAL=$((PASS+FAIL)) +if [ $FAIL -eq 0 ]; then + echo "ok $PASS/$TOTAL http_server_tcp tests passed (port $PORT)" +else + echo "FAIL $PASS/$TOTAL passed, $FAIL failed:" + echo "$ERRORS" + if [ "$VERBOSE" = "-v" ]; then + echo "--- sx_server output (last 30 lines) ---" + tail -30 "$LOG_FILE" + echo "---" + fi +fi +[ $FAIL -eq 0 ] diff --git a/plans/fed-sx-milestone-1.md b/plans/fed-sx-milestone-1.md index efc96d78..dbf053ce 100644 --- a/plans/fed-sx-milestone-1.md +++ b/plans/fed-sx-milestone-1.md @@ -511,7 +511,7 @@ publish(ActorId, ActivityRequest) -> **Sub-deliverables:** - [x] **8a** — `http:listen/2` BIF wrapper in `lib/erlang/runtime.sx` (the briefing's allowed exception). Validates args, bridges Erlang handler funs to SX-callable lambdas via `er-of-sx`/`er-to-sx`, delegates to the native `http-listen` primitive in `bin/sx_server.ml`. Tests verify registration + arg validation (not the blocking listen loop). `next/tests/http_listen_bif.sh` (5 cases). - [x] **8b-route** — `next/kernel/http_server.erl`: pure `route/1` dispatch + `ok_response/1`, `not_found_response/0`, `welcome_body/0`. GET / returns welcome; everything else returns 404 (graceful for missing fields). `next/tests/http_route.sh` (11 cases). -- [ ] **8b-start** — `start/1(Port)` spawns an Erlang process hosting `http:listen/2`, requires the dict↔proplist marshaling bridge in the BIF wrapper. +- [x] **8b-start** — `http_server:start/1(Port)` + `start/2(Port, Cfg)` spawn an Erlang process hosting `http:listen/2`. The BIF wrapper (`er-bif-http-listen` in lib/erlang/runtime.sx) now threads requests/responses through the marshaling bridge: SX request dict `{:method :path :query :headers :body}` → Erlang proplist `[{method, <<"GET">>}, {path, <<"/foo">>}, {query, <<>>}, {headers, [{<<"content-type">>, <<"text/plain">>}, ...]}, {body, <<>>}]` (atom keys for the fixed top-level fields, binary keys for the arbitrary header proplist), handler returns a proplist response that converts back to an SX dict for the native serialiser. Helpers: `er-request-dict-to-proplist`, `er-of-sx-deep`, `er-dict-to-header-proplist`, `er-proplist-to-dict`, `er-to-sx-deep`, `er-proplist-2tuple?`, `er-proplist-fill!`. `er-of-sx` itself is untouched so non-HTTP callers see no semantic change. Structural test `next/tests/http_server_start.sh` (6 cases, in-Erlang only — can't invoke spawn from the test because the cooperative scheduler hangs while draining a forever-blocking accept loop). Marshaling unit test `next/tests/http_marshal.sh` (10 cases). The live behaviour is proved end-to-end by `next/tests/http_server_tcp.sh` (5 curl probes over real TCP, doubles as 9a-tcp's smoke surface). Erlang conformance 761/761 unchanged. - [x] **8c-cap** — Route GET `/.well-known/sx-capabilities` (static doc: kernel/version/verbs lines). `next/tests/http_capabilities.sh` (8 cases). Other concrete routes follow. - [x] **8c-actors-doc** — `match_prefix/2` byte-level path-prefix matcher + GET `/actors/{id}` route returning an `actor: ` stub body. `/actors/{id}/outbox` deferred (needs path-segment splitting). `next/tests/http_actors.sh` (13 cases). - [x] **8c-art** — Route GET `/artifacts/{cid}` via `match_prefix`. Stub body echoes the cid (`artifact: \n`); real content store lookup deferred. `next/tests/http_artifacts.sh` (9 cases). @@ -1005,6 +1005,7 @@ A few things still under-specified; resolve as work begins. Newest first. One line per sub-deliverable commit. Erlang conformance gate (`bash lib/erlang/conformance.sh`) must remain 729/729 on every entry. +- **2026-06-05** — Step 8b-start landed: `http_server:start/1(Port)` + `start/2(Port, Cfg)` in `next/kernel/http_server.erl` spawn an Erlang process hosting the native `http:listen/2` accept loop. The blocker — the BIF wrapper had no dict↔proplist marshaling, so Erlang handlers couldn't pattern-match on the request — is resolved by a new family of helpers in `lib/erlang/runtime.sx`: `er-request-dict-to-proplist` (top-level: atom keys, recursive value marshal via `er-of-sx-deep`), `er-dict-to-header-proplist` (binary keys for arbitrary header names, kept out of the atom table), and the inverse pair `er-proplist-to-dict` / `er-proplist-fill!` / `er-to-sx-deep` / `er-proplist-2tuple?` that detect cons-of-2-tuples as nested dicts (handlers' response proplists fold cleanly back to the SX dict the native serialiser expects). `er-of-sx` itself stays unchanged so non-HTTP callers see no behavioural drift. Three new tests: `next/tests/http_marshal.sh` (10 cases — request/response leaf types, nested headers, full round-trip), `next/tests/http_server_start.sh` (6 structural cases — module loads, exports bound, marshalers defined; can't invoke spawn in-Erlang because the cooperative scheduler drains all processes before returning to `erlang-eval-ast`'s caller, and the listener's accept loop never exits), and **the live TCP smoke test** `next/tests/http_server_tcp.sh` (5 curl probes — GET / 200, GET /.well-known/sx-capabilities 200, GET unknown 404, POST /activity unauthorised 401 with no/bad bearer). The smoke test backgrounds `sx_server` with a FIFO-held stdin so EOF doesn't reap the process before the listener binds (~10s of `lib/erlang/*.sx` loads), then curls a high port and asserts HTTP status codes. This is the first end-to-end test in the milestone proving the full transport works — request → BIF marshaler → Erlang route → marshaled response → HTTP/1.1 wire format. **Erlang-port detail captured this iteration:** can't write an in-Erlang smoke test for the spawn path because `er-sched-run-all!` blocks until every spawned process leaves the runnable queue, and the listener thread never does. The structural test verifies code shape; the TCP test verifies behaviour. Erlang conformance 761/761 unchanged (all helpers + new tests live in next/ and runtime.sx FFI surface only; no semantic change to existing BIFs). - **2026-06-05** — Step 6e ticked as **superseded**: the "HTTP handler for POST /activity glue" bullet pre-dates the Step 8 dispatch refactor. `http_server:route/2` already wires POST `/activity` to `nx_kernel:publish/1` (kernel-registered: 200 with `cid: ` body via `cid_response/1`; sig/replay failure: 422 via `validation_failed_response/0`) and falls back to the stub when the kernel isn't running. Per-format response variants (json / sx / cbor / activity+json) followed in 8d-dispatch-post via `cid_response_for/2` + `post_activity_response_for/1`. Verified via `next/tests/http_publish.sh` 10/10 and `next/tests/http_post_format.sh` 13/13 — both already part of the standing suite. No new code or tests; plan-only commit to tick the redundant bullet and route the next iteration past it. Erlang conformance 761/761. - **2026-06-05** — Step 3c.b gen_server-mediated concurrent appends: `next/kernel/log_server.erl` (behaviour gen_server) wraps the pure Step 3c.a `log` substrate. `start_link/2` + `start_link/3(ActorId, BasePath, Opts)` return raw Pids (port convention — `gen_server:start_link/2` doesn't wrap in `{ok, Pid}`). Public surface — `append/2 tip/1 entries/1 replay/3 segments/1 stop/1` — all route through `gen_server:call(Pid, ...)`, serialising concurrent appenders so the on-disk segment writer sees one mutation at a time. `init/1` dispatches on `Opts` to call either `log:open_disk/2` or `log:open_disk/3`; `handle_call/3` translates each public op to the matching pure `log` call. New `next/tests/log_server.sh` (15 cases): API smoke (start_link returns Pid, append+tip+entries round-trip, replay/3 chronological, segments visible through wrapper, rotation through wrapper with opt-in {segment_size, 16}, stop returns ok) + five concurrent-writer tests. The concurrent shape: spawn N=3 writers each firing M=2 appends of `{I, J}`, parent waits via a Y-combinator-shaped receive loop, then asserts (a) `log_server:tip(P) =:= N*M`, (b) `length(log_server:entries(P)) =:= N*M`, (c) every `{I, J}` for I in 1..N, J in 1..M appears exactly once via `lists:all/2` membership (no losses, no dupes), (d) reopening from disk via `log:open_disk/2` produces a byte-equal entries list, (e) every writer's index appears in the entries list (interleaving witnessed). **Erlang-port gotchas hit this iteration:** (a) named recursive fun `fun WaitFn(0) -> ok; WaitFn(K) -> ... end` errors as "fun-ref syntax not yet supported" — rewrite as `fun (_, 0) -> ok; (Self, K) -> ... Self(Self, K - 1) end` then call `Wait(Wait, N)`. (b) `lists:foreach/2` isn't registered (only `lists:map/2`) — use `lists:map/2` and discard the result list when running side-effecting closures. (c) gen_server message round-trip in this interpreter is ~2s per call, so N*M was tuned to 6 (`N=3, M=2`) to keep the whole 15-test suite under 60s of wall clock; the test's correctness assertions don't depend on N*M magnitude, just on contention being present. Erlang conformance **761/761** unchanged (log_server.erl is in next/, not lib/erlang/). Step 3c now fully ticked. - **2026-06-05** — Step 3c.a segment rotation: `next/kernel/log.erl` rewritten around a `seg_lens :: [N0, N1, ...]` bookkeeping list (one entry-count per segment in numeric order, last is active) + `seg_size` threshold. Filename scheme now `-NNNNNN.log` (6-digit zero-padded so `file:list_dir`'s alphabetical sort = numeric). `open_disk/3(ActorId, BasePath, [{segment_size, N}])` opts a caller into a smaller rotation threshold; `open_disk/2` keeps a 1 GiB default that effectively never rotates (preserves Step 3b acceptance). Rotation rule (`place_append/4`): if the active segment's pre-append serialized size already ≥ threshold AND it holds at least one entry, the new activity opens a fresh segment — otherwise it extends current active. Single huge entry > threshold stays alone (no recursive rotation, no loop). On reopen, `load_all_segments` lists the directory, filters `-NNNNNN.log`, sorts numerically (insertion sort, since `lists:sort/1` isn't registered in this port — only `lists:append/2`/`lists:reverse/1`/`lists:filter/2` etc.), reads each via `try_read_segment`, and concatenates to rebuild flat `entries` + `seg_lens`. **Erlang-port gotchas hit & worked around:** (a) Erlang string literals like `"foo"` in this port are NOT charlists — `[H|T] = "foo"` badmatches, `length("foo")` errors as "not a proper list". `parse_segment_name` had to build prefix/suffix from `atom_to_list/1` + explicit `[$-]` / `[$., $l, $o, $g]` cons. (b) Cross-arg variable repetition (`strip_prefix([C | Rest], [C | PRest])`) works in tuple patterns but I rewrote it to explicit `case C =:= P of true -> ... false -> ...` for robustness. (c) `Pattern = Binding` syntax in a case clause (`[_|_] = Lst when length(Lst) > 1 -> ...`) errors "unsupported pattern type 'match'" — used `Lst when is_list(Lst), length(Lst) > 1` instead. New `next/tests/log_rotate.sh` 10/10: no-opt single-seg-after-3, rotation-fires-on-threshold, rotated-chronological, reopen-rebuilds-history, reopen-rebuilds-same-seg-shape, huge-single-entry-stays-1-seg, append-after-huge-keeps-order, tip-monotonic-across-rotations. Existing `next/tests/log_disk.sh` updated to the new filename (`corrupted-000000.log`) and stays 12/12. Erlang conformance **761/761** unchanged (log.erl is in next/, not lib/erlang/). Step 3c.a ticked; 3c.b (gen_server-mediated concurrent appends) is the next iteration.