identity: session-as-process — create/lookup/expire/revoke + idle timeout (11 tests)

Session is an Erlang process holding {subject, client, status}. lookup/ touch/expire/revoke are messages; expiry is the process's own `receive ... after Ttl` timeout (RFC-agnostic; no global sweep), which notifies the owner and tombstones. Tombstoned sessions answer lookups with an explicit {error, expired|revoked}, never a silent dead mailbox. Adds the conformance harness + scoreboard. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 23:45:50 +00:00
parent d446562ed1
commit 1c6b80404e
6 changed files with 284 additions and 3 deletions
--- a/lib/identity/conformance.sh
+++ b/lib/identity/conformance.sh
@@ -0,0 +1,120 @@
+#!/usr/bin/env bash
+# identity-on-sx conformance runner.
+#
+# Loads the Erlang-on-SX substrate, the identity library, and every
+# identity test suite via the epoch protocol, collects pass/fail counts,
+# and writes lib/identity/scoreboard.json + .md.
+#
+# Usage:
+#   bash lib/identity/conformance.sh        # run all suites
+#   bash lib/identity/conformance.sh -v     # verbose per-suite
+
+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:-}"
+TMPFILE=$(mktemp)
+OUTFILE=$(mktemp)
+trap "rm -f $TMPFILE $OUTFILE" EXIT
+
+# Each suite: name | counter pass | counter total
+SUITES=(
+  "session|id-session-test-pass|id-session-test-count"
+)
+
+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/identity/session.sx")
+(load "lib/identity/tests/session.sx")
+(epoch 100)
+(eval "(list id-session-test-pass id-session-test-count)")
+EPOCHS
+
+timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
+
+parse_pair() {
+  local epoch="$1"
+  local line
+  line=$(grep -A1 "^(ok-len $epoch " "$OUTFILE" | tail -1)
+  echo "$line" | sed -E 's/[()]//g'
+}
+
+TOTAL_PASS=0
+TOTAL_COUNT=0
+JSON_SUITES=""
+MD_ROWS=""
+
+idx=0
+for entry in "${SUITES[@]}"; do
+  name="${entry%%|*}"
+  epoch=$((100 + idx))
+  pair=$(parse_pair "$epoch")
+  pass=$(echo "$pair" | awk '{print $1}')
+  count=$(echo "$pair" | awk '{print $2}')
+  if [ -z "$pass" ] || [ -z "$count" ]; then
+    pass=0
+    count=0
+  fi
+  TOTAL_PASS=$((TOTAL_PASS + pass))
+  TOTAL_COUNT=$((TOTAL_COUNT + count))
+  status="ok"
+  marker="✅"
+  if [ "$pass" != "$count" ]; then
+    status="fail"
+    marker="❌"
+  fi
+  if [ "$VERBOSE" = "-v" ]; then
+    printf "  %-12s %s/%s\n" "$name" "$pass" "$count"
+  fi
+  if [ -n "$JSON_SUITES" ]; then JSON_SUITES+=","; fi
+  JSON_SUITES+=$'\n    '
+  JSON_SUITES+="{\"name\":\"$name\",\"pass\":$pass,\"total\":$count,\"status\":\"$status\"}"
+  MD_ROWS+="| $marker | $name | $pass | $count |"$'\n'
+  idx=$((idx + 1))
+done
+
+printf '\nidentity-on-sx conformance: %d / %d\n' "$TOTAL_PASS" "$TOTAL_COUNT"
+
+cat > lib/identity/scoreboard.json <<JSON
+{
+  "language": "identity",
+  "total_pass": $TOTAL_PASS,
+  "total": $TOTAL_COUNT,
+  "suites": [$JSON_SUITES
+  ]
+}
+JSON
+
+cat > lib/identity/scoreboard.md <<MD
+# identity-on-sx Scoreboard
+
+**Total: ${TOTAL_PASS} / ${TOTAL_COUNT} tests passing**
+
+|  | Suite | Pass | Total |
+|---|---|---|---|
+$MD_ROWS
+
+Generated by \`lib/identity/conformance.sh\`.
+MD
+
+if [ "$TOTAL_PASS" -eq "$TOTAL_COUNT" ]; then
+  exit 0
+else
+  exit 1
+fi
--- a/lib/identity/scoreboard.json
+++ b/lib/identity/scoreboard.json
@@ -0,0 +1,8 @@
+{
+  "language": "identity",
+  "total_pass": 11,
+  "total": 11,
+  "suites": [
+    {"name":"session","pass":11,"total":11,"status":"ok"}
+  ]
+}
--- a/lib/identity/scoreboard.md
+++ b/lib/identity/scoreboard.md
@@ -0,0 +1,10 @@
+# identity-on-sx Scoreboard
+
+**Total: 11 / 11 tests passing**
+
+|  | Suite | Pass | Total |
+|---|---|---|---|
+| ✅ | session | 11 | 11 |
+
+
+Generated by `lib/identity/conformance.sh`.
--- a/lib/identity/session.sx
+++ b/lib/identity/session.sx
@@ -0,0 +1,20 @@
+;; identity/session.sx — a session is an Erlang process.
+;;
+;; create  = spawn a session process holding {subject, client, status}
+;; lookup  = a message; the live process answers {ok, ...} or {error, S}
+;; expire  = explicit message OR an idle timeout the process arms itself
+;; revoke  = explicit message; the grant tombstones immediately
+;;
+;; Expiry is the process's own `receive ... after Ttl` timeout, never a
+;; global sweep. On timeout the process notifies its Owner and becomes a
+;; tombstone that still answers lookups — with {error, expired}, never a
+;; silent dead mailbox. A revoked or expired session is an explicit
+;; negative state, not the absence of a positive one.
+
+(define
+  identity-session-source
+  "-module(identity_session).\n\n   start(SessionId, Subject, Client, Owner, Ttl) ->\n     spawn(fun () -> active(SessionId, Subject, Client, Owner, Ttl) end).\n\n   lookup(Pid) ->\n     Pid ! {lookup, self()},\n     receive {session_reply, R} -> R end.\n\n   touch(Pid) ->\n     Pid ! {touch, self()},\n     receive {session_reply, R} -> R end.\n\n   expire(Pid) ->\n     Pid ! {expire, self()},\n     receive {session_reply, R} -> R end.\n\n   revoke(Pid) ->\n     Pid ! {revoke, self()},\n     receive {session_reply, R} -> R end.\n\n   stop(Pid) ->\n     Pid ! {stop, self()},\n     receive {session_reply, R} -> R end.\n\n   active(SessionId, Subject, Client, Owner, Ttl) ->\n     receive\n       {lookup, From} ->\n         From ! {session_reply, {ok, {SessionId, Subject, Client, active}}},\n         active(SessionId, Subject, Client, Owner, Ttl);\n       {touch, From} ->\n         From ! {session_reply, ok},\n         active(SessionId, Subject, Client, Owner, Ttl);\n       {expire, From} ->\n         From ! {session_reply, ok},\n         tombstone(SessionId, Subject, Client, expired);\n       {revoke, From} ->\n         From ! {session_reply, ok},\n         tombstone(SessionId, Subject, Client, revoked);\n       {stop, From} ->\n         From ! {session_reply, ok}\n     after Ttl ->\n       Owner ! {session_expired, SessionId},\n       tombstone(SessionId, Subject, Client, expired)\n     end.\n\n   tombstone(SessionId, Subject, Client, Status) ->\n     receive\n       {lookup, From} ->\n         From ! {session_reply, {error, Status}},\n         tombstone(SessionId, Subject, Client, Status);\n       {touch, From} ->\n         From ! {session_reply, {error, Status}},\n         tombstone(SessionId, Subject, Client, Status);\n       {expire, From} ->\n         From ! {session_reply, ok},\n         tombstone(SessionId, Subject, Client, Status);\n       {revoke, From} ->\n         From ! {session_reply, ok},\n         tombstone(SessionId, Subject, Client, revoked);\n       {stop, From} ->\n         From ! {session_reply, ok}\n     end.")
+
+(define
+  identity-load-session!
+  (fn () (erlang-load-module identity-session-source)))
--- a/lib/identity/tests/session.sx
+++ b/lib/identity/tests/session.sx
@@ -0,0 +1,118 @@
+;; identity/tests/session.sx — session-as-process: create, lookup,
+;; touch, explicit expire, revoke, and idle-timeout self-expiry.
+;; Negative paths are tested as first-class: a tombstoned session
+;; answers {error, Status}, it does not go silent.
+
+(define id-session-test-count 0)
+(define id-session-test-pass 0)
+(define id-session-test-fails (list))
+
+(define
+  id-session-test
+  (fn
+    (name actual expected)
+    (set! id-session-test-count (+ id-session-test-count 1))
+    (if
+      (= actual expected)
+      (set! id-session-test-pass (+ id-session-test-pass 1))
+      (append! id-session-test-fails {:name name :expected expected :actual actual}))))
+
+(define id-ev erlang-eval-ast)
+(define idnm (fn (v) (get v :name)))
+
+(identity-load-session!)
+
+;; ── create + lookup ──────────────────────────────────────────────
+
+(id-session-test
+  "lookup of live session is active"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, infinity),\n       case identity_session:lookup(S) of {ok, {_,_,_,St}} -> St end"))
+  "active")
+
+(id-session-test
+  "lookup preserves subject"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, infinity),\n       case identity_session:lookup(S) of {ok, {_,Subject,_,_}} -> Subject end"))
+  "alice")
+
+(id-session-test
+  "lookup preserves client"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, infinity),\n       case identity_session:lookup(S) of {ok, {_,_,Client,_}} -> Client end"))
+  "web")
+
+;; ── touch keeps a live session ───────────────────────────────────
+
+(id-session-test
+  "touch on live session is ok"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, infinity),\n       identity_session:touch(S)"))
+  "ok")
+
+;; ── explicit expire ──────────────────────────────────────────────
+
+(id-session-test
+  "expire then lookup is error expired"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, infinity),\n       identity_session:expire(S),\n       case identity_session:lookup(S) of {error, St} -> St end"))
+  "expired")
+
+(id-session-test
+  "touch on expired session is error"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, infinity),\n       identity_session:expire(S),\n       case identity_session:touch(S) of {error, St} -> St end"))
+  "expired")
+
+;; ── revoke is immediate ──────────────────────────────────────────
+
+(id-session-test
+  "revoke then lookup is error revoked"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, infinity),\n       identity_session:revoke(S),\n       case identity_session:lookup(S) of {error, St} -> St end"))
+  "revoked")
+
+;; ── idle-timeout self-expiry ─────────────────────────────────────
+
+(id-session-test
+  "idle timeout notifies owner"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, 50),\n       _ = identity_session:lookup(S),\n       receive {session_expired, Sid} -> Sid end"))
+  "s1")
+
+(id-session-test
+  "lookup after idle timeout is error expired"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, 50),\n       _ = identity_session:lookup(S),\n       receive {session_expired, _} -> ok end,\n       case identity_session:lookup(S) of {error, St} -> St end"))
+  "expired")
+
+;; ── isolation: sessions are independent processes ────────────────
+
+(id-session-test
+  "expiring one session leaves the other active"
+  (idnm
+    (id-ev
+      "Me = self(),\n       A = identity_session:start(s1, alice, web, Me, infinity),\n       B = identity_session:start(s2, bob, web, Me, infinity),\n       identity_session:expire(A),\n       case identity_session:lookup(B) of {ok, {_,_,_,St}} -> St end"))
+  "active")
+
+;; ── clean stop ───────────────────────────────────────────────────
+
+(id-session-test
+  "stop returns ok"
+  (idnm
+    (id-ev
+      "Me = self(),\n       S = identity_session:start(s1, alice, web, Me, infinity),\n       identity_session:stop(S)"))
+  "ok")
+
+(define
+  id-session-test-summary
+  (str "session " id-session-test-pass "/" id-session-test-count))