fed-sx-types Phase 1: DefineType + SubtypeOf genesis verbs

Two new DefineActivity-form genesis activity-types for host-type federation (plans/fed-sx-host-types.md step 1): - next/genesis/activity-types/define_type.sx — DefineType verb; schema accepts an :object with a string :name and optional list :fields. - next/genesis/activity-types/subtype_of.sx — SubtypeOf verb; schema accepts an :object carrying string :child-type-cid + :parent-type-cid. Schema bodies use nested `get` (not keyword-threading) so they are directly evaluatable — keywords are not callable getters in the kernel. Both registered in manifest.sx (activity-types now 7); the four bootstrap suites' bundle counts bumped (5->7, total 36->38). Tests: next/tests/define_type.sh (7), subtype_of.sh (6) — parse shape, schema accept/reject, term_codec envelope round-trip. Also load follower_graph + delivery in bootstrap_start.sh: its check-26 publish path exercises outbox:compute_delivery_set/3 (follower_graph:new + delivery:delivery_set), which an m2 substrate change had left unloaded in that suite — a pre-existing red unrelated to the count bump. Conformance 771/771; all touched next/tests green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 15:30:21 +00:00
parent 4da2a98c30
commit 5959a97dca
11 changed files with 413 additions and 9 deletions
--- a/next/tests/bootstrap_load.sh
+++ b/next/tests/bootstrap_load.sh
@@ -106,7 +106,7 @@ check 10  "strip suffix create.sx -> create"    "true"
 check 11  "strip suffix hello unchanged"        "true"
 check 12  "strip suffix .sx -> empty"           "true"
 check 13  "load_genesis rejects bad shape"      "ok"
-check 20  "loaded activity_types count = 5"     "5"
+check 20  "loaded activity_types count = 7"     "7"
 check 21  "loaded object_types count = 13"      "13"
 check 22  "loaded projections count = 7"        "7"
 check 23  "loaded validators count = 3"         "3"
