fed-prims: Phase J — http-request + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 2m48s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 2m48s
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.
This commit is contained in:
@@ -841,6 +841,164 @@ let setup_evaluator_bridge env =
|
|||||||
done;
|
done;
|
||||||
Nil
|
Nil
|
||||||
| _ -> raise (Eval_error "http-listen: (port handler)"));
|
| _ -> 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 ->
|
bind "trampoline" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [v] ->
|
| [v] ->
|
||||||
|
|||||||
80
hosts/ocaml/bin/test_http_client.sh
Executable file
80
hosts/ocaml/bin/test_http_client.sh
Executable file
@@ -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<body>\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 ]
|
||||||
@@ -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).
|
- **Acceptance:** curl test script green; WASM build untouched (prim not in lib).
|
||||||
Satisfies fed-sx Step 8 transport.
|
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
|
### Phase I — handoff ✅ DONE
|
||||||
- Flip the `plans/erlang-on-sx.md` Blockers entry "SX runtime lacks platform
|
- Flip the `plans/erlang-on-sx.md` Blockers entry "SX runtime lacks platform
|
||||||
primitives …" to **RESOLVED**, listing the exact SX primitive names so the
|
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._
|
_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
|
- 2026-05-18 — Phase I: handoff. `erlang-on-sx.md` Blockers gained one
|
||||||
RESOLVED entry (no "SX runtime lacks…" entry pre-existed; it read
|
RESOLVED entry (no "SX runtime lacks…" entry pre-existed; it read
|
||||||
"_(none yet)_") mapping every delivered primitive → its Phase 8 BIF,
|
"_(none yet)_") mapping every delivered primitive → its Phase 8 BIF,
|
||||||
|
|||||||
Reference in New Issue
Block a user