diff --git a/apps/simplex-store-service/src/StoreService/Names/Orders.hs b/apps/simplex-store-service/src/StoreService/Names/Orders.hs index d1d2f936d1..1f28acf81d 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Orders.hs +++ b/apps/simplex-store-service/src/StoreService/Names/Orders.hs @@ -51,7 +51,7 @@ import StoreService.Names.Env (NamesEnv (..)) import StoreService.Names.Phases (Phases) import StoreService.Names.Abi (bytes32FromHex) import StoreService.Names.Signatures (OrderFields (..), orderMessage, parseChecksumAddress, parseSignature, personalDigest) -import StoreService.Names.Store (LiveOrder (..), NameRegistration (..), RegistrationRefused (..), VersionWrite (..), closeOverdue, getLiveOrders, getRegistrationByOrderHash, isLabelRegistering) +import StoreService.Names.Store (LiveOrder (..), NameRegistration (..), RegistrationRefused (..), closeOverdue, getLiveOrders, getRegistrationByOrderHash, isLabelRegistering) import StoreService.Names.Turns (Turns) data OrdersEnv = OrdersEnv @@ -167,8 +167,8 @@ placeOrder OrdersEnv {oeStore, oeNow} req insert = do Nothing -> E.throwIO $ OrderRefused OROrderExists close db now r = closeOverdue db r now >>= \case - Written v -> pure ClosedOrder {coRegistration = r, coVersion = v} - _ -> E.throwIO $ OrderRefused OROrderExists + Just v -> pure ClosedOrder {coRegistration = r, coVersion = v} + Nothing -> E.throwIO $ OrderRefused OROrderExists checkTimestamp :: UTCTime -> Word64 -> Either OrderRefusal () checkTimestamp now timestamp = diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs index a497df10ed..fabcde83c0 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Store.hs +++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs @@ -75,6 +75,7 @@ import Data.ByteArray.Encoding (Base (Base16), convertToBase) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Int (Int64) +import Data.Functor ((<&>)) import Data.Maybe (isJust, listToMaybe) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) @@ -206,8 +207,7 @@ data RegistrationRefused = RRLiveOrder | RRCodeNotReservable deriving (Eq, Show) -- | NotLive: the write would make a closed order live. LiveOrderExists: another live order holds its commitment, or its owner and label hash. --- NotOverdue: closeOverdue found the order's invoice no longer open, or holding money. -data VersionWrite = Written Int64 | VersionChanged | NotLive | LiveOrderExists | NotOverdue +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. @@ -502,10 +502,10 @@ getLiveOrders db commitment owner (LabelHash lh) now = unfunded :: Query unfunded = unfundedQuery "i.invoice_id" --- | Run in the transaction that inserts the next order, so the unique constraints let it in. The invoice is written before --- 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 +-- | Run in the transaction that inserts the next order, so the unique constraints let it in; the registration's new version. +-- Nothing when the order changed since it was read, or its invoice is no longer open or holds money: the caller rolls back, +-- since the invoice is written before the registration, as settlement, cancel and the sweep write them. +closeOverdue :: DB.Connection -> NameRegistration -> UTCTime -> IO (Maybe Int64) 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 @@ -527,11 +527,11 @@ closeOverdue db r@NameRegistration {nrId = RegistrationId rid, nrVersion, nrPaym ) (invoiceStatusText ISExpired, truncateToSecond now, invoiceStatusText ISOpen, rid, nrVersion) if expired > 0 - then updateRegistration db r {nrLive = False} now - else - DB.query db "SELECT version FROM sx_badge_service_name_registrations WHERE registration_id = ?" (Only rid) >>= \case - [Only version] | version == nrVersion -> pure NotOverdue - _ -> pure VersionChanged + then + updateRegistration db r {nrLive = False} now <&> \case + Written v -> Just v + _ -> Nothing + else pure Nothing -- | 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. diff --git a/apps/simplex-store-service/src/StoreService/Orders.hs b/apps/simplex-store-service/src/StoreService/Orders.hs index 31f1cb8d0f..a1b2c4ad76 100644 --- a/apps/simplex-store-service/src/StoreService/Orders.hs +++ b/apps/simplex-store-service/src/StoreService/Orders.hs @@ -177,7 +177,7 @@ nameSettled db before after wrotePayment holdsMoney r@NameRegistration {nrId, nr updateRegistration db r {nrPhase = PQueued} now >>= \case Written v -> pure [NOWritten nrId v] NotLive -> pure [NOLate nrId] - -- another live order holds the name, so this payment can only be refunded; it is still recorded + -- not expected while this order is live; kept so the payment is still recorded LiveOrderExists -> pure [NOLate nrId] _ -> E.throwIO (RegistrationChanged nrId) Just ISExpired -> (<> [NOLate nrId | holdsMoney]) . maybe [] (\(rid, v) -> [NOWritten rid v]) <$> closeOrder db r now diff --git a/tests/Bots/StoreService/NamesOrdersTests.hs b/tests/Bots/StoreService/NamesOrdersTests.hs index 47119783d8..9efac23221 100644 --- a/tests/Bots/StoreService/NamesOrdersTests.hs +++ b/tests/Bots/StoreService/NamesOrdersTests.hs @@ -651,7 +651,7 @@ testFundedOverdueKept = withOrders $ \ctx -> do placeOrder ctx aliceOrder {oCommitment = commitmentOf 2, oTimestamp = seconds now, oDuration = durationAt now} `shouldReturn` refusedWith 409 "order_exists" r <- invoiceRegistration ctx inv (nrLive r, nrPhase r) `shouldBe` (True, PUnpaid) - withTransaction (cStore ctx) (\db -> closeOverdue db r now) >>= (`shouldNotBe` Written (nrVersion r + 1)) + withTransaction (cStore ctx) (\db -> closeOverdue db r now) `shouldReturn` Nothing (irStatus <$>) <$> getInvoice (cStore ctx) inv `shouldReturn` Just ISOpen settleNow ctx inv settled `shouldReturn` Right ISPaid nrPhase <$> invoiceRegistration ctx inv `shouldReturn` PQueued @@ -935,7 +935,7 @@ testFundedAgreement = withServiceStore $ \st -> do [LiveOrder {loRegistration, loOverdue}] <- withTransaction st $ \db -> getLiveOrders db (ofCommitment o) ownerA (ofLabelHash o) now (rid, loOverdue) `shouldBe` (rid, not funded) closed <- withTransaction st $ \db -> closeOverdue db loRegistration now - (rid, closed == Written (nrVersion loRegistration + 1)) `shouldBe` (rid, not funded) + (rid, closed) `shouldBe` (rid, if funded then Nothing else Just (nrVersion loRegistration + 1)) testViewFields :: IO () testViewFields = withServiceStore $ \st -> withFakeEthNode $ \node -> do diff --git a/tests/Bots/StoreService/NamesStoreTests.hs b/tests/Bots/StoreService/NamesStoreTests.hs index fc778c9925..c32ea0b0e2 100644 --- a/tests/Bots/StoreService/NamesStoreTests.hs +++ b/tests/Bots/StoreService/NamesStoreTests.hs @@ -304,7 +304,7 @@ testOrderHashLookup = withServiceStore $ \st -> do placePaid st "r1" ownerA o (at 1) `shouldReturn` Right () r <- reg st "r1" closed <- withTransaction st $ \db -> closeOverdue db r (at 2) - closed `shouldBe` Written 2 + closed `shouldBe` Just 2 found <- withTransaction st $ \db -> getRegistrationByOrderHash db (orderHash ownerA o (OTInvoice btc price)) (nrId <$> found, nrLive <$> found) `shouldBe` (Just (RegistrationId "r1"), Just False) withTransaction st (\db -> getRegistrationByOrderHash db (orderHash ownerA o (OTInvoice btc (price + 1)))) `shouldReturn` Nothing @@ -346,7 +346,7 @@ testCloseOverdueStale = withServiceStore $ \st -> do placePaid st "r1" ownerA (order "alicebakery" 1) (at 60) `shouldReturn` Right () r <- reg st "r1" write st r {nrPhase = PQueued} `shouldReturn` Written 2 - withTransaction st (\db -> closeOverdue db r (at 61)) `shouldReturn` VersionChanged + withTransaction st (\db -> closeOverdue db r (at 61)) `shouldReturn` Nothing invoiceStatus st "inv-r1" `shouldReturn` "open" (nrLive &&& nrPhase) <$> reg st "r1" `shouldReturn` (True, PQueued) @@ -462,7 +462,7 @@ testLatePayment = withServiceStore $ \st -> do 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 + withTransaction st (\db -> closeOverdue db closed (at 61)) `shouldReturn` Just 2 r1 <- reg st "r1" write st r1 {nrPhase = PQueued} `shouldReturn` NotLive reg st "r1" `shouldReturn` r1 @@ -549,7 +549,7 @@ testSameSecondOrder = withServiceStore $ \st -> do 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 + withTransaction st (\db -> closeOverdue db r (at 61)) `shouldReturn` Just 2 found <- withTransaction st $ \db -> getRegistrationByOrderHash db (orderHash ownerB o (OTInvoice btc price)) nrId <$> found `shouldBe` Just (RegistrationId "r5")