Compare commits

..

17 Commits

Author SHA1 Message Date
2d20f41498 erlang: fold lists/proplists BIFs into transpile.sx + runtime.sx (completes 27dedf9b)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m9s
27dedf9b deleted lists-ext.sx but a botched git-add left the actual
fold-in unstaged, so HEAD briefly referenced functions that weren't
registered. This commit lands them:

- transpile.sx: function bodies appended next to existing er-bif-lists-*
- runtime.sx: registrations inside er-register-builtin-bifs!
- conformance.sh: drop the lists-ext.sx load; keep the lists_ext suite

Conformance 874/874 (verified on the combined tree before push).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 15:04:22 +00:00
27dedf9b0a erlang: retire lists-ext.sx — fold lists/proplists BIFs into transpile.sx + runtime.sx (874/874)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m3s
The stdlib BIFs lived in a standalone lib/erlang/lists-ext.sx (a
workaround for this worktree's broken sx-tree write tools). Fold them
into the canonical files so every erlang consumer gets them, not just
the conformance harness:

- transpile.sx: function bodies appended next to existing er-bif-lists-*
- runtime.sx: registrations moved directly inside er-register-builtin-bifs!
  (the reset-survival wrapper is no longer needed)
- conformance.sh: drop the lists-ext.sx load; keep the lists_ext suite
- delete lib/erlang/lists-ext.sx

Byte-exact splice, sx_validate clean, conformance 874/874 unchanged.
Mirrors the architecture fold-in (39dbb00c).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 15:03:33 +00:00
3d8607a40a erlang: proplists module (get_value/get_all_values/is_defined/lookup/delete) (874/874)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
proplists BIFs in lib/erlang/lists-ext.sx (now lists + proplists).
Bare-atom shorthand {A,true}, first-match lookups, get_value default
undefined, lookup -> tuple | none. lists_ext suite 91 -> 103.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 14:00:13 +00:00
394d5790ad erlang: lists flatmap/2 + filtermap/2 + mapfoldl/3 + search/2 (862/862)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
Higher-order list ops in lib/erlang/lists-ext.sx. filtermap honours
true/false/{true,V}; mapfoldl returns {Mapped, Acc}; search returns
{value,E}|false. lists_ext suite 83 -> 91.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 13:55:57 +00:00
d2c1400737 erlang: lists sublist/2,3 + nthtail/2 + split/2 + droplast/1 (854/854)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
Slicing family in lib/erlang/lists-ext.sx. sublist lenient; nthtail
and split strict (badarg when list shorter than N); droplast raises
on []. lists_ext suite 70 -> 83.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 13:51:49 +00:00
5a1412515a erlang: lists zip/2 + zipwith/3 + unzip/1 (841/841)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
Zip family in lib/erlang/lists-ext.sx; length mismatch and malformed
pairs raise badarg. lists_ext suite 62 -> 70.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 13:46:46 +00:00
3ae35a4b9b erlang: lists flatten/1 + max/1 + min/1 (833/833)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
Structural/aggregate ops in lib/erlang/lists-ext.sx: flatten/1 deep
flatten, max/1 and min/1 by full Erlang term order (badarg on empty).
Extreme-finder uses er-ext-lt?'s SX boolean directly in if (er-truthy?
only recognises Erlang bool atoms). lists_ext suite 52 -> 62.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 13:41:15 +00:00
42a16f7cf3 erlang: lists foldr/3 + partition/2 + takewhile/dropwhile/splitwith (823/823)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m5s
Higher-order traversal family in lib/erlang/lists-ext.sx, registered
pure via the er-register-builtin-bifs! wrapper. foldr right-folds;
partition returns {Yes,No} order-preserved; splitwith = {takewhile,
dropwhile}. lists_ext suite 38 -> 52.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 13:34:44 +00:00
343c508939 erlang: lists keylist BIFs (keyfind/keymember/keydelete/keyreplace/keystore/keytake/keysort) (809/809)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m3s
Adds the tuple-keyed list family to lib/erlang/lists-ext.sx: act on
first match, key compare via == (er-equal?), non-tuples/short tuples
pass through. keysort/2 reuses the stable merge sort + full term
order. keytake/3 returns {value, Tuple, Rest} | false. All seven
registered through the er-register-builtin-bifs! wrapper so they
survive mid-run registry resets. lists_ext suite 17 -> 38.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 13:28:57 +00:00
355a482dfe erlang: lists:sort/1,2 + lists:usort/1 with full term order (lists_ext suite, 788/788)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m6s
New lib/erlang/lists-ext.sx (loaded after runtime.sx): stable merge
sort over an SX-list bridge. sort/1 and usort/1 use full Erlang term
order via a self-contained er-ext-lt? (deep tuple/list compare that
the shared er-lt? lacks); sort/2 takes a fun(A,B)->bool comparator.

Registration wraps er-register-builtin-bifs! so the BIFs survive the
mid-run registry resets done by tests/runtime.sx.

Roadmap is saturated within this loop's scope; this is forever-loop
stdlib hardening. New file forced by the broken sx-tree write tools
in this worktree (see Blockers) — authored via Write + sx_validate.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-30 13:19:00 +00:00
b10e55f04f erlang: send_after to registered name + gen_server timeout returns (T5+T6, 771/771)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
T5 — send_after addresses a registered atom name; the delayed message
lands in that process's mailbox (destination resolved at fire time,
dead/unregistered targets drop silently).

T6 — gen_server loop now handles the {reply,R,S,T} / {noreply,S,T}
timeout-bearing callback returns by scheduling {timeout} to itself via
send_after; handle_info({timeout}, S) fires when no other message
arrives first. Sanity-checks the library hookup.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-28 17:53:08 +00:00
98b0104c7b erlang: send_after deadline-ordering + cancel-of-fired tests (T3+T4, 769/769)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
T3 — concurrent timers fire in deadline order, not schedule order
(scheduler jumps the clock to the earliest pending deadline each
time the runnable queue drains). T4 — cancel_timer on an
already-fired timer returns the atom false.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-28 17:48:47 +00:00
3709460d0b erlang: erlang:send_after/3 + cancel_timer/1 + monotonic_time (T1+T2, 766/766)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m2s
Logical-clock timer wheel in the scheduler. send_after schedules a
message-delivery event at an absolute deadline (clock + Time ms);
cancel_timer marks a live timer cancelled and reports remaining ms,
or false. Time advances only when the runnable queue drains, jumping
to the earliest pending deadline (deterministic, no wall clock).

monotonic_time/0,1 exposes the logical ms clock.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-28 17:44:19 +00:00
bcabed6bce erlang: integer literals truncate to strict int (was float; broke integer->char)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
2026-06-06 08:05:57 +00:00
5098a8f015 erlang: atom_to_list/integer_to_list return Erlang charlists; list_to_* accept both (+9 net eval, 759/759) 2026-06-06 08:04:45 +00:00
9fe5c9044d erlang: $X char literals decode to char code in tokenizer (+12 eval tests, 750/750) 2026-06-06 08:03:46 +00:00
c6f397c3d9 erlang: register binary_to_list/1 + list_to_binary/1 BIFs (+9 ffi tests, 738/738) 2026-06-06 08:02:36 +00:00
158 changed files with 1187 additions and 20427 deletions

View File

@@ -39,6 +39,7 @@ SUITES=(
"ffi|er-ffi-test-pass|er-ffi-test-count"
"vm|er-vm-test-pass|er-vm-test-count"
"send_after|er-sa-test-pass|er-sa-test-count"
"lists_ext|er-lx-test-pass|er-lx-test-count"
)
cat > "$TMPFILE" << 'EPOCHS'
@@ -63,6 +64,7 @@ cat > "$TMPFILE" << 'EPOCHS'
(load "lib/erlang/tests/ffi.sx")
(load "lib/erlang/tests/vm.sx")
(load "lib/erlang/tests/send_after.sx")
(load "lib/erlang/tests/lists_ext.sx")
(epoch 100)
(eval "(list er-test-pass er-test-count)")
(epoch 101)
@@ -87,6 +89,8 @@ cat > "$TMPFILE" << 'EPOCHS'
(eval "(list er-vm-test-pass er-vm-test-count)")
(epoch 111)
(eval "(list er-sa-test-pass er-sa-test-count)")
(epoch 112)
(eval "(list er-lx-test-pass er-lx-test-count)")
EPOCHS
timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1

View File

@@ -932,10 +932,7 @@
0
(if
(= prev-k nil)
(er-apply-fun
(er-proc-field pid :initial-fun)
(let ((args (er-proc-field pid :pending-args)))
(cond (= args nil) (list) :else args)))
(er-apply-fun (er-proc-field pid :initial-fun) (list))
(do (er-proc-set! pid :continuation nil) (prev-k nil)))))
(let
((r (nth result-ref 0)))
@@ -1160,118 +1157,8 @@
(= ty "nil") (er-mk-nil)
:else v))))
;; ── HTTP request/response marshaling (Step 8b-start) ────────────
;; The native `http-listen` primitive hands the handler an SX dict
;; {:method :path :query :headers :body}
;; and expects an SX dict back
;; {:status :headers :body}
;; This layer converts so Erlang handlers see proper proplists:
;; [{method, <<"GET">>}, {path, <<"/foo">>}, {query, <<>>},
;; {headers, [{<<"content-type">>, <<"text/plain">>}, ...]},
;; {body, <<...>>}]
;; Headers ride as a nested proplist with binary keys — header names
;; are arbitrary user input, so they stay out of the atom table. The
;; outer request keys (method/path/query/headers/body) are fixed and
;; small, so they become atoms (cheap to pattern-match against).
(define er-of-sx-deep
(fn (v)
(cond
(= (type-of v) "dict") (er-dict-to-header-proplist v)
:else (er-of-sx v))))
(define er-dict-to-header-proplist
(fn (d)
(let ((ks (keys d)) (out (er-mk-nil)))
(for-each
(fn (i)
(let ((idx (- (- (len ks) 1) i)))
(let ((k (nth ks idx)))
(let ((v (get d k)))
(set!
out
(er-mk-cons
(er-mk-tuple
(list
(er-mk-binary (map char->integer (string->list k)))
(er-of-sx-deep v)))
out))))))
(range 0 (len ks)))
out)))
(define er-request-dict-to-proplist
(fn (d)
(cond
(not (= (type-of d) "dict")) (er-of-sx d)
:else
(let ((ks (keys d)) (out (er-mk-nil)))
(for-each
(fn (i)
(let ((idx (- (- (len ks) 1) i)))
(let ((k (nth ks idx)))
(let ((v (get d k)))
(set!
out
(er-mk-cons
(er-mk-tuple
(list (er-mk-atom k) (er-of-sx-deep v)))
out))))))
(range 0 (len ks)))
out))))
;; Inverse: handler's proplist response -> SX dict for native send.
;; Value rules:
;; Erlang binary -> SX string (bytes joined)
;; Erlang integer -> SX number passthrough
;; Erlang cons of 2-tuples -> nested SX dict (e.g. headers)
;; Erlang cons (other shapes) -> SX list via er-to-sx
;; anything else -> er-to-sx passthrough
(define er-proplist-2tuple?
(fn (v)
(cond
(er-nil? v) true
(er-cons? v)
(let ((h (get v :head)))
(cond
(and (er-tuple? h) (= (len (get h :elements)) 2))
(er-proplist-2tuple? (get v :tail))
:else false))
:else false)))
(define er-to-sx-deep
(fn (v)
(cond
(er-binary? v) (list->string (map integer->char (get v :bytes)))
(and (er-cons? v) (er-proplist-2tuple? v)) (er-proplist-to-dict v)
:else (er-to-sx v))))
(define er-proplist-to-dict
(fn (pl)
(let ((d (dict)))
(er-proplist-fill! pl d)
d)))
(define er-proplist-fill!
(fn (pl d)
(cond
(er-nil? pl) nil
(er-cons? pl)
(let ((head (get pl :head)) (tail (get pl :tail)))
(cond
(and (er-tuple? head) (= (len (get head :elements)) 2))
(let ((kv (get head :elements)))
(let ((k (nth kv 0)) (v (nth kv 1)))
(let ((key-str
(cond
(er-atom? k) (get k :name)
(er-binary? k)
(list->string (map integer->char (get k :bytes)))
:else (str k))))
(dict-set! d key-str (er-to-sx-deep v))
(er-proplist-fill! tail d))))
:else (er-proplist-fill! tail d)))
:else nil)))
;; Load an Erlang module declaration. Source must start with
;; `-module(Name).` and contain function definitions. Functions
@@ -1795,141 +1682,9 @@
;; entry is keyed by "Module/Name/Arity"; multi-arity BIFs register
;; once per arity. Called eagerly at the end of runtime.sx so the
;; registry is ready before any erlang-eval-ast call.
(define
er-bif-http-listen
(fn
(vs)
(let
((port (nth vs 0)) (handler (nth vs 1)))
(cond
(not (= (type-of port) "number"))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
(not (er-fun? handler))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (let
;; Bridge between native http-listen and Erlang handler.
;;
;; Inbound: native passes Req as SX Dict
;; {:method :path :query :headers :body}
;; converted to Erlang request proplist via the live
;; er-request-dict-to-proplist marshaller — that's the
;; same shape http_server:route/2 consumes (binaries
;; for path/method/body, dict-like proplist for headers).
;;
;; Outbound: Erlang handler returns
;; [{status, Int}, {headers, [{Bin, Bin}, ...]}, {body, Bin}]
;; converted back to SX Dict via er-proplist-to-dict —
;; binary values become SX strings, the headers cons
;; flattens to a nested SX dict (via er-to-sx-deep's
;; proplist-2tuple detection). Matches what native
;; http-listen serialises to the wire.
;;
;; (Step 8b-bridge originally shipped parallel
;; er-http-req-of-sx / er-http-resp-to-sx helpers; commit
;; 78eae9ef deleted them as dead because the BIF body
;; still referenced them — Blockers #1. This rewrite
;; threads through the live marshallers instead.)
;; Run the handler as a SCHEDULED er-process so any
;; `receive` (e.g. gen_server:call inside a kernel-aware
;; route) suspends and resumes inside the SX scheduler.
;; Without this, native http-listen invokes the handler
;; closure on a fresh OCaml thread that has no scheduler
;; frame, so the receive's er-suspend-marker propagates
;; out and the connection writes nothing — the Blockers
;; #4 deadlock the m2 loop observed.
;;
;; er-spawn-fun requires an er-fun (Erlang-AST-shaped
;; dict); handler IS one (created by user `fun (Req) ->
;; route(Req, Cfg) end`). To feed req-pl as the call
;; argument we stash it on the process record's
;; :pending-args field — er-sched-step-alive! reads it
;; on first step (the alternative was a host-closure-to-
;; er-fun wrapper, which needs AST construction).
((sx-handler
(fn (req-dict)
(let ((req-pl (er-request-dict-to-proplist req-dict)))
(let ((proc (er-proc-new! (er-env-new))))
(dict-set! proc :initial-fun handler)
(dict-set! proc :pending-args (list req-pl))
(er-sched-run-all!)
(let ((resp-pl (er-proc-field (get proc :pid) :exit-result)))
(er-proplist-to-dict resp-pl)))))))
(http-listen port sx-handler))))))
;; httpc:request/4(Url, Method, Headers, Body) - BRIEFING-EXCEPTION:
;; the m2 briefing's one allowed scope exception for Step 8e, mirroring
;; M1 Step 8a's http:listen wrapper on the client side.
;;
;; Url is an Erlang binary (must start with http://).
;; Method is an Erlang atom or binary; passed through to the native
;; verbatim, so callers should supply 'get / 'post or <<"GET">> as
;; appropriate (the native compares uppercase).
;; Headers is an Erlang proplist [{Name, Value}, ...]; names and
;; values are binaries or atoms (er-proplist-to-dict handles both).
;; Body is an Erlang binary (use <<>> for empty).
;;
;; Returns a 4-tuple {ok, StatusInt, HeadersProplist, BodyBinary}.
;; The native primitive raises Eval_error on DNS / connect / bad URL;
;; we catch the host exception here and re-raise as an Erlang error
;; marker so callers can use try/catch error:{network, _} -> _ end.
(define
er-bif-httpc-request
(fn
(vs)
(let
((url (nth vs 0))
(method (nth vs 1))
(headers (nth vs 2))
(body (nth vs 3)))
(let
((url-str
(cond
(er-binary? url) (list->string (map integer->char (get url :bytes)))
:else (raise (er-mk-error-marker (er-mk-atom "badarg")))))
(method-str
(cond
;; Erlang convention is lowercase atoms (get/post/put/...);
;; the HTTP wire wants uppercase. Binaries pass through so
;; callers can override with mixed-case verbs if needed.
(er-atom? method) (upcase (get method :name))
(er-binary? method) (list->string (map integer->char (get method :bytes)))
:else (raise (er-mk-error-marker (er-mk-atom "badarg")))))
(headers-dict
(cond
(er-nil? headers) (dict)
(er-cons? headers) (er-proplist-to-dict headers)
:else (raise (er-mk-error-marker (er-mk-atom "badarg")))))
(body-str
(cond
(er-binary? body) (list->string (map integer->char (get body :bytes)))
(er-nil? body) ""
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(let ((resp-ref (list nil)) (err-ref (list nil)))
(guard (c (:else (set-nth! err-ref 0 c)))
(set-nth! resp-ref 0
(http-request method-str url-str headers-dict body-str)))
(cond
(not (= (nth err-ref 0) nil))
;; Host error -> Erlang error:{network, ReasonBinary}
(raise (er-mk-error-marker
(er-mk-tuple (list
(er-mk-atom "network")
(er-mk-binary (map char->integer
(string->list (str (nth err-ref 0)))))))))
:else
(let ((resp (nth resp-ref 0)))
(er-mk-tuple
(list
(er-mk-atom "ok")
(get resp :status)
(er-of-sx-deep (get resp :headers))
(er-mk-binary (map char->integer (string->list (get resp :body)))))))))))))
;; Register everything at load time.
(define
er-register-builtin-bifs!
(fn
()
(define er-register-builtin-bifs!
(fn ()
;; erlang module — type predicates (all pure)
(er-register-pure-bif! "erlang" "is_integer" 1 er-bif-is-integer)
(er-register-pure-bif! "erlang" "is_atom" 1 er-bif-is-atom)
(er-register-pure-bif! "erlang" "is_list" 1 er-bif-is-list)
@@ -1938,61 +1693,27 @@
(er-register-pure-bif! "erlang" "is_float" 1 er-bif-is-float)
(er-register-pure-bif! "erlang" "is_boolean" 1 er-bif-is-boolean)
(er-register-pure-bif! "erlang" "is_pid" 1 er-bif-is-pid)
(er-register-pure-bif!
"erlang"
"is_reference"
1
er-bif-is-reference)
(er-register-pure-bif! "erlang" "is_reference" 1 er-bif-is-reference)
(er-register-pure-bif! "erlang" "is_binary" 1 er-bif-is-binary)
(er-register-pure-bif!
"erlang"
"is_function"
1
er-bif-is-function)
(er-register-pure-bif!
"erlang"
"is_function"
2
er-bif-is-function)
(er-register-pure-bif! "erlang" "is_function" 1 er-bif-is-function)
(er-register-pure-bif! "erlang" "is_function" 2 er-bif-is-function)
;; erlang module — pure data ops
(er-register-pure-bif! "erlang" "length" 1 er-bif-length)
(er-register-pure-bif! "erlang" "hd" 1 er-bif-hd)
(er-register-pure-bif! "erlang" "tl" 1 er-bif-tl)
(er-register-pure-bif! "erlang" "element" 2 er-bif-element)
(er-register-pure-bif! "erlang" "tuple_size" 1 er-bif-tuple-size)
(er-register-pure-bif! "erlang" "byte_size" 1 er-bif-byte-size)
(er-register-pure-bif!
"erlang"
"atom_to_list"
1
er-bif-atom-to-list)
(er-register-pure-bif!
"erlang"
"list_to_atom"
1
er-bif-list-to-atom)
(er-register-pure-bif! "erlang" "atom_to_list" 1 er-bif-atom-to-list)
(er-register-pure-bif! "erlang" "list_to_atom" 1 er-bif-list-to-atom)
(er-register-pure-bif! "erlang" "abs" 1 er-bif-abs)
(er-register-pure-bif! "erlang" "min" 2 er-bif-min)
(er-register-pure-bif! "erlang" "max" 2 er-bif-max)
(er-register-pure-bif!
"erlang"
"tuple_to_list"
1
er-bif-tuple-to-list)
(er-register-pure-bif!
"erlang"
"list_to_tuple"
1
er-bif-list-to-tuple)
(er-register-pure-bif!
"erlang"
"integer_to_list"
1
er-bif-integer-to-list)
(er-register-pure-bif!
"erlang"
"list_to_integer"
1
er-bif-list-to-integer)
(er-register-pure-bif! "erlang" "tuple_to_list" 1 er-bif-tuple-to-list)
(er-register-pure-bif! "erlang" "list_to_tuple" 1 er-bif-list-to-tuple)
(er-register-pure-bif! "erlang" "integer_to_list" 1 er-bif-integer-to-list)
(er-register-pure-bif! "erlang" "list_to_integer" 1 er-bif-list-to-integer)
;; erlang module — process / runtime (side-effecting)
(er-register-bif! "erlang" "self" 0 er-bif-self)
(er-register-bif! "erlang" "spawn" 1 er-bif-spawn)
(er-register-bif! "erlang" "spawn" 3 er-bif-spawn)
@@ -2012,16 +1733,12 @@
(er-register-bif! "erlang" "unregister" 1 er-bif-unregister)
(er-register-bif! "erlang" "whereis" 1 er-bif-whereis)
(er-register-bif! "erlang" "registered" 0 er-bif-registered)
(er-register-bif!
"erlang"
"throw"
1
;; erlang module — exception raising (modelled as side-effecting)
(er-register-bif! "erlang" "throw" 1
(fn (vs) (raise (er-mk-throw-marker (er-bif-arg1 vs "throw")))))
(er-register-bif!
"erlang"
"error"
1
(er-register-bif! "erlang" "error" 1
(fn (vs) (raise (er-mk-error-marker (er-bif-arg1 vs "error")))))
;; lists module — all pure
(er-register-pure-bif! "lists" "reverse" 1 er-bif-lists-reverse)
(er-register-pure-bif! "lists" "map" 2 er-bif-lists-map)
(er-register-pure-bif! "lists" "foldl" 3 er-bif-lists-foldl)
@@ -2035,13 +1752,47 @@
(er-register-pure-bif! "lists" "filter" 2 er-bif-lists-filter)
(er-register-pure-bif! "lists" "any" 2 er-bif-lists-any)
(er-register-pure-bif! "lists" "all" 2 er-bif-lists-all)
(er-register-pure-bif!
"lists"
"duplicate"
2
er-bif-lists-duplicate)
(er-register-pure-bif! "lists" "duplicate" 2 er-bif-lists-duplicate)
(er-register-pure-bif! "lists" "sort" 1 er-bif-lists-sort)
(er-register-pure-bif! "lists" "sort" 2 er-bif-lists-sort)
(er-register-pure-bif! "lists" "usort" 1 er-bif-lists-usort)
(er-register-pure-bif! "lists" "keyfind" 3 er-bif-lists-keyfind)
(er-register-pure-bif! "lists" "keymember" 3 er-bif-lists-keymember)
(er-register-pure-bif! "lists" "keydelete" 3 er-bif-lists-keydelete)
(er-register-pure-bif! "lists" "keyreplace" 4 er-bif-lists-keyreplace)
(er-register-pure-bif! "lists" "keystore" 4 er-bif-lists-keystore)
(er-register-pure-bif! "lists" "keytake" 3 er-bif-lists-keytake)
(er-register-pure-bif! "lists" "keysort" 2 er-bif-lists-keysort)
(er-register-pure-bif! "lists" "foldr" 3 er-bif-lists-foldr)
(er-register-pure-bif! "lists" "partition" 2 er-bif-lists-partition)
(er-register-pure-bif! "lists" "takewhile" 2 er-bif-lists-takewhile)
(er-register-pure-bif! "lists" "dropwhile" 2 er-bif-lists-dropwhile)
(er-register-pure-bif! "lists" "splitwith" 2 er-bif-lists-splitwith)
(er-register-pure-bif! "lists" "flatten" 1 er-bif-lists-flatten)
(er-register-pure-bif! "lists" "max" 1 er-bif-lists-max)
(er-register-pure-bif! "lists" "min" 1 er-bif-lists-min)
(er-register-pure-bif! "lists" "zip" 2 er-bif-lists-zip)
(er-register-pure-bif! "lists" "zipwith" 3 er-bif-lists-zipwith)
(er-register-pure-bif! "lists" "unzip" 1 er-bif-lists-unzip)
(er-register-pure-bif! "lists" "sublist" 2 er-bif-lists-sublist)
(er-register-pure-bif! "lists" "sublist" 3 er-bif-lists-sublist)
(er-register-pure-bif! "lists" "nthtail" 2 er-bif-lists-nthtail)
(er-register-pure-bif! "lists" "split" 2 er-bif-lists-split)
(er-register-pure-bif! "lists" "droplast" 1 er-bif-lists-droplast)
(er-register-pure-bif! "lists" "flatmap" 2 er-bif-lists-flatmap)
(er-register-pure-bif! "lists" "filtermap" 2 er-bif-lists-filtermap)
(er-register-pure-bif! "lists" "mapfoldl" 3 er-bif-lists-mapfoldl)
(er-register-pure-bif! "lists" "search" 2 er-bif-lists-search)
(er-register-pure-bif! "proplists" "get_value" 2 er-bif-pl-get-value)
(er-register-pure-bif! "proplists" "get_value" 3 er-bif-pl-get-value)
(er-register-pure-bif! "proplists" "get_all_values" 2 er-bif-pl-get-all-values)
(er-register-pure-bif! "proplists" "is_defined" 2 er-bif-pl-is-defined)
(er-register-pure-bif! "proplists" "lookup" 2 er-bif-pl-lookup)
(er-register-pure-bif! "proplists" "delete" 2 er-bif-pl-delete)
;; io module — side-effecting (writes to io buffer)
(er-register-bif! "io" "format" 1 er-bif-io-format)
(er-register-bif! "io" "format" 2 er-bif-io-format)
;; ets module — side-effecting (mutates table state)
(er-register-bif! "ets" "new" 2 er-bif-ets-new)
(er-register-bif! "ets" "insert" 2 er-bif-ets-insert)
(er-register-bif! "ets" "lookup" 2 er-bif-ets-lookup)
@@ -2049,89 +1800,82 @@
(er-register-bif! "ets" "delete" 2 er-bif-ets-delete)
(er-register-bif! "ets" "tab2list" 1 er-bif-ets-tab2list)
(er-register-bif! "ets" "info" 2 er-bif-ets-info)
;; code module — side-effecting (mutates module registry, kills procs)
(er-register-bif! "code" "load_binary" 3 er-bif-code-load-binary)
(er-register-bif! "code" "purge" 1 er-bif-code-purge)
(er-register-bif! "code" "soft_purge" 1 er-bif-code-soft-purge)
(er-register-bif! "code" "which" 1 er-bif-code-which)
(er-register-bif! "code" "is_loaded" 1 er-bif-code-is-loaded)
(er-register-bif! "code" "all_loaded" 0 er-bif-code-all-loaded)
;; file module
(er-register-bif! "file" "read_file" 1 er-bif-file-read-file)
(er-register-bif! "file" "write_file" 2 er-bif-file-write-file)
(er-register-bif! "file" "delete" 1 er-bif-file-delete)
;; Phase 8 FFI — host-primitive BIFs (loops/fed-prims)
(er-register-pure-bif! "crypto" "hash" 2 er-bif-crypto-hash)
(er-register-pure-bif! "cid" "from_bytes" 1 er-bif-cid-from-bytes)
(er-register-pure-bif! "cid" "to_string" 1 er-bif-cid-to-string)
(define
er-bif-binary-to-list
(fn
(vs)
(let
((v (nth vs 0)))
(cond
(not (er-binary? v))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (let
((bs (get v :bytes)) (out (er-mk-nil)))
(for-each
(fn
(i)
(set!
out
(er-mk-cons (nth bs (- (- (len bs) 1) i)) out)))
(range 0 (len bs)))
out)))))
(define
er-iolist-walk!
(fn
(v acc fail)
(cond
(nth fail 0)
nil
(er-nil? v)
nil
(er-cons? v)
(do
(er-iolist-walk! (get v :head) acc fail)
;; ── binary_to_list / list_to_binary (Step 3b — term codec) ──────
;; Standard Erlang semantics:
;; binary_to_list(<<B1,B2,...>>) -> [B1, B2, ...] (Erlang cons of ints)
;; list_to_binary(IoList) -> <<...>> (flattens nested
;; iolists; elements are byte ints 0-255 or binaries)
;; Bad arg / out-of-range byte / non-iolist element -> error:badarg.
(define er-bif-binary-to-list
(fn (vs)
(let ((v (nth vs 0)))
(cond
(not (er-binary? v))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((bs (get v :bytes)) (out (er-mk-nil)))
(for-each
(fn (i)
(set! out (er-mk-cons (nth bs (- (- (len bs) 1) i)) out)))
(range 0 (len bs)))
out)))))
;; Walk an Erlang iolist, appending bytes to `acc` (a mutable SX list).
;; Accepts: nil, cons-of-X, binary, integer in 0..255. Anything else
;; signals failure by setting (nth fail 0) to true.
(define er-iolist-walk!
(fn (v acc fail)
(cond
(nth fail 0) nil
(er-nil? v) nil
(er-cons? v)
(do (er-iolist-walk! (get v :head) acc fail)
(er-iolist-walk! (get v :tail) acc fail))
(er-binary? v)
(for-each
(fn (i) (append! acc (nth (get v :bytes) i)))
(range 0 (len (get v :bytes))))
(= (type-of v) "number")
(cond
(and (>= v 0) (<= v 255))
(append! acc v)
:else (set-nth! fail 0 true))
:else (set-nth! fail 0 true))))
(define
er-bif-list-to-binary
(fn
(vs)
(let
((v (nth vs 0)) (acc (list)) (fail (list false)))
(cond
(not (or (er-nil? v) (er-cons? v) (er-binary? v)))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (do
(er-iolist-walk! v acc fail)
(cond
(nth fail 0)
(er-binary? v)
(for-each
(fn (i) (append! acc (nth (get v :bytes) i)))
(range 0 (len (get v :bytes))))
(= (type-of v) "number")
(cond
(and (>= v 0) (<= v 255)) (append! acc v)
:else (set-nth! fail 0 true))
:else (set-nth! fail 0 true))))
(define er-bif-list-to-binary
(fn (vs)
(let ((v (nth vs 0)) (acc (list)) (fail (list false)))
(cond
(not (or (er-nil? v) (er-cons? v) (er-binary? v)))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(do
(er-iolist-walk! v acc fail)
(cond
(nth fail 0)
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (er-mk-binary acc)))))))
:else (er-mk-binary acc)))))))
(er-register-bif! "file" "list_dir" 1 er-bif-file-list-dir)
(er-register-pure-bif!
"erlang"
"binary_to_list"
1
er-bif-binary-to-list)
(er-register-pure-bif!
"erlang"
"list_to_binary"
1
er-bif-list-to-binary)
(er-register-pure-bif! "erlang" "binary_to_list" 1 er-bif-binary-to-list)
(er-register-pure-bif! "erlang" "list_to_binary" 1 er-bif-list-to-binary)
(er-mk-atom "ok")))
(er-register-bif! "http" "listen" 2 er-bif-http-listen)
(er-register-bif! "httpc" "request" 4 er-bif-httpc-request)
;; Register everything at load time.
(er-register-builtin-bifs!)

View File

@@ -1,7 +1,7 @@
{
"language": "erlang",
"total_pass": 771,
"total": 771,
"total_pass": 874,
"total": 874,
"suites": [
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
{"name":"parse","pass":52,"total":52,"status":"ok"},
@@ -14,6 +14,7 @@
{"name":"fib","pass":8,"total":8,"status":"ok"},
{"name":"ffi","pass":37,"total":37,"status":"ok"},
{"name":"vm","pass":78,"total":78,"status":"ok"},
{"name":"send_after","pass":10,"total":10,"status":"ok"}
{"name":"send_after","pass":10,"total":10,"status":"ok"},
{"name":"lists_ext","pass":103,"total":103,"status":"ok"}
]
}

View File

@@ -1,6 +1,6 @@
# Erlang-on-SX Scoreboard
**Total: 771 / 771 tests passing**
**Total: 874 / 874 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
@@ -16,6 +16,7 @@
| ✅ | ffi | 37 | 37 |
| ✅ | vm | 78 | 78 |
| ✅ | send_after | 10 | 10 |
| ✅ | lists_ext | 103 | 103 |
Generated by `lib/erlang/conformance.sh`.

View File

@@ -0,0 +1,385 @@
;; lists-ext tests — lists:sort/1, lists:sort/2, lists:usort/1.
;; Each case evaluates an Erlang expression that reduces to the bool
;; atom `true` (via =:= on the sorted result) and checks its name.
(define er-lx-test-count 0)
(define er-lx-test-pass 0)
(define er-lx-test-fails (list))
(define
er-lx-test
(fn
(name actual expected)
(set! er-lx-test-count (+ er-lx-test-count 1))
(if
(= actual expected)
(set! er-lx-test-pass (+ er-lx-test-pass 1))
(append! er-lx-test-fails {:name name :expected expected :actual actual}))))
;; eval an Erlang source string and return the result atom's name
(define er-lx-nm (fn (src) (get (erlang-eval-ast src) :name)))
;; ── lists:sort/1 ──────────────────────────────────────────────────
(er-lx-test "sort/1 ascending"
(er-lx-nm "lists:sort([3,1,2]) =:= [1,2,3]") "true")
(er-lx-test "sort/1 already sorted"
(er-lx-nm "lists:sort([1,2,3]) =:= [1,2,3]") "true")
(er-lx-test "sort/1 empty"
(er-lx-nm "lists:sort([]) =:= []") "true")
(er-lx-test "sort/1 singleton"
(er-lx-nm "lists:sort([7]) =:= [7]") "true")
(er-lx-test "sort/1 keeps duplicates"
(er-lx-nm "lists:sort([3,1,2,1]) =:= [1,1,2,3]") "true")
(er-lx-test "sort/1 length preserved"
(erlang-eval-ast "length(lists:sort([5,4,3,2,1]))") 5)
(er-lx-test "sort/1 term order: number < atom"
(er-lx-nm "lists:sort([b,a,1]) =:= [1,a,b]") "true")
(er-lx-test "sort/1 tuples elementwise"
(er-lx-nm "lists:sort([{2,a},{1,b},{1,a}]) =:= [{1,a},{1,b},{2,a}]") "true")
;; ── lists:sort/2 ──────────────────────────────────────────────────
(er-lx-test "sort/2 ascending =<"
(er-lx-nm "lists:sort(fun(A,B) -> A =< B end, [3,1,2]) =:= [1,2,3]") "true")
(er-lx-test "sort/2 descending >="
(er-lx-nm "lists:sort(fun(A,B) -> A >= B end, [1,3,2]) =:= [3,2,1]") "true")
(er-lx-test "sort/2 stable on equal keys"
(er-lx-nm
"lists:sort(fun({A,_},{B,_}) -> A =< B end, [{1,x},{1,y},{0,z}]) =:= [{0,z},{1,x},{1,y}]")
"true")
(er-lx-test "sort/2 empty"
(er-lx-nm "lists:sort(fun(A,B) -> A =< B end, []) =:= []") "true")
;; ── lists:usort/1 ─────────────────────────────────────────────────
(er-lx-test "usort/1 removes duplicates"
(er-lx-nm "lists:usort([3,1,2,1,3]) =:= [1,2,3]") "true")
(er-lx-test "usort/1 empty"
(er-lx-nm "lists:usort([]) =:= []") "true")
(er-lx-test "usort/1 all equal collapses to one"
(er-lx-nm "lists:usort([5,5,5]) =:= [5]") "true")
(er-lx-test "usort/1 already unique"
(er-lx-nm "lists:usort([1,2,3]) =:= [1,2,3]") "true")
(er-lx-test "usort/1 length after dedup"
(erlang-eval-ast "length(lists:usort([4,4,2,2,1,1,4]))") 3)
;; ── lists:keyfind/3 ───────────────────────────────────────────────
(er-lx-test "keyfind hit"
(erlang-eval-ast "element(2, lists:keyfind(b, 1, [{a,1},{b,2},{c,3}]))") 2)
(er-lx-test "keyfind first match only"
(erlang-eval-ast "element(2, lists:keyfind(a, 1, [{a,1},{a,9}]))") 1)
(er-lx-test "keyfind miss returns false"
(er-lx-nm "lists:keyfind(z, 1, [{a,1},{b,2}])") "false")
(er-lx-test "keyfind on second element"
(er-lx-nm "element(1, lists:keyfind(2, 2, [{a,1},{b,2}]))") "b")
(er-lx-test "keyfind skips short tuples"
(er-lx-nm "lists:keyfind(x, 2, [{x},{y,x}]) =:= {y,x}") "true")
;; ── lists:keymember/3 ─────────────────────────────────────────────
(er-lx-test "keymember true"
(er-lx-nm "lists:keymember(b, 1, [{a,1},{b,2}])") "true")
(er-lx-test "keymember false"
(er-lx-nm "lists:keymember(z, 1, [{a,1},{b,2}])") "false")
;; ── lists:keydelete/3 ─────────────────────────────────────────────
(er-lx-test "keydelete removes first match"
(er-lx-nm "lists:keydelete(b, 1, [{a,1},{b,2},{c,3}]) =:= [{a,1},{c,3}]") "true")
(er-lx-test "keydelete only first"
(er-lx-nm "lists:keydelete(a, 1, [{a,1},{a,2},{b,3}]) =:= [{a,2},{b,3}]") "true")
(er-lx-test "keydelete miss unchanged"
(er-lx-nm "lists:keydelete(z, 1, [{a,1},{b,2}]) =:= [{a,1},{b,2}]") "true")
;; ── lists:keyreplace/4 ────────────────────────────────────────────
(er-lx-test "keyreplace hit"
(er-lx-nm
"lists:keyreplace(b, 1, [{a,1},{b,2},{c,3}], {b,99}) =:= [{a,1},{b,99},{c,3}]")
"true")
(er-lx-test "keyreplace miss unchanged"
(er-lx-nm
"lists:keyreplace(z, 1, [{a,1}], {z,0}) =:= [{a,1}]") "true")
;; ── lists:keystore/4 ──────────────────────────────────────────────
(er-lx-test "keystore replaces existing"
(er-lx-nm
"lists:keystore(b, 1, [{a,1},{b,2}], {b,99}) =:= [{a,1},{b,99}]") "true")
(er-lx-test "keystore appends when absent"
(er-lx-nm
"lists:keystore(z, 1, [{a,1},{b,2}], {z,0}) =:= [{a,1},{b,2},{z,0}]") "true")
;; ── lists:keytake/3 ───────────────────────────────────────────────
(er-lx-test "keytake hit value tag"
(er-lx-nm "element(1, lists:keytake(b, 1, [{a,1},{b,2},{c,3}]))") "value")
(er-lx-test "keytake hit tuple"
(er-lx-nm
"element(2, lists:keytake(b, 1, [{a,1},{b,2},{c,3}])) =:= {b,2}") "true")
(er-lx-test "keytake hit rest"
(er-lx-nm
"element(3, lists:keytake(b, 1, [{a,1},{b,2},{c,3}])) =:= [{a,1},{c,3}]") "true")
(er-lx-test "keytake miss false"
(er-lx-nm "lists:keytake(z, 1, [{a,1}])") "false")
;; ── lists:keysort/2 ───────────────────────────────────────────────
(er-lx-test "keysort by element 1"
(er-lx-nm
"lists:keysort(1, [{c,3},{a,1},{b,2}]) =:= [{a,1},{b,2},{c,3}]") "true")
(er-lx-test "keysort by element 2"
(er-lx-nm
"lists:keysort(2, [{a,3},{b,1},{c,2}]) =:= [{b,1},{c,2},{a,3}]") "true")
(er-lx-test "keysort stable on equal keys"
(er-lx-nm
"lists:keysort(1, [{a,1},{a,2},{a,3}]) =:= [{a,1},{a,2},{a,3}]") "true")
;; ── lists:foldr/3 ─────────────────────────────────────────────────
(er-lx-test "foldr preserves order"
(er-lx-nm
"lists:foldr(fun(X,Acc) -> [X|Acc] end, [], [1,2,3]) =:= [1,2,3]") "true")
(er-lx-test "foldr sum"
(erlang-eval-ast "lists:foldr(fun(X,A) -> X+A end, 0, [1,2,3,4])") 10)
(er-lx-test "foldr empty returns acc"
(erlang-eval-ast "lists:foldr(fun(X,A) -> X+A end, 42, [])") 42)
;; ── lists:partition/2 ─────────────────────────────────────────────
(er-lx-test "partition evens/odds"
(er-lx-nm
"lists:partition(fun(X) -> X rem 2 =:= 0 end, [1,2,3,4,5]) =:= {[2,4],[1,3,5]}")
"true")
(er-lx-test "partition all satisfy"
(er-lx-nm "lists:partition(fun(_) -> true end, [1,2]) =:= {[1,2],[]}") "true")
(er-lx-test "partition empty"
(er-lx-nm "lists:partition(fun(_) -> true end, []) =:= {[],[]}") "true")
;; ── lists:takewhile/2 ─────────────────────────────────────────────
(er-lx-test "takewhile prefix"
(er-lx-nm "lists:takewhile(fun(X) -> X < 3 end, [1,2,3,4,1]) =:= [1,2]") "true")
(er-lx-test "takewhile none"
(er-lx-nm "lists:takewhile(fun(X) -> X < 0 end, [1,2]) =:= []") "true")
(er-lx-test "takewhile all"
(er-lx-nm "lists:takewhile(fun(X) -> X < 9 end, [1,2,3]) =:= [1,2,3]") "true")
;; ── lists:dropwhile/2 ─────────────────────────────────────────────
(er-lx-test "dropwhile prefix"
(er-lx-nm "lists:dropwhile(fun(X) -> X < 3 end, [1,2,3,4,1]) =:= [3,4,1]") "true")
(er-lx-test "dropwhile all"
(er-lx-nm "lists:dropwhile(fun(X) -> X < 9 end, [1,2,3]) =:= []") "true")
(er-lx-test "dropwhile none"
(er-lx-nm "lists:dropwhile(fun(X) -> X < 0 end, [1,2]) =:= [1,2]") "true")
;; ── lists:splitwith/2 ─────────────────────────────────────────────
(er-lx-test "splitwith"
(er-lx-nm
"lists:splitwith(fun(X) -> X < 3 end, [1,2,3,4,1]) =:= {[1,2],[3,4,1]}") "true")
(er-lx-test "splitwith empty"
(er-lx-nm "lists:splitwith(fun(_) -> true end, []) =:= {[],[]}") "true")
;; ── lists:flatten/1 ───────────────────────────────────────────────
(er-lx-test "flatten nested"
(er-lx-nm "lists:flatten([1,[2,[3,4]],5]) =:= [1,2,3,4,5]") "true")
(er-lx-test "flatten already flat"
(er-lx-nm "lists:flatten([1,2,3]) =:= [1,2,3]") "true")
(er-lx-test "flatten empty"
(er-lx-nm "lists:flatten([]) =:= []") "true")
(er-lx-test "flatten deep empties"
(er-lx-nm "lists:flatten([[],[1],[[]]]) =:= [1]") "true")
(er-lx-test "flatten length"
(erlang-eval-ast "length(lists:flatten([[1,2],[3],[4,5,6]]))") 6)
;; ── lists:max/1 ───────────────────────────────────────────────────
(er-lx-test "max ints"
(erlang-eval-ast "lists:max([3,1,4,1,5,9,2,6])") 9)
(er-lx-test "max single"
(erlang-eval-ast "lists:max([7])") 7)
(er-lx-test "max atoms term order"
(er-lx-nm "lists:max([a,c,b]) =:= c") "true")
;; ── lists:min/1 ───────────────────────────────────────────────────
(er-lx-test "min ints"
(erlang-eval-ast "lists:min([3,1,4,1,5])") 1)
(er-lx-test "min mixed term order"
(er-lx-nm "lists:min([a,1,b]) =:= 1") "true")
;; ── lists:zip/2 ───────────────────────────────────────────────────
(er-lx-test "zip pairs"
(er-lx-nm "lists:zip([a,b,c],[1,2,3]) =:= [{a,1},{b,2},{c,3}]") "true")
(er-lx-test "zip empty"
(er-lx-nm "lists:zip([],[]) =:= []") "true")
(er-lx-test "zip length"
(erlang-eval-ast "length(lists:zip([1,2],[3,4]))") 2)
;; ── lists:zipwith/3 ───────────────────────────────────────────────
(er-lx-test "zipwith sum"
(er-lx-nm
"lists:zipwith(fun(X,Y) -> X+Y end, [1,2,3], [10,20,30]) =:= [11,22,33]")
"true")
(er-lx-test "zipwith tuple"
(er-lx-nm "lists:zipwith(fun(X,Y) -> {X,Y} end, [a], [1]) =:= [{a,1}]") "true")
;; ── lists:unzip/1 ─────────────────────────────────────────────────
(er-lx-test "unzip"
(er-lx-nm "lists:unzip([{a,1},{b,2},{c,3}]) =:= {[a,b,c],[1,2,3]}") "true")
(er-lx-test "unzip empty"
(er-lx-nm "lists:unzip([]) =:= {[],[]}") "true")
(er-lx-test "zip/unzip roundtrip"
(er-lx-nm "lists:unzip(lists:zip([1,2],[3,4])) =:= {[1,2],[3,4]}") "true")
;; ── lists:sublist/2,3 ─────────────────────────────────────────────
(er-lx-test "sublist/2 first n"
(er-lx-nm "lists:sublist([1,2,3,4,5],3) =:= [1,2,3]") "true")
(er-lx-test "sublist/2 over length"
(er-lx-nm "lists:sublist([1,2],5) =:= [1,2]") "true")
(er-lx-test "sublist/2 zero"
(er-lx-nm "lists:sublist([1,2,3],0) =:= []") "true")
(er-lx-test "sublist/3 mid"
(er-lx-nm "lists:sublist([1,2,3,4,5],2,3) =:= [2,3,4]") "true")
(er-lx-test "sublist/3 to end"
(er-lx-nm "lists:sublist([1,2,3],2,10) =:= [2,3]") "true")
;; ── lists:nthtail/2 ───────────────────────────────────────────────
(er-lx-test "nthtail mid"
(er-lx-nm "lists:nthtail(2,[1,2,3,4]) =:= [3,4]") "true")
(er-lx-test "nthtail zero"
(er-lx-nm "lists:nthtail(0,[1,2]) =:= [1,2]") "true")
(er-lx-test "nthtail full"
(er-lx-nm "lists:nthtail(3,[1,2,3]) =:= []") "true")
;; ── lists:split/2 ─────────────────────────────────────────────────
(er-lx-test "split mid"
(er-lx-nm "lists:split(2,[1,2,3,4,5]) =:= {[1,2],[3,4,5]}") "true")
(er-lx-test "split zero"
(er-lx-nm "lists:split(0,[1,2]) =:= {[],[1,2]}") "true")
(er-lx-test "split full"
(er-lx-nm "lists:split(3,[1,2,3]) =:= {[1,2,3],[]}") "true")
;; ── lists:droplast/1 ──────────────────────────────────────────────
(er-lx-test "droplast"
(er-lx-nm "lists:droplast([1,2,3]) =:= [1,2]") "true")
(er-lx-test "droplast single"
(er-lx-nm "lists:droplast([9]) =:= []") "true")
;; ── lists:flatmap/2 ───────────────────────────────────────────────
(er-lx-test "flatmap duplicates"
(er-lx-nm "lists:flatmap(fun(X) -> [X,X] end, [1,2]) =:= [1,1,2,2]") "true")
(er-lx-test "flatmap empty"
(er-lx-nm "lists:flatmap(fun(X) -> [X] end, []) =:= []") "true")
;; ── lists:filtermap/2 ─────────────────────────────────────────────
(er-lx-test "filtermap transform"
(er-lx-nm
"lists:filtermap(fun(X) -> case X rem 2 of 0 -> {true, X*10}; _ -> false end end, [1,2,3,4]) =:= [20,40]")
"true")
(er-lx-test "filtermap bool keep"
(er-lx-nm "lists:filtermap(fun(X) -> X > 2 end, [1,2,3,4]) =:= [3,4]") "true")
;; ── lists:mapfoldl/3 ──────────────────────────────────────────────
(er-lx-test "mapfoldl map+acc"
(er-lx-nm
"lists:mapfoldl(fun(X,A) -> {X*2, A+X} end, 0, [1,2,3]) =:= {[2,4,6],6}") "true")
(er-lx-test "mapfoldl empty"
(er-lx-nm "lists:mapfoldl(fun(X,A) -> {X,A} end, 5, []) =:= {[],5}") "true")
;; ── lists:search/2 ────────────────────────────────────────────────
(er-lx-test "search hit"
(er-lx-nm "lists:search(fun(X) -> X > 2 end, [1,2,3,4]) =:= {value,3}") "true")
(er-lx-test "search miss"
(er-lx-nm "lists:search(fun(X) -> X > 9 end, [1,2,3])") "false")
;; ── proplists:get_value/2,3 ───────────────────────────────────────
(er-lx-test "pl get_value hit"
(erlang-eval-ast "proplists:get_value(b, [{a,1},{b,2}])") 2)
(er-lx-test "pl get_value miss undefined"
(er-lx-nm "proplists:get_value(z, [{a,1}])") "undefined")
(er-lx-test "pl get_value default"
(erlang-eval-ast "proplists:get_value(z, [{a,1}], 99)") 99)
(er-lx-test "pl get_value bare atom is true"
(er-lx-nm "proplists:get_value(flag, [flag, {a,1}])") "true")
(er-lx-test "pl get_value first occurrence"
(erlang-eval-ast "proplists:get_value(a, [{a,1},{a,2}])") 1)
;; ── proplists:get_all_values/2 ────────────────────────────────────
(er-lx-test "pl get_all_values"
(er-lx-nm
"proplists:get_all_values(a, [{a,1},{b,2},{a,3}]) =:= [1,3]") "true")
;; ── proplists:is_defined/2 ────────────────────────────────────────
(er-lx-test "pl is_defined true"
(er-lx-nm "proplists:is_defined(b, [{a,1},{b,2}])") "true")
(er-lx-test "pl is_defined false"
(er-lx-nm "proplists:is_defined(z, [{a,1}])") "false")
;; ── proplists:lookup/2 ────────────────────────────────────────────
(er-lx-test "pl lookup hit"
(er-lx-nm "proplists:lookup(b, [{a,1},{b,2}]) =:= {b,2}") "true")
(er-lx-test "pl lookup bare atom"
(er-lx-nm "proplists:lookup(flag, [flag]) =:= {flag,true}") "true")
(er-lx-test "pl lookup miss"
(er-lx-nm "proplists:lookup(z, [{a,1}])") "none")
;; ── proplists:delete/2 ────────────────────────────────────────────
(er-lx-test "pl delete removes all"
(er-lx-nm "proplists:delete(a, [{a,1},{b,2},{a,3}]) =:= [{b,2}]") "true")

View File

@@ -2039,4 +2039,657 @@
(range 0 (len ks)))
out)))
;; ── extra lists + proplists BIFs (folded from lists-ext.sx) ──
;; ── cons <-> SX-list bridges ──────────────────────────────────────
(define
er-cons->sxlist
(fn (lst)
(cond
(er-nil? lst) (list)
(er-cons? lst) (cons (get lst :head) (er-cons->sxlist (get lst :tail)))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-sxlist->cons
(fn (xs)
(if (= (len xs) 0)
(er-mk-nil)
(er-mk-cons (first xs) (er-sxlist->cons (rest xs))))))
;; ── merge sort over SX lists (stable) ─────────────────────────────
(define
er-ext-take
(fn (xs n)
(if (or (= n 0) (= (len xs) 0))
(list)
(cons (first xs) (er-ext-take (rest xs) (- n 1))))))
(define
er-ext-drop
(fn (xs n)
(if (or (= n 0) (= (len xs) 0))
xs
(er-ext-drop (rest xs) (- n 1)))))
;; le? returns a truthy value (Erlang bool atom or SX bool) iff a
;; should sort at-or-before b. Taking from the left half first on a
;; true result keeps the sort stable.
(define
er-ext-merge
(fn (a b le?)
(cond
(= (len a) 0) b
(= (len b) 0) a
(er-truthy? (le? (first a) (first b)))
(cons (first a) (er-ext-merge (rest a) b le?))
:else (cons (first b) (er-ext-merge a (rest b) le?)))))
(define
er-ext-msort
(fn (xs le?)
(if (<= (len xs) 1)
xs
(let ((mid (quotient (len xs) 2)))
(er-ext-merge
(er-ext-msort (er-ext-take xs mid) le?)
(er-ext-msort (er-ext-drop xs mid) le?)
le?)))))
;; Full Erlang term order. The shared er-lt? (transpile.sx) only
;; deep-compares numbers/atoms/strings and otherwise falls back to a
;; coarse type rank — so any two tuples (or two lists) compare as
;; order-equal there. er-ext-lt? adds the missing structural cases:
;; tuples by arity then elementwise, lists elementwise with a shorter
;; proper prefix sorting first. Cross-type cases delegate to er-lt?.
(define
er-ext-lt-seq
(fn (ea eb i)
(cond
(>= i (len ea)) false
(er-ext-lt? (nth ea i) (nth eb i)) true
(er-ext-lt? (nth eb i) (nth ea i)) false
:else (er-ext-lt-seq ea eb (+ i 1)))))
(define
er-ext-lt?
(fn (a b)
(cond
(and (er-tuple? a) (er-tuple? b))
(let ((ea (get a :elements)) (eb (get b :elements)))
(cond
(< (len ea) (len eb)) true
(> (len ea) (len eb)) false
:else (er-ext-lt-seq ea eb 0)))
(and (er-cons? a) (er-cons? b))
(cond
(er-ext-lt? (get a :head) (get b :head)) true
(er-ext-lt? (get b :head) (get a :head)) false
:else (er-ext-lt? (get a :tail) (get b :tail)))
(and (er-nil? a) (er-cons? b)) true
(and (er-cons? a) (er-nil? b)) false
(and (er-nil? a) (er-nil? b)) false
:else (er-lt? a b))))
;; Default Erlang term order: a =< b == not (b < a).
(define
er-ext-term-le
(fn (a b) (er-bool (not (er-ext-lt? b a)))))
;; ── lists:sort/1, lists:sort/2 ────────────────────────────────────
(define
er-bif-lists-sort
(fn (vs)
(cond
(= (len vs) 1)
(er-sxlist->cons
(er-ext-msort (er-cons->sxlist (nth vs 0)) er-ext-term-le))
(= (len vs) 2)
(let ((f (nth vs 0)) (lst (nth vs 1)))
(er-sxlist->cons
(er-ext-msort
(er-cons->sxlist lst)
(fn (a b) (er-apply-fun f (list a b))))))
:else (error "Erlang: lists:sort: wrong arity"))))
;; ── lists:usort/1 (sort then drop adjacent term-equal dups) ───────
(define
er-ext-dedup
(fn (xs)
(cond
(= (len xs) 0) (list)
(= (len xs) 1) xs
(er-equal? (first xs) (nth xs 1)) (er-ext-dedup (rest xs))
:else (cons (first xs) (er-ext-dedup (rest xs))))))
(define
er-bif-lists-usort
(fn (vs)
(let ((lst (er-bif-arg1 vs "lists:usort")))
(er-sxlist->cons
(er-ext-dedup
(er-ext-msort (er-cons->sxlist lst) er-ext-term-le))))))
;; ── keylists (lists of tuples keyed on element N, 1-indexed) ──────
;; keyfind/keymember/keydelete/keyreplace/keystore/keytake/keysort.
;; Key comparison is == (er-equal?), matching the standard lib. Only
;; the FIRST matching tuple is acted on. Non-tuples / tuples shorter
;; than N never match and are passed through unchanged.
(define
er-ext-tup-elem
(fn (tup n)
(if (er-tuple? tup)
(let ((es (get tup :elements)))
(if (and (>= n 1) (<= n (len es))) (nth es (- n 1)) nil))
nil)))
(define
er-ext-key-match?
(fn (key n tup)
(and
(er-tuple? tup)
(>= n 1)
(<= n (len (get tup :elements)))
(er-equal? key (nth (get tup :elements) (- n 1))))))
(define
er-ext-keyfind
(fn (key n lst)
(cond
(er-nil? lst) (er-mk-atom "false")
(er-cons? lst)
(if (er-ext-key-match? key n (get lst :head))
(get lst :head)
(er-ext-keyfind key n (get lst :tail)))
:else (er-mk-atom "false"))))
(define
er-ext-keydelete
(fn (key n lst)
(cond
(er-nil? lst) (er-mk-nil)
(er-cons? lst)
(if (er-ext-key-match? key n (get lst :head))
(get lst :tail)
(er-mk-cons (get lst :head) (er-ext-keydelete key n (get lst :tail))))
:else lst)))
(define
er-ext-keyreplace
(fn (key n lst new)
(cond
(er-nil? lst) (er-mk-nil)
(er-cons? lst)
(if (er-ext-key-match? key n (get lst :head))
(er-mk-cons new (get lst :tail))
(er-mk-cons (get lst :head) (er-ext-keyreplace key n (get lst :tail) new)))
:else lst)))
(define
er-ext-keystore
(fn (key n lst new)
(cond
(er-nil? lst) (er-mk-cons new (er-mk-nil))
(er-cons? lst)
(if (er-ext-key-match? key n (get lst :head))
(er-mk-cons new (get lst :tail))
(er-mk-cons (get lst :head) (er-ext-keystore key n (get lst :tail) new)))
:else lst)))
(define
er-bif-lists-keyfind
(fn (vs) (er-ext-keyfind (nth vs 0) (nth vs 1) (nth vs 2))))
(define
er-bif-lists-keymember
(fn (vs)
(er-bool (not (er-atom? (er-ext-keyfind (nth vs 0) (nth vs 1) (nth vs 2)))))))
(define
er-bif-lists-keydelete
(fn (vs) (er-ext-keydelete (nth vs 0) (nth vs 1) (nth vs 2))))
(define
er-bif-lists-keyreplace
(fn (vs) (er-ext-keyreplace (nth vs 0) (nth vs 1) (nth vs 2) (nth vs 3))))
(define
er-bif-lists-keystore
(fn (vs) (er-ext-keystore (nth vs 0) (nth vs 1) (nth vs 2) (nth vs 3))))
(define
er-bif-lists-keytake
(fn (vs)
(let ((key (nth vs 0)) (n (nth vs 1)) (lst (nth vs 2)))
(let ((hit (er-ext-keyfind key n lst)))
(if (er-atom? hit)
(er-mk-atom "false")
(er-mk-tuple
(list (er-mk-atom "value") hit (er-ext-keydelete key n lst))))))))
(define
er-bif-lists-keysort
(fn (vs)
(let ((n (nth vs 0)) (lst (nth vs 1)))
(er-sxlist->cons
(er-ext-msort
(er-cons->sxlist lst)
(fn (a b)
(er-bool
(not (er-ext-lt? (er-ext-tup-elem b n) (er-ext-tup-elem a n))))))))))
;; ── higher-order traversal (foldr / partition / *while) ───────────
(define
er-ext-foldr
(fn (f acc lst)
(cond
(er-nil? lst) acc
(er-cons? lst)
(er-apply-fun f (list (get lst :head) (er-ext-foldr f acc (get lst :tail))))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-foldr
(fn (vs) (er-ext-foldr (nth vs 0) (nth vs 1) (nth vs 2))))
(define
er-ext-partition
(fn (pred lst yes no)
(cond
(er-nil? lst)
(er-mk-tuple
(list
(er-list-reverse-iter yes (er-mk-nil))
(er-list-reverse-iter no (er-mk-nil))))
(er-cons? lst)
(if (er-truthy? (er-apply-fun pred (list (get lst :head))))
(er-ext-partition pred (get lst :tail) (er-mk-cons (get lst :head) yes) no)
(er-ext-partition pred (get lst :tail) yes (er-mk-cons (get lst :head) no)))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-partition
(fn (vs) (er-ext-partition (nth vs 0) (nth vs 1) (er-mk-nil) (er-mk-nil))))
(define
er-ext-takewhile
(fn (pred lst)
(cond
(er-nil? lst) (er-mk-nil)
(er-cons? lst)
(if (er-truthy? (er-apply-fun pred (list (get lst :head))))
(er-mk-cons (get lst :head) (er-ext-takewhile pred (get lst :tail)))
(er-mk-nil))
:else (er-mk-nil))))
(define
er-bif-lists-takewhile
(fn (vs) (er-ext-takewhile (nth vs 0) (nth vs 1))))
(define
er-ext-dropwhile
(fn (pred lst)
(cond
(er-nil? lst) (er-mk-nil)
(er-cons? lst)
(if (er-truthy? (er-apply-fun pred (list (get lst :head))))
(er-ext-dropwhile pred (get lst :tail))
lst)
:else lst)))
(define
er-bif-lists-dropwhile
(fn (vs) (er-ext-dropwhile (nth vs 0) (nth vs 1))))
(define
er-bif-lists-splitwith
(fn (vs)
(let ((pred (nth vs 0)) (lst (nth vs 1)))
(er-mk-tuple
(list (er-ext-takewhile pred lst) (er-ext-dropwhile pred lst))))))
;; ── structural / aggregate (flatten / max / min) ──────────────────
(define
er-ext-flatten
(fn (lst)
(cond
(er-nil? lst) (er-mk-nil)
(er-cons? lst)
(let ((h (get lst :head)))
(if (or (er-nil? h) (er-cons? h))
(er-list-append (er-ext-flatten h) (er-ext-flatten (get lst :tail)))
(er-mk-cons h (er-ext-flatten (get lst :tail)))))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-flatten
(fn (vs) (er-ext-flatten (er-bif-arg1 vs "lists:flatten"))))
(define
er-ext-extreme
(fn (lst best lt?)
(cond
(er-nil? lst) best
(er-cons? lst)
(er-ext-extreme
(get lst :tail)
(if (lt? best (get lst :head)) (get lst :head) best)
lt?)
:else best)))
(define
er-bif-lists-max
(fn (vs)
(let ((lst (er-bif-arg1 vs "lists:max")))
(if (er-cons? lst)
(er-ext-extreme (get lst :tail) (get lst :head)
(fn (a b) (er-ext-lt? a b)))
(raise (er-mk-error-marker (er-mk-atom "badarg")))))))
(define
er-bif-lists-min
(fn (vs)
(let ((lst (er-bif-arg1 vs "lists:min")))
(if (er-cons? lst)
(er-ext-extreme (get lst :tail) (get lst :head)
(fn (a b) (er-ext-lt? b a)))
(raise (er-mk-error-marker (er-mk-atom "badarg")))))))
;; ── zip family (zip / zipwith / unzip) ────────────────────────────
;; Length mismatch raises badarg (real Erlang raises function_clause;
;; badarg is the closest in-port equivalent).
(define
er-ext-zip
(fn (a b)
(cond
(and (er-nil? a) (er-nil? b)) (er-mk-nil)
(and (er-cons? a) (er-cons? b))
(er-mk-cons
(er-mk-tuple (list (get a :head) (get b :head)))
(er-ext-zip (get a :tail) (get b :tail)))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-zip
(fn (vs) (er-ext-zip (nth vs 0) (nth vs 1))))
(define
er-ext-zipwith
(fn (f a b)
(cond
(and (er-nil? a) (er-nil? b)) (er-mk-nil)
(and (er-cons? a) (er-cons? b))
(er-mk-cons
(er-apply-fun f (list (get a :head) (get b :head)))
(er-ext-zipwith f (get a :tail) (get b :tail)))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-zipwith
(fn (vs) (er-ext-zipwith (nth vs 0) (nth vs 1) (nth vs 2))))
(define
er-ext-unzip
(fn (lst as bs)
(cond
(er-nil? lst)
(er-mk-tuple
(list
(er-list-reverse-iter as (er-mk-nil))
(er-list-reverse-iter bs (er-mk-nil))))
(and (er-cons? lst) (er-tuple? (get lst :head)))
(let ((es (get (get lst :head) :elements)))
(if (= (len es) 2)
(er-ext-unzip (get lst :tail)
(er-mk-cons (nth es 0) as)
(er-mk-cons (nth es 1) bs))
(raise (er-mk-error-marker (er-mk-atom "badarg")))))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-unzip
(fn (vs)
(er-ext-unzip (er-bif-arg1 vs "lists:unzip") (er-mk-nil) (er-mk-nil))))
;; ── slicing (sublist / nthtail / split / droplast) ────────────────
(define
er-ext-sublist2
(fn (lst n)
(cond
(or (<= n 0) (er-nil? lst)) (er-mk-nil)
(er-cons? lst)
(er-mk-cons (get lst :head) (er-ext-sublist2 (get lst :tail) (- n 1)))
:else (er-mk-nil))))
;; lenient drop (used by sublist/3); never raises
(define
er-ext-drop-cons
(fn (lst n)
(cond
(or (<= n 0) (er-nil? lst)) lst
(er-cons? lst) (er-ext-drop-cons (get lst :tail) (- n 1))
:else lst)))
;; strict drop (used by nthtail/2 + split/2); raises if list too short
(define
er-ext-nthtail
(fn (n lst)
(cond
(<= n 0) lst
(er-cons? lst) (er-ext-nthtail (- n 1) (get lst :tail))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-sublist
(fn (vs)
(cond
(= (len vs) 2) (er-ext-sublist2 (nth vs 0) (nth vs 1))
(= (len vs) 3)
(er-ext-sublist2
(er-ext-drop-cons (nth vs 0) (- (nth vs 1) 1))
(nth vs 2))
:else (error "Erlang: lists:sublist: wrong arity"))))
(define
er-bif-lists-nthtail
(fn (vs) (er-ext-nthtail (nth vs 0) (nth vs 1))))
(define
er-bif-lists-split
(fn (vs)
(let ((n (nth vs 0)) (lst (nth vs 1)))
(er-mk-tuple
(list (er-ext-sublist2 lst n) (er-ext-nthtail n lst))))))
(define
er-ext-droplast
(fn (lst)
(cond
(and (er-cons? lst) (er-nil? (get lst :tail))) (er-mk-nil)
(er-cons? lst) (er-mk-cons (get lst :head) (er-ext-droplast (get lst :tail)))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-droplast
(fn (vs) (er-ext-droplast (er-bif-arg1 vs "lists:droplast"))))
;; ── more higher-order (flatmap / filtermap / mapfoldl / search) ───
(define
er-ext-flatmap
(fn (f lst)
(cond
(er-nil? lst) (er-mk-nil)
(er-cons? lst)
(er-list-append
(er-apply-fun f (list (get lst :head)))
(er-ext-flatmap f (get lst :tail)))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-flatmap
(fn (vs) (er-ext-flatmap (nth vs 0) (nth vs 1))))
(define
er-ext-atom-true?
(fn (v) (and (er-atom? v) (= (get v :name) "true"))))
(define
er-ext-filtermap
(fn (f lst)
(cond
(er-nil? lst) (er-mk-nil)
(er-cons? lst)
(let ((r (er-apply-fun f (list (get lst :head)))))
(cond
(er-ext-atom-true? r)
(er-mk-cons (get lst :head) (er-ext-filtermap f (get lst :tail)))
(and
(er-tuple? r)
(= (len (get r :elements)) 2)
(er-ext-atom-true? (nth (get r :elements) 0)))
(er-mk-cons (nth (get r :elements) 1) (er-ext-filtermap f (get lst :tail)))
:else (er-ext-filtermap f (get lst :tail))))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-filtermap
(fn (vs) (er-ext-filtermap (nth vs 0) (nth vs 1))))
(define
er-ext-mapfoldl
(fn (f acc lst mapped)
(cond
(er-nil? lst)
(er-mk-tuple (list (er-list-reverse-iter mapped (er-mk-nil)) acc))
(er-cons? lst)
(let ((r (er-apply-fun f (list (get lst :head) acc))))
(let ((es (get r :elements)))
(er-ext-mapfoldl f (nth es 1) (get lst :tail)
(er-mk-cons (nth es 0) mapped))))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
(define
er-bif-lists-mapfoldl
(fn (vs) (er-ext-mapfoldl (nth vs 0) (nth vs 1) (nth vs 2) (er-mk-nil))))
(define
er-ext-search
(fn (pred lst)
(cond
(er-nil? lst) (er-mk-atom "false")
(er-cons? lst)
(if (er-truthy? (er-apply-fun pred (list (get lst :head))))
(er-mk-tuple (list (er-mk-atom "value") (get lst :head)))
(er-ext-search pred (get lst :tail)))
:else (er-mk-atom "false"))))
(define
er-bif-lists-search
(fn (vs) (er-ext-search (nth vs 0) (nth vs 1))))
;; ── proplists module ──────────────────────────────────────────────
;; A property list element is either a bare atom A (shorthand for
;; {A, true}) or a tuple whose first element is the key (value = its
;; second element, or true for a 1-tuple). Lookups use the FIRST match.
(define
er-ext-pl-key-of
(fn (e)
(cond
(er-atom? e) e
(and (er-tuple? e) (>= (len (get e :elements)) 1)) (nth (get e :elements) 0)
:else nil)))
(define
er-ext-pl-val-of
(fn (e)
(cond
(and (er-tuple? e) (>= (len (get e :elements)) 2)) (nth (get e :elements) 1)
:else (er-mk-atom "true"))))
(define
er-ext-pl-match?
(fn (key e)
(let ((k (er-ext-pl-key-of e)))
(and (not (= k nil)) (er-equal? key k)))))
(define
er-ext-pl-get-value
(fn (key lst default)
(cond
(er-nil? lst) default
(er-cons? lst)
(if (er-ext-pl-match? key (get lst :head))
(er-ext-pl-val-of (get lst :head))
(er-ext-pl-get-value key (get lst :tail) default))
:else default)))
(define
er-bif-pl-get-value
(fn (vs)
(cond
(= (len vs) 2)
(er-ext-pl-get-value (nth vs 0) (nth vs 1) (er-mk-atom "undefined"))
(= (len vs) 3)
(er-ext-pl-get-value (nth vs 0) (nth vs 1) (nth vs 2))
:else (error "Erlang: proplists:get_value: wrong arity"))))
(define
er-ext-pl-all
(fn (key lst acc)
(cond
(er-nil? lst) (er-list-reverse-iter acc (er-mk-nil))
(er-cons? lst)
(er-ext-pl-all key (get lst :tail)
(if (er-ext-pl-match? key (get lst :head))
(er-mk-cons (er-ext-pl-val-of (get lst :head)) acc)
acc))
:else (er-list-reverse-iter acc (er-mk-nil)))))
(define
er-bif-pl-get-all-values
(fn (vs) (er-ext-pl-all (nth vs 0) (nth vs 1) (er-mk-nil))))
(define
er-ext-pl-defined?
(fn (key lst)
(cond
(er-nil? lst) false
(er-cons? lst)
(if (er-ext-pl-match? key (get lst :head))
true
(er-ext-pl-defined? key (get lst :tail)))
:else false)))
(define
er-bif-pl-is-defined
(fn (vs) (er-bool (er-ext-pl-defined? (nth vs 0) (nth vs 1)))))
(define
er-ext-pl-lookup
(fn (key lst)
(cond
(er-nil? lst) (er-mk-atom "none")
(er-cons? lst)
(if (er-ext-pl-match? key (get lst :head))
(let ((e (get lst :head)))
(if (er-tuple? e) e (er-mk-tuple (list e (er-mk-atom "true")))))
(er-ext-pl-lookup key (get lst :tail)))
:else (er-mk-atom "none"))))
(define
er-bif-pl-lookup
(fn (vs) (er-ext-pl-lookup (nth vs 0) (nth vs 1))))
(define
er-ext-pl-delete
(fn (key lst)
(cond
(er-nil? lst) (er-mk-nil)
(er-cons? lst)
(if (er-ext-pl-match? key (get lst :head))
(er-ext-pl-delete key (get lst :tail))
(er-mk-cons (get lst :head) (er-ext-pl-delete key (get lst :tail))))
:else lst)))
(define
er-bif-pl-delete
(fn (vs) (er-ext-pl-delete (nth vs 0) (nth vs 1))))

1
next/.gitignore vendored
View File

@@ -1 +0,0 @@
data/

View File

@@ -1,170 +0,0 @@
# next — fed-sx Milestone 1 kernel
Single-instance, single-actor fed-sx server built as Erlang-on-SX modules.
See `plans/fed-sx-design.md` for the architecture and
`plans/fed-sx-milestone-1.md` for the build plan + per-step progress log.
## Status
Both Step 9 smoke proof points are functional **in-process**:
- **9a-pure (verb extensibility)** — `Create{DefineActivity{Pin}}` registers Pin
at runtime; subsequent `Pin{path, cid}` activities fold into a pin-state
projection. Zero kernel code between definition and use.
See `next/tests/smoke_pin_pure.sh`.
- **9b-pure (reactive application)** — A trigger projection matches Notes
tagged `smoketest` and derives a `TestEcho` carrying the source CID.
See `next/tests/smoke_app_pure.sh`.
The remaining `9a-tcp` / `9b-tcp` deliverables layer TCP transport on top — see
*Substrate gaps* below.
## Layout
```
next/
├── kernel/ Erlang-on-SX kernel modules (.erl)
├── genesis/ SX source files for the bootstrap bundle
├── tests/ Bash test scripts driving sx_server.exe via the epoch protocol
└── data/ Runtime state — gitignored
```
## Module map
| Module | Role |
|-----------------------|------------------------------------------------------------------------|
| `nx_cid.erl` | Canonical CID wrapper around the host `cid:to_string` BIF |
| `envelope.erl` | Activity envelope shape, canonical bytes, time-aware sig verify |
| `log.erl` | Per-actor in-memory append log (open / append / tip / replay / entries) |
| `registry.erl` | Pure-functional + gen_server-wrapped registry keyed by Kind |
| `pipeline.erl` | Validation driver + stage_envelope/signature/replay/schema |
| `projection.erl` | Pure projection driver + gen_server-per-projection wrapper |
| `outbox.erl` | Envelope construct + sign + publish orchestrator + broadcast |
| `bootstrap.erl` | Genesis read/build/verify/load + one-call `start/3` kernel bring-up |
| `define_registry.erl` | Meta-projection fold for `Create{Define*}` → registry |
| `sandbox.erl` | `eval_pure/2,3` try/catch envelope for projection folds |
| `nx_kernel.erl` | Long-lived runtime orchestrator; per-actor bucketed state (m2 Step 1a) |
| `http_server.erl` | route/1,2 + format-aware GET + POST + Accept header content negotiation |
## Genesis bundle
`next/genesis/` contains 31 SX files across 7 sections, all consumed as data
(read + serialised by `bootstrap:populate_registry`, not eval'd):
- 3 activity-types — Create, Update, Delete
- 10 object-types — SXArtifact, Note, Tombstone, 6 Define* meta-types, Snapshot
- 7 projections — activity-log, by-type, by-actor, by-object, actor-state,
define-registry, audience-graph
- 3 validators — envelope-shape, signature, type-schema
- 3 codecs — dag-cbor, raw, dag-json
- 2 sig-suites — rsa-sha256-2018, ed25519-2020
- 3 audience predicates — Public, Followers, Direct
`manifest.sx` is the bundle root, listed in dependency-friendly order.
## Tests
43 test suites, ~560+ assertions. Each script drives `sx_server.exe` via the
epoch protocol — loads the Erlang substrate, loads relevant kernel modules
via `code:load_binary` / `erlang-load-module`, then exercises behaviour
through `erlang-eval-ast`.
Conventions:
- Scripts marked `_pure.sh` exercise pure-functional state.
- Scripts marked `_server.sh` (or no suffix) exercise gen_server APIs and
must inline `start_link` with operations — the Erlang-on-SX scheduler
doesn't preserve spawned processes across separate `erlang-eval-ast`
invocations.
- `smoke_*_pure.sh` are end-to-end smoke tests demonstrating the §Step 9
proof points without TCP / curl / JSON.
The Erlang-on-SX conformance gate (`bash lib/erlang/conformance.sh`, **729 /
729**) is the no-regression contract — every commit on `loops/fed-sx-m1`
preserves it.
## Substrate
Each `.erl` source file is hot-loaded at boot via
`code:load_binary(Mod, Filename, SourceString)` (Phase 7 BIF). Tests drive
the runtime via the epoch protocol:
```bash
printf '(epoch 1)\n(load "lib/erlang/runtime.sx")\n(epoch 2)\n<test-expr>\n' \
| hosts/ocaml/_build/default/bin/sx_server.exe
```
The kernel calls into these host primitives: `crypto:hash/2`,
`cid:from_bytes/1`, `cid:to_string/1`, `file:read_file/1`, `file:write_file/2`,
`file:delete/1`, `file:list_dir/1`, `code:load_binary/3`, plus `http:listen/2`
(the briefing's allowed scope exception, added to `lib/erlang/runtime.sx`).
### Substrate gaps (parked work)
These three gaps block the remaining unchecked deliverables:
1. **Term codec** (`3b`/`3c`) — **all three substrate fixes done 2026-06-05:**
`erlang:binary_to_list/1` and `erlang:list_to_binary/1` registered in
`lib/erlang/runtime.sx` (iolist-aware); the tokenizer's `$X` branch
emits the decimal char code; `atom_to_list/1` and `integer_to_list/1`
now return Erlang charlists (standard Erlang semantics) with `list_to_atom`/
`list_to_integer` accepting both charlists and SX strings for back-compat.
759/759 conformance. The full term-codec primitive set is in place —
Step 3b on-disk segment writer can encode arbitrary Erlang activity
terms (atoms, ints, binaries, tuples, lists) into byte sequences using
only Erlang-native primitives.
2. **SX-source eval bridge** — There's no BIF that lets Erlang call into the
SX evaluator on a parsed source string. Blocks evaluating the `:schema` /
`:fold` / `:predicate` / `:verify` bodies from the genesis bundle. Erlang-fun
stand-ins (`pipeline:stage_schema`, `define_registry:fold`, etc.) prove the
API shapes; the bridge would let bundle bodies dispatch through them
unchanged.
3. **Dict ↔ proplist marshalling for `http:listen/2`****done 2026-06-05.**
`er-bif-http-listen` marshals the native server's request dict
(`{:method :path :query :headers :body}`) into the proplist shape
`[{method, Bin}, {path, Bin}, {query, Bin}, {headers, [{Name, Value}]},
{body, Bin}]` that `http_server:route/2` consumes, and converts the
handler's response proplist back to `{:status :headers :body}` for the
native server to serialise. Helpers (`er-request-dict-to-proplist`,
`er-proplist-to-dict`, `er-of-sx-deep`, `er-to-sx-deep`,
`er-dict-to-header-proplist`, `er-proplist-fill!`) live alongside the
BIF wrapper in `lib/erlang/runtime.sx`. The BIF also spawns the handler
into a real Erlang process via `er-spawn-fun` + `er-sched-run-all!`
so `self()` / `gen_server:call` work inside route handlers (the kernel
and projection gen_servers reach the handler this way). Verified by
`next/tests/http_marshal.sh` and the live TCP smoke
`next/tests/http_server_tcp.sh` / `http_server_start.sh`. Unblocks
`Step 8b-start` (TCP listener spawn) and the curl-driven 9a-tcp / 9b-tcp
smoke tests.
### Bringing up the kernel
For tests, `bootstrap:start/3(ActorId, KeySpec, ActorState)` is the
one-call boot:
```erlang
KM = <<1,2,3,4>>,
KS = [{key_id, k1}, {algorithm, ed25519}, {value, KM}],
AS = [{public_keys, [[{id, k1}, {created, 0}, {value, KM}]]}],
Pid = bootstrap:start(alice, KS, AS),
%% nx_kernel + registry populated; you now have a kernel.
```
The HTTP layer (`http_server`) and `nx_kernel:publish/1` flow through the
same in-process gen_servers; `http_publish_fold.sh` is the end-to-end proof
the chain works.
## What's next (when work resumes)
In priority order:
1. **8b-start**`http_server:start/1` spawns a process hosting `http:listen/2`.
(8b-bridge done — see Substrate gap #3.)
2. **9a-tcp / 9b-tcp** — replace the in-process smoke scripts with curl-driven
versions hitting the running server.
3. **Term codec / on-disk log** — needs either a new BIF or a temp-file
workaround; current in-memory log keeps everything functional otherwise.
4. **SX-source eval bridge** — unlocks real `:schema` / `:fold` body
evaluation from the genesis bundle.

View File

View File

@@ -1,14 +0,0 @@
;; next/genesis/activity-types/announce.sx
;;
;; Bootstrap definition of the Announce verb per design §13.5 / m2
;; Step 11. An Announce re-broadcasts a peer's activity to the
;; announcer's followers: the announcer's outbox carries an Announce
;; envelope whose :object is the original activity's CID. Followers
;; can re-fetch the wrapped activity from the original instance if
;; their projection wants to fold the body.
(DefineActivity
:name "Announce"
:doc "Re-broadcast a peer's activity to followers. :object is the CID of the activity being announced. Recipients see the Announce in their inbox / feed; their projection decides whether to fetch the wrapped activity body."
:schema (fn (act) (string? (-> act :object)))
:semantics (fn (state act) state))

View File

@@ -1,15 +0,0 @@
;; next/genesis/activity-types/create.sx
;;
;; Bootstrap definition of the Create verb per design §3 and §12.2.
;; Read as data by the bundler (bootstrap.erl) — never evaluated as
;; code. The :schema and :semantics bodies are SX source; the
;; validation pipeline (Step 6) and projection scheduler (Step 7)
;; evaluate them at the appropriate times.
(DefineActivity
:name "Create"
:doc "Publish a new object. Required for actor onboarding and for\n every Define* meta-activity. The activity's :object holds\n the canonical content of the published object."
:schema (fn
(act)
(and (not (nil? (-> act :object))) (string? (-> act :object :type))))
:semantics (fn (state act) state))

View File

@@ -1,13 +0,0 @@
;; next/genesis/activity-types/delete.sx
;;
;; Bootstrap definition of the Delete verb per design §3 and §12.2.
;; Read as data by the bundler — never evaluated as code here. The
;; :schema and :semantics bodies are SX source; the validator
;; pipeline (Step 6) and projection scheduler (Step 7) evaluate them
;; at the appropriate times.
(DefineActivity
:name "Delete"
:doc "Tombstone an existing object. :object is the CID of the\n target. Projections fold Delete by removing the object from\n their working indexes; the underlying log line is never\n erased — durability of the historical record is independent\n of projection state."
:schema (fn (act) (string? (-> act :object)))
:semantics (fn (state act) state))

View File

@@ -1,13 +0,0 @@
;; next/genesis/activity-types/endorse.sx
;;
;; Bootstrap definition of the Endorse verb per design §13.5 / m2
;; Step 11. An Endorse expresses cross-actor signal on a target
;; activity (like / share / etc.). :object is the target activity's
;; CID; :kind is the endorsement variant (string). Projections
;; aggregate endorsements into counters / heat / ranking signals.
(DefineActivity
:name "Endorse"
:doc "Cross-actor signal on a target activity. :object is the target activity's CID; :kind is the endorsement variant (e.g. 'like', 'share'). Projections aggregate endorsements into counters / heat / ranking signals."
:schema (fn (act) (and (string? (-> act :object)) (string? (-> act :kind))))
:semantics (fn (state act) state))

View File

@@ -1,15 +0,0 @@
;; next/genesis/activity-types/update.sx
;;
;; Bootstrap definition of the Update verb per design §3 and §12.2.
;; Read as data by the bundler — never evaluated as code here. The
;; :schema and :semantics bodies are SX source; the validator
;; pipeline (Step 6) and projection scheduler (Step 7) evaluate them
;; at the appropriate times.
(DefineActivity
:name "Update"
:doc "Patch or replace an existing object. :object is the CID of\n the target; :patch is the field-level edit. Behaviour is\n delegated to per-object-type semantics — e.g. an Update of a\n DefineActivity supersedes the prior registry entry; an\n Update of a Person actor rotates keys via :patch :add-publicKey\n + :patch :supersede."
:schema (fn
(act)
(and (string? (-> act :object)) (not (nil? (-> act :patch)))))
:semantics (fn (state act) state))

View File

@@ -1,14 +0,0 @@
;; next/genesis/audience/direct.sx
;;
;; Direct audience: an actor is a member iff they are
;; explicitly named in the activity's :to or :cc lists. No
;; group expansion — true direct addressing only.
(DefineAudience
:name "Direct"
:doc "Direct-addressing predicate. Tests literal membership\n in the activity's :to or :cc."
:member-of (fn
(actor audience)
(or
(member? actor (-> audience :to))
(member? actor (-> audience :cc)))))

View File

@@ -1,14 +0,0 @@
;; next/genesis/audience/followers.sx
;;
;; Followers audience: an actor is a member iff they appear in
;; the audience-owner's :followers set in the audience-graph
;; projection. Federation (m2) wires this to peer delivery.
(DefineAudience
:name "Followers"
:doc "Followers-of-owner predicate. Looks up the\n audience-graph projection's :followers list for the\n audience owner and tests membership."
:member-of (fn
(actor audience)
(member?
actor
(-> (get-projection :audience-graph) (-> audience :owner) :followers))))

View File

@@ -1,9 +0,0 @@
;; next/genesis/audience/public.sx
;;
;; Public audience: every actor is a member. Maps to the AP
;; magic id `https://www.w3.org/ns/activitystreams#Public`.
(DefineAudience
:name "Public"
:doc "Public audience predicate. Always returns true — every\n actor on the network is considered a member."
:member-of (fn (actor audience) true))

View File

@@ -1,13 +0,0 @@
;; next/genesis/codecs/dag-cbor.sx
;;
;; Canonical CBOR encoding per IPLD dag-cbor. Used to compute
;; envelope canonical bytes for signature coverage and to serialise
;; the genesis bundle itself. In Erlang-on-SX mode the kernel
;; dispatches to the host cid:to_string substrate (Step 1b) when
;; this codec is requested.
(DefineCodec
:name "dag-cbor"
:doc "Deterministic CBOR with dag-cbor restrictions: sorted\n map keys, no floats unless required, no indefinite-length\n items. The canonical wire format for fed-sx artifacts."
:encode (fn (term) (host-codec :dag-cbor :encode term))
:decode (fn (bytes) (host-codec :dag-cbor :decode bytes)))

View File

@@ -1,12 +0,0 @@
;; next/genesis/codecs/dag-json.sx
;;
;; JSON encoding with dag-json restrictions per IPLD: sorted map
;; keys, no NaN / Infinity, no comments, CIDs as `{"/": "..."}`.
;; Used as the human-readable wire format for ActivityPub interop
;; (JSON-LD over dag-json).
(DefineCodec
:name "dag-json"
:doc "Deterministic JSON with dag-json restrictions. Sorted\n keys, CIDs as the {\"/\": \"...\"} object. Used by the\n HTTP server (Step 8) for application/json responses."
:encode (fn (term) (host-codec :dag-json :encode term))
:decode (fn (bytes) (host-codec :dag-json :decode bytes)))

View File

@@ -1,12 +0,0 @@
;; next/genesis/codecs/raw.sx
;;
;; Identity codec — input bytes pass through unchanged in both
;; directions. Used for already-encoded payloads and for binary
;; artifacts (images, archives) whose CID is computed over the
;; raw bytes directly.
(DefineCodec
:name "raw"
:doc "Identity codec. The CID's multicodec byte is 0x55.\n :encode and :decode return their input unchanged."
:encode (fn (bytes) bytes)
:decode (fn (bytes) bytes))

View File

@@ -1,51 +0,0 @@
;; next/genesis/manifest.sx
;;
;; Genesis bundle root per design §12.2. Lists every definition file
;; that gets packed into the bundle. The bundler (bootstrap.erl)
;; walks this manifest, reads each referenced file, parses its
;; top-level form, and inserts it into the bundle dict at the
;; appropriate section path.
;;
;; The bundle CID is the content-address of the resulting dag-cbor
;; (or v1 stand-in) blob over the assembled dict. That CID is
;; baked into the kernel at build time and re-verified on startup
;; per design §12.3.
;;
;; Section values are bare parenthesised paths (data lists, not
;; function calls) — the manifest is consumed by `parse`, not
;; `eval`. Empty sections are written as `()`.
(GenesisManifest
:version "0.0.1"
:kernel-version "1.0.0-m1"
:activity-types ("activity-types/create.sx"
"activity-types/update.sx"
"activity-types/delete.sx"
"activity-types/announce.sx"
"activity-types/endorse.sx")
:object-types ("object-types/sx-artifact.sx"
"object-types/note.sx"
"object-types/tombstone.sx"
"object-types/person.sx"
"object-types/service.sx"
"object-types/group.sx"
"object-types/define-activity.sx"
"object-types/define-object.sx"
"object-types/define-projection.sx"
"object-types/define-validator.sx"
"object-types/define-codec.sx"
"object-types/define-sig-suite.sx"
"object-types/snapshot.sx")
:projections ("projections/activity-log.sx"
"projections/by-type.sx"
"projections/by-actor.sx"
"projections/by-object.sx"
"projections/actor-state.sx"
"projections/define-registry.sx"
"projections/audience-graph.sx")
:validators ("validators/envelope-shape.sx"
"validators/signature.sx"
"validators/type-schema.sx")
:codecs ("codecs/dag-cbor.sx" "codecs/raw.sx" "codecs/dag-json.sx")
:sig-suites ("sig-suites/rsa-sha256-2018.sx" "sig-suites/ed25519-2020.sx")
:audience ("audience/public.sx" "audience/followers.sx" "audience/direct.sx"))

View File

@@ -1,12 +0,0 @@
;; next/genesis/object-types/define-activity.sx
;;
;; Meta-object that registers a new activity verb. Published as
;; Create{DefineActivity{...}}; the define-registry projection
;; folds it into the activity-types registry. Per design §5.
(DefineObject
:name "DefineActivity"
:doc "Activity-type registration. :name is the verb (e.g.\n \"Pin\"); :schema is an SX predicate over activity\n envelopes; :semantics is an optional state-fold body."
:schema (fn
(obj)
(and (string? (-> obj :name)) (not (nil? (-> obj :schema))))))

View File

@@ -1,15 +0,0 @@
;; next/genesis/object-types/define-codec.sx
;;
;; Meta-object that registers a content codec — an encode/decode
;; pair. The bootstrap bundle ships dag-cbor, raw, and dag-json
;; codecs; new codecs can be added via Create{DefineCodec{...}}.
(DefineObject
:name "DefineCodec"
:doc "Codec registration. :name identifies the codec ('dag-cbor',\n 'raw', 'dag-json', ...); :encode and :decode are the\n SX bodies the kernel calls when serialising / parsing\n artifacts under this codec."
:schema (fn
(obj)
(and
(string? (-> obj :name))
(not (nil? (-> obj :encode)))
(not (nil? (-> obj :decode))))))

View File

@@ -1,12 +0,0 @@
;; next/genesis/object-types/define-object.sx
;;
;; Meta-object that registers a new object-type. Bootstrap-level —
;; runtime registration of new object types (e.g. DefineSubscription
;; in the Step 9b smoke test) flows through this.
(DefineObject
:name "DefineObject"
:doc "Object-type registration. :name is the type tag (e.g.\n \"PinSpec\"); :schema is an SX predicate over object\n forms of that type."
:schema (fn
(obj)
(and (string? (-> obj :name)) (not (nil? (-> obj :schema))))))

View File

@@ -1,16 +0,0 @@
;; next/genesis/object-types/define-projection.sx
;;
;; Meta-object that registers a new projection. The projection
;; scheduler (Step 7) spawns one gen_server per registered
;; projection and feeds activities through its :fold body in
;; sandbox mode.
(DefineObject
:name "DefineProjection"
:doc "Projection registration. :name is the projection key;\n :initial-state is the empty state value; :fold is the\n pure (state activity) -> state function evaluated in\n sandbox mode per activity."
:schema (fn
(obj)
(and
(string? (-> obj :name))
(not (nil? (-> obj :initial-state)))
(not (nil? (-> obj :fold))))))

View File

@@ -1,12 +0,0 @@
;; next/genesis/object-types/define-sig-suite.sx
;;
;; Meta-object that registers a signature suite. Bootstrap ships
;; rsa-sha256-2018 and ed25519-2020; the suite name maps an
;; algorithm to a :verify body and a :key-format predicate.
(DefineObject
:name "DefineSigSuite"
:doc "Signature suite registration. :name identifies the suite\n ('rsa-sha256-2018', 'ed25519-2020', ...); :verify is the\n SX (canonical-bytes signature key) -> bool body; the\n envelope-signature validator dispatches by suite name."
:schema (fn
(obj)
(and (string? (-> obj :name)) (not (nil? (-> obj :verify))))))

View File

@@ -1,12 +0,0 @@
;; next/genesis/object-types/define-validator.sx
;;
;; Meta-object that registers a validator predicate. The validation
;; pipeline (Step 6) consults registered validators by name when
;; running its stages.
(DefineObject
:name "DefineValidator"
:doc "Validator registration. :name is the validator key (e.g.\n \"envelope-shape\"); :predicate is the SX (activity) ->\n ok|{error, R} body."
:schema (fn
(obj)
(and (string? (-> obj :name)) (not (nil? (-> obj :predicate))))))

View File

@@ -1,11 +0,0 @@
;; next/genesis/object-types/group.sx
;;
;; Per design §9.1: a Group is a multi-controller actor — typically
;; a working group, channel, or collective whose membership is
;; managed via Add/Remove activities. Sig-suite validation honours
;; the current key-set rather than a single keypair.
(DefineObject
:name "Group"
:doc "Multi-controller actor. :name is the group's display name; :preferredUsername is the local handle; :summary is the description; :icon is a CID or URL; :members is the current member list (managed via Add/Remove)."
:schema (fn (obj) (string? (-> obj :name))))

View File

@@ -1,10 +0,0 @@
;; next/genesis/object-types/note.sx
;;
;; Short message intended for an audience, ActivityPub-Note-compatible.
;; Used by the Step 9b reactive smoke test (Note tagged "smoketest"
;; matches the Topic subscription).
(DefineObject
:name "Note"
:doc "Short authored message. :content is the body text;\n :tags is a list of subscription-routable tags."
:schema (fn (obj) (string? (-> obj :content))))

View File

@@ -1,11 +0,0 @@
;; next/genesis/object-types/person.sx
;;
;; Per design §9.1: a Person is the canonical actor type for a
;; human-controlled identity. Bootstrapped via Create{Person{...}}
;; as the actor's first activity (see nx_kernel:bootstrap_actor/4).
;; ActivityPub-Person-compatible.
(DefineObject
:name "Person"
:doc "Human-controlled actor. :name is the display name; :preferredUsername is the local handle; :summary is the profile bio; :icon is a CID or URL."
:schema (fn (obj) (string? (-> obj :name))))

View File

@@ -1,11 +0,0 @@
;; next/genesis/object-types/service.sx
;;
;; Per design §9.1: a Service is a non-human actor — a bot, an
;; automated feed, an organisational publisher. Same activity
;; surface as Person, different ActivityPub Actor type. Tooling
;; treats a Service identically to a Person except for UX hints.
(DefineObject
:name "Service"
:doc "Automated / programmatic actor. :name is the display name; :preferredUsername is the local handle; :summary is the profile bio; :icon is a CID or URL."
:schema (fn (obj) (string? (-> obj :name))))

View File

@@ -1,13 +0,0 @@
;; next/genesis/object-types/snapshot.sx
;;
;; Projection state checkpoint. The projection scheduler emits
;; Snapshot{projection-name, state-cid, log-seq} periodically;
;; cold starts read the most recent Snapshot and replay only
;; activities after :log-seq. Per design §10.5.
(DefineObject
:name "Snapshot"
:doc "Projection-state checkpoint. :projection-name identifies\n the projection; :state-cid is the content-address of\n the snapshotted state value; :log-seq is the activity\n sequence number the snapshot was taken at."
:schema (fn
(obj)
(and (string? (-> obj :projection-name)) (string? (-> obj :state-cid)))))

View File

@@ -1,10 +0,0 @@
;; next/genesis/object-types/sx-artifact.sx
;;
;; Content-addressed SX source — a library, component, or
;; executable form published via Create{SXArtifact{...}}.
;; Consumers reference an artifact by its CID. Per design §3.4.
(DefineObject
:name "SXArtifact"
:doc "Published SX source. :source carries the form text;\n :language is optional ('sx' by default); :imports lists\n CIDs the artifact depends on."
:schema (fn (obj) (string? (-> obj :source))))

View File

@@ -1,9 +0,0 @@
;; next/genesis/object-types/tombstone.sx
;;
;; Replacement for an object that has been Delete'd. Lets projection
;; folds keep a marker without retaining the deleted content.
(DefineObject
:name "Tombstone"
:doc "Marker for a deleted object. :former-cid carries the CID\n of the object that was removed. Projections fold Tombstone\n by replacing the cached entry (not by omitting it)."
:schema (fn (obj) (string? (-> obj :former-cid))))

View File

@@ -1,11 +0,0 @@
;; next/genesis/projections/activity-log.sx
;;
;; Identity projection: stores every activity by its CID. The
;; base ledger every other projection could be re-derived from
;; if needed. Per design §10.2.
(DefineProjection
:name "activity-log"
:doc "Maps activity CID to the full envelope. Every activity\n flows through; no filter. State is the CID-keyed dict."
:initial-state {}
:fold (fn (state act) (assoc state (-> act :cid) act)))

View File

@@ -1,26 +0,0 @@
;; next/genesis/projections/actor-state.sx
;;
;; Per-actor live state: publicKeys (with history per design §9.6),
;; profile fields (preferredUsername, summary, ...), follower/
;; following counts. Powers the actor doc endpoint and the
;; time-aware signature verification in envelope:verify_signature/2.
(DefineProjection
:name "actor-state"
:doc "Actor-id -> {publicKeys, profile, followers, following}.\n Updated by Create{Person|Service|Group}, Update (key\n rotation, profile edits), Move (federation migration)."
:initial-state {}
:fold (fn
(state act)
(let
((aid (-> act :actor)) (t (-> act :type)))
(cond
(= t "Create")
(assoc state aid (or (-> act :object) {}))
(= t "Update")
(assoc
state
aid
(merge
(or (get state aid) {})
(or (-> act :patch) {})))
:else state))))

View File

@@ -1,25 +0,0 @@
;; next/genesis/projections/audience-graph.sx
;;
;; Per-actor follow / follower graph and audience caches. Folded
;; from Follow / Accept / Reject / Undo{Follow}. Used by the
;; activity router to expand :to / :cc audiences (Public,
;; Followers, Direct) into concrete recipient sets. Per design §16.
(DefineProjection
:name "audience-graph"
:doc "Actor-id -> {following, followers, pending} sets.\n Updated by Follow / Accept / Reject / Undo. Federation\n (m2) wires this projection to the delivery queue."
:initial-state {}
:fold (fn
(state act)
(let
((t (-> act :type)))
(cond
(= t "Follow")
state
(= t "Accept")
state
(= t "Reject")
state
(= t "Undo")
state
:else state))))

View File

@@ -1,15 +0,0 @@
;; next/genesis/projections/by-actor.sx
;;
;; Index of activity CIDs grouped by :actor. Maps actor-id to a
;; list of CIDs in append order. Powers the per-actor outbox
;; listing (Step 8) without re-scanning the full log.
(DefineProjection
:name "by-actor"
:doc "Actor-id -> list of activity CIDs (append order)."
:initial-state {}
:fold (fn
(state act)
(let
((a (-> act :actor)) (cid (-> act :cid)))
(assoc state a (append (or (get state a) (list)) (list cid))))))

View File

@@ -1,22 +0,0 @@
;; next/genesis/projections/by-object.sx
;;
;; Index of activities that reference each :object CID. Maps
;; object-CID to the list of activity CIDs that target it
;; (Update / Delete / Announce / etc.). Used for "show me
;; everything that happened to X" queries.
(DefineProjection
:name "by-object"
:doc "Object CID -> list of activity CIDs that target it."
:initial-state {}
:fold (fn
(state act)
(let
((obj-cid (-> act :object)) (cid (-> act :cid)))
(if
(string? obj-cid)
(assoc
state
obj-cid
(append (or (get state obj-cid) (list)) (list cid)))
state))))

View File

@@ -1,15 +0,0 @@
;; next/genesis/projections/by-type.sx
;;
;; Index of activity CIDs grouped by :type. Maps type-name to a
;; list of CIDs in append order. Used by the outbox listing
;; endpoints (Step 8) for type-filtered pagination.
(DefineProjection
:name "by-type"
:doc "Type-name -> list of activity CIDs (append order)."
:initial-state {}
:fold (fn
(state act)
(let
((t (-> act :type)) (cid (-> act :cid)))
(assoc state t (append (or (get state t) (list)) (list cid))))))

View File

@@ -1,33 +0,0 @@
;; next/genesis/projections/define-registry.sx
;;
;; The meta-projection: folds Create{Define*{...}} activities into
;; the kernel registry. Resolves the chicken-and-egg circle —
;; bootstrap.erl populates the registry directly at startup from
;; the genesis bundle, and from then on define-registry's fold
;; keeps it current as new Define* activities arrive. Per design §5.
(DefineProjection
:name "define-registry"
:doc "Maps {kind, name} -> definition entry. Folded from\n Create{DefineActivity|DefineObject|DefineProjection|\n DefineValidator|DefineCodec|DefineSigSuite|...}. Kind is\n derived from the inner :object :type tag."
:initial-state {}
:fold (fn
(state act)
(let
((obj (-> act :object)) (otype (-> act :object :type)))
(cond
(= (-> act :type) "Create")
(cond
(= otype "DefineActivity")
(assoc-in state (list :activity-types (-> obj :name)) obj)
(= otype "DefineObject")
(assoc-in state (list :object-types (-> obj :name)) obj)
(= otype "DefineProjection")
(assoc-in state (list :projections (-> obj :name)) obj)
(= otype "DefineValidator")
(assoc-in state (list :validators (-> obj :name)) obj)
(= otype "DefineCodec")
(assoc-in state (list :codecs (-> obj :name)) obj)
(= otype "DefineSigSuite")
(assoc-in state (list :sig-suites (-> obj :name)) obj)
:else state)
:else state))))

View File

@@ -1,11 +0,0 @@
;; next/genesis/sig-suites/ed25519-2020.sx
;;
;; W3C Verifiable Credential signature suite — Ed25519 over
;; canonical bytes, key material in multibase. Default suite
;; for fed-sx actors per design §9.
(DefineSigSuite
:name "ed25519-2020"
:doc "Ed25519 verification. Key carries publicKeyMultibase.\n :verify takes canonical-bytes + signature + key and\n returns bool. Real verification deferred to m2 once\n crypto:verify_ed25519/3 BIF lands; v1 stand-in returns\n false to defer all Ed25519-signed activities."
:verify (fn (canonical-bytes signature key) false)
:key-format (fn (key-doc) (string? (-> key-doc :publicKeyMultibase))))

View File

@@ -1,11 +0,0 @@
;; next/genesis/sig-suites/rsa-sha256-2018.sx
;;
;; W3C Verifiable Credential signature suite — RSA-SHA256 over
;; canonical bytes, key material in PEM. Compatible with
;; Mastodon's HTTP-Signatures / Linked-Data-Signatures-2017.
(DefineSigSuite
:name "rsa-sha256-2018"
:doc "RSA-SHA256 verification. Key carries publicKeyPem.\n :verify takes canonical-bytes + signature + key and\n returns bool. Real verification deferred to m2 once\n crypto:verify_rsa/3 BIF lands; v1 stand-in returns\n false to defer all RSA-signed activities."
:verify (fn (canonical-bytes signature key) false)
:key-format (fn (key-doc) (string? (-> key-doc :publicKeyPem))))

View File

@@ -1,22 +0,0 @@
;; next/genesis/validators/envelope-shape.sx
;;
;; Validates required envelope fields per design §3.1. Stage 1 of
;; the validation pipeline (Step 6). Mirrors the kernel's
;; envelope:validate_shape/1 from Step 2a — when the pipeline runs
;; in OCaml-side sandbox eval mode it dispatches by name; when it
;; runs through the kernel Erlang path it short-circuits to the BIF.
(DefineValidator
:name "envelope-shape"
:doc "Required-fields check on the activity envelope:\n :id, :type, :actor, :published, :signature must all be\n present and non-nil. The :signature sub-field needs\n :key_id, :algorithm, :value."
:predicate (fn
(act)
(and
(not (nil? (-> act :id)))
(not (nil? (-> act :type)))
(not (nil? (-> act :actor)))
(not (nil? (-> act :published)))
(not (nil? (-> act :signature)))
(not (nil? (-> act :signature :key_id)))
(not (nil? (-> act :signature :algorithm)))
(not (nil? (-> act :signature :value))))))

View File

@@ -1,13 +0,0 @@
;; next/genesis/validators/signature.sx
;;
;; Stage 2 of the validation pipeline per design §14. Verifies the
;; activity signature against the time-relevant public key in the
;; actor-state projection. Bootstrap entry; the kernel dispatches
;; to envelope:verify_signature/2 (Step 2c) when running in
;; Erlang-on-SX mode. Per design §9.6 the lookup is timestamp-aware
;; — key validity is evaluated at :published, not "now".
(DefineValidator
:name "signature"
:doc "Signature verification. Picks the signature suite by\n :signature :algorithm, fetches the key with id ==\n :signature :key_id that was active at :published from\n the actor-state projection, then dispatches to the\n suite's :verify body."
:predicate (fn (act) true))

View File

@@ -1,21 +0,0 @@
;; next/genesis/validators/type-schema.sx
;;
;; Stage 5 of the validation pipeline per design §14. Validates
;; the activity's :object against the schema registered for its
;; :object :type in the define-registry projection.
(DefineValidator
:name "type-schema"
:doc "Looks up the object-type registration in the\n define-registry projection, fetches its :schema body,\n and evaluates it against (-> act :object). Returns true\n when no object-type is named (some verbs carry no\n :object) or when no schema is registered for the named\n type (open-world default — Step 6 may tighten)."
:predicate (fn
(act)
(let
((obj (-> act :object)))
(cond
(nil? obj)
true
(nil? (-> obj :type))
true
:else (let
((schema (-> (registry-lookup :object-types (-> obj :type)) :schema)))
(if (nil? schema) true (apply-schema schema obj)))))))

View File

View File

@@ -1,260 +0,0 @@
-module(actor_state).
-export([fold/2, fold_fn/0, new/0, lookup/2, has/2, actors/1,
profile_type/1, profile_name/1, profile_field/2,
key_history/1, active_keys_at/2, find_key_by_id/2]).
%% Actor-state projection fold — Erlang-fun stand-in for the
%% genesis `actor-state.sx` projection body. Tracks per-actor
%% profiles, key-history, and Move pointers per design §9.1-§9.4.
%%
%% State shape:
%% [{ActorId, Profile}, ...]
%%
%% Profile = [{type, person|service|group},
%% {name, Bin},
%% {preferredUsername, Bin},
%% {summary, Bin},
%% {icon, Bin},
%% {public_keys, [Key]},
%% {moved_to, ActorIdOrUrl},
%% {created, N}]
%%
%% Bridge note: the SX-source eval bridge would replace this fold
%% body once available (same gap as Step 5d-pure / Step 6c-schema-pure).
%% define_registry.erl is the structural twin.
%%
%% lists:keyfind/keymember aren't in this substrate (Step 1a noted
%% same gap), so local `find_keyed`/`has_keyed`/`set_keyed` helpers
%% handle the keyed-list ops.
new() -> [].
actors(State) -> [Id || {Id, _Profile} <- State].
has(ActorId, State) -> has_keyed(ActorId, State).
lookup(ActorId, State) ->
case find_keyed(ActorId, State) of
{ok, Profile} -> {ok, Profile};
{error, _} -> not_found
end.
%% ── Fold dispatch ───────────────────────────────────────────────
fold(Activity, State) ->
case envelope:get_field(type, Activity) of
{ok, create} -> fold_create(Activity, State);
{ok, update} -> fold_update(Activity, State);
{ok, move} -> fold_move(Activity, State);
_ -> State
end.
fold_create(Activity, State) ->
case envelope:get_field(object, Activity) of
{ok, Obj} ->
case envelope:get_field(type, Obj) of
{ok, ObjType} ->
case is_actor_type(ObjType) of
true -> register_actor(Activity, Obj, ObjType, State);
false -> State
end;
_ -> State
end;
_ -> State
end.
register_actor(Activity, Obj, ObjType, State) ->
case envelope:get_field(actor, Activity) of
{ok, ActorId} ->
case has_keyed(ActorId, State) of
true ->
State;
false ->
Created = published_seq(Activity),
Profile = build_profile(ObjType, Obj, Created),
State ++ [{ActorId, Profile}]
end;
_ -> State
end.
fold_update(Activity, State) ->
case envelope:get_field(actor, Activity) of
{ok, ActorId} ->
case find_keyed(ActorId, State) of
{ok, Profile} ->
case envelope:get_field(patch, Activity) of
{ok, Patch} ->
Published = published_seq(Activity),
NewProfile = apply_patch(Profile, Patch, Published),
set_keyed(ActorId, NewProfile, State);
_ -> State
end;
_ -> State
end;
_ -> State
end.
fold_move(Activity, State) ->
case envelope:get_field(actor, Activity) of
{ok, ActorId} ->
case find_keyed(ActorId, State) of
{ok, Profile} ->
case envelope:get_field(moved_to, Activity) of
{ok, Target} ->
NewProfile = set_keyed(moved_to, Target, Profile),
set_keyed(ActorId, NewProfile, State);
_ -> State
end;
_ -> State
end;
_ -> State
end.
%% ── Profile assembly ────────────────────────────────────────────
build_profile(ObjType, Obj, Created) ->
Base = [{type, ObjType}, {created, Created}],
Fields = [name, preferredUsername, summary, icon, public_keys],
Base ++ collect_fields(Fields, Obj).
collect_fields([], _) -> [];
collect_fields([F | Rest], Obj) ->
case envelope:get_field(F, Obj) of
{ok, V} -> [{F, V} | collect_fields(Rest, Obj)];
_ -> collect_fields(Rest, Obj)
end.
merge_patch(Profile, []) -> Profile;
merge_patch(Profile, [{K, V} | Rest]) ->
merge_patch(set_keyed(K, V, Profile), Rest);
merge_patch(Profile, _) -> Profile.
%% apply_patch/3 — same as merge_patch but special-cases two
%% key-rotation patch entries per design §9.6:
%% {add_publicKey, KeyProplist} — append a new key to :public_keys,
%% defaulting :created to Published.
%% {supersede, OldKeyId} — mark the key with :id =:= OldKeyId
%% as :superseded_at = Published.
%% Other patch entries fall through to last-write-wins per key.
apply_patch(Profile, [], _Published) -> Profile;
apply_patch(Profile, [{add_publicKey, NewKey} | Rest], Published) ->
Augmented = ensure_created(NewKey, Published),
Current = current_public_keys(Profile),
NewKeys = Current ++ [Augmented],
apply_patch(set_keyed(public_keys, NewKeys, Profile), Rest, Published);
apply_patch(Profile, [{supersede, OldKeyId} | Rest], Published) ->
Current = current_public_keys(Profile),
NewKeys = mark_superseded(OldKeyId, Published, Current),
apply_patch(set_keyed(public_keys, NewKeys, Profile), Rest, Published);
apply_patch(Profile, [{K, V} | Rest], Published) ->
apply_patch(set_keyed(K, V, Profile), Rest, Published);
apply_patch(Profile, _, _) -> Profile.
current_public_keys(Profile) ->
case find_keyed(public_keys, Profile) of
{ok, Keys} -> Keys;
_ -> []
end.
ensure_created(Key, Published) ->
case find_keyed(created, Key) of
{ok, _} -> Key;
_ -> set_keyed(created, Published, Key)
end.
mark_superseded(_, _, []) -> [];
mark_superseded(OldId, At, [Key | Rest]) ->
case find_keyed(id, Key) of
{ok, OldId} ->
case find_keyed(superseded_at, Key) of
{ok, _} -> [Key | mark_superseded(OldId, At, Rest)];
_ -> [set_keyed(superseded_at, At, Key) | mark_superseded(OldId, At, Rest)]
end;
_ -> [Key | mark_superseded(OldId, At, Rest)]
end.
%% Key-history view — full :public_keys list including superseded
%% entries (per §9.6: history is preserved so historical activities
%% verify against keys that were active at their :published time).
key_history(Profile) ->
current_public_keys(Profile).
%% active_keys_at/2 — the subset of :public_keys active at Now,
%% mirroring envelope's is_active_at semantics (local copy: envelope
%% keeps the predicate private).
active_keys_at(Profile, Now) ->
[K || K <- current_public_keys(Profile),
key_active_at(K, Now)].
find_key_by_id(KeyId, Profile) ->
find_key_by_id_in(KeyId, current_public_keys(Profile)).
find_key_by_id_in(_, []) -> not_found;
find_key_by_id_in(WantId, [K | Rest]) ->
case find_keyed(id, K) of
{ok, WantId} -> {ok, K};
_ -> find_key_by_id_in(WantId, Rest)
end.
key_active_at(Key, Now) ->
case find_keyed(created, Key) of
{ok, Created} when Now >= Created ->
case find_keyed(superseded_at, Key) of
{ok, SupAt} -> Now < SupAt;
_ -> true
end;
_ -> false
end.
published_seq(Activity) ->
case envelope:get_field(published, Activity) of
{ok, P} -> P;
_ -> 0
end.
is_actor_type(person) -> true;
is_actor_type(service) -> true;
is_actor_type(group) -> true;
is_actor_type(_) -> false.
%% ── Profile accessors ───────────────────────────────────────────
profile_type(Profile) ->
case find_keyed(type, Profile) of
{ok, T} -> T;
_ -> nil
end.
profile_name(Profile) ->
case find_keyed(name, Profile) of
{ok, N} -> N;
_ -> nil
end.
profile_field(F, Profile) ->
case find_keyed(F, Profile) of
{ok, V} -> {ok, V};
_ -> not_found
end.
%% ── Projection integration ──────────────────────────────────────
fold_fn() ->
fun (Activity, State) -> fold(Activity, State) end.
%% ── Internal ────────────────────────────────────────────────────
has_keyed(_, []) -> false;
has_keyed(K, [{K, _} | _]) -> true;
has_keyed(K, [_ | Rest]) -> has_keyed(K, Rest).
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].

View File

@@ -1,79 +0,0 @@
-module(announce_state).
-export([new/0, fold/2, fold_fn/0,
announcers_for/2, announce_count/2, announced_cids/1,
has_announced/3]).
%% Announce-fanout projection. Folds Announce activities into a
%% per-target-Cid set of announcer ActorIds so projections can
%% answer "who re-broadcast this activity" / "how many announces
%% does this Note have" / "what activities has X announced".
%%
%% Announce envelope shape (per next/genesis/activity-types/announce.sx):
%% [{type, announce},
%% {actor, AnnouncerActorId},
%% {object, TargetCidBinary},
%% ...]
%%
%% State shape:
%% [{TargetCid, [Announcer1, Announcer2, ...]}, ...]
%%
%% Set semantics — the same actor announcing the same target twice
%% is a no-op (already in the list). Undo{Announce} retraction
%% defers to a follow-up.
new() -> [].
fold_fn() ->
fun (Activity, State) -> fold(Activity, State) end.
fold(Activity, State) ->
case envelope:get_field(type, Activity) of
{ok, announce} -> fold_announce(Activity, State);
_ -> State
end.
fold_announce(Activity, State) ->
case {envelope:get_field(actor, Activity),
envelope:get_field(object, Activity)} of
{{ok, Actor}, {ok, Cid}} -> add_announcer(Cid, Actor, State);
_ -> State
end.
add_announcer(Cid, Actor, State) ->
Current = case find_keyed(Cid, State) of
{ok, Set} -> Set;
_ -> []
end,
case contains(Actor, Current) of
true -> State;
false -> set_keyed(Cid, Current ++ [Actor], State)
end.
%% ── Read-side accessors ───────────────────────────────────────
announcers_for(Cid, State) ->
case find_keyed(Cid, State) of
{ok, Set} -> Set;
_ -> []
end.
announce_count(Cid, State) -> length(announcers_for(Cid, State)).
announced_cids(State) -> [C || {C, _} <- State].
has_announced(Actor, Cid, State) ->
contains(Actor, announcers_for(Cid, State)).
%% ── Internal ──────────────────────────────────────────────────
contains(_, []) -> false;
contains(X, [X | _]) -> true;
contains(X, [_ | Rest]) -> contains(X, Rest).
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].

View File

@@ -1,136 +0,0 @@
-module(backfill).
-export([slice/2, slice/3,
wrap_backfill/1, parse_mode/1,
all_entries/1, last_n_entries/2, last_t_entries/3,
since_cid_entries/2, none_entries/0]).
%% Backfill mode slicing per design §13.3 / Step 9. When A follows B
%% with a backfill spec, B's kernel slices the outbox log into the
%% appropriate window and delivers each entry as
%% `{backfilled, true}`-marked envelopes alongside forward-going
%% activity.
%%
%% Mode shapes (per the Follow activity's `:backfill` field):
%% none — newer follower sees only forward content
%% {last_n, N} — backfill last N activities (FIFO order)
%% {last_t, T, NowFn} — backfill activities with :published in
%% (Now - T .. Now]. NowFn is a 0-arity fun
%% so tests can fake-time it.
%% full — backfill the entire outbox
%%
%% slice/2 returns the activity list. slice/3 also wraps each entry
%% with `{backfilled, true}` so projections can decide whether to
%% re-fold or skip (the §13.3 Backfilled bodies preserve the
%% original `:id` so replay defence still works on the receiver).
%%
%% parse_mode/1 lifts the Follow activity's `:backfill` proplist
%% (or atom) into the internal mode tuple. Unknown shapes fall back
%% to `none` — the default open-world policy.
slice(Mode, LogState) ->
slice(Mode, LogState, false).
slice(Mode, LogState, Wrap) ->
Entries = log:entries(LogState),
Slice = case Mode of
none -> none_entries();
full -> all_entries(Entries);
{last_n, N} -> last_n_entries(N, Entries);
{last_t, T, NowFn} -> last_t_entries(T, NowFn, Entries);
{since_cid, Cid} -> since_cid_entries(Cid, Entries);
_ -> none_entries()
end,
case Wrap of
true -> wrap_backfill(Slice);
_ -> Slice
end.
%% ── Mode-specific entry selection ─────────────────────────────
all_entries(Entries) -> Entries.
none_entries() -> [].
%% last_n_entries/2 — tail N entries in FIFO order.
last_n_entries(N, _) when N =< 0 -> [];
last_n_entries(N, Entries) ->
Len = length(Entries),
case Len =< N of
true -> Entries;
false -> drop_n(Len - N, Entries)
end.
drop_n(0, L) -> L;
drop_n(_, []) -> [];
drop_n(N, [_ | Rest]) -> drop_n(N - 1, Rest).
%% last_t_entries/3 — entries whose :published is within the last
%% T units of (NowFn() - T .. NowFn()]. T and :published are
%% integers (seconds-since-epoch in production; opaque ints in tests).
last_t_entries(T, NowFn, Entries) when is_integer(T), T >= 0 ->
Now = NowFn(),
Cutoff = Now - T,
[E || E <- Entries, in_window(E, Cutoff, Now)];
last_t_entries(_, _, _) -> [].
in_window(Activity, Cutoff, Now) ->
case envelope:get_field(published, Activity) of
{ok, P} when is_integer(P), P > Cutoff, P =< Now -> true;
_ -> false
end.
%% since_cid_entries/2 — every entry after the one with :id = Cid.
%% If Cid isn't in the log, returns [] (caller's pointer is stale).
%% Used by `GET /actors/<id>/outbox?since=Cid` pagination.
since_cid_entries(_Cid, []) -> [];
since_cid_entries(Cid, [E | Rest]) ->
case envelope:get_field(id, E) of
{ok, Cid} -> Rest;
_ -> since_cid_entries(Cid, Rest)
end.
%% wrap_backfill/1 — append `{backfilled, true}` to each entry.
%% The receiving projection scheduler reads this field and chooses
%% whether to fold (re-emit) or skip (already known via replay
%% defence on `:id`).
wrap_backfill([]) -> [];
wrap_backfill([E | Rest]) ->
[E ++ [{backfilled, true}] | wrap_backfill(Rest)].
%% parse_mode/1 — Lift a Follow activity's `:backfill` value into the
%% internal mode tuple. Accepts:
%% nil / not_found -> none
%% none -> none
%% full -> full
%% {last_n, N} -> {last_n, N} (already-parsed shape)
%% {last_t, T, NowFn} -> pass-through
%% Proplist with :mode + :limit / :duration -> parsed
%% Unknown shape -> none (open-world default).
parse_mode(nil) -> none;
parse_mode(none) -> none;
parse_mode(full) -> full;
parse_mode({last_n, N}) -> {last_n, N};
parse_mode({last_t, T, NowFn}) -> {last_t, T, NowFn};
parse_mode({since_cid, Cid}) -> {since_cid, Cid};
parse_mode(List) when is_list(List) ->
case envelope:get_field(mode, List) of
{ok, last_n} ->
case envelope:get_field(limit, List) of
{ok, N} when is_integer(N) -> {last_n, N};
_ -> none
end;
{ok, last_t} ->
case envelope:get_field(duration, List) of
{ok, T} when is_integer(T) -> {last_t, T, fun () -> 0 end};
_ -> none
end;
{ok, full} -> full;
{ok, none} -> none;
_ -> none
end;
parse_mode(_) -> none.

View File

@@ -1,223 +0,0 @@
-module(bootstrap).
-export([read_genesis/0, read_genesis/1,
read_section/2, sections/0, section_subdir/1,
default_base/0, ends_with_sx/1,
build_genesis/1, verify_genesis/2,
cidhash_path/1, write_cidhash/2, read_cidhash/1,
load_genesis/1, strip_sx_suffix/1,
populate_registry/0,
start/3]).
%% Genesis bundle reader per design §12.2.
%%
%% read_genesis/0,1 walks the seven canonical section subdirectories
%% under `next/genesis/`, filters .sx files, reads each file into a
%% binary, and returns a structured snapshot:
%%
%% {ok, [{Section :: atom,
%% [{FileName :: binary, FileBytes :: binary}, ...]},
%% ...]}
%%
%% Step 4d will compute the bundle CID by hashing the assembled
%% byte string across all entries; Step 4e will register the parsed
%% definitions in the kernel registry.
%%
%% Port note: this module does NOT parse the .sx contents. The
%% Erlang-on-SX port has no in-Erlang path from binary bytes to SX
%% structured terms (same substrate gap that parked Step 3b); the
%% bundle CID needs only the raw bytes, and registry registration
%% will happen via an SX-side helper that the kernel hands the
%% binary contents to. read_genesis/1 ignores its arg in v1 except
%% to swap the BasePath — `default_base/0` is "next/genesis".
%%
%% Port note 2: string-literal binary segments `<<"abc">>` truncate
%% to one byte in this port, so all path constants are hand-spelled
%% as integer-segment binaries.
%% ── Public API ──────────────────────────────────────────────────
%% "next/genesis"
default_base() ->
<<110,101,120,116,47,103,101,110,101,115,105,115>>.
read_genesis() ->
read_genesis(default_base()).
read_genesis(BasePath) ->
{ok, lists:map(
fun (S) -> {S, read_section(BasePath, S)} end,
sections())}.
sections() ->
[activity_types, object_types, projections,
validators, codecs, sig_suites, audience].
%% "activity-types"
section_subdir(activity_types) ->
<<97,99,116,105,118,105,116,121,45,116,121,112,101,115>>;
%% "object-types"
section_subdir(object_types) ->
<<111,98,106,101,99,116,45,116,121,112,101,115>>;
%% "projections"
section_subdir(projections) ->
<<112,114,111,106,101,99,116,105,111,110,115>>;
%% "validators"
section_subdir(validators) ->
<<118,97,108,105,100,97,116,111,114,115>>;
%% "codecs"
section_subdir(codecs) ->
<<99,111,100,101,99,115>>;
%% "sig-suites"
section_subdir(sig_suites) ->
<<115,105,103,45,115,117,105,116,101,115>>;
%% "audience"
section_subdir(audience) ->
<<97,117,100,105,101,110,99,101>>.
read_section(BasePath, Section) ->
SubDir = section_subdir(Section),
%% 47 = '/'
Path = <<BasePath/binary, 47, SubDir/binary>>,
case file:list_dir(Path) of
{ok, Names} ->
SxNames = lists:filter(fun (N) -> ends_with_sx(N) end, Names),
lists:map(fun (Name) -> read_one(Path, Name) end, SxNames);
{error, _} ->
[]
end.
%% Suffix check on the .sx extension. 46='.' 115='s' 120='x'.
ends_with_sx(<<46, 115, 120>>) -> true;
ends_with_sx(<<>>) -> false;
ends_with_sx(<<_, Rest/binary>>) -> ends_with_sx(Rest).
%% ── Internal ────────────────────────────────────────────────────
read_one(DirPath, Name) ->
Full = <<DirPath/binary, 47, Name/binary>>,
case file:read_file(Full) of
{ok, Bytes} -> {Name, Bytes};
{error, R} -> {Name, {error, R}}
end.
%% ── Step 4d: bundle CID compute + verify ────────────────────────
%%
%% The bundle CID is the canonical content-address of everything in
%% read_genesis/0's result. We delegate to the host `cid:to_string/1`
%% BIF (Step 1b substrate): it walks the term via `er-format-value`,
%% feeds the deterministic textual form into `cid-from-sx`, returns
%% a CIDv1 (raw codec, sha2-256 multihash) as a binary.
%%
%% Design §12.3: at startup the kernel computes this CID and
%% compares against a hardcoded value (here: a sibling `.cidhash`
%% file). A mismatch is a hard refuse-to-start.
build_genesis(ReadResult) ->
case ReadResult of
{ok, Sections} ->
Cid = cid:to_string({genesis_bundle, Sections}),
{ok, [{cid, Cid}, {sections, Sections}]};
Other ->
{error, {bad_read_result, Other}}
end.
verify_genesis(ReadResult, ExpectedCid) ->
case build_genesis(ReadResult) of
{ok, [{cid, Cid}, _]} ->
case Cid =:= ExpectedCid of
true -> ok;
false -> {error, {cid_mismatch, Cid, ExpectedCid}}
end;
Err -> Err
end.
%% Sibling-file CID storage. "/.cidhash" appended to BasePath as
%% an integer-segment binary (string-literal segments are broken).
%% "/.cidhash" — 47='/' 46='.' c i d h a s h
cidhash_path(BasePath) ->
<<BasePath/binary, 47, 46, 99, 105, 100, 104, 97, 115, 104>>.
write_cidhash(BasePath, Cid) ->
file:write_file(cidhash_path(BasePath), Cid).
read_cidhash(BasePath) ->
file:read_file(cidhash_path(BasePath)).
%% ── Step 4e: load_genesis → registry ────────────────────────────
%%
%% Walks the read_genesis result and registers each file as a
%% registry entry. The section atom is the registry kind directly
%% (both name spaces are identical — see Step 4c sections/0 and
%% Step 5a registry:kinds/0). The entry Name is the filename minus
%% the `.sx` suffix, kept as a binary; the entry value is the
%% file's raw bytes.
%%
%% Returns `{ok, RegistryState}` on success. Later steps (4f / the
%% SX-parser bridge) will replace the raw bytes with parsed forms;
%% the binary stand-in is enough to prove the bridge works.
load_genesis(ReadResult) ->
case ReadResult of
{ok, Sections} ->
{ok, load_sections(Sections, registry:new())};
Other ->
{error, {bad_read_result, Other}}
end.
load_sections([], State) -> State;
load_sections([{Kind, Entries} | Rest], State) ->
load_sections(Rest, load_entries(Kind, Entries, State)).
load_entries(_Kind, [], State) -> State;
load_entries(Kind, [{Name, Bytes} | Rest], State) ->
BaseName = strip_sx_suffix(Name),
{ok, NewState} = registry:register(Kind, BaseName, Bytes, State),
load_entries(Kind, Rest, NewState).
%% strip_sx_suffix(Binary) — drops the trailing ".sx" if present.
%% 46='.' 115='s' 120='x'.
strip_sx_suffix(B) when is_binary(B) ->
case ends_with_sx(B) of
false -> B;
true -> take_prefix(B, byte_size(B) - 3)
end.
take_prefix(_, 0) -> <<>>;
take_prefix(<<H, Rest/binary>>, N) when N > 0 ->
Tail = take_prefix(Rest, N - 1),
<<H, Tail/binary>>.
%% populate_registry/0 — load the canonical genesis bundle and
%% register every entry in the running registry gen_server. The
%% caller is expected to have started the registry (via
%% registry:start_link/0) before calling this. Returns the count
%% of entries registered across all kinds.
populate_registry() ->
{ok, Sections} = read_genesis(),
populate_sections(Sections, 0).
populate_sections([], Count) -> Count;
populate_sections([{Kind, Entries} | Rest], Count) ->
populate_sections(Rest, Count + populate_entries(Kind, Entries, 0)).
populate_entries(_, [], Count) -> Count;
populate_entries(Kind, [{Name, Bytes} | Rest], Count) ->
BaseName = strip_sx_suffix(Name),
ok = registry:register(Kind, BaseName, Bytes),
populate_entries(Kind, Rest, Count + 1).
%% start/3 — one-call bring-up of the kernel substrate. Starts
%% the registry gen_server, populates it from the canonical
%% genesis bundle, then starts the nx_kernel gen_server with the
%% supplied actor identity / key / state. Returns the nx_kernel
%% Pid (gen_server start_link convention in this port returns the
%% raw Pid, not {ok, Pid}).
%%
%% Tests + production bring-up share this entry point. The
%% caller is still responsible for starting any application-level
%% projections and wiring them via nx_kernel:with_projections/1.
start(ActorId, KeySpec, ActorState) ->
registry:start_link(),
populate_registry(),
nx_kernel:start_link(ActorId, KeySpec, ActorState).

View File

@@ -1,68 +0,0 @@
-module(define_registry).
-export([fold/2, fold_fn/0, define_kind/1]).
%% Define-registry projection fold — Erlang-fun stand-in for the
%% genesis `define-registry.sx` body. The intent is identical: a
%% projection whose state is a registry-shaped property list, fed
%% by every `Create{Define*{...}}` activity. The SX body would
%% eventually replace this once an SX-source eval bridge lets the
%% kernel evaluate the genesis fold directly; until then this
%% Erlang module proves the meta-projection mechanism wires
%% through `projection:fold_fn` and `nx_kernel` cleanly.
%%
%% State shape mirrors `registry:new()` exactly:
%% [{Kind, [{Name, Entry}, ...]}, ...]
%% so callers can use `registry:lookup/3` etc. on the result.
%%
%% Type discrimination uses atoms (`define_activity`, …). Real SX
%% would carry the string forms ("DefineActivity", …); the bridge
%% will translate. See define_kind/1 for the mapping.
fold(Activity, State) ->
case envelope:get_field(type, Activity) of
{ok, create} -> fold_create(Activity, State);
_ -> State
end.
fold_create(Activity, State) ->
case envelope:get_field(object, Activity) of
{ok, Obj} ->
case envelope:get_field(type, Obj) of
{ok, ObjType} ->
case define_kind(ObjType) of
not_a_define -> State;
Kind -> fold_register(Kind, Obj, State)
end;
_ -> State
end;
_ -> State
end.
fold_register(Kind, Obj, State) ->
case envelope:get_field(name, Obj) of
{ok, Name} ->
case registry:register(Kind, Name, Obj, State) of
{ok, NewState} -> NewState;
{error, unknown_kind} -> State
end;
not_found -> State
end.
%% fold_fn/0 — a 2-arity Erlang fun the projection module plants
%% in its record's :fold slot. Lets `projection:start_link/3`
%% wire define-registry directly.
fold_fn() ->
fun (Activity, State) -> fold(Activity, State) end.
%% define_kind/1 — discriminator from the inner Define* object's
%% :type atom to the registry kind atom. Anything unrecognised
%% returns not_a_define so the fold treats it as a pass-through.
define_kind(define_activity) -> activity_types;
define_kind(define_object) -> object_types;
define_kind(define_projection) -> projections;
define_kind(define_validator) -> validators;
define_kind(define_codec) -> codecs;
define_kind(define_sig_suite) -> sig_suites;
define_kind(define_audience) -> audience;
define_kind(_) -> not_a_define.

View File

@@ -1,86 +0,0 @@
-module(delivery).
-export([delivery_set/2, delivery_set/3,
collect_recipients/1, suppress_self/2, dedup/1,
expand_audience/3]).
%% Audience-resolving delivery set computation per design §13.4.
%%
%% delivery_set/2(Activity, KernelState) returns a sorted, deduped
%% list of ActorId atoms — every actor the outgoing Activity needs
%% to be POSTed to. Sources:
%% - Activity's `:to` field (single ActorId or list)
%% - Activity's `:cc` field (single ActorId or list)
%% - audience-symbol expansion of `public` and `followers`
%%
%% Self-delivery (the publishing actor reading their own activity
%% on a peer's behalf) is suppressed.
%%
%% Output for Step 7a is the bare ActorId list; Step 8 will resolve
%% each entry to `{PeerInstanceUrl, ActorId}` via the peer-actors
%% cache.
delivery_set(Activity, KernelState) ->
delivery_set(Activity, KernelState, follower_graph:new()).
delivery_set(Activity, KernelState, FollowerGraph) ->
Self = sender(Activity),
Raw = collect_recipients(Activity),
Expanded = expand_all(Raw, Self, KernelState, FollowerGraph),
Suppressed = suppress_self(Expanded, Self),
dedup(Suppressed).
%% collect_recipients/1 — flat list from :to + :cc, normalised so
%% each element is either an ActorId atom or an audience symbol
%% (`public` / `followers`).
collect_recipients(Activity) ->
To = envelope_field_list(to, Activity),
Cc = envelope_field_list(cc, Activity),
To ++ Cc.
envelope_field_list(Field, Activity) ->
case envelope:get_field(Field, Activity) of
not_found -> [];
{ok, V} when is_list(V) -> V;
{ok, V} -> [V]
end.
%% expand_audience/3 — `followers` -> the sender's followers
%% proplist entry from a follower_graph state. `public` for v2
%% expands to the same list (per design §13.4: practical Public
%% fan-out is "every follower of the publishing actor"). The
%% explicit shared-inbox peer-instance model defers to v3.
%% Other symbols / explicit ActorIds pass through unchanged.
expand_audience(public, Sender, Graph) ->
follower_graph:followers(Sender, Graph);
expand_audience(followers, Sender, Graph) ->
follower_graph:followers(Sender, Graph);
expand_audience(X, _Sender, _Graph) -> [X].
expand_all([], _Self, _State, _Graph) -> [];
expand_all([X | Rest], Self, State, Graph) ->
expand_audience(X, Self, Graph) ++ expand_all(Rest, Self, State, Graph).
suppress_self([], _Self) -> [];
suppress_self([Self | Rest], Self) -> suppress_self(Rest, Self);
suppress_self([X | Rest], Self) -> [X | suppress_self(Rest, Self)].
dedup(L) -> dedup_acc(L, []).
dedup_acc([], Acc) -> Acc;
dedup_acc([X | Rest], Acc) ->
case contains(X, Acc) of
true -> dedup_acc(Rest, Acc);
false -> dedup_acc(Rest, Acc ++ [X])
end.
contains(_, []) -> false;
contains(X, [X | _]) -> true;
contains(X, [_ | Rest]) -> contains(X, Rest).
sender(Activity) ->
case envelope:get_field(actor, Activity) of
{ok, A} -> A;
_ -> nil
end.

View File

@@ -1,209 +0,0 @@
-module(delivery_state).
-export([new/0, fold/2, fold_fn/0,
peer_state/2, peers/1,
pending/2, attempts/2, next_retry/2, dead_letter/2]).
%% Delivery-state projection. Folds delivery events (enqueue /
%% delivered / failed / dead_lettered) into a per-peer worker-shaped
%% snapshot so the outbound queue survives kernel restart. Per design
%% §13.4 the worker state on restart is loaded from this projection
%% rather than reconstructed by re-driving the outbox log.
%%
%% Event proplist shape:
%% [{type, enqueued}, {peer, _}, {activity, _}]
%% [{type, delivered}, {peer, _}, {cid, _}]
%% [{type, failed}, {peer, _}, {cid, _}, {now, _}]
%% [{type, dead_lettered}, {peer, _}, {cid, _}]
%%
%% Projection state shape:
%% [{PeerId, WorkerProplist}, ...]
%%
%% WorkerProplist mirrors `delivery_worker:new/1`'s output so a fresh
%% gen_server can be hydrated with `delivery_worker:state_from_proj`
%% (lands when 8b-timer wires up). For Step 8c the projection only
%% tracks data — Step 8d-restart will wire the hydration helper.
new() -> [].
fold_fn() ->
fun (Event, State) -> fold(Event, State) end.
fold(Event, State) ->
case envelope:get_field(type, Event) of
{ok, enqueued} -> fold_enqueued(Event, State);
{ok, delivered} -> fold_delivered(Event, State);
{ok, failed} -> fold_failed(Event, State);
{ok, dead_lettered} -> fold_dead_lettered(Event, State);
_ -> State
end.
fold_enqueued(Event, State) ->
case {envelope:get_field(peer, Event),
envelope:get_field(activity, Event)} of
{{ok, Peer}, {ok, Act}} ->
Worker = ensure_peer(Peer, State),
Pending = field(pending, Worker),
Worker1 = set_field(pending, Pending ++ [Act], Worker),
set_peer(Peer, Worker1, State);
_ -> State
end.
fold_delivered(Event, State) ->
case {envelope:get_field(peer, Event),
envelope:get_field(cid, Event)} of
{{ok, Peer}, {ok, Cid}} ->
case find_keyed(Peer, State) of
{ok, Worker} ->
Worker1 = drop_pending_by_cid(Cid, Worker),
Worker2 = clear_retry_for(Cid, Worker1),
set_peer(Peer, Worker2, State);
_ -> State
end;
_ -> State
end.
fold_failed(Event, State) ->
case {envelope:get_field(peer, Event),
envelope:get_field(cid, Event),
envelope:get_field(now, Event)} of
{{ok, Peer}, {ok, Cid}, {ok, Now}} ->
case find_keyed(Peer, State) of
{ok, Worker} ->
Attempts = field(attempts, Worker),
Current = case find_keyed(Cid, Attempts) of
{ok, N} -> N;
_ -> 0
end,
New = Current + 1,
Attempts1 = set_keyed(Cid, New, Attempts),
Worker1 = set_field(attempts, Attempts1, Worker),
Worker2 = case delivery_worker:backoff_for(New) of
dead_letter ->
dead_letter_pending(Cid, Worker1);
Seconds ->
NR = field(next_retry, Worker1),
NextAt = Now + Seconds,
set_field(next_retry, set_keyed(Cid, NextAt, NR), Worker1)
end,
set_peer(Peer, Worker2, State);
_ -> State
end;
_ -> State
end.
fold_dead_lettered(Event, State) ->
case {envelope:get_field(peer, Event),
envelope:get_field(cid, Event)} of
{{ok, Peer}, {ok, Cid}} ->
case find_keyed(Peer, State) of
{ok, Worker} ->
set_peer(Peer, dead_letter_pending(Cid, Worker), State);
_ -> State
end;
_ -> State
end.
%% ── Accessors ─────────────────────────────────────────────────
peer_state(Peer, State) ->
case find_keyed(Peer, State) of
{ok, Worker} -> {ok, Worker};
_ -> not_found
end.
peers(State) -> [P || {P, _} <- State].
pending(Peer, State) ->
worker_field(Peer, pending, State, []).
attempts(Peer, State) ->
worker_field(Peer, attempts, State, []).
next_retry(Peer, State) ->
worker_field(Peer, next_retry, State, []).
dead_letter(Peer, State) ->
worker_field(Peer, dead_letter, State, []).
%% ── Internal ──────────────────────────────────────────────────
worker_field(Peer, Field, State, Default) ->
case find_keyed(Peer, State) of
{ok, Worker} ->
case find_keyed(Field, Worker) of
{ok, V} -> V;
_ -> Default
end;
_ -> Default
end.
ensure_peer(Peer, State) ->
case find_keyed(Peer, State) of
{ok, Worker} -> Worker;
_ -> empty_worker(Peer)
end.
empty_worker(Peer) ->
[{peer, Peer},
{pending, []},
{attempts, []},
{next_retry, []},
{dead_letter, []}].
set_peer(Peer, Worker, State) ->
set_keyed(Peer, Worker, State).
drop_pending_by_cid(Cid, Worker) ->
Pending = field(pending, Worker),
Kept = [A || A <- Pending, activity_cid(A) =/= Cid],
set_field(pending, Kept, Worker).
clear_retry_for(Cid, Worker) ->
A1 = del_keyed(Cid, field(attempts, Worker)),
NR1 = del_keyed(Cid, field(next_retry, Worker)),
set_field(attempts, A1, set_field(next_retry, NR1, Worker)).
dead_letter_pending(Cid, Worker) ->
Pending = field(pending, Worker),
{Match, Rest} = split_by_cid(Cid, Pending),
DL = field(dead_letter, Worker),
Worker1 = set_field(pending, Rest, Worker),
Worker2 = case Match of
none -> Worker1;
Act -> set_field(dead_letter, DL ++ [Act], Worker1)
end,
clear_retry_for(Cid, Worker2).
split_by_cid(Cid, List) -> split_by_cid(Cid, List, []).
split_by_cid(_, [], Acc) -> {none, lists:reverse(Acc)};
split_by_cid(Cid, [A | Rest], Acc) ->
case activity_cid(A) of
Cid -> {A, lists:reverse(Acc) ++ Rest};
_ -> split_by_cid(Cid, Rest, [A | Acc])
end.
activity_cid(Activity) ->
case envelope:get_field(id, Activity) of
{ok, Cid} -> Cid;
_ -> nil
end.
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> undefined.
set_field(K, V, []) -> [{K, V}];
set_field(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_field(K, V, [P | Rest]) -> [P | set_field(K, V, Rest)].
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].
del_keyed(_, []) -> [];
del_keyed(K, [{K, _} | Rest]) -> Rest;
del_keyed(K, [P | Rest]) -> [P | del_keyed(K, Rest)].

View File

@@ -1,426 +0,0 @@
-module(delivery_worker).
-behaviour(gen_server).
-export([new/1, pending/1, peer/1,
enqueue_pure/3, drain_pure/1, deliver_one_pure/2,
backoff_for/1, schedule_for/1,
record_failure_pure/3, record_success_pure/2,
next_due_pure/2, attempts_for/2, next_retry_at/2,
dead_letter_list/1, timer_ref_for/2,
start_link/1, start_link/2, stop/1,
enqueue/2, flush/1, pending_srv/1, set_dispatch_fn/2,
state_srv/1]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
%% Outbound delivery worker per design §13.4. One gen_server per
%% peer instance (peer-id atom) holding a FIFO queue of pending
%% activities to deliver. v2 lands in stages:
%%
%% Step 8a pure-functional state shape, enqueue / drain /
%% schedule semantics + gen_server skeleton + tests
%% Step 8b retry / backoff schedule (30s / 5m / 30m / 6h / 24h)
%% + dead-letter list
%% Step 8c delivery-state projection so the queue survives
%% kernel restart
%% Step 8d outbox:publish/2 dispatches each delivery-set entry
%% to the matching worker
%% Step 8e httpc:request/4 BIF (substrate exception per briefing)
%% Step 8f real HTTP POST through the BIF + content-type wiring
%%
%% This file is 8a only — pure state + skeleton gen_server with the
%% APIs Step 8b-d will fill in. Real HTTP dispatch is stubbed via a
%% caller-supplied `:dispatch_fn` so tests can intercept and Step 8f
%% can plug in the live httpc call without touching the queue logic.
%%
%% State shape (pure):
%% [{peer, PeerId},
%% {pending, [Activity, ...]}, %% FIFO; head delivered first
%% {attempts, [{Cid, AttemptCount}, ...]},
%% {next_retry, [{Cid, NextRetryAt}, ...]}, %% Step 8b-pure
%% {dead_letter, [Activity, ...]},
%% {dispatch_fn, fun/1 | undefined}]
%%
%% gen_server registers under the peer-id atom (one worker per peer);
%% the same APIs work as pure-functional state transitions for tests.
%% ── Pure-functional API ─────────────────────────────────────────
new(PeerId) ->
[{peer, PeerId},
{pending, []},
{attempts, []},
{next_retry, []},
{dead_letter, []},
{timers, []},
{dispatch_fn, undefined}].
pending(State) -> field(pending, State).
peer(State) -> field(peer, State).
%% enqueue_pure/3 — append an activity to the queue. Returns new
%% state. Duplicate :id activities aren't deduplicated here — that's
%% the caller's job (Step 8d will pass each delivery-set entry once).
enqueue_pure(_PeerId, Activity, State) ->
Pending = field(pending, State),
set_field(pending, Pending ++ [Activity], State).
%% drain_pure/1 — attempt to deliver every queued activity through
%% the configured dispatch_fn. Returns {NewState, DeliveredCids,
%% RetryCids}. Activities that fail dispatch stay in :pending with
%% an incremented attempt counter — Step 8b will use the count to
%% pick a backoff slot.
drain_pure(State) ->
Pending = field(pending, State),
drain_loop(Pending, [], State, [], []).
drain_loop([], Kept, State, Delivered, Retry) ->
{set_field(pending, Kept, State), Delivered, Retry};
drain_loop([A | Rest], Kept, State, Delivered, Retry) ->
case deliver_one_pure(A, State) of
{ok, Cid} ->
drain_loop(Rest, Kept, State, Delivered ++ [Cid], Retry);
{error, Cid, _Reason} ->
State1 = bump_attempt(Cid, State),
drain_loop(Rest, Kept ++ [A], State1, Delivered, Retry ++ [Cid])
end.
%% deliver_one_pure/2 — single-activity dispatch via the caller-
%% supplied dispatch_fn. Returns {ok, Cid} on success or {error,
%% Cid, Reason} on failure. With no dispatch_fn configured returns
%% {error, _, no_dispatch_fn} so callers know to wire one before
%% the worker is useful.
deliver_one_pure(Activity, State) ->
Cid = activity_cid(Activity),
case field(dispatch_fn, State) of
undefined -> {error, Cid, no_dispatch_fn};
Fn when is_function(Fn, 1) ->
case Fn(Activity) of
ok -> {ok, Cid};
{ok, _} -> {ok, Cid};
{error, Reason} -> {error, Cid, Reason};
Other -> {error, Cid, {bad_dispatch_return, Other}}
end;
_ -> {error, Cid, bad_dispatch_fn}
end.
%% backoff_for/1 — Step 8a returns the static schedule per the
%% plan; Step 8b wires it into the retry loop. Attempts are
%% 1-indexed (first retry uses slot 1).
%%
%% 30s / 5m / 30m / 6h / 24h then dead_letter.
backoff_for(0) -> 0;
backoff_for(1) -> 30;
backoff_for(2) -> 300; % 5 * 60
backoff_for(3) -> 1800; % 30 * 60
backoff_for(4) -> 21600; % 6 * 3600
backoff_for(5) -> 86400; % 24 * 3600
backoff_for(_) -> dead_letter.
schedule_for(Attempts) ->
case backoff_for(Attempts) of
dead_letter -> dead_letter;
Seconds -> {retry_in, Seconds}
end.
%% ── Step 8b-pure: retry-time bookkeeping ───────────────────────
%%
%% `record_failure_pure/3(Cid, Now, State)` — call after a failed
%% deliver_one. Bumps the per-cid attempt counter; if the new
%% attempt is past the dead-letter threshold, moves the matching
%% activity from :pending to :dead_letter. Otherwise records the
%% next retry time as Now + backoff_for(NewAttempt).
%%
%% Real timer wiring (erlang:send_after self-cast on the worker
%% pid) needs substrate support — Step 8b-timer when that lands.
%%
%% `record_success_pure/2(Cid, State)` — clears :attempts and
%% :next_retry entries for the cid; called after a successful
%% deliver_one.
%%
%% `next_due_pure/2(Now, State)` — returns the list of Cids whose
%% NextRetryAt has passed, in insertion order.
record_failure_pure(Cid, Now, State) ->
Attempts = field(attempts, State),
Current = case find_keyed(Cid, Attempts) of
{ok, N} -> N;
_ -> 0
end,
New = Current + 1,
State1 = set_field(attempts, set_keyed(Cid, New, Attempts), State),
case backoff_for(New) of
dead_letter ->
move_to_dead_letter(Cid, State1);
Seconds ->
NextAt = Now + Seconds,
NR = field(next_retry, State1),
set_field(next_retry, set_keyed(Cid, NextAt, NR), State1)
end.
record_success_pure(Cid, State) ->
A1 = del_keyed(Cid, field(attempts, State)),
NR1 = del_keyed(Cid, field(next_retry, State)),
set_field(attempts, A1, set_field(next_retry, NR1, State)).
%% next_due_pure/2 — Cids whose NextRetryAt <= Now. Preserves
%% insertion order so the worker drains them in FIFO retry order.
next_due_pure(Now, State) ->
[Cid || {Cid, At} <- field(next_retry, State), At =< Now].
attempts_for(Cid, State) ->
case find_keyed(Cid, field(attempts, State)) of
{ok, N} -> N;
_ -> 0
end.
next_retry_at(Cid, State) ->
case find_keyed(Cid, field(next_retry, State)) of
{ok, At} -> At;
_ -> undefined
end.
dead_letter_list(State) -> field(dead_letter, State).
%% Step 8b-timer: per-cid timer ref accessor. Exposed for tests so
%% they can assert a retry timer was scheduled (or wasn't, after a
%% success / dead-letter). Returns the live Ref or undefined.
timer_ref_for(Cid, State) ->
case find_keyed(Cid, field(timers, State)) of
{ok, Ref} -> Ref;
_ -> undefined
end.
move_to_dead_letter(Cid, State) ->
Pending = field(pending, State),
{Match, Rest} = take_by_cid(Cid, Pending, [], []),
DL = field(dead_letter, State),
State1 = set_field(pending, Rest, State),
State2 = case Match of
none -> State1;
Act -> set_field(dead_letter, DL ++ [Act], State1)
end,
NR = field(next_retry, State2),
set_field(next_retry, del_keyed(Cid, NR), State2).
take_by_cid(_, [], Acc, _) -> {none, lists:reverse(Acc)};
take_by_cid(Cid, [A | Rest], Acc, _) ->
case activity_cid(A) of
Cid -> {A, lists:reverse(Acc) ++ Rest};
_ -> take_by_cid(Cid, Rest, [A | Acc], 0)
end.
%% ── gen_server wrapper ──────────────────────────────────────────
start_link(PeerId) ->
start_link(PeerId, undefined).
start_link(PeerId, DispatchFn) ->
Pid = gen_server:start_link(delivery_worker, [PeerId, DispatchFn]),
erlang:register(PeerId, Pid),
Pid.
stop(PeerId) ->
R = gen_server:call(PeerId, '$gen_stop'),
erlang:unregister(PeerId),
R.
enqueue(PeerId, Activity) ->
gen_server:call(PeerId, {enqueue, Activity}).
flush(PeerId) ->
gen_server:call(PeerId, flush).
pending_srv(PeerId) ->
gen_server:call(PeerId, get_pending).
set_dispatch_fn(PeerId, Fn) ->
gen_server:call(PeerId, {set_dispatch_fn, Fn}).
%% Step 8b-timer: return the worker's full state so tests can use the
%% pure introspection functions (attempts_for / next_retry_at /
%% timer_ref_for / dead_letter_list) against it.
state_srv(PeerId) ->
gen_server:call(PeerId, get_state).
%% gen_server callbacks
init([PeerId, DispatchFn]) ->
S0 = new(PeerId),
{ok, set_field(dispatch_fn, DispatchFn, S0)}.
handle_call({enqueue, Activity}, _From, State) ->
{reply, ok, enqueue_pure(field(peer, State), Activity, State)};
handle_call(flush, _From, State) ->
%% Step 8b-timer: drain (which already bumps :attempts via
%% bump_attempt on each failed deliver), then for each retried
%% Cid compute the backoff slot from the now-current attempt
%% count, set NextRetryAt, and arm a send_after self-cast.
%% handle_info({retry, Cid}, ...) fires when the slot elapses.
%% Reply shape unchanged.
{DrainState, Delivered, Retry} = drain_pure(State),
Now = monotonic_seconds(),
NewState = lists:foldl(
fun(Cid, S) -> arm_retry_timer(Cid, Now, S) end,
DrainState, Retry),
{reply, {ok, Delivered, Retry}, NewState};
handle_call(get_pending, _From, State) ->
{reply, field(pending, State), State};
handle_call(get_state, _From, State) ->
{reply, State, State};
handle_call({set_dispatch_fn, Fn}, _From, State) ->
{reply, ok, set_field(dispatch_fn, Fn, State)}.
handle_cast(_, S) -> {noreply, S}.
%% Step 8b-timer: a retry timer fired. Pull the activity by Cid from
%% the pending queue (it might have been drained meanwhile by a
%% concurrent flush — if so, we just clear bookkeeping and exit).
%% Run deliver_one_pure: success clears retry state; failure bumps
%% the counter and schedules the next slot — or dead-letters if the
%% sixth attempt failed.
handle_info({retry, Cid}, State) ->
%% Clear the timer ref we just consumed.
State0 = clear_timer_ref(Cid, State),
case take_by_cid(Cid, field(pending, State0), [], 0) of
{none, _} ->
%% Already drained / dead-lettered. Clear any stale
%% bookkeeping in case the cid is half-tracked.
{noreply, record_success_pure(Cid, State0)};
{Activity, Rest} ->
case deliver_one_pure(Activity, State0) of
{ok, _} ->
State1 = set_field(pending, Rest, State0),
State2 = record_success_pure(Cid, State1),
{noreply, State2};
{error, _, _} ->
%% Keep the activity in pending; record_failure
%% leaves :pending alone (or dead-letters it on
%% slot 6).
Now = monotonic_seconds(),
State1 = schedule_retry_for(Cid, Now, State0),
{noreply, State1}
end
end;
handle_info(_, S) -> {noreply, S}.
%% Step 8b-timer helpers ────────────────────────────────────────────
%% arm_retry_timer/3 — POST-DRAIN form. Used from handle_call(flush)
%% after drain_pure has already bumped :attempts via bump_attempt.
%% Sets next_retry_at = Now + backoff(attempts) and schedules the
%% send_after self-cast. On the dead-letter slot (attempt 6), moves
%% the activity from :pending to :dead_letter and arms no timer.
arm_retry_timer(Cid, Now, State) ->
State0 = cancel_timer_for(Cid, State),
Attempts = attempts_for(Cid, State0),
case backoff_for(Attempts) of
dead_letter ->
move_to_dead_letter(Cid, State0);
Seconds ->
NextAt = Now + Seconds,
NR = field(next_retry, State0),
State1 = set_field(next_retry, set_keyed(Cid, NextAt, NR), State0),
Ms = Seconds * 1000,
Ref = erlang:send_after(Ms, self(), {retry, Cid}),
Timers = field(timers, State1),
set_field(timers, set_keyed(Cid, Ref, Timers), State1)
end.
%% schedule_retry_for/3 — POST-RETRY-ATTEMPT form. Used from
%% handle_info({retry, Cid}, ...) when the retry attempt failed.
%% Bookkeep one failure and arm the next retry timer (or promote
%% to dead-letter, in which case no timer is needed).
schedule_retry_for(Cid, Now, State) ->
%% Cancel any in-flight timer for this Cid before scheduling a new
%% one. Without the cancel a stale timer can still fire after
%% record_success has cleared the cid, the handle_info no-match
%% branch silently absorbs it — but it keeps the scheduler's
%% run-loop alive long after the work is done. A pure clear (no
%% cancel) is fine when the timer's own firing brought us here,
%% so the explicit cancel only matters for the flush path.
State0 = cancel_timer_for(Cid, State),
State1 = record_failure_pure(Cid, Now, State0),
Attempts = attempts_for(Cid, State1),
case backoff_for(Attempts) of
dead_letter ->
State1;
Seconds ->
Ms = Seconds * 1000,
Ref = erlang:send_after(Ms, self(), {retry, Cid}),
Timers = field(timers, State1),
set_field(timers, set_keyed(Cid, Ref, Timers), State1)
end.
%% Cancel the live timer for Cid (if any) and clear it from :timers.
%% Idempotent — silent no-op if there isn't one.
cancel_timer_for(Cid, State) ->
Timers = field(timers, State),
case find_keyed(Cid, Timers) of
{ok, Ref} ->
erlang:cancel_timer(Ref),
set_field(timers, del_keyed(Cid, Timers), State);
_ -> State
end.
%% Drop the :timers entry for Cid without calling cancel_timer — used
%% when the timer's own firing brought us into handle_info and the ref
%% is already consumed.
clear_timer_ref(Cid, State) ->
Timers = field(timers, State),
case find_keyed(Cid, Timers) of
{ok, _Ref} -> set_field(timers, del_keyed(Cid, Timers), State);
_ -> State
end.
%% Step 8b-timer: bookkeeping uses seconds (matches backoff_for /
%% record_failure_pure / next_retry_at). The monotonic clock reports
%% ms; we floor to seconds here to keep all the comparisons aligned.
monotonic_seconds() -> erlang:monotonic_time() div 1000.
%% ── Internal ────────────────────────────────────────────────────
activity_cid(Activity) ->
case envelope:get_field(id, Activity) of
{ok, Cid} -> Cid;
_ -> nil
end.
bump_attempt(Cid, State) ->
Attempts = field(attempts, State),
Current = case find_keyed(Cid, Attempts) of
{ok, N} -> N;
_ -> 0
end,
set_field(attempts, set_keyed(Cid, Current + 1, Attempts), State).
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> undefined.
set_field(K, V, []) -> [{K, V}];
set_field(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_field(K, V, [P | Rest]) -> [P | set_field(K, V, Rest)].
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].
del_keyed(_, []) -> [];
del_keyed(K, [{K, _} | Rest]) -> Rest;
del_keyed(K, [P | Rest]) -> [P | del_keyed(K, Rest)].

View File

@@ -1,98 +0,0 @@
-module(discovery).
-export([parse_acct/1, parse_resource/1,
actor_url_for/2, webfinger_body/3]).
%% Discovery primitives per design §13.7. Step 10a covers the
%% local-side webfinger endpoint (responding when a peer asks
%% "where does acct:alice@here live?"); the peer-fetch direction
%% (loading a peer's actor doc lazily on first inbound) is Step 10b
%% and gates on Blockers #2 (native http-request primitive).
%%
%% parse_acct/1 — accept a binary in either form:
%% <<"acct:alice@host:port">> (full prefixed URI)
%% <<"alice@host:port">> (bare account, prefix optional)
%% Returns {ok, User, Host} | {error, Reason}.
%%
%% parse_resource/1 — the resource= query parameter from
%% /.well-known/webfinger. Same shape as parse_acct.
%%
%% actor_url_for/2(User, Host) — synthesises the canonical
%% per-actor URL `<scheme>://<host>/actors/<user>`. v2 hardcodes
%% http://; TLS / https is v3 (Blockers gate).
%%
%% webfinger_body/3 — builds the JSON response body.
%% ── parse_acct / parse_resource ─────────────────────────────────
%% "acct:" -> 5 bytes: 97 99 99 116 58
parse_acct(Bin) when is_binary(Bin) ->
AcctPrefix = <<97,99,99,116,58>>,
case strip_prefix(AcctPrefix, Bin) of
{ok, Rest} -> split_user_host(Rest);
nomatch -> split_user_host(Bin)
end;
parse_acct(_) -> {error, bad_input}.
parse_resource(Bin) -> parse_acct(Bin).
%% strip_prefix/2 — return {ok, Rest} when Bin starts with Prefix,
%% else nomatch. Substrate has no proper prefix-match BIF; this
%% byte-walks.
strip_prefix(<<>>, Rest) -> {ok, Rest};
strip_prefix(<<B, PRest/binary>>, <<B, RRest/binary>>) ->
strip_prefix(PRest, RRest);
strip_prefix(_, _) -> nomatch.
%% split_user_host/1 — split a `user@host[:port]` binary at the
%% first `@`. Returns {ok, User, Host} where Host may include the
%% optional port suffix.
split_user_host(Bin) ->
case split_at(64, Bin) of % 64 = '@'
{Before, After} when byte_size(Before) > 0, byte_size(After) > 0 ->
{ok, Before, After};
_ ->
{error, bad_acct}
end.
split_at(Byte, Bin) ->
split_at(Byte, Bin, <<>>).
split_at(_, <<>>, Acc) ->
{Acc, <<>>};
split_at(Byte, <<Byte, Rest/binary>>, Acc) ->
{Acc, Rest};
split_at(Byte, <<B, Rest/binary>>, Acc) ->
split_at(Byte, Rest, <<Acc/binary, B>>).
%% ── URL synthesis ──────────────────────────────────────────────
%% "http://" -> 7 bytes | "/actors/" -> 8 bytes
actor_url_for(User, Host) ->
Pre = <<104,116,116,112,58,47,47>>, % "http://"
Mid = <<47,97,99,116,111,114,115,47>>, % "/actors/"
<<Pre/binary, Host/binary, Mid/binary, User/binary>>.
%% ── webfinger JSON body ────────────────────────────────────────
%%
%% Mastodon-shape per RFC 7033:
%% {"subject":"acct:<user>@<host>",
%% "links":[{"rel":"self",
%% "type":"application/activity+json",
%% "href":"<actor_url>"}]}
%%
%% Hand-rolled byte concatenation — no JSON BIF on this port. The
%% caller has already validated User + Host; we don't need to
%% re-escape (Mastodon's webfinger inputs are alphanumeric +
%% .-_ in practice).
webfinger_body(User, Host, ActorUrl) ->
AcctPre = <<123,34,115,117,98,106,101,99,116,34,58,34,97,99,99,116,58>>, % '{"subject":"acct:'
AcctAt = <<64>>, % '@'
LinksHd = <<34,44,34,108,105,110,107,115,34,58,91,123,34,114,101,108,34,58,34,115,101,108,102,34,44,
34,116,121,112,101,34,58,34,97,112,112,108,105,99,97,116,105,111,110,47,97,99,116,
105,118,105,116,121,43,106,115,111,110,34,44,34,104,114,101,102,34,58,34>>, % '","links":[{"rel":"self","type":"application/activity+json","href":"'
LinksTl = <<34,125,93,125,10>>, % '"}]}\n'
<<AcctPre/binary, User/binary, AcctAt/binary, Host/binary,
LinksHd/binary, ActorUrl/binary, LinksTl/binary>>.

View File

@@ -1,89 +0,0 @@
-module(discovery_fetch).
-export([make_fetch_fn/1,
fetch/2,
actor_doc_url/2,
decode_body/1,
accept_header/0]).
%% Live peer-actor-doc fetch for peer_actors — Step 10c per design
%% §13.6. The peer_actors gen_server already exposes
%% lookup_or_fetch_srv/2(PeerId, FetchFn) where FetchFn is a
%% 1-arity closure that returns {ok, PeerAS} | {error, Reason} on
%% cache miss. For tests we wire a fake FetchFn that returns a
%% pre-baked AS; for live federation we wire the closure this
%% module produces — it GETs <base>/actors/<peer> with an Accept
%% header that asks for the actor_doc format
%% (http_server.erl Step 10c), decodes the response body via
%% term_codec, and returns the AS proplist.
%%
%% Cfg shape (reuses dispatch_http's peer URL resolution so a
%% single Cfg threads through both delivery and discovery):
%% {peer_url, [{PeerId, BaseUrl}, ...]}
%% {peer_url_fn, fun ((PeerId) -> {ok, BaseUrl} | not_found)}
%%
%% BaseUrl shape: <<"http://host:port">> (no trailing slash; this
%% module appends the path). PeerId is the actor atom.
%%
%% Outcomes:
%% 2xx + decodable body -> {ok, PeerAS}
%% 2xx + bad body -> {error, bad_actor_doc}
%% non-2xx -> {error, {status, N}}
%% resolver miss -> {error, no_peer_url}
%% transport -> {error, Reason}
%%
%% Cache write semantics live in peer_actors:lookup_or_fetch/3 —
%% successful fetches store; errors do NOT poison so callers can
%% retry on transients.
%% ── Accept header ────────────────────────────────────────────
%% "application/vnd.fed-sx.actor-doc" — same MIME the http_server
%% content_type_for(actor_doc) emits, so the Accept negotiation
%% in accept_format/1 routes the peer's response to the term_codec
%% serializer arm.
accept_header() ->
<<97,112,112,108,105,99,97,116,105,111,110,47,
118,110,100,46,102,101,100,45,115,120,46,
97,99,116,111,114,45,100,111,99>>.
%% ── public API ───────────────────────────────────────────────
make_fetch_fn(Cfg) ->
fun (PeerId) ->
case dispatch_http:resolve_peer_url(PeerId, Cfg) of
{error, R} -> {error, R};
{ok, BaseUrl} -> fetch(actor_doc_url(BaseUrl, PeerId), Cfg)
end
end.
fetch(Url, _Cfg) ->
AcceptKey = <<97,99,99,101,112,116>>, % "accept"
Headers = [{AcceptKey, accept_header()}],
try httpc:request(Url, get, Headers, <<>>) of
{ok, Status, _H, Body} when Status >= 200, Status < 300 ->
decode_body(Body);
{ok, Status, _H, _B} ->
{error, {status, Status}};
Other ->
{error, {bad_response, Other}}
catch
error:Reason -> {error, Reason}
end.
%% actor_doc_url/2 — <BaseUrl>/actors/<peer>. PeerId is the actor
%% atom; rendered to a binary via its name (matches the same path
%% layout http_server.erl uses for the route registration at
%% prefix "/actors/").
actor_doc_url(BaseUrl, PeerId) when is_atom(PeerId) ->
PeerBin = list_to_binary(atom_to_list(PeerId)),
%% "/actors/" — 8 bytes
Prefix = <<47,97,99,116,111,114,115,47>>,
<<BaseUrl/binary, Prefix/binary, PeerBin/binary>>.
%% decode_body/1 — round the wire body back through term_codec.
%% Returns {ok, AS} on a proplist-shaped decode (matching the
%% peer-actor-state schema), {error, bad_actor_doc} otherwise.
decode_body(Body) ->
case term_codec:decode(Body) of
{ok, AS, _} when is_list(AS) -> {ok, AS};
_ -> {error, bad_actor_doc}
end.

View File

@@ -1,119 +0,0 @@
-module(dispatch_http).
-export([make_dispatch_fn/2,
dispatch/3,
inbox_url/2,
resolve_peer_url/2,
content_type/0]).
%% Live HTTP dispatch for delivery_worker — Step 8f per design §13.4.
%%
%% delivery_worker takes an opaque `dispatch_fn :: fun(Activity) ->
%% ok | {ok, _} | {error, Reason}`. For tests we wire a fake one
%% that records calls; for live federation we wire the closure this
%% module produces — a 1-arity fun that encodes the activity with
%% term_codec, looks up the peer's URL base, and POSTs to
%% `<base>/actors/<peer>/inbox` via httpc:request/4 (the BIF
%% wrapper Step 8e landed in lib/erlang/runtime.sx around the
%% native http-request primitive from fed-prims).
%%
%% Cfg shape (composable, priority order):
%% {peer_url, [{PeerId, BaseUrl::binary}, ...]}
%% Static map; tests + small static deployments. PeerId is
%% the actor atom (alice / bob / ...).
%% {peer_url_fn, fun((PeerId) -> {ok, BaseUrl} | not_found)}
%% Dynamic lookup; used when peer_actors gen_server caches a
%% discovery result (Step 10c will plumb this).
%%
%% BaseUrl is the scheme+host+port of the peer's HTTP server, e.g.
%% <<"http://127.0.0.1:8123">>. The inbox URL is built by
%% appending /actors/<peer>/inbox so callers don't have to know the
%% wire path layout.
%%
%% Dispatch outcome:
%% 2xx -> ok (delivery_worker drops the entry)
%% non-2xx -> {error, {status, N}}
%% resolver miss -> {error, no_peer_url}
%% transport -> {error, Reason} (BIF-raised, caught here)
%% ── content-type ─────────────────────────────────────────────
%% "application/vnd.fed-sx.activity" — picked to be distinct from
%% the existing http_server content types (text/json/sx/cbor) since
%% the wire bytes are term_codec's custom netstring-ish format, not
%% any of them. The receiver's handle_inbox_post/3 in
%% http_server.erl doesn't gate on content-type yet; it just hands
%% the body to term_codec:decode. We still send a real MIME so
%% intermediaries (proxies, load balancers, logs) see something
%% honest. Substrate Note: M2 doesn't add a content_type_for/1
%% clause to http_server because that's serving outbound responses
%% (the dispatch direction is FROM us; the receiver shapes its
%% own response).
content_type() ->
%% "application/vnd.fed-sx.activity"
<<97,112,112,108,105,99,97,116,105,111,110,47,
118,110,100,46,102,101,100,45,115,120,46,97,99,
116,105,118,105,116,121>>.
%% ── public API ───────────────────────────────────────────────
make_dispatch_fn(PeerId, Cfg) ->
fun (Activity) ->
case resolve_peer_url(PeerId, Cfg) of
{error, R} ->
{error, R};
{ok, BaseUrl} ->
Url = inbox_url(BaseUrl, PeerId),
dispatch(Url, Activity, Cfg)
end
end.
dispatch(Url, Activity, _Cfg) ->
Body = term_codec:encode(Activity),
Headers = [{<<99,111,110,116,101,110,116,45,116,121,112,101>>,
content_type()}],
%% This port's try/catch needs a literal class atom (not Class:R).
%% The BIF wrapper raises error:{network, _} on transport failure
%% and error:badarg on shape failure; both reach us as `error`.
try httpc:request(Url, post, Headers, Body) of
{ok, Status, _H, _B} when Status >= 200, Status < 300 -> ok;
{ok, Status, _H, _B} -> {error, {status, Status}};
Other -> {error, {bad_response, Other}}
catch
error:Reason -> {error, Reason}
end.
%% inbox_url/2 — concatenate BaseUrl + "/actors/" + PeerId + "/inbox".
%% PeerId is the actor atom; rendered to a binary via its name.
inbox_url(BaseUrl, PeerId) when is_atom(PeerId) ->
PeerBin = list_to_binary(atom_to_list(PeerId)),
%% "/actors/" — 47,97,99,116,111,114,115,47
Prefix = <<47,97,99,116,111,114,115,47>>,
%% "/inbox" — 47,105,110,98,111,120
Suffix = <<47,105,110,98,111,120>>,
<<BaseUrl/binary, Prefix/binary, PeerBin/binary, Suffix/binary>>.
%% resolve_peer_url/2 — static :peer_url map first (tests), then
%% :peer_url_fn closure (Step 10c will hand one in once peer_actors
%% caches discovered URLs).
resolve_peer_url(PeerId, Cfg) ->
case envelope:get_field(peer_url, Cfg) of
{ok, Map} when is_list(Map) ->
case lookup_peer(PeerId, Map) of
{ok, U} -> {ok, U};
_ -> try_fn(PeerId, Cfg)
end;
_ -> try_fn(PeerId, Cfg)
end.
try_fn(PeerId, Cfg) ->
case envelope:get_field(peer_url_fn, Cfg) of
{ok, Fn} when is_function(Fn, 1) ->
case Fn(PeerId) of
{ok, U} when is_binary(U) -> {ok, U};
_ -> {error, no_peer_url}
end;
_ -> {error, no_peer_url}
end.
lookup_peer(_PeerId, []) -> not_found;
lookup_peer(PeerId, [{PeerId, Url} | _]) -> {ok, Url};
lookup_peer(PeerId, [_ | Rest]) -> lookup_peer(PeerId, Rest).

View File

@@ -1,118 +0,0 @@
-module(endorsement_state).
-export([new/0, fold/2, fold_fn/0,
counters_for/2, total_for/2, kinds_for/2,
endorsers_for/3, has_endorsed/4]).
%% Endorsement counter projection. Folds Endorse activities into a
%% per-target-Cid + per-kind counter so projections can serve
%% "how many likes does this Note have" / "list everyone who shared
%% this Announce" queries.
%%
%% Endorse envelope shape (per next/genesis/activity-types/endorse.sx):
%% [{type, endorse},
%% {actor, ActorId},
%% {object, TargetCidBinary},
%% {kind, KindAtomOrBinary},
%% ...]
%%
%% State shape:
%% [{TargetCid, [{Kind, [{ActorId, Count}, ...]}, ...]}, ...]
%%
%% Each ActorId can endorse the same target multiple times under
%% the same kind (e.g. like → unlike → like → ...); the counter
%% tracks how many *net* endorsement events fired. Step 11b ships
%% the additive counter only; the unlike / un-endorse semantics
%% (Undo{Endorse}) and reaction-toggling defer to a follow-up.
new() -> [].
fold_fn() ->
fun (Activity, State) -> fold(Activity, State) end.
fold(Activity, State) ->
case envelope:get_field(type, Activity) of
{ok, endorse} -> fold_endorse(Activity, State);
_ -> State
end.
fold_endorse(Activity, State) ->
case {envelope:get_field(actor, Activity),
envelope:get_field(object, Activity),
envelope:get_field(kind, Activity)} of
{{ok, Actor}, {ok, Cid}, {ok, Kind}} ->
bump(Cid, Kind, Actor, State);
_ ->
State
end.
bump(Cid, Kind, Actor, State) ->
KindMap = case find_keyed(Cid, State) of
{ok, KM} -> KM;
_ -> []
end,
ActorMap = case find_keyed(Kind, KindMap) of
{ok, AM} -> AM;
_ -> []
end,
Current = case find_keyed(Actor, ActorMap) of
{ok, N} -> N;
_ -> 0
end,
ActorMap1 = set_keyed(Actor, Current + 1, ActorMap),
KindMap1 = set_keyed(Kind, ActorMap1, KindMap),
set_keyed(Cid, KindMap1, State).
%% ── Read-side accessors ───────────────────────────────────────
%% counters_for(Cid, State) -> [{Kind, TotalCount}, ...]
%% Sum per-kind across all endorsers.
counters_for(Cid, State) ->
case find_keyed(Cid, State) of
{ok, KindMap} ->
[{K, sum_counts(AM)} || {K, AM} <- KindMap];
_ -> []
end.
total_for(Cid, State) ->
lists:foldl(fun ({_, N}, Acc) -> N + Acc end, 0, counters_for(Cid, State)).
kinds_for(Cid, State) ->
[K || {K, _} <- counters_for(Cid, State)].
endorsers_for(Cid, Kind, State) ->
case find_keyed(Cid, State) of
{ok, KindMap} ->
case find_keyed(Kind, KindMap) of
{ok, AM} -> [A || {A, _} <- AM];
_ -> []
end;
_ -> []
end.
has_endorsed(Actor, Cid, Kind, State) ->
case find_keyed(Cid, State) of
{ok, KindMap} ->
case find_keyed(Kind, KindMap) of
{ok, AM} ->
case find_keyed(Actor, AM) of
{ok, N} -> N > 0;
_ -> false
end;
_ -> false
end;
_ -> false
end.
%% ── Internal ──────────────────────────────────────────────────
sum_counts([]) -> 0;
sum_counts([{_, N} | Rest]) -> N + sum_counts(Rest).
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].

View File

@@ -1,177 +0,0 @@
-module(envelope).
-export([validate_shape/1, get_field/2, canonical_bytes/1, verify_signature/2]).
%% Activity envelope per design §3.1.
%%
%% Erlang maps (#{...}) are not supported by this port, so envelopes
%% are represented as property lists of {atom_key, value} pairs. This
%% port's binary syntax also can't carry string literals; values that
%% would naturally be binaries in real Erlang are kept as atoms or
%% integer-segment binaries in the test corpus.
%%
%% Required fields: id, type, actor, published, signature.
%% The signature value is itself a property list with key_id,
%% algorithm, value.
%%
%% validate_shape/1 returns ok | {error, Reason}. Reasons:
%% not_a_proplist
%% {missing_field, FieldName}
%% {bad_signature, BadSigReason}
%%
%% get_field/2 returns {ok, Value} | not_found.
validate_shape(Env) when is_list(Env) ->
case check_required([id, type, actor, published, signature], Env) of
ok -> validate_signature_shape(Env);
Err -> Err
end;
validate_shape(_) ->
{error, not_a_proplist}.
get_field(_, []) -> not_found;
get_field(K, [{K, V} | _]) -> {ok, V};
get_field(K, [_ | Rest]) -> get_field(K, Rest).
check_required([], _) -> ok;
check_required([F | Rest], Env) ->
case get_field(F, Env) of
{ok, _} -> check_required(Rest, Env);
not_found -> {error, {missing_field, F}}
end.
validate_signature_shape(Env) ->
{ok, Sig} = get_field(signature, Env),
case is_list(Sig) of
true ->
case check_required([key_id, algorithm, value], Sig) of
ok -> ok;
{error, {missing_field, F}} ->
{error, {bad_signature, {missing_field, F}}}
end;
false ->
{error, {bad_signature, not_a_proplist}}
end.
%% canonical_bytes/1 — the byte string the signature covers.
%%
%% Real fed-sx will use dag-cbor over a JSON-LD-canonicalised form
%% (design §3.2). For milestone 1 we stand in for that with the host
%% BIF `cid:to_string/1`, which produces a CIDv1 over the deterministic
%% textual form of the term. Two prior steps make this work:
%% 1. The signature pair is stripped (sig covers everything except
%% itself).
%% 2. The top-level property list is sorted by key so field order in
%% the source envelope is not load-bearing.
%%
%% The result is an Erlang binary suitable as the sig-cover input.
canonical_bytes(Env) when is_list(Env) ->
Stripped = strip_signature(Env),
Sorted = sort_pairs(Stripped),
cid:to_string(Sorted).
strip_signature([]) -> [];
strip_signature([{signature, _} | Rest]) -> strip_signature(Rest);
strip_signature([P | Rest]) -> [P | strip_signature(Rest)].
sort_pairs([]) -> [];
sort_pairs([H | T]) -> insert_pair(H, sort_pairs(T)).
insert_pair(P, []) -> [P];
insert_pair({K1, V1}, [{K2, V2} | Rest]) ->
case K1 < K2 of
true -> [{K1, V1}, {K2, V2} | Rest];
false -> [{K2, V2} | insert_pair({K1, V1}, Rest)]
end.
%% verify_signature/2 — time-aware sig verification per design §9.6.
%%
%% Activity carries a `signature` proplist with `key_id`, `algorithm`,
%% `value`. ActorState carries `public_keys` — a list of key proplists
%% with `id`, `created`, optionally `superseded_at`, and `value` (the
%% key material).
%%
%% A key is active at time T iff `created =< T` AND
%% (no `superseded_at` OR T < `superseded_at`). Verification picks the
%% first matching active key whose `id == signature.key_id` at the
%% activity's `published` timestamp, then recomputes the MAC
%% `crypto:hash(sha256, <<KeyMaterial/binary, CanonicalBytes/binary>>)`
%% and compares it to `signature.value`.
%%
%% Returns ok | {error, Reason}. Reasons:
%% no_signature | no_key_id | no_published | no_keys |
%% no_active_key | bad_signature
%%
%% Real RSA-SHA256 / Ed25519 verification is deferred to milestone 2:
%% Phase 8 only ships `crypto:hash/2`, so we stand in with an HMAC-shaped
%% MAC that exercises the same key-lookup and canonical-bytes pipeline.
verify_signature(Activity, ActorState) ->
case get_field(signature, Activity) of
not_found -> {error, no_signature};
{ok, Sig} ->
case get_field(key_id, Sig) of
not_found -> {error, no_key_id};
{ok, KeyId} ->
case get_field(published, Activity) of
not_found -> {error, no_published};
{ok, Published} ->
verify_with_keys(Activity, Sig, KeyId,
Published, ActorState)
end
end
end.
verify_with_keys(Activity, Sig, KeyId, Published, ActorState) ->
case get_field(public_keys, ActorState) of
not_found -> {error, no_keys};
{ok, Keys} ->
case find_active_key(KeyId, Published, Keys) of
not_found -> {error, no_active_key};
{ok, Key} -> verify_mac(Activity, Sig, Key)
end
end.
find_active_key(_, _, []) -> not_found;
find_active_key(KeyId, Now, [Key | Rest]) ->
case is_matching_active_key(Key, KeyId, Now) of
true -> {ok, Key};
false -> find_active_key(KeyId, Now, Rest)
end.
is_matching_active_key(Key, WantId, Now) ->
case get_field(id, Key) of
{ok, WantId} -> is_active_at(Key, Now);
_ -> false
end.
is_active_at(Key, Now) ->
case get_field(created, Key) of
not_found -> false;
{ok, Created} ->
case Now >= Created of
false -> false;
true ->
case get_field(superseded_at, Key) of
not_found -> true;
{ok, SupAt} -> Now < SupAt
end
end
end.
verify_mac(Activity, Sig, Key) ->
case get_field(value, Sig) of
not_found -> {error, bad_signature};
{ok, SigValue} ->
case get_field(value, Key) of
not_found -> {error, bad_signature};
{ok, KeyMat} ->
Bytes = canonical_bytes(Activity),
Computed = crypto:hash(sha256,
<<KeyMat/binary, Bytes/binary>>),
case SigValue =:= Computed of
true -> ok;
false -> {error, bad_signature}
end
end
end.

View File

@@ -1,237 +0,0 @@
-module(follower_graph).
-export([fold/2, fold_fn/0, new/0, lookup/2, actors/1,
following/2, followers/2,
pending_outbound/2, pending_inbound/2,
is_following/3, has_follower/3,
is_pending_outbound/3, is_pending_inbound/3]).
%% Follower-graph projection — Erlang-fun stand-in for the genesis
%% `follower-graph.sx` body. Tracks per-actor follow relationships
%% per design §13.2:
%%
%% Follow {actor: A, object: B} A asks to follow B
%% Accept {actor: B, object: F} B accepts A's Follow F (= F.actor → F.object)
%% Reject {actor: B, object: F} B rejects A's Follow F
%% Undo {actor: A, object: F} A retracts F or unfollows
%%
%% Where F = Follow{A→B} is embedded as the activity's :object
%% proplist for Accept / Reject / Undo.
%%
%% State shape:
%% [{ActorId, ActorEntry}, ...]
%%
%% ActorEntry = [{following, [PeerId, ...]},
%% {followers, [PeerId, ...]},
%% {pending_outbound, [PeerId, ...]}, %% I asked, no answer yet
%% {pending_inbound, [PeerId, ...]}] %% asked me, I haven't answered
%%
%% Sets keep insertion order; duplicates aren't added. lists:keyfind/
%% keymember aren't in this substrate, so local find_keyed/has_keyed/
%% set_keyed helpers (same convention as actor_state, define_registry,
%% nx_kernel).
%% ── Public API ──────────────────────────────────────────────────
new() -> [].
actors(State) -> [Id || {Id, _Entry} <- State].
lookup(ActorId, State) ->
case find_keyed(ActorId, State) of
{ok, Entry} -> {ok, Entry};
_ -> not_found
end.
following(ActorId, State) -> entry_field(ActorId, following, State).
followers(ActorId, State) -> entry_field(ActorId, followers, State).
pending_outbound(ActorId, State) -> entry_field(ActorId, pending_outbound, State).
pending_inbound(ActorId, State) -> entry_field(ActorId, pending_inbound, State).
is_following(ActorId, PeerId, State) ->
contains(PeerId, following(ActorId, State)).
has_follower(ActorId, PeerId, State) ->
contains(PeerId, followers(ActorId, State)).
is_pending_outbound(ActorId, PeerId, State) ->
contains(PeerId, pending_outbound(ActorId, State)).
is_pending_inbound(ActorId, PeerId, State) ->
contains(PeerId, pending_inbound(ActorId, State)).
%% ── Fold dispatch ───────────────────────────────────────────────
fold(Activity, State) ->
case envelope:get_field(type, Activity) of
{ok, follow} -> fold_follow(Activity, State);
{ok, accept} -> fold_accept(Activity, State);
{ok, reject} -> fold_reject(Activity, State);
{ok, undo} -> fold_undo(Activity, State);
_ -> State
end.
fold_fn() ->
fun (Activity, State) -> fold(Activity, State) end.
%% Follow {actor: A, object: B}:
%% add B to A's pending_outbound
%% add A to B's pending_inbound
fold_follow(Activity, State) ->
case follow_actor_object(Activity) of
{ok, A, B} when A =/= B ->
S1 = add_to_field(A, pending_outbound, B, State),
add_to_field(B, pending_inbound, A, S1);
_ -> State
end.
%% Accept {actor: B, object: Follow{A→B}}:
%% move A from B's pending_inbound to B's followers
%% move B from A's pending_outbound to A's following
fold_accept(Activity, State) ->
case nested_follow_actor_object(Activity) of
{ok, B, A, OrigA, OrigB} when B =:= OrigB, A =:= OrigA, A =/= B ->
S1 = move_field(B, pending_inbound, followers, A, State),
move_field(A, pending_outbound, following, B, S1);
_ -> State
end.
%% Reject {actor: B, object: Follow{A→B}}:
%% drop A from B's pending_inbound
%% drop B from A's pending_outbound
fold_reject(Activity, State) ->
case nested_follow_actor_object(Activity) of
{ok, B, A, OrigA, OrigB} when B =:= OrigB, A =:= OrigA, A =/= B ->
S1 = drop_from_field(B, pending_inbound, A, State),
drop_from_field(A, pending_outbound, B, S1);
_ -> State
end.
%% Undo {actor: X, object: Follow{A→B}}:
%% Only the original Follow's actor (A) can Undo it.
%% Drops A↔B from every list on either side.
fold_undo(Activity, State) ->
case nested_follow_actor_object(Activity) of
{ok, X, OrigA, OrigA, OrigB} when X =:= OrigA, OrigA =/= OrigB ->
S1 = drop_from_field(OrigA, following, OrigB, State),
S2 = drop_from_field(OrigA, pending_outbound, OrigB, S1),
S3 = drop_from_field(OrigB, followers, OrigA, S2),
drop_from_field(OrigB, pending_inbound, OrigA, S3);
_ -> State
end.
%% ── Extraction helpers ─────────────────────────────────────────
follow_actor_object(Activity) ->
case envelope:get_field(actor, Activity) of
{ok, A} ->
case envelope:get_field(object, Activity) of
{ok, B} when is_atom(B) -> {ok, A, B};
_ -> not_follow
end;
_ -> not_follow
end.
%% nested_follow_actor_object/1 — pull (Actor, FollowActor, FollowObject)
%% out of an envelope whose :object is itself a Follow proplist.
%% Returns {ok, OuterActor, InferredPeer, InnerActor, InnerObject}.
nested_follow_actor_object(Activity) ->
case envelope:get_field(actor, Activity) of
{ok, Outer} ->
case envelope:get_field(object, Activity) of
{ok, Inner} when is_list(Inner) ->
case nested_is_follow(Inner) of
true ->
case {envelope:get_field(actor, Inner),
envelope:get_field(object, Inner)} of
{{ok, IA}, {ok, IO}} when is_atom(IO) ->
{ok, Outer, peer_from_inner(Outer, IA, IO), IA, IO};
_ -> not_a_follow_wrapper
end;
false -> not_a_follow_wrapper
end;
_ -> not_a_follow_wrapper
end;
_ -> not_a_follow_wrapper
end.
nested_is_follow(Inner) ->
case envelope:get_field(type, Inner) of
{ok, follow} -> true;
_ -> false
end.
%% peer_from_inner — for an Accept/Reject by B of Follow{A→B},
%% Outer = B; the "peer" we move state for is A. For an Undo by A,
%% Outer = A; the peer is B. Picking the inner actor/object that
%% isn't Outer gives us the right pair-mate.
peer_from_inner(Outer, IA, _IO) when Outer =:= IA -> IA;
peer_from_inner(_Outer, IA, _IO) -> IA.
%% ── Entry / field accessors ────────────────────────────────────
entry_field(ActorId, Field, State) ->
case find_keyed(ActorId, State) of
{ok, Entry} ->
case find_keyed(Field, Entry) of
{ok, Val} -> Val;
_ -> []
end;
_ -> []
end.
empty_entry() ->
[{following, []},
{followers, []},
{pending_outbound, []},
{pending_inbound, []}].
ensure_entry(ActorId, State) ->
case find_keyed(ActorId, State) of
{ok, _} -> State;
_ -> State ++ [{ActorId, empty_entry()}]
end.
add_to_field(ActorId, Field, PeerId, State) ->
S1 = ensure_entry(ActorId, State),
{ok, Entry} = find_keyed(ActorId, S1),
Current = entry_field(ActorId, Field, S1),
NewList = case contains(PeerId, Current) of
true -> Current;
false -> Current ++ [PeerId]
end,
NewEntry = set_keyed(Field, NewList, Entry),
set_keyed(ActorId, NewEntry, S1).
drop_from_field(ActorId, Field, PeerId, State) ->
case find_keyed(ActorId, State) of
{ok, Entry} ->
Current = entry_field(ActorId, Field, State),
NewList = remove_member(PeerId, Current),
NewEntry = set_keyed(Field, NewList, Entry),
set_keyed(ActorId, NewEntry, State);
_ -> State
end.
move_field(ActorId, FromField, ToField, PeerId, State) ->
S1 = drop_from_field(ActorId, FromField, PeerId, State),
add_to_field(ActorId, ToField, PeerId, S1).
%% ── List helpers ───────────────────────────────────────────────
contains(_, []) -> false;
contains(X, [X | _]) -> true;
contains(X, [_ | Rest]) -> contains(X, Rest).
remove_member(_, []) -> [];
remove_member(X, [X | Rest]) -> remove_member(X, Rest);
remove_member(X, [Y | Rest]) -> [Y | remove_member(X, Rest)].
%% ── Keyed-list helpers ─────────────────────────────────────────
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].

File diff suppressed because it is too large Load Diff

View File

@@ -1,362 +0,0 @@
-module(log).
-export([open/2, open_disk/2, open_disk/3,
append/2, tip/1, replay/3, entries/1,
segments/1]).
%% Per-actor activity log — the canonical record of everything an
%% actor has emitted, in chronological order. Per design §15.2 this
%% lives on disk as numbered segment files; v1 started with an
%% in-memory backend (Step 3a) so the API + seq-number machinery
%% could be locked down before on-disk persistence (Step 3b) and
%% segment rotation (Step 3c.a — this revision).
%%
%% On-disk layout:
%% <BasePath>/<ActorId>-NNNNNN.log
%%
%% NNNNNN is a 6-digit zero-padded segment index (000000..999999) so
%% file:list_dir's alphabetical ordering coincides with numeric. Each
%% segment file is the concat of length-prefixed frames; each frame
%% is `<<Len:32/big>>` + `term_codec:encode(Activity)`.
%%
%% In-memory state (a property list):
%% [{actor, ActorId},
%% {base, BasePath}, %% binary | charlist
%% {seq, NextSeq}, %% next seq the log will assign
%% {entries, [Activity, ...]}, %% flat, append order, oldest first
%% {persisted, true|false}, %% does append write through?
%% {seg_size, MaxBytes}, %% rotate when active segment > this
%% {seg_lens, [N0, N1, ...]}] %% entry count per segment in order
%%
%% `seg_lens` is the sole bookkeeping needed to compute (a) which
%% segment any given seq lives in, and (b) which slice of `entries`
%% is the active segment's contents to rewrite on append. The last
%% element is the active segment's length.
%% In-memory only — atoms accepted as BasePath for back-compat with
%% Step 3a tests that just want the API surface.
open(ActorId, BasePath) ->
{ok, [{actor, ActorId}, {base, BasePath},
{seq, 0}, {entries, []},
{persisted, false}]}.
%% Disk-backed; default segment size = effectively unlimited (no
%% rotation). Use open_disk/3 with {segment_size, N} to enable.
open_disk(ActorId, BasePath) ->
open_disk(ActorId, BasePath, [{segment_size, 1073741824}]). %% 1 GiB
open_disk(ActorId, BasePath, Opts) ->
SegSize = proplist_get(segment_size, Opts, 1073741824),
case load_all_segments(ActorId, BasePath) of
{ok, SegEntries} ->
%% SegEntries :: [[Entry, ...]] in segment-index order
%% (empty list when no segments exist on disk).
Lens0 = [length(S) || S <- SegEntries],
%% Always have at least one active segment, even if empty.
Lens = case Lens0 of
[] -> [0];
_ -> Lens0
end,
Flat = flatten_segs(SegEntries),
State = [{actor, ActorId}, {base, BasePath},
{seq, length(Flat)},
{entries, Flat},
{persisted, true},
{seg_size, SegSize},
{seg_lens, Lens}],
{ok, State};
{error, _} = E ->
E
end.
append(LogState, Activity) ->
Seq = field(seq, LogState),
Entries = field(entries, LogState),
case lookup(persisted, LogState) of
true ->
SegLens = field(seg_lens, LogState),
SegSize = field(seg_size, LogState),
{NewSegLens, ActiveIdx, ActiveEntries} =
place_append(Entries, Activity, SegLens, SegSize),
Path = segment_path(field(actor, LogState),
field(base, LogState),
ActiveIdx),
ok = write_segment(Path, ActiveEntries),
NewState = replace_field(seq, Seq + 1,
replace_field(entries, Entries ++ [Activity],
replace_field(seg_lens, NewSegLens, LogState))),
{ok, NewState, Seq};
_ ->
NewState = replace_field(seq, Seq + 1,
replace_field(entries, Entries ++ [Activity],
LogState)),
{ok, NewState, Seq}
end.
tip(LogState) ->
field(seq, LogState).
replay(LogState, InitAcc, Fun) ->
Entries = field(entries, LogState),
replay_loop(Entries, 0, InitAcc, Fun).
entries(LogState) ->
field(entries, LogState).
%% Debug accessor: returns the in-memory seg_lens (count per segment
%% in index order). Used by rotation tests to assert that rotation
%% happened.
segments(LogState) ->
case lookup(seg_lens, LogState) of
undefined -> [];
L -> L
end.
%% --- internals ---
replay_loop([], _, Acc, _) -> Acc;
replay_loop([Act | Rest], Seq, Acc, Fun) ->
replay_loop(Rest, Seq + 1, Fun(Act, Seq, Acc), Fun).
%% place_append/4 decides whether the new Activity extends the current
%% active segment or opens a fresh one, returning the resulting
%% seg_lens, the active segment's index, and the active segment's
%% complete entry list (the slice that needs to be (re)written to
%% disk).
%%
%% Rotation rule: if the active segment already on disk is at or past
%% the size threshold (encoded_size(OldActive) >= SegSize) AND it
%% already holds at least one entry, the new Activity opens a new
%% segment. A single entry larger than the threshold therefore lives
%% on its own — we never recurse rotating a one-entry segment.
%%
%% This is decided BEFORE the append (looking at the pre-append size),
%% so each segment file is written exactly once per append cycle.
place_append(OldEntries, Activity, SegLens, SegSize) ->
{Pre, Last} = split_last(SegLens),
PreCount = sum(Pre),
OldActive = drop(PreCount, OldEntries),
OldActiveSize = encoded_size(OldActive),
case (OldActiveSize >= SegSize) andalso (Last >= 1) of
true ->
%% Rotate: new entry starts a brand-new segment.
NewSegLens = SegLens ++ [1],
NewActiveIdx = length(SegLens),
{NewSegLens, NewActiveIdx, [Activity]};
false ->
%% Stay: extend current active.
NewSegLens = Pre ++ [Last + 1],
NewActiveIdx = length(Pre),
{NewSegLens, NewActiveIdx, OldActive ++ [Activity]}
end.
split_last([X]) -> {[], X};
split_last([H | T]) ->
{Tl, Last} = split_last(T),
{[H | Tl], Last}.
sum(L) -> sum_(L, 0).
sum_([], A) -> A;
sum_([H | T], A) -> sum_(T, A + H).
drop(0, L) -> L;
drop(_, []) -> [];
drop(N, [_ | T]) -> drop(N - 1, T).
%% flatten_segs/1 — concat a list of segments (each itself a list of
%% entries) into a single flat list, preserving order. Used by
%% open_disk to assemble the on-disk activity history from per-
%% segment loads. Implemented locally because lists:append/1 isn't
%% registered in this port — only lists:append/2.
flatten_segs([]) -> [];
flatten_segs([Seg | Rest]) -> Seg ++ flatten_segs(Rest).
encoded_size(Entries) ->
byte_size(list_to_binary(
[frame(term_codec:encode(E)) || E <- Entries])).
%% Try to read every segment file under BasePath matching the actor.
%% Returns {ok, [[Entry, ...]]} where the outer list is in segment-
%% index order. Empty when no segments exist.
load_all_segments(ActorId, BasePath) ->
%% list_dir returns {ok, [Binary]} of entry names in sorted order
%% per fed-prims contract.
BaseChars = base_chars(BasePath),
case file:list_dir(BaseChars) of
{ok, Names} ->
%% Erlang string literals are NOT charlists in this port,
%% so build prefix/suffix as explicit char-code lists.
Prefix = atom_to_list(ActorId) ++ [$-],
Suffix = [$., $l, $o, $g],
Indices = collect_segment_indices(Names, Prefix, Suffix),
read_segments_in_order(Indices, ActorId, BasePath, []);
{error, enoent} ->
{ok, []};
{error, R} ->
{error, {read, R}}
end.
collect_segment_indices([], _, _) -> [];
collect_segment_indices([Name | Rest], Prefix, Suffix) ->
case parse_segment_name(Name, Prefix, Suffix) of
{ok, N} ->
[N | collect_segment_indices(Rest, Prefix, Suffix)];
not_ours ->
collect_segment_indices(Rest, Prefix, Suffix)
end.
parse_segment_name(NameBin, Prefix, Suffix) when is_binary(NameBin) ->
parse_segment_name(binary_to_list(NameBin), Prefix, Suffix);
parse_segment_name(Name, Prefix, Suffix) ->
case strip_prefix(Name, Prefix) of
{ok, Rest} ->
case strip_suffix(Rest, Suffix) of
{ok, NumStr} ->
case is_all_digits(NumStr) of
true -> {ok, list_to_integer(NumStr)};
false -> not_ours
end;
not_ours -> not_ours
end;
not_ours -> not_ours
end.
strip_prefix(Str, []) -> {ok, Str};
strip_prefix([C | Rest], [P | PRest]) ->
case C =:= P of
true -> strip_prefix(Rest, PRest);
false -> not_ours
end;
strip_prefix(_, _) -> not_ours.
strip_suffix(Str, Suffix) ->
SL = length(Str),
XL = length(Suffix),
case SL >= XL of
true ->
Head = take_n_pl(SL - XL, Str),
Tail = drop(SL - XL, Str),
case Tail =:= Suffix of
true -> {ok, Head};
false -> not_ours
end;
false -> not_ours
end.
take_n_pl(0, _) -> [];
take_n_pl(_, []) -> [];
take_n_pl(N, [H | T]) -> [H | take_n_pl(N - 1, T)].
is_all_digits([]) -> false;
is_all_digits(Chars) -> all_digits(Chars).
all_digits([]) -> true;
all_digits([C | Rest]) when C >= $0, C =< $9 -> all_digits(Rest);
all_digits(_) -> false.
%% read_segments_in_order/4 — fed-prims sorts list_dir alphabetically;
%% with 6-digit zero-padded names that coincides with numeric order.
%% But we also accept legacy unpadded names, so sort by index to be
%% defensive.
read_segments_in_order(Indices, ActorId, BasePath, Acc) ->
Sorted = isort(Indices),
read_each(Sorted, ActorId, BasePath, Acc).
read_each([], _, _, Acc) ->
{ok, lists:reverse(Acc)};
read_each([Idx | Rest], ActorId, BasePath, Acc) ->
Path = segment_path(ActorId, BasePath, Idx),
case try_read_segment(Path) of
{ok, Entries} ->
read_each(Rest, ActorId, BasePath, [Entries | Acc]);
{error, _} = E -> E
end.
%% Tiny insertion sort over a small list of integers.
isort([]) -> [];
isort([H | T]) -> insert(H, isort(T)).
insert(X, []) -> [X];
insert(X, [Y | Rest]) when X =< Y -> [X, Y | Rest];
insert(X, [Y | Rest]) -> [Y | insert(X, Rest)].
%% segment_path/3 — charlist path to the Idx'th segment file.
segment_path(ActorId, BasePath, Idx) ->
base_chars(BasePath) ++ [$/] ++ atom_to_list(ActorId)
++ [$-] ++ pad_int(Idx, 6) ++ [$., $l, $o, $g].
base_chars(B) when is_binary(B) -> binary_to_list(B);
base_chars(L) when is_list(L) -> L.
%% Zero-pad an integer to Width digits as a charlist.
pad_int(N, Width) ->
Cs = integer_to_list(N),
pad_left(Cs, Width).
pad_left(Cs, Width) ->
case length(Cs) >= Width of
true -> Cs;
false -> pad_left([$0 | Cs], Width)
end.
write_segment(Path, Entries) ->
Frames = [frame(term_codec:encode(E)) || E <- Entries],
file:write_file(Path, list_to_binary(Frames)).
%% frame/1 — prepend 4-byte big-endian length to Payload.
frame(Payload) when is_binary(Payload) ->
L = byte_size(Payload),
B3 = (L div 16777216) rem 256,
B2 = (L div 65536) rem 256,
B1 = (L div 256) rem 256,
B0 = L rem 256,
[B3, B2, B1, B0, Payload].
try_read_segment(Path) ->
case file:read_file(Path) of
{ok, Bin} ->
try {ok, decode_frames(binary_to_list(Bin), [])}
catch
throw:Reason -> {error, {corrupt, Reason}};
error:Reason -> {error, {corrupt, Reason}}
end;
{error, enoent} ->
{ok, []};
{error, R} ->
{error, {read, R}}
end.
decode_frames([], Acc) ->
lists:reverse(Acc);
decode_frames([B3, B2, B1, B0 | Rest], Acc) ->
Len = B3 * 16777216 + B2 * 65536 + B1 * 256 + B0,
{Payload, Rest2} = take_n(Len, Rest),
case term_codec:decode(list_to_binary(Payload)) of
{ok, Term, _} -> decode_frames(Rest2, [Term | Acc]);
{error, R} -> throw({decode, R})
end;
decode_frames(_, _) ->
throw(truncated_header).
take_n(0, R) -> {[], R};
take_n(N, [H | T]) ->
{Hs, Tl} = take_n(N - 1, T),
{[H | Hs], Tl};
take_n(_, []) ->
throw(truncated_body).
%% --- proplist helpers ---
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> erlang:error(badkey).
lookup(K, [{K, V} | _]) -> V;
lookup(K, [_ | Rest]) -> lookup(K, Rest);
lookup(_, []) -> undefined.
replace_field(K, V, []) -> [{K, V}];
replace_field(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
replace_field(K, V, [P | Rest]) -> [P | replace_field(K, V, Rest)].
proplist_get(K, [{K, V} | _], _) -> V;
proplist_get(K, [_ | Rest], Default) -> proplist_get(K, Rest, Default);
proplist_get(_, [], Default) -> Default.

View File

@@ -1,85 +0,0 @@
-module(log_server).
-behaviour(gen_server).
-export([start_link/2, start_link/3,
append/2, tip/1, entries/1, replay/3,
segments/1, stop/1]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
%% Step 3c.b — gen_server in front of `log` that owns a single
%% per-actor disk-backed log state and serialises concurrent
%% appenders through `gen_server:call`.
%%
%% Architecture: the pure `log` module from Step 3c.a remains the
%% canonical substrate (open_disk, append, tip, replay, entries,
%% segments). This wrapper owns one log state per process; every
%% public op (append/tip/entries/replay/segments) routes through
%% gen_server:call so that the on-disk segment writer sees one
%% append at a time, regardless of how many writer processes are
%% pushing concurrently.
%%
%% Port notes carried from Step 5b's registry_server:
%% * `gen_server:start_link/2` returns the raw Pid, not `{ok,Pid}`.
%% * Spawned processes don't survive across separate
%% `erlang-eval-ast` invocations — every concurrency test has
%% to start the server, spin writers, join them, and assert all
%% within one eval expression.
%%
%% API takes the server Pid (not a registered name) so multiple
%% per-actor servers can coexist without colliding on the registry.
%% --- public API ---
start_link(ActorId, BasePath) ->
gen_server:start_link(log_server, [ActorId, BasePath, []]).
start_link(ActorId, BasePath, Opts) ->
gen_server:start_link(log_server, [ActorId, BasePath, Opts]).
append(Pid, Activity) ->
gen_server:call(Pid, {append, Activity}).
tip(Pid) ->
gen_server:call(Pid, tip).
entries(Pid) ->
gen_server:call(Pid, entries).
replay(Pid, InitAcc, Fun) ->
%% The fold runs server-side so the state stays consistent
%% with concurrent writers; the caller's Fun is closed over
%% the message and shipped opaque through gen_server:call.
gen_server:call(Pid, {replay, InitAcc, Fun}).
segments(Pid) ->
gen_server:call(Pid, segments).
stop(Pid) ->
gen_server:call(Pid, '$gen_stop').
%% --- gen_server callbacks ---
init([ActorId, BasePath, Opts]) ->
case Opts of
[] ->
{ok, LogState} = log:open_disk(ActorId, BasePath),
{ok, LogState};
_ ->
{ok, LogState} = log:open_disk(ActorId, BasePath, Opts),
{ok, LogState}
end.
handle_call({append, Activity}, _From, State) ->
{ok, NewState, Seq} = log:append(State, Activity),
{reply, {ok, Seq}, NewState};
handle_call(tip, _From, State) ->
{reply, log:tip(State), State};
handle_call(entries, _From, State) ->
{reply, log:entries(State), State};
handle_call({replay, InitAcc, Fun}, _From, State) ->
{reply, log:replay(State, InitAcc, Fun), State};
handle_call(segments, _From, State) ->
{reply, log:segments(State), State}.
handle_cast(_, S) -> {noreply, S}.
handle_info(_, S) -> {noreply, S}.

View File

@@ -1,24 +0,0 @@
-module(nx_cid).
-export([from_sx/1, to_string/1, from_string/1, equals/2]).
%% The kernel-side CID wrapper. The host BIF `cid:to_string/1` already
%% produces a canonical CIDv1 (raw codec, sha2-256 multihash) over the
%% deterministic textual form of any term (er-format-value); we expose
%% it under the kernel namespace and add the equality + round-trip
%% helpers the rest of the kernel needs.
%%
%% Naming note: the BIF module is `cid`, so we use `nx_cid` to avoid
%% shadowing. Plans/fed-sx-milestone-1.md §Step 1 spells the file as
%% `cid.erl`; the briefing flags Erlang snippets as illustrative.
from_sx(V) ->
cid:to_string(V).
to_string(Cid) ->
Cid.
from_string(S) ->
S.
equals(A, B) ->
A =:= B.

View File

@@ -1,451 +0,0 @@
-module(nx_kernel).
-behaviour(gen_server).
%% Pure-functional API
-export([new/0, new/3,
add_actor/4, has_actor/2, actors/1, actor_count/1,
publish/2, publish/3,
bootstrap_actor/4,
actor_id/1, log_state/1, log_tip/1,
key_spec/1, actor_state/1, projections/1, next_published/1,
actor_log_state/2, actor_log_tip/2,
actor_inbox_state/2, actor_inbox_tip/2,
append_to_actor_inbox/3,
actor_key_spec/2, actor_state/2, actor_projections/2,
actor_next_published/2, actor_bucket/2,
with_projections/2, with_actor_projections/3,
next_actor_seq/1]).
%% gen_server API
-export([start_link/3, publish/1, query/0, log_tip/0,
with_projections/1, stop/0,
add_actor/3, publish_to/2, log_tip_for/1, log_state_for/1,
inbox_tip_for/1, inbox_state_for/1, append_inbox/2,
actors/0, state_for/1, bucket_for/1,
with_projections_for/2,
bootstrap_actor/3]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
%% Kernel orchestrator — the long-lived runtime state held by the
%% running fed-sx instance. Step 1 (m2) refactor: state is now
%% per-actor bucketed so one kernel hosts any number of actors.
%%
%% New state shape (property list):
%% [{actors, [{ActorId, ActorBucket}, ...]},
%% {next_actor_seq, NextN}]
%%
%% ActorBucket = [{key_spec, KS},
%% {actor_state, AS},
%% {log, L},
%% {projections, [Name]},
%% {next_published, NextSeq}]
%%
%% Legacy single-actor accessors (actor_id/1, key_spec/1, etc.)
%% continue to read from the first registered actor — keeps every
%% pre-m2 test passing through bootstrap:start/3.
%%
%% next_actor_seq is a monotonic counter handed out to add_actor for
%% future use (e.g. per-actor URL paths in Step 4). It's not yet
%% read by the rest of the kernel.
%% ── Pure-functional API ──────────────────────────────────────────
new() ->
[{actors, []}, {next_actor_seq, 1}].
new(ActorId, KeySpec, ActorStateProplist) ->
{ok, S} = add_actor(ActorId, KeySpec, ActorStateProplist, new()),
S.
add_actor(ActorId, KeySpec, AS, State) ->
Actors = field(actors, State),
case has_keyed(ActorId, Actors) of
true ->
{error, already_present};
false ->
{ok, L0} = log:open(ActorId, base_stub()),
{ok, I0} = log:open(ActorId, inbox_base_stub()),
Bucket = [{key_spec, KeySpec},
{actor_state, AS},
{log, L0},
{actor_inbox, I0},
{projections, []},
{next_published, 1}],
Seq = field(next_actor_seq, State),
State1 = set(actors, Actors ++ [{ActorId, Bucket}], State),
State2 = set(next_actor_seq, Seq + 1, State1),
{ok, State2}
end.
has_actor(ActorId, State) ->
has_keyed(ActorId, field(actors, State)).
actors(State) ->
[Id || {Id, _Bucket} <- field(actors, State)].
actor_count(State) ->
length(field(actors, State)).
next_actor_seq(State) ->
field(next_actor_seq, State).
actor_bucket(ActorId, State) ->
find_keyed(ActorId, field(actors, State)).
%% publish/3 — per-actor publish.
publish(ActorId, Request, State) ->
case actor_bucket(ActorId, State) of
{error, no_actor} ->
{error, no_actor, State};
{ok, Bucket} ->
P = field(next_published, Bucket),
Ctx = [{actor_id, ActorId},
{published, P},
{key_spec, field(key_spec, Bucket)},
{actor_state, field(actor_state, Bucket)},
{log, field(log, Bucket)},
{projections, field(projections, Bucket)}],
case outbox:publish(Request, Ctx) of
{ok, Result, NewLog} ->
B1 = set(log, NewLog, Bucket),
B2 = set(next_published, P + 1, B1),
NewState = set_bucket(ActorId, B2, State),
{ok, Result, NewState};
{error, Reason, _} ->
{error, Reason, State}
end
end.
%% publish/2 — legacy single-actor publish; routes to first actor.
publish(Request, State) ->
case actors(State) of
[] -> {error, no_actor, State};
[First | _] -> publish(First, Request, State)
end.
%% bootstrap_actor/4 — register an actor bucket and immediately
%% publish a Create{Person|Service|Group} as that actor's first
%% activity. Profile carries the object fields plus :public_keys.
%% Returns {ok, Result, NewState} where Result has the published
%% Create's CID, or {error, Reason, State} on validation halt.
bootstrap_actor(ActorId, Profile, KeySpec, State) ->
PublicKeys = case field(public_keys, Profile) of
nil -> [];
KS -> KS
end,
AS = [{public_keys, PublicKeys}],
case add_actor(ActorId, KeySpec, AS, State) of
{ok, State1} ->
ActorType = case field(type, Profile) of
nil -> person;
T -> T
end,
Object = [{type, ActorType}] ++ collect_profile_fields(
[name, preferredUsername, summary, icon, public_keys],
Profile),
Request = [{type, create}, {object, Object}],
publish(ActorId, Request, State1);
{error, Reason} ->
{error, Reason, State}
end.
collect_profile_fields([], _) -> [];
collect_profile_fields([F | Rest], Profile) ->
case field(F, Profile) of
nil -> collect_profile_fields(Rest, Profile);
V -> [{F, V} | collect_profile_fields(Rest, Profile)]
end.
with_actor_projections(ActorId, Names, State) ->
case actor_bucket(ActorId, State) of
{error, no_actor} ->
{error, no_actor};
{ok, Bucket} ->
B1 = set(projections, Names, Bucket),
{ok, set_bucket(ActorId, B1, State)}
end.
with_projections(Names, State) ->
case actors(State) of
[] -> State;
[First | _] ->
{ok, NewState} = with_actor_projections(First, Names, State),
NewState
end.
%% Per-actor accessors
actor_log_state(ActorId, State) ->
case actor_bucket(ActorId, State) of
{ok, B} -> {ok, field(log, B)};
{error, _} -> {error, no_actor}
end.
actor_log_tip(ActorId, State) ->
case actor_log_state(ActorId, State) of
{ok, L} -> log:tip(L);
{error, _} -> nil
end.
actor_inbox_state(ActorId, State) ->
case actor_bucket(ActorId, State) of
{ok, B} -> {ok, field(actor_inbox, B)};
{error, _} -> {error, no_actor}
end.
actor_inbox_tip(ActorId, State) ->
case actor_inbox_state(ActorId, State) of
{ok, I} -> log:tip(I);
{error, _} -> nil
end.
%% append_to_actor_inbox/3 — pure-functional inbox append. Mirrors
%% publish/3's bucket-update shape; the activity is already signed
%% + validated by the time it lands here (Step 5's pipeline handles
%% sig verify + replay before this call).
append_to_actor_inbox(ActorId, Activity, State) ->
case actor_bucket(ActorId, State) of
{error, no_actor} ->
{error, no_actor, State};
{ok, Bucket} ->
Inbox = field(actor_inbox, Bucket),
{ok, NewInbox, _Seq} = log:append(Inbox, Activity),
B1 = set(actor_inbox, NewInbox, Bucket),
{ok, log:tip(NewInbox), set_bucket(ActorId, B1, State)}
end.
actor_key_spec(ActorId, State) ->
case actor_bucket(ActorId, State) of
{ok, B} -> {ok, field(key_spec, B)};
{error, _} -> {error, no_actor}
end.
actor_state(ActorId, State) when is_list(State), is_atom(ActorId) ->
case actor_bucket(ActorId, State) of
{ok, B} -> {ok, field(actor_state, B)};
{error, _} -> {error, no_actor}
end.
actor_projections(ActorId, State) ->
case actor_bucket(ActorId, State) of
{ok, B} -> {ok, field(projections, B)};
{error, _} -> {error, no_actor}
end.
actor_next_published(ActorId, State) ->
case actor_bucket(ActorId, State) of
{ok, B} -> {ok, field(next_published, B)};
{error, _} -> {error, no_actor}
end.
%% Legacy single-actor accessors — read from first bucket. Keeps
%% every M1 test (smoke_app_pure, bootstrap_start, http_publish,
%% nx_kernel_server, http_post_format) passing.
actor_id(State) ->
case field(actors, State) of
[] -> nil;
[{First, _Bucket} | _] -> First
end.
key_spec(State) ->
bucket_field(key_spec, State).
actor_state(State) ->
bucket_field(actor_state, State).
log_state(State) ->
bucket_field(log, State).
log_tip(State) ->
log:tip(log_state(State)).
projections(State) ->
case bucket_field(projections, State) of
nil -> [];
Ps -> Ps
end.
next_published(State) ->
bucket_field(next_published, State).
%% ── Internal helpers ──────────────────────────────────────────────
base_stub() ->
<<98,97,115,101,95,115,116,117,98>>.
%% "inbox_base_stub" — distinct path stub so the in-memory log
%% module's open/2 returns a fresh log state for the per-actor
%% inbox bucket. Disk paths will namespace on this once Step 3b
%% on-disk persistence is reactivated for inbox buckets.
inbox_base_stub() ->
<<105,110,98,111,120,95,115,116,117,98>>.
bucket_field(Key, State) ->
case field(actors, State) of
[] -> nil;
[{_First, Bucket} | _] -> field(Key, Bucket)
end.
set_bucket(ActorId, NewBucket, State) ->
Actors = field(actors, State),
NewActors = set_keyed(ActorId, NewBucket, Actors),
set(actors, NewActors, State).
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)];
set_keyed(_, _, []) -> [].
has_keyed(_, []) -> false;
has_keyed(K, [{K, _} | _]) -> true;
has_keyed(K, [_ | Rest]) -> has_keyed(K, Rest).
find_keyed(_, []) -> {error, no_actor};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> nil.
set(K, V, []) -> [{K, V}];
set(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set(K, V, [P | Rest]) -> [P | set(K, V, Rest)].
%% ── gen_server wrapper ──────────────────────────────────────────
%%
%% Mirrors the registry / projection gen_server patterns from
%% Steps 5b and 7b. Same port quirks: raw Pid return, no `?MODULE`
%% macro, spawned processes don't persist across separate
%% erlang-eval-ast calls — tests inline start_link with operations.
%%
%% Step 1b (m2) adds multi-actor gen_server calls:
%% add_actor/3, publish_to/2, log_tip_for/1, actors/0, state_for/1,
%% with_projections_for/2 — all delegating to the pure-functional
%% bucket APIs. Existing single-actor calls (publish/1, log_tip/0,
%% with_projections/1) continue to route through bucket 0.
start_link(ActorId, KeySpec, ActorStateProplist) ->
Pid = gen_server:start_link(nx_kernel,
[ActorId, KeySpec, ActorStateProplist]),
erlang:register(nx_kernel, Pid),
Pid.
stop() ->
R = gen_server:call(nx_kernel, '$gen_stop'),
erlang:unregister(nx_kernel),
R.
publish(Request) ->
gen_server:call(nx_kernel, {publish, Request}).
query() ->
gen_server:call(nx_kernel, get_state).
log_tip() ->
gen_server:call(nx_kernel, get_log_tip).
with_projections(Names) ->
gen_server:call(nx_kernel, {set_projections, Names}).
%% Step 1b — multi-actor gen_server calls.
add_actor(ActorId, KeySpec, AS) ->
gen_server:call(nx_kernel, {add_actor, ActorId, KeySpec, AS}).
publish_to(ActorId, Request) ->
gen_server:call(nx_kernel, {publish_to, ActorId, Request}).
log_tip_for(ActorId) ->
gen_server:call(nx_kernel, {log_tip_for, ActorId}).
log_state_for(ActorId) ->
gen_server:call(nx_kernel, {log_state_for, ActorId}).
inbox_tip_for(ActorId) ->
gen_server:call(nx_kernel, {inbox_tip_for, ActorId}).
inbox_state_for(ActorId) ->
gen_server:call(nx_kernel, {inbox_state_for, ActorId}).
append_inbox(ActorId, Activity) ->
gen_server:call(nx_kernel, {append_inbox, ActorId, Activity}).
actors() ->
gen_server:call(nx_kernel, get_actors).
state_for(ActorId) ->
gen_server:call(nx_kernel, {state_for, ActorId}).
bucket_for(ActorId) ->
gen_server:call(nx_kernel, {bucket_for, ActorId}).
with_projections_for(ActorId, Names) ->
gen_server:call(nx_kernel, {set_projections_for, ActorId, Names}).
bootstrap_actor(ActorId, Profile, KeySpec) ->
gen_server:call(nx_kernel, {bootstrap_actor, ActorId, Profile, KeySpec}).
%% gen_server callbacks
init([ActorId, KeySpec, AS]) ->
{ok, new(ActorId, KeySpec, AS)}.
handle_call({publish, Request}, _From, State) ->
case publish(Request, State) of
{ok, Result, NewState} ->
{reply, {ok, Result}, NewState};
{error, Reason, SameState} ->
{reply, {error, Reason}, SameState}
end;
handle_call(get_state, _From, State) ->
{reply, State, State};
handle_call(get_log_tip, _From, State) ->
{reply, log_tip(State), State};
handle_call({set_projections, Names}, _From, State) ->
{reply, ok, with_projections(Names, State)};
handle_call({add_actor, ActorId, KeySpec, AS}, _From, State) ->
case add_actor(ActorId, KeySpec, AS, State) of
{ok, NewState} -> {reply, ok, NewState};
{error, Reason} -> {reply, {error, Reason}, State}
end;
handle_call({publish_to, ActorId, Request}, _From, State) ->
case publish(ActorId, Request, State) of
{ok, Result, NewState} -> {reply, {ok, Result}, NewState};
{error, Reason, SameState} -> {reply, {error, Reason}, SameState}
end;
handle_call({log_tip_for, ActorId}, _From, State) ->
{reply, actor_log_tip(ActorId, State), State};
handle_call({log_state_for, ActorId}, _From, State) ->
{reply, actor_log_state(ActorId, State), State};
handle_call({inbox_tip_for, ActorId}, _From, State) ->
{reply, actor_inbox_tip(ActorId, State), State};
handle_call({inbox_state_for, ActorId}, _From, State) ->
{reply, actor_inbox_state(ActorId, State), State};
handle_call({append_inbox, ActorId, Activity}, _From, State) ->
case append_to_actor_inbox(ActorId, Activity, State) of
{ok, Tip, NewState} -> {reply, {ok, Tip}, NewState};
{error, Reason, Same} -> {reply, {error, Reason}, Same}
end;
handle_call(get_actors, _From, State) ->
{reply, actors(State), State};
handle_call({state_for, ActorId}, _From, State) ->
{reply, actor_state(ActorId, State), State};
handle_call({bucket_for, ActorId}, _From, State) ->
{reply, actor_bucket(ActorId, State), State};
handle_call({set_projections_for, ActorId, Names}, _From, State) ->
case with_actor_projections(ActorId, Names, State) of
{ok, NewState} -> {reply, ok, NewState};
{error, Reason} -> {reply, {error, Reason}, State}
end;
handle_call({bootstrap_actor, ActorId, Profile, KeySpec}, _From, State) ->
case bootstrap_actor(ActorId, Profile, KeySpec, State) of
{ok, Result, NewState} -> {reply, {ok, Result}, NewState};
{error, Reason, SameState} -> {reply, {error, Reason}, SameState}
end.
handle_cast(_, S) -> {noreply, S}.
handle_info(_, S) -> {noreply, S}.

View File

@@ -1,188 +0,0 @@
-module(outbox).
-export([construct/4, sign/2, cid_of/1, publish/2]).
%% Outbox envelope construction + signing per design §3.1.
%%
%% construct/4 builds an unsigned activity envelope from caller-supplied
%% (Type, ActorId, Published, Object). The envelope's `:id` field is
%% derived from the host `cid:to_string` BIF over a skeleton tag, so
%% recipients can address the activity by its content hash. The
%% returned property list is the canonical key-sorted form that
%% `envelope:canonical_bytes/1` operates on.
%%
%% sign/2 takes the unsigned envelope plus a KeySpec proplist that
%% mirrors a `public_keys` entry: `[{key_id, _}, {algorithm, _},
%% {value, KeyMaterial}]`. It computes the v1 HMAC stand-in
%% `crypto:hash(sha256, <<KeyMaterial/binary, CanonicalBytes/binary>>)`
%% — the same scheme `envelope:verify_signature/2` checks — and
%% appends a `:signature` pair.
%%
%% Real Ed25519 / RSA signing arrives in milestone 2 once
%% `crypto:sign_ed25519/2` BIFs land; the API shape doesn't change.
%% construct/4 — Type and ActorId are atoms; Published is an
%% integer timestamp the caller supplies (no clock BIF in this
%% port; the HTTP layer / outbox:publish caller injects it).
%% Object can be any term, including a property list of inner
%% fields.
construct(Type, ActorId, Published, Object) ->
Skeleton = [{actor, ActorId},
{object, Object},
{published, Published},
{type, Type}],
Id = cid:to_string({activity_envelope, Skeleton}),
[{actor, ActorId},
{id, Id},
{object, Object},
{published, Published},
{type, Type}].
%% sign/2 — KeySpec carries key_id, algorithm, value (key material).
sign(Envelope, KeySpec) ->
{ok, KeyId} = envelope:get_field(key_id, KeySpec),
{ok, Alg} = envelope:get_field(algorithm, KeySpec),
{ok, KM} = envelope:get_field(value, KeySpec),
CB = envelope:canonical_bytes(Envelope),
SigValue = crypto:hash(sha256, <<KM/binary, CB/binary>>),
Sig = [{algorithm, Alg}, {key_id, KeyId}, {value, SigValue}],
Envelope ++ [{signature, Sig}].
%% cid_of/1 — extract the :id field from a constructed envelope.
%% Convenience for callers that don't want to thread the CID
%% separately when both the envelope and its ID matter.
cid_of(Envelope) ->
{ok, Id} = envelope:get_field(id, Envelope),
Id.
%% publish/2 — the outbound activity pipeline orchestrator.
%%
%% Request shape: [{type, T}, {object, O}]
%% Context shape: [{actor_id, A}, {published, P}, {key_spec, KS},
%% {actor_state, AS}, {log, L}]
%%
%% Returns:
%% {ok, [{cid, Cid}, {activity, Signed}], NewLog} — happy path
%% {error, Reason, LogState} — validation halted
%%
%% Stages run in order: envelope shape, signature, replay. The
%% replay check uses the log state pre-append, so if the caller
%% publishes the same Request twice with the same Published
%% timestamp the second call halts with {error, replay, _}.
%%
%% Projection-scheduler dispatch (the async fold the design calls
%% for) is deferred to Step 7 — once the projection gen_server
%% exists, this function will broadcast `Signed` to it.
publish(Request, Context) ->
Type = envelope_field(type, Request),
Object = envelope_field(object, Request),
ActorId = envelope_field(actor_id, Context),
Published = envelope_field(published, Context),
KeySpec = envelope_field(key_spec, Context),
ActorState = envelope_field(actor_state, Context),
LogState = envelope_field(log, Context),
Unsigned = construct(Type, ActorId, Published, Object),
Signed = sign(Unsigned, KeySpec),
Stages = [
fun (A) -> pipeline:stage_envelope(A) end,
pipeline:stage_signature(ActorState),
pipeline:stage_replay(LogState)
],
case pipeline:run_stages(Signed, Stages) of
ok ->
{ok, NewLog, _Seq} = log:append(LogState, Signed),
broadcast(Signed, envelope_field(projections, Context)),
DeliverySet = compute_delivery_set(Request, Signed, Context),
dispatch_deliveries(Signed, DeliverySet, Context),
Result = [{cid, cid_of(Signed)},
{activity, Signed},
{delivery_set, DeliverySet}],
{ok, Result, NewLog};
{error, Reason} ->
{error, Reason, LogState}
end.
%% dispatch_deliveries/3 — Step 8d. For each ActorId in the
%% delivery_set, enqueue the signed activity onto the matching
%% delivery_worker if the worker is registered under that atom.
%% Missing workers are silently skipped — lazy creation belongs
%% to the kernel manager (later in Step 8). The Context
%% `:dispatch_deliveries` field gates the call so existing
%% outbox callers that don't yet care about delivery (e.g. all of
%% M1's tests) stay back-compat.
%%
%% No-op when:
%% - :dispatch_deliveries is absent or not the atom true
%% - delivery_set is []
%% - the per-peer worker isn't registered (whereis returns undefined)
dispatch_deliveries(Activity, DeliverySet, Context) ->
case envelope_field(dispatch_deliveries, Context) of
true -> enqueue_each(Activity, DeliverySet);
_ -> ok
end.
enqueue_each(_Activity, []) -> ok;
enqueue_each(Activity, [PeerId | Rest]) when is_atom(PeerId) ->
case erlang:whereis(PeerId) of
undefined -> enqueue_each(Activity, Rest);
_ ->
delivery_worker:enqueue(PeerId, Activity),
enqueue_each(Activity, Rest)
end;
enqueue_each(Activity, [_ | Rest]) ->
enqueue_each(Activity, Rest).
%% compute_delivery_set/3 — Step 7c. Pulls the audience-resolved
%% recipient list off the Request's `:to` / `:cc` fields (the
%% envelope itself doesn't carry them — construct/4 only takes
%% type / actor / published / object). Context's optional
%% `:follower_graph` field carries a follower_graph state for
%% `public` / `followers` audience expansion; absent -> empty graph,
%% so explicit `:to` / `:cc` lists still resolve. Synthesises a
%% recipient-shaped envelope from Request + Signed so the existing
%% delivery:delivery_set/3 (which reads `:actor`, `:to`, `:cc`) can
%% process it as-is.
%%
%% Step 8's delivery-queue worker reads `{delivery_set, [ActorId, ...]}`
%% off the publish result and routes one HTTP POST per entry.
compute_delivery_set(Request, Signed, Context) ->
Graph = case envelope_field(follower_graph, Context) of
nil -> follower_graph:new();
G -> G
end,
Recipients = recipients_envelope(Request, Signed),
delivery:delivery_set(Recipients, [], Graph).
recipients_envelope(Request, Signed) ->
Base = case envelope:get_field(actor, Signed) of
{ok, A} -> [{actor, A}];
_ -> []
end,
To = case envelope:get_field(to, Request) of
{ok, T} -> [{to, T}];
_ -> []
end,
Cc = case envelope:get_field(cc, Request) of
{ok, C} -> [{cc, C}];
_ -> []
end,
Base ++ To ++ Cc.
%% broadcast/2 — fire-and-forget cast to each named projection.
%% Missing/nil/empty list is a no-op; the publish API does not
%% require projections to exist. Activity is the post-sign Signed
%% envelope (same value that landed in the log).
broadcast(_Activity, nil) -> ok;
broadcast(_Activity, []) -> ok;
broadcast(Activity, [Name | Rest]) ->
projection:async_fold(Name, Activity),
broadcast(Activity, Rest).
envelope_field(K, PL) ->
case envelope:get_field(K, PL) of
{ok, V} -> V;
not_found -> nil
end.

View File

@@ -1,140 +0,0 @@
-module(peer_actors).
-export([new/0, lookup/2, store/3, evict/2, peers/1,
lookup_or_fetch/3,
start_link/0, start_link/1, stop/0,
lookup_srv/1, store_srv/2, lookup_or_fetch_srv/2,
peers_srv/0, evict_srv/1]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
-behaviour(gen_server).
%% Peer-actors cache. On first inbound from a new peer, the
%% federation layer needs the peer's `:public_keys` (and eventually
%% other actor-doc fields) to verify the inbound signature. Fetching
%% the peer's actor doc on every inbound would be wasteful, so we
%% cache the peer-AS keyed by ActorId atom. Per design §13.6 stale-
%% key invalidation defers to v3 — for v2 entries are TTL-free.
%%
%% State shape (pure-functional):
%% [{PeerActorId, PeerActorState}, ...]
%%
%% PeerActorState is the same shape that envelope:verify_signature/2
%% reads — a proplist with :public_keys (a list of key proplists).
%%
%% lookup_or_fetch/3 is the load-bearing entry point: a miss invokes
%% the caller-supplied FetchFn (1-arity, takes PeerActorId, returns
%% {ok, PeerAS} | {error, Reason}). The cache stores successful
%% fetches; errors do NOT poison the cache so the caller can retry.
%%
%% gen_server wrapper exposes the same API for the http inbox
%% handler. Tests inline start_link with operations (same port quirks
%% as registry / projection / nx_kernel).
%% ── Pure-functional API ─────────────────────────────────────────
new() -> [].
lookup(PeerId, State) ->
case find_keyed(PeerId, State) of
{ok, PeerAS} -> {ok, PeerAS};
{error, _} -> not_found
end.
store(PeerId, PeerAS, State) ->
set_keyed(PeerId, PeerAS, State).
evict(PeerId, State) ->
delete_keyed(PeerId, State).
peers(State) -> [Id || {Id, _AS} <- State].
%% lookup_or_fetch/3 — cache hit returns {ok, PeerAS, State}
%% unchanged. Cache miss calls FetchFn; success path stores and
%% returns {ok, PeerAS, NewState}; failure returns {error, Reason,
%% State} so the caller knows the cache state and can retry on
%% transient errors.
lookup_or_fetch(PeerId, FetchFn, State) ->
case find_keyed(PeerId, State) of
{ok, PeerAS} -> {ok, PeerAS, State};
{error, _} ->
case FetchFn(PeerId) of
{ok, PeerAS} -> {ok, PeerAS, store(PeerId, PeerAS, State)};
{error, Reason} -> {error, Reason, State};
Other -> {error, {bad_fetch_return, Other}, State}
end
end.
%% ── gen_server wrapper ──────────────────────────────────────────
%%
%% Mirrors registry / projection / nx_kernel patterns. Registered
%% name `peer_actors` so callers (http_server inbox handler) can
%% find it without threading the Pid through Cfg.
start_link() ->
start_link([]).
start_link(InitialState) ->
Pid = gen_server:start_link(peer_actors, [InitialState]),
erlang:register(peer_actors, Pid),
Pid.
stop() ->
R = gen_server:call(peer_actors, '$gen_stop'),
erlang:unregister(peer_actors),
R.
lookup_srv(PeerId) ->
gen_server:call(peer_actors, {lookup, PeerId}).
store_srv(PeerId, PeerAS) ->
gen_server:call(peer_actors, {store, PeerId, PeerAS}).
%% lookup_or_fetch_srv/2 — same shape as the pure form. FetchFn must
%% be a 1-arity fun. Reply is {ok, PeerAS} on hit-or-fetched,
%% {error, Reason} on fetch failure.
lookup_or_fetch_srv(PeerId, FetchFn) ->
gen_server:call(peer_actors, {lookup_or_fetch, PeerId, FetchFn}).
peers_srv() ->
gen_server:call(peer_actors, get_peers).
evict_srv(PeerId) ->
gen_server:call(peer_actors, {evict, PeerId}).
%% gen_server callbacks
init([InitialState]) ->
{ok, InitialState}.
handle_call({lookup, PeerId}, _From, State) ->
{reply, lookup(PeerId, State), State};
handle_call({store, PeerId, PeerAS}, _From, State) ->
{reply, ok, store(PeerId, PeerAS, State)};
handle_call({lookup_or_fetch, PeerId, FetchFn}, _From, State) ->
case lookup_or_fetch(PeerId, FetchFn, State) of
{ok, PeerAS, NewState} -> {reply, {ok, PeerAS}, NewState};
{error, Reason, SameState} -> {reply, {error, Reason}, SameState}
end;
handle_call(get_peers, _From, State) ->
{reply, peers(State), State};
handle_call({evict, PeerId}, _From, State) ->
{reply, ok, evict(PeerId, State)}.
handle_cast(_, S) -> {noreply, S}.
handle_info(_, S) -> {noreply, S}.
%% ── Internal helpers ────────────────────────────────────────────
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].
delete_keyed(_, []) -> [];
delete_keyed(K, [{K, _} | Rest]) -> Rest;
delete_keyed(K, [P | Rest]) -> [P | delete_keyed(K, Rest)].

View File

@@ -1,167 +0,0 @@
-module(pipeline).
-export([run_stages/2,
validate_inbound/1, validate_inbound/3,
validate_outbound/1,
inbound_stages/0, inbound_stages/2, outbound_stages/0,
stage_envelope/1,
stage_signature/1, stage_signature/2,
stage_replay/1, stage_replay/2,
stage_schema/1, stage_schema/2]).
%% Validation pipeline per design §14.
%%
%% A stage is a 1-arity fun `(Activity) -> ok | {error, Reason}`.
%% The driver folds the activity through the stage list, halting
%% on the first error. The pure-functional driver itself takes a
%% stage list directly so tests can inject ad-hoc stage sequences
%% without depending on the bundled inbound/outbound lists.
%%
%% Inbound pipeline (full set per design §14): envelope, signature,
%% replay, audience, activity_schema, object_schema, content_validators,
%% capabilities, trust. Outbound is a subset (no replay, no trust;
%% auth handled at the HTTP layer).
%%
%% This sub-deliverable (6a) wires only the driver and the empty
%% stage lists. Concrete stages land in 6b-6c.
run_stages(_Activity, []) -> ok;
run_stages(Activity, [Stage | Rest]) ->
Result = Stage(Activity),
case Result of
ok -> run_stages(Activity, Rest);
{error, _} -> Result
end.
validate_inbound(Activity) ->
run_stages(Activity, inbound_stages()).
%% validate_inbound/3 — Step 5b federation inbound pipeline.
%%
%% Activity: the signed envelope as received from the peer.
%% PeerActorState: the peer's actor-state proplist carrying
%% :public_keys for signature verification. Caller
%% resolves this — for v2 it's either pre-populated
%% from a peer-actors cache (Step 5c) or known from
%% a two-instance test fixture.
%% InboxLog: the receiving actor's :actor_inbox log state.
%% Used by stage_replay to reject duplicate :id.
%%
%% Stages (per design §13.2 + §14):
%% stage_envelope — shape check
%% stage_signature(PeerAS) — peer sig verify
%% stage_replay(InboxLog) — replay defence against
%% receiving actor's inbox
%%
%% Returns ok | {error, Reason}. The driver halts on first failure.
%% Audience / schema / capabilities / trust stages defer to v3.
validate_inbound(Activity, PeerActorState, InboxLog) ->
run_stages(Activity, inbound_stages(PeerActorState, InboxLog)).
validate_outbound(Activity) ->
run_stages(Activity, outbound_stages()).
inbound_stages() ->
[fun (A) -> stage_envelope(A) end].
%% inbound_stages/2 — the full ordered stage list for federation
%% inbound (envelope -> peer sig -> replay against inbox).
inbound_stages(PeerActorState, InboxLog) ->
[fun (A) -> stage_envelope(A) end,
stage_signature(PeerActorState),
stage_replay(InboxLog)].
outbound_stages() ->
[fun (A) -> stage_envelope(A) end].
%% ── Concrete stages ─────────────────────────────────────────────
%% stage_envelope/1 — wrap envelope:validate_shape/1. The pipeline
%% driver expects ok | {error, R}; validate_shape returns exactly
%% that, so delegation is direct.
stage_envelope(Activity) ->
envelope:validate_shape(Activity).
%% stage_signature/2 — direct (Activity, ActorState) check. Wraps
%% envelope:verify_signature/2 from Step 2c. Useful for tests and
%% for callers that already have ActorState in scope.
stage_signature(Activity, ActorState) ->
envelope:verify_signature(Activity, ActorState).
%% stage_signature/1 — factory: takes the ActorState and returns a
%% 1-arity stage fun the pipeline driver can fold. This is how
%% signature checking gets composed into a stage list at runtime
%% (the static `inbound_stages/0` list omits it precisely because
%% ActorState isn't available at static-list build time).
stage_signature(ActorState) ->
fun (Activity) -> envelope:verify_signature(Activity, ActorState) end.
%% stage_replay/2 — checks the in-memory log for an existing
%% activity with the same :id. Returns ok if the activity is new,
%% `{error, replay}` if the log already carries it, `{error, no_id}`
%% if the activity has no :id field. The check is linear scan of
%% log entries; the projection scheduler (Step 7) will eventually
%% maintain a CID index that turns this into O(1).
stage_replay(Activity, LogState) ->
case envelope:get_field(id, Activity) of
not_found -> {error, no_id};
{ok, Id} ->
case log_has_id(Id, log:entries(LogState)) of
true -> {error, replay};
false -> ok
end
end.
stage_replay(LogState) ->
fun (Activity) -> stage_replay(Activity, LogState) end.
log_has_id(_, []) -> false;
log_has_id(Id, [Act | Rest]) ->
case envelope:get_field(id, Act) of
{ok, Id} -> true;
_ -> log_has_id(Id, Rest)
end.
%% stage_schema/2 — validates the activity's :object against the
%% schema registered for its :type. SchemaLookup is a caller-
%% supplied fun (Type) -> {ok, SchemaFn} | not_found; SchemaFn is
%% itself a fun (Object) -> bool. Returns:
%% ok when the schema accepts the object
%% {error, no_type} when the activity has no :type
%% {error, schema_mismatch} when SchemaFn returned false
%%
%% Open-world default: an unregistered Type returns ok so the
%% pipeline doesn't block activities the kernel hasn't yet learned
%% about. Tightening to strict-world happens later in milestone 2.
%%
%% Activities with no :object skip the schema check (some verbs
%% legitimately carry no object).
%%
%% The Erlang-fun shape is the substrate-friendly stand-in for the
%% SX-source :schema bodies stored in the genesis bundle. Once an
%% SX-source eval bridge exists, the same stage shape will dispatch
%% through it instead — no API change.
stage_schema(Activity, SchemaLookup) ->
case envelope:get_field(type, Activity) of
not_found -> {error, no_type};
{ok, Type} ->
case SchemaLookup(Type) of
not_found -> ok;
{ok, SchemaFn} ->
check_object_schema(Activity, SchemaFn)
end
end.
check_object_schema(Activity, SchemaFn) ->
case envelope:get_field(object, Activity) of
not_found -> ok;
{ok, Obj} ->
case SchemaFn(Obj) of
true -> ok;
false -> {error, schema_mismatch}
end
end.
stage_schema(SchemaLookup) ->
fun (Activity) -> stage_schema(Activity, SchemaLookup) end.

View File

@@ -1,97 +0,0 @@
-module(projection).
-behaviour(gen_server).
-export([new/2, new/3, fold_activity/2, replay/2,
name/1, state/1, fold_fn/1]).
-export([start_link/3, async_fold/2, query/1, stop/1]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
%% Pure-functional projection driver per design §10.
%%
%% A projection is a property list:
%% [{name, atom}, {state, term}, {fold, fun}]
%%
%% The fold function is `fun (Activity, State) -> NewState`. v1
%% uses Erlang funs as the fold body — the genesis bundle's SX
%% `:fold` bodies are stored as binaries; an SX-source eval
%% bridge will plug them into the same projection record once
%% it lands (Step 7d). For now, callers supply Erlang funs
%% directly when constructing a projection.
%%
%% `replay/2` is the cold-start primitive: fold an activity
%% list (e.g. `log:entries/1`) through the projection from its
%% initial state.
new(Name, InitialState) ->
new(Name, InitialState, fun (_Activity, S) -> S end).
new(Name, InitialState, FoldFn) ->
[{name, Name}, {state, InitialState}, {fold, FoldFn}].
fold_activity(Proj, Activity) ->
Fn = fold_fn(Proj),
S0 = state(Proj),
S1 = Fn(Activity, S0),
set_field(state, S1, Proj).
replay(Proj, Activities) ->
fold_each(Proj, Activities).
fold_each(Proj, []) -> Proj;
fold_each(Proj, [A | Rest]) ->
fold_each(fold_activity(Proj, A), Rest).
%% Accessors
name(Proj) -> field(name, Proj).
state(Proj) -> field(state, Proj).
fold_fn(Proj) -> field(fold, Proj).
%% Internal
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> erlang:error(badkey).
set_field(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_field(K, V, [P | Rest]) -> [P | set_field(K, V, Rest)];
set_field(K, V, []) -> [{K, V}].
%% ── Step 7b: gen_server wrapper ─────────────────────────────────
%%
%% Each projection runs in its own gen_server, registered under the
%% projection's Name atom. `async_fold/2` casts an activity into the
%% process; `query/1` synchronously fetches the current state.
%%
%% Port notes (mirroring Step 5b on the registry): `gen_server:start_link`
%% returns the raw Pid; `?MODULE` macro is unsupported; spawned
%% processes don't survive across separate `erlang-eval-ast` calls
%% so tests must inline start_link with their operations.
start_link(Name, InitialState, FoldFn) ->
Pid = gen_server:start_link(projection, [Name, InitialState, FoldFn]),
erlang:register(Name, Pid),
Pid.
async_fold(Name, Activity) ->
gen_server:cast(Name, {fold, Activity}).
query(Name) ->
gen_server:call(Name, get_state).
stop(Name) ->
R = gen_server:call(Name, '$gen_stop'),
erlang:unregister(Name),
R.
%% gen_server callbacks
init([Name, InitialState, FoldFn]) ->
{ok, new(Name, InitialState, FoldFn)}.
handle_call(get_state, _From, Proj) ->
{reply, state(Proj), Proj}.
handle_cast({fold, Activity}, Proj) ->
{noreply, fold_activity(Proj, Activity)}.
handle_info(_, Proj) -> {noreply, Proj}.

View File

@@ -1,120 +0,0 @@
-module(registry).
-behaviour(gen_server).
-export([new/0, kinds/0, register/4, lookup/3, list/2]).
-export([start_link/0, register/3, lookup/2, list/1, stop/0]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
%% Pure-functional registry for the seven bootstrap kinds.
%%
%% State is a property list keyed by kind atom; each kind's value
%% is itself a property list of {Name, Entry} pairs. Entry is
%% opaque — typically a proplist with :cid, :schema, :semantics,
%% :supersedes fields, but the registry doesn't enforce that here.
%%
%% A gen_server wrapper (Step 5b) will own the global registry
%% process; the pure functions in this module remain the canonical
%% API and are usable for tests and for offline projection-replay.
%%
%% Return shapes:
%% new/0 -> State
%% kinds/0 -> [Atom, ...]
%% register/4 -> {ok, NewState} | {error, unknown_kind}
%% lookup/3 -> {ok, Entry} | not_found | {error, unknown_kind}
%% list/2 -> [{Name, Entry}, ...] | {error, unknown_kind}
new() -> [].
kinds() ->
[activity_types, object_types, projections,
validators, codecs, sig_suites, audience].
register(Kind, Name, Entry, State) ->
case is_valid_kind(Kind) of
false -> {error, unknown_kind};
true ->
Entries = kind_entries(Kind, State),
Updated = put_pair(Name, Entry, Entries),
{ok, set_kind_entries(Kind, Updated, State)}
end.
lookup(Kind, Name, State) ->
case is_valid_kind(Kind) of
false -> {error, unknown_kind};
true ->
find_pair(Name, kind_entries(Kind, State))
end.
list(Kind, State) ->
case is_valid_kind(Kind) of
false -> {error, unknown_kind};
true -> kind_entries(Kind, State)
end.
%% ── Internal ────────────────────────────────────────────────────
is_valid_kind(K) -> lists:member(K, kinds()).
kind_entries(Kind, State) ->
case find_pair(Kind, State) of
not_found -> [];
{ok, V} -> V
end.
set_kind_entries(Kind, Entries, State) ->
put_pair(Kind, Entries, State).
put_pair(K, V, []) -> [{K, V}];
put_pair(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
put_pair(K, V, [P | Rest]) -> [P | put_pair(K, V, Rest)].
find_pair(_, []) -> not_found;
find_pair(K, [{K, V} | _]) -> {ok, V};
find_pair(K, [_ | Rest]) -> find_pair(K, Rest).
%% ── Step 5b: gen_server wrapper ─────────────────────────────────
%%
%% The named process owns the registry state; concurrent readers
%% and writers serialize through gen_server:call. The pure /3 and
%% /4 functions remain available for offline projection-replay and
%% for tests that don't need a process at all.
%%
%% Port notes: gen_server:start_link returns the raw Pid (not
%% `{ok, Pid}` as in OTP). `?MODULE` macro is unsupported here, so
%% the registered name is the literal `registry` atom in every call.
start_link() ->
Pid = gen_server:start_link(registry, []),
erlang:register(registry, Pid),
Pid.
stop() ->
R = gen_server:call(registry, '$gen_stop'),
erlang:unregister(registry),
R.
register(Kind, Name, Entry) ->
gen_server:call(registry, {register, Kind, Name, Entry}).
lookup(Kind, Name) ->
gen_server:call(registry, {lookup, Kind, Name}).
list(Kind) ->
gen_server:call(registry, {list, Kind}).
%% gen_server callbacks
init(_) -> {ok, new()}.
handle_call({register, Kind, Name, Entry}, _From, State) ->
case register(Kind, Name, Entry, State) of
{ok, NewState} -> {reply, ok, NewState};
{error, R} -> {reply, {error, R}, State}
end;
handle_call({lookup, Kind, Name}, _From, State) ->
{reply, lookup(Kind, Name, State), State};
handle_call({list, Kind}, _From, State) ->
{reply, list(Kind, State), State}.
handle_cast(_, S) -> {noreply, S}.
handle_info(_, S) -> {noreply, S}.

View File

@@ -1,41 +0,0 @@
-module(sandbox).
-export([eval_pure/2, eval_pure/3]).
%% Sandboxed evaluation of an Erlang fun.
%%
%% eval_pure/2(Fun, Arg) -> {ok, Result} | {error, Reason}
%% eval_pure/3(Fun, Arg1, Arg2) -> {ok, Result} | {error, Reason}
%%
%% The 3-arity variant matches the (Activity, State) -> NewState
%% shape of projection folds. The projection scheduler can wrap
%% every fold call in `sandbox:eval_pure(Fun, Act, State)` to
%% ensure a misbehaving fold body can't crash the projection
%% gen_server.
%%
%% v1 sandboxing is just the try/catch envelope: no gas budget,
%% no IO denial, no environment stripping. Real sandboxing lands
%% with SX-source eval (the fold body would then be an SX form
%% evaluated under the spec/harness platform). The API shape is
%% stable — callers don't need to change when that arrives.
%% Port note: this Erlang implementation catches by explicit
%% class names (throw, error, exit) rather than the open
%% `Class:Reason` pattern. The wrappers below enumerate the three.
eval_pure(Fun, Arg) ->
try Fun(Arg) of
Result -> {ok, Result}
catch
throw:Reason -> {error, {throw, Reason}};
error:Reason -> {error, {error, Reason}};
exit:Reason -> {error, {exit, Reason}}
end.
eval_pure(Fun, Arg1, Arg2) ->
try Fun(Arg1, Arg2) of
Result -> {ok, Result}
catch
throw:Reason -> {error, {throw, Reason}};
error:Reason -> {error, {error, Reason}};
exit:Reason -> {error, {exit, Reason}}
end.

View File

@@ -1,105 +0,0 @@
-module(term_codec).
-export([encode/1, decode/1]).
%% Erlang-side term <-> binary codec, built on the substrate fixes from
%% commits 24e3bf53 (binary_to_list / list_to_binary), 3d80bd8c ($X char
%% literals), 4852cca9 (atom_to_list / integer_to_list charlists).
%%
%% Wire format (netstring-ish; all length headers ASCII decimal):
%%
%% atom $a Len $: NameBytes
%% integer $i Len $: DecimalBytes (negative ints carry leading $-)
%% binary $b Len $: RawBytes
%% tuple $t Count $: Enc1 Enc2 ... Encn
%% list $l Count $: Enc1 Enc2 ... Encn (proper list)
%% nil $l $0 $: (empty list)
%%
%% Each Enc is itself one of these forms — recursive. The format is
%% byte-clean: binary bodies may contain any byte (newlines, NULs, etc.),
%% so callers can frame entries with a 4-byte big-endian length prefix
%% (Step 3b on-disk segment writer's job).
%% encode/1: term -> binary
encode(T) when is_atom(T) ->
Cs = atom_to_list(T),
list_to_binary([$a, integer_to_list(length(Cs)), $:, Cs]);
encode(T) when is_integer(T) ->
Cs = integer_to_list(T),
list_to_binary([$i, integer_to_list(length(Cs)), $:, Cs]);
encode(T) when is_binary(T) ->
list_to_binary([$b, integer_to_list(byte_size(T)), $:, T]);
encode(T) when is_tuple(T) ->
L = tuple_to_list(T),
list_to_binary([$t, integer_to_list(length(L)), $:,
[encode(E) || E <- L]]);
encode([]) ->
list_to_binary([$l, $0, $:]);
encode(T) when is_list(T) ->
list_to_binary([$l, integer_to_list(length(T)), $:,
[encode(E) || E <- T]]).
%% decode/1: binary -> {ok, Term, RestBinary} | {error, badform}
%% On success returns the remaining unconsumed bytes so callers can
%% stream-decode multiple frames from one buffer.
decode(B) when is_binary(B) ->
decode_chars(binary_to_list(B)).
decode_chars([$a | Rest]) ->
{Len, Rest1} = read_len(Rest, 0),
Rest2 = strip_colon(Rest1),
{NameChars, Rest3} = split_at(Len, Rest2),
{ok, list_to_atom(NameChars), list_to_binary(Rest3)};
decode_chars([$i | Rest]) ->
{Len, Rest1} = read_len(Rest, 0),
Rest2 = strip_colon(Rest1),
{NumChars, Rest3} = split_at(Len, Rest2),
{ok, list_to_integer(NumChars), list_to_binary(Rest3)};
decode_chars([$b | Rest]) ->
{Len, Rest1} = read_len(Rest, 0),
Rest2 = strip_colon(Rest1),
{Bytes, Rest3} = split_at(Len, Rest2),
{ok, list_to_binary(Bytes), list_to_binary(Rest3)};
decode_chars([$t | Rest]) ->
{N, Rest1} = read_len(Rest, 0),
Rest2 = strip_colon(Rest1),
{Elems, Rest3} = decode_n(N, Rest2, []),
{ok, list_to_tuple(Elems), list_to_binary(Rest3)};
decode_chars([$l | Rest]) ->
{N, Rest1} = read_len(Rest, 0),
Rest2 = strip_colon(Rest1),
{Elems, Rest3} = decode_n(N, Rest2, []),
{ok, Elems, list_to_binary(Rest3)};
decode_chars(_) ->
{error, badform}.
read_len([C | Rest], Acc) when C >= $0, C =< $9 ->
read_len(Rest, Acc * 10 + C - $0);
read_len([$- | Rest], 0) ->
%% Leading minus for negative integer-body lengths is invalid for
%% lengths, but appears inside integer-body bytes (handled in
%% the body, not here — read_len only consumes digits before $:).
{0, [$- | Rest]};
read_len(Rest, Acc) ->
{Acc, Rest}.
strip_colon([$: | Rest]) -> Rest;
strip_colon(Other) -> erlang:error({badform, Other}).
split_at(0, Rest) -> {[], Rest};
split_at(N, [H | T]) ->
{Hs, Tl} = split_at(N - 1, T),
{[H | Hs], Tl};
split_at(_, []) ->
erlang:error({badform, short}).
decode_n(0, Rest, Acc) ->
{lists:reverse(Acc), Rest};
decode_n(N, Bytes, Acc) ->
{Term, Rest} = decode_one(Bytes),
decode_n(N - 1, Rest, [Term | Acc]).
decode_one(Bytes) ->
case decode_chars(Bytes) of
{ok, Term, RestBin} -> {Term, binary_to_list(RestBin)};
{error, R} -> erlang:error({badform, R})
end.

View File

View File

@@ -1,164 +0,0 @@
#!/usr/bin/env bash
# next/tests/actor_lifecycle.sh — m2 Step 2c end-to-end test.
#
# Ties Step 2a artefacts (genesis Person/Service/Group SX files),
# Step 2b projection (actor_state.erl), and Step 2c bootstrap
# (nx_kernel:bootstrap_actor/4) together. Profiles bootstrap as
# Create{Person|Service|Group} activities; the actor_state projection
# folds them into the per-actor profile registry.
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
# Two actors share signing-key bytes (each in its own AS). The
# profile's :public_keys list is what gets wrapped in the Create
# object; the kernel-side AS proplist (built by bootstrap_actor/4
# from :public_keys) is what envelope:verify_signature reads.
ALICE_KM='AliceK = <<1,2,3,4>>, AliceKey = [{id, k1}, {created, 0}, {value, AliceK}], AlicePks = [AliceKey], AliceKS = [{key_id, k1}, {algorithm, ed25519}, {value, AliceK}],'
BOB_KM='BobK = <<5,6,7,8>>, BobKey = [{id, k1}, {created, 0}, {value, BobK}], BobPks = [BobKey], BobKS = [{key_id, k1}, {algorithm, ed25519}, {value, BobK}],'
ALICE_PROFILE='AliceProfile = [{type, person}, {name, alice_n}, {preferredUsername, alice_local}, {public_keys, AlicePks}],'
BOB_PROFILE='BobProfile = [{type, service}, {name, bobbot_n}, {preferredUsername, bobbot_local}, {public_keys, BobPks}],'
# actor_state projection wiring — fold_fn from actor_state:fold_fn/0,
# initial state = actor_state:new().
PROJ_SETUP='projection:start_link(actors, actor_state:new(), actor_state:fold_fn()),'
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/log.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
(epoch 7)
(eval "(get (erlang-load-module (file-read \"next/kernel/projection.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/actor_state.erl\")) :name)")
(epoch 9)
(eval "(get (erlang-load-module (file-read \"next/kernel/nx_kernel.erl\")) :name)")
;; Pure: bootstrap_actor/4 on a fresh kernel publishes Create and
;; returns {ok, Result, S}.
(epoch 10)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} case nx_kernel:bootstrap_actor(alice, AliceProfile, AliceKS, nx_kernel:new()) of {ok, _, _} -> ok; _ -> bad end\") :name)")
;; Pure: after bootstrap, log_tip = 1, has_actor true
(epoch 11)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} {ok, _, S} = nx_kernel:bootstrap_actor(alice, AliceProfile, AliceKS, nx_kernel:new()), nx_kernel:has_actor(alice, S) andalso nx_kernel:actor_log_tip(alice, S) =:= 1\") :name)")
;; Pure: log entry is a Create with object's type = person
(epoch 12)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} {ok, _, S} = nx_kernel:bootstrap_actor(alice, AliceProfile, AliceKS, nx_kernel:new()), {ok, L} = nx_kernel:actor_log_state(alice, S), [E] = log:entries(L), {ok, create} = envelope:get_field(type, E), {ok, Obj} = envelope:get_field(object, E), envelope:get_field(type, Obj) =:= {ok, person}\") :name)")
;; Pure: bootstrap into existing kernel with another actor
(epoch 13)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} {ok, _, S1} = nx_kernel:bootstrap_actor(alice, AliceProfile, AliceKS, nx_kernel:new()), {ok, _, S2} = nx_kernel:bootstrap_actor(bobbot, BobProfile, BobKS, S1), nx_kernel:actors(S2) =:= [alice, bobbot]\") :name)")
;; Pure: two actors have independent log_tips
(epoch 14)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} {ok, _, S1} = nx_kernel:bootstrap_actor(alice, AliceProfile, AliceKS, nx_kernel:new()), {ok, _, S2} = nx_kernel:bootstrap_actor(bobbot, BobProfile, BobKS, S1), {nx_kernel:actor_log_tip(alice, S2), nx_kernel:actor_log_tip(bobbot, S2)} =:= {1, 1}\") :name)")
;; Pure: duplicate bootstrap_actor returns already_present
(epoch 15)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} {ok, _, S1} = nx_kernel:bootstrap_actor(alice, AliceProfile, AliceKS, nx_kernel:new()), case nx_kernel:bootstrap_actor(alice, AliceProfile, AliceKS, S1) of {error, already_present, _} -> ok; _ -> bad end\") :name)")
;; gen_server: bootstrap_actor/3 publishes + actor_state projection captures profile
(epoch 16)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} nx_kernel:start_link(seed, AliceKS, [{public_keys, AlicePks}]), ${PROJ_SETUP} nx_kernel:with_projections_for(seed, [actors]), {ok, _} = nx_kernel:bootstrap_actor(alice, AliceProfile, AliceKS), nx_kernel:has_actor(seed, nx_kernel:query()) andalso nx_kernel:has_actor(alice, nx_kernel:query())\") :name)")
;; gen_server: actor_state projection captures the bootstrapped Person profile
(epoch 17)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} nx_kernel:start_link(seed, AliceKS, [{public_keys, AlicePks}]), ${PROJ_SETUP} nx_kernel:with_projections_for(alice_pre, [actors]), nx_kernel:add_actor(alice_pre, AliceKS, [{public_keys, AlicePks}]), nx_kernel:with_projections_for(alice_pre, [actors]), {ok, _} = nx_kernel:publish_to(alice_pre, [{type, create}, {object, [{type, person}, {name, alice_n}, {preferredUsername, alice_local}, {public_keys, AlicePks}]}]), {ok, Profile} = actor_state:lookup(alice_pre, projection:query(actors)), actor_state:profile_type(Profile) =:= person andalso actor_state:profile_name(Profile) =:= alice_n\") :name)")
;; gen_server: Service profile lands as service in actor_state
(epoch 18)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} nx_kernel:start_link(seed, BobKS, [{public_keys, BobPks}]), ${PROJ_SETUP} nx_kernel:add_actor(bobbot, BobKS, [{public_keys, BobPks}]), nx_kernel:with_projections_for(bobbot, [actors]), {ok, _} = nx_kernel:publish_to(bobbot, [{type, create}, {object, [{type, service}, {name, bobbot_n}, {public_keys, BobPks}]}]), {ok, Profile} = actor_state:lookup(bobbot, projection:query(actors)), actor_state:profile_type(Profile) =:= service\") :name)")
;; gen_server: Group profile lands as group in actor_state
(epoch 19)
(eval "(get (erlang-eval-ast \"${ALICE_KM} nx_kernel:start_link(seed, AliceKS, [{public_keys, AlicePks}]), ${PROJ_SETUP} nx_kernel:add_actor(wg1, AliceKS, [{public_keys, AlicePks}]), nx_kernel:with_projections_for(wg1, [actors]), {ok, _} = nx_kernel:publish_to(wg1, [{type, create}, {object, [{type, group}, {name, working_group_n}, {public_keys, AlicePks}]}]), {ok, Profile} = actor_state:lookup(wg1, projection:query(actors)), actor_state:profile_type(Profile) =:= group\") :name)")
;; Sanity: profile captures :preferredUsername + :public_keys from the Create object
(epoch 20)
(eval "(get (erlang-eval-ast \"${ALICE_KM} ${BOB_KM} ${ALICE_PROFILE} ${BOB_PROFILE} nx_kernel:start_link(seed, AliceKS, [{public_keys, AlicePks}]), ${PROJ_SETUP} nx_kernel:add_actor(alice, AliceKS, [{public_keys, AlicePks}]), nx_kernel:with_projections_for(alice, [actors]), {ok, _} = nx_kernel:publish_to(alice, [{type, create}, {object, [{type, person}, {name, alice_n}, {preferredUsername, alice_local}, {public_keys, AlicePks}]}]), {ok, Profile} = actor_state:lookup(alice, projection:query(actors)), actor_state:profile_field(preferredUsername, Profile) =:= {ok, alice_local} andalso actor_state:profile_field(public_keys, Profile) =:= {ok, AlicePks}\") :name)")
;; Pure: profile defaults to person when :type missing
(epoch 21)
(eval "(get (erlang-eval-ast \"${ALICE_KM} TypelessProfile = [{name, alice_n}, {public_keys, AlicePks}], {ok, _, S} = nx_kernel:bootstrap_actor(alice, TypelessProfile, AliceKS, nx_kernel:new()), {ok, L} = nx_kernel:actor_log_state(alice, S), [E] = log:entries(L), {ok, Obj} = envelope:get_field(object, E), envelope:get_field(type, Obj) =:= {ok, person}\") :name)")
;; Pure: empty profile :public_keys defaults to []
(epoch 22)
(eval "(get (erlang-eval-ast \"${ALICE_KM} EmptyProfile = [{type, person}, {name, alice_n}], case nx_kernel:bootstrap_actor(alice, EmptyProfile, AliceKS, nx_kernel:new()) of {ok, _, _} -> ok; {error, _, _} -> ok end\") :name)")
EPOCHS
OUTPUT=$(timeout 240 "$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 "gen_server loaded" "gen_server"
check 9 "nx_kernel loaded" "nx_kernel"
check 10 "bootstrap_actor/4 -> {ok, _, _}" "ok"
check 11 "bootstrap_actor advances log_tip" "true"
check 12 "log entry is Create{Person}" "true"
check 13 "two actors live in one kernel" "true"
check 14 "independent log_tips after boot" "true"
check 15 "duplicate boot -> already_present" "ok"
check 16 "gen_server bootstrap_actor/3" "true"
check 17 "actor_state captures Person" "true"
check 18 "actor_state captures Service" "true"
check 19 "actor_state captures Group" "true"
check 20 "profile carries preferredUsername" "true"
check 21 "typeless profile defaults Person" "true"
check 22 "empty public_keys handled" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/actor_lifecycle.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,163 +0,0 @@
#!/usr/bin/env bash
# next/tests/actor_state_pure.sh — m2 Step 2b test.
#
# Exercises the Erlang-fun stand-in for the actor-state projection
# fold. Activities flow:
# Create{Person|Service|Group} -> profile registered
# Update{Person|Service|Group, patch} -> patch deep-merged
# Move -> :moved_to recorded
# Non-actor object Creates pass through.
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
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/actor_state.erl\")) :name)")
;; new/0 returns []
(epoch 10)
(eval "(get (erlang-eval-ast \"actor_state:new() =:= []\") :name)")
;; has/2 false on empty
(epoch 11)
(eval "(get (erlang-eval-ast \"actor_state:has(alice, actor_state:new()) =:= false\") :name)")
;; lookup/2 not_found on empty
(epoch 12)
(eval "(get (erlang-eval-ast \"actor_state:lookup(alice, actor_state:new()) =:= not_found\") :name)")
;; actors/1 returns [] on empty
(epoch 13)
(eval "(get (erlang-eval-ast \"actor_state:actors(actor_state:new()) =:= []\") :name)")
;; Create{Person} registers profile
(epoch 14)
(eval "(get (erlang-eval-ast \"Obj = [{type, person}, {name, alice_name}, {preferredUsername, alice_local}], Act = [{actor, alice}, {type, create}, {object, Obj}, {published, 1}], S = actor_state:fold(Act, actor_state:new()), actor_state:has(alice, S)\") :name)")
;; Profile carries :type, :name, :preferredUsername, :created
(epoch 15)
(eval "(get (erlang-eval-ast \"Obj = [{type, person}, {name, alice_name}, {preferredUsername, alice_local}], Act = [{actor, alice}, {type, create}, {object, Obj}, {published, 7}], S = actor_state:fold(Act, actor_state:new()), {ok, P} = actor_state:lookup(alice, S), {actor_state:profile_type(P), actor_state:profile_name(P), actor_state:profile_field(preferredUsername, P), actor_state:profile_field(created, P)} =:= {person, alice_name, {ok, alice_local}, {ok, 7}}\") :name)")
;; Create{Service} also registers
(epoch 16)
(eval "(get (erlang-eval-ast \"Obj = [{type, service}, {name, feedbot}], Act = [{actor, feed1}, {type, create}, {object, Obj}, {published, 1}], S = actor_state:fold(Act, actor_state:new()), {ok, P} = actor_state:lookup(feed1, S), actor_state:profile_type(P) =:= service\") :name)")
;; Create{Group} also registers
(epoch 17)
(eval "(get (erlang-eval-ast \"Obj = [{type, group}, {name, working_group}], Act = [{actor, wg1}, {type, create}, {object, Obj}, {published, 1}], S = actor_state:fold(Act, actor_state:new()), {ok, P} = actor_state:lookup(wg1, S), actor_state:profile_type(P) =:= group\") :name)")
;; Create{Note} is pass-through (non-actor object)
(epoch 18)
(eval "(get (erlang-eval-ast \"Obj = [{type, note}, {content, hi}], Act = [{actor, alice}, {type, create}, {object, Obj}, {published, 1}], actor_state:fold(Act, actor_state:new()) =:= []\") :name)")
;; Duplicate Create doesn't overwrite an existing profile
(epoch 19)
(eval "(get (erlang-eval-ast \"O1 = [{type, person}, {name, alice_v1}], O2 = [{type, person}, {name, alice_v2}], A1 = [{actor, alice}, {type, create}, {object, O1}, {published, 1}], A2 = [{actor, alice}, {type, create}, {object, O2}, {published, 2}], S1 = actor_state:fold(A1, actor_state:new()), S2 = actor_state:fold(A2, S1), {ok, P} = actor_state:lookup(alice, S2), actor_state:profile_name(P) =:= alice_v1\") :name)")
;; Two distinct actors live side by side
(epoch 20)
(eval "(get (erlang-eval-ast \"PO = [{type, person}, {name, alice_n}], SO = [{type, service}, {name, bobbot_n}], A1 = [{actor, alice}, {type, create}, {object, PO}, {published, 1}], A2 = [{actor, bobbot}, {type, create}, {object, SO}, {published, 2}], S = actor_state:fold(A2, actor_state:fold(A1, actor_state:new())), actor_state:actors(S) =:= [alice, bobbot]\") :name)")
;; Update merges patch
(epoch 21)
(eval "(get (erlang-eval-ast \"PO = [{type, person}, {name, alice_n}], A1 = [{actor, alice}, {type, create}, {object, PO}, {published, 1}], A2 = [{actor, alice}, {type, update}, {patch, [{summary, new_bio}]}, {published, 2}], S = actor_state:fold(A2, actor_state:fold(A1, actor_state:new())), {ok, P} = actor_state:lookup(alice, S), actor_state:profile_field(summary, P) =:= {ok, new_bio}\") :name)")
;; Update overwrites individual fields (last-write-wins per key)
(epoch 22)
(eval "(get (erlang-eval-ast \"PO = [{type, person}, {name, alice_v1}], A1 = [{actor, alice}, {type, create}, {object, PO}, {published, 1}], A2 = [{actor, alice}, {type, update}, {patch, [{name, alice_v2}]}, {published, 2}], S = actor_state:fold(A2, actor_state:fold(A1, actor_state:new())), {ok, P} = actor_state:lookup(alice, S), actor_state:profile_name(P) =:= alice_v2\") :name)")
;; Update for unknown actor is pass-through
(epoch 23)
(eval "(get (erlang-eval-ast \"A = [{actor, ghost}, {type, update}, {patch, [{summary, x}]}, {published, 1}], actor_state:fold(A, actor_state:new()) =:= []\") :name)")
;; Move records :moved_to
(epoch 24)
(eval "(get (erlang-eval-ast \"PO = [{type, person}, {name, alice_n}], A1 = [{actor, alice}, {type, create}, {object, PO}, {published, 1}], A2 = [{actor, alice}, {type, move}, {moved_to, new_alice}, {published, 2}], S = actor_state:fold(A2, actor_state:fold(A1, actor_state:new())), {ok, P} = actor_state:lookup(alice, S), actor_state:profile_field(moved_to, P) =:= {ok, new_alice}\") :name)")
;; fold_fn/0 is a 2-arity Erlang fun usable by projection:start_link
(epoch 25)
(eval "(get (erlang-eval-ast \"F = actor_state:fold_fn(), is_function(F, 2)\") :name)")
;; fold ignores activities with no :actor field
(epoch 26)
(eval "(get (erlang-eval-ast \"Obj = [{type, person}, {name, x}], Act = [{type, create}, {object, Obj}, {published, 1}], actor_state:fold(Act, actor_state:new()) =:= []\") :name)")
;; public_keys field is captured at Create time
(epoch 27)
(eval "(get (erlang-eval-ast \"Keys = [[{id, k1}, {value, <<1,2,3,4>>}]], Obj = [{type, person}, {name, alice_n}, {public_keys, Keys}], Act = [{actor, alice}, {type, create}, {object, Obj}, {published, 1}], S = actor_state:fold(Act, actor_state:new()), {ok, P} = actor_state:lookup(alice, S), actor_state:profile_field(public_keys, P) =:= {ok, Keys}\") :name)")
EPOCHS
OUTPUT=$(timeout 240 "$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 3 "actor_state module loaded" "actor_state"
check 10 "new/0 -> []" "true"
check 11 "has/2 false on empty" "true"
check 12 "lookup/2 not_found on empty" "true"
check 13 "actors/1 [] on empty" "true"
check 14 "Create{Person} registers actor" "true"
check 15 "Profile carries type/name/created" "true"
check 16 "Create{Service} registers actor" "true"
check 17 "Create{Group} registers actor" "true"
check 18 "Create{Note} pass-through" "true"
check 19 "Duplicate Create no-overwrite" "true"
check 20 "Two actors side by side" "true"
check 21 "Update merges new fields" "true"
check 22 "Update last-write-wins per key" "true"
check 23 "Update unknown actor pass-through" "true"
check 24 "Move records :moved_to" "true"
check 25 "fold_fn/0 is fun/2" "true"
check 26 "Activity sans :actor pass-through" "true"
check 27 "public_keys captured at Create" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/actor_state_pure.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,138 +0,0 @@
#!/usr/bin/env bash
# next/tests/auto_accept.sh — m2 Step 6c test.
#
# Per design §13.2 the v2 Follow policy is open-world: every
# successfully-ingested Follow triggers an Accept publish from the
# target actor. Enabled per-Cfg via {auto_accept_follows, true};
# off by default so manual-moderation deployments can opt out.
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
# Alice is on this kernel (target). Bob is the peer (signs Follow
# with BobKS). Alice's outbox projection is `followers` so when
# alice publishes the Accept, it folds through follower_graph too —
# both sides of the relationship update without any test scaffolding.
SETUP='AK = <<1,2,3,4>>, AKS = [{key_id,k1},{algorithm,ed25519},{value,AK}], AAS = [{public_keys,[[{id,k1},{created,0},{value,AK}]]}], BK = <<5,6,7,8>>, BKS = [{key_id,k1},{algorithm,ed25519},{value,BK}], BAS = [{public_keys,[[{id,k1},{created,0},{value,BK}]]}], FollowEnv = outbox:construct(follow, bob, 1, alice), SignedFollow = outbox:sign(FollowEnv, BKS), Body = term_codec:encode(SignedFollow), projection:start_link(followers, follower_graph:new(), follower_graph:fold_fn()), nx_kernel:start_link(alice, AKS, AAS), nx_kernel:with_projections_for(alice, [followers]), Cfg = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}, {inbox_projections, [followers]}, {auto_accept_follows, true}], InboxPath = <<47,97,99,116,111,114,115,47,97,108,105,99,101,47,105,110,98,111,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 "(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/log.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
(epoch 7)
(eval "(get (erlang-load-module (file-read \"next/kernel/projection.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/nx_kernel.erl\")) :name)")
(epoch 9)
(eval "(get (erlang-load-module (file-read \"next/kernel/term_codec.erl\")) :name)")
(epoch 10)
(eval "(get (erlang-load-module (file-read \"next/kernel/follower_graph.erl\")) :name)")
(epoch 11)
(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
(epoch 12)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery.erl\")) :name)")
;; auto_accept on: Follow ingestion advances alice's outbox tip (Accept published)
(epoch 20)
(eval "(erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, Cfg), nx_kernel:log_tip_for(alice)\")")
;; auto_accept on: alice's outbox entry is an Accept activity
(epoch 21)
(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, Cfg), {ok, L} = nx_kernel:log_state_for(alice), [E] = log:entries(L), envelope:get_field(type, E) =:= {ok, accept}\") :name)")
;; auto_accept on: follower_graph state converges to full Follow relationship
;; (alice.followers = [bob], bob.following = [alice]) after both inbox + outbox
;; projections fold through followers.
(epoch 22)
(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, Cfg), S = projection:query(followers), {follower_graph:followers(alice, S), follower_graph:following(bob, S)} =:= {[bob], [alice]}\") :name)")
;; auto_accept on: pendings cleared after the Accept fold
(epoch 23)
(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, Cfg), S = projection:query(followers), {follower_graph:pending_inbound(alice, S), follower_graph:pending_outbound(bob, S)} =:= {[], []}\") :name)")
;; auto_accept off (default): no outbox publish; outbox tip stays 0
(epoch 24)
(eval "(erlang-eval-ast \"${SETUP} CfgOff = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}, {inbox_projections, [followers]}], Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, CfgOff), nx_kernel:log_tip_for(alice)\")")
;; auto_accept off: pending_inbound still gets populated (Step 6b path)
;; but no Accept fired, so alice.followers stays empty.
(epoch 25)
(eval "(get (erlang-eval-ast \"${SETUP} CfgOff = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}, {inbox_projections, [followers]}], Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, CfgOff), S = projection:query(followers), {follower_graph:pending_inbound(alice, S), follower_graph:followers(alice, S)} =:= {[bob], []}\") :name)")
;; Non-Follow activity (Create{Note}) with auto_accept on: outbox stays empty
(epoch 26)
(eval "(erlang-eval-ast \"${SETUP} NoteEnv = outbox:construct(create, bob, 2, [{type, note}, {content, hi}]), SignedNote = outbox:sign(NoteEnv, BKS), NoteBody = term_codec:encode(SignedNote), Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, NoteBody}], http_server:route(Req, Cfg), nx_kernel:log_tip_for(alice)\")")
;; Bad-sig Follow ingestion with auto_accept on: no Accept publish (short-circuit)
(epoch 27)
(eval "(erlang-eval-ast \"${SETUP} EvilK = <<9,9,9,9>>, EvilAS = [{public_keys,[[{id,k1},{created,0},{value,EvilK}]]}], EvilCfg = [{peer_as, [{bob, EvilAS}]}, {kernel, nx_kernel}, {inbox_projections, [followers]}, {auto_accept_follows, true}], Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, EvilCfg), nx_kernel:log_tip_for(alice)\")")
EPOCHS
OUTPUT=$(timeout 900 "$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 11 "http_server loaded" "http_server"
check 20 "auto_accept on: outbox tip = 1" "1"
check 21 "outbox entry is an Accept" "true"
check 22 "graph converges to full Follow" "true"
check 23 "pendings cleared after Accept" "true"
check 24 "auto_accept off: outbox tip = 0" "0"
check 25 "auto_accept off: pending only" "true"
check 26 "non-Follow ingestion: no Accept" "0"
check 27 "bad-sig short-circuits Accept" "0"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/auto_accept.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,170 +0,0 @@
#!/usr/bin/env bash
# next/tests/backfill.sh — m2 Step 9a test.
#
# Backfill mode slicing per design §13.3. Given an outbox log +
# a mode (none / last_n / last_t / full / since_cid), backfill:slice
# returns the activity list to send to a new follower as backfill.
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
# Five activities published at :published = 1, 2, 3, 4, 5
SETUP='Act1 = [{id, <<1>>}, {type, note}, {actor, alice}, {published, 1}], Act2 = [{id, <<2>>}, {type, note}, {actor, alice}, {published, 2}], Act3 = [{id, <<3>>}, {type, note}, {actor, alice}, {published, 3}], Act4 = [{id, <<4>>}, {type, note}, {actor, alice}, {published, 4}], Act5 = [{id, <<5>>}, {type, note}, {actor, alice}, {published, 5}], {ok, L0} = log:open(alice, <<98,97,115,101>>), {ok, L1, _} = log:append(L0, Act1), {ok, L2, _} = log:append(L1, Act2), {ok, L3, _} = log:append(L2, Act3), {ok, L4, _} = log:append(L3, Act4), {ok, L5, _} = log:append(L4, Act5),'
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/log.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/kernel/backfill.erl\")) :name)")
;; none mode -> []
(epoch 10)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice(none, L5) =:= []\") :name)")
;; full mode -> all 5
(epoch 11)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice(full, L5) =:= [Act1, Act2, Act3, Act4, Act5]\") :name)")
;; last_n with N=2 -> tail 2 (Act4, Act5)
(epoch 12)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice({last_n, 2}, L5) =:= [Act4, Act5]\") :name)")
;; last_n with N > total -> all entries
(epoch 13)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice({last_n, 100}, L5) =:= [Act1, Act2, Act3, Act4, Act5]\") :name)")
;; last_n with N = 0 -> []
(epoch 14)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice({last_n, 0}, L5) =:= []\") :name)")
;; last_t with T=2, Now=5 -> activities with :published > 3 and <= 5 -> [Act4, Act5]
(epoch 15)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice({last_t, 2, fun() -> 5 end}, L5) =:= [Act4, Act5]\") :name)")
;; last_t with T=10, Now=5 -> covers everything from :published > -5 -> all 5
(epoch 16)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice({last_t, 10, fun() -> 5 end}, L5) =:= [Act1, Act2, Act3, Act4, Act5]\") :name)")
;; last_t with T=0, Now=5 -> only entries at exactly Now (>0, <=5) — really [] because window is (5..5]
(epoch 17)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice({last_t, 0, fun() -> 5 end}, L5) =:= []\") :name)")
;; since_cid with the 2nd cid -> entries AFTER it (Act3..Act5)
(epoch 18)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice({since_cid, <<2>>}, L5) =:= [Act3, Act4, Act5]\") :name)")
;; since_cid with last cid -> []
(epoch 19)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice({since_cid, <<5>>}, L5) =:= []\") :name)")
;; since_cid with unknown cid -> []
(epoch 20)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice({since_cid, <<99>>}, L5) =:= []\") :name)")
;; wrap_backfill adds {backfilled, true} to each entry
(epoch 21)
(eval "(get (erlang-eval-ast \"${SETUP} Wrapped = backfill:slice({last_n, 1}, L5, true), [Act5W] = Wrapped, envelope:get_field(backfilled, Act5W) =:= {ok, true}\") :name)")
;; Wrapped entries preserve :id
(epoch 22)
(eval "(get (erlang-eval-ast \"${SETUP} Wrapped = backfill:slice({last_n, 1}, L5, true), [Act5W] = Wrapped, envelope:get_field(id, Act5W) =:= {ok, <<5>>}\") :name)")
;; parse_mode: nil / none / atoms
(epoch 23)
(eval "(get (erlang-eval-ast \"{backfill:parse_mode(nil), backfill:parse_mode(none), backfill:parse_mode(full)} =:= {none, none, full}\") :name)")
;; parse_mode: tuple shapes pass through
(epoch 24)
(eval "(get (erlang-eval-ast \"backfill:parse_mode({last_n, 3}) =:= {last_n, 3}\") :name)")
;; parse_mode: proplist with mode + limit
(epoch 25)
(eval "(get (erlang-eval-ast \"backfill:parse_mode([{mode, last_n}, {limit, 50}]) =:= {last_n, 50}\") :name)")
;; parse_mode: proplist with mode = full
(epoch 26)
(eval "(get (erlang-eval-ast \"backfill:parse_mode([{mode, full}]) =:= full\") :name)")
;; parse_mode: unknown -> none
(epoch 27)
(eval "(get (erlang-eval-ast \"backfill:parse_mode([{mode, mystery}]) =:= none\") :name)")
;; Unknown mode -> []
(epoch 28)
(eval "(get (erlang-eval-ast \"${SETUP} backfill:slice(garbage, L5) =:= []\") :name)")
EPOCHS
OUTPUT=$(timeout 280 "$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 4 "backfill module loaded" "backfill"
check 10 "none mode -> []" "true"
check 11 "full mode -> all 5" "true"
check 12 "last_n N=2 -> tail 2" "true"
check 13 "last_n N=100 -> all 5" "true"
check 14 "last_n N=0 -> []" "true"
check 15 "last_t T=2 Now=5 -> 4,5" "true"
check 16 "last_t T=10 Now=5 -> all 5" "true"
check 17 "last_t T=0 Now=5 -> []" "true"
check 18 "since_cid mid -> tail 3" "true"
check 19 "since_cid last -> []" "true"
check 20 "since_cid unknown -> []" "true"
check 21 "wrap adds backfilled=true" "true"
check 22 "wrap preserves :id" "true"
check 23 "parse_mode atoms" "true"
check 24 "parse_mode tuple passthrough" "true"
check 25 "parse_mode proplist last_n" "true"
check 26 "parse_mode proplist full" "true"
check 27 "parse_mode unknown -> none" "true"
check 28 "unknown slice mode -> []" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/backfill.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,121 +0,0 @@
#!/usr/bin/env bash
# next/tests/backfill_drain.sh — m2 Step 9c test.
#
# Auto-Accept on Follow ingestion can now also drain the receiving
# actor's outbox into the new follower's delivery_worker queue per
# the Follow's :backfill spec. Gated by Cfg :backfill_enabled.
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
# Alice is the target (on this kernel). Bob is the peer publishing the
# Follow. Three notes pre-published to alice's outbox before bob's
# Follow lands; the Follow asks for last_n=2 backfill.
SETUP='AK = <<1,2,3,4>>, AKS = [{key_id,k1},{algorithm,ed25519},{value,AK}], AAS = [{public_keys,[[{id,k1},{created,0},{value,AK}]]}], BK = <<5,6,7,8>>, BKS = [{key_id,k1},{algorithm,ed25519},{value,BK}], BAS = [{public_keys,[[{id,k1},{created,0},{value,BK}]]}], FollowReq = [{type, follow}, {object, alice}], FollowReqBF = [{type, follow}, {object, alice}, {backfill, {last_n, 2}}], FollowEnvBF = outbox:construct(follow, bob, 1, alice), FollowSignedNoBF = outbox:sign(FollowEnvBF, BKS), FollowSignedBF = outbox:sign(FollowEnvBF ++ [{backfill, {last_n, 2}}], BKS), BodyBF = term_codec:encode(FollowSignedBF), BodyNoBF = term_codec:encode(FollowSignedNoBF), nx_kernel:start_link(alice, AKS, AAS), delivery_worker:start_link(bob), InboxPath = <<47,97,99,116,111,114,115,47,97,108,105,99,101,47,105,110,98,111,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 "(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/log.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/follower_graph.erl\")) :name)")
(epoch 7)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/backfill.erl\")) :name)")
(epoch 9)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery_worker.erl\")) :name)")
(epoch 10)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
(epoch 11)
(eval "(get (erlang-load-module (file-read \"next/kernel/nx_kernel.erl\")) :name)")
(epoch 12)
(eval "(get (erlang-load-module (file-read \"next/kernel/term_codec.erl\")) :name)")
(epoch 13)
(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
;; backfill_enabled + Follow with :backfill last_n=2 + 3 pre-published
;; notes -> bob's delivery_worker has 2 pending entries after Follow lands
(epoch 20)
(eval "(get (erlang-eval-ast \"${SETUP} N1 = [{type, note}, {object, [{content, hi1}]}], N2 = [{type, note}, {object, [{content, hi2}]}], N3 = [{type, note}, {object, [{content, hi3}]}], nx_kernel:publish_to(alice, N1), nx_kernel:publish_to(alice, N2), nx_kernel:publish_to(alice, N3), Cfg = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}, {auto_accept_follows, true}, {backfill_enabled, true}], Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, BodyBF}], http_server:route(Req, Cfg), length(delivery_worker:pending_srv(bob)) =:= 2\") :name)")
;; Each backfilled entry carries {backfilled, true}
(epoch 21)
(eval "(get (erlang-eval-ast \"${SETUP} N1 = [{type, note}, {object, [{content, hi}]}], nx_kernel:publish_to(alice, N1), Cfg = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}, {auto_accept_follows, true}, {backfill_enabled, true}], Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, BodyBF}], http_server:route(Req, Cfg), [E | _] = delivery_worker:pending_srv(bob), envelope:get_field(backfilled, E) =:= {ok, true}\") :name)")
;; No :backfill_enabled flag -> no backfill drain even with :backfill in Follow
(epoch 22)
(eval "(get (erlang-eval-ast \"${SETUP} N1 = [{type, note}, {object, [{content, hi}]}], nx_kernel:publish_to(alice, N1), Cfg = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}, {auto_accept_follows, true}], Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, BodyBF}], http_server:route(Req, Cfg), delivery_worker:pending_srv(bob) =:= []\") :name)")
;; Follow without :backfill field -> no backfill drain (even with the flag)
(epoch 23)
(eval "(get (erlang-eval-ast \"${SETUP} N1 = [{type, note}, {object, [{content, hi}]}], nx_kernel:publish_to(alice, N1), Cfg = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}, {auto_accept_follows, true}, {backfill_enabled, true}], Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, BodyNoBF}], http_server:route(Req, Cfg), delivery_worker:pending_srv(bob) =:= []\") :name)")
;; Missing delivery_worker for the peer -> silently skipped (no enqueue, no crash)
(epoch 24)
(eval "(get (erlang-eval-ast \"AK = <<1,2,3,4>>, AKS = [{key_id,k1},{algorithm,ed25519},{value,AK}], AAS = [{public_keys,[[{id,k1},{created,0},{value,AK}]]}], BK = <<5,6,7,8>>, BKS = [{key_id,k1},{algorithm,ed25519},{value,BK}], BAS = [{public_keys,[[{id,k1},{created,0},{value,BK}]]}], nx_kernel:start_link(alice, AKS, AAS), FollowEnvBF = outbox:construct(follow, bob, 1, alice), FollowSignedBF = outbox:sign(FollowEnvBF ++ [{backfill, {last_n, 2}}], BKS), BodyBF = term_codec:encode(FollowSignedBF), N1 = [{type, note}, {object, [{content, hi}]}], nx_kernel:publish_to(alice, N1), Cfg = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}, {auto_accept_follows, true}, {backfill_enabled, true}], InboxPath = <<47,97,99,116,111,114,115,47,97,108,105,99,101,47,105,110,98,111,120>>, Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, BodyBF}], case http_server:route(Req, Cfg) of [{status, 202}, _, _] -> true; _ -> false end\") :name)")
EPOCHS
OUTPUT=$(timeout 900 "$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 13 "http_server loaded" "http_server"
check 20 "Follow w/ backfill -> 2 enqueued" "true"
check 21 "backfilled marker on entries" "true"
check 22 "no flag -> no backfill" "true"
check 23 "no :backfill field -> no drain" "true"
check 24 "missing worker -> 202 (skip)" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/backfill_drain.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,127 +0,0 @@
#!/usr/bin/env bash
# next/tests/bootstrap_build.sh — Step 4d acceptance test.
#
# Exercises bootstrap:build_genesis/1, verify_genesis/2,
# cidhash_path/1, write_cidhash/2, read_cidhash/1. The bundle CID
# is computed by delegating to the host cid:to_string BIF (Step 1b
# substrate) over the read_genesis result. 11 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
# Clean any stale .cidhash from previous runs before tests touch
# the filesystem.
rm -f next/genesis/.cidhash
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE; rm -f next/genesis/.cidhash" EXIT
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/bootstrap.erl\")) :name)")
;; build_genesis returns {ok, [{cid, _}, {sections, _}]}
(epoch 10)
(eval "(erlang-eval-ast \"{ok, B} = bootstrap:build_genesis(bootstrap:read_genesis()), {Tag, _} = hd(B), Tag\")")
;; The CID is a non-empty binary
(epoch 11)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), is_binary(C)\") :name)")
(epoch 12)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), byte_size(C) > 50\") :name)")
;; build_genesis is deterministic across calls
(epoch 13)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C1}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), {ok, [{cid, C2}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), C1 =:= C2\") :name)")
;; build_genesis preserves the sections list
(epoch 14)
(eval "(erlang-eval-ast \"{ok, [_, {sections, S}]} = bootstrap:build_genesis(bootstrap:read_genesis()), length(S)\")")
;; build_genesis rejects bad input shapes
(epoch 15)
(eval "(get (erlang-eval-ast \"case bootstrap:build_genesis({error, broken}) of {error, {bad_read_result, _}} -> ok; _ -> bad end\") :name)")
;; verify_genesis returns ok when CID matches
(epoch 20)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), bootstrap:verify_genesis(bootstrap:read_genesis(), C) =:= ok\") :name)")
;; verify_genesis returns {error, {cid_mismatch, _, _}} when CID doesn't match
(epoch 21)
(eval "(get (erlang-eval-ast \"case bootstrap:verify_genesis(bootstrap:read_genesis(), <<99,99,99>>) of {error, {cid_mismatch, _, _}} -> ok; _ -> bad end\") :name)")
;; cidhash_path concatenation
(epoch 22)
(eval "(get (erlang-eval-ast \"bootstrap:cidhash_path(<<110,101,120,116>>) =:= <<110,101,120,116,47,46,99,105,100,104,97,115,104>>\") :name)")
;; write_cidhash + read_cidhash round-trip the bundle CID
(epoch 23)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), Base = bootstrap:default_base(), ok = bootstrap:write_cidhash(Base, C), {ok, Stored} = bootstrap:read_cidhash(Base), Stored =:= C\") :name)")
;; Full verify path against the persisted .cidhash
(epoch 24)
(eval "(get (erlang-eval-ast \"Base = bootstrap:default_base(), {ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), ok = bootstrap:write_cidhash(Base, C), {ok, Stored} = bootstrap:read_cidhash(Base), bootstrap:verify_genesis(bootstrap:read_genesis(), Stored) =:= ok\") :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 2 "module load name" "bootstrap"
check 10 "build_genesis head tag" "cid"
check 11 "CID is a binary" "true"
check 12 "CID length > 50" "true"
check 13 "build_genesis deterministic" "true"
check 14 "sections preserved (7 entries)" "7"
check 15 "build_genesis rejects bad shape" "ok"
check 20 "verify_genesis ok when match" "true"
check 21 "verify_genesis errs on mismatch" "ok"
check 22 "cidhash_path concatenation" "true"
check 23 "write/read_cidhash round-trip" "true"
check 24 "verify against persisted hash" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/bootstrap_build.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,126 +0,0 @@
#!/usr/bin/env bash
# next/tests/bootstrap_load.sh — Step 4e acceptance test.
#
# Exercises bootstrap:load_genesis/1 + strip_sx_suffix/1.
# Walks bootstrap:read_genesis output, strips .sx from each
# filename, registers raw bytes as entries under the matching
# kind. 13 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
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/registry.erl\")) :name)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/bootstrap.erl\")) :name)")
;; strip_sx_suffix on "create.sx" -> "create"
(epoch 10)
(eval "(get (erlang-eval-ast \"bootstrap:strip_sx_suffix(<<99,114,101,97,116,101,46,115,120>>) =:= <<99,114,101,97,116,101>>\") :name)")
;; strip_sx_suffix unchanged on names without .sx
(epoch 11)
(eval "(get (erlang-eval-ast \"bootstrap:strip_sx_suffix(<<104,101,108,108,111>>) =:= <<104,101,108,108,111>>\") :name)")
;; strip_sx_suffix on exactly ".sx" -> empty binary
(epoch 12)
(eval "(get (erlang-eval-ast \"bootstrap:strip_sx_suffix(<<46,115,120>>) =:= <<>>\") :name)")
;; load_genesis on bad input rejects with proper tag
(epoch 13)
(eval "(get (erlang-eval-ast \"case bootstrap:load_genesis({error, broken}) of {error, {bad_read_result, _}} -> ok; _ -> bad end\") :name)")
;; Per-kind counts after load match the section file counts
(epoch 20)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(activity_types, S))\")")
(epoch 21)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(object_types, S))\")")
(epoch 22)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(projections, S))\")")
(epoch 23)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(validators, S))\")")
(epoch 24)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(codecs, S))\")")
(epoch 25)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(sig_suites, S))\")")
(epoch 26)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(audience, S))\")")
;; registry:lookup retrieves a known entry's bytes
(epoch 30)
(eval "(get (erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), case registry:lookup(activity_types, <<99,114,101,97,116,101>>, S) of {ok, B} -> is_binary(B) and (byte_size(B) > 100); _ -> false end\") :name)")
;; load_genesis is deterministic — compare via cid:to_string of state
(epoch 31)
(eval "(get (erlang-eval-ast \"R = bootstrap:read_genesis(), {ok, S1} = bootstrap:load_genesis(R), {ok, S2} = bootstrap:load_genesis(R), cid:to_string(S1) =:= cid:to_string(S2)\") :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 2 "registry module loaded" "registry"
check 3 "bootstrap module loaded" "bootstrap"
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 21 "loaded object_types count = 13" "13"
check 22 "loaded projections count = 7" "7"
check 23 "loaded validators count = 3" "3"
check 24 "loaded codecs count = 3" "3"
check 25 "loaded sig_suites count = 2" "2"
check 26 "loaded audience count = 3" "3"
check 30 "registry:lookup activity_types/create" "true"
check 31 "load_genesis deterministic" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/bootstrap_load.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,121 +0,0 @@
#!/usr/bin/env bash
# next/tests/bootstrap_populate.sh — Step 5c-populate acceptance test.
#
# Closes the bootstrap → registry loop end-to-end. Each test
# inlines registry:start_link() with bootstrap:populate_registry()
# because spawned processes don't survive separate erlang-eval-ast
# invocations. 11 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
# Shared prelude: starts registry, runs populate.
PRELUDE='registry:start_link(), N = bootstrap:populate_registry(),'
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/registry.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/kernel/bootstrap.erl\")) :name)")
;; populate returns the total count
(epoch 10)
(eval "(erlang-eval-ast \"${PRELUDE} N\")")
;; Per-kind counts match the manifest authored in Step 4
(epoch 20)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(activity_types))\")")
(epoch 21)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(object_types))\")")
(epoch 22)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(projections))\")")
(epoch 23)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(validators))\")")
(epoch 24)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(codecs))\")")
(epoch 25)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(sig_suites))\")")
(epoch 26)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(audience))\")")
;; Lookup of a known entry returns its bytes
(epoch 30)
(eval "(get (erlang-eval-ast \"${PRELUDE} case registry:lookup(activity_types, <<99,114,101,97,116,101>>) of {ok, B} -> is_binary(B) and (byte_size(B) > 100); _ -> false end\") :name)")
;; A known object-type entry registered correctly
(epoch 31)
(eval "(get (erlang-eval-ast \"${PRELUDE} case registry:lookup(object_types, <<100,101,102,105,110,101,45,97,99,116,105,118,105,116,121>>) of {ok, B} -> is_binary(B); _ -> false end\") :name)")
;; A known validator entry
(epoch 32)
(eval "(get (erlang-eval-ast \"${PRELUDE} case registry:lookup(validators, <<101,110,118,101,108,111,112,101,45,115,104,97,112,101>>) of {ok, B} -> is_binary(B); _ -> false end\") :name)")
EPOCHS
OUTPUT=$(timeout 600 "$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 "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 21 "object_types count = 13" "13"
check 22 "projections count = 7" "7"
check 23 "validators count = 3" "3"
check 24 "codecs count = 3" "3"
check 25 "sig_suites count = 2" "2"
check 26 "audience count = 3" "3"
check 30 "lookup activity_types/create" "true"
check 31 "lookup object_types/define-activity" "true"
check 32 "lookup validators/envelope-shape" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/bootstrap_populate.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,123 +0,0 @@
#!/usr/bin/env bash
# next/tests/bootstrap_read.sh — Step 4c acceptance test.
#
# Exercises bootstrap:read_genesis/0, read_section/2, sections/0,
# section_subdir/1, ends_with_sx/1. Verifies per-section file
# counts match the manifest authored in Steps 4a/4b. 14 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
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/bootstrap.erl\")) :name)")
;; sections/0 returns 7 atoms
(epoch 10)
(eval "(erlang-eval-ast \"length(bootstrap:sections())\")")
;; ends_with_sx — positive on "create.sx", negative on "hello"
(epoch 11)
(eval "(get (erlang-eval-ast \"bootstrap:ends_with_sx(<<99,114,101,97,116,101,46,115,120>>)\") :name)")
(epoch 12)
(eval "(get (erlang-eval-ast \"bootstrap:ends_with_sx(<<104,101,108,108,111>>)\") :name)")
(epoch 13)
(eval "(get (erlang-eval-ast \"bootstrap:ends_with_sx(<<>>)\") :name)")
;; Per-section file counts match the manifest (3/10/7/3/3/2/3)
(epoch 20)
(eval "(erlang-eval-ast \"length(bootstrap:read_section(bootstrap:default_base(), activity_types))\")")
(epoch 21)
(eval "(erlang-eval-ast \"length(bootstrap:read_section(bootstrap:default_base(), object_types))\")")
(epoch 22)
(eval "(erlang-eval-ast \"length(bootstrap:read_section(bootstrap:default_base(), projections))\")")
(epoch 23)
(eval "(erlang-eval-ast \"length(bootstrap:read_section(bootstrap:default_base(), validators))\")")
(epoch 24)
(eval "(erlang-eval-ast \"length(bootstrap:read_section(bootstrap:default_base(), codecs))\")")
(epoch 25)
(eval "(erlang-eval-ast \"length(bootstrap:read_section(bootstrap:default_base(), sig_suites))\")")
(epoch 26)
(eval "(erlang-eval-ast \"length(bootstrap:read_section(bootstrap:default_base(), audience))\")")
;; read_genesis/0 returns {ok, [{Section, Entries}, ...]} with 7 entries
(epoch 30)
(eval "(erlang-eval-ast \"{ok, G} = bootstrap:read_genesis(), length(G)\")")
;; First entry is {activity_types, [_,_,_]}
(epoch 31)
(eval "(get (erlang-eval-ast \"{ok, G} = bootstrap:read_genesis(), {S, Entries} = hd(G), S\") :name)")
;; Each entry has the right number of files
(epoch 32)
(eval "(erlang-eval-ast \"{ok, G} = bootstrap:read_genesis(), {_, E} = hd(G), length(E)\")")
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" "bootstrap"
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 21 "section object_types count" "13"
check 22 "section projections count" "7"
check 23 "section validators count" "3"
check 24 "section codecs count" "3"
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"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/bootstrap_read.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,134 +0,0 @@
#!/usr/bin/env bash
# next/tests/bootstrap_start.sh — Step 4f-consolidate test.
#
# bootstrap:start/3 is the one-call kernel bring-up: starts the
# registry gen_server, populates it from the genesis bundle,
# and starts the nx_kernel gen_server. Each test inlines the
# start call with downstream operations because spawned
# processes don't survive across separate erlang-eval-ast calls.
# 11 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
PRELUDE='KM = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,KM}], AS = [{public_keys,[[{id,k1},{created,0},{value,KM}]]}], bootstrap:start(alice, KS, AS),'
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/log.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/projection.erl\")) :name)")
(epoch 7)
(eval "(get (erlang-load-module (file-read \"next/kernel/registry.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
(epoch 9)
(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)")
;; bootstrap:start returns a Pid
(epoch 20)
(eval "(get (erlang-eval-ast \"${PRELUDE} is_pid(whereis(nx_kernel))\") :name)")
;; Registry has 3 activity types after start
(epoch 21)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(activity_types))\")")
;; Registry has 10 object types
(epoch 22)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(object_types))\")")
;; Registry has 7 projections
(epoch 23)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(projections))\")")
;; Total entries across all kinds = 31
(epoch 24)
(eval "(erlang-eval-ast \"${PRELUDE} L = lists:map(fun (K) -> length(registry:list(K)) end, registry:kinds()), lists:foldl(fun (X, A) -> X + A end, 0, L)\")")
;; nx_kernel fresh log_tip = 0
(epoch 25)
(eval "(erlang-eval-ast \"${PRELUDE} nx_kernel:log_tip()\")")
;; nx_kernel publish advances log_tip
(epoch 26)
(eval "(erlang-eval-ast \"${PRELUDE} nx_kernel:publish([{type, create}, {object, nil}]), nx_kernel:log_tip()\")")
;; nx_kernel state carries the supplied actor_id
(epoch 27)
(eval "(get (erlang-eval-ast \"${PRELUDE} nx_kernel:actor_id(nx_kernel:query()) =:= alice\") :name)")
;; Registry lookup works after start (canonical entry: Create)
(epoch 28)
(eval "(get (erlang-eval-ast \"${PRELUDE} case registry:lookup(activity_types, <<99,114,101,97,116,101>>) of {ok, _} -> ok; _ -> bad end\") :name)")
EPOCHS
OUTPUT=$(timeout 600 "$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 "bootstrap module loaded" "bootstrap"
check 20 "whereis(nx_kernel) is Pid" "true"
check 21 "activity_types count = 5" "5"
check 22 "object_types count = 13" "13"
check 23 "projections count = 7" "7"
check 24 "total entries = 36" "36"
check 25 "fresh log_tip = 0" "0"
check 26 "publish advances tip to 1" "1"
check 27 "actor_id = alice" "true"
check 28 "registry has create" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/bootstrap_start.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,117 +0,0 @@
#!/usr/bin/env bash
# next/tests/cid.sh — Step 1b acceptance test.
#
# Loads next/kernel/nx_cid.erl into the Erlang-on-SX runtime and checks
# the canonical CID contract: determinism, uniqueness, equality, and
# to_string/from_string round-trip. 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
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/nx_cid.erl\")) :name)")
;; from_sx returns a binary
(epoch 10)
(eval "(get (erlang-eval-ast \"is_binary(nx_cid:from_sx(foo))\") :name)")
;; from_sx is deterministic on atoms / ints / compound terms
(epoch 11)
(eval "(get (erlang-eval-ast \"nx_cid:from_sx(foo) =:= nx_cid:from_sx(foo)\") :name)")
(epoch 12)
(eval "(get (erlang-eval-ast \"nx_cid:from_sx(42) =:= nx_cid:from_sx(42)\") :name)")
(epoch 13)
(eval "(get (erlang-eval-ast \"nx_cid:from_sx({a, [1, 2, 3]}) =:= nx_cid:from_sx({a, [1, 2, 3]})\") :name)")
;; from_sx is collision-resistant on distinct terms
(epoch 20)
(eval "(get (erlang-eval-ast \"nx_cid:from_sx(foo) =/= nx_cid:from_sx(bar)\") :name)")
(epoch 21)
(eval "(get (erlang-eval-ast \"nx_cid:from_sx(1) =/= nx_cid:from_sx(2)\") :name)")
(epoch 22)
(eval "(get (erlang-eval-ast \"nx_cid:from_sx([1, 2]) =/= nx_cid:from_sx([1, 2, 3])\") :name)")
;; equals/2 is alias for =:=
(epoch 30)
(eval "(get (erlang-eval-ast \"nx_cid:equals(nx_cid:from_sx(foo), nx_cid:from_sx(foo))\") :name)")
(epoch 31)
(eval "(get (erlang-eval-ast \"nx_cid:equals(nx_cid:from_sx(foo), nx_cid:from_sx(bar))\") :name)")
;; to_string + from_string round-trip
(epoch 40)
(eval "(get (erlang-eval-ast \"nx_cid:equals(nx_cid:from_string(nx_cid:to_string(nx_cid:from_sx(foo))), nx_cid:from_sx(foo))\") :name)")
(epoch 41)
(eval "(get (erlang-eval-ast \"is_binary(nx_cid:to_string(nx_cid:from_sx({tuple, 1, 2})))\") :name)")
;; CIDv1 raw codec sha256 base32 form is around 59 chars; sanity-check length
(epoch 50)
(eval "(get (erlang-eval-ast \"byte_size(nx_cid:from_sx(hello)) > 50\") :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" "nx_cid"
check 10 "from_sx returns binary" "true"
check 11 "from_sx atom deterministic" "true"
check 12 "from_sx int deterministic" "true"
check 13 "from_sx compound deterministic" "true"
check 20 "from_sx atoms distinct" "true"
check 21 "from_sx ints distinct" "true"
check 22 "from_sx lists distinct" "true"
check 30 "equals same CIDs" "true"
check 31 "equals different CIDs" "false"
check 40 "to_string/from_string round-trip" "true"
check 41 "to_string returns binary" "true"
check 50 "CIDv1 base32 length sanity" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/cid.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,139 +0,0 @@
#!/usr/bin/env bash
# next/tests/define_registry_pure.sh — Step 5d-pure test.
#
# Exercises the Erlang-fun stand-in for the define-registry
# projection fold. Activities flow: Create{Define*{...}} ->
# registry:register/4 keyed by define_kind/1. 14 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
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/registry.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/projection.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/define_registry.erl\")) :name)")
;; define_kind covers all seven kinds
(epoch 10)
(eval "(get (erlang-eval-ast \"define_registry:define_kind(define_activity) =:= activity_types\") :name)")
(epoch 11)
(eval "(get (erlang-eval-ast \"define_registry:define_kind(define_object) =:= object_types\") :name)")
(epoch 12)
(eval "(get (erlang-eval-ast \"define_registry:define_kind(define_projection) =:= projections\") :name)")
(epoch 13)
(eval "(get (erlang-eval-ast \"define_registry:define_kind(define_validator) =:= validators\") :name)")
(epoch 14)
(eval "(get (erlang-eval-ast \"define_registry:define_kind(define_codec) =:= codecs\") :name)")
(epoch 15)
(eval "(get (erlang-eval-ast \"define_registry:define_kind(define_sig_suite) =:= sig_suites\") :name)")
(epoch 16)
(eval "(get (erlang-eval-ast \"define_registry:define_kind(define_audience) =:= audience\") :name)")
;; Unknown type returns not_a_define
(epoch 17)
(eval "(get (erlang-eval-ast \"define_registry:define_kind(some_other_type) =:= not_a_define\") :name)")
;; Non-Create activity is a pass-through
(epoch 20)
(eval "(get (erlang-eval-ast \"define_registry:fold([{type, update}, {object, [{type, define_activity}, {name, pin}]}], registry:new()) =:= registry:new()\") :name)")
;; Create{non-Define} is a pass-through
(epoch 21)
(eval "(get (erlang-eval-ast \"define_registry:fold([{type, create}, {object, [{type, note}, {name, x}]}], registry:new()) =:= registry:new()\") :name)")
;; Create{Define*} without :name is a pass-through (preserves State)
(epoch 22)
(eval "(get (erlang-eval-ast \"define_registry:fold([{type, create}, {object, [{type, define_activity}]}], registry:new()) =:= registry:new()\") :name)")
;; Happy path: Create{DefineActivity{name: pin}} registers under activity_types
(epoch 23)
(eval "(get (erlang-eval-ast \"Act = [{type, create}, {object, [{type, define_activity}, {name, pin}]}], S = define_registry:fold(Act, registry:new()), {ok, _} = registry:lookup(activity_types, pin, S), ok\") :name)")
;; Multi-fold accumulates across kinds
(epoch 24)
(eval "(get (erlang-eval-ast \"A1 = [{type, create}, {object, [{type, define_activity}, {name, pin}]}], A2 = [{type, create}, {object, [{type, define_object}, {name, pin_spec}]}], A3 = [{type, create}, {object, [{type, define_projection}, {name, pin_state}]}], S = define_registry:fold(A3, define_registry:fold(A2, define_registry:fold(A1, registry:new()))), {length(registry:list(activity_types, S)), length(registry:list(object_types, S)), length(registry:list(projections, S))} =:= {1, 1, 1}\") :name)")
;; Override: re-defining same name does not duplicate entry
(epoch 25)
(eval "(get (erlang-eval-ast \"A1 = [{type, create}, {object, [{type, define_activity}, {name, pin}, {v, 1}]}], A2 = [{type, create}, {object, [{type, define_activity}, {name, pin}, {v, 2}]}], S = define_registry:fold(A2, define_registry:fold(A1, registry:new())), case registry:lookup(activity_types, pin, S) of {ok, Entry} -> (length(registry:list(activity_types, S)) =:= 1) and (envelope:get_field(v, Entry) =:= {ok, 2}); _ -> false end\") :name)")
;; Integration with the projection driver: define_registry as fold_fn
(epoch 26)
(eval "(get (erlang-eval-ast \"projection:start_link(dr, registry:new(), define_registry:fold_fn()), projection:async_fold(dr, [{type, create}, {object, [{type, define_activity}, {name, pin}]}]), S = projection:query(dr), case registry:lookup(activity_types, pin, S) of {ok, _} -> ok; _ -> bad end\") :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 6 "define_registry module loaded" "define_registry"
check 10 "kind: define_activity" "true"
check 11 "kind: define_object" "true"
check 12 "kind: define_projection" "true"
check 13 "kind: define_validator" "true"
check 14 "kind: define_codec" "true"
check 15 "kind: define_sig_suite" "true"
check 16 "kind: define_audience" "true"
check 17 "kind: other -> not_a_define" "true"
check 20 "non-Create -> pass-through" "true"
check 21 "Create{non-Define} pass-through" "true"
check 22 "Define{} without :name no-op" "true"
check 23 "Create{DefineActivity} registers" "ok"
check 24 "multi-fold accumulates" "true"
check 25 "override preserves single entry" "true"
check 26 "projection integration" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/define_registry_pure.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,120 +0,0 @@
#!/usr/bin/env bash
# next/tests/delivery_dispatch.sh — m2 Step 8d test.
#
# After a successful outbox:publish, each ActorId in the
# Result's :delivery_set is enqueued onto the matching
# delivery_worker (registered under the peer-id atom). Only
# happens when Context carries {dispatch_deliveries, true} —
# back-compat with every M1 outbox caller that doesn't dispatch.
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
# Alice publishes to bob (and carol). Each peer worker is registered
# under its peer-id atom; the outbox dispatches via the workers'
# enqueue path. dispatch_fn left undefined so the workers just
# accumulate pending without firing HTTP.
SETUP='K = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,K}], AS = [{public_keys,[[{id,k1},{created,0},{value,K}]]}], {ok, L0} = log:open(alice, <<98,97,115,101>>), Ctx = [{actor_id,alice},{published,1},{key_spec,KS},{actor_state,AS},{log,L0},{projections,[]},{dispatch_deliveries, true}], CtxNoDispatch = [{actor_id,alice},{published,1},{key_spec,KS},{actor_state,AS},{log,L0},{projections,[]}], ReqToBob = [{type, note}, {object, [{content, hi}]}, {to, bob}], ReqToTwo = [{type, note}, {object, [{content, hi}]}, {to, [bob, carol]}],'
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/log.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/follower_graph.erl\")) :name)")
(epoch 7)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery_worker.erl\")) :name)")
(epoch 9)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
;; Bob's worker registered + publish to bob -> bob's pending has 1 entry
(epoch 20)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob), {ok, _, _} = outbox:publish(ReqToBob, Ctx), case delivery_worker:pending_srv(bob) of [_] -> ok; _ -> bad end\") :name)")
;; Carol's worker registered, publish to [bob, carol] -> both queues get 1 entry
(epoch 21)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob), delivery_worker:start_link(carol), {ok, _, _} = outbox:publish(ReqToTwo, Ctx), {length(delivery_worker:pending_srv(bob)), length(delivery_worker:pending_srv(carol))} =:= {1, 1}\") :name)")
;; Missing worker for an actor in delivery_set -> silently skipped (no error)
(epoch 22)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob), case outbox:publish(ReqToTwo, Ctx) of {ok, R, _} -> envelope:get_field(delivery_set, R) =:= {ok, [bob, carol]}; _ -> false end andalso length(delivery_worker:pending_srv(bob)) =:= 1\") :name)")
;; No :dispatch_deliveries flag -> no enqueue happens (back-compat)
(epoch 23)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob), {ok, _, _} = outbox:publish(ReqToBob, CtxNoDispatch), delivery_worker:pending_srv(bob) =:= []\") :name)")
;; Two publishes -> bob's queue has 2 entries (FIFO append)
(epoch 24)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob), {ok, _, NewLog} = outbox:publish(ReqToBob, Ctx), Ctx2 = [{actor_id,alice},{published,2},{key_spec,KS},{actor_state,AS},{log,NewLog},{projections,[]},{dispatch_deliveries, true}], {ok, _, _} = outbox:publish(ReqToBob, Ctx2), length(delivery_worker:pending_srv(bob)) =:= 2\") :name)")
;; Empty delivery_set -> no dispatch (no :to, no :cc)
(epoch 25)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob), ReqNoAud = [{type, note}, {object, [{content, hi}]}], {ok, _, _} = outbox:publish(ReqNoAud, Ctx), delivery_worker:pending_srv(bob) =:= []\") :name)")
EPOCHS
OUTPUT=$(timeout 540 "$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 9 "outbox module loaded" "outbox"
check 20 "single peer enqueued" "ok"
check 21 "two peers both enqueued" "true"
check 22 "missing worker silently skip" "true"
check 23 "no dispatch_deliveries no-op" "true"
check 24 "two publishes FIFO append" "true"
check 25 "empty delivery_set -> no-op" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/delivery_dispatch.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,126 +0,0 @@
#!/usr/bin/env bash
# next/tests/delivery_retry.sh — m2 Step 8b-pure test.
#
# Pure-functional retry-time bookkeeping for the delivery worker.
# record_failure bumps the attempt counter and computes the next
# retry time per backoff_for. record_success clears state for a
# cid. next_due returns cids whose retry time has passed.
#
# Real timer wiring (erlang:send_after self-cast) is Step 8b-timer
# once substrate support lands.
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
SETUP='Act1 = [{id, <<1>>}, {type, note}, {actor, alice}], Act2 = [{id, <<2>>}, {type, note}, {actor, alice}],'
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/delivery_worker.erl\")) :name)")
;; Fresh state: no attempts, no next_retry, no dead_letter
(epoch 10)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_worker:new(bob), {delivery_worker:attempts_for(<<1>>, S), delivery_worker:next_retry_at(<<1>>, S), delivery_worker:dead_letter_list(S)} =:= {0, undefined, []}\") :name)")
;; record_failure bumps the attempt counter
(epoch 11)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:new(bob)), S1 = delivery_worker:record_failure_pure(<<1>>, 1000, S0), delivery_worker:attempts_for(<<1>>, S1) =:= 1\") :name)")
;; record_failure sets next_retry_at = Now + backoff(1) = Now + 30
(epoch 12)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:new(bob)), S1 = delivery_worker:record_failure_pure(<<1>>, 1000, S0), delivery_worker:next_retry_at(<<1>>, S1) =:= 1030\") :name)")
;; Second failure -> attempts=2, NextRetryAt = Now+300
(epoch 13)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:new(bob)), S1 = delivery_worker:record_failure_pure(<<1>>, 1000, S0), S2 = delivery_worker:record_failure_pure(<<1>>, 2000, S1), {delivery_worker:attempts_for(<<1>>, S2), delivery_worker:next_retry_at(<<1>>, S2)} =:= {2, 2300}\") :name)")
;; record_success clears attempts + next_retry for the cid
(epoch 14)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:new(bob)), S1 = delivery_worker:record_failure_pure(<<1>>, 1000, S0), S2 = delivery_worker:record_success_pure(<<1>>, S1), {delivery_worker:attempts_for(<<1>>, S2), delivery_worker:next_retry_at(<<1>>, S2)} =:= {0, undefined}\") :name)")
;; next_due returns Cids whose retry time has passed
(epoch 15)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:new(bob)), S1 = delivery_worker:record_failure_pure(<<1>>, 1000, S0), delivery_worker:next_due_pure(1030, S1) =:= [<<1>>]\") :name)")
;; next_due returns [] before retry time
(epoch 16)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:new(bob)), S1 = delivery_worker:record_failure_pure(<<1>>, 1000, S0), delivery_worker:next_due_pure(1020, S1) =:= []\") :name)")
;; 6th failure -> dead_letter; activity moves out of :pending
(epoch 17)
(eval "(get (erlang-eval-ast \"${SETUP} F = fun(S) -> delivery_worker:record_failure_pure(<<1>>, 1000, S) end, S0 = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:new(bob)), S6 = F(F(F(F(F(F(S0)))))), {delivery_worker:dead_letter_list(S6), delivery_worker:pending(S6)} =:= {[Act1], []}\") :name)")
;; Dead-lettered cid is no longer in next_retry
(epoch 18)
(eval "(get (erlang-eval-ast \"${SETUP} F = fun(S) -> delivery_worker:record_failure_pure(<<1>>, 1000, S) end, S0 = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:new(bob)), S6 = F(F(F(F(F(F(S0)))))), delivery_worker:next_retry_at(<<1>>, S6) =:= undefined\") :name)")
;; Two cids: success on one doesn't disturb the other's retry state
(epoch 19)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:enqueue_pure(bob, Act2, delivery_worker:new(bob))), S1 = delivery_worker:record_failure_pure(<<1>>, 1000, S0), S2 = delivery_worker:record_failure_pure(<<2>>, 1000, S1), S3 = delivery_worker:record_success_pure(<<1>>, S2), delivery_worker:next_retry_at(<<2>>, S3) =:= 1030\") :name)")
EPOCHS
OUTPUT=$(timeout 240 "$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 3 "module loaded" "delivery_worker"
check 10 "fresh state empty" "true"
check 11 "record_failure bumps attempts" "true"
check 12 "record_failure sets next_retry_at" "true"
check 13 "second failure: slot 2 = +300" "true"
check 14 "record_success clears state" "true"
check 15 "next_due returns due cids" "true"
check 16 "next_due empty before due" "true"
check 17 "6th failure -> dead_letter" "true"
check 18 "dead-lettered cid out of retry" "true"
check 19 "success on one preserves other" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/delivery_retry.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,131 +0,0 @@
#!/usr/bin/env bash
# next/tests/delivery_retry_timer.sh — m2 Step 8b-timer.
#
# Live timer wiring on the delivery_worker gen_server. The pure
# bookkeeping is covered by delivery_retry.sh — this suite proves the
# erlang:send_after / cancel_timer wiring fires retries from the
# scheduler's logical clock without anyone calling drain by hand.
#
# Substrate dependency: erlang:send_after/3 + cancel_timer/1 +
# monotonic_time/0,1 — landed via cherry-pick from loops/erlang
# (commits 3709460d / 98b0104c / 779e53b2 on this branch).
#
# Test discipline: every test cancels its leftover timer before
# returning. If we don't, the scheduler keeps the run loop alive
# advancing time through the full backoff chain (30s → 5m → 30m →
# 6h → 24h), and each tick costs ~10s of wall time inside the
# Erlang-on-SX VM. Canceling the trailing timer is the difference
# between a 25s test and a 60s+ test.
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
# A canned activity with cid <<1,2,3>>.
SETUP='Act = [{id, <<1,2,3>>}, {type, note}, {actor, alice}], FailFn = fun(_) -> {error, transient} end,'
# Convenience: cancel any leftover timer for cid <<1,2,3>> on Peer.
# Prevents the scheduler from grinding through 30s/5m/30m/6h/24h of
# retries between epochs.
CANCEL='CancelLeftover = fun(Peer) -> SS = delivery_worker:state_srv(Peer), case delivery_worker:timer_ref_for(<<1,2,3>>, SS) of undefined -> ok; LRef -> erlang:cancel_timer(LRef), ok end 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 "(er-load-gen-server!)")
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery_worker.erl\")) :name)")
;; T1 — a failing flush schedules a retry timer. timer_ref_for
;; returns a live Ref (not undefined). Then cancel before
;; returning so the scheduler doesn't grind the full backoff
;; chain trying to retry.
(epoch 10)
(eval "(get (erlang-eval-ast \"${SETUP}${CANCEL} delivery_worker:start_link(bob, FailFn), delivery_worker:enqueue(bob, Act), {ok, [], [<<1,2,3>>]} = delivery_worker:flush(bob), S = delivery_worker:state_srv(bob), Ref = delivery_worker:timer_ref_for(<<1,2,3>>, S), Result = is_reference(Ref), CancelLeftover(bob), Result\") :name)")
;; T2 — initial flush bumps the attempt counter to 1; next_retry_at
;; gets set; cancel the timer before returning.
(epoch 11)
(eval "(get (erlang-eval-ast \"${SETUP}${CANCEL} delivery_worker:start_link(bob, FailFn), delivery_worker:enqueue(bob, Act), delivery_worker:flush(bob), S = delivery_worker:state_srv(bob), Result = delivery_worker:attempts_for(<<1,2,3>>, S) =:= 1, CancelLeftover(bob), Result\") :name)")
;; T3 — advancing the logical clock past the 30s backoff fires the
;; timer; handle_info({retry, Cid}) bumps attempts to 2 and arms
;; the next slot (backoff(2)=300s). Then cancel the new timer.
(epoch 12)
(eval "(get (erlang-eval-ast \"${SETUP}${CANCEL} delivery_worker:start_link(bob, FailFn), delivery_worker:enqueue(bob, Act), delivery_worker:flush(bob), receive after 31000 -> ok end, S = delivery_worker:state_srv(bob), Result = delivery_worker:attempts_for(<<1,2,3>>, S) =:= 2, CancelLeftover(bob), Result\") :name)")
;; T4 — after the retry fires the worker has armed a fresh timer
;; for the next backoff slot. Confirm it's a live ref, then
;; cancel it.
(epoch 13)
(eval "(get (erlang-eval-ast \"${SETUP}${CANCEL} delivery_worker:start_link(bob, FailFn), delivery_worker:enqueue(bob, Act), delivery_worker:flush(bob), receive after 31000 -> ok end, S = delivery_worker:state_srv(bob), Result = is_reference(delivery_worker:timer_ref_for(<<1,2,3>>, S)), CancelLeftover(bob), Result\") :name)")
;; T5 — successful retry path. Dispatch fails twice then succeeds
;; (ets-backed counter). After two backoff slots elapse
;; (30s, then 300s), the third attempt succeeds and
;; record_success_pure clears the per-cid bookkeeping. No new
;; timer is scheduled, so the scheduler terminates naturally.
(epoch 14)
(eval "(get (erlang-eval-ast \"${SETUP} ets:new(rt_ctr, [named_table, public]), ets:insert(rt_ctr, {n, 0}), Mixed = fun(_) -> [{n, N}] = ets:lookup(rt_ctr, n), ets:insert(rt_ctr, {n, N+1}), case N < 2 of true -> {error, transient}; false -> ok end end, delivery_worker:start_link(carol, Mixed), delivery_worker:enqueue(carol, Act), delivery_worker:flush(carol), receive after 31000 -> ok end, receive after 301000 -> ok end, S = delivery_worker:state_srv(carol), delivery_worker:pending(S) =:= [] andalso delivery_worker:attempts_for(<<1,2,3>>, S) =:= 0 andalso delivery_worker:timer_ref_for(<<1,2,3>>, S) =:= undefined\") :name)")
EPOCHS
OUTPUT=$(timeout 900 "$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 "T1 flush schedules a timer" "true"
check 11 "T2 initial flush bumps attempts to 1" "true"
check 12 "T3 timer fires; attempts=2" "true"
check 13 "T4 retry rearms next timer" "true"
check 14 "T5 success clears retry state" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/delivery_retry_timer.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
if [ "$VERBOSE" = "-v" ]; then
echo "--- sx_server output ---"
echo "$OUTPUT" | tail -40
echo "---"
fi
fi
[ $FAIL -eq 0 ]

View File

@@ -1,164 +0,0 @@
#!/usr/bin/env bash
# next/tests/delivery_set.sh — m2 Step 7 test.
#
# delivery:delivery_set/2,3 computes the audience-resolved
# recipient list for an outbound activity. Sources are :to / :cc
# fields plus expansion of `followers` (via follower_graph) and
# `public` (v2 placeholder — Step 7c will populate with peer
# instances). Self-delivery suppressed; result deduplicated.
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
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/follower_graph.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery.erl\")) :name)")
;; Empty activity -> empty delivery set
(epoch 10)
(eval "(get (erlang-eval-ast \"delivery:delivery_set([{actor, alice}], []) =:= []\") :name)")
;; Single :to atom recipient
(epoch 11)
(eval "(get (erlang-eval-ast \"delivery:delivery_set([{actor, alice}, {to, bob}], []) =:= [bob]\") :name)")
;; :to list of recipients
(epoch 12)
(eval "(get (erlang-eval-ast \"delivery:delivery_set([{actor, alice}, {to, [bob, carol]}], []) =:= [bob, carol]\") :name)")
;; :cc adds to :to
(epoch 13)
(eval "(get (erlang-eval-ast \"delivery:delivery_set([{actor, alice}, {to, [bob]}, {cc, [carol]}], []) =:= [bob, carol]\") :name)")
;; Self-delivery suppressed (alice in :to is the publisher)
(epoch 14)
(eval "(get (erlang-eval-ast \"delivery:delivery_set([{actor, alice}, {to, [alice, bob]}], []) =:= [bob]\") :name)")
;; Duplicate recipients deduped
(epoch 15)
(eval "(get (erlang-eval-ast \"delivery:delivery_set([{actor, alice}, {to, [bob, bob]}, {cc, [bob]}], []) =:= [bob]\") :name)")
;; :to and :cc with overlap are deduped
(epoch 16)
(eval "(get (erlang-eval-ast \"delivery:delivery_set([{actor, alice}, {to, [bob, carol]}, {cc, [carol, dave]}], []) =:= [bob, carol, dave]\") :name)")
;; followers audience symbol -> sender's followers from follower_graph
(epoch 17)
(eval "(get (erlang-eval-ast \"Follow = [{actor, bob}, {type, follow}, {object, alice}], Accept = [{actor, alice}, {type, accept}, {object, Follow}], S = follower_graph:fold(Accept, follower_graph:fold(Follow, follower_graph:new())), delivery:delivery_set([{actor, alice}, {to, followers}], [], S) =:= [bob]\") :name)")
;; followers with empty follower-graph -> []
(epoch 18)
(eval "(get (erlang-eval-ast \"delivery:delivery_set([{actor, alice}, {to, followers}], [], follower_graph:new()) =:= []\") :name)")
;; public audience symbol -> sender's followers for v2 (§13.4)
(epoch 19)
(eval "(get (erlang-eval-ast \"F = [{actor, bob}, {type, follow}, {object, alice}], A = [{actor, alice}, {type, accept}, {object, F}], S = follower_graph:fold(A, follower_graph:fold(F, follower_graph:new())), delivery:delivery_set([{actor, alice}, {to, public}], [], S) =:= [bob]\") :name)")
;; public with empty follower-graph -> []
(epoch 28)
(eval "(get (erlang-eval-ast \"delivery:delivery_set([{actor, alice}, {to, public}], [], follower_graph:new()) =:= []\") :name)")
;; public + followers in same audience deduped (both expand identically)
(epoch 29)
(eval "(get (erlang-eval-ast \"F = [{actor, bob}, {type, follow}, {object, alice}], A = [{actor, alice}, {type, accept}, {object, F}], S = follower_graph:fold(A, follower_graph:fold(F, follower_graph:new())), delivery:delivery_set([{actor, alice}, {to, [public, followers]}], [], S) =:= [bob]\") :name)")
;; Mixed explicit + followers, followers carry two peers
(epoch 20)
(eval "(get (erlang-eval-ast \"F1 = [{actor, bob}, {type, follow}, {object, alice}], A1 = [{actor, alice}, {type, accept}, {object, F1}], F2 = [{actor, carol}, {type, follow}, {object, alice}], A2 = [{actor, alice}, {type, accept}, {object, F2}], S = follower_graph:fold(A2, follower_graph:fold(F2, follower_graph:fold(A1, follower_graph:fold(F1, follower_graph:new())))), delivery:delivery_set([{actor, alice}, {to, [dave, followers]}], [], S) =:= [dave, bob, carol]\") :name)")
;; followers + explicit, with overlap deduped
(epoch 21)
(eval "(get (erlang-eval-ast \"F = [{actor, bob}, {type, follow}, {object, alice}], A = [{actor, alice}, {type, accept}, {object, F}], S = follower_graph:fold(A, follower_graph:fold(F, follower_graph:new())), delivery:delivery_set([{actor, alice}, {to, [bob, followers]}], [], S) =:= [bob]\") :name)")
;; collect_recipients: bare helper returns flat list (no dedup, no self-suppression)
(epoch 22)
(eval "(get (erlang-eval-ast \"delivery:collect_recipients([{actor, alice}, {to, [bob, carol]}, {cc, [carol, dave]}]) =:= [bob, carol, carol, dave]\") :name)")
;; suppress_self drops every occurrence of Self
(epoch 23)
(eval "(get (erlang-eval-ast \"delivery:suppress_self([bob, alice, carol, alice], alice) =:= [bob, carol]\") :name)")
;; dedup preserves first occurrence order
(epoch 24)
(eval "(get (erlang-eval-ast \"delivery:dedup([bob, carol, bob, dave, carol]) =:= [bob, carol, dave]\") :name)")
;; expand_audience: pass-through for plain ActorId
(epoch 25)
(eval "(get (erlang-eval-ast \"delivery:expand_audience(carol, alice, follower_graph:new()) =:= [carol]\") :name)")
EPOCHS
OUTPUT=$(timeout 240 "$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 4 "delivery module loaded" "delivery"
check 10 "empty activity -> empty set" "true"
check 11 "single :to atom recipient" "true"
check 12 "list :to recipients" "true"
check 13 ":to + :cc unioned" "true"
check 14 "self-delivery suppressed" "true"
check 15 "duplicates within :to deduped" "true"
check 16 ":to/:cc overlap deduped" "true"
check 17 "followers expands via graph" "true"
check 18 "empty follower-graph -> []" "true"
check 19 "public -> sender's followers" "true"
check 28 "public empty graph -> []" "true"
check 29 "public + followers dedupe" "true"
check 20 "mixed explicit + followers" "true"
check 21 "followers + overlap deduped" "true"
check 22 "collect_recipients raw flat" "true"
check 23 "suppress_self drops every match" "true"
check 24 "dedup preserves first-occurrence" "true"
check 25 "expand_audience pass-through" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/delivery_set.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,139 +0,0 @@
#!/usr/bin/env bash
# next/tests/delivery_state.sh — m2 Step 8c test.
#
# Delivery-state projection: folds enqueue / delivered / failed /
# dead_lettered events into a per-peer worker-shaped snapshot so
# the outbound queue survives kernel restart.
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
SETUP='Act1 = [{id, <<1>>}, {type, note}, {actor, alice}], Act2 = [{id, <<2>>}, {type, note}, {actor, alice}], E_Enq1 = [{type, enqueued}, {peer, bob}, {activity, Act1}], E_Enq2 = [{type, enqueued}, {peer, bob}, {activity, Act2}], E_Enq2Carol = [{type, enqueued}, {peer, carol}, {activity, Act2}], E_Del1 = [{type, delivered}, {peer, bob}, {cid, <<1>>}], E_Fail1 = [{type, failed}, {peer, bob}, {cid, <<1>>}, {now, 1000}],'
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/delivery_worker.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery_state.erl\")) :name)")
;; Fresh projection -> []
(epoch 10)
(eval "(get (erlang-eval-ast \"delivery_state:new() =:= []\") :name)")
;; enqueued event creates a peer entry and appends to pending
(epoch 11)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_state:fold(E_Enq1, delivery_state:new()), delivery_state:pending(bob, S) =:= [Act1]\") :name)")
;; Two enqueues to same peer -> FIFO order
(epoch 12)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_state:fold(E_Enq2, delivery_state:fold(E_Enq1, delivery_state:new())), delivery_state:pending(bob, S) =:= [Act1, Act2]\") :name)")
;; Enqueues to different peers -> independent queues
(epoch 13)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_state:fold(E_Enq2Carol, delivery_state:fold(E_Enq1, delivery_state:new())), {delivery_state:pending(bob, S), delivery_state:pending(carol, S)} =:= {[Act1], [Act2]}\") :name)")
;; delivered event clears the matching pending entry
(epoch 14)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_state:fold(E_Del1, delivery_state:fold(E_Enq1, delivery_state:new())), delivery_state:pending(bob, S) =:= []\") :name)")
;; failed event bumps attempts and sets next_retry
(epoch 15)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_state:fold(E_Fail1, delivery_state:fold(E_Enq1, delivery_state:new())), {delivery_state:attempts(bob, S), delivery_state:next_retry(bob, S)} =:= {[{<<1>>, 1}], [{<<1>>, 1030}]}\") :name)")
;; Five failures then 6th fails -> dead_lettered
(epoch 16)
(eval "(get (erlang-eval-ast \"${SETUP} F = fun(S) -> delivery_state:fold(E_Fail1, S) end, S0 = delivery_state:fold(E_Enq1, delivery_state:new()), S6 = F(F(F(F(F(F(S0)))))), {delivery_state:dead_letter(bob, S6), delivery_state:pending(bob, S6)} =:= {[Act1], []}\") :name)")
;; Explicit dead_lettered event moves activity to dead_letter
(epoch 17)
(eval "(get (erlang-eval-ast \"${SETUP} E_DL = [{type, dead_lettered}, {peer, bob}, {cid, <<1>>}], S = delivery_state:fold(E_DL, delivery_state:fold(E_Enq1, delivery_state:new())), {delivery_state:dead_letter(bob, S), delivery_state:pending(bob, S)} =:= {[Act1], []}\") :name)")
;; peers/1 lists every peer touched
(epoch 18)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_state:fold(E_Enq2Carol, delivery_state:fold(E_Enq1, delivery_state:new())), delivery_state:peers(S) =:= [bob, carol]\") :name)")
;; peer_state returns {ok, Worker} | not_found
(epoch 19)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_state:fold(E_Enq1, delivery_state:new()), case delivery_state:peer_state(bob, S) of {ok, _} -> true; _ -> false end andalso delivery_state:peer_state(ghost, S) =:= not_found\") :name)")
;; fold_fn/0 returns a 2-arity Erlang fun usable by projection:start_link/3
(epoch 20)
(eval "(get (erlang-eval-ast \"is_function(delivery_state:fold_fn(), 2)\") :name)")
;; Unknown event type passes through
(epoch 21)
(eval "(get (erlang-eval-ast \"Garbage = [{type, mystery}, {peer, bob}], delivery_state:fold(Garbage, delivery_state:new()) =:= []\") :name)")
;; delivered after failed clears retry state
(epoch 22)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_state:fold(E_Del1, delivery_state:fold(E_Fail1, delivery_state:fold(E_Enq1, delivery_state:new()))), {delivery_state:attempts(bob, S), delivery_state:next_retry(bob, S)} =:= {[], []}\") :name)")
EPOCHS
OUTPUT=$(timeout 240 "$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 4 "delivery_state module loaded" "delivery_state"
check 10 "new/0 -> []" "true"
check 11 "enqueued -> pending appended" "true"
check 12 "two enqueues -> FIFO" "true"
check 13 "two peers independent queues" "true"
check 14 "delivered clears pending entry" "true"
check 15 "failed bumps attempts + next_retry" "true"
check 16 "6th failed -> dead_lettered" "true"
check 17 "explicit dead_lettered event" "true"
check 18 "peers/1 lists touched" "true"
check 19 "peer_state ok / not_found" "true"
check 20 "fold_fn/0 is fun/2" "true"
check 21 "unknown event passes through" "true"
check 22 "delivered after failed clears" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/delivery_state.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,156 +0,0 @@
#!/usr/bin/env bash
# next/tests/delivery_worker.sh — m2 Step 8a test.
#
# Pure-functional state shape + gen_server skeleton for the
# outbound delivery worker. One worker per peer; FIFO queue of
# pending activities; caller-supplied :dispatch_fn does the actual
# HTTP POST (stubbed for tests, live httpc in Step 8f). Retry /
# backoff (Step 8b) and persist-survival (Step 8c) layer on top.
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
SETUP='Act1 = [{id, <<1,2,3>>}, {type, note}, {actor, alice}], Act2 = [{id, <<4,5,6>>}, {type, note}, {actor, alice}], OkFetch = fun(_) -> ok end, FailFetch = fun(_) -> {error, http_500} 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 "(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/delivery_worker.erl\")) :name)")
;; new/1 returns initial state with empty queue
(epoch 10)
(eval "(get (erlang-eval-ast \"delivery_worker:pending(delivery_worker:new(bob)) =:= []\") :name)")
;; peer/1 reads the peer id
(epoch 11)
(eval "(get (erlang-eval-ast \"delivery_worker:peer(delivery_worker:new(bob)) =:= bob\") :name)")
;; enqueue_pure appends to the queue
(epoch 12)
(eval "(get (erlang-eval-ast \"${SETUP} S = delivery_worker:enqueue_pure(bob, Act1, delivery_worker:new(bob)), delivery_worker:pending(S) =:= [Act1]\") :name)")
;; Two enqueues -> FIFO order
(epoch 13)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:new(bob), S1 = delivery_worker:enqueue_pure(bob, Act1, S0), S2 = delivery_worker:enqueue_pure(bob, Act2, S1), delivery_worker:pending(S2) =:= [Act1, Act2]\") :name)")
;; drain_pure with no dispatch_fn -> all retry, queue intact
(epoch 14)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:new(bob), S1 = delivery_worker:enqueue_pure(bob, Act1, S0), {S2, Delivered, Retry} = delivery_worker:drain_pure(S1), Delivered =:= [] andalso length(Retry) =:= 1 andalso delivery_worker:pending(S2) =:= [Act1]\") :name)")
;; drain_pure with success dispatch -> activities cleared
(epoch 15)
(eval "(get (erlang-eval-ast \"${SETUP} S0 = delivery_worker:new(bob), S1 = lists:foldl(fun(K, A) -> delivery_worker:enqueue_pure(bob, K, A) end, S0, [Act1, Act2]), Wired = [{peer, bob}, {pending, [Act1, Act2]}, {attempts, []}, {dead_letter, []}, {dispatch_fn, OkFetch}], {S2, Delivered, Retry} = delivery_worker:drain_pure(Wired), delivery_worker:pending(S2) =:= [] andalso length(Delivered) =:= 2 andalso Retry =:= []\") :name)")
;; drain_pure with failing dispatch -> activities stay; attempt counter bumped
(epoch 16)
(eval "(get (erlang-eval-ast \"${SETUP} Wired = [{peer, bob}, {pending, [Act1]}, {attempts, []}, {dead_letter, []}, {dispatch_fn, FailFetch}], {S, Delivered, Retry} = delivery_worker:drain_pure(Wired), delivery_worker:pending(S) =:= [Act1] andalso Delivered =:= [] andalso length(Retry) =:= 1\") :name)")
;; deliver_one_pure success returns {ok, Cid}
(epoch 17)
(eval "(get (erlang-eval-ast \"${SETUP} Wired = [{peer, bob}, {pending, []}, {attempts, []}, {dead_letter, []}, {dispatch_fn, OkFetch}], case delivery_worker:deliver_one_pure(Act1, Wired) of {ok, <<1,2,3>>} -> ok; _ -> bad end\") :name)")
;; deliver_one_pure with no dispatch_fn returns no_dispatch_fn
(epoch 18)
(eval "(get (erlang-eval-ast \"${SETUP} case delivery_worker:deliver_one_pure(Act1, delivery_worker:new(bob)) of {error, _, no_dispatch_fn} -> ok; _ -> bad end\") :name)")
;; backoff_for slots match the design schedule
(epoch 19)
(eval "(get (erlang-eval-ast \"{delivery_worker:backoff_for(1), delivery_worker:backoff_for(2), delivery_worker:backoff_for(3), delivery_worker:backoff_for(4), delivery_worker:backoff_for(5)} =:= {30, 300, 1800, 21600, 86400}\") :name)")
;; backoff_for(>=6) returns dead_letter
(epoch 20)
(eval "(get (erlang-eval-ast \"delivery_worker:backoff_for(6) =:= dead_letter\") :name)")
;; schedule_for returns {retry_in, Sec} or dead_letter
(epoch 21)
(eval "(get (erlang-eval-ast \"{delivery_worker:schedule_for(1), delivery_worker:schedule_for(6)} =:= {{retry_in, 30}, dead_letter}\") :name)")
;; gen_server: start_link + enqueue + pending_srv
(epoch 22)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob), delivery_worker:enqueue(bob, Act1), delivery_worker:pending_srv(bob) =:= [Act1]\") :name)")
;; gen_server: flush with dispatch_fn -> {ok, [Cid], []}
(epoch 23)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob, OkFetch), delivery_worker:enqueue(bob, Act1), case delivery_worker:flush(bob) of {ok, [<<1,2,3>>], []} -> ok; _ -> bad end\") :name)")
;; gen_server: flush with failing dispatch -> {ok, [], [Cid]}, queue stays
(epoch 24)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob, FailFetch), delivery_worker:enqueue(bob, Act1), case delivery_worker:flush(bob) of {ok, [], [<<1,2,3>>]} -> ok; _ -> bad end andalso delivery_worker:pending_srv(bob) =:= [Act1]\") :name)")
;; gen_server: set_dispatch_fn swaps the function in-flight
(epoch 25)
(eval "(get (erlang-eval-ast \"${SETUP} delivery_worker:start_link(bob), delivery_worker:enqueue(bob, Act1), delivery_worker:set_dispatch_fn(bob, OkFetch), case delivery_worker:flush(bob) of {ok, [<<1,2,3>>], []} -> ok; _ -> bad end\") :name)")
EPOCHS
OUTPUT=$(timeout 360 "$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 4 "delivery_worker module loaded" "delivery_worker"
check 10 "new/1 -> empty queue" "true"
check 11 "peer/1 reads peer id" "true"
check 12 "enqueue_pure appends" "true"
check 13 "FIFO order preserved" "true"
check 14 "drain w/o dispatch -> retry" "true"
check 15 "drain ok clears queue" "true"
check 16 "drain fail keeps queue" "true"
check 17 "deliver_one ok -> {ok, Cid}" "ok"
check 18 "deliver_one no fn -> err" "ok"
check 19 "backoff schedule matches plan" "true"
check 20 "backoff overflow -> dead" "true"
check 21 "schedule_for shape" "true"
check 22 "gen_server enqueue + pending" "true"
check 23 "gen_server flush ok" "ok"
check 24 "gen_server flush fail keeps" "ok"
check 25 "gen_server set_dispatch_fn" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/delivery_worker.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,124 +0,0 @@
#!/usr/bin/env bash
# next/tests/discovery.sh — m2 Step 10a test.
#
# Local-side webfinger primitives: parse acct: URIs, synthesise
# actor URLs, build the RFC 7033 webfinger JSON body.
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
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/discovery.erl\")) :name)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
;; parse_acct accepts the acct: prefix form
(epoch 10)
(eval "(get (erlang-eval-ast \"discovery:parse_acct(<<97,99,99,116,58,97,108,105,99,101,64,104,111,115,116>>) =:= {ok, <<97,108,105,99,101>>, <<104,111,115,116>>}\") :name)")
;; parse_acct accepts the bare form
(epoch 11)
(eval "(get (erlang-eval-ast \"discovery:parse_acct(<<97,108,105,99,101,64,104,111,115,116>>) =:= {ok, <<97,108,105,99,101>>, <<104,111,115,116>>}\") :name)")
;; parse_acct host with port
(epoch 12)
(eval "(get (erlang-eval-ast \"discovery:parse_acct(<<97,108,105,99,101,64,104,111,115,116,58,57,57,57,57>>) =:= {ok, <<97,108,105,99,101>>, <<104,111,115,116,58,57,57,57,57>>}\") :name)")
;; parse_acct rejects empty user
(epoch 13)
(eval "(get (erlang-eval-ast \"case discovery:parse_acct(<<64,104,111,115,116>>) of {error, _} -> true; _ -> false end\") :name)")
;; parse_acct rejects missing @
(epoch 14)
(eval "(get (erlang-eval-ast \"case discovery:parse_acct(<<97,108,105,99,101>>) of {error, _} -> true; _ -> false end\") :name)")
;; parse_acct rejects empty host
(epoch 15)
(eval "(get (erlang-eval-ast \"case discovery:parse_acct(<<97,108,105,99,101,64>>) of {error, _} -> true; _ -> false end\") :name)")
;; parse_resource is an alias for parse_acct
(epoch 16)
(eval "(get (erlang-eval-ast \"discovery:parse_resource(<<97,99,99,116,58,98,111,98,64,98,46,99,111,109>>) =:= {ok, <<98,111,98>>, <<98,46,99,111,109>>}\") :name)")
;; actor_url_for synthesises http://<host>/actors/<user>
(epoch 17)
(eval "(get (erlang-eval-ast \"discovery:actor_url_for(<<97,108,105,99,101>>, <<104,111,115,116>>) =:= <<104,116,116,112,58,47,47,104,111,115,116,47,97,99,116,111,114,115,47,97,108,105,99,101>>\") :name)")
;; actor_url_for preserves port in host
(epoch 18)
(eval "(get (erlang-eval-ast \"discovery:actor_url_for(<<98,111,98>>, <<104,58,57,57>>) =:= <<104,116,116,112,58,47,47,104,58,57,57,47,97,99,116,111,114,115,47,98,111,98>>\") :name)")
;; webfinger_body starts with {"subject":"acct:<user>@<host>" — http_server:match_prefix
(epoch 19)
(eval "(get (erlang-eval-ast \"B = discovery:webfinger_body(<<97,108,105,99,101>>, <<104,111,115,116>>, <<117,114,108>>), Pre = <<123,34,115,117,98,106,101,99,116,34,58,34,97,99,99,116,58,97,108,105,99,101,64,104,111,115,116,34>>, http_server:match_prefix(Pre, B) =/= nomatch\") :name)")
;; webfinger_body byte_size is at least subject+links length (sanity)
(epoch 20)
(eval "(get (erlang-eval-ast \"B = discovery:webfinger_body(<<97,108,105,99,101>>, <<104,111,115,116>>, <<117,114,108>>), byte_size(B) > 80\") :name)")
EPOCHS
OUTPUT=$(timeout 480 "$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 "discovery module loaded" "discovery"
check 10 "parse_acct prefixed" "true"
check 11 "parse_acct bare form" "true"
check 12 "parse_acct host with port" "true"
check 13 "parse_acct empty user -> error" "true"
check 14 "parse_acct missing @ -> error" "true"
check 15 "parse_acct empty host -> error" "true"
check 16 "parse_resource alias" "true"
check 17 "actor_url_for synthesises" "true"
check 18 "actor_url_for preserves port" "true"
check 19 "webfinger_body subject prefix" "true"
check 20 "webfinger_body has body bytes" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/discovery.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,224 +0,0 @@
#!/usr/bin/env bash
# next/tests/discovery_fetch.sh — m2 Step 10c acceptance test.
#
# Two halves:
# (a) http_server side: the new actor_doc Accept format negotiates
# to a term_codec-encoded peer-actor-state proplist served
# from `nx_kernel:actor_state/1`. Verified via http_server:route
# in-process.
# (b) discovery_fetch closure: builds the FetchFn that
# peer_actors:lookup_or_fetch_srv/2 expects, GETs the actor
# doc via httpc:request/4, decodes the body, returns the AS
# proplist. Verified end-to-end against a background
# `python3 -m http.server`-style stub that returns hand-crafted
# term_codec bytes (so we exercise the wire, not just the
# in-process route).
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 ─────────────────────────────────────────
# Python script that:
# GET /actors/alice -> 200 with term_codec-encoded AS
# (built in Python: matches term_codec
# netstring format spelled out in
# next/kernel/term_codec.erl).
# GET /actors/missing -> 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_int(n):
s = str(n).encode()
return f"i{len(s)}:".encode() + s
def enc_bin(b):
return f"b{len(b)}:".encode() + b
def enc_list(items):
payload = b"".join(items)
# term_codec uses ELEMENT COUNT (not byte length) for list/tuple
# headers — see encode/1 in next/kernel/term_codec.erl.
return f"l{len(items)}:".encode() + payload
def enc_tuple(items):
payload = b"".join(items)
return f"t{len(items)}:".encode() + payload
def enc_nil():
return b"l0:"
# {public_keys, [[{id, k1}, {created, 0}, {value, <<1,2,3,4>>}]]}
KEY = enc_list([
enc_tuple([enc_atom("id"), enc_atom("k1")]),
enc_tuple([enc_atom("created"), enc_int(0)]),
enc_tuple([enc_atom("value"), enc_bin(bytes([1,2,3,4]))]),
])
PROPLIST = enc_list([
enc_tuple([enc_atom("public_keys"), enc_list([KEY])]),
])
class H(http.server.BaseHTTPRequestHandler):
def do_GET(self):
if self.path == "/actors/alice":
self.send_response(200)
self.send_header('content-type','application/vnd.fed-sx.actor-doc')
self.send_header('content-length', str(len(PROPLIST)))
self.end_headers()
self.wfile.write(PROPLIST)
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/actors/alice" >/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/envelope.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/kernel/log.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/term_codec.erl\")) :name)")
(epoch 7)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/peer_actors.erl\")) :name)")
(epoch 9)
(eval "(get (erlang-load-module (file-read \"next/kernel/nx_kernel.erl\")) :name)")
(epoch 10)
(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
(epoch 11)
(eval "(get (erlang-load-module (file-read \"next/kernel/dispatch_http.erl\")) :name)")
(epoch 12)
(eval "(get (erlang-load-module (file-read \"next/kernel/discovery_fetch.erl\")) :name)")
;; (a) http_server side: actor_doc Accept negotiates to actor_doc
(epoch 20)
(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,97,99,116,111,114,45,100,111,99>>) =:= actor_doc\") :name)")
;; (a) actor_doc_response_for/3 with kernel + actor returns 200 +
;; term_codec body; decoded body has :public_keys. Inline SETUP
;; per epoch because separate (eval ...) calls share gen_server
;; state but not Erlang locals, and we need fresh kernel-aware
;; assertions even though the previous epoch's nx_kernel persists.
(epoch 21)
(eval "(get (erlang-eval-ast \"AK = <<1,2,3,4>>, AKS = [{key_id,k1},{algorithm,ed25519},{value,AK}], AAS = [{public_keys,[[{id,k1},{created,0},{value,AK}]]}], nx_kernel:start_link(alice, AKS, AAS), Cfg = [{kernel, nx_kernel}], R = http_server:actor_doc_response_for(<<97,108,105,99,101>>, actor_doc, Cfg), {ok, S} = envelope:get_field(status, R), S =:= 200\") :name)")
;; (a) body decodes to a proplist with :public_keys
(epoch 22)
(eval "(get (erlang-eval-ast \"AK = <<1,2,3,4>>, AKS = [{key_id,k1},{algorithm,ed25519},{value,AK}], AAS = [{public_keys,[[{id,k1},{created,0},{value,AK}]]}], nx_kernel:start_link(alice, AKS, AAS), R = http_server:actor_doc_response_for(<<97,108,105,99,101>>, actor_doc, [{kernel, nx_kernel}]), {ok, Body} = envelope:get_field(body, R), {ok, AS, _} = term_codec:decode(Body), case envelope:get_field(public_keys, AS) of {ok, [_|_]} -> true; _ -> false end\") :name)")
;; (a) unknown actor -> 404
(epoch 23)
(eval "(get (erlang-eval-ast \"AK = <<1,2,3,4>>, AKS = [{key_id,k1},{algorithm,ed25519},{value,AK}], AAS = [{public_keys,[[{id,k1},{created,0},{value,AK}]]}], nx_kernel:start_link(alice, AKS, AAS), R = http_server:actor_doc_response_for(<<109,105,115,115,105,110,103>>, actor_doc, [{kernel, nx_kernel}]), {ok, S} = envelope:get_field(status, R), S =:= 404\") :name)")
;; (b) discovery_fetch:actor_doc_url builds <base>/actors/alice
(epoch 30)
(eval "(get (erlang-eval-ast \"U = discovery_fetch:actor_doc_url(<<__URL_BASE__>>, alice), U =:= <<__URL_BASE__,47,97,99,116,111,114,115,47,97,108,105,99,101>>\") :name)")
;; (b) discovery_fetch:fetch live -> {ok, AS} with :public_keys
(epoch 31)
(eval "(get (erlang-eval-ast \"R = discovery_fetch:fetch(<<__URL_BASE__,47,97,99,116,111,114,115,47,97,108,105,99,101>>, []), case R of {ok, AS} -> case envelope:get_field(public_keys, AS) of {ok, [_|_]} -> true; _ -> false end; _ -> false end\") :name)")
;; (b) closure produced by make_fetch_fn dispatches ok
(epoch 32)
(eval "(get (erlang-eval-ast \"Fn = discovery_fetch:make_fetch_fn([{peer_url, [{alice, <<__URL_BASE__>>}]}]), case Fn(alice) of {ok, AS} -> case envelope:get_field(public_keys, AS) of {ok, [_|_]} -> true; _ -> false end; _ -> false end\") :name)")
;; (b) closure on missing peer -> {error, no_peer_url}
(epoch 33)
(eval "(get (erlang-eval-ast \"Fn = discovery_fetch:make_fetch_fn([{peer_url, []}]), case Fn(alice) of {error, no_peer_url} -> true; _ -> false end\") :name)")
;; (b) closure GETs 404 path -> {error, {status, 404}}
(epoch 34)
(eval "(get (erlang-eval-ast \"R = discovery_fetch:fetch(<<__URL_BASE__,47,97,99,116,111,114,115,47,109,105,115,115,105,110,103>>, []), case R of {error, {status, 404}} -> true; _ -> false end\") :name)")
;; (b) lookup_or_fetch on cache miss writes the result back
(epoch 35)
(eval "(get (erlang-eval-ast \"Fn = discovery_fetch:make_fetch_fn([{peer_url, [{alice, <<__URL_BASE__>>}]}]), {R, NewState} = case peer_actors:lookup_or_fetch(alice, Fn, peer_actors:new()) of {ok, _AS, S} -> {ok, S}; {error, R0, S} -> {error, S} end, R =:= ok andalso peer_actors:peers(NewState) =:= [alice]\") :name)")
EPOCHS
sed -i "s|__URL_BASE__|${URL_BASE_BYTES}|g" "$TMPFILE"
OUTPUT=$(timeout 360 "$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 12 "discovery_fetch loaded" "discovery_fetch"
check 20 "actor_doc Accept negotiates" "true"
check 21 "actor_doc /3 with kernel -> 200" "true"
check 22 "body decodes to proplist w/ :public_keys" "true"
check 23 "unknown actor -> 404" "true"
check 30 "actor_doc_url builds /actors/X" "true"
check 31 "fetch live -> {ok, AS}" "true"
check 32 "closure -> {ok, AS}" "true"
check 33 "closure on missing peer -> no_peer_url" "true"
check 34 "closure on 404 -> {status, 404}" "true"
check 35 "lookup_or_fetch caches result" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/discovery_fetch.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,182 +0,0 @@
#!/usr/bin/env bash
# next/tests/dispatch_http.sh — m2 Step 8f acceptance test.
#
# Verifies the live HTTP dispatch closure built by
# dispatch_http:make_dispatch_fn/2:
# * 2xx response -> ok
# * non-2xx (404) -> {error, {status, 404}}
# * resolver miss -> {error, no_peer_url}
# * connection refused (closed port) -> {error, ...}
# * inbox_url constructs the path /actors/<peer>/inbox
# * the closure can be plugged into delivery_worker:drain
#
# Live HTTP uses a background `python3 -m http.server`. Step 8e's
# httpc:request/4 BIF wrapper is the underlying transport.
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=""
PORT=$(python3 -c 'import socket;s=socket.socket();s.bind(("127.0.0.1",0));print(s.getsockname()[1]);s.close()')
SRVROOT=$(mktemp -d)
# Python's http.server returns 200 for any GET to an existing path and
# 501 for POST. For our purposes we need a POST endpoint that returns
# 2xx. Use a tiny background Python server that always returns 200 OK
# regardless of method, so we can prove the dispatch path works.
PYSRV="$SRVROOT/srv.py"
cat > "$PYSRV" <<'PY'
import sys, http.server, socketserver
PORT = int(sys.argv[1])
class H(http.server.BaseHTTPRequestHandler):
def do_POST(self):
n = int(self.headers.get('content-length', '0'))
self.rfile.read(n) if n else None
self.send_response(200); self.send_header('content-type','text/plain'); self.end_headers()
self.wfile.write(b'ok')
def do_GET(self):
self.send_response(200); self.send_header('content-type','text/plain'); self.end_headers()
self.wfile.write(b'ok')
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/" >/dev/null 2>&1; then break; fi
sleep 0.2
done
# A DIFFERENT port that nothing is bound to — for the connection-
# refused test.
DEAD_PORT=$(python3 -c 'import socket;s=socket.socket();s.bind(("127.0.0.1",0));p=s.getsockname()[1];s.close();print(p)')
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")
URL_DEAD_BYTES=$(bytes_of "http://127.0.0.1:$DEAD_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/envelope.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/kernel/log.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
(epoch 7)
(eval "(get (erlang-load-module (file-read \"next/kernel/term_codec.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/dispatch_http.erl\")) :name)")
(epoch 9)
(eval "(get (erlang-load-module (file-read \"next/kernel/follower_graph.erl\")) :name)")
(epoch 10)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery.erl\")) :name)")
(epoch 11)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery_worker.erl\")) :name)")
;; inbox_url builds <base>/actors/<peer>/inbox
(epoch 20)
(eval "(get (erlang-eval-ast \"U = dispatch_http:inbox_url(<<__URL_BASE__>>, alice), case U of <<__URL_BASE__,47,97,99,116,111,114,115,47,97,108,105,99,101,47,105,110,98,111,120>> -> true; _ -> false end\") :name)")
;; resolve_peer_url hits the static map
(epoch 21)
(eval "(get (erlang-eval-ast \"Cfg = [{peer_url, [{alice, <<__URL_BASE__>>}]}], case dispatch_http:resolve_peer_url(alice, Cfg) of {ok, _} -> true; _ -> false end\") :name)")
;; resolve_peer_url misses cleanly
(epoch 22)
(eval "(get (erlang-eval-ast \"Cfg = [{peer_url, [{bob, <<__URL_BASE__>>}]}], case dispatch_http:resolve_peer_url(alice, Cfg) of {error, no_peer_url} -> true; _ -> false end\") :name)")
;; dispatch -> 200 from python server -> ok
(epoch 23)
(eval "(get (erlang-eval-ast \"Activity = [{type, note}, {object, [{content, hi}]}], dispatch_http:dispatch(<<__URL_BASE__,47,105,110,98,111,120>>, Activity, []) =:= ok\") :name)")
;; closure produced by make_dispatch_fn dispatches ok
(epoch 24)
(eval "(get (erlang-eval-ast \"Cfg = [{peer_url, [{alice, <<__URL_BASE__>>}]}], Fn = dispatch_http:make_dispatch_fn(alice, Cfg), Activity = [{type, note}, {object, [{content, hi}]}], Fn(Activity) =:= ok\") :name)")
;; closure on missing peer -> {error, no_peer_url}
(epoch 25)
(eval "(get (erlang-eval-ast \"Cfg = [{peer_url, []}], Fn = dispatch_http:make_dispatch_fn(alice, Cfg), Activity = [{type, note}, {object, [{content, hi}]}], case Fn(Activity) of {error, no_peer_url} -> true; _ -> false end\") :name)")
;; dispatch against a closed port -> error (not crash)
(epoch 26)
(eval "(get (erlang-eval-ast \"Activity = [{type, note}, {object, [{content, hi}]}], R = dispatch_http:dispatch(<<__URL_DEAD__,47,105,110,98,111,120>>, Activity, []), case R of {error, _} -> true; _ -> false end\") :name)")
;; delivery_worker drains successfully through the live closure.
;; Spin up a delivery_worker, enqueue an activity, set the live
;; dispatch_fn, drain — should drop the entry.
(epoch 27)
(eval "(get (erlang-eval-ast \"delivery_worker:start_link(alice), Cfg = [{peer_url, [{alice, <<__URL_BASE__>>}]}], Fn = dispatch_http:make_dispatch_fn(alice, Cfg), delivery_worker:set_dispatch_fn(alice, Fn), Activity = [{type, note}, {object, [{content, hi}]}, {cid, <<\\\"c1\\\">>}], delivery_worker:enqueue(alice, Activity), delivery_worker:flush(alice), delivery_worker:pending_srv(alice) =:= []\") :name)")
;; peer_url_fn closure path also resolves
(epoch 28)
(eval "(get (erlang-eval-ast \"Cfg = [{peer_url_fn, fun (alice) -> {ok, <<__URL_BASE__>>}; (_) -> not_found end}], Fn = dispatch_http:make_dispatch_fn(alice, Cfg), Activity = [{type, note}, {object, [{content, hi}]}], Fn(Activity) =:= ok\") :name)")
EPOCHS
sed -i "s|__URL_BASE__|${URL_BASE_BYTES}|g; s|__URL_DEAD__|${URL_DEAD_BYTES}|g" "$TMPFILE"
OUTPUT=$(timeout 360 "$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 8 "dispatch_http loaded" "dispatch_http"
check 20 "inbox_url builds /actors/X/inbox" "true"
check 21 "resolve hits static peer_url map" "true"
check 22 "resolve misses cleanly" "true"
check 23 "live POST -> 200 -> ok" "true"
check 24 "closure dispatches ok" "true"
check 25 "closure on missing peer -> err" "true"
check 26 "closed port -> {error, _}" "true"
check 27 "delivery_worker drains via closure" "true"
check 28 "peer_url_fn closure path resolves" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/dispatch_http.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,105 +0,0 @@
#!/usr/bin/env bash
# next/tests/envelope_canonical.sh — Step 2b acceptance test.
#
# Loads next/kernel/envelope.erl and checks canonical_bytes/1 contract:
# returns a binary, deterministic across runs, invariant under
# field-order permutation, invariant under signature changes, and
# different for different covered content. 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
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)")
;; canonical_bytes returns a binary
(epoch 10)
(eval "(get (erlang-eval-ast \"is_binary(envelope:canonical_bytes([{id,1},{type,create},{actor,alice},{published,1000},{signature,whatever}]))\") :name)")
;; Determinism: same envelope twice -> same bytes
(epoch 11)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =:= envelope:canonical_bytes([{id,1},{type,create},{actor,alice}])\") :name)")
;; Signature stripping: different signatures -> same canonical bytes
(epoch 12)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice},{signature,sig_one}]) =:= envelope:canonical_bytes([{id,1},{type,create},{actor,alice},{signature,sig_two}])\") :name)")
;; No signature vs some signature -> same canonical bytes
(epoch 13)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =:= envelope:canonical_bytes([{id,1},{type,create},{actor,alice},{signature,whatever}])\") :name)")
;; Key-order invariance: reordering top-level fields -> same bytes
(epoch 14)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =:= envelope:canonical_bytes([{actor,alice},{type,create},{id,1}])\") :name)")
;; Changing a covered field changes the bytes
(epoch 15)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =/= envelope:canonical_bytes([{id,2},{type,create},{actor,alice}])\") :name)")
;; Distinct envelopes -> distinct bytes
(epoch 16)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =/= envelope:canonical_bytes([{id,1},{type,update},{actor,bob}])\") :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" "envelope"
check 10 "canonical_bytes returns binary" "true"
check 11 "deterministic" "true"
check 12 "signature stripped (changes)" "true"
check 13 "signature stripped (absent)" "true"
check 14 "key-order invariant" "true"
check 15 "covered field change visible" "true"
check 16 "distinct envelopes distinct" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/envelope_canonical.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,126 +0,0 @@
#!/usr/bin/env bash
# next/tests/envelope_shape.sh — Step 2a acceptance test.
#
# Loads next/kernel/envelope.erl into the Erlang-on-SX runtime and
# checks validate_shape/1 / get_field/2 against the design §3.1 shape
# contract. 13 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
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)")
;; Reusable valid envelope as Erlang text. The signature itself is a
;; property list with key_id, algorithm, value.
;; E0 = [{id,1},{type,create},{actor,alice},{published,1000},
;; {signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]
;; Complete valid envelope
(epoch 10)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= ok\") :name)")
;; Missing each top-level required field
(epoch 11)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{type,create},{actor,alice},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= {error,{missing_field,id}}\") :name)")
(epoch 12)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{actor,alice},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= {error,{missing_field,type}}\") :name)")
(epoch 13)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= {error,{missing_field,actor}}\") :name)")
(epoch 14)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= {error,{missing_field,published}}\") :name)")
(epoch 15)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000}]) =:= {error,{missing_field,signature}}\") :name)")
;; Non-list inputs
(epoch 16)
(eval "(get (erlang-eval-ast \"envelope:validate_shape(42) =:= {error,not_a_proplist}\") :name)")
(epoch 17)
(eval "(get (erlang-eval-ast \"envelope:validate_shape(some_atom) =:= {error,not_a_proplist}\") :name)")
;; Signature sub-shape
(epoch 20)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,[{algorithm,ed25519},{value,v}]}]) =:= {error,{bad_signature,{missing_field,key_id}}}\") :name)")
(epoch 21)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,[{key_id,k1},{value,v}]}]) =:= {error,{bad_signature,{missing_field,algorithm}}}\") :name)")
(epoch 22)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519}]}]) =:= {error,{bad_signature,{missing_field,value}}}\") :name)")
(epoch 23)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,not_a_proplist}]) =:= {error,{bad_signature,not_a_proplist}}\") :name)")
;; get_field
(epoch 30)
(eval "(get (erlang-eval-ast \"envelope:get_field(actor,[{id,1},{actor,alice}]) =:= {ok,alice}\") :name)")
(epoch 31)
(eval "(get (erlang-eval-ast \"envelope:get_field(missing,[{id,1},{actor,alice}]) =:= not_found\") :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" "envelope"
check 10 "complete envelope -> ok" "true"
check 11 "missing id" "true"
check 12 "missing type" "true"
check 13 "missing actor" "true"
check 14 "missing published" "true"
check 15 "missing signature" "true"
check 16 "non-list (integer)" "true"
check 17 "non-list (atom)" "true"
check 20 "signature missing key_id" "true"
check 21 "signature missing algorithm" "true"
check 22 "signature missing value" "true"
check 23 "signature not a proplist" "true"
check 30 "get_field hit" "true"
check 31 "get_field miss" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/envelope_shape.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,129 +0,0 @@
#!/usr/bin/env bash
# next/tests/envelope_sig.sh — Step 2c acceptance test.
#
# Exercises envelope:verify_signature/2 against the full sig pipeline:
# canonical_bytes + crypto:hash MAC + time-aware key validity per design
# §9.6. 10 cases.
#
# The signature stand-in is HMAC-shaped:
# sig.value = crypto:hash(sha256, <<KeyMaterial/binary, CanonicalBytes/binary>>)
# Real Ed25519/RSA verification is deferred to milestone 2 once the
# corresponding crypto BIFs are wired.
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
# Shared Erlang prelude builds a valid-signed envelope template and an
# actor state with one active key. Each test reuses these and asserts
# against an Erlang =:= comparison so the result is a bare boolean.
PRELUDE='KM = <<1,2,3,4>>, U = [{actor,alice},{id,1},{published,100},{type,create}], CB = envelope:canonical_bytes(U), Sig = crypto:hash(sha256, <<KM/binary, CB/binary>>), Env = [{actor,alice},{id,1},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,Sig}]}], AS = [{public_keys, [[{id,k1},{created,50},{value,KM}]]}],'
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)")
;; valid sig + active key -> ok
(epoch 10)
(eval "(get (erlang-eval-ast \"${PRELUDE} envelope:verify_signature(Env, AS) =:= ok\") :name)")
;; tampered envelope (id mutated post-sign) -> bad_signature
(epoch 11)
(eval "(get (erlang-eval-ast \"${PRELUDE} Tampered = [{actor,alice},{id,999},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,Sig}]}], envelope:verify_signature(Tampered, AS) =:= {error,bad_signature}\") :name)")
;; wrong sig value (random bytes) -> bad_signature
(epoch 12)
(eval "(get (erlang-eval-ast \"${PRELUDE} BadEnv = [{actor,alice},{id,1},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,<<0,0,0,0>>}]}], envelope:verify_signature(BadEnv, AS) =:= {error,bad_signature}\") :name)")
;; unknown key_id -> no_active_key
(epoch 13)
(eval "(get (erlang-eval-ast \"${PRELUDE} OtherAS = [{public_keys, [[{id,k_other},{created,50},{value,KM}]]}], envelope:verify_signature(Env, OtherAS) =:= {error,no_active_key}\") :name)")
;; key superseded BEFORE published -> no_active_key
(epoch 14)
(eval "(get (erlang-eval-ast \"${PRELUDE} SupAS = [{public_keys, [[{id,k1},{created,50},{superseded_at,80},{value,KM}]]}], envelope:verify_signature(Env, SupAS) =:= {error,no_active_key}\") :name)")
;; key superseded AFTER published -> ok (historical valid)
(epoch 15)
(eval "(get (erlang-eval-ast \"${PRELUDE} SupAS2 = [{public_keys, [[{id,k1},{created,50},{superseded_at,200},{value,KM}]]}], envelope:verify_signature(Env, SupAS2) =:= ok\") :name)")
;; key not yet created at published -> no_active_key
(epoch 16)
(eval "(get (erlang-eval-ast \"${PRELUDE} FutAS = [{public_keys, [[{id,k1},{created,150},{value,KM}]]}], envelope:verify_signature(Env, FutAS) =:= {error,no_active_key}\") :name)")
;; missing signature field -> no_signature
(epoch 17)
(eval "(get (erlang-eval-ast \"${PRELUDE} envelope:verify_signature(U, AS) =:= {error,no_signature}\") :name)")
;; actor state with no public_keys field -> no_keys
(epoch 18)
(eval "(get (erlang-eval-ast \"${PRELUDE} envelope:verify_signature(Env, []) =:= {error,no_keys}\") :name)")
;; second key in list matches when first doesn't (lookup walks list)
(epoch 19)
(eval "(get (erlang-eval-ast \"${PRELUDE} TwoKeys = [{public_keys, [[{id,k_other},{created,50},{value,<<9,9,9>>}], [{id,k1},{created,50},{value,KM}]]}], envelope:verify_signature(Env, TwoKeys) =:= 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 "module load name" "envelope"
check 10 "valid sig active key" "true"
check 11 "tampered envelope" "true"
check 12 "wrong sig value" "true"
check 13 "unknown key_id" "true"
check 14 "key superseded before published" "true"
check 15 "key superseded after published" "true"
check 16 "key not yet created" "true"
check 17 "missing signature field" "true"
check 18 "actor state no keys" "true"
check 19 "match second key in list" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/envelope_sig.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,137 +0,0 @@
#!/usr/bin/env bash
# next/tests/follow_lifecycle.sh — m2 Step 6b test.
#
# Ties Step 5 (POST /actors/<id>/inbox real ingestion) to Step 6a
# (follower_graph projection) via Cfg :inbox_projections. The
# inbox handler casts every successfully-ingested activity into
# each named projection — the follower_graph state mutates as
# Follow / Accept / Reject / Undo activities land.
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
# Alice is on this kernel (target). Bob is the peer (signs activities
# with BobKS). PeerAS = Bob's actor-state (Bob's public_keys). The
# :inbox_projections wires inbound to the followers projection so
# follower_graph state advances on every successful ingestion.
SETUP='AK = <<1,2,3,4>>, AKS = [{key_id,k1},{algorithm,ed25519},{value,AK}], AAS = [{public_keys,[[{id,k1},{created,0},{value,AK}]]}], BK = <<5,6,7,8>>, BKS = [{key_id,k1},{algorithm,ed25519},{value,BK}], BAS = [{public_keys,[[{id,k1},{created,0},{value,BK}]]}], FollowReq = [{actor, bob}, {type, follow}, {object, alice}, {published, 1}], FollowEnv = outbox:construct(follow, bob, 1, alice), SignedFollow = outbox:sign(FollowEnv, BKS), Body = term_codec:encode(SignedFollow), nx_kernel:start_link(alice, AKS, AAS), projection:start_link(followers, follower_graph:new(), follower_graph:fold_fn()), Cfg = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}, {inbox_projections, [followers]}], InboxPath = <<47,97,99,116,111,114,115,47,97,108,105,99,101,47,105,110,98,111,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 "(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/log.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
(epoch 7)
(eval "(get (erlang-load-module (file-read \"next/kernel/projection.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/nx_kernel.erl\")) :name)")
(epoch 9)
(eval "(get (erlang-load-module (file-read \"next/kernel/term_codec.erl\")) :name)")
(epoch 10)
(eval "(get (erlang-load-module (file-read \"next/kernel/follower_graph.erl\")) :name)")
(epoch 11)
(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
;; Follow peer -> 202 from inbox handler
(epoch 20)
(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], case http_server:route(Req, Cfg) of [{status, 202}, _, _] -> true; _ -> false end\") :name)")
;; After Follow: follower_graph state shows alice with pending_inbound = [bob]
(epoch 21)
(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {object, alice}, {body, Body}], http_server:route(Req, Cfg), follower_graph:pending_inbound(alice, projection:query(followers)) =:= [bob]\") :name)")
;; And bob has pending_outbound = [alice]
(epoch 22)
(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, Cfg), follower_graph:pending_outbound(bob, projection:query(followers)) =:= [alice]\") :name)")
;; Inbox tip advanced even without auto-Accept (separate concern)
(epoch 23)
(eval "(erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, Cfg), nx_kernel:inbox_tip_for(alice)\")")
;; No :inbox_projections in Cfg: projection state stays empty
(epoch 24)
(eval "(get (erlang-eval-ast \"${SETUP} BareCfg = [{peer_as, [{bob, BAS}]}, {kernel, nx_kernel}], Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, BareCfg), follower_graph:pending_inbound(alice, projection:query(followers)) =:= []\") :name)")
;; Follow + Accept end-to-end: bob -> alice (Follow), alice -> bob (Accept via outbox).
;; v2 only has the inbox side wired; the Accept is built locally in the test and
;; folded through the same projection to demonstrate that the projection state
;; converges. Auto-Accept publish lands in 6c.
(epoch 25)
(eval "(get (erlang-eval-ast \"${SETUP} Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, Cfg), AcceptAct = [{actor, alice}, {type, accept}, {object, [{actor, bob}, {type, follow}, {object, alice}]}], projection:async_fold(followers, AcceptAct), S = projection:query(followers), follower_graph:followers(alice, S) =:= [bob] andalso follower_graph:following(bob, S) =:= [alice]\") :name)")
;; Inbox handler with bad sig fails BEFORE projection broadcast
(epoch 26)
(eval "(get (erlang-eval-ast \"AK = <<1,2,3,4>>, AKS = [{key_id,k1},{algorithm,ed25519},{value,AK}], AAS = [{public_keys,[[{id,k1},{created,0},{value,AK}]]}], EvilK = <<9,9,9,9>>, EvilAS = [{public_keys,[[{id,k1},{created,0},{value,EvilK}]]}], BK = <<5,6,7,8>>, BKS = [{key_id,k1},{algorithm,ed25519},{value,BK}], FollowEnv = outbox:construct(follow, bob, 1, alice), SignedFollow = outbox:sign(FollowEnv, BKS), Body = term_codec:encode(SignedFollow), nx_kernel:start_link(alice, AKS, AAS), projection:start_link(followers, follower_graph:new(), follower_graph:fold_fn()), EvilCfg = [{peer_as, [{bob, EvilAS}]}, {kernel, nx_kernel}, {inbox_projections, [followers]}], InboxPath = <<47,97,99,116,111,114,115,47,97,108,105,99,101,47,105,110,98,111,120>>, Req = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], http_server:route(Req, EvilCfg), follower_graph:actors(projection:query(followers)) =:= []\") :name)")
;; Multiple distinct peer Follows accumulate
(epoch 27)
(eval "(get (erlang-eval-ast \"${SETUP} CK = <<9,9,9,9>>, CKS = [{key_id,k1},{algorithm,ed25519},{value,CK}], CAS = [{public_keys,[[{id,k1},{created,0},{value,CK}]]}], MultiCfg = [{peer_as, [{bob, BAS}, {carol, CAS}]}, {kernel, nx_kernel}, {inbox_projections, [followers]}], CarolEnv = outbox:construct(follow, carol, 1, alice), CarolSigned = outbox:sign(CarolEnv, CKS), CarolBody = term_codec:encode(CarolSigned), Req1 = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, Body}], Req2 = [{method, <<80,79,83,84>>}, {path, InboxPath}, {headers, []}, {body, CarolBody}], http_server:route(Req1, MultiCfg), http_server:route(Req2, MultiCfg), follower_graph:pending_inbound(alice, projection:query(followers)) =:= [bob, carol]\") :name)")
EPOCHS
OUTPUT=$(timeout 900 "$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 11 "http_server module loaded" "http_server"
check 20 "Follow ingestion -> 202" "true"
check 21 "alice.pending_inbound = [bob]" "true"
check 22 "bob.pending_outbound = [alice]" "true"
check 23 "inbox tip advances to 1" "1"
check 24 "no inbox_projections -> no fold" "true"
check 25 "Follow + Accept projection state" "true"
check 26 "bad sig doesn't pollute projection" "true"
check 27 "two distinct peer Follows accumulate" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/follow_lifecycle.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,159 +0,0 @@
#!/usr/bin/env bash
# next/tests/follower_graph.sh — m2 Step 6a test.
#
# Pure projection fold over Follow / Accept / Reject / Undo
# activities per design §13.2. State tracks per-actor
# {following, followers, pending_outbound, pending_inbound} lists.
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
# F(A→B) is the embedded Follow object Accept / Reject / Undo wrap.
SETUP='F = [{type, follow}, {actor, alice}, {object, bob}], Follow = [{actor, alice}, {type, follow}, {object, bob}], Accept = [{actor, bob}, {type, accept}, {object, F}], Reject = [{actor, bob}, {type, reject}, {object, F}], Undo = [{actor, alice}, {type, undo}, {object, F}],'
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/follower_graph.erl\")) :name)")
;; new/0 -> []
(epoch 10)
(eval "(get (erlang-eval-ast \"follower_graph:new() =:= []\") :name)")
;; Follow alice->bob: alice has pending_outbound = [bob]; bob pending_inbound = [alice]
(epoch 11)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Follow, follower_graph:new()), follower_graph:pending_outbound(alice, S) =:= [bob] andalso follower_graph:pending_inbound(bob, S) =:= [alice]\") :name)")
;; After Follow alone, neither party shows the other as following/follower
(epoch 12)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Follow, follower_graph:new()), follower_graph:following(alice, S) =:= [] andalso follower_graph:followers(bob, S) =:= []\") :name)")
;; Accept: alice moves into bob's followers; bob moves into alice's following
(epoch 13)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Follow, follower_graph:new()), S1 = follower_graph:fold(Accept, S), follower_graph:followers(bob, S1) =:= [alice] andalso follower_graph:following(alice, S1) =:= [bob]\") :name)")
;; Accept: both pending lists cleared on each side
(epoch 14)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Follow, follower_graph:new()), S1 = follower_graph:fold(Accept, S), follower_graph:pending_outbound(alice, S1) =:= [] andalso follower_graph:pending_inbound(bob, S1) =:= []\") :name)")
;; Reject: pending lists clear without populating following/followers
(epoch 15)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Follow, follower_graph:new()), S1 = follower_graph:fold(Reject, S), follower_graph:pending_outbound(alice, S1) =:= [] andalso follower_graph:pending_inbound(bob, S1) =:= [] andalso follower_graph:following(alice, S1) =:= [] andalso follower_graph:followers(bob, S1) =:= []\") :name)")
;; Undo by alice after accept: drops both following and followers
(epoch 16)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Follow, follower_graph:new()), S1 = follower_graph:fold(Accept, S), S2 = follower_graph:fold(Undo, S1), follower_graph:following(alice, S2) =:= [] andalso follower_graph:followers(bob, S2) =:= []\") :name)")
;; Undo before accept: pending lists clear
(epoch 17)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Follow, follower_graph:new()), S1 = follower_graph:fold(Undo, S), follower_graph:pending_outbound(alice, S1) =:= [] andalso follower_graph:pending_inbound(bob, S1) =:= []\") :name)")
;; Self-follow ignored (alice follows alice no-ops)
(epoch 18)
(eval "(get (erlang-eval-ast \"SelfFollow = [{actor, alice}, {type, follow}, {object, alice}], S = follower_graph:fold(SelfFollow, follower_graph:new()), follower_graph:new() =:= S\") :name)")
;; Two distinct follows: alice->bob, carol->bob produce two pending_inbound entries on bob
(epoch 19)
(eval "(get (erlang-eval-ast \"${SETUP} F2 = [{actor, carol}, {type, follow}, {object, bob}], S = follower_graph:fold(Follow, follower_graph:new()), S1 = follower_graph:fold(F2, S), follower_graph:pending_inbound(bob, S1) =:= [alice, carol]\") :name)")
;; Duplicate Follow is idempotent (no double-add)
(epoch 20)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Follow, follower_graph:new()), S1 = follower_graph:fold(Follow, S), follower_graph:pending_outbound(alice, S1) =:= [bob]\") :name)")
;; Predicates: is_following / has_follower / pendings after accept
(epoch 21)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Accept, follower_graph:fold(Follow, follower_graph:new())), {follower_graph:is_following(alice, bob, S), follower_graph:has_follower(bob, alice, S), follower_graph:is_pending_outbound(alice, bob, S), follower_graph:is_pending_inbound(bob, alice, S)} =:= {true, true, false, false}\") :name)")
;; actors/1 lists every actor seen (alice + bob after one Follow,
;; in insertion order: alice's bucket added first, then bob's)
(epoch 22)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Follow, follower_graph:new()), follower_graph:actors(S) =:= [alice, bob]\") :name)")
;; fold_fn/0 is a 2-arity Erlang fun (plugs into projection:start_link)
(epoch 23)
(eval "(get (erlang-eval-ast \"is_function(follower_graph:fold_fn(), 2)\") :name)")
;; Activity sans :type passes through
(epoch 24)
(eval "(get (erlang-eval-ast \"Garbage = [{actor, alice}], follower_graph:fold(Garbage, follower_graph:new()) =:= []\") :name)")
;; Accept whose embedded :object isn't a Follow passes through
(epoch 25)
(eval "(get (erlang-eval-ast \"BadAccept = [{actor, bob}, {type, accept}, {object, [{type, note}, {actor, alice}, {object, bob}]}], follower_graph:fold(BadAccept, follower_graph:new()) =:= []\") :name)")
;; Undo by the wrong actor (carol trying to undo F where A=alice) is a no-op
(epoch 26)
(eval "(get (erlang-eval-ast \"${SETUP} S = follower_graph:fold(Accept, follower_graph:fold(Follow, follower_graph:new())), BadUndo = [{actor, carol}, {type, undo}, {object, F}], S1 = follower_graph:fold(BadUndo, S), follower_graph:following(alice, S1) =:= [bob]\") :name)")
EPOCHS
OUTPUT=$(timeout 240 "$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 3 "follower_graph module loaded" "follower_graph"
check 10 "new/0 -> []" "true"
check 11 "Follow sets pendings each side" "true"
check 12 "Follow alone: no following/follower" "true"
check 13 "Accept promotes to following/followers" "true"
check 14 "Accept clears pendings" "true"
check 15 "Reject clears without promote" "true"
check 16 "Undo after accept drops rel" "true"
check 17 "Undo before accept clears pending" "true"
check 18 "self-follow is a no-op" "true"
check 19 "two follows -> two pending_inbound" "true"
check 20 "duplicate Follow idempotent" "true"
check 21 "predicates after accept" "true"
check 22 "actors/1 lists every seen" "true"
check 23 "fold_fn/0 is fun/2" "true"
check 24 "untyped activity passes through" "true"
check 25 "Accept of non-Follow passes through" "true"
check 26 "Undo by wrong actor no-op" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/follower_graph.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

Some files were not shown because too many files have changed in this diff Show More