From da349b169ec77aaaefe911c7c61fc0419f8b0e55 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 12:31:19 +0000 Subject: [PATCH] =?UTF-8?q?commerce:=20stock-constrained=20reservation=20(?= =?UTF-8?q?19=20tests)=20=E2=80=94=20Phase=205=20ext?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit stock.sx — reservation as a precondition the host checks before order-begin! (validate -> begin), keeping the flow pure. available-stock reads catalog stock facts; can-reserve?/reserve-check/reservation-shortfalls gate a cart; effective-available nets out concurrent reservations so orders can't over-reserve; sufficient-stocko is the multidirectional availability query. Total 258/258 across 16 suites. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/commerce/conformance.sh | 3 +- lib/commerce/scoreboard.json | 7 +- lib/commerce/scoreboard.md | 3 +- lib/commerce/stock.sx | 106 ++++++++++++++++++++++++++++++ lib/commerce/tests/stock.sx | 122 +++++++++++++++++++++++++++++++++++ plans/commerce-on-sx.md | 16 ++++- 6 files changed, 249 insertions(+), 8 deletions(-) create mode 100644 lib/commerce/stock.sx create mode 100644 lib/commerce/tests/stock.sx diff --git a/lib/commerce/conformance.sh b/lib/commerce/conformance.sh index 52ae2d5d..d5003ad7 100755 --- a/lib/commerce/conformance.sh +++ b/lib/commerce/conformance.sh @@ -17,7 +17,7 @@ if [ ! -x "$SX_SERVER" ]; then exit 1 fi -SUITES=(catalog cart price api promo stack quote ledger order recon federation attribution payment window nettax) +SUITES=(catalog cart price api promo stack quote ledger order recon federation attribution payment window nettax stock) OUT_JSON="lib/commerce/scoreboard.json" OUT_MD="lib/commerce/scoreboard.md" @@ -68,6 +68,7 @@ run_suite() { (load "lib/commerce/quote.sx") (load "lib/commerce/window.sx") (load "lib/commerce/nettax.sx") +(load "lib/commerce/stock.sx") (load "lib/commerce/ledger.sx") (load "lib/commerce/order.sx") (load "lib/commerce/payment.sx") diff --git a/lib/commerce/scoreboard.json b/lib/commerce/scoreboard.json index 9f691d44..99df57cf 100644 --- a/lib/commerce/scoreboard.json +++ b/lib/commerce/scoreboard.json @@ -14,9 +14,10 @@ "attribution": {"pass": 16, "fail": 0}, "payment": {"pass": 7, "fail": 0}, "window": {"pass": 19, "fail": 0}, - "nettax": {"pass": 11, "fail": 0} + "nettax": {"pass": 11, "fail": 0}, + "stock": {"pass": 19, "fail": 0} }, - "total_pass": 239, + "total_pass": 258, "total_fail": 0, - "total": 239 + "total": 258 } diff --git a/lib/commerce/scoreboard.md b/lib/commerce/scoreboard.md index 15246c32..9c1202a4 100644 --- a/lib/commerce/scoreboard.md +++ b/lib/commerce/scoreboard.md @@ -19,4 +19,5 @@ _Generated by `lib/commerce/conformance.sh`_ | payment | 7 | 0 | 7 | | window | 19 | 0 | 19 | | nettax | 11 | 0 | 11 | -| **Total** | **239** | **0** | **239** | +| stock | 19 | 0 | 19 | +| **Total** | **258** | **0** | **258** | diff --git a/lib/commerce/stock.sx b/lib/commerce/stock.sx new file mode 100644 index 00000000..195991a5 --- /dev/null +++ b/lib/commerce/stock.sx @@ -0,0 +1,106 @@ +;; lib/commerce/stock.sx — stock-constrained reservation. +;; +;; Reservation is a precondition the host checks BEFORE order-begin! (validate → +;; begin), so the order flow stays pure orchestration. Availability is read +;; relationally from the catalog stock facts (catalog.sx stocko); a stock view +;; subtracts already-reserved quantities so concurrent orders can't over-reserve. +;; +;; can-reserve? cat cart — every line fits available stock +;; reservation-shortfalls cat cart — the lines that do not, with detail +;; effective-available cat reservations … — availability net of reservations +;; sufficient-stocko cat sku variant qty — relational "can supply qty?" query + +;; Deterministic on-hand stock for a (sku,variant); 0 if absent. +(define + available-stock + (fn + (cat sku variant) + (let + ((rs (run 1 q (stocko cat sku variant q)))) + (if (empty? rs) 0 (first rs))))) + +;; Units a line cannot fulfil from on-hand stock (0 if it fits). +(define + line-shortfall + (fn + (cat line) + (let + ((short (- (line-qty line) (available-stock cat (line-sku line) (line-variant line))))) + (if (< short 0) 0 short)))) + +(define + line-reservable? + (fn (cat line) (= (line-shortfall cat line) 0))) + +;; Lines that cannot be fully reserved, each with requested/available/short. +(define + reservation-shortfalls + (fn + (cat cart) + (reduce + (fn + (acc line) + (let + ((short (line-shortfall cat line))) + (if (> short 0) (append acc (list {:requested (line-qty line) :available (available-stock cat (line-sku line) (line-variant line)) :sku (line-sku line) :variant (line-variant line) :short short})) acc))) + (list) + cart))) + +(define + can-reserve? + (fn (cat cart) (empty? (reservation-shortfalls cat cart)))) + +;; Validate → reject; the host gates order-begin! on this. +(define + reserve-check + (fn (cat cart) (if (can-reserve? cat cart) :ok {:shortfalls (reservation-shortfalls cat cart) :rejected :insufficient-stock}))) + +;; --- reservation view (concurrent-safety) --- +;; reservations: list of (sku variant qty) already held. + +(define + reserved-qty + (fn + (reservations sku variant) + (reduce + (fn + (acc r) + (if + (and (= (first r) sku) (= (nth r 1) variant)) + (+ acc (nth r 2)) + acc)) + 0 + reservations))) + +;; On-hand minus already-reserved (clamped at 0). +(define + effective-available + (fn + (cat reservations sku variant) + (let + ((eff (- (available-stock cat sku variant) (reserved-qty reservations sku variant)))) + (if (< eff 0) 0 eff)))) + +;; Can a line be reserved given existing reservations? +(define + line-reservable-with? + (fn + (cat reservations line) + (<= + (line-qty line) + (effective-available + cat + reservations + (line-sku line) + (line-variant line))))) + +;; --- relational availability query (the showcase) --- + +;; Succeeds when on-hand stock for (sku,variant) covers qty. Multidirectional +;; over the stock facts: "which variants of widget can supply 5?" is a backward +;; query. +(define + sufficient-stocko + (fn + (cat sku variant qty) + (fresh (avail) (stocko cat sku variant avail) (lteo-i qty avail)))) diff --git a/lib/commerce/tests/stock.sx b/lib/commerce/tests/stock.sx new file mode 100644 index 00000000..cc4a4cea --- /dev/null +++ b/lib/commerce/tests/stock.sx @@ -0,0 +1,122 @@ +;; lib/commerce/tests/stock.sx — stock-constrained reservation. +;; Uses (commerce-test name got expected) provided by conformance.sh. + +(define + cat + (make-catalog + (list + (list "widget" 1000 :standard) + (list "gadget" 2500 :standard)) + (list) + (list + (list "widget" :small 5) + (list "widget" :large 0) + (list "gadget" :std 12)))) + +;; --- availability --- + +(commerce-test + "available-found" + (available-stock cat "widget" :small) + 5) +(commerce-test + "available-zero" + (available-stock cat "widget" :large) + 0) +(commerce-test + "available-absent" + (available-stock cat "widget" :none) + 0) + +;; --- per-line reservability --- + +(commerce-test + "shortfall-fits" + (line-shortfall cat (list "widget" :small 5)) + 0) +(commerce-test + "shortfall-over" + (line-shortfall cat (list "widget" :small 8)) + 3) +(commerce-test + "reservable-yes" + (line-reservable? cat (list "gadget" :std 12)) + true) +(commerce-test + "reservable-no" + (line-reservable? cat (list "widget" :large 1)) + false) + +;; --- cart-level reservation check --- + +(commerce-test + "can-reserve-yes" + (can-reserve? + cat + (list (list "widget" :small 5) (list "gadget" :std 2))) + true) + +(commerce-test + "can-reserve-no" + (can-reserve? cat (list (list "widget" :small 9))) + false) + +(commerce-test + "shortfalls-detail" + (reservation-shortfalls + cat + (list (list "widget" :small 9) (list "gadget" :std 2))) + (list {:requested 9 :available 5 :sku "widget" :variant :small :short 4})) + +(commerce-test + "reserve-check-ok" + (reserve-check cat (list (list "gadget" :std 1))) + :ok) + +(commerce-test + "reserve-check-rejected" + (reserve-check cat (list (list "widget" :large 1))) + {:shortfalls (list {:requested 1 :available 0 :sku "widget" :variant :large :short 1}) :rejected :insufficient-stock}) + +;; --- reservation view: concurrent holds reduce availability --- + +(define held (list (list "widget" :small 3))) + +(commerce-test + "effective-after-hold" + (effective-available cat held "widget" :small) + 2) +(commerce-test + "effective-other-unaffected" + (effective-available cat held "gadget" :std) + 12) +(commerce-test + "reservable-with-fits" + (line-reservable-with? cat held (list "widget" :small 2)) + true) +(commerce-test + "reservable-with-over" + (line-reservable-with? cat held (list "widget" :small 3)) + false) + +;; --- relational availability query (multidirectional) --- + +(commerce-test + "sufficient-forward" + (run* + x + (fresh () (sufficient-stocko cat "widget" :small 5) (== x true))) + (list true)) + +(commerce-test + "sufficient-forward-over" + (run* + x + (fresh () (sufficient-stocko cat "widget" :small 6) (== x true))) + (list)) + +;; backward: which variants of widget can supply 1 unit? +(commerce-test + "variants-supplying-1" + (run* v (fresh (q) (stocko cat "widget" v q) (lteo-i 1 q))) + (list :small)) diff --git a/plans/commerce-on-sx.md b/plans/commerce-on-sx.md index bb9eba79..9f07d849 100644 --- a/plans/commerce-on-sx.md +++ b/plans/commerce-on-sx.md @@ -21,7 +21,7 @@ reconciliation — all auditable via the event log. ## Status (rolling) -`bash lib/commerce/conformance.sh` → **239/239** (15 suites; + nettax) — **roadmap complete; Phase 5 extensions in progress** +`bash lib/commerce/conformance.sh` → **258/258** (16 suites; + stock) — **roadmap + full Phase 5 backlog complete** ## Ground rules @@ -89,8 +89,10 @@ that unlocks the most tests per effort each iteration. lines by extended share with largest-remainder so per-line shares sum exactly. - [ ] refund as a flow — refund lifecycle (request → approve → settle) as a second flow-on-sx flow, recorded in the ledger; idempotent. -- [ ] stock-constrained reservation — order-begin! fails (railway `fail`) when - requested qty exceeds stocko availability; reservation decrements a stock view. +- [x] stock-constrained reservation — `stock.sx`: `can-reserve?`/`reserve-check` + precondition (host gates order-begin! on it, keeping the flow pure); + `reservation-shortfalls` detail; `effective-available` nets out concurrent + reservations; `sufficient-stocko` relational availability query. - [x] provider-neutral payment-request envelope — `payment.sx`: `payment-request` materialises `{:order :amount :currency :return-url}` at the IO edge (amount from the ledger, currency/return-url host-supplied); `pending-payments` enumerates @@ -98,6 +100,14 @@ that unlocks the most tests per effort each iteration. agnostic; `order-settle!(ref, amount)` is the resume seam. ## Progress log +- 2026-06-07 — `stock.sx` (Phase 5 ext): stock-constrained reservation. Design + choice: reservation is a precondition the host checks BEFORE order-begin! + (validate → begin), keeping the order flow pure orchestration. `available-stock` + reads the catalog stock facts; `can-reserve?`/`reserve-check`/ + `reservation-shortfalls` gate a cart; `effective-available`/`line-reservable-with?` + net out concurrent reservations (no over-reserve); `sufficient-stocko` is the + multidirectional availability query. Only refund-as-flow remains in the + backlog. stock suite 19/19; total 258/258 (16 suites). - 2026-06-07 — `nettax.sx` (Phase 5 ext): discount-aware tax — the alternative to quote.sx's gross-tax default. `cart-quote-net` taxes the NET (post-discount) base. `allocate-discount` spreads the basket-level discount across lines in