fed-sx-m1: 8b-bridge cleanup — remove dead helpers + duplicate test
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Step 8b-bridge was actually completed in0f85bd96(Step 8b-start) using er-request-dict-to-proplist / er-proplist-to-dict plus er-spawn-fun to host the handler inside a real Erlang process. My previous commit (31ff1e6a) shipped a parallel set of helpers (er-http-req-of-sx, er-http-resp-to-sx and friends) plus a duplicate test under next/tests/http_listen_bridge.sh — the BIF body never referenced them, so they sat in runtime.sx as dead code while http_marshal.sh already covered the live marshalers. This commit: - deletes the 8 dead helpers from lib/erlang/runtime.sx - deletes the duplicate next/tests/http_listen_bridge.sh - rewrites next/README.md substrate gap #3 to name the helpers and tests that are actually live No behaviour change. Erlang conformance still 761/761; http_listen_bif 5/5, http_route 11/11, http_publish_fold 10/10, http_marshal 10/10.
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
|
||||
@@ -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="<no output for epoch $epoch>"
|
||||
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 ]
|
||||
Reference in New Issue
Block a user