From f52549017ca2dff9c1d795748fc662bb818ca0bf Mon Sep 17 00:00:00 2001 From: shum Date: Thu, 22 Oct 2026 03:08:31 +0000 Subject: [PATCH] store: lock the invoice row before a payment --- .../src/StoreService/Names/Store.hs | 8 ++++++-- .../src/StoreService/Orders.hs | 20 +++++++++++++------ .../src/StoreService/Store/Invoices.hs | 8 ++++++++ tests/Bots/StoreService/NamesOrdersTests.hs | 11 ++++++++++ 4 files changed, 39 insertions(+), 8 deletions(-) diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs index 76bdfca27a..bd8b348d1f 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Store.hs +++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs @@ -97,7 +97,7 @@ import StoreService.Names.Chain (TxHash (..)) import StoreService.Names.Phases (RegistrationId (..)) import StoreService.Names.Signatures (OrderFields (..), parseSignature) import StoreService.Store (RevokeResult (..)) -import StoreService.Store.Invoices (StoreDecodeError (..), executeChanging, invoiceStatusText, newInvoiceId, truncateToSecond) +import StoreService.Store.Invoices (StoreDecodeError (..), executeChanging, invoiceStatusText, lockInvoice, newInvoiceId, truncateToSecond) #if defined(dbPostgres) import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..)) @@ -513,7 +513,11 @@ unfunded = -- the registration, as settlement, cancel and the sweep write them; a registration write that loses after it leaves the -- caller to roll back. closeOverdue :: DB.Connection -> NameRegistration -> UTCTime -> IO VersionWrite -closeOverdue db r@NameRegistration {nrId = RegistrationId rid, nrVersion} now = do +closeOverdue db r@NameRegistration {nrId = RegistrationId rid, nrVersion, nrPayment} now = do + -- locked first, so the funding check below, a later statement, sees a payment a concurrent settlement committed + mapM_ (\invId -> lockInvoice db invId now) $ case nrPayment of + RPInvoice _ invId -> Just invId + RPCode _ -> Nothing expired <- executeChanging db diff --git a/apps/simplex-store-service/src/StoreService/Orders.hs b/apps/simplex-store-service/src/StoreService/Orders.hs index 4f1823d263..31f1cb8d0f 100644 --- a/apps/simplex-store-service/src/StoreService/Orders.hs +++ b/apps/simplex-store-service/src/StoreService/Orders.hs @@ -18,7 +18,7 @@ import StoreService.Names.Phases (Phases, RegistrationId (..)) import qualified StoreService.Names.Phases as Phases import StoreService.Names.Store (NamePhase (..), NameRegistration (..), VersionWrite (..), getRegistration, updateRegistration) import StoreService.Providers (Funded (..), PaymentSignal (..), Received (..)) -import StoreService.Store.Invoices (InvoicePayment (..), InvoiceProduct (..), InvoiceRow (..), expireOverdueInvoice, markCodePaid, paymentHolds, paymentStatusText, settlementCodeHash, settlementInvoice, truncateToSecond, updateInvoiceStatus, upsertPayment) +import StoreService.Store.Invoices (InvoicePayment (..), InvoiceProduct (..), InvoiceRow (..), expireOverdueInvoice, lockInvoice, markCodePaid, paymentHolds, paymentStatusText, settlementCodeHash, settlementInvoice, truncateToSecond, updateInvoiceStatus, upsertPayment) import StoreService.Waiters (Waiters, publish, publishPayment) import Control.Concurrent.STM (STM, atomically) import Control.Exception (Exception) @@ -91,11 +91,13 @@ settleOrder :: DBStore -> Waiters -> Maybe Phases -> InvoiceId -> PaymentSignal settleOrder st waiters phases invId@(InvoiceId invText) signal now' = do outcome <- withTransaction st $ \db -> settlementInvoice db invId >>= \case - Nothing -> pure (Left "no such invoice") - Just row@InvoiceRow {irStatus} -> case decide irStatus signal of - Nothing -> pure (Right (irStatus, PubNothing, [])) - -- read the product first, so an invoice without one leaves the transaction empty, not paid with nothing to show for it - Just w -> productOf db row w >>= either (pure . Left) (settle db row w) + Just InvoiceRow {irStatus} + | isJust (decide irStatus signal) -> do + -- On Postgres, a concurrent overdue close holding the row is waited for, and the read below sees its writes; + -- a close that comes later waits for this payment and then sees it. + lockInvoice db invId now + settlementInvoice db invId >>= settleRow db + row_ -> settleRow db row_ case outcome of Left e -> pure (Left e) Right (status, toPublish, name) -> do @@ -115,6 +117,12 @@ settleOrder st waiters phases invId@(InvoiceId invText) signal now' = do where now = truncateToSecond now' at = truncateToSecond (settledInstant signal now) + settleRow db = \case + Nothing -> pure (Left "no such invoice") + Just row@InvoiceRow {irStatus} -> case decide irStatus signal of + Nothing -> pure (Right (irStatus, PubNothing, [])) + -- read the product first, so an invoice without one is not marked paid with nothing to show for it + Just w -> productOf db row w >>= either (pure . Left) (settle db row w) productOf :: DB.Connection -> InvoiceRow -> Write -> IO (Either Text Product) productOf db InvoiceRow {irProduct} Write {wCode} = case irProduct of IPBadge {} diff --git a/apps/simplex-store-service/src/StoreService/Store/Invoices.hs b/apps/simplex-store-service/src/StoreService/Store/Invoices.hs index fcfff1da0e..dc132cd615 100644 --- a/apps/simplex-store-service/src/StoreService/Store/Invoices.hs +++ b/apps/simplex-store-service/src/StoreService/Store/Invoices.hs @@ -26,6 +26,7 @@ module StoreService.Store.Invoices OverdueInvoice (..), overdueInvoices, expireOverdueInvoice, + lockInvoice, newInvoiceId, readCatalogRows, seedCatalog, @@ -296,6 +297,9 @@ qUpsertPayment = where alreadySettled = "@payments.status = '" <> paymentStatusText PSSettled <> "'" +qLockInvoice :: Query +qLockInvoice = mkQuery "UPDATE @invoices SET updated_at = ? WHERE invoice_id = ?" + qUpdateInvoiceStatus :: Query qUpdateInvoiceStatus = mkQuery "UPDATE @invoices SET status = ?, updated_at = ? WHERE invoice_id = ? AND status = ?" @@ -657,6 +661,10 @@ upsertPayment db InvoiceRow {irInvoiceId, irProvider, irProviderRef, irCurrency} InvoiceId invId = irInvoiceId at = truncateToSecond at' +-- | Takes the invoice row's lock for the rest of the transaction; SQLite's transactions hold the whole database already. +lockInvoice :: DB.Connection -> InvoiceId -> UTCTime -> IO () +lockInvoice db (InvoiceId invId) at = DB.execute db qLockInvoice (truncateToSecond at, invId) + updateInvoiceStatus :: DB.Connection -> InvoiceId -> InvoiceStatus -> InvoiceStatus -> UTCTime -> IO Bool updateInvoiceStatus db (InvoiceId invId) observed new at = (> 0) <$> executeChanging db qUpdateInvoiceStatus (invoiceStatusText new, truncateToSecond at, invId, invoiceStatusText observed) diff --git a/tests/Bots/StoreService/NamesOrdersTests.hs b/tests/Bots/StoreService/NamesOrdersTests.hs index 2078860b8b..1365ff615f 100644 --- a/tests/Bots/StoreService/NamesOrdersTests.hs +++ b/tests/Bots/StoreService/NamesOrdersTests.hs @@ -100,6 +100,7 @@ namesOrdersTests = describe "StoreService names: orders" $ do it "answers cancel with funded, not_open, paid when settlement won, and expired with the payment read meanwhile" testCancelAnswers it "leaves a late payment of a cancelled invoice unpaid and alerts" testLatePayment it "queues an order settled while open and publishes its version" testSettlementQueues + it "takes the invoice's row before recording a payment that moves no status" testSettlementLocksInvoice it "closes the order of an invoice the provider closed or the sweep expired" testExpiryCloses it "sweeps each invoice on its own, skipping one whose order cannot be read" testSweepSkipsBadRow it "cleans up unpaid orders after 30 days, reading the provider first" testCleanup @@ -780,6 +781,16 @@ testSettlementQueues = withOrders $ \ctx -> do r <- invoiceRegistration ctx invId (nrPhase r, nrLive r, nrVersion r) `shouldBe` (PQueued, True, 2) +-- | Postgres serializes the payment with a concurrent overdue close only on this row; SQLite shows that it is written. +testSettlementLocksInvoice :: IO () +testSettlementLocksInvoice = withOrders $ \ctx -> do + (inv@(InvoiceId t), _) <- placed ctx aliceOrder + advance ctx 60 + settleNow ctx inv (SigFunded (rcv 10000 (Just "0.00156")) PaidInFull) `shouldReturn` Right ISOpen + now <- readIORef (cClock ctx) + withConnection (cStore ctx) (\db -> DB.query db "SELECT updated_at, status FROM sx_badge_service_invoices WHERE invoice_id = ?" [t]) + `shouldReturn` [(now, "open" :: Text)] + testExpiryCloses :: IO () testExpiryCloses = withOrders $ \ctx -> do (closedByProvider, _) <- placed ctx aliceOrder