fed-sx-m1: Step 8d-dispatch-get — format-aware actor/artifact/projection/list responses + dispatch/3 refactor + 17 tests

next/kernel/http_server.erl

@@ -13,7 +13,9 @@
          accept_format/1, accept_format_from/1,
          capabilities_body_for/1,
          content_type_for/1, ok_response/2,
-         cid_response_for/2, post_activity_response_for/1]).
+         cid_response_for/2, post_activity_response_for/1,
+         actor_doc_response_for/2, artifact_response_for/2,
+         projection_response_for/2, projections_list_response_for/1]).
 
 %% HTTP request router per design §16.1.
 %%
@@ -43,49 +45,56 @@ route(Req) ->
 route(Req, Cfg) ->
     M = field(method, Req),
     P = field(path, Req),
+    F = accept_format_from(Req),
     case {M, P} of
         {<<80,79,83,84>>, <<47,97,99,116,105,118,105,116,121>>} ->
             handle_post_activity(Req, Cfg);
         {<<71,69,84>>,
          <<47,46,119,101,108,108,45,107,110,111,119,110,
            47,115,120,45,99,97,112,97,98,105,108,105,116,105,101,115>>} ->
-            F = accept_format_from(Req),
             ok_response(capabilities_body_for(F));
         _ ->
-            dispatch(M, P)
+            dispatch(M, P, F)
     end.
 
+%% Backward-compat /2 wrapper — defaults to text format. Route
+%% computes Format from the Accept header and calls dispatch/3
+%% directly; dispatch/2 is kept for callers that don't have a
+%% format in scope.
+dispatch(M, P) ->
+    dispatch(M, P, text).
+
 %% 71 69 84 = "GET"  | 47 = "/"
-dispatch(<<71, 69, 84>>, <<47>>) ->
+dispatch(<<71, 69, 84>>, <<47>>, _F) ->
     ok_response(welcome_body());
-%% GET /.well-known/sx-capabilities
+%% GET /.well-known/sx-capabilities — Format threaded through
 dispatch(<<71, 69, 84>>,
          <<47,46,119,101,108,108,45,107,110,111,119,110,
-           47,115,120,45,99,97,112,97,98,105,108,105,116,105,101,115>>) ->
-    ok_response(capabilities_body());
+           47,115,120,45,99,97,112,97,98,105,108,105,116,105,101,115>>, F) ->
+    ok_response(capabilities_body_for(F));
 %% GET /projections — list stub. Comes before the /projections/{name}
 %% prefix clause because the bare path has no trailing slash.
-dispatch(<<71, 69, 84>>, <<47,112,114,111,106,101,99,116,105,111,110,115>>) ->
-    projections_list_response();
+dispatch(<<71, 69, 84>>, <<47,112,114,111,106,101,99,116,105,111,110,115>>, F) ->
+    projections_list_response_for(F);
 %% GET /actors/{id} or /artifacts/{cid} or /projections/{name}
-dispatch(<<71, 69, 84>>, Path) ->
+dispatch(<<71, 69, 84>>, Path, F) ->
     case match_prefix(actors_prefix(), Path) of
         {ok, Id} when byte_size(Id) > 0 ->
-            actor_doc_response(Id);
+            actor_doc_response_for(Id, F);
         _ ->
             case match_prefix(artifacts_prefix(), Path) of
                 {ok, Cid} when byte_size(Cid) > 0 ->
-                    artifact_response(Cid);
+                    artifact_response_for(Cid, F);
                 _ ->
                     case match_prefix(projections_prefix(), Path) of
                         {ok, Name} when byte_size(Name) > 0 ->
-                            projection_response(Name);
+                            projection_response_for(Name, F);
                         _ ->
                             not_found_response()
                     end
             end
     end;
-dispatch(_, _) ->
+dispatch(_, _, _) ->
     not_found_response().
 
 %% "fed-sx kernel m1\n" — 17 bytes, hand-spelled.
