diff --git a/lib/erlang/runtime.sx b/lib/erlang/runtime.sx index cc64d466..32ce6e56 100644 --- a/lib/erlang/runtime.sx +++ b/lib/erlang/runtime.sx @@ -1578,147 +1578,6 @@ ;; 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 @@ -1731,14 +1590,10 @@ (not (er-fun? handler)) (raise (er-mk-error-marker (er-mk-atom "badarg"))) :else (let - ((sx-handler - (fn (req-dict) - (er-http-resp-to-sx - (er-apply-fun - handler - (list (er-http-req-of-sx req-dict))))))) + ((sx-handler (fn (req-dict) (er-http-resp-to-sx (er-apply-fun handler (list (er-http-req-of-sx req-dict))))))) (http-listen port sx-handler)))))) +;; Register everything at load time. (define er-register-builtin-bifs! (fn diff --git a/next/README.md b/next/README.md index fceea9c3..2f77bfbb 100644 --- a/next/README.md +++ b/next/README.md @@ -122,17 +122,20 @@ These three gaps block the remaining unchecked deliverables: unchanged. 3. **Dict ↔ proplist marshalling for `http:listen/2`** — **done 2026-06-05.** - `er-bif-http-listen` now marshals the native server's request dict + `er-bif-http-listen` 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 + native server to serialise. Helpers (`er-request-dict-to-proplist`, + `er-proplist-to-dict`, `er-of-sx-deep`, `er-to-sx-deep`, + `er-dict-to-header-proplist`, `er-proplist-fill!`) live alongside the + BIF wrapper in `lib/erlang/runtime.sx`. The BIF also spawns the handler + into a real Erlang process via `er-spawn-fun` + `er-sched-run-all!` + so `self()` / `gen_server:call` work inside route handlers (the kernel + and projection gen_servers reach the handler this way). Verified by + `next/tests/http_marshal.sh` and the live TCP smoke + `next/tests/http_server_tcp.sh` / `http_server_start.sh`. Unblocks `Step 8b-start` (TCP listener spawn) and the curl-driven 9a-tcp / 9b-tcp smoke tests. diff --git a/next/tests/http_listen_bridge.sh b/next/tests/http_listen_bridge.sh deleted file mode 100755 index 42594a61..00000000 --- a/next/tests/http_listen_bridge.sh +++ /dev/null @@ -1,177 +0,0 @@ -#!/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 ]