From 98d9772b5e8e94829b4a4a4c902088beb5d64da4 Mon Sep 17 00:00:00 2001 From: shum Date: Thu, 22 Oct 2026 13:29:15 +0000 Subject: [PATCH] store: record a balance's refund --- .../src/StoreService/Names/Balances.hs | 55 +++++++++++++++++++ simplex-chat.cabal | 2 + tests/Bots/StoreService/NamesBalancesTests.hs | 28 ++++++++++ 3 files changed, 85 insertions(+) create mode 100644 apps/simplex-store-service/src/StoreService/Names/Balances.hs diff --git a/apps/simplex-store-service/src/StoreService/Names/Balances.hs b/apps/simplex-store-service/src/StoreService/Names/Balances.hs new file mode 100644 index 0000000000..52f534614d --- /dev/null +++ b/apps/simplex-store-service/src/StoreService/Names/Balances.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} + +module StoreService.Names.Balances + ( RefundRefusal (..), + RefundRecord (..), + recordRefund, + ) +where + +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction) +import StoreService.Names.Phases (RegistrationId) +import StoreService.Names.Store (Balance (..), BalanceHold, BalanceLink, balanceByReference, balanceChain, refundBalance) +import StoreService.Names.Turns (Turns, withBalanceTurn) + +-- | RefundAmount: the balance's amount now, which is not the cents given. RefundHeld: an order holds it, overdue or not, +-- since only the poller's sweep can close a holder and cancel its invoice at the provider. +data RefundRefusal = RefundNoOrder | RefundNoBalance | RefundAmount Int | RefundHeld BalanceHold + deriving (Eq, Show) + +-- | The chain names every order the money came through, for support to pay it back by the methods that paid it. +data RefundRecord = RefundRecord + { rdRegistration :: RegistrationId, + rdCents :: Int, + rdChain :: [BalanceLink] + } + deriving (Eq, Show) + +-- | The reference is the order's registration id or its name invoice's id. In the balance's turn and one transaction. +recordRefund :: Turns -> DBStore -> Text -> Int -> UTCTime -> IO (Either RefundRefusal RefundRecord) +recordRefund turns st ref cents now = + withTransaction st (\db -> balanceByReference db ref now) >>= \case + Nothing -> pure $ Left RefundNoOrder + Just (rid, _) -> withBalanceTurn turns rid $ withTransaction st refund + where + refund db = + balanceByReference db ref now >>= \case + Nothing -> pure $ Left RefundNoOrder + Just (rid, balance) -> case refusal balance of + Just r -> pure $ Left r + Nothing -> + refundBalance db rid cents now >>= \case + True -> Right . RefundRecord rid cents <$> balanceChain db rid + -- only a writer outside the turn, as a late credit, can change the balance between the read and the write + False -> Left . fromMaybe (RefundAmount cents) . refusal . (snd =<<) <$> balanceByReference db ref now + refusal :: Maybe Balance -> Maybe RefundRefusal + refusal = \case + Nothing -> Just RefundNoBalance + Just Balance {blHold = Just hold} -> Just $ RefundHeld hold + Just Balance {blAmount} + | blAmount /= cents || blAmount <= 0 -> Just $ RefundAmount blAmount + | otherwise -> Nothing diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 32dc37695a..7a4f155c39 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -443,6 +443,7 @@ executable simplex-store-service StoreService.Group.Command StoreService.Log StoreService.Names.Abi + StoreService.Names.Balances StoreService.Names.Chain StoreService.Names.Codes StoreService.Names.Contracts @@ -807,6 +808,7 @@ test-suite simplex-chat-test StoreService.Group.Command StoreService.Log StoreService.Names.Abi + StoreService.Names.Balances StoreService.Names.Chain StoreService.Names.Codes StoreService.Names.Contracts diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs index 4ba21ac5d2..7236eb839e 100644 --- a/tests/Bots/StoreService/NamesBalancesTests.hs +++ b/tests/Bots/StoreService/NamesBalancesTests.hs @@ -26,6 +26,7 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.SimplexName (labelHash) import StoreService.Config (ServiceConfig (..)) +import StoreService.Names.Balances import StoreService.Names.Orders (ClosedOrder (..), OrderRefusal (..), OrderRequest (..), OrdersEnv (..)) import qualified StoreService.Names.Orders as Orders import StoreService.Names.Phases (RegistrationId (..)) @@ -71,6 +72,8 @@ namesBalancesTests = describe "StoreService names: balances" $ do it "reads an overdue holder's hold as none, and closes it in the transaction of the order placed" testOverdueHolderClosed it "skips a named holder no longer live, and refuses with the balance when a live one cannot be closed" testNamedHolders it "keeps at the cleanup, and logs, an unpaid order still holding a balance" testCleanupKeepsHolder + describe "refunds" $ do + it "refuses no order, no balance, a balance held by an open or overdue holder, and another amount, then records one with its chain" testRecordRefund describe "late credits" $ do it "credits a late payment once per credit number, a taken number changing neither the rows nor the balance" testCreditLatePayment it "tells each case of pending money and selects confirmed money not all credited, by the order whatever the invoice's status" testLateScans @@ -506,6 +509,31 @@ testCleanupKeepsHolder = withOrders $ \Ctx {cStore = st, cWeb} -> do nrLive <$> reg st "h" `shouldReturn` True figures st "s" due `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" t0 True) +-- refunds + +testRecordRefund :: IO () +testRecordRefund = withServiceStore $ \st -> do + turns <- newTurns + waiters <- newWaiters + source st "s" 10000 + placeOrderRow st "plain" False 20000 (at 60) + holder st "h" "s" 10000 (at 60) `shouldReturn` Right () + let refundOf :: Text -> Int -> UTCTime -> IO (Either RefundRefusal RefundRecord) + refundOf ref cents now = recordRefund turns st ref cents now + refundOf "nothing" 10000 t0 `shouldReturn` Left RefundNoOrder + refundOf "plain" 20000 t0 `shouldReturn` Left RefundNoBalance + refundOf "s" 10000 t0 `shouldReturn` Left (RefundHeld $ hold "h" (at 60) False) + refundOf "inv-s" 10000 (at 61) `shouldReturn` Left (RefundHeld $ hold "h" (at 60) True) + figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" (at 60) False) + cancelOpenInvoice st waiters Nothing (InvoiceId "inv-h") (at 2) `shouldReturn` True + refundOf "s" 9000 t0 `shouldReturn` Left (RefundAmount 10000) + chain <- withTransaction st $ \db -> balanceChain db (RegistrationId "s") + chain `shouldBe` [BalanceLink {lkRegistration = RegistrationId "s", lkPayment = RPInvoice btc (InvoiceId "inv-s"), lkPaid = 10000, lkFromBalance = 0, lkLateCredits = []}] + refundOf "inv-s" 10000 t0 `shouldReturn` Right RefundRecord {rdRegistration = RegistrationId "s", rdCents = 10000, rdChain = chain} + figures st "s" t0 `shouldReturn` Just (0, 10000, 10000, Nothing) + refundOf "s" 10000 t0 `shouldReturn` Left (RefundAmount 0) + turnsCount turns `shouldReturn` 0 + -- late credits testCreditLatePayment :: IO ()