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
185 changed files with 1187 additions and 24104 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

@@ -1,91 +0,0 @@
# flow-on-erlang — durable workflows in the fed-sx runtime
A native Erlang-on-SX port of the Scheme flow engine (`lib/flow`), so
the fed-sx kernel can fan arriving activities out into durable,
branching, multi-step business flows **in its own runtime** — no
cross-guest FFI, no marshalling, no Scheme dependency. The seed of a
real engine that can later supersede the Scheme one for substrate use.
Run the suite: `bash next/flow/conformance.sh` → engine conformance.
## Model
A **flow** is an Erlang `fun(Ctx) -> Ctx`. Combinators (`flow_spec`)
compose flows; user code stays value-level (the functions you hand to
`flow_node`/`branch`/… take and return plain values). A flow that
ignores its input is a thunk; composition *is* function composition.
```erlang
F = flow_spec:sequence([
flow_spec:flow_node(fun(Draft) -> Draft + 1 end),
flow_spec:branch(fun(P) -> P >= 3 end,
flow_spec:flow_const(ok),
flow_spec:flow_const(rejected))]),
flow:run(F, 2) %% => {flow_done, ok}
```
## Durability — deterministic replay
Same semantics as the Scheme engine: a flow re-runs from the top on
every resume; effects/non-determinism go through `flow:suspend/1`,
whose resolved values are logged; an already-resolved suspend replays
its logged value, and the first unresolved suspend short-circuits back
to the driver. The persisted state is the **replay log** — plain
`[{Tag, Value}]` data — so nothing live (no continuation, no process)
is ever serialized; an instance survives restart by re-driving its
named flow against its log.
```erlang
flow_store:register_flow(publish, F),
{ok, Id, R} = flow_store:start(publish, Draft), %% R = {flow_suspended, Tag} | {flow_done, V}
%% ... driver performs the effect for Tag, then:
flow_store:resume(Id, EffectResult) %% re-drives; completes or suspends again
```
## Why railway threading instead of call/cc + a global
The Scheme engine uses an escape-only `call/cc` plus a mutable global
replay log. This Erlang-on-SX runtime can't do either, and has a third
sharp edge:
- **No re-enterable continuation** — but suspend only needs to *escape*,
which Erlang `throw` could do …
- **… except a blocking `receive` / `gen_server:call` inside a `try`
deadlocks** the cooperative scheduler. So `suspend` must not consult
the log via a registry process while inside a `try`.
- **No process dictionary** — so there is no ambient per-process slot to
stash the replay log in.
The resolution: thread the replay log through a railway-style **context**
and make `suspend` *short-circuit* (like a `fail` value) rather than
throw. No ambient state, no throw, no gen_server in the hot path —
purely functional, which sidesteps all three constraints. The driver
(`flow_store`) is the only stateful part, and it calls the pure
`flow:drive/3` from inside `handle_call`, never wrapping a blocking
receive.
A `Ctx` is `{flow_cont, Value, Log}` (running) or `{flow_susp, Tag,
Log}` (short-circuited); every combinator passes a suspended context
straight through.
## Modules
| Module | Role |
|---|---|
| `flow.erl` | pure replay driver: `drive/3`, `run/2`, `suspend/1`, the `Ctx` constructors/accessors |
| `flow_spec.erl` | combinator algebra: leaves, `sequence`/`parallel`/`map_flow`, `flow_while`/`flow_until`, `branch`, railway `fail`/`recover`/`attempt`, `tap`, `try_catch`/`retry` |
| `flow_store.erl` | durable gen_server: named-flow registry + instance table + `start`/`resume`/`status` |
## Consumed by
The fed-sx kernel's trigger fan-out (`pipeline.erl` + `flow_dispatch`)
starts named flows from arriving activities; see
`plans/fed-sx-host-types.md` and the triggers phases.
## Not yet (later layers)
- Persisting instance logs to the kernel's durable on-disk log (the
data shape is already restart-ready; only the backing is in-memory).
- `parallel` with multiple independent suspends resolving concurrently
(current `parallel` is sequential under one shared log).
- Full parity with the Scheme engine's distributed/remote nodes.

View File

