store: keep closed and registered orders not live

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.

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 =

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 =

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