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
110 changed files with 1604 additions and 9874 deletions

View File

@@ -38,6 +38,8 @@ SUITES=(
"fib|er-fib-test-pass|er-fib-test-count"
"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'
@@ -61,6 +63,8 @@ cat > "$TMPFILE" << 'EPOCHS'
(load "lib/erlang/vm/dispatcher.sx")
(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)
@@ -83,6 +87,10 @@ cat > "$TMPFILE" << 'EPOCHS'
(eval "(list er-ffi-test-pass er-ffi-test-count)")
(epoch 110)
(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

@@ -135,6 +135,56 @@
(dict-set! s :next-ref (+ n 1))
(er-mk-ref n)))))
;; ── logical clock + timer wheel ──────────────────────────────────
;; The scheduler runs a synchronous model: logical time advances only
;; when the runnable queue drains (see `er-sched-advance-time!`). The
;; clock is in milliseconds, monotonic, never derived from wall time
;; — deterministic and time-travel-safe. `send_after` schedules a
;; message-delivery event at an absolute deadline; `receive after Ms`
;; schedules a timeout event the same way. When no process is runnable
;; the scheduler jumps the clock to the earliest pending deadline and
;; fires that single event, then re-runs.
(define er-clock (fn () (get (er-sched) :clock)))
;; Advance the clock to `ms`, but never backwards (monotonicity).
(define
er-clock-set!
(fn (ms) (dict-set! (er-sched) :clock (max (er-clock) ms))))
(define er-sched-timers (fn () (get (er-sched) :timers)))
;; Register a timer event. `dest` is a pid or registered-atom value,
;; resolved to a live process at fire time. Returns the timer ref.
(define
er-timer-add!
(fn
(deadline dest msg ref)
(append!
(er-sched-timers)
{:ref ref :deadline deadline :dest dest :msg msg :alive true})
ref))
;; Find the live timer with the given ref, or nil.
(define
er-timer-find-alive
(fn
(ref)
(let
((ts (er-sched-timers)) (found (list nil)))
(for-each
(fn
(i)
(let
((t (nth ts i)))
(when
(and
(= (nth found 0) nil)
(get t :alive)
(er-ref-equal? (get t :ref) ref))
(set-nth! found 0 t))))
(range 0 (len ts)))
(nth found 0))))
;; ── scheduler state ──────────────────────────────────────────────
(define er-scheduler (list nil))
@@ -151,6 +201,8 @@
:processes {}
:registered {}
:ets {}
:clock 0
:timers (list)
:runnable (er-q-new)})))
(define er-sched (fn () (nth er-scheduler 0)))
@@ -217,6 +269,7 @@
:trap-exit false
:has-timeout false
:timed-out false
:timeout-deadline nil
:exit-reason nil}))
(dict-set! (er-sched-processes) (er-pid-key pid) proc)
(er-sched-enqueue! pid)
@@ -456,6 +509,69 @@
(error "Erlang: make_ref/0: arity")
(er-ref-new!))))
;; ── timer BIFs ───────────────────────────────────────────────────
;; erlang:send_after(Time, Dest, Msg) -> Ref
;; Schedules Msg to be delivered to Dest after Time ms (logical).
;; Time must be a non-negative integer; Dest a pid or registered
;; atom name. Returns a fresh timer reference.
(define
er-bif-send-after
(fn
(vs)
(let
((time (nth vs 0)) (dest (nth vs 1)) (msg (nth vs 2)))
(cond
(not (and (= (type-of time) "number") (>= time 0)))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
(not (or (er-pid? dest) (er-atom? dest)))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(er-timer-add!
(+ (er-clock) (truncate time))
dest
msg
(er-ref-new!))))))
;; erlang:cancel_timer(Ref) -> RemainingMs | false
;; For a live (not-yet-fired) timer, marks it cancelled and returns
;; the milliseconds left until its deadline. For an already-fired,
;; already-cancelled, or unknown ref, returns the atom `false`.
(define
er-bif-cancel-timer
(fn
(vs)
(let
((ref (nth vs 0)))
(cond
(not (er-ref? ref))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let
((t (er-timer-find-alive ref)))
(cond
(= t nil) (er-mk-atom "false")
:else (do
(dict-set! t :alive false)
(max 0 (- (get t :deadline) (er-clock))))))))))
;; erlang:monotonic_time() | erlang:monotonic_time(Unit) -> Integer
;; Returns the scheduler's logical monotonic clock in milliseconds.
;; Unit (millisecond / second / native) is accepted for API
;; compatibility; all units report from the same ms-resolution clock.
(define
er-bif-monotonic-time
(fn
(vs)
(cond
(= (len vs) 0) (er-clock)
(and (= (len vs) 1) (er-atom? (nth vs 0)))
(let
((unit (get (nth vs 0) :name)))
(cond
(= unit "second") (truncate (/ (er-clock) 1000))
:else (er-clock)))
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
;; Add `target` to `pid`'s :links list if not already there.
(define
er-link-add-one!
@@ -664,37 +780,122 @@
(cond
(not (= pid nil))
(do (er-sched-step! pid) (er-sched-run-all!))
;; Queue empty — fire one pending receive-with-timeout and go again.
(er-sched-fire-one-timeout!) (er-sched-run-all!)
;; Queue empty — advance logical time to the next pending
;; deadline (timer delivery or receive-timeout) and go again.
(er-sched-advance-time!) (er-sched-run-all!)
:else nil))))
;; Wake one waiting process whose receive had an `after Ms` clause.
;; Returns true if one fired. In our synchronous model "time passes"
;; once the runnable queue drains — timeouts only fire then.
;; ── time advance ─────────────────────────────────────────────────
;; Called when the runnable queue is empty. Two kinds of pending event
;; carry a deadline: live `send_after` timers and waiting processes in
;; a `receive ... after Ms` block. Find the single earliest deadline
;; across both, jump the clock to it, and fire just that one event
;; (timer wins ties — a message delivered exactly at the timeout
;; arrives "first"). Returns true if an event fired, false when there
;; is nothing left to wake (genuine idle / termination).
(define
er-sched-fire-one-timeout!
er-sched-advance-time!
(fn
()
(let
((ks (keys (er-sched-processes))) (fired (list false)))
((best (er-sched-next-event)))
(cond
(= best nil) false
:else (do
(er-clock-set! (get best :deadline))
(cond
(= (get best :kind) "timer")
(er-timer-fire! (get best :timer))
:else (er-recv-timeout-fire! (get best :proc)))
true)))))
;; Scan timers and waiting-with-timeout processes for the earliest
;; deadline. Returns {:kind "timer"|"recv" :deadline D ...} or nil.
(define
er-sched-next-event
(fn
()
(let
((best (list nil)))
(for-each
(fn
(i)
(let
((t (nth (er-sched-timers) i)))
(when
(get t :alive)
(er-event-consider!
best
{:kind "timer" :deadline (get t :deadline) :timer t}))))
(range 0 (len (er-sched-timers))))
(for-each
(fn
(k)
(when
(not (nth fired 0))
(let
((p (get (er-sched-processes) k)))
(when
(and
(= (get p :state) "waiting")
(get p :has-timeout))
(dict-set! p :timed-out true)
(dict-set! p :has-timeout false)
(dict-set! p :state "runnable")
(er-sched-enqueue! (get p :pid))
(set-nth! fired 0 true)))))
ks)
(nth fired 0))))
(let
((p (get (er-sched-processes) k)))
(when
(and (= (get p :state) "waiting") (get p :has-timeout))
(er-event-consider!
best
{:kind "recv"
:deadline (get p :timeout-deadline)
:proc p}))))
(keys (er-sched-processes)))
(nth best 0))))
;; Keep the earlier-deadline candidate in the single-cell `best`.
;; Strictly-earlier replaces; equal deadlines keep the incumbent so a
;; timer registered first (and timers over recv-timeouts) win ties.
(define
er-event-consider!
(fn
(best cand)
(when
(or
(= (nth best 0) nil)
(< (get cand :deadline) (get (nth best 0) :deadline)))
(set-nth! best 0 cand))))
;; Deliver a fired timer's message to its destination and retire it.
;; Destination is resolved at fire time; a dead/missing target (or an
;; unregistered name) silently drops the message, as in real Erlang.
(define
er-timer-fire!
(fn
(t)
(dict-set! t :alive false)
(let
((pid (er-timer-resolve-dest (get t :dest))))
(when
(and (not (= pid nil)) (er-proc-exists? pid))
(er-proc-mailbox-push! pid (get t :msg))
(when
(= (er-proc-field pid :state) "waiting")
(er-proc-set! pid :state "runnable")
(er-sched-enqueue! pid))))))
;; Non-raising destination resolver for timer delivery.
(define
er-timer-resolve-dest
(fn
(v)
(cond
(er-pid? v) v
(er-atom? v)
(let
((name (get v :name)))
(if (dict-has? (er-registered) name) (get (er-registered) name) nil))
:else nil)))
;; Wake a process whose `receive ... after Ms` deadline elapsed.
(define
er-recv-timeout-fire!
(fn
(p)
(dict-set! p :timed-out true)
(dict-set! p :has-timeout false)
(dict-set! p :state "runnable")
(er-sched-enqueue! (get p :pid))))
(define
er-sched-step!
@@ -956,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
@@ -1174,8 +1265,15 @@
{reply, Reply, NewState} ->
From ! {Ref, Reply},
gen_server:loop(Mod, NewState);
{reply, Reply, NewState, Timeout} ->
From ! {Ref, Reply},
erlang:send_after(Timeout, self(), {timeout}),
gen_server:loop(Mod, NewState);
{noreply, NewState} ->
gen_server:loop(Mod, NewState);
{noreply, NewState, Timeout} ->
erlang:send_after(Timeout, self(), {timeout}),
gen_server:loop(Mod, NewState);
{stop, Reason, Reply, NewState} ->
From ! {Ref, Reply},
exit(Reason)
@@ -1183,11 +1281,17 @@
{'$gen_cast', Msg} ->
case Mod:handle_cast(Msg, State) of
{noreply, NewState} -> gen_server:loop(Mod, NewState);
{noreply, NewState, Timeout} ->
erlang:send_after(Timeout, self(), {timeout}),
gen_server:loop(Mod, NewState);
{stop, Reason, NewState} -> exit(Reason)
end;
Other ->
case Mod:handle_info(Other, State) of
{noreply, NewState} -> gen_server:loop(Mod, NewState);
{noreply, NewState, Timeout} ->
erlang:send_after(Timeout, self(), {timeout}),
gen_server:loop(Mod, NewState);
{stop, Reason, NewState} -> exit(Reason)
end
end.")
@@ -1578,26 +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
((sx-handler (fn (req-dict) (er-http-resp-to-sx (er-apply-fun handler (list (er-http-req-of-sx req-dict)))))))
(http-listen port sx-handler))))))
;; 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)
@@ -1606,67 +1693,37 @@
(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)
(er-register-bif! "erlang" "exit" 1 er-bif-exit)
(er-register-bif! "erlang" "exit" 2 er-bif-exit)
(er-register-bif! "erlang" "make_ref" 0 er-bif-make-ref)
(er-register-bif! "erlang" "send_after" 3 er-bif-send-after)
(er-register-bif! "erlang" "cancel_timer" 1 er-bif-cancel-timer)
(er-register-bif! "erlang" "monotonic_time" 0 er-bif-monotonic-time)
(er-register-bif! "erlang" "monotonic_time" 1 er-bif-monotonic-time)
(er-register-bif! "erlang" "link" 1 er-bif-link)
(er-register-bif! "erlang" "unlink" 1 er-bif-unlink)
(er-register-bif! "erlang" "monitor" 2 er-bif-monitor)
@@ -1676,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)
@@ -1699,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)
@@ -1713,88 +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)
;; Register everything at load time.
(er-register-builtin-bifs!)

View File