--- a/next/tests/bootstrap_populate.sh
+++ b/next/tests/bootstrap_populate.sh
@@ -99,8 +99,8 @@ check() {
 check  2  "gen_server loaded"                "gen_server"
 check  3  "registry loaded"                  "registry"
 check  4  "bootstrap loaded"                 "bootstrap"
-check 10  "populate returns total 36"        "36"
-check 20  "activity_types count = 5"         "5"
+check 10  "populate returns total 38"        "38"
+check 20  "activity_types count = 7"         "7"
 check 21  "object_types count = 13"          "13"
 check 22  "projections count = 7"            "7"
 check 23  "validators count = 3"             "3"
--- a/next/tests/bootstrap_read.sh
+++ b/next/tests/bootstrap_read.sh
@@ -102,7 +102,7 @@ check 10  "sections/0 length"               "7"
 check 11  "ends_with_sx create.sx"          "true"
 check 12  "ends_with_sx hello"              "false"
 check 13  "ends_with_sx empty"              "false"
-check 20  "section activity_types count"    "5"
+check 20  "section activity_types count"    "7"
 check 21  "section object_types count"      "13"
 check 22  "section projections count"       "7"
 check 23  "section validators count"        "3"
@@ -111,7 +111,7 @@ check 25  "section sig_suites count"        "2"
 check 26  "section audience count"          "3"
 check 30  "read_genesis returns 7 sections" "7"
 check 31  "first section name"              "activity_types"
-check 32  "first section entry count"       "5"
+check 32  "first section entry count"       "7"

 TOTAL=$((PASS+FAIL))
 if [ $FAIL -eq 0 ]; then
--- a/next/tests/bootstrap_start.sh
+++ b/next/tests/bootstrap_start.sh
@@ -54,6 +54,12 @@ cat > "$TMPFILE" <<EPOCHS
 (eval "(get (erlang-load-module (file-read \"next/kernel/nx_kernel.erl\")) :name)")
 (epoch 10)
 (eval "(get (erlang-load-module (file-read \"next/kernel/bootstrap.erl\")) :name)")
+;; outbox:publish computes a delivery set via follower_graph + delivery
+;; (compute_delivery_set/3) — load both so the publish path resolves.
+(epoch 11)
+(eval "(get (erlang-load-module (file-read \"next/kernel/follower_graph.erl\")) :name)")
+(epoch 12)
+(eval "(get (erlang-load-module (file-read \"next/kernel/delivery.erl\")) :name)")

 ;; bootstrap:start returns a Pid
 (epoch 20)
@@ -115,10 +121,10 @@ check() {

 check 10  "bootstrap module loaded"           "bootstrap"
 check 20  "whereis(nx_kernel) is Pid"         "true"
-check 21  "activity_types count = 5"          "5"
+check 21  "activity_types count = 7"          "7"
 check 22  "object_types count = 13"           "13"
 check 23  "projections count = 7"             "7"
-check 24  "total entries = 36"                "36"
+check 24  "total entries = 38"                "38"
 check 25  "fresh log_tip = 0"                 "0"
 check 26  "publish advances tip to 1"         "1"
 check 27  "actor_id = alice"                  "true"
--- a/next/tests/define_type.sh
+++ b/next/tests/define_type.sh
@@ -0,0 +1,110 @@
+#!/usr/bin/env bash
+# next/tests/define_type.sh — host-type federation Phase 1 acceptance.
+#
+# The DefineType genesis verb (next/genesis/activity-types/define_type.sx)
+# declares a refinement type. This suite confirms:
+#   - the file parses with the expected DefineActivity head + :name
+#   - the :schema predicate accepts a well-formed type-definition
+#     activity and rejects malformed ones (missing :name, non-list
+#     :fields)
+#   - a DefineType envelope round-trips through term_codec
+#
+# Schema bodies are SX source; we eval them with `eval-expr` and call
+# the resulting lambda directly (note: `apply` does not spread into
+# SX lambdas in this kernel, and keyword-getters are not callable —
+# the schema uses nested `get`). 7 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
+
+# The schema fn, evaluated from the genesis file into a lambda.
+SCH='(eval-expr (get (apply dict (rest (parse (file-read \"next/genesis/activity-types/define_type.sx\")))) :schema))'
+
+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/term_codec.erl\")) :name)")
+
+;; ── parse / shape ──────────────────────────────────────────
+(epoch 10)
+(eval "(first (parse (file-read \"next/genesis/activity-types/define_type.sx\")))")
+(epoch 11)
+(eval "(get (apply dict (rest (parse (file-read \"next/genesis/activity-types/define_type.sx\")))) :name)")
+
+;; ── schema accept / reject ─────────────────────────────────
+;; valid: :object with string :name and list :fields -> true
+(epoch 20)
+(eval "(define sch ${SCH}) (sch (dict :object (dict :name \"Post\" :fields (list))))")
+;; valid: :fields omitted (optional) -> true
+(epoch 21)
+(eval "(define sch ${SCH}) (sch (dict :object (dict :name \"Post\")))")
+;; reject: missing :name -> false
+(epoch 22)
+(eval "(define sch ${SCH}) (sch (dict :object (dict :fields (list))))")
+;; reject: :fields present but not a list -> false
+(epoch 23)
+(eval "(define sch ${SCH}) (sch (dict :object (dict :name \"Post\" :fields \"notalist\")))")
+
+;; ── envelope round-trip through term_codec ─────────────────
+(epoch 30)
+(eval "(get (erlang-eval-ast \"A = [{type, define_type}, {actor, alice}, {object, [{name, <<80,111,115,116>>}, {instance_type, <<78,111,116,101>>}]}], {ok, D, _} = term_codec:decode(term_codec:encode(A)), D =:= A\") :name)")
+EPOCHS
+
+OUTPUT=$(timeout 180 "$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 "define_type.sx head form"        "DefineActivity"
+check 11 "define_type.sx name"             "DefineType"
+check 20 "schema accepts valid type def"   "true"
+check 21 "schema accepts omitted :fields"  "true"
+check 22 "schema rejects missing :name"    "false"
+check 23 "schema rejects non-list :fields" "false"
+check 30 "DefineType envelope round-trips" "true"
+
+TOTAL=$((PASS+FAIL))
+if [ $FAIL -eq 0 ]; then
+  echo "ok $PASS/$TOTAL next/tests/define_type.sh passed"
+else
+  echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
+  echo "$ERRORS"
+fi
+[ $FAIL -eq 0 ]
--- a/next/tests/genesis_parse.sh
+++ b/next/tests/genesis_parse.sh
@@ -48,6 +48,14 @@ cat > "$TMPFILE" <<'EPOCHS'
 (eval "(first (parse (file-read \"next/genesis/activity-types/endorse.sx\")))")
 (epoch 200)
 (eval "(get (apply dict (rest (parse (file-read \"next/genesis/activity-types/endorse.sx\")))) :name)")
+(epoch 201)
+(eval "(first (parse (file-read \"next/genesis/activity-types/define_type.sx\")))")
+(epoch 202)
+(eval "(get (apply dict (rest (parse (file-read \"next/genesis/activity-types/define_type.sx\")))) :name)")
+(epoch 203)
+(eval "(first (parse (file-read \"next/genesis/activity-types/subtype_of.sx\")))")
+(epoch 204)
+(eval "(get (apply dict (rest (parse (file-read \"next/genesis/activity-types/subtype_of.sx\")))) :name)")
 (epoch 19)
 (eval "(len (get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :activity-types))")
 (epoch 30)
@@ -180,7 +188,11 @@ check 27 "announce.sx head form"        "DefineActivity"
 check 28 "announce.sx name is Announce" "Announce"
 check 29 "endorse.sx head form"         "DefineActivity"
 check 200 "endorse.sx name is Endorse"  "Endorse"
-check 19 "manifest has 5 activity-types" "5"
+check 201 "define_type.sx head form"    "DefineActivity"
+check 202 "define_type.sx name"         "DefineType"
+check 203 "subtype_of.sx head form"     "DefineActivity"
+check 204 "subtype_of.sx name"          "SubtypeOf"
+check 19 "manifest has 7 activity-types" "7"
 check 30 "sx-artifact.sx head form"     "DefineObject"
 check 31 "sx-artifact.sx name"          "SXArtifact"
 check 32 "note.sx name"                 "Note"
--- a/next/tests/subtype_of.sh
+++ b/next/tests/subtype_of.sh
@@ -0,0 +1,103 @@
+#!/usr/bin/env bash
+# next/tests/subtype_of.sh — host-type federation Phase 1 acceptance.
+#
+# The SubtypeOf genesis verb (next/genesis/activity-types/subtype_of.sx)
+# records a hierarchy edge between two previously-defined types. This
+# suite confirms:
+#   - the file parses with the expected DefineActivity head + :name
+#   - the :schema predicate accepts an edge carrying both CIDs and
+#     rejects edges missing either side
+#   - a SubtypeOf envelope round-trips through term_codec
+#
+# Schema bodies are SX source; we eval them with `eval-expr` and call
+# the resulting lambda directly. 7 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
+
+SCH='(eval-expr (get (apply dict (rest (parse (file-read \"next/genesis/activity-types/subtype_of.sx\")))) :schema))'
+
+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/term_codec.erl\")) :name)")
+
+;; ── parse / shape ──────────────────────────────────────────
+(epoch 10)
+(eval "(first (parse (file-read \"next/genesis/activity-types/subtype_of.sx\")))")
+(epoch 11)
+(eval "(get (apply dict (rest (parse (file-read \"next/genesis/activity-types/subtype_of.sx\")))) :name)")
+
+;; ── schema accept / reject ─────────────────────────────────
+;; valid: both CIDs present + strings -> true
+(epoch 20)
+(eval "(define sch ${SCH}) (sch (dict :object (dict :child-type-cid \"bafyChild\" :parent-type-cid \"bafyParent\")))")
+;; reject: missing :child-type-cid -> false
+(epoch 21)
+(eval "(define sch ${SCH}) (sch (dict :object (dict :parent-type-cid \"bafyParent\")))")
+;; reject: missing :parent-type-cid -> false
+(epoch 22)
+(eval "(define sch ${SCH}) (sch (dict :object (dict :child-type-cid \"bafyChild\")))")
+
+;; ── envelope round-trip through term_codec ─────────────────
+(epoch 30)
+(eval "(get (erlang-eval-ast \"A = [{type, subtype_of}, {actor, alice}, {object, [{child_type_cid, <<99,104>>}, {parent_type_cid, <<112,97>>}]}], {ok, D, _} = term_codec:decode(term_codec:encode(A)), D =:= A\") :name)")
+EPOCHS
+
+OUTPUT=$(timeout 180 "$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 "subtype_of.sx head form"          "DefineActivity"
+check 11 "subtype_of.sx name"               "SubtypeOf"
+check 20 "schema accepts edge with 2 CIDs"  "true"
+check 21 "schema rejects missing child CID" "false"
+check 22 "schema rejects missing parent CID" "false"
+check 30 "SubtypeOf envelope round-trips"   "true"
+
+TOTAL=$((PASS+FAIL))
+if [ $FAIL -eq 0 ]; then
+  echo "ok $PASS/$TOTAL next/tests/subtype_of.sh passed"
+else
+  echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
+  echo "$ERRORS"
+fi
+[ $FAIL -eq 0 ]