core, tests, plan: guard the order invoice write

This commit is contained in:
shum
2026-08-27 10:28:27 +00:00
parent 655e933c56
commit 13ea3862de
3 changed files with 104 additions and 37 deletions
@@ -113,12 +113,12 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String (TextEncoding (..))
import Simplex.Messaging.Util (tshow)
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), Query, ToRow, (:.) (..))
import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.FromField (FromField (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.ToField (ToField (..))
#else
import Database.SQLite.Simple (Only (..), Query, ToRow, (:.) (..))
import Database.SQLite.Simple (Only (..), Query, (:.) (..))
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.QQ (sql)
import Database.SQLite.Simple.ToField (ToField (..))
@@ -133,6 +133,11 @@ data ServiceError
| SEPriceNotFound
| SEOfferNotFound
| SEOrderNotFound
| -- | 'setOrderInvoiceStatus' only: the order exists (its own UPDATE returned a row) but
-- resolves to no @invoices@ row, so A3's "@invoices.status@ in step" invariant could not be
-- maintained. Unreachable through 'createOrder', which writes the invoice first and the
-- order's reference to it second, in one transaction.
SEInvoiceNotFound
| -- | 'markProviderEventProcessed' only: no @provider_events@ row for that
-- @(provider, event_id)@. Its caller reaches it through a 'recordProviderEvent' that
-- returned 'True' in the same transaction, so the row is always there; a 'Left' here means
@@ -374,8 +379,11 @@ orderSelect =
|]
-- | Writes the @invoices@ row and the @web_orders@ row that references it, in that order (the
-- foreign key points that way). Both start @invoiced@. The caller supplies the transaction, as
-- everywhere else here, so a failed provider call after a partial write leaves neither row.
-- foreign key points that way). Both start @invoiced@. The two inserts are never split: the
-- caller supplies the transaction, as everywhere else here, so if the second fails -- a
-- @short_ref@ or @provider_ref@ collision against A3's UNIQUE indexes is the realistic way --
-- the invoice row goes with it rather than being left orphaned. D6 makes its provider call
-- BEFORE this, so what is being made atomic is the pair of rows, not the provider call.
--
-- @invoices.payment_crypto_currency@ is deliberately not written: 'method' is the single source
-- and E4 derives the currency from it (A3).
@@ -410,22 +418,24 @@ createOrder db newOrder now = do
unOfferId (BadgeOfferId oid) = oid
getOrder :: DB.Connection -> Text -> ExceptT ServiceError IO (Maybe WebOrder)
getOrder db orderId = queryOneOrder db (orderSelect <> " WHERE o.order_id = ?") (Only orderId)
getOrder db orderId = queryOneOrder db (orderSelect <> " WHERE o.order_id = ?") orderId
-- | At most one row: A3's @idx_web_orders_provider_ref@ is UNIQUE, so a provider reference that
-- resolved to two orders could not have been stored. F2 resolves a Stripe charge this way, and
-- H3 re-reads provider state through it.
getOrderByProviderRef :: DB.Connection -> Text -> ExceptT ServiceError IO (Maybe WebOrder)
getOrderByProviderRef db providerRef = queryOneOrder db (orderSelect <> " WHERE o.provider_ref = ?") (Only providerRef)
getOrderByProviderRef db providerRef = queryOneOrder db (orderSelect <> " WHERE o.provider_ref = ?") providerRef
-- | At most one row, on A3's UNIQUE @idx_web_orders_short_ref@. This is what support resolves a
-- bank-statement reference with (H2's @--ref@ subcommands).
getOrderByShortRef :: DB.Connection -> Text -> ExceptT ServiceError IO (Maybe WebOrder)
getOrderByShortRef db shortRef = queryOneOrder db (orderSelect <> " WHERE o.short_ref = ?") (Only shortRef)
getOrderByShortRef db shortRef = queryOneOrder db (orderSelect <> " WHERE o.short_ref = ?") shortRef
queryOneOrder :: ToRow q => DB.Connection -> Query -> q -> ExceptT ServiceError IO (Maybe WebOrder)
queryOneOrder db q params = do
rows <- liftIO $ DB.query db q params
-- | Every single-order read: one 'Text' key, matched by whichever WHERE clause is appended to
-- 'orderSelect'.
queryOneOrder :: DB.Connection -> Query -> Text -> ExceptT ServiceError IO (Maybe WebOrder)
queryOneOrder db q key = do
rows <- liftIO $ DB.query db q (Only key)
case rows of
[] -> pure Nothing
(row : _) -> Just <$> liftEither (rowToOrder row)
@@ -494,11 +504,18 @@ setOrderProviderRef db orderId providerRef now = do
-- statement, so no reader can ever see a paid order without its amount or its time, and
-- @invoices.status@ moves to @settled@ with them. E3, H3 and F2 all settle through it.
--
-- __@settledAt@ and @now@ are separate on purpose.__ @settledAt@ is the provider's reported
-- settlement time, which for an on-chain confirmation is routinely in the past -- H3 may read it
-- from an invoice that settled while the service was down. Writing it to @updated_at@ as well
-- would move that column BACKWARDS past what an earlier 'updateOrderStatus' wrote, and
-- @updated_at@ is the row's own bookkeeping, not the payment's. Every other writer here takes a
-- @now@; so does this one.
--
-- It does not guard on the current status. Settlement is idempotent and monotonic toward @paid@
-- (E3), but that is the caller's rule to apply -- it decides whether a second @InvoiceSettled@
-- is a replay before it gets here, because it must also decide whether to write a code row.
setOrderSettled :: DB.Connection -> Text -> CurrencyAmount -> UTCTime -> ExceptT ServiceError IO ()
setOrderSettled db orderId (CurrencyAmount amountPaid) settledAt = do
setOrderSettled :: DB.Connection -> Text -> CurrencyAmount -> UTCTime -> UTCTime -> ExceptT ServiceError IO ()
setOrderSettled db orderId (CurrencyAmount amountPaid) settledAt now = do
updated <-
liftIO $
DB.query
@@ -509,23 +526,30 @@ setOrderSettled db orderId (CurrencyAmount amountPaid) settledAt = do
WHERE order_id = ?
RETURNING order_id
|]
(WOSPaid, amountPaid, settledAt, settledAt, orderId)
(WOSPaid, amountPaid, settledAt, now, orderId)
when (null (updated :: [Only Text])) $ throwError SEOrderNotFound
setOrderInvoiceStatus db orderId WOSPaid settledAt
setOrderInvoiceStatus db orderId WOSPaid now
-- | The @invoices.status@ half of A3's invariant, written through the order's own @invoice_id@
-- so no caller has to carry it.
-- so no caller has to carry it. Reached only after the caller's own @UPDATE ... RETURNING@ has
-- confirmed the order exists, so 'SEInvoiceNotFound' means the order has no resolvable invoice
-- -- which makes the invariant self-enforcing rather than merely true today: a future writer
-- that creates a @web_orders@ row with a NULL @invoice_id@ fails here instead of silently
-- leaving the two columns disagreeing.
setOrderInvoiceStatus :: DB.Connection -> Text -> WebOrderStatus -> UTCTime -> ExceptT ServiceError IO ()
setOrderInvoiceStatus db orderId status now =
liftIO $
DB.execute
db
[sql|
UPDATE sx_badge_service_invoices
SET status = ?, updated_at = ?
WHERE invoice_id IN (SELECT invoice_id FROM sx_badge_service_web_orders WHERE order_id = ?)
|]
(orderInvoiceStatus status, now, orderId)
setOrderInvoiceStatus db orderId status now = do
updated <-
liftIO $
DB.query
db
[sql|
UPDATE sx_badge_service_invoices
SET status = ?, updated_at = ?
WHERE invoice_id IN (SELECT invoice_id FROM sx_badge_service_web_orders WHERE order_id = ?)
RETURNING invoice_id
|]
(orderInvoiceStatus status, now, orderId)
when (null (updated :: [Only Text])) $ throwError SEInvoiceNotFound
-- Provider events ---------------------------------------------------------------
@@ -853,7 +853,7 @@ Resuming an existing order from `?order=` belongs to E5, which owns the polling
#### D6 — `POST /api/checkout`, provider interface, order creation
**Files:** `apps/simplex-badge-service/src/BadgeService/Web/Server.hs`, `apps/simplex-badge-service/src/BadgeService/Orders.hs`, `simplex-chat.cabal`, `tests/Bots/BadgeServiceTests.hs`
**Files:** `apps/simplex-badge-service/src/BadgeService/Web/Server.hs`, `apps/simplex-badge-service/src/BadgeService/Orders.hs`, `simplex-chat.cabal`, `tests/Bots/BadgeServiceTests.hs`, `apps/simplex-badge-service/src/BadgeService/Store.hs` (unchanged; D0's `createOrder`, `NewWebOrder` and `OrderMethod` are what this step writes orders through)
**Do:** The shared order-creation endpoint, provider-agnostic. It lives here rather than in Phase E because it serves all three methods and Stripe reuses it unchanged.
@@ -872,7 +872,7 @@ POST /api/checkout { priceId, offerId?, method: "card"|"btc"|"xmr" }
- `orderId` is 128 random bits, base64url. It is a bearer capability for the code (A3, decision 9), so it must not be sequential or derived from anything guessable.
- `shortRef` is 5 characters from B3's Crockford alphabet, encoded with B3's encoder, drawn from a CSPRNG, unique per order, stored on `@web_orders`. On a unique-constraint violation the generator retries up to 10 times before failing the checkout request with `bad_request` and logging it (H4). The 32⁵ space is adequate for this plan's order volume; H5 records widening `shortRef` as the remedy if retries become frequent.
- The provider call goes through `createProviderInvoice :: OrderMethod -> OrderDraft -> IO (Either ProviderError ProviderInvoice)`, dispatching on method. A method whose provider section is absent from the ini is rejected the same way.
- On a successful provider call, write an `@invoices` row and a `web_orders` row with `status = 'invoiced'` and `provider_ref` set from `ProviderInvoice`, in one transaction.
- On a successful provider call, write an `@invoices` row and a `web_orders` row with `status = 'invoiced'` and `provider_ref` set from `ProviderInvoice`, in one transaction. **Do not hand-roll the inserts:** fill D0's `NewWebOrder` and call `createOrder` inside one `withServiceTransaction`, which writes both rows in the right order and sets both statuses. `NewWebOrder` needs an `invoiceId` as well as the `orderId` — the `@invoices` primary key has no default and the store mints no identifiers — so mint it here, and **not** from the `orderId`, which is a bearer capability for the code (§9). `@invoices.provider`, `price` and `payment_crypto_currency` are D0's to decide and are not passed in.
**Verify:** In `tests/Bots/BadgeServiceTests.hs`: a disabled price, a disabled offer and an offer pinned to a different price are rejected before any provider call with `price_disabled`, `offer_disabled` and `offer_mismatch` respectively, the disabled rows produced with B1's `setPriceStatus` and `setOfferStatus`. An unrecognised extra key such as `months` or `amount` in the request body is ignored rather than honoured, since the request carries neither. At this step every method returns `provider_unavailable` and no order row is written, whether or not a provider section is present. No checkout can succeed until E2, so the assertions that need a written order, the `orderId` and `shortRef` uniqueness and the charged amounts, are in E2's Verify.
@@ -1473,7 +1473,7 @@ Append here when a step contradicts this plan: the step id, what was wrong, and
- **D0 — `PaymentProvider` now has a column codec, and both `codePaymentProviderText = "code"` literals are gone.** B1's and C1's entries above deferred a real `TextEncoding PaymentProvider` until "a second provider needs writing from the service side"; D0's `createOrder` is that step, since `@invoices.provider` is written per order. The instance lives with the type (`PaymentService/Types.hs`), with `ToField`/`FromField` derived from it under the same CPP pattern `Badges/Types.hs` uses, and no JSON: `PaymentProvider` does not cross the wire, so this spelling is only ever read back from a column it was written to. The service's and the client's `createCodePayment` both now write `PPCode`, so the two databases cannot drift. **`@invoices.provider` is derived from `@web_orders.method`, not passed in** — `card → stripe`, `btc | xmr → crypto`, both crypto methods being the one BTCPay instance — so a caller cannot get the pair wrong. E2 and F1 inherit this rather than inventing their own literals; note that `crypto` is the spelling, not `btcpay` (which appears only in B10's hand-written test fixture).
- **D0 — the method enum lives in `Store.hs` as `OrderMethod`, not in D6's `Orders.hs` as `Method`.** D0 has to persist `@web_orders.method` before `Orders.hs` exists, and D0 makes no cabal edit, so the type and its codec are defined beside the column they serve. D6's step text is corrected to import it. The same applies to `WebOrderStatus` (`invoiced | pending | paid | expired | failed`), which is deliberately **not** `BadgePaymentStatus`: that enum has a `new` state an order never occupies and spells settlement `settled`, where A3's CHECK requires `paid`. `orderInvoiceStatus` is the single mapping between the two vocabularies, and it is what keeps A3's "`@invoices.status` in step" invariant true.
- **D0 — `createOrder` takes an `invoiceId`, which the plan's field list did not name.** `@invoices.invoice_id` is `TEXT NOT NULL PRIMARY KEY` with no default and the store mints no identifiers (it opens no transaction either), so D6 mints it alongside the `orderId`. It must NOT be the `orderId` itself: the order id is a bearer capability for the code (decision 9) and putting it in a second table widens the surface for no gain. Two more shapes the field list left open, both now fixed in code: `@invoices.price` and `@invoices.amount` both carry A4's `offerTotal` with `discount_amount`/`credit_amount` NULL, because an offer's discount is expressed as free months so the total IS the price; and `@invoices.payment_crypto_currency` is not written at all (A3 — `method` is the single source).
- **D0 — every order read is an INNER join to `@invoices`, and two new `ServiceError` constructors.** `getOrder`, `getOrderByProviderRef`, `getOrderByShortRef` and `getStuckOrders` all go through one `orderSelect`, joined rather than left-joined: `createOrder` is the only writer of a `@web_orders` row and always writes the invoice with it, so an order without one does not exist and `WebOrder` can hold the invoice's NOT NULL columns unwrapped. `SEOrderNotFound` is what `updateOrderStatus`, `setOrderProviderRef` and `setOrderSettled` throw when the order they name is absent; `SEProviderEventNotFound` is `markProviderEventProcessed`'s, reachable only if it and `recordProviderEvent` disagree about the key. **`setOrderSettled` does not guard on the current status**: settlement is idempotent and monotonic toward `paid` (E3), but that is E3's rule to apply, because the same decision governs whether a code row is written — a guard here would answer `SEOrderNotFound` for a replay, which is worse than no guard.
- **D0 — every order read is an INNER join to `@invoices`, and three new `ServiceError` constructors.** `getOrder`, `getOrderByProviderRef`, `getOrderByShortRef` and `getStuckOrders` all go through one `orderSelect`, joined rather than left-joined: `createOrder` is the only writer of a `@web_orders` row and always writes the invoice with it, so an order without one does not exist and `WebOrder` can hold the invoice's NOT NULL columns unwrapped. `SEOrderNotFound` is what `updateOrderStatus`, `setOrderProviderRef` and `setOrderSettled` throw when the order they name is absent; `SEProviderEventNotFound` is `markProviderEventProcessed`'s, reachable only if it and `recordProviderEvent` disagree about the key. `SEInvoiceNotFound` is the invariant guard: the `@invoices.status` write is an `UPDATE … RETURNING` like every other writer here, so an order that resolves to no invoice fails instead of moving one status and leaving the other behind — `createOrder` makes that unreachable, and the guard is there for whoever next writes this table. **`setOrderSettled` takes `settledAt` and `now` separately**: the provider's reported settlement instant is routinely in the past for an on-chain confirmation, and writing it to `updated_at` would move that column backwards past an earlier `updateOrderStatus`; E3, F2 and H3 pass both. **`setOrderSettled` does not guard on the current status**: settlement is idempotent and monotonic toward `paid` (E3), but that is E3's rule to apply, because the same decision governs whether a code row is written — a guard here would answer `SEOrderNotFound` for a replay, which is worse than no guard.
- **D0 — `getStuckOrders`' status filter leaves a recovery gap, implemented as specified. H3 decides.** The step says `invoiced` or `pending`, and that is what shipped. But E3 can move `expired` and `failed` to `paid` on a late webhook, so an order that one webhook marked `expired` and that then settles on chain with THAT webhook missed is never re-read from the provider by H3's pass — the buyer has paid and only support (H2) recovers it. Missed webhooks are exactly what H3 exists for, so this is worth a decision rather than an assumption; widening the filter to all four non-`paid` statuses is a change to H3's contract, not to this query, and the haddock on `getStuckOrders` says so.
## 10. End-to-end verification
+52 -9
View File
@@ -2090,7 +2090,7 @@ testBadgeServiceNoTableLinksOrdersToPurchases ps =
-- enforces that, so it is asserted here, over rows shaped exactly as a settled web order and
-- a code redemption leave them.
withConnection st $ \db -> do
DB.execute_ db "INSERT INTO sx_badge_service_invoices (invoice_id, provider, price, amount, currency, expires_at, status, created_at, updated_at) VALUES ('b10-invoice','btcpay',1000,1000,'USD','2026-03-10','paid','2026-03-10','2026-03-10')"
DB.execute_ db "INSERT INTO sx_badge_service_invoices (invoice_id, provider, price, amount, currency, expires_at, status, created_at, updated_at) VALUES ('b10-invoice','crypto',1000,1000,'USD','2026-03-10','paid','2026-03-10','2026-03-10')"
DB.execute_ db "INSERT INTO sx_badge_service_web_orders (order_id, invoice_id, method, short_ref, badge_type, months, status, created_at, updated_at) VALUES ('b10-order','b10-invoice','btc','B10RF','supporter',3,'paid','2026-03-10','2026-03-10')"
DB.execute_ db "INSERT INTO sx_badge_service_payments (payment_id, invoice_id, provider, status, created_at, updated_at) VALUES ('b10-payment', NULL, 'code', 'settled', '2026-03-10', '2026-03-10')"
DB.execute_ db "INSERT INTO sx_badge_service_badge_purchases (purchase_key, master_key, initial_badge_type, current_badge_type, payment_id, status, created_at, updated_at) VALUES (x'0102', x'0304', 'supporter', 'supporter', 'b10-payment', 'issued', '2026-03-10', '2026-03-10')"
@@ -2403,6 +2403,16 @@ orderIdOf WebOrder {orderId} = orderId
serviceRowCount' :: DBStore -> String -> IO Int
serviceRowCount' st table = withConnection st (`serviceRowCount` table)
-- | @web_orders.updated_at@, which no store function returns: 'WebOrder' carries it, but the
-- point of reading it raw here is to pin the column 'setOrderSettled' writes separately from
-- @settled_at@.
updatedAtOf :: HasCallStack => DBStore -> Text -> IO UTCTime
updatedAtOf st orderId = do
rows <- withConnection st $ \db -> DB.query db "SELECT updated_at FROM sx_badge_service_web_orders WHERE order_id = ?" (Only orderId)
case rows of
[Only at] -> pure at
_ -> expectationFailure ("expected exactly one order row for " <> show orderId) >> error "unreachable"
-- | The @invoices row as the database holds it: @(provider, price, amount, currency, status,
-- payment_crypto_currency)@. Read as raw columns rather than through 'getOrder', so the
-- assertions pin what was written rather than what the join makes of it -- and because
@@ -2495,12 +2505,18 @@ testBadgeStoreStuckOrders ps =
now <- getCurrentTime
let daysAgo d = addUTCTime (negate d * nominalDay) now
create orderId shortRef expiry = expectRight $ withServiceTransaction st $ \db -> createOrder db (testNewOrder orderId shortRef expiry Nothing Nothing) now
create "d0-stuck-oldest" "AAAAA" (daysAgo 3)
-- Insertion order is the REVERSE of expiry order, and the ids sort the same wrong way
-- ("d0-stuck-newer" < "d0-stuck-oldest"), so the expected list is neither the natural scan
-- order nor an order-by-id: dropping the ORDER BY clause altogether fails this, not only
-- inverting it. Unordered is the realistic regression -- a WHERE-clause edit that changes
-- the plan, or Postgres reusing heap space after an update -- and a fixture whose insertion
-- order happens to match the expectation cannot see it.
create "d0-stuck-newer" "BBBBB" (daysAgo 1)
create "d0-stuck-oldest" "AAAAA" (daysAgo 3)
create "d0-settled" "CCCCC" (daysAgo 2)
create "d0-open" "DDDDD" (addUTCTime nominalDay now)
_ <- expectRight $ withServiceTransaction st $ \db -> updateOrderStatus db "d0-stuck-newer" WOSPending (Just (CurrencyAmount 700)) now
_ <- expectRight $ withServiceTransaction st $ \db -> setOrderSettled db "d0-settled" (CurrencyAmount 1400) now
_ <- expectRight $ withServiceTransaction st $ \db -> setOrderSettled db "d0-settled" (CurrencyAmount 1400) now now
stuck <- expectRight $ withServiceTransaction st $ \db -> getStuckOrders db now
-- oldest expiry first, the paid one omitted, the unexpired one omitted
map orderIdOf stuck `shouldBe` ["d0-stuck-oldest", "d0-stuck-newer"]
@@ -2520,26 +2536,37 @@ testBadgeStoreOrderStatusAndSettlement ps =
withFreshBadgeStore ps $ \st -> do
now <- getCurrentTime
let expiry = addUTCTime (30 * 60) now
invoiceStatus = do
(_, _, _, _, status, _) <- serviceInvoiceRow st "d0-order-1-invoice"
invoiceStatusOf invoiceId = do
(_, _, _, _, status, _) <- serviceInvoiceRow st invoiceId
pure status
invoiceStatus = invoiceStatusOf "d0-order-1-invoice"
-- a second order nothing below touches: every assertion on it is what proves
-- setOrderInvoiceStatus resolves the invoice THROUGH the order it was given, rather
-- than updating whatever invoice rows exist
untouchedInvoiceStatus = invoiceStatusOf "d0-order-2-invoice"
orderState = do
Just WebOrder {status, amountPaid, settledAt} <- expectRight $ withServiceTransaction st $ \db -> getOrder db "d0-order-1"
pure (status, amountPaid, settledAt)
_ <- expectRight $ withServiceTransaction st $ \db -> createOrder db (testNewOrder "d0-order-1" "K3M7Q" expiry Nothing Nothing) now
_ <- expectRight $ withServiceTransaction st $ \db -> createOrder db (testNewOrder "d0-order-2" "T9WZ4" expiry Nothing Nothing) now
invoiceStatus `shouldReturn` "open"
untouchedInvoiceStatus `shouldReturn` "open"
-- a partial payment: recorded, not settled. The order moves invoiced -> pending; the invoice
-- does not move at all, because orderInvoiceStatus maps both onto ISOpen
_ <- expectRight $ withServiceTransaction st $ \db -> updateOrderStatus db "d0-order-1" WOSPending (Just (CurrencyAmount 700)) now
orderState `shouldReturn` (WOSPending, Just (CurrencyAmount 700), Nothing)
invoiceStatus `shouldReturn` "open"
untouchedInvoiceStatus `shouldReturn` "open"
-- an underpaid expiry: no new amount, and the one already recorded is kept rather than cleared
_ <- expectRight $ withServiceTransaction st $ \db -> updateOrderStatus db "d0-order-1" WOSExpired Nothing now
orderState `shouldReturn` (WOSExpired, Just (CurrencyAmount 700), Nothing)
invoiceStatus `shouldReturn` "expired"
-- late settlement after expiry, which is routine on-chain: all three columns at once
let settledAt = addUTCTime (2 * 3600) now
_ <- expectRight $ withServiceTransaction st $ \db -> setOrderSettled db "d0-order-1" (CurrencyAmount 1400) settledAt
-- late settlement after expiry, which is routine on-chain: all three columns at once. The
-- settlement instant is BEFORE `now` here, as an on-chain confirmation read after the fact
-- is, so it must not be written to updated_at -- hence the separate argument.
let settledAt = addUTCTime (negate (2 * 3600)) now
settledNow = addUTCTime 60 now
_ <- expectRight $ withServiceTransaction st $ \db -> setOrderSettled db "d0-order-1" (CurrencyAmount 1400) settledAt settledNow
(status, amountPaid, storedSettledAt) <- orderState
(status, amountPaid) `shouldBe` (WOSPaid, Just (CurrencyAmount 1400))
case storedSettledAt of
@@ -2548,11 +2575,27 @@ testBadgeStoreOrderStatusAndSettlement ps =
-- the invoice leaves 'expired' for 'paid' with the order: the projection is applied on every
-- write, not only on the way out of 'open'
invoiceStatus `shouldReturn` "paid"
untouchedInvoiceStatus `shouldReturn` "open"
-- settled_at is the payment's instant, updated_at the row's: the settlement did not drag
-- updated_at back before the status change that preceded it
updatedAtOf st "d0-order-1" >>= (`shouldBeStoredAt` settledNow)
-- neither writer invents an order
missingUpdate <- withServiceTransaction st $ \db -> updateOrderStatus db "d0-order-nonexistent" WOSPending Nothing now
missingUpdate `shouldBe` Left SEOrderNotFound
missingSettle <- withServiceTransaction st $ \db -> setOrderSettled db "d0-order-nonexistent" (CurrencyAmount 1400) now
missingSettle <- withServiceTransaction st $ \db -> setOrderSettled db "d0-order-nonexistent" (CurrencyAmount 1400) now now
missingSettle `shouldBe` Left SEOrderNotFound
-- A3's invariant is enforced, not merely upheld: an order that resolves to no invoice --
-- which createOrder cannot produce, but a future writer of this table could -- fails rather
-- than moving the order's status while leaving the invoice's behind. Planted with raw SQL
-- because no store function can reach that state.
withConnection st $ \db ->
DB.execute_ db "INSERT INTO sx_badge_service_web_orders (order_id, invoice_id, method, short_ref, badge_type, months, status, created_at, updated_at) VALUES ('d0-order-no-invoice',NULL,'btc','ZZZZZ','supporter',3,'invoiced','2026-03-10','2026-03-10')"
orphaned <- withServiceTransaction st $ \db -> updateOrderStatus db "d0-order-no-invoice" WOSPending Nothing now
orphaned `shouldBe` Left SEInvoiceNotFound
-- and the order's own UPDATE, which succeeded before the invoice write failed, was rolled
-- back with it -- the reason withServiceTransaction throws rather than returning Left
orphanStatus <- withConnection st $ \db -> DB.query db "SELECT status FROM sx_badge_service_web_orders WHERE order_id = ?" (Only ("d0-order-no-invoice" :: Text))
orphanStatus `shouldBe` [Only ("invoiced" :: Text)]
-- recordProviderEvent returns False ONLY for an event that has already been PROCESSED. A row whose
-- processed_at is NULL is one whose previous attempt died mid-settlement, so it comes back as True