@@ -482,3 +491,96 @@ post_activity_response_for(cbor) ->
     ok_response(Body, cbor);
 post_activity_response_for(_) ->
     post_activity_response().
+
+%% ── 8d-dispatch-get: format-aware GET responses ─────────────────
+%%
+%% Each builder mirrors its text-only counterpart but emits a
+%% format-tagged body and Content-Type. json/activity_json share
+%% the body shape but differ in CT; sx uses parenthesized form;
+%% cbor returns the raw payload bytes (encoder follow-up).
+
+%% actor_doc_response — text body `actor: <id>\n`.
+
+actor_doc_response_for(Id, text) ->
+    actor_doc_response(Id);
+actor_doc_response_for(Id, json) ->
+    Pre = <<123,34,97,99,116,111,114,34,58,34>>,  % '{"actor":"'
+    Suf = <<34,125,10>>,                           % '"}\n'
+    ok_response(<<Pre/binary, Id/binary, Suf/binary>>, json);
+actor_doc_response_for(Id, activity_json) ->
+    Pre = <<123,34,97,99,116,111,114,34,58,34>>,
+    Suf = <<34,125,10>>,
+    ok_response(<<Pre/binary, Id/binary, Suf/binary>>, activity_json);
+actor_doc_response_for(Id, sx) ->
+    Pre = <<40,97,99,116,111,114,32,34>>,          % '(actor "'
+    Suf = <<34,41,10>>,                             % '")\n'
+    ok_response(<<Pre/binary, Id/binary, Suf/binary>>, sx);
+actor_doc_response_for(Id, cbor) ->
+    ok_response(Id, cbor);
+actor_doc_response_for(Id, _) ->
+    actor_doc_response(Id).
+
+%% artifact_response — text body `artifact: <cid>\n`.
+
+artifact_response_for(Cid, text) ->
+    artifact_response(Cid);
+artifact_response_for(Cid, json) ->
+    Pre = <<123,34,97,114,116,105,102,97,99,116,34,58,34>>,
+    Suf = <<34,125,10>>,
+    ok_response(<<Pre/binary, Cid/binary, Suf/binary>>, json);
+artifact_response_for(Cid, activity_json) ->
+    Pre = <<123,34,97,114,116,105,102,97,99,116,34,58,34>>,
+    Suf = <<34,125,10>>,
+    ok_response(<<Pre/binary, Cid/binary, Suf/binary>>, activity_json);
+artifact_response_for(Cid, sx) ->
+    Pre = <<40,97,114,116,105,102,97,99,116,32,34>>,
+    Suf = <<34,41,10>>,
+    ok_response(<<Pre/binary, Cid/binary, Suf/binary>>, sx);
+artifact_response_for(Cid, cbor) ->
+    ok_response(Cid, cbor);
+artifact_response_for(Cid, _) ->
+    artifact_response(Cid).
+
+%% projection_response (singular) — text body `projection: <name>\n`.
+
+projection_response_for(Name, text) ->
+    projection_response(Name);
+projection_response_for(Name, json) ->
+    Pre = <<123,34,112,114,111,106,101,99,116,105,111,110,34,58,34>>,
+    Suf = <<34,125,10>>,
+    ok_response(<<Pre/binary, Name/binary, Suf/binary>>, json);
+projection_response_for(Name, activity_json) ->
+    Pre = <<123,34,112,114,111,106,101,99,116,105,111,110,34,58,34>>,
+    Suf = <<34,125,10>>,
+    ok_response(<<Pre/binary, Name/binary, Suf/binary>>, activity_json);
+projection_response_for(Name, sx) ->
+    Pre = <<40,112,114,111,106,101,99,116,105,111,110,32,34>>,
+    Suf = <<34,41,10>>,
+    ok_response(<<Pre/binary, Name/binary, Suf/binary>>, sx);
+projection_response_for(Name, cbor) ->
+    ok_response(Name, cbor);
+projection_response_for(Name, _) ->
+    projection_response(Name).
+
+%% projections_list_response — empty-list stub.
+
+projections_list_response_for(text) ->
+    projections_list_response();
+%% `{"projections":[]}\n`
+projections_list_response_for(json) ->
+    Body = <<123,34,112,114,111,106,101,99,116,105,111,110,115,
+             34,58,91,93,125,10>>,
+    ok_response(Body, json);
+projections_list_response_for(activity_json) ->
+    Body = <<123,34,112,114,111,106,101,99,116,105,111,110,115,
+             34,58,91,93,125,10>>,
+    ok_response(Body, activity_json);
+%% `(projections)\n`
+projections_list_response_for(sx) ->
+    Body = <<40,112,114,111,106,101,99,116,105,111,110,115,41,10>>,
+    ok_response(Body, sx);
+projections_list_response_for(cbor) ->
+    [_, _, {body, Body}] = projections_list_response(),
+    ok_response(Body, cbor);
+projections_list_response_for(_) ->
+    projections_list_response().

