Compare commits
17 Commits
loops/fed-
...
loops/erla
| Author | SHA1 | Date | |
|---|---|---|---|
| 2d20f41498 | |||
| 27dedf9b0a | |||
| 3d8607a40a | |||
| 394d5790ad | |||
| d2c1400737 | |||
| 5a1412515a | |||
| 3ae35a4b9b | |||
| 42a16f7cf3 | |||
| 343c508939 | |||
| 355a482dfe | |||
| b10e55f04f | |||
| 98b0104c7b | |||
| 3709460d0b | |||
| bcabed6bce | |||
| 5098a8f015 | |||
| 9fe5c9044d | |||
| c6f397c3d9 |
@@ -38,6 +38,8 @@ SUITES=(
|
|||||||
"fib|er-fib-test-pass|er-fib-test-count"
|
"fib|er-fib-test-pass|er-fib-test-count"
|
||||||
"ffi|er-ffi-test-pass|er-ffi-test-count"
|
"ffi|er-ffi-test-pass|er-ffi-test-count"
|
||||||
"vm|er-vm-test-pass|er-vm-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'
|
cat > "$TMPFILE" << 'EPOCHS'
|
||||||
@@ -61,6 +63,8 @@ cat > "$TMPFILE" << 'EPOCHS'
|
|||||||
(load "lib/erlang/vm/dispatcher.sx")
|
(load "lib/erlang/vm/dispatcher.sx")
|
||||||
(load "lib/erlang/tests/ffi.sx")
|
(load "lib/erlang/tests/ffi.sx")
|
||||||
(load "lib/erlang/tests/vm.sx")
|
(load "lib/erlang/tests/vm.sx")
|
||||||
|
(load "lib/erlang/tests/send_after.sx")
|
||||||
|
(load "lib/erlang/tests/lists_ext.sx")
|
||||||
(epoch 100)
|
(epoch 100)
|
||||||
(eval "(list er-test-pass er-test-count)")
|
(eval "(list er-test-pass er-test-count)")
|
||||||
(epoch 101)
|
(epoch 101)
|
||||||
@@ -83,6 +87,10 @@ cat > "$TMPFILE" << 'EPOCHS'
|
|||||||
(eval "(list er-ffi-test-pass er-ffi-test-count)")
|
(eval "(list er-ffi-test-pass er-ffi-test-count)")
|
||||||
(epoch 110)
|
(epoch 110)
|
||||||
(eval "(list er-vm-test-pass er-vm-test-count)")
|
(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
|
EPOCHS
|
||||||
|
|
||||||
timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
|
timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
|
||||||
|
|||||||
@@ -135,6 +135,56 @@
|
|||||||
(dict-set! s :next-ref (+ n 1))
|
(dict-set! s :next-ref (+ n 1))
|
||||||
(er-mk-ref n)))))
|
(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 ──────────────────────────────────────────────
|
;; ── scheduler state ──────────────────────────────────────────────
|
||||||
(define er-scheduler (list nil))
|
(define er-scheduler (list nil))
|
||||||
|
|
||||||
@@ -151,6 +201,8 @@
|
|||||||
:processes {}
|
:processes {}
|
||||||
:registered {}
|
:registered {}
|
||||||
:ets {}
|
:ets {}
|
||||||
|
:clock 0
|
||||||
|
:timers (list)
|
||||||
:runnable (er-q-new)})))
|
:runnable (er-q-new)})))
|
||||||
|
|
||||||
(define er-sched (fn () (nth er-scheduler 0)))
|
(define er-sched (fn () (nth er-scheduler 0)))
|
||||||
@@ -217,6 +269,7 @@
|
|||||||
:trap-exit false
|
:trap-exit false
|
||||||
:has-timeout false
|
:has-timeout false
|
||||||
:timed-out false
|
:timed-out false
|
||||||
|
:timeout-deadline nil
|
||||||
:exit-reason nil}))
|
:exit-reason nil}))
|
||||||
(dict-set! (er-sched-processes) (er-pid-key pid) proc)
|
(dict-set! (er-sched-processes) (er-pid-key pid) proc)
|
||||||
(er-sched-enqueue! pid)
|
(er-sched-enqueue! pid)
|
||||||
@@ -456,6 +509,69 @@
|
|||||||
(error "Erlang: make_ref/0: arity")
|
(error "Erlang: make_ref/0: arity")
|
||||||
(er-ref-new!))))
|
(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.
|
;; Add `target` to `pid`'s :links list if not already there.
|
||||||
(define
|
(define
|
||||||
er-link-add-one!
|
er-link-add-one!
|
||||||
@@ -664,37 +780,122 @@
|
|||||||
(cond
|
(cond
|
||||||
(not (= pid nil))
|
(not (= pid nil))
|
||||||
(do (er-sched-step! pid) (er-sched-run-all!))
|
(do (er-sched-step! pid) (er-sched-run-all!))
|
||||||
;; Queue empty — fire one pending receive-with-timeout and go again.
|
;; Queue empty — advance logical time to the next pending
|
||||||
(er-sched-fire-one-timeout!) (er-sched-run-all!)
|
;; deadline (timer delivery or receive-timeout) and go again.
|
||||||
|
(er-sched-advance-time!) (er-sched-run-all!)
|
||||||
:else nil))))
|
:else nil))))
|
||||||
|
|
||||||
;; Wake one waiting process whose receive had an `after Ms` clause.
|
;; ── time advance ─────────────────────────────────────────────────
|
||||||
;; Returns true if one fired. In our synchronous model "time passes"
|
;; Called when the runnable queue is empty. Two kinds of pending event
|
||||||
;; once the runnable queue drains — timeouts only fire then.
|
;; 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
|
(define
|
||||||
er-sched-fire-one-timeout!
|
er-sched-advance-time!
|
||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(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
|
(for-each
|
||||||
(fn
|
(fn
|
||||||
(k)
|
(k)
|
||||||
(when
|
|
||||||
(not (nth fired 0))
|
|
||||||
(let
|
(let
|
||||||
((p (get (er-sched-processes) k)))
|
((p (get (er-sched-processes) k)))
|
||||||
(when
|
(when
|
||||||
(and
|
(and (= (get p :state) "waiting") (get p :has-timeout))
|
||||||
(= (get p :state) "waiting")
|
(er-event-consider!
|
||||||
(get p :has-timeout))
|
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 :timed-out true)
|
||||||
(dict-set! p :has-timeout false)
|
(dict-set! p :has-timeout false)
|
||||||
(dict-set! p :state "runnable")
|
(dict-set! p :state "runnable")
|
||||||
(er-sched-enqueue! (get p :pid))
|
(er-sched-enqueue! (get p :pid))))
|
||||||
(set-nth! fired 0 true)))))
|
|
||||||
ks)
|
|
||||||
(nth fired 0))))
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
er-sched-step!
|
er-sched-step!
|
||||||
@@ -956,118 +1157,8 @@
|
|||||||
(= ty "nil") (er-mk-nil)
|
(= ty "nil") (er-mk-nil)
|
||||||
:else v))))
|
: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
|
;; Load an Erlang module declaration. Source must start with
|
||||||
;; `-module(Name).` and contain function definitions. Functions
|
;; `-module(Name).` and contain function definitions. Functions
|
||||||
@@ -1174,8 +1265,15 @@
|
|||||||
{reply, Reply, NewState} ->
|
{reply, Reply, NewState} ->
|
||||||
From ! {Ref, Reply},
|
From ! {Ref, Reply},
|
||||||
gen_server:loop(Mod, NewState);
|
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} ->
|
{noreply, NewState} ->
|
||||||
gen_server:loop(Mod, NewState);
|
gen_server:loop(Mod, NewState);
|
||||||
|
{noreply, NewState, Timeout} ->
|
||||||
|
erlang:send_after(Timeout, self(), {timeout}),
|
||||||
|
gen_server:loop(Mod, NewState);
|
||||||
{stop, Reason, Reply, NewState} ->
|
{stop, Reason, Reply, NewState} ->
|
||||||
From ! {Ref, Reply},
|
From ! {Ref, Reply},
|
||||||
exit(Reason)
|
exit(Reason)
|
||||||
@@ -1183,11 +1281,17 @@
|
|||||||
{'$gen_cast', Msg} ->
|
{'$gen_cast', Msg} ->
|
||||||
case Mod:handle_cast(Msg, State) of
|
case Mod:handle_cast(Msg, State) of
|
||||||
{noreply, NewState} -> 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, NewState} -> exit(Reason)
|
{stop, Reason, NewState} -> exit(Reason)
|
||||||
end;
|
end;
|
||||||
Other ->
|
Other ->
|
||||||
case Mod:handle_info(Other, State) of
|
case Mod:handle_info(Other, State) of
|
||||||
{noreply, NewState} -> 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, NewState} -> exit(Reason)
|
{stop, Reason, NewState} -> exit(Reason)
|
||||||
end
|
end
|
||||||
end.")
|
end.")
|
||||||
@@ -1578,26 +1682,9 @@
|
|||||||
;; entry is keyed by "Module/Name/Arity"; multi-arity BIFs register
|
;; entry is keyed by "Module/Name/Arity"; multi-arity BIFs register
|
||||||
;; once per arity. Called eagerly at the end of runtime.sx so the
|
;; once per arity. Called eagerly at the end of runtime.sx so the
|
||||||
;; registry is ready before any erlang-eval-ast call.
|
;; registry is ready before any erlang-eval-ast call.
|
||||||
(define
|
(define er-register-builtin-bifs!
|
||||||
er-bif-http-listen
|
(fn ()
|
||||||
(fn
|
;; erlang module — type predicates (all pure)
|
||||||
(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
|
|
||||||
()
|
|
||||||
(er-register-pure-bif! "erlang" "is_integer" 1 er-bif-is-integer)
|
(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_atom" 1 er-bif-is-atom)
|
||||||
(er-register-pure-bif! "erlang" "is_list" 1 er-bif-is-list)
|
(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_float" 1 er-bif-is-float)
|
||||||
(er-register-pure-bif! "erlang" "is_boolean" 1 er-bif-is-boolean)
|
(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_pid" 1 er-bif-is-pid)
|
||||||
(er-register-pure-bif!
|
(er-register-pure-bif! "erlang" "is_reference" 1 er-bif-is-reference)
|
||||||
"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_binary" 1 er-bif-is-binary)
|
||||||
(er-register-pure-bif!
|
(er-register-pure-bif! "erlang" "is_function" 1 er-bif-is-function)
|
||||||
"erlang"
|
(er-register-pure-bif! "erlang" "is_function" 2 er-bif-is-function)
|
||||||
"is_function"
|
;; erlang module — pure data ops
|
||||||
1
|
|
||||||
er-bif-is-function)
|
|
||||||
(er-register-pure-bif!
|
|
||||||
"erlang"
|
|
||||||
"is_function"
|
|
||||||
2
|
|
||||||
er-bif-is-function)
|
|
||||||
(er-register-pure-bif! "erlang" "length" 1 er-bif-length)
|
(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" "hd" 1 er-bif-hd)
|
||||||
(er-register-pure-bif! "erlang" "tl" 1 er-bif-tl)
|
(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" "element" 2 er-bif-element)
|
||||||
(er-register-pure-bif! "erlang" "tuple_size" 1 er-bif-tuple-size)
|
(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" "byte_size" 1 er-bif-byte-size)
|
||||||
(er-register-pure-bif!
|
(er-register-pure-bif! "erlang" "atom_to_list" 1 er-bif-atom-to-list)
|
||||||
"erlang"
|
(er-register-pure-bif! "erlang" "list_to_atom" 1 er-bif-list-to-atom)
|
||||||
"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" "abs" 1 er-bif-abs)
|
||||||
(er-register-pure-bif! "erlang" "min" 2 er-bif-min)
|
(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" "max" 2 er-bif-max)
|
||||||
(er-register-pure-bif!
|
(er-register-pure-bif! "erlang" "tuple_to_list" 1 er-bif-tuple-to-list)
|
||||||
"erlang"
|
(er-register-pure-bif! "erlang" "list_to_tuple" 1 er-bif-list-to-tuple)
|
||||||
"tuple_to_list"
|
(er-register-pure-bif! "erlang" "integer_to_list" 1 er-bif-integer-to-list)
|
||||||
1
|
(er-register-pure-bif! "erlang" "list_to_integer" 1 er-bif-list-to-integer)
|
||||||
er-bif-tuple-to-list)
|
;; erlang module — process / runtime (side-effecting)
|
||||||
(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-bif! "erlang" "self" 0 er-bif-self)
|
(er-register-bif! "erlang" "self" 0 er-bif-self)
|
||||||
(er-register-bif! "erlang" "spawn" 1 er-bif-spawn)
|
(er-register-bif! "erlang" "spawn" 1 er-bif-spawn)
|
||||||
(er-register-bif! "erlang" "spawn" 3 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" 1 er-bif-exit)
|
||||||
(er-register-bif! "erlang" "exit" 2 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" "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" "link" 1 er-bif-link)
|
||||||
(er-register-bif! "erlang" "unlink" 1 er-bif-unlink)
|
(er-register-bif! "erlang" "unlink" 1 er-bif-unlink)
|
||||||
(er-register-bif! "erlang" "monitor" 2 er-bif-monitor)
|
(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" "unregister" 1 er-bif-unregister)
|
||||||
(er-register-bif! "erlang" "whereis" 1 er-bif-whereis)
|
(er-register-bif! "erlang" "whereis" 1 er-bif-whereis)
|
||||||
(er-register-bif! "erlang" "registered" 0 er-bif-registered)
|
(er-register-bif! "erlang" "registered" 0 er-bif-registered)
|
||||||
(er-register-bif!
|
;; erlang module — exception raising (modelled as side-effecting)
|
||||||
"erlang"
|
(er-register-bif! "erlang" "throw" 1
|
||||||
"throw"
|
|
||||||
1
|
|
||||||
(fn (vs) (raise (er-mk-throw-marker (er-bif-arg1 vs "throw")))))
|
(fn (vs) (raise (er-mk-throw-marker (er-bif-arg1 vs "throw")))))
|
||||||
(er-register-bif!
|
(er-register-bif! "erlang" "error" 1
|
||||||
"erlang"
|
|
||||||
"error"
|
|
||||||
1
|
|
||||||
(fn (vs) (raise (er-mk-error-marker (er-bif-arg1 vs "error")))))
|
(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" "reverse" 1 er-bif-lists-reverse)
|
||||||
(er-register-pure-bif! "lists" "map" 2 er-bif-lists-map)
|
(er-register-pure-bif! "lists" "map" 2 er-bif-lists-map)
|
||||||
(er-register-pure-bif! "lists" "foldl" 3 er-bif-lists-foldl)
|
(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" "filter" 2 er-bif-lists-filter)
|
||||||
(er-register-pure-bif! "lists" "any" 2 er-bif-lists-any)
|
(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" "all" 2 er-bif-lists-all)
|
||||||
(er-register-pure-bif!
|
(er-register-pure-bif! "lists" "duplicate" 2 er-bif-lists-duplicate)
|
||||||
"lists"
|
(er-register-pure-bif! "lists" "sort" 1 er-bif-lists-sort)
|
||||||
"duplicate"
|
(er-register-pure-bif! "lists" "sort" 2 er-bif-lists-sort)
|
||||||
2
|
(er-register-pure-bif! "lists" "usort" 1 er-bif-lists-usort)
|
||||||
er-bif-lists-duplicate)
|
(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" 1 er-bif-io-format)
|
||||||
(er-register-bif! "io" "format" 2 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" "new" 2 er-bif-ets-new)
|
||||||
(er-register-bif! "ets" "insert" 2 er-bif-ets-insert)
|
(er-register-bif! "ets" "insert" 2 er-bif-ets-insert)
|
||||||
(er-register-bif! "ets" "lookup" 2 er-bif-ets-lookup)
|
(er-register-bif! "ets" "lookup" 2 er-bif-ets-lookup)
|
||||||
@@ -1713,49 +1800,53 @@
|
|||||||
(er-register-bif! "ets" "delete" 2 er-bif-ets-delete)
|
(er-register-bif! "ets" "delete" 2 er-bif-ets-delete)
|
||||||
(er-register-bif! "ets" "tab2list" 1 er-bif-ets-tab2list)
|
(er-register-bif! "ets" "tab2list" 1 er-bif-ets-tab2list)
|
||||||
(er-register-bif! "ets" "info" 2 er-bif-ets-info)
|
(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" "load_binary" 3 er-bif-code-load-binary)
|
||||||
(er-register-bif! "code" "purge" 1 er-bif-code-purge)
|
(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" "soft_purge" 1 er-bif-code-soft-purge)
|
||||||
(er-register-bif! "code" "which" 1 er-bif-code-which)
|
(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" "is_loaded" 1 er-bif-code-is-loaded)
|
||||||
(er-register-bif! "code" "all_loaded" 0 er-bif-code-all-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" "read_file" 1 er-bif-file-read-file)
|
||||||
(er-register-bif! "file" "write_file" 2 er-bif-file-write-file)
|
(er-register-bif! "file" "write_file" 2 er-bif-file-write-file)
|
||||||
(er-register-bif! "file" "delete" 1 er-bif-file-delete)
|
(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! "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" "from_bytes" 1 er-bif-cid-from-bytes)
|
||||||
(er-register-pure-bif! "cid" "to_string" 1 er-bif-cid-to-string)
|
(er-register-pure-bif! "cid" "to_string" 1 er-bif-cid-to-string)
|
||||||
(define
|
|
||||||
er-bif-binary-to-list
|
;; ── binary_to_list / list_to_binary (Step 3b — term codec) ──────
|
||||||
(fn
|
;; Standard Erlang semantics:
|
||||||
(vs)
|
;; binary_to_list(<<B1,B2,...>>) -> [B1, B2, ...] (Erlang cons of ints)
|
||||||
(let
|
;; list_to_binary(IoList) -> <<...>> (flattens nested
|
||||||
((v (nth vs 0)))
|
;; 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
|
(cond
|
||||||
(not (er-binary? v))
|
(not (er-binary? v))
|
||||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||||
:else (let
|
:else
|
||||||
((bs (get v :bytes)) (out (er-mk-nil)))
|
(let ((bs (get v :bytes)) (out (er-mk-nil)))
|
||||||
(for-each
|
(for-each
|
||||||
(fn
|
(fn (i)
|
||||||
(i)
|
(set! out (er-mk-cons (nth bs (- (- (len bs) 1) i)) out)))
|
||||||
(set!
|
|
||||||
out
|
|
||||||
(er-mk-cons (nth bs (- (- (len bs) 1) i)) out)))
|
|
||||||
(range 0 (len bs)))
|
(range 0 (len bs)))
|
||||||
out)))))
|
out)))))
|
||||||
(define
|
|
||||||
er-iolist-walk!
|
;; Walk an Erlang iolist, appending bytes to `acc` (a mutable SX list).
|
||||||
(fn
|
;; Accepts: nil, cons-of-X, binary, integer in 0..255. Anything else
|
||||||
(v acc fail)
|
;; signals failure by setting (nth fail 0) to true.
|
||||||
|
(define er-iolist-walk!
|
||||||
|
(fn (v acc fail)
|
||||||
(cond
|
(cond
|
||||||
(nth fail 0)
|
(nth fail 0) nil
|
||||||
nil
|
(er-nil? v) nil
|
||||||
(er-nil? v)
|
|
||||||
nil
|
|
||||||
(er-cons? v)
|
(er-cons? v)
|
||||||
(do
|
(do (er-iolist-walk! (get v :head) acc fail)
|
||||||
(er-iolist-walk! (get v :head) acc fail)
|
|
||||||
(er-iolist-walk! (get v :tail) acc fail))
|
(er-iolist-walk! (get v :tail) acc fail))
|
||||||
(er-binary? v)
|
(er-binary? v)
|
||||||
(for-each
|
(for-each
|
||||||
@@ -1763,38 +1854,28 @@
|
|||||||
(range 0 (len (get v :bytes))))
|
(range 0 (len (get v :bytes))))
|
||||||
(= (type-of v) "number")
|
(= (type-of v) "number")
|
||||||
(cond
|
(cond
|
||||||
(and (>= v 0) (<= v 255))
|
(and (>= v 0) (<= v 255)) (append! acc v)
|
||||||
(append! acc v)
|
|
||||||
:else (set-nth! fail 0 true))
|
:else (set-nth! fail 0 true))
|
||||||
:else (set-nth! fail 0 true))))
|
:else (set-nth! fail 0 true))))
|
||||||
(define
|
|
||||||
er-bif-list-to-binary
|
(define er-bif-list-to-binary
|
||||||
(fn
|
(fn (vs)
|
||||||
(vs)
|
(let ((v (nth vs 0)) (acc (list)) (fail (list false)))
|
||||||
(let
|
|
||||||
((v (nth vs 0)) (acc (list)) (fail (list false)))
|
|
||||||
(cond
|
(cond
|
||||||
(not (or (er-nil? v) (er-cons? v) (er-binary? v)))
|
(not (or (er-nil? v) (er-cons? v) (er-binary? v)))
|
||||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||||
:else (do
|
:else
|
||||||
|
(do
|
||||||
(er-iolist-walk! v acc fail)
|
(er-iolist-walk! v acc fail)
|
||||||
(cond
|
(cond
|
||||||
(nth fail 0)
|
(nth fail 0)
|
||||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
(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-bif! "file" "list_dir" 1 er-bif-file-list-dir)
|
||||||
(er-register-pure-bif!
|
(er-register-pure-bif! "erlang" "binary_to_list" 1 er-bif-binary-to-list)
|
||||||
"erlang"
|
(er-register-pure-bif! "erlang" "list_to_binary" 1 er-bif-list-to-binary)
|
||||||
"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-mk-atom "ok")))
|
||||||
|
|
||||||
(er-register-bif! "http" "listen" 2 er-bif-http-listen)
|
;; Register everything at load time.
|
||||||
|
|
||||||
(er-register-builtin-bifs!)
|
(er-register-builtin-bifs!)
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{
|
{
|
||||||
"language": "erlang",
|
"language": "erlang",
|
||||||
"total_pass": 761,
|
"total_pass": 874,
|
||||||
"total": 761,
|
"total": 874,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
|
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
|
||||||
{"name":"parse","pass":52,"total":52,"status":"ok"},
|
{"name":"parse","pass":52,"total":52,"status":"ok"},
|
||||||
@@ -13,6 +13,8 @@
|
|||||||
{"name":"echo","pass":7,"total":7,"status":"ok"},
|
{"name":"echo","pass":7,"total":7,"status":"ok"},
|
||||||
{"name":"fib","pass":8,"total":8,"status":"ok"},
|
{"name":"fib","pass":8,"total":8,"status":"ok"},
|
||||||
{"name":"ffi","pass":37,"total":37,"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"}
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
# Erlang-on-SX Scoreboard
|
# Erlang-on-SX Scoreboard
|
||||||
|
|
||||||
**Total: 761 / 761 tests passing**
|
**Total: 874 / 874 tests passing**
|
||||||
|
|
||||||
| | Suite | Pass | Total |
|
| | Suite | Pass | Total |
|
||||||
|---|---|---|---|
|
|---|---|---|---|
|
||||||
@@ -15,6 +15,8 @@
|
|||||||
| ✅ | fib | 8 | 8 |
|
| ✅ | fib | 8 | 8 |
|
||||||
| ✅ | ffi | 37 | 37 |
|
| ✅ | ffi | 37 | 37 |
|
||||||
| ✅ | vm | 78 | 78 |
|
| ✅ | vm | 78 | 78 |
|
||||||
|
| ✅ | send_after | 10 | 10 |
|
||||||
|
| ✅ | lists_ext | 103 | 103 |
|
||||||
|
|
||||||
|
|
||||||
Generated by `lib/erlang/conformance.sh`.
|
Generated by `lib/erlang/conformance.sh`.
|
||||||
|
|||||||
385
lib/erlang/tests/lists_ext.sx
Normal file
385
lib/erlang/tests/lists_ext.sx
Normal 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")
|
||||||
163
lib/erlang/tests/send_after.sx
Normal file
163
lib/erlang/tests/send_after.sx
Normal 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")
|
||||||
@@ -1147,7 +1147,7 @@
|
|||||||
(and (er-atom? ms) (= (get ms :name) "infinity"))
|
(and (er-atom? ms) (= (get ms :name) "infinity"))
|
||||||
(er-eval-receive-loop node pid env)
|
(er-eval-receive-loop node pid env)
|
||||||
(= ms 0) (er-eval-receive-poll 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.
|
;; after 0 — poll once; on no match, run the after-body immediately.
|
||||||
(define
|
(define
|
||||||
@@ -1161,12 +1161,15 @@
|
|||||||
(get r :value)
|
(get r :value)
|
||||||
(er-eval-body (get node :after-body) env)))))
|
(er-eval-body (get node :after-body) env)))))
|
||||||
|
|
||||||
;; after Ms — suspend; on resume check :timed-out. When the scheduler
|
;; after Ms — suspend with an absolute `deadline` (logical ms). On
|
||||||
;; runs out of other work it fires one pending timeout per round.
|
;; 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
|
(define
|
||||||
er-eval-receive-timed
|
er-eval-receive-timed
|
||||||
(fn
|
(fn
|
||||||
(node pid env)
|
(node pid env deadline)
|
||||||
(let
|
(let
|
||||||
((r (er-try-receive (get node :clauses) pid env)))
|
((r (er-try-receive (get node :clauses) pid env)))
|
||||||
(if
|
(if
|
||||||
@@ -1174,6 +1177,7 @@
|
|||||||
(get r :value)
|
(get r :value)
|
||||||
(do
|
(do
|
||||||
(er-proc-set! pid :has-timeout true)
|
(er-proc-set! pid :has-timeout true)
|
||||||
|
(er-proc-set! pid :timeout-deadline deadline)
|
||||||
(call/cc
|
(call/cc
|
||||||
(fn
|
(fn
|
||||||
(k)
|
(k)
|
||||||
@@ -1186,7 +1190,7 @@
|
|||||||
(er-proc-set! pid :timed-out false)
|
(er-proc-set! pid :timed-out false)
|
||||||
(er-proc-set! pid :has-timeout false)
|
(er-proc-set! pid :has-timeout false)
|
||||||
(er-eval-body (get node :after-body) env))
|
(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.
|
;; Scan mailbox in arrival order. For each msg, try every clause.
|
||||||
;; On first match: remove that msg from mailbox and return body value.
|
;; On first match: remove that msg from mailbox and return body value.
|
||||||
@@ -2035,4 +2039,657 @@
|
|||||||
(range 0 (len ks)))
|
(range 0 (len ks)))
|
||||||
out)))
|
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
1
next/.gitignore
vendored
@@ -1 +0,0 @@
|
|||||||
data/
|
|
||||||
170
next/README.md
170
next/README.md
@@ -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.
|
|
||||||
@@ -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))
|
|
||||||
@@ -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))
|
|
||||||
@@ -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))
|
|
||||||
@@ -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)))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))
|
|
||||||
@@ -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)))
|
|
||||||
@@ -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)))
|
|
||||||
@@ -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))
|
|
||||||
@@ -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"))
|
|
||||||
@@ -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))))))
|
|
||||||
@@ -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))))))
|
|
||||||
@@ -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))))))
|
|
||||||
@@ -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))))))
|
|
||||||
@@ -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))))))
|
|
||||||
@@ -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))))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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)))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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)))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))))
|
|
||||||
@@ -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))
|
|
||||||
@@ -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)))))))
|
|
||||||
@@ -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).
|
|
||||||
@@ -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.
|
|
||||||
@@ -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.
|
|
||||||
@@ -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().
|
|
||||||
@@ -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.
|
|
||||||
@@ -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}.
|
|
||||||
@@ -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.
|
|
||||||
@@ -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}.
|
|
||||||
@@ -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.
|
|
||||||
|
|
||||||
@@ -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.
|
|
||||||
@@ -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}.
|
|
||||||
@@ -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}.
|
|
||||||
@@ -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.
|
|
||||||
@@ -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.
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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 ]
|
|
||||||
@@ -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
Reference in New Issue
Block a user