@@ -1,206 +0,0 @@
#!/usr/bin/env bash
# next/flow/conformance.sh — flow-on-erlang engine conformance.
#
# Exercises the native Erlang-on-SX durable workflow engine
# (next/flow/{flow,flow_spec,flow_store}.erl): the combinator algebra,
# the deterministic-replay suspend/resume core, and the durable store.
# This is the gate for the engine, replacing lib/flow/conformance.sh
# (the Scheme engine) for the fed-sx substrate — the kernel's trigger
# fan-out drives flows in its own runtime, with no cross-guest FFI.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
# Common combinator shorthands built per-epoch (Erlang locals don't
# survive across erlang-eval-ast calls; the gen_server state does).
N1='flow_spec:flow_node(fun(X) -> X + 1 end)'
N2='flow_spec:flow_node(fun(X) -> X * 2 end)'
SUSP_FLOW='flow_spec:sequence([flow_spec:flow_node(fun(X) -> X + 1 end), flow:suspend(wait1), flow_spec:flow_node(fun(V) -> {resumed, V} end)])'
TWO_SUSP='flow_spec:sequence([flow:suspend(a), flow_spec:flow_node(fun(V) -> V * 10 end), flow:suspend(b), flow_spec:flow_node(fun(V) -> V + 1 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/flow/flow.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/flow/flow_spec.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/flow/flow_store.erl\")) :name)")
;; ── leaves ─────────────────────────────────────────────────
(epoch 10)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:flow_id(), 7) =:= {flow_done, 7}\") :name)")
(epoch 11)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:flow_const(k), 7) =:= {flow_done, k}\") :name)")
(epoch 12)
(eval "(get (erlang-eval-ast \"flow:run(${N1}, 41) =:= {flow_done, 42}\") :name)")
;; ── threading / fan-out / iteration ────────────────────────
(epoch 20)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:sequence([${N1}, ${N2}]), 3) =:= {flow_done, 8}\") :name)")
(epoch 21)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:parallel([flow_spec:flow_const(a), flow_spec:flow_const(b)]), 0) =:= {flow_done, [a, b]}\") :name)")
(epoch 22)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:map_flow(${N1}), [1, 2, 3]) =:= {flow_done, [2, 3, 4]}\") :name)")
(epoch 23)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:flow_while(fun(X) -> X < 10 end, ${N1}, 100), 0) =:= {flow_done, 10}\") :name)")
(epoch 24)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:flow_until(fun(X) -> X >= 5 end, ${N1}, 100), 0) =:= {flow_done, 5}\") :name)")
(epoch 25)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:flow_while(fun(_) -> true end, ${N1}, 3), 0) =:= {flow_done, 3}\") :name)")
;; ── branching ──────────────────────────────────────────────
(epoch 30)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:branch(fun(X) -> X > 0 end, flow_spec:flow_const(pos), flow_spec:flow_const(neg)), 5) =:= {flow_done, pos}\") :name)")
(epoch 31)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:branch(fun(X) -> X > 0 end, flow_spec:flow_const(pos), flow_spec:flow_const(neg)), -5) =:= {flow_done, neg}\") :name)")
;; ── railway failure ────────────────────────────────────────
(epoch 40)
(eval "(get (erlang-eval-ast \"flow_spec:failed(flow_spec:fail(x)) andalso (flow_spec:failed(42) =:= false)\") :name)")
(epoch 41)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:attempt([flow_spec:flow_node(fun(_) -> flow_spec:fail(boom) end), flow_spec:flow_node(fun(_) -> 999 end)]), 0) =:= {flow_done, {flow_fail, boom}}\") :name)")
(epoch 42)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:attempt([${N1}, ${N2}]), 3) =:= {flow_done, 8}\") :name)")
(epoch 43)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:recover(flow_spec:flow_node(fun(_) -> flow_spec:fail(bad) end), fun(R) -> {ok, R} end), 0) =:= {flow_done, {ok, bad}}\") :name)")
;; ── effects / exceptions ───────────────────────────────────
(epoch 50)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:tap(fun(_) -> ok end), 7) =:= {flow_done, 7}\") :name)")
(epoch 51)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:try_catch(flow_spec:flow_node(fun(_) -> throw(oops) end), fun(E) -> {caught, E} end), 0) =:= {flow_done, {caught, oops}}\") :name)")
(epoch 52)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:retry(5, flow_spec:flow_node(fun(X) -> X + 1 end)), 1) =:= {flow_done, 2}\") :name)")
;; ── suspend / replay (deterministic-replay core) ───────────
(epoch 60)
(eval "(get (erlang-eval-ast \"flow:run(${SUSP_FLOW}, 0) =:= {flow_suspended, wait1}\") :name)")
(epoch 61)
(eval "(get (erlang-eval-ast \"flow:drive(${SUSP_FLOW}, 0, [{wait1, 99}]) =:= {flow_done, {resumed, 99}}\") :name)")
(epoch 62)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:sequence([flow:suspend(a), flow:suspend(b)]), 0) =:= {flow_suspended, a}\") :name)")
;; wait/1 — timer-style suspend that PRESERVES the value on resume
(epoch 63)
(eval "(get (erlang-eval-ast \"flow:run(flow_spec:sequence([flow:wait(t), flow_spec:flow_node(fun(X) -> X + 1 end)]), 5) =:= {flow_suspended, t}\") :name)")
(epoch 64)
(eval "(get (erlang-eval-ast \"flow:drive(flow_spec:sequence([flow:wait(t), flow_spec:flow_node(fun(X) -> X + 1 end)]), 5, [{t, ignored}]) =:= {flow_done, 6}\") :name)")
;; ── durable store: registry ────────────────────────────────
(epoch 70)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:register_flow(f1, ${N1}), flow_store:resolve_flow(f1) =/= not_found andalso flow_store:registered_flows() =:= [f1]\") :name)")
(epoch 71)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:resolve_flow(ghost) =:= not_found\") :name)")
;; ── durable store: start / resume ──────────────────────────
;; one-shot flow runs to completion on start
(epoch 80)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:register_flow(done1, ${N1}), flow_store:start(done1, 41) =:= {ok, 1, {flow_done, 42}}\") :name)")
;; suspending flow: start suspends, resume completes
(epoch 81)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:register_flow(s1, ${SUSP_FLOW}), {ok, Id, R} = flow_store:start(s1, 10), R =:= {flow_suspended, wait1} andalso flow_store:status(Id) =:= {ok, {suspended, wait1}}\") :name)")
(epoch 82)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:register_flow(s1, ${SUSP_FLOW}), {ok, Id, _} = flow_store:start(s1, 10), flow_store:resume(Id, 99) =:= {ok, {flow_done, {resumed, 99}}}\") :name)")
(epoch 83)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:register_flow(s1, ${SUSP_FLOW}), {ok, Id, _} = flow_store:start(s1, 10), flow_store:resume(Id, 99), flow_store:status(Id) =:= {ok, {done, {resumed, 99}}}\") :name)")
;; two-suspend flow: resume chain accumulates the replay log
(epoch 84)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:register_flow(s2, ${TWO_SUSP}), {ok, Id, _} = flow_store:start(s2, 0), {ok, R1} = flow_store:resume(Id, 5), R2 = flow_store:resume(Id, 7), R1 =:= {flow_suspended, b} andalso R2 =:= {ok, {flow_done, 8}}\") :name)")
;; error paths
(epoch 85)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:start(ghost, 0) =:= {error, no_such_flow}\") :name)")
(epoch 86)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:resume(999, x) =:= {error, no_such_instance}\") :name)")
(epoch 87)
(eval "(get (erlang-eval-ast \"flow_store:start_link(), flow_store:register_flow(done1, ${N1}), {ok, Id, _} = flow_store:start(done1, 0), flow_store:resume(Id, x) =:= {error, already_done}\") :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 3 "flow module loaded" "flow"
check 4 "flow_spec module loaded" "flow_spec"
check 5 "flow_store module loaded" "flow_store"
check 10 "flow_id" "true"
check 11 "flow_const" "true"
check 12 "flow_node" "true"
check 20 "sequence threads left-to-right" "true"
check 21 "parallel fans out" "true"
check 22 "map_flow over a list" "true"
check 23 "flow_while bounded by pred" "true"
check 24 "flow_until bounded by pred" "true"
check 25 "flow_while bounded by max" "true"
check 30 "branch then-arm" "true"
check 31 "branch else-arm" "true"
check 40 "failed? predicate" "true"
check 41 "attempt stops at first fail" "true"
check 42 "attempt threads on success" "true"
check 43 "recover handles fail value" "true"
check 50 "tap pass-through" "true"
check 51 "try_catch catches a raise" "true"
check 52 "retry runs node" "true"
check 60 "suspend miss short-circuits" "true"
check 61 "suspend replay completes" "true"
check 62 "first of two suspends wins" "true"
check 63 "wait short-circuits on miss" "true"
check 64 "wait preserves value on resume" "true"
check 70 "register + resolve + list" "true"
check 71 "resolve unknown -> not_found" "true"
check 80 "start one-shot -> done" "true"
check 81 "start suspends + status" "true"
check 82 "resume completes" "true"
check 83 "status after resume = done" "true"
check 84 "two-suspend resume chain" "true"
check 85 "start unknown -> no_such_flow" "true"
check 86 "resume unknown -> no_such_instance" "true"
check 87 "resume a done flow -> already_done" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL flow-on-erlang engine tests passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,102 +0,0 @@
-module(flow).
-export([drive/3, run/2,
cont/2, susp/2, is_susp/1, ctx_value/1, ctx_log/1,
suspend/1, wait/1, log_lookup/2]).
%% flow-on-erlang — the deterministic-replay core. A native Erlang port
%% of the Scheme flow engine (lib/flow), so the fed-sx kernel can fan
%% activities out into durable business flows in its own runtime (no
%% cross-guest FFI).
%%
%% Durability model — identical semantics to the Scheme engine, but
%% adapted to this Erlang-on-SX runtime, which has three hard
%% constraints the Scheme host doesn't: no escape continuation that can
%% be re-entered, no process dictionary, and (critically) a blocking
%% `receive` / `gen_server:call` inside a `try` deadlocks the
%% cooperative scheduler. So instead of the Scheme engine's
%% mutable-global + call/cc-escape, the replay log is THREADED through a
%% railway-style context and `suspend` SHORT-CIRCUITS (like a fail
%% value) rather than throwing. No ambient state, no throw, no
%% gen_server — purely functional, which sidesteps every constraint.
%%
%% A node is `fun(Ctx) -> Ctx`. A Ctx is one of:
%% {flow_cont, Value, Log} — running; Value is the current value
%% {flow_susp, Tag, Log} — short-circuited at suspend Tag
%% Log is the replay log: [{Tag, ResolvedValue}, ...]. Combinators
%% (flow_spec) thread Ctx and pass {flow_susp,...} straight through, so
%% once a flow suspends nothing downstream runs.
%%
%% suspend/1 is the load-bearing primitive: a node that, given the
%% running Ctx, looks Tag up in the replay log. A hit replaces the
%% current value with the logged value and continues; a miss
%% short-circuits to {flow_susp, Tag, Log}. ALL effects/non-determinism
%% go through a suspend node so they run once — in the driver, between
%% drives — and their results are logged, never re-run on replay. Tags
%% must be unique and deterministic across replays.
%% ── context constructors / accessors ────────────────────────────
cont(Value, Log) -> {flow_cont, Value, Log}.
susp(Tag, Log) -> {flow_susp, Tag, Log}.
is_susp({flow_susp, _, _}) -> true;
is_susp(_) -> false.
ctx_value({flow_cont, Value, _}) -> Value;
ctx_value({flow_susp, _, _}) -> undefined.
ctx_log({flow_cont, _, Log}) -> Log;
ctx_log({flow_susp, _, Log}) -> Log.
%% ── suspend node ────────────────────────────────────────────────
suspend(Tag) ->
fun (Ctx) ->
case Ctx of
{flow_susp, _, _} -> Ctx;
{flow_cont, _Value, Log} ->
case log_lookup(Tag, Log) of
{ok, Resolved} -> {flow_cont, Resolved, Log};
miss -> {flow_susp, Tag, Log}
end
end
end.
%% wait(Tag) — a timer-style suspend that PRESERVES the current value
%% instead of replacing it with the resolved one. Use it for pure
%% waits ("resume in the morning") where the resume is just a signal,
%% not a result: on the first pass it short-circuits like suspend; once
%% Tag is in the log the value flows through unchanged, so downstream
%% steps still see the value (e.g. the env) they had before the wait.
wait(Tag) ->
fun (Ctx) ->
case Ctx of
{flow_susp, _, _} -> Ctx;
{flow_cont, Value, Log} ->
case log_lookup(Tag, Log) of
{ok, _} -> {flow_cont, Value, Log};
miss -> {flow_susp, Tag, Log}
end
end
end.
log_lookup(_, []) -> miss;
log_lookup(Tag, [{Tag, Value} | _]) -> {ok, Value};
log_lookup(Tag, [_ | Rest]) -> log_lookup(Tag, Rest).
%% ── driver ──────────────────────────────────────────────────────
%% drive(Flow, Input, Log) — run Flow under the replay Log.
%% {flow_done, Result} — flow completed
%% {flow_suspended, Tag} — flow short-circuited at an unresolved
%% suspend; the driver resolves Tag, appends
%% {Tag, Value} to Log, and re-drives.
drive(Flow, Input, Log) ->
case Flow({flow_cont, Input, Log}) of
{flow_cont, Result, _} -> {flow_done, Result};
{flow_susp, Tag, _} -> {flow_suspended, Tag}
end.
%% run(Flow, Input) — drive with an empty replay log.
run(Flow, Input) ->
drive(Flow, Input, []).

View File

@@ -1,240 +0,0 @@
-module(flow_spec).
-export([flow_node/1, flow_id/0, flow_const/1,
sequence/1, parallel/1, map_flow/1,
flow_while/3, flow_until/3,
branch/3, fail/1, failed/1, fail_reason/1,
recover/2, tap/1, attempt/1, try_catch/2, retry/2]).
%% flow-on-erlang combinators — a native port of lib/flow/spec.sx,
%% adapted to the railway-threaded context model in flow.erl. A node is
%% `fun(Ctx) -> Ctx`; every combinator passes a {flow_susp,...} context
%% straight through, so once a flow suspends nothing downstream runs.
%% User code stays value-level: the predicates/functions handed to
%% flow_node / branch / etc. take and return plain values, and the
%% combinator threads them into the context.
%%
%% Variadic Scheme forms (sequence, parallel, attempt) take an explicit
%% list here — the one idiom difference from the Scheme engine. Effects
%% must go through a flow:suspend/1 node so they run once (in the
%% driver) and replay from the log; `tap` is only for replay-safe
%% effects (e.g. tracing).
%% ── leaves ──────────────────────────────────────────────────────
%% flow_node(F) — lift a value function F :: Value -> Value into a node.
flow_node(F) ->
fun (Ctx) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false -> flow:cont(F(flow:ctx_value(Ctx)), flow:ctx_log(Ctx))
end
end.
flow_id() ->
fun (Ctx) -> Ctx end.
flow_const(V) ->
fun (Ctx) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false -> flow:cont(V, flow:ctx_log(Ctx))
end
end.
%% ── threading / fan-out / iteration ─────────────────────────────
%% sequence(Nodes) — thread the context left-to-right. Each node
%% self-guards on suspension, so a suspended context flows through
%% untouched.
sequence(Nodes) ->
fun (Ctx) -> seq_step(Nodes, Ctx) end.
seq_step([], Ctx) -> Ctx;
seq_step([N | Ns], Ctx) -> seq_step(Ns, N(Ctx)).
%% parallel(Nodes) — fan the input value to every node, join results
%% into a list (sequential evaluation under one shared replay log).
%% First child to suspend short-circuits the whole parallel.
parallel(Nodes) ->
fun (Ctx) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false -> par_step(Nodes, flow:ctx_value(Ctx), flow:ctx_log(Ctx), [])
end
end.
par_step([], _Input, Log, Acc) ->
flow:cont(lists:reverse(Acc), Log);
par_step([N | Ns], Input, Log, Acc) ->
R = N(flow:cont(Input, Log)),
case flow:is_susp(R) of
true -> R;
false -> par_step(Ns, Input, Log, [flow:ctx_value(R) | Acc])
end.
%% map_flow(Node) — run Node over each item of a list input value.
map_flow(Node) ->
fun (Ctx) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false -> map_step(Node, flow:ctx_value(Ctx), flow:ctx_log(Ctx), [])
end
end.
map_step(_, [], Log, Acc) ->
flow:cont(lists:reverse(Acc), Log);
map_step(Node, [I | Is], Log, Acc) ->
R = Node(flow:cont(I, Log)),
case flow:is_susp(R) of
true -> R;
false -> map_step(Node, Is, Log, [flow:ctx_value(R) | Acc])
end.
%% flow_while(Pred, Body, Max) — re-run Body (a node), threading the
%% context, while Pred(value) holds, up to Max steps. Pred :: Value ->
%% bool; Body :: node.
flow_while(Pred, Body, Max) ->
fun (Ctx) -> while_step(Pred, Body, Ctx, Max) end.
while_step(_, _, Ctx, N) when N =< 0 -> Ctx;
while_step(Pred, Body, Ctx, N) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false ->
case Pred(flow:ctx_value(Ctx)) of
true -> while_step(Pred, Body, Body(Ctx), N - 1);
_ -> Ctx
end
end.
%% flow_until(Pred, Body, Max) — re-run Body until Pred(value) holds.
flow_until(Pred, Body, Max) ->
fun (Ctx) -> until_step(Pred, Body, Ctx, Max) end.
until_step(_, _, Ctx, N) when N =< 0 -> Ctx;
until_step(Pred, Body, Ctx, N) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false ->
case Pred(flow:ctx_value(Ctx)) of
true -> Ctx;
_ -> until_step(Pred, Body, Body(Ctx), N - 1)
end
end.
%% ── branching ───────────────────────────────────────────────────
%% branch(Pred, Then, Else) — Pred :: Value -> bool; Then/Else :: node.
branch(Pred, Then, Else) ->
fun (Ctx) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false ->
case Pred(flow:ctx_value(Ctx)) of
true -> Then(Ctx);
_ -> Else(Ctx)
end
end
end.
%% ── railway-style failure (values, not exceptions) ──────────────
fail(Reason) -> {flow_fail, Reason}.
failed({flow_fail, _}) -> true;
failed(_) -> false.
fail_reason({flow_fail, R}) -> R.
%% recover(Node, Handler) — if Node yields a fail VALUE, run Handler on
%% the reason; else pass through. Handler :: Reason -> Value.
recover(Node, Handler) ->
fun (Ctx) ->
R = Node(Ctx),
case flow:is_susp(R) of
true -> R;
false ->
V = flow:ctx_value(R),
case failed(V) of
true -> flow:cont(Handler(fail_reason(V)), flow:ctx_log(R));
false -> R
end
end
end.
%% tap(Effect) — replay-safe side-effecting pass-through (returns the
%% input value unchanged). Effect :: Value -> any.
tap(Effect) ->
fun (Ctx) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false -> Effect(flow:ctx_value(Ctx)), Ctx
end
end.
%% attempt(Nodes) — railway sequence: thread left-to-right but stop at
%% the first node whose value is a fail, returning that failure.
attempt(Nodes) ->
fun (Ctx) -> attempt_step(Nodes, Ctx) end.
attempt_step([], Ctx) -> Ctx;
attempt_step([N | Ns], Ctx) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false ->
case failed(flow:ctx_value(Ctx)) of
true -> Ctx;
false -> attempt_step(Ns, N(Ctx))
end
end.
%% ── exception-style control ─────────────────────────────────────
%% Nodes are pure (effects go through suspend, run by the driver), so a
%% try around a node never wraps a blocking receive — safe in this
%% runtime.
%% try_catch(Node, Handler) — run Node; if it raises, run Handler on the
%% exception. Handler :: Exception -> Value.
try_catch(Node, Handler) ->
fun (Ctx) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false ->
Log = flow:ctx_log(Ctx),
try Node(Ctx) of
R -> R
catch
throw:E -> flow:cont(Handler(E), Log);
error:E -> flow:cont(Handler(E), Log);
exit:E -> flow:cont(Handler(E), Log)
end
end
end.
%% retry(N, Node) — run Node, retrying up to N attempts on a raise.
retry(N, Node) ->
fun (Ctx) -> retry_step(N, Node, Ctx) end.
retry_step(N, Node, Ctx) ->
case flow:is_susp(Ctx) of
true -> Ctx;
false ->
try Node(Ctx) of
R -> R
catch
throw:Reason -> retry_reraise(N, Node, Ctx, throw, Reason);
error:Reason -> retry_reraise(N, Node, Ctx, error, Reason);
exit:Reason -> retry_reraise(N, Node, Ctx, exit, Reason)
end
end.
retry_reraise(N, Node, Ctx, Class, Reason) ->
case N =< 1 of
false -> retry_step(N - 1, Node, Ctx);
true ->
case Class of
throw -> throw(Reason);
error -> erlang:error(Reason);
exit -> exit(Reason)
end
end.

View File

@@ -1,161 +0,0 @@
-module(flow_store).
-export([start_link/0, start_link/1, stop/0,
register_flow/2, resolve_flow/1, registered_flows/0,
start/2, resume/2, status/1, instances/0]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
-behaviour(gen_server).
%% flow-on-erlang durable store — the named-flow registry plus the
%% instance table that makes suspend/resume durable. flow.erl is the
%% pure replay driver; this gen_server is the stateful shell around it,
%% holding the registry (so triggers can reference flows by name, and
%% so an instance can be re-resolved + replayed after a restart) and
%% each instance's accumulated replay log.
%%
%% Crucially the driver stays OUT of any blocking context: start/resume
%% call flow:drive/3 (pure — no receive, no gen_server:call) from inside
%% handle_call, and the only message-passing is the caller's
%% gen_server:call into this store. (A blocking receive inside a `try`
%% deadlocks this cooperative scheduler, so the engine never does one.)
%%
%% State: {Registry, Instances, NextId}
%% Registry = [{Name, FlowFun}, ...]
%% Instances = [{Id, {Name, Input, Log, Status}}, ...]
%% Status = {suspended, Tag} | {done, Result}
%% Log = [{Tag, ResolvedValue}, ...] (the replay log — plain
%% data, so an instance is fully described by its log and
%% survives process restart by re-driving the named flow)
%%
%% v1 backs the store in gen_server memory; persisting the instance
%% logs to the kernel's durable log (so flows survive an OS restart) is
%% a later layer — the data shape is already restart-ready.
start_link() ->
start_link([]).
start_link(InitialFlows) ->
Pid = gen_server:start_link(flow_store, [InitialFlows]),
erlang:register(flow_store, Pid),
Pid.
stop() ->
R = gen_server:call(flow_store, '$gen_stop'),
erlang:unregister(flow_store),
R.
%% register_flow(Name, Flow) — register a named flow (a node fun). Named
%% rather than `register` to avoid the erlang:register/2 auto-import.
register_flow(Name, Flow) ->
gen_server:call(flow_store, {register_flow, Name, Flow}).
resolve_flow(Name) ->
gen_server:call(flow_store, {resolve_flow, Name}).
registered_flows() ->
gen_server:call(flow_store, registered_flows).
%% start(Name, Input) -> {ok, Id, Result} | {error, no_such_flow}.
%% Result is {flow_done, V} | {flow_suspended, Tag}; the instance is
%% recorded either way so a suspended flow can be resumed by Id.
start(Name, Input) ->
gen_server:call(flow_store, {start, Name, Input}).
%% resume(Id, Value) -> {ok, Result} | {error, Reason}. Resolves the
%% instance's current suspend tag with Value (appends {Tag, Value} to
%% its replay log) and re-drives from the top.
resume(Id, Value) ->
gen_server:call(flow_store, {resume, Id, Value}).
%% status(Id) -> {ok, {suspended, Tag}} | {ok, {done, Result}} | not_found
status(Id) ->
gen_server:call(flow_store, {status, Id}).
instances() ->
gen_server:call(flow_store, instances).
%% ── gen_server ──────────────────────────────────────────────────
init([InitialFlows]) ->
{ok, {InitialFlows, [], 1}}.
handle_call({register_flow, Name, Flow}, _From, {Reg, Ins, N}) ->
{reply, ok, {set_keyed(Name, Flow, Reg), Ins, N}};
handle_call({resolve_flow, Name}, _From, {Reg, Ins, N}) ->
{reply, find_keyed(Name, Reg), {Reg, Ins, N}};
handle_call(registered_flows, _From, {Reg, Ins, N}) ->
{reply, [Name || {Name, _} <- Reg], {Reg, Ins, N}};
handle_call({start, Name, Input}, _From, {Reg, Ins, N}) ->
case find_keyed(Name, Reg) of
not_found ->
{reply, {error, no_such_flow}, {Reg, Ins, N}};
{ok, Flow} ->
case safe_drive(Flow, Input, []) of
{ok, R} ->
Status = result_status(R),
Ins2 = set_keyed(N, {Name, Input, [], Status}, Ins),
{reply, {ok, N, R}, {Reg, Ins2, N + 1}};
{error, Crash} ->
{reply, {error, {flow_crashed, Crash}}, {Reg, Ins, N}}
end
end;
handle_call({resume, Id, Value}, _From, {Reg, Ins, N}) ->
case find_keyed(Id, Ins) of
not_found ->
{reply, {error, no_such_instance}, {Reg, Ins, N}};
{ok, {_Name, _Input, _Log, {done, _}}} ->
{reply, {error, already_done}, {Reg, Ins, N}};
{ok, {Name, Input, Log, {suspended, Tag}}} ->
case find_keyed(Name, Reg) of
not_found ->
{reply, {error, no_such_flow}, {Reg, Ins, N}};
{ok, Flow} ->
NewLog = log_append(Log, Tag, Value),
case safe_drive(Flow, Input, NewLog) of
{ok, R} ->
Status = result_status(R),
Ins2 = set_keyed(Id, {Name, Input, NewLog, Status}, Ins),
{reply, {ok, R}, {Reg, Ins2, N}};
{error, Crash} ->
{reply, {error, {flow_crashed, Crash}}, {Reg, Ins, N}}
end
end
end;
handle_call({status, Id}, _From, {Reg, Ins, N}) ->
case find_keyed(Id, Ins) of
{ok, {_Name, _Input, _Log, Status}} -> {reply, {ok, Status}, {Reg, Ins, N}};
not_found -> {reply, not_found, {Reg, Ins, N}}
end;
handle_call(instances, _From, {Reg, Ins, N}) ->
{reply, [Id || {Id, _} <- Ins], {Reg, Ins, N}}.
handle_cast(_, S) -> {noreply, S}.
handle_info(_, S) -> {noreply, S}.
%% ── helpers ─────────────────────────────────────────────────────
result_status({flow_done, R}) -> {done, R};
result_status({flow_suspended, T}) -> {suspended, T}.
%% safe_drive/3 — flow:drive is pure (no blocking receive), so a `try`
%% around it is safe in this runtime and isolates a flow whose step
%% raises: the store returns {error, {flow_crashed, _}} instead of the
%% gen_server crashing, keeping one bad flow from taking down others.
safe_drive(Flow, Input, Log) ->
try {ok, flow:drive(Flow, Input, Log)}
catch
throw:R -> {error, {throw, R}};
error:R -> {error, {error, R}};
exit:R -> {error, {exit, R}}
end.
log_append([], Tag, Value) -> [{Tag, Value}];
log_append([H | T], Tag, Value) -> [H | log_append(T, Tag, Value)].
find_keyed(_, []) -> 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,81 +0,0 @@
-module(blog_publish_digest).
-export([build/1]).
%% A motivating multi-step business flow for the fed-sx-triggers e2e:
%% when an Article is published, decide a batch policy by category,
%% (for newsletters) wait until morning, fetch the author's followers,
%% build a digest email for each, and emit a DigestSent activity — the
%% flow's own output, which a driver appends, closing the loop so it can
%% trigger downstream flows.
%%
%% Demonstrates: a branch on an activity field (:category), a timer
%% suspension (flow:wait/1, resumed by advancing the clock), an injected
%% effect (fetch_followers), and a follow-up activity emit.
%%
%% Effect-as-data: a flow runs inside flow_store's drive, where a
%% blocking call (e.g. into nx_kernel) would deadlock this scheduler, so
%% the flow does NOT perform IO itself. It DESCRIBES the effects in its
%% result — {digest_sent, Emails, DigestActivityObject} — and the driver
%% (the fan-out caller) dispatches the emails and appends the DigestSent
%% activity. fetch_followers is injected (the one external read) as a
%% pure function so the e2e can supply a deterministic list.
%%
%% Input env (from flow_dispatch): [{activity, A}, {actor, Actor}, ...].
%% Result: {digest_sent, [Email], DigestObject} | skipped.
build(Effects) ->
FetchFollowers = field(fetch_followers, Effects),
flow_spec:branch(
fun (Env) -> is_article(Env) end,
flow_spec:branch(
fun (Env) -> category_is(Env, newsletter) end,
%% newsletter: hold until morning, then send + emit
flow_spec:sequence([flow:wait(morning), send_emit(FetchFollowers)]),
flow_spec:branch(
fun (Env) -> category_is(Env, urgent) end,
%% urgent: send + emit now (no wait)
send_emit(FetchFollowers),
%% any other category: skip
flow_spec:flow_const(skipped))),
%% not an Article: skip
flow_spec:flow_const(skipped)).
%% send_emit(FetchFollowers) — the terminal step: build one digest email
%% per follower and the DigestSent emit object. Pure given the injected
%% follower list, so it is replay-safe (and it sits after the only
%% suspend point, so it runs exactly once).
send_emit(FetchFollowers) ->
flow_spec:flow_node(
fun (Env) ->
Activity = env_activity(Env),
Actor = env_actor(Env),
ArtId = activity_id(Activity),
Followers = FetchFollowers(Actor),
Emails = [ [{to, F}, {article, ArtId}] || F <- Followers ],
Digest = [{type, digest_sent},
{for, ArtId},
{follower_count, length(Followers)}],
{digest_sent, Emails, Digest}
end).
%% ── predicates / accessors ──────────────────────────────────────
is_article(Env) ->
object_type(object_of(env_activity(Env))) =:= article.
category_is(Env, Cat) ->
object_category(object_of(env_activity(Env))) =:= Cat.
env_activity(Env) -> field(activity, Env).
env_actor(Env) -> field(actor, Env).
object_of(Activity) -> field(object, Activity).
object_type(Obj) -> field(type, Obj).
object_category(Obj) -> field(category, Obj).
activity_id(Activity) -> field(id, Activity).
field(Key, Proplist) ->
case envelope:get_field(Key, Proplist) of
{ok, V} -> V;
_ -> undefined
end.

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,33 +0,0 @@
;; next/genesis/activity-types/define_trigger.sx
;;
;; Bootstrap definition of the DefineTrigger verb per
;; plans/agent-briefings/fed-sx-triggers-loop.md (Phase 1) and
;; plans/fed-sx-design.md §13. Read as data by the bundler
;; (bootstrap.erl) — never evaluated as code.
;;
;; DefineTrigger binds an activity-type to a flow. When a matching
;; activity is appended to the log, the kernel's trigger fan-out
;; (pipeline.erl, post-append) looks the type up in the trigger
;; registry and starts the named flow with the activity as input.
;; The activity's :object is the binding record:
;; {:activity-type "Create" ;; the verb to fire on
;; :flow-name "blog-publish-digest"
;; :guard <optional predicate> ;; discriminator
;; :actor-scope <optional actor id>} ;; default: any
;;
;; The schema validates the *activity* shape: :object present with
;; string :activity-type and :flow-name. The optional :guard lets one
;; type bind to multiple flows with discriminators; it is resolved to
;; an Erlang predicate at registration time (trigger_registry), not
;; carried in the pure-predicate schema here. Schema bodies use nested
;; `get` (not keyword-threading) so the predicate is evaluatable.
(DefineActivity
:name "DefineTrigger"
:doc "Bind an activity-type to a flow. :object carries :activity-type, :flow-name, and optional :guard and :actor-scope."
:schema (fn
(act)
(and
(not (nil? (get act :object)))
(string? (get (get act :object) :activity-type))
(string? (get (get act :object) :flow-name))))
:semantics (fn (state act) state))

View File

@@ -1,34 +0,0 @@
;; next/genesis/activity-types/define_type.sx
;;
;; Bootstrap definition of the DefineType verb per
;; plans/fed-sx-host-types.md (host-type federation, Phase 1).
;; Read as data by the bundler (bootstrap.erl) — never evaluated as
;; code. The :schema and :semantics bodies are SX source.
;;
;; DefineType declares a refinement type. The activity's :object is
;; the type record:
;; {:name "Post" ;; the type's display name
;; :fields (...) ;; optional field descriptors
;; :refinement-schema (fn (obj) ...) ;; predicate over instances
;; :instance-type "Note"} ;; base object-type it refines
;;
;; The schema below validates the *activity* shape: :object present,
;; :name a string, :fields (when present) a list. The richer
;; per-field shape check and the registry registration land with the
;; peer_types cache (Phase 2) — at this phase the form is pure data.
;;
;; Schema bodies use nested `get` rather than keyword-threading so
;; the predicate is directly evaluatable (keywords are not callable
;; getters in the kernel; `(-> d :k)` is not a get).
(DefineActivity
:name "DefineType"
:doc "Declare a refinement type. :object carries :name, optional :fields, :refinement-schema, and :instance-type."
:schema (fn
(act)
(and
(not (nil? (get act :object)))
(string? (get (get act :object) :name))
(or
(nil? (get (get act :object) :fields))
(list? (get (get act :object) :fields)))))
: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,31 +0,0 @@
;; next/genesis/activity-types/subtype_of.sx
;;
;; Bootstrap definition of the SubtypeOf verb per
;; plans/fed-sx-host-types.md (host-type federation, Phase 1).
;; Read as data by the bundler (bootstrap.erl) — never evaluated as
;; code. The :schema and :semantics bodies are SX source.
;;
;; SubtypeOf records a hierarchy edge between two previously-defined
;; types. The activity's :object is the relation record:
;; {:child-type-cid "bafy...child"
;; :parent-type-cid "bafy...parent"}
;;
;; The schema validates the *activity* shape: both CIDs present and
;; string-typed. Verifying that each CID names a previously-defined
;; type is a registry concern (it needs the type index that lands
;; with peer_types in Phase 2), so it is deliberately out of the
;; pure-predicate schema here — adding the edge to the hierarchy
;; index is the :semantics' job once the registry surface exists.
;;
;; Schema bodies use nested `get` rather than keyword-threading so
;; the predicate is directly evaluatable.
(DefineActivity
:name "SubtypeOf"
:doc "Record a subtype edge. :object carries :child-type-cid and :parent-type-cid, both type CIDs."
:schema (fn
(act)
(and
(not (nil? (get act :object)))
(string? (get (get act :object) :child-type-cid))
(string? (get (get act :object) :parent-type-cid))))
: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,54 +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"
"activity-types/define_type.sx"
"activity-types/subtype_of.sx"
"activity-types/define_trigger.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,118 +0,0 @@
-module(discovery_type_fetch).
-export([make_fetch_fn/0, make_fetch_fn/1,
fetch/2,
type_doc_url/2,
resolve_type_url/2,
accept_header/0]).
%% Live type-doc fetch for peer_types — host-type federation Step 3,
%% the sibling of discovery_fetch.erl. peer_types:lookup_or_fetch/3
%% calls a Cfg-supplied type_fetch_fn :: fun ((TypeCid, Cfg) -> {ok,
%% Bytes} | {error, _}) on a cache miss; this module produces that
%% closure for live federation. It GETs <base>/types/<cid> with an
%% Accept header that asks for the type-doc format (http_server.erl
%% Step 3) and returns the RAW response bytes — peer_types decodes
%% them via term_codec into the TypeRecord. (This is the one shape
%% difference from discovery_fetch, whose closure returns an already-
%% decoded actor-state: there the cache stores the decoded AS, here
%% peer_types owns the decode so the type-doc wire format lives in one
%% place — the /types/ route encodes, peer_types decodes.)
%%
%% Cfg shape (parallels discovery_fetch's peer URL resolution):
%% {type_url, [{TypeCid, BaseUrl}, ...]}
%% {type_url_fn, fun ((TypeCid) -> {ok, BaseUrl} | not_found)}
%%
%% BaseUrl shape: <<"http://host:port">> (no trailing slash; this
%% module appends the path). TypeCid is the type's CID bytes.
%%
%% Outcomes:
%% 2xx -> {ok, Bytes}
%% non-2xx -> {error, {status, N}}
%% resolver miss -> {error, no_type_url}
%% transport -> {error, Reason}
%% ── Accept header ────────────────────────────────────────────
%% "application/vnd.fed-sx.type-doc" — same MIME http_server's
%% content_type_for(type_doc) emits, so the Accept negotiation routes
%% the served bytes to the term_codec-encoded TypeRecord 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,
116,121,112,101,45,100,111,99>>.
%% ── public API ───────────────────────────────────────────────
%% make_fetch_fn/0 — the fun/2 peer_types:lookup_or_fetch calls. It
%% reads the type-URL resolver out of the Cfg passed at call time, so
%% the same Cfg threads through peer_types and this closure.
make_fetch_fn() ->
fun (TypeCid, Cfg) ->
case resolve_type_url(TypeCid, Cfg) of
{error, R} -> {error, R};
{ok, BaseUrl} -> fetch(type_doc_url(BaseUrl, TypeCid), Cfg)
end
end.
%% make_fetch_fn/1 — variant that closes over a static Cfg for the
%% resolver while still honouring the call-time Cfg for transport.
%% Lets a caller bake the type_url map once and reuse the closure.
make_fetch_fn(StaticCfg) ->
fun (TypeCid, Cfg) ->
case resolve_type_url(TypeCid, StaticCfg) of
{error, R} -> {error, R};
{ok, BaseUrl} -> fetch(type_doc_url(BaseUrl, TypeCid), 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 ->
{ok, Body};
{ok, Status, _H, _B} ->
{error, {status, Status}};
Other ->
{error, {bad_response, Other}}
catch
error:Reason -> {error, Reason}
end.
%% type_doc_url/2 — <BaseUrl>/types/<cid>. TypeCid is the cid bytes,
%% appended verbatim as the path segment (matches the "/types/" prefix
%% http_server.erl registers).
type_doc_url(BaseUrl, TypeCid) when is_binary(TypeCid) ->
%% "/types/" — 7 bytes
Prefix = <<47,116,121,112,101,115,47>>,
<<BaseUrl/binary, Prefix/binary, TypeCid/binary>>.
%% resolve_type_url/2 — map a TypeCid to its serving node's base URL.
%% type_url_fn (a 1-arity closure) takes precedence over the static
%% type_url proplist; absent both -> {error, no_type_url}.
resolve_type_url(TypeCid, Cfg) ->
case field(type_url_fn, Cfg) of
Fn when is_function(Fn, 1) ->
case Fn(TypeCid) of
{ok, BaseUrl} -> {ok, BaseUrl};
_ -> {error, no_type_url}
end;
_ ->
case field(type_url, Cfg) of
nil -> {error, no_type_url};
Map ->
case find_keyed(TypeCid, Map) of
{ok, BaseUrl} -> {ok, BaseUrl};
_ -> {error, no_type_url}
end
end
end.
%% ── helpers ──────────────────────────────────────────────────
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> nil.
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).

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,76 +0,0 @@
-module(flow_dispatch).
-export([start/4, guard_passes/3]).
%% Bridge from "an activity matched a trigger" to "a flow started with
%% that activity as input" (fed-sx-triggers Phase 3). A NATIVE call into
%% next/flow (flow_store) — the engine is Erlang-on-SX too, so there is
%% no cross-guest FFI: the kernel and the workflow engine share one
%% runtime.
%%
%% start(Spec, Activity, ActorState, Cfg)
%% -> {ok, FlowId, {ActivityCid, TriggerCid, FlowId}} (audit triple)
%% | {error, Reason}
%%
%% The flow named in Spec is started with the activity bound into its
%% input environment, so flow steps can read the activity, the actor id,
%% and the trigger cid (the audit chain). Flow-start failures — an
%% unknown flow name, or a crashing first step (flow_store isolates the
%% raise) — come back as {error, Reason}, never raised, so the fan-out
%% caller is insulated from one flow's failure.
start(Spec, Activity, ActorState, _Cfg) ->
FlowName = trigger_registry:spec_flow_name(Spec),
TriggerCid = trigger_registry:spec_cid(Spec),
ActivityCid = activity_cid(Activity),
Input = [{activity, Activity},
{actor, actor_id_of(ActorState, Activity)},
{trigger_cid, TriggerCid}],
case flow_store:start(FlowName, Input) of
{ok, FlowId, _Result} ->
{ok, FlowId, {ActivityCid, TriggerCid, FlowId}};
{error, Reason} ->
{error, Reason}
end.
%% guard_passes(Spec, Activity, ActorState) — a spec fires when its
%% actor-scope admits the activity's actor AND its guard (if any)
%% returns true. An `any` scope and an `undefined` guard always pass;
%% the guard lets one activity-type bind multiple flows with
%% discriminators.
guard_passes(Spec, Activity, ActorState) ->
scope_ok(trigger_registry:spec_actor_scope(Spec), Activity) andalso
guard_ok(trigger_registry:spec_guard(Spec), Activity, ActorState).
scope_ok(any, _Activity) -> true;
scope_ok(Scope, Activity) ->
case envelope:get_field(actor, Activity) of
{ok, Scope} -> true;
_ -> false
end.
guard_ok(undefined, _Activity, _ActorState) -> true;
guard_ok(Guard, Activity, ActorState) when is_function(Guard, 2) ->
Guard(Activity, ActorState);
guard_ok(_, _, _) -> false.
%% ── helpers ─────────────────────────────────────────────────────
activity_cid(Activity) ->
case envelope:get_field(id, Activity) of
{ok, Cid} -> Cid;
_ -> undefined
end.
%% actor_id_of/2 — prefer the receiving actor's id (ActorState carries
%% {actor_id, _}); fall back to the activity's :actor. Reading
%% ActorState as a proplist keeps this decoupled from actor_state's
%% internal shape and testable with a plain [{actor_id, _}] stand-in.
actor_id_of(ActorState, Activity) ->
case envelope:get_field(actor_id, ActorState) of
{ok, Id} -> Id;
_ ->
case envelope:get_field(actor, Activity) of
{ok, A} -> A;
_ -> undefined
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,180 +0,0 @@
-module(peer_types).
-export([new/0, lookup/2, store/3, evict/2, types/1,
lookup_or_fetch/3, decode_type_doc/1,
start_link/0, start_link/1, stop/0,
put/2, lookup/1, state_for/1, known_types/0,
lookup_or_fetch/2, evict/1]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
-behaviour(gen_server).
%% Peer-types cache — receiver-side mirror of peer_actors.erl, for
%% host-type federation (plans/fed-sx-host-types.md, Phase 2). When an
%% inbound activity references a refinement type the local node hasn't
%% seen, the object-schema validation stage (Phase 4) needs that
%% type's record — its :refinement-schema and field shape — to vet the
%% inner object. Re-fetching the type doc on every inbound would be
%% wasteful, so we cache the TypeRecord keyed by its content-address.
%%
%% State shape (pure-functional):
%% [{TypeCidBytes, TypeRecord}, ...]
%%
%% TypeCidBytes is the type's CID (a binary). TypeRecord is the parsed
%% DefineType envelope's :object payload — a proplist carrying :name,
%% :fields, :refinement-schema, :instance-type. Refinement schemas are
%% immutable per CID (an updated type is a new CID), so cache entries
%% never go stale — TTL-free, like peer_actors' v2 entries.
%%
%% lookup_or_fetch is the load-bearing entry point: a miss invokes a
%% Cfg-supplied closure to fetch the type doc over the wire. Per the
%% design the closure has shape
%% type_fetch_fn :: fun ((TypeCid, Cfg) -> {ok, Bytes} | {error, _})
%% returning the term_codec-encoded type-doc bytes; lookup_or_fetch
%% decodes them into the TypeRecord and caches it. Keeping the
%% transport in the closure (Phase 3's discovery_type_fetch) keeps
%% peer_types testable with a mocked fetch — same split as
%% peer_actors / discovery_fetch.
%%
%% gen_server wrapper registers under the atom `peer_types` so the
%% pipeline + http_server handlers can reach it without threading a
%% Pid through Cfg.
%% ── Pure-functional API ─────────────────────────────────────────
new() -> [].
lookup(TypeCid, State) ->
case find_keyed(TypeCid, State) of
{ok, TR} -> {ok, TR};
{error, _} -> not_found
end.
store(TypeCid, TR, State) ->
set_keyed(TypeCid, TR, State).
evict(TypeCid, State) ->
delete_keyed(TypeCid, State).
types(State) -> [Cid || {Cid, _TR} <- State].
%% lookup_or_fetch/3 — cache hit returns {ok, TR, State} unchanged.
%% Cache miss pulls the type_fetch_fn out of Cfg and calls it with
%% (TypeCid, Cfg); a {ok, Bytes} reply is decoded via term_codec into
%% the TypeRecord, which is then stored. Failures (no fn, fetch error,
%% bad bytes) do NOT poison the cache so the caller can retry.
%%
%% no type_fetch_fn in Cfg -> {error, no_fetch_fn, State}
%% fn -> {ok, Bytes}, decodable -> {ok, TR, store(...)}
%% fn -> {ok, Bytes}, bad bytes -> {error, bad_type_doc, State}
%% fn -> {error, Reason} -> {error, Reason, State}
%% fn -> Other -> {error, {bad_fetch_return, Other}, State}
lookup_or_fetch(TypeCid, Cfg, State) ->
case find_keyed(TypeCid, State) of
{ok, TR} -> {ok, TR, State};
{error, _} -> fetch_and_store(TypeCid, Cfg, State)
end.
fetch_and_store(TypeCid, Cfg, State) ->
case field(type_fetch_fn, Cfg) of
nil -> {error, no_fetch_fn, State};
Fn when is_function(Fn, 2) ->
case Fn(TypeCid, Cfg) of
{ok, Bytes} ->
case decode_type_doc(Bytes) of
{ok, TR} -> {ok, TR, store(TypeCid, TR, State)};
{error, R} -> {error, R, State}
end;
{error, Reason} -> {error, Reason, State};
Other -> {error, {bad_fetch_return, Other}, State}
end;
_ -> {error, bad_fetch_fn_cfg, State}
end.
%% decode_type_doc/1 — round the wire body back through term_codec.
%% The on-wire form is term_codec:encode(TypeRecord) (Phase 3's
%% /types/<cid> route), so a clean decode yields the proplist TR.
decode_type_doc(Bytes) ->
case term_codec:decode(Bytes) of
{ok, TR, _} when is_list(TR) -> {ok, TR};
_ -> {error, bad_type_doc}
end.
%% ── gen_server wrapper ──────────────────────────────────────────
start_link() ->
start_link([]).
start_link(InitialState) ->
Pid = gen_server:start_link(peer_types, [InitialState]),
erlang:register(peer_types, Pid),
Pid.
stop() ->
R = gen_server:call(peer_types, '$gen_stop'),
erlang:unregister(peer_types),
R.
%% put/2 — store a TypeRecord under its CID. Mirrors store_srv.
put(TypeCid, TR) ->
gen_server:call(peer_types, {put, TypeCid, TR}).
%% lookup/1 — cache read. {ok, TR} | not_found.
lookup(TypeCid) ->
gen_server:call(peer_types, {lookup, TypeCid}).
%% state_for/1 — alias of lookup/1, named to match peer_actors'
%% state_for accessor used by http_server's kernel bridge.
state_for(TypeCid) ->
gen_server:call(peer_types, {lookup, TypeCid}).
known_types() ->
gen_server:call(peer_types, get_types).
evict(TypeCid) ->
gen_server:call(peer_types, {evict, TypeCid}).
%% lookup_or_fetch/2 — gen_server form. Cfg carries the type_fetch_fn.
%% Reply is {ok, TR} on hit-or-fetched, {error, Reason} otherwise.
lookup_or_fetch(TypeCid, Cfg) ->
gen_server:call(peer_types, {lookup_or_fetch, TypeCid, Cfg}).
%% gen_server callbacks
init([InitialState]) ->
{ok, InitialState}.
handle_call({put, TypeCid, TR}, _From, State) ->
{reply, ok, store(TypeCid, TR, State)};
handle_call({lookup, TypeCid}, _From, State) ->
{reply, lookup(TypeCid, State), State};
handle_call({lookup_or_fetch, TypeCid, Cfg}, _From, State) ->
case lookup_or_fetch(TypeCid, Cfg, State) of
{ok, TR, NewState} -> {reply, {ok, TR}, NewState};
{error, Reason, Same} -> {reply, {error, Reason}, Same}
end;
handle_call(get_types, _From, State) ->
{reply, types(State), State};
handle_call({evict, TypeCid}, _From, State) ->
{reply, ok, evict(TypeCid, State)}.
handle_cast(_, S) -> {noreply, S}.
handle_info(_, S) -> {noreply, S}.
%% ── Internal helpers ────────────────────────────────────────────
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> nil.
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,399 +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,
apply_object_schema/2, stage_object_schema/1,
apply_triggers/3]).
%% 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.
%% ── host-type fed Step 4: object-schema validation stage ────────
%%
%% apply_object_schema/2 — when an inbound activity's :object declares
%% a refinement type ({type, TypeName} on the object), resolve that
%% type's record and apply its refinement schema to the object's
%% :field_values. Sits between activity-type (stage_schema) validation
%% and the kernel append; rejects the activity on schema-fail.
%%
%% Resolution mirrors the design note: TypeName -> TypeCid via Cfg's
%% `type_index` ([{TypeName, TypeCid}, ...], the local Define-name
%% index), then TypeCid -> TypeRecord via peer_types:lookup_or_fetch/2
%% (a local cache hit, or a wire fetch through the Cfg type_fetch_fn).
%%
%% Outcomes:
%% object has no {type, _} -> ok (no schema applies)
%% TypeName not in type_index -> ok (undeclared type;
%% open-world default)
%% record resolved, schema passes -> ok
%% record resolved, schema fails -> {error, {validation_failed,
%% object_schema}}
%% record unresolvable (cache miss + -> strict_object_schema:
%% fetch failure / no peer_types) true -> {error, ...}
%% false -> ok (skipped)
%%
%% Default strict_object_schema = false: a node only blocks on an
%% unresolvable type when it opts into airtight validation via Cfg
%% {strict_object_schema, true}. The non-strict skip is where a
%% `validation_skipped` log entry belongs (left to the caller's logger
%% so this stage keeps the ok | {error, _} contract run_stages wants).
%%
%% A TypeRecord's refinement schema is either a 1-arity Erlang
%% predicate over the field-values (the substrate stand-in, for
%% locally-defined types) or a data constraint {required, [Field, ...]}
%% (term_codec-safe, so a wire-fetched TypeRecord can still validate).
apply_object_schema(Activity, Cfg) ->
case object_type_name(Activity) of
none -> ok;
{ok, TypeName} ->
case type_cid_for(TypeName, Cfg) of
none -> ok;
{ok, TypeCid} ->
case resolve_type_record(TypeCid, Cfg) of
{ok, TR} -> check_object_against(Activity, TR);
{error, _} -> on_unresolved_type(Cfg)
end
end
end.
stage_object_schema(Cfg) ->
fun (Activity) -> apply_object_schema(Activity, Cfg) end.
object_type_name(Activity) ->
case envelope:get_field(object, Activity) of
{ok, Obj} when is_list(Obj) ->
case envelope:get_field(type, Obj) of
{ok, T} -> {ok, T};
_ -> none
end;
_ -> none
end.
object_field_values(Activity) ->
case envelope:get_field(object, Activity) of
{ok, Obj} when is_list(Obj) ->
case envelope:get_field(field_values, Obj) of
{ok, FV} -> FV;
_ -> []
end;
_ -> []
end.
type_cid_for(TypeName, Cfg) ->
case stage_field(type_index, Cfg) of
nil -> none;
Index ->
case find_keyed(TypeName, Index) of
{ok, Cid} -> {ok, Cid};
_ -> none
end
end.
resolve_type_record(TypeCid, Cfg) ->
case stage_field(peer_types, Cfg) of
nil -> {error, no_peer_types};
_ ->
case erlang:whereis(peer_types) of
undefined -> {error, peer_types_down};
_ -> peer_types:lookup_or_fetch(TypeCid, Cfg)
end
end.
on_unresolved_type(Cfg) ->
case stage_field(strict_object_schema, Cfg) of
true -> {error, {validation_failed, object_schema}};
_ -> ok
end.
check_object_against(Activity, TR) ->
case stage_field(refinement_schema, TR) of
nil -> ok;
Schema -> apply_refinement(Schema, object_field_values(Activity))
end.
apply_refinement(Fn, FieldValues) when is_function(Fn, 1) ->
case Fn(FieldValues) of
true -> ok;
_ -> {error, {validation_failed, object_schema}}
end;
apply_refinement({required, Fields}, FieldValues) ->
case all_present(Fields, FieldValues) of
true -> ok;
false -> {error, {validation_failed, object_schema}}
end;
apply_refinement(_, _) -> ok.
all_present([], _) -> true;
all_present([F | Rest], FV) ->
case has_key(F, FV) of
true -> all_present(Rest, FV);
false -> false
end.
has_key(_, []) -> false;
has_key(K, [{K, _} | _]) -> true;
has_key(K, [_ | Rest]) -> has_key(K, Rest).
stage_field(K, [{K, V} | _]) -> V;
stage_field(K, [_ | Rest]) -> stage_field(K, Rest);
stage_field(_, []) -> nil.
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
%% ── fed-sx triggers Step 2: post-append fan-out ─────────────────
%%
%% apply_triggers/3 — fires the durable flows bound to an activity's
%% type AFTER it has been accepted and appended (rejected activities
%% never reach here, so a flow only runs for an activity that really
%% landed). For each spec the activity's type is bound to, the spec
%% must pass its guard/actor-scope, and its {ActivityCid, TriggerCid}
%% pair must not already have fired (federation can deliver the same
%% activity twice via different peers — dedup is keyed on that pair,
%% read from the receiving actor's :triggers_fired). Surviving specs are
%% dispatched via flow_dispatch:start (a native flow_store:start), which
%% never raises.
%%
%% Returns {ok, Results} where Results is one
%% {ActivityCid, TriggerCid, {ok, FlowId} | {error, Reason}}
%% per spec actually dispatched (guard-passed, not a duplicate). The
%% kernel folds the {ActivityCid, TriggerCid} pairs into the actor's
%% :triggers_fired (dedup) and the audit triples into its projection.
%% No matching/ready registry yields {ok, []}.
%%
%% Cfg gates the fan-out on {trigger_registry, trigger_registry} (the
%% registered gen_server), mirroring the object-schema stage's
%% {peer_types, _} gate. apply_triggers must NOT be called inside a
%% `try` — flow_dispatch does gen_server:calls, and a blocking call
%% inside a try deadlocks this scheduler; the fan-out runs after append,
%% in its own step, so this is naturally satisfied.
apply_triggers(Activity, ActorState, Cfg) ->
case trigger_registry_ready(Cfg) of
false -> {ok, []};
true ->
Type = activity_type_of(Activity),
Specs = trigger_registry:lookup(Type),
ActCid = trigger_activity_cid(Activity),
Fired = field_or_default(triggers_fired, ActorState, []),
fire_each(Specs, Activity, ActorState, ActCid, Fired, Cfg, [])
end.
trigger_registry_ready(Cfg) ->
case stage_field(trigger_registry, Cfg) of
nil -> false;
_ ->
case erlang:whereis(trigger_registry) of
undefined -> false;
_ -> true
end
end.
fire_each([], _A, _AS, _ACid, _Fired, _Cfg, Acc) ->
{ok, lists:reverse(Acc)};
fire_each([Spec | Rest], A, AS, ACid, Fired, Cfg, Acc) ->
TCid = trigger_registry:spec_cid(Spec),
Pair = {ACid, TCid},
AlreadyFired = pair_member(Pair, Fired) orelse acc_member(Pair, Acc),
Pass = (not AlreadyFired) andalso flow_dispatch:guard_passes(Spec, A, AS),
case Pass of
false ->
fire_each(Rest, A, AS, ACid, Fired, Cfg, Acc);
true ->
Outcome = case flow_dispatch:start(Spec, A, AS, Cfg) of
{ok, FlowId, _Audit} -> {ok, FlowId};
{error, Reason} -> {error, Reason}
end,
fire_each(Rest, A, AS, ACid, Fired, Cfg, [{ACid, TCid, Outcome} | Acc])
end.
activity_type_of(Activity) ->
case envelope:get_field(type, Activity) of
{ok, Type} -> Type;
_ -> undefined
end.
trigger_activity_cid(Activity) ->
case envelope:get_field(id, Activity) of
{ok, Cid} -> Cid;
_ -> undefined
end.
field_or_default(Key, Proplist, Default) ->
case envelope:get_field(Key, Proplist) of
{ok, V} -> V;
_ -> Default
end.
%% pair_member/2 — {ACid, TCid} present in a [{ACid, TCid}] fired list.
pair_member(_, []) -> false;
pair_member(P, [P | _]) -> true;
pair_member(P, [_ | Rest]) -> pair_member(P, Rest).
%% acc_member/2 — {ACid, TCid} already dispatched this call (Acc holds
%% {ACid, TCid, Outcome} triples).
acc_member(_, []) -> false;
acc_member({A, T}, [{A, T, _} | _]) -> true;
acc_member(P, [_ | Rest]) -> acc_member(P, Rest).

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

@@ -1,180 +0,0 @@
-module(trigger_registry).
-export([new/0, add/3, remove/2, lookup/2, all/1, fold/2, fold_fn/0,
mk_spec/4, spec_cid/1, spec_flow_name/1, spec_guard/1,
spec_actor_scope/1,
start_link/0, start_link/1, stop/0,
add/2, remove/1, lookup/1, all_triggers/0]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
-behaviour(gen_server).
%% Trigger registry — binds activity-types to durable flows
%% (plans/agent-briefings/fed-sx-triggers-loop.md, Phase 1). When an
%% activity is appended, the kernel's post-append fan-out
%% (pipeline.erl, Phase 2) looks the activity's type up here and starts
%% each registered flow. Mirrors the peer_actors / peer_types shape: a
%% pure-functional core plus a registered gen_server, hydrated on start
%% from a fold over DefineTrigger activities.
%%
%% State shape (pure-functional):
%% [{ActivityType, [Spec, ...]}, ...]
%% Multiple triggers may bind the same activity-type; they fire
%% independently. A Spec is a 4-tuple:
%% {TriggerCid, FlowName, Guard, ActorScope}
%% TriggerCid — content-address of the DefineTrigger activity
%% (dedup + audit); `undefined` if not yet addressed.
%% FlowName — the flow_store-registered flow to start.
%% Guard — fun ((Activity, ActorState) -> bool) | undefined.
%% Lets one type bind multiple flows with
%% discriminators ("only Articles in :newsletter").
%% Resolved to a fun at registration; not carried over
%% the wire (term_codec can't encode funs).
%% ActorScope — an actor id the trigger is scoped to, or `any`.
%% ── Spec constructor / accessors ────────────────────────────────
mk_spec(TriggerCid, FlowName, Guard, ActorScope) ->
{TriggerCid, FlowName, Guard, ActorScope}.
spec_cid({Cid, _, _, _}) -> Cid.
spec_flow_name({_, FlowName, _, _}) -> FlowName.
spec_guard({_, _, Guard, _}) -> Guard.
spec_actor_scope({_, _, _, Scope}) -> Scope.
%% ── Pure-functional API ─────────────────────────────────────────
new() -> [].
%% add(ActivityType, Spec, State) — append Spec to ActivityType's list.
add(ActivityType, Spec, State) ->
Existing = lookup(ActivityType, State),
set_keyed(ActivityType, append1(Existing, Spec), State).
%% remove(TriggerCid, State) — drop every spec carrying TriggerCid,
%% across all activity-types; empties are pruned.
remove(TriggerCid, State) ->
prune([{T, drop_cid(TriggerCid, Specs)} || {T, Specs} <- State]).
%% lookup(ActivityType, State) — the specs bound to ActivityType ([] if
%% none).
lookup(ActivityType, State) ->
case find_keyed(ActivityType, State) of
{ok, Specs} -> Specs;
not_found -> []
end.
all(State) -> State.
%% ── Hydration fold ──────────────────────────────────────────────
%%
%% fold(Activity, State) — register the binding carried by a
%% DefineTrigger activity. Replaying the actor log through this fold
%% rebuilds the registry after a restart (same content-addressing
%% discipline as define_registry). A non-DefineTrigger activity passes
%% through untouched.
fold(Activity, State) ->
case envelope:get_field(type, Activity) of
{ok, define_trigger} -> fold_trigger(Activity, State);
_ -> State
end.
fold_trigger(Activity, State) ->
case envelope:get_field(object, Activity) of
{ok, Obj} ->
case binding_of(Activity, Obj) of
{ok, AType, Spec} -> add(AType, Spec, State);
not_a_binding -> State
end;
_ -> State
end.
binding_of(Activity, Obj) ->
case envelope:get_field(activity_type, Obj) of
{ok, AType} ->
case envelope:get_field(flow_name, Obj) of
{ok, FlowName} ->
Guard = field_or(guard, Obj, undefined),
Scope = field_or(actor_scope, Obj, any),
Cid = field_or(id, Activity, undefined),
{ok, AType, mk_spec(Cid, FlowName, Guard, Scope)};
_ -> not_a_binding
end;
_ -> not_a_binding
end.
%% fold_fn/0 — a 2-arity fun the projection scheduler can plant.
fold_fn() ->
fun (Activity, State) -> fold(Activity, State) end.
%% ── gen_server wrapper ──────────────────────────────────────────
start_link() ->
start_link([]).
start_link(InitialState) ->
Pid = gen_server:start_link(trigger_registry, [InitialState]),
erlang:register(trigger_registry, Pid),
Pid.
stop() ->
R = gen_server:call(trigger_registry, '$gen_stop'),
erlang:unregister(trigger_registry),
R.
add(ActivityType, Spec) ->
gen_server:call(trigger_registry, {add, ActivityType, Spec}).
remove(TriggerCid) ->
gen_server:call(trigger_registry, {remove, TriggerCid}).
lookup(ActivityType) ->
gen_server:call(trigger_registry, {lookup, ActivityType}).
all_triggers() ->
gen_server:call(trigger_registry, all_triggers).
init([InitialState]) ->
{ok, InitialState}.
handle_call({add, ActivityType, Spec}, _From, State) ->
{reply, ok, add(ActivityType, Spec, State)};
handle_call({remove, TriggerCid}, _From, State) ->
{reply, ok, remove(TriggerCid, State)};
handle_call({lookup, ActivityType}, _From, State) ->
{reply, lookup(ActivityType, State), State};
handle_call(all_triggers, _From, State) ->
{reply, State, State}.
handle_cast(_, S) -> {noreply, S}.
handle_info(_, S) -> {noreply, S}.
%% ── helpers ─────────────────────────────────────────────────────
field_or(Key, Proplist, Default) ->
case envelope:get_field(Key, Proplist) of
{ok, V} -> V;
_ -> Default
end.
drop_cid(_, []) -> [];
drop_cid(Cid, [Spec | Rest]) ->
case spec_cid(Spec) of
Cid -> drop_cid(Cid, Rest);
_ -> [Spec | drop_cid(Cid, Rest)]
end.
prune([]) -> [];
prune([{_, []} | Rest]) -> prune(Rest);
prune([P | Rest]) -> [P | prune(Rest)].
append1([], X) -> [X];
append1([H | T], X) -> [H | append1(T, X)].
find_keyed(_, []) -> 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

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 590 "$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 = 8" "8"
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 39" "39"
check 20 "activity_types count = 8" "8"
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" "8"
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" "8"
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,140 +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)")
;; outbox:publish computes a delivery set via follower_graph + delivery
;; (compute_delivery_set/3) — load both so the publish path resolves.
(epoch 11)
(eval "(get (erlang-load-module (file-read \"next/kernel/follower_graph.erl\")) :name)")
(epoch 12)
(eval "(get (erlang-load-module (file-read \"next/kernel/delivery.erl\")) :name)")
;; bootstrap:start returns a Pid
(epoch 20)
(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 = 8" "8"
check 22 "object_types count = 13" "13"
check 23 "projections count = 7" "7"
check 24 "total entries = 39" "39"
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,99 +0,0 @@
#!/usr/bin/env bash
# next/tests/define_trigger.sh — fed-sx triggers Phase 1 (verb).
#
# The DefineTrigger genesis verb
# (next/genesis/activity-types/define_trigger.sx) binds an activity-type
# to a flow. This suite confirms it parses with the expected
# DefineActivity head + :name, that its :schema accepts a well-formed
# binding and rejects malformed ones, and that a DefineTrigger envelope
# round-trips through term_codec.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
SCH='(eval-expr (get (apply dict (rest (parse (file-read \"next/genesis/activity-types/define_trigger.sx\")))) :schema))'
cat > "$TMPFILE" <<EPOCHS
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/term_codec.erl\")) :name)")
;; ── parse / shape ──────────────────────────────────────────
(epoch 10)
(eval "(first (parse (file-read \"next/genesis/activity-types/define_trigger.sx\")))")
(epoch 11)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/activity-types/define_trigger.sx\")))) :name)")
;; ── schema accept / reject ─────────────────────────────────
;; valid binding: string :activity-type + :flow-name -> true
(epoch 20)
(eval "(define sch ${SCH}) (sch (dict :object (dict :activity-type \"Create\" :flow-name \"blog-publish-digest\")))")
;; reject: missing :activity-type -> false
(epoch 21)
(eval "(define sch ${SCH}) (sch (dict :object (dict :flow-name \"f\")))")
;; reject: missing :flow-name -> false
(epoch 22)
(eval "(define sch ${SCH}) (sch (dict :object (dict :activity-type \"Create\")))")
;; ── envelope round-trip through term_codec ─────────────────
(epoch 30)
(eval "(get (erlang-eval-ast \"A = [{type, define_trigger}, {actor, alice}, {object, [{activity_type, create}, {flow_name, blog_publish_digest}]}], {ok, D, _} = term_codec:decode(term_codec:encode(A)), D =:= A\") :name)")
EPOCHS
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 10 "define_trigger.sx head form" "DefineActivity"
check 11 "define_trigger.sx name" "DefineTrigger"
check 20 "schema accepts valid binding" "true"
check 21 "schema rejects missing type" "false"
check 22 "schema rejects missing flow-name" "false"
check 30 "DefineTrigger envelope round-trips" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/define_trigger.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