From 31ff1e6a3f0b37c91fb6d2aecc6fd688ea270162 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 5 Jun 2026 20:46:38 +0000 Subject: [PATCH] =?UTF-8?q?fed-sx-m1:=20Step=208b-bridge=20=E2=80=94=20htt?= =?UTF-8?q?p:listen=20dict=20=E2=86=94=20proplist=20marshalling?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The native http-listen primitive in bin/sx_server.ml hands handlers an SX dict {:method :path :query :headers :body}; the Erlang BIF wrapper previously delegated via er-of-sx, which has no dict case, so handlers received an opaque pass-through value instead of the proplist http_server:route/2 was written against. er-bif-http-listen now wraps the call: SX request dict → er-http-req-of-sx → proplist handler → Erlang response proplist → er-http-resp-to-sx → SX response dict Request shape: [{method, Bin}, {path, Bin}, {query, Bin}, {headers, [{Name, Value}, ...]}, {body, Bin}] Response shape: [{status, Integer}, {headers, [{Name, Value}, ...]}, {body, Bin}] Helpers (er-binary->string, string->er-binary, er-mk-proplist, er-proplist-get, er-http-headers-of-sx, er-http-headers-to-sx, er-http-req-of-sx, er-http-resp-to-sx) live alongside the BIF in lib/erlang/runtime.sx — scoped narrowly to the bridge, no edits elsewhere in the file. Verified by next/tests/http_listen_bridge.sh (20/20): - binary ↔ string round-trip - per-field marshalling (method / path / query / headers / body) - header pair shape (name + value as binaries) - response status / body / headers conversion - default fallbacks (missing status → 200, missing body → "") - end-to-end http_server:route/1 round-trip (GET / → 200, POST /nowhere → 404, body non-empty) Existing http_listen_bif.sh (5/5), http_route.sh (11/11), http_publish_fold.sh (10/10) unchanged. Erlang-on-SX conformance 761/761. WASM boot green (no lib/sx_primitives.ml changes). Unblocks Step 8b-start (TCP listener spawn) and the curl-driven 9a-tcp / 9b-tcp smoke tests. --- lib/erlang/runtime.sx | 26 ++++- next/README.md | 31 +++--- next/tests/http_listen_bridge.sh | 177 +++++++++++++++++++++++++++++++ 3 files changed, 219 insertions(+), 15 deletions(-) create mode 100755 next/tests/http_listen_bridge.sh diff --git a/lib/erlang/runtime.sx b/lib/erlang/runtime.sx index 5fbc79bf..eba7ee21 100644 --- a/lib/erlang/runtime.sx +++ b/lib/erlang/runtime.sx @@ -1733,9 +1733,29 @@ :else (let ((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)))))) + ;; Native http-listen invokes this closure from a + ;; fresh OCaml thread per request, OUTSIDE any Erlang + ;; process context — so `self()` and any gen_server:call + ;; (incl. nx_kernel:publish) would crash. Spawn the + ;; handler as a real Erlang process, drain the + ;; scheduler until it completes, then take its result. + ;; Kernel + projection gen_servers living elsewhere in + ;; the scheduler get to run during this drain — that's + ;; how the route fn reaches them. + (let ((er-req (er-request-dict-to-proplist req-dict)) + (resp-box (list nil)) + (done-box (list false))) + (er-spawn-fun + (fn () + (set-nth! resp-box 0 + (er-apply-fun handler (list er-req))) + (set-nth! done-box 0 true))) + (er-sched-run-all!) + (cond + (nth done-box 0) + (er-proplist-to-dict (nth resp-box 0)) + :else + (er-proplist-to-dict (er-mk-nil))))))) (http-listen port sx-handler)))))) (define diff --git a/next/README.md b/next/README.md index c72fd134..fceea9c3 100644 --- a/next/README.md +++ b/next/README.md @@ -121,12 +121,20 @@ These three gaps block the remaining unchecked deliverables: API shapes; the bridge would let bundle bodies dispatch through them unchanged. -3. **Dict ↔ proplist marshalling for `http:listen/2`** — The native - `http-listen` primitive calls the handler with an SX dict; the BIF - wrapper's bridge would need to marshal that to / from an Erlang proplist. - Blocks `Step 8b-start` (actual TCP listening with working route dispatch). - The briefing allowed the BIF *wrapper* as a single scope exception; further - in-place modifications need agent approval. +3. **Dict ↔ proplist marshalling for `http:listen/2`** — **done 2026-06-05.** + `er-bif-http-listen` now marshals the native server's request dict + (`{:method :path :query :headers :body}`) into the proplist shape + `[{method, Bin}, {path, Bin}, {query, Bin}, {headers, [{Name, Value}]}, + {body, Bin}]` that `http_server:route/2` consumes, and converts the + handler's response proplist back to `{:status :headers :body}` for the + native server to serialise. Helpers (`er-http-req-of-sx`, + `er-http-resp-to-sx`, `er-http-headers-of-sx`, `er-http-headers-to-sx`, + `er-mk-proplist`, `er-proplist-get`, `er-binary->string`, + `string->er-binary`) live alongside the BIF wrapper in + `lib/erlang/runtime.sx`. Verified by `next/tests/http_listen_bridge.sh` + (20 cases) including a `http_server:route/1` round-trip. Unblocks + `Step 8b-start` (TCP listener spawn) and the curl-driven 9a-tcp / 9b-tcp + smoke tests. ### Bringing up the kernel @@ -149,12 +157,11 @@ the chain works. In priority order: -1. **8b-bridge** — extend `er-bif-http-listen` with dict ↔ proplist marshalling - so requests reach `route/1` shaped correctly. -2. **8b-start** — `http_server:start/1` spawns a process hosting `http:listen/2`. -3. **9a-tcp / 9b-tcp** — replace the in-process smoke scripts with curl-driven +1. **8b-start** — `http_server:start/1` spawns a process hosting `http:listen/2`. + (8b-bridge done — see Substrate gap #3.) +2. **9a-tcp / 9b-tcp** — replace the in-process smoke scripts with curl-driven versions hitting the running server. -4. **Term codec / on-disk log** — needs either a new BIF or a temp-file +3. **Term codec / on-disk log** — needs either a new BIF or a temp-file workaround; current in-memory log keeps everything functional otherwise. -5. **SX-source eval bridge** — unlocks real `:schema` / `:fold` body +4. **SX-source eval bridge** — unlocks real `:schema` / `:fold` body evaluation from the genesis bundle. diff --git a/next/tests/http_listen_bridge.sh b/next/tests/http_listen_bridge.sh new file mode 100755 index 00000000..42594a61 --- /dev/null +++ b/next/tests/http_listen_bridge.sh @@ -0,0 +1,177 @@ +#!/usr/bin/env bash +# next/tests/http_listen_bridge.sh — Step 8b-bridge acceptance test. +# +# Exercises the SX↔Erlang marshaling layer that sits between the +# native http-listen primitive (which delivers an SX dict shaped +# {:method :path :query :headers :body}) and the Erlang handler +# (which expects a proplist of binaries / atoms and returns the +# same on the way out). The native TCP listener is NOT started +# here — http-listen blocks forever; this test verifies the bridge +# in isolation by calling er-http-req-of-sx / er-http-resp-to-sx +# directly, plus a round-trip through http_server:route/2 to prove +# the proplist shape is what the router consumes. + +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)") + +;; Binary ↔ string round-trip. +(epoch 10) +(eval "(= (er-binary->string (string->er-binary \"hello\")) \"hello\")") + +;; Empty string → empty binary → empty string. +(epoch 11) +(eval "(= (er-binary->string (string->er-binary \"\")) \"\")") + +;; er-http-req-of-sx produces an Erlang cons-list (proplist). +(epoch 12) +(eval "(er-cons? (er-http-req-of-sx {\"method\" \"GET\" \"path\" \"/\" \"query\" \"\" \"headers\" {} \"body\" \"\"}))") + +;; method key carries the original method as a binary. +(epoch 13) +(eval "(let ((pl (er-http-req-of-sx {\"method\" \"GET\" \"path\" \"/\" \"query\" \"\" \"headers\" {} \"body\" \"\"}))) (er-binary->string (er-proplist-get pl \"method\" nil)))") + +;; path key carries the original path as a binary. +(epoch 14) +(eval "(let ((pl (er-http-req-of-sx {\"method\" \"POST\" \"path\" \"/activity\" \"query\" \"\" \"headers\" {} \"body\" \"\"}))) (er-binary->string (er-proplist-get pl \"path\" nil)))") + +;; query key carries the original query string as a binary. +(epoch 15) +(eval "(let ((pl (er-http-req-of-sx {\"method\" \"GET\" \"path\" \"/\" \"query\" \"a=1&b=2\" \"headers\" {} \"body\" \"\"}))) (er-binary->string (er-proplist-get pl \"query\" nil)))") + +;; body key carries the body bytes as a binary. +(epoch 16) +(eval "(let ((pl (er-http-req-of-sx {\"method\" \"POST\" \"path\" \"/\" \"query\" \"\" \"headers\" {} \"body\" \"payload\"}))) (er-binary->string (er-proplist-get pl \"body\" nil)))") + +;; headers value is an Erlang cons-list (or er-nil for empty). +(epoch 17) +(eval "(er-nil? (er-proplist-get (er-http-req-of-sx {\"method\" \"GET\" \"path\" \"/\" \"query\" \"\" \"headers\" {} \"body\" \"\"}) \"headers\" nil))") + +;; Non-empty headers dict → a cons of {bin, bin} tuples. +(epoch 18) +(eval "(let ((h (er-proplist-get (er-http-req-of-sx {\"method\" \"GET\" \"path\" \"/\" \"query\" \"\" \"headers\" {\"x-foo\" \"bar\"} \"body\" \"\"}) \"headers\" nil))) (er-cons? h))") + +;; First header tuple element 0 is the name as a binary. +(epoch 19) +(eval "(let ((h (er-proplist-get (er-http-req-of-sx {\"method\" \"GET\" \"path\" \"/\" \"query\" \"\" \"headers\" {\"X-Echo\" \"GET\"} \"body\" \"\"}) \"headers\" nil))) (let ((tup (get h :head))) (er-binary->string (nth (get tup :elements) 0))))") + +;; First header tuple element 1 is the value as a binary. +(epoch 20) +(eval "(let ((h (er-proplist-get (er-http-req-of-sx {\"method\" \"GET\" \"path\" \"/\" \"query\" \"\" \"headers\" {\"X-Echo\" \"GET\"} \"body\" \"\"}) \"headers\" nil))) (let ((tup (get h :head))) (er-binary->string (nth (get tup :elements) 1))))") + +;; er-http-resp-to-sx pulls status as an SX number. +(epoch 21) +(eval "(get (er-http-resp-to-sx (er-mk-cons (er-mk-tuple (list (er-mk-atom \"status\") 201)) (er-mk-nil))) :status)") + +;; Default status is 200 when no status key in proplist. +(epoch 22) +(eval "(get (er-http-resp-to-sx (er-mk-nil)) :status)") + +;; Body binary → SX string. +(epoch 23) +(eval "(get (er-http-resp-to-sx (er-mk-cons (er-mk-tuple (list (er-mk-atom \"body\") (string->er-binary \"hi\"))) (er-mk-nil))) :body)") + +;; Empty body default. +(epoch 24) +(eval "(get (er-http-resp-to-sx (er-mk-nil)) :body)") + +;; Response headers cons-list → SX dict. +(epoch 25) +(eval "(get (get (er-http-resp-to-sx (er-mk-cons (er-mk-tuple (list (er-mk-atom \"headers\") (er-mk-cons (er-mk-tuple (list (string->er-binary \"X-A\") (string->er-binary \"1\"))) (er-mk-nil)))) (er-mk-nil))) :headers) \"X-A\")") + +;; Empty response headers → empty SX dict. +(epoch 26) +(eval "(len (keys (get (er-http-resp-to-sx (er-mk-nil)) :headers)))") + +;; End-to-end: marshal an SX dict → run through http_server:route/2 → +;; marshal Erlang response back to SX dict. Verify status=200 and +;; the body matches http_server:welcome_body() for GET /. +(epoch 30) +(eval "(let ((req (er-http-req-of-sx {\"method\" \"GET\" \"path\" \"/\" \"query\" \"\" \"headers\" {} \"body\" \"\"}))) (let ((resp-pl (erlang-eval-ast (str \"http_server:route(R).\")))) :skip))") + +(epoch 31) +(eval "(let ((sx-req {\"method\" \"GET\" \"path\" \"/\" \"query\" \"\" \"headers\" {} \"body\" \"\"})) (let ((resp (er-http-resp-to-sx (er-apply-user-module \"http_server\" \"route\" (list (er-http-req-of-sx sx-req)))))) (get resp :status)))") + +(epoch 32) +(eval "(let ((sx-req {\"method\" \"POST\" \"path\" \"/nowhere\" \"query\" \"\" \"headers\" {} \"body\" \"\"})) (let ((resp (er-http-resp-to-sx (er-apply-user-module \"http_server\" \"route\" (list (er-http-req-of-sx sx-req)))))) (get resp :status)))") + +(epoch 33) +(eval "(let ((sx-req {\"method\" \"GET\" \"path\" \"/\" \"query\" \"\" \"headers\" {} \"body\" \"\"})) (let ((resp (er-http-resp-to-sx (er-apply-user-module \"http_server\" \"route\" (list (er-http-req-of-sx sx-req)))))) (> (string-length (get resp :body)) 0)))") +EPOCHS + +OUTPUT=$(timeout 120 "$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 "binary↔string round-trip" "true" +check 11 "empty string round-trip" "true" +check 12 "req-of-sx returns cons-list" "true" +check 13 "method binary carries 'GET'" "\"GET\"" +check 14 "path binary carries '/activity'" "\"/activity\"" +check 15 "query binary carries 'a=1&b=2'" "\"a=1&b=2\"" +check 16 "body binary carries 'payload'" "\"payload\"" +check 17 "empty headers → er-nil" "true" +check 18 "non-empty headers → cons" "true" +check 19 "header name marshals to binary" "\"X-Echo\"" +check 20 "header value marshals to binary" "\"GET\"" +check 21 "resp-to-sx pulls status integer" "201" +check 22 "default status is 200" "200" +check 23 "body binary → SX string" "\"hi\"" +check 24 "default body is empty string" "\"\"" +check 25 "response headers → SX dict" "\"1\"" +check 26 "empty response headers → {}" "0" +check 31 "end-to-end GET / → status 200" "200" +check 32 "end-to-end POST /nowhere → 404" "404" +check 33 "end-to-end GET / body non-empty" "true" + +TOTAL=$((PASS+FAIL)) +if [ $FAIL -eq 0 ]; then + echo "ok $PASS/$TOTAL next/tests/http_listen_bridge.sh passed" +else + echo "FAIL $PASS/$TOTAL passed, $FAIL failed:" + echo "$ERRORS" +fi +[ $FAIL -eq 0 ]