diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs index 5d091a828c..860ab972bc 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Store.hs +++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs @@ -16,7 +16,6 @@ module StoreService.Names.Store VersionWrite (..), LiveOrder (..), OrderTerms (..), - HeldBalance (..), Balance (..), BalanceHold (..), BalanceLink (..), @@ -251,9 +250,6 @@ data LiveOrder = LiveOrder -- | What an order pays with, as its hash covers it. OTBalance: the paying order, the price, the balance seen, and the method of a difference. data OrderTerms = OTInvoice ServicePaymentMethod Int | OTCode ByteString | OTBalance RegistrationId Int Int (Maybe ServicePaymentMethod) --- | The balance a difference order holds while its invoice is open: the paying order, and all of its amount. -data HeldBalance = HeldBalance {hbSource :: RegistrationId, hbAmount :: Int} - -- | Cents left to spend, and over the balance's life the cents credited and refunded. data Balance = Balance { blRegistration :: RegistrationId, @@ -473,12 +469,16 @@ methodText = \case textMethod :: Text -> Maybe ServicePaymentMethod textMethod t = lookup t [(methodText m, m) | m <- [SPMCard CPStripe, SPMCrypto CCBtc, SPMCrypto CCXmr]] --- | A difference order's hold is written after the registration, so the registration's row is locked before the balance's. -createPaidRegistration :: DB.Connection -> NewRegistration -> OrderTerms -> PaidOrder -> Maybe HeldBalance -> UTCTime -> IO (Either RegistrationRefused ()) -createPaidRegistration db new@NewRegistration {nrgId = regId@(RegistrationId rid), nrgOwner, nrgOrder} terms PaidOrder {poMethod, poPrice, poInvoiceId = InvoiceId invId, poProviderRef} held now' = do +-- | A difference order (OTBalance) holds all of the balance seen while its invoice is open. The hold is written after the registration, +-- so the registration's row is locked before the balance's. +createPaidRegistration :: DB.Connection -> NewRegistration -> OrderTerms -> PaidOrder -> UTCTime -> IO (Either RegistrationRefused ()) +createPaidRegistration db new@NewRegistration {nrgId = regId@(RegistrationId rid), nrgOwner, nrgOrder} terms PaidOrder {poMethod, poPrice, poInvoiceId = InvoiceId invId, poProviderRef} now' = do let now = truncateToSecond now' - fromBalance = (\HeldBalance {hbSource, hbAmount} -> (hbSource, hbAmount)) <$> held - inserted <- insertRegistration db new PUnpaid poPrice (Just poMethod) Nothing fromBalance (orderHash nrgOwner nrgOrder terms) now + held = case terms of + OTBalance source _ seen _ -> Just (source, seen) + OTInvoice {} -> Nothing + OTCode _ -> Nothing + inserted <- insertRegistration db new PUnpaid poPrice (Just poMethod) Nothing held (orderHash nrgOwner nrgOrder terms) now if not inserted then pure $ Left RRLiveOrder else do @@ -486,7 +486,7 @@ createPaidRegistration db new@NewRegistration {nrgId = regId@(RegistrationId rid db "INSERT INTO sx_badge_service_name_invoices (invoice_id, registration_id, provider_ref, created_at) VALUES (?,?,?,?)" (invId, rid, poProviderRef, now) - held' <- maybe (pure True) (\HeldBalance {hbSource, hbAmount} -> holdBalance db hbSource hbAmount regId now) held + held' <- maybe (pure True) (\(source, seen) -> holdBalance db source seen regId now) held if held' then pure $ Right () else Left RRBalanceChanged <$ deleteRegistration db regId -- | Reserving the code is the conditional update of the transaction that creates the registration. diff --git a/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs b/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs index 5d77f257a7..d853b8dced 100644 --- a/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs +++ b/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs @@ -128,7 +128,7 @@ nameInvoiceHandler env@OrdersEnv {oeStore, oeTurns, oeNow} cfg providers waiters let invoice = NewNameInvoice {nniInvoiceId = invId, nniProvider = pProvider provider, nniAmount = amount, nniCurrency = catalogCurrency, nniDestination = piDestination, nniExpiresAt = addUTCTime (invoiceWindow cfg ioMethod) now, nniCreatedAt = now} registration = NewRegistration {nrgId = rid, nrgOwner = orOwner, nrgOrder = orFields, nrgYears = nYears $ oeConfig env} paid = PaidOrder {poMethod = ioMethod, poPrice = price, poInvoiceId = invId, poProviderRef = piProviderRef} - placeOrder env req [] (\db at -> insertNameInvoice db invoice >> first (const OROrderExists) <$> createPaidRegistration db registration (OTInvoice ioMethod price) paid Nothing at) + placeOrder env req [] (\db at -> insertNameInvoice db invoice >> first (const OROrderExists) <$> createPaidRegistration db registration (OTInvoice ioMethod price) paid at) `E.catch` strandedBy provider piProviderRef >>= \case Left refusal -> do diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs index 68cde59f07..e3cf572689 100644 --- a/tests/Bots/StoreService/NamesBalancesTests.hs +++ b/tests/Bots/StoreService/NamesBalancesTests.hs @@ -122,7 +122,7 @@ invoiceRow db invId card cents expiresAt = placeOrderRow :: DBStore -> Text -> Bool -> Int -> UTCTime -> IO () placeOrderRow st r card cents expiresAt = withTransaction st $ \db -> do invoiceRow db ("inv-" <> r) card cents expiresAt - createPaidRegistration db (newReg r ownerA (fieldsN r)) (OTInvoice method cents) (paidOrder ("inv-" <> r)) {poMethod = method, poPrice = cents} Nothing t0 `shouldReturn` Right () + createPaidRegistration db (newReg r ownerA (fieldsN r)) (OTInvoice method cents) (paidOrder ("inv-" <> r)) {poMethod = method, poPrice = cents} t0 `shouldReturn` Right () where method = if card then SPMCard CPStripe else btc @@ -147,7 +147,7 @@ holdTerms src seen = OTBalance (RegistrationId src) holdPrice seen (Just btc) holder :: DBStore -> Text -> Text -> Int -> UTCTime -> IO (Either RegistrationRefused ()) holder st r src seen expiresAt = withTransaction st $ \db -> do invoiceRow db ("inv-" <> r) False (holdPrice - seen) expiresAt - createPaidRegistration db (newReg r ownerA (fieldsN r)) (holdTerms src seen) (paidOrder ("inv-" <> r)) {poPrice = holdPrice} (Just $ HeldBalance (RegistrationId src) seen) t0 + createPaidRegistration db (newReg r ownerA (fieldsN r)) (holdTerms src seen) (paidOrder ("inv-" <> r)) {poPrice = holdPrice} t0 hold :: Text -> UTCTime -> Bool -> BalanceHold hold h bhUntil bhOverdue = BalanceHold {bhHolder = RegistrationId h, bhUntil, bhOverdue} @@ -458,7 +458,7 @@ testFindBalances = withServiceStore $ \st -> do rid i = "r" <> T.pack (show i) forM_ [1 .. 52 :: Int] $ \i -> withTransaction st $ \db -> do invoiceRow db ("inv-" <> rid i) False 20000 (at 60) - createPaidRegistration db (newReg (rid i) ownerA (fieldsN $ rid i)) (OTInvoice btc 20000) (paidOrder ("inv-" <> rid i)) Nothing (at i) `shouldReturn` Right () + createPaidRegistration db (newReg (rid i) ownerA (fieldsN $ rid i)) (OTInvoice btc 20000) (paidOrder ("inv-" <> rid i)) (at i) `shouldReturn` Right () credit st "r1" 5000 credit st "r2" 3000 refund st "r2" 3000 `shouldReturn` True diff --git a/tests/Bots/StoreService/NamesOrdersTests.hs b/tests/Bots/StoreService/NamesOrdersTests.hs index 32276434f7..0831e1457f 100644 --- a/tests/Bots/StoreService/NamesOrdersTests.hs +++ b/tests/Bots/StoreService/NamesOrdersTests.hs @@ -1413,7 +1413,7 @@ testViewBalance = withServiceStore $ \st -> withFakeEthNode $ \node -> do Right () <- withTransaction st $ \db -> do insertInvoiceRow db "inv-holder" holderExpiry "open" let terms = OTBalance (RegistrationId "source") 20000 15000 (Just btc) - createPaidRegistration db (newReg "holder" ownerA (order "bobsbakery" 2)) terms (paidOrder "inv-holder") (Just $ HeldBalance (RegistrationId "source") 15000) t0 + createPaidRegistration db (newReg "holder" ownerA (order "bobsbakery" 2)) terms (paidOrder "inv-holder") t0 balanceOf <$> viewOf "source" t0 `shouldReturn` (Just $ balance 15000 True (Just holderExpiry) 0, Just $ J.Number 0) balanceOf <$> viewOf "source" (addUTCTime 1 holderExpiry) `shouldReturn` (Just $ balance 15000 False Nothing 0, Just $ J.Number 0) balanceOf <$> viewOf "holder" t0 `shouldReturn` (Just J.Null, Just $ J.Number 15000) diff --git a/tests/Bots/StoreService/NamesStoreTests.hs b/tests/Bots/StoreService/NamesStoreTests.hs index 65b9f1198e..99eff9a111 100644 --- a/tests/Bots/StoreService/NamesStoreTests.hs +++ b/tests/Bots/StoreService/NamesStoreTests.hs @@ -143,7 +143,7 @@ insertInvoiceRow db invId expiresAt status = placePaid :: DBStore -> Text -> Address -> OrderFields -> UTCTime -> IO (Either RegistrationRefused ()) placePaid st rid owner o expiresAt = withTransaction st $ \db -> do insertInvoiceRow db ("inv-" <> rid) expiresAt "open" - createPaidRegistration db (newReg rid owner o) (OTInvoice btc price) (paidOrder $ "inv-" <> rid) Nothing t0 + createPaidRegistration db (newReg rid owner o) (OTInvoice btc price) (paidOrder $ "inv-" <> rid) t0 issue :: DBStore -> Word8 -> NewPrepaidCode -> IO PrepaidCode issue st n c = withTransaction st $ \db -> do @@ -417,7 +417,7 @@ testCloseOverdue = withServiceStore $ \st -> do [LiveOrder {loRegistration, loOverdue = True}] <- getLiveOrders db (ofCommitment o') ownerA (ofLabelHash o') (at 61) void $ closeOverdue db loRegistration (at 61) insertInvoiceRow db "inv-r2" (at 120) "open" - createPaidRegistration db (newReg "r2" ownerA o') (OTInvoice btc price) (paidOrder "inv-r2") Nothing (at 61) + createPaidRegistration db (newReg "r2" ownerA o') (OTInvoice btc price) (paidOrder "inv-r2") (at 61) placed `shouldBe` Right () old <- reg st "r1" (nrLive old, nrPhase old, nrVersion old) `shouldBe` (False, PUnpaid, 2) @@ -610,7 +610,7 @@ testFind = withServiceStore $ \st -> do let rid = "r" <> T.pack (show i) o = order ("alicebakery" <> T.pack (show i)) (fromIntegral i) insertInvoiceRow db ("inv-" <> rid) (at 60) "open" - createPaidRegistration db (newReg rid ownerA o) (OTInvoice btc price) (paidOrder $ "inv-" <> rid) Nothing (at i) `shouldReturn` Right () + createPaidRegistration db (newReg rid ownerA o) (OTInvoice btc price) (paidOrder $ "inv-" <> rid) (at i) `shouldReturn` Right () placePaid st "other" ownerB (order "bobsbakery" 99) (at 60) `shouldReturn` Right () found <- withTransaction st $ \db -> findRegistrations db ownerA map nrId found `shouldBe` [RegistrationId $ "r" <> T.pack (show i) | i <- [52, 51 .. 3 :: Int]]