From cd8a1562548b18bf12bd56a4992cf309f80689c0 Mon Sep 17 00:00:00 2001 From: shum Date: Wed, 21 Oct 2026 23:27:52 +0000 Subject: [PATCH] store: keep closed and registered orders not live --- .../src/StoreService/Names/Store.hs | 54 +++++++++--- .../StoreService/Store/Postgres/Migrations.hs | 2 +- .../StoreService/Store/SQLite/Migrations.hs | 2 +- tests/Bots/StoreService/NamesStoreTests.hs | 88 ++++++++++++++++--- 4 files changed, 118 insertions(+), 28 deletions(-) diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs index 68c41810d3..760536c9cb 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Store.hs +++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs @@ -29,6 +29,7 @@ module StoreService.Names.Store NewRecordEdit (..), findLimit, orderHash, + orderLive, newRegistrationId, methodText, createPaidRegistration, @@ -202,7 +203,8 @@ data PaidOrder = PaidOrder data RegistrationRefused = RRLiveOrder | RRCodeNotReservable deriving (Eq, Show) -data VersionWrite = Written Int64 | VersionChanged +-- | NotLive: the write would make a closed order live. LiveOrderExists: another live order holds its commitment, or its owner and label hash. +data VersionWrite = Written Int64 | VersionChanged | NotLive | LiveOrderExists deriving (Eq, Show) -- | A live order an order request meets; overdue when its open invoice is past its expiry time. @@ -494,7 +496,7 @@ getLiveOrders db commitment owner (LabelHash lh) now = closeOverdue :: DB.Connection -> NameRegistration -> UTCTime -> IO VersionWrite closeOverdue db r@NameRegistration {nrId = RegistrationId rid} now = do written <- updateRegistration db r {nrLive = False} now - when (written /= VersionChanged) $ + when (isWritten written) $ DB.execute db [sql| @@ -504,8 +506,30 @@ closeOverdue db r@NameRegistration {nrId = RegistrationId rid} now = do (invoiceStatusText ISExpired, truncateToSecond now, invoiceStatusText ISOpen, rid) pure written --- | Writes every changeable field of a registration read at its nrVersion, unless it changed since. --- An unpaid registration keeps the given nrLive, which only its invoice decides. +isWritten :: VersionWrite -> Bool +isWritten = \case + Written _ -> True + _ -> False + +-- | Whether an order can still progress to a registration for its name. The unique live indexes allow one such order per commitment, +-- and one per owner and label hash, so a wallet can order a name again once its registration is done. +-- An unpaid order is live while its invoice is open, which nrLive carries; a paid order that lost its name can move to another one. +orderLive :: NameRegistration -> Bool +orderLive NameRegistration {nrPhase, nrPayment, nrLive} = case nrPhase of + PUnpaid -> nrLive + PQueued -> True + PCommitting -> True + PCommitted -> True + PRegistering -> True + PFailed -> True + PTaken -> case nrPayment of + RPInvoice {} -> True + RPCode _ -> False + PRegistered -> False + PCodeIssued -> False + +-- | Writes every changeable field of a registration read at its nrVersion, unless it changed since, with live as orderLive decides. +-- A closed order is never made live again, and a write that would make the order meet another live one changes nothing. updateRegistration :: DB.Connection -> NameRegistration -> UTCTime -> IO VersionWrite updateRegistration db r now = do changed <- @@ -518,23 +542,27 @@ updateRegistration db r now = do commit_tx = ?, commit_block = ?, register_tx = ?, register_block = ?, reveal_after = ?, reveal_before = ?, expires_at = ?, issued_code_id = ?, registered_at = ?, failed_at = ?, error = ?, live = ?, moves = ?, links_refused_at = ?, updated_at = ? WHERE registration_id = ? AND version = ? + AND (? = 0 OR (live = 1 AND NOT EXISTS ( + SELECT 1 FROM sx_badge_service_name_registrations o + WHERE o.live = 1 AND o.registration_id <> ? AND (o.commitment = ? OR (o.owner = ? AND o.label_hash = ?)) + ))) |] ( (Binary lh, nrLength, int64 nrDuration, Binary nrCommitment, nrSealed, nrPhase, nrPrice) :. (rvLabel <$> nrReveal, Binary . rvSecret <$> nrReveal, rvContactLink =<< nrReveal, rvChannelLink =<< nrReveal, int64 . rvNonce <$> nrReveal, int64 . rvDeadline <$> nrReveal, Binary . serializeSignature . rvSignature <$> nrReveal) :. (Binary <$> nrCommitTx, int64 <$> nrCommitBlock, Binary <$> nrRegisterTx, int64 <$> nrRegisterBlock, int64 <$> nrRevealAfter, int64 <$> nrRevealBefore, int64 <$> nrExpiresAt) :. (nrIssuedCodeId, truncateToSecond <$> nrRegisteredAt, truncateToSecond <$> nrFailedAt, nrError, BI live, nrMoves, truncateToSecond <$> nrLinksRefusedAt, truncateToSecond now) - :. (rid, nrVersion) + :. (rid, nrVersion, BI live, rid, Binary nrCommitment, Binary $ unAddress nrOwner, Binary lh) ) - pure $ if changed > 0 then Written (nrVersion + 1) else VersionChanged + if changed > 0 then pure $ Written (nrVersion + 1) else refusal where - NameRegistration {nrId = RegistrationId rid, nrVersion, nrLabelHash = LabelHash lh, nrLength, nrDuration, nrCommitment, nrSealed, nrPhase, nrPrice, nrReveal} = r + NameRegistration {nrId = RegistrationId rid, nrVersion, nrLabelHash = LabelHash lh, nrLength, nrDuration, nrOwner, nrCommitment, nrSealed, nrPhase, nrPrice, nrReveal} = r NameRegistration {nrCommitTx, nrCommitBlock, nrRegisterTx, nrRegisterBlock, nrRevealAfter, nrRevealBefore, nrExpiresAt} = r - NameRegistration {nrIssuedCodeId, nrRegisteredAt, nrFailedAt, nrError, nrLive, nrMoves, nrLinksRefusedAt} = r - live = case nrPhase of - PUnpaid -> nrLive - PTaken -> False - PCodeIssued -> False - _ -> True + NameRegistration {nrIssuedCodeId, nrRegisteredAt, nrFailedAt, nrError, nrMoves, nrLinksRefusedAt} = r + live = orderLive r + refusal = + DB.query db "SELECT version, live FROM sx_badge_service_name_registrations WHERE registration_id = ?" (Only rid) >>= \case + [(version, BI storedLive)] | version == nrVersion -> pure $ if storedLive then LiveOrderExists else NotLive + _ -> pure VersionChanged -- | Another name, or other links: queued again with the reveal, transactions, reveal times and link refusal cleared. -- The order hash stays the original order's, so a resend of that order still finds it. diff --git a/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs b/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs index f6dfe057a3..9e440f4f06 100644 --- a/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs +++ b/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs @@ -153,7 +153,7 @@ ALTER TABLE @badge_codes DROP COLUMN redeem_limit; DROP TABLE @group; |] --- A registration is live while its invoice is open, or past unpaid and not taken or code_issued. +-- A registration is live as Names.Store's orderLive decides. -- reserved_by is added after the registrations table, which references the codes table. m20261010_names :: Text m20261010_names = diff --git a/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs b/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs index 4521bc59e9..a86cda9c65 100644 --- a/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs +++ b/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs @@ -154,7 +154,7 @@ ALTER TABLE @badge_codes DROP COLUMN redeem_limit; DROP TABLE @group; |] --- A registration is live while its invoice is open, or past unpaid and not taken or code_issued. +-- A registration is live as Names.Store's orderLive decides. -- reserved_by is added after the registrations table, which references the codes table. m20261010_names :: Query m20261010_names = diff --git a/tests/Bots/StoreService/NamesStoreTests.hs b/tests/Bots/StoreService/NamesStoreTests.hs index d3f7bd2d10..fbf8d9af47 100644 --- a/tests/Bots/StoreService/NamesStoreTests.hs +++ b/tests/Bots/StoreService/NamesStoreTests.hs @@ -57,6 +57,10 @@ namesStoreTests = describe "StoreService names: store" $ do it "bumps the version on every write and changes nothing for a stale one" testVersionBumps it "writes and reads back every changeable field, and clears the reveal" testRoundTrip it "keeps live in step with the phase" testLiveFollowsPhase + it "is live while an order can still progress to a registration for its name" testOrderLive + it "lets a wallet order a name again once its registration is done" testReorderAfterRegistered + it "refuses to queue a closed order, also when a newer live order holds its name" testLatePayment + it "refuses a write that would meet another live order, writing nothing" testWriteMeetsLiveOrder it "retargets to the new fields, clearing the reveal, transactions, reveal times and refusal" testRetarget it "finds an owner's orders newest first, at most 50" testFind it "tells a label being registered here" testLabelRegistering @@ -398,27 +402,85 @@ testRoundTrip = withServiceStore $ \st -> do nrMoves = 2 } write st changed `shouldReturn` Written 2 - reg st "r1" `shouldReturn` changed {nrVersion = 2, nrUpdatedAt = at 1} + reg st "r1" `shouldReturn` changed {nrVersion = 2, nrLive = False, nrUpdatedAt = at 1} write st changed {nrVersion = 2, nrReveal = Nothing} `shouldReturn` Written 3 nrReveal <$> reg st "r1" `shouldReturn` Nothing testLiveFollowsPhase :: IO () testLiveFollowsPhase = withServiceStore $ \st -> do placePaid st "r1" ownerA (order "alicebakery" 1) (at 60) `shouldReturn` Right () - let step phase expected = do - r <- reg st "r1" - void $ write st r {nrPhase = phase} - (nrPhase &&& nrLive) <$> reg st "r1" `shouldReturn` (phase, expected) - step PQueued True - step PTaken False - step PFailed True - step PCodeIssued False + code <- issue st 1 usable + placeCode st "r2" ownerB (order "bobsbakery" 2) code `shouldReturn` Right () + let step rid phase expected = do + r <- reg st rid + write st r {nrPhase = phase} `shouldReturn` Written (nrVersion r + 1) + (nrPhase &&& nrLive) <$> reg st rid `shouldReturn` (phase, expected) + step "r1" PQueued True + step "r1" PTaken True + step "r1" PFailed True + step "r1" PTaken True + step "r1" PCodeIssued False + step "r2" PRegistering True + step "r2" PTaken False + placePaid st "r3" ownerA (order "carolsbakery" 3) (at 60) `shouldReturn` Right () + r3 <- reg st "r3" + write st r3 {nrLive = False} `shouldReturn` Written 2 + nrLive <$> reg st "r3" `shouldReturn` False + +testOrderLive :: IO () +testOrderLive = withServiceStore $ \st -> do + placePaid st "r1" ownerA (order "alicebakery" 1) (at 60) `shouldReturn` Right () + paid <- reg st "r1" + let code = paid {nrPayment = RPCode 1} + liveIn r phase = (phase, orderLive r {nrPhase = phase}) + map (liveIn paid) [minBound .. maxBound] + `shouldBe` [(PUnpaid, True), (PQueued, True), (PCommitting, True), (PCommitted, True), (PRegistering, True), (PRegistered, False), (PTaken, True), (PFailed, True), (PCodeIssued, False)] + map (liveIn code) [PTaken, PFailed, PRegistered] `shouldBe` [(PTaken, False), (PFailed, True), (PRegistered, False)] + orderLive paid {nrLive = False} `shouldBe` False + orderLive paid {nrLive = False, nrPhase = PQueued} `shouldBe` True + +testReorderAfterRegistered :: IO () +testReorderAfterRegistered = withServiceStore $ \st -> do + let o = order "alicebakery" 1 + code <- issue st 1 usable + placeCode st "r1" ownerA o code `shouldReturn` Right () + placePaid st "r2" ownerA o {ofCommitment = digestFixture 2} (at 60) `shouldReturn` Left RRLiveOrder r <- reg st "r1" - void $ write st r {nrPhase = PUnpaid, nrLive = True} - nrLive <$> reg st "r1" `shouldReturn` True - r' <- reg st "r1" - void $ write st r' {nrLive = False} + write st r {nrPhase = PRegistered, nrRegisteredAt = Just (at 1)} `shouldReturn` Written 2 nrLive <$> reg st "r1" `shouldReturn` False + placePaid st "r3" ownerA o {ofCommitment = digestFixture 2} (at 60) `shouldReturn` Right () + +testLatePayment :: IO () +testLatePayment = withServiceStore $ \st -> do + let o = order "alicebakery" 1 + o' = o {ofCommitment = digestFixture 2, ofSealed = "new"} + placePaid st "r1" ownerA o (at 60) `shouldReturn` Right () + closed <- reg st "r1" + withTransaction st (\db -> closeOverdue db closed (at 61)) `shouldReturn` Written 2 + r1 <- reg st "r1" + write st r1 {nrPhase = PQueued} `shouldReturn` NotLive + reg st "r1" `shouldReturn` r1 + placePaid st "r2" ownerA o' (at 120) `shouldReturn` Right () + write st r1 {nrPhase = PQueued} `shouldReturn` NotLive + reg st "r1" `shouldReturn` r1 + (nrPhase &&& nrLive) <$> reg st "r2" `shouldReturn` (PUnpaid, True) + write st r1 {nrVersion = 1, nrPhase = PQueued} `shouldReturn` VersionChanged + +testWriteMeetsLiveOrder :: IO () +testWriteMeetsLiveOrder = withServiceStore $ \st -> do + let held = order "bobsbakery" 2 + placePaid st "r1" ownerA (order "alicebakery" 1) (at 60) `shouldReturn` Right () + placePaid st "r2" ownerA held (at 60) `shouldReturn` Right () + placePaid st "r3" ownerB (order "carolsbakery" 3) (at 60) `shouldReturn` Right () + r1 <- reg st "r1" + write st r1 {nrPhase = PTaken} `shouldReturn` Written 2 + taken <- reg st "r1" + let retarget o = withTransaction st $ \db -> retargetRegistration db taken o 10000 (at 6) + retarget held {ofCommitment = digestFixture 4} `shouldReturn` LiveOrderExists + r3 <- reg st "r3" + retarget (order "carolsbakery" 5) {ofCommitment = nrCommitment r3} `shouldReturn` LiveOrderExists + reg st "r1" `shouldReturn` taken + retarget (order "davesbakery" 6) `shouldReturn` Written 3 testRetarget :: IO () testRetarget = withServiceStore $ \st -> do