From 43bc65997d44f92063d9bc0b2b2b4d5d139f8ce5 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 14:24:22 +0000
Subject: [PATCH 01/17] store: read confirmed money and rates at providers

---
 .../src/StoreService/Providers.hs             |  34 ++-
 .../src/StoreService/Providers/BTCPay.hs      | 135 +++++++++---
 .../src/StoreService/Providers/Stripe.hs      |  20 +-
 .../btcpay/invoice-list-alien-method.json     |   4 +-
 .../btcpay/invoice-list-alien-status.json     |   4 +-
 .../btcpay/invoice-list-no-id.json            |   4 +-
 .../test-fixtures/btcpay/invoice-list.json    |   6 +-
 .../btcpay/payment-methods-btc.json           |   2 +-
 .../btcpay/payment-methods-no-amount.json     |   2 +-
 .../payment-methods-no-destination.json       |   2 +-
 .../btcpay/payment-methods-xmr.json           |   2 +-
 tests/Bots/StoreService/BTCPayTests.hs        | 205 ++++++++++++++++--
 tests/Bots/StoreService/FakeBTCPay.hs         |  60 ++++-
 tests/Bots/StoreService/StripeTests.hs        |  31 ++-
 tests/Bots/StoreService/WebTests.hs           |  26 ++-
 15 files changed, 458 insertions(+), 79 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Providers.hs b/apps/simplex-store-service/src/StoreService/Providers.hs
index c0904094c5..8e5aae52c2 100644
--- a/apps/simplex-store-service/src/StoreService/Providers.hs
+++ b/apps/simplex-store-service/src/StoreService/Providers.hs
@@ -5,6 +5,9 @@ module StoreService.Providers
   ( ProviderError (..),
     WebhookError (..),
     Received (..),
+    Confirmed (..),
+    Uncreditable (..),
+    Rate (..),
     PaymentSignal (..),
     ProviderInvoice (..),
     Funded (..),
@@ -17,10 +20,12 @@ module StoreService.Providers
 where
 
 import Data.ByteString (ByteString)
+import Data.Int (Int64)
+import Data.Scientific (Scientific)
 import Data.Text (Text)
 import Data.Time.Clock (NominalDiffTime, UTCTime)
 import Network.HTTP.Types.Header (Header)
-import Simplex.Chat.PaymentService.Types (CurrencyAmount, PaymentProvider (..), ServicePaymentDestination, ServicePaymentMethod)
+import Simplex.Chat.PaymentService.Types (CryptoCurrency, CurrencyAmount, PaymentProvider (..), ServicePaymentDestination, ServicePaymentMethod)
 
 newtype ProviderError = ProviderError Text deriving (Eq, Show)
 
@@ -29,7 +34,30 @@ data WebhookError = WebhookError Text | WebhookStale Text deriving (Eq, Show)
 
 -- rcvAmount is the total received on the invoice so far, not the amount of one payment.
 -- rcvDue is the provider's figure for what is still owed.
-data Received = Received {rcvAmount :: CurrencyAmount, rcvCrypto :: Maybe Text, rcvDue :: Maybe Text}
+-- rcvUnits is the crypto received in integer atomic units, Nothing for card money or crypto that could not be counted in them.
+-- rcvRate is the invoice's rate for crypto, as the provider wrote it.
+data Received = Received
+  { rcvAmount :: CurrencyAmount,
+    rcvCrypto :: Maybe Text,
+    rcvDue :: Maybe Text,
+    rcvUnits :: Maybe Int64,
+    rcvRate :: Maybe Text,
+    rcvConfirmed :: Confirmed,
+    rcvUncreditable :: Maybe Uncreditable
+  }
+  deriving (Eq, Show)
+
+-- | The money confirmed so far: its cents at the invoice's rate, and for crypto its atomic units.
+data Confirmed = Confirmed {cfCents :: CurrencyAmount, cfUnits :: Maybe Int64}
+  deriving (Eq, Show)
+
+-- | Why money on an invoice is never credited by itself: it was made under a policy that settles at zero confirmations,
+-- or its crypto could not be counted in atomic units. Such money confirms nothing.
+data Uncreditable = UCHighSpeed | UCUncounted
+  deriving (Eq, Show)
+
+-- | A coin's current price in the service's currency, above 0: as the provider wrote it, and as a decimal to compute with.
+data Rate = Rate {rateText :: Text, rateValue :: Scientific}
   deriving (Eq, Show)
 
 -- The provider applies its own tolerance, so this cannot be recomputed from the amounts.
@@ -77,5 +105,7 @@ data Provider = Provider
     -- Stops the provider from accepting payment for this order.
     pCancelInvoice :: Text -> IO (Either ProviderError ()),
     pListOpen :: IO (Either ProviderError ListPass),
+    -- | Nothing for a provider of card payments, which needs no rate.
+    pCurrentRate :: Maybe (CryptoCurrency -> IO (Either ProviderError Rate)),
     pVerifyWebhook :: UTCTime -> [Header] -> ByteString -> Either WebhookError (Maybe Text)
   }
diff --git a/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs b/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs
index 3b55fe1190..fef0764691 100644
--- a/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs
+++ b/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs
@@ -7,6 +7,7 @@ module StoreService.Providers.BTCPay
   ( btcpayProvider,
     btcMethodId,
     xmrMethodId,
+    unitDecimals,
     minorToDecimal,
     paymentMethodsSignal,
     listSignals,
@@ -16,22 +17,26 @@ module StoreService.Providers.BTCPay
   )
 where
 
-import StoreService.Config (BTCPayConfig (..), speedPolicyName)
+import StoreService.Catalog (catalogCurrency)
+import StoreService.Config (BTCPayConfig (..), SpeedPolicy (..), speedPolicyName)
 import StoreService.Providers
-  ( ListPass (..),
+  ( Confirmed (..),
+    ListPass (..),
     OrderDraft (..),
     PaymentSignal (..),
     Provider (..),
     ProviderError (..),
     ProviderInvoice (..),
     Funded (..),
+    Rate (..),
     Received (..),
+    Uncreditable (..),
     settleWindow,
     WebhookError (..),
   )
 import Control.Exception (try)
 import StoreService.Log (logError, logInfo, logWarn)
-import Control.Monad (unless)
+import Control.Monad (unless, (<=<))
 import Crypto.Hash (Digest, SHA256)
 import Crypto.MAC.HMAC (HMAC, hmac, hmacGetDigest)
 import qualified Data.Aeson as J
@@ -45,8 +50,8 @@ import qualified Data.ByteString.Lazy as LB
 import Data.Char (toLower)
 import Data.Int (Int64)
 import Data.List (find)
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Scientific (FPFormat (Fixed), Scientific, base10Exponent, formatScientific)
+import Data.Maybe (fromMaybe, isNothing, mapMaybe)
+import Data.Scientific (FPFormat (Fixed), Scientific, base10Exponent, formatScientific, scientific, toBoundedInteger)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
@@ -74,12 +79,35 @@ import Simplex.Chat.PaymentService.Types
   )
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
 
+-- Shapes cited from BTCPay Server v2.4.5 (https://github.com/btcpayserver/btcpayserver/tree/v2.4.5):
+-- - payment methods, GET stores/{storeId}/invoices/{invoiceId}/payment-methods: BTCPayServer.Client/Models/InvoicePaymentMethodDataModel.cs,
+--   each method's rate, paymentMethodPaid, due, amount, paymentMethodFee and payments, each payment's id, receivedDate, value, fee and
+--   status (Invalid, Processing or Settled), the decimals as strings;
+-- - an invoice's checkout.speedPolicy, GET stores/{storeId}/invoices/{invoiceId} and the list: BTCPayServer.Client/Models/InvoiceData.cs,
+--   nullable; HighSpeed settles at 0 confirmations, MediumSpeed at 1, LowMediumSpeed at 2, LowSpeed at 6
+--   (wwwroot/swagger/v1/swagger.template.json, SpeedPolicy). The Monero plugin (btcpay-monero/btcpayserver-monero-plugin v1.4.0,
+--   Plugins/Monero/Services/MoneroListener.cs, ConfirmationsRequired) maps the policies the same way, unless the store sets its own threshold;
+-- - the store's rates, GET stores/{storeId}/rates?currencyPair=BTC_USD: Controllers/GreenField/GreenfieldStoreRatesController.cs and
+--   Models/StoreRateResult.cs, a list of {currencyPair, errors, rate}, rate null when errors is not empty; it needs canviewstoresettings.
 btcMethodId, xmrMethodId :: Text
 btcMethodId = "BTC-CHAIN"
 xmrMethodId = "XMR-CHAIN"
 
+methodCurrencies :: [(Text, CryptoCurrency)]
+methodCurrencies = [(btcMethodId, CCBtc), (xmrMethodId, CCXmr)]
+
 knownMethodIds :: [Text]
-knownMethodIds = [btcMethodId, xmrMethodId]
+knownMethodIds = map fst methodCurrencies
+
+-- | The decimals of each coin's atomic unit: satoshi and piconero.
+unitDecimals :: CryptoCurrency -> Int
+unitDecimals = \case
+  CCBtc -> 8
+  CCXmr -> 12
+
+-- | The policies that settle a payment only after at least one confirmation.
+confirmingPolicies :: [SpeedPolicy]
+confirmingPolicies = [MediumSpeed, LowMediumSpeed, LowSpeed]
 
 -- The last two are the only events a payment into a closed invoice sends.
 actedOnEventTypes :: [Text]
@@ -148,6 +176,7 @@ data GInvoice = GInvoice
   { giId :: Text,
     giStatus :: Text,
     giAdditionalStatus :: Maybe Text,
+    giSpeedPolicy :: Maybe Text,
     giPaymentMethods :: Maybe [GPaymentMethod]
   }
   deriving (Show)
@@ -158,6 +187,7 @@ instance J.FromJSON GInvoice where
       <$> o J..: "id"
       <*> o J..: "status"
       <*> o J..:? "additionalStatus"
+      <*> (maybe (pure Nothing) (J..:? "speedPolicy") =<< o J..:? "checkout")
       <*> o J..:? "paymentMethods"
 
 -- totalPaid is not decoded because it counts every method's payment in this currency, so it is non-zero
@@ -184,15 +214,27 @@ instance J.FromJSON GPaymentMethod where
       <*> o J..:? "due"
       <*> (fromMaybe [] <$> o J..:? "payments")
 
+-- | A payment without a value is read, and only its units cannot be counted.
 data GPayment = GPayment
   { gpStatus :: Text,
-    gpReceivedDate :: WireNum
+    gpReceivedDate :: WireNum,
+    gpValue :: Maybe WireNum
   }
   deriving (Show)
 
 instance J.FromJSON GPayment where
   parseJSON = J.withObject "payment" $ \o ->
-    GPayment <$> o J..: "status" <*> o J..: "receivedDate"
+    GPayment <$> o J..: "status" <*> o J..: "receivedDate" <*> o J..:? "value"
+
+data GRate = GRate
+  { grPair :: Text,
+    grErrors :: [Text],
+    grRate :: Maybe WireNum
+  }
+
+instance J.FromJSON GRate where
+  parseJSON = J.withObject "store rate" $ \o ->
+    GRate <$> o J..: "currencyPair" <*> (fromMaybe [] <$> o J..:? "errors") <*> o J..:? "rate"
 
 newtype GCreated = GCreated {gcId :: Text}
   deriving (Show)
@@ -226,6 +268,7 @@ btcpayProvider cfg = do
         pReadInvoice = readInvoice env,
         pCancelInvoice = cancelInvoice env,
         pListOpen = listOpen env,
+        pCurrentRate = Just (currentRate env),
         pVerifyWebhook = const (verifyBTCPaySig (bWebhookSecret cfg))
       }
 
@@ -305,11 +348,11 @@ readInvoice env ref = do
   inv <- greenfield env what methodGet ["invoices", ref] [] Nothing
   case inv >>= decodeGreenfield what of
     Left e -> pure (Left e)
-    Right GInvoice {giStatus, giAdditionalStatus} -> do
+    Right GInvoice {giStatus, giAdditionalStatus, giSpeedPolicy} -> do
       logAdditionalStatus ref giAdditionalStatus
       ms <- greenfield env what methodGet ["invoices", ref, "payment-methods"] [] Nothing
       now <- getCurrentTime
-      pure (ms >>= paymentMethodsSignal now ref giStatus)
+      pure (ms >>= paymentMethodsSignal now ref giStatus giSpeedPolicy)
   where
     what = "read invoice"
 
@@ -356,11 +399,11 @@ invoicesPass now invs = foldr add (Right ListPass {lpMoved = [], lpSkipped = []}
     add v (Right pass) = case J.fromJSON v of
       J.Error e -> Right pass {lpSkipped = (invoiceIdOf v, T.pack e) : lpSkipped pass}
       J.Success gi -> addInvoice gi pass
-    addInvoice GInvoice {giId, giStatus, giPaymentMethods} pass = case giPaymentMethods of
+    addInvoice GInvoice {giId, giStatus, giSpeedPolicy, giPaymentMethods} pass = case giPaymentMethods of
       Nothing ->
         Left . ProviderError $
           listWhat <> ": invoice " <> giId <> " carries no paymentMethods, so includePaymentMethods was not honoured"
-      Just ms -> case invoiceSignal now giId giStatus ms of
+      Just ms -> case invoiceSignal now giId giStatus giSpeedPolicy ms of
         Left (ProviderError e) -> Right pass {lpSkipped = (Just giId, e) : lpSkipped pass}
         Right Nothing -> Right pass
         Right (Just sig) -> Right pass {lpMoved = (giId, sig) : lpMoved pass}
@@ -377,17 +420,20 @@ logAdditionalStatus ref = \case
   Just s | s /= "None" -> logInfo ("btcpay: invoice " <> ref <> " additionalStatus " <> s)
   _ -> pure ()
 
-paymentMethodsSignal :: UTCTime -> Text -> Text -> LB.ByteString -> Either ProviderError (Maybe PaymentSignal)
-paymentMethodsSignal now ref status body =
-  decodeGreenfield "read invoice" body >>= invoiceSignal now ref status
+-- | The status and speed policy are the invoice's, the body its payment methods.
+paymentMethodsSignal :: UTCTime -> Text -> Text -> Maybe Text -> LB.ByteString -> Either ProviderError (Maybe PaymentSignal)
+paymentMethodsSignal now ref status policy body =
+  decodeGreenfield "read invoice" body >>= invoiceSignal now ref status policy
 
 -- Complete is the old API's status name and never matches, so it has no case here.
-invoiceSignal :: UTCTime -> Text -> Text -> [GPaymentMethod] -> Either ProviderError (Maybe PaymentSignal)
-invoiceSignal now ref status ms = do
-  m@GPaymentMethod {gpmRate, gpmPaid, gpmDue} <- chooseMethod ref ms
+invoiceSignal :: UTCTime -> Text -> Text -> Maybe Text -> [GPaymentMethod] -> Either ProviderError (Maybe PaymentSignal)
+invoiceSignal now ref status policy ms = do
+  (m@GPaymentMethod {gpmRate, gpmPaid, gpmDue, gpmPayments}, cc) <- chooseMethod ref ms
   rate <- priced "rate" gpmRate
   paid <- priced "paymentMethodPaid" gpmPaid
-  let received = receivedOf rate paid gpmDue
+  let decimals = unitDecimals cc
+      confirming = maybe False (`elem` map speedPolicyName confirmingPolicies) policy
+      received = receivedOf decimals confirming (status == "Settled") rate paid gpmDue gpmPayments
   case status of
     "Settled" -> Right (Just (SigSettled received (fromMaybe now (latestSettledAt m))))
     "Processing" -> Right (Just (SigFunded received PaidInFull))
@@ -399,9 +445,9 @@ invoiceSignal now ref status ms = do
     priced field =
       maybe (Left (ProviderError ("btcpay invoice " <> ref <> ": its payment method carries no " <> field))) Right
 
-chooseMethod :: Text -> [GPaymentMethod] -> Either ProviderError GPaymentMethod
-chooseMethod ref ms = case filter ((`elem` knownMethodIds) . gpmId) ms of
-  m : _ -> Right m
+chooseMethod :: Text -> [GPaymentMethod] -> Either ProviderError (GPaymentMethod, CryptoCurrency)
+chooseMethod ref ms = case [(m, cc) | m <- ms, Just cc <- [lookup (gpmId m) methodCurrencies]] of
+  known : _ -> Right known
   [] ->
     Left . ProviderError $
       "btcpay invoice "
@@ -427,13 +473,52 @@ findMethod what ref methodId body = do
           <> T.intercalate ", " (map gpmId ms)
           <> "]"
 
-receivedOf :: WireNum -> WireNum -> Maybe WireNum -> Received
-receivedOf rate paid due =
+-- | The confirmed crypto shares paymentMethodPaid's basis, whatever it nets out: all of it once the invoice or every payment is Settled,
+-- else the Settled payments' value capped at it. An amount with a non-zero digit past its unit leaves every figure in units out.
+receivedOf :: Int -> Bool -> Bool -> WireNum -> WireNum -> Maybe WireNum -> [GPayment] -> Received
+receivedOf decimals confirming invoiceSettled rate paid due payments =
   Received
     { rcvAmount = toMinorUnits (wnValue paid * wnValue rate),
       rcvCrypto = if wnValue paid > 0 then Just (wnText paid) else Nothing,
-      rcvDue = wnText <$> due
+      rcvDue = wnText <$> due,
+      rcvUnits = fst <$> counted,
+      rcvRate = Just (wnText rate),
+      rcvConfirmed = case uncreditable of
+        Nothing -> Confirmed {cfCents = toMinorUnits (scientific (maybe 0 (toInteger . snd) counted) (negate decimals) * wnValue rate), cfUnits = snd <$> counted}
+        Just _ -> Confirmed {cfCents = CurrencyAmount 0, cfUnits = Just 0},
+      rcvUncreditable = uncreditable
     }
+  where
+    settled = filter ((== "Settled") . gpStatus) payments
+    allSettled = invoiceSettled || (not (null payments) && length settled == length payments)
+    counted = do
+      paidUnits <- toUnits (wnValue paid)
+      settledUnits <- mapM (toUnits . wnValue <=< gpValue) settled
+      pure (paidUnits, if allSettled then paidUnits else fromInteger (min (toInteger paidUnits) (sum (map toInteger settledUnits))))
+    uncreditable
+      | isNothing counted = Just UCUncounted
+      | not confirming = Just UCHighSpeed
+      | otherwise = Nothing
+    toUnits v
+      | v < 0 = Nothing
+      | otherwise = toBoundedInteger (v * scientific 1 decimals) :: Maybe Int64
+
+-- | Of the coin against the catalog's currency, as the invoices are priced, so it compares with an invoice's rate.
+currentRate :: BTCPayEnv -> CryptoCurrency -> IO (Either ProviderError Rate)
+currentRate env cc = (>>= rateOf) <$> greenfield env what methodGet ["rates"] [("currencyPair", Just (TE.encodeUtf8 pair))] Nothing
+  where
+    what = "read rate " <> pair
+    pair = coinCode <> "_" <> T.toUpper catalogCurrency
+    coinCode = case cc of
+      CCBtc -> "BTC"
+      CCXmr -> "XMR"
+    rateOf body = do
+      rates :: [GRate] <- decodeGreenfield what body
+      GRate {grErrors, grRate} <- maybe (failed "the answer has no such pair") Right (find ((== pair) . grPair) rates)
+      unless (null grErrors) $ failed (T.intercalate "; " grErrors)
+      WireNum {wnText, wnValue} <- maybe (failed "no rate") Right grRate
+      if wnValue > 0 then Right Rate {rateText = wnText, rateValue = wnValue} else failed ("the rate " <> wnText <> " is not above 0")
+    failed e = Left (ProviderError (what <> ": " <> e))
 
 -- Clamp stops a wildly wrong figure wrapping Word32 and coming out small.
 toMinorUnits :: Scientific -> CurrencyAmount
diff --git a/apps/simplex-store-service/src/StoreService/Providers/Stripe.hs b/apps/simplex-store-service/src/StoreService/Providers/Stripe.hs
index aff7100cf7..562ba52fe7 100644
--- a/apps/simplex-store-service/src/StoreService/Providers/Stripe.hs
+++ b/apps/simplex-store-service/src/StoreService/Providers/Stripe.hs
@@ -12,7 +12,8 @@ where
 
 import StoreService.Config (StripeConfig (..))
 import StoreService.Providers
-  ( ListPass (..),
+  ( Confirmed (..),
+    ListPass (..),
     OrderDraft (..),
     PaymentSignal (..),
     Provider (..),
@@ -121,6 +122,7 @@ stripeProvider cfg = do
         pReadInvoice = readInvoice env,
         pCancelInvoice = cancelInvoice env,
         pListOpen = listOpen env,
+        pCurrentRate = Nothing,
         pVerifyWebhook = verifyStripeSig (sWebhookSecret cfg)
       }
 
@@ -263,13 +265,23 @@ readInvoice env pid = do
 signalOf :: UTCTime -> IntentRead -> Either ProviderError (Maybe PaymentSignal)
 signalOf now IntentRead {irStatus, irAmountReceived, irChargeCreated} =
   case irStatus of
-    "succeeded" -> Right (Just (SigSettled (received irAmountReceived) settledAt))
-    "canceled" -> Right (Just (SigClosed (received 0)))
+    "succeeded" -> Right (Just (SigSettled (received irAmountReceived irAmountReceived) settledAt))
+    "canceled" -> Right (Just (SigClosed (received 0 0)))
     s | s `elem` openStatuses -> Right Nothing
       | otherwise -> Left (ProviderError ("stripe payment_intent: unknown status " <> s))
   where
     openStatuses = ["requires_payment_method", "requires_confirmation", "requires_action", "processing", "requires_capture"]
-    received amt = Received {rcvAmount = amountFrom amt, rcvCrypto = Nothing, rcvDue = Nothing}
+    -- only a succeeded intent's money is confirmed
+    received amt confirmed =
+      Received
+        { rcvAmount = amountFrom amt,
+          rcvCrypto = Nothing,
+          rcvDue = Nothing,
+          rcvUnits = Nothing,
+          rcvRate = Nothing,
+          rcvConfirmed = Confirmed {cfCents = amountFrom confirmed, cfUnits = Nothing},
+          rcvUncreditable = Nothing
+        }
     settledAt = maybe now posixSecondsToUTCTime irChargeCreated
 
 -- Clamp stops a wildly wrong figure wrapping Word32 and coming out small.
diff --git a/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-alien-method.json b/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-alien-method.json
index 3339eb44a8..1a6eeb2c5d 100644
--- a/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-alien-method.json
+++ b/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-alien-method.json
@@ -49,7 +49,7 @@
           "totalPaid": "9.99999999",
           "due": "0.00000000",
           "amount": "0.00050000",
-          "networkFee": "0.00000500",
+          "paymentMethodFee": "0.00000500",
           "activated": true,
           "payments": [
             {
@@ -113,7 +113,7 @@
           "totalPaid": "9.99999999",
           "due": "0.00000000",
           "amount": "0.00050000",
-          "networkFee": "0.00000500",
+          "paymentMethodFee": "0.00000500",
           "activated": true,
           "payments": [
             {
diff --git a/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-alien-status.json b/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-alien-status.json
index 28aad30892..017e879493 100644
--- a/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-alien-status.json
+++ b/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-alien-status.json
@@ -49,7 +49,7 @@
           "totalPaid": "9.99999999",
           "due": "0.00000000",
           "amount": "0.00050000",
-          "networkFee": "0.00000500",
+          "paymentMethodFee": "0.00000500",
           "activated": true,
           "payments": [
             {
@@ -113,7 +113,7 @@
           "totalPaid": "9.99999999",
           "due": "0.00000000",
           "amount": "0.00050000",
-          "networkFee": "0.00000500",
+          "paymentMethodFee": "0.00000500",
           "activated": true,
           "payments": [
             {
diff --git a/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-no-id.json b/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-no-id.json
index 9a8ed8c97f..cd19e8d26b 100644
--- a/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-no-id.json
+++ b/apps/simplex-store-service/test-fixtures/btcpay/invoice-list-no-id.json
@@ -49,7 +49,7 @@
           "totalPaid": "9.99999999",
           "due": "0.00000000",
           "amount": "0.00050000",
-          "networkFee": "0.00000500",
+          "paymentMethodFee": "0.00000500",
           "activated": true,
           "payments": [
             {
@@ -112,7 +112,7 @@
           "totalPaid": "9.99999999",
           "due": "0.00000000",
           "amount": "0.00050000",
-          "networkFee": "0.00000500",
+          "paymentMethodFee": "0.00000500",
           "activated": true,
           "payments": [
             {
diff --git a/apps/simplex-store-service/test-fixtures/btcpay/invoice-list.json b/apps/simplex-store-service/test-fixtures/btcpay/invoice-list.json
index 95d477f14f..0672dd9e88 100644
--- a/apps/simplex-store-service/test-fixtures/btcpay/invoice-list.json
+++ b/apps/simplex-store-service/test-fixtures/btcpay/invoice-list.json
@@ -49,7 +49,7 @@
           "totalPaid": "9.99999999",
           "due": "0.00000000",
           "amount": "0.00050000",
-          "networkFee": "0.00000500",
+          "paymentMethodFee": "0.00000500",
           "activated": true,
           "payments": [
             {
@@ -113,7 +113,7 @@
           "totalPaid": "9.99999999",
           "due": "0.00000000",
           "amount": "0.32095000",
-          "networkFee": "0.00000500",
+          "paymentMethodFee": "0.00000500",
           "activated": true,
           "payments": [
             {
@@ -177,7 +177,7 @@
           "totalPaid": "0.00000000",
           "due": "0.00050000",
           "amount": "0.00050000",
-          "networkFee": "0.00000500",
+          "paymentMethodFee": "0.00000500",
           "activated": true,
           "payments": [],
           "additionalData": {}
diff --git a/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-btc.json b/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-btc.json
index 83c03dcfd4..952ffb66ac 100644
--- a/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-btc.json
+++ b/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-btc.json
@@ -11,7 +11,7 @@
       "totalPaid": "9.99999999",
       "due": "0.00000000",
       "amount": "0.00050000",
-      "networkFee": "0.00000500",
+      "paymentMethodFee": "0.00000500",
       "activated": true,
       "payments": [
         {
diff --git a/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-no-amount.json b/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-no-amount.json
index d1c4129ce2..59b51638bc 100644
--- a/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-no-amount.json
+++ b/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-no-amount.json
@@ -10,7 +10,7 @@
       "paymentMethodPaid": "0.00000000",
       "totalPaid": "0.00000000",
       "due": "0.00050000",
-      "networkFee": "0.00000500",
+      "paymentMethodFee": "0.00000500",
       "activated": true,
       "payments": [],
       "additionalData": {}
diff --git a/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-no-destination.json b/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-no-destination.json
index 4dc67e6170..4ca3d37bdb 100644
--- a/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-no-destination.json
+++ b/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-no-destination.json
@@ -9,7 +9,7 @@
       "totalPaid": "0.00000000",
       "due": "0.00050000",
       "amount": "0.00050000",
-      "networkFee": "0.00000500",
+      "paymentMethodFee": "0.00000500",
       "activated": false,
       "payments": [],
       "additionalData": {}
diff --git a/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-xmr.json b/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-xmr.json
index c68256f3d7..e825040420 100644
--- a/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-xmr.json
+++ b/apps/simplex-store-service/test-fixtures/btcpay/payment-methods-xmr.json
@@ -11,7 +11,7 @@
       "totalPaid": "9.99999999",
       "due": "0.00000000",
       "amount": "0.32095000",
-      "networkFee": "0.00000500",
+      "paymentMethodFee": "0.00000500",
       "activated": true,
       "payments": [
         {
diff --git a/tests/Bots/StoreService/BTCPayTests.hs b/tests/Bots/StoreService/BTCPayTests.hs
index 268faca7e8..bfee4427f0 100644
--- a/tests/Bots/StoreService/BTCPayTests.hs
+++ b/tests/Bots/StoreService/BTCPayTests.hs
@@ -14,14 +14,18 @@ import StoreService.Providers
     Provider (..),
     ProviderError (..),
     ProviderInvoice (..),
+    Rate (..),
     Received (..),
+    Confirmed (..),
+    Uncreditable (..),
     WebhookError (..),
     settleWindow,
   )
 import StoreService.Providers.BTCPay (btcMethodId, btcpayProvider, listSignals, minorToDecimal, paymentMethodsSignal, verifyBTCPaySig, xmrMethodId)
+import StoreService.Config (SpeedPolicy (..))
 import Bots.StoreService.FakeBTCPay
 import Control.Exception (evaluate)
-import Control.Monad (join)
+import Control.Monad (forM_, join)
 import Data.Aeson ((.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.KeyMap as KM
@@ -29,6 +33,8 @@ import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Lazy as LB
 import Data.Char (toUpper)
 import Data.Foldable (toList)
+import Data.Int (Int64)
+import Data.Word (Word32)
 import Data.Scientific (Scientific, scientific)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -71,6 +77,14 @@ badgeBTCPayTests = describe "badge btcpay adapter" $ do
     it "keeps the crypto amount exactly as the provider wrote it" testCryptoAmountVerbatim
     it "multiplies the decimals exactly, where a Double would be a cent out" testExactDecimalMultiplication
     it "reads a numeric field sent as a JSON number as well as a string" testNumberAsWellAsString
+  describe "confirmed money" $ do
+    it "confirms all of paymentMethodPaid on an invoice-level Settled, with a payment still Processing" testConfirmedInvoiceSettled
+    it "confirms all of paymentMethodPaid when every payment reads Settled, whatever their values" testConfirmedAllSettled
+    it "confirms the Settled payments' value otherwise, rounded to cents once and capped at paymentMethodPaid" testConfirmedSettledSum
+    it "counts BTC in satoshi and XMR in piconero" testConfirmedUnits
+    it "confirms nothing under HighSpeed, or with no or an unknown speed policy, an invoice-level Settled included" testHighSpeedConfirmsNothing
+    it "accepts trailing zeros past the unit" testTrailingZeros
+    it "drops only the units of an amount with a non-zero digit past its unit, the signal and its cents as before" testDigitPastUnit
   describe "the list pass" $ do
     it "skips an invoice whose status it does not know, and settles the rest" testListSkipsUnknownStatus
     it "skips an invoice it cannot parse, and settles the rest" testListSkipsUnparseable
@@ -106,7 +120,11 @@ badgeBTCPayTests = describe "badge btcpay adapter" $ do
     it "makes a 500 on a read a ProviderError the next read recovers from" testFakeRead500
     it "verifies a webhook with the secret it was configured with" testFakeWebhookSecretWiring
     it "keeps totalPaid distinguishable in every fixture an amount is asserted from" testFixturesGuardTotalPaid
-    it "keeps due distinguishable from networkFee, so the wrong field cannot be read" testFixturesGuardDue
+    it "keeps due distinguishable from paymentMethodFee, so the wrong field cannot be read" testFixturesGuardDue
+  describe "rates and speed policies against the fake Greenfield" $ do
+    it "reads the store's rate for the coin against the catalog's currency" testFakeRate
+    it "refuses a failed read, a missing pair, a rate with errors, a null rate and a rate at or below 0" testFakeRateRefusals
+    it "reads the speed policy an invoice was made under, whatever the configuration says now" testFakeInvoicePolicy
   describe "the list pass against the fake Greenfield" $ do
     it "returns the invoices whose state moved and omits the one that did not" testFakeListMoved
     it "bounds the request at 72 hours plus one invoice window" testFakeListWindow
@@ -115,6 +133,81 @@ badgeBTCPayTests = describe "badge btcpay adapter" $ do
     it "fails the pass when the payment methods are absent" testFakeListNoPaymentMethods
     it "skips an invoice it cannot even name, unaccounted for" testFakeListNoId
 
+-- | A payment of the value given, as the methods body lists it.
+paymentOf :: Text -> Text -> J.Value
+paymentOf status value =
+  J.object
+    [ "id" .= ("txid-" <> value),
+      "status" .= status,
+      "receivedDate" .= (1700000000 :: Int),
+      "value" .= value,
+      "fee" .= ("0.00000100" :: Text)
+    ]
+
+xmrPaid :: Text -> [J.Value] -> J.Value
+xmrPaid paid payments =
+  J.object
+    [ "paymentMethodId" .= xmrMethodId,
+      "destination" .= ("44AFFq5kSiGBoZ4NMDwYtN18obc8AemS33DBLWs3H7otXft3XjrpDtQGv7SqSsaBYBb98uNbr2VBBEt7f2wfn3RVGQBEP3A" :: Text),
+      "amount" .= ("0.32095000" :: Text),
+      "rate" .= ("168.25" :: Text),
+      "paymentMethodPaid" .= paid,
+      "due" .= ("0.00000000" :: Text),
+      "payments" .= payments
+    ]
+
+testConfirmedInvoiceSettled :: IO ()
+testConfirmedInvoiceSettled =
+  signalOf "Settled" [btcPaid "0.00050000" [paymentOf "Settled" "0.00025000", paymentOf "Processing" "0.00025000"]]
+    `shouldBe` Right (Just (SigSettled halfMilliBtc (posixSecondsToUTCTime 1700000000)))
+
+-- | The values sum to more than paymentMethodPaid, as a fee BTCPay nets out would; all of it is confirmed, never more.
+testConfirmedAllSettled :: IO ()
+testConfirmedAllSettled =
+  signalOf "Processing" [btcPaid "0.00049800" [paymentOf "Settled" "0.00025000", paymentOf "Settled" "0.00025000"]]
+    `shouldBe` Right (Just (SigFunded (btcReceived 5378 (Just "0.00049800") "0.00050000" 49800 49800 5378) PaidInFull))
+
+-- | 5 + 5 satoshi are 0.54 + 0.54 cents, 2 cents rounded one by one but 1 rounded once.
+testConfirmedSettledSum :: IO ()
+testConfirmedSettledSum = do
+  signalOf "Processing" [btcPaid "0.00000015" (map (paymentOf "Settled") ["0.00000005", "0.00000005"] <> [paymentOf "Processing" "0.00000005"])]
+    `shouldBe` Right (Just (SigFunded (btcReceived 2 (Just "0.00000015") "0.00050000" 15 10 1) PaidInFull))
+  signalOf "Processing" [btcPaid "0.00050000" [paymentOf "Settled" "0.00030000", paymentOf "Settled" "0.00030000", paymentOf "Processing" "0.00010000"]]
+    `shouldBe` Right (Just (SigFunded halfMilliBtc PaidInFull))
+
+testConfirmedUnits :: IO ()
+testConfirmedUnits = do
+  (rcvUnitsOf =<<) <$> signalOf "Settled" [btcPaid "0.00050000" []] `shouldBe` Right (Just 50000)
+  signalOf "Settled" [xmrPaid "0.32095000" [paymentOf "Settled" "0.32095000"]]
+    `shouldBe` Right (Just (SigSettled xmrReceived {rcvConfirmed = Confirmed {cfCents = CurrencyAmount 5400, cfUnits = Just 320950000000}} (posixSecondsToUTCTime 1700000000)))
+
+rcvUnitsOf :: PaymentSignal -> Maybe Int64
+rcvUnitsOf = \case
+  SigFunded r _ -> rcvUnits r
+  SigSettled r _ -> rcvUnits r
+  SigClosed r -> rcvUnits r
+
+testHighSpeedConfirmsNothing :: IO ()
+testHighSpeedConfirmsNothing = do
+  let settledUnder policy = signalUnder policy "Settled" [btcPaid "0.00050000" [paymentOf "Settled" "0.00050000"]]
+      unconfirmed = halfMilliBtcUnconfirmed {rcvUncreditable = Just UCHighSpeed}
+  mapM_ (\policy -> (policy, settledUnder policy) `shouldBe` (policy, Right (Just (SigSettled unconfirmed (posixSecondsToUTCTime 1700000000))))) [Just "HighSpeed", Nothing, Just "Turbo"]
+  mapM_ (\policy -> (policy, settledUnder policy) `shouldBe` (policy, Right (Just (SigSettled halfMilliBtc (posixSecondsToUTCTime 1700000000))))) [Just "MediumSpeed", Just "LowMediumSpeed", Just "LowSpeed"]
+
+testTrailingZeros :: IO ()
+testTrailingZeros =
+  signalOf "Settled" [btcPaid "0.000500000000" [paymentOf "Settled" "0.0005000000000"]]
+    `shouldBe` Right (Just (SigSettled halfMilliBtc {rcvCrypto = Just "0.000500000000", rcvDue = Just "0.00050000"} (posixSecondsToUTCTime 1700000000)))
+
+-- | A badge invoice reads and settles on this signal as before; only a late credit needs the units.
+testDigitPastUnit :: IO ()
+testDigitPastUnit = do
+  let uncounted crypto due = halfMilliBtcUnconfirmed {rcvCrypto = Just crypto, rcvDue = Just due, rcvUnits = Nothing, rcvUncreditable = Just UCUncounted}
+  signalOf "Settled" [btcPaid "0.000500001" [paymentOf "Settled" "0.000500001"]]
+    `shouldBe` Right (Just (SigSettled (uncounted "0.000500001" "0.00050000") (posixSecondsToUTCTime 1700000000)))
+  signalOf "Processing" [btcPaid "0.00050000" [paymentOf "Settled" "0.000250001", paymentOf "Processing" "0.00025000"]]
+    `shouldBe` Right (Just (SigFunded (uncounted "0.00050000" "0.00000000") PaidInFull))
+
 testMinorToDecimal :: IO ()
 testMinorToDecimal =
   map (minorToDecimal . CurrencyAmount) [0, 5, 99, 100, 700, 4200, 42000, 100000000]
@@ -136,7 +229,7 @@ btcPaid paid payments =
       "paymentMethodPaid" .= paid,
       "totalPaid" .= ("9.99999999" :: Text),
       "due" .= dueAfter paid,
-      "networkFee" .= ("0.00000500" :: Text),
+      "paymentMethodFee" .= ("0.00000500" :: Text),
       "payments" .= payments
     ]
 
@@ -163,13 +256,33 @@ methodsBody :: [J.Value] -> LB.ByteString
 methodsBody = J.encode
 
 signalOf :: Text -> [J.Value] -> Either ProviderError (Maybe PaymentSignal)
-signalOf status methods = paymentMethodsSignal readTime ref status (methodsBody methods)
+signalOf = signalUnder (Just "MediumSpeed")
+
+-- | Read from an invoice made under the speed policy given, or none.
+signalUnder :: Maybe Text -> Text -> [J.Value] -> Either ProviderError (Maybe PaymentSignal)
+signalUnder policy status methods = paymentMethodsSignal readTime ref status policy (methodsBody methods)
+
+-- | BTC at the rate the bodies carry: the cents, crypto and due received, and the satoshi received and confirmed, with the confirmed cents.
+btcReceived :: Word32 -> Maybe Text -> Text -> Int64 -> Int64 -> Word32 -> Received
+btcReceived cents crypto due units confirmedUnits confirmedCents =
+  Received
+    { rcvAmount = CurrencyAmount cents,
+      rcvCrypto = crypto,
+      rcvDue = Just due,
+      rcvUnits = Just units,
+      rcvRate = Just "108000.12",
+      rcvConfirmed = Confirmed {cfCents = CurrencyAmount confirmedCents, cfUnits = Just confirmedUnits},
+      rcvUncreditable = Nothing
+    }
 
 halfMilliBtc :: Received
-halfMilliBtc = Received {rcvAmount = CurrencyAmount 5400, rcvCrypto = Just "0.00050000", rcvDue = Just "0.00000000"}
+halfMilliBtc = btcReceived 5400 (Just "0.00050000") "0.00000000" 50000 50000 5400
+
+halfMilliBtcUnconfirmed :: Received
+halfMilliBtcUnconfirmed = halfMilliBtc {rcvConfirmed = Confirmed {cfCents = CurrencyAmount 0, cfUnits = Just 0}}
 
 nothingReceived :: Text -> Received
-nothingReceived due = Received {rcvAmount = CurrencyAmount 0, rcvCrypto = Nothing, rcvDue = Just due}
+nothingReceived due = btcReceived 0 Nothing due 0 0 0
 
 testSettled :: IO ()
 testSettled =
@@ -184,24 +297,24 @@ testSettledManuallyMarked =
 testProcessing :: IO ()
 testProcessing =
   signalOf "Processing" [btcPaid "0.00050000" [payment "Processing" 1700000000]]
-    `shouldBe` Right (Just (SigFunded halfMilliBtc PaidInFull))
+    `shouldBe` Right (Just (SigFunded halfMilliBtcUnconfirmed PaidInFull))
 
 testClosed :: IO ()
 testClosed = do
   signalOf "Expired" [btcPaid "0.00050000" [payment "Processing" 1700000000]]
-    `shouldBe` Right (Just (SigClosed halfMilliBtc))
+    `shouldBe` Right (Just (SigClosed halfMilliBtcUnconfirmed))
   signalOf "Invalid" [btcPaid "0.00000000" []]
     `shouldBe` Right (Just (SigClosed (nothingReceived "0.00050000")))
 
 testNewWithPayment :: IO ()
 testNewWithPayment =
   signalOf "New" [btcPaid "0.00050000" [payment "Processing" 1700000000]]
-    `shouldBe` Right (Just (SigFunded halfMilliBtc PaidInPart))
+    `shouldBe` Right (Just (SigFunded halfMilliBtcUnconfirmed PaidInPart))
 
 testNewWithDust :: IO ()
 testNewWithDust =
   signalOf "New" [btcPaid "0.00000001" [payment "Processing" 1700000000]]
-    `shouldBe` Right (Just (SigFunded Received {rcvAmount = CurrencyAmount 0, rcvCrypto = Just "0.00000001", rcvDue = Just "0.00050499"} PaidInPart))
+    `shouldBe` Right (Just (SigFunded (btcReceived 0 (Just "0.00000001") "0.00050499" 1 0 0) PaidInPart))
 
 testNewWithNothing :: IO ()
 testNewWithNothing = signalOf "New" [btcPaid "0.00000000" []] `shouldBe` Right Nothing
@@ -229,7 +342,7 @@ testAbsurdExponentAsANumberIsRefused = do
             "rate" .= ("108000.12" :: Text),
             "paymentMethodPaid" .= ("0.00050000" :: Text),
             "due" .= ("0.00000000" :: Text),
-            "networkFee" .= ("0.00000500" :: Text),
+            "paymentMethodFee" .= ("0.00000500" :: Text),
             "payments" .= ([] :: [J.Value])
           ]
   answered <- timeout 5000000 (evaluate (signalOf "Settled" [method]))
@@ -251,7 +364,7 @@ testLongRateIsAccepted =
           "rate" .= ("0.3333333333333333333333333333" :: Text),
           "paymentMethodPaid" .= ("0.00050000" :: Text),
           "due" .= ("0.00000000" :: Text),
-          "networkFee" .= ("0.00000500" :: Text),
+          "paymentMethodFee" .= ("0.00000500" :: Text),
           "payments" .= ([] :: [J.Value])
         ]
 
@@ -271,7 +384,7 @@ testUnknownPaymentMethod = do
 
 testUnreadableResponse :: IO ()
 testUnreadableResponse =
-  paymentMethodsSignal readTime ref "Settled" "<html>502 Bad Gateway</html>" `shouldSatisfy` namesInError "could not read the response"
+  paymentMethodsSignal readTime ref "Settled" (Just "MediumSpeed") "<html>502 Bad Gateway</html>" `shouldSatisfy` namesInError "could not read the response"
 
 namesInError :: Text -> Either ProviderError a -> Bool
 namesInError what = \case
@@ -285,7 +398,8 @@ listEntry invId status methods =
       "status" .= status,
       "additionalStatus" .= ("None" :: Text),
       "amount" .= ("54.00" :: Text),
-      "currency" .= ("USD" :: Text)
+      "currency" .= ("USD" :: Text),
+      "checkout" .= J.object ["speedPolicy" .= ("MediumSpeed" :: Text)]
     ]
       <> maybe [] (\ms -> ["paymentMethods" .= ms]) methods
 
@@ -328,7 +442,7 @@ testListSkipsUnparseable = do
             "rate" .= ("108000.12" :: Text),
             "paymentMethodPaid" .= ("0.00050000" :: Text),
             "due" .= ("0.00000000" :: Text),
-            "networkFee" .= ("0.00000500" :: Text),
+            "paymentMethodFee" .= ("0.00000500" :: Text),
             "payments" .= [J.object ["receivedDate" .= (1700000000 :: Int)]]
           ]
       broken = listEntry "MALFORMEDINVOICE" "Settled" (Just [noStatus])
@@ -418,7 +532,7 @@ testNumberAsWellAsString = do
   let asNumbers =
         "[{\"paymentMethodId\":\"BTC-CHAIN\",\"rate\":108000.12,\"paymentMethodPaid\":0.00050000,\
         \\"payments\":[{\"status\":\"Settled\",\"receivedDate\":1700000000}]}]"
-  case paymentMethodsSignal readTime ref "Settled" asNumbers of
+  case paymentMethodsSignal readTime ref "Settled" (Just "MediumSpeed") asNumbers of
     Right (Just (SigSettled r t)) -> do
       rcvAmount r `shouldBe` CurrencyAmount 5400
       rcvCrypto r `shouldBe` Just "0.00050000"
@@ -496,7 +610,16 @@ listSettledRef = "SettledInvoiceRefAAAA"
 listProcessingRef = "ProcessingInvoiceRefB"
 
 xmrReceived :: Received
-xmrReceived = Received {rcvAmount = CurrencyAmount 5400, rcvCrypto = Just "0.32095000", rcvDue = Just "0.00000000"}
+xmrReceived =
+  Received
+    { rcvAmount = CurrencyAmount 5400,
+      rcvCrypto = Just "0.32095000",
+      rcvDue = Just "0.00000000",
+      rcvUnits = Just 320950000000,
+      rcvRate = Just "168.25",
+      rcvConfirmed = Confirmed {cfCents = CurrencyAmount 0, cfUnits = Just 0},
+      rcvUncreditable = Nothing
+    }
 
 fiftyFourDollars :: OrderDraft
 fiftyFourDollars =
@@ -600,21 +723,24 @@ testFakeLifecycle = withProvider $ \fake p -> do
   pReadInvoice p invRef `shouldReturn` Right Nothing
   setInvoiceState fake invRef ["paymentMethodPaid" .= ("0.00025000" :: Text)]
   pReadInvoice p invRef
-    `shouldReturn` Right (Just (SigFunded Received {rcvAmount = CurrencyAmount 2700, rcvCrypto = Just "0.00025000", rcvDue = Just "0.00000000"} PaidInPart))
+    `shouldReturn` Right (Just (SigFunded quarterMilliBtc PaidInPart))
   setInvoiceState fake invRef ["status" .= ("Processing" :: Text), "additionalStatus" .= ("PaidPartial" :: Text)]
   pReadInvoice p invRef
-    `shouldReturn` Right (Just (SigFunded Received {rcvAmount = CurrencyAmount 2700, rcvCrypto = Just "0.00025000", rcvDue = Just "0.00000000"} PaidInFull))
+    `shouldReturn` Right (Just (SigFunded quarterMilliBtc PaidInFull))
   setInvoiceState fake invRef ["status" .= ("Settled" :: Text), "paymentMethodPaid" .= ("0.00050000" :: Text)]
   pReadInvoice p invRef `shouldReturn` Right (Just (SigSettled halfMilliBtc fixtureSettledAt))
   details <- apiRequests fake "GET" ["invoices", invRef]
   methods <- apiRequests fake "GET" ["invoices", invRef, "payment-methods"]
   (length details, length methods) `shouldBe` (4, 5)
 
+quarterMilliBtc :: Received
+quarterMilliBtc = btcReceived 2700 (Just "0.00025000") "0.00000000" 25000 0 0
+
 testFakeClosed :: IO ()
 testFakeClosed = withProvider $ \fake p -> do
   ProviderInvoice {piProviderRef = invRef} <- createdInvoice p (SPMCrypto CCBtc)
   setInvoiceState fake invRef ["status" .= ("Expired" :: Text), "paymentMethodPaid" .= ("0.00050000" :: Text)]
-  pReadInvoice p invRef `shouldReturn` Right (Just (SigClosed halfMilliBtc))
+  pReadInvoice p invRef `shouldReturn` Right (Just (SigClosed halfMilliBtcUnconfirmed))
   setInvoiceState fake invRef ["status" .= ("Invalid" :: Text), "paymentMethodPaid" .= ("0.00000000" :: Text)]
   pReadInvoice p invRef `shouldReturn` Right (Just (SigClosed (nothingReceived "0.00050000")))
 
@@ -721,7 +847,7 @@ testFixturesGuardTotalPaid =
     totalPaidStaysDistinguishable
     ["payment-methods-btc", "payment-methods-xmr", "invoice-list", "invoice-list-alien-status", "invoice-list-alien-method"]
 
--- | With due equal to networkFee a fixture cannot tell which field the adapter reads, and
+-- | With due equal to paymentMethodFee a fixture cannot tell which field the adapter reads, and
 -- reading the fee would report a part-paid invoice as covered.
 dueStaysDistinguishable :: HasCallStack => Text -> IO ()
 dueStaysDistinguishable name = do
@@ -730,7 +856,7 @@ dueStaysDistinguishable name = do
     [] -> expectationFailure (T.unpack name <> " carries no payment method")
     ms -> mapM_ distinguishable ms
   where
-    distinguishable m = case (KM.lookup "due" m, KM.lookup "networkFee" m) of
+    distinguishable m = case (KM.lookup "due" m, KM.lookup "paymentMethodFee" m) of
       (Just d, Just f) -> d `shouldNotBe` f
       _ -> pure ()
 
@@ -740,6 +866,41 @@ testFixturesGuardDue =
     dueStaysDistinguishable
     ["payment-methods-btc", "payment-methods-xmr", "invoice-list", "invoice-list-alien-status", "invoice-list-alien-method"]
 
+testFakeRate :: IO ()
+testFakeRate = withProvider $ \fake p -> do
+  readRate <- maybe (failWith "btcpay offers no current rate") pure (pCurrentRate p)
+  readRate CCBtc `shouldReturn` Right (Rate "108000.12" 108000.12)
+  setRates fake (J.toJSON [rateEntry "XMR_USD" [] (Just "168.25")])
+  readRate CCXmr `shouldReturn` Right (Rate "168.25" 168.25)
+  map (lookup "currencyPair" . frQuery) <$> apiRequests fake "GET" ["rates"] `shouldReturn` [Just (Just "BTC_USD"), Just (Just "XMR_USD")]
+
+rateEntry :: Text -> [Text] -> Maybe Text -> J.Value
+rateEntry pair errors rate = J.object ["currencyPair" .= pair, "errors" .= errors, "rate" .= rate]
+
+testFakeRateRefusals :: IO ()
+testFakeRateRefusals = withProvider $ \fake p -> do
+  readRate <- maybe (failWith "btcpay offers no current rate") pure (pCurrentRate p)
+  failNextCalls fake 1 500
+  readRate CCBtc >>= (`shouldSatisfy` namesInError "HTTP 500")
+  let refusedFor answer what = do
+        setRates fake (J.toJSON answer)
+        readRate CCBtc >>= (`shouldSatisfy` namesInError what)
+  refusedFor [rateEntry "XMR_USD" [] (Just "168.25")] "BTC_USD"
+  refusedFor [rateEntry "BTC_USD" ["coingecko: rate limited"] Nothing] "rate limited"
+  refusedFor [rateEntry "BTC_USD" [] Nothing] "no rate"
+  refusedFor [rateEntry "BTC_USD" [] (Just "0")] "not above 0"
+  refusedFor [rateEntry "BTC_USD" [] (Just "-108000.12")] "not above 0"
+
+testFakeInvoicePolicy :: IO ()
+testFakeInvoicePolicy = withFakeBTCPay $ \fake -> do
+  highSpeed <- btcpayProvider (fbConfig fake) {bSpeedPolicy = HighSpeed}
+  mediumSpeed <- btcpayProvider (fbConfig fake)
+  ProviderInvoice {piProviderRef = madeHigh} <- createdInvoice highSpeed (SPMCrypto CCBtc)
+  ProviderInvoice {piProviderRef = madeMedium} <- createdInvoice mediumSpeed (SPMCrypto CCBtc)
+  forM_ [madeHigh, madeMedium] $ \r -> setInvoiceState fake r ["status" .= ("Settled" :: Text), "paymentMethodPaid" .= ("0.00050000" :: Text)]
+  pReadInvoice mediumSpeed madeHigh `shouldReturn` Right (Just (SigSettled halfMilliBtcUnconfirmed {rcvUncreditable = Just UCHighSpeed} fixtureSettledAt))
+  pReadInvoice highSpeed madeMedium `shouldReturn` Right (Just (SigSettled halfMilliBtc fixtureSettledAt))
+
 testFakeListMoved :: IO ()
 testFakeListMoved = withProvider $ \_ p ->
   pListOpen p
diff --git a/tests/Bots/StoreService/FakeBTCPay.hs b/tests/Bots/StoreService/FakeBTCPay.hs
index b9bf45d954..839198d5d3 100644
--- a/tests/Bots/StoreService/FakeBTCPay.hs
+++ b/tests/Bots/StoreService/FakeBTCPay.hs
@@ -10,6 +10,7 @@ module Bots.StoreService.FakeBTCPay
     fakeApiKey,
     fakeExpiryMinutes,
     setInvoiceState,
+    setRates,
     failNextCalls,
     failAfterCalls,
     useListFixture,
@@ -98,12 +99,16 @@ data FakeRequest = FakeRequest
   }
   deriving (Eq, Show)
 
+-- | isSpeedPolicy: the checkout's speedPolicy the invoice was created with. isPayments: the payments set by a test, else one of all
+-- that was paid, Settled once the invoice is.
 data InvoiceState = InvoiceState
   { isMethodId :: Text,
     isStatus :: Text,
     isAdditionalStatus :: Text,
     isPaid :: Maybe Text,
-    isDue :: Maybe Text
+    isDue :: Maybe Text,
+    isSpeedPolicy :: Maybe Text,
+    isPayments :: Maybe J.Value
   }
   deriving (Eq, Show)
 
@@ -118,6 +123,8 @@ data FakeState = FakeState
     fsMethods :: Maybe Text,
     fsIgnorePaging :: Bool,
     fsOversize :: Bool,
+    -- | The rates answer set by a test, else each pair asked at the fixtures' rate.
+    fsRates :: Maybe J.Value,
     fsRequests :: [FakeRequest]
   }
 
@@ -131,6 +138,7 @@ initialState =
       fsMethods = Nothing,
       fsIgnorePaging = False,
       fsOversize = False,
+      fsRates = Nothing,
       fsRequests = []
     }
 
@@ -222,16 +230,20 @@ btcMethod = "BTC-CHAIN"
 xmrMethod = "XMR-CHAIN"
 
 patchInvoice :: Text -> InvoiceState -> J.Value -> J.Value
-patchInvoice invId InvoiceState {isStatus, isAdditionalStatus} =
+patchInvoice invId InvoiceState {isStatus, isAdditionalStatus, isSpeedPolicy} v =
   setField "id" (J.String invId)
     . setField "status" (J.String isStatus)
     . setField "additionalStatus" (J.String isAdditionalStatus)
+    . setField "checkout" (setField "speedPolicy" (maybe J.Null J.String isSpeedPolicy) (fromMaybe (J.object []) (objectField "checkout" v)))
+    $ v
 
+-- | The fixtures' payments were written for a settled invoice, so the payments follow the state instead.
 patchMethods :: InvoiceState -> J.Value -> J.Value
-patchMethods InvoiceState {isPaid, isDue} = \case
+patchMethods InvoiceState {isStatus, isPaid, isDue, isPayments} = \case
   J.Array vs -> J.Array (fmap one vs)
   other -> other
   where
+    paidStatus = if isStatus == "Settled" then "Settled" else "Processing" :: Text
     one = \case
       J.Object o ->
         let paid = fromMaybe (fixturePaid o) isPaid
@@ -241,12 +253,20 @@ patchMethods InvoiceState {isPaid, isDue} = \case
             due = if isZero paid then isDue <|> textField "amount" o else isDue
             withPaid = KM.insert "paymentMethodPaid" (J.String paid) o
             withDue = maybe withPaid (\d -> KM.insert "due" (J.String d) withPaid) due
-         in J.Object (if isZero paid then KM.insert "payments" (J.Array mempty) withDue else withDue)
+            payments
+              | Just ps <- isPayments = ps
+              | isZero paid = J.Array mempty
+              | otherwise = J.toJSON [J.object ["id" J..= ("faketx-" <> paid), "receivedDate" J..= settledDate, "value" J..= paid, "fee" J..= ("0.00000000" :: Text), "status" J..= paidStatus]]
+         in J.Object (KM.insert "payments" payments withDue)
       v -> v
     fixturePaid o = case KM.lookup "paymentMethodPaid" o of
       Just (J.String t) -> t
       _ -> "0"
 
+-- | The fixtures' settlement time.
+settledDate :: Int
+settledDate = 1700003600
+
 isZero :: Text -> Bool
 isZero t = (J.decodeStrict (TE.encodeUtf8 t) :: Maybe Scientific) == Just 0
 
@@ -264,6 +284,7 @@ fakeApp stv req respond = do
     ["_fixtures"] | isPost -> control body setFixtures
     ["_paging"] | isPost -> control body setPaging
     ["_oversize"] | isPost -> control body setOversize
+    ["_rates"] | isPost -> setRatesAnswer body
     "api" : "v1" : "stores" : storeId : rest -> apiCall body storeId rest
     _ -> refuse notFound404 "no such path on the fake btcpay"
   where
@@ -292,7 +313,8 @@ fakeApp stv req respond = do
                     { isStatus = fromMaybe (isStatus inv) (textField "status" o),
                       isAdditionalStatus = fromMaybe (isAdditionalStatus inv) (textField "additionalStatus" o),
                       isPaid = maybe (isPaid inv) Just (textField "paymentMethodPaid" o),
-                      isDue = maybe (isDue inv) Just (textField "due" o)
+                      isDue = maybe (isDue inv) Just (textField "due" o),
+                      isPayments = maybe (isPayments inv) Just (KM.lookup "payments" o)
                     }
             writeTVar stv st {fsInvoices = M.insert invId inv' (fsInvoices st)}
             pure Nothing
@@ -325,6 +347,10 @@ fakeApp stv req respond = do
         fsListOf name st = st {fsList = name}
         fsMethodsOf name st = st {fsMethods = Just name}
 
+    setRatesAnswer body = case J.decode body of
+      Just v -> atomically (modifyTVar' stv (\st -> st {fsRates = Just v})) >> ok
+      Nothing -> refuse badRequest400 "_rates takes the answer to serve, as JSON"
+
     setOversize o = case unknownKeys ["on"] o of
       Just message -> pure (Just message)
       Nothing -> case KM.lookup "on" o of
@@ -370,6 +396,7 @@ fakeApp stv req respond = do
 
     greenfield body = \case
       ["payment-methods"] | isGet -> serve "store-payment-methods" id
+      ["rates"] | isGet -> rates
       ["invoices"] | isPost -> createInvoice body
       ["invoices"] | isGet -> listInvoices
       ["invoices", invId] | isGet ->
@@ -380,6 +407,13 @@ fakeApp stv req respond = do
           serve (fromMaybe (methodsFixture (isMethodId inv)) override) (patchMethods inv)
       _ -> refuse notFound404 "no such greenfield path on the fake btcpay"
 
+    rates = do
+      answer <- fsRates <$> readTVarIO stv
+      let asked = [TE.decodeUtf8 pair | ("currencyPair", Just pair) <- queryString req]
+      respond . jsonResponse ok200 $ fromMaybe (J.toJSON (map fixtureRate asked)) answer
+    fixtureRate pair = J.object ["currencyPair" J..= pair, "errors" J..= ([] :: [Text]), "rate" J..= lookup pair fixtureRates]
+    fixtureRates = [("BTC_USD", "108000.12"), ("XMR_USD", "168.25") :: (Text, Text)]
+
     listInvoices = do
       st <- readTVarIO stv
       fixture <- fixtureResponse (fsList st)
@@ -429,7 +463,10 @@ fakeApp stv req respond = do
                   { isMethodId = methodId,
                     isStatus = "New",
                     isAdditionalStatus = "None",
-                    isPaid = Just "0.00000000", isDue = Nothing
+                    isPaid = Just "0.00000000",
+                    isDue = Nothing,
+                    isSpeedPolicy = J.decode body >>= objectField "checkout" >>= objectField "speedPolicy" >>= asText,
+                    isPayments = Nothing
                   }
           writeTVar stv st {fsNextId = fsNextId st + 1, fsInvoices = M.insert invId inv (fsInvoices st)}
           pure (invId, inv)
@@ -447,7 +484,7 @@ intQuery :: ByteString -> Query -> Maybe Int
 intQuery k q = join (lookup k q) >>= readMaybe . B8.unpack
 
 stateKeys :: [Key]
-stateKeys = ["status", "additionalStatus", "paymentMethodPaid", "due"]
+stateKeys = ["status", "additionalStatus", "paymentMethodPaid", "due", "payments"]
 
 unknownKeys :: [Key] -> J.Object -> Maybe Text
 unknownKeys known o = case filter (`notElem` known) (KM.keys o) of
@@ -461,6 +498,11 @@ chosenMethod v = case objectField "checkout" v >>= objectField "paymentMethods"
     _ -> Nothing
   _ -> Nothing
 
+asText :: J.Value -> Maybe Text
+asText = \case
+  J.String t -> Just t
+  _ -> Nothing
+
 objectField :: Key -> J.Value -> Maybe J.Value
 objectField k = \case
   J.Object o -> KM.lookup k o
@@ -505,6 +547,10 @@ failAfterCalls skip fake calls code =
 answerOversize :: FakeBTCPay -> Bool -> IO ()
 answerOversize fake on = controlPost fake "/_oversize" (J.object ["on" J..= on])
 
+-- | The rates call answers this from now on.
+setRates :: FakeBTCPay -> J.Value -> IO ()
+setRates fake = controlPost fake "/_rates"
+
 useListFixture :: FakeBTCPay -> Text -> IO ()
 useListFixture fake name = controlPost fake "/_fixtures" (J.object ["list" J..= name])
 
diff --git a/tests/Bots/StoreService/StripeTests.hs b/tests/Bots/StoreService/StripeTests.hs
index 773df83c05..94b8fcfcdb 100644
--- a/tests/Bots/StoreService/StripeTests.hs
+++ b/tests/Bots/StoreService/StripeTests.hs
@@ -6,7 +6,8 @@ module Bots.StoreService.StripeTests (badgeStripeTests) where
 
 import StoreService.Config (StripeConfig (..))
 import StoreService.Providers
-  ( ListPass (..),
+  ( Confirmed (..),
+    ListPass (..),
     OrderDraft (..),
     PaymentSignal (..),
     Provider (..),
@@ -23,6 +24,8 @@ import Data.Aeson ((.=))
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Lazy as LB
 import Data.Either (isLeft)
+import Data.Maybe (isNothing)
+import Data.Word (Word32)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime, getCurrentTime)
@@ -55,6 +58,7 @@ badgeStripeTests = describe "badge stripe adapter" $ do
     it "refuses a crypto method, since Stripe offers none" testRefusesCrypto
     it "makes an unknown intent status a ProviderError, not a silent no-signal" testFakeReadUnknownStatus
     it "settles a succeeded intent with no charge at read time" testSettledNoChargeReadTime
+    it "confirms only a succeeded intent's amount, and reads no rate" testConfirmedOnlySucceeded
   describe "listing intents to settle" $ do
     it "lists by a created window, never status=open" testFakeListWindow
     it "moves the settled and canceled intents, at read time, leaving the open one" testFakeListsOpen
@@ -73,10 +77,23 @@ fiftyFourDollars :: OrderDraft
 fiftyFourDollars = OrderDraft {odAmount = CurrencyAmount 5400, odCurrency = "usd"}
 
 fiftyFourDollarsReceived :: Received
-fiftyFourDollarsReceived = Received {rcvAmount = CurrencyAmount 5400, rcvCrypto = Nothing, rcvDue = Nothing}
+fiftyFourDollarsReceived = cardReceived 5400 5400
 
 nothingReceived :: Received
-nothingReceived = Received {rcvAmount = CurrencyAmount 0, rcvCrypto = Nothing, rcvDue = Nothing}
+nothingReceived = cardReceived 0 0
+
+-- | Cents received and confirmed, with no units or rate.
+cardReceived :: Word32 -> Word32 -> Received
+cardReceived cents confirmed =
+  Received
+    { rcvAmount = CurrencyAmount cents,
+      rcvCrypto = Nothing,
+      rcvDue = Nothing,
+      rcvUnits = Nothing,
+      rcvRate = Nothing,
+      rcvConfirmed = Confirmed {cfCents = CurrencyAmount confirmed, cfUnits = Nothing},
+      rcvUncreditable = Nothing
+    }
 
 fixtureChargeAt :: UTCTime
 fixtureChargeAt = posixSecondsToUTCTime 1700000000
@@ -214,6 +231,14 @@ testSettledNoChargeReadTime = do
   let ir = IntentRead {irId = "pi_test_x", irStatus = "succeeded", irAmountReceived = 5400, irChargeCreated = Nothing}
   signalOf now ir `shouldBe` Right (Just (SigSettled fiftyFourDollarsReceived now))
 
+testConfirmedOnlySucceeded :: IO ()
+testConfirmedOnlySucceeded = do
+  now <- getCurrentTime
+  let read' status = signalOf now IntentRead {irId = "pi_test_x", irStatus = status, irAmountReceived = 5400, irChargeCreated = Nothing}
+  read' "succeeded" `shouldBe` Right (Just (SigSettled (cardReceived 5400 5400) now))
+  read' "canceled" `shouldBe` Right (Just (SigClosed (cardReceived 0 0)))
+  withProvider $ \_ p -> isNothing (pCurrentRate p) `shouldBe` True
+
 -- | A status=open query returns only open intents, which carry no signal, so the poll lists by
 -- creation time instead to catch a settlement the webhook missed. The window reaches back the
 -- settle window plus an intent's own lifetime.
diff --git a/tests/Bots/StoreService/WebTests.hs b/tests/Bots/StoreService/WebTests.hs
index 03e0d7c07e..69c5a4b2f2 100644
--- a/tests/Bots/StoreService/WebTests.hs
+++ b/tests/Bots/StoreService/WebTests.hs
@@ -842,6 +842,7 @@ data StubCall
   | StubRead Text
   | StubCancel Text
   | StubListOpen
+  | StubRate CryptoCurrency
   deriving (Eq, Show)
 
 data StubState = StubState
@@ -857,7 +858,8 @@ data StubState = StubState
     ssVerifyResult :: Either WebhookError (Maybe Text),
     ssVerifyThrows :: Bool,
     ssWebhooks :: [([Header], ByteString)],
-    ssReadDelay :: Int
+    ssReadDelay :: Int,
+    ssRate :: Either ProviderError Rate
   }
 
 newStubState :: Either ProviderError ProviderInvoice -> StubState
@@ -874,9 +876,14 @@ newStubState ssCreateResult =
       ssVerifyResult = Right Nothing,
       ssVerifyThrows = False,
       ssWebhooks = [],
-      ssReadDelay = 0
+      ssReadDelay = 0,
+      ssRate = Right stubRate
     }
 
+-- | Below the stored invoices' rate of 62500.
+stubRate :: Rate
+stubRate = Rate {rateText = "60000.5", rateValue = 60000.5}
+
 record :: IORef StubState -> StubCall -> IO ()
 record ref call = atomicModifyIORef' ref $ \s -> (s {ssCalls = ssCalls s ++ [call]}, ())
 
@@ -906,6 +913,9 @@ stubProvider ref =
         pure $ case ssListError stub of
           Just e -> Left e
           Nothing -> Right ListPass {lpMoved = Map.toList (ssInvoices stub), lpSkipped = ssSkipped stub},
+      pCurrentRate = Just $ \cc -> do
+        record ref (StubRate cc)
+        ssRate <$> readIORef ref,
       pVerifyWebhook = const (verifyRecording ref)
     }
 
@@ -2124,8 +2134,18 @@ replayAt = addUTCTime 3600 settleAt
 detectedAt :: UTCTime
 detectedAt = addUTCTime 300 settleAt
 
+-- | Nothing confirmed and no units, as the badge paths read it.
 rcv :: Word32 -> Maybe Text -> Received
-rcv amount crypto = Received {rcvAmount = CurrencyAmount amount, rcvCrypto = crypto, rcvDue = Nothing}
+rcv amount crypto =
+  Received
+    { rcvAmount = CurrencyAmount amount,
+      rcvCrypto = crypto,
+      rcvDue = Nothing,
+      rcvUnits = Nothing,
+      rcvRate = Nothing,
+      rcvConfirmed = Confirmed {cfCents = CurrencyAmount 0, cfUnits = Nothing},
+      rcvUncreditable = Nothing
+    }
 
 settle :: DBStore -> InvoiceId -> PaymentSignal -> UTCTime -> IO (Either Text InvoiceStatus)
 settle st iid signal at = newWaiters >>= \waiters -> settleOrder st waiters Nothing iid signal at

From 329179142fce12c1031c2ad7396c725bad74fad3 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 15:27:46 +0000
Subject: [PATCH 02/17] store: add the name late wait migration

---
 .../StoreService/Store/Postgres/Migrations.hs | 20 ++++++++++++++++++-
 .../StoreService/Store/SQLite/Migrations.hs   | 20 ++++++++++++++++++-
 tests/Bots/StoreService/NamesStoreTests.hs    |  4 ++--
 3 files changed, 40 insertions(+), 4 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs b/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
index 4690968ec4..736ddd3a82 100644
--- a/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
+++ b/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
@@ -21,7 +21,8 @@ schemaMigrations =
     ("20260918_badge_group_ops", m20260918_badge_group_ops, Just down_m20260918_badge_group_ops),
     ("20261010_names", m20261010_names, Just down_m20261010_names),
     ("20261022_drop_taken_codes", m20261022_drop_taken_codes, Just down_m20261022_drop_taken_codes),
-    ("20261022_name_balances", m20261022_name_balances, Just down_m20261022_name_balances)
+    ("20261022_name_balances", m20261022_name_balances, Just down_m20261022_name_balances),
+    ("20261022_name_late_wait", m20261022_name_late_wait, Just down_m20261022_name_late_wait)
   ]
 
 -- | The client tables share this database, so the service tables are the same names behind a prefix.
@@ -441,6 +442,23 @@ DROP INDEX @idx_name_balances_reserved_by;
 DROP TABLE @name_balances;
 |]
 
+-- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor or unconfirmed. Never cleared.
+m20261022_name_late_wait :: Text
+m20261022_name_late_wait =
+  withPrefix
+    servicePrefix
+    [r|
+ALTER TABLE @name_invoices ADD COLUMN late_support TEXT;
+|]
+
+down_m20261022_name_late_wait :: Text
+down_m20261022_name_late_wait =
+  withPrefix
+    servicePrefix
+    [r|
+ALTER TABLE @name_invoices DROP COLUMN late_support;
+|]
+
 {- TODO [badges] deferred with the draft in M20260915_user_badges, service only.
 
 ALTER TABLE @payments ADD COLUMN receipt_hash BYTEA;
diff --git a/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs b/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
index aba4d5bee1..7761b1e838 100644
--- a/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
+++ b/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
@@ -22,7 +22,8 @@ schemaMigrations =
     ("20260918_badge_group_ops", m20260918_badge_group_ops, Just down_m20260918_badge_group_ops),
     ("20261010_names", m20261010_names, Just down_m20261010_names),
     ("20261022_drop_taken_codes", m20261022_drop_taken_codes, Just down_m20261022_drop_taken_codes),
-    ("20261022_name_balances", m20261022_name_balances, Just down_m20261022_name_balances)
+    ("20261022_name_balances", m20261022_name_balances, Just down_m20261022_name_balances),
+    ("20261022_name_late_wait", m20261022_name_late_wait, Just down_m20261022_name_late_wait)
   ]
 
 -- | The client tables share this database, so the service tables are the same names behind a prefix.
@@ -443,6 +444,23 @@ DROP INDEX @idx_name_balances_reserved_by;
 DROP TABLE @name_balances;
 |]
 
+-- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor or unconfirmed. Never cleared.
+m20261022_name_late_wait :: Query
+m20261022_name_late_wait =
+  withPrefix
+    servicePrefix
+    [sql|
+ALTER TABLE @name_invoices ADD COLUMN late_support TEXT;
+|]
+
+down_m20261022_name_late_wait :: Query
+down_m20261022_name_late_wait =
+  withPrefix
+    servicePrefix
+    [sql|
+ALTER TABLE @name_invoices DROP COLUMN late_support;
+|]
+
 {- TODO [badges] deferred with the draft in M20260915_user_badges, service only.
 
 ALTER TABLE @payments ADD COLUMN receipt_hash BLOB;
diff --git a/tests/Bots/StoreService/NamesStoreTests.hs b/tests/Bots/StoreService/NamesStoreTests.hs
index 99eff9a111..2832a0e124 100644
--- a/tests/Bots/StoreService/NamesStoreTests.hs
+++ b/tests/Bots/StoreService/NamesStoreTests.hs
@@ -183,7 +183,7 @@ testNamesColumns = withServiceStore $ \st -> do
       "years", "duration", "expires_at", "price", "name_prepaid_code_id", "registered_at", "failed_at", "error", "created_at",
       "updated_at", "version", "live", "order_hash", "method", "moves", "links_refused_at", "balance_source", "balance_used"
     ]
-  has "sx_badge_service_name_invoices" ["invoice_id", "registration_id", "provider_ref", "late_alerted_at", "late_alerted_units"]
+  has "sx_badge_service_name_invoices" ["invoice_id", "registration_id", "provider_ref", "late_alerted_at", "late_alerted_units", "late_support"]
   has "sx_badge_service_name_balances" ["registration_id", "amount", "credited", "refunded", "reserved_by", "refunded_at", "created_at", "updated_at"]
   has "sx_badge_service_name_late_credits" ["invoice_id", "credit_no", "registration_id", "units", "invoice_rate", "current_rate", "rate_used", "cents", "created_at"]
   has "sx_badge_service_payments" balancePaymentColumns
@@ -194,7 +194,7 @@ testNamesDownUp :: IO ()
 testNamesDownUp = withServiceStore $ \st -> do
   let names = dropWhile ((/= "20261010_names") . name) storeServiceSchemaMigrations
       badgeColumns = mapM (fmap sort . columnsOf st) badgeTables
-  map name names `shouldBe` ["20261010_names", "20261022_drop_taken_codes", "20261022_name_balances"]
+  map name names `shouldBe` ["20261010_names", "20261022_drop_taken_codes", "20261022_name_balances", "20261022_name_late_wait"]
   badgeBefore <- badgeColumns
   code <- issue st 1 usable
   placeCode st "r1" ownerA (order "alicebakery" 1) code `shouldReturn` Right ()

From 0b498d20d8786055fcb3dcc2adb8d49c9a4007aa Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 15:28:02 +0000
Subject: [PATCH 03/17] store: keep a taken order's worth as a balance

---
 .../src/StoreService/Names/Orders.hs          |  6 +-
 .../src/StoreService/Names/Store.hs           |  9 +-
 .../src/StoreService/Names/Worker.hs          | 12 ++-
 tests/Bots/StoreService/NamesOwnerTests.hs    |  5 +-
 tests/Bots/StoreService/NamesStoreTests.hs    | 25 ++---
 tests/Bots/StoreService/NamesWorkerTests.hs   | 94 ++++++++++++++++++-
 6 files changed, 117 insertions(+), 34 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Orders.hs b/apps/simplex-store-service/src/StoreService/Names/Orders.hs
index bedf470508..f23383617d 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Orders.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Orders.hs
@@ -276,11 +276,9 @@ checkPrice ct len years price =
 unixSeconds :: UTCTime -> Integer
 unixSeconds = floor . utcTimeToPOSIXSeconds
 
--- | A paid order that lost its name, any failed order, and one whose reveal was refused for its links can move to another name.
+-- | A failed order, and one whose reveal was refused for its links, can move to another name.
 movable :: NameRegistration -> Bool
-movable NameRegistration {nrPhase, nrPayment, nrLinksRefusedAt} = case nrPhase of
-  PTaken | RPInvoice {} <- nrPayment -> True
-  PTaken | RPBalance <- nrPayment -> True
+movable NameRegistration {nrPhase, nrLinksRefusedAt} = case nrPhase of
   PFailed -> True
   PCommitted -> isJust nrLinksRefusedAt
   _ -> False
diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index e5bd7a038a..03640f3b59 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -683,19 +683,16 @@ closeOverdue db r@NameRegistration {nrId = regId@(RegistrationId rid), nrVersion
 
 -- | 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.
+-- An unpaid order is live while its invoice is open, which nrLive carries; a taken order is final, its worth kept as a balance.
 orderLive :: NameRegistration -> Bool
-orderLive NameRegistration {nrPhase, nrPayment, nrLive} = case nrPhase of
+orderLive NameRegistration {nrPhase, nrLive} = case nrPhase of
   PUnpaid -> nrLive
   PQueued -> True
   PCommitting -> True
   PCommitted -> True
   PRegistering -> True
   PFailed -> True
-  PTaken -> case nrPayment of
-    RPInvoice {} -> True
-    RPBalance -> True
-    RPCode _ -> False
+  PTaken -> False
   PRegistered -> False
 
 -- | Writes every changeable field of a registration read at its nrVersion, unless it changed since, with live as orderLive decides.
diff --git a/apps/simplex-store-service/src/StoreService/Names/Worker.hs b/apps/simplex-store-service/src/StoreService/Names/Worker.hs
index 6e1b4c7a03..3b0de170f3 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Worker.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Worker.hs
@@ -49,7 +49,7 @@ import StoreService.Names.Reveal (intentOf)
 import StoreService.Names.Revert (RevertName (..))
 import StoreService.Names.Sender (PendingTx, SendError (..), Sender, awaitOutcome, inFlightTransaction, ptHash, submitTransaction)
 import StoreService.Names.Store
-import StoreService.Names.Turns (withLabelTurn)
+import StoreService.Names.Turns (withBalanceTurn, withLabelTurn)
 import StoreService.Names.View (lapseMoment, notSignedInTime, registrationAt, registrationVersion)
 
 data Worker = Worker
@@ -323,14 +323,16 @@ judge w@Worker {wkOrders = oe@OrdersEnv {oeContracts}} now r@NameRegistration {n
                 | otherwise -> failed w now r reason
           Nothing -> failed w now r reason
 
--- | The payment is kept, and a code order's code released.
+-- | A paid order keeps its whole price as a balance of its own, credited in the taken write's transaction, registration before balance,
+-- in the balance's turn after the name's; a code order's code is released.
 taken :: Worker -> UTCTime -> NameRegistration -> IO (Maybe Int64, Next)
-taken Worker {wkOrders = OrdersEnv {oeStore, oeTurns}} now r@NameRegistration {nrId, nrPayment} = case nrPayment of
-  RPInvoice {} -> written r <$> withTransaction oeStore write
-  RPBalance -> written r <$> withTransaction oeStore write
+taken Worker {wkOrders = OrdersEnv {oeStore, oeTurns}} now r@NameRegistration {nrId, nrPayment, nrPrice} = case nrPayment of
+  RPInvoice {} -> credited
+  RPBalance -> credited
   RPCode codeId -> written r . fmap fst <$> releaseCode oeTurns oeStore codeId nrId write
   where
     write db = versionWritten <$> updateRegistration db r {nrPhase = PTaken, nrError = Nothing} now
+    credited = written r <$> withBalanceTurn oeTurns nrId (withTransaction oeStore $ \db -> write db >>= traverse (\v -> v <$ creditBalance db nrId nrPrice now))
 
 -- | A code order keeps its code for Try again.
 failed :: Worker -> UTCTime -> NameRegistration -> Maybe RevertName -> IO (Maybe Int64, Next)
diff --git a/tests/Bots/StoreService/NamesOwnerTests.hs b/tests/Bots/StoreService/NamesOwnerTests.hs
index fe83bd45a8..2d3360e631 100644
--- a/tests/Bots/StoreService/NamesOwnerTests.hs
+++ b/tests/Bots/StoreService/NamesOwnerTests.hs
@@ -83,7 +83,7 @@ namesOwnerTests = describe "StoreService names: owner" $ do
     it "lists the owner's orders newest first, a moved, an unpaid and a lapsed one read failed included, at most 50, and 404 for none" testFind
     it "refuses another signer's signature, a stale timestamp and a malformed body" testFindRefused
   describe "another name" $ do
-    it "refuses a move from registered, queued, and committed without a refused reveal" testMoveRefusedPhases
+    it "refuses a move from registered, queued, taken, and committed without a refused reveal" testMoveRefusedPhases
     it "moves a failed order, a lapsed one, and a committed one whose links were refused, to the same name with other links too" testMoveAccepted
     it "answers a body equal to the current fields with the view unchanged, counting no move, whatever its timestamp" testMoveRepeat
     it "answers the fourth move move_limit with the current view, changing nothing" testMoveLimit
@@ -386,7 +386,8 @@ testMoveRefusedPhases = withOwner $ \ctx -> do
   registeredOrder <- paidIn ctx aliceOrder registeredPhase
   committedOrder <- paidIn ctx aliceOrder {oCommitment = commitmentOf 2, oTimestamp = seconds orderTime + 1} committedPhase
   queuedOrder <- paidIn ctx dynamisOrder id
-  forM_ [registeredOrder, committedOrder, queuedOrder] $ \r -> do
+  takenOrder <- paidIn ctx (byB aliceOrder) {oCommitment = commitmentOf 4} takenPhase
+  forM_ [registeredOrder, committedOrder, queuedOrder, takenOrder] $ \r -> do
     (nrPhase r,) <$> move ctx keyA r to `shouldReturn` (nrPhase r, refusedWith 400 "bad_request")
     stored ctx r `shouldReturn` r
 
diff --git a/tests/Bots/StoreService/NamesStoreTests.hs b/tests/Bots/StoreService/NamesStoreTests.hs
index 2832a0e124..975110643c 100644
--- a/tests/Bots/StoreService/NamesStoreTests.hs
+++ b/tests/Bots/StoreService/NamesStoreTests.hs
@@ -503,9 +503,10 @@ testLiveFollowsPhase = withServiceStore $ \st -> do
         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" PTaken False
+  r1 <- reg st "r1"
+  write st r1 {nrPhase = PFailed} `shouldReturn` NotLive
   step "r2" PRegistering True
   step "r2" PTaken False
   placePaid st "r3" ownerA (order "carolsbakery" 3) (at 60) `shouldReturn` Right ()
@@ -520,7 +521,7 @@ testOrderLive = withServiceStore $ \st -> do
   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)]
+    `shouldBe` [(PUnpaid, True), (PQueued, True), (PCommitting, True), (PCommitted, True), (PRegistering, True), (PRegistered, False), (PTaken, False), (PFailed, True)]
   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
@@ -559,13 +560,13 @@ testWriteMeetsLiveOrder = withServiceStore $ \st -> do
   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)
+  write st r1 {nrPhase = PFailed} `shouldReturn` Written 2
+  failed <- reg st "r1"
+  let retarget o = withTransaction st $ \db -> retargetRegistration db failed 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
+  reg st "r1" `shouldReturn` failed
   retarget (order "davesbakery" 6) `shouldReturn` Written 3
 
 testRetarget :: IO ()
@@ -574,9 +575,9 @@ testRetarget = withServiceStore $ \st -> do
       o' = order "alicebakers" 2
   placePaid st "r1" ownerA o (at 60) `shouldReturn` Right ()
   r <- reg st "r1"
-  let taken =
+  let failed =
         r
-          { nrPhase = PTaken,
+          { nrPhase = PFailed,
             nrReveal = Just reveal,
             nrCommitTx = Just (TxHash $ digestFixture 8),
             nrCommitBlock = Just 100,
@@ -588,8 +589,8 @@ testRetarget = withServiceStore $ \st -> do
             nrFailedAt = Just (at 5),
             nrError = Just "failed"
           }
-  write st taken `shouldReturn` Written 2
-  withTransaction st (\db -> retargetRegistration db taken {nrVersion = 2} o' 10000 (at 6)) `shouldReturn` Written 3
+  write st failed `shouldReturn` Written 2
+  withTransaction st (\db -> retargetRegistration db failed {nrVersion = 2} o' 10000 (at 6)) `shouldReturn` Written 3
   r' <- reg st "r1"
   r'
     `shouldBe` r
@@ -602,7 +603,7 @@ testRetarget = withServiceStore $ \st -> do
         nrMoves = 1,
         nrUpdatedAt = at 6
       }
-  withTransaction st (\db -> retargetRegistration db taken {nrVersion = 2} o 10000 (at 7)) `shouldReturn` VersionChanged
+  withTransaction st (\db -> retargetRegistration db failed {nrVersion = 2} o 10000 (at 7)) `shouldReturn` VersionChanged
 
 testFind :: IO ()
 testFind = withServiceStore $ \st -> do
diff --git a/tests/Bots/StoreService/NamesWorkerTests.hs b/tests/Bots/StoreService/NamesWorkerTests.hs
index 416abd9857..043ea190fd 100644
--- a/tests/Bots/StoreService/NamesWorkerTests.hs
+++ b/tests/Bots/StoreService/NamesWorkerTests.hs
@@ -10,11 +10,14 @@ import Bots.StoreService.NamesContractsTests (availableCall, maxCommitmentAgeCal
 import Bots.StoreService.NamesOrdersTests
 import Bots.StoreService.NamesOwnerTests (answerExpiry, answerFree, answerOwner, answerUnowned, byB, codeIn, committedPhase, dynamisOrder, failedPhase, labelBytes, ownerOfSelector, paidIn, rewrite, sentRegister, stored)
 import Bots.StoreService.NamesPhasesTests (held, prompt, registrationPath, woken)
-import Bots.StoreService.NamesStoreTests (reveal)
+import Bots.StoreService.NamesStoreTests (btc, insertInvoiceRow, ownerA, paidOrder, reveal)
 import Bots.StoreService.WebTests (capturingStderr, jsonObject, statusOf, webGet, webRequestBody)
 import Control.Applicative ((<|>))
 import Control.Arrow ((&&&))
+import Control.Concurrent (threadDelay)
+import qualified Control.Concurrent.Async as Async
 import Control.Concurrent.Async (wait, withAsync)
+import qualified Control.Exception as E
 import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 import Control.Concurrent.STM (atomically, check)
 import Control.Monad (forM_, replicateM, replicateM_, void)
@@ -30,6 +33,7 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
 import Data.Word (Word64)
 import Network.HTTP.Client (defaultManagerSettings, newManager)
 import qualified Network.Wai.Handler.Warp as Warp
+import Simplex.Chat.PaymentService.Types (InvoiceId (..), InvoiceStatus (..))
 import Simplex.Messaging.Agent.Store.Common (withTransaction)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Crypto (keccak256)
@@ -43,6 +47,7 @@ import StoreService.Names.Phases (RegistrationId (..), awaitChange)
 import StoreService.Names.Registration (RegisterIntent (..), commitCalldata, registerIntentDigest, registerWithCreditCalldata, sponsorDomain)
 import StoreService.Names.Reveal (intentOf)
 import StoreService.Names.Sender
+import StoreService.Names.Signatures (OrderFields (..))
 import StoreService.Names.Store
 import StoreService.Names.Turns (labelTurnCount, withLabelTurn)
 import StoreService.Names.Worker
@@ -54,7 +59,16 @@ import System.Timeout (timeout)
 import Test.Hspec
 
 namesWorkerTests :: Spec
-namesWorkerTests = describe "StoreService names: worker" $ do
+namesWorkerTests = workerTests >> takenBalanceTests
+
+takenBalanceTests :: Spec
+takenBalanceTests = describe "StoreService names: balance life" $ describe "taken" $ do
+  it "credits a taken order paid wholly from a balance, and one paid partly, its whole price as a balance of its own, the source's left as it was" testTakenFromBalance
+  it "leaves the order as it was when the taken write's credit is refused, in one transaction" testTakenCreditRefused
+  it "wakes a held poll with the taken write, and not with a change of the order's balance" testTakenWakesPoll
+
+workerTests :: Spec
+workerTests = describe "StoreService names: worker" $ do
   describe "commit" $ do
     it "commits, waits for the reveal and revealAfter, and registers a code order, spending its code and publishing each change" testCommitWaitRegister
     it "waits for a pending commit without sending another, following its fee-bumped replacement" testPendingCommit
@@ -68,8 +82,8 @@ namesWorkerTests = describe "StoreService names: worker" $ do
     it "writes nothing when the registration changed since it was read" testLostRace
     it "writes in the name's turn" testInNameTurn
   describe "register" $ do
-    it "ends the later of two wallets' paid orders for one name taken, with its value kept" testTwoWallets
-    it "ends taken on any revert while the name is not available, releasing a code" testRevertTaken
+    it "ends the later of two wallets' paid orders for one name taken, not live, with a balance of its price" testTwoWallets
+    it "ends taken on any revert while the name is not available, releasing a code and keeping no balance" testRevertTaken
     it "keeps the phase on NameNotAvailable while the name still reads available, as for a pending competitor" testPendingCompetitor
     it "ends failed on a revert while the name is available, alerting on InsufficientAllowance and keeping a code" testRevertFailed
     it "clears the reveal on InvalidNonce, staying committed" testInvalidNonce
@@ -484,9 +498,78 @@ testTwoWallets = withWorker $ \w@W {wCtx = ctx} -> do
   dryRunsRevert w "NameNotAvailable(string)" $ abiTuple [Dynamic $ abiBytes "alicebakery"]
   published w b (steps w b) >>= done
   x <- stored ctx b
-  (nrPhase x, nrLive x, nrPrice x, nrPayment x, nrError x) `shouldBe` (PTaken, True, nrPrice b, nrPayment b, Nothing)
+  (nrPhase x, nrLive x, nrPrice x, nrPayment x, nrError x) `shouldBe` (PTaken, False, nrPrice b, nrPayment b, Nothing)
+  fmap (\Balance {blAmount, blCredited, blHold} -> (blAmount, blCredited, blHold)) <$> withTransaction (cStore ctx) (\db -> getBalance db (nrId b) orderTime)
+    `shouldReturn` Just (nrPrice b, nrPrice b, Nothing)
   length <$> sent w `shouldReturn` 1
 
+-- | The order of alicebakery, by owner A, with this commitment.
+aliceFields :: Int -> OrderFields
+aliceFields n = OrderFields {ofLabelHash = labelHash "alicebakery", ofLength = 11, ofDuration = yearsDuration 2 orderTime, ofCommitment = commitmentOf n, ofSealed = "sealed-alicebakery-" <> tshow n}
+
+aliceRegistration :: Text -> Int -> NewRegistration
+aliceRegistration rid n = NewRegistration {nrgId = RegistrationId rid, nrgOwner = ownerA, nrgOrder = aliceFields n, nrgYears = 2}
+
+-- | The amount and credited of the order's balance.
+balanceFigures :: Ctx -> RegistrationId -> IO (Maybe (Int, Int))
+balanceFigures Ctx {cStore} rid = fmap (\Balance {blAmount, blCredited} -> (blAmount, blCredited)) <$> withTransaction cStore (\db -> getBalance db rid orderTime)
+
+-- | The register's dry run reverts on a name someone else holds, so the registration ends taken.
+endsTaken :: W -> NameRegistration -> IO ()
+endsTaken w@W {wCtx = Ctx {cNode}} r = do
+  answerAvailable w False
+  setFault cNode "eth_estimateGas" $ RpcError 3 "execution reverted: ERC721: invalid token ID" Nothing
+  published w r (steps w r) >>= done
+
+testTakenFromBalance :: IO ()
+testTakenFromBalance = withWorker $ \w@W {wCtx = ctx@Ctx {cStore}} -> do
+  let price = oPrice aliceOrder
+  wholly <- paidIn ctx (byB dynamisOrder) failedPhase
+  partly <- paidIn ctx (byB aliceOrder) {oCommitment = commitmentOf 5} failedPhase
+  withTransaction cStore $ \db -> creditBalance db (nrId wholly) 30000 orderTime >> creditBalance db (nrId partly) 4000 orderTime
+  withTransaction cStore (\db -> createBalanceRegistration db (aliceRegistration "covered" 1) (nrId wholly) price 30000 orderTime) `shouldReturn` Right ()
+  covered <- registrationById ctx (RegistrationId "covered") >>= \r -> rewrite ctx r openPhase >>= revealed ctx keyA "alicebakery"
+  endsTaken w covered
+  (\x -> (nrPhase x, nrLive x, nrPayment x)) <$> stored ctx covered `shouldReturn` (PTaken, False, RPBalance)
+  balanceFigures ctx (nrId covered) `shouldReturn` Just (price, price)
+  balanceFigures ctx (nrId wholly) `shouldReturn` Just (30000 - price, 30000)
+  withTransaction cStore $ \db -> do
+    insertInvoiceRow db "inv-diff" (addUTCTime 3600 orderTime) "open"
+    createPaidRegistration db (aliceRegistration "diff" 2) (OTBalance (nrId partly) price 4000 (Just btc)) (paidOrder "inv-diff") {poPrice = price} orderTime `shouldReturn` Right ()
+  settleNow ctx (InvoiceId "inv-diff") settled `shouldReturn` Right ISPaid
+  balanceFigures ctx (nrId partly) `shouldReturn` Just (0, 4000)
+  diff <- registrationById ctx (RegistrationId "diff") >>= \r -> rewrite ctx r openPhase >>= revealed ctx keyA "alicebakery"
+  endsTaken w diff
+  nrPhase <$> stored ctx diff `shouldReturn` PTaken
+  balanceFigures ctx (nrId diff) `shouldReturn` Just (price, price)
+  balanceFigures ctx (nrId partly) `shouldReturn` Just (0, 4000)
+
+-- | A price the balance's CHECK refuses makes the credit fail inside the taken write's transaction.
+testTakenCreditRefused :: IO ()
+testTakenCreditRefused = withWorker $ \w@W {wCtx = ctx@Ctx {cStore, cNode}} -> do
+  r <- paidIn ctx aliceOrder openPhase >>= revealed ctx keyA "alicebakery"
+  withTransaction cStore $ \db -> DB.execute db "UPDATE sx_badge_service_name_registrations SET price = -1 WHERE registration_id = ?" [(\(RegistrationId t) -> t) $ nrId r]
+  unchanged <- stored ctx r
+  answerAvailable w False
+  setFault cNode "eth_estimateGas" $ RpcError 3 "execution reverted: ERC721: invalid token ID" Nothing
+  void (E.try (steps w r) :: IO (Either E.SomeException Next))
+  stored ctx r `shouldReturn` unchanged
+  balanceFigures ctx (nrId r) `shouldReturn` Nothing
+
+testTakenWakesPoll :: IO ()
+testTakenWakesPoll = withWorker $ \w@W {wCtx = ctx@Ctx {cStore}} -> do
+  r <- paidIn ctx aliceOrder openPhase >>= revealed ctx keyA "alicebakery"
+  waiting <- held ctx (0, 1) $ registrationPath (nrId r) <> "?seenVersion=" <> show (nrVersion r)
+  withTransaction cStore $ \db -> creditBalance db (nrId r) 500 orderTime
+  threadDelay shortWait
+  isJust <$> Async.poll waiting `shouldReturn` False
+  endsTaken w r
+  (status, view) <- woken "the registration poll" waiting
+  (status, field "phase" view) `shouldBe` (200, Just "taken")
+  balanceFigures ctx (nrId r) `shouldReturn` Just (500 + oPrice aliceOrder, 500 + oPrice aliceOrder)
+  where
+    shortWait = 500000
+
 testPendingCompetitor :: IO ()
 testPendingCompetitor = withWorker $ \w@W {wCtx = ctx} -> do
   (r, code) <- codeIn ctx 8 aliceOrder openPhase >>= traverseFst (revealed ctx keyA "alicebakery")
@@ -512,6 +595,7 @@ testRevertTaken = withWorker $ \w@W {wCtx = ctx@Ctx {cNode}} -> do
   (nrPhase x, nrLive x) `shouldBe` (PTaken, False)
   PrepaidCode {pcReservedBy, pcSpentAt} <- codeOf ctx code
   (pcReservedBy, pcSpentAt) `shouldBe` (Nothing, Nothing)
+  balanceFigures ctx (nrId r) `shouldReturn` Nothing
   sent w `shouldReturn` []
 
 testRevertFailed :: IO ()

From bb7c954d181dea5f64304be58751ff52f3ae73b5 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 15:28:05 +0000
Subject: [PATCH 04/17] store: credit a cheaper move's difference

---
 .../src/StoreService/Names/Orders.hs          | 14 ++++--
 tests/Bots/StoreService/NamesOwnerTests.hs    | 49 +++++++++++++++++--
 2 files changed, 54 insertions(+), 9 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Orders.hs b/apps/simplex-store-service/src/StoreService/Names/Orders.hs
index f23383617d..711ef57165 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Orders.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Orders.hs
@@ -70,8 +70,8 @@ import StoreService.Names.Env (NamesEnv (..))
 import StoreService.Names.Phases (Phases, RegistrationId (..))
 import StoreService.Names.Abi (bytes32FromHex, hex)
 import StoreService.Names.Signatures (OrderFields (..), orderMessage, parseChecksumAddress, parseSignature, personalDigest)
-import StoreService.Names.Store (Balance, LiveOrder (..), NamePhase (..), NameRegistration (..), NewRegistration (..), PrepaidCode (..), RegistrationPayment (..), RegistrationRefused (..), NameTransaction (..), TxFor (..), TxStatus (..), VersionWrite (..), closeOverdue, createCodeRegistration, getBalance, getLiveOrders, getPrepaidCode, getPrepaidCodeById, getRegistration, getRegistrationByOrderHash, isLabelRegistering, registrationTransactions, retargetRegistration, updateRegistration)
-import StoreService.Names.Turns (Turns, withCodeTurn)
+import StoreService.Names.Store (Balance, LiveOrder (..), NamePhase (..), NameRegistration (..), NewRegistration (..), PrepaidCode (..), RegistrationPayment (..), RegistrationRefused (..), NameTransaction (..), TxFor (..), TxStatus (..), VersionWrite (..), closeOverdue, createCodeRegistration, creditBalance, getBalance, getLiveOrders, getPrepaidCode, getPrepaidCodeById, getRegistration, getRegistrationByOrderHash, isLabelRegistering, registrationTransactions, retargetRegistration, updateRegistration)
+import StoreService.Names.Turns (Turns, withBalanceTurn, withCodeTurn)
 
 data OrdersEnv = OrdersEnv
   { oeStore :: DBStore,
@@ -303,13 +303,17 @@ checkMovePrice ct NameRegistration {nrPrice, nrYears} len =
       | otherwise -> pure $ Right price
 
 -- | The move's write, a compare-and-set on the version read. A code order's code is checked and reserved again in the code's turn.
+-- A paid order moved to a cheaper name keeps the difference as its balance, credited in the move's transaction and the balance's turn.
 retargetOrder :: OrdersEnv -> NameRegistration -> OrderFields -> Int -> IO (Either WriteRefusal Int64)
-retargetOrder OrdersEnv {oeStore, oeTurns, oeNow} r@NameRegistration {nrId, nrPayment} fields@OrderFields {ofLength} price = do
+retargetOrder OrdersEnv {oeStore, oeTurns, oeNow} r@NameRegistration {nrId, nrPayment, nrPrice} fields@OrderFields {ofLength} price = do
   now <- oeNow
   let write db = versionWritten <$> retargetRegistration db r fields price now
+      paidMove
+        | price < nrPrice = withBalanceTurn oeTurns nrId $ withTransaction oeStore $ \db -> write db >>= traverse (\v -> v <$ creditBalance db nrId (nrPrice - price) now)
+        | otherwise = withTransaction oeStore write
   case nrPayment of
-    RPInvoice {} -> withTransaction oeStore write
-    RPBalance -> withTransaction oeStore write
+    RPInvoice {} -> paidMove
+    RPBalance -> paidMove
     RPCode codeId ->
       withTransaction oeStore (`getPrepaidCodeById` codeId) >>= \case
         Nothing -> pure $ Left $ WRRefused $ ORCode CRInvalid
diff --git a/tests/Bots/StoreService/NamesOwnerTests.hs b/tests/Bots/StoreService/NamesOwnerTests.hs
index 2d3360e631..f62eb6cf9d 100644
--- a/tests/Bots/StoreService/NamesOwnerTests.hs
+++ b/tests/Bots/StoreService/NamesOwnerTests.hs
@@ -29,7 +29,7 @@ where
 import Bots.StoreService.FakeEthNode
 import Bots.StoreService.NamesContractsTests (registrarOf, unhex)
 import Bots.StoreService.NamesOrdersTests
-import Bots.StoreService.NamesStoreTests (order, ownerA, t0)
+import Bots.StoreService.NamesStoreTests (btc, insertInvoiceRow, order, ownerA, paidOrder, t0)
 import Bots.StoreService.WebTests (capturingStderr, digestFixture, jsonObject, statusOf, webGet)
 import Control.Applicative ((<|>))
 import Control.Arrow ((&&&))
@@ -92,7 +92,9 @@ namesOwnerTests = describe "StoreService names: owner" $ do
     it "registers a failed order whose register went through, by its mined register or by ownerOf, answering registration_changed and spending a code" testMoveLanded
     it "answers name_check_unavailable when the register check cannot read the chain, changing nothing" testMoveLandedUnread
     it "spends a released code still unused when its failed order turns out registered, and alerts once when it was spent elsewhere meanwhile" testMoveLandedReleasedCode
-    it "answers a dearer name price_too_high with its price, and moves to a cheaper one at its price" testMovePrice
+    it "answers a dearer name price_too_high with its price, and moves to a cheaper one at its price, crediting the difference to its balance" testMovePrice
+    it "credits nothing for a cheaper move whose compare-and-set loses" testCheaperMoveLostRace
+    it "keeps fromBalance through a move to a cheaper name" testMoveKeepsFromBalance
     it "checks a code order's code again: code_not_covering for a shorter name, a held code kept though revoked and expired since" testMoveCodeOrder
     it "reserves a released code again while unused, else answers code_used, code_reserved, code_invalid or code_expired" testMoveReleasedCode
     it "refuses sealed over 11095 characters, a body over 16384 bytes and malformed fields, accepting the longest" testMoveSizes
@@ -209,6 +211,10 @@ rewrite Ctx {cStore, cClock} NameRegistration {nrId} change = do
       Written _ -> fromJust <$> getRegistration db nrId
       refused -> error $ "not written: " <> show refused
 
+-- | The amount and credited of the order's balance.
+balanceOf :: Ctx -> NameRegistration -> IO (Maybe (Int, Int))
+balanceOf Ctx {cStore} NameRegistration {nrId} = fmap (\Balance {blAmount, blCredited} -> (blAmount, blCredited)) <$> withTransaction cStore (\db -> getBalance db nrId orderTime)
+
 stored :: Ctx -> NameRegistration -> IO NameRegistration
 stored ctx = registrationById ctx . nrId
 
@@ -563,11 +569,46 @@ testMovePrice = withOwner $ \ctx -> do
   toDynamis <- moveTo ctx "dynamis" 10
   move ctx keyA cheap toDynamis `shouldReturn` (409, Just $ KM.fromList [("error", "price_too_high"), ("price", J.Number 20000)])
   stored ctx cheap `shouldReturn` cheap
-  dear <- paidIn ctx (byB dynamisOrder) takenPhase
+  balanceOf ctx cheap `shouldReturn` Nothing
+  dear <- paidIn ctx (byB dynamisOrder) failedPhase
   toCheaper <- moveTo ctx "alicebakers" 11
   v <- moved ctx keyB dear toCheaper
-  (field "price" v, field "phase" v) `shouldBe` (Just (J.Number 10000), Just "queued")
+  (field "price" v, field "phase" v, field "fromBalance" v) `shouldBe` (Just (J.Number 10000), Just "queued", Just (J.Number 0))
+  field "balance" v `shouldBe` Just (J.object ["amount" J..= (10000 :: Int), "held" J..= False, "heldUntil" J..= J.Null, "refunded" J..= (0 :: Int)])
   nrPrice <$> stored ctx dear `shouldReturn` 10000
+  balanceOf ctx dear `shouldReturn` Just (10000, 10000)
+
+testCheaperMoveLostRace :: IO ()
+testCheaperMoveLostRace = withOwner $ \ctx@Ctx {cNode} -> do
+  answerFree ctx "alicebakers"
+  r <- paidIn ctx dynamisOrder failedPhase
+  to <- moveTo ctx "alicebakers" 10
+  -- held at the register check's ownerOf read, inside the turns
+  (moving, gate) <- pausedAt cNode "eth_call" $ move ctx keyA r to
+  changed <- rewrite ctx r id
+  releaseGate gate
+  fst <$> within "the move" (wait moving) `shouldReturn` 409
+  stored ctx r `shouldReturn` changed
+  balanceOf ctx r `shouldReturn` Nothing
+
+-- | dynamis for 20000, 5000 of it from another order's balance, moved to alicebakers for 10000.
+testMoveKeepsFromBalance :: IO ()
+testMoveKeepsFromBalance = withOwner $ \ctx@Ctx {cStore} -> do
+  answerFree ctx "alicebakers"
+  paying <- paidIn ctx (byB aliceOrder) failedPhase
+  withTransaction cStore $ \db -> creditBalance db (nrId paying) 5000 orderTime
+  let fields = OrderFields {ofLabelHash = labelHash "dynamis", ofLength = 7, ofDuration = yearsDuration 2 orderTime, ofCommitment = commitmentOf 3, ofSealed = "sealed-dynamis-3"}
+      new = NewRegistration {nrgId = RegistrationId "diff", nrgOwner = ownerA, nrgOrder = fields, nrgYears = 2}
+  withTransaction cStore $ \db -> do
+    insertInvoiceRow db "inv-diff" (addUTCTime 3600 orderTime) "open"
+    createPaidRegistration db new (OTBalance (nrId paying) 20000 5000 (Just btc)) (paidOrder "inv-diff") {poPrice = 20000} orderTime `shouldReturn` Right ()
+  settleNow ctx (InvoiceId "inv-diff") settled `shouldReturn` Right ISPaid
+  r <- registrationById ctx (RegistrationId "diff") >>= \d -> rewrite ctx d failedPhase
+  to <- moveTo ctx "alicebakers" 11
+  v <- moved ctx keyA r to
+  (field "price" v, field "fromBalance" v) `shouldBe` (Just (J.Number 10000), Just (J.Number 5000))
+  balanceOf ctx r `shouldReturn` Just (10000, 10000)
+  balanceOf ctx paying `shouldReturn` Just (0, 5000)
 
 testMoveCodeOrder :: IO ()
 testMoveCodeOrder = withOwner $ \ctx@Ctx {cStore} -> do

From 586351d9248125c7a5124efa3cd9589ef152b319 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 15:29:37 +0000
Subject: [PATCH 05/17] store: spend holds and credit late payments

---
 .../src/StoreService/Names/LateCredits.hs     |  94 +++
 .../src/StoreService/Names/Store.hs           |  84 ++-
 .../src/StoreService/Names/View.hs            |  23 +-
 .../src/StoreService/Orders.hs                |  66 +-
 .../src/StoreService/Poller.hs                | 153 +++-
 .../src/StoreService/Store/Invoices.hs        |  49 +-
 simplex-chat.cabal                            |   3 +
 tests/Bots/StoreService/NamesBalancesTests.hs |  11 +-
 .../Bots/StoreService/NamesLateCreditTests.hs | 664 ++++++++++++++++++
 tests/Bots/StoreService/NamesOrdersTests.hs   |  25 +-
 tests/Bots/StoreService/WebTests.hs           |   8 +-
 tests/Test.hs                                 |   2 +
 12 files changed, 1096 insertions(+), 86 deletions(-)
 create mode 100644 apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
 create mode 100644 tests/Bots/StoreService/NamesLateCreditTests.hs

diff --git a/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs b/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
new file mode 100644
index 0000000000..ea251b64ae
--- /dev/null
+++ b/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
@@ -0,0 +1,94 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+
+-- | The credit of a closed order's late money to its balance: only confirmed money not yet credited, crypto at the lower
+-- of the invoice's rate and the current one. The rate is read outside any transaction, so the credit runs after the
+-- settlement that recorded the money commits, and again from the poller's pass for whatever is still not credited.
+module StoreService.Names.LateCredits
+  ( CreditOutcome (..),
+    minCurrentRateFraction,
+    creditLateInvoice,
+    lateCreditOf,
+  )
+where
+
+import Data.Ratio ((%))
+import Data.Scientific (Scientific)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Clock (UTCTime)
+import Simplex.Chat.PaymentService.Types (CryptoCurrency, InvoiceId)
+import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
+import StoreService.Names.Store (LateCredit (..), LateCreditState (..), LateSupport (..), NamePhase (..), creditLatePayment, lateCreditState, setLateSupport)
+import StoreService.Providers (ProviderError (..), Rate (..))
+import StoreService.Providers.BTCPay (unitDecimals)
+import StoreService.Store.Invoices (lockInvoice)
+import Text.Read (readMaybe)
+
+-- | A current rate below this fraction of the invoice's is not used: it may be a glitch or a real fall, which the owner decides on.
+minCurrentRateFraction :: Rational
+minCurrentRateFraction = 1 % 2
+
+-- | CORefused: the credit's number was taken meanwhile, which the invoice's lock rules out.
+data CreditOutcome
+  = CONothingDue
+  | COCredited LateCredit
+  | CORateFailed ProviderError
+  | CORateFloor Text Rate
+  | CORefused
+  deriving (Eq, Show)
+
+creditLateInvoice :: DBStore -> (CryptoCurrency -> IO (Either ProviderError Rate)) -> InvoiceId -> UTCTime -> IO CreditOutcome
+creditLateInvoice st readRate invId now =
+  withTransaction st (`lateCreditState` invId) >>= \case
+    Just s | closedUnpaid s && moneyDue s -> case lsCoin s of
+      Nothing -> credit Nothing
+      Just coin ->
+        readRate coin >>= \case
+          Left e -> pure $ CORateFailed e
+          Right rate -> case invoiceRate s of
+            Nothing -> pure $ CORateFailed $ ProviderError "the invoice's rate is not stored"
+            Just (invoiceText, invoiceValue)
+              | toRational (rateValue rate) < minCurrentRateFraction * toRational invoiceValue ->
+                  CORateFloor invoiceText rate <$ withTransaction st (\db -> setLateSupport db invId LSRateFloor)
+              | otherwise -> credit (Just rate)
+    _ -> pure CONothingDue
+  where
+    credit rate = withTransaction st $ \db -> do
+      lockInvoice db invId now
+      lateCreditState db invId >>= \case
+        Just s | closedUnpaid s, Just c <- lateCreditOf s rate -> do
+          applied <- creditLatePayment db c now
+          pure $ if applied then COCredited c else CORefused
+        _ -> pure CONothingDue
+
+closedUnpaid :: LateCreditState -> Bool
+closedUnpaid LateCreditState {lsPhase, lsLive} = lsPhase == PUnpaid && not lsLive
+
+moneyDue :: LateCreditState -> Bool
+moneyDue s@LateCreditState {lsConfirmedCents, lsCreditedCents} = case lsCoin s of
+  Nothing -> lsConfirmedCents > lsCreditedCents
+  Just _ -> unitsDue s > 0
+
+unitsDue :: LateCreditState -> Integer
+unitsDue LateCreditState {lsConfirmedUnits, lsCreditedUnits} = maybe 0 toInteger lsConfirmedUnits - toInteger lsCreditedUnits
+
+invoiceRate :: LateCreditState -> Maybe (Text, Scientific)
+invoiceRate LateCreditState {lsInvoiceRate} = lsInvoiceRate >>= \t -> (t,) <$> readMaybe (T.unpack t)
+
+-- | The next credit of the money not yet credited: card cents as they are, crypto units at the lower rate, rounded down to the cent.
+lateCreditOf :: LateCreditState -> Maybe Rate -> Maybe LateCredit
+lateCreditOf s@LateCreditState {lsInvoice, lsRegistration, lsCredits, lsConfirmedCents, lsCreditedCents} rate = case (lsCoin s, rate, invoiceRate s) of
+  (Nothing, _, _)
+    | lsConfirmedCents > lsCreditedCents -> Just (credit Nothing Nothing Nothing Nothing (lsConfirmedCents - lsCreditedCents))
+  (Just coin, Just Rate {rateText, rateValue}, Just (invoiceText, invoiceValue))
+    | unitsDue s > 0 ->
+        let (usedText, usedValue) = if rateValue < invoiceValue then (rateText, rateValue) else (invoiceText, invoiceValue)
+            cents = floor (fromInteger (unitsDue s) * toRational usedValue * 100 / 10 ^ unitDecimals coin)
+         in Just (credit (Just $ fromInteger $ unitsDue s) (Just invoiceText) (Just rateText) (Just usedText) cents)
+  _ -> Nothing
+  where
+    credit lcUnits lcInvoiceRate lcCurrentRate lcRateUsed lcCents =
+      LateCredit {lcInvoice = lsInvoice, lcCreditNo = lsCredits + 1, lcRegistration = lsRegistration, lcUnits, lcInvoiceRate, lcCurrentRate, lcRateUsed, lcCents}
diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index 03640f3b59..36ee52ffdb 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -23,6 +23,8 @@ module StoreService.Names.Store
     LateCreditState (..),
     LatePending (..),
     LateAlert (..),
+    LateSupport (..),
+    LateWait (..),
     CleanupKept (..),
     PrepaidCode (..),
     NewPrepaidCode (..),
@@ -71,6 +73,8 @@ module StoreService.Names.Store
     uncreditedLateInvoices,
     lateAlertDue,
     claimLateAlert,
+    setLateSupport,
+    lateWait,
     insertPrepaidCode,
     getPrepaidCode,
     getPrepaidCodeById,
@@ -126,7 +130,7 @@ import StoreService.Names.Chain (TxHash (..))
 import StoreService.Names.Phases (RegistrationId (..))
 import StoreService.Names.Signatures (OrderFields (..), parseSignature)
 import StoreService.Store (RevokeResult (..))
-import StoreService.Store.Invoices (StoreDecodeError (..), executeChanging, invoiceStatusText, lockInvoice, newInvoiceId, truncateToSecond, unfundedQuery)
+import StoreService.Store.Invoices (StoreDecodeError (..), executeChanging, invoiceStatusText, lockInvoice, newInvoiceId, textToCryptoCurrency, truncateToSecond, unfundedQuery)
 
 #if defined(dbPostgres)
 import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
@@ -293,13 +297,15 @@ data LateCredit = LateCredit
   }
   deriving (Eq, Show)
 
--- | A name invoice's payment figures, what was credited from it, and its order's phase and live flag. Card money is counted in cents, crypto in units.
+-- | A name invoice's payment figures, what was credited from it, and its order's phase and live flag. Card money (no coin) is counted in cents,
+-- crypto in units. lsSupport: why its money will not be credited by itself, once known.
 data LateCreditState = LateCreditState
   { lsInvoice :: InvoiceId,
     lsRegistration :: RegistrationId,
     lsPhase :: NamePhase,
     lsLive :: Bool,
-    lsCard :: Bool,
+    lsCoin :: Maybe CryptoCurrency,
+    lsSupport :: Maybe LateSupport,
     lsReceivedCents :: Int,
     lsConfirmedCents :: Int,
     lsReceivedUnits :: Maybe Int64,
@@ -327,6 +333,27 @@ instance TextEncoding LatePending where
 
 instance FromField LatePending where fromField = fromTextField_ textDecode
 
+-- | What a closed order's late money waits on, for the view: confirmation, the credit, or support.
+data LateWait = LWConfirming | LWCrediting | LWSupport
+  deriving (Eq, Show)
+
+-- | Why a closed order's money will not be credited by itself: an invoice made under HighSpeed, an amount that could not be counted in units,
+-- a current rate below the floor, or unconfirmed money alerted past the read window.
+data LateSupport = LSHighSpeed | LSUnits | LSRateFloor | LSUnconfirmed
+  deriving (Eq, Show, Enum, Bounded)
+
+instance TextEncoding LateSupport where
+  textEncode = \case
+    LSHighSpeed -> "high_speed"
+    LSUnits -> "units"
+    LSRateFloor -> "rate_floor"
+    LSUnconfirmed -> "unconfirmed"
+  textDecode t = lookup t [(textEncode s, s) | s <- [minBound .. maxBound]]
+
+instance FromField LateSupport where fromField = fromTextField_ textDecode
+
+instance ToField LateSupport where toField = toField . textEncode
+
 -- | A closed order's pending money to alert on, with the received figure the alert names and the one the last alert named.
 data LateAlert = LateAlert
   { laState :: LateCreditState,
@@ -1043,25 +1070,26 @@ receivedFigure = " CASE WHEN" <> cardInvoice <> " THEN p.amount ELSE COALESCE(p.
 
 lateColumns :: Query
 lateColumns =
-  "SELECT ni.invoice_id, ni.registration_id, r.phase, r.live, CASE WHEN" <> cardInvoice <> " THEN 1 ELSE 0 END, COALESCE(p.amount, 0), p.confirmed_amount,"
+  "SELECT ni.invoice_id, ni.registration_id, r.phase, r.live, i.payment_crypto_currency, ni.late_support, COALESCE(p.amount, 0), p.confirmed_amount,"
     <> " p.received_units, p.confirmed_units, p.invoice_rate,"
     <> creditedTotal "units"
     <> ","
     <> creditedTotal "cents"
     <> ", (SELECT COUNT(*) FROM sx_badge_service_name_late_credits c WHERE c.invoice_id = ni.invoice_id), p.created_at"
 
-type LateRow = (Text, Text, NamePhase, BoolInt, BoolInt, Int, Int, Maybe Int64, Maybe Int64, Maybe Text) :. (Int64, Int, Int, UTCTime)
+type LateRow = (Text, Text, NamePhase, BoolInt, Maybe Text, Maybe LateSupport, Int, Int, Maybe Int64, Maybe Int64) :. (Maybe Text, Int64, Int, Int, UTCTime)
 
-toLateState :: LateRow -> LateCreditState
+toLateState :: LateRow -> Either Text LateCreditState
 toLateState
-  ( (inv, reg, lsPhase, BI lsLive, BI lsCard, lsReceivedCents, lsConfirmedCents, lsReceivedUnits, lsConfirmedUnits, lsInvoiceRate)
-      :. (lsCreditedUnits, lsCreditedCents, lsCredits, lsPaymentCreatedAt)
-    ) =
-    LateCreditState {lsInvoice = InvoiceId inv, lsRegistration = RegistrationId reg, lsPhase, lsLive, lsCard, lsReceivedCents, lsConfirmedCents, lsReceivedUnits, lsConfirmedUnits, lsInvoiceRate, lsCreditedUnits, lsCreditedCents, lsCredits, lsPaymentCreatedAt}
+  ( (inv, reg, lsPhase, BI lsLive, coin_, lsSupport, lsReceivedCents, lsConfirmedCents, lsReceivedUnits, lsConfirmedUnits)
+      :. (lsInvoiceRate, lsCreditedUnits, lsCreditedCents, lsCredits, lsPaymentCreatedAt)
+    ) = do
+    lsCoin <- traverse (\c -> note ("invoices.payment_crypto_currency: " <> c) (textToCryptoCurrency c)) coin_
+    pure LateCreditState {lsInvoice = InvoiceId inv, lsRegistration = RegistrationId reg, lsPhase, lsLive, lsCoin, lsSupport, lsReceivedCents, lsConfirmedCents, lsReceivedUnits, lsConfirmedUnits, lsInvoiceRate, lsCreditedUnits, lsCreditedCents, lsCredits, lsPaymentCreatedAt}
 
 -- | Nothing without a payment row.
 lateCreditState :: DB.Connection -> InvoiceId -> IO (Maybe LateCreditState)
-lateCreditState db (InvoiceId invId) = maybeFirstRow toLateState $ DB.query db (lateColumns <> lateFrom <> " WHERE ni.invoice_id = ?") (Only invId)
+lateCreditState db (InvoiceId invId) = firstDecoded toLateState $ DB.query db (lateColumns <> lateFrom <> " WHERE ni.invoice_id = ?") (Only invId)
 
 -- | Run after the invoice's lock. The order's balance is credited only when the credit's row is new, so a taken credit number changes neither.
 creditLatePayment :: DB.Connection -> LateCredit -> UTCTime -> IO Bool
@@ -1086,6 +1114,21 @@ latePending db (InvoiceId invId) =
   maybe Nothing fromOnly . listToMaybe
     <$> DB.query db ("SELECT" <> pendingCase <> lateFrom <> " WHERE ni.invoice_id = ? AND" <> closedUnpaid) (invId, PUnpaid)
 
+-- | Nothing once all of the closed order's money is credited, whatever support reason was given before.
+lateWait :: DB.Connection -> InvoiceId -> IO (Maybe LateWait)
+lateWait db (InvoiceId invId) =
+  maybe Nothing waitOf . listToMaybe
+    <$> DB.query db ("SELECT" <> pendingCase <> ", ni.late_support" <> lateFrom <> " WHERE ni.invoice_id = ? AND" <> closedUnpaid) (invId, PUnpaid)
+  where
+    waitOf :: (Maybe LatePending, Maybe LateSupport) -> Maybe LateWait
+    waitOf = \case
+      (Nothing, _) -> Nothing
+      (Just _, Just _) -> Just LWSupport
+      (Just LPUncounted, Nothing) -> Just LWSupport
+      (Just LPUncredited, Nothing) -> Just LWCrediting
+      (Just LPConfirming, Nothing) -> Just LWConfirming
+      (Just LPUnconfirmed, Nothing) -> Just LWConfirming
+
 -- | Closed orders' invoices with confirmed money not all credited, for the poller's credit pass.
 uncreditedLateInvoices :: DB.Connection -> IO [InvoiceId]
 uncreditedLateInvoices db =
@@ -1117,22 +1160,29 @@ lateAlertDue db cutoff =
   where
     toAlert :: LateRow :. (Maybe LatePending, Maybe Int64, Maybe UTCTime, Maybe Int64) -> Either Text LateAlert
     toAlert (row :. (pending_, laReceived, laAlertedAt, laAlertedReceived)) = case pending_ of
-      Just laPending -> Right LateAlert {laState = toLateState row, laPending, laReceived, laAlertedAt, laAlertedReceived}
+      Just laPending -> (\laState -> LateAlert {laState, laPending, laReceived, laAlertedAt, laAlertedReceived}) <$> toLateState row
       Nothing -> Left "name invoice alert without pending money"
 
--- | Marks the alert sent, unless another instance marked it since it was read; only the instance that marks it logs it.
-claimLateAlert :: DB.Connection -> LateAlert -> UTCTime -> IO Bool
-claimLateAlert db LateAlert {laState = LateCreditState {lsInvoice = InvoiceId invId}, laReceived, laAlertedAt, laAlertedReceived} now =
+-- | Marks the alert sent, with the support reason it gives unless one is set, unless another instance marked it since it was read;
+-- only the instance that marks it logs it.
+claimLateAlert :: DB.Connection -> LateAlert -> Maybe LateSupport -> UTCTime -> IO Bool
+claimLateAlert db LateAlert {laState = LateCreditState {lsInvoice = InvoiceId invId}, laReceived, laAlertedAt, laAlertedReceived} support now =
   (> 0)
     <$> executeChanging
       db
-      ( "UPDATE sx_badge_service_name_invoices SET late_alerted_at = ?, late_alerted_units = ? WHERE invoice_id = ? AND late_alerted_at"
+      ( "UPDATE sx_badge_service_name_invoices SET late_alerted_at = ?, late_alerted_units = ?, late_support = COALESCE(late_support, ?)"
+          <> " WHERE invoice_id = ? AND late_alerted_at"
           <> notDistinctFrom
           <> "? AND late_alerted_units"
           <> notDistinctFrom
           <> "?"
       )
-      (truncateToSecond now, laReceived, invId, laAlertedAt, laAlertedReceived)
+      (truncateToSecond now, laReceived, support, invId, laAlertedAt, laAlertedReceived)
+
+-- | The first reason given stays.
+setLateSupport :: DB.Connection -> InvoiceId -> LateSupport -> IO ()
+setLateSupport db (InvoiceId invId) support =
+  DB.execute db "UPDATE sx_badge_service_name_invoices SET late_support = COALESCE(late_support, ?) WHERE invoice_id = ?" (support, invId)
 
 insertPrepaidCode :: DB.Connection -> NewPrepaidCode -> UTCTime -> IO (Either CodeHashTaken Int64)
 insertPrepaidCode db NewPrepaidCode {npcCodeHash, npcMinLength, npcYears, npcPaymentStatus, npcExpiresAt} now = do
diff --git a/apps/simplex-store-service/src/StoreService/Names/View.hs b/apps/simplex-store-service/src/StoreService/Names/View.hs
index 9b188ba599..adcfd1bc9d 100644
--- a/apps/simplex-store-service/src/StoreService/Names/View.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/View.hs
@@ -36,7 +36,7 @@ import StoreService.Names.Abi (hex)
 import StoreService.Names.Chain (TxHash (..))
 import StoreService.Names.Contracts (Contracts, sponsorNonce)
 import StoreService.Names.Phases (RegistrationId (..))
-import StoreService.Names.Store (Balance (..), BalanceHold (..), NamePhase (..), NameRegistration (..), NameReveal (..), getBalance, getRegistration, heldBy)
+import StoreService.Names.Store (Balance (..), BalanceHold (..), LateWait (..), NamePhase (..), NameRegistration (..), NameReveal (..), RegistrationPayment (..), getBalance, getRegistration, heldBy, lateWait)
 
 -- | The view's chain reads; a field whose read failed is null and named in vrUnread.
 data ViewReads = ViewReads
@@ -45,11 +45,16 @@ data ViewReads = ViewReads
   }
   deriving (Eq, Show)
 
--- | The balance as it reads at the given time, when a hold may have become overdue.
+-- | The balance as it reads at the given time, when a hold may have become overdue, and what a closed order's late money waits on.
 registrationView :: DBStore -> NamesConfig -> Contracts -> UTCTime -> NameRegistration -> IO J.Value
 registrationView st cfg ct now r = do
-  balance <- withTransaction st $ \db -> getBalance db (nrId r) now
-  viewJSON cfg r balance <$> readViewChain ct r
+  (balance, late) <- withTransaction st $ \db -> do
+    balance <- getBalance db (nrId r) now
+    late <- case nrPayment r of
+      RPInvoice _ invId -> lateWait db invId
+      _ -> pure Nothing
+    pure (balance, late)
+  viewJSON cfg r balance late <$> readViewChain ct r
 
 -- | The intent nonce only in committed.
 readViewChain :: Contracts -> NameRegistration -> IO ViewReads
@@ -61,8 +66,8 @@ readViewChain ct NameRegistration {nrPhase, nrOwner} = case nrPhase of
   where
     none = ViewReads {vrIntentNonce = Nothing, vrUnread = []}
 
-viewJSON :: NamesConfig -> NameRegistration -> Maybe Balance -> ViewReads -> J.Value
-viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}} r balance ViewReads {vrIntentNonce, vrUnread} =
+viewJSON :: NamesConfig -> NameRegistration -> Maybe Balance -> Maybe LateWait -> ViewReads -> J.Value
+viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}} r balance late ViewReads {vrIntentNonce, vrUnread} =
   J.object
     [ "id" .= rid,
       "version" .= nrVersion,
@@ -83,6 +88,7 @@ viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}
       "price" .= nrPrice,
       "fromBalance" .= nrBalanceUsed,
       "balance" .= (balanceJSON <$> balance),
+      "latePayment" .= ((\w -> J.object ["waiting" .= waitingText w]) <$> late),
       "commitTx" .= (txText <$> nrCommitTx),
       "registerTx" .= (txText <$> nrRegisterTx),
       "revealAfter" .= nrRevealAfter,
@@ -96,6 +102,11 @@ viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}
     NameRegistration {nrId = RegistrationId rid, nrVersion, nrMoves, nrLinksRefusedAt, nrPhase, nrLabelHash = LabelHash lh, nrReveal, nrOwner, nrCommitment, nrSealed} = r
     NameRegistration {nrYears, nrDuration, nrPrice, nrBalanceUsed, nrCommitTx, nrRegisterTx, nrRevealAfter, nrRevealBefore, nrExpiresAt, nrError} = r
     txText (TxHash h) = hex h
+    waitingText :: LateWait -> Text
+    waitingText = \case
+      LWConfirming -> "confirming"
+      LWCrediting -> "crediting"
+      LWSupport -> "support"
 
 -- | The holder is not named, so an order's link discloses no other order.
 balanceJSON :: Balance -> J.Value
diff --git a/apps/simplex-store-service/src/StoreService/Orders.hs b/apps/simplex-store-service/src/StoreService/Orders.hs
index 879f9019b1..92023d6c78 100644
--- a/apps/simplex-store-service/src/StoreService/Orders.hs
+++ b/apps/simplex-store-service/src/StoreService/Orders.hs
@@ -14,11 +14,11 @@ module StoreService.Orders
   )
 where
 
-import StoreService.Log (logError, safelyWith)
+import StoreService.Log (logError, logInfo, safelyWith)
 import StoreService.Names.Phases (Phases, RegistrationId (..))
 import qualified StoreService.Names.Phases as Phases
-import StoreService.Names.Store (NamePhase (..), NameRegistration (..), VersionWrite (..), getRegistration, releaseHeldBalance, updateRegistration)
-import StoreService.Providers (Funded (..), PaymentSignal (..), Received (..))
+import StoreService.Names.Store (LateSupport (..), NamePhase (..), NameRegistration (..), VersionWrite (..), getRegistration, releaseHeldBalance, setLateSupport, spendHeldBalance, updateRegistration)
+import StoreService.Providers (Confirmed (..), Funded (..), PaymentSignal (..), Received (..), Uncreditable (..))
 import StoreService.Store.Invoices (InvoicePayment (..), InvoiceProduct (..), InvoiceRow (..), expireOverdueInvoice, lockInvoice, markCodePaid, paymentHolds, paymentStatusText, settlementCodeHash, settlementInvoice, truncateToSecond, updateInvoiceStatus, upsertPayment)
 import StoreService.Waiters (Waiters, publish, publishPayment)
 import Control.Concurrent.STM (STM, atomically)
@@ -85,8 +85,10 @@ data Published = PubNothing | PubStatus InvoiceStatus | PubPayment
 -- | What the invoice pays for, read before any write.
 data Product = PBadge (Maybe ByteString) | PName NameRegistration
 
--- | A name order's change at settlement: its new version, or money received after it closed, which stays unpaid.
-data NameOutcome = NOWritten RegistrationId Int64 | NOLate RegistrationId
+-- | A name order's change at settlement: its new version; money received after it closed, which stays unpaid and is credited to its balance;
+-- a holder queued whose held balance could not be spent (the holder, then the balance's order); or an order closed because another live order
+-- holds its commitment, or its owner and name.
+data NameOutcome = NOWritten RegistrationId Int64 | NOLate RegistrationId | NOHoldNotSpent RegistrationId RegistrationId | NOLiveOrderExists RegistrationId
 
 settleOrder :: DBStore -> Waiters -> Maybe Phases -> InvoiceId -> PaymentSignal -> UTCTime -> IO (Either Text InvoiceStatus)
 settleOrder st waiters phases invId signal now' = do
@@ -110,9 +112,11 @@ settleOrder st waiters phases invId signal now' = do
           PubNothing -> pure ()
         forM_ name $ \case
           NOWritten rid v -> publishRegistration phases (rid, v)
-          NOLate _ -> pure ()
+          _ -> pure ()
       forM_ name $ \case
         NOLate rid -> latePayment invId rid
+        NOHoldNotSpent holder source -> holdNotSpent invId holder source
+        NOLiveOrderExists rid -> liveOrderExists invId rid
         NOWritten {} -> pure ()
       pure (Right status)
   where
@@ -131,27 +135,34 @@ settleOrder st waiters phases invId signal now' = do
         | otherwise -> maybe (Left "settled invoice has no code hash") (Right . PBadge . Just) <$> settlementCodeHash db invId
       IPName rid -> maybe (Left "name invoice has no registration") (Right . PName) <$> getRegistration db rid
     newPayment :: InvoiceRow -> Write -> Bool
+    -- A rise of the confirmed money is a new payment with the totals unchanged, so a late payment that confirms is credited.
     newPayment InvoiceRow {irPayment} Write {wPayment}
       -- Monero reports an invoice as confirming while its figures are still zero, so a funded verdict earns a row
       | not (paidInFull signal) && rcvCrypto == Nothing && rcvAmount == CurrencyAmount 0 = False
       | otherwise = case irPayment of
           Nothing -> True
           -- the write is monotonic, so a lower figure or withdrawn verdict is not a new payment
-          Just InvoicePayment {ipAmount, ipCryptoPaid, ipPaidInFull, ipStatus}
+          Just InvoicePayment {ipAmount, ipCryptoPaid, ipPaidInFull, ipStatus, ipConfirmed = Confirmed {cfCents = CurrencyAmount heldCents, cfUnits = heldUnits}}
             | ipStatus == paymentStatusText PSSettled -> False
             | otherwise ->
                 maybe True (\(CurrencyAmount held) -> held < minor) ipAmount
                   || (ipCryptoPaid == Nothing && rcvCrypto /= Nothing)
                   || (paidInFull signal && not ipPaidInFull)
                   || ipStatus /= paymentStatusText wPayment
+                  || confirmedCents > heldCents
+                  || maybe False (> fromMaybe 0 heldUnits) confirmedUnits
       where
-        Received {rcvAmount, rcvCrypto} = received signal
+        Received {rcvAmount, rcvCrypto, rcvConfirmed = Confirmed {cfCents = CurrencyAmount confirmedCents, cfUnits = confirmedUnits}} = received signal
         CurrencyAmount minor = rcvAmount
     settle :: DB.Connection -> InvoiceRow -> Write -> Product -> IO (Either Text (InvoiceStatus, Published, [NameOutcome]))
     settle db row@InvoiceRow {irStatus} w@Write {wStatus, wPayment} sold = do
-      let Received {rcvAmount, rcvCrypto, rcvDue} = received signal
+      let money@Received {rcvUncreditable} = received signal
           wrotePayment = newPayment row w
-      when wrotePayment $ upsertPayment db row wPayment rcvAmount rcvCrypto rcvDue (paidInFull signal) at
+      when wrotePayment $ do
+        upsertPayment db row wPayment money (paidInFull signal) at
+        case sold of
+          PName _ -> mapM_ (setLateSupport db invId . lateSupportOf) rcvUncreditable
+          PBadge _ -> pure ()
       moved <- maybe (pure True) (\new -> updateInvoiceStatus db invId irStatus new at) wStatus
       if moved
         then do
@@ -169,20 +180,26 @@ settleOrder st waiters phases invId signal now' = do
 -- BTCPay reports money paid into a closed invoice as Expired or Invalid, not Settled, so a new payment figure
 -- on a closed invoice is late too; the monotonic payment write reports each figure once.
 nameSettled :: DB.Connection -> InvoiceStatus -> Maybe InvoiceStatus -> Bool -> Bool -> NameRegistration -> UTCTime -> IO [NameOutcome]
-nameSettled db before after wrotePayment holdsMoney r@NameRegistration {nrId, nrPhase} now
+nameSettled db before after wrotePayment holdsMoney r@NameRegistration {nrId, nrPhase, nrBalanceSource, nrBalanceUsed} now
   | nrPhase /= PUnpaid = pure []
   | otherwise = case after of
       Just ISPaid
         | before /= ISOpen -> pure [NOLate nrId]
         | otherwise ->
             updateRegistration db r {nrPhase = PQueued} now >>= \case
-              Written v -> pure [NOWritten nrId v]
+              Written v -> (NOWritten nrId v :) <$> spendHold
               NotLive -> pure [NOLate nrId]
-              -- not expected while this order is live; kept so the payment is still recorded
-              LiveOrderExists -> pure [NOLate nrId]
+              -- an invariant broke; left live, the order would keep its hold for ever, as no sweep closes a paid invoice
+              LiveOrderExists -> (<> [NOLate nrId, NOLiveOrderExists nrId]) <$> closed
               _ -> E.throwIO (RegistrationChanged nrId)
-      Just ISExpired -> (<> [NOLate nrId | holdsMoney]) . maybe [] (\(rid, v) -> [NOWritten rid v]) <$> closeOrder db r now
+      Just ISExpired -> (<> [NOLate nrId | holdsMoney]) <$> closed
       _ -> pure [NOLate nrId | before /= ISOpen, wrotePayment]
+  where
+    closed = maybe [] (\(rid, v) -> [NOWritten rid v]) <$> closeOrder db r now
+    -- the buyer paid the difference, so the order stays queued even when its hold cannot be spent
+    spendHold = case nrBalanceSource of
+      Just source -> (\spent -> [NOHoldNotSpent nrId source | not spent]) <$> spendHeldBalance db nrId nrBalanceUsed now
+      Nothing -> pure []
 
 -- | Clears a live unpaid order's live flag, as its invoice closes in the same transaction, and releases a balance it held.
 closeOrder :: DB.Connection -> NameRegistration -> UTCTime -> IO (Maybe (RegistrationId, Int64))
@@ -200,9 +217,26 @@ closeInvoiceOrder db invId now =
     Just InvoiceRow {irProduct = IPName rid} -> getRegistration db rid >>= maybe (pure Nothing) (\r -> closeOrder db r now)
     _ -> pure Nothing
 
+lateSupportOf :: Uncreditable -> LateSupport
+lateSupportOf = \case
+  UCHighSpeed -> LSHighSpeed
+  UCUncounted -> LSUnits
+
 latePayment :: InvoiceId -> RegistrationId -> IO ()
 latePayment (InvoiceId invText) (RegistrationId rid) =
-  logError ("names: invoice " <> invText <> " was paid after its order closed, so registration " <> rid <> " stays unpaid; refund the payment")
+  logInfo ("names: invoice " <> invText <> " received money after registration " <> rid <> " closed; it stays unpaid, and its confirmed money is credited to its balance")
+
+holdNotSpent :: InvoiceId -> RegistrationId -> RegistrationId -> IO ()
+holdNotSpent (InvoiceId invText) (RegistrationId holder) (RegistrationId source) =
+  logError $
+    "names: invoice " <> invText <> " queued registration " <> holder <> " as paid, but the balance of registration " <> source
+      <> " it held could not be spent; check that balance and release or spend its hold by hand"
+
+liveOrderExists :: InvoiceId -> RegistrationId -> IO ()
+liveOrderExists (InvoiceId invText) (RegistrationId rid) =
+  logError $
+    "names: invoice " <> invText <> " was paid while another live order held the commitment, or the owner and name, of registration " <> rid
+      <> "; it was closed and its money is credited to its balance; the unique live indexes should have prevented this"
 
 -- | False when the invoice was no longer open. Throws RegistrationChanged, changing nothing, when its order changed meanwhile.
 -- The provider has taken the cancel, so a name invoice a payment landed on meanwhile expires too, and its payment is late.
diff --git a/apps/simplex-store-service/src/StoreService/Poller.hs b/apps/simplex-store-service/src/StoreService/Poller.hs
index 3d2cb4a8be..5138b6e547 100644
--- a/apps/simplex-store-service/src/StoreService/Poller.hs
+++ b/apps/simplex-store-service/src/StoreService/Poller.hs
@@ -28,15 +28,18 @@ module StoreService.Poller
     cleanupReadsPerPass,
     unpaidRetention,
     cleanupUnpaid,
+    creditPass,
+    forgetRates,
   )
 where
 
 import StoreService.Config (PollConfig (..))
+import StoreService.Names.LateCredits (CreditOutcome (..), creditLateInvoice)
 import StoreService.Names.Phases (Phases, RegistrationId (..))
-import StoreService.Names.Store (CleanupKept (..), deleteUnpaidRegistration, unpaidCleanupCandidates)
+import StoreService.Names.Store (CleanupKept (..), LateAlert (..), LateCredit (..), LateCreditState (..), LatePending (..), LateSupport (..), claimLateAlert, deleteUnpaidRegistration, lateAlertDue, latePending, uncreditedLateInvoices, unpaidCleanupCandidates)
 import StoreService.Orders (decide, expireOverdue, settleOrder)
-import StoreService.Providers (ListPass (..), PaymentSignal (..), Provider (..), ProviderError (..), Received (..), expiresItself, settleWindow)
-import StoreService.Store.Invoices (InvoiceProduct (..), InvoiceRow (..), OverdueInvoice (..), getInvoice, getInvoiceByProviderRef, overdueInvoices, providerText, unpaidRefs)
+import StoreService.Providers (ListPass (..), PaymentSignal (..), Provider (..), ProviderError (..), Rate (..), Received (..), expiresItself, settleWindow)
+import StoreService.Store.Invoices (InvoiceProduct (..), InvoiceRow (..), OverdueInvoice (..), cryptoCurrencyText, getInvoice, getInvoiceByProviderRef, overdueInvoices, providerText, unpaidRefs)
 import StoreService.Waiters (Waiters, waitingCount, waitingCountSTM)
 import Control.Concurrent.STM
 import StoreService.Log (logError, logInfo, logWarn, safely, safelyWith)
@@ -50,7 +53,7 @@ import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime)
 import Numeric.Natural (Natural)
-import Simplex.Chat.PaymentService.Types (InvoiceId (..), InvoiceStatus (..), PaymentProvider (..))
+import Simplex.Chat.PaymentService.Types (CryptoCurrency (..), InvoiceId (..), InvoiceStatus (..), PaymentProvider (..))
 import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
 import Simplex.Messaging.Util (tshow)
 
@@ -120,7 +123,10 @@ data PollerEnv = PollerEnv
     peCancelFailed :: TVar (Map Text UTCTime),
     peCleanedAt :: TVar (Maybe UTCTime),
     -- | The orders of the day's cleanup not read yet.
-    peCleanupLeft :: TVar [(RegistrationId, InvoiceId)]
+    peCleanupLeft :: TVar [(RegistrationId, InvoiceId)],
+    peCreditedAt :: TVar (Maybe UTCTime),
+    -- | The rates read in this pass or hinted read, by provider and coin.
+    peRates :: TVar (Map (Text, Text) (Either ProviderError Rate))
   }
 
 newPollerEnv :: DBStore -> Waiters -> Maybe Phases -> ReadHints -> [Provider] -> PollConfig -> IO PollerEnv
@@ -130,13 +136,16 @@ newPollerEnv peStore peWaiters pePhases peHints peProviders pePoll = do
   peCancelFailed <- newTVarIO M.empty
   peCleanedAt <- newTVarIO Nothing
   peCleanupLeft <- newTVarIO []
-  pure PollerEnv {peStore, peWaiters, pePhases, peHints, peProviders, pePoll, peSkipped, peListedAt, peStrayEvery = strayListInterval, peCancelFailed, peCleanedAt, peCleanupLeft}
+  peCreditedAt <- newTVarIO Nothing
+  peRates <- newTVarIO M.empty
+  pure PollerEnv {peStore, peWaiters, pePhases, peHints, peProviders, pePoll, peSkipped, peListedAt, peStrayEvery = strayListInterval, peCancelFailed, peCleanedAt, peCleanupLeft, peCreditedAt, peRates}
 
 -- | Read providers before the sweep, and leave out of the sweep every invoice whose read or settlement failed,
 -- so an invoice with money in it is never expired. A list that cannot account for every invoice skips the sweep.
 runOnePass :: PollerEnv -> IO ()
 runOnePass env@PollerEnv {peStore, peProviders} = do
   now <- getCurrentTime
+  forgetRates env
   rows <- unpaidRefs peStore (addUTCTime (negate settleWindow) now)
   let bulk = length rows > readsPerPass
   listNow <- listDue env now bulk
@@ -152,6 +161,7 @@ runOnePass env@PollerEnv {peStore, peProviders} = do
   pruneSkipLog env now
   -- the cleanup runs whatever the sweep met
   unless (null peProviders) $ forM_ missed $ \refs -> safely "badge poller: the sweep" (sweepExpired env now refs)
+  void $ safely "names: the late credit pass" (creditPass env now)
   cleanupUnpaid env now
 
 -- | The cases the stray list catches are rare and not urgent, so minutes, not the pass cadence.
@@ -220,19 +230,27 @@ listPass env now p =
         skipWhat (ref, _) = "badge poller: reading the skipped " <> tshow (pProvider p) <> " invoice " <> fromMaybe "the provider did not name" ref
 
 -- | provider_ref is unique table-wide, not per provider, so check the provider too.
+-- A name invoice's late money is credited after the settlement that recorded it commits.
 settleMoved :: PollerEnv -> PaymentProvider -> UTCTime -> (Text, PaymentSignal) -> IO ()
-settleMoved env@PollerEnv {peStore, peWaiters, pePhases} provider now (ref, signal) =
+settleMoved env@PollerEnv {peStore, peWaiters, pePhases, peProviders} provider now (ref, signal) =
   getInvoiceByProviderRef peStore ref >>= \case
     Just InvoiceRow {irInvoiceId, irStatus, irProvider, irProduct} | irProvider == provider ->
       when (isJust (decide irStatus signal)) $
         settleOrder peStore peWaiters pePhases irInvoiceId signal now >>= \case
           Left e -> logError ("badge poller: settling order " <> ref <> " failed: " <> e)
-          Right status -> reportSettled irProduct irStatus status
+          Right status -> do
+            reportSettled irProduct irStatus status
+            case (irProduct, find ((== provider) . pProvider) peProviders) of
+              (IPName _, Just p) ->
+                creditLate env p now irInvoiceId >>= \case
+                  CONothingDue -> pendingLate env irInvoiceId
+                  _ -> pure ()
+              _ -> pure ()
     _ -> pure ()
   where
     reportSettled sold before after
       -- checked before the no-change case, so a refund still alerts when money lands after expiry;
-      -- settlement itself alerts once for a name order's late payment
+      -- a name order's late payment is credited to its balance instead
       | IPBadge {} <- sold, after == ISExpired, SigClosed Received {rcvCrypto = Just paid} <- signal = do
           let alert = "badge poller: order " <> ref <> " expired holding " <> paid <> ", which needs a refund"
           due <- dueToWarn env now alert
@@ -243,6 +261,7 @@ settleMoved env@PollerEnv {peStore, peWaiters, pePhases} provider now (ref, sign
 serveHint :: PollerEnv -> Text -> IO ()
 serveHint env ref = do
   now <- getCurrentTime
+  forgetRates env
   hintSafely env now ref
 
 readHint :: PollerEnv -> UTCTime -> Text -> IO ()
@@ -276,12 +295,14 @@ cleanupDue PollerEnv {peCleanedAt} now = atomically $ do
   pure due
 
 -- | The poller reads an invoice only within settleWindow of its creation, so each order's invoice is read once more
--- before the order goes: a payment whose webhook was lost is recorded then, and the order is kept for support.
--- Each pass reads at most cleanupReadsPerPass of the day's orders.
+-- before the order goes: a payment whose webhook was lost is recorded then, and the order is kept with its balance.
+-- Each pass reads at most cleanupReadsPerPass of the day's orders. The day's alerts on late money go with it.
 cleanupUnpaid :: PollerEnv -> UTCTime -> IO ()
 cleanupUnpaid env@PollerEnv {peStore, peCleanupLeft} now = do
   due <- cleanupDue env now
-  when due $ withTransaction peStore (`unpaidCleanupCandidates` addUTCTime (negate unpaidRetention) now) >>= atomically . writeTVar peCleanupLeft
+  when due $ do
+    withTransaction peStore (`unpaidCleanupCandidates` addUTCTime (negate unpaidRetention) now) >>= atomically . writeTVar peCleanupLeft
+    void $ safely "names: the late payment alerts" (alertLatePayments env now)
   candidates <- atomically $ stateTVar peCleanupLeft (splitAt cleanupReadsPerPass)
   deleted <- filterM (\c@(RegistrationId rid, _) -> safelyWith ("names cleanup: registration " <> rid) False (cleanOne c)) candidates
   unless (null deleted) $ logInfo ("names cleanup: deleted " <> tshow (length deleted) <> " unpaid order(s)")
@@ -298,11 +319,117 @@ cleanupUnpaid env@PollerEnv {peStore, peCleanupLeft} now = do
                 mapM_ (\signal -> settleMoved env irProvider now (irProviderRef, signal)) signal_
                 withTransaction peStore (`deleteUnpaidRegistration` rid) >>= \case
                   Right () -> pure True
-                  Left CKPaid -> False <$ logError ("names cleanup: unpaid registration " <> ridText <> " is kept because invoice " <> invText <> " received a payment; refund it")
+                  Left CKPaid -> False <$ logInfo ("names cleanup: unpaid registration " <> ridText <> " is kept with its balance, because invoice " <> invText <> " received a payment")
                   Left (CKHolder (RegistrationId source)) -> False <$ logError ("names cleanup: unpaid registration " <> ridText <> " is kept because it still holds the balance of registration " <> source)
       where
         keep why = False <$ logWarn ("names cleanup: unpaid registration " <> ridText <> " is kept until the next run, " <> why)
 
+-- | At the idle cadence, so a failing rate read costs one read per coin per pass while browsers wait.
+creditDue :: PollerEnv -> UTCTime -> IO Bool
+creditDue PollerEnv {peCreditedAt, pePoll = PollConfig {pIdleSeconds}} now = atomically $ do
+  due <- maybe True (\at -> diffUTCTime now at >= fromIntegral pIdleSeconds) <$> readTVar peCreditedAt
+  when due $ writeTVar peCreditedAt (Just now)
+  pure due
+
+-- | Credits every closed order's confirmed money not all credited, so a crash or a failed rate read after a settlement loses nothing.
+creditPass :: PollerEnv -> UTCTime -> IO ()
+creditPass env@PollerEnv {peStore, peProviders} now = do
+  due <- creditDue env now
+  when due $ do
+    invoices <- withTransaction peStore uncreditedLateInvoices
+    forM_ invoices $ \invId@(InvoiceId invText) ->
+      safely ("names: crediting invoice " <> invText) $
+        getInvoice peStore invId >>= \case
+          Just InvoiceRow {irProvider} | Just p <- find ((== irProvider) . pProvider) peProviders -> void $ creditLate env p now invId
+          _ -> logWarn ("names: invoice " <> invText <> " has late money to credit, but no provider is configured to read its rate")
+
+-- | The pass's rate of a coin at a provider, read at most once.
+cachedRate :: PollerEnv -> Provider -> CryptoCurrency -> IO (Either ProviderError Rate)
+cachedRate PollerEnv {peRates} Provider {pProvider, pCurrentRate} coin =
+  M.lookup key <$> readTVarIO peRates >>= \case
+    Just rate -> pure rate
+    Nothing -> do
+      rate <- maybe (pure $ Left $ ProviderError $ providerText pProvider <> " offers no rates") ($ coin) pCurrentRate
+      rate <$ atomically (modifyTVar' peRates (M.insert key rate))
+  where
+    key = (providerText pProvider, cryptoCurrencyText coin)
+
+-- | Each pass and hinted read reads the rates again.
+forgetRates :: PollerEnv -> IO ()
+forgetRates PollerEnv {peRates} = atomically $ writeTVar peRates M.empty
+
+creditLate :: PollerEnv -> Provider -> UTCTime -> InvoiceId -> IO CreditOutcome
+creditLate env@PollerEnv {peStore} p now invId@(InvoiceId invText) = do
+  outcome <- creditLateInvoice peStore (cachedRate env p) invId now
+  case outcome of
+    CONothingDue -> pure ()
+    COCredited LateCredit {lcRegistration = RegistrationId rid, lcUnits, lcInvoiceRate, lcCurrentRate, lcRateUsed, lcCents} ->
+      logInfo $
+        "names: invoice " <> invText <> " credited " <> tshow lcCents <> " cents to the balance of registration " <> rid
+          <> maybe "" (\units -> " for " <> tshow units <> " units at " <> fromMaybe "?" lcRateUsed <> " (invoice " <> fromMaybe "?" lcInvoiceRate <> ", current " <> fromMaybe "?" lcCurrentRate <> ")") lcUnits
+    CORateFailed (ProviderError e) -> do
+      due <- dueToWarn env now ("rate read failed: " <> tshow (pProvider p))
+      when due $ logWarn ("names: late credits wait, as the current rate cannot be read; each pass tries again: " <> e)
+    CORateFloor invoiceRate Rate {rateText} -> do
+      let alert = "names: invoice " <> invText <> " is not credited: the current rate " <> rateText <> " is below half its rate " <> invoiceRate <> "; a glitch, or a real fall the owner decides on"
+      due <- dueToWarn env now alert
+      when due $ logError alert
+    CORefused -> logError ("names: the credit of invoice " <> invText <> " was refused, its credit number taken meanwhile; the next pass tries again")
+  pure outcome
+
+-- | Money not yet confirmed waits for the settlement that confirms it.
+pendingLate :: PollerEnv -> InvoiceId -> IO ()
+pendingLate PollerEnv {peStore} invId@(InvoiceId invText) =
+  withTransaction peStore (`latePending` invId) >>= \case
+    Just pending | pending `elem` [LPConfirming, LPUnconfirmed] -> logInfo ("names: invoice " <> invText <> " holds money of its closed order not yet confirmed; it is credited once confirmed")
+    _ -> pure ()
+
+-- | Late money still not all credited when its payment row is older than the read window, once per invoice and again when more arrives;
+-- the claim keeps it to one instance.
+alertLatePayments :: PollerEnv -> UTCTime -> IO ()
+alertLatePayments env@PollerEnv {peStore} now = do
+  due <- withTransaction peStore (`lateAlertDue` addUTCTime (negate settleWindow) now)
+  forM_ due $ \alert@LateAlert {laState = LateCreditState {lsInvoice = InvoiceId invText}} ->
+    safely ("names: the alert on invoice " <> invText) $ do
+      (reason, support) <- lateReason env alert
+      claimed <- withTransaction peStore $ \db -> claimLateAlert db alert support now
+      when claimed $ logError (lateAlertText alert reason)
+
+lateReason :: PollerEnv -> LateAlert -> IO (Text, Maybe LateSupport)
+lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState = LateCreditState {lsInvoice, lsCoin, lsSupport, lsInvoiceRate}} = case laPending of
+  LPUncounted -> pure (uncounted, Nothing)
+  _ | lsSupport == Just LSHighSpeed -> pure (highSpeed, Nothing)
+  LPUncredited -> case lsCoin of
+    Nothing -> pure (cardWaits, Nothing)
+    Just coin
+      | lsSupport == Just LSRateFloor ->
+          getInvoice peStore lsInvoice >>= \case
+            Just InvoiceRow {irProvider} | Just p <- find ((== irProvider) . pProvider) peProviders -> either (const (rateRead, Nothing)) (\Rate {rateText} -> (rateFloor rateText, Nothing)) <$> cachedRate env p coin
+            _ -> pure (rateRead, Nothing)
+      | otherwise -> pure (rateRead, Nothing)
+  _ -> pure (unconfirmed, Just LSUnconfirmed)
+  where
+    unconfirmed = "refund by hand only a transaction confirmed on chain that BTCPay no longer monitors; one still Processing there waits"
+    highSpeed = "the invoice was made under HighSpeed, so its money is never credited by itself; refund by hand only a transaction confirmed on chain"
+    rateRead = "confirmed, the credit waits on the rate read; do not refund; fix the rate read"
+    cardWaits = "confirmed, the credit waits on the poller's credit pass; do not refund; check the service log"
+    rateFloor current = "confirmed; the coin's price fell by more than half since the invoice (" <> fromMaybe "?" lsInvoiceRate <> ", " <> current <> "); the owner decides: credit at the current rate, or refund by hand"
+    uncounted = "an amount BTCPay reported with more decimals than its unit; check it at the provider"
+
+lateAlertText :: LateAlert -> Text -> Text
+lateAlertText LateAlert {laState = LateCreditState {lsInvoice = InvoiceId invText, lsRegistration = RegistrationId rid, lsCoin, lsReceivedCents, lsConfirmedCents, lsCreditedCents, lsReceivedUnits, lsConfirmedUnits, lsCreditedUnits}} reason =
+  "names: invoice " <> invText <> " of order " <> rid <> ": " <> figures <> "; " <> reason
+  where
+    figures = case (lsCoin, lsReceivedUnits) of
+      (Nothing, _) -> amounts "cents" (toInteger lsReceivedCents) (toInteger lsConfirmedCents) (toInteger lsCreditedCents)
+      (Just coin, Just received) -> amounts (unitName coin) (toInteger received) (maybe 0 toInteger lsConfirmedUnits) (toInteger lsCreditedUnits)
+      (Just _, Nothing) -> tshow lsReceivedCents <> " cents received at the invoice's rate, not counted in units"
+    amounts unit received confirmed credited =
+      tshow received <> " " <> unit <> " received, " <> tshow confirmed <> " " <> unit <> " confirmed, " <> tshow credited <> " " <> unit <> " credited"
+    unitName = \case
+      CCBtc -> "satoshi"
+      CCXmr -> "piconero"
+
 -- | Cancel the order at the provider first, so the buyer can no longer pay it.
 closedAtProvider :: PollerEnv -> UTCTime -> OverdueInvoice -> IO Bool
 closedAtProvider env@PollerEnv {peProviders} now oi@OverdueInvoice {oiProvider, oiProviderRef = ref} =
diff --git a/apps/simplex-store-service/src/StoreService/Store/Invoices.hs b/apps/simplex-store-service/src/StoreService/Store/Invoices.hs
index f3d093d0e1..3150470fc5 100644
--- a/apps/simplex-store-service/src/StoreService/Store/Invoices.hs
+++ b/apps/simplex-store-service/src/StoreService/Store/Invoices.hs
@@ -37,6 +37,7 @@ module StoreService.Store.Invoices
     upsertPayment,
     paymentStatusText,
     cryptoCurrencyText,
+    textToCryptoCurrency,
     textToInvoiceStatus,
     invoiceStatusText,
     updateInvoiceStatus,
@@ -49,6 +50,7 @@ import qualified Control.Exception as E
 import Crypto.Random (getRandomBytes)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as B64U
+import Data.Int (Int64)
 import qualified Data.ByteString.Char8 as BC8
 import Data.String (fromString)
 import Data.Text (Text)
@@ -66,6 +68,7 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Encoding.String (textEncode)
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
 import StoreService.Names.Phases (RegistrationId (..))
+import StoreService.Providers (Confirmed (..), Received (..))
 
 #if defined(dbPostgres)
 import StoreService.Store.Postgres.Migrations (servicePrefix, withPrefix)
@@ -108,7 +111,8 @@ data InvoicePayment = InvoicePayment
     ipCryptoDue :: Maybe Text,
     ipPaidInFull :: Bool,
     ipStatus :: Text,
-    ipUpdatedAt :: UTCTime
+    ipUpdatedAt :: UTCTime,
+    ipConfirmed :: Confirmed
   }
   deriving (Eq, Show)
 
@@ -206,7 +210,7 @@ invoiceRowSelect =
     <> ", bc.badge_type, bc.months, ni.registration_id, "
     <> "i.price, i.amount, i.currency, i.payment_url, i.payment_address, i.payment_crypto_currency, "
     <> "i.payment_crypto_amount, i.expires_at, i.status, i.created_at, "
-    <> "p.amount, p.crypto_paid, p.crypto_due, p.paid_in_full, p.status, p.updated_at "
+    <> "p.amount, p.crypto_paid, p.crypto_due, p.paid_in_full, p.status, p.updated_at, p.confirmed_amount, p.confirmed_units "
     <> "FROM @invoices i "
     <> productJoins
     <> "LEFT JOIN @payments p ON p.invoice_id = i.invoice_id "
@@ -281,17 +285,27 @@ largerOf = "GREATEST"
 largerOf = "MAX"
 #endif
 
--- Once a row is settled it stays settled, so a later pending update cannot overwrite it.
+-- Once a row is settled it stays settled, so a later pending update cannot overwrite it. The confirmed figures and received units
+-- only rise, so a settled sum that falls (a payment turned invalid, a reorg) leaves them; the invoice's rate is written once.
 qUpsertPayment :: Query
 qUpsertPayment =
   mkQuery $
     "INSERT INTO @payments "
-      <> "(payment_id, invoice_id, provider, provider_ref, amount, currency, crypto_paid, crypto_due, paid_in_full, status, created_at, updated_at) "
-      <> "VALUES (?,?,?,?,?,?,?,?,?,?,?,?) "
+      <> "(payment_id, invoice_id, provider, provider_ref, amount, currency, crypto_paid, crypto_due, paid_in_full, status, "
+      <> "received_units, confirmed_amount, confirmed_units, invoice_rate, created_at, updated_at) "
+      <> "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) "
       <> "ON CONFLICT (payment_id) DO UPDATE SET "
       <> "amount = "
       <> largerOf
       <> "(COALESCE(@payments.amount, 0), excluded.amount), "
+      <> "received_units = "
+      <> largerOfNullable "received_units"
+      <> ", confirmed_amount = "
+      <> largerOf
+      <> "(@payments.confirmed_amount, excluded.confirmed_amount), "
+      <> "confirmed_units = "
+      <> largerOfNullable "confirmed_units"
+      <> ", invoice_rate = COALESCE(@payments.invoice_rate, excluded.invoice_rate), "
       <> "crypto_paid = CASE WHEN excluded.amount > COALESCE(@payments.amount, 0) OR @payments.crypto_paid IS NULL "
       <> "THEN excluded.crypto_paid ELSE @payments.crypto_paid END, "
       <> "crypto_due = COALESCE(excluded.crypto_due, @payments.crypto_due), "
@@ -306,6 +320,8 @@ qUpsertPayment =
       <> " THEN @payments.updated_at ELSE excluded.updated_at END"
   where
     alreadySettled = "@payments.status = '" <> paymentStatusText PSSettled <> "'"
+    -- SQLite's MAX of a NULL is NULL, so each side falls back to the other
+    largerOfNullable column = largerOf <> "(COALESCE(@payments." <> column <> ", excluded." <> column <> "), COALESCE(excluded." <> column <> ", @payments." <> column <> "))"
 
 qLockInvoice :: Query
 qLockInvoice = mkQuery "UPDATE @invoices SET updated_at = ? WHERE invoice_id = ?"
@@ -425,14 +441,14 @@ type InvoiceCols =
   (Text, Text, Text, Maybe BadgeType, Maybe Word32, Maybe Text)
     :. (Word32, Word32, Text, Maybe Text, Maybe Text, Maybe Text)
     :. (Maybe Text, UTCTime, Text, UTCTime)
-    :. (Maybe Word32, Maybe Text, Maybe Text, Maybe Int, Maybe Text, Maybe UTCTime)
+    :. (Maybe Word32, Maybe Text, Maybe Text, Maybe Int, Maybe Text, Maybe UTCTime, Maybe Word32, Maybe Int64)
 
 mkInvoiceRow :: InvoiceCols -> Either Text InvoiceRow
 mkInvoiceRow
   ( (invId, providerTxt, providerRef, badgeType, months, registrationId)
       :. (price, amount, currency, url, addr, cryptoCur)
       :. (cryptoAmt, expiresAt, statusTxt, createdAt)
-      :. (pAmount, pCryptoPaid, pCryptoDue, pPaidInFull, pStatus, pUpdatedAt)
+      :. (pAmount, pCryptoPaid, pCryptoDue, pPaidInFull, pStatus, pUpdatedAt, pConfirmedAmount, pConfirmedUnits)
     ) = do
     provider <- note "invoices.provider" (textToProvider providerTxt)
     invoiceProduct <- case (badgeType, months, registrationId) of
@@ -454,12 +470,15 @@ mkInvoiceRow
           irExpiresAt = expiresAt,
           irStatus = status,
           irCreatedAt = createdAt,
-          irPayment = mkPayment pAmount pCryptoPaid pCryptoDue pPaidInFull pStatus pUpdatedAt
+          irPayment = mkPayment pAmount pCryptoPaid pCryptoDue pPaidInFull pStatus pUpdatedAt pConfirmedAmount pConfirmedUnits
         }
 
-mkPayment :: Maybe Word32 -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Text -> Maybe UTCTime -> Maybe InvoicePayment
-mkPayment amt cryptoPaid cryptoDue paidInFull status updatedAt =
-  InvoicePayment (CurrencyAmount <$> amt) cryptoPaid cryptoDue (paidInFull == Just 1) <$> status <*> updatedAt
+mkPayment :: Maybe Word32 -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Text -> Maybe UTCTime -> Maybe Word32 -> Maybe Int64 -> Maybe InvoicePayment
+mkPayment amt cryptoPaid cryptoDue paidInFull status updatedAt confirmedAmount confirmedUnits =
+  InvoicePayment (CurrencyAmount <$> amt) cryptoPaid cryptoDue (paidInFull == Just 1)
+    <$> status
+    <*> updatedAt
+    <*> ((\cents -> Confirmed {cfCents = CurrencyAmount cents, cfUnits = confirmedUnits}) <$> confirmedAmount)
 
 selectInvoiceRow :: DB.Connection -> Query -> Text -> IO (Maybe InvoiceRow)
 selectInvoiceRow db q param = do
@@ -659,16 +678,18 @@ settlementCodeHash db (InvoiceId invId) = do
     (Only codeHash : _) -> DB.fromBinary <$> codeHash
     [] -> Nothing
 
-upsertPayment :: DB.Connection -> InvoiceRow -> PaymentStatus -> CurrencyAmount -> Maybe Text -> Maybe Text -> Bool -> UTCTime -> IO ()
-upsertPayment db InvoiceRow {irInvoiceId, irProvider, irProviderRef, irCurrency} status (CurrencyAmount amount) cryptoAmount cryptoDue paidInFull at' =
+upsertPayment :: DB.Connection -> InvoiceRow -> PaymentStatus -> Received -> Bool -> UTCTime -> IO ()
+upsertPayment db InvoiceRow {irInvoiceId, irProvider, irProviderRef, irCurrency} status received paidInFull at' =
   DB.execute
     db
     qUpsertPayment
     ( (invId, invId, providerText irProvider, irProviderRef, amount)
-        :. (irCurrency, cryptoAmount, cryptoDue, if paidInFull then 1 :: Int else 0, paymentStatusText status, at, at)
+        :. (irCurrency, rcvCrypto, rcvDue, if paidInFull then 1 :: Int else 0, paymentStatusText status)
+        :. (rcvUnits, confirmedCents, cfUnits, rcvRate, at, at)
     )
   where
     InvoiceId invId = irInvoiceId
+    Received {rcvAmount = CurrencyAmount amount, rcvCrypto, rcvDue, rcvUnits, rcvRate, rcvConfirmed = Confirmed {cfCents = CurrencyAmount confirmedCents, cfUnits}} = received
     at = truncateToSecond at'
 
 -- | Takes the invoice row's lock for the rest of the transaction; SQLite's transactions hold the whole database already.
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 7a4f155c39..2445cac7ce 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -449,6 +449,7 @@ executable simplex-store-service
       StoreService.Names.Contracts
       StoreService.Names.Env
       StoreService.Names.Label
+      StoreService.Names.LateCredits
       StoreService.Names.Links
       StoreService.Names.Orders
       StoreService.Names.Phases
@@ -773,6 +774,7 @@ test-suite simplex-chat-test
       Bots.StoreService.NamesCodesTests
       Bots.StoreService.NamesContractsTests
       Bots.StoreService.NamesLabelTests
+      Bots.StoreService.NamesLateCreditTests
       Bots.StoreService.NamesLinksTests
       Bots.StoreService.NamesOrdersTests
       Bots.StoreService.NamesOwnerTests
@@ -814,6 +816,7 @@ test-suite simplex-chat-test
       StoreService.Names.Contracts
       StoreService.Names.Env
       StoreService.Names.Label
+      StoreService.Names.LateCredits
       StoreService.Names.Links
       StoreService.Names.Orders
       StoreService.Names.Phases
diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs
index e3cf572689..1553a778ec 100644
--- a/tests/Bots/StoreService/NamesBalancesTests.hs
+++ b/tests/Bots/StoreService/NamesBalancesTests.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Bots.StoreService.NamesBalancesTests (namesBalancesTests) where
+module Bots.StoreService.NamesBalancesTests (namesBalancesTests, fieldsN, figures, holdPrice, holder, invariantHolds, placeOrderRow, source) where
 
 import Bots.StoreService.NamesOrdersTests (Ctx (..), withOrders)
 import Bots.StoreService.NamesStoreTests (at, btc, invoiceStatus, newReg, ownerA, ownerB, paidOrder, reg, signature, t0, write)
@@ -20,7 +20,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime, addUTCTime)
-import Simplex.Chat.PaymentService.Types (CardProvider (..), InvoiceId (..), InvoiceStatus (..), ServicePaymentMethod (..))
+import Simplex.Chat.PaymentService.Types (CardProvider (..), CryptoCurrency (..), InvoiceId (..), InvoiceStatus (..), ServicePaymentMethod (..))
 import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import qualified Simplex.Messaging.Crypto as C
@@ -620,7 +620,8 @@ testLateScans = withServiceStore $ \st -> do
           lsRegistration = RegistrationId "part",
           lsPhase = PUnpaid,
           lsLive = False,
-          lsCard = False,
+          lsCoin = Just CCBtc,
+          lsSupport = Nothing,
           lsReceivedCents = 20000,
           lsConfirmedCents = 0,
           lsReceivedUnits = Just 300000,
@@ -665,7 +666,7 @@ testLateAlerts = withServiceStore $ \st -> do
       marks :: LateAlert -> (InvoiceId, LatePending, Maybe Int64, Maybe UTCTime, Maybe Int64)
       marks LateAlert {laState = LateCreditState {lsInvoice}, laPending, laReceived, laAlertedAt, laAlertedReceived} = (lsInvoice, laPending, laReceived, laAlertedAt, laAlertedReceived)
       claim :: LateAlert -> UTCTime -> IO Bool
-      claim alert t = withTransaction st $ \db -> claimLateAlert db alert t
+      claim alert t = withTransaction st $ \db -> claimLateAlert db alert Nothing t
   [old, card] <- due
   map marks [old, card]
     `shouldBe` [(InvoiceId "inv-old", LPUnconfirmed, Just 300000, Nothing, Nothing), (InvoiceId "inv-card", LPUnconfirmed, Just 5000, Nothing, Nothing)]
@@ -688,7 +689,7 @@ testUncountedAlertRepeats = withServiceStore $ \st -> do
       due = withTransaction st $ \db -> lateAlertDue db (at 60)
   [alert] <- due
   (laPending alert, laReceived alert) `shouldBe` (LPUncounted, Just 5000)
-  withTransaction st (\db -> claimLateAlert db alert (at 61)) `shouldReturn` True
+  withTransaction st (\db -> claimLateAlert db alert Nothing (at 61)) `shouldReturn` True
   due `shouldReturn` []
   withTransaction st $ \db -> DB.execute db "UPDATE sx_badge_service_payments SET amount = ? WHERE invoice_id = ?" (6000 :: Int, "inv-x" :: Text)
   map (\LateAlert {laPending, laReceived, laAlertedReceived} -> (laPending, laReceived, laAlertedReceived)) <$> due `shouldReturn` [(LPUncounted, Just 6000, Just 5000)]
diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
new file mode 100644
index 0000000000..ff487e1e98
--- /dev/null
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -0,0 +1,664 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+
+module Bots.StoreService.NamesLateCreditTests (namesLateCreditTests) where
+
+import Bots.StoreService.NamesBalancesTests (fieldsN, figures, holder, invariantHolds, placeOrderRow, source)
+import Bots.StoreService.NamesStoreTests (at, newReg, ownerA, reg, t0)
+import Bots.StoreService.WebTests (StubCall (..), StubState (..), capturingStderr, newStubState, sampleProviderInvoice, setSignals, stubCalls, stubProvider, withServiceStore)
+import Control.Monad (void)
+import qualified Data.Aeson as J
+import Data.Int (Int64)
+import Data.IORef (IORef, atomicModifyIORef', newIORef)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime)
+import Simplex.Chat.PaymentService.Types (CurrencyAmount (..), InvoiceId (..), InvoiceStatus (..), PaymentProvider (..))
+import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
+import qualified Simplex.Messaging.Agent.Store.DB as DB
+import StoreService.Config (PollConfig (..))
+import StoreService.Names.Balances (RefundRefusal (..), recordRefund)
+import StoreService.Names.LateCredits (CreditOutcome (..), creditLateInvoice)
+import StoreService.Names.Phases (RegistrationId (..))
+import StoreService.Names.Store
+import StoreService.Names.Turns (newTurns)
+import StoreService.Names.View (balanceJSON)
+import StoreService.Orders (cancelOpenInvoice, settleOrder)
+import StoreService.Poller (PollerEnv, ReadHints, cleanupUnpaid, creditPass, drainHints, forgetRates, newPollerEnv, newReadHints, queueReadHint)
+import StoreService.Providers (Confirmed (..), Funded (..), PaymentSignal (..), Provider (..), ProviderError (..), Rate (..), Received (..), Uncreditable (..), settleWindow)
+import StoreService.Store.Invoices (unpaidRefs)
+import StoreService.Waiters (Waiters, newWaiters)
+import Test.Hspec
+
+#if defined(dbPostgres)
+import Bots.StoreService.WebTests (withServiceStores)
+import Control.Concurrent.Async (concurrently)
+import Control.Concurrent.STM (TVar, atomically, check, modifyTVar', newTVarIO, readTVar)
+import Control.Monad (forM, forM_)
+import Data.Maybe (fromJust, fromMaybe)
+import Simplex.Chat.PaymentService.Types (CryptoCurrency)
+import StoreService.Names.LateCredits (lateCreditOf)
+import StoreService.Store.Invoices (lockInvoice)
+import Database.PostgreSQL.Simple (Only (..))
+#else
+import Database.SQLite.Simple (Only (..))
+#endif
+
+namesLateCreditTests :: Spec
+namesLateCreditTests = describe "StoreService names: balance life" $ do
+  describe "settlement" $ do
+    it "queues a held order and spends its hold, the source's amount down by fromBalance" testHeldSettled
+    it "queues a difference order funded before its expiry and settled after it, still open in the database, spending its hold" testFundedThenSettledLate
+    it "queues an order whose hold was removed by hand and alerts naming the order and the balance's order" testHoldNotSpent
+    it "closes an order meeting another live order at settlement, alerts, and credits its payment after" testLiveOrderExists
+    it "releases a difference order's hold in that settlement's transaction and credits its own balance after, by the credit step" testLiveOrderExistsHolder
+    it "refuses a refund while the hold is open and spends the balance at settlement" testSettlementBeforeRefund
+  describe "late credits" $ do
+    it "credits a late payment to the closed order's balance at the lower rate, the released source's balance untouched, logged at info" testLateCredited
+    it "credits at the invoice's rate when the price rose, storing both rates and the rate used" testRisingPrice
+    it "credits a payment confirming over two reports by its increase, and a repeated report once" testGrowingReports
+    it "credits a confirmed part payment the provider's close meets, and a cancel's at the pass, the cancel reading no rate" testCloseAndCancel
+    it "credits nothing for unconfirmed money, logged as pending, then once when it reads Settled with the totals unchanged" testUnconfirmedThenSettled
+    it "never credits a replaced or dropped payment, alerting it once past the window from its payment row, never again" testNeverConfirmed
+    it "alerts a part credit with an unconfirmed rest once, naming its units" testPartCreditAlerted
+    it "logs Monero's zero figure as pending and does not alert it within the window" testMoneroZero
+    it "credits nothing while the rate read fails, warning once, then credits at the next pass" testRateFails
+    it "credits nothing below the rate floor, logging an error, and alerts naming both rates and the owner's decision" testRateFloor
+    it "reads one rate per coin per pass for several invoices, and none when nothing is due" testOneRateReadPerPass
+    it "never credits a late Settled payment on an invoice made under HighSpeed, alerting it past the window" testHighSpeed
+    it "credits at the next pass a late Settled invoice and a settlement whose credit step did not run" testCreditedByPass
+    it "refuses to credit an order that is live again by the time it takes the invoice's lock" testLiveAgain
+    it "alerts once of two instances, and again when more money arrives" testTwoInstancesAlert
+    it "keeps the confirmed figure and the credit when the settled sum falls, crediting nothing on the same sum again" testFallingSum
+    it "credits an invoice past the read window after a hinted read" testHintPastWindow
+    it "credits Stripe's succeeded amount without reading a rate" testStripeCredited
+  describe "balances with late credits" $ do
+    it "keeps a credit made while the balance is held, the held spend settling" testCreditWhileHeld
+    it "refuses a covered spend that read the amount before a credit" testSpendBeforeCredit
+    it "sums the refunds over credit, refund, late credit, refund" testCreditRefundTwice
+    it "spends a late credit with a covered spend and refunds the rest" testSpendAndRefundLate
+  describe "the view" $ do
+    it "shows a balance spent to 0 and a refunded one as objects with amount 0" testZeroBalances
+    it "waits confirming, crediting, or support for each reason, and on nothing once all is credited" testLateWaits
+#if defined(dbPostgres)
+  describe "two connections" $ do
+    it "credits once of two credit steps on one invoice, cleanly, where a step reading before the lock is refused" testConcurrentCredits
+    it "credits the confirmed units once against a settlement raising them" testCreditAgainstSettlement
+#endif
+
+-- fixtures
+
+data Late = Late
+  { lStore :: DBStore,
+    lStub :: IORef StubState,
+    lPoller :: PollerEnv,
+    lHints :: ReadHints,
+    lWaiters :: Waiters
+  }
+
+withLate :: (Late -> IO a) -> IO a
+withLate action = withServiceStore (`withLateOn` action)
+
+-- | Another poller over the store, as another instance or a restarted service runs.
+withLateOn :: DBStore -> (Late -> IO a) -> IO a
+withLateOn lStore action = do
+  lStub <- newIORef (newStubState (Right sampleProviderInvoice))
+  lWaiters <- newWaiters
+  lHints <- newReadHints
+  let crypto = stubProvider lStub
+      card = crypto {pProvider = PPStripe, pCurrentRate = Nothing}
+  lPoller <- newPollerEnv lStore lWaiters Nothing lHints [crypto, card] PollConfig {pWaitingSeconds = 1, pIdleSeconds = 1}
+  action Late {lStore, lStub, lPoller, lHints, lWaiters}
+
+-- | The invoices' rate, 62500 dollars a bitcoin, is 0.0625 cents a satoshi.
+satCents :: Int64 -> Int
+satCents units = fromIntegral (units * 625 `div` 10000)
+
+-- | Bitcoin received and confirmed, in satoshi, at the invoices' rate.
+btcPaid :: Int64 -> Int64 -> Received
+btcPaid units confirmed =
+  Received
+    { rcvAmount = CurrencyAmount (fromIntegral $ satCents units),
+      rcvCrypto = Just (T.pack $ show units),
+      rcvDue = Nothing,
+      rcvUnits = Just units,
+      rcvRate = Just "62500",
+      rcvConfirmed = Confirmed {cfCents = CurrencyAmount (fromIntegral $ satCents confirmed), cfUnits = Just confirmed},
+      rcvUncreditable = Nothing
+    }
+
+cardPaid :: Int -> Int -> Received
+cardPaid cents confirmed =
+  Received
+    { rcvAmount = CurrencyAmount (fromIntegral cents),
+      rcvCrypto = Nothing,
+      rcvDue = Nothing,
+      rcvUnits = Nothing,
+      rcvRate = Nothing,
+      rcvConfirmed = Confirmed {cfCents = CurrencyAmount (fromIntegral confirmed), cfUnits = Nothing},
+      rcvUncreditable = Nothing
+    }
+
+nothingPaid :: Received
+nothingPaid = cardPaid 0 0
+
+-- | 320000 satoshi: 20000 cents at the invoice's rate, 19200 at the stub's current rate of 60000.5.
+lateUnits :: Int64
+lateUnits = 320000
+
+invOf :: Text -> InvoiceId
+invOf r = InvoiceId ("inv-" <> r)
+
+refOf :: Text -> Text
+refOf r = "ref-inv-" <> r
+
+setRate :: Late -> Either ProviderError Rate -> IO ()
+setRate Late {lStub} r = atomicModifyIORef' lStub $ \s -> (s {ssRate = r}, ())
+
+rateOf :: Text -> Rational -> Rate
+rateOf t v = Rate {rateText = t, rateValue = fromRational v}
+
+stubRate :: Rate
+stubRate = rateOf "60000.5" 60000.5
+
+-- | An unpaid order of 20000 cents, crypto unless card, whose invoice the provider closed with nothing received.
+closedOrder :: Late -> Text -> Bool -> IO ()
+closedOrder l@Late {lStore} r card = do
+  placeOrderRow lStore r card 20000 (at 60)
+  settleAt l r (SigClosed nothingPaid) (at 61) `shouldReturn` Right ISExpired
+  NameRegistration {nrPhase, nrLive} <- reg lStore r
+  (nrPhase, nrLive) `shouldBe` (PUnpaid, False)
+
+-- | The provider reports the signal for the order's invoice, and the poller reads it on a hint, as a webhook asks; the logs.
+readSignal :: Late -> Text -> PaymentSignal -> IO Text
+readSignal Late {lStub, lHints, lPoller} r signal = do
+  setSignals lStub [(refOf r, signal)]
+  capturingStderr $ void (queueReadHint lHints (refOf r)) >> drainHints lPoller
+
+-- | Settled straight in the store at the given time, with no credit step after it.
+settleAt :: Late -> Text -> PaymentSignal -> UTCTime -> IO (Either Text InvoiceStatus)
+settleAt Late {lStore, lWaiters} r = settleOrder lStore lWaiters Nothing (invOf r)
+
+-- | A new pass's credits; the logs.
+passAt :: Late -> UTCTime -> IO Text
+passAt Late {lPoller} now = capturingStderr $ forgetRates lPoller >> creditPass lPoller now
+
+-- | The daily alerts of a newly started instance at the given time, with its rates; the logs.
+alertsAt :: Late -> Either ProviderError Rate -> UTCTime -> IO Text
+alertsAt Late {lStore} r now = withLateOn lStore $ \l@Late {lPoller} -> setRate l r >> capturingStderr (cleanupUnpaid lPoller now)
+
+-- | Amount, credited and refunded of the order's balance.
+balanceOf :: DBStore -> Text -> IO (Maybe (Int, Int, Int))
+balanceOf st r = fmap (\(amount, credited, refunded, _) -> (amount, credited, refunded)) <$> figures st r t0
+
+-- | Units, the invoice's, current and used rates, and cents of each credit of the order's invoice.
+creditsOf :: DBStore -> Text -> IO [(Maybe Int64, Maybe Text, Maybe Text, Maybe Text, Int)]
+creditsOf st r =
+  withTransaction st $ \db ->
+    DB.query db "SELECT units, invoice_rate, current_rate, rate_used, cents FROM sx_badge_service_name_late_credits WHERE invoice_id = ? ORDER BY credit_no" (Only $ "inv-" <> r)
+
+rateCalls :: Late -> IO Int
+rateCalls Late {lStub} = length . filter isRate <$> stubCalls lStub
+  where
+    isRate = \case
+      StubRate _ -> True
+      _ -> False
+
+lateWaitOf :: DBStore -> Text -> IO (Maybe LateWait)
+lateWaitOf st r = withTransaction st $ \db -> lateWait db (invOf r)
+
+-- | A log line of the level holding the text.
+logged :: Text -> Text -> Text -> Bool
+logged level needle = any (\ln -> ("[" <> level) `T.isPrefixOf` ln && needle `T.isInfixOf` ln) . T.lines
+
+count :: Text -> Text -> Int
+count needle = length . T.breakOnAll needle
+
+-- | The payment rows' created_at, past the read window by the seconds given.
+pastWindow :: UTCTime -> Integer -> UTCTime
+pastWindow createdAt by = addUTCTime (settleWindow + fromInteger by) createdAt
+
+-- settlement
+
+testHeldSettled :: IO ()
+testHeldSettled = withLate $ \l@Late {lStore = st} -> do
+  source st "s" 10000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  settleAt l "h" (SigSettled (btcPaid 480000 480000) (at 10)) (at 10) `shouldReturn` Right ISPaid
+  NameRegistration {nrPhase, nrLive, nrBalanceUsed} <- reg st "h"
+  (nrPhase, nrLive, nrBalanceUsed) `shouldBe` (PQueued, True, 10000)
+  figures st "s" (at 10) `shouldReturn` Just (0, 10000, 0, Nothing)
+  invariantHolds st "s"
+
+testFundedThenSettledLate :: IO ()
+testFundedThenSettledLate = withLate $ \l@Late {lStore = st} -> do
+  source st "s" 10000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  settleAt l "h" (SigFunded (btcPaid 480000 0) PaidInFull) (at 50) `shouldReturn` Right ISOpen
+  settleAt l "h" (SigSettled (btcPaid 480000 480000) (at 120)) (at 120) `shouldReturn` Right ISPaid
+  nrPhase <$> reg st "h" `shouldReturn` PQueued
+  figures st "s" (at 120) `shouldReturn` Just (0, 10000, 0, Nothing)
+
+testHoldNotSpent :: IO ()
+testHoldNotSpent = withLate $ \l@Late {lStore = st} -> do
+  source st "s" 10000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  withTransaction st $ \db -> DB.execute db "UPDATE sx_badge_service_name_balances SET reserved_by = NULL WHERE registration_id = ?" (Only ("s" :: Text))
+  logs <- capturingStderr $ settleAt l "h" (SigSettled (btcPaid 480000 480000) (at 10)) (at 10) `shouldReturn` Right ISPaid
+  logs `shouldSatisfy` logged "ERROR" "queued registration h as paid, but the balance of registration s it held could not be spent"
+  nrPhase <$> reg st "h" `shouldReturn` PQueued
+  balanceOf st "s" `shouldReturn` Just (10000, 10000, 0)
+
+-- | The unique index keeping one live order per commitment is dropped, so a second live order can meet the first at settlement.
+meetsLiveOrder :: DBStore -> Text -> IO ()
+meetsLiveOrder st r = do
+  withTransaction st $ \db -> DB.execute_ db "DROP INDEX sx_badge_service_idx_name_registrations_live_commitment"
+  NameRegistration {nrCommitment} <- reg st r
+  placeOrderRow st "twin" False 20000 (at 60)
+  withTransaction st $ \db -> DB.execute db "UPDATE sx_badge_service_name_registrations SET commitment = ? WHERE registration_id = 'twin'" (Only $ DB.Binary nrCommitment)
+
+testLiveOrderExists :: IO ()
+testLiveOrderExists = withLate $ \l@Late {lStore = st} -> do
+  placeOrderRow st "a" False 20000 (at 60)
+  meetsLiveOrder st "a"
+  logs <- readSignal l "a" (SigSettled (btcPaid lateUnits lateUnits) (at 10))
+  logs `shouldSatisfy` logged "ERROR" "was paid while another live order held the commitment, or the owner and name, of registration a"
+  NameRegistration {nrPhase, nrLive} <- reg st "a"
+  (nrPhase, nrLive) `shouldBe` (PUnpaid, False)
+  balanceOf st "a" `shouldReturn` Just (19200, 19200, 0)
+
+testLiveOrderExistsHolder :: IO ()
+testLiveOrderExistsHolder = withLate $ \l@Late {lStore = st} -> do
+  source st "s" 10000
+  holder st "a" "s" 10000 (at 60) `shouldReturn` Right ()
+  meetsLiveOrder st "a"
+  setRate l (Left $ ProviderError "rates down")
+  void $ readSignal l "a" (SigSettled (btcPaid lateUnits lateUnits) (at 10))
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
+  balanceOf st "a" `shouldReturn` Nothing
+  setRate l (Right stubRate)
+  void $ passAt l (at 20)
+  balanceOf st "a" `shouldReturn` Just (19200, 19200, 0)
+  invariantHolds st "s"
+
+testSettlementBeforeRefund :: IO ()
+testSettlementBeforeRefund = withLate $ \l@Late {lStore = st} -> do
+  turns <- newTurns
+  source st "s" 10000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  recordRefund turns st "s" 10000 (at 5) >>= (`shouldSatisfy` \case Left (RefundHeld _) -> True; _ -> False)
+  settleAt l "h" (SigSettled (btcPaid 480000 480000) (at 10)) (at 10) `shouldReturn` Right ISPaid
+  recordRefund turns st "s" 10000 (at 11) >>= (`shouldSatisfy` \case Left _ -> True; Right _ -> False)
+  balanceOf st "s" `shouldReturn` Just (0, 10000, 0)
+
+-- late credits
+
+testLateCredited :: IO ()
+testLateCredited = withLate $ \l@Late {lStore = st} -> do
+  source st "s" 10000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  settleAt l "h" (SigClosed nothingPaid) (at 61) `shouldReturn` Right ISExpired
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
+  logs <- readSignal l "h" (SigClosed (btcPaid lateUnits lateUnits))
+  logs `shouldSatisfy` logged "INFO" "invoice inv-h credited 19200 cents to the balance of registration h for 320000 units at 60000.5 (invoice 62500, current 60000.5)"
+  logs `shouldNotSatisfy` T.isInfixOf "[ERROR"
+  balanceOf st "h" `shouldReturn` Just (19200, 19200, 0)
+  creditsOf st "h" `shouldReturn` [(Just lateUnits, Just "62500", Just "60000.5", Just "60000.5", 19200)]
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
+
+testRisingPrice :: IO ()
+testRisingPrice = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  setRate l (Right $ rateOf "70000" 70000)
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  creditsOf st "x" `shouldReturn` [(Just lateUnits, Just "62500", Just "70000", Just "62500", 20000)]
+  balanceOf st "x" `shouldReturn` Just (20000, 20000, 0)
+
+testGrowingReports :: IO ()
+testGrowingReports = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits 160000))
+  balanceOf st "x" `shouldReturn` Just (9600, 9600, 0)
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits 160000))
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  map (\(units, _, _, _, cents) -> (units, cents)) <$> creditsOf st "x" `shouldReturn` [(Just 160000, 9600), (Just 160000, 9600)]
+  balanceOf st "x" `shouldReturn` Just (19200, 19200, 0)
+
+testCloseAndCancel :: IO ()
+testCloseAndCancel = withLate $ \l@Late {lStore = st, lWaiters} -> do
+  placeOrderRow st "p" False 20000 (at 60)
+  settleAt l "p" (SigFunded (btcPaid lateUnits 160000) PaidInPart) (at 10) `shouldReturn` Right ISOpen
+  void $ readSignal l "p" (SigClosed (btcPaid lateUnits 160000))
+  nrLive <$> reg st "p" `shouldReturn` False
+  balanceOf st "p" `shouldReturn` Just (9600, 9600, 0)
+  placeOrderRow st "c" False 20000 (at 60)
+  settleAt l "c" (SigFunded (btcPaid lateUnits lateUnits) PaidInFull) (at 10) `shouldReturn` Right ISOpen
+  calls <- rateCalls l
+  cancelOpenInvoice st lWaiters Nothing (invOf "c") (at 20) `shouldReturn` True
+  rateCalls l `shouldReturn` calls
+  balanceOf st "c" `shouldReturn` Nothing
+  void $ passAt l (at 21)
+  balanceOf st "c" `shouldReturn` Just (19200, 19200, 0)
+
+testUnconfirmedThenSettled :: IO ()
+testUnconfirmedThenSettled = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  logs <- readSignal l "x" (SigClosed (btcPaid lateUnits 0))
+  logs `shouldSatisfy` logged "INFO" "invoice inv-x holds money of its closed order not yet confirmed"
+  balanceOf st "x" `shouldReturn` Nothing
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  length <$> creditsOf st "x" `shouldReturn` 1
+  balanceOf st "x" `shouldReturn` Just (19200, 19200, 0)
+
+-- | The order was placed long before the payment, whose own row the window counts from.
+testNeverConfirmed :: IO ()
+testNeverConfirmed = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  let seenAt = at (60 * 24 * 5)
+      alert = "invoice inv-x of order x: 320000 satoshi received, 0 satoshi confirmed, 0 satoshi credited; refund by hand only a transaction confirmed on chain that BTCPay no longer monitors; one still Processing there waits"
+  settleAt l "x" (SigClosed (btcPaid lateUnits 0)) seenAt `shouldReturn` Right ISExpired
+  alertsAt l (Right stubRate) (pastWindow seenAt (-60)) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-x of order x")
+  lateWaitOf st "x" `shouldReturn` Just LWConfirming
+  logs <- alertsAt l (Right stubRate) (pastWindow seenAt 60)
+  (count alert logs, logged "ERROR" alert logs) `shouldBe` (1, True)
+  lateWaitOf st "x" `shouldReturn` Just LWSupport
+  alertsAt l (Right stubRate) (pastWindow seenAt (24 * 3600 + 60)) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-x of order x")
+  balanceOf st "x" `shouldReturn` Nothing
+
+testPartCreditAlerted :: IO ()
+testPartCreditAlerted = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  settleAt l "x" (SigClosed (btcPaid lateUnits 160000)) (at 100) `shouldReturn` Right ISExpired
+  void $ passAt l (at 101)
+  balanceOf st "x" `shouldReturn` Just (9600, 9600, 0)
+  logs <- alertsAt l (Right stubRate) (pastWindow (at 100) 60)
+  count "invoice inv-x of order x: 320000 satoshi received, 160000 satoshi confirmed, 160000 satoshi credited; refund by hand only" logs `shouldBe` 1
+  alertsAt l (Right stubRate) (pastWindow (at 100) (24 * 3600 + 60)) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-x")
+
+testMoneroZero :: IO ()
+testMoneroZero = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  logs <- readSignal l "x" (SigFunded (btcPaid 0 0) {rcvCrypto = Nothing} PaidInFull)
+  logs `shouldSatisfy` logged "INFO" "invoice inv-x holds money of its closed order not yet confirmed"
+  withTransaction st (\db -> latePending db (invOf "x")) `shouldReturn` Just LPConfirming
+  now <- getCurrentTime
+  alertsAt l (Right stubRate) (addUTCTime 3600 now) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-x")
+  balanceOf st "x" `shouldReturn` Nothing
+
+testRateFails :: IO ()
+testRateFails = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  closedOrder l "y" False
+  setRate l (Left $ ProviderError "rates down")
+  logs <- readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  settleAt l "y" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  more <- passAt l (at 71)
+  count "late credits wait, as the current rate cannot be read" (logs <> more) `shouldBe` 1
+  lateWaitOf st "x" `shouldReturn` Just LWCrediting
+  mapM (balanceOf st) ["x", "y"] `shouldReturn` [Nothing, Nothing]
+  setRate l (Right stubRate)
+  void $ passAt l (at 72)
+  mapM (balanceOf st) ["x", "y"] `shouldReturn` replicate 2 (Just (19200, 19200, 0))
+  lateWaitOf st "x" `shouldReturn` Nothing
+
+testRateFloor :: IO ()
+testRateFloor = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  let floored = rateOf "31000" 31000
+  setRate l (Right floored)
+  settleAt l "x" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  logs <- passAt l (at 71)
+  logs `shouldSatisfy` logged "ERROR" "invoice inv-x is not credited: the current rate 31000 is below half its rate 62500"
+  balanceOf st "x" `shouldReturn` Nothing
+  lateWaitOf st "x" `shouldReturn` Just LWSupport
+  alertsAt l (Right floored) (pastWindow (at 70) 60)
+    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-x of order x: 320000 satoshi received, 320000 satoshi confirmed, 0 satoshi credited; confirmed; the coin's price fell by more than half since the invoice (62500, 31000); the owner decides: credit at the current rate, or refund by hand")
+  setRate l (Right $ rateOf "31250" 31250)
+  void $ passAt l (at 72)
+  creditsOf st "x" `shouldReturn` [(Just lateUnits, Just "62500", Just "31250", Just "31250", 10000)]
+  lateWaitOf st "x" `shouldReturn` Nothing
+
+testOneRateReadPerPass :: IO ()
+testOneRateReadPerPass = withLate $ \l@Late {lStore = st} -> do
+  mapM_ (\r -> closedOrder l r False >> settleAt l r (SigClosed (btcPaid lateUnits lateUnits)) (at 70)) ["x", "y", "z"]
+  closedOrder l "card" True
+  settleAt l "card" (SigSettled (cardPaid 20000 20000) (at 70)) (at 70) `shouldReturn` Right ISPaid
+  void $ passAt l (at 71)
+  rateCalls l `shouldReturn` 1
+  mapM (balanceOf st) ["x", "y", "z", "card"] `shouldReturn` replicate 3 (Just (19200, 19200, 0)) <> [Just (20000, 20000, 0)]
+  void $ passAt l (at 72)
+  rateCalls l `shouldReturn` 1
+
+testHighSpeed :: IO ()
+testHighSpeed = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  let highSpeed = (btcPaid lateUnits 0) {rcvUncreditable = Just UCHighSpeed}
+  settleAt l "x" (SigSettled highSpeed (at 70)) (at 70) `shouldReturn` Right ISPaid
+  void $ passAt l (at 71)
+  balanceOf st "x" `shouldReturn` Nothing
+  lateWaitOf st "x" `shouldReturn` Just LWSupport
+  alertsAt l (Right stubRate) (pastWindow (at 70) 60)
+    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-x of order x: 320000 satoshi received, 0 satoshi confirmed, 0 satoshi credited; the invoice was made under HighSpeed")
+
+testCreditedByPass :: IO ()
+testCreditedByPass = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "settled" False
+  settleAt l "settled" (SigSettled (btcPaid lateUnits lateUnits) (at 70)) (at 70) `shouldReturn` Right ISPaid
+  closedOrder l "crashed" False
+  settleAt l "crashed" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  mapM (balanceOf st) ["settled", "crashed"] `shouldReturn` [Nothing, Nothing]
+  void $ passAt l (at 71)
+  mapM (balanceOf st) ["settled", "crashed"] `shouldReturn` replicate 2 (Just (19200, 19200, 0))
+
+testLiveAgain :: IO ()
+testLiveAgain = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  settleAt l "x" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  let liveAgain _ = do
+        withTransaction st $ \db -> DB.execute_ db "UPDATE sx_badge_service_name_registrations SET live = 1 WHERE registration_id = 'x'"
+        pure (Right stubRate)
+  creditLateInvoice st liveAgain (invOf "x") (at 71) `shouldReturn` CONothingDue
+  balanceOf st "x" `shouldReturn` Nothing
+  creditsOf st "x" `shouldReturn` []
+
+testTwoInstancesAlert :: IO ()
+testTwoInstancesAlert = withLate $ \l -> do
+  closedOrder l "x" False
+  settleAt l "x" (SigClosed (btcPaid lateUnits 0)) (at 70) `shouldReturn` Right ISExpired
+  let first = "invoice inv-x of order x: 320000 satoshi received"
+  logs <- (<>) <$> alertsAt l (Right stubRate) (pastWindow (at 70) 60) <*> alertsAt l (Right stubRate) (pastWindow (at 70) 60)
+  count first logs `shouldBe` 1
+  settleAt l "x" (SigClosed (btcPaid 400000 0)) (at 80) `shouldReturn` Right ISExpired
+  alertsAt l (Right stubRate) (pastWindow (at 70) 120) >>= (`shouldSatisfy` logged "ERROR" "invoice inv-x of order x: 400000 satoshi received, 0 satoshi confirmed")
+
+testFallingSum :: IO ()
+testFallingSum = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits 160000))
+  confirmed <- withTransaction st $ \db -> DB.query db "SELECT confirmed_units FROM sx_badge_service_payments WHERE invoice_id = 'inv-x'" ()
+  confirmed `shouldBe` [Only (Just lateUnits)]
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  length <$> creditsOf st "x" `shouldReturn` 1
+  balanceOf st "x" `shouldReturn` Just (19200, 19200, 0)
+
+testHintPastWindow :: IO ()
+testHintPastWindow = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  now <- getCurrentTime
+  let longAgo = addUTCTime (negate $ settleWindow + 3600) now
+  withTransaction st $ \db -> DB.execute db "UPDATE sx_badge_service_invoices SET created_at = ? WHERE invoice_id = 'inv-x'" (Only longAgo)
+  unpaidRefs st (addUTCTime (negate settleWindow) now) >>= (`shouldNotSatisfy` elem ("crypto", refOf "x"))
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  balanceOf st "x" `shouldReturn` Just (19200, 19200, 0)
+
+testStripeCredited :: IO ()
+testStripeCredited = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "c" True
+  void $ readSignal l "c" (SigSettled (cardPaid 20000 20000) (at 70))
+  creditsOf st "c" `shouldReturn` [(Nothing, Nothing, Nothing, Nothing, 20000)]
+  balanceOf st "c" `shouldReturn` Just (20000, 20000, 0)
+  rateCalls l `shouldReturn` 0
+
+-- balances with late credits
+
+testCreditWhileHeld :: IO ()
+testCreditWhileHeld = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  holder st "h" "x" 19200 (at 60) `shouldReturn` Right ()
+  void $ readSignal l "x" (SigClosed (btcPaid 400000 400000))
+  figures st "x" (at 10) `shouldReturn` Just (24000, 24000, 0, Just BalanceHold {bhHolder = RegistrationId "h", bhUntil = at 60, bhOverdue = False})
+  settleAt l "h" (SigSettled (btcPaid 330000 330000) (at 10)) (at 10) `shouldReturn` Right ISPaid
+  figures st "x" (at 10) `shouldReturn` Just (4800, 24000, 0, Nothing)
+  invariantHolds st "x"
+
+coveredSpend :: DBStore -> Text -> Text -> Int -> Int -> IO (Either RegistrationRefused ())
+coveredSpend st r src price seen = withTransaction st $ \db -> createBalanceRegistration db (newReg r ownerA (fieldsN r)) (RegistrationId src) price seen t0
+
+testSpendBeforeCredit :: IO ()
+testSpendBeforeCredit = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "x" False
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  void $ readSignal l "x" (SigClosed (btcPaid 400000 400000))
+  coveredSpend st "c" "x" 10000 19200 `shouldReturn` Left RRBalanceChanged
+  coveredSpend st "c" "x" 10000 24000 `shouldReturn` Right ()
+  balanceOf st "x" `shouldReturn` Just (14000, 24000, 0)
+
+testCreditRefundTwice :: IO ()
+testCreditRefundTwice = withLate $ \l@Late {lStore = st} -> do
+  turns <- newTurns
+  closedOrder l "x" False
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits 160000))
+  void (recordRefund turns st "x" 9600 (at 80) >>= either (fail . show) pure)
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  void (recordRefund turns st "inv-x" 9600 (at 81) >>= either (fail . show) pure)
+  balanceOf st "x" `shouldReturn` Just (0, 19200, 19200)
+  invariantHolds st "x"
+
+testSpendAndRefundLate :: IO ()
+testSpendAndRefundLate = withLate $ \l@Late {lStore = st} -> do
+  turns <- newTurns
+  closedOrder l "x" False
+  void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
+  coveredSpend st "c" "x" 10000 19200 `shouldReturn` Right ()
+  nrBalanceSource <$> reg st "c" `shouldReturn` Just (RegistrationId "x")
+  recordRefund turns st "x" 10000 (at 80) >>= (`shouldSatisfy` \case Left (RefundAmount 9200) -> True; _ -> False)
+  void (recordRefund turns st "x" 9200 (at 80) >>= either (fail . show) pure)
+  balanceOf st "x" `shouldReturn` Just (0, 19200, 9200)
+
+-- the view
+
+balanceAt :: DBStore -> Text -> UTCTime -> IO (Maybe J.Value)
+balanceAt st r now = fmap balanceJSON <$> withTransaction st (\db -> getBalance db (RegistrationId r) now)
+
+balanceObject :: Int -> Bool -> Maybe UTCTime -> Int -> J.Value
+balanceObject amount held heldUntil refunded = J.object ["amount" J..= amount, "held" J..= held, "heldUntil" J..= heldUntil, "refunded" J..= refunded]
+
+testZeroBalances :: IO ()
+testZeroBalances = withLate $ \Late {lStore = st} -> do
+  turns <- newTurns
+  source st "spent" 10000
+  coveredSpend st "c" "spent" 10000 10000 `shouldReturn` Right ()
+  balanceAt st "spent" t0 `shouldReturn` Just (balanceObject 0 False Nothing 0)
+  source st "refunded" 10000
+  void (recordRefund turns st "refunded" 10000 (at 5) >>= either (fail . show) pure)
+  balanceAt st "refunded" t0 `shouldReturn` Just (balanceObject 0 False Nothing 10000)
+  placeOrderRow st "none" False 20000 (at 60)
+  balanceAt st "none" t0 `shouldReturn` Nothing
+
+testLateWaits :: IO ()
+testLateWaits = withLate $ \l@Late {lStore = st} -> do
+  mapM_ (\r -> closedOrder l r False) ["confirming", "crediting", "highspeed", "units", "floor", "alerted"]
+  settleAt l "crediting" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  settleAt l "highspeed" (SigClosed (btcPaid lateUnits 0) {rcvUncreditable = Just UCHighSpeed}) (at 70) `shouldReturn` Right ISExpired
+  settleAt l "units" (SigClosed (btcPaid 0 0) {rcvAmount = CurrencyAmount 20000, rcvCrypto = Just "0.003200001", rcvUnits = Nothing, rcvUncreditable = Just UCUncounted}) (at 70) `shouldReturn` Right ISExpired
+  settleAt l "alerted" (SigClosed (btcPaid lateUnits 0)) (at 70) `shouldReturn` Right ISExpired
+  void $ alertsAt l (Right stubRate) (pastWindow (at 70) 60)
+  settleAt l "confirming" (SigClosed (btcPaid lateUnits 0)) (pastWindow (at 70) 60) `shouldReturn` Right ISExpired
+  setRate l (Right $ rateOf "31000" 31000)
+  void $ readSignal l "floor" (SigClosed (btcPaid lateUnits lateUnits))
+  placeOrderRow st "open" False 20000 (at 60)
+  settleAt l "open" (SigFunded (btcPaid lateUnits 0) PaidInFull) (at 70) `shouldReturn` Right ISOpen
+  let waits = mapM (\r -> (r,) <$> lateWaitOf st r)
+  waits ["confirming", "crediting", "highspeed", "units", "floor", "alerted", "open"]
+    `shouldReturn` [ ("confirming", Just LWConfirming),
+                     ("crediting", Just LWCrediting),
+                     ("highspeed", Just LWSupport),
+                     ("units", Just LWSupport),
+                     ("floor", Just LWSupport),
+                     ("alerted", Just LWSupport),
+                     ("open", Nothing)
+                   ]
+  setRate l (Right stubRate)
+  void $ readSignal l "alerted" (SigClosed (btcPaid lateUnits lateUnits))
+  void $ passAt l (at 71)
+  waits ["crediting", "floor", "alerted"] `shouldReturn` [("crediting", Nothing), ("floor", Nothing), ("alerted", Nothing)]
+
+#if defined(dbPostgres)
+-- | Each thread waits here until both arrive, after its unlocked read and before its locked transaction.
+meet :: TVar Int -> IO ()
+meet arrived = atomically (modifyTVar' arrived (+ 1)) >> atomically (readTVar arrived >>= check . (== 2))
+
+rounds :: Int
+rounds = 20
+
+testConcurrentCredits :: IO ()
+testConcurrentCredits = withServiceStores $ \open -> do
+  st <- open
+  other <- open
+  withLateOn st $ \l -> do
+    let due r = closedOrder l r False >> settleAt l r (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+    forM_ [1 .. rounds] $ \n -> do
+      let r = "x" <> T.pack (show n)
+      due r
+      arrived <- newTVarIO 0
+      let readRate :: CryptoCurrency -> IO (Either ProviderError Rate)
+          readRate _ = Right stubRate <$ meet arrived
+      (a, b) <- concurrently (creditLateInvoice st readRate (invOf r) (at 80)) (creditLateInvoice other readRate (invOf r) (at 80))
+      (n, length [() | COCredited _ <- [a, b]], length [() | CONothingDue <- [a, b]]) `shouldBe` (n, 1, 1)
+      length <$> creditsOf st r `shouldReturn` 1
+      balanceOf st r `shouldReturn` Just (19200, 19200, 0)
+    refused <- forM [1 .. rounds] $ \n -> do
+      let r = "stale" <> T.pack (show n)
+      due r
+      arrived <- newTVarIO 0
+      let staleStep :: DBStore -> IO Bool
+          staleStep store = do
+            Just s <- withTransaction store (`lateCreditState` invOf r)
+            meet arrived
+            withTransaction store $ \db -> do
+              lockInvoice db (invOf r) (at 80)
+              creditLatePayment db (fromJust $ lateCreditOf s (Just stubRate)) (at 80)
+      (a, b) <- concurrently (staleStep st) (staleStep other)
+      balanceOf st r `shouldReturn` Just (19200, 19200, 0)
+      pure $ length (filter not [a, b])
+    sum refused `shouldSatisfy` (> 0)
+
+testCreditAgainstSettlement :: IO ()
+testCreditAgainstSettlement = withServiceStores $ \open -> do
+  st <- open
+  other <- open
+  otherWaiters <- newWaiters
+  withLateOn st $ \l -> forM_ [1 .. rounds] $ \n -> do
+    let r = "x" <> T.pack (show n)
+    closedOrder l r False
+    settleAt l r (SigClosed (btcPaid lateUnits 160000)) (at 70) `shouldReturn` Right ISExpired
+    arrived <- newTVarIO 0
+    let readRate :: CryptoCurrency -> IO (Either ProviderError Rate)
+        readRate _ = Right stubRate <$ meet arrived
+        raise :: IO (Either Text InvoiceStatus)
+        raise = meet arrived >> settleOrder other otherWaiters Nothing (invOf r) (SigClosed (btcPaid lateUnits lateUnits)) (at 80)
+    (credited, raised) <- concurrently (creditLateInvoice st readRate (invOf r) (at 80)) raise
+    (n, raised) `shouldBe` (n, Right ISExpired)
+    credited `shouldSatisfy` \case COCredited _ -> True; _ -> False
+    creditLateInvoice st (const $ pure $ Right stubRate) (invOf r) (at 81) >>= (`shouldSatisfy` (/= CORefused))
+    units <- map (\(u, _, _, _, _) -> u) <$> creditsOf st r
+    (n, sum (map (fromMaybe 0) units)) `shouldBe` (n, lateUnits)
+    balanceOf st r `shouldReturn` Just (19200, 19200, 0)
+#endif
diff --git a/tests/Bots/StoreService/NamesOrdersTests.hs b/tests/Bots/StoreService/NamesOrdersTests.hs
index 0831e1457f..686764a41f 100644
--- a/tests/Bots/StoreService/NamesOrdersTests.hs
+++ b/tests/Bots/StoreService/NamesOrdersTests.hs
@@ -1021,7 +1021,7 @@ testLatePaymentAfterNewOrder = withOrders $ \ctx -> do
   now <- readIORef (cClock ctx)
   (newInv, _) <- placed ctx aliceOrder {oCommitment = commitmentOf 2, oTimestamp = seconds now, oDuration = durationAt now}
   logs <- capturingStderr $ settleNow ctx oldInv settled `shouldReturn` Right ISPaid
-  logs `shouldSatisfy` T.isInfixOf "refund"
+  logs `shouldSatisfy` T.isInfixOf "credited to its balance"
   old <- invoiceRegistration ctx oldInv
   (nrPhase old, nrLive old) `shouldBe` (PUnpaid, False)
   new <- invoiceRegistration ctx newInv
@@ -1055,7 +1055,7 @@ testLateBTCPayPayments = withFakeBTCPay $ \fake -> do
     let refOf inv = maybe (error "no invoice") irProviderRef <$> getInvoice st inv
         readAt ref = queueReadHint (weHints cWeb) ref >> drainHints poller
         paidLate ref fields = capturingStderr $ setInvoiceState fake ref fields >> readAt ref
-        alerted logs = T.isInfixOf "stays unpaid; refund the payment" logs
+        alerted logs = T.isInfixOf "credited to its balance" logs
         later = addUTCTime 3600 orderTime
     (expired, _) <- placed ctx aliceOrder
     expiredRef <- refOf expired
@@ -1076,7 +1076,7 @@ testLateBTCPayPayments = withFakeBTCPay $ \fake -> do
       r <- invoiceRegistration ctx inv
       (nrPhase r, nrLive r) `shouldBe` (PUnpaid, False)
 
--- | Paid in part while open, then expired by BTCPay with the same figures: one refund line, none from a restarted poller.
+-- | Paid in part while open, then expired by BTCPay with the same figures: one late payment line, none from a restarted poller.
 testOneLateAlert :: IO ()
 testOneLateAlert = withOrders $ \ctx@Ctx {cStore = st, cWeb} -> do
   (inv, _) <- placed ctx aliceOrder
@@ -1084,14 +1084,14 @@ testOneLateAlert = withOrders $ \ctx@Ctx {cStore = st, cWeb} -> do
   let paid = rcv 5000 (Just "0.00078")
       newPoller = newPollerEnv st (weWaiters cWeb) (Just $ oePhases $ cOrders ctx) (weHints cWeb) (weProviders cWeb) (poll $ weConfig cWeb)
       readWith poller = capturingStderr $ queueReadHint (weHints cWeb) ref >> drainHints poller
-      refunds = length . T.breakOnAll "refund"
+      refunds = length . T.breakOnAll "received money after"
   poller <- newPoller
   setSignals (cStub ctx) [(ref, SigFunded paid PaidInPart)]
   refunds <$> readWith poller `shouldReturn` 0
   setSignals (cStub ctx) [(ref, SigClosed paid)]
   logs <- readWith poller
   refunds logs `shouldBe` 1
-  logs `shouldSatisfy` T.isInfixOf "stays unpaid; refund the payment"
+  logs `shouldSatisfy` T.isInfixOf "it stays unpaid, and its confirmed money is credited to its balance"
   restarted <- newPoller
   refunds <$> readWith restarted `shouldReturn` 0
   (nrPhase &&& nrLive) <$> invoiceRegistration ctx inv `shouldReturn` (PUnpaid, False)
@@ -1133,7 +1133,7 @@ testCancelAlertsFunded = withOrdersCancelling (SigFunded paid PaidInPart) $ \ctx
   where
     paid = rcv 5000 (Just "0.00078")
     invoiceText (InvoiceId t) = t
-    alertOf invId = "invoice " <> invoiceText invId <> " was paid after its order closed"
+    alertOf invId = "invoice " <> invoiceText invId <> " received money after"
 
 testNamesOff :: IO ()
 testNamesOff = withOrders $ \ctx -> do
@@ -1168,7 +1168,7 @@ testLatePayment = withOrders $ \ctx -> do
   fst <$> post ctx ("/api/invoice/" <> T.unpack t <> "/cancel") "" `shouldReturn` 200
   closed <- invoiceRegistration ctx invId
   logs <- capturingStderr $ settleNow ctx invId settled `shouldReturn` Right ISPaid
-  logs `shouldSatisfy` T.isInfixOf ("registration " <> (\(RegistrationId r) -> r) (nrId closed) <> " stays unpaid")
+  logs `shouldSatisfy` T.isInfixOf ("registration " <> (\(RegistrationId r) -> r) (nrId closed) <> " closed; it stays unpaid")
   invoiceRegistration ctx invId `shouldReturn` closed
   r <- webGet (cClient ctx) ("/api/invoice/" <> T.unpack t)
   v <- jsonObject r
@@ -1269,7 +1269,7 @@ testCleanupIn ctx@Ctx {cStore = st} = do
   isNothing <$> getInvoice st (InvoiceId "inv-gone") `shouldReturn` True
   Just InvoiceRow {irPayment = latePayment} <- getInvoice st (InvoiceId "inv-late")
   (ipCryptoPaid <$> latePayment) `shouldBe` Just (Just "0.00078")
-  logs `shouldSatisfy` T.isInfixOf "registration late is kept because invoice inv-late received a payment"
+  logs `shouldSatisfy` T.isInfixOf "registration late is kept with its balance, because invoice inv-late received a payment"
   logs `shouldSatisfy` T.isInfixOf "registration unread is kept until the next run"
   reads' <- stubReads
   sort reads' `shouldBe` [ref "gone", ref "late"]
@@ -1345,12 +1345,15 @@ testViewFields :: IO ()
 testViewFields = withServiceStore $ \st -> withFakeEthNode $ \node -> do
   Right () <- placePaid st "r1" ownerA (order "alicebakery" 1) (addUTCTime 3600 t0)
   r <- withTransaction st $ \db -> fromJust <$> getRegistration db (RegistrationId "r1")
-  let v = objectOf $ viewJSON (testNamesConfig node) r Nothing ViewReads {vrIntentNonce = Nothing, vrUnread = []}
+  let v = objectOf $ viewJSON (testNamesConfig node) r Nothing Nothing ViewReads {vrIntentNonce = Nothing, vrUnread = []}
   sort (KM.keys v)
     `shouldBe` sort
       [ "id", "version", "moves", "linksRefused", "phase", "labelHash", "label", "owner", "commitment", "sealed", "resolver", "sponsor", "chainId", "tld",
-        "years", "duration", "price", "fromBalance", "balance", "commitTx", "registerTx", "revealAfter", "revealBefore", "intentNonce", "unread", "expiresAt", "error"
+        "years", "duration", "price", "fromBalance", "balance", "latePayment", "commitTx", "registerTx", "revealAfter", "revealBefore", "intentNonce", "unread", "expiresAt", "error"
       ]
+  field "latePayment" v `shouldBe` Just J.Null
+  let waiting w = field "latePayment" $ objectOf $ viewJSON (testNamesConfig node) r Nothing (Just w) ViewReads {vrIntentNonce = Nothing, vrUnread = []}
+  map waiting [LWConfirming, LWCrediting, LWSupport] `shouldBe` map (\t -> Just $ J.object ["waiting" .= (t :: Text)]) ["confirming", "crediting", "support"]
   map (`field` v) ["id", "phase", "owner", "tld", "chainId", "linksRefused", "label", "unread", "sponsor", "fromBalance", "balance"]
     `shouldBe` map
       Just
@@ -1391,7 +1394,7 @@ testViewUnread = withServiceStore $ \st -> withFakeEthNode $ \node -> do
   r <- withTransaction st $ \db -> fromJust <$> getRegistration db (RegistrationId "paid")
   readViewChain ct r {nrPhase = PCommitted} `shouldReturn` ViewReads Nothing ["intentNonce"]
   readViewChain ct r {nrPhase = PTaken} `shouldReturn` ViewReads Nothing []
-  let v = objectOf $ viewJSON (testNamesConfig node) r {nrPhase = PCommitted} Nothing (ViewReads Nothing ["intentNonce"])
+  let v = objectOf $ viewJSON (testNamesConfig node) r {nrPhase = PCommitted} Nothing Nothing (ViewReads Nothing ["intentNonce"])
   (field "intentNonce" v, field "unread" v) `shouldBe` (Just J.Null, Just (J.toJSON ["intentNonce" :: Text]))
 
 testViewBalance :: IO ()
diff --git a/tests/Bots/StoreService/WebTests.hs b/tests/Bots/StoreService/WebTests.hs
index 69c5a4b2f2..d50d831922 100644
--- a/tests/Bots/StoreService/WebTests.hs
+++ b/tests/Bots/StoreService/WebTests.hs
@@ -2455,8 +2455,8 @@ testSettledPaymentIsNotDowngraded :: IO ()
 testSettledPaymentIsNotDowngraded = bounded "settled is not downgraded" $ withServiceStore $ \st -> do
   iid <- seedOpen st
   row <- getInvoice st iid >>= maybe (failWith "no invoice row") pure
-  withTransaction st $ \db -> upsertPayment db row PSSettled (CurrencyAmount 500) (Just "0.00050000") Nothing False settleAt
-  withTransaction st $ \db -> upsertPayment db row PSPending (CurrencyAmount 200) (Just "0.00020000") Nothing False replayAt
+  withTransaction st $ \db -> upsertPayment db row PSSettled (rcv 500 (Just "0.00050000")) False settleAt
+  withTransaction st $ \db -> upsertPayment db row PSPending (rcv 200 (Just "0.00020000")) False replayAt
   p <- paymentRow st iid
   ipStatus p `shouldBe` "settled"
   ipUpdatedAt p `shouldBe` settleAt
@@ -2465,8 +2465,8 @@ testSettledPaymentIsNotDowngraded = bounded "settled is not downgraded" $ withSe
   let second' = sampleInvoice {niInvoiceId = InvoiceId "inv-pending", niProviderRef = "p-pending", niCodeHash = digestFixture 16}
   createInvoiceRows st second' `shouldReturn` Right ()
   row' <- getInvoice st (niInvoiceId second') >>= maybe (failWith "no invoice row") pure
-  withTransaction st $ \db -> upsertPayment db row' PSPending (CurrencyAmount 100) Nothing Nothing False settleAt
-  withTransaction st $ \db -> upsertPayment db row' PSSettled (CurrencyAmount 500) (Just "0.00050000") Nothing False replayAt
+  withTransaction st $ \db -> upsertPayment db row' PSPending (rcv 100 Nothing) False settleAt
+  withTransaction st $ \db -> upsertPayment db row' PSSettled (rcv 500 (Just "0.00050000")) False replayAt
   p' <- paymentRow st (niInvoiceId second')
   ipStatus p' `shouldBe` "settled"
   ipUpdatedAt p' `shouldBe` replayAt
diff --git a/tests/Test.hs b/tests/Test.hs
index ceccb86c99..a9d81f1b86 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -11,6 +11,7 @@ import Bots.StoreService.GroupIntegrationTests
 import Bots.StoreService.GroupTests
 import Bots.StoreService.NameRegistrationTests
 import Bots.StoreService.NamesBalancesTests
+import Bots.StoreService.NamesLateCreditTests
 import Bots.StoreService.NamesChainTests
 import Bots.StoreService.NamesCodesTests
 import Bots.StoreService.NamesContractsTests
@@ -106,6 +107,7 @@ main = do
         badgeNameRegistrationTests
       namesConfigTests
       namesBalancesTests
+      namesLateCreditTests
       namesChainTests
       namesCodesTests
       namesContractsTests

From 3cc901b1bd4000ce393ad623c4f702d716742c52 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 15:29:41 +0000
Subject: [PATCH 06/17] store: show funded holds and balance links

---
 .../src/StoreService/Names/Store.hs           | 46 ++++++++++++++-----
 .../src/StoreService/Names/View.hs            |  5 +-
 .../src/StoreService/Web/Names/Owner.hs       | 14 ++++--
 tests/Bots/StoreService/NamesBalancesTests.hs |  6 +--
 .../Bots/StoreService/NamesLateCreditTests.hs | 28 ++++++++++-
 tests/Bots/StoreService/NamesOrdersTests.hs   |  2 +-
 tests/Bots/StoreService/NamesOwnerTests.hs    | 10 ++--
 tests/Bots/StoreService/NamesStoreTests.hs    |  8 ++--
 8 files changed, 88 insertions(+), 31 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index 36ee52ffdb..4dda7c42a1 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -266,10 +266,12 @@ data Balance = Balance
   deriving (Eq, Show)
 
 -- | The order whose open invoice holds a balance, until that invoice expires; overdue past it with no money received.
+-- Funded once money reached it: it then holds until its payment settles or the provider closes it, whatever the time.
 data BalanceHold = BalanceHold
   { bhHolder :: RegistrationId,
     bhUntil :: UTCTime,
-    bhOverdue :: Bool
+    bhOverdue :: Bool,
+    bhFunded :: Bool
   }
   deriving (Eq, Show)
 
@@ -786,12 +788,26 @@ retargetRegistration db r OrderFields {ofLabelHash, ofLength, ofDuration, ofComm
       }
 
 -- | Newest first: findLimit of them, then every older one holding a balance above 0, since a balance never expires.
-findRegistrations :: DB.Connection -> Address -> IO [NameRegistration]
-findRegistrations db owner = do
-  newest <- DB.query db (selectRegistrations <> " WHERE r.owner = ?" <> newestFirst <> " LIMIT ?") (Binary $ unAddress owner, findLimit) >>= decodeAll toRegistration
-  holding <- DB.query db (selectRegistrations <> " WHERE r.owner = ?" <> withBalance <> newestFirst) (Only $ Binary $ unAddress owner) >>= decodeAll toRegistration
-  pure $ newest <> filter ((`notElem` map nrId newest) . nrId) holding
+-- Each with the order holding its balance, as getBalance reads the hold at the given time.
+findRegistrations :: DB.Connection -> Address -> UTCTime -> IO [(NameRegistration, Maybe RegistrationId)]
+findRegistrations db owner now = do
+  newest <- DB.query db (selectHeld <> " WHERE r.owner = ?" <> newestFirst <> " LIMIT ?") (holdParams :. (Binary $ unAddress owner, findLimit)) >>= decodeAll found
+  holding <- DB.query db (selectHeld <> " WHERE r.owner = ?" <> withBalance <> newestFirst) (holdParams :. Only (Binary $ unAddress owner)) >>= decodeAll found
+  pure $ newest <> filter ((`notElem` map (nrId . fst) newest) . nrId . fst) holding
   where
+    selectHeld =
+      registrationColumns
+        <> ", (SELECT b.reserved_by FROM sx_badge_service_name_balances b"
+        <> " JOIN sx_badge_service_name_registrations h ON h.registration_id = b.reserved_by"
+        <> " JOIN sx_badge_service_name_invoices hni ON hni.registration_id = b.reserved_by"
+        <> " JOIN sx_badge_service_invoices i ON i.invoice_id = hni.invoice_id"
+        <> " WHERE b.registration_id = r.registration_id AND NOT ("
+        <> holdOverdue
+        <> "))"
+        <> registrationFrom
+    holdParams = (PUnpaid, invoiceStatusText ISPaid, truncateToSecond now)
+    found :: RegistrationRow :. Only (Maybe Text) -> Either Text (NameRegistration, Maybe RegistrationId)
+    found (row :. Only holder) = (\r -> (r, RegistrationId <$> holder)) <$> toRegistration row
     newestFirst = " ORDER BY r.created_at DESC, r.registration_id DESC"
     withBalance = " AND EXISTS (SELECT 1 FROM sx_badge_service_name_balances b WHERE b.registration_id = r.registration_id AND b.amount > 0)"
 
@@ -870,16 +886,22 @@ heldBy Balance {blHold} = case blHold of
   Just BalanceHold {bhOverdue = False} -> blHold
   _ -> Nothing
 
--- | A holder is overdue as getLiveOrders reads an order overdue: its invoice past its expiry, not paid, and holding no money.
+-- | A holder h with invoice i is overdue as getLiveOrders reads an order overdue: its invoice past its expiry, not paid, and holding no money.
+-- Takes the unpaid phase, the paid status and the time.
+holdOverdue :: Query
+holdOverdue = " h.phase = ? AND i.status <> ? AND i.expires_at < ?" <> unfunded
+
 getBalance :: DB.Connection -> RegistrationId -> UTCTime -> IO (Maybe Balance)
 getBalance db (RegistrationId rid) now =
   firstDecoded toBalance $
     DB.query
       db
       ( "SELECT b.registration_id, b.amount, b.credited, b.refunded, b.reserved_by, i.expires_at,"
-          <> " CASE WHEN h.phase = ? AND i.status <> ? AND i.expires_at < ?"
+          <> " CASE WHEN"
+          <> holdOverdue
+          <> " THEN 1 ELSE 0 END, CASE WHEN i.invoice_id IS NOT NULL"
           <> unfunded
-          <> " THEN 1 ELSE 0 END, b.refunded_at"
+          <> " THEN 0 ELSE 1 END, b.refunded_at"
           <> " FROM sx_badge_service_name_balances b"
           <> " LEFT JOIN sx_badge_service_name_registrations h ON h.registration_id = b.reserved_by"
           <> " LEFT JOIN sx_badge_service_name_invoices ni ON ni.registration_id = b.reserved_by"
@@ -888,11 +910,11 @@ getBalance db (RegistrationId rid) now =
       )
       (PUnpaid, invoiceStatusText ISPaid, truncateToSecond now, rid)
 
-toBalance :: (Text, Int, Int, Int, Maybe Text, Maybe UTCTime, BoolInt, Maybe UTCTime) -> Either Text Balance
-toBalance (rid, blAmount, blCredited, blRefunded, holder_, until_, BI overdue, blRefundedAt) = do
+toBalance :: (Text, Int, Int, Int, Maybe Text, Maybe UTCTime, BoolInt, BoolInt, Maybe UTCTime) -> Either Text Balance
+toBalance (rid, blAmount, blCredited, blRefunded, holder_, until_, BI bhOverdue, BI bhFunded, blRefundedAt) = do
   blHold <- case (holder_, until_) of
     (Nothing, _) -> Right Nothing
-    (Just holder, Just bhUntil) -> Right $ Just BalanceHold {bhHolder = RegistrationId holder, bhUntil, bhOverdue = overdue}
+    (Just holder, Just bhUntil) -> Right $ Just BalanceHold {bhHolder = RegistrationId holder, bhUntil, bhOverdue, bhFunded}
     (Just _, Nothing) -> Left $ "name_balances holder without an invoice: " <> rid
   pure Balance {blRegistration = RegistrationId rid, blAmount, blCredited, blRefunded, blHold, blRefundedAt}
 
diff --git a/apps/simplex-store-service/src/StoreService/Names/View.hs b/apps/simplex-store-service/src/StoreService/Names/View.hs
index adcfd1bc9d..eef633d2a9 100644
--- a/apps/simplex-store-service/src/StoreService/Names/View.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/View.hs
@@ -108,12 +108,13 @@ viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}
       LWCrediting -> "crediting"
       LWSupport -> "support"
 
--- | The holder is not named, so an order's link discloses no other order.
+-- | The holder is not named, so an order's link discloses no other order. A funded hold has no end time.
 balanceJSON :: Balance -> J.Value
 balanceJSON b@Balance {blAmount, blRefunded} =
-  J.object ["amount" .= blAmount, "held" .= isJust hold, "heldUntil" .= (bhUntil <$> hold), "refunded" .= blRefunded]
+  J.object ["amount" .= blAmount, "held" .= isJust hold, "heldUntil" .= (bhUntil <$> (hold >>= unfunded)), "refunded" .= blRefunded]
   where
     hold = heldBy b
+    unfunded h@BalanceHold {bhFunded} = if bhFunded then Nothing else Just h
 
 -- | EIP-55, as the page compares owners.
 addressText :: Address -> Text
diff --git a/apps/simplex-store-service/src/StoreService/Web/Names/Owner.hs b/apps/simplex-store-service/src/StoreService/Web/Names/Owner.hs
index 77ecf4bb0a..e0598df16a 100644
--- a/apps/simplex-store-service/src/StoreService/Web/Names/Owner.hs
+++ b/apps/simplex-store-service/src/StoreService/Web/Names/Owner.hs
@@ -53,9 +53,9 @@ findHandler OrdersEnv {oeStore, oeNow} req respond =
       firstRefusal [checkSigner frOwner (findMessage frOwner frTimestamp) frSignature, pure $ checkTimestamp now frTimestamp] >>= \case
         Just refusal -> refuse refusal
         Nothing ->
-          withTransaction oeStore (`findRegistrations` frOwner) >>= \case
+          withTransaction oeStore (\db -> findRegistrations db frOwner now) >>= \case
             [] -> pure $ answerNow notFound
-            rs -> pure $ answerNow $ jsonResponse status200 $ J.object ["registrations" .= map (foundJSON . registrationAt now) rs]
+            rs -> pure $ answerNow $ jsonResponse status200 $ J.object ["registrations" .= map (\(r, holder) -> foundJSON (registrationAt now r) holder) rs]
     refuse = refused "POST /api/registration/find"
 
 parseFind :: J.Object -> Maybe FindRequest
@@ -65,17 +65,21 @@ parseFind o = do
   frSignature <- eitherToMaybe . parseSignature =<< textField o "signature"
   pure FindRequest {frOwner, frTimestamp, frSignature}
 
-foundJSON :: NameRegistration -> J.Value
-foundJSON NameRegistration {nrId = RegistrationId rid, nrPayment, nrPhase, nrCreatedAt, nrLabelHash = LabelHash lh, nrSealed} =
+-- | balanceSource: the order whose balance paid this one; heldBy: the order whose invoice holds this one's balance.
+foundJSON :: NameRegistration -> Maybe RegistrationId -> J.Value
+foundJSON NameRegistration {nrId = RegistrationId rid, nrPayment, nrPhase, nrCreatedAt, nrLabelHash = LabelHash lh, nrSealed, nrBalanceSource} holder =
   J.object
     [ "registrationId" .= rid,
       "invoiceId" .= invoiceId,
       "phase" .= (textEncode nrPhase :: Text),
       "createdAt" .= nrCreatedAt,
       "labelHash" .= hex lh,
-      "sealed" .= nrSealed
+      "sealed" .= nrSealed,
+      "balanceSource" .= (idText <$> nrBalanceSource),
+      "heldBy" .= (idText <$> holder)
     ]
   where
+    idText (RegistrationId t) = t
     invoiceId = case nrPayment of
       RPInvoice _ (InvoiceId t) -> Just t
       RPCode _ -> Nothing
diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs
index 1553a778ec..b554365e81 100644
--- a/tests/Bots/StoreService/NamesBalancesTests.hs
+++ b/tests/Bots/StoreService/NamesBalancesTests.hs
@@ -150,7 +150,7 @@ holder st r src seen expiresAt = withTransaction st $ \db -> do
   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}
+hold h bhUntil bhOverdue = BalanceHold {bhHolder = RegistrationId h, bhUntil, bhOverdue, bhFunded = False}
 
 coveredSpend :: DBStore -> Text -> Text -> Int -> Int -> IO (Either RegistrationRefused ())
 coveredSpend st r src price seen = withTransaction st $ \db -> createBalanceRegistration db (newReg r ownerA (fieldsN r)) (RegistrationId src) price seen t0
@@ -462,7 +462,7 @@ testFindBalances = withServiceStore $ \st -> do
   credit st "r1" 5000
   credit st "r2" 3000
   refund st "r2" 3000 `shouldReturn` True
-  map nrId <$> withTransaction st (`findRegistrations` ownerA) `shouldReturn` map (RegistrationId . rid) ([52, 51 .. 3] <> [1])
+  map (nrId . fst) <$> withTransaction st (\db -> findRegistrations db ownerA t0) `shouldReturn` map (RegistrationId . rid) ([52, 51 .. 3] <> [1])
 
 -- closes
 
@@ -517,7 +517,7 @@ testNamedHolders = withOrders $ \Ctx {cStore = st, cOrders, cWeb} -> do
   h2 <- reg st "h2"
   payment st "inv-h2" (cardPaid 100 0) (at 61)
   Just funded <- withTransaction st $ \db -> getBalance db (RegistrationId "s2") now
-  blHold funded `shouldBe` Just (hold "h2" (at 60) False)
+  blHold funded `shouldBe` Just (hold "h2" (at 60) False) {bhFunded = True}
   closedIds <$> Orders.placeOrder cOrders (orderRequest "c2") [h2] (spendInsert "c2" "s2" 6000 10000) `shouldReturn` Left (ORBalanceChanged $ Just funded)
   absent st "c2"
   nrLive <$> reg st "h2" `shouldReturn` True
diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index ff487e1e98..94163bd7f9 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -81,8 +81,10 @@ namesLateCreditTests = describe "StoreService names: balance life" $ do
     it "sums the refunds over credit, refund, late credit, refund" testCreditRefundTwice
     it "spends a late credit with a covered spend and refunds the rest" testSpendAndRefundLate
   describe "the view" $ do
+    it "shows a funded holder past its expiry held with no end time, and an unfunded one before it with its expiry" testHeldUntil
     it "shows a balance spent to 0 and a refunded one as objects with amount 0" testZeroBalances
     it "waits confirming, crediting, or support for each reason, and on nothing once all is credited" testLateWaits
+    it "finds the order a balance paid and the order holding a balance, none for an overdue unfunded holder" testFindLinks
 #if defined(dbPostgres)
   describe "two connections" $ do
     it "credits once of two credit steps on one invoice, cleanly, where a step reading before the lock is refused" testConcurrentCredits
@@ -513,7 +515,7 @@ testCreditWhileHeld = withLate $ \l@Late {lStore = st} -> do
   void $ readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
   holder st "h" "x" 19200 (at 60) `shouldReturn` Right ()
   void $ readSignal l "x" (SigClosed (btcPaid 400000 400000))
-  figures st "x" (at 10) `shouldReturn` Just (24000, 24000, 0, Just BalanceHold {bhHolder = RegistrationId "h", bhUntil = at 60, bhOverdue = False})
+  figures st "x" (at 10) `shouldReturn` Just (24000, 24000, 0, Just BalanceHold {bhHolder = RegistrationId "h", bhUntil = at 60, bhOverdue = False, bhFunded = False})
   settleAt l "h" (SigSettled (btcPaid 330000 330000) (at 10)) (at 10) `shouldReturn` Right ISPaid
   figures st "x" (at 10) `shouldReturn` Just (4800, 24000, 0, Nothing)
   invariantHolds st "x"
@@ -560,6 +562,19 @@ balanceAt st r now = fmap balanceJSON <$> withTransaction st (\db -> getBalance
 balanceObject :: Int -> Bool -> Maybe UTCTime -> Int -> J.Value
 balanceObject amount held heldUntil refunded = J.object ["amount" J..= amount, "held" J..= held, "heldUntil" J..= heldUntil, "refunded" J..= refunded]
 
+testHeldUntil :: IO ()
+testHeldUntil = withLate $ \l@Late {lStore = st} -> do
+  source st "funded" 10000
+  holder st "fh" "funded" 10000 (at 60) `shouldReturn` Right ()
+  source st "unfunded" 10000
+  holder st "uh" "unfunded" 10000 (at 60) `shouldReturn` Right ()
+  balanceAt st "funded" (at 30) `shouldReturn` Just (balanceObject 10000 True (Just $ at 60) 0)
+  settleAt l "fh" (SigFunded (btcPaid 100 0) PaidInPart) (at 30) `shouldReturn` Right ISOpen
+  balanceAt st "funded" (at 30) `shouldReturn` Just (balanceObject 10000 True Nothing 0)
+  balanceAt st "funded" (at 120) `shouldReturn` Just (balanceObject 10000 True Nothing 0)
+  balanceAt st "unfunded" (at 30) `shouldReturn` Just (balanceObject 10000 True (Just $ at 60) 0)
+  balanceAt st "unfunded" (at 120) `shouldReturn` Just (balanceObject 10000 False Nothing 0)
+
 testZeroBalances :: IO ()
 testZeroBalances = withLate $ \Late {lStore = st} -> do
   turns <- newTurns
@@ -600,6 +615,17 @@ testLateWaits = withLate $ \l@Late {lStore = st} -> do
   void $ passAt l (at 71)
   waits ["crediting", "floor", "alerted"] `shouldReturn` [("crediting", Nothing), ("floor", Nothing), ("alerted", Nothing)]
 
+testFindLinks :: IO ()
+testFindLinks = withLate $ \Late {lStore = st} -> do
+  source st "paying" 10000
+  coveredSpend st "spend" "paying" 10000 10000 `shouldReturn` Right ()
+  source st "held" 10000
+  holder st "holder" "held" 10000 (at 60) `shouldReturn` Right ()
+  let links now = map (\(NameRegistration {nrId = RegistrationId r, nrBalanceSource}, heldBy') -> (r, nrBalanceSource, heldBy')) <$> withTransaction st (\db -> findRegistrations db ownerA now)
+      linked rows = filter (\(_, src, h) -> src /= Nothing || h /= Nothing) rows
+  linked <$> links (at 30) `shouldReturn` [("spend", Just (RegistrationId "paying"), Nothing), ("holder", Just (RegistrationId "held"), Nothing), ("held", Nothing, Just (RegistrationId "holder"))]
+  linked <$> links (at 120) `shouldReturn` [("spend", Just (RegistrationId "paying"), Nothing), ("holder", Just (RegistrationId "held"), Nothing)]
+
 #if defined(dbPostgres)
 -- | Each thread waits here until both arrive, after its unlocked read and before its locked transaction.
 meet :: TVar Int -> IO ()
diff --git a/tests/Bots/StoreService/NamesOrdersTests.hs b/tests/Bots/StoreService/NamesOrdersTests.hs
index 686764a41f..a4e5ee5e4f 100644
--- a/tests/Bots/StoreService/NamesOrdersTests.hs
+++ b/tests/Bots/StoreService/NamesOrdersTests.hs
@@ -392,7 +392,7 @@ advance :: Ctx -> NominalDiffTime -> IO ()
 advance Ctx {cClock} by = modifyIORef' cClock (addUTCTime by)
 
 registrationsOf :: Ctx -> Address -> IO [NameRegistration]
-registrationsOf Ctx {cStore} owner = withTransaction cStore (`findRegistrations` owner)
+registrationsOf Ctx {cStore, cClock} owner = readIORef cClock >>= \now -> map fst <$> withTransaction cStore (\db -> findRegistrations db owner now)
 
 invoiceRegistration :: Ctx -> InvoiceId -> IO NameRegistration
 invoiceRegistration Ctx {cStore} invId =
diff --git a/tests/Bots/StoreService/NamesOwnerTests.hs b/tests/Bots/StoreService/NamesOwnerTests.hs
index f62eb6cf9d..44f6e76efd 100644
--- a/tests/Bots/StoreService/NamesOwnerTests.hs
+++ b/tests/Bots/StoreService/NamesOwnerTests.hs
@@ -343,7 +343,7 @@ testFind = withOwner $ \ctx@Ctx {cStore} -> do
       case entries of
         lapsedEntry : unpaidEntry : moveEntry : _ -> do
           (field "phase" lapsedEntry, nrPhase lapsed) `shouldBe` (Just "failed", PCommitted)
-          sort (KM.keys unpaidEntry) `shouldBe` sort ["registrationId", "invoiceId", "phase", "createdAt", "labelHash", "sealed"]
+          sort (KM.keys unpaidEntry) `shouldBe` sort ["registrationId", "invoiceId", "phase", "createdAt", "labelHash", "sealed", "balanceSource", "heldBy"]
           unpaidEntry
             `shouldBe` KM.fromList
               [ ("registrationId", idText $ nrId paid),
@@ -351,7 +351,9 @@ testFind = withOwner $ \ctx@Ctx {cStore} -> do
                 ("phase", "unpaid"),
                 ("createdAt", J.toJSON orderTime),
                 ("labelHash", labelHashText "alicebakery"),
-                ("sealed", "sealed-alicebakery-1")
+                ("sealed", "sealed-alicebakery-1"),
+                ("balanceSource", J.Null),
+                ("heldBy", J.Null)
               ]
           moveEntry
             `shouldBe` KM.fromList
@@ -360,7 +362,9 @@ testFind = withOwner $ \ctx@Ctx {cStore} -> do
                 ("phase", "queued"),
                 ("createdAt", J.toJSON $ addUTCTime 50 t0),
                 ("labelHash", labelHashText "alicebakers"),
-                ("sealed", "sealed-alicebakers-10")
+                ("sealed", "sealed-alicebakers-10"),
+                ("balanceSource", J.Null),
+                ("heldBy", J.Null)
               ]
         _ -> expectationFailure "fewer than three entries"
     other -> expectationFailure $ "find refused: " <> show other
diff --git a/tests/Bots/StoreService/NamesStoreTests.hs b/tests/Bots/StoreService/NamesStoreTests.hs
index 975110643c..f04baa5c27 100644
--- a/tests/Bots/StoreService/NamesStoreTests.hs
+++ b/tests/Bots/StoreService/NamesStoreTests.hs
@@ -613,9 +613,9 @@ testFind = withServiceStore $ \st -> do
     insertInvoiceRow db ("inv-" <> rid) (at 60) "open"
     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]]
-  withTransaction st (\db -> findRegistrations db (address "0x0000000000000000000000000000000000000001")) `shouldReturn` []
+  found <- withTransaction st $ \db -> findRegistrations db ownerA t0
+  map (nrId . fst) found `shouldBe` [RegistrationId $ "r" <> T.pack (show i) | i <- [52, 51 .. 3 :: Int]]
+  withTransaction st (\db -> findRegistrations db (address "0x0000000000000000000000000000000000000001") t0) `shouldReturn` []
 
 testSameSecondOrder :: IO ()
 testSameSecondOrder = withServiceStore $ \st -> do
@@ -625,7 +625,7 @@ testSameSecondOrder = withServiceStore $ \st -> 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 . fst) <$> withTransaction st (\db -> findRegistrations db ownerA t0) `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 ()

From 7e4f6742c69eba8b0c6cfc1bf030ee89711e41a4 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 15:56:42 +0000
Subject: [PATCH 07/17] store: let the Postgres credit specs compile

---
 tests/Bots/StoreService/NamesLateCreditTests.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index 94163bd7f9..5ae72330fc 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -639,7 +639,10 @@ testConcurrentCredits = withServiceStores $ \open -> do
   st <- open
   other <- open
   withLateOn st $ \l -> do
-    let due r = closedOrder l r False >> settleAt l r (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+    let due :: Text -> IO ()
+        due r = do
+          closedOrder l r False
+          settleAt l r (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
     forM_ [1 .. rounds] $ \n -> do
       let r = "x" <> T.pack (show n)
       due r

From a721c66d1b20fefeb48bcb1ff8249b10b958c6c3 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 15:59:29 +0000
Subject: [PATCH 08/17] store: keep late credit specs' logs apart

---
 .../Bots/StoreService/NamesLateCreditTests.hs | 128 +++++++++---------
 1 file changed, 64 insertions(+), 64 deletions(-)

diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index 5ae72330fc..175509d4cb 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -246,13 +246,13 @@ testFundedThenSettledLate = withLate $ \l@Late {lStore = st} -> do
 
 testHoldNotSpent :: IO ()
 testHoldNotSpent = withLate $ \l@Late {lStore = st} -> do
-  source st "s" 10000
-  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
-  withTransaction st $ \db -> DB.execute db "UPDATE sx_badge_service_name_balances SET reserved_by = NULL WHERE registration_id = ?" (Only ("s" :: Text))
-  logs <- capturingStderr $ settleAt l "h" (SigSettled (btcPaid 480000 480000) (at 10)) (at 10) `shouldReturn` Right ISPaid
-  logs `shouldSatisfy` logged "ERROR" "queued registration h as paid, but the balance of registration s it held could not be spent"
-  nrPhase <$> reg st "h" `shouldReturn` PQueued
-  balanceOf st "s" `shouldReturn` Just (10000, 10000, 0)
+  source st "unspentsrc" 10000
+  holder st "unspent" "unspentsrc" 10000 (at 60) `shouldReturn` Right ()
+  withTransaction st $ \db -> DB.execute db "UPDATE sx_badge_service_name_balances SET reserved_by = NULL WHERE registration_id = ?" (Only ("unspentsrc" :: Text))
+  logs <- capturingStderr $ settleAt l "unspent" (SigSettled (btcPaid 480000 480000) (at 10)) (at 10) `shouldReturn` Right ISPaid
+  logs `shouldSatisfy` logged "ERROR" "queued registration unspent as paid, but the balance of registration unspentsrc it held could not be spent"
+  nrPhase <$> reg st "unspent" `shouldReturn` PQueued
+  balanceOf st "unspentsrc" `shouldReturn` Just (10000, 10000, 0)
 
 -- | The unique index keeping one live order per commitment is dropped, so a second live order can meet the first at settlement.
 meetsLiveOrder :: DBStore -> Text -> IO ()
@@ -300,16 +300,16 @@ testSettlementBeforeRefund = withLate $ \l@Late {lStore = st} -> do
 
 testLateCredited :: IO ()
 testLateCredited = withLate $ \l@Late {lStore = st} -> do
-  source st "s" 10000
-  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
-  settleAt l "h" (SigClosed nothingPaid) (at 61) `shouldReturn` Right ISExpired
-  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
-  logs <- readSignal l "h" (SigClosed (btcPaid lateUnits lateUnits))
-  logs `shouldSatisfy` logged "INFO" "invoice inv-h credited 19200 cents to the balance of registration h for 320000 units at 60000.5 (invoice 62500, current 60000.5)"
-  logs `shouldNotSatisfy` T.isInfixOf "[ERROR"
-  balanceOf st "h" `shouldReturn` Just (19200, 19200, 0)
-  creditsOf st "h" `shouldReturn` [(Just lateUnits, Just "62500", Just "60000.5", Just "60000.5", 19200)]
-  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
+  source st "paid" 10000
+  holder st "credited" "paid" 10000 (at 60) `shouldReturn` Right ()
+  settleAt l "credited" (SigClosed nothingPaid) (at 61) `shouldReturn` Right ISExpired
+  figures st "paid" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
+  logs <- readSignal l "credited" (SigClosed (btcPaid lateUnits lateUnits))
+  logs `shouldSatisfy` logged "INFO" "invoice inv-credited credited 19200 cents to the balance of registration credited for 320000 units at 60000.5 (invoice 62500, current 60000.5)"
+  logs `shouldNotSatisfy` logged "ERROR" "inv-credited"
+  balanceOf st "credited" `shouldReturn` Just (19200, 19200, 0)
+  creditsOf st "credited" `shouldReturn` [(Just lateUnits, Just "62500", Just "60000.5", Just "60000.5", 19200)]
+  figures st "paid" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
 
 testRisingPrice :: IO ()
 testRisingPrice = withLate $ \l@Late {lStore = st} -> do
@@ -360,70 +360,70 @@ testUnconfirmedThenSettled = withLate $ \l@Late {lStore = st} -> do
 -- | The order was placed long before the payment, whose own row the window counts from.
 testNeverConfirmed :: IO ()
 testNeverConfirmed = withLate $ \l@Late {lStore = st} -> do
-  closedOrder l "x" False
+  closedOrder l "never" False
   let seenAt = at (60 * 24 * 5)
-      alert = "invoice inv-x of order x: 320000 satoshi received, 0 satoshi confirmed, 0 satoshi credited; refund by hand only a transaction confirmed on chain that BTCPay no longer monitors; one still Processing there waits"
-  settleAt l "x" (SigClosed (btcPaid lateUnits 0)) seenAt `shouldReturn` Right ISExpired
-  alertsAt l (Right stubRate) (pastWindow seenAt (-60)) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-x of order x")
-  lateWaitOf st "x" `shouldReturn` Just LWConfirming
+      alert = "invoice inv-never of order never: 320000 satoshi received, 0 satoshi confirmed, 0 satoshi credited; refund by hand only a transaction confirmed on chain that BTCPay no longer monitors; one still Processing there waits"
+  settleAt l "never" (SigClosed (btcPaid lateUnits 0)) seenAt `shouldReturn` Right ISExpired
+  alertsAt l (Right stubRate) (pastWindow seenAt (-60)) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-never of order never")
+  lateWaitOf st "never" `shouldReturn` Just LWConfirming
   logs <- alertsAt l (Right stubRate) (pastWindow seenAt 60)
   (count alert logs, logged "ERROR" alert logs) `shouldBe` (1, True)
-  lateWaitOf st "x" `shouldReturn` Just LWSupport
-  alertsAt l (Right stubRate) (pastWindow seenAt (24 * 3600 + 60)) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-x of order x")
-  balanceOf st "x" `shouldReturn` Nothing
+  lateWaitOf st "never" `shouldReturn` Just LWSupport
+  alertsAt l (Right stubRate) (pastWindow seenAt (24 * 3600 + 60)) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-never of order never")
+  balanceOf st "never" `shouldReturn` Nothing
 
 testPartCreditAlerted :: IO ()
 testPartCreditAlerted = withLate $ \l@Late {lStore = st} -> do
-  closedOrder l "x" False
-  settleAt l "x" (SigClosed (btcPaid lateUnits 160000)) (at 100) `shouldReturn` Right ISExpired
+  closedOrder l "part" False
+  settleAt l "part" (SigClosed (btcPaid lateUnits 160000)) (at 100) `shouldReturn` Right ISExpired
   void $ passAt l (at 101)
-  balanceOf st "x" `shouldReturn` Just (9600, 9600, 0)
+  balanceOf st "part" `shouldReturn` Just (9600, 9600, 0)
   logs <- alertsAt l (Right stubRate) (pastWindow (at 100) 60)
-  count "invoice inv-x of order x: 320000 satoshi received, 160000 satoshi confirmed, 160000 satoshi credited; refund by hand only" logs `shouldBe` 1
-  alertsAt l (Right stubRate) (pastWindow (at 100) (24 * 3600 + 60)) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-x")
+  count "invoice inv-part of order part: 320000 satoshi received, 160000 satoshi confirmed, 160000 satoshi credited; refund by hand only" logs `shouldBe` 1
+  alertsAt l (Right stubRate) (pastWindow (at 100) (24 * 3600 + 60)) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-part of order part")
 
 testMoneroZero :: IO ()
 testMoneroZero = withLate $ \l@Late {lStore = st} -> do
-  closedOrder l "x" False
-  logs <- readSignal l "x" (SigFunded (btcPaid 0 0) {rcvCrypto = Nothing} PaidInFull)
-  logs `shouldSatisfy` logged "INFO" "invoice inv-x holds money of its closed order not yet confirmed"
-  withTransaction st (\db -> latePending db (invOf "x")) `shouldReturn` Just LPConfirming
+  closedOrder l "monero" False
+  logs <- readSignal l "monero" (SigFunded (btcPaid 0 0) {rcvCrypto = Nothing} PaidInFull)
+  logs `shouldSatisfy` logged "INFO" "invoice inv-monero holds money of its closed order not yet confirmed"
+  withTransaction st (\db -> latePending db (invOf "monero")) `shouldReturn` Just LPConfirming
   now <- getCurrentTime
-  alertsAt l (Right stubRate) (addUTCTime 3600 now) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-x")
-  balanceOf st "x" `shouldReturn` Nothing
+  alertsAt l (Right stubRate) (addUTCTime 3600 now) >>= (`shouldNotSatisfy` T.isInfixOf "invoice inv-monero of order monero")
+  balanceOf st "monero" `shouldReturn` Nothing
 
 testRateFails :: IO ()
 testRateFails = withLate $ \l@Late {lStore = st} -> do
-  closedOrder l "x" False
-  closedOrder l "y" False
-  setRate l (Left $ ProviderError "rates down")
-  logs <- readSignal l "x" (SigClosed (btcPaid lateUnits lateUnits))
-  settleAt l "y" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  closedOrder l "fail1" False
+  closedOrder l "fail2" False
+  setRate l (Left $ ProviderError "rates down for fail1")
+  logs <- readSignal l "fail1" (SigClosed (btcPaid lateUnits lateUnits))
+  settleAt l "fail2" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
   more <- passAt l (at 71)
-  count "late credits wait, as the current rate cannot be read" (logs <> more) `shouldBe` 1
-  lateWaitOf st "x" `shouldReturn` Just LWCrediting
-  mapM (balanceOf st) ["x", "y"] `shouldReturn` [Nothing, Nothing]
+  count "late credits wait, as the current rate cannot be read; each pass tries again: rates down for fail1" (logs <> more) `shouldBe` 1
+  lateWaitOf st "fail1" `shouldReturn` Just LWCrediting
+  mapM (balanceOf st) ["fail1", "fail2"] `shouldReturn` [Nothing, Nothing]
   setRate l (Right stubRate)
   void $ passAt l (at 72)
-  mapM (balanceOf st) ["x", "y"] `shouldReturn` replicate 2 (Just (19200, 19200, 0))
-  lateWaitOf st "x" `shouldReturn` Nothing
+  mapM (balanceOf st) ["fail1", "fail2"] `shouldReturn` replicate 2 (Just (19200, 19200, 0))
+  lateWaitOf st "fail1" `shouldReturn` Nothing
 
 testRateFloor :: IO ()
 testRateFloor = withLate $ \l@Late {lStore = st} -> do
-  closedOrder l "x" False
+  closedOrder l "floored" False
   let floored = rateOf "31000" 31000
   setRate l (Right floored)
-  settleAt l "x" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  settleAt l "floored" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
   logs <- passAt l (at 71)
-  logs `shouldSatisfy` logged "ERROR" "invoice inv-x is not credited: the current rate 31000 is below half its rate 62500"
-  balanceOf st "x" `shouldReturn` Nothing
-  lateWaitOf st "x" `shouldReturn` Just LWSupport
+  logs `shouldSatisfy` logged "ERROR" "invoice inv-floored is not credited: the current rate 31000 is below half its rate 62500"
+  balanceOf st "floored" `shouldReturn` Nothing
+  lateWaitOf st "floored" `shouldReturn` Just LWSupport
   alertsAt l (Right floored) (pastWindow (at 70) 60)
-    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-x of order x: 320000 satoshi received, 320000 satoshi confirmed, 0 satoshi credited; confirmed; the coin's price fell by more than half since the invoice (62500, 31000); the owner decides: credit at the current rate, or refund by hand")
+    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-floored of order floored: 320000 satoshi received, 320000 satoshi confirmed, 0 satoshi credited; confirmed; the coin's price fell by more than half since the invoice (62500, 31000); the owner decides: credit at the current rate, or refund by hand")
   setRate l (Right $ rateOf "31250" 31250)
   void $ passAt l (at 72)
-  creditsOf st "x" `shouldReturn` [(Just lateUnits, Just "62500", Just "31250", Just "31250", 10000)]
-  lateWaitOf st "x" `shouldReturn` Nothing
+  creditsOf st "floored" `shouldReturn` [(Just lateUnits, Just "62500", Just "31250", Just "31250", 10000)]
+  lateWaitOf st "floored" `shouldReturn` Nothing
 
 testOneRateReadPerPass :: IO ()
 testOneRateReadPerPass = withLate $ \l@Late {lStore = st} -> do
@@ -438,14 +438,14 @@ testOneRateReadPerPass = withLate $ \l@Late {lStore = st} -> do
 
 testHighSpeed :: IO ()
 testHighSpeed = withLate $ \l@Late {lStore = st} -> do
-  closedOrder l "x" False
+  closedOrder l "hs" False
   let highSpeed = (btcPaid lateUnits 0) {rcvUncreditable = Just UCHighSpeed}
-  settleAt l "x" (SigSettled highSpeed (at 70)) (at 70) `shouldReturn` Right ISPaid
+  settleAt l "hs" (SigSettled highSpeed (at 70)) (at 70) `shouldReturn` Right ISPaid
   void $ passAt l (at 71)
-  balanceOf st "x" `shouldReturn` Nothing
-  lateWaitOf st "x" `shouldReturn` Just LWSupport
+  balanceOf st "hs" `shouldReturn` Nothing
+  lateWaitOf st "hs" `shouldReturn` Just LWSupport
   alertsAt l (Right stubRate) (pastWindow (at 70) 60)
-    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-x of order x: 320000 satoshi received, 0 satoshi confirmed, 0 satoshi credited; the invoice was made under HighSpeed")
+    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-hs of order hs: 320000 satoshi received, 0 satoshi confirmed, 0 satoshi credited; the invoice was made under HighSpeed")
 
 testCreditedByPass :: IO ()
 testCreditedByPass = withLate $ \l@Late {lStore = st} -> do
@@ -470,13 +470,13 @@ testLiveAgain = withLate $ \l@Late {lStore = st} -> do
 
 testTwoInstancesAlert :: IO ()
 testTwoInstancesAlert = withLate $ \l -> do
-  closedOrder l "x" False
-  settleAt l "x" (SigClosed (btcPaid lateUnits 0)) (at 70) `shouldReturn` Right ISExpired
-  let first = "invoice inv-x of order x: 320000 satoshi received"
+  closedOrder l "twice" False
+  settleAt l "twice" (SigClosed (btcPaid lateUnits 0)) (at 70) `shouldReturn` Right ISExpired
+  let first = "invoice inv-twice of order twice: 320000 satoshi received"
   logs <- (<>) <$> alertsAt l (Right stubRate) (pastWindow (at 70) 60) <*> alertsAt l (Right stubRate) (pastWindow (at 70) 60)
   count first logs `shouldBe` 1
-  settleAt l "x" (SigClosed (btcPaid 400000 0)) (at 80) `shouldReturn` Right ISExpired
-  alertsAt l (Right stubRate) (pastWindow (at 70) 120) >>= (`shouldSatisfy` logged "ERROR" "invoice inv-x of order x: 400000 satoshi received, 0 satoshi confirmed")
+  settleAt l "twice" (SigClosed (btcPaid 400000 0)) (at 80) `shouldReturn` Right ISExpired
+  alertsAt l (Right stubRate) (pastWindow (at 70) 120) >>= (`shouldSatisfy` logged "ERROR" "invoice inv-twice of order twice: 400000 satoshi received, 0 satoshi confirmed")
 
 testFallingSum :: IO ()
 testFallingSum = withLate $ \l@Late {lStore = st} -> do

From aaaf561c6685da00e1256b54f9c618245ede0e86 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 16:05:13 +0000
Subject: [PATCH 09/17] store: name the invoice in late payment log specs

---
 tests/Bots/StoreService/NamesOrdersTests.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/tests/Bots/StoreService/NamesOrdersTests.hs b/tests/Bots/StoreService/NamesOrdersTests.hs
index a4e5ee5e4f..ba7d1ee4cd 100644
--- a/tests/Bots/StoreService/NamesOrdersTests.hs
+++ b/tests/Bots/StoreService/NamesOrdersTests.hs
@@ -1055,23 +1055,23 @@ testLateBTCPayPayments = withFakeBTCPay $ \fake -> do
     let refOf inv = maybe (error "no invoice") irProviderRef <$> getInvoice st inv
         readAt ref = queueReadHint (weHints cWeb) ref >> drainHints poller
         paidLate ref fields = capturingStderr $ setInvoiceState fake ref fields >> readAt ref
-        alerted logs = T.isInfixOf "credited to its balance" logs
+        alerted (InvoiceId t) logs = T.isInfixOf ("invoice " <> t <> " received money after registration") logs
         later = addUTCTime 3600 orderTime
     (expired, _) <- placed ctx aliceOrder
     expiredRef <- refOf expired
     setInvoiceState fake expiredRef ["status" .= ("Expired" :: Text)]
     readAt expiredRef
     (irStatus <$>) <$> getInvoice st expired `shouldReturn` Just ISExpired
-    paidLate expiredRef ["additionalStatus" .= ("PaidLate" :: Text), "paymentMethodPaid" .= ("0.00050000" :: Text)] >>= (`shouldSatisfy` alerted)
-    capturingStderr (readAt expiredRef) >>= (`shouldNotSatisfy` alerted)
+    paidLate expiredRef ["additionalStatus" .= ("PaidLate" :: Text), "paymentMethodPaid" .= ("0.00050000" :: Text)] >>= (`shouldSatisfy` alerted expired)
+    capturingStderr (readAt expiredRef) >>= (`shouldNotSatisfy` alerted expired)
     (cancelled, _) <- placed ctx aliceOrder {oLabel = "dynamis", oPrice = 20000, oCommitment = commitmentOf 2}
     cancelledRef <- refOf cancelled
     cancelOpenInvoice st (weWaiters cWeb) (Just $ oePhases $ cOrders ctx) cancelled later `shouldReturn` True
-    paidLate cancelledRef ["status" .= ("Invalid" :: Text), "paymentMethodPaid" .= ("0.00078000" :: Text)] >>= (`shouldSatisfy` alerted)
+    paidLate cancelledRef ["status" .= ("Invalid" :: Text), "paymentMethodPaid" .= ("0.00078000" :: Text)] >>= (`shouldSatisfy` alerted cancelled)
     (swept, _) <- placed ctx aliceOrder {oOwner = ownerBText, oKey = keyB, oCommitment = commitmentOf 3}
     sweptRef <- refOf swept
     expireOverdue st (weWaiters cWeb) (Just $ oePhases $ cOrders ctx) later later [swept] `shouldReturn` [swept]
-    paidLate sweptRef ["paymentMethodPaid" .= ("0.00025000" :: Text)] >>= (`shouldSatisfy` alerted)
+    paidLate sweptRef ["paymentMethodPaid" .= ("0.00025000" :: Text)] >>= (`shouldSatisfy` alerted swept)
     forM_ [expired, cancelled, swept] $ \inv -> do
       r <- invoiceRegistration ctx inv
       (nrPhase r, nrLive r) `shouldBe` (PUnpaid, False)
@@ -1084,7 +1084,8 @@ testOneLateAlert = withOrders $ \ctx@Ctx {cStore = st, cWeb} -> do
   let paid = rcv 5000 (Just "0.00078")
       newPoller = newPollerEnv st (weWaiters cWeb) (Just $ oePhases $ cOrders ctx) (weHints cWeb) (weProviders cWeb) (poll $ weConfig cWeb)
       readWith poller = capturingStderr $ queueReadHint (weHints cWeb) ref >> drainHints poller
-      refunds = length . T.breakOnAll "received money after"
+      InvoiceId invText = inv
+      refunds = length . T.breakOnAll ("invoice " <> invText <> " received money after")
   poller <- newPoller
   setSignals (cStub ctx) [(ref, SigFunded paid PaidInPart)]
   refunds <$> readWith poller `shouldReturn` 0

From f2d414a8fd76deae1abc92d9fcf23444f2668ecb Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 16:13:50 +0000
Subject: [PATCH 10/17] store: credit late XMR only once shown confirmed

---
 .../src/StoreService/Names/Store.hs           |  5 ++--
 .../src/StoreService/Orders.hs                |  1 +
 .../src/StoreService/Poller.hs                |  2 ++
 .../src/StoreService/Providers.hs             |  4 +--
 .../src/StoreService/Providers/BTCPay.hs      | 25 ++++++++++++----
 .../StoreService/Store/Postgres/Migrations.hs |  2 +-
 .../StoreService/Store/SQLite/Migrations.hs   |  2 +-
 tests/Bots/StoreService/BTCPayTests.hs        | 27 +++++++++++++----
 .../Bots/StoreService/NamesLateCreditTests.hs | 30 +++++++++++++++++++
 9 files changed, 80 insertions(+), 18 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index 4dda7c42a1..feece95196 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -340,8 +340,8 @@ data LateWait = LWConfirming | LWCrediting | LWSupport
   deriving (Eq, Show)
 
 -- | Why a closed order's money will not be credited by itself: an invoice made under HighSpeed, an amount that could not be counted in units,
--- a current rate below the floor, or unconfirmed money alerted past the read window.
-data LateSupport = LSHighSpeed | LSUnits | LSRateFloor | LSUnconfirmed
+-- a current rate below the floor, unconfirmed money alerted past the read window, or money the provider shows no confirmation of.
+data LateSupport = LSHighSpeed | LSUnits | LSRateFloor | LSUnconfirmed | LSNoConfirmation
   deriving (Eq, Show, Enum, Bounded)
 
 instance TextEncoding LateSupport where
@@ -350,6 +350,7 @@ instance TextEncoding LateSupport where
     LSUnits -> "units"
     LSRateFloor -> "rate_floor"
     LSUnconfirmed -> "unconfirmed"
+    LSNoConfirmation -> "no_confirmation"
   textDecode t = lookup t [(textEncode s, s) | s <- [minBound .. maxBound]]
 
 instance FromField LateSupport where fromField = fromTextField_ textDecode
diff --git a/apps/simplex-store-service/src/StoreService/Orders.hs b/apps/simplex-store-service/src/StoreService/Orders.hs
index 92023d6c78..fbb3928280 100644
--- a/apps/simplex-store-service/src/StoreService/Orders.hs
+++ b/apps/simplex-store-service/src/StoreService/Orders.hs
@@ -221,6 +221,7 @@ lateSupportOf :: Uncreditable -> LateSupport
 lateSupportOf = \case
   UCHighSpeed -> LSHighSpeed
   UCUncounted -> LSUnits
+  UCNoConfirmationShown -> LSNoConfirmation
 
 latePayment :: InvoiceId -> RegistrationId -> IO ()
 latePayment (InvoiceId invText) (RegistrationId rid) =
diff --git a/apps/simplex-store-service/src/StoreService/Poller.hs b/apps/simplex-store-service/src/StoreService/Poller.hs
index 5138b6e547..791178d9d5 100644
--- a/apps/simplex-store-service/src/StoreService/Poller.hs
+++ b/apps/simplex-store-service/src/StoreService/Poller.hs
@@ -399,6 +399,7 @@ lateReason :: PollerEnv -> LateAlert -> IO (Text, Maybe LateSupport)
 lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState = LateCreditState {lsInvoice, lsCoin, lsSupport, lsInvoiceRate}} = case laPending of
   LPUncounted -> pure (uncounted, Nothing)
   _ | lsSupport == Just LSHighSpeed -> pure (highSpeed, Nothing)
+  _ | lsSupport == Just LSNoConfirmation -> pure (noConfirmation, Nothing)
   LPUncredited -> case lsCoin of
     Nothing -> pure (cardWaits, Nothing)
     Just coin
@@ -411,6 +412,7 @@ lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState =
   where
     unconfirmed = "refund by hand only a transaction confirmed on chain that BTCPay no longer monitors; one still Processing there waits"
     highSpeed = "the invoice was made under HighSpeed, so its money is never credited by itself; refund by hand only a transaction confirmed on chain"
+    noConfirmation = "the Monero plugin shows no confirmation of this money (the invoice's settled-confirmation threshold is 0 or not given), so it is never credited by itself; refund by hand only a transaction confirmed on chain"
     rateRead = "confirmed, the credit waits on the rate read; do not refund; fix the rate read"
     cardWaits = "confirmed, the credit waits on the poller's credit pass; do not refund; check the service log"
     rateFloor current = "confirmed; the coin's price fell by more than half since the invoice (" <> fromMaybe "?" lsInvoiceRate <> ", " <> current <> "); the owner decides: credit at the current rate, or refund by hand"
diff --git a/apps/simplex-store-service/src/StoreService/Providers.hs b/apps/simplex-store-service/src/StoreService/Providers.hs
index 8e5aae52c2..f4d02372e2 100644
--- a/apps/simplex-store-service/src/StoreService/Providers.hs
+++ b/apps/simplex-store-service/src/StoreService/Providers.hs
@@ -52,8 +52,8 @@ data Confirmed = Confirmed {cfCents :: CurrencyAmount, cfUnits :: Maybe Int64}
   deriving (Eq, Show)
 
 -- | Why money on an invoice is never credited by itself: it was made under a policy that settles at zero confirmations,
--- or its crypto could not be counted in atomic units. Such money confirms nothing.
-data Uncreditable = UCHighSpeed | UCUncounted
+-- its crypto could not be counted in atomic units, or the provider shows no confirmation of it. Such money confirms nothing.
+data Uncreditable = UCHighSpeed | UCUncounted | UCNoConfirmationShown
   deriving (Eq, Show)
 
 -- | A coin's current price in the service's currency, above 0: as the provider wrote it, and as a decimal to compute with.
diff --git a/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs b/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs
index fef0764691..23bc5b199a 100644
--- a/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs
+++ b/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs
@@ -86,7 +86,11 @@ import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
 -- - an invoice's checkout.speedPolicy, GET stores/{storeId}/invoices/{invoiceId} and the list: BTCPayServer.Client/Models/InvoiceData.cs,
 --   nullable; HighSpeed settles at 0 confirmations, MediumSpeed at 1, LowMediumSpeed at 2, LowSpeed at 6
 --   (wwwroot/swagger/v1/swagger.template.json, SpeedPolicy). The Monero plugin (btcpay-monero/btcpayserver-monero-plugin v1.4.0,
---   Plugins/Monero/Services/MoneroListener.cs, ConfirmationsRequired) maps the policies the same way, unless the store sets its own threshold;
+--   Plugins/Monero/Services/MoneroListener.cs, ConfirmationsRequired) maps the policies the same way, unless the store sets its own
+--   InvoiceSettledConfirmationThreshold, which settles a payment at that many confirmations. Greenfield's payment model
+--   (Controllers/GreenField/GreenfieldInvoiceController.cs, ToPaymentModel) carries no payment's confirmations; the method's
+--   additionalData (Payments/MoneroLikeOnChainPaymentMethodDetails.cs, camel-cased by Data/BlobSerializer.cs) carries the invoice's
+--   invoiceSettledConfirmationThreshold, so a Settled XMR payment shows a confirmation only when it is at least 1;
 -- - the store's rates, GET stores/{storeId}/rates?currencyPair=BTC_USD: Controllers/GreenField/GreenfieldStoreRatesController.cs and
 --   Models/StoreRateResult.cs, a list of {currencyPair, errors, rate}, rate null when errors is not empty; it needs canviewstoresettings.
 btcMethodId, xmrMethodId :: Text
@@ -199,7 +203,8 @@ data GPaymentMethod = GPaymentMethod
     gpmRate :: Maybe WireNum,
     gpmPaid :: Maybe WireNum,
     gpmDue :: Maybe WireNum,
-    gpmPayments :: [GPayment]
+    gpmPayments :: [GPayment],
+    gpmSettledThreshold :: Maybe Int
   }
   deriving (Show)
 
@@ -213,6 +218,12 @@ instance J.FromJSON GPaymentMethod where
       <*> o J..:? "paymentMethodPaid"
       <*> o J..:? "due"
       <*> (fromMaybe [] <$> o J..:? "payments")
+      <*> (settledThreshold <$> o J..:? "additionalData")
+    where
+      -- read leniently: another plugin's additionalData must not fail the read
+      settledThreshold = \case
+        Just (J.Object d) | Just (J.Number n) <- KM.lookup "invoiceSettledConfirmationThreshold" d -> toBoundedInteger n
+        _ -> Nothing
 
 -- | A payment without a value is read, and only its units cannot be counted.
 data GPayment = GPayment
@@ -428,12 +439,13 @@ paymentMethodsSignal now ref status policy body =
 -- Complete is the old API's status name and never matches, so it has no case here.
 invoiceSignal :: UTCTime -> Text -> Text -> Maybe Text -> [GPaymentMethod] -> Either ProviderError (Maybe PaymentSignal)
 invoiceSignal now ref status policy ms = do
-  (m@GPaymentMethod {gpmRate, gpmPaid, gpmDue, gpmPayments}, cc) <- chooseMethod ref ms
+  (m@GPaymentMethod {gpmRate, gpmPaid, gpmDue, gpmPayments, gpmSettledThreshold}, cc) <- chooseMethod ref ms
   rate <- priced "rate" gpmRate
   paid <- priced "paymentMethodPaid" gpmPaid
   let decimals = unitDecimals cc
       confirming = maybe False (`elem` map speedPolicyName confirmingPolicies) policy
-      received = receivedOf decimals confirming (status == "Settled") rate paid gpmDue gpmPayments
+      shown = cc /= CCXmr || maybe False (>= 1) gpmSettledThreshold
+      received = receivedOf decimals confirming shown (status == "Settled") rate paid gpmDue gpmPayments
   case status of
     "Settled" -> Right (Just (SigSettled received (fromMaybe now (latestSettledAt m))))
     "Processing" -> Right (Just (SigFunded received PaidInFull))
@@ -475,8 +487,8 @@ findMethod what ref methodId body = do
 
 -- | The confirmed crypto shares paymentMethodPaid's basis, whatever it nets out: all of it once the invoice or every payment is Settled,
 -- else the Settled payments' value capped at it. An amount with a non-zero digit past its unit leaves every figure in units out.
-receivedOf :: Int -> Bool -> Bool -> WireNum -> WireNum -> Maybe WireNum -> [GPayment] -> Received
-receivedOf decimals confirming invoiceSettled rate paid due payments =
+receivedOf :: Int -> Bool -> Bool -> Bool -> WireNum -> WireNum -> Maybe WireNum -> [GPayment] -> Received
+receivedOf decimals confirming shown invoiceSettled rate paid due payments =
   Received
     { rcvAmount = toMinorUnits (wnValue paid * wnValue rate),
       rcvCrypto = if wnValue paid > 0 then Just (wnText paid) else Nothing,
@@ -498,6 +510,7 @@ receivedOf decimals confirming invoiceSettled rate paid due payments =
     uncreditable
       | isNothing counted = Just UCUncounted
       | not confirming = Just UCHighSpeed
+      | not shown = Just UCNoConfirmationShown
       | otherwise = Nothing
     toUnits v
       | v < 0 = Nothing
diff --git a/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs b/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
index 736ddd3a82..cd805f2fd7 100644
--- a/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
+++ b/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
@@ -442,7 +442,7 @@ DROP INDEX @idx_name_balances_reserved_by;
 DROP TABLE @name_balances;
 |]
 
--- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor or unconfirmed. Never cleared.
+-- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor, unconfirmed or no_confirmation. Never cleared.
 m20261022_name_late_wait :: Text
 m20261022_name_late_wait =
   withPrefix
diff --git a/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs b/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
index 7761b1e838..5c432c0458 100644
--- a/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
+++ b/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
@@ -444,7 +444,7 @@ DROP INDEX @idx_name_balances_reserved_by;
 DROP TABLE @name_balances;
 |]
 
--- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor or unconfirmed. Never cleared.
+-- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor, unconfirmed or no_confirmation. Never cleared.
 m20261022_name_late_wait :: Query
 m20261022_name_late_wait =
   withPrefix
diff --git a/tests/Bots/StoreService/BTCPayTests.hs b/tests/Bots/StoreService/BTCPayTests.hs
index bfee4427f0..5db1ed7c47 100644
--- a/tests/Bots/StoreService/BTCPayTests.hs
+++ b/tests/Bots/StoreService/BTCPayTests.hs
@@ -82,6 +82,7 @@ badgeBTCPayTests = describe "badge btcpay adapter" $ do
     it "confirms all of paymentMethodPaid when every payment reads Settled, whatever their values" testConfirmedAllSettled
     it "confirms the Settled payments' value otherwise, rounded to cents once and capped at paymentMethodPaid" testConfirmedSettledSum
     it "counts BTC in satoshi and XMR in piconero" testConfirmedUnits
+    it "confirms XMR only when the invoice's settled-confirmation threshold is at least 1, never with 0 or none" testXmrConfirmations
     it "confirms nothing under HighSpeed, or with no or an unknown speed policy, an invoice-level Settled included" testHighSpeedConfirmsNothing
     it "accepts trailing zeros past the unit" testTrailingZeros
     it "drops only the units of an amount with a non-zero digit past its unit, the signal and its cents as before" testDigitPastUnit
@@ -144,8 +145,9 @@ paymentOf status value =
       "fee" .= ("0.00000100" :: Text)
     ]
 
-xmrPaid :: Text -> [J.Value] -> J.Value
-xmrPaid paid payments =
+-- | The Monero plugin's method, its additionalData carrying the invoice's settled-confirmation threshold when given.
+xmrPaid :: Maybe Int -> Text -> [J.Value] -> J.Value
+xmrPaid threshold paid payments =
   J.object
     [ "paymentMethodId" .= xmrMethodId,
       "destination" .= ("44AFFq5kSiGBoZ4NMDwYtN18obc8AemS33DBLWs3H7otXft3XjrpDtQGv7SqSsaBYBb98uNbr2VBBEt7f2wfn3RVGQBEP3A" :: Text),
@@ -153,7 +155,8 @@ xmrPaid paid payments =
       "rate" .= ("168.25" :: Text),
       "paymentMethodPaid" .= paid,
       "due" .= ("0.00000000" :: Text),
-      "payments" .= payments
+      "payments" .= payments,
+      "additionalData" .= J.object (maybe [] (\n -> ["invoiceSettledConfirmationThreshold" .= n]) threshold)
     ]
 
 testConfirmedInvoiceSettled :: IO ()
@@ -178,8 +181,20 @@ testConfirmedSettledSum = do
 testConfirmedUnits :: IO ()
 testConfirmedUnits = do
   (rcvUnitsOf =<<) <$> signalOf "Settled" [btcPaid "0.00050000" []] `shouldBe` Right (Just 50000)
-  signalOf "Settled" [xmrPaid "0.32095000" [paymentOf "Settled" "0.32095000"]]
-    `shouldBe` Right (Just (SigSettled xmrReceived {rcvConfirmed = Confirmed {cfCents = CurrencyAmount 5400, cfUnits = Just 320950000000}} (posixSecondsToUTCTime 1700000000)))
+  signalOf "Settled" [xmrPaid (Just 1) "0.32095000" [paymentOf "Settled" "0.32095000"]]
+    `shouldBe` Right (Just (SigSettled xmrConfirmed (posixSecondsToUTCTime 1700000000)))
+
+xmrConfirmed :: Received
+xmrConfirmed = xmrReceived {rcvConfirmed = Confirmed {cfCents = CurrencyAmount 5400, cfUnits = Just 320950000000}, rcvUncreditable = Nothing}
+
+-- | A Monero payment's own confirmations are not in Greenfield's payment model, so only the invoice's threshold shows one.
+testXmrConfirmations :: IO ()
+testXmrConfirmations = do
+  let settledWith threshold = signalOf "Settled" [xmrPaid threshold "0.32095000" [paymentOf "Settled" "0.32095000"]]
+      settled r = Right (Just (SigSettled r (posixSecondsToUTCTime 1700000000)))
+  settledWith (Just 0) `shouldBe` settled xmrReceived
+  settledWith Nothing `shouldBe` settled xmrReceived
+  mapM_ (\n -> settledWith (Just n) `shouldBe` settled xmrConfirmed) [1, 10]
 
 rcvUnitsOf :: PaymentSignal -> Maybe Int64
 rcvUnitsOf = \case
@@ -618,7 +633,7 @@ xmrReceived =
       rcvUnits = Just 320950000000,
       rcvRate = Just "168.25",
       rcvConfirmed = Confirmed {cfCents = CurrencyAmount 0, cfUnits = Just 0},
-      rcvUncreditable = Nothing
+      rcvUncreditable = Just UCNoConfirmationShown
     }
 
 fiftyFourDollars :: OrderDraft
diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index 175509d4cb..05cb6fbc98 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -75,6 +75,7 @@ namesLateCreditTests = describe "StoreService names: balance life" $ do
     it "keeps the confirmed figure and the credit when the settled sum falls, crediting nothing on the same sum again" testFallingSum
     it "credits an invoice past the read window after a hinted read" testHintPastWindow
     it "credits Stripe's succeeded amount without reading a rate" testStripeCredited
+    it "credits late XMR in piconero when the plugin shows a confirmation, and alerts it to support when it shows none" testXmrLate
   describe "balances with late credits" $ do
     it "keeps a credit made while the balance is held, the held spend settling" testCreditWhileHeld
     it "refuses a covered spend that read the amount before a credit" testSpendBeforeCredit
@@ -507,6 +508,35 @@ testStripeCredited = withLate $ \l@Late {lStore = st} -> do
   balanceOf st "c" `shouldReturn` Just (20000, 20000, 0)
   rateCalls l `shouldReturn` 0
 
+-- | 0.32095 XMR at the invoice's rate of 168.25, all of it Settled; uncreditable unless the plugin shows a confirmation.
+xmrPaid :: Maybe Uncreditable -> Received
+xmrPaid uncreditable =
+  Received
+    { rcvAmount = CurrencyAmount 5400,
+      rcvCrypto = Just "0.32095000",
+      rcvDue = Nothing,
+      rcvUnits = Just xmrUnits,
+      rcvRate = Just "168.25",
+      rcvConfirmed = maybe (Confirmed {cfCents = CurrencyAmount 5400, cfUnits = Just xmrUnits}) (const Confirmed {cfCents = CurrencyAmount 0, cfUnits = Just 0}) uncreditable,
+      rcvUncreditable = uncreditable
+    }
+  where
+    xmrUnits = 320950000000
+
+testXmrLate :: IO ()
+testXmrLate = withLate $ \l@Late {lStore = st} -> do
+  mapM_ (\r -> closedOrder l r False) ["xmrshown", "xmrnone"]
+  withTransaction st $ \db -> DB.execute_ db "UPDATE sx_badge_service_invoices SET payment_crypto_currency = 'xmr' WHERE invoice_id IN ('inv-xmrshown', 'inv-xmrnone')"
+  setRate l (Right $ rateOf "150" 150)
+  void $ readSignal l "xmrshown" (SigSettled (xmrPaid Nothing) (at 70))
+  creditsOf st "xmrshown" `shouldReturn` [(Just 320950000000, Just "168.25", Just "150", Just "150", 4814)]
+  void $ readSignal l "xmrnone" (SigSettled (xmrPaid $ Just UCNoConfirmationShown) (at 70))
+  balanceOf st "xmrnone" `shouldReturn` Nothing
+  lateWaitOf st "xmrnone" `shouldReturn` Just LWSupport
+  now <- getCurrentTime
+  alertsAt l (Right stubRate) (pastWindow now 60)
+    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-xmrnone of order xmrnone: 320950000000 piconero received, 0 piconero confirmed, 0 piconero credited; the Monero plugin shows no confirmation")
+
 -- balances with late credits
 
 testCreditWhileHeld :: IO ()

From b1159ef5727502dadc44a7e63312125379f85f01 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 16:30:49 +0000
Subject: [PATCH 11/17] store: log a rate floor once an hour per invoice

---
 apps/simplex-store-service/src/StoreService/Poller.hs |  5 ++---
 tests/Bots/StoreService/NamesLateCreditTests.hs       | 11 +++++++++++
 2 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Poller.hs b/apps/simplex-store-service/src/StoreService/Poller.hs
index 791178d9d5..5d6502f4a8 100644
--- a/apps/simplex-store-service/src/StoreService/Poller.hs
+++ b/apps/simplex-store-service/src/StoreService/Poller.hs
@@ -371,9 +371,8 @@ creditLate env@PollerEnv {peStore} p now invId@(InvoiceId invText) = do
       due <- dueToWarn env now ("rate read failed: " <> tshow (pProvider p))
       when due $ logWarn ("names: late credits wait, as the current rate cannot be read; each pass tries again: " <> e)
     CORateFloor invoiceRate Rate {rateText} -> do
-      let alert = "names: invoice " <> invText <> " is not credited: the current rate " <> rateText <> " is below half its rate " <> invoiceRate <> "; a glitch, or a real fall the owner decides on"
-      due <- dueToWarn env now alert
-      when due $ logError alert
+      due <- dueToWarn env now ("rate floor: " <> invText)
+      when due $ logError ("names: invoice " <> invText <> " is not credited: the current rate " <> rateText <> " is below half its rate " <> invoiceRate <> "; a glitch, or a real fall the owner decides on")
     CORefused -> logError ("names: the credit of invoice " <> invText <> " was refused, its credit number taken meanwhile; the next pass tries again")
   pure outcome
 
diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index 05cb6fbc98..1cb5171bad 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -67,6 +67,7 @@ namesLateCreditTests = describe "StoreService names: balance life" $ do
     it "logs Monero's zero figure as pending and does not alert it within the window" testMoneroZero
     it "credits nothing while the rate read fails, warning once, then credits at the next pass" testRateFails
     it "credits nothing below the rate floor, logging an error, and alerts naming both rates and the owner's decision" testRateFloor
+    it "logs the rate floor of an invoice once while the price moves below it" testFloorLoggedOnce
     it "reads one rate per coin per pass for several invoices, and none when nothing is due" testOneRateReadPerPass
     it "never credits a late Settled payment on an invoice made under HighSpeed, alerting it past the window" testHighSpeed
     it "credits at the next pass a late Settled invoice and a settlement whose credit step did not run" testCreditedByPass
@@ -426,6 +427,16 @@ testRateFloor = withLate $ \l@Late {lStore = st} -> do
   creditsOf st "floored" `shouldReturn` [(Just lateUnits, Just "62500", Just "31250", Just "31250", 10000)]
   lateWaitOf st "floored" `shouldReturn` Nothing
 
+testFloorLoggedOnce :: IO ()
+testFloorLoggedOnce = withLate $ \l -> do
+  closedOrder l "floorlog" False
+  settleAt l "floorlog" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  setRate l (Right $ rateOf "31000" 31000)
+  first <- passAt l (at 71)
+  setRate l (Right $ rateOf "30000" 30000)
+  second <- passAt l (at 72)
+  count "invoice inv-floorlog is not credited" (first <> second) `shouldBe` 1
+
 testOneRateReadPerPass :: IO ()
 testOneRateReadPerPass = withLate $ \l@Late {lStore = st} -> do
   mapM_ (\r -> closedOrder l r False >> settleAt l r (SigClosed (btcPaid lateUnits lateUnits)) (at 70)) ["x", "y", "z"]

From 64dd9e963bcc276e16c73161bb259f3364c628ae Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 16:31:10 +0000
Subject: [PATCH 12/17] store: stop late credit at the rate floor

---
 .../src/StoreService/Names/LateCredits.hs             |  9 +++++----
 .../src/StoreService/Names/Store.hs                   |  7 +++++--
 apps/simplex-store-service/src/StoreService/Poller.hs |  8 ++++----
 tests/Bots/StoreService/NamesLateCreditTests.hs       | 11 ++++++-----
 4 files changed, 20 insertions(+), 15 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs b/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
index ea251b64ae..1187ddddd6 100644
--- a/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
@@ -43,7 +43,7 @@ data CreditOutcome
 creditLateInvoice :: DBStore -> (CryptoCurrency -> IO (Either ProviderError Rate)) -> InvoiceId -> UTCTime -> IO CreditOutcome
 creditLateInvoice st readRate invId now =
   withTransaction st (`lateCreditState` invId) >>= \case
-    Just s | closedUnpaid s && moneyDue s -> case lsCoin s of
+    Just s | creditable s && moneyDue s -> case lsCoin s of
       Nothing -> credit Nothing
       Just coin ->
         readRate coin >>= \case
@@ -59,13 +59,14 @@ creditLateInvoice st readRate invId now =
     credit rate = withTransaction st $ \db -> do
       lockInvoice db invId now
       lateCreditState db invId >>= \case
-        Just s | closedUnpaid s, Just c <- lateCreditOf s rate -> do
+        Just s | creditable s, Just c <- lateCreditOf s rate -> do
           applied <- creditLatePayment db c now
           pure $ if applied then COCredited c else CORefused
         _ -> pure CONothingDue
 
-closedUnpaid :: LateCreditState -> Bool
-closedUnpaid LateCreditState {lsPhase, lsLive} = lsPhase == PUnpaid && not lsLive
+-- | A closed order's money, unless a rate below the floor sent it to support for good, so a later recovery cannot credit money refunded by hand.
+creditable :: LateCreditState -> Bool
+creditable LateCreditState {lsPhase, lsLive, lsSupport} = lsPhase == PUnpaid && not lsLive && lsSupport /= Just LSRateFloor
 
 moneyDue :: LateCreditState -> Bool
 moneyDue s@LateCreditState {lsConfirmedCents, lsCreditedCents} = case lsCoin s of
diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index feece95196..f28117b8b7 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -1152,11 +1152,14 @@ lateWait db (InvoiceId invId) =
       (Just LPConfirming, Nothing) -> Just LWConfirming
       (Just LPUnconfirmed, Nothing) -> Just LWConfirming
 
--- | Closed orders' invoices with confirmed money not all credited, for the poller's credit pass.
+-- | Closed orders' invoices with confirmed money not all credited, for the poller's credit pass; none a rate below the floor sent to support.
 uncreditedLateInvoices :: DB.Connection -> IO [InvoiceId]
 uncreditedLateInvoices db =
   map (InvoiceId . fromOnly)
-    <$> DB.query db ("SELECT ni.invoice_id" <> lateFrom <> " WHERE" <> closedUnpaid <> " AND" <> uncreditedMoney <> " ORDER BY p.created_at, ni.invoice_id") (Only PUnpaid)
+    <$> DB.query
+      db
+      ("SELECT ni.invoice_id" <> lateFrom <> " WHERE" <> closedUnpaid <> " AND" <> uncreditedMoney <> " AND (ni.late_support IS NULL OR ni.late_support <> ?) ORDER BY p.created_at, ni.invoice_id")
+      (PUnpaid, LSRateFloor)
 
 -- | Pending money whose payment row was created before the cutoff, never alerted, or alerted for less money than now received.
 lateAlertDue :: DB.Connection -> UTCTime -> IO [LateAlert]
diff --git a/apps/simplex-store-service/src/StoreService/Poller.hs b/apps/simplex-store-service/src/StoreService/Poller.hs
index 5d6502f4a8..eb9377a0ed 100644
--- a/apps/simplex-store-service/src/StoreService/Poller.hs
+++ b/apps/simplex-store-service/src/StoreService/Poller.hs
@@ -372,7 +372,7 @@ creditLate env@PollerEnv {peStore} p now invId@(InvoiceId invText) = do
       when due $ logWarn ("names: late credits wait, as the current rate cannot be read; each pass tries again: " <> e)
     CORateFloor invoiceRate Rate {rateText} -> do
       due <- dueToWarn env now ("rate floor: " <> invText)
-      when due $ logError ("names: invoice " <> invText <> " is not credited: the current rate " <> rateText <> " is below half its rate " <> invoiceRate <> "; a glitch, or a real fall the owner decides on")
+      when due $ logError ("names: invoice " <> invText <> " is not credited: the current rate " <> rateText <> " is below half its rate " <> invoiceRate <> "; it is never credited by itself, and support refunds it by hand")
     CORefused -> logError ("names: the credit of invoice " <> invText <> " was refused, its credit number taken meanwhile; the next pass tries again")
   pure outcome
 
@@ -404,8 +404,8 @@ lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState =
     Just coin
       | lsSupport == Just LSRateFloor ->
           getInvoice peStore lsInvoice >>= \case
-            Just InvoiceRow {irProvider} | Just p <- find ((== irProvider) . pProvider) peProviders -> either (const (rateRead, Nothing)) (\Rate {rateText} -> (rateFloor rateText, Nothing)) <$> cachedRate env p coin
-            _ -> pure (rateRead, Nothing)
+            Just InvoiceRow {irProvider} | Just p <- find ((== irProvider) . pProvider) peProviders -> (\r -> (rateFloor (either (const "unread") rateText r), Nothing)) <$> cachedRate env p coin
+            _ -> pure (rateFloor "unread", Nothing)
       | otherwise -> pure (rateRead, Nothing)
   _ -> pure (unconfirmed, Just LSUnconfirmed)
   where
@@ -414,7 +414,7 @@ lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState =
     noConfirmation = "the Monero plugin shows no confirmation of this money (the invoice's settled-confirmation threshold is 0 or not given), so it is never credited by itself; refund by hand only a transaction confirmed on chain"
     rateRead = "confirmed, the credit waits on the rate read; do not refund; fix the rate read"
     cardWaits = "confirmed, the credit waits on the poller's credit pass; do not refund; check the service log"
-    rateFloor current = "confirmed; the coin's price fell by more than half since the invoice (" <> fromMaybe "?" lsInvoiceRate <> ", " <> current <> "); the owner decides: credit at the current rate, or refund by hand"
+    rateFloor current = "confirmed; the coin's price fell by more than half since the invoice (" <> fromMaybe "?" lsInvoiceRate <> ", " <> current <> "); it is never credited by itself; refund by hand only a transaction confirmed on chain"
     uncounted = "an amount BTCPay reported with more decimals than its unit; check it at the provider"
 
 lateAlertText :: LateAlert -> Text -> Text
diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index 1cb5171bad..d5d24e81a6 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -66,7 +66,7 @@ namesLateCreditTests = describe "StoreService names: balance life" $ do
     it "alerts a part credit with an unconfirmed rest once, naming its units" testPartCreditAlerted
     it "logs Monero's zero figure as pending and does not alert it within the window" testMoneroZero
     it "credits nothing while the rate read fails, warning once, then credits at the next pass" testRateFails
-    it "credits nothing below the rate floor, logging an error, and alerts naming both rates and the owner's decision" testRateFloor
+    it "credits nothing below the rate floor and never after, logging an error, and alerts support naming both rates" testRateFloor
     it "logs the rate floor of an invoice once while the price moves below it" testFloorLoggedOnce
     it "reads one rate per coin per pass for several invoices, and none when nothing is due" testOneRateReadPerPass
     it "never credits a late Settled payment on an invoice made under HighSpeed, alerting it past the window" testHighSpeed
@@ -421,11 +421,12 @@ testRateFloor = withLate $ \l@Late {lStore = st} -> do
   balanceOf st "floored" `shouldReturn` Nothing
   lateWaitOf st "floored" `shouldReturn` Just LWSupport
   alertsAt l (Right floored) (pastWindow (at 70) 60)
-    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-floored of order floored: 320000 satoshi received, 320000 satoshi confirmed, 0 satoshi credited; confirmed; the coin's price fell by more than half since the invoice (62500, 31000); the owner decides: credit at the current rate, or refund by hand")
-  setRate l (Right $ rateOf "31250" 31250)
+    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-floored of order floored: 320000 satoshi received, 320000 satoshi confirmed, 0 satoshi credited; confirmed; the coin's price fell by more than half since the invoice (62500, 31000); it is never credited by itself; refund by hand only a transaction confirmed on chain")
+  setRate l (Right stubRate)
   void $ passAt l (at 72)
-  creditsOf st "floored" `shouldReturn` [(Just lateUnits, Just "62500", Just "31250", Just "31250", 10000)]
-  lateWaitOf st "floored" `shouldReturn` Nothing
+  creditsOf st "floored" `shouldReturn` []
+  withTransaction st uncreditedLateInvoices >>= (`shouldNotSatisfy` elem (invOf "floored"))
+  lateWaitOf st "floored" `shouldReturn` Just LWSupport
 
 testFloorLoggedOnce :: IO ()
 testFloorLoggedOnce = withLate $ \l -> do

From 8a35f182dc6b098da0a10647bc1ae0f66c3d6a8f Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 16:31:19 +0000
Subject: [PATCH 13/17] store: alert waiting money before stored reasons

---
 apps/simplex-store-service/src/StoreService/Poller.hs |  5 +++--
 tests/Bots/StoreService/NamesLateCreditTests.hs       | 10 ++++++++++
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Poller.hs b/apps/simplex-store-service/src/StoreService/Poller.hs
index eb9377a0ed..4e461cfb65 100644
--- a/apps/simplex-store-service/src/StoreService/Poller.hs
+++ b/apps/simplex-store-service/src/StoreService/Poller.hs
@@ -394,11 +394,10 @@ alertLatePayments env@PollerEnv {peStore} now = do
       claimed <- withTransaction peStore $ \db -> claimLateAlert db alert support now
       when claimed $ logError (lateAlertText alert reason)
 
+-- | Confirmed money waiting comes before a stored reason, as in pendingCase, so its alert never asks for a refund by hand.
 lateReason :: PollerEnv -> LateAlert -> IO (Text, Maybe LateSupport)
 lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState = LateCreditState {lsInvoice, lsCoin, lsSupport, lsInvoiceRate}} = case laPending of
   LPUncounted -> pure (uncounted, Nothing)
-  _ | lsSupport == Just LSHighSpeed -> pure (highSpeed, Nothing)
-  _ | lsSupport == Just LSNoConfirmation -> pure (noConfirmation, Nothing)
   LPUncredited -> case lsCoin of
     Nothing -> pure (cardWaits, Nothing)
     Just coin
@@ -407,6 +406,8 @@ lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState =
             Just InvoiceRow {irProvider} | Just p <- find ((== irProvider) . pProvider) peProviders -> (\r -> (rateFloor (either (const "unread") rateText r), Nothing)) <$> cachedRate env p coin
             _ -> pure (rateFloor "unread", Nothing)
       | otherwise -> pure (rateRead, Nothing)
+  _ | lsSupport == Just LSHighSpeed -> pure (highSpeed, Nothing)
+  _ | lsSupport == Just LSNoConfirmation -> pure (noConfirmation, Nothing)
   _ -> pure (unconfirmed, Just LSUnconfirmed)
   where
     unconfirmed = "refund by hand only a transaction confirmed on chain that BTCPay no longer monitors; one still Processing there waits"
diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index d5d24e81a6..c3fb1cb1e3 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -68,6 +68,7 @@ namesLateCreditTests = describe "StoreService names: balance life" $ do
     it "credits nothing while the rate read fails, warning once, then credits at the next pass" testRateFails
     it "credits nothing below the rate floor and never after, logging an error, and alerts support naming both rates" testRateFloor
     it "logs the rate floor of an invoice once while the price moves below it" testFloorLoggedOnce
+    it "alerts confirmed money waiting on the rate read as such, whatever reason was stored before" testWaitingOutranksStoredReason
     it "reads one rate per coin per pass for several invoices, and none when nothing is due" testOneRateReadPerPass
     it "never credits a late Settled payment on an invoice made under HighSpeed, alerting it past the window" testHighSpeed
     it "credits at the next pass a late Settled invoice and a settlement whose credit step did not run" testCreditedByPass
@@ -438,6 +439,15 @@ testFloorLoggedOnce = withLate $ \l -> do
   second <- passAt l (at 72)
   count "invoice inv-floorlog is not credited" (first <> second) `shouldBe` 1
 
+-- | A reason stored by an earlier read, as one without the invoice's policy would store HighSpeed.
+testWaitingOutranksStoredReason :: IO ()
+testWaitingOutranksStoredReason = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "outranked" False
+  withTransaction st $ \db -> setLateSupport db (invOf "outranked") LSHighSpeed
+  settleAt l "outranked" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  alertsAt l (Left $ ProviderError "rates down for outranked") (pastWindow (at 70) 60)
+    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-outranked of order outranked: 320000 satoshi received, 320000 satoshi confirmed, 0 satoshi credited; confirmed, the credit waits on the rate read; do not refund; fix the rate read")
+
 testOneRateReadPerPass :: IO ()
 testOneRateReadPerPass = withLate $ \l@Late {lStore = st} -> do
   mapM_ (\r -> closedOrder l r False >> settleAt l r (SigClosed (btcPaid lateUnits lateUnits)) (at 70)) ["x", "y", "z"]

From 6b2bb17db3903721f28895c70bf01659d3792c6b Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 16:31:36 +0000
Subject: [PATCH 14/17] store: name the invoice in credit pass warnings

---
 .../src/StoreService/Names/LateCredits.hs        | 16 +++++++++-------
 .../src/StoreService/Poller.hs                   |  7 ++++++-
 tests/Bots/StoreService/NamesLateCreditTests.hs  | 12 ++++++++++++
 3 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs b/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
index 1187ddddd6..082febeea7 100644
--- a/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
@@ -31,10 +31,12 @@ import Text.Read (readMaybe)
 minCurrentRateFraction :: Rational
 minCurrentRateFraction = 1 % 2
 
--- | CORefused: the credit's number was taken meanwhile, which the invoice's lock rules out.
+-- | CONoInvoiceRate: crypto due with no invoice rate recorded to credit it at. CORefused: the credit's number was taken meanwhile,
+-- which the invoice's lock rules out.
 data CreditOutcome
   = CONothingDue
   | COCredited LateCredit
+  | CONoInvoiceRate
   | CORateFailed ProviderError
   | CORateFloor Text Rate
   | CORefused
@@ -45,12 +47,12 @@ creditLateInvoice st readRate invId now =
   withTransaction st (`lateCreditState` invId) >>= \case
     Just s | creditable s && moneyDue s -> case lsCoin s of
       Nothing -> credit Nothing
-      Just coin ->
-        readRate coin >>= \case
-          Left e -> pure $ CORateFailed e
-          Right rate -> case invoiceRate s of
-            Nothing -> pure $ CORateFailed $ ProviderError "the invoice's rate is not stored"
-            Just (invoiceText, invoiceValue)
+      Just coin -> case invoiceRate s of
+        Nothing -> pure CONoInvoiceRate
+        Just (invoiceText, invoiceValue) ->
+          readRate coin >>= \case
+            Left e -> pure $ CORateFailed e
+            Right rate
               | toRational (rateValue rate) < minCurrentRateFraction * toRational invoiceValue ->
                   CORateFloor invoiceText rate <$ withTransaction st (\db -> setLateSupport db invId LSRateFloor)
               | otherwise -> credit (Just rate)
diff --git a/apps/simplex-store-service/src/StoreService/Poller.hs b/apps/simplex-store-service/src/StoreService/Poller.hs
index 4e461cfb65..0044168de2 100644
--- a/apps/simplex-store-service/src/StoreService/Poller.hs
+++ b/apps/simplex-store-service/src/StoreService/Poller.hs
@@ -341,7 +341,9 @@ creditPass env@PollerEnv {peStore, peProviders} now = do
       safely ("names: crediting invoice " <> invText) $
         getInvoice peStore invId >>= \case
           Just InvoiceRow {irProvider} | Just p <- find ((== irProvider) . pProvider) peProviders -> void $ creditLate env p now invId
-          _ -> logWarn ("names: invoice " <> invText <> " has late money to credit, but no provider is configured to read its rate")
+          _ -> do
+            due' <- dueToWarn env now ("no rate provider: " <> invText)
+            when due' $ logWarn ("names: invoice " <> invText <> " has late money to credit, but no provider is configured to read its rate")
 
 -- | The pass's rate of a coin at a provider, read at most once.
 cachedRate :: PollerEnv -> Provider -> CryptoCurrency -> IO (Either ProviderError Rate)
@@ -367,6 +369,9 @@ creditLate env@PollerEnv {peStore} p now invId@(InvoiceId invText) = do
       logInfo $
         "names: invoice " <> invText <> " credited " <> tshow lcCents <> " cents to the balance of registration " <> rid
           <> maybe "" (\units -> " for " <> tshow units <> " units at " <> fromMaybe "?" lcRateUsed <> " (invoice " <> fromMaybe "?" lcInvoiceRate <> ", current " <> fromMaybe "?" lcCurrentRate <> ")") lcUnits
+    CONoInvoiceRate -> do
+      due <- dueToWarn env now ("no invoice rate: " <> invText)
+      when due $ logError ("names: invoice " <> invText <> " has confirmed late money, but no invoice rate was recorded to credit it at; check it at the provider")
     CORateFailed (ProviderError e) -> do
       due <- dueToWarn env now ("rate read failed: " <> tshow (pProvider p))
       when due $ logWarn ("names: late credits wait, as the current rate cannot be read; each pass tries again: " <> e)
diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index c3fb1cb1e3..3150176450 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -69,6 +69,7 @@ namesLateCreditTests = describe "StoreService names: balance life" $ do
     it "credits nothing below the rate floor and never after, logging an error, and alerts support naming both rates" testRateFloor
     it "logs the rate floor of an invoice once while the price moves below it" testFloorLoggedOnce
     it "alerts confirmed money waiting on the rate read as such, whatever reason was stored before" testWaitingOutranksStoredReason
+    it "warns once of an invoice no provider reads a rate for, and names an invoice with no recorded rate" testRateProblemsNamed
     it "reads one rate per coin per pass for several invoices, and none when nothing is due" testOneRateReadPerPass
     it "never credits a late Settled payment on an invoice made under HighSpeed, alerting it past the window" testHighSpeed
     it "credits at the next pass a late Settled invoice and a settlement whose credit step did not run" testCreditedByPass
@@ -448,6 +449,17 @@ testWaitingOutranksStoredReason = withLate $ \l@Late {lStore = st} -> do
   alertsAt l (Left $ ProviderError "rates down for outranked") (pastWindow (at 70) 60)
     >>= (`shouldSatisfy` logged "ERROR" "invoice inv-outranked of order outranked: 320000 satoshi received, 320000 satoshi confirmed, 0 satoshi credited; confirmed, the credit waits on the rate read; do not refund; fix the rate read")
 
+testRateProblemsNamed :: IO ()
+testRateProblemsNamed = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "noprovider" False
+  settleAt l "noprovider" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  withTransaction st $ \db -> DB.execute_ db "UPDATE sx_badge_service_invoices SET provider = 'apple' WHERE invoice_id = 'inv-noprovider'"
+  closedOrder l "norate" False
+  settleAt l "norate" (SigClosed (btcPaid lateUnits lateUnits) {rcvRate = Nothing}) (at 70) `shouldReturn` Right ISExpired
+  logs <- (<>) <$> passAt l (at 71) <*> passAt l (at 72)
+  count "invoice inv-noprovider has late money to credit, but no provider" logs `shouldBe` 1
+  logs `shouldSatisfy` logged "ERROR" "invoice inv-norate has confirmed late money, but no invoice rate was recorded to credit it at"
+
 testOneRateReadPerPass :: IO ()
 testOneRateReadPerPass = withLate $ \l@Late {lStore = st} -> do
   mapM_ (\r -> closedOrder l r False >> settleAt l r (SigClosed (btcPaid lateUnits lateUnits)) (at 70)) ["x", "y", "z"]

From 2ae70f7136efadf0052caf665cd9dec1881e055e Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 16:34:07 +0000
Subject: [PATCH 15/17] store: keep coin units with the providers

---
 .../src/StoreService/Names/LateCredits.hs        |  3 +--
 .../src/StoreService/Poller.hs                   |  7 ++-----
 .../src/StoreService/Providers.hs                | 16 +++++++++++++++-
 .../src/StoreService/Providers/BTCPay.hs         |  8 +-------
 4 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs b/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
index 082febeea7..12b8087164 100644
--- a/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/LateCredits.hs
@@ -22,8 +22,7 @@ import Data.Time.Clock (UTCTime)
 import Simplex.Chat.PaymentService.Types (CryptoCurrency, InvoiceId)
 import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
 import StoreService.Names.Store (LateCredit (..), LateCreditState (..), LateSupport (..), NamePhase (..), creditLatePayment, lateCreditState, setLateSupport)
-import StoreService.Providers (ProviderError (..), Rate (..))
-import StoreService.Providers.BTCPay (unitDecimals)
+import StoreService.Providers (ProviderError (..), Rate (..), unitDecimals)
 import StoreService.Store.Invoices (lockInvoice)
 import Text.Read (readMaybe)
 
diff --git a/apps/simplex-store-service/src/StoreService/Poller.hs b/apps/simplex-store-service/src/StoreService/Poller.hs
index 0044168de2..35d8fae683 100644
--- a/apps/simplex-store-service/src/StoreService/Poller.hs
+++ b/apps/simplex-store-service/src/StoreService/Poller.hs
@@ -38,7 +38,7 @@ import StoreService.Names.LateCredits (CreditOutcome (..), creditLateInvoice)
 import StoreService.Names.Phases (Phases, RegistrationId (..))
 import StoreService.Names.Store (CleanupKept (..), LateAlert (..), LateCredit (..), LateCreditState (..), LatePending (..), LateSupport (..), claimLateAlert, deleteUnpaidRegistration, lateAlertDue, latePending, uncreditedLateInvoices, unpaidCleanupCandidates)
 import StoreService.Orders (decide, expireOverdue, settleOrder)
-import StoreService.Providers (ListPass (..), PaymentSignal (..), Provider (..), ProviderError (..), Rate (..), Received (..), expiresItself, settleWindow)
+import StoreService.Providers (ListPass (..), PaymentSignal (..), Provider (..), ProviderError (..), Rate (..), Received (..), expiresItself, settleWindow, unitName)
 import StoreService.Store.Invoices (InvoiceProduct (..), InvoiceRow (..), OverdueInvoice (..), cryptoCurrencyText, getInvoice, getInvoiceByProviderRef, overdueInvoices, providerText, unpaidRefs)
 import StoreService.Waiters (Waiters, waitingCount, waitingCountSTM)
 import Control.Concurrent.STM
@@ -53,7 +53,7 @@ import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime)
 import Numeric.Natural (Natural)
-import Simplex.Chat.PaymentService.Types (CryptoCurrency (..), InvoiceId (..), InvoiceStatus (..), PaymentProvider (..))
+import Simplex.Chat.PaymentService.Types (CryptoCurrency, InvoiceId (..), InvoiceStatus (..), PaymentProvider (..))
 import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
 import Simplex.Messaging.Util (tshow)
 
@@ -433,9 +433,6 @@ lateAlertText LateAlert {laState = LateCreditState {lsInvoice = InvoiceId invTex
       (Just _, Nothing) -> tshow lsReceivedCents <> " cents received at the invoice's rate, not counted in units"
     amounts unit received confirmed credited =
       tshow received <> " " <> unit <> " received, " <> tshow confirmed <> " " <> unit <> " confirmed, " <> tshow credited <> " " <> unit <> " credited"
-    unitName = \case
-      CCBtc -> "satoshi"
-      CCXmr -> "piconero"
 
 -- | Cancel the order at the provider first, so the buyer can no longer pay it.
 closedAtProvider :: PollerEnv -> UTCTime -> OverdueInvoice -> IO Bool
diff --git a/apps/simplex-store-service/src/StoreService/Providers.hs b/apps/simplex-store-service/src/StoreService/Providers.hs
index f4d02372e2..0d533c7d73 100644
--- a/apps/simplex-store-service/src/StoreService/Providers.hs
+++ b/apps/simplex-store-service/src/StoreService/Providers.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module StoreService.Providers
   ( ProviderError (..),
@@ -8,6 +9,8 @@ module StoreService.Providers
     Confirmed (..),
     Uncreditable (..),
     Rate (..),
+    unitDecimals,
+    unitName,
     PaymentSignal (..),
     ProviderInvoice (..),
     Funded (..),
@@ -25,7 +28,7 @@ import Data.Scientific (Scientific)
 import Data.Text (Text)
 import Data.Time.Clock (NominalDiffTime, UTCTime)
 import Network.HTTP.Types.Header (Header)
-import Simplex.Chat.PaymentService.Types (CryptoCurrency, CurrencyAmount, PaymentProvider (..), ServicePaymentDestination, ServicePaymentMethod)
+import Simplex.Chat.PaymentService.Types (CryptoCurrency (..), CurrencyAmount, PaymentProvider (..), ServicePaymentDestination, ServicePaymentMethod)
 
 newtype ProviderError = ProviderError Text deriving (Eq, Show)
 
@@ -60,6 +63,17 @@ data Uncreditable = UCHighSpeed | UCUncounted | UCNoConfirmationShown
 data Rate = Rate {rateText :: Text, rateValue :: Scientific}
   deriving (Eq, Show)
 
+-- | The decimals of each coin's atomic unit.
+unitDecimals :: CryptoCurrency -> Int
+unitDecimals = \case
+  CCBtc -> 8
+  CCXmr -> 12
+
+unitName :: CryptoCurrency -> Text
+unitName = \case
+  CCBtc -> "satoshi"
+  CCXmr -> "piconero"
+
 -- The provider applies its own tolerance, so this cannot be recomputed from the amounts.
 data Funded = PaidInFull | PaidInPart
   deriving (Eq, Show)
diff --git a/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs b/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs
index 23bc5b199a..e0bf1273a3 100644
--- a/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs
+++ b/apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs
@@ -7,7 +7,6 @@ module StoreService.Providers.BTCPay
   ( btcpayProvider,
     btcMethodId,
     xmrMethodId,
-    unitDecimals,
     minorToDecimal,
     paymentMethodsSignal,
     listSignals,
@@ -32,6 +31,7 @@ import StoreService.Providers
     Received (..),
     Uncreditable (..),
     settleWindow,
+    unitDecimals,
     WebhookError (..),
   )
 import Control.Exception (try)
@@ -103,12 +103,6 @@ methodCurrencies = [(btcMethodId, CCBtc), (xmrMethodId, CCXmr)]
 knownMethodIds :: [Text]
 knownMethodIds = map fst methodCurrencies
 
--- | The decimals of each coin's atomic unit: satoshi and piconero.
-unitDecimals :: CryptoCurrency -> Int
-unitDecimals = \case
-  CCBtc -> 8
-  CCXmr -> 12
-
 -- | The policies that settle a payment only after at least one confirmation.
 confirmingPolicies :: [SpeedPolicy]
 confirmingPolicies = [MediumSpeed, LowMediumSpeed, LowSpeed]

From 98e3fb4520a84686286dcf2c8ec71a60b6c76deb Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 16:34:16 +0000
Subject: [PATCH 16/17] store: say how late money is credited or alerted

---
 apps/simplex-store-service/src/StoreService/Orders.hs | 2 +-
 apps/simplex-store-service/src/StoreService/Poller.hs | 2 +-
 tests/Bots/StoreService/NamesLateCreditTests.hs       | 2 +-
 tests/Bots/StoreService/NamesOrdersTests.hs           | 2 +-
 4 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Orders.hs b/apps/simplex-store-service/src/StoreService/Orders.hs
index fbb3928280..9b38468d58 100644
--- a/apps/simplex-store-service/src/StoreService/Orders.hs
+++ b/apps/simplex-store-service/src/StoreService/Orders.hs
@@ -225,7 +225,7 @@ lateSupportOf = \case
 
 latePayment :: InvoiceId -> RegistrationId -> IO ()
 latePayment (InvoiceId invText) (RegistrationId rid) =
-  logInfo ("names: invoice " <> invText <> " received money after registration " <> rid <> " closed; it stays unpaid, and its confirmed money is credited to its balance")
+  logInfo ("names: invoice " <> invText <> " received money after registration " <> rid <> " closed; it stays unpaid, and its money is credited to its balance once confirmed, else alerted")
 
 holdNotSpent :: InvoiceId -> RegistrationId -> RegistrationId -> IO ()
 holdNotSpent (InvoiceId invText) (RegistrationId holder) (RegistrationId source) =
diff --git a/apps/simplex-store-service/src/StoreService/Poller.hs b/apps/simplex-store-service/src/StoreService/Poller.hs
index 35d8fae683..a3ec50e1eb 100644
--- a/apps/simplex-store-service/src/StoreService/Poller.hs
+++ b/apps/simplex-store-service/src/StoreService/Poller.hs
@@ -417,7 +417,7 @@ lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState =
   where
     unconfirmed = "refund by hand only a transaction confirmed on chain that BTCPay no longer monitors; one still Processing there waits"
     highSpeed = "the invoice was made under HighSpeed, so its money is never credited by itself; refund by hand only a transaction confirmed on chain"
-    noConfirmation = "the Monero plugin shows no confirmation of this money (the invoice's settled-confirmation threshold is 0 or not given), so it is never credited by itself; refund by hand only a transaction confirmed on chain"
+    noConfirmation = "the Monero plugin shows no confirmation of this money, so it is never credited by itself; refund by hand only a transaction confirmed on chain"
     rateRead = "confirmed, the credit waits on the rate read; do not refund; fix the rate read"
     cardWaits = "confirmed, the credit waits on the poller's credit pass; do not refund; check the service log"
     rateFloor current = "confirmed; the coin's price fell by more than half since the invoice (" <> fromMaybe "?" lsInvoiceRate <> ", " <> current <> "); it is never credited by itself; refund by hand only a transaction confirmed on chain"
diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index 3150176450..ddf21edf76 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -569,7 +569,7 @@ testXmrLate = withLate $ \l@Late {lStore = st} -> do
   lateWaitOf st "xmrnone" `shouldReturn` Just LWSupport
   now <- getCurrentTime
   alertsAt l (Right stubRate) (pastWindow now 60)
-    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-xmrnone of order xmrnone: 320950000000 piconero received, 0 piconero confirmed, 0 piconero credited; the Monero plugin shows no confirmation")
+    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-xmrnone of order xmrnone: 320950000000 piconero received, 0 piconero confirmed, 0 piconero credited; the Monero plugin shows no confirmation of this money, so it is never credited by itself; refund by hand only a transaction confirmed on chain")
 
 -- balances with late credits
 
diff --git a/tests/Bots/StoreService/NamesOrdersTests.hs b/tests/Bots/StoreService/NamesOrdersTests.hs
index ba7d1ee4cd..3ba6256632 100644
--- a/tests/Bots/StoreService/NamesOrdersTests.hs
+++ b/tests/Bots/StoreService/NamesOrdersTests.hs
@@ -1092,7 +1092,7 @@ testOneLateAlert = withOrders $ \ctx@Ctx {cStore = st, cWeb} -> do
   setSignals (cStub ctx) [(ref, SigClosed paid)]
   logs <- readWith poller
   refunds logs `shouldBe` 1
-  logs `shouldSatisfy` T.isInfixOf "it stays unpaid, and its confirmed money is credited to its balance"
+  logs `shouldSatisfy` T.isInfixOf "it stays unpaid, and its money is credited to its balance once confirmed, else alerted"
   restarted <- newPoller
   refunds <$> readWith restarted `shouldReturn` 0
   (nrPhase &&& nrLive) <$> invoiceRegistration ctx inv `shouldReturn` (PUnpaid, False)

From 8b8797b3b574174af0bfb21ff1f4bbd6bd486ec0 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 16:37:22 +0000
Subject: [PATCH 17/17] store: expect support for floored money in waits

---
 tests/Bots/StoreService/NamesLateCreditTests.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/Bots/StoreService/NamesLateCreditTests.hs b/tests/Bots/StoreService/NamesLateCreditTests.hs
index ddf21edf76..b7a2c937ff 100644
--- a/tests/Bots/StoreService/NamesLateCreditTests.hs
+++ b/tests/Bots/StoreService/NamesLateCreditTests.hs
@@ -87,7 +87,7 @@ namesLateCreditTests = describe "StoreService names: balance life" $ do
   describe "the view" $ do
     it "shows a funded holder past its expiry held with no end time, and an unfunded one before it with its expiry" testHeldUntil
     it "shows a balance spent to 0 and a refunded one as objects with amount 0" testZeroBalances
-    it "waits confirming, crediting, or support for each reason, and on nothing once all is credited" testLateWaits
+    it "waits confirming, crediting, or support for each reason, on nothing once all is credited, and on support for good below the rate floor" testLateWaits
     it "finds the order a balance paid and the order holding a balance, none for an overdue unfunded holder" testFindLinks
 #if defined(dbPostgres)
   describe "two connections" $ do
@@ -677,7 +677,7 @@ testLateWaits = withLate $ \l@Late {lStore = st} -> do
   setRate l (Right stubRate)
   void $ readSignal l "alerted" (SigClosed (btcPaid lateUnits lateUnits))
   void $ passAt l (at 71)
-  waits ["crediting", "floor", "alerted"] `shouldReturn` [("crediting", Nothing), ("floor", Nothing), ("alerted", Nothing)]
+  waits ["crediting", "floor", "alerted"] `shouldReturn` [("crediting", Nothing), ("floor", Just LWSupport), ("alerted", Nothing)]
 
 testFindLinks :: IO ()
 testFindLinks = withLate $ \Late {lStore = st} -> do