fed-sx-types Phase 3: /types/<cid> route + discovery_type_fetch

Wire format for serving + fetching type docs (plans/fed-sx-host-types.md step 3). http_server.erl: - new type_doc Accept format + content type (application/vnd.fed-sx.type-doc), distinct from actor-doc. - GET /types/<cid> -> the cached TypeRecord term_codec-encoded, 404 if not in the peer_types cache. Reads peer_types via a Cfg {peer_types, peer_types} guard (hardcoded registered atom, mirroring the actor-doc route's kernel guard). discovery_type_fetch.erl — sibling of discovery_fetch. make_fetch_fn produces the fun/2 peer_types:lookup_or_fetch calls: GET <base>/types/<cid> with the type-doc Accept header, returning the RAW bytes (peer_types owns the term_codec decode, so the wire format lives in one place — the route encodes, the cache decodes). Cfg carries type_url / type_url_fn for TypeCid -> base URL resolution. Tests: next/tests/peer_types_route.sh (13, in-process route dispatch), next/tests/discovery_type_fetch.sh (9, closure vs a python type-doc stub, end-to-end through peer_types:lookup_or_fetch). No regression: http_accept, http_actors, http_get_format, discovery_fetch all still green. Conformance 771/771. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 15:48:33 +00:00
parent 8d54028c7f
commit 441a895737
4 changed files with 498 additions and 1 deletions
--- a/next/tests/discovery_type_fetch.sh
+++ b/next/tests/discovery_type_fetch.sh
@@ -0,0 +1,176 @@
+#!/usr/bin/env bash
+# next/tests/discovery_type_fetch.sh — host-type federation Phase 3.
+#
+# Client side of the type-doc wire: discovery_type_fetch builds the
+# fun/2 closure peer_types:lookup_or_fetch calls on a cache miss. It
+# GETs <base>/types/<cid> with the type-doc Accept header and returns
+# the RAW response bytes (peer_types decodes them via term_codec).
+# Exercised end-to-end against a background python http server that
+# serves hand-crafted term_codec bytes, so we test the wire — not just
+# an in-process call.
+
+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=""
+
+# ── live stub server ─────────────────────────────────────────
+# GET /types/bafy1 -> 200 with term_codec-encoded TypeRecord
+#   TR = [{name, <<"Post">>}, {instance_type, <<"Note">>}]
+# GET anything else -> 404
+PORT=$(python3 -c 'import socket;s=socket.socket();s.bind(("127.0.0.1",0));print(s.getsockname()[1]);s.close()')
+SRVROOT=$(mktemp -d)
+PYSRV="$SRVROOT/srv.py"
+cat > "$PYSRV" <<'PY'
+import sys, http.server, socketserver
+
+PORT = int(sys.argv[1])
+
+# term_codec encoding (mirror of next/kernel/term_codec.erl).
+def enc_atom(s):
+    b = s.encode()
+    return f"a{len(b)}:".encode() + b
+def enc_bin(b):
+    return f"b{len(b)}:".encode() + b
+def enc_tuple(items):
+    return f"t{len(items)}:".encode() + b"".join(items)
+def enc_list(items):
+    return f"l{len(items)}:".encode() + b"".join(items)
+
+# [{name, <<"Post">>}, {instance_type, <<"Note">>}]
+TYPEDOC = enc_list([
+    enc_tuple([enc_atom("name"), enc_bin(b"Post")]),
+    enc_tuple([enc_atom("instance_type"), enc_bin(b"Note")]),
+])
+
+class H(http.server.BaseHTTPRequestHandler):
+    def do_GET(self):
+        if self.path == "/types/bafy1":
+            self.send_response(200)
+            self.send_header('content-type','application/vnd.fed-sx.type-doc')
+            self.send_header('content-length', str(len(TYPEDOC)))
+            self.end_headers()
+            self.wfile.write(TYPEDOC)
+        else:
+            self.send_response(404); self.end_headers(); self.wfile.write(b'not found')
+    def log_message(self, fmt, *args): pass
+
+with socketserver.TCPServer(("127.0.0.1", PORT), H) as srv:
+    srv.serve_forever()
+PY
+python3 "$PYSRV" "$PORT" >/dev/null 2>&1 &
+SRV_PID=$!
+TMPFILE=$(mktemp)
+trap "rm -rf $SRVROOT $TMPFILE; kill $SRV_PID 2>/dev/null || true" EXIT
+for _ in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15; do
+  if curl -fsS "http://127.0.0.1:$PORT/types/bafy1" >/dev/null 2>&1; then break; fi
+  sleep 0.2
+done
+
+bytes_of() { python3 -c "import sys; print(','.join(str(b) for b in sys.argv[1].encode()))" "$1"; }
+URL_BASE_BYTES=$(bytes_of "http://127.0.0.1:$PORT")
+
+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 "(er-load-gen-server!)")
+(epoch 3)
+(eval "(get (erlang-load-module (file-read \"next/kernel/term_codec.erl\")) :name)")
+(epoch 4)
+(eval "(get (erlang-load-module (file-read \"next/kernel/peer_types.erl\")) :name)")
+(epoch 5)
+(eval "(get (erlang-load-module (file-read \"next/kernel/discovery_type_fetch.erl\")) :name)")
+
+;; accept_header is the 31-byte type-doc MIME
+(epoch 10)
+(eval "(get (erlang-eval-ast \"byte_size(discovery_type_fetch:accept_header()) =:= 31\") :name)")
+
+;; type_doc_url builds <base>/types/bafy1
+(epoch 11)
+(eval "(get (erlang-eval-ast \"U = discovery_type_fetch:type_doc_url(<<__URL_BASE__>>, <<98,97,102,121,49>>), U =:= <<__URL_BASE__,47,116,121,112,101,115,47,98,97,102,121,49>>\") :name)")
+
+;; resolve_type_url via the static type_url proplist
+(epoch 12)
+(eval "(get (erlang-eval-ast \"discovery_type_fetch:resolve_type_url(<<98,97,102,121,49>>, [{type_url, [{<<98,97,102,121,49>>, <<__URL_BASE__>>}]}]) =:= {ok, <<__URL_BASE__>>}\") :name)")
+
+;; fetch live -> {ok, Bytes} that decode to the TypeRecord
+(epoch 13)
+(eval "(get (erlang-eval-ast \"R = discovery_type_fetch:fetch(<<__URL_BASE__,47,116,121,112,101,115,47,98,97,102,121,49>>, []), case R of {ok, B} -> {ok, TR, _} = term_codec:decode(B), TR =:= [{name, <<80,111,115,116>>}, {instance_type, <<78,111,116,101>>}]; _ -> false end\") :name)")
+
+;; closure from make_fetch_fn/0 dispatches and returns raw bytes
+(epoch 14)
+(eval "(get (erlang-eval-ast \"Fn = discovery_type_fetch:make_fetch_fn(), Cfg = [{type_url, [{<<98,97,102,121,49>>, <<__URL_BASE__>>}]}], case Fn(<<98,97,102,121,49>>, Cfg) of {ok, B} -> {ok, TR, _} = term_codec:decode(B), TR =:= [{name, <<80,111,115,116>>}, {instance_type, <<78,111,116,101>>}]; _ -> false end\") :name)")
+
+;; closure with no resolver -> {error, no_type_url}
+(epoch 15)
+(eval "(get (erlang-eval-ast \"Fn = discovery_type_fetch:make_fetch_fn(), case Fn(<<98,97,102,121,49>>, []) of {error, no_type_url} -> true; _ -> false end\") :name)")
+
+;; fetch on an unknown cid path -> {error, {status, 404}}
+(epoch 16)
+(eval "(get (erlang-eval-ast \"R = discovery_type_fetch:fetch(<<__URL_BASE__,47,116,121,112,101,115,47,122,122,122>>, []), case R of {error, {status, 404}} -> true; _ -> false end\") :name)")
+
+;; end-to-end: peer_types:lookup_or_fetch uses the closure, decodes,
+;; and writes the TypeRecord into the cache
+(epoch 17)
+(eval "(get (erlang-eval-ast \"Fn = discovery_type_fetch:make_fetch_fn(), Cfg = [{type_fetch_fn, Fn}, {type_url, [{<<98,97,102,121,49>>, <<__URL_BASE__>>}]}], case peer_types:lookup_or_fetch(<<98,97,102,121,49>>, Cfg, peer_types:new()) of {ok, TR, S} -> TR =:= [{name, <<80,111,115,116>>}, {instance_type, <<78,111,116,101>>}] andalso peer_types:types(S) =:= [<<98,97,102,121,49>>]; _ -> false end\") :name)")
+EPOCHS
+
+sed -i "s|__URL_BASE__|${URL_BASE_BYTES}|g" "$TMPFILE"
+
+OUTPUT=$(timeout 300 "$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  5  "discovery_type_fetch loaded"          "discovery_type_fetch"
+check 10  "accept_header is 31-byte type-doc"    "true"
+check 11  "type_doc_url builds /types/<cid>"     "true"
+check 12  "resolve_type_url via type_url map"    "true"
+check 13  "fetch live -> raw bytes decode to TR" "true"
+check 14  "closure -> raw bytes decode to TR"    "true"
+check 15  "closure no resolver -> no_type_url"   "true"
+check 16  "fetch 404 path -> {status, 404}"      "true"
+check 17  "lookup_or_fetch caches fetched TR"    "true"
+
+TOTAL=$((PASS+FAIL))
+if [ $FAIL -eq 0 ]; then
+  echo "ok $PASS/$TOTAL next/tests/discovery_type_fetch.sh passed"
+else
+  echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
+  echo "$ERRORS"
+fi
+[ $FAIL -eq 0 ]
--- a/next/tests/peer_types_route.sh
+++ b/next/tests/peer_types_route.sh
@@ -0,0 +1,140 @@
+#!/usr/bin/env bash
+# next/tests/peer_types_route.sh — host-type federation Phase 3.
+#
+# Server side of the type-doc wire: http_server serves
+#   GET /types/<cid>   Accept: application/vnd.fed-sx.type-doc
+# as the term_codec-encoded TypeRecord pulled from the peer_types
+# cache; 404 if the cid isn't cached. Exercised via http_server:route
+# in-process (the established pattern — see http_actors.sh) so the
+# route resolution + content negotiation are tested without a live
+# socket. The peer_types gen_server holds the cache across epochs.
+
+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
+
+# TR is the served TypeRecord, Cid its key. AccV is the type-doc
+# Accept header value, CT the content-type key. Cfg opts the route
+# into the peer_types cache. ReqHit / ReqMiss / ReqEmpty / ReqPost
+# vary the request line.
+SETUP='TR = [{name, <<80,111,115,116>>}, {instance_type, <<78,111,116,101>>}], Cid = <<98,97,102,121,49>>, peer_types:start_link(), peer_types:put(Cid, TR), AcK = <<97,99,99,101,112,116>>, AcV = <<97,112,112,108,105,99,97,116,105,111,110,47,118,110,100,46,102,101,100,45,115,120,46,116,121,112,101,45,100,111,99>>, Hs = [{AcK, AcV}], Cfg = [{peer_types, peer_types}],'
+
+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 "(er-load-gen-server!)")
+(epoch 3)
+(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
+(epoch 4)
+(eval "(get (erlang-load-module (file-read \"next/kernel/term_codec.erl\")) :name)")
+(epoch 5)
+(eval "(get (erlang-load-module (file-read \"next/kernel/peer_types.erl\")) :name)")
+(epoch 6)
+(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
+
+;; ── negotiation + prefix primitives ────────────────────────
+;; Accept: type-doc negotiates to the type_doc format atom
+(epoch 10)
+(eval "(get (erlang-eval-ast \"http_server:accept_format(<<97,112,112,108,105,99,97,116,105,111,110,47,118,110,100,46,102,101,100,45,115,120,46,116,121,112,101,45,100,111,99>>) =:= type_doc\") :name)")
+;; type_doc content type is 31 bytes
+(epoch 11)
+(eval "(get (erlang-eval-ast \"byte_size(http_server:content_type_for(type_doc)) =:= 31\") :name)")
+;; types_prefix is "/types/" — 7 bytes
+(epoch 12)
+(eval "(get (erlang-eval-ast \"byte_size(http_server:types_prefix()) =:= 7\") :name)")
+
+;; ── GET /types/<cid> ───────────────────────────────────────
+;; cache hit -> 200
+(epoch 20)
+(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<71,69,84>>}, {path, <<47,116,121,112,101,115,47,98,97,102,121,49>>}, {headers, Hs}], R = http_server:route(Req, Cfg), {ok, S} = envelope:get_field(status, R), S =:= 200\") :name)")
+;; body decodes back to the stored TypeRecord
+(epoch 21)
+(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<71,69,84>>}, {path, <<47,116,121,112,101,115,47,98,97,102,121,49>>}, {headers, Hs}], R = http_server:route(Req, Cfg), {ok, B} = envelope:get_field(body, R), {ok, DTR, _} = term_codec:decode(B), DTR =:= TR\") :name)")
+;; response carries the type-doc content type
+(epoch 22)
+(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<71,69,84>>}, {path, <<47,116,121,112,101,115,47,98,97,102,121,49>>}, {headers, Hs}], R = http_server:route(Req, Cfg), {ok, Hdrs} = envelope:get_field(headers, R), {_CTK, CTV} = hd(Hdrs), CTV =:= http_server:content_type_for(type_doc)\") :name)")
+;; type_doc_response_for/2 direct: known cid -> 200
+(epoch 23)
+(eval "(get (erlang-eval-ast \"${SETUP} R = http_server:type_doc_response_for(Cid, Cfg), {ok, S} = envelope:get_field(status, R), S =:= 200\") :name)")
+
+;; ── misses + wrong method ──────────────────────────────────
+;; unknown cid -> 404
+(epoch 30)
+(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<71,69,84>>}, {path, <<47,116,121,112,101,115,47,122,122,122>>}, {headers, Hs}], R = http_server:route(Req, Cfg), {ok, S} = envelope:get_field(status, R), S =:= 404\") :name)")
+;; empty cid (GET /types/) -> 404
+(epoch 31)
+(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<71,69,84>>}, {path, <<47,116,121,112,101,115,47>>}, {headers, Hs}], R = http_server:route(Req, Cfg), {ok, S} = envelope:get_field(status, R), S =:= 404\") :name)")
+;; no peer_types cfg -> 404 even for a known cid
+(epoch 32)
+(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<71,69,84>>}, {path, <<47,116,121,112,101,115,47,98,97,102,121,49>>}, {headers, Hs}], R = http_server:route(Req, []), {ok, S} = envelope:get_field(status, R), S =:= 404\") :name)")
+;; POST /types/<cid> -> 404 (only GET serves type docs)
+(epoch 33)
+(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, <<47,116,121,112,101,115,47,98,97,102,121,49>>}, {headers, Hs}], R = http_server:route(Req, Cfg), {ok, S} = envelope:get_field(status, R), S =:= 404\") :name)")
+;; existing routes intact: GET / still 200
+(epoch 34)
+(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<71,69,84>>}, {path, <<47>>}], R = http_server:route(Req, Cfg), {ok, S} = envelope:get_field(status, R), S =:= 200\") :name)")
+EPOCHS
+
+OUTPUT=$(timeout 300 "$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  6  "http_server module loaded"        "http_server"
+check 10  "Accept type-doc -> type_doc"      "true"
+check 11  "type_doc content type = 31 bytes" "true"
+check 12  "types_prefix = 7 bytes"           "true"
+check 20  "GET /types/<cid> hit -> 200"      "true"
+check 21  "body decodes to TypeRecord"       "true"
+check 22  "response is type-doc content type" "true"
+check 23  "type_doc_response_for hit -> 200" "true"
+check 30  "unknown cid -> 404"               "true"
+check 31  "empty cid -> 404"                 "true"
+check 32  "no peer_types cfg -> 404"         "true"
+check 33  "POST /types/<cid> -> 404"         "true"
+check 34  "existing GET / route intact"      "true"
+
+TOTAL=$((PASS+FAIL))
+if [ $FAIL -eq 0 ]; then
+  echo "ok $PASS/$TOTAL next/tests/peer_types_route.sh passed"
+else
+  echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
+  echo "$ERRORS"
+fi
+[ $FAIL -eq 0 ]