diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs index 760536c9cb..786b5bcfdd 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Store.hs +++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs @@ -474,7 +474,7 @@ getRegistration db (RegistrationId rid) = getRegistrationByOrderHash :: DB.Connection -> ByteString -> IO (Maybe NameRegistration) getRegistrationByOrderHash db hash = firstDecoded toRegistration $ - DB.query db (selectRegistrations <> " WHERE r.order_hash = ? ORDER BY r.created_at DESC LIMIT 1") (Only $ Binary hash) + DB.query db (selectRegistrations <> " WHERE r.order_hash = ? ORDER BY r.created_at DESC, r.registration_id DESC LIMIT 1") (Only $ Binary hash) -- | Overdue whatever status the poller has marked, as long as the invoice is not paid. getLiveOrders :: DB.Connection -> ByteString -> Address -> LabelHash -> UTCTime -> IO [LiveOrder] @@ -594,7 +594,7 @@ retargetRegistration db r OrderFields {ofLabelHash, ofLength, ofDuration, ofComm -- | Newest first, at most findLimit. findRegistrations :: DB.Connection -> Address -> IO [NameRegistration] findRegistrations db owner = - DB.query db (selectRegistrations <> " WHERE r.owner = ? ORDER BY r.created_at DESC LIMIT ?") (Binary $ unAddress owner, findLimit) + DB.query db (selectRegistrations <> " WHERE r.owner = ? ORDER BY r.created_at DESC, r.registration_id DESC LIMIT ?") (Binary $ unAddress owner, findLimit) >>= decodeAll toRegistration isLabelRegistering :: DB.Connection -> LabelHash -> IO Bool @@ -607,7 +607,7 @@ isLabelRegistering db (LabelHash lh) = -- | The registrations a worker moves on, oldest first. activeRegistrations :: DB.Connection -> IO [NameRegistration] activeRegistrations db = - DB.query db (selectRegistrations <> " WHERE r.phase IN (?,?,?,?) ORDER BY r.created_at") (PQueued, PCommitting, PCommitted, PRegistering) + DB.query db (selectRegistrations <> " WHERE r.phase IN (?,?,?,?) ORDER BY r.created_at, r.registration_id") (PQueued, PCommitting, PCommitted, PRegistering) >>= decodeAll toRegistration unpaidCleanupCandidates :: DB.Connection -> UTCTime -> IO [(RegistrationId, InvoiceId)] @@ -620,7 +620,7 @@ unpaidCleanupCandidates db createdBefore = FROM sx_badge_service_name_registrations r JOIN sx_badge_service_name_invoices ni ON ni.registration_id = r.registration_id WHERE r.phase = ? AND r.created_at < ? - ORDER BY r.created_at + ORDER BY r.created_at, r.registration_id |] (PUnpaid, truncateToSecond createdBefore) @@ -656,7 +656,7 @@ failedCodeOrdersBefore db cutoff = FROM sx_badge_service_name_registrations r JOIN sx_badge_service_name_prepaid_codes c ON c.reserved_by = r.registration_id WHERE r.phase = ? AND r.failed_at < ? AND c.spent_at IS NULL - ORDER BY r.failed_at + ORDER BY r.failed_at, r.registration_id |] (PFailed, truncateToSecond cutoff) diff --git a/tests/Bots/StoreService/NamesStoreTests.hs b/tests/Bots/StoreService/NamesStoreTests.hs index fbf8d9af47..d049e6ced8 100644 --- a/tests/Bots/StoreService/NamesStoreTests.hs +++ b/tests/Bots/StoreService/NamesStoreTests.hs @@ -63,6 +63,7 @@ namesStoreTests = describe "StoreService names: store" $ do 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 "orders registrations made in the same second by their id" testSameSecondOrder it "tells a label being registered here" testLabelRegistering it "lists the registrations a worker moves on" testActive it "deletes an unpaid order past the cutoff with its invoice, sparing one with a payment" testUnpaidCleanup @@ -530,6 +531,23 @@ testFind = withServiceStore $ \st -> do map nrId found `shouldBe` [RegistrationId $ "r" <> T.pack (show i) | i <- [52, 51 .. 3 :: Int]] withTransaction st (\db -> findRegistrations db (address "0x0000000000000000000000000000000000000001")) `shouldReturn` [] +testSameSecondOrder :: IO () +testSameSecondOrder = withServiceStore $ \st -> do + let o = order "alicebakery" 1 + ids = ["r2", "r3", "r1"] + forM_ (zip ids [10 ..]) $ \(rid, n) -> do + placePaid st rid ownerA (order ("alicebakery" <> rid) n) (at 60) `shouldReturn` Right () + r <- reg st rid + write st r {nrPhase = PQueued} `shouldReturn` Written 2 + map nrId <$> withTransaction st (`findRegistrations` ownerA) `shouldReturn` map RegistrationId ["r3", "r2", "r1"] + map nrId <$> withTransaction st activeRegistrations `shouldReturn` map RegistrationId ["r1", "r2", "r3"] + forM_ ["r5", "r4"] $ \rid -> do + placePaid st rid ownerB o (at 60) `shouldReturn` Right () + r <- reg st rid + withTransaction st (\db -> closeOverdue db r (at 61)) `shouldReturn` Written 2 + found <- withTransaction st $ \db -> getRegistrationByOrderHash db (orderHash ownerB o (OTInvoice btc price)) + nrId <$> found `shouldBe` Just (RegistrationId "r5") + testLabelRegistering :: IO () testLabelRegistering = withServiceStore $ \st -> do let o = order "alicebakery" 1