next/tests/http_get_format.sh

@@ -0,0 +1,147 @@
+#!/usr/bin/env bash
+# next/tests/http_get_format.sh — Step 8d-dispatch-get test.
+#
+# Verifies actor/artifact/projection/projections_list GET routes
+# return format-specific bodies + the right Content-Type. 16 cases.
+
+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
+
+# Common: accept key + several Accept values
+PRELUDE='AK = <<97,99,99,101,112,116>>, JsonAV = <<97,112,112,108,105,99,97,116,105,111,110,47,106,115,111,110>>, SxAV = <<97,112,112,108,105,99,97,116,105,111,110,47,115,120>>,'
+
+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)")
+
+;; actor_doc_response_for(text) matches text-only counterpart
+(epoch 10)
+(eval "(get (erlang-eval-ast \"http_server:actor_doc_response_for(<<97>>, text) =:= http_server:actor_doc_response(<<97>>)\") :name)")
+
+;; actor_doc_response_for(json) body: {"actor":"a"}\n
+(epoch 11)
+(eval "(get (erlang-eval-ast \"R = http_server:actor_doc_response_for(<<97>>, json), case R of [_, _, {body, B}] -> B =:= <<123,34,97,99,116,111,114,34,58,34,97,34,125,10>>; _ -> false end\") :name)")
+
+;; artifact_response_for(sx) body: (artifact "X")\n
+(epoch 12)
+(eval "(get (erlang-eval-ast \"R = http_server:artifact_response_for(<<120>>, sx), case R of [_, _, {body, B}] -> B =:= <<40,97,114,116,105,102,97,99,116,32,34,120,34,41,10>>; _ -> false end\") :name)")
+
+;; projection_response_for(json) body: {"projection":"foo"}\n
+(epoch 13)
+(eval "(get (erlang-eval-ast \"R = http_server:projection_response_for(<<102,111,111>>, json), case R of [_, _, {body, B}] -> B =:= <<123,34,112,114,111,106,101,99,116,105,111,110,34,58,34,102,111,111,34,125,10>>; _ -> false end\") :name)")
+
+;; projections_list_response_for(json) body: {"projections":[]}\n
+(epoch 14)
+(eval "(get (erlang-eval-ast \"R = http_server:projections_list_response_for(json), case R of [_, _, {body, B}] -> B =:= <<123,34,112,114,111,106,101,99,116,105,111,110,115,34,58,91,93,125,10>>; _ -> false end\") :name)")
+
+;; projections_list_response_for(sx) body: (projections)\n
+(epoch 15)
+(eval "(get (erlang-eval-ast \"R = http_server:projections_list_response_for(sx), case R of [_, _, {body, B}] -> B =:= <<40,112,114,111,106,101,99,116,105,111,110,115,41,10>>; _ -> false end\") :name)")
+
+;; cbor variants pass payload bytes through unchanged
+(epoch 16)
+(eval "(get (erlang-eval-ast \"R = http_server:actor_doc_response_for(<<97,98>>, cbor), case R of [_, _, {body, B}] -> B =:= <<97,98>>; _ -> false end\") :name)")
+(epoch 17)
+(eval "(get (erlang-eval-ast \"R = http_server:artifact_response_for(<<99,100>>, cbor), case R of [_, _, {body, B}] -> B =:= <<99,100>>; _ -> false end\") :name)")
+(epoch 18)
+(eval "(get (erlang-eval-ast \"R = http_server:projection_response_for(<<101>>, cbor), case R of [_, _, {body, B}] -> B =:= <<101>>; _ -> false end\") :name)")
+
+;; End-to-end: GET /actors/a with Accept: application/json returns json body
+(epoch 19)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97>>}, {headers, [{AK, JsonAV}]}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= <<123,34,97,99,116,111,114,34,58,34,97,34,125,10>>; _ -> false end\") :name)")
+
+;; End-to-end: GET /artifacts/X with Accept: application/sx returns sx body
+(epoch 20)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<71,69,84>>}, {path, <<(http_server:artifacts_prefix())/binary, 120>>}, {headers, [{AK, SxAV}]}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= <<40,97,114,116,105,102,97,99,116,32,34,120,34,41,10>>; _ -> false end\") :name)")
+
+;; End-to-end: GET /projections with Accept: application/json returns json list body
+(epoch 21)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<71,69,84>>}, {path, http_server:projections_list_path()}, {headers, [{AK, JsonAV}]}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= <<123,34,112,114,111,106,101,99,116,105,111,110,115,34,58,91,93,125,10>>; _ -> false end\") :name)")
+
+;; End-to-end: Content-Type matches for actor GET with json Accept
+(epoch 22)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97>>}, {headers, [{AK, JsonAV}]}], R = http_server:route(Req), case R of [_, {headers, [{_, CT}]}, _] -> CT =:= http_server:content_type_for(json); _ -> false end\") :name)")
+
+;; GET without Accept still returns the text body (no Content-Type header)
+(epoch 23)
+(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97>>}], R = http_server:route(Req), R =:= http_server:actor_doc_response(<<97>>)\") :name)")
+
+;; activity_json shares body with json for actor
+(epoch 24)
+(eval "(get (erlang-eval-ast \"[_, _, {body, BJ}] = http_server:actor_doc_response_for(<<122>>, json), [_, _, {body, BAJ}] = http_server:actor_doc_response_for(<<122>>, activity_json), BJ =:= BAJ\") :name)")
+
+;; Unknown format falls back to text
+(epoch 25)
+(eval "(get (erlang-eval-ast \"http_server:projection_response_for(<<97>>, weird) =:= http_server:projection_response(<<97>>)\") :name)")
+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  2  "module load name"                  "http_server"
+check 10  "actor text preserves"              "true"
+check 11  "actor json body"                   "true"
+check 12  "artifact sx body"                  "true"
+check 13  "projection json body"              "true"
+check 14  "projections list json body"        "true"
+check 15  "projections list sx body"          "true"
+check 16  "actor cbor body = id"              "true"
+check 17  "artifact cbor body = cid"          "true"
+check 18  "projection cbor body = name"       "true"
+check 19  "E2E GET actor with json Accept"    "true"
+check 20  "E2E GET artifact with sx Accept"   "true"
+check 21  "E2E GET projections with json"     "true"
+check 22  "E2E actor json CT"                 "true"
+check 23  "no Accept -> text shape"           "true"
+check 24  "activity_json body == json body"   "true"
+check 25  "unknown -> text"                   "true"
+
+TOTAL=$((PASS+FAIL))
+if [ $FAIL -eq 0 ]; then
+  echo "ok $PASS/$TOTAL next/tests/http_get_format.sh passed"
+else
+  echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
+  echo "$ERRORS"
+fi
+[ $FAIL -eq 0 ]