fed-sx-m1: Step 6c-schema-pure — pipeline:stage_schema/1,/2 with SchemaLookup callback + 14 tests

next/tests/pipeline_schema.sh

@@ -0,0 +1,137 @@
+#!/usr/bin/env bash
+# next/tests/pipeline_schema.sh — Step 6c-schema-pure test.
+#
+# Exercises stage_schema/2 (direct call) and stage_schema/1
+# (factory). The SchemaLookup callback returns either
+# {ok, SchemaFn} or not_found; open-world default means
+# not_found resolves to ok. 12 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: a strict Pin schema requires Object to have :path and :cid
+# `PinSchema = fun (Obj) -> ...`.
+PRELUDE='PinSchema = fun (Obj) -> case envelope:get_field(path, Obj) of {ok, _} -> case envelope:get_field(cid, Obj) of {ok, _} -> true; _ -> false end; _ -> false end end, PinLookup = fun (pin) -> {ok, PinSchema}; (_) -> not_found end,'
+
+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/envelope.erl\")) :name)")
+(epoch 3)
+(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
+
+;; Open-world default: unknown type returns ok
+(epoch 10)
+(eval "(get (erlang-eval-ast \"NoLookup = fun (_) -> not_found end, pipeline:stage_schema([{type, foo}, {object, bar}], NoLookup) =:= ok\") :name)")
+
+;; Activity without :type -> {error, no_type}
+(epoch 11)
+(eval "(get (erlang-eval-ast \"NoLookup = fun (_) -> not_found end, pipeline:stage_schema([{object, x}], NoLookup) =:= {error, no_type}\") :name)")
+
+;; Known type, schema passes -> ok
+(epoch 12)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Act = [{type, pin}, {object, [{path, <<47,97>>}, {cid, <<98>>}]}], pipeline:stage_schema(Act, PinLookup) =:= ok\") :name)")
+
+;; Known type, schema fails -> {error, schema_mismatch}
+(epoch 13)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Act = [{type, pin}, {object, [{path, <<47,97>>}]}], pipeline:stage_schema(Act, PinLookup) =:= {error, schema_mismatch}\") :name)")
+
+;; Activity with no :object skips schema check
+(epoch 14)
+(eval "(get (erlang-eval-ast \"${PRELUDE} pipeline:stage_schema([{type, pin}], PinLookup) =:= ok\") :name)")
+
+;; stage_schema/1 returns a function
+(epoch 15)
+(eval "(get (erlang-eval-ast \"is_function(pipeline:stage_schema(fun (_) -> not_found end))\") :name)")
+
+;; Factory + activity -> applies the lookup
+(epoch 16)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Stage = pipeline:stage_schema(PinLookup), Stage([{type, pin}, {object, [{path, <<1>>}, {cid, <<2>>}]}]) =:= ok\") :name)")
+
+;; Factory + bad activity -> schema_mismatch
+(epoch 17)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Stage = pipeline:stage_schema(PinLookup), Stage([{type, pin}, {object, [{path, <<1>>}]}]) =:= {error, schema_mismatch}\") :name)")
+
+;; Composed with stage_envelope via run_stages: bad envelope halts first
+(epoch 18)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Stages = [fun (A) -> pipeline:stage_envelope(A) end, pipeline:stage_schema(PinLookup)], case pipeline:run_stages([{type, pin}], Stages) of {error, {missing_field, _}} -> ok; _ -> bad end\") :name)")
+
+;; Composed: envelope ok + schema fail -> schema_mismatch
+(epoch 19)
+(eval "(get (erlang-eval-ast \"${PRELUDE} Act = [{id, 1}, {type, pin}, {actor, alice}, {published, 1}, {signature, [{key_id, k}, {algorithm, e}, {value, v}]}, {object, [{path, <<1>>}]}], Stages = [fun (A) -> pipeline:stage_envelope(A) end, pipeline:stage_schema(PinLookup)], pipeline:run_stages(Act, Stages) =:= {error, schema_mismatch}\") :name)")
+
+;; Schema fn receives the object (verify by mutating an Erlang process flag isn't reliable; instead capture & test inside the schema)
+(epoch 20)
+(eval "(get (erlang-eval-ast \"Captor = fun (Obj) -> envelope:get_field(target, Obj) =:= {ok, mark} end, Lookup = fun (_) -> {ok, Captor} end, pipeline:stage_schema([{type, t}, {object, [{target, mark}]}], Lookup) =:= ok\") :name)")
+
+;; Multiple types registered: only matching one consulted
+(epoch 21)
+(eval "(get (erlang-eval-ast \"PinF = fun (_) -> true end, NoteF = fun (_) -> false end, Multi = fun (pin) -> {ok, PinF}; (note) -> {ok, NoteF}; (_) -> not_found end, {pipeline:stage_schema([{type, pin}, {object, ignored}], Multi), pipeline:stage_schema([{type, note}, {object, ignored}], Multi), pipeline:stage_schema([{type, other}, {object, ignored}], Multi)} =:= {ok, {error, schema_mismatch}, ok}\") :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  "envelope module loaded"             "envelope"
+check  3  "pipeline module loaded"             "pipeline"
+check 10  "open-world default for unknown"     "true"
+check 11  "no :type -> no_type error"          "true"
+check 12  "schema accepts -> ok"               "true"
+check 13  "schema rejects -> mismatch"         "true"
+check 14  "no :object skips check"             "true"
+check 15  "stage_schema/1 returns fun"         "true"
+check 16  "factory + ok"                       "true"
+check 17  "factory + mismatch"                 "true"
+check 18  "envelope halt before schema"        "ok"
+check 19  "envelope ok + schema mismatch"      "true"
+check 20  "schema fn receives object"          "true"
+check 21  "multi-type lookup dispatches"       "true"
+
+TOTAL=$((PASS+FAIL))
+if [ $FAIL -eq 0 ]; then
+  echo "ok $PASS/$TOTAL next/tests/pipeline_schema.sh passed"
+else
+  echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
+  echo "$ERRORS"
+fi
+[ $FAIL -eq 0 ]