From 46e065391158910308aab57514d6a6c8e35e4ef1 Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 26 May 2026 19:53:58 +0000 Subject: [PATCH] =?UTF-8?q?fed-prims:=20Phase=20J=20=E2=80=94=20http-reque?= =?UTF-8?q?st=20+=206=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit NATIVE-ONLY http-request primitive (bin/sx_server.ml). HTTP/1.1 over Unix sockets + gethostbyname; inline http:// URL parsing (full url-parse deferred to Phase K); Connection: close + Host + Content-Length headers auto-supplied; reads response via Content-Length or read-to-EOF; chunked transfer-encoding rejected. Test bin/test_http_client.sh spins a Phase-H echo server and drives a second sx_server: GET+query, POST+body, 404, custom request header reflected, non-http scheme rejected, integer status — 6/6. WASM boot green (prim not in lib); Erlang conformance 530/530. --- hosts/ocaml/bin/sx_server.ml | 158 ++++++++++++++++++++++++++++ hosts/ocaml/bin/test_http_client.sh | 80 ++++++++++++++ plans/fed-sx-host-primitives.md | 52 +++++++++ 3 files changed, 290 insertions(+) create mode 100755 hosts/ocaml/bin/test_http_client.sh diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 1fb6594d..06328503 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -841,6 +841,164 @@ let setup_evaluator_bridge env = done; Nil | _ -> raise (Eval_error "http-listen: (port handler)")); + + (* fed-sx Milestone 1 client direction (Phase J). NATIVE ONLY — + Unix sockets + DNS; absent from the WASM kernel. HTTP/1.1 + request: TCP connect, write request line + headers + body, + read status + headers + body, return {:status :headers :body}. + URL must be http://...; HTTPS is a later phase (needs TLS). + Body read: Content-Length first, else read to EOF (we send + Connection: close). Transfer-Encoding: chunked is rejected — + fed-sx Phase 8 wires this for inter-server POSTs which will + all carry Content-Length. *) + Sx_primitives.register "http-request" (fun args -> + let strip_cr s = + let n = String.length s in + if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s + in + match args with + | [String meth; String url; headers_v; body_v] -> + let body = match body_v with + | String s -> s + | Nil -> "" + | v -> Sx_types.value_to_string v in + let prefix = "http://" in + let plen = String.length prefix in + let ulen = String.length url in + if ulen < plen || String.sub url 0 plen <> prefix + then raise (Eval_error "http-request: URL must start with http://"); + let rest = String.sub url plen (ulen - plen) in + let host_port, path = + match String.index_opt rest '/' with + | Some i -> + String.sub rest 0 i, + String.sub rest i (String.length rest - i) + | None -> rest, "/" in + if host_port = "" then + raise (Eval_error "http-request: missing host"); + let host, port = + match String.index_opt host_port ':' with + | Some i -> + let h = String.sub host_port 0 i in + let ps = String.sub host_port (i + 1) + (String.length host_port - i - 1) in + (h, + (try int_of_string ps with _ -> + raise (Eval_error "http-request: bad port"))) + | None -> host_port, 80 in + let addr = + (try (Unix.gethostbyname host).h_addr_list.(0) + with Not_found -> + raise (Eval_error ("http-request: dns: " ^ host))) in + let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + let cleanup () = try Unix.close sock with _ -> () in + let result = + (try + (try Unix.connect sock (Unix.ADDR_INET (addr, port)) + with Unix.Unix_error (e, _, _) -> + raise (Eval_error + ("http-request: connect: " ^ Unix.error_message e))); + let oc = Unix.out_channel_of_descr sock in + let ic = Unix.in_channel_of_descr sock in + let buf = Buffer.create 256 in + Buffer.add_string buf + (Printf.sprintf "%s %s HTTP/1.1\r\n" meth path); + let host_hdr_sent = ref false in + let clen_sent = ref false in + let conn_sent = ref false in + (match headers_v with + | Dict h -> + Hashtbl.iter (fun k v -> + let kl = String.lowercase_ascii k in + if kl = "host" then host_hdr_sent := true; + if kl = "content-length" then clen_sent := true; + if kl = "connection" then conn_sent := true; + let vs = match v with + | String s -> s + | x -> Sx_types.value_to_string x in + Buffer.add_string buf + (Printf.sprintf "%s: %s\r\n" k vs)) h + | Nil -> () + | _ -> raise (Eval_error "http-request: headers must be dict")); + if not !host_hdr_sent then + Buffer.add_string buf + (Printf.sprintf "Host: %s\r\n" host_port); + if not !clen_sent then + Buffer.add_string buf + (Printf.sprintf "Content-Length: %d\r\n" + (String.length body)); + if not !conn_sent then + Buffer.add_string buf "Connection: close\r\n"; + Buffer.add_string buf "\r\n"; + Buffer.add_string buf body; + output_string oc (Buffer.contents buf); + flush oc; + let sl = + (try strip_cr (input_line ic) + with End_of_file -> + raise (Eval_error + "http-request: connection closed before status")) in + let status = + match String.split_on_char ' ' sl with + | _ver :: code :: _ -> + (try int_of_string code with _ -> + raise (Eval_error "http-request: bad status code")) + | _ -> raise (Eval_error "http-request: bad status line") in + let rhdrs = Sx_types.make_dict () in + let clen = ref (-1) in + let chunked = ref false in + let rec rdh () = + let h = + (try strip_cr (input_line ic) + with End_of_file -> "") in + if h = "" then () + else begin + (match String.index_opt h ':' with + | Some i -> + let name = + String.lowercase_ascii + (String.trim (String.sub h 0 i)) in + let value = + String.trim + (String.sub h (i + 1) + (String.length h - i - 1)) in + Hashtbl.replace rhdrs name (String value); + if name = "content-length" then + (try clen := int_of_string value with _ -> ()) + else if name = "transfer-encoding" && + String.lowercase_ascii value = "chunked" + then chunked := true + | None -> ()); + rdh () + end in + rdh (); + if !chunked then + raise (Eval_error + "http-request: chunked transfer-encoding not supported"); + let rbody = + if !clen >= 0 then begin + let b = Bytes.create !clen in + really_input ic b 0 !clen; + Bytes.unsafe_to_string b + end else begin + let b = Buffer.create 256 in + (try + while true do + Buffer.add_channel b ic 4096 + done; assert false + with End_of_file -> ()); + Buffer.contents b + end in + let resp = Sx_types.make_dict () in + Hashtbl.replace resp "status" (Integer status); + Hashtbl.replace resp "headers" (Dict rhdrs); + Hashtbl.replace resp "body" (String rbody); + Dict resp + with e -> cleanup (); raise e) in + cleanup (); + result + | _ -> raise (Eval_error "http-request: (method url headers body)")); + bind "trampoline" (fun args -> match args with | [v] -> diff --git a/hosts/ocaml/bin/test_http_client.sh b/hosts/ocaml/bin/test_http_client.sh new file mode 100755 index 00000000..5ca0354f --- /dev/null +++ b/hosts/ocaml/bin/test_http_client.sh @@ -0,0 +1,80 @@ +#!/usr/bin/env bash +# Phase J test — native-only http-request client primitive. +# Reuses Phase H's http-listen to spin up an echo server, then drives +# a separate sx_server via the epoch protocol to issue http-request +# calls and assert response shape + headers + body. +set -u +cd "$(dirname "$0")/.." + +SRV=_build/default/bin/sx_server.exe +PORT=${HTTP_CLIENT_TEST_PORT:-8921} +PASS=0 +FAIL=0 +ok() { echo " PASS: $1"; PASS=$((PASS+1)); } +bad() { echo " FAIL: $1 — $2"; FAIL=$((FAIL+1)); } + +if [ ! -x "$SRV" ]; then + echo "build sx_server.exe first (dune build bin/sx_server.exe)"; exit 1 +fi + +# /echo echoes method/path/query/body and reflects request X-Custom +# back as response X-Got; /missing-test → 404. +H='(begin (define (h req) (if (= (get req "path") "/echo") {:status 200 :headers {"X-Echo" (get req "method") "X-Got" (get (get req "headers") "x-custom")} :body (str "M=" (get req "method") " P=" (get req "path") " Q=" (get req "query") " B=" (get req "body"))} (if (= (get req "path") "/missing-test") {:status 404 :body "nope"} {:status 500 :body "err"}))) (http-listen '"$PORT"' h))' +ESC=${H//\"/\\\"} + +{ printf '(epoch 1)\n(eval "%s")\n' "$ESC"; sleep 60; } | "$SRV" >/tmp/test_http_client_srv.out 2>&1 & +SVPID=$! +trap 'kill $SVPID 2>/dev/null; wait 2>/dev/null' EXIT + +up=0 +for _ in $(seq 1 50); do + curl -s -o /dev/null "http://127.0.0.1:$PORT/echo" 2>/dev/null && { up=1; break; } + sleep 0.2 +done +[ "$up" = 1 ] || { echo " FAIL: server did not start"; cat /tmp/test_http_client_srv.out; exit 1; } + +emit() { + # $1 = epoch num, $2 = raw SX form. Wraps in (eval "...") with quotes escaped. + local esc=${2//\"/\\\"} + printf '(epoch %s)\n(eval "%s")\n' "$1" "$esc" +} + +DRV_OUT=/tmp/test_http_client_drv.out +{ + emit 1 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/echo?x=1" {} ""))) (str "S=" (get r "status") " E=" (get (get r "headers") "x-echo") " B=" (get r "body")))' + emit 2 '(let ((r (http-request "POST" "http://127.0.0.1:'"$PORT"'/echo" {} "hello"))) (str "S=" (get r "status") " B=" (get r "body")))' + emit 3 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/missing-test" {} ""))) (str "S=" (get r "status") " B=" (get r "body")))' + emit 4 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/echo" {"X-Custom" "myval"} ""))) (get (get r "headers") "x-got"))' + emit 5 '(http-request "GET" "ftp://nope" {} "")' + emit 6 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/echo" {} ""))) (get r "status"))' +} | "$SRV" >"$DRV_OUT" 2>&1 + +# eval results come back as (ok-len N L)\n\n — grep the body content. +grep -q '^"S=200 E=GET B=M=GET P=/echo Q=x=1 B="$' "$DRV_OUT" \ + && ok "GET status + echo header + body" \ + || bad "GET" "$(grep -A1 '^(ok-len 1 ' "$DRV_OUT" | tail -1)" + +grep -q '^"S=200 B=M=POST P=/echo Q= B=hello"$' "$DRV_OUT" \ + && ok "POST body roundtrip" \ + || bad "POST" "$(grep -A1 '^(ok-len 2 ' "$DRV_OUT" | tail -1)" + +grep -q '^"S=404 B=nope"$' "$DRV_OUT" \ + && ok "404 status + body" \ + || bad "404" "$(grep -A1 '^(ok-len 3 ' "$DRV_OUT" | tail -1)" + +grep -q '^"myval"$' "$DRV_OUT" \ + && ok "custom request header reaches server" \ + || bad "custom-header" "$(grep -A1 '^(ok-len 4 ' "$DRV_OUT" | tail -1)" + +R5=$(grep '^(error 5 ' "$DRV_OUT" | head -1) +echo "$R5" | grep -q 'URL must start with http' \ + && ok "non-http scheme rejected" \ + || bad "bad-url" "$R5" + +# Status is an Integer (200), serialized bare without quotes. +grep -q '^200$' "$DRV_OUT" \ + && ok "response status is integer 200" \ + || bad "status-integer" "$(grep -A1 '^(ok-len 6 ' "$DRV_OUT" | tail -1)" + +echo "Results: $PASS passed, $FAIL failed" +[ "$FAIL" = 0 ] diff --git a/plans/fed-sx-host-primitives.md b/plans/fed-sx-host-primitives.md index 6869d666..211f8ace 100644 --- a/plans/fed-sx-host-primitives.md +++ b/plans/fed-sx-host-primitives.md @@ -145,6 +145,44 @@ check** → tests → commit → tick box → Progress-log line → push. - **Acceptance:** curl test script green; WASM build untouched (prim not in lib). Satisfies fed-sx Step 8 transport. +### Phase J — HTTP/1.1 client, **native-only** (`bin/sx_server.ml`) ✅ DONE +- Mirror of Phase H, inverse direction. TCP connect via `Unix.gethostbyname` + + `Unix.socket`/`Unix.connect`. Write request line + headers + body, read + response status line + headers + body (Content-Length first; chunked + encoding optional v2 — flag as Blockers if a fed-sx need hits it). +- Primitive `(http-request method url headers body) -> response-dict` + registered ONLY in `bin/sx_server.ml`. Response dict shape: + `{:status :headers :body}` (mirror of server's request dict). URL must be + `http://...` for v1; HTTPS is a separate later phase (needs TLS lib). +- Tests: `bin/test_http_client.sh` — start a tiny python HTTP server in a + subprocess (or reuse Phase H's SX server), drive GET / POST / 404 / + custom-header roundtrip via `(http-request ...)` from the epoch protocol, + assert response dict shape + body, kill server. +- **Acceptance:** test script green; WASM build untouched (prim not in lib); + Erlang conformance unchanged. Unblocks Erlang Phase 8 `httpc:request/4` BIF + wiring and fed-sx Milestone 2 federation `POST /inbox` outbound. + +### Phase K — URL parser, pure OCaml, WASM-safe (`lib/sx_url.ml`) +- `(url-parse "http://host:port/path?q=1") -> {:scheme :host :port :path :query}` + — small recursive-descent parser. No external deps. Port is integer when + present, absent key otherwise (or default per scheme: 80/443). +- `(url-encode-component string) -> string` / + `(url-decode-component string) -> string` — percent-encoding per RFC 3986 + (reserved/unreserved sets). +- Tests: `bin/test_url.ml` — full URL, port-less, path-only, query string with + multiple pairs, empty path, percent-encoding round-trips, malformed inputs + (return error-shaped result, not exception). +- **Acceptance:** WASM boot green (pure lib); supports fed-sx kernel actor URL + parsing and Phase J HTTP-client url handling. + +### Phase L — (open) further client prims as fed-sx kernel needs surface +- Add new phases here as the kernel loop or design conversations identify + needs: chunked HTTP transfer encoding, HTTPS / TLS verify (likely opam-dep + Blockers), webfinger HTTP shape, DNS (probably folded into `http-request`). +- Each new phase: define test vectors / contract → implement → WASM-check + (skip for native-only) → commit → Progress log. Same iteration discipline as + A–I. + ### Phase I — handoff ✅ DONE - Flip the `plans/erlang-on-sx.md` Blockers entry "SX runtime lacks platform primitives …" to **RESOLVED**, listing the exact SX primitive names so the @@ -226,6 +264,20 @@ should leave `httpc`/`sqlite` BIFs blocked with that note. _Newest first._ +- 2026-05-26 — Phase J: `http-request` primitive in `bin/sx_server.ml` + (NATIVE ONLY — `Unix.gethostbyname` + `Unix.connect`; HTTP/1.1 with + inline `http://` URL parser; sends Connection: close + Host + + Content-Length unless caller supplies them; reads status line + + headers + body via Content-Length, falling back to read-to-EOF; + Transfer-Encoding: chunked rejected with explicit error per plan). + Test `bin/test_http_client.sh` spins up a Phase-H echo server in a + background sx_server and drives a second sx_server with epoch + `(eval …)` calls: GET+query, POST+body, 404, custom request + header reflected back, non-http scheme rejected (error path), + integer status — 6/6 pass. NOT in lib/ so WASM boot untouched + (green); Erlang conformance 530/530 unchanged; run_tests + unchanged. Unblocks Erlang Phase 8 `httpc:request/4` BIF wiring + and fed-sx Milestone 2 federation `POST /inbox` outbound. - 2026-05-18 — Phase I: handoff. `erlang-on-sx.md` Blockers gained one RESOLVED entry (no "SX runtime lacks…" entry pre-existed; it read "_(none yet)_") mapping every delivered primitive → its Phase 8 BIF,