@@ -1,7 +1,7 @@
{
"language": "erlang",
"total_pass": 761,
"total": 761,
"total_pass": 874,
"total": 874,
"suites": [
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
{"name":"parse","pass":52,"total":52,"status":"ok"},
@@ -13,6 +13,8 @@
{"name":"echo","pass":7,"total":7,"status":"ok"},
{"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":"vm","pass":78,"total":78,"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: 761 / 761 tests passing**
**Total: 874 / 874 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
@@ -15,6 +15,8 @@
| ✅ | fib | 8 | 8 |
| ✅ | 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

@@ -0,0 +1,163 @@
;; erlang:send_after / cancel_timer — timer primitives.
;;
;; A process schedules a message to itself (or another pid / registered
;; name) after N logical milliseconds. `cancel_timer` removes a pending
;; timer and reports the time left. These are the same primitives the
;; gen_server library uses to implement `{noreply, State, Timeout}`.
;;
;; The scheduler runs a synchronous logical clock (see runtime.sx
;; `er-sched-advance-time!`): time advances only when the runnable
;; queue drains, jumping to the earliest pending deadline. That makes
;; delivery deterministic and time-travel-safe — no wall clock.
(define er-sa-test-count 0)
(define er-sa-test-pass 0)
(define er-sa-test-fails (list))
(define
er-sa-test
(fn
(name actual expected)
(set! er-sa-test-count (+ er-sa-test-count 1))
(if
(= actual expected)
(set! er-sa-test-pass (+ er-sa-test-pass 1))
(append!
er-sa-test-fails
{:actual actual :expected expected :name name}))))
(define er-sa-pred
(fn (name actual) (er-sa-test name (if actual true false) true)))
(define sa-ev erlang-eval-ast)
;; ── T1 — schedule a self-message, receive it after the deadline ──
;; send_after returns a reference handle.
(er-sa-pred
"T1 send_after returns a ref"
(er-ref?
(sa-ev "erlang:send_after(50, self(), hello)")))
;; The scheduled message lands and a plain receive picks it up.
(er-sa-test
"T1 delivered message received"
(get
(sa-ev
"erlang:send_after(50, self(), hello),
receive M -> M end")
:name)
"hello")
;; Logical time advances exactly to the timer deadline (50ms) by the
;; time the message is received — round-trip latency well under 100ms.
(er-sa-test
"T1 clock at deadline on receipt"
(sa-ev
"erlang:send_after(50, self(), hello),
receive hello -> erlang:monotonic_time() end")
50)
;; ── T2 — cancel_timer returns remaining ms; message never arrives ──
;; Cancel immediately after scheduling: clock has not advanced, so the
;; full duration (~1000ms) is reported as remaining.
(er-sa-test
"T2 cancel returns remaining ms"
(sa-ev
"Ref = erlang:send_after(1000, self(), late),
erlang:cancel_timer(Ref)")
1000)
;; The cancelled timer never delivers — the receive falls through to
;; its `after` clause and returns `none`.
(er-sa-test
"T2 cancelled message never arrives"
(get
(sa-ev
"Ref = erlang:send_after(1000, self(), late),
erlang:cancel_timer(Ref),
receive late -> got after 50 -> none end")
:name)
"none")
;; ── T3 — multiple timers fire in deadline order, not schedule order ──
;; `b` is scheduled first (deadline 80) but `a` second (deadline 20).
;; Two plain receives drain the mailbox in arrival order — and arrival
;; is governed by deadline, so the first message out is `a`.
(er-sa-test
"T3 timers fire in deadline order"
(er-format-value
(sa-ev
"erlang:send_after(80, self(), b),
erlang:send_after(20, self(), a),
X = receive M1 -> M1 end,
Y = receive M2 -> M2 end,
{X, Y}"))
"{a,b}")
;; A selective receive on `a` matches the earlier-deadline timer even
;; though `b` was scheduled first.
(er-sa-test
"T3 selective receive picks earliest deadline"
(get
(sa-ev
"erlang:send_after(80, self(), b),
erlang:send_after(20, self(), a),
receive a -> first end")
:name)
"first")
;; ── T4 — cancel_timer on an already-fired timer returns false ──────
;; Once `x` has been received the timer has fired; cancelling its ref
;; now yields the atom `false`.
(er-sa-test
"T4 cancel of fired timer is false"
(get
(sa-ev
"Ref = erlang:send_after(20, self(), x),
receive x -> ok end,
erlang:cancel_timer(Ref)")
:name)
"false")
;; ── T5 — send_after to a registered atom name ──────────────────────
;; A second process registers itself as `srv`; the timer addresses it
;; by name, and the delayed message lands in that process's mailbox.
;; The server forwards what it got back to the parent for inspection.
(er-sa-test
"T5 timer delivers to registered name"
(get
(sa-ev
"Me = self(),
Pid = spawn(fun () -> receive M -> Me ! {got, M} end end),
register(srv, Pid),
erlang:send_after(20, srv, ping),
receive {got, X} -> X end")
:name)
"ping")
;; ── T6 — gen_server {noreply, State, Timeout} hookup ───────────────
;; A gen_server that, on the `arm` cast, returns {noreply, S, 100}.
;; The library schedules {timeout} to itself via send_after; when no
;; other message arrives first, handle_info({timeout}, S) fires. The
;; handler signals the parent so we can confirm the timeout landed.
(do
(er-load-gen-server!)
(erlang-load-module
"-module(sa_tmo).
init(Me) -> {ok, Me}.
handle_call(_R, _F, S) -> {reply, ok, S}.
handle_cast(arm, Me) -> {noreply, Me, 100}.
handle_info({timeout}, Me) -> Me ! fired, {noreply, Me};
handle_info(_M, S) -> {noreply, S}.")
nil)
(er-sa-test
"T6 gen_server timeout fires handle_info"
(get
(sa-ev
"Me = self(),
P = gen_server:start_link(sa_tmo, Me),
gen_server:cast(P, arm),
receive fired -> ok after 5000 -> timeout end")
:name)
"ok")

View File

@@ -1147,7 +1147,7 @@
(and (er-atom? ms) (= (get ms :name) "infinity"))
(er-eval-receive-loop node pid env)
(= ms 0) (er-eval-receive-poll node pid env)
:else (er-eval-receive-timed node pid env)))))
:else (er-eval-receive-timed node pid env (+ (er-clock) ms))))))
;; after 0 — poll once; on no match, run the after-body immediately.
(define
@@ -1161,12 +1161,15 @@
(get r :value)
(er-eval-body (get node :after-body) env)))))
;; after Ms — suspend; on resume check :timed-out. When the scheduler
;; runs out of other work it fires one pending timeout per round.
;; after Ms — suspend with an absolute `deadline` (logical ms). On
;; resume check :timed-out: the scheduler fires the earliest pending
;; deadline once the runnable queue drains. A non-matching message can
;; wake the process early; it re-suspends on the SAME deadline so the
;; timeout window is not extended.
(define
er-eval-receive-timed
(fn
(node pid env)
(node pid env deadline)
(let
((r (er-try-receive (get node :clauses) pid env)))
(if
@@ -1174,6 +1177,7 @@
(get r :value)
(do
(er-proc-set! pid :has-timeout true)
(er-proc-set! pid :timeout-deadline deadline)
(call/cc
(fn
(k)
@@ -1186,7 +1190,7 @@
(er-proc-set! pid :timed-out false)
(er-proc-set! pid :has-timeout false)
(er-eval-body (get node :after-body) env))
(er-eval-receive-timed node pid env)))))))
(er-eval-receive-timed node pid env deadline)))))))
;; Scan mailbox in arrival order. For each msg, try every clause.
;; On first match: remove that msg from mailbox and return body value.
@@ -2035,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 (state + gen_server) |
| `http_server.erl` | route/1,2 + format-aware GET + POST + Accept header content negotiation |
## Genesis bundle
`next/genesis/` contains 31 SX files across 7 sections, all consumed as data
(read + serialised by `bootstrap:populate_registry`, not eval'd):
- 3 activity-types — Create, Update, Delete
- 10 object-types — SXArtifact, Note, Tombstone, 6 Define* meta-types, Snapshot
- 7 projections — activity-log, by-type, by-actor, by-object, actor-state,
define-registry, audience-graph
- 3 validators — envelope-shape, signature, type-schema
- 3 codecs — dag-cbor, raw, dag-json
- 2 sig-suites — rsa-sha256-2018, ed25519-2020
- 3 audience predicates — Public, Followers, Direct
`manifest.sx` is the bundle root, listed in dependency-friendly order.
## Tests
43 test suites, ~560+ assertions. Each script drives `sx_server.exe` via the
epoch protocol — loads the Erlang substrate, loads relevant kernel modules
via `code:load_binary` / `erlang-load-module`, then exercises behaviour
through `erlang-eval-ast`.
Conventions:
- Scripts marked `_pure.sh` exercise pure-functional state.
- Scripts marked `_server.sh` (or no suffix) exercise gen_server APIs and
must inline `start_link` with operations — the Erlang-on-SX scheduler
doesn't preserve spawned processes across separate `erlang-eval-ast`
invocations.
- `smoke_*_pure.sh` are end-to-end smoke tests demonstrating the §Step 9
proof points without TCP / curl / JSON.
The Erlang-on-SX conformance gate (`bash lib/erlang/conformance.sh`, **729 /
729**) is the no-regression contract — every commit on `loops/fed-sx-m1`
preserves it.
## Substrate
Each `.erl` source file is hot-loaded at boot via
`code:load_binary(Mod, Filename, SourceString)` (Phase 7 BIF). Tests drive
the runtime via the epoch protocol:
```bash
printf '(epoch 1)\n(load "lib/erlang/runtime.sx")\n(epoch 2)\n<test-expr>\n' \
| hosts/ocaml/_build/default/bin/sx_server.exe
```
The kernel calls into these host primitives: `crypto:hash/2`,
`cid:from_bytes/1`, `cid:to_string/1`, `file:read_file/1`, `file:write_file/2`,
`file:delete/1`, `file:list_dir/1`, `code:load_binary/3`, plus `http:listen/2`
(the briefing's allowed scope exception, added to `lib/erlang/runtime.sx`).
### Substrate gaps (parked work)
These three gaps block the remaining unchecked deliverables:
1. **Term codec** (`3b`/`3c`) — **all three substrate fixes done 2026-06-05:**
`erlang:binary_to_list/1` and `erlang:list_to_binary/1` registered in
`lib/erlang/runtime.sx` (iolist-aware); the tokenizer's `$X` branch
emits the decimal char code; `atom_to_list/1` and `integer_to_list/1`
now return Erlang charlists (standard Erlang semantics) with `list_to_atom`/
`list_to_integer` accepting both charlists and SX strings for back-compat.
759/759 conformance. The full term-codec primitive set is in place —
Step 3b on-disk segment writer can encode arbitrary Erlang activity
terms (atoms, ints, binaries, tuples, lists) into byte sequences using
only Erlang-native primitives.
2. **SX-source eval bridge** — There's no BIF that lets Erlang call into the
SX evaluator on a parsed source string. Blocks evaluating the `:schema` /
`:fold` / `:predicate` / `:verify` bodies from the genesis bundle. Erlang-fun
stand-ins (`pipeline:stage_schema`, `define_registry:fold`, etc.) prove the
API shapes; the bridge would let bundle bodies dispatch through them
unchanged.
3. **Dict ↔ proplist marshalling for `http:listen/2`****done 2026-06-05.**
`er-bif-http-listen` marshals the native server's request dict
(`{:method :path :query :headers :body}`) into the proplist shape
`[{method, Bin}, {path, Bin}, {query, Bin}, {headers, [{Name, Value}]},
{body, Bin}]` that `http_server:route/2` consumes, and converts the
handler's response proplist back to `{:status :headers :body}` for the
native server to serialise. Helpers (`er-request-dict-to-proplist`,
`er-proplist-to-dict`, `er-of-sx-deep`, `er-to-sx-deep`,
`er-dict-to-header-proplist`, `er-proplist-fill!`) live alongside the
BIF wrapper in `lib/erlang/runtime.sx`. The BIF also spawns the handler
into a real Erlang process via `er-spawn-fun` + `er-sched-run-all!`
so `self()` / `gen_server:call` work inside route handlers (the kernel
and projection gen_servers reach the handler this way). Verified by
`next/tests/http_marshal.sh` and the live TCP smoke
`next/tests/http_server_tcp.sh` / `http_server_start.sh`. Unblocks
`Step 8b-start` (TCP listener spawn) and the curl-driven 9a-tcp / 9b-tcp
smoke tests.
### Bringing up the kernel
For tests, `bootstrap:start/3(ActorId, KeySpec, ActorState)` is the
one-call boot:
```erlang
KM = <<1,2,3,4>>,
KS = [{key_id, k1}, {algorithm, ed25519}, {value, KM}],
AS = [{public_keys, [[{id, k1}, {created, 0}, {value, KM}]]}],
Pid = bootstrap:start(alice, KS, AS),
%% nx_kernel + registry populated; you now have a kernel.
```
The HTTP layer (`http_server`) and `nx_kernel:publish/1` flow through the
same in-process gen_servers; `http_publish_fold.sh` is the end-to-end proof
the chain works.
## What's next (when work resumes)
In priority order:
1. **8b-start**`http_server:start/1` spawns a process hosting `http:listen/2`.
(8b-bridge done — see Substrate gap #3.)
2. **9a-tcp / 9b-tcp** — replace the in-process smoke scripts with curl-driven
versions hitting the running server.
3. **Term codec / on-disk log** — needs either a new BIF or a temp-file
workaround; current in-memory log keeps everything functional otherwise.
4. **SX-source eval bridge** — unlocks real `:schema` / `:fold` body
evaluation from the genesis bundle.

View File

View File

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

View File

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

View File

@@ -1,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,46 +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")
:object-types ("object-types/sx-artifact.sx"
"object-types/note.sx"
"object-types/tombstone.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,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,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,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,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,604 +0,0 @@
-module(http_server).
-export([start/1, start/2]).
-export([route/1, route/2, ok_response/1, not_found_response/0,
welcome_body/0, capabilities_body/0,
capabilities_path/0,
match_prefix/2, actors_prefix/0, actor_doc_response/1,
artifacts_prefix/0, artifact_response/1,
projections_list_path/0, projections_prefix/0,
projections_list_response/0, projection_response/1,
activity_path/0, unauthorized_response/0,
post_activity_response/0,
validation_failed_response/0,
cid_response/1,
accept_format/1, accept_format_from/1,
capabilities_body_for/1,
content_type_for/1, ok_response/2,
cid_response_for/2, post_activity_response_for/1,
actor_doc_response_for/2, artifact_response_for/2,
projection_response_for/2, projections_list_response_for/1]).
%% HTTP request router per design §16.1.
%%
%% Request shape (mirrors what the SX-side `http-listen` builds and
%% the http:listen/2 BIF bridge marshals into a proplist):
%% [{method, Binary}, {path, Binary}, {query, Binary},
%% {headers, [{Name, Value}, ...]}, {body, Binary}]
%%
%% Response shape:
%% [{status, Integer}, {headers, [{Name, Value}, ...]}, {body, Binary}]
%%
%% Real dispatch (actor docs, outbox listings, /activity POST,
%% /.well-known/sx-capabilities, etc.) lands in Step 8c+. Step 8b
%% wires the route/1 shape and a single hello-world handler that
%% proves the request→response round-trip.
%%
%% Method/path comparison uses integer-segment binaries because
%% `<<"GET">>` truncates to a single byte in this port.
%% Step 8b-start. `http:listen/2` blocks the calling process
%% forever (it's a native accept-loop on a TCP socket), so callers
%% wrap it in a spawned Erlang process. `start/1` is the bare form;
%% `start/2` accepts the same Cfg proplist that `route/2` uses so
%% the spawned handler closes over `:publish_token`, etc.
%%
%% Returns the Pid of the listener process; the caller can `link`
%% it or `monitor` it as needed. The handler always returns a
%% response — uncaught Erlang errors become a generic 500 via the
%% native primitive's try/with-fallback in sx_server.ml.
start(Port) ->
start(Port, []).
start(Port, Cfg) ->
spawn(fun () -> http:listen(Port, fun (Req) -> route(Req, Cfg) end) end).
route(Req) ->
route(Req, []).
%% route/2 — Cfg proplist carries optional `:publish_token` (binary)
%% for POST /activity auth. Other state (logs, projections, etc.) is
%% not yet threaded through — POST /activity returns a stub 200
%% once auth succeeds; real outbox:publish glue lands separately.
route(Req, Cfg) ->
M = field(method, Req),
P = field(path, Req),
F = accept_format_from(Req),
case {M, P} of
{<<80,79,83,84>>, <<47,97,99,116,105,118,105,116,121>>} ->
handle_post_activity(Req, Cfg);
{<<71,69,84>>,
<<47,46,119,101,108,108,45,107,110,111,119,110,
47,115,120,45,99,97,112,97,98,105,108,105,116,105,101,115>>} ->
ok_response(capabilities_body_for(F));
_ ->
dispatch(M, P, F)
end.
%% Backward-compat /2 wrapper — defaults to text format. Route
%% computes Format from the Accept header and calls dispatch/3
%% directly; dispatch/2 is kept for callers that don't have a
%% format in scope.
dispatch(M, P) ->
dispatch(M, P, text).
%% 71 69 84 = "GET" | 47 = "/"
dispatch(<<71, 69, 84>>, <<47>>, _F) ->
ok_response(welcome_body());
%% GET /.well-known/sx-capabilities — Format threaded through
dispatch(<<71, 69, 84>>,
<<47,46,119,101,108,108,45,107,110,111,119,110,
47,115,120,45,99,97,112,97,98,105,108,105,116,105,101,115>>, F) ->
ok_response(capabilities_body_for(F));
%% GET /projections — list stub. Comes before the /projections/{name}
%% prefix clause because the bare path has no trailing slash.
dispatch(<<71, 69, 84>>, <<47,112,114,111,106,101,99,116,105,111,110,115>>, F) ->
projections_list_response_for(F);
%% GET /actors/{id} or /artifacts/{cid} or /projections/{name}
dispatch(<<71, 69, 84>>, Path, F) ->
case match_prefix(actors_prefix(), Path) of
{ok, Id} when byte_size(Id) > 0 ->
actor_doc_response_for(Id, F);
_ ->
case match_prefix(artifacts_prefix(), Path) of
{ok, Cid} when byte_size(Cid) > 0 ->
artifact_response_for(Cid, F);
_ ->
case match_prefix(projections_prefix(), Path) of
{ok, Name} when byte_size(Name) > 0 ->
projection_response_for(Name, F);
_ ->
not_found_response()
end
end
end;
dispatch(_, _, _) ->
not_found_response().
%% "fed-sx kernel m1\n" — 17 bytes, hand-spelled.
%% f e d - s x _ k e r n e l _ m 1 \n
welcome_body() ->
<<102,101,100,45,115,120,32,107,101,114,110,101,108,32,109,49,10>>.
%% "/.well-known/sx-capabilities" — exposed for callers that build
%% requests in tests or that need the canonical path string.
capabilities_path() ->
<<47,46,119,101,108,108,45,107,110,111,119,110,
47,115,120,45,99,97,112,97,98,105,108,105,116,105,101,115>>.
%% Capability descriptor body. Returned as plain text per design
%% §16; future content-negotiation work (Step 8d) layers JSON /
%% dag-cbor / SX representations on top.
%%
%% Lines (each terminated by \n = 10):
%% "kernel: fed-sx-m1\n"
%% "version: 0.0.1\n"
%% "verbs: Create Update Delete\n"
capabilities_body() ->
<<107,101,114,110,101,108,58,32,102,101,100,45,115,120,45,109,49,10,
118,101,114,115,105,111,110,58,32,48,46,48,46,49,10,
118,101,114,98,115,58,32,67,114,101,97,116,101,32,85,112,100,97,116,101,32,68,101,108,101,116,101,10>>.
ok_response(Body) ->
[{status, 200}, {headers, []}, {body, Body}].
not_found_response() ->
[{status, 404}, {headers, []},
{body, <<110,111,116,32,102,111,117,110,100,10>>}]. % "not found\n"
%% Internal property-list field lookup. Returns nil when missing
%% so the route falls into the not_found arm gracefully.
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> nil.
%% ── Dynamic-segment routing ─────────────────────────────────────
%%
%% match_prefix(Prefix, Path) — if Path starts with the entire
%% Prefix binary, return {ok, Rest} where Rest is the remaining
%% bytes; else return nomatch. Pure byte-level pattern match,
%% no regex / no parsing. Path-segment splitting comes in later
%% sub-deliverables (8c-art, 8c-proj) where it's needed.
match_prefix(<<>>, Rest) -> {ok, Rest};
match_prefix(<<B, PRest/binary>>, <<B, PathRest/binary>>) ->
match_prefix(PRest, PathRest);
match_prefix(_, _) -> nomatch.
%% "/actors/" — 8 bytes: 47 97 99 116 111 114 115 47
actors_prefix() ->
<<47,97,99,116,111,114,115,47>>.
%% Actor doc stub. Real implementation (Step 8c continuation) will
%% fetch the actor-state projection entry and serialise it; v1
%% returns the id as the body so route resolution can be exercised
%% end-to-end without the projection wiring.
actor_doc_response(Id) ->
%% "actor: " — 7 bytes
Pre = <<97,99,116,111,114,58,32>>,
Body = <<Pre/binary, Id/binary, 10>>,
ok_response(Body).
%% "/artifacts/" — 11 bytes
artifacts_prefix() ->
<<47,97,114,116,105,102,97,99,116,115,47>>.
%% Artifact stub. Real implementation will fetch the bytes from
%% the registry (or a CID-keyed store) and content-negotiate.
%% v1 echoes the CID so route resolution can be tested.
artifact_response(Cid) ->
%% "artifact: " — 10 bytes
Pre = <<97,114,116,105,102,97,99,116,58,32>>,
Body = <<Pre/binary, Cid/binary, 10>>,
ok_response(Body).
%% "/projections" — 12 bytes (no trailing slash; the list endpoint)
projections_list_path() ->
<<47,112,114,111,106,101,99,116,105,111,110,115>>.
%% "/projections/" — 13 bytes (the per-projection prefix)
projections_prefix() ->
<<47,112,114,111,106,101,99,116,105,111,110,115,47>>.
%% Stub list response — real implementation queries the registry
%% for active projections and serialises the name+CID list.
projections_list_response() ->
%% "projections: (empty)\n" — hand-spelled
Body = <<112,114,111,106,101,99,116,105,111,110,115,58,32,
40,101,109,112,116,121,41,10>>,
ok_response(Body).
projection_response(Name) ->
%% "projection: " — 12 bytes
Pre = <<112,114,111,106,101,99,116,105,111,110,58,32>>,
Body = <<Pre/binary, Name/binary, 10>>,
ok_response(Body).
%% "/activity" — 9 bytes
activity_path() ->
<<47,97,99,116,105,118,105,116,121>>.
%% 401 Unauthorized response. Body: "unauthorized\n" = 13 bytes.
unauthorized_response() ->
[{status, 401}, {headers, []},
{body, <<117,110,97,117,116,104,111,114,105,122,101,100,10>>}].
%% Stub success body for POST /activity. Real impl will return
%% the published activity's CID once outbox:publish is wired
%% through a server-state context (Step 8c-post-publish).
post_activity_response() ->
%% "published (stub)\n" — hand-spelled
Body = <<112,117,98,108,105,115,104,101,100,32,
40,115,116,117,98,41,10>>,
ok_response(Body).
%% Auth helpers.
handle_post_activity(Req, Cfg) ->
case check_bearer(Req, Cfg) of
ok ->
F = accept_format_from(Req),
publish_if_kernel(Req, F);
{error, _} ->
unauthorized_response()
end.
%% publish_if_kernel/2 — if the nx_kernel gen_server is registered,
%% delegate the publish there and translate the result. Otherwise
%% keep the stub response so the auth-only tests stay green without
%% having to spin up a kernel process. Format threads through to
%% both stub and CID responses so the Content-Type matches what
%% the client asked for via Accept.
publish_if_kernel(Req, F) ->
case erlang:whereis(nx_kernel) of
undefined ->
post_activity_response_for(F);
_Pid ->
Body = field(body, Req),
Request = [{type, create}, {object, Body}],
case nx_kernel:publish(Request) of
{ok, Result} ->
case envelope:get_field(cid, Result) of
{ok, Cid} -> cid_response_for(Cid, F);
_ -> post_activity_response_for(F)
end;
{error, _} ->
validation_failed_response()
end
end.
%% 200 OK with body "cid: <cid>\n" (5 prefix bytes + cid + newline)
cid_response(Cid) ->
%% "cid: " — 99 105 100 58 32
Pre = <<99,105,100,58,32>>,
Body = <<Pre/binary, Cid/binary, 10>>,
ok_response(Body).
%% 422 Unprocessable Entity. Body "validation failed\n" — 18 bytes.
validation_failed_response() ->
[{status, 422}, {headers, []},
{body, <<118,97,108,105,100,97,116,105,111,110,32,
102,97,105,108,101,100,10>>}].
check_bearer(Req, Cfg) ->
case bearer_token(Req) of
{ok, Got} ->
case expected_token(Cfg) of
{ok, Want} when Got =:= Want -> ok;
_ -> {error, bad_token}
end;
not_found -> {error, no_auth}
end.
%% Look up the Authorization header, strip "Bearer ", return token.
bearer_token(Req) ->
case field(headers, Req) of
nil -> not_found;
Hs ->
%% "authorization" — 13 bytes, lowercase as the BIF wrapper
%% normalises headers to lowercase keys.
AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>,
case find_header(AuthKey, Hs) of
not_found -> not_found;
{ok, V} -> strip_bearer(V)
end
end.
find_header(_, []) -> not_found;
find_header(K, [{K, V} | _]) -> {ok, V};
find_header(K, [_ | Rest]) -> find_header(K, Rest).
%% "Bearer " — 7 bytes — strip and return the rest as the token.
%% Anything else returns not_found (treated as missing auth).
strip_bearer(V) ->
Prefix = <<66,101,97,114,101,114,32>>,
case match_prefix(Prefix, V) of
{ok, Token} when byte_size(Token) > 0 -> {ok, Token};
_ -> not_found
end.
expected_token(Cfg) ->
case field(publish_token, Cfg) of
nil -> not_found;
T -> {ok, T}
end.
%% ── Step 8d: Accept-header parsing ──────────────────────────────
%%
%% accept_format/1 — given an Accept header value, return the
%% content-negotiation atom the route should serialise into. The
%% first media-type prefix that matches wins, in this priority:
%% application/activity+json -> activity_json
%% application/json -> json
%% application/sx -> sx
%% application/cbor -> cbor
%% Anything else (including unrecognised, empty, or missing header)
%% returns text — current routes default to text/plain bodies.
%%
%% Per-prefix recognition uses `match_prefix`. The header value is
%% NOT split on `,` here; matching against the leading bytes is
%% enough for the v1 envelope shapes the kernel currently emits.
%% Media-type prefix byte sequences — hand-spelled because
%% `<<"...">>` string-segments truncate in this port.
%% "application/activity+json" — 25 bytes
activity_json_prefix() ->
<<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>>.
%% "application/json" — 16 bytes
json_prefix() ->
<<97,112,112,108,105,99,97,116,105,111,110,47,106,115,111,110>>.
%% "application/sx" — 14 bytes
sx_prefix() ->
<<97,112,112,108,105,99,97,116,105,111,110,47,115,120>>.
%% "application/cbor" — 16 bytes
cbor_prefix() ->
<<97,112,112,108,105,99,97,116,105,111,110,47,99,98,111,114>>.
accept_format(nil) -> text;
accept_format(<<>>) -> text;
accept_format(V) when is_binary(V) ->
case match_prefix(activity_json_prefix(), V) of
{ok, _} -> activity_json;
_ ->
case match_prefix(json_prefix(), V) of
{ok, _} -> json;
_ ->
case match_prefix(sx_prefix(), V) of
{ok, _} -> sx;
_ ->
case match_prefix(cbor_prefix(), V) of
{ok, _} -> cbor;
_ -> text
end
end
end
end;
accept_format(_) -> text.
%% accept_format_from/1 — pull the Accept header out of a request
%% proplist and run accept_format on its value. Lowercase key name
%% (matches the BIF wrapper's normalisation).
accept_format_from(Req) ->
case field(headers, Req) of
nil -> text;
Hs ->
%% "accept" — 6 bytes
K = <<97,99,99,101,112,116>>,
case find_header(K, Hs) of
{ok, V} -> accept_format(V);
not_found -> text
end
end.
%% capabilities_body_for/1 — content-negotiated capability bodies.
%% Each format returns a distinct byte sequence so dispatch can be
%% observed end-to-end. Real serialisation (JSON-LD, dag-cbor, etc.)
%% lands once the corresponding encoder BIFs are wired; v1 uses
%% tagged stubs that are syntactically the right shape.
capabilities_body_for(text) ->
capabilities_body();
%% `{"caps":"fed-sx-m1"}\n` — 21 bytes
capabilities_body_for(json) ->
<<123,34,99,97,112,115,34,58,34,
102,101,100,45,115,120,45,109,49,34,125,10>>;
capabilities_body_for(activity_json) ->
%% Same payload as :json — the difference is the Content-Type
%% header (Step 8d-content-type follow-up); body shape matches.
capabilities_body_for(json);
%% `(caps "fed-sx-m1")\n` — 19 bytes
capabilities_body_for(sx) ->
<<40,99,97,112,115,32,34,
102,101,100,45,115,120,45,109,49,34,41,10>>;
%% A minimal CBOR map: 0xA1 0x64 "caps" 0x69 "fed-sx-m1"
%% A1 = map(1); 64 = text(4) "caps"; 69 = text(9) "fed-sx-m1"
capabilities_body_for(cbor) ->
<<161,100,99,97,112,115,105,
102,101,100,45,115,120,45,109,49>>;
capabilities_body_for(_) ->
capabilities_body().
%% content_type_for/1 — MIME type binary for each format atom.
%% "text/plain" — 10 bytes
content_type_for(text) ->
<<116,101,120,116,47,112,108,97,105,110>>;
%% "application/json" — 16 bytes
content_type_for(json) ->
<<97,112,112,108,105,99,97,116,105,111,110,47,
106,115,111,110>>;
%% "application/activity+json" — 25 bytes
content_type_for(activity_json) ->
<<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>>;
%% "application/sx" — 14 bytes
content_type_for(sx) ->
<<97,112,112,108,105,99,97,116,105,111,110,47,
115,120>>;
%% "application/cbor" — 16 bytes
content_type_for(cbor) ->
<<97,112,112,108,105,99,97,116,105,111,110,47,
99,98,111,114>>;
content_type_for(_) ->
content_type_for(text).
%% ok_response/2 — 200 OK with a Content-Type header derived from
%% the Format atom. The header key is lowercase to match how the
%% BIF wrapper normalises request headers.
%% "content-type" — 12 bytes
ok_response(Body, Format) ->
CTKey = <<99,111,110,116,101,110,116,45,116,121,112,101>>,
[{status, 200},
{headers, [{CTKey, content_type_for(Format)}]},
{body, Body}].
%% cid_response_for/2 — format-aware version of cid_response/1.
%% Each variant emits a syntactically appropriate body for the
%% chosen format and tags the response with the matching
%% Content-Type via ok_response/2.
cid_response_for(Cid, text) ->
cid_response(Cid);
%% `{"cid":"<cid>"}\n` — 8-byte prefix + cid + 3-byte suffix
cid_response_for(Cid, json) ->
Pre = <<123,34,99,105,100,34,58,34>>, % '{"cid":"'
Suf = <<34,125,10>>, % '"}\n'
ok_response(<<Pre/binary, Cid/binary, Suf/binary>>, json);
cid_response_for(Cid, activity_json) ->
Pre = <<123,34,99,105,100,34,58,34>>,
Suf = <<34,125,10>>,
ok_response(<<Pre/binary, Cid/binary, Suf/binary>>, activity_json);
%% `(cid "<cid>")\n` — 6-byte prefix + cid + 3-byte suffix
cid_response_for(Cid, sx) ->
Pre = <<40,99,105,100,32,34>>, % '(cid "'
Suf = <<34,41,10>>, % '")\n'
ok_response(<<Pre/binary, Cid/binary, Suf/binary>>, sx);
%% v1 cbor stub: the raw CID bytes with the application/cbor CT.
%% Real cbor encoding (A1 63 cid 78 <len> ...) lands later.
cid_response_for(Cid, cbor) ->
ok_response(Cid, cbor);
cid_response_for(Cid, _) ->
cid_response(Cid).
%% post_activity_response_for/1 — format-aware version of
%% post_activity_response/0 (the kernel-absent stub).
post_activity_response_for(text) ->
post_activity_response();
%% `{"status":"stub"}\n` — hand-spelled
post_activity_response_for(json) ->
Body = <<123,34,115,116,97,116,117,115,34,58,34,
115,116,117,98,34,125,10>>,
ok_response(Body, json);
post_activity_response_for(activity_json) ->
Body = <<123,34,115,116,97,116,117,115,34,58,34,
115,116,117,98,34,125,10>>,
ok_response(Body, activity_json);
%% `(status "stub")\n`
post_activity_response_for(sx) ->
Body = <<40,115,116,97,116,117,115,32,34,
115,116,117,98,34,41,10>>,
ok_response(Body, sx);
post_activity_response_for(cbor) ->
%% Same body as text but with cbor CT — clients see the same
%% bytes as the text fallback. Step 8d-cbor encoder will replace.
[_, _, {body, Body}] = post_activity_response(),
ok_response(Body, cbor);
post_activity_response_for(_) ->
post_activity_response().
%% ── 8d-dispatch-get: format-aware GET responses ─────────────────
%%
%% Each builder mirrors its text-only counterpart but emits a
%% format-tagged body and Content-Type. json/activity_json share
%% the body shape but differ in CT; sx uses parenthesized form;
%% cbor returns the raw payload bytes (encoder follow-up).
%% actor_doc_response — text body `actor: <id>\n`.
actor_doc_response_for(Id, text) ->
actor_doc_response(Id);
actor_doc_response_for(Id, json) ->
Pre = <<123,34,97,99,116,111,114,34,58,34>>, % '{"actor":"'
Suf = <<34,125,10>>, % '"}\n'
ok_response(<<Pre/binary, Id/binary, Suf/binary>>, json);
actor_doc_response_for(Id, activity_json) ->
Pre = <<123,34,97,99,116,111,114,34,58,34>>,
Suf = <<34,125,10>>,
ok_response(<<Pre/binary, Id/binary, Suf/binary>>, activity_json);
actor_doc_response_for(Id, sx) ->
Pre = <<40,97,99,116,111,114,32,34>>, % '(actor "'
Suf = <<34,41,10>>, % '")\n'
ok_response(<<Pre/binary, Id/binary, Suf/binary>>, sx);
actor_doc_response_for(Id, cbor) ->
ok_response(Id, cbor);
actor_doc_response_for(Id, _) ->
actor_doc_response(Id).
%% artifact_response — text body `artifact: <cid>\n`.
artifact_response_for(Cid, text) ->
artifact_response(Cid);
artifact_response_for(Cid, json) ->
Pre = <<123,34,97,114,116,105,102,97,99,116,34,58,34>>,
Suf = <<34,125,10>>,
ok_response(<<Pre/binary, Cid/binary, Suf/binary>>, json);
artifact_response_for(Cid, activity_json) ->
Pre = <<123,34,97,114,116,105,102,97,99,116,34,58,34>>,
Suf = <<34,125,10>>,
ok_response(<<Pre/binary, Cid/binary, Suf/binary>>, activity_json);
artifact_response_for(Cid, sx) ->
Pre = <<40,97,114,116,105,102,97,99,116,32,34>>,
Suf = <<34,41,10>>,
ok_response(<<Pre/binary, Cid/binary, Suf/binary>>, sx);
artifact_response_for(Cid, cbor) ->
ok_response(Cid, cbor);
artifact_response_for(Cid, _) ->
artifact_response(Cid).
%% projection_response (singular) — text body `projection: <name>\n`.
projection_response_for(Name, text) ->
projection_response(Name);
projection_response_for(Name, json) ->
Pre = <<123,34,112,114,111,106,101,99,116,105,111,110,34,58,34>>,
Suf = <<34,125,10>>,
ok_response(<<Pre/binary, Name/binary, Suf/binary>>, json);
projection_response_for(Name, activity_json) ->
Pre = <<123,34,112,114,111,106,101,99,116,105,111,110,34,58,34>>,
Suf = <<34,125,10>>,
ok_response(<<Pre/binary, Name/binary, Suf/binary>>, activity_json);
projection_response_for(Name, sx) ->
Pre = <<40,112,114,111,106,101,99,116,105,111,110,32,34>>,
Suf = <<34,41,10>>,
ok_response(<<Pre/binary, Name/binary, Suf/binary>>, sx);
projection_response_for(Name, cbor) ->
ok_response(Name, cbor);
projection_response_for(Name, _) ->
projection_response(Name).
%% projections_list_response — empty-list stub.
projections_list_response_for(text) ->
projections_list_response();
%% `{"projections":[]}\n`
projections_list_response_for(json) ->
Body = <<123,34,112,114,111,106,101,99,116,105,111,110,115,
34,58,91,93,125,10>>,
ok_response(Body, json);
projections_list_response_for(activity_json) ->
Body = <<123,34,112,114,111,106,101,99,116,105,111,110,115,
34,58,91,93,125,10>>,
ok_response(Body, activity_json);
%% `(projections)\n`
projections_list_response_for(sx) ->
Body = <<40,112,114,111,106,101,99,116,105,111,110,115,41,10>>,
ok_response(Body, sx);
projections_list_response_for(cbor) ->
[_, _, {body, Body}] = projections_list_response(),
ok_response(Body, cbor);
projections_list_response_for(_) ->
projections_list_response().

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,139 +0,0 @@
-module(nx_kernel).
-behaviour(gen_server).
-export([new/3, publish/2,
actor_id/1, log_state/1, log_tip/1,
key_spec/1, actor_state/1, projections/1,
next_published/1, with_projections/2]).
-export([start_link/3, publish/1, query/0, log_tip/0,
with_projections/1, stop/0]).
-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. The HTTP layer (Step 8c-post-publish
%% follow-up) will park this in a gen_server and dispatch the POST
%% /activity request through `publish/2`.
%%
%% State shape (property list):
%% [{actor_id, A},
%% {key_spec, KS}, % proplist: key_id / algorithm / value
%% {actor_state, AS}, % proplist: public_keys
%% {log, L}, % log:open/2 return value
%% {projections, [Name]}, % list of registered projection process names
%% {next_published, N}] % monotonic counter we feed as :published
%%
%% Step 6c's stage_replay catches duplicates by `:id`; the `:id`
%% is derived from the unsigned envelope contents. Same Request +
%% same `:published` -> same CID, so the next_published counter
%% gives every publish a distinct timestamp without needing a
%% wall-clock BIF.
new(ActorId, KeySpec, ActorStateProplist) ->
{ok, L0} = log:open(ActorId, base_stub()),
[{actor_id, ActorId},
{key_spec, KeySpec},
{actor_state, ActorStateProplist},
{log, L0},
{projections, []},
{next_published, 1}].
%% publish/2 — pure state transition. Returns either:
%% {ok, Result, NewState} — log + counter advanced
%% {error, Reason, State} — state unchanged on validation halt
publish(Request, State) ->
P = field(next_published, State),
Ctx = [{actor_id, field(actor_id, State)},
{published, P},
{key_spec, field(key_spec, State)},
{actor_state, field(actor_state, State)},
{log, field(log, State)},
{projections, field(projections, State)}],
case outbox:publish(Request, Ctx) of
{ok, Result, NewLog} ->
State1 = set(log, NewLog, State),
State2 = set(next_published, P + 1, State1),
{ok, Result, State2};
{error, Reason, _} ->
{error, Reason, State}
end.
%% Accessors
actor_id(State) -> field(actor_id, State).
key_spec(State) -> field(key_spec, State).
actor_state(State) -> field(actor_state, State).
log_state(State) -> field(log, State).
log_tip(State) -> log:tip(field(log, State)).
projections(State) -> field(projections, State).
next_published(State) -> field(next_published, State).
%% with_projections — return a new state with :projections replaced.
with_projections(Names, State) ->
set(projections, Names, State).
%% Internal
%% "base_stub" — placeholder base path for the in-memory log
%% in v1 (the in-memory log ignores the base argument).
base_stub() ->
<<98,97,115,101,95,115,116,117,98>>.
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.
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}).
%% 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_cast(_, S) -> {noreply, S}.
handle_info(_, S) -> {noreply, S}.

View File

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

View File

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

View File

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

View File

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

View File

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

View File

View File

@@ -1,127 +0,0 @@
#!/usr/bin/env bash
# next/tests/bootstrap_build.sh — Step 4d acceptance test.
#
# Exercises bootstrap:build_genesis/1, verify_genesis/2,
# cidhash_path/1, write_cidhash/2, read_cidhash/1. The bundle CID
# is computed by delegating to the host cid:to_string BIF (Step 1b
# substrate) over the read_genesis result. 11 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
# Clean any stale .cidhash from previous runs before tests touch
# the filesystem.
rm -f next/genesis/.cidhash
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE; rm -f next/genesis/.cidhash" EXIT
cat > "$TMPFILE" <<'EPOCHS'
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/bootstrap.erl\")) :name)")
;; build_genesis returns {ok, [{cid, _}, {sections, _}]}
(epoch 10)
(eval "(erlang-eval-ast \"{ok, B} = bootstrap:build_genesis(bootstrap:read_genesis()), {Tag, _} = hd(B), Tag\")")
;; The CID is a non-empty binary
(epoch 11)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), is_binary(C)\") :name)")
(epoch 12)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), byte_size(C) > 50\") :name)")
;; build_genesis is deterministic across calls
(epoch 13)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C1}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), {ok, [{cid, C2}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), C1 =:= C2\") :name)")
;; build_genesis preserves the sections list
(epoch 14)
(eval "(erlang-eval-ast \"{ok, [_, {sections, S}]} = bootstrap:build_genesis(bootstrap:read_genesis()), length(S)\")")
;; build_genesis rejects bad input shapes
(epoch 15)
(eval "(get (erlang-eval-ast \"case bootstrap:build_genesis({error, broken}) of {error, {bad_read_result, _}} -> ok; _ -> bad end\") :name)")
;; verify_genesis returns ok when CID matches
(epoch 20)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), bootstrap:verify_genesis(bootstrap:read_genesis(), C) =:= ok\") :name)")
;; verify_genesis returns {error, {cid_mismatch, _, _}} when CID doesn't match
(epoch 21)
(eval "(get (erlang-eval-ast \"case bootstrap:verify_genesis(bootstrap:read_genesis(), <<99,99,99>>) of {error, {cid_mismatch, _, _}} -> ok; _ -> bad end\") :name)")
;; cidhash_path concatenation
(epoch 22)
(eval "(get (erlang-eval-ast \"bootstrap:cidhash_path(<<110,101,120,116>>) =:= <<110,101,120,116,47,46,99,105,100,104,97,115,104>>\") :name)")
;; write_cidhash + read_cidhash round-trip the bundle CID
(epoch 23)
(eval "(get (erlang-eval-ast \"{ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), Base = bootstrap:default_base(), ok = bootstrap:write_cidhash(Base, C), {ok, Stored} = bootstrap:read_cidhash(Base), Stored =:= C\") :name)")
;; Full verify path against the persisted .cidhash
(epoch 24)
(eval "(get (erlang-eval-ast \"Base = bootstrap:default_base(), {ok, [{cid, C}, _]} = bootstrap:build_genesis(bootstrap:read_genesis()), ok = bootstrap:write_cidhash(Base, C), {ok, Stored} = bootstrap:read_cidhash(Base), bootstrap:verify_genesis(bootstrap:read_genesis(), Stored) =:= ok\") :name)")
EPOCHS
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 2 "module load name" "bootstrap"
check 10 "build_genesis head tag" "cid"
check 11 "CID is a binary" "true"
check 12 "CID length > 50" "true"
check 13 "build_genesis deterministic" "true"
check 14 "sections preserved (7 entries)" "7"
check 15 "build_genesis rejects bad shape" "ok"
check 20 "verify_genesis ok when match" "true"
check 21 "verify_genesis errs on mismatch" "ok"
check 22 "cidhash_path concatenation" "true"
check 23 "write/read_cidhash round-trip" "true"
check 24 "verify against persisted hash" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/bootstrap_build.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,126 +0,0 @@
#!/usr/bin/env bash
# next/tests/bootstrap_load.sh — Step 4e acceptance test.
#
# Exercises bootstrap:load_genesis/1 + strip_sx_suffix/1.
# Walks bootstrap:read_genesis output, strips .sx from each
# filename, registers raw bytes as entries under the matching
# kind. 13 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
cat > "$TMPFILE" <<'EPOCHS'
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/registry.erl\")) :name)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/bootstrap.erl\")) :name)")
;; strip_sx_suffix on "create.sx" -> "create"
(epoch 10)
(eval "(get (erlang-eval-ast \"bootstrap:strip_sx_suffix(<<99,114,101,97,116,101,46,115,120>>) =:= <<99,114,101,97,116,101>>\") :name)")
;; strip_sx_suffix unchanged on names without .sx
(epoch 11)
(eval "(get (erlang-eval-ast \"bootstrap:strip_sx_suffix(<<104,101,108,108,111>>) =:= <<104,101,108,108,111>>\") :name)")
;; strip_sx_suffix on exactly ".sx" -> empty binary
(epoch 12)
(eval "(get (erlang-eval-ast \"bootstrap:strip_sx_suffix(<<46,115,120>>) =:= <<>>\") :name)")
;; load_genesis on bad input rejects with proper tag
(epoch 13)
(eval "(get (erlang-eval-ast \"case bootstrap:load_genesis({error, broken}) of {error, {bad_read_result, _}} -> ok; _ -> bad end\") :name)")
;; Per-kind counts after load match the section file counts
(epoch 20)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(activity_types, S))\")")
(epoch 21)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(object_types, S))\")")
(epoch 22)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(projections, S))\")")
(epoch 23)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(validators, S))\")")
(epoch 24)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(codecs, S))\")")
(epoch 25)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(sig_suites, S))\")")
(epoch 26)
(eval "(erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), length(registry:list(audience, S))\")")
;; registry:lookup retrieves a known entry's bytes
(epoch 30)
(eval "(get (erlang-eval-ast \"{ok, S} = bootstrap:load_genesis(bootstrap:read_genesis()), case registry:lookup(activity_types, <<99,114,101,97,116,101>>, S) of {ok, B} -> is_binary(B) and (byte_size(B) > 100); _ -> false end\") :name)")
;; load_genesis is deterministic — compare via cid:to_string of state
(epoch 31)
(eval "(get (erlang-eval-ast \"R = bootstrap:read_genesis(), {ok, S1} = bootstrap:load_genesis(R), {ok, S2} = bootstrap:load_genesis(R), cid:to_string(S1) =:= cid:to_string(S2)\") :name)")
EPOCHS
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 2 "registry module loaded" "registry"
check 3 "bootstrap module loaded" "bootstrap"
check 10 "strip suffix create.sx -> create" "true"
check 11 "strip suffix hello unchanged" "true"
check 12 "strip suffix .sx -> empty" "true"
check 13 "load_genesis rejects bad shape" "ok"
check 20 "loaded activity_types count = 3" "3"
check 21 "loaded object_types count = 10" "10"
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 300 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 2 "gen_server loaded" "gen_server"
check 3 "registry loaded" "registry"
check 4 "bootstrap loaded" "bootstrap"
check 10 "populate returns total 31" "31"
check 20 "activity_types count = 3" "3"
check 21 "object_types count = 10" "10"
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" "3"
check 21 "section object_types count" "10"
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" "3"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/bootstrap_read.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,134 +0,0 @@
#!/usr/bin/env bash
# next/tests/bootstrap_start.sh — Step 4f-consolidate test.
#
# bootstrap:start/3 is the one-call kernel bring-up: starts the
# registry gen_server, populates it from the genesis bundle,
# and starts the nx_kernel gen_server. Each test inlines the
# start call with downstream operations because spawned
# processes don't survive across separate erlang-eval-ast calls.
# 11 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
PRELUDE='KM = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,KM}], AS = [{public_keys,[[{id,k1},{created,0},{value,KM}]]}], bootstrap:start(alice, KS, AS),'
cat > "$TMPFILE" <<EPOCHS
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(er-load-gen-server!)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/kernel/log.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/projection.erl\")) :name)")
(epoch 7)
(eval "(get (erlang-load-module (file-read \"next/kernel/registry.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
(epoch 9)
(eval "(get (erlang-load-module (file-read \"next/kernel/nx_kernel.erl\")) :name)")
(epoch 10)
(eval "(get (erlang-load-module (file-read \"next/kernel/bootstrap.erl\")) :name)")
;; bootstrap:start returns a Pid
(epoch 20)
(eval "(get (erlang-eval-ast \"${PRELUDE} is_pid(whereis(nx_kernel))\") :name)")
;; Registry has 3 activity types after start
(epoch 21)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(activity_types))\")")
;; Registry has 10 object types
(epoch 22)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(object_types))\")")
;; Registry has 7 projections
(epoch 23)
(eval "(erlang-eval-ast \"${PRELUDE} length(registry:list(projections))\")")
;; Total entries across all kinds = 31
(epoch 24)
(eval "(erlang-eval-ast \"${PRELUDE} L = lists:map(fun (K) -> length(registry:list(K)) end, registry:kinds()), lists:foldl(fun (X, A) -> X + A end, 0, L)\")")
;; nx_kernel fresh log_tip = 0
(epoch 25)
(eval "(erlang-eval-ast \"${PRELUDE} nx_kernel:log_tip()\")")
;; nx_kernel publish advances log_tip
(epoch 26)
(eval "(erlang-eval-ast \"${PRELUDE} nx_kernel:publish([{type, create}, {object, nil}]), nx_kernel:log_tip()\")")
;; nx_kernel state carries the supplied actor_id
(epoch 27)
(eval "(get (erlang-eval-ast \"${PRELUDE} nx_kernel:actor_id(nx_kernel:query()) =:= alice\") :name)")
;; Registry lookup works after start (canonical entry: Create)
(epoch 28)
(eval "(get (erlang-eval-ast \"${PRELUDE} case registry:lookup(activity_types, <<99,114,101,97,116,101>>) of {ok, _} -> ok; _ -> bad end\") :name)")
EPOCHS
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 10 "bootstrap module loaded" "bootstrap"
check 20 "whereis(nx_kernel) is Pid" "true"
check 21 "activity_types count = 3" "3"
check 22 "object_types count = 10" "10"
check 23 "projections count = 7" "7"
check 24 "total entries = 31" "31"
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,105 +0,0 @@
#!/usr/bin/env bash
# next/tests/envelope_canonical.sh — Step 2b acceptance test.
#
# Loads next/kernel/envelope.erl and checks canonical_bytes/1 contract:
# returns a binary, deterministic across runs, invariant under
# field-order permutation, invariant under signature changes, and
# different for different covered content. 7 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
cat > "$TMPFILE" <<'EPOCHS'
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
;; canonical_bytes returns a binary
(epoch 10)
(eval "(get (erlang-eval-ast \"is_binary(envelope:canonical_bytes([{id,1},{type,create},{actor,alice},{published,1000},{signature,whatever}]))\") :name)")
;; Determinism: same envelope twice -> same bytes
(epoch 11)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =:= envelope:canonical_bytes([{id,1},{type,create},{actor,alice}])\") :name)")
;; Signature stripping: different signatures -> same canonical bytes
(epoch 12)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice},{signature,sig_one}]) =:= envelope:canonical_bytes([{id,1},{type,create},{actor,alice},{signature,sig_two}])\") :name)")
;; No signature vs some signature -> same canonical bytes
(epoch 13)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =:= envelope:canonical_bytes([{id,1},{type,create},{actor,alice},{signature,whatever}])\") :name)")
;; Key-order invariance: reordering top-level fields -> same bytes
(epoch 14)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =:= envelope:canonical_bytes([{actor,alice},{type,create},{id,1}])\") :name)")
;; Changing a covered field changes the bytes
(epoch 15)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =/= envelope:canonical_bytes([{id,2},{type,create},{actor,alice}])\") :name)")
;; Distinct envelopes -> distinct bytes
(epoch 16)
(eval "(get (erlang-eval-ast \"envelope:canonical_bytes([{id,1},{type,create},{actor,alice}]) =/= envelope:canonical_bytes([{id,1},{type,update},{actor,bob}])\") :name)")
EPOCHS
OUTPUT=$(timeout 120 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 2 "module load name" "envelope"
check 10 "canonical_bytes returns binary" "true"
check 11 "deterministic" "true"
check 12 "signature stripped (changes)" "true"
check 13 "signature stripped (absent)" "true"
check 14 "key-order invariant" "true"
check 15 "covered field change visible" "true"
check 16 "distinct envelopes distinct" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/envelope_canonical.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,126 +0,0 @@
#!/usr/bin/env bash
# next/tests/envelope_shape.sh — Step 2a acceptance test.
#
# Loads next/kernel/envelope.erl into the Erlang-on-SX runtime and
# checks validate_shape/1 / get_field/2 against the design §3.1 shape
# contract. 13 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
cat > "$TMPFILE" <<'EPOCHS'
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
;; Reusable valid envelope as Erlang text. The signature itself is a
;; property list with key_id, algorithm, value.
;; E0 = [{id,1},{type,create},{actor,alice},{published,1000},
;; {signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]
;; Complete valid envelope
(epoch 10)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= ok\") :name)")
;; Missing each top-level required field
(epoch 11)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{type,create},{actor,alice},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= {error,{missing_field,id}}\") :name)")
(epoch 12)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{actor,alice},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= {error,{missing_field,type}}\") :name)")
(epoch 13)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= {error,{missing_field,actor}}\") :name)")
(epoch 14)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{signature,[{key_id,k1},{algorithm,ed25519},{value,v}]}]) =:= {error,{missing_field,published}}\") :name)")
(epoch 15)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000}]) =:= {error,{missing_field,signature}}\") :name)")
;; Non-list inputs
(epoch 16)
(eval "(get (erlang-eval-ast \"envelope:validate_shape(42) =:= {error,not_a_proplist}\") :name)")
(epoch 17)
(eval "(get (erlang-eval-ast \"envelope:validate_shape(some_atom) =:= {error,not_a_proplist}\") :name)")
;; Signature sub-shape
(epoch 20)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,[{algorithm,ed25519},{value,v}]}]) =:= {error,{bad_signature,{missing_field,key_id}}}\") :name)")
(epoch 21)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,[{key_id,k1},{value,v}]}]) =:= {error,{bad_signature,{missing_field,algorithm}}}\") :name)")
(epoch 22)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,[{key_id,k1},{algorithm,ed25519}]}]) =:= {error,{bad_signature,{missing_field,value}}}\") :name)")
(epoch 23)
(eval "(get (erlang-eval-ast \"envelope:validate_shape([{id,1},{type,create},{actor,alice},{published,1000},{signature,not_a_proplist}]) =:= {error,{bad_signature,not_a_proplist}}\") :name)")
;; get_field
(epoch 30)
(eval "(get (erlang-eval-ast \"envelope:get_field(actor,[{id,1},{actor,alice}]) =:= {ok,alice}\") :name)")
(epoch 31)
(eval "(get (erlang-eval-ast \"envelope:get_field(missing,[{id,1},{actor,alice}]) =:= not_found\") :name)")
EPOCHS
OUTPUT=$(timeout 120 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 2 "module load name" "envelope"
check 10 "complete envelope -> ok" "true"
check 11 "missing id" "true"
check 12 "missing type" "true"
check 13 "missing actor" "true"
check 14 "missing published" "true"
check 15 "missing signature" "true"
check 16 "non-list (integer)" "true"
check 17 "non-list (atom)" "true"
check 20 "signature missing key_id" "true"
check 21 "signature missing algorithm" "true"
check 22 "signature missing value" "true"
check 23 "signature not a proplist" "true"
check 30 "get_field hit" "true"
check 31 "get_field miss" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/envelope_shape.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,129 +0,0 @@
#!/usr/bin/env bash
# next/tests/envelope_sig.sh — Step 2c acceptance test.
#
# Exercises envelope:verify_signature/2 against the full sig pipeline:
# canonical_bytes + crypto:hash MAC + time-aware key validity per design
# §9.6. 10 cases.
#
# The signature stand-in is HMAC-shaped:
# sig.value = crypto:hash(sha256, <<KeyMaterial/binary, CanonicalBytes/binary>>)
# Real Ed25519/RSA verification is deferred to milestone 2 once the
# corresponding crypto BIFs are wired.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
# Shared Erlang prelude builds a valid-signed envelope template and an
# actor state with one active key. Each test reuses these and asserts
# against an Erlang =:= comparison so the result is a bare boolean.
PRELUDE='KM = <<1,2,3,4>>, U = [{actor,alice},{id,1},{published,100},{type,create}], CB = envelope:canonical_bytes(U), Sig = crypto:hash(sha256, <<KM/binary, CB/binary>>), Env = [{actor,alice},{id,1},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,Sig}]}], AS = [{public_keys, [[{id,k1},{created,50},{value,KM}]]}],'
cat > "$TMPFILE" <<EPOCHS
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
;; valid sig + active key -> ok
(epoch 10)
(eval "(get (erlang-eval-ast \"${PRELUDE} envelope:verify_signature(Env, AS) =:= ok\") :name)")
;; tampered envelope (id mutated post-sign) -> bad_signature
(epoch 11)
(eval "(get (erlang-eval-ast \"${PRELUDE} Tampered = [{actor,alice},{id,999},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,Sig}]}], envelope:verify_signature(Tampered, AS) =:= {error,bad_signature}\") :name)")
;; wrong sig value (random bytes) -> bad_signature
(epoch 12)
(eval "(get (erlang-eval-ast \"${PRELUDE} BadEnv = [{actor,alice},{id,1},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,<<0,0,0,0>>}]}], envelope:verify_signature(BadEnv, AS) =:= {error,bad_signature}\") :name)")
;; unknown key_id -> no_active_key
(epoch 13)
(eval "(get (erlang-eval-ast \"${PRELUDE} OtherAS = [{public_keys, [[{id,k_other},{created,50},{value,KM}]]}], envelope:verify_signature(Env, OtherAS) =:= {error,no_active_key}\") :name)")
;; key superseded BEFORE published -> no_active_key
(epoch 14)
(eval "(get (erlang-eval-ast \"${PRELUDE} SupAS = [{public_keys, [[{id,k1},{created,50},{superseded_at,80},{value,KM}]]}], envelope:verify_signature(Env, SupAS) =:= {error,no_active_key}\") :name)")
;; key superseded AFTER published -> ok (historical valid)
(epoch 15)
(eval "(get (erlang-eval-ast \"${PRELUDE} SupAS2 = [{public_keys, [[{id,k1},{created,50},{superseded_at,200},{value,KM}]]}], envelope:verify_signature(Env, SupAS2) =:= ok\") :name)")
;; key not yet created at published -> no_active_key
(epoch 16)
(eval "(get (erlang-eval-ast \"${PRELUDE} FutAS = [{public_keys, [[{id,k1},{created,150},{value,KM}]]}], envelope:verify_signature(Env, FutAS) =:= {error,no_active_key}\") :name)")
;; missing signature field -> no_signature
(epoch 17)
(eval "(get (erlang-eval-ast \"${PRELUDE} envelope:verify_signature(U, AS) =:= {error,no_signature}\") :name)")
;; actor state with no public_keys field -> no_keys
(epoch 18)
(eval "(get (erlang-eval-ast \"${PRELUDE} envelope:verify_signature(Env, []) =:= {error,no_keys}\") :name)")
;; second key in list matches when first doesn't (lookup walks list)
(epoch 19)
(eval "(get (erlang-eval-ast \"${PRELUDE} TwoKeys = [{public_keys, [[{id,k_other},{created,50},{value,<<9,9,9>>}], [{id,k1},{created,50},{value,KM}]]}], envelope:verify_signature(Env, TwoKeys) =:= ok\") :name)")
EPOCHS
OUTPUT=$(timeout 120 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 2 "module load name" "envelope"
check 10 "valid sig active key" "true"
check 11 "tampered envelope" "true"
check 12 "wrong sig value" "true"
check 13 "unknown key_id" "true"
check 14 "key superseded before published" "true"
check 15 "key superseded after published" "true"
check 16 "key not yet created" "true"
check 17 "missing signature field" "true"
check 18 "actor state no keys" "true"
check 19 "match second key in list" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/envelope_sig.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,206 +0,0 @@
#!/usr/bin/env bash
# next/tests/genesis_parse.sh — Step 4a acceptance test.
#
# Confirms the seed genesis SX files parse cleanly and have the
# expected top-level head form. The bundler (Step 4c+) consumes
# these forms directly as data. 50 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 10)
(eval "(first (parse (file-read \"next/genesis/manifest.sx\")))")
(epoch 11)
(eval "(first (parse (file-read \"next/genesis/activity-types/create.sx\")))")
(epoch 12)
(eval "(first (get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :activity-types))")
(epoch 13)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/activity-types/create.sx\")))) :name)")
(epoch 14)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :version)")
(epoch 15)
(eval "(first (parse (file-read \"next/genesis/activity-types/update.sx\")))")
(epoch 16)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/activity-types/update.sx\")))) :name)")
(epoch 17)
(eval "(first (parse (file-read \"next/genesis/activity-types/delete.sx\")))")
(epoch 18)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/activity-types/delete.sx\")))) :name)")
(epoch 19)
(eval "(len (get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :activity-types))")
(epoch 30)
(eval "(first (parse (file-read \"next/genesis/object-types/sx-artifact.sx\")))")
(epoch 31)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/sx-artifact.sx\")))) :name)")
(epoch 32)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/note.sx\")))) :name)")
(epoch 33)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/tombstone.sx\")))) :name)")
(epoch 34)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/define-activity.sx\")))) :name)")
(epoch 35)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/define-object.sx\")))) :name)")
(epoch 36)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/define-projection.sx\")))) :name)")
(epoch 37)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/define-validator.sx\")))) :name)")
(epoch 38)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/define-codec.sx\")))) :name)")
(epoch 39)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/define-sig-suite.sx\")))) :name)")
(epoch 40)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/object-types/snapshot.sx\")))) :name)")
(epoch 41)
(eval "(len (get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :object-types))")
(epoch 50)
(eval "(first (parse (file-read \"next/genesis/projections/activity-log.sx\")))")
(epoch 51)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/projections/activity-log.sx\")))) :name)")
(epoch 52)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/projections/by-type.sx\")))) :name)")
(epoch 53)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/projections/by-actor.sx\")))) :name)")
(epoch 54)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/projections/by-object.sx\")))) :name)")
(epoch 55)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/projections/actor-state.sx\")))) :name)")
(epoch 56)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/projections/define-registry.sx\")))) :name)")
(epoch 57)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/projections/audience-graph.sx\")))) :name)")
(epoch 58)
(eval "(len (get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :projections))")
(epoch 60)
(eval "(first (parse (file-read \"next/genesis/validators/envelope-shape.sx\")))")
(epoch 61)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/validators/envelope-shape.sx\")))) :name)")
(epoch 62)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/validators/signature.sx\")))) :name)")
(epoch 63)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/validators/type-schema.sx\")))) :name)")
(epoch 64)
(eval "(len (get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :validators))")
(epoch 70)
(eval "(first (parse (file-read \"next/genesis/codecs/dag-cbor.sx\")))")
(epoch 71)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/codecs/dag-cbor.sx\")))) :name)")
(epoch 72)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/codecs/raw.sx\")))) :name)")
(epoch 73)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/codecs/dag-json.sx\")))) :name)")
(epoch 74)
(eval "(len (get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :codecs))")
(epoch 80)
(eval "(first (parse (file-read \"next/genesis/sig-suites/rsa-sha256-2018.sx\")))")
(epoch 81)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/sig-suites/rsa-sha256-2018.sx\")))) :name)")
(epoch 82)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/sig-suites/ed25519-2020.sx\")))) :name)")
(epoch 83)
(eval "(len (get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :sig-suites))")
(epoch 90)
(eval "(first (parse (file-read \"next/genesis/audience/public.sx\")))")
(epoch 91)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/audience/public.sx\")))) :name)")
(epoch 92)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/audience/followers.sx\")))) :name)")
(epoch 93)
(eval "(get (apply dict (rest (parse (file-read \"next/genesis/audience/direct.sx\")))) :name)")
(epoch 94)
(eval "(len (get (apply dict (rest (parse (file-read \"next/genesis/manifest.sx\")))) :audience))")
EPOCHS
OUTPUT=$(timeout 30 "$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 "manifest.sx head form" "GenesisManifest"
check 11 "create.sx head form" "DefineActivity"
check 12 "manifest lists create.sx" "activity-types/create.sx"
check 13 "create.sx name is Create" "Create"
check 14 "manifest version present" "0.0.1"
check 15 "update.sx head form" "DefineActivity"
check 16 "update.sx name is Update" "Update"
check 17 "delete.sx head form" "DefineActivity"
check 18 "delete.sx name is Delete" "Delete"
check 19 "manifest has 3 activity-types" "3"
check 30 "sx-artifact.sx head form" "DefineObject"
check 31 "sx-artifact.sx name" "SXArtifact"
check 32 "note.sx name" "Note"
check 33 "tombstone.sx name" "Tombstone"
check 34 "define-activity.sx name" "DefineActivity"
check 35 "define-object.sx name" "DefineObject"
check 36 "define-projection.sx name" "DefineProjection"
check 37 "define-validator.sx name" "DefineValidator"
check 38 "define-codec.sx name" "DefineCodec"
check 39 "define-sig-suite.sx name" "DefineSigSuite"
check 40 "snapshot.sx name" "Snapshot"
check 41 "manifest has 10 object-types" "10"
check 50 "activity-log.sx head form" "DefineProjection"
check 51 "activity-log.sx name" "activity-log"
check 52 "by-type.sx name" "by-type"
check 53 "by-actor.sx name" "by-actor"
check 54 "by-object.sx name" "by-object"
check 55 "actor-state.sx name" "actor-state"
check 56 "define-registry.sx name" "define-registry"
check 57 "audience-graph.sx name" "audience-graph"
check 58 "manifest has 7 projections" "7"
check 60 "envelope-shape.sx head form" "DefineValidator"
check 61 "envelope-shape.sx name" "envelope-shape"
check 62 "signature.sx name" "signature"
check 63 "type-schema.sx name" "type-schema"
check 64 "manifest has 3 validators" "3"
check 70 "dag-cbor.sx head form" "DefineCodec"
check 71 "dag-cbor.sx name" "dag-cbor"
check 72 "raw.sx name" "raw"
check 73 "dag-json.sx name" "dag-json"
check 74 "manifest has 3 codecs" "3"
check 80 "rsa-sha256-2018.sx head form" "DefineSigSuite"
check 81 "rsa-sha256-2018.sx name" "rsa-sha256-2018"
check 82 "ed25519-2020.sx name" "ed25519-2020"
check 83 "manifest has 2 sig-suites" "2"
check 90 "public.sx head form" "DefineAudience"
check 91 "public.sx name" "Public"
check 92 "followers.sx name" "Followers"
check 93 "direct.sx name" "Direct"
check 94 "manifest has 3 audience" "3"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/genesis_parse.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,128 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_accept.sh — Step 8d-accept acceptance test.
#
# Exercises accept_format/1 + accept_format_from/1. 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/http_server.erl\")) :name)")
;; activity_json
(epoch 10)
(eval "(get (erlang-eval-ast \"http_server:accept_format(<<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>>)\") :name)")
;; json
(epoch 11)
(eval "(get (erlang-eval-ast \"http_server:accept_format(<<97,112,112,108,105,99,97,116,105,111,110,47,106,115,111,110>>)\") :name)")
;; sx
(epoch 12)
(eval "(get (erlang-eval-ast \"http_server:accept_format(<<97,112,112,108,105,99,97,116,105,111,110,47,115,120>>)\") :name)")
;; cbor
(epoch 13)
(eval "(get (erlang-eval-ast \"http_server:accept_format(<<97,112,112,108,105,99,97,116,105,111,110,47,99,98,111,114>>)\") :name)")
;; text/plain -> text
(epoch 14)
(eval "(get (erlang-eval-ast \"http_server:accept_format(<<116,101,120,116,47,112,108,97,105,110>>)\") :name)")
;; nil -> text
(epoch 15)
(eval "(get (erlang-eval-ast \"http_server:accept_format(nil)\") :name)")
;; empty binary -> text
(epoch 16)
(eval "(get (erlang-eval-ast \"http_server:accept_format(<<>>)\") :name)")
;; activity_json wins over json when both present at the start
;; "application/activity+json, application/json"
(epoch 17)
(eval "(get (erlang-eval-ast \"http_server:accept_format(<<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,44,32,97,112,112,108,105,99,97,116,105,111,110,47,106,115,111,110>>)\") :name)")
;; accept_format_from with no header field -> text
(epoch 18)
(eval "(get (erlang-eval-ast \"http_server:accept_format_from([])\") :name)")
;; accept_format_from with Accept header
(epoch 19)
(eval "(get (erlang-eval-ast \"AK = <<97,99,99,101,112,116>>, AV = <<97,112,112,108,105,99,97,116,105,111,110,47,115,120>>, http_server:accept_format_from([{headers, [{AK, AV}]}])\") :name)")
;; accept_format_from with headers but no Accept -> text
(epoch 20)
(eval "(get (erlang-eval-ast \"OK = <<102,111,111>>, http_server:accept_format_from([{headers, [{OK, <<98,97,114>>}]}])\") :name)")
;; accept_format on a non-binary returns text
(epoch 21)
(eval "(get (erlang-eval-ast \"http_server:accept_format(some_atom)\") :name)")
EPOCHS
OUTPUT=$(timeout 60 "$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" "http_server"
check 10 "activity+json -> activity_json" "activity_json"
check 11 "json -> json" "json"
check 12 "sx -> sx" "sx"
check 13 "cbor -> cbor" "cbor"
check 14 "text/plain -> text" "text"
check 15 "nil -> text" "text"
check 16 "empty binary -> text" "text"
check 17 "activity+json wins over json" "activity_json"
check 18 "no headers -> text" "text"
check 19 "Accept: application/sx -> sx" "sx"
check 20 "no Accept header -> text" "text"
check 21 "non-binary input -> text" "text"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_accept.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,129 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_actors.sh — Step 8c-actors acceptance test.
#
# Exercises match_prefix/2 + GET /actors/{id} route. The id is
# carried back in the response body so callers can confirm the
# right segment was extracted. 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/http_server.erl\")) :name)")
;; match_prefix on a clean match returns the rest
(epoch 10)
(eval "(get (erlang-eval-ast \"http_server:match_prefix(<<97,98>>, <<97,98,99,100>>) =:= {ok, <<99,100>>}\") :name)")
;; Empty prefix matches everything
(epoch 11)
(eval "(get (erlang-eval-ast \"http_server:match_prefix(<<>>, <<97,98,99>>) =:= {ok, <<97,98,99>>}\") :name)")
;; No common bytes -> nomatch
(epoch 12)
(eval "(get (erlang-eval-ast \"http_server:match_prefix(<<97,98>>, <<120,121>>) =:= nomatch\") :name)")
;; Prefix longer than path -> nomatch
(epoch 13)
(eval "(get (erlang-eval-ast \"http_server:match_prefix(<<97,98,99,100>>, <<97,98>>) =:= nomatch\") :name)")
;; Exact match yields empty rest
(epoch 14)
(eval "(get (erlang-eval-ast \"http_server:match_prefix(<<97,98>>, <<97,98>>) =:= {ok, <<>>}\") :name)")
;; actors_prefix is "/actors/" — 8 bytes
(epoch 15)
(eval "(erlang-eval-ast \"byte_size(http_server:actors_prefix())\")")
;; GET /actors/alice -> 200
(epoch 16)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97,108,105,99,101>>}], case http_server:route(Req) of [{status, 200} | _] -> ok; _ -> bad end\") :name)")
;; The id appears in the body
(epoch 17)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97,108,105,99,101>>}], R = http_server:route(Req), case R of [_, _, {body, B}] -> http_server:match_prefix(<<97,99,116,111,114,58,32>>, B) =/= nomatch; _ -> false end\") :name)")
;; GET /actors/ (empty id) -> 404
(epoch 18)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47>>}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; POST /actors/alice -> 404 (only GET)
(epoch 19)
(eval "(get (erlang-eval-ast \"Req = [{method, <<80,79,83,84>>}, {path, <<47,97,99,116,111,114,115,47,97,108,105,99,101>>}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; GET /unrelated still 404
(epoch 20)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47,102,111,111>>}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; Existing routes (GET /, capabilities) still work
(epoch 21)
(eval "(get (erlang-eval-ast \"Req1 = [{method, <<71,69,84>>}, {path, <<47>>}], Req2 = [{method, <<71,69,84>>}, {path, http_server:capabilities_path()}], R1 = case http_server:route(Req1) of [{status, 200} | _] -> ok; _ -> bad end, R2 = case http_server:route(Req2) of [{status, 200} | _] -> ok; _ -> bad end, {R1, R2} =:= {ok, ok}\") :name)")
EPOCHS
OUTPUT=$(timeout 60 "$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" "http_server"
check 10 "match_prefix clean match" "true"
check 11 "empty prefix matches all" "true"
check 12 "no common bytes -> nomatch" "true"
check 13 "prefix > path -> nomatch" "true"
check 14 "exact match -> empty rest" "true"
check 15 "actors_prefix size = 8" "8"
check 16 "GET /actors/alice -> 200" "ok"
check 17 "body carries 'actor: ' prefix" "true"
check 18 "GET /actors/ (empty id) -> 404" "ok"
check 19 "POST /actors/alice -> 404" "ok"
check 20 "GET /unrelated still 404" "ok"
check 21 "existing routes intact" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_actors.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,108 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_artifacts.sh — Step 8c-art acceptance test.
#
# Exercises GET /artifacts/{cid} via the shared match_prefix
# machinery. Mirrors the actors-route test shape. 9 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/http_server.erl\")) :name)")
;; artifacts_prefix is "/artifacts/" — 11 bytes
(epoch 10)
(eval "(erlang-eval-ast \"byte_size(http_server:artifacts_prefix())\")")
;; GET /artifacts/<cid> -> 200
(epoch 11)
(eval "(get (erlang-eval-ast \"Cid = <<98,97,102,107,114,101,49>>, Req = [{method, <<71,69,84>>}, {path, <<(http_server:artifacts_prefix())/binary, Cid/binary>>}], case http_server:route(Req) of [{status, 200} | _] -> ok; _ -> bad end\") :name)")
;; The cid is echoed in the body (carries 'artifact: ' prefix)
(epoch 12)
(eval "(get (erlang-eval-ast \"Cid = <<98,97,102,107,114,101,49>>, Req = [{method, <<71,69,84>>}, {path, <<(http_server:artifacts_prefix())/binary, Cid/binary>>}], R = http_server:route(Req), case R of [_, _, {body, B}] -> http_server:match_prefix(<<97,114,116,105,102,97,99,116,58,32>>, B) =/= nomatch; _ -> false end\") :name)")
;; GET /artifacts/ (empty cid) -> 404
(epoch 13)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, http_server:artifacts_prefix()}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; POST /artifacts/<cid> -> 404 (only GET)
(epoch 14)
(eval "(get (erlang-eval-ast \"Cid = <<98,97,102>>, Req = [{method, <<80,79,83,84>>}, {path, <<(http_server:artifacts_prefix())/binary, Cid/binary>>}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; Actor and artifact routes don't collide
(epoch 15)
(eval "(get (erlang-eval-ast \"R1 = http_server:route([{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97>>}]), R2 = http_server:route([{method, <<71,69,84>>}, {path, <<(http_server:artifacts_prefix())/binary, 98>>}]), case {R1, R2} of {[{status, 200} | _], [{status, 200} | _]} -> ok; _ -> bad end\") :name)")
;; Existing routes (GET /, capabilities) still work
(epoch 16)
(eval "(get (erlang-eval-ast \"R1 = case http_server:route([{method, <<71,69,84>>}, {path, <<47>>}]) of [{status, 200} | _] -> ok; _ -> bad end, R2 = case http_server:route([{method, <<71,69,84>>}, {path, http_server:capabilities_path()}]) of [{status, 200} | _] -> ok; _ -> bad end, {R1, R2} =:= {ok, ok}\") :name)")
;; artifacts_prefix starts with '/'
(epoch 17)
(eval "(get (erlang-eval-ast \"case http_server:artifacts_prefix() of <<47, _/binary>> -> ok; _ -> bad end\") :name)")
EPOCHS
OUTPUT=$(timeout 60 "$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" "http_server"
check 10 "artifacts_prefix size = 11" "11"
check 11 "GET /artifacts/<cid> -> 200" "ok"
check 12 "body carries 'artifact: '" "true"
check 13 "GET /artifacts/ (empty) -> 404" "ok"
check 14 "POST /artifacts/<cid> -> 404" "ok"
check 15 "actors + artifacts no collision" "ok"
check 16 "static routes still 200" "true"
check 17 "artifacts_prefix leading /" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_artifacts.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,105 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_capabilities.sh — Step 8c-cap acceptance test.
#
# Exercises GET /.well-known/sx-capabilities — kernel-version
# descriptor per design §16. The path is exposed as
# http_server:capabilities_path/0 so tests don't have to spell
# it byte-by-byte. 7 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
cat > "$TMPFILE" <<'EPOCHS'
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
;; capabilities_path is exposed and non-empty
(epoch 10)
(eval "(get (erlang-eval-ast \"byte_size(http_server:capabilities_path()) > 10\") :name)")
;; GET capabilities_path returns 200
(epoch 11)
(eval "(get (erlang-eval-ast \"P = http_server:capabilities_path(), Req = [{method, <<71,69,84>>}, {path, P}], case http_server:route(Req) of [{status, 200} | _] -> ok; _ -> bad end\") :name)")
;; Capabilities body is non-empty and contains the verb names
(epoch 12)
(eval "(get (erlang-eval-ast \"B = http_server:capabilities_body(), byte_size(B) > 30\") :name)")
;; POST to capabilities path returns 404 (only GET dispatched)
(epoch 13)
(eval "(get (erlang-eval-ast \"P = http_server:capabilities_path(), Req = [{method, <<80,79,83,84>>}, {path, P}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; Route returns capabilities_body when matching
(epoch 14)
(eval "(get (erlang-eval-ast \"P = http_server:capabilities_path(), Req = [{method, <<71,69,84>>}, {path, P}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= http_server:capabilities_body(); _ -> false end\") :name)")
;; capabilities_path starts with '/' (47)
(epoch 15)
(eval "(get (erlang-eval-ast \"case http_server:capabilities_path() of <<47, _/binary>> -> ok; _ -> bad end\") :name)")
;; Existing GET / route still works (no regression from the new clause)
(epoch 16)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47>>}], case http_server:route(Req) of [{status, 200} | _] -> ok; _ -> bad end\") :name)")
EPOCHS
OUTPUT=$(timeout 60 "$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" "http_server"
check 10 "capabilities_path non-empty" "true"
check 11 "GET capabilities -> 200" "ok"
check 12 "capabilities body non-empty" "true"
check 13 "POST capabilities -> 404" "ok"
check 14 "route body matches capabilities" "true"
check 15 "capabilities_path leading /" "ok"
check 16 "GET / still works" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_capabilities.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,133 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_capabilities_format.sh — Step 8d-dispatch-cap test.
#
# Proves Accept header dispatch end-to-end on the
# /.well-known/sx-capabilities route. 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
# Shared bindings for the test:
# AK = "accept" header key
# CapPath = capabilities path (looked up from the module)
PRELUDE='AK = <<97,99,99,101,112,116>>, CapPath = http_server:capabilities_path(),'
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/http_server.erl\")) :name)")
;; capabilities_body_for(text) == capabilities_body()
(epoch 10)
(eval "(get (erlang-eval-ast \"http_server:capabilities_body_for(text) =:= http_server:capabilities_body()\") :name)")
;; All format stubs are distinct
(epoch 11)
(eval "(get (erlang-eval-ast \"T = http_server:capabilities_body_for(text), J = http_server:capabilities_body_for(json), S = http_server:capabilities_body_for(sx), C = http_server:capabilities_body_for(cbor), (T =/= J) and (J =/= S) and (S =/= C) and (T =/= C)\") :name)")
;; json body starts with '{' (123)
(epoch 12)
(eval "(get (erlang-eval-ast \"case http_server:capabilities_body_for(json) of <<123, _/binary>> -> ok; _ -> bad end\") :name)")
;; sx body starts with '(' (40)
(epoch 13)
(eval "(get (erlang-eval-ast \"case http_server:capabilities_body_for(sx) of <<40, _/binary>> -> ok; _ -> bad end\") :name)")
;; cbor body starts with 0xA1 (161) — map(1)
(epoch 14)
(eval "(get (erlang-eval-ast \"case http_server:capabilities_body_for(cbor) of <<161, _/binary>> -> ok; _ -> bad end\") :name)")
;; activity_json shares its body with json
(epoch 15)
(eval "(get (erlang-eval-ast \"http_server:capabilities_body_for(activity_json) =:= http_server:capabilities_body_for(json)\") :name)")
;; Unknown format falls back to text
(epoch 16)
(eval "(get (erlang-eval-ast \"http_server:capabilities_body_for(weird_format) =:= http_server:capabilities_body()\") :name)")
;; Route with Accept: application/json -> json body
(epoch 17)
(eval "(get (erlang-eval-ast \"${PRELUDE} AV = <<97,112,112,108,105,99,97,116,105,111,110,47,106,115,111,110>>, Req = [{method, <<71,69,84>>}, {path, CapPath}, {headers, [{AK, AV}]}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= http_server:capabilities_body_for(json); _ -> false end\") :name)")
;; Route with Accept: application/sx -> sx body
(epoch 18)
(eval "(get (erlang-eval-ast \"${PRELUDE} AV = <<97,112,112,108,105,99,97,116,105,111,110,47,115,120>>, Req = [{method, <<71,69,84>>}, {path, CapPath}, {headers, [{AK, AV}]}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= http_server:capabilities_body_for(sx); _ -> false end\") :name)")
;; Route with Accept: application/cbor -> cbor body
(epoch 19)
(eval "(get (erlang-eval-ast \"${PRELUDE} AV = <<97,112,112,108,105,99,97,116,105,111,110,47,99,98,111,114>>, Req = [{method, <<71,69,84>>}, {path, CapPath}, {headers, [{AK, AV}]}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= http_server:capabilities_body_for(cbor); _ -> false end\") :name)")
;; No Accept header -> text body
(epoch 20)
(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<71,69,84>>}, {path, CapPath}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= http_server:capabilities_body(); _ -> false end\") :name)")
;; POST capabilities still 404
(epoch 21)
(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<80,79,83,84>>}, {path, CapPath}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
EPOCHS
OUTPUT=$(timeout 60 "$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" "http_server"
check 10 "text format = existing body" "true"
check 11 "all format stubs distinct" "true"
check 12 "json body starts with '{'" "ok"
check 13 "sx body starts with '('" "ok"
check 14 "cbor body starts with 0xA1" "ok"
check 15 "activity_json == json body" "true"
check 16 "unknown format -> text" "true"
check 17 "Accept: json -> json body" "true"
check 18 "Accept: sx -> sx body" "true"
check 19 "Accept: cbor -> cbor body" "true"
check 20 "no Accept -> text body" "true"
check 21 "POST capabilities still 404" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_capabilities_format.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,119 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_content_type.sh — Step 8d-content-type test.
#
# Exercises content_type_for/1 and ok_response/2. 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/http_server.erl\")) :name)")
;; content_type_for returns the right byte size per format
(epoch 10)
(eval "(erlang-eval-ast \"byte_size(http_server:content_type_for(text))\")")
(epoch 11)
(eval "(erlang-eval-ast \"byte_size(http_server:content_type_for(json))\")")
(epoch 12)
(eval "(erlang-eval-ast \"byte_size(http_server:content_type_for(activity_json))\")")
(epoch 13)
(eval "(erlang-eval-ast \"byte_size(http_server:content_type_for(sx))\")")
(epoch 14)
(eval "(erlang-eval-ast \"byte_size(http_server:content_type_for(cbor))\")")
;; All content types are distinct
(epoch 15)
(eval "(get (erlang-eval-ast \"T = http_server:content_type_for(text), J = http_server:content_type_for(json), AJ = http_server:content_type_for(activity_json), S = http_server:content_type_for(sx), C = http_server:content_type_for(cbor), (T =/= J) and (J =/= AJ) and (AJ =/= S) and (S =/= C) and (T =/= C)\") :name)")
;; Unknown format -> text Content-Type
(epoch 16)
(eval "(get (erlang-eval-ast \"http_server:content_type_for(weird) =:= http_server:content_type_for(text)\") :name)")
;; ok_response/2 has shape [{status, 200}, {headers, [{ct, ...}]}, {body, ...}]
(epoch 17)
(eval "(get (erlang-eval-ast \"R = http_server:ok_response(<<1,2>>, json), case R of [{status, 200}, {headers, [{<<99,111,110,116,101,110,116,45,116,121,112,101>>, _}]}, {body, <<1,2>>}] -> ok; _ -> bad end\") :name)")
;; ok_response/2's CT value matches content_type_for for that format
(epoch 18)
(eval "(get (erlang-eval-ast \"R = http_server:ok_response(<<>>, sx), case R of [_, {headers, [{_, CT}]}, _] -> CT =:= http_server:content_type_for(sx); _ -> false end\") :name)")
;; ok_response/2 carries the body unchanged
(epoch 19)
(eval "(get (erlang-eval-ast \"R = http_server:ok_response(<<104,105>>, cbor), case R of [_, _, {body, <<104,105>>}] -> ok; _ -> bad end\") :name)")
;; activity_json starts with 'application' (97)
(epoch 20)
(eval "(get (erlang-eval-ast \"case http_server:content_type_for(activity_json) of <<97, _/binary>> -> ok; _ -> bad end\") :name)")
;; Existing ok_response/1 still works (backwards compat)
(epoch 21)
(eval "(get (erlang-eval-ast \"R = http_server:ok_response(<<1,2,3>>), case R of [{status, 200}, {headers, []}, {body, <<1,2,3>>}] -> ok; _ -> bad end\") :name)")
EPOCHS
OUTPUT=$(timeout 60 "$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" "http_server"
check 10 "text -> 'text/plain' (10b)" "10"
check 11 "json -> 'application/json' (16b)" "16"
check 12 "activity_json (25b)" "25"
check 13 "sx (14b)" "14"
check 14 "cbor (16b)" "16"
check 15 "all CTs distinct" "true"
check 16 "unknown -> text" "true"
check 17 "ok_response/2 shape" "ok"
check 18 "ok_response/2 CT matches" "true"
check 19 "body carried through" "ok"
check 20 "activity_json starts 'a'" "ok"
check 21 "ok_response/1 backward-compat" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_content_type.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,147 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_get_format.sh — Step 8d-dispatch-get test.
#
# Verifies actor/artifact/projection/projections_list GET routes
# return format-specific bodies + the right Content-Type. 16 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
# Common: accept key + several Accept values
PRELUDE='AK = <<97,99,99,101,112,116>>, JsonAV = <<97,112,112,108,105,99,97,116,105,111,110,47,106,115,111,110>>, SxAV = <<97,112,112,108,105,99,97,116,105,111,110,47,115,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 "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
;; actor_doc_response_for(text) matches text-only counterpart
(epoch 10)
(eval "(get (erlang-eval-ast \"http_server:actor_doc_response_for(<<97>>, text) =:= http_server:actor_doc_response(<<97>>)\") :name)")
;; actor_doc_response_for(json) body: {"actor":"a"}\n
(epoch 11)
(eval "(get (erlang-eval-ast \"R = http_server:actor_doc_response_for(<<97>>, json), case R of [_, _, {body, B}] -> B =:= <<123,34,97,99,116,111,114,34,58,34,97,34,125,10>>; _ -> false end\") :name)")
;; artifact_response_for(sx) body: (artifact "X")\n
(epoch 12)
(eval "(get (erlang-eval-ast \"R = http_server:artifact_response_for(<<120>>, sx), case R of [_, _, {body, B}] -> B =:= <<40,97,114,116,105,102,97,99,116,32,34,120,34,41,10>>; _ -> false end\") :name)")
;; projection_response_for(json) body: {"projection":"foo"}\n
(epoch 13)
(eval "(get (erlang-eval-ast \"R = http_server:projection_response_for(<<102,111,111>>, json), case R of [_, _, {body, B}] -> B =:= <<123,34,112,114,111,106,101,99,116,105,111,110,34,58,34,102,111,111,34,125,10>>; _ -> false end\") :name)")
;; projections_list_response_for(json) body: {"projections":[]}\n
(epoch 14)
(eval "(get (erlang-eval-ast \"R = http_server:projections_list_response_for(json), case R of [_, _, {body, B}] -> B =:= <<123,34,112,114,111,106,101,99,116,105,111,110,115,34,58,91,93,125,10>>; _ -> false end\") :name)")
;; projections_list_response_for(sx) body: (projections)\n
(epoch 15)
(eval "(get (erlang-eval-ast \"R = http_server:projections_list_response_for(sx), case R of [_, _, {body, B}] -> B =:= <<40,112,114,111,106,101,99,116,105,111,110,115,41,10>>; _ -> false end\") :name)")
;; cbor variants pass payload bytes through unchanged
(epoch 16)
(eval "(get (erlang-eval-ast \"R = http_server:actor_doc_response_for(<<97,98>>, cbor), case R of [_, _, {body, B}] -> B =:= <<97,98>>; _ -> false end\") :name)")
(epoch 17)
(eval "(get (erlang-eval-ast \"R = http_server:artifact_response_for(<<99,100>>, cbor), case R of [_, _, {body, B}] -> B =:= <<99,100>>; _ -> false end\") :name)")
(epoch 18)
(eval "(get (erlang-eval-ast \"R = http_server:projection_response_for(<<101>>, cbor), case R of [_, _, {body, B}] -> B =:= <<101>>; _ -> false end\") :name)")
;; End-to-end: GET /actors/a with Accept: application/json returns json body
(epoch 19)
(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97>>}, {headers, [{AK, JsonAV}]}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= <<123,34,97,99,116,111,114,34,58,34,97,34,125,10>>; _ -> false end\") :name)")
;; End-to-end: GET /artifacts/X with Accept: application/sx returns sx body
(epoch 20)
(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<71,69,84>>}, {path, <<(http_server:artifacts_prefix())/binary, 120>>}, {headers, [{AK, SxAV}]}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= <<40,97,114,116,105,102,97,99,116,32,34,120,34,41,10>>; _ -> false end\") :name)")
;; End-to-end: GET /projections with Accept: application/json returns json list body
(epoch 21)
(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<71,69,84>>}, {path, http_server:projections_list_path()}, {headers, [{AK, JsonAV}]}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= <<123,34,112,114,111,106,101,99,116,105,111,110,115,34,58,91,93,125,10>>; _ -> false end\") :name)")
;; End-to-end: Content-Type matches for actor GET with json Accept
(epoch 22)
(eval "(get (erlang-eval-ast \"${PRELUDE} Req = [{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97>>}, {headers, [{AK, JsonAV}]}], R = http_server:route(Req), case R of [_, {headers, [{_, CT}]}, _] -> CT =:= http_server:content_type_for(json); _ -> false end\") :name)")
;; GET without Accept still returns the text body (no Content-Type header)
(epoch 23)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97>>}], R = http_server:route(Req), R =:= http_server:actor_doc_response(<<97>>)\") :name)")
;; activity_json shares body with json for actor
(epoch 24)
(eval "(get (erlang-eval-ast \"[_, _, {body, BJ}] = http_server:actor_doc_response_for(<<122>>, json), [_, _, {body, BAJ}] = http_server:actor_doc_response_for(<<122>>, activity_json), BJ =:= BAJ\") :name)")
;; Unknown format falls back to text
(epoch 25)
(eval "(get (erlang-eval-ast \"http_server:projection_response_for(<<97>>, weird) =:= http_server:projection_response(<<97>>)\") :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" "http_server"
check 10 "actor text preserves" "true"
check 11 "actor json body" "true"
check 12 "artifact sx body" "true"
check 13 "projection json body" "true"
check 14 "projections list json body" "true"
check 15 "projections list sx body" "true"
check 16 "actor cbor body = id" "true"
check 17 "artifact cbor body = cid" "true"
check 18 "projection cbor body = name" "true"
check 19 "E2E GET actor with json Accept" "true"
check 20 "E2E GET artifact with sx Accept" "true"
check 21 "E2E GET projections with json" "true"
check 22 "E2E actor json CT" "true"
check 23 "no Accept -> text shape" "true"
check 24 "activity_json body == json body" "true"
check 25 "unknown -> text" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_get_format.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,96 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_listen_bif.sh — Step 8a acceptance test.
#
# Verifies the http:listen/2 BIF wrapper is registered and
# validates its arguments. We do NOT exercise the actual listen
# loop — http-listen blocks forever, so production callers spawn
# an Erlang process to host the call. The BIF wrapper itself is
# tested for: registration, integer port enforcement, function
# handler enforcement.
#
# This BIF is the briefing's allowed-exception scope addition
# to lib/erlang/runtime.sx. 5 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")
;; BIF registered under http/listen/2
(epoch 10)
(eval "(not (= (er-lookup-bif \"http\" \"listen\" 2) nil))")
;; BIF is non-pure (side effect: opens a socket)
(epoch 11)
(eval "(get (er-lookup-bif \"http\" \"listen\" 2) :pure?)")
;; Non-integer port -> badarg
(epoch 12)
(eval "(get (erlang-eval-ast \"try http:listen(not_a_number, fun () -> ok end) catch error:badarg -> ok end\") :name)")
;; Non-fun handler -> badarg
(epoch 13)
(eval "(get (erlang-eval-ast \"try http:listen(8080, not_a_fun) catch error:badarg -> ok end\") :name)")
;; Wrong arity not registered (http/listen/1 should be nil)
(epoch 14)
(eval "(= (er-lookup-bif \"http\" \"listen\" 1) nil)")
EPOCHS
OUTPUT=$(timeout 60 "$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 "BIF registered under http/listen/2" "true"
check 11 "BIF marked non-pure" "false"
check 12 "non-integer port -> badarg" "ok"
check 13 "non-fun handler -> badarg" "ok"
check 14 "no /1 arity registered" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_listen_bif.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,134 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_marshal.sh — Step 8b-start unit test for the
# dict↔proplist marshaling helpers added to lib/erlang/runtime.sx.
#
# Exercises:
# er-request-dict-to-proplist — http-listen request dict shape
# er-of-sx-deep — recursive marshaling
# er-dict-to-header-proplist — headers (binary keys)
# er-proplist-to-dict — handler-response inverse
# er-to-sx-deep — recursive marshaling on the way out
#
# These helpers underpin the http_server:start/1 process so an
# Erlang route/1 handler can pattern-match on a real proplist
# instead of an opaque SX dict.
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")
;; Local helper: walk an Erlang proplist (cons of {Key, Value}) and
;; return the value for the first matching key. Key can be an atom
;; name (string) or a binary as bytes-list.
(epoch 9)
(eval "(define test-pl-find (fn (pl key-name) (cond (er-nil? pl) nil (er-cons? pl) (let ((head (get pl :head))) (cond (er-tuple? head) (let ((kv (get head :elements))) (cond (and (er-atom? (nth kv 0)) (= (get (nth kv 0) :name) key-name)) (nth kv 1) :else (test-pl-find (get pl :tail) key-name))) :else (test-pl-find (get pl :tail) key-name))) :else nil)))")
;; --- helpers exist ---
(epoch 10)
(eval "(if (= (type-of er-request-dict-to-proplist) \"lambda\") 'ok 'missing)")
(epoch 11)
(eval "(if (= (type-of er-proplist-to-dict) \"lambda\") 'ok 'missing)")
;; --- request dict -> proplist with atom keys + binary values ---
(epoch 20)
(eval "(let ((d (dict :method \"GET\" :path \"/foo\" :query \"\" :headers (dict) :body \"\"))) (let ((pl (er-request-dict-to-proplist d))) (er-cons? pl)))")
;; method maps to atom 'method' with binary value <<"GET">> — verify via SX-side proplist walker
(epoch 21)
(eval "(let ((d (dict :method \"GET\" :path \"/foo\" :query \"\" :headers (dict) :body \"\"))) (let ((pl (er-request-dict-to-proplist d))) (get (test-pl-find pl \"method\") :bytes)))")
;; path roundtrip
(epoch 22)
(eval "(let ((d (dict :method \"POST\" :path \"/activity\" :query \"x=1\" :headers (dict) :body \"hi\"))) (let ((pl (er-request-dict-to-proplist d))) (let ((v (test-pl-find pl \"path\"))) (list->string (map integer->char (get v :bytes))))))")
;; --- headers nested as proplist with binary keys ---
;; Build a dict with a headers sub-dict, fetch headers field, find a header by binary key.
;; Local helper for binary-keyed proplist lookup.
(epoch 23)
(eval "(define test-pl-find-bin (fn (pl key-bytes) (cond (er-nil? pl) nil (er-cons? pl) (let ((head (get pl :head))) (cond (er-tuple? head) (let ((kv (get head :elements))) (cond (and (er-binary? (nth kv 0)) (= (get (nth kv 0) :bytes) key-bytes)) (nth kv 1) :else (test-pl-find-bin (get pl :tail) key-bytes))) :else (test-pl-find-bin (get pl :tail) key-bytes))) :else nil)))")
(epoch 30)
(eval "(let ((h (dict \"content-type\" \"text/plain\")) (d (dict :method \"GET\" :path \"/\" :query \"\" :body \"\"))) (dict-set! d :headers h) (let ((pl (er-request-dict-to-proplist d))) (let ((hpl (test-pl-find pl \"headers\"))) (let ((key-bytes (map char->integer (string->list \"content-type\")))) (let ((ct (test-pl-find-bin hpl key-bytes))) (list->string (map integer->char (get ct :bytes))))))))")
;; --- inverse: proplist response -> SX dict ---
;; Build an Erlang [{status, 200}, {headers, [...]}, {body, <<...>>}] proplist via SX
;; and verify er-proplist-to-dict returns an SX dict with status=200 and body string.
(epoch 40)
(eval "(let ((resp (er-mk-cons (er-mk-tuple (list (er-mk-atom \"status\") 200)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"headers\") (er-mk-nil))) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"body\") (er-mk-binary (map char->integer (string->list \"hello\"))))) (er-mk-nil)))))) (let ((d (er-proplist-to-dict resp))) (get d \"status\")))")
(epoch 41)
(eval "(let ((resp (er-mk-cons (er-mk-tuple (list (er-mk-atom \"status\") 200)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"headers\") (er-mk-nil))) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"body\") (er-mk-binary (map char->integer (string->list \"hello\"))))) (er-mk-nil)))))) (let ((d (er-proplist-to-dict resp))) (get d \"body\")))")
;; --- inverse: nested headers proplist -> nested SX dict ---
(epoch 42)
(eval "(let ((hpl (er-mk-cons (er-mk-tuple (list (er-mk-binary (map char->integer (string->list \"content-type\"))) (er-mk-binary (map char->integer (string->list \"text/plain\"))))) (er-mk-nil)))) (let ((resp (er-mk-cons (er-mk-tuple (list (er-mk-atom \"status\") 200)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"headers\") hpl)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"body\") (er-mk-binary (map char->integer (string->list \"ok\"))))) (er-mk-nil)))))) (let ((d (er-proplist-to-dict resp))) (let ((h (get d \"headers\"))) (get h \"content-type\")))))")
;; --- round-trip: handler eats a dict via proplist, returns a dict ---
;; Simulate: request dict -> proplist -> Erlang handler builds reply proplist
;; -> dict. Verify final dict has the keys the native http-listen expects.
(epoch 50)
(eval "(let ((req-dict (dict :method \"GET\" :path \"/echo\" :query \"\" :headers (dict) :body \"\"))) (let ((req-pl (er-request-dict-to-proplist req-dict))) (let ((resp (er-mk-cons (er-mk-tuple (list (er-mk-atom \"status\") 200)) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"headers\") (er-mk-nil))) (er-mk-cons (er-mk-tuple (list (er-mk-atom \"body\") (er-mk-binary (map char->integer (string->list \"echoed\"))))) (er-mk-nil)))))) (let ((d (er-proplist-to-dict resp))) (get d \"status\"))))) ")
EPOCHS
OUTPUT=$(timeout 60 "$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 "er-request-dict-to-proplist defined" "ok"
check 11 "er-proplist-to-dict defined" "ok"
check 20 "request dict -> cons proplist" "true"
check 21 "method value is <<\"GET\">>" "(71 69 84)"
check 22 "path value as string" "/activity"
check 30 "header value reachable as binary" "text/plain"
check 40 "response status field = 200" "200"
check 41 "response body present as string" "hello"
check 42 "nested headers reconstructed dict" "text/plain"
check 50 "full round-trip status preserved" "200"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL http_marshal tests passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,134 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_post_activity.sh — Step 8c-post-auth acceptance test.
#
# Exercises route/2 with bearer-token auth on POST /activity.
# Cfg :publish_token is the expected token; mismatched / missing /
# malformed Authorization header all 401. Real outbox:publish
# wiring lands in a follow-up sub-deliverable. 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
# Convenience: the bearer header name = "authorization"; "Bearer "
# prefix = 7 bytes; a sample token = "foo".
# Compose the right shapes inline in each test.
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/http_server.erl\")) :name)")
;; activity_path is 9 bytes
(epoch 10)
(eval "(erlang-eval-ast \"byte_size(http_server:activity_path())\")")
;; Authorized POST -> 200
(epoch 11)
(eval "(get (erlang-eval-ast \"Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, <<>>}], Cfg = [{publish_token, Token}], case http_server:route(Req, Cfg) of [{status, 200} | _] -> ok; _ -> bad end\") :name)")
;; Authorized body has 'published' prefix
(epoch 12)
(eval "(get (erlang-eval-ast \"Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, <<>>}], Cfg = [{publish_token, Token}], R = http_server:route(Req, Cfg), case R of [_, _, {body, B}] -> http_server:match_prefix(<<112,117,98,108,105,115,104,101,100>>, B) =/= nomatch; _ -> false end\") :name)")
;; No Authorization header -> 401
(epoch 13)
(eval "(get (erlang-eval-ast \"Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, []}, {body, <<>>}], Cfg = [{publish_token, <<102,111,111>>}], case http_server:route(Req, Cfg) of [{status, 401} | _] -> ok; _ -> bad end\") :name)")
;; Wrong bearer token -> 401
(epoch 14)
(eval "(get (erlang-eval-ast \"AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,98,97,100>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, <<>>}], Cfg = [{publish_token, <<102,111,111>>}], case http_server:route(Req, Cfg) of [{status, 401} | _] -> ok; _ -> bad end\") :name)")
;; Malformed Authorization (missing 'Bearer ') -> 401
(epoch 15)
(eval "(get (erlang-eval-ast \"AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<102,111,111>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, <<>>}], Cfg = [{publish_token, <<102,111,111>>}], case http_server:route(Req, Cfg) of [{status, 401} | _] -> ok; _ -> bad end\") :name)")
;; Cfg without :publish_token -> 401 even with a bearer token present
(epoch 16)
(eval "(get (erlang-eval-ast \"AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, <<>>}], case http_server:route(Req, []) of [{status, 401} | _] -> ok; _ -> bad end\") :name)")
;; route/1 (no Cfg) treats POST /activity as 401 (no token configured)
(epoch 17)
(eval "(get (erlang-eval-ast \"AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, <<>>}], case http_server:route(Req) of [{status, 401} | _] -> ok; _ -> bad end\") :name)")
;; GET /activity -> 404 (only POST is /activity)
(epoch 18)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, http_server:activity_path()}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; Other authorized routes still work via route/2
(epoch 19)
(eval "(get (erlang-eval-ast \"Cfg = [{publish_token, <<102,111,111>>}], Req = [{method, <<71,69,84>>}, {path, <<47>>}], case http_server:route(Req, Cfg) of [{status, 200} | _] -> ok; _ -> bad end\") :name)")
;; unauthorized_response shape sanity
(epoch 20)
(eval "(erlang-eval-ast \"R = http_server:unauthorized_response(), case R of [{status, 401} | _] -> 401; _ -> nope end\")")
;; Empty bearer token (just \"Bearer \") -> 401
(epoch 21)
(eval "(get (erlang-eval-ast \"AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, <<>>}], Cfg = [{publish_token, <<102,111,111>>}], case http_server:route(Req, Cfg) of [{status, 401} | _] -> 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 2 "module load name" "http_server"
check 10 "activity_path = 9 bytes" "9"
check 11 "authorized POST -> 200" "ok"
check 12 "body has 'published' prefix" "true"
check 13 "no Authorization -> 401" "ok"
check 14 "wrong token -> 401" "ok"
check 15 "malformed Authorization -> 401" "ok"
check 16 "Cfg without token -> 401" "ok"
check 17 "route/1 rejects POST /activity" "ok"
check 18 "GET /activity -> 404" "ok"
check 19 "other GETs work via route/2" "ok"
check 20 "unauthorized_response status 401" "401"
check 21 "empty bearer token -> 401" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_post_activity.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,142 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_post_format.sh — Step 8d-dispatch-post test.
#
# Verifies POST /activity returns format-specific bodies + the
# right Content-Type, both for the kernel-absent stub path and
# the kernel-present cid response. 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/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/nx_kernel.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
;; cid_response_for(json) body: {"cid":"foo"}\n
(epoch 10)
(eval "(get (erlang-eval-ast \"R = http_server:cid_response_for(<<102,111,111>>, json), case R of [_, _, {body, B}] -> B =:= <<123,34,99,105,100,34,58,34,102,111,111,34,125,10>>; _ -> false end\") :name)")
;; cid_response_for(json) CT is application/json
(epoch 11)
(eval "(get (erlang-eval-ast \"R = http_server:cid_response_for(<<102,111,111>>, json), case R of [_, {headers, [{_, CT}]}, _] -> CT =:= http_server:content_type_for(json); _ -> false end\") :name)")
;; cid_response_for(sx) body: (cid "foo")\n
(epoch 12)
(eval "(get (erlang-eval-ast \"R = http_server:cid_response_for(<<102,111,111>>, sx), case R of [_, _, {body, B}] -> B =:= <<40,99,105,100,32,34,102,111,111,34,41,10>>; _ -> false end\") :name)")
;; cid_response_for(text) matches cid_response/1
(epoch 13)
(eval "(get (erlang-eval-ast \"http_server:cid_response_for(<<102,111,111>>, text) =:= http_server:cid_response(<<102,111,111>>)\") :name)")
;; cid_response_for(activity_json) body == cid_response_for(json) body
(epoch 14)
(eval "(get (erlang-eval-ast \"[_, _, {body, BJ}] = http_server:cid_response_for(<<102,111,111>>, json), [_, _, {body, BAJ}] = http_server:cid_response_for(<<102,111,111>>, activity_json), BJ =:= BAJ\") :name)")
;; cid_response_for(activity_json) CT is application/activity+json
(epoch 15)
(eval "(get (erlang-eval-ast \"R = http_server:cid_response_for(<<102,111,111>>, activity_json), case R of [_, {headers, [{_, CT}]}, _] -> CT =:= http_server:content_type_for(activity_json); _ -> false end\") :name)")
;; cid_response_for(cbor) carries the raw CID as body
(epoch 16)
(eval "(get (erlang-eval-ast \"R = http_server:cid_response_for(<<102,111,111>>, cbor), case R of [_, _, {body, B}] -> B =:= <<102,111,111>>; _ -> false end\") :name)")
;; post_activity_response_for(json) has json CT
(epoch 17)
(eval "(get (erlang-eval-ast \"R = http_server:post_activity_response_for(json), case R of [_, {headers, [{_, CT}]}, _] -> CT =:= http_server:content_type_for(json); _ -> false end\") :name)")
;; post_activity_response_for(text) matches the original
(epoch 18)
(eval "(get (erlang-eval-ast \"http_server:post_activity_response_for(text) =:= http_server:post_activity_response()\") :name)")
;; End-to-end: POST /activity with Accept: application/json returns
;; the json stub when nx_kernel is not running
(epoch 19)
(eval "(get (erlang-eval-ast \"Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, AcceptKey = <<97,99,99,101,112,116>>, AcceptVal = <<97,112,112,108,105,99,97,116,105,111,110,47,106,115,111,110>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}, {AcceptKey, AcceptVal}]}, {body, <<>>}], Cfg = [{publish_token, Token}], R = http_server:route(Req, Cfg), case R of [_, {headers, [{_, CT}]}, _] -> CT =:= http_server:content_type_for(json); _ -> false end\") :name)")
;; End-to-end: POST /activity with kernel running + Accept: application/sx
;; returns body shaped as (cid "...")
(epoch 20)
(eval "(get (erlang-eval-ast \"KM = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,KM}], AS = [{public_keys,[[{id,k1},{created,0},{value,KM}]]}], nx_kernel:start_link(alice, KS, AS), Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, AcceptKey = <<97,99,99,101,112,116>>, AcceptVal = <<97,112,112,108,105,99,97,116,105,111,110,47,115,120>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}, {AcceptKey, AcceptVal}]}, {body, <<104,105>>}], Cfg = [{publish_token, Token}], R = http_server:route(Req, Cfg), case R of [_, _, {body, B}] -> http_server:match_prefix(<<40,99,105,100,32,34>>, B) =/= nomatch; _ -> false end\") :name)")
;; End-to-end CT for kernel-publish with json Accept matches application/json
(epoch 21)
(eval "(get (erlang-eval-ast \"KM = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,KM}], AS = [{public_keys,[[{id,k1},{created,0},{value,KM}]]}], nx_kernel:start_link(alice, KS, AS), Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, AcceptKey = <<97,99,99,101,112,116>>, AcceptVal = <<97,112,112,108,105,99,97,116,105,111,110,47,106,115,111,110>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}, {AcceptKey, AcceptVal}]}, {body, <<104,105>>}], Cfg = [{publish_token, Token}], R = http_server:route(Req, Cfg), case R of [_, {headers, [{_, CT}]}, _] -> CT =:= http_server:content_type_for(json); _ -> false 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 8 "http_server loaded" "http_server"
check 10 "cid_response_for(json) body" "true"
check 11 "cid_response_for(json) CT" "true"
check 12 "cid_response_for(sx) body" "true"
check 13 "cid_response_for(text) preserves" "true"
check 14 "activity_json body == json body" "true"
check 15 "activity_json CT differs" "true"
check 16 "cbor carries raw cid" "true"
check 17 "post_activity stub json CT" "true"
check 18 "post_activity stub text preserves" "true"
check 19 "POST kernel-absent json CT" "true"
check 20 "POST kernel-publish sx body" "true"
check 21 "POST kernel-publish json CT" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_post_format.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,118 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_projections.sh — Step 8c-proj acceptance test.
#
# Exercises GET /projections (list stub) and GET /projections/{name}
# via the shared match_prefix machinery. 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
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/http_server.erl\")) :name)")
;; projections_list_path is 12 bytes
(epoch 10)
(eval "(erlang-eval-ast \"byte_size(http_server:projections_list_path())\")")
;; projections_prefix is 13 bytes (adds trailing slash)
(epoch 11)
(eval "(erlang-eval-ast \"byte_size(http_server:projections_prefix())\")")
;; GET /projections -> 200 (list stub)
(epoch 12)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, http_server:projections_list_path()}], case http_server:route(Req) of [{status, 200} | _] -> ok; _ -> bad end\") :name)")
;; List body has 'projections: ' prefix
(epoch 13)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, http_server:projections_list_path()}], R = http_server:route(Req), case R of [_, _, {body, B}] -> http_server:match_prefix(<<112,114,111,106,101,99,116,105,111,110,115,58,32>>, B) =/= nomatch; _ -> false end\") :name)")
;; GET /projections/foo -> 200
(epoch 14)
(eval "(get (erlang-eval-ast \"Name = <<102,111,111>>, Req = [{method, <<71,69,84>>}, {path, <<(http_server:projections_prefix())/binary, Name/binary>>}], case http_server:route(Req) of [{status, 200} | _] -> ok; _ -> bad end\") :name)")
;; Projection body has 'projection: ' prefix (singular)
(epoch 15)
(eval "(get (erlang-eval-ast \"Name = <<102,111,111>>, Req = [{method, <<71,69,84>>}, {path, <<(http_server:projections_prefix())/binary, Name/binary>>}], R = http_server:route(Req), case R of [_, _, {body, B}] -> http_server:match_prefix(<<112,114,111,106,101,99,116,105,111,110,58,32>>, B) =/= nomatch; _ -> false end\") :name)")
;; GET /projections/ (empty name) -> 404
(epoch 16)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, http_server:projections_prefix()}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; POST /projections -> 404
(epoch 17)
(eval "(get (erlang-eval-ast \"Req = [{method, <<80,79,83,84>>}, {path, http_server:projections_list_path()}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; POST /projections/foo -> 404
(epoch 18)
(eval "(get (erlang-eval-ast \"Name = <<102,111,111>>, Req = [{method, <<80,79,83,84>>}, {path, <<(http_server:projections_prefix())/binary, Name/binary>>}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; No collision: actors / artifacts / projections all return 200 simultaneously
(epoch 19)
(eval "(get (erlang-eval-ast \"R1 = http_server:route([{method, <<71,69,84>>}, {path, <<47,97,99,116,111,114,115,47,97>>}]), R2 = http_server:route([{method, <<71,69,84>>}, {path, <<(http_server:artifacts_prefix())/binary, 98>>}]), R3 = http_server:route([{method, <<71,69,84>>}, {path, <<(http_server:projections_prefix())/binary, 99>>}]), case {R1, R2, R3} of {[{status, 200} | _], [{status, 200} | _], [{status, 200} | _]} -> ok; _ -> bad end\") :name)")
EPOCHS
OUTPUT=$(timeout 60 "$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" "http_server"
check 10 "projections_list_path = 12" "12"
check 11 "projections_prefix = 13" "13"
check 12 "GET /projections -> 200" "ok"
check 13 "list body 'projections: '" "true"
check 14 "GET /projections/foo -> 200" "ok"
check 15 "single body 'projection: '" "true"
check 16 "GET /projections/ -> 404" "ok"
check 17 "POST /projections -> 404" "ok"
check 18 "POST /projections/foo -> 404" "ok"
check 19 "all three /-routes 200" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_projections.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,134 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_publish.sh — Step 8c-post-publish-http test.
#
# Exercises the HTTP -> nx_kernel publish bridge: authorized
# POST /activity with the kernel gen_server running gets routed
# through nx_kernel:publish/1; the response carries the
# resulting CID. Without the kernel running, the route falls
# back to the auth-only stub (covered by http_post_activity.sh).
# 9 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: kernel started, auth header, valid request shape.
PRELUDE='KM = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,KM}], AS = [{public_keys,[[{id,k1},{created,0},{value,KM}]]}], nx_kernel:start_link(alice, KS, AS), Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, Cfg = [{publish_token, Token}],'
# Body builder helper appended into each test:
BUILDREQ='Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, Body}],'
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/nx_kernel.erl\")) :name)")
(epoch 8)
(eval "(get (erlang-load-module (file-read \"next/kernel/http_server.erl\")) :name)")
;; Authorized POST -> 200 with body starting with "cid: "
(epoch 10)
(eval "(get (erlang-eval-ast \"${PRELUDE} Body = <<104,101,108,108,111>>, ${BUILDREQ} case http_server:route(Req, Cfg) of [{status, 200}, _, {body, B}] -> http_server:match_prefix(<<99,105,100,58,32>>, B) =/= nomatch; _ -> false end\") :name)")
;; Log tip advances after authorized POST
(epoch 11)
(eval "(erlang-eval-ast \"${PRELUDE} Body = <<104,105>>, ${BUILDREQ} http_server:route(Req, Cfg), nx_kernel:log_tip()\")")
;; Two authorized POSTs -> tip = 2
(epoch 12)
(eval "(erlang-eval-ast \"${PRELUDE} Body = <<104,105>>, ${BUILDREQ} http_server:route(Req, Cfg), http_server:route(Req, Cfg), nx_kernel:log_tip()\")")
;; Same POST twice produces two distinct CIDs (next_published counter)
(epoch 13)
(eval "(get (erlang-eval-ast \"${PRELUDE} Body = <<104,105>>, ${BUILDREQ} [{status, 200}, _, {body, B1}] = http_server:route(Req, Cfg), [{status, 200}, _, {body, B2}] = http_server:route(Req, Cfg), B1 =/= B2\") :name)")
;; Unauthorized POST does NOT advance the kernel log
(epoch 14)
(eval "(erlang-eval-ast \"${PRELUDE} BadAuth = <<66,101,97,114,101,114,32,98,97,100>>, BadReq = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, BadAuth}]}, {body, <<>>}], http_server:route(BadReq, Cfg), nx_kernel:log_tip()\")")
;; Sig-failure publish surfaces as 422 (when key material doesn't match)
(epoch 15)
(eval "(get (erlang-eval-ast \"OtherKM = <<9,9,9,9>>, BadKS = [{key_id,k1},{algorithm,ed25519},{value,OtherKM}], AS = [{public_keys,[[{id,k1},{created,0},{value,<<1,2,3,4>>}]]}], nx_kernel:start_link(alice, BadKS, AS), Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, Cfg = [{publish_token, Token}], Body = <<104,105>>, Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, Body}], case http_server:route(Req, Cfg) of [{status, 422} | _] -> ok; _ -> bad end\") :name)")
;; Without the kernel running, the auth-only stub still works
(epoch 16)
(eval "(get (erlang-eval-ast \"Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, Cfg = [{publish_token, Token}], Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, <<>>}], R = http_server:route(Req, Cfg), case R of [{status, 200}, _, {body, B}] -> http_server:match_prefix(<<112,117,98,108,105,115,104,101,100>>, B) =/= nomatch; _ -> false end\") :name)")
;; validation_failed_response shape sanity
(epoch 17)
(eval "(erlang-eval-ast \"R = http_server:validation_failed_response(), case R of [{status, 422} | _] -> 422; _ -> nope end\")")
;; cid_response wraps a cid with the right prefix
(epoch 18)
(eval "(get (erlang-eval-ast \"R = http_server:cid_response(<<102,111,111>>), case R of [_, _, {body, B}] -> B =:= <<99,105,100,58,32,102,111,111,10>>; _ -> false 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 8 "http_server loaded" "http_server"
check 10 "POST -> 200 with 'cid: '" "true"
check 11 "log_tip = 1 after POST" "1"
check 12 "two POSTs -> tip = 2" "2"
check 13 "same POST -> distinct CIDs" "true"
check 14 "unauthorized POST -> tip = 0" "0"
check 15 "sig failure -> 422" "ok"
check 16 "kernel-absent fallback stub" "true"
check 17 "validation_failed_response 422" "422"
check 18 "cid_response wraps cid" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_publish.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,133 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_publish_fold.sh — Step 9-pre-fold integration.
#
# Proves the full POST → publish → broadcast → projection-fold
# chain through HTTP without a real TCP socket. The kernel
# orchestrator threads :projections into the publish Context,
# so outbox:publish broadcasts the signed activity to every
# registered projection process and each fold runs.
#
# Step 9a/b smoke tests will exercise the same path via curl
# once Step 8b-start lights up actual TCP. 10 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}]]}], projection:start_link(p_count, 0, fun (_A, S) -> S + 1 end), projection:start_link(p_collect, [], fun (A, S) -> [A | S] end), nx_kernel:start_link(alice, KS, AS), nx_kernel:with_projections([p_count, p_collect]), Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, Cfg = [{publish_token, Token}], BuildReq = fun (B) -> [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, B}] end,'
cat > "$TMPFILE" <<EPOCHS
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(er-load-gen-server!)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/kernel/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/outbox.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/http_server.erl\")) :name)")
;; Single authorized POST advances both projection counters
(epoch 10)
(eval "(erlang-eval-ast \"${PRELUDE} http_server:route(BuildReq(<<104,105>>), Cfg), projection:query(p_count)\")")
(epoch 11)
(eval "(erlang-eval-ast \"${PRELUDE} http_server:route(BuildReq(<<104,105>>), Cfg), length(projection:query(p_collect))\")")
;; Three POSTs -> both projections at 3
(epoch 12)
(eval "(get (erlang-eval-ast \"${PRELUDE} http_server:route(BuildReq(<<104,105>>), Cfg), http_server:route(BuildReq(<<104,105>>), Cfg), http_server:route(BuildReq(<<104,105>>), Cfg), {projection:query(p_count), length(projection:query(p_collect))} =:= {3, 3}\") :name)")
;; Log tip and projection counter agree
(epoch 13)
(eval "(get (erlang-eval-ast \"${PRELUDE} http_server:route(BuildReq(<<104,105>>), Cfg), http_server:route(BuildReq(<<104,105>>), Cfg), {nx_kernel:log_tip(), projection:query(p_count)} =:= {2, 2}\") :name)")
;; Unauthorized POST does NOT advance projection state
(epoch 14)
(eval "(erlang-eval-ast \"${PRELUDE} BadAuth = <<66,101,97,114,101,114,32,98,97,100>>, BadReq = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, BadAuth}]}, {body, <<104,105>>}], http_server:route(BadReq, Cfg), projection:query(p_count)\")")
;; Sig-failed POST does NOT advance projection state (kernel rejects)
(epoch 15)
(eval "(erlang-eval-ast \"OtherKM = <<9,9,9,9>>, BadKS = [{key_id,k1},{algorithm,ed25519},{value,OtherKM}], AS = [{public_keys,[[{id,k1},{created,0},{value,<<1,2,3,4>>}]]}], projection:start_link(p_count, 0, fun (_A, S) -> S + 1 end), nx_kernel:start_link(alice, BadKS, AS), nx_kernel:with_projections([p_count]), Token = <<102,111,111>>, AuthKey = <<97,117,116,104,111,114,105,122,97,116,105,111,110>>, AuthVal = <<66,101,97,114,101,114,32,102,111,111>>, Cfg = [{publish_token, Token}], Req = [{method, <<80,79,83,84>>}, {path, http_server:activity_path()}, {headers, [{AuthKey, AuthVal}]}, {body, <<>>}], http_server:route(Req, Cfg), projection:query(p_count)\")")
;; The body posted is what the projection sees inside the activity's :object
(epoch 16)
(eval "(get (erlang-eval-ast \"${PRELUDE} http_server:route(BuildReq(<<120,121,122>>), Cfg), [Act] = projection:query(p_collect), case envelope:get_field(object, Act) of {ok, <<120,121,122>>} -> ok; _ -> bad end\") :name)")
;; Three POSTs -> log entries match (round-trip via the kernel log)
(epoch 17)
(eval "(erlang-eval-ast \"${PRELUDE} http_server:route(BuildReq(<<104,105>>), Cfg), http_server:route(BuildReq(<<104,105>>), Cfg), http_server:route(BuildReq(<<104,105>>), Cfg), length(log:entries(nx_kernel:log_state(nx_kernel:query())))\")")
;; Single POST: projection seq number proves fold ran (state changed)
(epoch 18)
(eval "(get (erlang-eval-ast \"${PRELUDE} http_server:route(BuildReq(<<104,105>>), Cfg), projection:query(p_count) =/= 0\") :name)")
EPOCHS
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 9 "http_server loaded" "http_server"
check 10 "POST -> p_count = 1" "1"
check 11 "POST -> p_collect length = 1" "1"
check 12 "three POSTs -> both at 3" "true"
check 13 "log_tip == p_count" "true"
check 14 "unauthorized POST no fold" "0"
check 15 "sig failure no fold" "0"
check 16 "projection sees body as :object" "ok"
check 17 "log entries = 3 after 3 POSTs" "3"
check 18 "single POST changes proj state" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_publish_fold.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,120 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_route.sh — Step 8b acceptance test.
#
# Exercises http_server:route/1 — pure (Request) -> Response
# proplist dispatch. The actual HTTP listener (which would call
# this via the http:listen/2 BIF bridge) is wired in Step 8c+.
# 10 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/http_server.erl\")) :name)")
;; GET / -> 200
(epoch 10)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47>>}], case http_server:route(Req) of [{status, 200} | _] -> ok; _ -> bad end\") :name)")
;; GET / body is the welcome message
(epoch 11)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47>>}], R = http_server:route(Req), case R of [_, _, {body, B}] -> B =:= http_server:welcome_body(); _ -> false end\") :name)")
;; POST / -> 404 (only GET / is known)
(epoch 12)
(eval "(get (erlang-eval-ast \"Req = [{method, <<80,79,83,84>>}, {path, <<47>>}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; GET /unknown -> 404
(epoch 13)
(eval "(get (erlang-eval-ast \"Req = [{method, <<71,69,84>>}, {path, <<47,102,111,111>>}], case http_server:route(Req) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; Missing fields -> 404 (graceful)
(epoch 14)
(eval "(get (erlang-eval-ast \"case http_server:route([]) of [{status, 404} | _] -> ok; _ -> bad end\") :name)")
;; Response always has :status, :headers, :body
(epoch 15)
(eval "(erlang-eval-ast \"R = http_server:not_found_response(), length(R)\")")
;; ok_response sets the right status
(epoch 16)
(eval "(erlang-eval-ast \"R = http_server:ok_response(<<104,105>>), case R of [{status, 200} | _] -> 200; _ -> nope end\")")
;; ok_response carries the supplied body
(epoch 17)
(eval "(get (erlang-eval-ast \"R = http_server:ok_response(<<104,105>>), case R of [_, _, {body, B}] -> B =:= <<104,105>>; _ -> false end\") :name)")
;; not_found body present (non-empty)
(epoch 18)
(eval "(get (erlang-eval-ast \"R = http_server:not_found_response(), case R of [_, _, {body, B}] -> byte_size(B) > 0; _ -> false end\") :name)")
;; welcome_body is non-empty
(epoch 19)
(eval "(get (erlang-eval-ast \"byte_size(http_server:welcome_body()) > 0\") :name)")
EPOCHS
OUTPUT=$(timeout 60 "$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" "http_server"
check 10 "GET / -> 200" "ok"
check 11 "GET / body is welcome" "true"
check 12 "POST / -> 404" "ok"
check 13 "GET /unknown -> 404" "ok"
check 14 "missing fields -> 404" "ok"
check 15 "response has 3 entries" "3"
check 16 "ok_response status = 200" "200"
check 17 "ok_response carries body" "true"
check 18 "not_found body non-empty" "true"
check 19 "welcome body non-empty" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/http_route.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,105 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_server_start.sh — Step 8b-start structural test.
#
# `http_server:start/1,2` spawn an Erlang process that blocks in
# `http:listen/2` forever. In this port's cooperative scheduler,
# any in-process `erlang-eval-ast` that triggers that spawn hangs
# the runtime — `er-sched-run-all!` waits for every spawned
# process to leave the runnable queue before returning to the
# caller, and the listener never does. So this test verifies the
# code SHAPE without actually invoking start/1:
# * Module loads.
# * `start/1` and `start/2` are bound in the module env.
# * The dict↔proplist marshaling bridge (the BIF-wrapper hook)
# is bound in the runtime env.
# The live TCP behaviour lands in `next/tests/http_server_tcp.sh`
# (Step 9a-tcp) via a shell-side curl probe.
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/http_server.erl\")) :name)")
;; --- module is registered ---
(epoch 10)
(eval "(let ((m (get (er-modules-get) \"http_server\"))) (cond (= m nil) 'absent :else 'present))")
;; --- start/1 + start/2 are bound (multi-arity stored as a single binding) ---
(epoch 11)
(eval "(let ((env (get (get (er-modules-get) \"http_server\") \"current\"))) (cond (= (get env \"start\") nil) 'missing :else 'present))")
;; --- request->proplist marshaler exists in runtime env ---
(epoch 12)
(eval "(if (= (type-of er-request-dict-to-proplist) \"lambda\") 'present 'missing)")
;; --- proplist->dict marshaler exists in runtime env ---
(epoch 13)
(eval "(if (= (type-of er-proplist-to-dict) \"lambda\") 'present 'missing)")
;; --- http:listen BIF wrapper now routes through the marshalers ---
;; Probe by registration only (calling listen would block forever).
(epoch 14)
(eval "(not (= (er-lookup-bif \"http\" \"listen\" 2) nil))")
EPOCHS
OUTPUT=$(timeout 30 "$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 "http_server module loaded" "http_server"
check 10 "module registered" "present"
check 11 "start bound in module env" "present"
check 12 "request marshaler defined" "present"
check 13 "response marshaler defined" "present"
check 14 "http:listen BIF registered" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL http_server_start tests passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,143 +0,0 @@
#!/usr/bin/env bash
# next/tests/http_server_tcp.sh — Step 9a-tcp live TCP smoke test.
#
# Boots sx_server in the background with a script that loads
# http_server.erl and calls http_server:start/1 on a high port,
# then drives the running server with curl from this shell to
# verify the request → marshaling → route → marshaling → HTTP
# response chain end-to-end.
#
# Boot timing: ~10s for all `lib/erlang/*.sx` loads + module
# compile + spawn + Unix.bind. We hold the server's stdin open
# via `(cat file; sleep 60) | sx_server` so EOF doesn't trigger
# exit(0) before the listener finishes binding.
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
PORT=51820
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
EPOCH_FILE=$(mktemp)
LOG_FILE=$(mktemp)
cleanup() {
if [ -n "${SXPID:-}" ]; then
kill -KILL "$SXPID" 2>/dev/null || true
wait "$SXPID" 2>/dev/null || true
fi
if [ -n "${HOLDPID:-}" ]; then
kill -KILL "$HOLDPID" 2>/dev/null || true
wait "$HOLDPID" 2>/dev/null || true
fi
rm -f "$EPOCH_FILE" "$LOG_FILE"
}
trap cleanup EXIT
cat > "$EPOCH_FILE" <<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/http_server.erl\")) :name)")
(epoch 3)
(eval "(erlang-eval-ast \"http_server:start($PORT)\")")
EPOCHS
# Run sx_server with stdin held open via a long-running background
# `sleep` so EOF doesn't trigger exit(0) before the listener binds
# and the test finishes curling. Use a FIFO so we can capture both
# the holder process's PID and sx_server's PID explicitly — bash
# only captures the rightmost pipe stage with $!.
FIFO=$(mktemp -u)
mkfifo "$FIFO"
( cat "$EPOCH_FILE"; sleep 120 ) > "$FIFO" &
HOLDPID=$!
"$SX_SERVER" < "$FIFO" > "$LOG_FILE" 2>&1 &
SXPID=$!
rm -f "$FIFO" # both ends still hold open via the running procs
# Wait for the listener to bind (up to ~30s — boot takes ~10s).
BOUND=""
for i in $(seq 1 60); do
if (exec 3<>/dev/tcp/127.0.0.1/$PORT) 2>/dev/null; then
exec 3<&-; exec 3>&-
BOUND="yes"
break
fi
sleep 0.5
done
if [ -z "$BOUND" ]; then
echo "FAIL: listener never bound on port $PORT"
if [ "$VERBOSE" = "-v" ]; then
echo "--- sx_server output ---"
cat "$LOG_FILE"
echo "---"
fi
exit 1
fi
check_http() {
local desc="$1" method="$2" path="$3" auth="$4" expected_status="$5" expected_body_substr="$6"
local args=()
args+=(-s -o /tmp/http_body.out -w "%{http_code}")
args+=(-X "$method")
if [ -n "$auth" ]; then
args+=(-H "Authorization: $auth")
fi
if [ "$method" = "POST" ]; then
args+=(-d "")
fi
args+=("http://127.0.0.1:$PORT$path")
local code
code=$(curl "${args[@]}" 2>/dev/null || echo "000")
local body
body=$(cat /tmp/http_body.out 2>/dev/null || echo "")
local pass=1
if [ "$code" != "$expected_status" ]; then pass=0; fi
if [ -n "$expected_body_substr" ] && ! echo "$body" | grep -qF -- "$expected_body_substr"; then pass=0; fi
if [ $pass -eq 1 ]; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc ($code)"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] code=$code body=$body
"
fi
}
check_http "GET / -> 200" GET / "" 200 ""
check_http "GET capabilities -> 200" GET /.well-known/sx-capabilities "" 200 "kernel:"
check_http "GET unknown -> 404" GET /no-such-path "" 404 ""
check_http "POST /activity no bearer -> 401" POST /activity "" 401 ""
check_http "POST /activity bad bearer -> 401" POST /activity "Bearer wrong" 401 ""
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL http_server_tcp tests passed (port $PORT)"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
if [ "$VERBOSE" = "-v" ]; then
echo "--- sx_server output (last 30 lines) ---"
tail -30 "$LOG_FILE"
echo "---"
fi
fi
[ $FAIL -eq 0 ]

View File

@@ -1,141 +0,0 @@
#!/usr/bin/env bash
# next/tests/log_disk.sh — Step 3b on-disk log acceptance test.
#
# Exercises log:open_disk/2, append/2 (write-through), and the
# read-segment-on-reopen path. Uses next/kernel/term_codec.erl for
# the entry encoding and a 4-byte big-endian length prefix per frame.
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
# Fixed tmp dir so we can refer to it as an Erlang binary literal.
DISK_BASE=/tmp/fed_sx_m1_log_disk
rm -rf "$DISK_BASE"
mkdir -p "$DISK_BASE"
# Pre-write a corrupted segment file for the corrupt-detect test
# (just a truncated 4-byte length header with no payload). Segment
# filenames are <ActorId>-NNNNNN.log (6-digit zero-padded index) as
# of Step 3c.a.
printf '\x00\x00\x00\x05XX' > "$DISK_BASE/corrupted-000000.log"
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE; rm -rf $DISK_BASE" 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/term_codec.erl\")) :name)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/log.erl\")) :name)")
;; Base path: /tmp/fed_sx_m1_log_disk constructed as an Erlang binary
;; via list_to_binary of the char codes. (`<<"...">>` literals don't
;; carry through in this port — see Step 3b substrate fix #2.)
;; --- 3a in-memory open/2 still works unchanged ---
(epoch 10)
(eval "(get (erlang-eval-ast \"{ok, L} = log:open(alice, base), log:tip(L) =:= 0\") :name)")
;; --- open_disk on missing file returns empty fresh state ---
(epoch 20)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $d, $i, $s, $k]), {ok, L} = log:open_disk(alice, Base), log:tip(L) =:= 0\") :name)")
(epoch 21)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $d, $i, $s, $k]), {ok, L} = log:open_disk(alice, Base), log:entries(L) =:= []\") :name)")
;; --- append + re-open: entries match ---
(epoch 30)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $d, $i, $s, $k]), {ok, L0} = log:open_disk(bob, Base), {ok, L1, _} = log:append(L0, hello), {ok, L2, _} = log:append(L1, world), {ok, L3} = log:open_disk(bob, Base), log:entries(L3) =:= [hello, world]\") :name)")
;; --- tip resumes correctly across restart ---
(epoch 31)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $d, $i, $s, $k]), {ok, L0} = log:open_disk(carol, Base), {ok, L1, _} = log:append(L0, a), {ok, L2, _} = log:append(L1, b), {ok, L3, _} = log:append(L2, c), {ok, L4} = log:open_disk(carol, Base), log:tip(L4) =:= 3\") :name)")
;; --- replay/3 over re-opened state visits append order ---
(epoch 32)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $d, $i, $s, $k]), {ok, L0} = log:open_disk(dave, Base), {ok, L1, _} = log:append(L0, a), {ok, L2, _} = log:append(L1, b), {ok, L3, _} = log:append(L2, c), {ok, L4} = log:open_disk(dave, Base), log:replay(L4, [], fun (X, S, Acc) -> [{S, X} | Acc] end) =:= [{2,c},{1,b},{0,a}]\") :name)")
;; --- mixed types round-trip (atom, int, binary, tuple, list) ---
(epoch 33)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $d, $i, $s, $k]), {ok, L0} = log:open_disk(eve, Base), {ok, L1, _} = log:append(L0, foo), {ok, L2, _} = log:append(L1, 42), {ok, L3, _} = log:append(L2, <<1,2,3>>), {ok, L4, _} = log:append(L3, {pair, alice, bob}), {ok, L5, _} = log:append(L4, [1, two, <<3>>]), {ok, L6} = log:open_disk(eve, Base), log:entries(L6) =:= [foo, 42, <<1,2,3>>, {pair, alice, bob}, [1, two, <<3>>]]\") :name)")
;; --- continuing to append after reopen preserves chronology ---
(epoch 34)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $d, $i, $s, $k]), {ok, L0} = log:open_disk(frank, Base), {ok, L1, _} = log:append(L0, a), {ok, L2} = log:open_disk(frank, Base), {ok, L3, S} = log:append(L2, b), {S, log:tip(L3)} =:= {1, 2}\") :name)")
;; --- corrupted segment returns {error, _} not crash ---
(epoch 40)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $d, $i, $s, $k]), element(1, log:open_disk(corrupted, Base))\") :name)")
;; --- per-actor isolation: two disk-backed logs are independent ---
(epoch 41)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $d, $i, $s, $k]), {ok, LA0} = log:open_disk(g1, Base), {ok, LB0} = log:open_disk(g2, Base), {ok, LA1, _} = log:append(LA0, x), {ok, LB1, _} = log:append(LB0, y1), {ok, LB2, _} = log:append(LB1, y2), {ok, LAr} = log:open_disk(g1, Base), {ok, LBr} = log:open_disk(g2, Base), {log:entries(LAr), log:entries(LBr)} =:= {[x], [y1, y2]}\") :name)")
EPOCHS
OUTPUT=$(timeout 90 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1 || true)
if echo "$actual" | grep -q "^(ok-len"; then actual=""; fi
if [ -z "$actual" ]; then
actual=$(echo "$OUTPUT" | grep "^(ok $epoch " | head -1 || true)
fi
if [ -z "$actual" ]; then
actual=$(echo "$OUTPUT" | grep "^(error $epoch " | head -1 || true)
fi
[ -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 "term_codec loads" "term_codec"
check 3 "log module loads" "log"
check 10 "3a in-memory open/2 compat" "true"
check 20 "open_disk missing -> tip 0" "true"
check 21 "open_disk missing -> []" "true"
check 30 "append+reopen entries match" "true"
check 31 "tip resumes after restart" "true"
check 32 "replay chronological" "true"
check 33 "mixed types round-trip" "true"
check 34 "append after reopen" "true"
check 40 "corrupted segment -> error" "error"
check 41 "per-actor isolation" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL log_disk tests 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/log_memory.sh — Step 3a acceptance test.
#
# Exercises the in-memory log API: open/2, append/2, tip/1, replay/3,
# entries/1. On-disk persistence is the job of Step 3b. 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
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/log.erl\")) :name)")
;; Fresh log: tip is 0
(epoch 10)
(eval "(get (erlang-eval-ast \"{ok, L} = log:open(alice, base), log:tip(L) =:= 0\") :name)")
;; Fresh log: entries empty
(epoch 11)
(eval "(get (erlang-eval-ast \"{ok, L} = log:open(alice, base), log:entries(L) =:= []\") :name)")
;; First append returns seq 0; tip advances to 1
(epoch 12)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), {ok, L1, S} = log:append(L0, act_a), {S, log:tip(L1)} =:= {0, 1}\") :name)")
;; Two appends: seq 0,1; tip = 2
(epoch 13)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), {ok, L1, S0} = log:append(L0, a), {ok, L2, S1} = log:append(L1, b), {S0, S1, log:tip(L2)} =:= {0, 1, 2}\") :name)")
;; Five appends: seq sequence gap-free
(epoch 14)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), {ok, L1, S0} = log:append(L0, a), {ok, L2, S1} = log:append(L1, b), {ok, L3, S2} = log:append(L2, c), {ok, L4, S3} = log:append(L3, d), {ok, L5, S4} = log:append(L4, e), {S0,S1,S2,S3,S4,log:tip(L5)} =:= {0,1,2,3,4,5}\") :name)")
;; entries/1 returns activities in append order
(epoch 15)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), {ok, L1, _} = log:append(L0, a), {ok, L2, _} = log:append(L1, b), {ok, L3, _} = log:append(L2, c), log:entries(L3) =:= [a, b, c]\") :name)")
;; Round-trip: appended activity is recoverable byte-for-byte
(epoch 16)
(eval "(get (erlang-eval-ast \"Act = [{id,1},{type,create},{actor,alice}], {ok, L0} = log:open(alice, base), {ok, L1, _} = log:append(L0, Act), log:entries(L1) =:= [Act]\") :name)")
;; Per-actor isolation: two logs are independent
(epoch 17)
(eval "(get (erlang-eval-ast \"{ok, LA0} = log:open(alice, base), {ok, LB0} = log:open(bob, base), {ok, LA1, _} = log:append(LA0, a), {ok, LB1, _} = log:append(LB0, b1), {ok, LB2, _} = log:append(LB1, b2), {log:tip(LA1), log:tip(LB2)} =:= {1, 2}\") :name)")
;; replay/3 visits all activities in append order with monotonic seqs
(epoch 18)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), {ok, L1, _} = log:append(L0, a), {ok, L2, _} = log:append(L1, b), {ok, L3, _} = log:append(L2, c), log:replay(L3, [], fun (A, S, Acc) -> [{S, A} | Acc] end) =:= [{2,c},{1,b},{0,a}]\") :name)")
;; replay over empty log: InitAcc returned unchanged
(epoch 19)
(eval "(get (erlang-eval-ast \"{ok, L} = log:open(alice, base), log:replay(L, init_acc, fun (_, _, A) -> A end) =:= init_acc\") :name)")
;; replay can compute a derived state (sum of integer activities)
(epoch 20)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), {ok, L1, _} = log:append(L0, 10), {ok, L2, _} = log:append(L1, 20), {ok, L3, _} = log:append(L2, 30), log:replay(L3, 0, fun (V, _, Acc) -> V + Acc end) =:= 60\") :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" "log"
check 10 "fresh log tip is 0" "true"
check 11 "fresh log entries empty" "true"
check 12 "append returns seq 0, tip 1" "true"
check 13 "two appends seq 0,1; tip 2" "true"
check 14 "five appends gap-free" "true"
check 15 "entries in append order" "true"
check 16 "round-trip activity" "true"
check 17 "per-actor isolation" "true"
check 18 "replay visits all in order" "true"
check 19 "replay over empty log" "true"
check 20 "replay computes derived state" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/log_memory.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,125 +0,0 @@
#!/usr/bin/env bash
# next/tests/log_rotate.sh — Step 3c.a segment rotation acceptance.
#
# Exercises log:open_disk/3 with {segment_size, N} opt-in, append/2
# rotation behaviour at the threshold, replay across segments, and
# reopen-after-rotation. Builds on the Step 3b on-disk substrate
# (term_codec.erl + log.erl framed-segment writer).
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
DISK_BASE=/tmp/fed_sx_m1_log_rotate
rm -rf "$DISK_BASE"
mkdir -p "$DISK_BASE"
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE; rm -rf $DISK_BASE" 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/term_codec.erl\")) :name)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/log.erl\")) :name)")
;; Base path /tmp/fed_sx_m1_log_rotate built byte-by-byte.
;; --- default open_disk/2 = no rotation: many appends still single seg ---
(epoch 10)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $r, $o, $t, $a, $t, $e]), {ok, L0} = log:open_disk(noopt, Base), {ok, L1, _} = log:append(L0, a), {ok, L2, _} = log:append(L1, b), {ok, L3, _} = log:append(L2, c), log:segments(L3) =:= [3]\") :name)")
;; --- small threshold rotates: 5 short entries -> multiple segs ---
;; Each encoded entry like 'msg' is ~6 bytes + 4-byte length header = 10 bytes.
;; Threshold 16 bytes means seg rotates after every 2 entries.
(epoch 20)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $r, $o, $t, $a, $t, $e]), {ok, L0} = log:open_disk(small, Base, [{segment_size, 16}]), {ok, L1, _} = log:append(L0, aa), {ok, L2, _} = log:append(L1, bb), {ok, L3, _} = log:append(L2, cc), {ok, L4, _} = log:append(L3, dd), {ok, L5, _} = log:append(L4, ee), case log:segments(L5) of Lst when is_list(Lst), length(Lst) > 1 -> rotated; _ -> singleseg end\") :name)")
;; --- rotated entries replay in chronological order ---
(epoch 21)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $r, $o, $t, $a, $t, $e]), {ok, L0} = log:open_disk(replay, Base, [{segment_size, 16}]), {ok, L1, _} = log:append(L0, aa), {ok, L2, _} = log:append(L1, bb), {ok, L3, _} = log:append(L2, cc), {ok, L4, _} = log:append(L3, dd), {ok, L5, _} = log:append(L4, ee), log:entries(L5) =:= [aa, bb, cc, dd, ee]\") :name)")
;; --- reopen after rotation: history is reassembled in order ---
(epoch 22)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $r, $o, $t, $a, $t, $e]), {ok, L0} = log:open_disk(reopen, Base, [{segment_size, 16}]), {ok, L1, _} = log:append(L0, aa), {ok, L2, _} = log:append(L1, bb), {ok, L3, _} = log:append(L2, cc), {ok, L4, _} = log:append(L3, dd), {ok, L5, _} = log:append(L4, ee), {ok, R} = log:open_disk(reopen, Base, [{segment_size, 16}]), {log:entries(R), log:tip(R)} =:= {[aa, bb, cc, dd, ee], 5}\") :name)")
;; --- segments after reopen match (same shape rebuilt from disk) ---
(epoch 23)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $r, $o, $t, $a, $t, $e]), {ok, L0} = log:open_disk(shape, Base, [{segment_size, 16}]), {ok, L1, _} = log:append(L0, aa), {ok, L2, _} = log:append(L1, bb), {ok, L3, _} = log:append(L2, cc), {ok, L4, _} = log:append(L3, dd), {ok, L5, _} = log:append(L4, ee), {ok, R} = log:open_disk(shape, Base, [{segment_size, 16}]), log:segments(R) =:= log:segments(L5)\") :name)")
;; --- single huge entry > threshold: still one segment, no infinite loop ---
(epoch 30)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $r, $o, $t, $a, $t, $e]), {ok, L0} = log:open_disk(huge, Base, [{segment_size, 4}]), Big = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, {ok, L1, _} = log:append(L0, Big), log:segments(L1) =:= [1]\") :name)")
;; --- append after huge first entry forces rotation on next entry ---
(epoch 31)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $r, $o, $t, $a, $t, $e]), {ok, L0} = log:open_disk(post, Base, [{segment_size, 4}]), Big = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, {ok, L1, _} = log:append(L0, Big), {ok, L2, _} = log:append(L1, small), log:entries(L2) =:= [Big, small]\") :name)")
;; --- tip increments monotonically across rotations ---
(epoch 40)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $r, $o, $t, $a, $t, $e]), {ok, L0} = log:open_disk(tipcheck, Base, [{segment_size, 16}]), {ok, L1, _} = log:append(L0, x1), {ok, L2, _} = log:append(L1, x2), {ok, L3, _} = log:append(L2, x3), {ok, L4, _} = log:append(L3, x4), log:tip(L4) =:= 4\") :name)")
EPOCHS
OUTPUT=$(timeout 90 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1 || true)
if echo "$actual" | grep -q "^(ok-len"; then actual=""; fi
if [ -z "$actual" ]; then
actual=$(echo "$OUTPUT" | grep "^(ok $epoch " | head -1 || true)
fi
if [ -z "$actual" ]; then
actual=$(echo "$OUTPUT" | grep "^(error $epoch " | head -1 || true)
fi
[ -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 "term_codec loads" "term_codec"
check 3 "log module loads" "log"
check 10 "no-opt = single seg after 3" "true"
check 20 "rotation fires on threshold" "rotated"
check 21 "rotated entries chronological" "true"
check 22 "reopen rebuilds history" "true"
check 23 "reopen rebuilds same seg shape" "true"
check 30 "huge single entry stays 1 seg" "true"
check 31 "append after huge keeps order" "true"
check 40 "tip monotonic across rotations" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL log_rotate tests passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,154 +0,0 @@
#!/usr/bin/env bash
# next/tests/log_server.sh — Step 3c.b acceptance test.
#
# Exercises the gen_server-wrapped log: start_link, single-shot
# append/tip/entries/replay, and concurrent appends from N writer
# processes each firing M appends. Asserts no entries are lost or
# duplicated, tip equals N*M, and reopening from disk reconstructs
# the same activity set.
#
# Tests combine start_link + ops + assertion into a single
# erlang-eval-ast expression because spawned processes don't
# survive across separate eval invocations (see registry_server.sh
# for the same constraint at Step 5b).
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
DISK_BASE=/tmp/fed_sx_m1_log_server
rm -rf "$DISK_BASE"
mkdir -p "$DISK_BASE"
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE; rm -rf $DISK_BASE" 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 (er-load-gen-server!) :name)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/term_codec.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/log_server.erl\")) :name)")
;; Base path: /tmp/fed_sx_m1_log_server — built via list_to_binary
;; from $-prefixed char codes.
;; --- start_link returns a Pid ---
(epoch 10)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(srvA, Base), is_pid(P)\") :name)")
;; --- single append + tip + entries ---
(epoch 11)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(srvB, Base), {ok, 0} = log_server:append(P, hello), {ok, 1} = log_server:append(P, world), {log_server:tip(P), log_server:entries(P)} =:= {2, [hello, world]}\") :name)")
;; --- replay/3 visits append order ---
(epoch 12)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(srvC, Base), log_server:append(P, a), log_server:append(P, b), log_server:append(P, c), log_server:replay(P, [], fun (X, S, Acc) -> [{S, X} | Acc] end) =:= [{2,c},{1,b},{0,a}]\") :name)")
;; --- segments visible through wrapper ---
(epoch 13)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(srvD, Base), log_server:append(P, x), log_server:segments(P) =:= [1]\") :name)")
;; --- rotation through wrapper (opt-in small threshold) ---
(epoch 14)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(srvE, Base, [{segment_size, 16}]), log_server:append(P, aa), log_server:append(P, bb), log_server:append(P, cc), log_server:append(P, dd), log_server:append(P, ee), case log_server:segments(P) of Lst when is_list(Lst), length(Lst) > 1 -> rotated; _ -> singleseg end\") :name)")
;; --- CONCURRENCY: N=4 writers each fire M=10 appends ---
;; Each writer sends a sequence of appends, then notifies the parent.
;; The parent waits for all N {done, I} messages then asserts total.
;; Activities are {I, J} pairs so we can later check no dupes.
(epoch 20)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(conc1, Base), Parent = self(), N = 3, M = 2, Writer = fun (I) -> spawn(fun () -> lists:map(fun (J) -> log_server:append(P, {I, J}) end, lists:seq(1, M)), Parent ! {done, I} end) end, lists:map(Writer, lists:seq(1, N)), Wait = fun (_, 0) -> ok; (Self, K) -> receive {done, _} -> Self(Self, K - 1) end end, Wait(Wait, N), log_server:tip(P) =:= N * M\") :name)")
;; --- CONCURRENCY: entry count after N*M appends ---
(epoch 21)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(conc2, Base), Parent = self(), N = 3, M = 2, Writer = fun (I) -> spawn(fun () -> lists:map(fun (J) -> log_server:append(P, {I, J}) end, lists:seq(1, M)), Parent ! {done, I} end) end, lists:map(Writer, lists:seq(1, N)), Wait = fun (_, 0) -> ok; (Self, K) -> receive {done, _} -> Self(Self, K - 1) end end, Wait(Wait, N), length(log_server:entries(P)) =:= N * M\") :name)")
;; --- CONCURRENCY: every {I, J} pair shows up exactly once (no dupes / no losses) ---
(epoch 22)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(conc3, Base), Parent = self(), N = 3, M = 2, Writer = fun (I) -> spawn(fun () -> lists:map(fun (J) -> log_server:append(P, {I, J}) end, lists:seq(1, M)), Parent ! {done, I} end) end, lists:map(Writer, lists:seq(1, N)), Wait = fun (_, 0) -> ok; (Self, K) -> receive {done, _} -> Self(Self, K - 1) end end, Wait(Wait, N), E = log_server:entries(P), Check = fun (I) -> lists:all(fun (J) -> lists:member({I, J}, E) end, lists:seq(1, M)) end, lists:all(Check, lists:seq(1, N))\") :name)")
;; --- CONCURRENCY: reopen from disk after concurrent appends reproduces the set ---
(epoch 23)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(conc4, Base), Parent = self(), N = 3, M = 2, Writer = fun (I) -> spawn(fun () -> lists:map(fun (J) -> log_server:append(P, {I, J}) end, lists:seq(1, M)), Parent ! {done, I} end) end, lists:map(Writer, lists:seq(1, N)), Wait = fun (_, 0) -> ok; (Self, K) -> receive {done, _} -> Self(Self, K - 1) end end, Wait(Wait, N), Before = log_server:entries(P), {ok, R} = log:open_disk(conc4, Base), After = log:entries(R), {length(Before), length(After), Before =:= After} =:= {N * M, N * M, true}\") :name)")
;; --- CONCURRENCY: writes interleave (some writer's later append precedes another writer's earlier append) ---
(epoch 24)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(conc5, Base), Parent = self(), N = 3, M = 2, Writer = fun (I) -> spawn(fun () -> lists:map(fun (J) -> log_server:append(P, {I, J}) end, lists:seq(1, M)), Parent ! {done, I} end) end, lists:map(Writer, lists:seq(1, N)), Wait = fun (_, 0) -> ok; (Self, K) -> receive {done, _} -> Self(Self, K - 1) end end, Wait(Wait, N), E = log_server:entries(P), FirstWriter = fun ({I, _}) -> I end, Writers = lists:map(FirstWriter, E), Witnessed = fun (I) -> lists:member(I, Writers) end, lists:all(Witnessed, lists:seq(1, N))\") :name)")
;; --- stop returns ok and the Pid is no longer alive ---
(epoch 30)
(eval "(get (erlang-eval-ast \"Base = list_to_binary([$/, $t, $m, $p, $/, $f, $e, $d, $_, $s, $x, $_, $m, $1, $_, $l, $o, $g, $_, $s, $e, $r, $v, $e, $r]), P = log_server:start_link(srvF, Base), log_server:stop(P) =:= ok\") :name)")
EPOCHS
OUTPUT=$(timeout 240 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1 || true)
if echo "$actual" | grep -q "^(ok-len"; then actual=""; fi
if [ -z "$actual" ]; then
actual=$(echo "$OUTPUT" | grep "^(ok $epoch " | head -1 || true)
fi
if [ -z "$actual" ]; then
actual=$(echo "$OUTPUT" | grep "^(error $epoch " | head -1 || true)
fi
[ -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 "term_codec loads" "term_codec"
check 4 "log loads" "log"
check 5 "log_server loads" "log_server"
check 10 "start_link returns pid" "true"
check 11 "single append+tip+entries" "true"
check 12 "replay/3 chronological" "true"
check 13 "segments through wrapper" "true"
check 14 "rotation through wrapper" "rotated"
check 20 "concurrent: tip = N*M" "true"
check 21 "concurrent: entries count N*M" "true"
check 22 "concurrent: every pair present" "true"
check 23 "concurrent: reopen matches" "true"
check 24 "concurrent: every writer wrote" "true"
check 30 "stop returns ok" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL log_server tests passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,130 +0,0 @@
#!/usr/bin/env bash
# next/tests/nx_kernel_pure.sh — Step 8c-post-publish-pure tests.
#
# Exercises pure-functional nx_kernel:new/3, publish/2, and the
# accessors. Verifies the state advances correctly across multiple
# publishes and that the next_published counter prevents replay
# collisions when the same Request is published twice. 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: key material + actor state + an initial nx_kernel
# state bound to S0. Each test builds from S0.
PRELUDE='KM = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,KM}], AS = [{public_keys,[[{id,k1},{created,0},{value,KM}]]}], S0 = nx_kernel:new(alice, KS, AS), Req = [{type,create},{object,nil}],'
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/pipeline.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
(epoch 6)
(eval "(get (erlang-load-module (file-read \"next/kernel/nx_kernel.erl\")) :name)")
;; new/3 — fresh state has log_tip 0 and next_published 1
(epoch 10)
(eval "(erlang-eval-ast \"${PRELUDE} nx_kernel:log_tip(S0)\")")
(epoch 11)
(eval "(erlang-eval-ast \"${PRELUDE} nx_kernel:next_published(S0)\")")
;; Accessors return the expected values
(epoch 12)
(eval "(get (erlang-eval-ast \"${PRELUDE} nx_kernel:actor_id(S0) =:= alice\") :name)")
(epoch 13)
(eval "(get (erlang-eval-ast \"${PRELUDE} nx_kernel:key_spec(S0) =:= KS\") :name)")
(epoch 14)
(eval "(get (erlang-eval-ast \"${PRELUDE} nx_kernel:actor_state(S0) =:= AS\") :name)")
(epoch 15)
(eval "(get (erlang-eval-ast \"${PRELUDE} nx_kernel:projections(S0) =:= []\") :name)")
;; publish/2 happy path: log_tip advances to 1, next_published to 2
(epoch 20)
(eval "(get (erlang-eval-ast \"${PRELUDE} {ok, _, S1} = nx_kernel:publish(Req, S0), {nx_kernel:log_tip(S1), nx_kernel:next_published(S1)} =:= {1, 2}\") :name)")
;; Two sequential publishes (same Request) succeed because the
;; next_published counter makes each canonical envelope distinct
(epoch 21)
(eval "(erlang-eval-ast \"${PRELUDE} {ok, _, S1} = nx_kernel:publish(Req, S0), {ok, _, S2} = nx_kernel:publish(Req, S1), nx_kernel:log_tip(S2)\")")
;; Two publishes also bump next_published to 3
(epoch 22)
(eval "(erlang-eval-ast \"${PRELUDE} {ok, _, S1} = nx_kernel:publish(Req, S0), {ok, _, S2} = nx_kernel:publish(Req, S1), nx_kernel:next_published(S2)\")")
;; Bad key in state -> publish fails, state unchanged
(epoch 23)
(eval "(get (erlang-eval-ast \"${PRELUDE} OtherKM = <<9,9,9,9>>, BadKS = [{key_id,k1},{algorithm,ed25519},{value,OtherKM}], BadS = nx_kernel:new(alice, BadKS, AS), case nx_kernel:publish(Req, BadS) of {error, bad_signature, S} -> nx_kernel:log_tip(S) =:= 0; _ -> false end\") :name)")
;; with_projections replaces the :projections list
(epoch 24)
(eval "(get (erlang-eval-ast \"${PRELUDE} S = nx_kernel:with_projections([p_count], S0), nx_kernel:projections(S) =:= [p_count]\") :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 6 "nx_kernel module loaded" "nx_kernel"
check 10 "fresh log_tip = 0" "0"
check 11 "next_published starts at 1" "1"
check 12 "actor_id accessor" "true"
check 13 "key_spec accessor" "true"
check 14 "actor_state accessor" "true"
check 15 "projections defaults to []" "true"
check 20 "publish advances tip + counter" "true"
check 21 "two publishes advance tip to 2" "2"
check 22 "two publishes -> counter = 3" "3"
check 23 "bad key fails, state unchanged" "true"
check 24 "with_projections sets list" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/nx_kernel_pure.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/nx_kernel_server.sh — Step 8c-post-publish-srv tests.
#
# Exercises the gen_server-wrapped nx_kernel. Same port quirks
# as registry/projection gen_servers: each test inlines start_link
# with operations. 10 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 — KS/AS bindings + start_link + a Req binding.
PRELUDE='KM = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,KM}], AS = [{public_keys,[[{id,k1},{created,0},{value,KM}]]}], nx_kernel:start_link(alice, KS, AS), Req = [{type,create},{object,nil}],'
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/nx_kernel.erl\")) :name)")
;; start_link returns a Pid registered under nx_kernel
(epoch 10)
(eval "(get (erlang-eval-ast \"${PRELUDE} is_pid(whereis(nx_kernel))\") :name)")
;; log_tip starts at 0
(epoch 11)
(eval "(erlang-eval-ast \"${PRELUDE} nx_kernel:log_tip()\")")
;; publish/1 happy path returns {ok, _}
(epoch 12)
(eval "(get (erlang-eval-ast \"${PRELUDE} case nx_kernel:publish(Req) of {ok, _} -> ok; _ -> bad end\") :name)")
;; After one publish, log_tip = 1
(epoch 13)
(eval "(erlang-eval-ast \"${PRELUDE} nx_kernel:publish(Req), nx_kernel:log_tip()\")")
;; Two publishes -> log_tip = 2 (next_published counter avoids replay)
(epoch 14)
(eval "(erlang-eval-ast \"${PRELUDE} nx_kernel:publish(Req), nx_kernel:publish(Req), nx_kernel:log_tip()\")")
;; query/0 returns a state proplist with the right actor_id
(epoch 15)
(eval "(get (erlang-eval-ast \"${PRELUDE} S = nx_kernel:query(), nx_kernel:actor_id(S) =:= alice\") :name)")
;; with_projections/1 sets the projection list, visible via query
(epoch 16)
(eval "(get (erlang-eval-ast \"${PRELUDE} nx_kernel:with_projections([px]), S = nx_kernel:query(), nx_kernel:projections(S) =:= [px]\") :name)")
;; Bad key in state -> publish returns {error, bad_signature}; log_tip unchanged
(epoch 17)
(eval "(get (erlang-eval-ast \"OtherKM = <<9,9,9,9>>, KS = [{key_id,k1},{algorithm,ed25519},{value,OtherKM}], AS = [{public_keys,[[{id,k1},{created,0},{value,<<1,2,3,4>>}]]}], nx_kernel:start_link(alice, KS, AS), Req = [{type,create},{object,nil}], R = nx_kernel:publish(Req), Tip = nx_kernel:log_tip(), case {R, Tip} of {{error, bad_signature}, 0} -> ok; _ -> bad end\") :name)")
;; State persists across multiple gen_server calls in one expression
(epoch 18)
(eval "(get (erlang-eval-ast \"${PRELUDE} nx_kernel:publish(Req), Tip1 = nx_kernel:log_tip(), nx_kernel:publish(Req), Tip2 = nx_kernel:log_tip(), {Tip1, Tip2} =:= {1, 2}\") :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 7 "nx_kernel module loaded" "nx_kernel"
check 10 "start_link registered Pid" "true"
check 11 "fresh log_tip = 0" "0"
check 12 "publish/1 happy path" "ok"
check 13 "tip = 1 after one publish" "1"
check 14 "tip = 2 after two publishes" "2"
check 15 "query returns state w/ actor_id" "true"
check 16 "with_projections persists" "true"
check 17 "bad key fails, tip unchanged" "ok"
check 18 "state persists across calls" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/nx_kernel_server.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,129 +0,0 @@
#!/usr/bin/env bash
# next/tests/outbox_broadcast.sh — Step 7c acceptance test.
#
# Verifies outbox:publish/2 fans out to projection processes
# listed in Context's :projections entry. Each test inlines
# start_link with publish + query because spawned processes
# don't survive across erlang-eval-ast invocations. 9 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: KM/KS/AS/L0 + projections registered + Ctx with
# the named projections wired through. Each test threads from
# this state.
PRELUDE='KM = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,KM}], AS = [{public_keys,[[{id,k1},{created,50},{value,KM}]]}], {ok, L0} = log:open(alice, base), projection:start_link(p_count, 0, fun (_A, S) -> S + 1 end), projection:start_link(p_collect, [], fun (A, S) -> [A | S] end),'
cat > "$TMPFILE" <<EPOCHS
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(er-load-gen-server!)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
(epoch 4)
(eval "(get (erlang-load-module (file-read \"next/kernel/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/outbox.erl\")) :name)")
;; Single publish fans out to one projection -> count = 1
(epoch 10)
(eval "(erlang-eval-ast \"${PRELUDE} Ctx = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L0},{projections,[p_count]}], outbox:publish([{type,create},{object,nil}], Ctx), projection:query(p_count)\")")
;; Single publish fans out to TWO projections -> both advance
(epoch 11)
(eval "(get (erlang-eval-ast \"${PRELUDE} Ctx = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L0},{projections,[p_count, p_collect]}], outbox:publish([{type,create},{object,nil}], Ctx), C = projection:query(p_count), L = projection:query(p_collect), {C, length(L)} =:= {1, 1}\") :name)")
;; Empty :projections list -> no fan-out, projections stay at initial state
(epoch 12)
(eval "(erlang-eval-ast \"${PRELUDE} Ctx = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L0},{projections,[]}], outbox:publish([{type,create},{object,nil}], Ctx), projection:query(p_count)\")")
;; Missing :projections field -> no fan-out
(epoch 13)
(eval "(erlang-eval-ast \"${PRELUDE} Ctx = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L0}], outbox:publish([{type,create},{object,nil}], Ctx), projection:query(p_count)\")")
;; Three sequential publishes -> projection count = 3 (state persisted across casts)
(epoch 14)
(eval "(erlang-eval-ast \"${PRELUDE} Ctx0 = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L0},{projections,[p_count]}], {ok, _, L1} = outbox:publish([{type,create},{object,nil}], Ctx0), Ctx1 = [{actor_id,alice},{published,200},{key_spec,KS},{actor_state,AS},{log,L1},{projections,[p_count]}], {ok, _, L2} = outbox:publish([{type,create},{object,nil}], Ctx1), Ctx2 = [{actor_id,alice},{published,300},{key_spec,KS},{actor_state,AS},{log,L2},{projections,[p_count]}], outbox:publish([{type,create},{object,nil}], Ctx2), projection:query(p_count)\")")
;; Replay-halted publish does NOT broadcast
(epoch 15)
(eval "(get (erlang-eval-ast \"${PRELUDE} Ctx = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L0},{projections,[p_count]}], Req = [{type,create},{object,nil}], {ok, _, L1} = outbox:publish(Req, Ctx), Ctx2 = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L1},{projections,[p_count]}], outbox:publish(Req, Ctx2), projection:query(p_count) =:= 1\") :name)")
;; Sig-failed publish does NOT broadcast
(epoch 16)
(eval "(get (erlang-eval-ast \"${PRELUDE} BadKS = [{key_id,k1},{algorithm,ed25519},{value,<<9,9,9,9>>}], Ctx = [{actor_id,alice},{published,100},{key_spec,BadKS},{actor_state,AS},{log,L0},{projections,[p_count]}], outbox:publish([{type,create},{object,nil}], Ctx), projection:query(p_count) =:= 0\") :name)")
;; Projections receive the Signed activity (collect-fold sees envelope structure)
(epoch 17)
(eval "(get (erlang-eval-ast \"${PRELUDE} Ctx = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L0},{projections,[p_collect]}], {ok, Result, _} = outbox:publish([{type,create},{object,nil}], Ctx), {ok, ExpectedAct} = envelope:get_field(activity, Result), [Got] = projection:query(p_collect), Got =:= ExpectedAct\") :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 3 "envelope module loaded" "envelope"
check 4 "log module loaded" "log"
check 5 "pipeline module loaded" "pipeline"
check 6 "projection module loaded" "projection"
check 7 "outbox module loaded" "outbox"
check 10 "single publish -> count = 1" "1"
check 11 "fan-out to two projections" "true"
check 12 "empty :projections -> no fanout" "0"
check 13 "missing :projections -> no fan" "0"
check 14 "three publishes -> count = 3" "3"
check 15 "replay halt skips broadcast" "true"
check 16 "sig failure skips broadcast" "true"
check 17 "projection sees Signed activity" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/outbox_broadcast.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,124 +0,0 @@
#!/usr/bin/env bash
# next/tests/outbox_construct.sh — Step 6d-cs acceptance test.
#
# Exercises outbox:construct/4, outbox:sign/2, outbox:cid_of/1.
# Closes the loop by verifying that construct→sign produces an
# envelope that envelope:verify_signature/2 accepts. 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
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/outbox.erl\")) :name)")
;; construct: required fields present
(epoch 10)
(eval "(get (erlang-eval-ast \"Env = outbox:construct(create, alice, 100, nil), envelope:get_field(actor, Env) =:= {ok, alice}\") :name)")
(epoch 11)
(eval "(get (erlang-eval-ast \"Env = outbox:construct(create, alice, 100, nil), envelope:get_field(type, Env) =:= {ok, create}\") :name)")
(epoch 12)
(eval "(get (erlang-eval-ast \"Env = outbox:construct(create, alice, 100, nil), envelope:get_field(published, Env) =:= {ok, 100}\") :name)")
;; construct: :id is a non-trivial CID
(epoch 13)
(eval "(get (erlang-eval-ast \"Env = outbox:construct(create, alice, 100, nil), {ok, Id} = envelope:get_field(id, Env), is_binary(Id) and (byte_size(Id) > 50)\") :name)")
;; construct deterministic across calls with same args
(epoch 14)
(eval "(get (erlang-eval-ast \"E1 = outbox:construct(create, alice, 100, nil), E2 = outbox:construct(create, alice, 100, nil), outbox:cid_of(E1) =:= outbox:cid_of(E2)\") :name)")
;; construct distinct CIDs for distinct types
(epoch 15)
(eval "(get (erlang-eval-ast \"E1 = outbox:construct(create, alice, 100, nil), E2 = outbox:construct(update, alice, 100, nil), outbox:cid_of(E1) =/= outbox:cid_of(E2)\") :name)")
;; construct distinct CIDs for distinct timestamps
(epoch 16)
(eval "(get (erlang-eval-ast \"E1 = outbox:construct(create, alice, 100, nil), E2 = outbox:construct(create, alice, 101, nil), outbox:cid_of(E1) =/= outbox:cid_of(E2)\") :name)")
;; sign adds a :signature field
(epoch 17)
(eval "(get (erlang-eval-ast \"KS = [{key_id, k1}, {algorithm, ed25519}, {value, <<1,2,3>>}], Unsigned = outbox:construct(create, alice, 100, nil), Signed = outbox:sign(Unsigned, KS), envelope:get_field(signature, Signed) =/= not_found\") :name)")
;; signed envelope passes envelope:verify_signature with matching key
(epoch 18)
(eval "(get (erlang-eval-ast \"KM = <<1,2,3,4>>, KS = [{key_id, k1}, {algorithm, ed25519}, {value, KM}], Unsigned = outbox:construct(create, alice, 100, nil), Signed = outbox:sign(Unsigned, KS), AS = [{public_keys, [[{id, k1}, {created, 50}, {value, KM}]]}], envelope:verify_signature(Signed, AS) =:= ok\") :name)")
;; signed envelope fails verify with a wrong key
(epoch 19)
(eval "(get (erlang-eval-ast \"KM = <<1,2,3,4>>, OtherKM = <<9,9,9,9>>, KS = [{key_id, k1}, {algorithm, ed25519}, {value, KM}], Unsigned = outbox:construct(create, alice, 100, nil), Signed = outbox:sign(Unsigned, KS), AS = [{public_keys, [[{id, k1}, {created, 50}, {value, OtherKM}]]}], envelope:verify_signature(Signed, AS) =:= {error, bad_signature}\") :name)")
;; Round-trip through the full pipeline:
;; construct → sign → stage_envelope → stage_signature → ok
(epoch 20)
(eval "(get (erlang-eval-ast \"KM = <<1,2,3,4>>, KS = [{key_id, k1}, {algorithm, ed25519}, {value, KM}], Unsigned = outbox:construct(create, alice, 100, nil), Signed = outbox:sign(Unsigned, KS), AS = [{public_keys, [[{id, k1}, {created, 50}, {value, KM}]]}], envelope:validate_shape(Signed) =:= ok and envelope:verify_signature(Signed, AS) =:= 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 "envelope module loaded" "envelope"
check 3 "outbox module loaded" "outbox"
check 10 "construct sets :actor" "true"
check 11 "construct sets :type" "true"
check 12 "construct sets :published" "true"
check 13 "construct :id is a CID" "true"
check 14 "construct deterministic" "true"
check 15 "distinct types -> distinct CIDs" "true"
check 16 "distinct ts -> distinct CIDs" "true"
check 17 "sign adds :signature" "true"
check 18 "signed verifies against key" "true"
check 19 "signed fails against wrong key" "true"
check 20 "full pipeline round-trip" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/outbox_construct.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,129 +0,0 @@
#!/usr/bin/env bash
# next/tests/outbox_publish.sh — Step 6d-publish acceptance test.
#
# Exercises outbox:publish/2 across the happy path, sig failure,
# replay halt, and envelope-shape failure. Returns shape:
# {ok, [{cid, _}, {activity, _}], NewLogState}
# {error, Reason, LogState}
# 10 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 builds a fresh actor state, key spec, empty log,
# and a context proplist. Each test inlines it.
PRELUDE='KM = <<1,2,3,4>>, KS = [{key_id,k1},{algorithm,ed25519},{value,KM}], AS = [{public_keys,[[{id,k1},{created,50},{value,KM}]]}], {ok, L0} = log:open(alice, base), Ctx = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L0}], Req = [{type,create},{object,nil}],'
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/pipeline.erl\")) :name)")
(epoch 5)
(eval "(get (erlang-load-module (file-read \"next/kernel/outbox.erl\")) :name)")
;; Happy path: publish returns {ok, Result, NewLog}, log tip advances
(epoch 10)
(eval "(get (erlang-eval-ast \"${PRELUDE} case outbox:publish(Req, Ctx) of {ok, _, NewLog} -> log:tip(NewLog) =:= 1; _ -> false end\") :name)")
;; Result has :cid pointing at the activity's CID
(epoch 11)
(eval "(get (erlang-eval-ast \"${PRELUDE} {ok, Result, _} = outbox:publish(Req, Ctx), {ok, Cid} = envelope:get_field(cid, Result), {ok, Act} = envelope:get_field(activity, Result), outbox:cid_of(Act) =:= Cid\") :name)")
;; The signed activity is in the log
(epoch 12)
(eval "(get (erlang-eval-ast \"${PRELUDE} {ok, Result, NewLog} = outbox:publish(Req, Ctx), {ok, Act} = envelope:get_field(activity, Result), log:entries(NewLog) =:= [Act]\") :name)")
;; Replay: second publish of identical Request halts the pipeline
(epoch 13)
(eval "(get (erlang-eval-ast \"${PRELUDE} {ok, _, L1} = outbox:publish(Req, Ctx), Ctx2 = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L1}], case outbox:publish(Req, Ctx2) of {error, replay, _} -> ok; _ -> bad end\") :name)")
;; Replay returns the pre-append LogState unchanged
(epoch 14)
(eval "(get (erlang-eval-ast \"${PRELUDE} {ok, _, L1} = outbox:publish(Req, Ctx), Ctx2 = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L1}], {error, _, L2} = outbox:publish(Req, Ctx2), log:tip(L2) =:= 1\") :name)")
;; Bad key material (sig fails) -> {error, bad_signature, LogState}
(epoch 15)
(eval "(get (erlang-eval-ast \"${PRELUDE} OtherKM = <<9,9,9,9>>, BadKS = [{key_id,k1},{algorithm,ed25519},{value,OtherKM}], BadCtx = [{actor_id,alice},{published,100},{key_spec,BadKS},{actor_state,AS},{log,L0}], case outbox:publish(Req, BadCtx) of {error, bad_signature, _} -> ok; _ -> bad end\") :name)")
;; Distinct timestamps -> two activities in log
(epoch 16)
(eval "(get (erlang-eval-ast \"${PRELUDE} {ok, _, L1} = outbox:publish(Req, Ctx), Ctx2 = [{actor_id,alice},{published,200},{key_spec,KS},{actor_state,AS},{log,L1}], {ok, _, L2} = outbox:publish(Req, Ctx2), log:tip(L2) =:= 2\") :name)")
;; Distinct types -> distinct CIDs
(epoch 17)
(eval "(get (erlang-eval-ast \"${PRELUDE} {ok, R1, L1} = outbox:publish(Req, Ctx), R2 = [{type,update},{object,nil}], Ctx2 = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L1}], {ok, R, _} = outbox:publish(R2, Ctx2), {ok, C1} = envelope:get_field(cid, R1), {ok, C2} = envelope:get_field(cid, R), C1 =/= C2\") :name)")
;; CID stable: same Request twice (across fresh logs) -> same CID
(epoch 18)
(eval "(get (erlang-eval-ast \"${PRELUDE} {ok, R1, _} = outbox:publish(Req, Ctx), {ok, L0b} = log:open(alice, base), Ctx_b = [{actor_id,alice},{published,100},{key_spec,KS},{actor_state,AS},{log,L0b}], {ok, R2, _} = outbox:publish(Req, Ctx_b), {ok, C1} = envelope:get_field(cid, R1), {ok, C2} = envelope:get_field(cid, R2), C1 =:= C2\") :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 "envelope module loaded" "envelope"
check 3 "log module loaded" "log"
check 4 "pipeline module loaded" "pipeline"
check 5 "outbox module loaded" "outbox"
check 10 "happy path tip advances to 1" "true"
check 11 "result :cid matches activity" "true"
check 12 "signed activity in log entries" "true"
check 13 "duplicate publish -> replay" "ok"
check 14 "replay leaves log tip at 1" "true"
check 15 "bad key material -> bad_signature" "ok"
check 16 "distinct timestamps -> tip 2" "true"
check 17 "distinct types -> distinct CIDs" "true"
check 18 "same request -> same CID" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/outbox_publish.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,112 +0,0 @@
#!/usr/bin/env bash
# next/tests/pipeline_driver.sh — Step 6a acceptance test.
#
# Exercises the pipeline driver: pipeline:run_stages/2,
# validate_inbound/1, validate_outbound/1, inbound_stages/0,
# outbound_stages/0. Concrete stages land in 6b+. 10 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/pipeline.erl\")) :name)")
;; Empty stage list returns ok
(epoch 10)
(eval "(get (erlang-eval-ast \"pipeline:run_stages(anything, []) =:= ok\") :name)")
;; All-ok stages return ok
(epoch 11)
(eval "(get (erlang-eval-ast \"pipeline:run_stages(anything, [fun (_) -> ok end, fun (_) -> ok end, fun (_) -> ok end]) =:= ok\") :name)")
;; First failing stage halts; later stages do not run
(epoch 12)
(eval "(get (erlang-eval-ast \"pipeline:run_stages(anything, [fun (_) -> ok end, fun (_) -> {error, halt_here} end, fun (_) -> {error, after_halt} end]) =:= {error, halt_here}\") :name)")
;; Single failing stage returns its error
(epoch 13)
(eval "(get (erlang-eval-ast \"pipeline:run_stages(anything, [fun (_) -> {error, bad} end]) =:= {error, bad}\") :name)")
;; Stage receives the activity verbatim
(epoch 14)
(eval "(get (erlang-eval-ast \"pipeline:run_stages(my_act, [fun (A) -> case A of my_act -> ok; _ -> {error, wrong_arg} end end]) =:= ok\") :name)")
;; inbound_stages / outbound_stages are lists (concrete stages
;; tested in pipeline_envelope.sh; we just confirm they're lists).
(epoch 15)
(eval "(get (erlang-eval-ast \"is_list(pipeline:inbound_stages())\") :name)")
(epoch 16)
(eval "(get (erlang-eval-ast \"is_list(pipeline:outbound_stages())\") :name)")
;; Driver-only invariants: explicit empty list with the wrappers
;; semantics is exercised via run_stages directly.
(epoch 17)
(eval "(get (erlang-eval-ast \"pipeline:run_stages(anything, []) =:= ok\") :name)")
(epoch 18)
(eval "(get (erlang-eval-ast \"pipeline:run_stages(my_act, [fun (_) -> ok end]) =:= ok\") :name)")
EPOCHS
OUTPUT=$(timeout 120 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 2 "module load name" "pipeline"
check 10 "empty stage list -> ok" "true"
check 11 "all-ok stages -> ok" "true"
check 12 "first failure halts pipeline" "true"
check 13 "single failing stage" "true"
check 14 "stage receives activity verbatim" "true"
check 15 "inbound_stages is a list" "true"
check 16 "outbound_stages is a list" "true"
check 17 "run_stages empty -> ok" "true"
check 18 "run_stages single ok stage" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/pipeline_driver.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,119 +0,0 @@
#!/usr/bin/env bash
# next/tests/pipeline_envelope.sh — Step 6b acceptance test.
#
# Exercises stage_envelope/1 directly and via validate_inbound /
# validate_outbound. The envelope module must be loaded first
# because stage_envelope delegates to envelope:validate_shape/1.
# 10 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
cat > "$TMPFILE" <<'EPOCHS'
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
;; Stage list now has exactly one stage
(epoch 10)
(eval "(erlang-eval-ast \"length(pipeline:inbound_stages())\")")
(epoch 11)
(eval "(erlang-eval-ast \"length(pipeline:outbound_stages())\")")
;; stage_envelope on a valid envelope returns ok
(epoch 12)
(eval "(get (erlang-eval-ast \"pipeline:stage_envelope([{id,1},{type,create},{actor,a},{published,1},{signature,[{key_id,k},{algorithm,e},{value,v}]}]) =:= ok\") :name)")
;; stage_envelope on a non-list returns {error, not_a_proplist}
(epoch 13)
(eval "(get (erlang-eval-ast \"pipeline:stage_envelope(not_a_list) =:= {error, not_a_proplist}\") :name)")
;; stage_envelope on missing id surfaces the missing-field error
(epoch 14)
(eval "(get (erlang-eval-ast \"case pipeline:stage_envelope([{type,create}]) of {error, {missing_field, id}} -> ok; _ -> bad end\") :name)")
;; validate_inbound runs stage_envelope and returns ok for valid input
(epoch 15)
(eval "(get (erlang-eval-ast \"pipeline:validate_inbound([{id,1},{type,create},{actor,a},{published,1},{signature,[{key_id,k},{algorithm,e},{value,v}]}]) =:= ok\") :name)")
;; validate_inbound short-circuits with the envelope error
(epoch 16)
(eval "(get (erlang-eval-ast \"case pipeline:validate_inbound([{type,create}]) of {error, {missing_field, id}} -> ok; _ -> bad end\") :name)")
;; validate_outbound likewise
(epoch 17)
(eval "(get (erlang-eval-ast \"pipeline:validate_outbound([{id,1},{type,create},{actor,a},{published,1},{signature,[{key_id,k},{algorithm,e},{value,v}]}]) =:= ok\") :name)")
(epoch 18)
(eval "(get (erlang-eval-ast \"case pipeline:validate_outbound([{id,1},{actor,a}]) of {error, _} -> ok; _ -> bad end\") :name)")
;; Signature-subfield missing surfaces nested error tag
(epoch 19)
(eval "(get (erlang-eval-ast \"case pipeline:validate_inbound([{id,1},{type,create},{actor,a},{published,1},{signature,[{key_id,k}]}]) of {error, {bad_signature, _}} -> 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 2 "envelope module loaded" "envelope"
check 3 "pipeline module loaded" "pipeline"
check 10 "inbound_stages length = 1" "1"
check 11 "outbound_stages length = 1" "1"
check 12 "stage_envelope ok on valid" "true"
check 13 "stage_envelope errs on non-list" "true"
check 14 "stage_envelope missing id error" "ok"
check 15 "validate_inbound ok on valid" "true"
check 16 "validate_inbound surfaces error" "ok"
check 17 "validate_outbound ok on valid" "true"
check 18 "validate_outbound errs on bad" "ok"
check 19 "nested bad_signature surfaces" "ok"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/pipeline_envelope.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,120 +0,0 @@
#!/usr/bin/env bash
# next/tests/pipeline_replay.sh — Step 6c acceptance test.
#
# Exercises pipeline:stage_replay/2 (direct) and stage_replay/1
# (factory) against the in-memory log from Step 3a. Composability
# with stage_envelope verified. 10 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
cat > "$TMPFILE" <<'EPOCHS'
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
(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/pipeline.erl\")) :name)")
;; New activity in an empty log is ok
(epoch 10)
(eval "(get (erlang-eval-ast \"{ok, L} = log:open(alice, base), Act = [{id, a1}, {type, create}], pipeline:stage_replay(Act, L) =:= ok\") :name)")
;; Same activity already in log -> {error, replay}
(epoch 11)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), Act = [{id, a1}, {type, create}], {ok, L1, _} = log:append(L0, Act), pipeline:stage_replay(Act, L1) =:= {error, replay}\") :name)")
;; Different :id is still ok even if log non-empty
(epoch 12)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), {ok, L1, _} = log:append(L0, [{id, a1}, {type, create}]), pipeline:stage_replay([{id, a2}, {type, create}], L1) =:= ok\") :name)")
;; No :id field -> {error, no_id}
(epoch 13)
(eval "(get (erlang-eval-ast \"{ok, L} = log:open(alice, base), pipeline:stage_replay([{type, create}], L) =:= {error, no_id}\") :name)")
;; Match against the second log entry (linear scan walks all entries)
(epoch 14)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), {ok, L1, _} = log:append(L0, [{id, a1}, {type, create}]), {ok, L2, _} = log:append(L1, [{id, a2}, {type, create}]), pipeline:stage_replay([{id, a2}, {type, update}], L2) =:= {error, replay}\") :name)")
;; stage_replay/1 factory returns a fun
(epoch 15)
(eval "(get (erlang-eval-ast \"{ok, L} = log:open(alice, base), is_function(pipeline:stage_replay(L))\") :name)")
;; Factory + run_stages: fresh activity flows through
(epoch 16)
(eval "(get (erlang-eval-ast \"{ok, L} = log:open(alice, base), Act = [{id, a1}, {type, create}], Stages = [pipeline:stage_replay(L)], pipeline:run_stages(Act, Stages) =:= ok\") :name)")
;; Factory + run_stages: replay halts the pipeline
(epoch 17)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), Act = [{id, a1}, {type, create}], {ok, L1, _} = log:append(L0, Act), Stages = [pipeline:stage_replay(L1)], pipeline:run_stages(Act, Stages) =:= {error, replay}\") :name)")
;; Composed with stage_envelope: envelope error precedes replay check
(epoch 18)
(eval "(get (erlang-eval-ast \"{ok, L0} = log:open(alice, base), Act = [{id, a1}, {type, create}, {actor, a}, {published, 1}, {signature, [{key_id, k}, {algorithm, e}, {value, v}]}], {ok, L1, _} = log:append(L0, Act), Stages = [fun (A) -> pipeline:stage_envelope(A) end, pipeline:stage_replay(L1)], pipeline:run_stages(Act, Stages) =:= {error, replay}\") :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 "envelope module loaded" "envelope"
check 3 "log module loaded" "log"
check 4 "pipeline module loaded" "pipeline"
check 10 "new activity in empty log -> ok" "true"
check 11 "same id -> {error, replay}" "true"
check 12 "different id still ok" "true"
check 13 "no :id -> {error, no_id}" "true"
check 14 "match second log entry" "true"
check 15 "stage_replay/1 returns fun" "true"
check 16 "factory + run_stages: ok" "true"
check 17 "factory + run_stages: halts" "true"
check 18 "composed envelope+replay halts" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/pipeline_replay.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,137 +0,0 @@
#!/usr/bin/env bash
# next/tests/pipeline_schema.sh — Step 6c-schema-pure test.
#
# Exercises stage_schema/2 (direct call) and stage_schema/1
# (factory). The SchemaLookup callback returns either
# {ok, SchemaFn} or not_found; open-world default means
# not_found resolves to ok. 12 cases.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
# Common: a strict Pin schema requires Object to have :path and :cid
# `PinSchema = fun (Obj) -> ...`.
PRELUDE='PinSchema = fun (Obj) -> case envelope:get_field(path, Obj) of {ok, _} -> case envelope:get_field(cid, Obj) of {ok, _} -> true; _ -> false end; _ -> false end end, PinLookup = fun (pin) -> {ok, PinSchema}; (_) -> not_found end,'
cat > "$TMPFILE" <<EPOCHS
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
;; Open-world default: unknown type returns ok
(epoch 10)
(eval "(get (erlang-eval-ast \"NoLookup = fun (_) -> not_found end, pipeline:stage_schema([{type, foo}, {object, bar}], NoLookup) =:= ok\") :name)")
;; Activity without :type -> {error, no_type}
(epoch 11)
(eval "(get (erlang-eval-ast \"NoLookup = fun (_) -> not_found end, pipeline:stage_schema([{object, x}], NoLookup) =:= {error, no_type}\") :name)")
;; Known type, schema passes -> ok
(epoch 12)
(eval "(get (erlang-eval-ast \"${PRELUDE} Act = [{type, pin}, {object, [{path, <<47,97>>}, {cid, <<98>>}]}], pipeline:stage_schema(Act, PinLookup) =:= ok\") :name)")
;; Known type, schema fails -> {error, schema_mismatch}
(epoch 13)
(eval "(get (erlang-eval-ast \"${PRELUDE} Act = [{type, pin}, {object, [{path, <<47,97>>}]}], pipeline:stage_schema(Act, PinLookup) =:= {error, schema_mismatch}\") :name)")
;; Activity with no :object skips schema check
(epoch 14)
(eval "(get (erlang-eval-ast \"${PRELUDE} pipeline:stage_schema([{type, pin}], PinLookup) =:= ok\") :name)")
;; stage_schema/1 returns a function
(epoch 15)
(eval "(get (erlang-eval-ast \"is_function(pipeline:stage_schema(fun (_) -> not_found end))\") :name)")
;; Factory + activity -> applies the lookup
(epoch 16)
(eval "(get (erlang-eval-ast \"${PRELUDE} Stage = pipeline:stage_schema(PinLookup), Stage([{type, pin}, {object, [{path, <<1>>}, {cid, <<2>>}]}]) =:= ok\") :name)")
;; Factory + bad activity -> schema_mismatch
(epoch 17)
(eval "(get (erlang-eval-ast \"${PRELUDE} Stage = pipeline:stage_schema(PinLookup), Stage([{type, pin}, {object, [{path, <<1>>}]}]) =:= {error, schema_mismatch}\") :name)")
;; Composed with stage_envelope via run_stages: bad envelope halts first
(epoch 18)
(eval "(get (erlang-eval-ast \"${PRELUDE} Stages = [fun (A) -> pipeline:stage_envelope(A) end, pipeline:stage_schema(PinLookup)], case pipeline:run_stages([{type, pin}], Stages) of {error, {missing_field, _}} -> ok; _ -> bad end\") :name)")
;; Composed: envelope ok + schema fail -> schema_mismatch
(epoch 19)
(eval "(get (erlang-eval-ast \"${PRELUDE} Act = [{id, 1}, {type, pin}, {actor, alice}, {published, 1}, {signature, [{key_id, k}, {algorithm, e}, {value, v}]}, {object, [{path, <<1>>}]}], Stages = [fun (A) -> pipeline:stage_envelope(A) end, pipeline:stage_schema(PinLookup)], pipeline:run_stages(Act, Stages) =:= {error, schema_mismatch}\") :name)")
;; Schema fn receives the object (verify by mutating an Erlang process flag isn't reliable; instead capture & test inside the schema)
(epoch 20)
(eval "(get (erlang-eval-ast \"Captor = fun (Obj) -> envelope:get_field(target, Obj) =:= {ok, mark} end, Lookup = fun (_) -> {ok, Captor} end, pipeline:stage_schema([{type, t}, {object, [{target, mark}]}], Lookup) =:= ok\") :name)")
;; Multiple types registered: only matching one consulted
(epoch 21)
(eval "(get (erlang-eval-ast \"PinF = fun (_) -> true end, NoteF = fun (_) -> false end, Multi = fun (pin) -> {ok, PinF}; (note) -> {ok, NoteF}; (_) -> not_found end, {pipeline:stage_schema([{type, pin}, {object, ignored}], Multi), pipeline:stage_schema([{type, note}, {object, ignored}], Multi), pipeline:stage_schema([{type, other}, {object, ignored}], Multi)} =:= {ok, {error, schema_mismatch}, ok}\") :name)")
EPOCHS
OUTPUT=$(timeout 120 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
$0 ~ "^\\(ok " e " " { print; exit }
$0 ~ "^\\(error " e " " { print; exit }
')
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
check 2 "envelope module loaded" "envelope"
check 3 "pipeline module loaded" "pipeline"
check 10 "open-world default for unknown" "true"
check 11 "no :type -> no_type error" "true"
check 12 "schema accepts -> ok" "true"
check 13 "schema rejects -> mismatch" "true"
check 14 "no :object skips check" "true"
check 15 "stage_schema/1 returns fun" "true"
check 16 "factory + ok" "true"
check 17 "factory + mismatch" "true"
check 18 "envelope halt before schema" "ok"
check 19 "envelope ok + schema mismatch" "true"
check 20 "schema fn receives object" "true"
check 21 "multi-type lookup dispatches" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/pipeline_schema.sh passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]

View File

@@ -1,122 +0,0 @@
#!/usr/bin/env bash
# next/tests/pipeline_signature.sh — Step 6b-sig acceptance test.
#
# Exercises pipeline:stage_signature/2 (direct) and stage_signature/1
# (factory). The factory returns a 1-arity stage fun bound to the
# given actor-state so it can be folded into a stage list by the
# pipeline driver alongside stage_envelope. 10 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 Erlang prelude builds a valid signed envelope + actor
# state — same shape as next/tests/envelope_sig.sh from Step 2c.
PRELUDE='KM = <<1,2,3,4>>, U = [{actor,alice},{id,1},{published,100},{type,create}], CB = envelope:canonical_bytes(U), Sig = crypto:hash(sha256, <<KM/binary, CB/binary>>), Env = [{actor,alice},{id,1},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,Sig}]}], AS = [{public_keys, [[{id,k1},{created,50},{value,KM}]]}],'
cat > "$TMPFILE" <<EPOCHS
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/vm/dispatcher.sx")
(epoch 2)
(eval "(get (erlang-load-module (file-read \"next/kernel/envelope.erl\")) :name)")
(epoch 3)
(eval "(get (erlang-load-module (file-read \"next/kernel/pipeline.erl\")) :name)")
;; Direct 2-arity stage_signature on a valid signed envelope returns ok
(epoch 10)
(eval "(get (erlang-eval-ast \"${PRELUDE} pipeline:stage_signature(Env, AS) =:= ok\") :name)")
;; Tampered envelope returns the proper error tag
(epoch 11)
(eval "(get (erlang-eval-ast \"${PRELUDE} Tampered = [{actor,alice},{id,999},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,Sig}]}], pipeline:stage_signature(Tampered, AS) =:= {error,bad_signature}\") :name)")
;; Missing signature -> no_signature
(epoch 12)
(eval "(get (erlang-eval-ast \"${PRELUDE} pipeline:stage_signature(U, AS) =:= {error,no_signature}\") :name)")
;; stage_signature/1 returns a function
(epoch 13)
(eval "(get (erlang-eval-ast \"is_function(pipeline:stage_signature([{public_keys, []}]))\") :name)")
;; stage_signature/1 factory: built stage returns ok on valid input
(epoch 14)
(eval "(get (erlang-eval-ast \"${PRELUDE} Stage = pipeline:stage_signature(AS), Stage(Env) =:= ok\") :name)")
;; stage_signature/1 factory: built stage returns error on tampered input
(epoch 15)
(eval "(get (erlang-eval-ast \"${PRELUDE} Stage = pipeline:stage_signature(AS), Tampered = [{actor,alice},{id,999},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,Sig}]}], Stage(Tampered) =:= {error,bad_signature}\") :name)")
;; Composable: envelope + signature stages folded together via run_stages
(epoch 16)
(eval "(get (erlang-eval-ast \"${PRELUDE} Stages = [fun (A) -> pipeline:stage_envelope(A) end, pipeline:stage_signature(AS)], pipeline:run_stages(Env, Stages) =:= ok\") :name)")
;; Composable + halt: envelope stage fails first, signature never runs
(epoch 17)
(eval "(get (erlang-eval-ast \"${PRELUDE} BadShape = [{type,create}], Stages = [fun (A) -> pipeline:stage_envelope(A) end, pipeline:stage_signature(AS)], case pipeline:run_stages(BadShape, Stages) of {error, {missing_field, _}} -> ok; _ -> bad end\") :name)")
;; Composable + halt: envelope OK, signature fails -> sig error surfaces
(epoch 18)
(eval "(get (erlang-eval-ast \"${PRELUDE} Tampered = [{actor,alice},{id,999},{published,100},{type,create},{signature,[{algorithm,ed25519},{key_id,k1},{value,Sig}]}], Stages = [fun (A) -> pipeline:stage_envelope(A) end, pipeline:stage_signature(AS)], pipeline:run_stages(Tampered, Stages) =:= {error,bad_signature}\") :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 "envelope module loaded" "envelope"
check 3 "pipeline module loaded" "pipeline"
check 10 "stage_signature/2 valid -> ok" "true"
check 11 "stage_signature/2 tampered" "true"
check 12 "stage_signature/2 no sig" "true"
check 13 "stage_signature/1 returns fun" "true"
check 14 "factory stage valid -> ok" "true"
check 15 "factory stage tampered" "true"
check 16 "envelope+sig composed ok" "true"
check 17 "halt on envelope before sig" "ok"
check 18 "sig error after envelope ok" "true"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL next/tests/pipeline_signature.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