giles
0f85bd963a
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
`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) <noreply@anthropic.com>
135 lines
7.4 KiB
Bash
Executable File
135 lines
7.4 KiB
Bash
Executable File
#!/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="<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 "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 ]
|