From 76ee0e2179b472c0ff9dedf81d0866f8d2a2eae9 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:29:03 +0000
Subject: [PATCH 01/13] store: add balance turns

---
 .../src/StoreService/Names/Turns.hs           | 26 ++++++++++++++-----
 1 file changed, 20 insertions(+), 6 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Turns.hs b/apps/simplex-store-service/src/StoreService/Names/Turns.hs
index b9a5560b6e..84a3a42e6c 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Turns.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Turns.hs
@@ -1,22 +1,25 @@
 {-# LANGUAGE NamedFieldPuns #-}
 
--- | A thread that takes a turn it already holds waits forever. Label turns are taken before a code turn.
-module StoreService.Names.Turns (Turns, newTurns, withLabelTurn, withLabelTurns, withCodeTurn, turnsCount, labelTurnCount) where
+-- | A thread that takes a turn it already holds waits forever. Label turns are taken before a code turn or a balance turn,
+-- and a balance turn is never taken with a code turn.
+module StoreService.Names.Turns (Turns, newTurns, withLabelTurn, withLabelTurns, withCodeTurn, withBalanceTurn, turnsCount, labelTurnCount, balanceTurnCount) where
 
 import Control.Concurrent.STM
 import Control.Exception (bracket, bracket_)
 import Data.ByteString (ByteString)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
+import Data.Text.Encoding (encodeUtf8)
 import Simplex.Messaging.SimplexName (LabelHash (..))
+import StoreService.Names.Phases (RegistrationId (..))
 
 -- | Each lock counts the requests holding or waiting for it, and its entry goes when none are left.
 type TurnLocks = TVar (Map ByteString (TMVar (), Int))
 
-data Turns = Turns {labelTurns :: TurnLocks, codeTurns :: TurnLocks}
+data Turns = Turns {labelTurns :: TurnLocks, codeTurns :: TurnLocks, balanceTurns :: TurnLocks}
 
 newTurns :: IO Turns
-newTurns = Turns <$> newTVarIO Map.empty <*> newTVarIO Map.empty
+newTurns = Turns <$> newTVarIO Map.empty <*> newTVarIO Map.empty <*> newTVarIO Map.empty
 
 withLabelTurn :: Turns -> LabelHash -> IO a -> IO a
 withLabelTurn Turns {labelTurns} (LabelHash h) = withTurn labelTurns h
@@ -28,9 +31,9 @@ withLabelTurns turns a@(LabelHash ha) b@(LabelHash hb) action
   | ha < hb = withLabelTurn turns a $ withLabelTurn turns b action
   | otherwise = withLabelTurn turns b $ withLabelTurn turns a action
 
--- | The label and code hashes with a holder or a waiter.
+-- | The label hashes, code hashes and balances with a holder or a waiter.
 turnsCount :: Turns -> IO Int
-turnsCount Turns {labelTurns, codeTurns} = atomically $ (+) <$> (Map.size <$> readTVar labelTurns) <*> (Map.size <$> readTVar codeTurns)
+turnsCount Turns {labelTurns, codeTurns, balanceTurns} = atomically $ sum <$> mapM (fmap Map.size . readTVar) [labelTurns, codeTurns, balanceTurns]
 
 -- | The requests holding or waiting for the label hash's turn.
 labelTurnCount :: Turns -> LabelHash -> STM Int
@@ -40,6 +43,17 @@ labelTurnCount Turns {labelTurns} (LabelHash h) = maybe 0 snd . Map.lookup h <$>
 withCodeTurn :: Turns -> ByteString -> IO a -> IO a
 withCodeTurn Turns {codeTurns} = withTurn codeTurns
 
+-- | Keyed by the order the balance belongs to.
+withBalanceTurn :: Turns -> RegistrationId -> IO a -> IO a
+withBalanceTurn Turns {balanceTurns} = withTurn balanceTurns . balanceKey
+
+-- | The requests holding or waiting for the balance's turn.
+balanceTurnCount :: Turns -> RegistrationId -> STM Int
+balanceTurnCount Turns {balanceTurns} rid = maybe 0 snd . Map.lookup (balanceKey rid) <$> readTVar balanceTurns
+
+balanceKey :: RegistrationId -> ByteString
+balanceKey (RegistrationId rid) = encodeUtf8 rid
+
 withTurn :: TurnLocks -> ByteString -> IO a -> IO a
 withTurn locks key action =
   bracket (atomically enter) (const $ atomically leave) $ \lock ->

From ac8a2119fc2bfc55d53e044e8169612fbacb787c Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:29:03 +0000
Subject: [PATCH 02/13] store: add the name balances migration

---
 .../StoreService/Store/Postgres/Migrations.hs | 89 ++++++++++++++++++-
 .../StoreService/Store/SQLite/Migrations.hs   | 89 ++++++++++++++++++-
 2 files changed, 176 insertions(+), 2 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 a6d86db2b2..dd84b69896 100644
--- a/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
+++ b/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
@@ -20,7 +20,8 @@ schemaMigrations =
   [ ("20260915_badge_service_schema", m20260915_badge_service_schema, Just down_m20260915_badge_service_schema),
     ("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_drop_taken_codes", m20261022_drop_taken_codes, Just down_m20261022_drop_taken_codes),
+    ("20261022_name_balances", m20261022_name_balances, Just down_m20261022_name_balances)
   ]
 
 -- | The client tables share this database, so the service tables are the same names behind a prefix.
@@ -354,6 +355,92 @@ ALTER TABLE @name_registrations ADD COLUMN issued_code_id BIGINT REFERENCES @nam
 CREATE INDEX @idx_name_registrations_issued_code ON @name_registrations(issued_code_id);
 |]
 
+-- amount = credited - spent - refunded, spent being the balance_used of the orders it paid for that went past unpaid.
+-- Crypto is counted in integer units (satoshi, piconero), so every sum is exact; rates are decimal text, never summed.
+m20261022_name_balances :: Text
+m20261022_name_balances =
+  withPrefix
+    servicePrefix
+    [r|
+CREATE TABLE @name_balances(
+  registration_id TEXT NOT NULL PRIMARY KEY REFERENCES @name_registrations,
+  amount INTEGER NOT NULL CHECK (amount >= 0),
+  credited INTEGER NOT NULL DEFAULT 0,
+  refunded INTEGER NOT NULL DEFAULT 0,
+  reserved_by TEXT REFERENCES @name_registrations,
+  refunded_at TIMESTAMPTZ,
+  created_at TIMESTAMPTZ NOT NULL,
+  updated_at TIMESTAMPTZ NOT NULL
+);
+
+CREATE UNIQUE INDEX @idx_name_balances_reserved_by ON @name_balances(reserved_by);
+
+ALTER TABLE @name_registrations ADD COLUMN balance_source TEXT REFERENCES @name_registrations;
+
+ALTER TABLE @name_registrations ADD COLUMN balance_used INTEGER NOT NULL DEFAULT 0;
+
+CREATE INDEX @idx_name_registrations_balance_source ON @name_registrations(balance_source);
+
+ALTER TABLE @payments ADD COLUMN confirmed_amount INTEGER NOT NULL DEFAULT 0;
+
+ALTER TABLE @payments ADD COLUMN received_units BIGINT;
+
+ALTER TABLE @payments ADD COLUMN confirmed_units BIGINT;
+
+ALTER TABLE @payments ADD COLUMN invoice_rate TEXT;
+
+ALTER TABLE @name_invoices ADD COLUMN late_alerted_at TIMESTAMPTZ;
+
+ALTER TABLE @name_invoices ADD COLUMN late_alerted_units BIGINT;
+
+CREATE TABLE @name_late_credits(
+  name_late_credit_id BIGINT GENERATED ALWAYS AS IDENTITY PRIMARY KEY,
+  invoice_id TEXT NOT NULL REFERENCES @invoices,
+  credit_no INTEGER NOT NULL,
+  registration_id TEXT NOT NULL REFERENCES @name_registrations,
+  units BIGINT,
+  invoice_rate TEXT,
+  current_rate TEXT,
+  rate_used TEXT,
+  cents INTEGER NOT NULL,
+  created_at TIMESTAMPTZ NOT NULL,
+  UNIQUE(invoice_id, credit_no)
+);
+
+CREATE INDEX @idx_name_late_credits_registration ON @name_late_credits(registration_id);
+
+UPDATE @name_registrations SET live = 0 WHERE phase = 'taken';
+
+INSERT INTO @name_balances (registration_id, amount, credited, refunded, created_at, updated_at)
+SELECT registration_id, price, price, 0, updated_at, updated_at FROM @name_registrations
+WHERE phase = 'taken' AND name_prepaid_code_id IS NULL AND price > 0;
+|]
+
+-- Taken orders stay not live.
+down_m20261022_name_balances :: Text
+down_m20261022_name_balances =
+  withPrefix
+    servicePrefix
+    [r|
+DROP INDEX @idx_name_late_credits_registration;
+DROP TABLE @name_late_credits;
+
+ALTER TABLE @name_invoices DROP COLUMN late_alerted_units;
+ALTER TABLE @name_invoices DROP COLUMN late_alerted_at;
+
+ALTER TABLE @payments DROP COLUMN invoice_rate;
+ALTER TABLE @payments DROP COLUMN confirmed_units;
+ALTER TABLE @payments DROP COLUMN received_units;
+ALTER TABLE @payments DROP COLUMN confirmed_amount;
+
+DROP INDEX @idx_name_registrations_balance_source;
+ALTER TABLE @name_registrations DROP COLUMN balance_used;
+ALTER TABLE @name_registrations DROP COLUMN balance_source;
+
+DROP INDEX @idx_name_balances_reserved_by;
+DROP TABLE @name_balances;
+|]
+
 {- 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 67bb44b7a5..863edbb380 100644
--- a/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
+++ b/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
@@ -21,7 +21,8 @@ schemaMigrations =
   [ ("20260915_badge_service_schema", m20260915_badge_service_schema, Just down_m20260915_badge_service_schema),
     ("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_drop_taken_codes", m20261022_drop_taken_codes, Just down_m20261022_drop_taken_codes),
+    ("20261022_name_balances", m20261022_name_balances, Just down_m20261022_name_balances)
   ]
 
 -- | The client tables share this database, so the service tables are the same names behind a prefix.
@@ -356,6 +357,92 @@ ALTER TABLE @name_registrations ADD COLUMN issued_code_id INTEGER REFERENCES @na
 CREATE INDEX @idx_name_registrations_issued_code ON @name_registrations(issued_code_id);
 |]
 
+-- amount = credited - spent - refunded, spent being the balance_used of the orders it paid for that went past unpaid.
+-- Crypto is counted in integer units (satoshi, piconero), so every sum is exact; rates are decimal text, never summed.
+m20261022_name_balances :: Query
+m20261022_name_balances =
+  withPrefix
+    servicePrefix
+    [sql|
+CREATE TABLE @name_balances(
+  registration_id TEXT NOT NULL PRIMARY KEY REFERENCES @name_registrations,
+  amount INTEGER NOT NULL CHECK (amount >= 0),
+  credited INTEGER NOT NULL DEFAULT 0,
+  refunded INTEGER NOT NULL DEFAULT 0,
+  reserved_by TEXT REFERENCES @name_registrations,
+  refunded_at TEXT,
+  created_at TEXT NOT NULL,
+  updated_at TEXT NOT NULL
+) STRICT;
+
+CREATE UNIQUE INDEX @idx_name_balances_reserved_by ON @name_balances(reserved_by);
+
+ALTER TABLE @name_registrations ADD COLUMN balance_source TEXT REFERENCES @name_registrations;
+
+ALTER TABLE @name_registrations ADD COLUMN balance_used INTEGER NOT NULL DEFAULT 0;
+
+CREATE INDEX @idx_name_registrations_balance_source ON @name_registrations(balance_source);
+
+ALTER TABLE @payments ADD COLUMN confirmed_amount INTEGER NOT NULL DEFAULT 0;
+
+ALTER TABLE @payments ADD COLUMN received_units INTEGER;
+
+ALTER TABLE @payments ADD COLUMN confirmed_units INTEGER;
+
+ALTER TABLE @payments ADD COLUMN invoice_rate TEXT;
+
+ALTER TABLE @name_invoices ADD COLUMN late_alerted_at TEXT;
+
+ALTER TABLE @name_invoices ADD COLUMN late_alerted_units INTEGER;
+
+CREATE TABLE @name_late_credits(
+  name_late_credit_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  invoice_id TEXT NOT NULL REFERENCES @invoices,
+  credit_no INTEGER NOT NULL,
+  registration_id TEXT NOT NULL REFERENCES @name_registrations,
+  units INTEGER,
+  invoice_rate TEXT,
+  current_rate TEXT,
+  rate_used TEXT,
+  cents INTEGER NOT NULL,
+  created_at TEXT NOT NULL,
+  UNIQUE(invoice_id, credit_no)
+) STRICT;
+
+CREATE INDEX @idx_name_late_credits_registration ON @name_late_credits(registration_id);
+
+UPDATE @name_registrations SET live = 0 WHERE phase = 'taken';
+
+INSERT INTO @name_balances (registration_id, amount, credited, refunded, created_at, updated_at)
+SELECT registration_id, price, price, 0, updated_at, updated_at FROM @name_registrations
+WHERE phase = 'taken' AND name_prepaid_code_id IS NULL AND price > 0;
+|]
+
+-- Taken orders stay not live.
+down_m20261022_name_balances :: Query
+down_m20261022_name_balances =
+  withPrefix
+    servicePrefix
+    [sql|
+DROP INDEX @idx_name_late_credits_registration;
+DROP TABLE @name_late_credits;
+
+ALTER TABLE @name_invoices DROP COLUMN late_alerted_units;
+ALTER TABLE @name_invoices DROP COLUMN late_alerted_at;
+
+ALTER TABLE @payments DROP COLUMN invoice_rate;
+ALTER TABLE @payments DROP COLUMN confirmed_units;
+ALTER TABLE @payments DROP COLUMN received_units;
+ALTER TABLE @payments DROP COLUMN confirmed_amount;
+
+DROP INDEX @idx_name_registrations_balance_source;
+ALTER TABLE @name_registrations DROP COLUMN balance_used;
+ALTER TABLE @name_registrations DROP COLUMN balance_source;
+
+DROP INDEX @idx_name_balances_reserved_by;
+DROP TABLE @name_balances;
+|]
+
 {- TODO [badges] deferred with the draft in M20260915_user_badges, service only.
 
 ALTER TABLE @payments ADD COLUMN receipt_hash BLOB;

From 340fc270775884c4dd51848cf5ee2aec7b501d42 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:29:15 +0000
Subject: [PATCH 03/13] store: store name balances and late credits

---
 .../src/StoreService/Names/Orders.hs          |  30 +-
 .../src/StoreService/Names/Store.hs           | 567 +++++++++++++--
 .../src/StoreService/Names/View.hs            |  25 +-
 .../src/StoreService/Names/Worker.hs          |   2 +
 .../src/StoreService/Orders.hs                |   6 +-
 .../src/StoreService/Poller.hs                |   9 +-
 .../src/StoreService/Web/Names/Orders.hs      |  15 +-
 .../src/StoreService/Web/Names/Owner.hs       |   6 +-
 .../StoreService/Web/Names/Registration.hs    |   4 +-
 simplex-chat.cabal                            |   1 +
 tests/Bots/StoreService/NamesBalancesTests.hs | 665 ++++++++++++++++++
 tests/Bots/StoreService/NamesOrdersTests.hs   |  49 +-
 tests/Bots/StoreService/NamesStoreTests.hs    |  82 ++-
 tests/Bots/StoreService/WebTests.hs           |  44 +-
 tests/Test.hs                                 |   2 +
 15 files changed, 1381 insertions(+), 126 deletions(-)
 create mode 100644 tests/Bots/StoreService/NamesBalancesTests.hs

diff --git a/apps/simplex-store-service/src/StoreService/Names/Orders.hs b/apps/simplex-store-service/src/StoreService/Names/Orders.hs
index 7aa95c69aa..eb557138f3 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Orders.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Orders.hs
@@ -48,7 +48,7 @@ import qualified Data.Aeson.KeyMap as KM
 import Data.Bifunctor (first)
 import Data.ByteString (ByteString)
 import Data.Int (Int64)
-import Data.Maybe (isJust)
+import Data.Maybe (catMaybes, isJust)
 import Data.Scientific (toBoundedInteger)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -70,7 +70,7 @@ 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 (LiveOrder (..), NamePhase (..), NameRegistration (..), NewRegistration (..), PrepaidCode (..), RegistrationPayment (..), RegistrationRefused (..), NameTransaction (..), TxFor (..), TxStatus (..), VersionWrite (..), closeOverdue, createCodeRegistration, getLiveOrders, getPrepaidCode, getPrepaidCodeById, getRegistrationByOrderHash, isLabelRegistering, registrationTransactions, retargetRegistration, updateRegistration)
+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)
 
 data OrdersEnv = OrdersEnv
@@ -103,6 +103,7 @@ data OrderRefusal
   | ORCatalogChanged Int
   | ORCode CodeRefusal
   | ORPriceTooHigh Int
+  | ORBalanceChanged (Maybe Balance)
   deriving (Eq, Show)
 
 newtype OrderRefused = OrderRefused OrderRefusal
@@ -193,10 +194,11 @@ overdueOrdersMet db OrderRequest {orOwner, orFields = OrderFields {ofLabelHash,
     closable LiveOrder {loRegistration = NameRegistration {nrOwner, nrLabelHash}, loOverdue} =
       loOverdue && nrOwner == orOwner && nrLabelHash == ofLabelHash
 
--- | In one transaction, the overdue orders the request meets are closed, then the order is inserted.
+-- | In one transaction, the overdue orders the request meets and the balance holders the caller names are closed, then the order is inserted.
+-- A named holder no longer live is skipped, and one still live that cannot be closed refuses with the balance it holds.
 -- Refused, changing nothing, when it meets an order it cannot close, or the insert refuses.
-placeOrder :: OrdersEnv -> OrderRequest -> (DB.Connection -> UTCTime -> IO (Either OrderRefusal ())) -> IO (Either OrderRefusal [ClosedOrder])
-placeOrder OrdersEnv {oeStore, oeNow} req insert = do
+placeOrder :: OrdersEnv -> OrderRequest -> [NameRegistration] -> (DB.Connection -> UTCTime -> IO (Either OrderRefusal ())) -> IO (Either OrderRefusal [ClosedOrder])
+placeOrder OrdersEnv {oeStore, oeNow} req holders insert = do
   now <- oeNow
   first (\(OrderRefused refusal) -> refusal) <$> E.try (withTransaction oeStore $ \db -> transaction db now)
   where
@@ -204,12 +206,21 @@ placeOrder OrdersEnv {oeStore, oeNow} req insert = do
       overdueOrdersMet db req now >>= \case
         Just overdue -> do
           closed <- mapM (close db now) overdue
-          insert db now >>= either (E.throwIO . OrderRefused) (const $ pure closed)
+          closedHolders <- catMaybes <$> mapM (closeHolder db now) holders
+          insert db now >>= either (E.throwIO . OrderRefused) (const $ pure $ closed <> closedHolders)
         Nothing -> E.throwIO $ OrderRefused OROrderExists
     close db now r =
       closeOverdue db r now >>= \case
         Just v -> pure ClosedOrder {coRegistration = r, coVersion = v}
         Nothing -> E.throwIO $ OrderRefused OROrderExists
+    -- read again here, since another order of its own name may have closed it meanwhile
+    closeHolder db now NameRegistration {nrId} =
+      getRegistration db nrId >>= \case
+        Just holder@NameRegistration {nrLive = True, nrBalanceSource} ->
+          closeOverdue db holder now >>= \case
+            Just v -> pure $ Just ClosedOrder {coRegistration = holder, coVersion = v}
+            Nothing -> E.throwIO . OrderRefused . ORBalanceChanged =<< maybe (pure Nothing) (\source -> getBalance db source now) nrBalanceSource
+        _ -> pure Nothing
 
 -- | In the code's turn, the code as it reads there must pay for the name; the order's insert then reserves it.
 placeCodeOrder :: OrdersEnv -> OrderRequest -> RegistrationId -> PrepaidCode -> IO (Either OrderRefusal [ClosedOrder])
@@ -220,15 +231,15 @@ placeCodeOrder env@OrdersEnv {oeStore, oeTurns, oeNow} req@OrderRequest {orOwner
       Nothing -> pure $ Left $ ORCode CRInvalid
       Just code
         | Just refusal <- codeRefusal now rid ofLength code -> pure $ Left $ ORCode refusal
-        | otherwise -> placeOrder env req $ codeOrderInsert NewRegistration {nrgId = rid, nrgOwner = orOwner, nrgOrder = fields, nrgYears = pcYears} code
+        | otherwise -> placeOrder env req [] $ codeOrderInsert NewRegistration {nrgId = rid, nrgOwner = orOwner, nrgOrder = fields, nrgYears = pcYears} code
 
 -- | The code was checked in its turn, so only a writer outside this process can make its reservation fail.
 codeOrderInsert :: NewRegistration -> PrepaidCode -> DB.Connection -> UTCTime -> IO (Either OrderRefusal ())
 codeOrderInsert new@NewRegistration {nrgId, nrgOrder = OrderFields {ofLength}} code@PrepaidCode {pcCodeHash} db now =
   createCodeRegistration db new code now >>= \case
     Right () -> pure $ Right ()
-    Left RRLiveOrder -> pure $ Left OROrderExists
     Left RRCodeNotReservable -> Left . ORCode <$> reserveRefusal db now pcCodeHash nrgId ofLength
+    Left _ -> pure $ Left OROrderExists
 
 checkTimestamp :: UTCTime -> Word64 -> Either OrderRefusal ()
 checkTimestamp now timestamp =
@@ -267,6 +278,7 @@ unixSeconds = floor . utcTimeToPOSIXSeconds
 movable :: NameRegistration -> Bool
 movable NameRegistration {nrPhase, nrPayment, nrLinksRefusedAt} = case nrPhase of
   PTaken | RPInvoice {} <- nrPayment -> True
+  PTaken | RPBalance <- nrPayment -> True
   PFailed -> True
   PCommitted -> isJust nrLinksRefusedAt
   _ -> False
@@ -297,6 +309,7 @@ retargetOrder OrdersEnv {oeStore, oeTurns, oeNow} r@NameRegistration {nrId, nrPa
   let write db = versionWritten <$> retargetRegistration db r fields price now
   case nrPayment of
     RPInvoice {} -> withTransaction oeStore write
+    RPBalance -> withTransaction oeStore write
     RPCode codeId ->
       withTransaction oeStore (`getPrepaidCodeById` codeId) >>= \case
         Nothing -> pure $ Left $ WRRefused $ ORCode CRInvalid
@@ -343,6 +356,7 @@ confirmLanded OrdersEnv {oeStore, oeContracts, oeTurns, oeNow} r@NameRegistratio
           write db = versionWritten <$> updateRegistration db registered now
       case nrPayment of
         RPInvoice {} -> withTransaction oeStore write
+        RPBalance -> withTransaction oeStore write
         RPCode codeId -> spendLandedCode oeTurns oeStore now codeId nrId write >>= traverse (paidWith codeId)
     paidWith codeId (v, spent) = do
       unless spent $ do
diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index e018154478..3774275f33 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -16,6 +16,15 @@ module StoreService.Names.Store
     VersionWrite (..),
     LiveOrder (..),
     OrderTerms (..),
+    HeldBalance (..),
+    Balance (..),
+    BalanceHold (..),
+    BalanceLink (..),
+    LateCredit (..),
+    LateCreditState (..),
+    LatePending (..),
+    LateAlert (..),
+    CleanupKept (..),
     PrepaidCode (..),
     NewPrepaidCode (..),
     CodeHashTaken (..),
@@ -35,6 +44,7 @@ module StoreService.Names.Store
     textMethod,
     createPaidRegistration,
     createCodeRegistration,
+    createBalanceRegistration,
     getRegistration,
     getRegistrationByOrderHash,
     getLiveOrders,
@@ -47,6 +57,21 @@ module StoreService.Names.Store
     unpaidCleanupCandidates,
     deleteUnpaidRegistration,
     failedCodeOrdersBefore,
+    heldBy,
+    getBalance,
+    overdueHolder,
+    balanceByReference,
+    balanceChain,
+    creditBalance,
+    spendHeldBalance,
+    releaseHeldBalance,
+    refundBalance,
+    lateCreditState,
+    creditLatePayment,
+    latePending,
+    uncreditedLateInvoices,
+    lateAlertDue,
+    claimLateAlert,
     insertPrepaidCode,
     getPrepaidCode,
     getPrepaidCodeById,
@@ -78,9 +103,10 @@ import Data.ByteArray.Encoding (Base (Base16), convertToBase)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import Data.Int (Int64)
-import Data.Functor ((<&>))
 import Data.Maybe (isJust, listToMaybe)
+import Data.String (fromString)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Word (Word64)
@@ -138,9 +164,11 @@ instance FromField NamePhase where fromField = fromTextField_ textDecode
 
 instance ToField NamePhase where toField = toField . textEncode
 
+-- | RPBalance: an order paid wholly from another order's balance, with neither invoice nor code.
 data RegistrationPayment
   = RPInvoice ServicePaymentMethod InvoiceId
   | RPCode Int64
+  | RPBalance
   deriving (Eq, Show)
 
 -- | The name, links and owner's intent, all set by an accepted reveal and cleared together.
@@ -168,6 +196,8 @@ data NameRegistration = NameRegistration
     nrYears :: Int,
     nrPrice :: Int,
     nrPayment :: RegistrationPayment,
+    nrBalanceSource :: Maybe RegistrationId,
+    nrBalanceUsed :: Int,
     nrReveal :: Maybe NameReveal,
     nrCommitTx :: Maybe TxHash,
     nrCommitBlock :: Maybe Word64,
@@ -203,7 +233,8 @@ data PaidOrder = PaidOrder
     poProviderRef :: Text
   }
 
-data RegistrationRefused = RRLiveOrder | RRCodeNotReservable
+-- | RRBalanceChanged: the source's balance no longer has the amount seen, or another order holds it.
+data RegistrationRefused = RRLiveOrder | RRCodeNotReservable | RRBalanceChanged
   deriving (Eq, Show)
 
 -- | NotLive: the write would make a closed order live. LiveOrderExists: another live order holds its commitment, or its owner and label hash.
@@ -217,8 +248,102 @@ data LiveOrder = LiveOrder
   }
   deriving (Eq, Show)
 
--- | What an order pays with, as its hash covers it.
-data OrderTerms = OTInvoice ServicePaymentMethod Int | OTCode ByteString
+-- | What an order pays with, as its hash covers it. OTBalance: the paying order, the price, the balance seen, and the method of a difference.
+data OrderTerms = OTInvoice ServicePaymentMethod Int | OTCode ByteString | OTBalance RegistrationId Int Int (Maybe ServicePaymentMethod)
+
+-- | The balance a difference order holds while its invoice is open: the paying order, and all of its amount.
+data HeldBalance = HeldBalance {hbSource :: RegistrationId, hbAmount :: Int}
+
+-- | Cents left to spend, and over the balance's life the cents credited and refunded.
+data Balance = Balance
+  { blRegistration :: RegistrationId,
+    blAmount :: Int,
+    blCredited :: Int,
+    blRefunded :: Int,
+    blHold :: Maybe BalanceHold,
+    blRefundedAt :: Maybe UTCTime
+  }
+  deriving (Eq, Show)
+
+-- | The order whose open invoice holds a balance, until that invoice expires; overdue past it with no money received.
+data BalanceHold = BalanceHold
+  { bhHolder :: RegistrationId,
+    bhUntil :: UTCTime,
+    bhOverdue :: Bool
+  }
+  deriving (Eq, Show)
+
+-- | An order the money of a balance came through. lkPaid and lkFromBalance count only an order that went past unpaid,
+-- since closing an unpaid one released its source's balance.
+data BalanceLink = BalanceLink
+  { lkRegistration :: RegistrationId,
+    lkPayment :: RegistrationPayment,
+    lkPaid :: Int,
+    lkFromBalance :: Int,
+    lkLateCredits :: [LateCredit]
+  }
+  deriving (Eq, Show)
+
+-- | Money paid on a name invoice after its order closed, credited to that order's balance. Rates are decimal text; card money has no units or rates.
+data LateCredit = LateCredit
+  { lcInvoice :: InvoiceId,
+    lcCreditNo :: Int,
+    lcRegistration :: RegistrationId,
+    lcUnits :: Maybe Int64,
+    lcInvoiceRate :: Maybe Text,
+    lcCurrentRate :: Maybe Text,
+    lcRateUsed :: Maybe Text,
+    lcCents :: Int
+  }
+  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.
+data LateCreditState = LateCreditState
+  { lsInvoice :: InvoiceId,
+    lsRegistration :: RegistrationId,
+    lsPhase :: NamePhase,
+    lsLive :: Bool,
+    lsCard :: Bool,
+    lsReceivedCents :: Int,
+    lsConfirmedCents :: Int,
+    lsReceivedUnits :: Maybe Int64,
+    lsConfirmedUnits :: Maybe Int64,
+    lsInvoiceRate :: Maybe Text,
+    lsCreditedUnits :: Int64,
+    lsCreditedCents :: Int,
+    lsCredits :: Int,
+    lsPaymentCreatedAt :: UTCTime
+  }
+  deriving (Eq, Show)
+
+-- | Why a closed order's money is not all credited: Monero confirming with a zero figure, confirmed money not credited yet,
+-- money received and not confirmed, or crypto received that could not be counted in units.
+data LatePending = LPConfirming | LPUncredited | LPUnconfirmed | LPUncounted
+  deriving (Eq, Show, Enum, Bounded)
+
+instance TextEncoding LatePending where
+  textEncode = \case
+    LPConfirming -> "confirming"
+    LPUncredited -> "uncredited"
+    LPUnconfirmed -> "unconfirmed"
+    LPUncounted -> "uncounted"
+  textDecode t = lookup t [(textEncode p, p) | p <- [minBound .. maxBound]]
+
+instance FromField LatePending where fromField = fromTextField_ textDecode
+
+-- | 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,
+    laPending :: LatePending,
+    laReceived :: Maybe Int64,
+    laAlertedAt :: Maybe UTCTime,
+    laAlertedReceived :: Maybe Int64
+  }
+  deriving (Eq, Show)
+
+-- | Why the cleanup keeps an unpaid order: a payment was recorded for it, or it holds the balance of the given order.
+data CleanupKept = CKPaid | CKHolder RegistrationId
+  deriving (Eq, Show)
 
 data PrepaidCode = PrepaidCode
   { pcId :: Int64,
@@ -331,6 +456,7 @@ orderHash owner OrderFields {ofLabelHash = LabelHash lh, ofLength, ofDuration, o
     (tag, payment) = case terms of
       OTInvoice method price -> ("name-invoice", [encodeUtf8 $ methodText method, num price])
       OTCode codeHash -> ("name-code", [codeHash])
+      OTBalance (RegistrationId source) price seen method -> ("name-balance", [encodeUtf8 source, num price, num seen, maybe "" (encodeUtf8 . methodText) method])
     field bs = i2ospOf_ orderHashFieldBytes (toInteger $ B.length bs) <> bs
     num :: Show a => a -> ByteString
     num = encodeUtf8 . tshow
@@ -347,47 +473,66 @@ methodText = \case
 textMethod :: Text -> Maybe ServicePaymentMethod
 textMethod t = lookup t [(methodText m, m) | m <- [SPMCard CPStripe, SPMCrypto CCBtc, SPMCrypto CCXmr]]
 
-createPaidRegistration :: DB.Connection -> NewRegistration -> PaidOrder -> UTCTime -> IO (Either RegistrationRefused ())
-createPaidRegistration db new@NewRegistration {nrgId = RegistrationId rid, nrgOwner, nrgOrder} PaidOrder {poMethod, poPrice, poInvoiceId = InvoiceId invId, poProviderRef} now' = do
+-- | A difference order's hold is written after the registration, so the registration's row is locked before the balance's.
+createPaidRegistration :: DB.Connection -> NewRegistration -> OrderTerms -> PaidOrder -> Maybe HeldBalance -> UTCTime -> IO (Either RegistrationRefused ())
+createPaidRegistration db new@NewRegistration {nrgId = regId@(RegistrationId rid), nrgOwner, nrgOrder} terms PaidOrder {poMethod, poPrice, poInvoiceId = InvoiceId invId, poProviderRef} held now' = do
   let now = truncateToSecond now'
-      hash = orderHash nrgOwner nrgOrder (OTInvoice poMethod poPrice)
-  inserted <- insertRegistration db new PUnpaid poPrice (Just poMethod) Nothing hash now
-  when inserted $
-    DB.execute
-      db
-      "INSERT INTO sx_badge_service_name_invoices (invoice_id, registration_id, provider_ref, created_at) VALUES (?,?,?,?)"
-      (invId, rid, poProviderRef, now)
-  pure $ if inserted then Right () else Left RRLiveOrder
+      fromBalance = (\HeldBalance {hbSource, hbAmount} -> (hbSource, hbAmount)) <$> held
+  inserted <- insertRegistration db new PUnpaid poPrice (Just poMethod) Nothing fromBalance (orderHash nrgOwner nrgOrder terms) now
+  if not inserted
+    then pure $ Left RRLiveOrder
+    else do
+      DB.execute
+        db
+        "INSERT INTO sx_badge_service_name_invoices (invoice_id, registration_id, provider_ref, created_at) VALUES (?,?,?,?)"
+        (invId, rid, poProviderRef, now)
+      held' <- maybe (pure True) (\HeldBalance {hbSource, hbAmount} -> holdBalance db hbSource hbAmount regId now) held
+      if held' then pure $ Right () else Left RRBalanceChanged <$ deleteRegistration db regId
 
 -- | Reserving the code is the conditional update of the transaction that creates the registration.
 createCodeRegistration :: DB.Connection -> NewRegistration -> PrepaidCode -> UTCTime -> IO (Either RegistrationRefused ())
-createCodeRegistration db new@NewRegistration {nrgId = regId@(RegistrationId rid), nrgOwner, nrgOrder} PrepaidCode {pcId, pcCodeHash} now' = do
+createCodeRegistration db new@NewRegistration {nrgId = regId, nrgOwner, nrgOrder} PrepaidCode {pcId, pcCodeHash} now' = do
   let now = truncateToSecond now'
-  inserted <- insertRegistration db new PQueued 0 Nothing (Just pcId) (orderHash nrgOwner nrgOrder (OTCode pcCodeHash)) now
+  inserted <- insertRegistration db new PQueued 0 Nothing (Just pcId) Nothing (orderHash nrgOwner nrgOrder (OTCode pcCodeHash)) now
   if not inserted
     then pure $ Left RRLiveOrder
     else
       reservePrepaidCode db pcId regId now >>= \case
         True -> pure $ Right ()
-        False -> do
-          DB.execute db "DELETE FROM sx_badge_service_name_registrations WHERE registration_id = ?" (Only rid)
-          pure $ Left RRCodeNotReservable
+        False -> Left RRCodeNotReservable <$ deleteRegistration db regId
+
+-- | A queued order whose price is spent from the source's balance in the same transaction, where its amount is the one seen and nothing holds it.
+createBalanceRegistration :: DB.Connection -> NewRegistration -> RegistrationId -> Int -> Int -> UTCTime -> IO (Either RegistrationRefused ())
+createBalanceRegistration db new@NewRegistration {nrgId, nrgOwner, nrgOrder} source price seen now' = do
+  let now = truncateToSecond now'
+  inserted <- insertRegistration db new PQueued price Nothing Nothing (Just (source, price)) (orderHash nrgOwner nrgOrder (OTBalance source price seen Nothing)) now
+  if not inserted
+    then pure $ Left RRLiveOrder
+    else
+      spendBalance db source price seen now >>= \case
+        True -> pure $ Right ()
+        False -> Left RRBalanceChanged <$ deleteRegistration db nrgId
+
+-- | The name invoice row goes with it.
+deleteRegistration :: DB.Connection -> RegistrationId -> IO ()
+deleteRegistration db (RegistrationId rid) = DB.execute db "DELETE FROM sx_badge_service_name_registrations WHERE registration_id = ?" (Only rid)
 
 -- | False when the registration would be a second live one for its commitment, or for its owner and label hash.
-insertRegistration :: DB.Connection -> NewRegistration -> NamePhase -> Int -> Maybe ServicePaymentMethod -> Maybe Int64 -> ByteString -> UTCTime -> IO Bool
-insertRegistration db NewRegistration {nrgId = RegistrationId rid, nrgOwner, nrgOrder, nrgYears} phase price method codeId hash now =
+-- fromBalance: the order whose balance pays, and the cents it pays.
+insertRegistration :: DB.Connection -> NewRegistration -> NamePhase -> Int -> Maybe ServicePaymentMethod -> Maybe Int64 -> Maybe (RegistrationId, Int) -> ByteString -> UTCTime -> IO Bool
+insertRegistration db NewRegistration {nrgId = RegistrationId rid, nrgOwner, nrgOrder, nrgYears} phase price method codeId fromBalance hash now =
   (> 0)
     <$> executeChanging
       db
       [sql|
         INSERT INTO sx_badge_service_name_registrations
           (registration_id, version, label_hash, length, duration, owner, commitment, sealed, phase, years,
-           price, method, name_prepaid_code_id, live, order_hash, moves, created_at, updated_at)
-        VALUES (?,?,?,?,?,?,?,?,?,?, ?,?,?,?,?,?,?,?)
+           price, method, name_prepaid_code_id, live, order_hash, moves, created_at, updated_at, balance_source, balance_used)
+        VALUES (?,?,?,?,?,?,?,?,?,?, ?,?,?,?,?,?,?,?,?,?)
         ON CONFLICT DO NOTHING
       |]
       ( (rid, initialVersion, Binary lh, ofLength, int64 ofDuration, Binary $ unAddress nrgOwner, Binary ofCommitment, ofSealed, phase, nrgYears)
-          :. (price, methodText <$> method, codeId, BI True, Binary hash, 0 :: Int, now, now)
+          :. (price, methodText <$> method, codeId, BI True, Binary hash, 0 :: Int, now, now, (\(RegistrationId s, _) -> s) <$> fromBalance, maybe 0 snd fromBalance)
       )
   where
     OrderFields {ofLabelHash = LabelHash lh, ofLength, ofDuration, ofCommitment, ofSealed} = nrgOrder
@@ -398,7 +543,7 @@ registrationColumns =
     SELECT r.registration_id, r.version, r.label_hash, r.length, r.duration, r.owner, r.commitment, r.sealed, r.phase, r.years,
       r.price, r.method, ni.invoice_id, r.name_prepaid_code_id, r.label, r.secret, r.contact_link, r.channel_link, r.intent_nonce, r.intent_deadline,
       r.intent_signature, r.commit_tx, r.commit_block, r.register_tx, r.register_block, r.reveal_after, r.reveal_before, r.expires_at, r.registered_at,
-      r.failed_at, r.error, r.live, r.order_hash, r.moves, r.links_refused_at, r.created_at, r.updated_at
+      r.failed_at, r.error, r.live, r.order_hash, r.moves, r.links_refused_at, r.created_at, r.updated_at, r.balance_source, r.balance_used
   |]
 
 registrationFrom :: Query
@@ -416,19 +561,20 @@ type RegistrationRow =
   (Text, Int64, Binary ByteString, Int, Int64, Binary ByteString, Binary ByteString, Text, NamePhase, Int)
     :. (Int, Maybe Text, Maybe Text, Maybe Int64, Maybe Text, Maybe (Binary ByteString), Maybe Text, Maybe Text, Maybe Int64, Maybe Int64)
     :. (Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe Int64, Maybe (Binary ByteString), Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
-    :. (Maybe UTCTime, Maybe Text, BoolInt, Binary ByteString, Int, Maybe UTCTime, UTCTime, UTCTime)
+    :. (Maybe UTCTime, Maybe Text, BoolInt, Binary ByteString, Int, Maybe UTCTime, UTCTime, UTCTime, Maybe Text, Int)
 
 toRegistration :: RegistrationRow -> Either Text NameRegistration
 toRegistration
   ( (rid, nrVersion, Binary lh, nrLength, duration, Binary owner, Binary nrCommitment, nrSealed, nrPhase, nrYears)
       :. (nrPrice, method_, invoiceId_, codeId_, label_, secret_, nrContactLink, nrChannelLink, nonce_, deadline_)
       :. (signature_, commitTx, commitBlock, registerTx, registerBlock, revealAfter, revealBefore, expiresAt, nrRegisteredAt)
-      :. (nrFailedAt, nrError, BI nrLive, Binary nrOrderHash, nrMoves, nrLinksRefusedAt, nrCreatedAt, nrUpdatedAt)
+      :. (nrFailedAt, nrError, BI nrLive, Binary nrOrderHash, nrMoves, nrLinksRefusedAt, nrCreatedAt, nrUpdatedAt, source_, nrBalanceUsed)
     ) = do
     nrOwner <- decodeAddress owner
     nrPayment <- case (method_, invoiceId_, codeId_) of
       (Just m, Just invId, Nothing) -> (`RPInvoice` InvoiceId invId) <$> note ("name_registrations.method: " <> m) (textMethod m)
       (Nothing, Nothing, Just codeId) -> Right $ RPCode codeId
+      (Nothing, Nothing, Nothing) | isJust source_ -> Right RPBalance
       _ -> Left $ "name_registrations payment: " <> rid
     nrReveal <- case (label_, secret_, nonce_, deadline_, signature_) of
       (Nothing, Nothing, Nothing, Nothing, Nothing) -> Right Nothing
@@ -450,6 +596,8 @@ toRegistration
           nrYears,
           nrPrice,
           nrPayment,
+          nrBalanceSource = RegistrationId <$> source_,
+          nrBalanceUsed,
           nrReveal,
           nrCommitTx = txHash <$> commitTx,
           nrCommitBlock = word64 <$> commitBlock,
@@ -503,13 +651,14 @@ unfunded = unfundedQuery "i.invoice_id"
 
 -- | Run in the transaction that inserts the next order, so the unique constraints let it in; the registration's new version.
 -- Nothing when the order changed since it was read, or its invoice is no longer open or holds money: the caller rolls back,
--- since the invoice is written before the registration, as settlement, cancel and the sweep write them.
+-- since the invoice is written before the registration, as settlement, cancel and the sweep write them. A balance it held is released.
 closeOverdue :: DB.Connection -> NameRegistration -> UTCTime -> IO (Maybe Int64)
-closeOverdue db r@NameRegistration {nrId = RegistrationId rid, nrVersion, nrPayment} now = do
+closeOverdue db r@NameRegistration {nrId = regId@(RegistrationId rid), nrVersion, nrPayment} now = do
   -- locked first, so the funding check below, a later statement, sees a payment a concurrent settlement committed
   mapM_ (\invId -> lockInvoice db invId now) $ case nrPayment of
     RPInvoice _ invId -> Just invId
     RPCode _ -> Nothing
+    RPBalance -> Nothing
   expired <-
     executeChanging
       db
@@ -527,9 +676,9 @@ closeOverdue db r@NameRegistration {nrId = RegistrationId rid, nrVersion, nrPaym
       (invoiceStatusText ISExpired, truncateToSecond now, invoiceStatusText ISOpen, rid, nrVersion)
   if expired > 0
     then
-      updateRegistration db r {nrLive = False} now <&> \case
-        Written v -> Just v
-        _ -> Nothing
+      updateRegistration db r {nrLive = False} now >>= \case
+        Written v -> Just v <$ releaseHeldBalance db regId now
+        _ -> pure Nothing
     else pure Nothing
 
 -- | Whether an order can still progress to a registration for its name. The unique live indexes allow one such order per commitment,
@@ -545,6 +694,7 @@ orderLive NameRegistration {nrPhase, nrPayment, nrLive} = case nrPhase of
   PFailed -> True
   PTaken -> case nrPayment of
     RPInvoice {} -> True
+    RPBalance -> True
     RPCode _ -> False
   PRegistered -> False
 
@@ -611,11 +761,15 @@ retargetRegistration db r OrderFields {ofLabelHash, ofLength, ofDuration, ofComm
         nrError = Nothing
       }
 
--- | Newest first, at most findLimit.
+-- | 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 =
-  DB.query db (selectRegistrations <> " WHERE r.owner = ? ORDER BY r.created_at DESC, r.registration_id DESC LIMIT ?") (Binary $ unAddress owner, findLimit)
-    >>= decodeAll toRegistration
+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
+  where
+    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)"
 
 isLabelRegistering :: DB.Connection -> LabelHash -> IO Bool
 isLabelRegistering db (LabelHash lh) =
@@ -647,26 +801,29 @@ unpaidCleanupCandidates db expiredBefore =
       |]
       (PUnpaid, truncateToSecond expiredBefore)
 
--- | Deletes an unpaid registration and its invoice, unless a payment was recorded for it.
-deleteUnpaidRegistration :: DB.Connection -> RegistrationId -> IO Bool
-deleteUnpaidRegistration db (RegistrationId rid) = do
-  invoiceIds <- DB.query db "SELECT invoice_id FROM sx_badge_service_name_invoices WHERE registration_id = ?" (Only rid)
-  deleted <-
-    executeChanging
-      db
-      [sql|
-        DELETE FROM sx_badge_service_name_registrations
-        WHERE registration_id = ? AND phase = ?
-          AND NOT EXISTS (
-            SELECT 1 FROM sx_badge_service_name_invoices ni
-            JOIN sx_badge_service_payments p ON p.invoice_id = ni.invoice_id
-            WHERE ni.registration_id = ?
-          )
-      |]
-      (rid, PUnpaid, rid)
-  when (deleted > 0) $
-    mapM_ (DB.execute db "DELETE FROM sx_badge_service_invoices WHERE invoice_id = ?" . Only . fromOnly) (invoiceIds :: [Only Text])
-  pure $ deleted > 0
+-- | Deletes an unpaid registration and its invoice, unless a payment was recorded for it or it holds a balance.
+deleteUnpaidRegistration :: DB.Connection -> RegistrationId -> IO (Either CleanupKept ())
+deleteUnpaidRegistration db (RegistrationId rid) =
+  DB.query db "SELECT registration_id FROM sx_badge_service_name_balances WHERE reserved_by = ?" (Only rid) >>= \case
+    Only source : _ -> pure $ Left $ CKHolder $ RegistrationId source
+    [] -> do
+      invoiceIds <- DB.query db "SELECT invoice_id FROM sx_badge_service_name_invoices WHERE registration_id = ?" (Only rid)
+      deleted <-
+        executeChanging
+          db
+          [sql|
+            DELETE FROM sx_badge_service_name_registrations
+            WHERE registration_id = ? AND phase = ?
+              AND NOT EXISTS (
+                SELECT 1 FROM sx_badge_service_name_invoices ni
+                JOIN sx_badge_service_payments p ON p.invoice_id = ni.invoice_id
+                WHERE ni.registration_id = ?
+              )
+          |]
+          (rid, PUnpaid, rid)
+      if deleted > 0
+        then Right () <$ mapM_ (DB.execute db "DELETE FROM sx_badge_service_invoices WHERE invoice_id = ?" . Only . fromOnly) (invoiceIds :: [Only Text])
+        else pure $ Left CKPaid
 
 -- | Code orders failed before the cutoff that still hold their unspent code.
 failedCodeOrdersBefore :: DB.Connection -> UTCTime -> IO [(RegistrationId, Int64)]
@@ -683,7 +840,303 @@ failedCodeOrdersBefore db cutoff =
       |]
       (PFailed, truncateToSecond cutoff)
 
-insertPrepaidCode :: DB.Connection -> NewPrepaidCode -> UTCTime -> IO (Either CodeHashTaken Int64)
+-- | The hold, unless it is overdue, which reads as none.
+heldBy :: Balance -> Maybe BalanceHold
+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.
+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 < ?"
+          <> unfunded
+          <> " THEN 1 ELSE 0 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"
+          <> " LEFT JOIN sx_badge_service_invoices i ON i.invoice_id = ni.invoice_id"
+          <> " WHERE b.registration_id = ?"
+      )
+      (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
+  blHold <- case (holder_, until_) of
+    (Nothing, _) -> Right Nothing
+    (Just holder, Just bhUntil) -> Right $ Just BalanceHold {bhHolder = RegistrationId holder, bhUntil, bhOverdue = overdue}
+    (Just _, Nothing) -> Left $ "name_balances holder without an invoice: " <> rid
+  pure Balance {blRegistration = RegistrationId rid, blAmount, blCredited, blRefunded, blHold, blRefundedAt}
+
+-- | The order holding the balance, when its hold is overdue, for the next spend to close.
+overdueHolder :: DB.Connection -> RegistrationId -> UTCTime -> IO (Maybe NameRegistration)
+overdueHolder db rid now =
+  getBalance db rid now >>= \case
+    Just Balance {blHold = Just BalanceHold {bhHolder, bhOverdue = True}} -> getRegistration db bhHolder
+    _ -> pure Nothing
+
+-- | The order a support reference names, by its registration id or its name invoice's id, with its balance.
+balanceByReference :: DB.Connection -> Text -> UTCTime -> IO (Maybe (RegistrationId, Maybe Balance))
+balanceByReference db ref now =
+  DB.query
+    db
+    "SELECT registration_id FROM sx_badge_service_name_registrations WHERE registration_id = ? UNION ALL SELECT registration_id FROM sx_badge_service_name_invoices WHERE invoice_id = ?"
+    (ref, ref)
+    >>= \case
+      Only rid : _ -> (\balance -> Just (RegistrationId rid, balance)) <$> getBalance db (RegistrationId rid) now
+      [] -> pure Nothing
+
+-- | From the order back along balance_source to the first, following it only from orders past unpaid.
+balanceChain :: DB.Connection -> RegistrationId -> IO [BalanceLink]
+balanceChain db rid =
+  getRegistration db rid >>= \case
+    Nothing -> pure []
+    Just NameRegistration {nrPhase, nrPayment, nrBalanceSource, nrBalanceUsed} -> do
+      let pastUnpaid = nrPhase /= PUnpaid
+      lkPaid <- case nrPayment of
+        RPInvoice _ (InvoiceId invId) | pastUnpaid -> maybe 0 fromOnly . listToMaybe <$> (DB.query db "SELECT amount FROM sx_badge_service_invoices WHERE invoice_id = ?" (Only invId) :: IO [Only Int])
+        _ -> pure 0
+      lkLateCredits <- case nrPayment of
+        RPInvoice _ invId -> lateCredits db invId
+        _ -> pure []
+      let link = BalanceLink {lkRegistration = rid, lkPayment = nrPayment, lkPaid, lkFromBalance = if pastUnpaid then nrBalanceUsed else 0, lkLateCredits}
+      (link :) <$> maybe (pure []) (balanceChain db) (if pastUnpaid then nrBalanceSource else Nothing)
+
+lateCredits :: DB.Connection -> InvoiceId -> IO [LateCredit]
+lateCredits db (InvoiceId invId) =
+  map toLateCredit
+    <$> DB.query
+      db
+      "SELECT invoice_id, credit_no, registration_id, units, invoice_rate, current_rate, rate_used, cents FROM sx_badge_service_name_late_credits WHERE invoice_id = ? ORDER BY credit_no"
+      (Only invId)
+  where
+    toLateCredit (inv, lcCreditNo, reg, lcUnits, lcInvoiceRate, lcCurrentRate, lcRateUsed, lcCents) =
+      LateCredit {lcInvoice = InvoiceId inv, lcCreditNo, lcRegistration = RegistrationId reg, lcUnits, lcInvoiceRate, lcCurrentRate, lcRateUsed, lcCents}
+
+-- | Adds to the order's balance, making it on its first credit.
+creditBalance :: DB.Connection -> RegistrationId -> Int -> UTCTime -> IO ()
+creditBalance db (RegistrationId rid) cents now' =
+  DB.execute
+    db
+    [sql|
+      INSERT INTO sx_badge_service_name_balances (registration_id, amount, credited, refunded, created_at, updated_at)
+      VALUES (?,?,?,0,?,?)
+      ON CONFLICT (registration_id) DO UPDATE SET
+        amount = sx_badge_service_name_balances.amount + excluded.amount,
+        credited = sx_badge_service_name_balances.credited + excluded.credited,
+        updated_at = excluded.updated_at
+    |]
+    (rid, cents, cents, now, now)
+  where
+    now = truncateToSecond now'
+
+-- | The price spent at once, where the amount is the one seen and nothing holds it.
+spendBalance :: DB.Connection -> RegistrationId -> Int -> Int -> UTCTime -> IO Bool
+spendBalance db (RegistrationId rid) price seen now =
+  (> 0)
+    <$> executeChanging
+      db
+      "UPDATE sx_badge_service_name_balances SET amount = amount - ?, updated_at = ? WHERE registration_id = ? AND amount = ? AND amount >= ? AND reserved_by IS NULL"
+      (price, now, rid, seen, price)
+
+-- | Held by a difference order, where the amount is the one seen and nothing holds it.
+holdBalance :: DB.Connection -> RegistrationId -> Int -> RegistrationId -> UTCTime -> IO Bool
+holdBalance db (RegistrationId rid) seen (RegistrationId holder) now =
+  (> 0)
+    <$> executeChanging
+      db
+      "UPDATE sx_badge_service_name_balances SET reserved_by = ?, updated_at = ? WHERE registration_id = ? AND amount = ? AND reserved_by IS NULL"
+      (holder, now, rid, seen)
+
+-- | The holder's hold spent and cleared, where this holder holds the balance and it still has the cents.
+spendHeldBalance :: DB.Connection -> RegistrationId -> Int -> UTCTime -> IO Bool
+spendHeldBalance db (RegistrationId holder) used now =
+  (> 0)
+    <$> executeChanging
+      db
+      "UPDATE sx_badge_service_name_balances SET amount = amount - ?, reserved_by = NULL, updated_at = ? WHERE reserved_by = ? AND amount >= ?"
+      (used, truncateToSecond now, holder, used)
+
+releaseHeldBalance :: DB.Connection -> RegistrationId -> UTCTime -> IO Bool
+releaseHeldBalance db (RegistrationId holder) now =
+  (> 0)
+    <$> executeChanging
+      db
+      "UPDATE sx_badge_service_name_balances SET reserved_by = NULL, updated_at = ? WHERE reserved_by = ?"
+      (truncateToSecond now, holder)
+
+-- | All of the balance, where it is the cents given, above 0, and nothing holds it; refunded counts every refund.
+refundBalance :: DB.Connection -> RegistrationId -> Int -> UTCTime -> IO Bool
+refundBalance db (RegistrationId rid) cents now' =
+  (> 0)
+    <$> executeChanging
+      db
+      [sql|
+        UPDATE sx_badge_service_name_balances SET amount = 0, refunded = refunded + ?, refunded_at = ?, updated_at = ?
+        WHERE registration_id = ? AND amount = ? AND amount > 0 AND reserved_by IS NULL
+      |]
+      (cents, now, now, rid, cents)
+  where
+    now = truncateToSecond now'
+
+-- | A name invoice with its order, its invoice row and its payment row.
+lateFrom :: Query
+lateFrom =
+  " FROM sx_badge_service_name_invoices ni"
+    <> " JOIN sx_badge_service_name_registrations r ON r.registration_id = ni.registration_id"
+    <> " JOIN sx_badge_service_invoices i ON i.invoice_id = ni.invoice_id"
+    <> " JOIN sx_badge_service_payments p ON p.invoice_id = ni.invoice_id"
+
+-- | Its order closed unpaid, whatever the invoice's status, since settlement queues only a live order; takes the unpaid phase.
+closedUnpaid :: Query
+closedUnpaid = " r.phase = ? AND r.live = 0"
+
+cardInvoice :: Query
+cardInvoice = " i.payment_crypto_currency IS NULL"
+
+cryptoInvoice :: Query
+cryptoInvoice = " i.payment_crypto_currency IS NOT NULL"
+
+-- | No credit rows sum to 0, not NULL.
+creditedTotal :: Query -> Query
+creditedTotal column = " (SELECT " <> integerSum ("COALESCE(SUM(c." <> column <> "), 0)") <> " FROM sx_badge_service_name_late_credits c WHERE c.invoice_id = ni.invoice_id)"
+
+integerSum :: Query -> Query
+#if defined(dbPostgres)
+-- Postgres sums a BIGINT as NUMERIC, which does not decode into an integer
+integerSum s = "CAST(" <> s <> " AS BIGINT)"
+#else
+integerSum = id
+#endif
+
+-- | The first alert's old marks are NULL, which = never matches.
+notDistinctFrom :: Query
+#if defined(dbPostgres)
+notDistinctFrom = " IS NOT DISTINCT FROM "
+#else
+notDistinctFrom = " IS "
+#endif
+
+-- | Confirmed money not all credited: cents for card, units for crypto.
+uncreditedMoney :: Query
+uncreditedMoney =
+  " ((" <> cardInvoice <> " AND p.confirmed_amount >" <> creditedTotal "cents" <> ")"
+    <> " OR (" <> cryptoInvoice <> " AND p.confirmed_units >" <> creditedTotal "units" <> "))"
+
+-- | Why a closed order's money is not all credited, by the first case that holds, else NULL.
+pendingCase :: Query
+pendingCase =
+  " CASE WHEN COALESCE(p.amount, 0) = 0 AND (p.crypto_paid IS NOT NULL OR p.paid_in_full = 1) THEN " <> literal LPConfirming
+    <> " WHEN" <> uncreditedMoney <> " THEN " <> literal LPUncredited
+    <> " WHEN" <> cardInvoice <> " AND COALESCE(p.amount, 0) > p.confirmed_amount THEN " <> literal LPUnconfirmed
+    <> " WHEN p.received_units > p.confirmed_units THEN " <> literal LPUnconfirmed
+    <> " WHEN" <> cryptoInvoice <> " AND p.received_units IS NULL AND COALESCE(p.amount, 0) > 0 THEN " <> literal LPUncounted
+    <> " END"
+  where
+    literal p = fromString $ "'" <> T.unpack (textEncode p) <> "'"
+
+-- | What an alert names as received: cents for card, units for crypto.
+receivedFigure :: Query
+receivedFigure = " CASE WHEN" <> cardInvoice <> " THEN p.amount ELSE p.received_units END"
+
+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,"
+    <> " 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)
+
+toLateState :: LateRow -> 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}
+
+-- | 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)
+
+-- | 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
+creditLatePayment db LateCredit {lcInvoice = InvoiceId invId, lcCreditNo, lcRegistration = regId@(RegistrationId rid), lcUnits, lcInvoiceRate, lcCurrentRate, lcRateUsed, lcCents} now' = do
+  inserted <-
+    executeChanging
+      db
+      [sql|
+        INSERT INTO sx_badge_service_name_late_credits (invoice_id, credit_no, registration_id, units, invoice_rate, current_rate, rate_used, cents, created_at)
+        VALUES (?,?,?,?,?,?,?,?,?)
+        ON CONFLICT DO NOTHING
+      |]
+      (invId, lcCreditNo, rid, lcUnits, lcInvoiceRate, lcCurrentRate, lcRateUsed, lcCents, now)
+  when (inserted > 0) $ creditBalance db regId lcCents now
+  pure $ inserted > 0
+  where
+    now = truncateToSecond now'
+
+-- | Why the closed order's money on the invoice is not all credited; the one rule of the pending log and the alert.
+latePending :: DB.Connection -> InvoiceId -> IO (Maybe LatePending)
+latePending db (InvoiceId invId) =
+  maybe Nothing fromOnly . listToMaybe
+    <$> DB.query db ("SELECT" <> pendingCase <> lateFrom <> " WHERE ni.invoice_id = ? AND" <> closedUnpaid) (invId, PUnpaid)
+
+-- | Closed orders' invoices with confirmed money not all credited, for the poller's credit pass.
+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)
+
+-- | 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]
+lateAlertDue db cutoff =
+  DB.query
+    db
+    ( lateColumns
+        <> ","
+        <> pendingCase
+        <> ","
+        <> receivedFigure
+        <> ", ni.late_alerted_at, ni.late_alerted_units"
+        <> lateFrom
+        <> " WHERE"
+        <> closedUnpaid
+        <> " AND p.created_at < ? AND"
+        <> pendingCase
+        <> " IS NOT NULL AND (ni.late_alerted_at IS NULL OR"
+        <> receivedFigure
+        <> " > ni.late_alerted_units) ORDER BY p.created_at, ni.invoice_id"
+    )
+    (PUnpaid, truncateToSecond cutoff)
+    >>= decodeAll toAlert
+  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}
+      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 =
+  (> 0)
+    <$> executeChanging
+      db
+      ( "UPDATE sx_badge_service_name_invoices SET late_alerted_at = ?, late_alerted_units = ? WHERE invoice_id = ? AND late_alerted_at"
+          <> notDistinctFrom
+          <> "? AND late_alerted_units"
+          <> notDistinctFrom
+          <> "?"
+      )
+      (truncateToSecond now, laReceived, invId, laAlertedAt, laAlertedReceived)
+
+insertPrepaidCode ::DB.Connection -> NewPrepaidCode -> UTCTime -> IO (Either CodeHashTaken Int64)
 insertPrepaidCode db NewPrepaidCode {npcCodeHash, npcMinLength, npcYears, npcPaymentStatus, npcExpiresAt} now = do
   inserted <-
     executeChanging
diff --git a/apps/simplex-store-service/src/StoreService/Names/View.hs b/apps/simplex-store-service/src/StoreService/Names/View.hs
index 733da26cb3..9b188ba599 100644
--- a/apps/simplex-store-service/src/StoreService/Names/View.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/View.hs
@@ -7,6 +7,7 @@ module StoreService.Names.View
     registrationView,
     readViewChain,
     viewJSON,
+    balanceJSON,
     addressText,
     tldText,
     registrationAt,
@@ -35,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 (NamePhase (..), NameRegistration (..), NameReveal (..), getRegistration)
+import StoreService.Names.Store (Balance (..), BalanceHold (..), NamePhase (..), NameRegistration (..), NameReveal (..), getBalance, getRegistration, heldBy)
 
 -- | The view's chain reads; a field whose read failed is null and named in vrUnread.
 data ViewReads = ViewReads
@@ -44,8 +45,11 @@ data ViewReads = ViewReads
   }
   deriving (Eq, Show)
 
-registrationView :: DBStore -> NamesConfig -> Contracts -> NameRegistration -> IO J.Value
-registrationView _ cfg ct r = viewJSON cfg r <$> readViewChain ct r
+-- | The balance as it reads at the given time, when a hold may have become overdue.
+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
 
 -- | The intent nonce only in committed.
 readViewChain :: Contracts -> NameRegistration -> IO ViewReads
@@ -57,8 +61,8 @@ readViewChain ct NameRegistration {nrPhase, nrOwner} = case nrPhase of
   where
     none = ViewReads {vrIntentNonce = Nothing, vrUnread = []}
 
-viewJSON :: NamesConfig -> NameRegistration -> ViewReads -> J.Value
-viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}} r ViewReads {vrIntentNonce, vrUnread} =
+viewJSON :: NamesConfig -> NameRegistration -> Maybe Balance -> ViewReads -> J.Value
+viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}} r balance ViewReads {vrIntentNonce, vrUnread} =
   J.object
     [ "id" .= rid,
       "version" .= nrVersion,
@@ -77,6 +81,8 @@ viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}
       "years" .= nrYears,
       "duration" .= nrDuration,
       "price" .= nrPrice,
+      "fromBalance" .= nrBalanceUsed,
+      "balance" .= (balanceJSON <$> balance),
       "commitTx" .= (txText <$> nrCommitTx),
       "registerTx" .= (txText <$> nrRegisterTx),
       "revealAfter" .= nrRevealAfter,
@@ -88,9 +94,16 @@ viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}
     ]
   where
     NameRegistration {nrId = RegistrationId rid, nrVersion, nrMoves, nrLinksRefusedAt, nrPhase, nrLabelHash = LabelHash lh, nrReveal, nrOwner, nrCommitment, nrSealed} = r
-    NameRegistration {nrYears, nrDuration, nrPrice, nrCommitTx, nrRegisterTx, nrRevealAfter, nrRevealBefore, nrExpiresAt, nrError} = r
+    NameRegistration {nrYears, nrDuration, nrPrice, nrBalanceUsed, nrCommitTx, nrRegisterTx, nrRevealAfter, nrRevealBefore, nrExpiresAt, nrError} = r
     txText (TxHash h) = hex h
 
+-- | The holder is not named, so an order's link discloses no other order.
+balanceJSON :: Balance -> J.Value
+balanceJSON b@Balance {blAmount, blRefunded} =
+  J.object ["amount" .= blAmount, "held" .= isJust hold, "heldUntil" .= (bhUntil <$> hold), "refunded" .= blRefunded]
+  where
+    hold = heldBy b
+
 -- | EIP-55, as the page compares owners.
 addressText :: Address -> Text
 addressText = safeDecodeUtf8 . strEncode
diff --git a/apps/simplex-store-service/src/StoreService/Names/Worker.hs b/apps/simplex-store-service/src/StoreService/Names/Worker.hs
index 59b33dc345..6e1b4c7a03 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Worker.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Worker.hs
@@ -327,6 +327,7 @@ judge w@Worker {wkOrders = oe@OrdersEnv {oeContracts}} now r@NameRegistration {n
 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
   RPCode codeId -> written r . fmap fst <$> releaseCode oeTurns oeStore codeId nrId write
   where
     write db = versionWritten <$> updateRegistration db r {nrPhase = PTaken, nrError = Nothing} now
@@ -396,6 +397,7 @@ retryRegistration oe@OrdersEnv {oeNow} current = do
 retryCode :: OrdersEnv -> UTCTime -> NameRegistration -> IO (Either CodeRefusal (Maybe PrepaidCode))
 retryCode OrdersEnv {oeStore} now NameRegistration {nrId, nrLength, nrPayment} = case nrPayment of
   RPInvoice {} -> pure $ Right Nothing
+  RPBalance -> pure $ Right Nothing
   RPCode codeId ->
     withTransaction oeStore (`getPrepaidCodeById` codeId) <&> \case
       Just code -> maybe (Right $ Just code) Left $ codeRefusal now nrId nrLength code
diff --git a/apps/simplex-store-service/src/StoreService/Orders.hs b/apps/simplex-store-service/src/StoreService/Orders.hs
index 73c756a32c..879f9019b1 100644
--- a/apps/simplex-store-service/src/StoreService/Orders.hs
+++ b/apps/simplex-store-service/src/StoreService/Orders.hs
@@ -17,7 +17,7 @@ where
 import StoreService.Log (logError, safelyWith)
 import StoreService.Names.Phases (Phases, RegistrationId (..))
 import qualified StoreService.Names.Phases as Phases
-import StoreService.Names.Store (NamePhase (..), NameRegistration (..), VersionWrite (..), getRegistration, updateRegistration)
+import StoreService.Names.Store (NamePhase (..), NameRegistration (..), VersionWrite (..), getRegistration, releaseHeldBalance, updateRegistration)
 import StoreService.Providers (Funded (..), PaymentSignal (..), Received (..))
 import StoreService.Store.Invoices (InvoicePayment (..), InvoiceProduct (..), InvoiceRow (..), expireOverdueInvoice, lockInvoice, markCodePaid, paymentHolds, paymentStatusText, settlementCodeHash, settlementInvoice, truncateToSecond, updateInvoiceStatus, upsertPayment)
 import StoreService.Waiters (Waiters, publish, publishPayment)
@@ -184,13 +184,13 @@ nameSettled db before after wrotePayment holdsMoney r@NameRegistration {nrId, nr
       Just ISExpired -> (<> [NOLate nrId | holdsMoney]) . maybe [] (\(rid, v) -> [NOWritten rid v]) <$> closeOrder db r now
       _ -> pure [NOLate nrId | before /= ISOpen, wrotePayment]
 
--- | Clears a live unpaid order's live flag, as its invoice closes in the same transaction.
+-- | 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))
 closeOrder db r@NameRegistration {nrId, nrPhase, nrLive} now
   | nrPhase /= PUnpaid || not nrLive = pure Nothing
   | otherwise =
       updateRegistration db r {nrLive = False} now >>= \case
-        Written v -> pure (Just (nrId, v))
+        Written v -> Just (nrId, v) <$ releaseHeldBalance db nrId now
         _ -> E.throwIO (RegistrationChanged nrId)
 
 -- | The order of a name invoice whose status this transaction moved to expired.
diff --git a/apps/simplex-store-service/src/StoreService/Poller.hs b/apps/simplex-store-service/src/StoreService/Poller.hs
index b5c6c09df0..3d2cb4a8be 100644
--- a/apps/simplex-store-service/src/StoreService/Poller.hs
+++ b/apps/simplex-store-service/src/StoreService/Poller.hs
@@ -33,7 +33,7 @@ where
 
 import StoreService.Config (PollConfig (..))
 import StoreService.Names.Phases (Phases, RegistrationId (..))
-import StoreService.Names.Store (deleteUnpaidRegistration, unpaidCleanupCandidates)
+import StoreService.Names.Store (CleanupKept (..), deleteUnpaidRegistration, 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)
@@ -296,9 +296,10 @@ cleanupUnpaid env@PollerEnv {peStore, peCleanupLeft} now = do
               Left (ProviderError e) -> keep ("reading invoice " <> invText <> " failed: " <> e)
               Right signal_ -> do
                 mapM_ (\signal -> settleMoved env irProvider now (irProviderRef, signal)) signal_
-                deleted <- withTransaction peStore (`deleteUnpaidRegistration` rid)
-                unless deleted $ logError ("names cleanup: unpaid registration " <> ridText <> " is kept because invoice " <> invText <> " received a payment; refund it")
-                pure deleted
+                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 (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)
 
diff --git a/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs b/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs
index 015ed7ff04..5d77f257a7 100644
--- a/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs
+++ b/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs
@@ -40,7 +40,7 @@ import StoreService.Names.Phases (RegistrationId (..))
 import StoreService.Names.Signatures (OrderFields (..))
 import StoreService.Names.Store (NameRegistration (..), NewRegistration (..), OrderTerms (..), PaidOrder (..), PrepaidCode (..), RegistrationPayment (..), createPaidRegistration, getRegistration, newRegistrationId, orderHash, textMethod)
 import StoreService.Names.Turns (withLabelTurn)
-import StoreService.Names.View (registrationAt, registrationView)
+import StoreService.Names.View (balanceJSON, registrationAt, registrationView)
 import StoreService.Orders (publishRegistration)
 import StoreService.Providers (OrderDraft (..), Provider (..), ProviderError (..), ProviderInvoice (..), expiresItself)
 import StoreService.Store.Invoices (InvoiceRow (..), NewNameInvoice (..), getInvoice, insertNameInvoice, newInvoiceId, truncateToSecond)
@@ -96,6 +96,7 @@ nameInvoiceHandler env@OrdersEnv {oeStore, oeTurns, oeNow} cfg providers waiters
     answerResend now r@NameRegistration {nrPayment} = case nrPayment of
       RPInvoice _ invId -> getInvoice oeStore invId >>= maybe (refuse OROrderExists) (fmap answerNow . viewOf (registrationAt now r) . invoiceAt now)
       RPCode _ -> refuse OROrderExists
+      RPBalance -> refuse OROrderExists
     viewOf r row = jsonResponse status200 <$> nameInvoiceView env (confirmationsFor cfg) row r
     newOrder order@InvoiceOrder {ioRequest = OrderRequest {orFields = OrderFields {ofLabelHash, ofLength, ofDuration}, orTimestamp}, ioMethod, ioPrice} = do
       now <- oeNow
@@ -117,6 +118,7 @@ nameInvoiceHandler env@OrdersEnv {oeStore, oeTurns, oeNow} cfg providers waiters
       invId <- newInvoiceId
       now <- truncateToSecond <$> oeNow
       let amount = CurrencyAmount ioPrice
+          price = fromIntegral ioPrice
       pCreateInvoice provider ioMethod OrderDraft {odAmount = amount, odCurrency = catalogCurrency} >>= \case
         Left (ProviderError e) -> do
           logError ("POST /api/invoice (name) failed: provider refused to create an invoice: " <> e)
@@ -125,8 +127,8 @@ nameInvoiceHandler env@OrdersEnv {oeStore, oeTurns, oeNow} cfg providers waiters
           rid <- newRegistrationId
           let invoice = NewNameInvoice {nniInvoiceId = invId, nniProvider = pProvider provider, nniAmount = amount, nniCurrency = catalogCurrency, nniDestination = piDestination, nniExpiresAt = addUTCTime (invoiceWindow cfg ioMethod) now, nniCreatedAt = now}
               registration = NewRegistration {nrgId = rid, nrgOwner = orOwner, nrgOrder = orFields, nrgYears = nYears $ oeConfig env}
-              paid = PaidOrder {poMethod = ioMethod, poPrice = fromIntegral ioPrice, poInvoiceId = invId, poProviderRef = piProviderRef}
-          placeOrder env req (\db at -> insertNameInvoice db invoice >> first (const OROrderExists) <$> createPaidRegistration db registration paid at)
+              paid = PaidOrder {poMethod = ioMethod, poPrice = price, poInvoiceId = invId, poProviderRef = piProviderRef}
+          placeOrder env req [] (\db at -> insertNameInvoice db invoice >> first (const OROrderExists) <$> createPaidRegistration db registration (OTInvoice ioMethod price) paid Nothing at)
             `E.catch` strandedBy provider piProviderRef
             >>= \case
             Left refusal -> do
@@ -206,6 +208,7 @@ announceClosed OrdersEnv {oeStore, oePhases} providers waiters closed = do
     paidInvoice = \case
       RPInvoice _ invId -> Just invId
       RPCode _ -> Nothing
+      RPBalance -> Nothing
 
 cancelAtProvider :: Provider -> Text -> IO ()
 cancelAtProvider Provider {pCancelInvoice} ref =
@@ -222,8 +225,9 @@ firstRefusal = \case
   check : rest -> check >>= either (pure . Just) (const $ firstRefusal rest)
 
 nameInvoiceView :: OrdersEnv -> Maybe Int -> InvoiceRow -> NameRegistration -> IO J.Value
-nameInvoiceView OrdersEnv {oeStore, oeConfig, oeContracts} confirmations row@InvoiceRow {irInvoiceId = InvoiceId invId} r = do
-  view <- registrationView oeStore oeConfig oeContracts r
+nameInvoiceView OrdersEnv {oeStore, oeConfig, oeContracts, oeNow} confirmations row@InvoiceRow {irInvoiceId = InvoiceId invId} r = do
+  now <- oeNow
+  view <- registrationView oeStore oeConfig oeContracts now r
   pure $ J.object $ ["invoiceId" .= invId, "kind" .= ("name" :: Text), "registration" .= view] <> invoicePairs confirmations row
 
 orderRefusalResponse :: OrderRefusal -> Response
@@ -236,3 +240,4 @@ orderRefusalResponse = \case
   ORCatalogChanged price -> jsonResponse status409 $ J.object ["error" .= ("catalog_changed" :: Text), "price" .= price]
   ORCode refusal -> codeRefusalResponse refusal
   ORPriceTooHigh price -> jsonResponse status409 $ J.object ["error" .= ("price_too_high" :: Text), "price" .= price]
+  ORBalanceChanged balance -> jsonResponse status409 $ J.object ["error" .= ("balance_changed" :: Text), "balance" .= (balanceJSON <$> balance)]
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 515bdd163d..77ecf4bb0a 100644
--- a/apps/simplex-store-service/src/StoreService/Web/Names/Owner.hs
+++ b/apps/simplex-store-service/src/StoreService/Web/Names/Owner.hs
@@ -79,6 +79,7 @@ foundJSON NameRegistration {nrId = RegistrationId rid, nrPayment, nrPhase, nrCre
     invoiceId = case nrPayment of
       RPInvoice _ (InvoiceId t) -> Just t
       RPCode _ -> Nothing
+      RPBalance -> Nothing
 
 -- | POST /api/registration/:id/name, another name or other links, under the turns of both names.
 retargetHandler :: OrdersEnv -> Text -> Request -> Respond -> IO ResponseReceived
@@ -105,7 +106,7 @@ retargetHandler env@OrdersEnv {oeStore, oeConfig, oeContracts, oeTurns, oeNow} r
           | nrLabelHash stored `notElem` held -> changed
           | otherwise -> moveTo now (registrationAt now stored) fields timestamp
     moveTo now r@NameRegistration {nrPhase} fields timestamp
-      | orderFieldsOf r == fields = answerNow . jsonResponse status200 <$> registrationView oeStore oeConfig oeContracts r
+      | orderFieldsOf r == fields = answerNow . jsonResponse status200 <$> registrationView oeStore oeConfig oeContracts now r
       | Left refusal <- checkTimestamp now timestamp = refuse refusal
       | not (movable r) = refuse ORBadRequest
       | nrPhase == PFailed =
@@ -122,6 +123,7 @@ retargetHandler env@OrdersEnv {oeStore, oeConfig, oeContracts, oeTurns, oeNow} r
             Just refusal -> refuse refusal
             Nothing -> case nrPayment of
               RPInvoice {} -> checkMovePrice oeContracts r ofLength >>= either refuse (write now r fields)
+              RPBalance -> checkMovePrice oeContracts r ofLength >>= either refuse (write now r fields)
               RPCode _ -> write now r fields nrPrice
     write now r fields price =
       retargetOrder env r fields price >>= \case
@@ -130,7 +132,7 @@ retargetHandler env@OrdersEnv {oeStore, oeConfig, oeContracts, oeTurns, oeNow} r
         Left (WRRefused refusal) -> refuse refusal
     movedAnswer now v =
       withTransaction oeStore (`getRegistration` rid) >>= \case
-        Just r -> written env rid v . jsonResponse status200 <$> registrationView oeStore oeConfig oeContracts (registrationAt now r)
+        Just r -> written env rid v . jsonResponse status200 <$> registrationView oeStore oeConfig oeContracts now (registrationAt now r)
         Nothing -> answerNow internalError <$ logError ("POST /api/registration/:id/name: order " <> ridText <> " is not readable after its move")
     changed = answerNow <$> registrationChangedResponse env rid
     refuse = refused "POST /api/registration/:id/name"
diff --git a/apps/simplex-store-service/src/StoreService/Web/Names/Registration.hs b/apps/simplex-store-service/src/StoreService/Web/Names/Registration.hs
index 99b29b2d14..9cd6bb0170 100644
--- a/apps/simplex-store-service/src/StoreService/Web/Names/Registration.hs
+++ b/apps/simplex-store-service/src/StoreService/Web/Names/Registration.hs
@@ -54,7 +54,7 @@ registrationHandler OrdersEnv {oeStore, oeConfig, oeContracts, oePhases, oeNow}
   where
     rid = RegistrationId ridText
     readNow = oeNow >>= \now -> fmap (now,) <$> withTransaction oeStore (`getRegistration` rid)
-    answer (now, r) = respond . jsonResponse status200 =<< registrationView oeStore oeConfig oeContracts (registrationAt now r)
+    answer (now, r) = respond . jsonResponse status200 =<< registrationView oeStore oeConfig oeContracts now (registrationAt now r)
 
 -- | What a reveal decided in the name's turn, with the version it wrote; the publish and the answer come after the turn.
 data RevealDecision
@@ -150,7 +150,7 @@ registrationRefusalResponse env tag rid = maybe notFound refusal <$> currentView
 -- | The registration's view as it reads now.
 currentView :: OrdersEnv -> RegistrationId -> IO (Maybe J.Value)
 currentView OrdersEnv {oeStore, oeConfig, oeContracts, oeNow} rid =
-  withTransaction oeStore (`getRegistration` rid) >>= traverse (\r -> oeNow >>= \now -> registrationView oeStore oeConfig oeContracts (registrationAt now r))
+  withTransaction oeStore (`getRegistration` rid) >>= traverse (\r -> oeNow >>= \now -> registrationView oeStore oeConfig oeContracts now (registrationAt now r))
 
 -- | The hold, cut to end just past the next moment at which the answer changes with time alone.
 heldFor :: Int -> UTCTime -> [UTCTime] -> Int
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 8ca6a8526a..32dc37695a 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -767,6 +767,7 @@ test-suite simplex-chat-test
       Bots.StoreService.GroupIntegrationTests
       Bots.StoreService.GroupTests
       Bots.StoreService.NameRegistrationTests
+      Bots.StoreService.NamesBalancesTests
       Bots.StoreService.NamesChainTests
       Bots.StoreService.NamesCodesTests
       Bots.StoreService.NamesContractsTests
diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs
new file mode 100644
index 0000000000..4ba21ac5d2
--- /dev/null
+++ b/tests/Bots/StoreService/NamesBalancesTests.hs
@@ -0,0 +1,665 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Bots.StoreService.NamesBalancesTests (namesBalancesTests) where
+
+import Bots.StoreService.NamesOrdersTests (Ctx (..), withOrders)
+import Bots.StoreService.NamesStoreTests (at, btc, invoiceStatus, newReg, ownerA, ownerB, paidOrder, reg, signature, t0, write)
+import Bots.StoreService.WebTests (capturingStderr, rcv, withServiceStore, withServiceStores)
+import Control.Concurrent.Async (async, wait)
+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
+import Control.Concurrent.STM (atomically, check)
+import Control.Monad (forM_)
+import Data.Bifunctor (first)
+import Data.Int (Int64)
+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.Messaging.Agent.Store.Common (DBStore, withTransaction)
+import qualified Simplex.Messaging.Agent.Store.DB as DB
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.SimplexName (labelHash)
+import StoreService.Config (ServiceConfig (..))
+import StoreService.Names.Orders (ClosedOrder (..), OrderRefusal (..), OrderRequest (..), OrdersEnv (..))
+import qualified StoreService.Names.Orders as Orders
+import StoreService.Names.Phases (RegistrationId (..))
+import StoreService.Names.Signatures (OrderFields (..))
+import StoreService.Names.Store
+import StoreService.Names.Turns (balanceTurnCount, newTurns, turnsCount, withBalanceTurn, withLabelTurn)
+import StoreService.Orders (cancelOpenInvoice, expireOverdue, settleOrder)
+import StoreService.Poller (cleanupUnpaid, newPollerEnv, unpaidRetention)
+import StoreService.Providers (PaymentSignal (..))
+import StoreService.Waiters (newWaiters)
+import StoreService.Web.Server (WebEnv (..))
+import System.Timeout (timeout)
+import Test.Hspec
+
+#if defined(dbPostgres)
+import Control.Concurrent.Async (concurrently)
+import Control.Concurrent.STM (modifyTVar', newTVarIO, readTVar)
+import Data.Either (isRight)
+import Database.PostgreSQL.Simple (Only (..), (:.) (..))
+#else
+import Database.SQLite.Simple (Only (..), (:.) (..))
+#endif
+
+namesBalancesTests :: Spec
+namesBalancesTests = describe "StoreService names: balances" $ do
+  describe "store" $ do
+    it "credits a balance, making it on the first credit" testCredit
+    it "spends a covered price at once from the amount seen, refusing a stale amount, a dearer price or a held balance, changing nothing" testSpendAtOnce
+    it "lets one of two difference orders hold a balance, the losing order not written" testTwoHolds
+    it "spends a hold only for its holder and while the amount covers it, clearing the hold" testSpendHeld
+    it "releases a hold only for its holder" testRelease
+    it "refunds a balance only at its amount, above 0 and not held, refused while held and accepted once released" testRefund
+    it "keeps amount = credited - spent - refunded over spends at once, a held spend, a released hold and a refund, spent counting orders past unpaid" testInvariant
+    it "keeps the invariant over credit, refund, credit, refund, refunded the sum" testCreditRefundTwice
+    it "reads a hold and a spend back through a new store connection" testRestart
+    it "finds an order and its balance by the order's registration id or its invoice id" testByReference
+    it "chains an order back along its balance sources over three orders, with each payment and its cents" testChain
+    it "stops the chain of a closed difference order at itself, with its late credits" testChainOfClosed
+    it "hashes a balance order over its fields, the paying order, price, balance and method, and stores it for a difference spend" testBalanceOrderHash
+    it "returns the 50 newest orders and then every older one holding a balance above 0" testFindBalances
+  describe "closes" $ do
+    it "releases a hold at a cancel, the sweep's expiry, settlement's expiry and the next order's close" testClosesRelease
+    it "reads an overdue holder's hold as none, and closes it in the transaction of the order placed" testOverdueHolderClosed
+    it "skips a named holder no longer live, and refuses with the balance when a live one cannot be closed" testNamedHolders
+    it "keeps at the cleanup, and logs, an unpaid order still holding a balance" testCleanupKeepsHolder
+  describe "late credits" $ do
+    it "credits a late payment once per credit number, a taken number changing neither the rows nor the balance" testCreditLatePayment
+    it "tells each case of pending money and selects confirmed money not all credited, by the order whatever the invoice's status" testLateScans
+    it "leaves 0.1 and 0.2 BTC credited against 0.3 confirmed neither pending nor selected" testExactUnits
+    it "alerts on pending money past the cutoff once, again only when more arrives, claimed by one of two instances" testLateAlerts
+  describe "turns" $ do
+    it "runs two holders of one balance one after the other, and nests in a label turn" testBalanceTurn
+#if defined(dbPostgres)
+  describe "two connections" $ do
+    it "applies one of a spend and a refund, or of a held spend and a refund, and keeps the invariant for a credit and a refund" testConcurrentWrites
+#endif
+
+-- fixtures
+
+-- | Every name and commitment its own, so any number of live orders fit.
+fieldsN :: Text -> OrderFields
+fieldsN label =
+  OrderFields
+    { ofLabelHash = labelHash label,
+      ofLength = T.length label,
+      ofDuration = 69292800,
+      ofCommitment = C.sha256Hash $ encodeUtf8 label,
+      ofSealed = "sealed-" <> label
+    }
+
+-- | A crypto invoice row, or a card one with its client secret in place of an address.
+invoiceRow :: DB.Connection -> Text -> Bool -> Int -> UTCTime -> IO ()
+invoiceRow db invId card cents expiresAt =
+  DB.execute
+    db
+    "INSERT INTO sx_badge_service_invoices (invoice_id, provider, price, amount, currency, payment_url, payment_address, payment_crypto_currency, payment_crypto_amount, expires_at, status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)"
+    ((invId, provider, cents, cents, "usd" :: Text, url, address, currency, cryptoAmount, expiresAt) :. ("open" :: Text, t0, t0))
+  where
+    destination :: (Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
+    destination
+      | card = ("stripe", Just "pi_secret", Nothing, Nothing, Nothing)
+      | otherwise = ("crypto", Nothing, Just "bc1qexampleaddress", Just "btc", Just "0.003")
+    (provider, url, address, currency, cryptoAmount) = destination
+
+-- | A paid order, unpaid and live, whose invoice of the cents expires at the given time.
+placeOrderRow :: DBStore -> Text -> Bool -> Int -> UTCTime -> IO ()
+placeOrderRow st r card cents expiresAt = withTransaction st $ \db -> do
+  invoiceRow db ("inv-" <> r) card cents expiresAt
+  createPaidRegistration db (newReg r ownerA (fieldsN r)) (OTInvoice method cents) (paidOrder ("inv-" <> r)) {poMethod = method, poPrice = cents} Nothing t0 `shouldReturn` Right ()
+  where
+    method = if card then SPMCard CPStripe else btc
+
+-- | A taken paid order with a balance of its price.
+source :: DBStore -> Text -> Int -> IO ()
+source st r cents = do
+  placeOrderRow st r False cents (at 60)
+  taken <- reg st r
+  write st taken {nrPhase = PTaken} `shouldReturn` Written 2
+  credit st r cents
+
+credit :: DBStore -> Text -> Int -> IO ()
+credit st r cents = withTransaction st $ \db -> creditBalance db (RegistrationId r) cents t0
+
+holdPrice :: Int
+holdPrice = 40000
+
+holdTerms :: Text -> Int -> OrderTerms
+holdTerms src seen = OTBalance (RegistrationId src) holdPrice seen (Just btc)
+
+-- | A difference order holding all of the source's balance seen, its invoice of the difference expiring at the given time.
+holder :: DBStore -> Text -> Text -> Int -> UTCTime -> IO (Either RegistrationRefused ())
+holder st r src seen expiresAt = withTransaction st $ \db -> do
+  invoiceRow db ("inv-" <> r) False (holdPrice - seen) expiresAt
+  createPaidRegistration db (newReg r ownerA (fieldsN r)) (holdTerms src seen) (paidOrder ("inv-" <> r)) {poPrice = holdPrice} (Just $ HeldBalance (RegistrationId src) seen) t0
+
+hold :: Text -> UTCTime -> Bool -> BalanceHold
+hold h bhUntil bhOverdue = BalanceHold {bhHolder = RegistrationId h, bhUntil, bhOverdue}
+
+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
+
+-- | The holder queued and its hold spent in one transaction, as settlement does.
+settleHolder :: DB.Connection -> NameRegistration -> IO Bool
+settleHolder db r = do
+  updateRegistration db r {nrPhase = PQueued} t0 `shouldReturn` Written (nrVersion r + 1)
+  spendHeldBalance db (nrId r) (nrBalanceUsed r) t0
+
+release :: DBStore -> Text -> IO Bool
+release st h = withTransaction st $ \db -> releaseHeldBalance db (RegistrationId h) t0
+
+refund :: DBStore -> Text -> Int -> IO Bool
+refund st r cents = withTransaction st $ \db -> refundBalance db (RegistrationId r) cents (at 5)
+
+-- | Amount, credited, refunded and the hold, as they read at the given time.
+figures :: DBStore -> Text -> UTCTime -> IO (Maybe (Int, Int, Int, Maybe BalanceHold))
+figures st r now = withTransaction st $ \db -> fmap (\Balance {blAmount, blCredited, blRefunded, blHold} -> (blAmount, blCredited, blRefunded, blHold)) <$> getBalance db (RegistrationId r) now
+
+-- | amount = credited - spent - refunded, spent being the balance_used of the orders past unpaid it paid for.
+invariantHolds :: DBStore -> Text -> IO ()
+invariantHolds st r = do
+  Just (amount, credited, refunded, _) <- figures st r t0
+  used <- withTransaction st $ \db -> DB.query db "SELECT balance_used FROM sx_badge_service_name_registrations WHERE balance_source = ? AND phase <> ?" (r, PUnpaid)
+  (r, amount) `shouldBe` (r, credited - sum (map fromOnly (used :: [Only Int])) - refunded)
+
+absent :: DBStore -> Text -> IO ()
+absent st r = withTransaction st (\db -> getRegistration db (RegistrationId r)) `shouldReturn` Nothing
+
+-- | A payment row with the figures the provider's reads left: cents received and confirmed, the crypto text, and units received and confirmed.
+data Paid = Paid
+  { pCents :: Int,
+    pConfirmedCents :: Int,
+    pCrypto :: Maybe Text,
+    pUnits :: Maybe Int64,
+    pConfirmedUnits :: Maybe Int64,
+    pInFull :: Bool
+  }
+
+cryptoPaid :: Int64 -> Int64 -> Paid
+cryptoPaid units confirmed = Paid {pCents = 20000, pConfirmedCents = 0, pCrypto = Just "0.003", pUnits = Just units, pConfirmedUnits = Just confirmed, pInFull = False}
+
+cardPaid :: Int -> Int -> Paid
+cardPaid cents confirmed = Paid {pCents = cents, pConfirmedCents = confirmed, pCrypto = Nothing, pUnits = Nothing, pConfirmedUnits = Nothing, pInFull = False}
+
+payment :: DBStore -> Text -> Paid -> UTCTime -> IO ()
+payment st invId Paid {pCents, pConfirmedCents, pCrypto, pUnits, pConfirmedUnits, pInFull} createdAt =
+  withTransaction st $ \db ->
+    DB.execute
+      db
+      "INSERT INTO sx_badge_service_payments (payment_id, invoice_id, provider, amount, currency, crypto_paid, paid_in_full, status, confirmed_amount, received_units, confirmed_units, invoice_rate, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
+      ((invId, invId, "crypto" :: Text, pCents, "usd" :: Text, pCrypto, if pInFull then 1 else 0 :: Int, "pending" :: Text, pConfirmedCents, pUnits) :. (pConfirmedUnits, Just ("62500" :: Text), createdAt, createdAt))
+
+-- | An order closed unpaid, by crypto unless card, with a late payment row created at the given time.
+closedWith :: DBStore -> Text -> Bool -> Paid -> UTCTime -> IO ()
+closedWith st r card paid createdAt = do
+  placeOrderRow st r card 20000 (at 60)
+  open <- reg st r
+  write st open {nrLive = False} `shouldReturn` Written 2
+  payment st ("inv-" <> r) paid createdAt
+
+lateCredit :: Text -> Int -> Maybe Int64 -> Int -> LateCredit
+lateCredit r n units cents =
+  LateCredit
+    { lcInvoice = InvoiceId ("inv-" <> r),
+      lcCreditNo = n,
+      lcRegistration = RegistrationId r,
+      lcUnits = units,
+      lcInvoiceRate = Just "62500",
+      lcCurrentRate = Just "60000.5",
+      lcRateUsed = Just "60000.5",
+      lcCents = cents
+    }
+
+creditLate :: DBStore -> LateCredit -> IO Bool
+creditLate st c = withTransaction st $ \db -> creditLatePayment db c (at 3)
+
+orderRequest :: Text -> OrderRequest
+orderRequest r = OrderRequest {orOwner = ownerA, orFields = fieldsN r, orTimestamp = 0, orSignature = signature}
+
+spendInsert :: Text -> Text -> Int -> Int -> DB.Connection -> UTCTime -> IO (Either OrderRefusal ())
+spendInsert r src price seen db now = first (const $ ORBalanceChanged Nothing) <$> createBalanceRegistration db (newReg r ownerA (fieldsN r)) (RegistrationId src) price seen now
+
+closedIds :: Either OrderRefusal [ClosedOrder] -> Either OrderRefusal [(RegistrationId, Int64)]
+closedIds = fmap $ map $ \ClosedOrder {coRegistration, coVersion} -> (nrId coRegistration, coVersion)
+
+-- store
+
+testCredit :: IO ()
+testCredit = withServiceStore $ \st -> do
+  placeOrderRow st "s" False 20000 (at 60)
+  figures st "s" t0 `shouldReturn` Nothing
+  credit st "s" 20000
+  credit st "s" 2500
+  figures st "s" t0 `shouldReturn` Just (22500, 22500, 0, Nothing)
+
+testSpendAtOnce :: IO ()
+testSpendAtOnce = withServiceStore $ \st -> do
+  source st "s" 10000
+  coveredSpend st "c1" "s" 6000 10000 `shouldReturn` Right ()
+  c1 <- reg st "c1"
+  (nrPhase c1, nrLive c1, nrPrice c1, nrPayment c1, nrBalanceSource c1, nrBalanceUsed c1) `shouldBe` (PQueued, True, 6000, RPBalance, Just (RegistrationId "s"), 6000)
+  nrOrderHash c1 `shouldBe` orderHash ownerA (fieldsN "c1") (OTBalance (RegistrationId "s") 6000 10000 Nothing)
+  figures st "s" t0 `shouldReturn` Just (4000, 10000, 0, Nothing)
+  coveredSpend st "c2" "s" 3000 10000 `shouldReturn` Left RRBalanceChanged
+  coveredSpend st "c3" "s" 5000 4000 `shouldReturn` Left RRBalanceChanged
+  mapM_ (absent st) ["c2", "c3"]
+  figures st "s" t0 `shouldReturn` Just (4000, 10000, 0, Nothing)
+  holder st "h" "s" 4000 (at 60) `shouldReturn` Right ()
+  coveredSpend st "c4" "s" 1000 4000 `shouldReturn` Left RRBalanceChanged
+  absent st "c4"
+  release st "h" `shouldReturn` True
+  coveredSpend st "c5" "s" 4000 4000 `shouldReturn` Right ()
+  figures st "s" t0 `shouldReturn` Just (0, 10000, 0, Nothing)
+
+testTwoHolds :: IO ()
+testTwoHolds = withServiceStore $ \st -> do
+  source st "s" 10000
+  holder st "h1" "s" 10000 (at 60) `shouldReturn` Right ()
+  holder st "h2" "s" 10000 (at 60) `shouldReturn` Left RRBalanceChanged
+  absent st "h2"
+  h1 <- reg st "h1"
+  (nrPhase h1, nrPayment h1, nrPrice h1, nrBalanceSource h1, nrBalanceUsed h1) `shouldBe` (PUnpaid, RPInvoice btc (InvoiceId "inv-h1"), holdPrice, Just (RegistrationId "s"), 10000)
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Just $ hold "h1" (at 60) False)
+  release st "h1" `shouldReturn` True
+  holder st "h3" "s" 9000 (at 60) `shouldReturn` Left RRBalanceChanged
+  absent st "h3"
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
+
+testSpendHeld :: IO ()
+testSpendHeld = withServiceStore $ \st -> do
+  source st "s" 10000
+  source st "other" 5000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  holder st "g" "other" 5000 (at 60) `shouldReturn` Right ()
+  let spendBy :: Text -> Int -> IO Bool
+      spendBy h used = withTransaction st $ \db -> spendHeldBalance db (RegistrationId h) used t0
+  spendBy "nobody" 10000 `shouldReturn` False
+  spendBy "h" 10001 `shouldReturn` False
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" (at 60) False)
+  spendBy "g" 5000 `shouldReturn` True
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" (at 60) False)
+  figures st "other" t0 `shouldReturn` Just (0, 5000, 0, Nothing)
+  spendBy "h" 10000 `shouldReturn` True
+  figures st "s" t0 `shouldReturn` Just (0, 10000, 0, Nothing)
+  spendBy "h" 0 `shouldReturn` False
+
+testRelease :: IO ()
+testRelease = withServiceStore $ \st -> do
+  source st "s" 10000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  release st "g" `shouldReturn` False
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" (at 60) False)
+  release st "h" `shouldReturn` True
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
+  release st "h" `shouldReturn` False
+
+testRefund :: IO ()
+testRefund = withServiceStore $ \st -> do
+  source st "s" 10000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  refund st "s" 10000 `shouldReturn` False
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" (at 60) False)
+  release st "h" `shouldReturn` True
+  mapM (refund st "s") [9999, 10001] `shouldReturn` [False, False]
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
+  refund st "s" 10000 `shouldReturn` True
+  Just Balance {blAmount, blCredited, blRefunded, blRefundedAt} <- withTransaction st $ \db -> getBalance db (RegistrationId "s") t0
+  (blAmount, blCredited, blRefunded, blRefundedAt) `shouldBe` (0, 10000, 10000, Just (at 5))
+  mapM (refund st "s") [0, 10000] `shouldReturn` [False, False]
+
+testInvariant :: IO ()
+testInvariant = withServiceStore $ \st -> do
+  source st "s" 30000
+  invariantHolds st "s"
+  coveredSpend st "c1" "s" 5000 30000 `shouldReturn` Right ()
+  invariantHolds st "s"
+  holder st "h1" "s" 25000 (at 60) `shouldReturn` Right ()
+  invariantHolds st "s"
+  h1 <- reg st "h1"
+  withTransaction st (`settleHolder` h1) `shouldReturn` True
+  figures st "s" t0 `shouldReturn` Just (0, 30000, 0, Nothing)
+  invariantHolds st "s"
+  credit st "s" 8000
+  holder st "h2" "s" 8000 (at 60) `shouldReturn` Right ()
+  h2 <- reg st "h2"
+  withTransaction st (\db -> closeOverdue db h2 (at 61)) `shouldReturn` Just (nrVersion h2 + 1)
+  figures st "s" t0 `shouldReturn` Just (8000, 38000, 0, Nothing)
+  invariantHolds st "s"
+  refund st "s" 8000 `shouldReturn` True
+  figures st "s" t0 `shouldReturn` Just (0, 38000, 8000, Nothing)
+  invariantHolds st "s"
+
+testCreditRefundTwice :: IO ()
+testCreditRefundTwice = withServiceStore $ \st -> do
+  source st "s" 10000
+  refund st "s" 10000 `shouldReturn` True
+  credit st "s" 4000
+  refund st "s" 4000 `shouldReturn` True
+  figures st "s" t0 `shouldReturn` Just (0, 14000, 14000, Nothing)
+  invariantHolds st "s"
+
+testRestart :: IO ()
+testRestart = withServiceStores $ \open -> do
+  st <- open
+  source st "s" 10000
+  source st "t" 8000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  coveredSpend st "c" "t" 3000 8000 `shouldReturn` Right ()
+  let readBack :: DBStore -> IO (Maybe (Int, Int, Int, Maybe BalanceHold), Maybe (Int, Int, Int, Maybe BalanceHold), NameRegistration, NameRegistration)
+      readBack store = (,,,) <$> figures store "s" t0 <*> figures store "t" t0 <*> reg store "h" <*> reg store "c"
+  stored@(held, spent, _, c) <- readBack st
+  (held, spent, nrBalanceUsed c) `shouldBe` (Just (10000, 10000, 0, Just $ hold "h" (at 60) False), Just (5000, 8000, 0, Nothing), 3000)
+  restarted <- open
+  readBack restarted `shouldReturn` stored
+
+testByReference :: IO ()
+testByReference = withServiceStore $ \st -> do
+  source st "s" 10000
+  placeOrderRow st "plain" False 20000 (at 60)
+  let byRef :: Text -> IO (Maybe (RegistrationId, Maybe Int))
+      byRef ref = withTransaction st $ \db -> fmap (fmap (fmap blAmount)) <$> balanceByReference db ref t0
+  mapM byRef ["s", "inv-s"] `shouldReturn` replicate 2 (Just (RegistrationId "s", Just 10000))
+  mapM byRef ["plain", "inv-plain"] `shouldReturn` replicate 2 (Just (RegistrationId "plain", Nothing))
+  byRef "nothing" `shouldReturn` Nothing
+
+testChain :: IO ()
+testChain = withServiceStore $ \st -> do
+  source st "a" 20000
+  holder st "b" "a" 20000 (at 60) `shouldReturn` Right ()
+  b <- reg st "b"
+  withTransaction st (`settleHolder` b) `shouldReturn` True
+  queued <- reg st "b"
+  write st queued {nrPhase = PTaken} `shouldReturn` Written (nrVersion queued + 1)
+  credit st "b" holdPrice
+  coveredSpend st "c" "b" 10000 holdPrice `shouldReturn` Right ()
+  withTransaction st (\db -> balanceChain db (RegistrationId "c"))
+    `shouldReturn` [ BalanceLink {lkRegistration = RegistrationId "c", lkPayment = RPBalance, lkPaid = 0, lkFromBalance = 10000, lkLateCredits = []},
+                     BalanceLink {lkRegistration = RegistrationId "b", lkPayment = RPInvoice btc (InvoiceId "inv-b"), lkPaid = holdPrice - 20000, lkFromBalance = 20000, lkLateCredits = []},
+                     BalanceLink {lkRegistration = RegistrationId "a", lkPayment = RPInvoice btc (InvoiceId "inv-a"), lkPaid = 20000, lkFromBalance = 0, lkLateCredits = []}
+                   ]
+
+testChainOfClosed :: IO ()
+testChainOfClosed = withServiceStore $ \st -> do
+  source st "s" 15000
+  holder st "d" "s" 15000 (at 60) `shouldReturn` Right ()
+  waiters <- newWaiters
+  cancelOpenInvoice st waiters Nothing (InvoiceId "inv-d") (at 2) `shouldReturn` True
+  figures st "s" t0 `shouldReturn` Just (15000, 15000, 0, Nothing)
+  let late = lateCredit "d" 1 (Just 40000) 2400
+  creditLate st late `shouldReturn` True
+  withTransaction st (\db -> balanceChain db (RegistrationId "d"))
+    `shouldReturn` [BalanceLink {lkRegistration = RegistrationId "d", lkPayment = RPInvoice btc (InvoiceId "inv-d"), lkPaid = 0, lkFromBalance = 0, lkLateCredits = [late]}]
+
+testBalanceOrderHash :: IO ()
+testBalanceOrderHash = withServiceStore $ \st -> do
+  let o = fieldsN "h"
+      terms = holdTerms "s" 15000
+      base = orderHash ownerA o terms
+      src = RegistrationId "s"
+      variants =
+        [ ("labelHash" :: Text, orderHash ownerA o {ofLabelHash = labelHash "hh"} terms),
+          ("length", orderHash ownerA o {ofLength = 2} terms),
+          ("duration", orderHash ownerA o {ofDuration = 69292801} terms),
+          ("owner", orderHash ownerB o terms),
+          ("commitment", orderHash ownerA o {ofCommitment = C.sha256Hash "another"} terms),
+          ("sealed", orderHash ownerA o {ofSealed = ofSealed o <> "x"} terms),
+          ("paying order", orderHash ownerA o (OTBalance (RegistrationId "t") holdPrice 15000 (Just btc))),
+          ("price", orderHash ownerA o (OTBalance src (holdPrice + 1) 15000 (Just btc))),
+          ("balance", orderHash ownerA o (OTBalance src holdPrice 15001 (Just btc))),
+          ("method", orderHash ownerA o (OTBalance src holdPrice 15000 (Just $ SPMCard CPStripe))),
+          ("no method", orderHash ownerA o (OTBalance src holdPrice 15000 Nothing)),
+          ("an invoice order", orderHash ownerA o (OTInvoice btc holdPrice))
+        ]
+  orderHash ownerA (fieldsN "h") (holdTerms "s" 15000) `shouldBe` base
+  forM_ variants $ \(field, h) -> (field, h == base) `shouldBe` (field, False)
+  source st "s" 15000
+  holder st "h" "s" 15000 (at 60) `shouldReturn` Right ()
+  fmap nrId <$> withTransaction st (`getRegistrationByOrderHash` base) `shouldReturn` Just (RegistrationId "h")
+
+testFindBalances :: IO ()
+testFindBalances = withServiceStore $ \st -> do
+  let rid :: Int -> Text
+      rid i = "r" <> T.pack (show i)
+  forM_ [1 .. 52 :: Int] $ \i -> withTransaction st $ \db -> do
+    invoiceRow db ("inv-" <> rid i) False 20000 (at 60)
+    createPaidRegistration db (newReg (rid i) ownerA (fieldsN $ rid i)) (OTInvoice btc 20000) (paidOrder ("inv-" <> rid i)) Nothing (at i) `shouldReturn` Right ()
+  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])
+
+-- closes
+
+testClosesRelease :: IO ()
+testClosesRelease = withServiceStore $ \st -> do
+  waiters <- newWaiters
+  let closes = ["cancel", "sweep", "settled", "next"]
+  forM_ closes $ \c -> do
+    source st ("s-" <> c) 10000
+    holder st ("h-" <> c) ("s-" <> c) 10000 (at 60) `shouldReturn` Right ()
+  cancelOpenInvoice st waiters Nothing (InvoiceId "inv-h-cancel") (at 2) `shouldReturn` True
+  expireOverdue st waiters Nothing (at 61) (at 61) [InvoiceId "inv-h-sweep"] `shouldReturn` [InvoiceId "inv-h-sweep"]
+  settleOrder st waiters Nothing (InvoiceId "inv-h-settled") (SigClosed (rcv 0 Nothing)) (at 2) `shouldReturn` Right ISExpired
+  next <- reg st "h-next"
+  withTransaction st (\db -> closeOverdue db next (at 61)) `shouldReturn` Just (nrVersion next + 1)
+  forM_ closes $ \c -> do
+    (c,) <$> figures st ("s-" <> c) t0 `shouldReturn` (c, Just (10000, 10000, 0, Nothing))
+    (c,) . nrLive <$> reg st ("h-" <> c) `shouldReturn` (c, False)
+    (c,) <$> invoiceStatus st ("inv-h-" <> c) `shouldReturn` (c, "expired")
+
+testOverdueHolderClosed :: IO ()
+testOverdueHolderClosed = withOrders $ \Ctx {cStore = st, cOrders} -> do
+  now <- oeNow cOrders
+  source st "s" 10000
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  Just balance <- withTransaction st $ \db -> getBalance db (RegistrationId "s") now
+  (blHold balance, heldBy balance) `shouldBe` (Just $ hold "h" (at 60) True, Nothing)
+  Just h <- withTransaction st $ \db -> overdueHolder db (RegistrationId "s") now
+  nrId h `shouldBe` RegistrationId "h"
+  withTransaction st (\db -> overdueHolder db (RegistrationId "s") t0) `shouldReturn` Nothing
+  closedIds <$> Orders.placeOrder cOrders (orderRequest "c") [h] (\_ _ -> pure $ Left ORBadRequest) `shouldReturn` Left ORBadRequest
+  invoiceStatus st "inv-h" `shouldReturn` "open"
+  nrLive <$> reg st "h" `shouldReturn` True
+  figures st "s" now `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" (at 60) True)
+  closedIds <$> Orders.placeOrder cOrders (orderRequest "c") [h] (spendInsert "c" "s" 6000 10000) `shouldReturn` Right [(RegistrationId "h", nrVersion h + 1)]
+  invoiceStatus st "inv-h" `shouldReturn` "expired"
+  nrLive <$> reg st "h" `shouldReturn` False
+  figures st "s" now `shouldReturn` Just (4000, 10000, 0, Nothing)
+  nrPhase <$> reg st "c" `shouldReturn` PQueued
+
+testNamedHolders :: IO ()
+testNamedHolders = withOrders $ \Ctx {cStore = st, cOrders, cWeb} -> do
+  now <- oeNow cOrders
+  source st "s1" 10000
+  holder st "h1" "s1" 10000 (at 60) `shouldReturn` Right ()
+  h1 <- reg st "h1"
+  cancelOpenInvoice st (weWaiters cWeb) Nothing (InvoiceId "inv-h1") now `shouldReturn` True
+  closedIds <$> Orders.placeOrder cOrders (orderRequest "c1") [h1] (spendInsert "c1" "s1" 6000 10000) `shouldReturn` Right []
+  figures st "s1" now `shouldReturn` Just (4000, 10000, 0, Nothing)
+  source st "s2" 10000
+  holder st "h2" "s2" 10000 (at 60) `shouldReturn` Right ()
+  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)
+  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
+  invoiceStatus st "inv-h2" `shouldReturn` "open"
+
+testCleanupKeepsHolder :: IO ()
+testCleanupKeepsHolder = withOrders $ \Ctx {cStore = st, cWeb} -> do
+  source st "s" 10000
+  holder st "h" "s" 10000 t0 `shouldReturn` Right ()
+  let due = addUTCTime (unpaidRetention + 1) t0
+  poller <- newPollerEnv st (weWaiters cWeb) Nothing (weHints cWeb) (weProviders cWeb) (poll $ weConfig cWeb)
+  logs <- capturingStderr $ cleanupUnpaid poller due
+  logs `shouldSatisfy` T.isInfixOf "unpaid registration h is kept because it still holds the balance of registration s"
+  nrLive <$> reg st "h" `shouldReturn` True
+  figures st "s" due `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" t0 True)
+
+-- late credits
+
+testCreditLatePayment :: IO ()
+testCreditLatePayment = withServiceStore $ \st -> do
+  closedWith st "x" False (cryptoPaid 400000 400000) t0
+  let state :: IO (Maybe (Int64, Int, Int))
+      state = withTransaction st $ \db -> fmap (\LateCreditState {lsCreditedUnits, lsCreditedCents, lsCredits} -> (lsCreditedUnits, lsCreditedCents, lsCredits)) <$> lateCreditState db (InvoiceId "inv-x")
+  creditLate st (lateCredit "x" 1 (Just 300000) 3000) `shouldReturn` True
+  creditLate st (lateCredit "x" 1 (Just 100000) 1000) `shouldReturn` False
+  figures st "x" t0 `shouldReturn` Just (3000, 3000, 0, Nothing)
+  state `shouldReturn` Just (300000, 3000, 1)
+  creditLate st (lateCredit "x" 2 (Just 100000) 1000) `shouldReturn` True
+  figures st "x" t0 `shouldReturn` Just (4000, 4000, 0, Nothing)
+  state `shouldReturn` Just (400000, 4000, 2)
+
+testLateScans :: IO ()
+testLateScans = withServiceStore $ \st -> do
+  let cases =
+        [ ("uncredited", False, cryptoPaid 300000 300000, Just LPUncredited),
+          ("unconfirmed", False, cryptoPaid 300000 0, Just LPUnconfirmed),
+          ("monero", False, Paid {pCents = 0, pConfirmedCents = 0, pCrypto = Just "0", pUnits = Just 0, pConfirmedUnits = Just 0, pInFull = True}, Just LPConfirming),
+          ("part", False, cryptoPaid 300000 100000, Just LPUnconfirmed),
+          ("card", True, cardPaid 5000 5000, Just LPUncredited),
+          ("cardpending", True, cardPaid 5000 0, Just LPUnconfirmed),
+          ("settledlate", False, cryptoPaid 200000 200000, Just LPUncredited),
+          ("uncounted", False, (cryptoPaid 0 0) {pCents = 5000, pUnits = Nothing}, Just LPUncounted),
+          ("credited", True, cardPaid 5000 5000, Nothing)
+        ]
+  forM_ (zip [1 ..] cases) $ \(i, (r, card, paid, _)) -> closedWith st r card paid (at i)
+  creditLate st (lateCredit "part" 1 (Just 100000) 1500) `shouldReturn` True
+  creditLate st (lateCredit "credited" 1 Nothing 5000) `shouldReturn` True
+  withTransaction st $ \db -> DB.execute db "UPDATE sx_badge_service_invoices SET status = ? WHERE invoice_id = ?" ("paid" :: Text, "inv-settledlate" :: Text)
+  placeOrderRow st "live" False 20000 (at 60)
+  payment st "inv-live" (cryptoPaid 300000 300000) (at 20)
+  let pendingOf :: Text -> IO (Text, Maybe LatePending)
+      pendingOf r = withTransaction st $ \db -> (r,) <$> latePending db (InvoiceId $ "inv-" <> r)
+  forM_ cases $ \(r, _, _, expected) -> pendingOf r `shouldReturn` (r, expected)
+  pendingOf "live" `shouldReturn` ("live", Nothing)
+  withTransaction st uncreditedLateInvoices `shouldReturn` map (InvoiceId . ("inv-" <>)) ["uncredited", "card", "settledlate"]
+  withTransaction st (\db -> lateCreditState db (InvoiceId "inv-part"))
+    `shouldReturn` Just
+      LateCreditState
+        { lsInvoice = InvoiceId "inv-part",
+          lsRegistration = RegistrationId "part",
+          lsPhase = PUnpaid,
+          lsLive = False,
+          lsCard = False,
+          lsReceivedCents = 20000,
+          lsConfirmedCents = 0,
+          lsReceivedUnits = Just 300000,
+          lsConfirmedUnits = Just 100000,
+          lsInvoiceRate = Just "62500",
+          lsCreditedUnits = 100000,
+          lsCreditedCents = 1500,
+          lsCredits = 1,
+          lsPaymentCreatedAt = at 4
+        }
+  withTransaction st (\db -> lateCreditState db (InvoiceId "inv-plain")) `shouldReturn` Nothing
+
+testExactUnits :: IO ()
+testExactUnits = withServiceStore $ \st -> do
+  closedWith st "x" False (cryptoPaid 30000000 30000000) t0
+  creditLate st (lateCredit "x" 1 (Just 10000000) 6000) `shouldReturn` True
+  creditLate st (lateCredit "x" 2 (Just 20000000) 12000) `shouldReturn` True
+  withTransaction st (\db -> latePending db (InvoiceId "inv-x")) `shouldReturn` Nothing
+  withTransaction st uncreditedLateInvoices `shouldReturn` []
+  fmap lsCreditedUnits <$> withTransaction st (\db -> lateCreditState db (InvoiceId "inv-x")) `shouldReturn` Just 30000000
+
+testLateAlerts :: IO ()
+testLateAlerts = withServiceStore $ \st -> do
+  closedWith st "old" False (cryptoPaid 300000 0) t0
+  closedWith st "card" True (cardPaid 5000 0) (at 1)
+  closedWith st "done" True (cardPaid 5000 5000) (at 2)
+  creditLate st (lateCredit "done" 1 Nothing 5000) `shouldReturn` True
+  closedWith st "new" False (cryptoPaid 300000 0) (at 120)
+  let due :: IO [LateAlert]
+      due = withTransaction st $ \db -> lateAlertDue db (at 60)
+      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
+  [old, card] <- due
+  map marks [old, card]
+    `shouldBe` [(InvoiceId "inv-old", LPUnconfirmed, Just 300000, Nothing, Nothing), (InvoiceId "inv-card", LPUnconfirmed, Just 5000, Nothing, Nothing)]
+  claim old (at 61) `shouldReturn` True
+  claim old (at 61) `shouldReturn` False
+  claim card (at 61) `shouldReturn` True
+  due `shouldReturn` []
+  withTransaction st $ \db -> DB.execute db "UPDATE sx_badge_service_payments SET received_units = ? WHERE invoice_id = ?" (400000 :: Int64, "inv-old" :: Text)
+  [more] <- due
+  marks more `shouldBe` (InvoiceId "inv-old", LPUnconfirmed, Just 400000, Just (at 61), Just 300000)
+  claim more (at 62) `shouldReturn` True
+  claim more (at 63) `shouldReturn` False
+  due `shouldReturn` []
+  map marks <$> withTransaction st (\db -> lateAlertDue db (at 180)) `shouldReturn` [(InvoiceId "inv-new", LPUnconfirmed, Just 300000, Nothing, Nothing)]
+
+-- turns
+
+testBalanceTurn :: IO ()
+testBalanceTurn = withServiceStore $ \st -> do
+  turns <- newTurns
+  source st "s" 10000
+  inside <- newEmptyMVar
+  proceed <- newEmptyMVar
+  let src = RegistrationId "s"
+  firstHolder <- async $ withBalanceTurn turns src $ do
+    putMVar inside ()
+    takeMVar proceed
+    holder st "h1" "s" 10000 (at 60)
+  takeMVar inside
+  secondHolder <- async $ withBalanceTurn turns src $ holder st "h2" "s" 10000 (at 60)
+  timeout 5000000 (atomically $ balanceTurnCount turns src >>= check . (== 2)) `shouldReturn` Just ()
+  putMVar proceed ()
+  wait firstHolder `shouldReturn` Right ()
+  wait secondHolder `shouldReturn` Left RRBalanceChanged
+  timeout 5000000 (withLabelTurn turns (labelHash "alicebakery") $ withBalanceTurn turns src $ pure ()) `shouldReturn` Just ()
+  turnsCount turns `shouldReturn` 0
+
+#if defined(dbPostgres)
+-- | Both transactions begun before either writes, so the second writer waits for the first's row lock and re-reads its condition.
+together :: DBStore -> DBStore -> (DB.Connection -> IO a) -> (DB.Connection -> IO b) -> IO (a, b)
+together st1 st2 w1 w2 = do
+  begun <- newTVarIO (0 :: Int)
+  let run :: DBStore -> (DB.Connection -> IO c) -> IO c
+      run st w = withTransaction st $ \db -> do
+        atomically $ modifyTVar' begun (+ 1)
+        atomically $ readTVar begun >>= check . (== 2)
+        w db
+  concurrently (run st1 w1) (run st2 w2)
+
+testConcurrentWrites :: IO ()
+testConcurrentWrites = withServiceStores $ \open -> do
+  st <- open
+  other <- open
+  forM_ [1 .. 25 :: Int] $ \n -> do
+    let tag = T.pack (show n)
+        spendSrc = "spend" <> tag
+        heldSrc = "held" <> tag
+        lateSrc = "late" <> tag
+    source st spendSrc 10000
+    (spent, refundedSpend) <-
+      together st other (\db -> createBalanceRegistration db (newReg ("c" <> tag) ownerA (fieldsN $ "c" <> tag)) (RegistrationId spendSrc) 6000 10000 t0) (\db -> refundBalance db (RegistrationId spendSrc) 10000 t0)
+    (n, isRight spent, refundedSpend) `shouldSatisfy` (\(_, a, b) -> a /= b)
+    fmap (\(amount, _, _, _) -> amount) <$> figures st spendSrc t0 `shouldReturn` Just (if refundedSpend then 0 else 4000)
+    invariantHolds st spendSrc
+    source st heldSrc 10000
+    holder st ("h" <> tag) heldSrc 10000 (at 60) `shouldReturn` Right ()
+    h <- reg st ("h" <> tag)
+    (n,) <$> together st other (`settleHolder` h) (\db -> refundBalance db (RegistrationId heldSrc) 10000 t0) `shouldReturn` (n, (True, False))
+    figures st heldSrc t0 `shouldReturn` Just (0, 10000, 0, Nothing)
+    invariantHolds st heldSrc
+    source st lateSrc 10000
+    (credited, refundedLate) <- together st other (\db -> creditLatePayment db (lateCredit lateSrc 1 (Just 50000) 3000) t0) (\db -> refundBalance db (RegistrationId lateSrc) 10000 t0)
+    credited `shouldBe` True
+    (n,) <$> figures st lateSrc t0 `shouldReturn` (n, Just $ if refundedLate then (3000, 13000, 10000, Nothing) else (13000, 13000, 0, Nothing))
+    invariantHolds st lateSrc
+#endif
diff --git a/tests/Bots/StoreService/NamesOrdersTests.hs b/tests/Bots/StoreService/NamesOrdersTests.hs
index dda413811c..32276434f7 100644
--- a/tests/Bots/StoreService/NamesOrdersTests.hs
+++ b/tests/Bots/StoreService/NamesOrdersTests.hs
@@ -35,7 +35,7 @@ where
 import Bots.StoreService.FakeBTCPay (FakeBTCPay (..), setInvoiceState, withFakeBTCPay)
 import Bots.StoreService.FakeEthNode
 import Bots.StoreService.NamesContractsTests (alice, answerRegistered, answerRegistrar, nameExpiresCall, noncesCall, registrarOf, rentPriceAnswer, rentPriceCall, reservedNamesCall, unhex)
-import Bots.StoreService.NamesStoreTests (order, ownerA, ownerB, placeCode, placePaid, t0)
+import Bots.StoreService.NamesStoreTests (btc, insertInvoiceRow, newReg, order, ownerA, ownerB, paidOrder, placeCode, placePaid, t0)
 import Bots.StoreService.WebTests
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (async, concurrently, wait)
@@ -88,7 +88,7 @@ import StoreService.Names.Phases (RegistrationId (..), awaitChange, newPhases)
 import StoreService.Names.Signatures (OrderFields (..), orderMessage, personalDigest)
 import StoreService.Names.Store
 import StoreService.Names.Turns (newTurns, withCodeTurn)
-import StoreService.Names.View (ViewReads (..), readViewChain, viewJSON)
+import StoreService.Names.View (ViewReads (..), readViewChain, registrationView, viewJSON)
 import StoreService.Orders (cancelOpenInvoice, expireOverdue, settleOrder)
 import StoreService.Poller (cleanupInterval, cleanupReadsPerPass, cleanupUnpaid, drainHints, newPollerEnv, newReadHints, queueReadHint, runOnePass, unpaidRetention)
 import StoreService.Providers.BTCPay (btcpayProvider)
@@ -170,6 +170,7 @@ namesOrdersTests = describe "StoreService names: orders" $ do
     it "has the contract's fields" testViewFields
     it "reads the intent nonce in committed and nothing in taken" testViewReads
     it "leaves a failed intentNonce read null and named in unread, reading nothing in taken" testViewUnread
+    it "reads the order's balance, held until its holder's invoice expires and free past it, and the cents its order took from another's" testViewBalance
 
 -- fixtures
 
@@ -937,7 +938,7 @@ testCodeNotReservable = withOrders $ \ctx@Ctx {cStore} -> do
   req <- fromJust . Orders.parseOrderRequest <$> signedBody (cRandom ctx) aliceOrder
   let new = NewRegistration {nrgId = RegistrationId "late", nrgOwner = ownerA, nrgOrder = fieldsOf aliceOrder, nrgYears = 2}
   forM_ [(reservedLate, CRReserved), (revokedLate, CRInvalid)] $ \(stale, refusal) -> do
-    placedOrder <- Orders.placeOrder (cOrders ctx) req (Orders.codeOrderInsert new stale)
+    placedOrder <- Orders.placeOrder (cOrders ctx) req [] (Orders.codeOrderInsert new stale)
     either Just (const Nothing) placedOrder `shouldBe` Just (Orders.ORCode refusal)
   length <$> registrationsOf ctx ownerA `shouldReturn` 0
 
@@ -1344,13 +1345,13 @@ 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 ViewReads {vrIntentNonce = Nothing, vrUnread = []}
+  let v = objectOf $ viewJSON (testNamesConfig node) r 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", "commitTx", "registerTx", "revealAfter", "revealBefore", "intentNonce", "unread", "expiresAt", "error"
+        "years", "duration", "price", "fromBalance", "balance", "commitTx", "registerTx", "revealAfter", "revealBefore", "intentNonce", "unread", "expiresAt", "error"
       ]
-  map (`field` v) ["id", "phase", "owner", "tld", "chainId", "linksRefused", "label", "unread", "sponsor"]
+  map (`field` v) ["id", "phase", "owner", "tld", "chainId", "linksRefused", "label", "unread", "sponsor", "fromBalance", "balance"]
     `shouldBe` map
       Just
       [ "r1",
@@ -1361,7 +1362,9 @@ testViewFields = withServiceStore $ \st -> withFakeEthNode $ \node -> do
         J.Bool False,
         J.Null,
         J.Array mempty,
-        J.String $ safeDecodeUtf8 $ strEncode fakeSponsor
+        J.String $ safeDecodeUtf8 $ strEncode fakeSponsor,
+        J.Number 0,
+        J.Null
       ]
 
 testViewReads :: IO ()
@@ -1388,5 +1391,35 @@ 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} (ViewReads Nothing ["intentNonce"])
+  let v = objectOf $ viewJSON (testNamesConfig node) r {nrPhase = PCommitted} Nothing (ViewReads Nothing ["intentNonce"])
   (field "intentNonce" v, field "unread" v) `shouldBe` (Just J.Null, Just (J.toJSON ["intentNonce" :: Text]))
+
+testViewBalance :: IO ()
+testViewBalance = withServiceStore $ \st -> withFakeEthNode $ \node -> do
+  g <- C.newRandom
+  ct <- newContracts TLDSimplex =<< newChainClient g (fakeChainConfig node)
+  let holderExpiry = addUTCTime 3600 t0
+      viewOf :: Text -> UTCTime -> IO J.Object
+      viewOf rid now = do
+        r <- withTransaction st $ \db -> fromJust <$> getRegistration db (RegistrationId rid)
+        objectOf <$> registrationView st (testNamesConfig node) ct now r
+      balanceOf :: J.Object -> (Maybe J.Value, Maybe J.Value)
+      balanceOf v = (field "balance" v, field "fromBalance" v)
+      balance :: Int -> Bool -> Maybe UTCTime -> Int -> J.Value
+      balance amount held heldUntil refunded = J.object ["amount" .= amount, "held" .= held, "heldUntil" .= heldUntil, "refunded" .= refunded]
+  Right () <- placePaid st "source" ownerA (order "alicebakery" 1) holderExpiry
+  withTransaction st $ \db -> creditBalance db (RegistrationId "source") 15000 t0
+  balanceOf <$> viewOf "source" t0 `shouldReturn` (Just $ balance 15000 False Nothing 0, Just $ J.Number 0)
+  Right () <- withTransaction st $ \db -> do
+    insertInvoiceRow db "inv-holder" holderExpiry "open"
+    let terms = OTBalance (RegistrationId "source") 20000 15000 (Just btc)
+    createPaidRegistration db (newReg "holder" ownerA (order "bobsbakery" 2)) terms (paidOrder "inv-holder") (Just $ HeldBalance (RegistrationId "source") 15000) t0
+  balanceOf <$> viewOf "source" t0 `shouldReturn` (Just $ balance 15000 True (Just holderExpiry) 0, Just $ J.Number 0)
+  balanceOf <$> viewOf "source" (addUTCTime 1 holderExpiry) `shouldReturn` (Just $ balance 15000 False Nothing 0, Just $ J.Number 0)
+  balanceOf <$> viewOf "holder" t0 `shouldReturn` (Just J.Null, Just $ J.Number 15000)
+  version <- nrVersion <$> withTransaction st (\db -> fromJust <$> getRegistration db (RegistrationId "source"))
+  withTransaction st (\db -> releaseHeldBalance db (RegistrationId "holder") t0) `shouldReturn` True
+  withTransaction st (\db -> refundBalance db (RegistrationId "source") 15000 t0) `shouldReturn` True
+  v <- viewOf "source" t0
+  balanceOf v `shouldBe` (Just $ balance 0 False Nothing 15000, Just $ J.Number 0)
+  field "version" v `shouldBe` Just (J.toJSON version)
diff --git a/tests/Bots/StoreService/NamesStoreTests.hs b/tests/Bots/StoreService/NamesStoreTests.hs
index 5dd5ad39f1..65b9f1198e 100644
--- a/tests/Bots/StoreService/NamesStoreTests.hs
+++ b/tests/Bots/StoreService/NamesStoreTests.hs
@@ -3,11 +3,12 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Bots.StoreService.NamesStoreTests (namesStoreTests, issue, order, ownerA, ownerB, placeCode, placePaid, reveal, t0, usable) where
+module Bots.StoreService.NamesStoreTests (namesStoreTests, at, btc, insertInvoiceRow, invoiceStatus, issue, newReg, order, ownerA, ownerB, paidOrder, placeCode, placePaid, price, reg, reveal, signature, t0, usable, write) where
 
 import Bots.StoreService.WebTests (columnsOf, digestFixture, runMigrations, withServiceStore)
 import Control.Arrow ((&&&))
 import Control.Monad (forM_, void)
+import Data.Int (Int64)
 import Data.List (sort)
 import Data.Maybe (fromJust, mapMaybe)
 import Data.Text (Text)
@@ -21,8 +22,8 @@ import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationsToRun (..), toDownMigration)
 import Simplex.Messaging.Crypto.Secp256k1 (RecoverableSignature)
-import Simplex.Messaging.Eth.Address (Address)
-import Simplex.Messaging.SimplexName (labelHash)
+import Simplex.Messaging.Eth.Address (Address, unAddress)
+import Simplex.Messaging.SimplexName (LabelHash (..), labelHash)
 import StoreService.Names.Chain (TxHash (..))
 import StoreService.Names.Phases (RegistrationId (..))
 import StoreService.Names.Signatures (OrderFields (..), parseAnyCaseAddress, parseSignature)
@@ -45,6 +46,7 @@ namesStoreTests = describe "StoreService names: store" $ do
     it "creates the names tables with the planned columns" testNamesColumns
     it "rolls back and re-applies only the names migrations, with rows in them, leaving the badge tables and paid invoices as they were" testNamesDownUp
     it "turns a code_issued order taken at price 0 and not live at its next version, dropping issued_code_id with its index and foreign key, which the down migration restores" testDropTakenCodes
+    it "makes taken orders not live and gives a taken paid order a balance of its price, none to a code order or a price of 0, and rolls back the balance tables and columns" testNameBalancesMigration
   describe "order hash" $ do
     it "is equal for the same order fields, and differs when any one field differs" testOrderHashFields
     it "keeps field boundaries, so moving a byte between two fields changes it" testOrderHashBoundaries
@@ -141,7 +143,7 @@ insertInvoiceRow db invId expiresAt status =
 placePaid :: DBStore -> Text -> Address -> OrderFields -> UTCTime -> IO (Either RegistrationRefused ())
 placePaid st rid owner o expiresAt = withTransaction st $ \db -> do
   insertInvoiceRow db ("inv-" <> rid) expiresAt "open"
-  createPaidRegistration db (newReg rid owner o) (paidOrder $ "inv-" <> rid) t0
+  createPaidRegistration db (newReg rid owner o) (OTInvoice btc price) (paidOrder $ "inv-" <> rid) Nothing t0
 
 issue :: DBStore -> Word8 -> NewPrepaidCode -> IO PrepaidCode
 issue st n c = withTransaction st $ \db -> do
@@ -161,7 +163,11 @@ write :: DBStore -> NameRegistration -> IO VersionWrite
 write st r = withTransaction st $ \db -> updateRegistration db r (at 1)
 
 namesTables :: [Text]
-namesTables = map ("sx_badge_service_name_" <>) ["prepaid_codes", "registrations", "invoices", "record_edits", "transactions"]
+namesTables = map ("sx_badge_service_name_" <>) ["prepaid_codes", "registrations", "invoices", "record_edits", "transactions", "balances", "late_credits"]
+
+-- | Added to the badge tables' payments by the names migrations.
+balancePaymentColumns :: [Text]
+balancePaymentColumns = ["confirmed_amount", "received_units", "confirmed_units", "invoice_rate"]
 
 badgeTables :: [Text]
 badgeTables = map ("sx_badge_service_" <>) ["invoices", "payments", "badge_prices", "badge_offers", "badge_purchases", "badge_ledger", "badge_issuances", "badge_codes", "badge_code_invoices", "group"]
@@ -175,9 +181,12 @@ testNamesColumns = withServiceStore $ \st -> do
     [ "registration_id", "label_hash", "length", "label", "secret", "contact_link", "channel_link", "intent_nonce", "intent_deadline", "intent_signature",
       "sealed", "owner", "commitment", "phase", "commit_tx", "commit_block", "register_tx", "register_block", "reveal_after", "reveal_before",
       "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"
+      "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"]
+  has "sx_badge_service_name_invoices" ["invoice_id", "registration_id", "provider_ref", "late_alerted_at", "late_alerted_units"]
+  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
   has "sx_badge_service_name_record_edits" ["label_hash", "owner", "nonce", "record_key", "record_value", "deadline", "signature", "body_hash", "state", "revert", "mined_tx", "created_at"]
   has "sx_badge_service_name_transactions" ["registration_id", "name_record_edit_id", "kind", "raw", "tx_hash", "registrar_nonce", "sent_at", "mined_block", "status"]
 
@@ -185,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"]
+  map name names `shouldBe` ["20261010_names", "20261022_drop_taken_codes", "20261022_name_balances"]
   badgeBefore <- badgeColumns
   code <- issue st 1 usable
   placeCode st "r1" ownerA (order "alicebakery" 1) code `shouldReturn` Right ()
@@ -195,7 +204,7 @@ testNamesDownUp = withServiceStore $ \st -> do
   runMigrations st $ MTRDown (mapMaybe toDownMigration names)
   mapM (columnsOf st) namesTables `shouldReturn` map (const []) namesTables
   mapM (invoiceCount st) ["inv-r2", "inv-r3"] `shouldReturn` [0, 1]
-  badgeColumns `shouldReturn` badgeBefore
+  badgeColumns `shouldReturn` map (filter (`notElem` balancePaymentColumns)) badgeBefore
   runMigrations st $ MTRUp names
   mapM (fmap null . columnsOf st) namesTables `shouldReturn` map (const False) namesTables
   badgeColumns `shouldReturn` badgeBefore
@@ -225,6 +234,53 @@ testDropTakenCodes = withServiceStore $ \st -> do
   worth <$> reg st "r1" `shouldReturn` (PTaken, 0, False, 2)
   withTransaction st (\db -> DB.execute db "UPDATE sx_badge_service_name_registrations SET issued_code_id = ? WHERE registration_id = 'r1'" (Only $ pcId code + 1)) `shouldThrow` foreignKeyViolation
 
+testNameBalancesMigration :: IO ()
+testNameBalancesMigration = withServiceStore $ \st -> do
+  let balances = [m | m@Migration {name = "20261022_name_balances"} <- storeServiceSchemaMigrations]
+      applied :: IO (Bool, Bool, Bool)
+      applied = (,,) <$> (not . null <$> columnsOf st "sx_badge_service_name_balances") <*> (elem "balance_source" <$> columnsOf st "sx_badge_service_name_registrations") <*> (elem "confirmed_units" <$> columnsOf st "sx_badge_service_payments")
+      live :: Text -> IO Bool
+      live rid = withTransaction st $ \db -> DB.query db "SELECT live FROM sx_badge_service_name_registrations WHERE registration_id = ?" (Only rid) >>= \case
+        [Only (DB.BI l)] -> pure l
+        rows -> fail $ "registration " <> show rid <> ": " <> show (length rows) <> " rows"
+      balanceOf :: Text -> IO (Maybe (Int, Int, Int, Maybe BalanceHold))
+      balanceOf rid = withTransaction st $ \db -> fmap (\Balance {blAmount, blCredited, blRefunded, blHold} -> (blAmount, blCredited, blRefunded, blHold)) <$> getBalance db (RegistrationId rid) t0
+  length balances `shouldBe` 1
+  runMigrations st $ MTRDown (mapMaybe toDownMigration balances)
+  applied `shouldReturn` (False, False, False)
+  code <- issue st 1 usable
+  withTransaction st $ \db -> do
+    insertInvoiceRow db "inv-paid" (at 60) "paid"
+    insertOldRegistration db "paid" 1 "taken" price Nothing (Just "inv-paid")
+    insertOldRegistration db "code" 2 "taken" 0 (Just $ pcId code) Nothing
+    insertInvoiceRow db "inv-converted" (at 60) "paid"
+    insertOldRegistration db "converted" 3 "taken" 0 Nothing (Just "inv-converted")
+    insertInvoiceRow db "inv-queued" (at 60) "paid"
+    insertOldRegistration db "queued" 4 "queued" price Nothing (Just "inv-queued")
+  runMigrations st $ MTRUp balances
+  applied `shouldReturn` (True, True, True)
+  mapM live ["paid", "code", "converted", "queued"] `shouldReturn` [False, False, False, True]
+  mapM balanceOf ["paid", "code", "converted", "queued"] `shouldReturn` [Just (price, price, 0, Nothing), Nothing, Nothing, Nothing]
+  runMigrations st $ MTRDown (mapMaybe toDownMigration balances)
+  applied `shouldReturn` (False, False, False)
+  mapM live ["paid", "queued"] `shouldReturn` [False, True]
+  runMigrations st $ MTRUp balances
+  balanceOf "paid" `shouldReturn` Just (price, price, 0, Nothing)
+
+-- | A registration row as the code before the balances wrote it, paid by the invoice or the code given.
+insertOldRegistration :: DB.Connection -> Text -> Word8 -> Text -> Int -> Maybe Int64 -> Maybe Text -> IO ()
+insertOldRegistration db rid n phase cents codeId invId = do
+  let OrderFields {ofLabelHash = LabelHash lh, ofLength, ofDuration, ofCommitment, ofSealed} = order ("alicebakery" <> rid) n
+  DB.execute
+    db
+    ( "INSERT INTO sx_badge_service_name_registrations (registration_id, version, label_hash, length, duration, owner, commitment, sealed, phase, years,"
+        <> " price, method, name_prepaid_code_id, live, order_hash, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?, ?,?,?,?,?,?,?)"
+    )
+    ( (rid, 1 :: Int, DB.Binary lh, ofLength, fromIntegral ofDuration :: Int64, DB.Binary $ unAddress ownerA, DB.Binary ofCommitment, ofSealed, phase, twoYears)
+        :. (cents, ("btc" :: Text) <$ invId, codeId, DB.BI True, DB.Binary $ digestFixture n, t0, t0)
+    )
+  mapM_ (\i -> DB.execute db "INSERT INTO sx_badge_service_name_invoices (invoice_id, registration_id, provider_ref, created_at) VALUES (?,?,?,?)" (i, rid, "ref-" <> i, t0)) invId
+
 testOrderHashFields :: IO ()
 testOrderHashFields = do
   let o = order "alicebakery" 1
@@ -270,6 +326,8 @@ testCreatePaid = withServiceStore $ \st -> do
         nrYears = twoYears,
         nrPrice = price,
         nrPayment = RPInvoice btc (InvoiceId "inv-r1"),
+        nrBalanceSource = Nothing,
+        nrBalanceUsed = 0,
         nrReveal = Nothing,
         nrCommitTx = Nothing,
         nrCommitBlock = Nothing,
@@ -359,7 +417,7 @@ testCloseOverdue = withServiceStore $ \st -> do
     [LiveOrder {loRegistration, loOverdue = True}] <- getLiveOrders db (ofCommitment o') ownerA (ofLabelHash o') (at 61)
     void $ closeOverdue db loRegistration (at 61)
     insertInvoiceRow db "inv-r2" (at 120) "open"
-    createPaidRegistration db (newReg "r2" ownerA o') (paidOrder "inv-r2") (at 61)
+    createPaidRegistration db (newReg "r2" ownerA o') (OTInvoice btc price) (paidOrder "inv-r2") Nothing (at 61)
   placed `shouldBe` Right ()
   old <- reg st "r1"
   (nrLive old, nrPhase old, nrVersion old) `shouldBe` (False, PUnpaid, 2)
@@ -552,7 +610,7 @@ testFind = withServiceStore $ \st -> do
     let rid = "r" <> T.pack (show i)
         o = order ("alicebakery" <> T.pack (show i)) (fromIntegral i)
     insertInvoiceRow db ("inv-" <> rid) (at 60) "open"
-    createPaidRegistration db (newReg rid ownerA o) (paidOrder $ "inv-" <> rid) (at i) `shouldReturn` Right ()
+    createPaidRegistration db (newReg rid ownerA o) (OTInvoice btc price) (paidOrder $ "inv-" <> rid) Nothing (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]]
@@ -611,7 +669,7 @@ testUnpaidCleanup = withServiceStore $ \st -> do
   void $ write st r {nrPhase = PQueued}
   candidates <- withTransaction st $ \db -> unpaidCleanupCandidates db (at 61)
   map (\(RegistrationId rid, InvoiceId invId) -> (rid, invId)) candidates `shouldBe` [("old", "inv-old")]
-  withTransaction st (\db -> mapM (deleteUnpaidRegistration db . RegistrationId) ["old", "funded", "queued"]) `shouldReturn` [True, False, False]
+  withTransaction st (\db -> mapM (deleteUnpaidRegistration db . RegistrationId) ["old", "funded", "queued"]) `shouldReturn` [Right (), Left CKPaid, Left CKPaid]
   withTransaction st (\db -> getRegistration db (RegistrationId "old")) `shouldReturn` Nothing
   invoiceCount st "inv-old" `shouldReturn` 0
   invoiceCount st "inv-funded" `shouldReturn` 1
diff --git a/tests/Bots/StoreService/WebTests.hs b/tests/Bots/StoreService/WebTests.hs
index 5728cc3365..03e0d7c07e 100644
--- a/tests/Bots/StoreService/WebTests.hs
+++ b/tests/Bots/StoreService/WebTests.hs
@@ -8,6 +8,7 @@
 module Bots.StoreService.WebTests
   ( badgeWebTests,
     withServiceStore,
+    withServiceStores,
     columnsOf,
     runMigrations,
     digestFixture,
@@ -67,7 +68,7 @@ import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (toLower)
 import Data.Either (isLeft)
-import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
+import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef)
 import Data.Int (Int64)
 import Data.List (isInfixOf, sort, sortOn)
 import qualified Data.Map.Strict as Map
@@ -122,32 +123,37 @@ import Simplex.Messaging.Agent.Store.DB (TrackQueries (..))
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 #endif
 
-#if defined(dbPostgres)
 withServiceStore :: (DBStore -> IO a) -> IO a
-withServiceStore action = do
+withServiceStore action = withServiceStores (>>= action)
+
+-- | Each store the action opens is a new one over the same test database, as a restarted service opens; all are closed at the end.
+withServiceStores :: (IO DBStore -> IO a) -> IO a
+withServiceStores action = withServiceDBOpts $ \opts -> do
+  opened <- newIORef []
+  let open = do
+        Right st <- createDBStore opts storeServiceSchemaMigrations (MigrationConfig MCError Nothing)
+        st <$ modifyIORef' opened (st :)
+  action open `E.finally` (readIORef opened >>= mapM_ closeDBStore)
+
+withServiceDBOpts :: (DBOpts -> IO a) -> IO a
+#if defined(dbPostgres)
+withServiceDBOpts action = do
   n <- atomicModifyIORef' serviceSchemaCounter (\i -> (i + 1, i))
-  Right st <- createDBStore (serviceDBOpts n) storeServiceSchemaMigrations (MigrationConfig MCError Nothing)
-  action st `E.finally` closeDBStore st
-  where
-    serviceDBOpts :: Int -> DBOpts
-    serviceDBOpts n =
-      DBOpts
-        { connstr = BC.pack testDBConnstr,
-          schema = "sx_badge_service_web_test_" <> BC.pack (show n),
-          poolSize = 4,
-          createSchema = True
-        }
+  action
+    DBOpts
+      { connstr = BC.pack testDBConnstr,
+        schema = "sx_badge_service_web_test_" <> BC.pack (show n),
+        poolSize = 4,
+        createSchema = True
+      }
 
 serviceSchemaCounter :: IORef Int
 serviceSchemaCounter = unsafePerformIO $ newIORef 0
 {-# NOINLINE serviceSchemaCounter #-}
 #else
-withServiceStore :: (DBStore -> IO a) -> IO a
-withServiceStore action = do
+withServiceDBOpts action = do
   createDirectoryIfMissing True "tests/tmp"
-  withTempDirectory "tests/tmp" "badge-web" $ \dir -> do
-    Right st <- createDBStore (DBOpts (dir </> "badge_service_test.db") [] "" False True TQOff) storeServiceSchemaMigrations (MigrationConfig MCError Nothing)
-    action st `E.finally` closeDBStore st
+  withTempDirectory "tests/tmp" "badge-web" $ \dir -> action (DBOpts (dir </> "badge_service_test.db") [] "" False True TQOff)
 #endif
 
 columnsOf :: DBStore -> Text -> IO [Text]
diff --git a/tests/Test.hs b/tests/Test.hs
index 149fb7413e..ceccb86c99 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -10,6 +10,7 @@ import Bots.StoreService.ConfigTests
 import Bots.StoreService.GroupIntegrationTests
 import Bots.StoreService.GroupTests
 import Bots.StoreService.NameRegistrationTests
+import Bots.StoreService.NamesBalancesTests
 import Bots.StoreService.NamesChainTests
 import Bots.StoreService.NamesCodesTests
 import Bots.StoreService.NamesContractsTests
@@ -104,6 +105,7 @@ main = do
         badgeStripeTests
         badgeNameRegistrationTests
       namesConfigTests
+      namesBalancesTests
       namesChainTests
       namesCodesTests
       namesContractsTests

From 98d9772b5e8e94829b4a4a4c902088beb5d64da4 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:29:15 +0000
Subject: [PATCH 04/13] store: record a balance's refund

---
 .../src/StoreService/Names/Balances.hs        | 55 +++++++++++++++++++
 simplex-chat.cabal                            |  2 +
 tests/Bots/StoreService/NamesBalancesTests.hs | 28 ++++++++++
 3 files changed, 85 insertions(+)
 create mode 100644 apps/simplex-store-service/src/StoreService/Names/Balances.hs

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

From 36f101891e5f89b1f7c0cf99b586374e6681df32 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:43:31 +0000
Subject: [PATCH 05/13] store: close only an overdue holder

---
 .../src/StoreService/Names/Store.hs              |  6 +++---
 tests/Bots/StoreService/NamesBalancesTests.hs    | 16 ++++++++++++++++
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index 3774275f33..cddd7e9486 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -650,7 +650,7 @@ unfunded :: Query
 unfunded = unfundedQuery "i.invoice_id"
 
 -- | Run in the transaction that inserts the next order, so the unique constraints let it in; the registration's new version.
--- Nothing when the order changed since it was read, or its invoice is no longer open or holds money: the caller rolls back,
+-- Nothing when the order changed since it was read, or its invoice is no longer open, not past its expiry, or holds money: the caller rolls back,
 -- since the invoice is written before the registration, as settlement, cancel and the sweep write them. A balance it held is released.
 closeOverdue :: DB.Connection -> NameRegistration -> UTCTime -> IO (Maybe Int64)
 closeOverdue db r@NameRegistration {nrId = regId@(RegistrationId rid), nrVersion, nrPayment} now = do
@@ -668,12 +668,12 @@ closeOverdue db r@NameRegistration {nrId = regId@(RegistrationId rid), nrVersion
             SELECT i.invoice_id FROM sx_badge_service_name_invoices ni
             JOIN sx_badge_service_name_registrations r ON r.registration_id = ni.registration_id
             JOIN sx_badge_service_invoices i ON i.invoice_id = ni.invoice_id
-            WHERE ni.registration_id = ? AND r.version = ? AND r.live = 1
+            WHERE ni.registration_id = ? AND r.version = ? AND r.live = 1 AND i.expires_at < ?
         |]
           <> unfunded
           <> " )"
       )
-      (invoiceStatusText ISExpired, truncateToSecond now, invoiceStatusText ISOpen, rid, nrVersion)
+      (invoiceStatusText ISExpired, truncateToSecond now, invoiceStatusText ISOpen, rid, nrVersion, truncateToSecond now)
   if expired > 0
     then
       updateRegistration db r {nrLive = False} now >>= \case
diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs
index 7236eb839e..fc5a5b66f2 100644
--- a/tests/Bots/StoreService/NamesBalancesTests.hs
+++ b/tests/Bots/StoreService/NamesBalancesTests.hs
@@ -71,6 +71,7 @@ namesBalancesTests = describe "StoreService names: balances" $ do
     it "releases a hold at a cancel, the sweep's expiry, settlement's expiry and the next order's close" testClosesRelease
     it "reads an overdue holder's hold as none, and closes it in the transaction of the order placed" testOverdueHolderClosed
     it "skips a named holder no longer live, and refuses with the balance when a live one cannot be closed" testNamedHolders
+    it "refuses with the balance a named holder whose invoice has not expired, leaving it open and holding" testNamedHolderNotDue
     it "keeps at the cleanup, and logs, an unpaid order still holding a balance" testCleanupKeepsHolder
   describe "refunds" $ do
     it "refuses no order, no balance, a balance held by an open or overdue holder, and another amount, then records one with its chain" testRecordRefund
@@ -498,6 +499,21 @@ testNamedHolders = withOrders $ \Ctx {cStore = st, cOrders, cWeb} -> do
   nrLive <$> reg st "h2" `shouldReturn` True
   invoiceStatus st "inv-h2" `shouldReturn` "open"
 
+testNamedHolderNotDue :: IO ()
+testNamedHolderNotDue = withOrders $ \Ctx {cStore = st, cOrders} -> do
+  now <- oeNow cOrders
+  let expiry = addUTCTime 600 now
+  source st "s" 10000
+  holder st "h" "s" 10000 expiry `shouldReturn` Right ()
+  h <- reg st "h"
+  Just held <- withTransaction st $ \db -> getBalance db (RegistrationId "s") now
+  blHold held `shouldBe` Just (hold "h" expiry False)
+  closedIds <$> Orders.placeOrder cOrders (orderRequest "c") [h] (spendInsert "c" "s" 6000 10000) `shouldReturn` Left (ORBalanceChanged $ Just held)
+  absent st "c"
+  invoiceStatus st "inv-h" `shouldReturn` "open"
+  nrLive <$> reg st "h" `shouldReturn` True
+  figures st "s" now `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" expiry False)
+
 testCleanupKeepsHolder :: IO ()
 testCleanupKeepsHolder = withOrders $ \Ctx {cStore = st, cWeb} -> do
   source st "s" 10000

From f8706902154f77accc7441910b035aa1b0676417 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:43:31 +0000
Subject: [PATCH 06/13] store: refuse balance writes of 0 or fewer cents

---
 .../src/StoreService/Names/Store.hs           | 18 ++++++++--------
 .../StoreService/Store/Postgres/Migrations.hs |  6 +++---
 .../StoreService/Store/SQLite/Migrations.hs   |  6 +++---
 tests/Bots/StoreService/NamesBalancesTests.hs | 21 +++++++++++++++++++
 4 files changed, 36 insertions(+), 15 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index cddd7e9486..938db09348 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -934,32 +934,32 @@ creditBalance db (RegistrationId rid) cents now' =
   where
     now = truncateToSecond now'
 
--- | The price spent at once, where the amount is the one seen and nothing holds it.
+-- | The price, above 0, spent at once, where the amount is the one seen and nothing holds it.
 spendBalance :: DB.Connection -> RegistrationId -> Int -> Int -> UTCTime -> IO Bool
 spendBalance db (RegistrationId rid) price seen now =
   (> 0)
     <$> executeChanging
       db
-      "UPDATE sx_badge_service_name_balances SET amount = amount - ?, updated_at = ? WHERE registration_id = ? AND amount = ? AND amount >= ? AND reserved_by IS NULL"
-      (price, now, rid, seen, price)
+      "UPDATE sx_badge_service_name_balances SET amount = amount - ?, updated_at = ? WHERE registration_id = ? AND amount = ? AND amount >= ? AND ? > 0 AND reserved_by IS NULL"
+      (price, now, rid, seen, price, price)
 
--- | Held by a difference order, where the amount is the one seen and nothing holds it.
+-- | Held by a difference order, where the amount is the one seen, above 0, and nothing holds it.
 holdBalance :: DB.Connection -> RegistrationId -> Int -> RegistrationId -> UTCTime -> IO Bool
 holdBalance db (RegistrationId rid) seen (RegistrationId holder) now =
   (> 0)
     <$> executeChanging
       db
-      "UPDATE sx_badge_service_name_balances SET reserved_by = ?, updated_at = ? WHERE registration_id = ? AND amount = ? AND reserved_by IS NULL"
-      (holder, now, rid, seen)
+      "UPDATE sx_badge_service_name_balances SET reserved_by = ?, updated_at = ? WHERE registration_id = ? AND amount = ? AND ? > 0 AND reserved_by IS NULL"
+      (holder, now, rid, seen, seen)
 
--- | The holder's hold spent and cleared, where this holder holds the balance and it still has the cents.
+-- | The holder's hold spent and cleared, where this holder holds the balance and it still has the cents, above 0.
 spendHeldBalance :: DB.Connection -> RegistrationId -> Int -> UTCTime -> IO Bool
 spendHeldBalance db (RegistrationId holder) used now =
   (> 0)
     <$> executeChanging
       db
-      "UPDATE sx_badge_service_name_balances SET amount = amount - ?, reserved_by = NULL, updated_at = ? WHERE reserved_by = ? AND amount >= ?"
-      (used, truncateToSecond now, holder, used)
+      "UPDATE sx_badge_service_name_balances SET amount = amount - ?, reserved_by = NULL, updated_at = ? WHERE reserved_by = ? AND amount >= ? AND ? > 0"
+      (used, truncateToSecond now, holder, used, used)
 
 releaseHeldBalance :: DB.Connection -> RegistrationId -> UTCTime -> IO Bool
 releaseHeldBalance db (RegistrationId holder) now =
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 dd84b69896..4690968ec4 100644
--- a/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
+++ b/apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs
@@ -365,8 +365,8 @@ m20261022_name_balances =
 CREATE TABLE @name_balances(
   registration_id TEXT NOT NULL PRIMARY KEY REFERENCES @name_registrations,
   amount INTEGER NOT NULL CHECK (amount >= 0),
-  credited INTEGER NOT NULL DEFAULT 0,
-  refunded INTEGER NOT NULL DEFAULT 0,
+  credited INTEGER NOT NULL DEFAULT 0 CHECK (credited >= 0),
+  refunded INTEGER NOT NULL DEFAULT 0 CHECK (refunded >= 0),
   reserved_by TEXT REFERENCES @name_registrations,
   refunded_at TIMESTAMPTZ,
   created_at TIMESTAMPTZ NOT NULL,
@@ -402,7 +402,7 @@ CREATE TABLE @name_late_credits(
   invoice_rate TEXT,
   current_rate TEXT,
   rate_used TEXT,
-  cents INTEGER NOT NULL,
+  cents INTEGER NOT NULL CHECK (cents >= 0),
   created_at TIMESTAMPTZ NOT NULL,
   UNIQUE(invoice_id, credit_no)
 );
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 863edbb380..aba4d5bee1 100644
--- a/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
+++ b/apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs
@@ -367,8 +367,8 @@ m20261022_name_balances =
 CREATE TABLE @name_balances(
   registration_id TEXT NOT NULL PRIMARY KEY REFERENCES @name_registrations,
   amount INTEGER NOT NULL CHECK (amount >= 0),
-  credited INTEGER NOT NULL DEFAULT 0,
-  refunded INTEGER NOT NULL DEFAULT 0,
+  credited INTEGER NOT NULL DEFAULT 0 CHECK (credited >= 0),
+  refunded INTEGER NOT NULL DEFAULT 0 CHECK (refunded >= 0),
   reserved_by TEXT REFERENCES @name_registrations,
   refunded_at TEXT,
   created_at TEXT NOT NULL,
@@ -404,7 +404,7 @@ CREATE TABLE @name_late_credits(
   invoice_rate TEXT,
   current_rate TEXT,
   rate_used TEXT,
-  cents INTEGER NOT NULL,
+  cents INTEGER NOT NULL CHECK (cents >= 0),
   created_at TEXT NOT NULL,
   UNIQUE(invoice_id, credit_no)
 ) STRICT;
diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs
index fc5a5b66f2..d22e0bf57e 100644
--- a/tests/Bots/StoreService/NamesBalancesTests.hs
+++ b/tests/Bots/StoreService/NamesBalancesTests.hs
@@ -58,6 +58,7 @@ namesBalancesTests = describe "StoreService names: balances" $ do
     it "lets one of two difference orders hold a balance, the losing order not written" testTwoHolds
     it "spends a hold only for its holder and while the amount covers it, clearing the hold" testSpendHeld
     it "releases a hold only for its holder" testRelease
+    it "refuses spends, holds and held spends of 0 or fewer cents, and negative credits, refunds and late credits" testNoNegativeCents
     it "refunds a balance only at its amount, above 0 and not held, refused while held and accepted once released" testRefund
     it "keeps amount = credited - spent - refunded over spends at once, a held spend, a released hold and a refund, spent counting orders past unpaid" testInvariant
     it "keeps the invariant over credit, refund, credit, refund, refunded the sum" testCreditRefundTwice
@@ -305,6 +306,26 @@ testRelease = withServiceStore $ \st -> do
   figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
   release st "h" `shouldReturn` False
 
+testNoNegativeCents :: IO ()
+testNoNegativeCents = withServiceStore $ \st -> do
+  source st "s" 10000
+  mapM (\(r, cents) -> coveredSpend st r "s" cents 10000) [("c0", 0), ("c1", -1)] `shouldReturn` replicate 2 (Left RRBalanceChanged)
+  mapM_ (absent st) ["c0", "c1"]
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Nothing)
+  holder st "h" "s" 10000 (at 60) `shouldReturn` Right ()
+  mapM (\used -> withTransaction st $ \db -> spendHeldBalance db (RegistrationId "h") used t0) [0, -1] `shouldReturn` [False, False]
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" (at 60) False)
+  source st "z" 0
+  holder st "hz" "z" 0 (at 60) `shouldReturn` Left RRBalanceChanged
+  figures st "z" t0 `shouldReturn` Just (0, 0, 0, Nothing)
+  placeOrderRow st "x" False 20000 (at 60)
+  credit st "x" 5000
+  creditLate st (lateCredit "x" 1 Nothing (-1)) `shouldThrow` anyException
+  figures st "x" t0 `shouldReturn` Just (5000, 5000, 0, Nothing)
+  forM_ ["credited", "refunded"] $ \column ->
+    withTransaction st (\db -> DB.execute_ db $ "UPDATE sx_badge_service_name_balances SET " <> column <> " = -1 WHERE registration_id = 's'") `shouldThrow` anyException
+  figures st "s" t0 `shouldReturn` Just (10000, 10000, 0, Just $ hold "h" (at 60) False)
+
 testRefund :: IO ()
 testRefund = withServiceStore $ \st -> do
   source st "s" 10000

From f91832528e7e6d02705ba005996cea3f19f35801 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:43:35 +0000
Subject: [PATCH 07/13] store: alert again on more uncounted money

---
 .../src/StoreService/Names/Store.hs                 |  6 +++---
 tests/Bots/StoreService/NamesBalancesTests.hs       | 13 +++++++++++++
 2 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index 938db09348..bd6ee97449 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -1039,9 +1039,9 @@ pendingCase =
   where
     literal p = fromString $ "'" <> T.unpack (textEncode p) <> "'"
 
--- | What an alert names as received: cents for card, units for crypto.
+-- | What an alert names as received: units for crypto, and cents for card or for crypto that could not be counted in units.
 receivedFigure :: Query
-receivedFigure = " CASE WHEN" <> cardInvoice <> " THEN p.amount ELSE p.received_units END"
+receivedFigure = " CASE WHEN" <> cardInvoice <> " THEN p.amount ELSE COALESCE(p.received_units, p.amount) END"
 
 lateColumns :: Query
 lateColumns =
@@ -1112,7 +1112,7 @@ lateAlertDue db cutoff =
         <> pendingCase
         <> " IS NOT NULL AND (ni.late_alerted_at IS NULL OR"
         <> receivedFigure
-        <> " > ni.late_alerted_units) ORDER BY p.created_at, ni.invoice_id"
+        <> " > COALESCE(ni.late_alerted_units, -1)) ORDER BY p.created_at, ni.invoice_id"
     )
     (PUnpaid, truncateToSecond cutoff)
     >>= decodeAll toAlert
diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs
index d22e0bf57e..570875a1d4 100644
--- a/tests/Bots/StoreService/NamesBalancesTests.hs
+++ b/tests/Bots/StoreService/NamesBalancesTests.hs
@@ -81,6 +81,7 @@ namesBalancesTests = describe "StoreService names: balances" $ do
     it "tells each case of pending money and selects confirmed money not all credited, by the order whatever the invoice's status" testLateScans
     it "leaves 0.1 and 0.2 BTC credited against 0.3 confirmed neither pending nor selected" testExactUnits
     it "alerts on pending money past the cutoff once, again only when more arrives, claimed by one of two instances" testLateAlerts
+    it "alerts again on money that could not be counted in units when more of it arrives" testUncountedAlertRepeats
   describe "turns" $ do
     it "runs two holders of one balance one after the other, and nests in a label turn" testBalanceTurn
 #if defined(dbPostgres)
@@ -667,6 +668,18 @@ testLateAlerts = withServiceStore $ \st -> do
   due `shouldReturn` []
   map marks <$> withTransaction st (\db -> lateAlertDue db (at 180)) `shouldReturn` [(InvoiceId "inv-new", LPUnconfirmed, Just 300000, Nothing, Nothing)]
 
+testUncountedAlertRepeats :: IO ()
+testUncountedAlertRepeats = withServiceStore $ \st -> do
+  closedWith st "x" False (cryptoPaid 0 0) {pCents = 5000, pUnits = Nothing} t0
+  let due :: IO [LateAlert]
+      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
+  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)]
+
 -- turns
 
 testBalanceTurn :: IO ()

From c259e6382794a00faaeed8a463edc761f4a0a8c7 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:43:46 +0000
Subject: [PATCH 08/13] store: tell uncredited money before confirming

---
 apps/simplex-store-service/src/StoreService/Names/Store.hs | 5 +++--
 tests/Bots/StoreService/NamesBalancesTests.hs              | 7 +++++++
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index bd6ee97449..6676149e6c 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -1028,10 +1028,11 @@ uncreditedMoney =
     <> " OR (" <> cryptoInvoice <> " AND p.confirmed_units >" <> creditedTotal "units" <> "))"
 
 -- | Why a closed order's money is not all credited, by the first case that holds, else NULL.
+-- Confirmed money waiting comes first, so its alert never asks for a refund by hand.
 pendingCase :: Query
 pendingCase =
-  " CASE WHEN COALESCE(p.amount, 0) = 0 AND (p.crypto_paid IS NOT NULL OR p.paid_in_full = 1) THEN " <> literal LPConfirming
-    <> " WHEN" <> uncreditedMoney <> " THEN " <> literal LPUncredited
+  " CASE WHEN" <> uncreditedMoney <> " THEN " <> literal LPUncredited
+    <> " WHEN COALESCE(p.amount, 0) = 0 AND (p.crypto_paid IS NOT NULL OR p.paid_in_full = 1) THEN " <> literal LPConfirming
     <> " WHEN" <> cardInvoice <> " AND COALESCE(p.amount, 0) > p.confirmed_amount THEN " <> literal LPUnconfirmed
     <> " WHEN p.received_units > p.confirmed_units THEN " <> literal LPUnconfirmed
     <> " WHEN" <> cryptoInvoice <> " AND p.received_units IS NULL AND COALESCE(p.amount, 0) > 0 THEN " <> literal LPUncounted
diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs
index 570875a1d4..df038532a7 100644
--- a/tests/Bots/StoreService/NamesBalancesTests.hs
+++ b/tests/Bots/StoreService/NamesBalancesTests.hs
@@ -80,6 +80,7 @@ namesBalancesTests = describe "StoreService names: balances" $ do
     it "credits a late payment once per credit number, a taken number changing neither the rows nor the balance" testCreditLatePayment
     it "tells each case of pending money and selects confirmed money not all credited, by the order whatever the invoice's status" testLateScans
     it "leaves 0.1 and 0.2 BTC credited against 0.3 confirmed neither pending nor selected" testExactUnits
+    it "tells confirmed money not credited as such while its cents still read 0, as Monero's can" testConfirmedBeforeCents
     it "alerts on pending money past the cutoff once, again only when more arrives, claimed by one of two instances" testLateAlerts
     it "alerts again on money that could not be counted in units when more of it arrives" testUncountedAlertRepeats
   describe "turns" $ do
@@ -640,6 +641,12 @@ testExactUnits = withServiceStore $ \st -> do
   withTransaction st uncreditedLateInvoices `shouldReturn` []
   fmap lsCreditedUnits <$> withTransaction st (\db -> lateCreditState db (InvoiceId "inv-x")) `shouldReturn` Just 30000000
 
+testConfirmedBeforeCents :: IO ()
+testConfirmedBeforeCents = withServiceStore $ \st -> do
+  closedWith st "x" False Paid {pCents = 0, pConfirmedCents = 0, pCrypto = Just "0", pUnits = Just 1000000000000, pConfirmedUnits = Just 1000000000000, pInFull = True} t0
+  withTransaction st (\db -> latePending db (InvoiceId "inv-x")) `shouldReturn` Just LPUncredited
+  withTransaction st uncreditedLateInvoices `shouldReturn` [InvoiceId "inv-x"]
+
 testLateAlerts :: IO ()
 testLateAlerts = withServiceStore $ \st -> do
   closedWith st "old" False (cryptoPaid 300000 0) t0

From 154bedd63010f1823aed9e8f6759996a011a8038 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:43:53 +0000
Subject: [PATCH 09/13] store: read no confirmed units as 0

---
 apps/simplex-store-service/src/StoreService/Names/Store.hs | 2 +-
 tests/Bots/StoreService/NamesBalancesTests.hs              | 6 ++++++
 2 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index 6676149e6c..5d091a828c 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -1034,7 +1034,7 @@ pendingCase =
   " CASE WHEN" <> uncreditedMoney <> " THEN " <> literal LPUncredited
     <> " WHEN COALESCE(p.amount, 0) = 0 AND (p.crypto_paid IS NOT NULL OR p.paid_in_full = 1) THEN " <> literal LPConfirming
     <> " WHEN" <> cardInvoice <> " AND COALESCE(p.amount, 0) > p.confirmed_amount THEN " <> literal LPUnconfirmed
-    <> " WHEN p.received_units > p.confirmed_units THEN " <> literal LPUnconfirmed
+    <> " WHEN p.received_units > COALESCE(p.confirmed_units, 0) THEN " <> literal LPUnconfirmed
     <> " WHEN" <> cryptoInvoice <> " AND p.received_units IS NULL AND COALESCE(p.amount, 0) > 0 THEN " <> literal LPUncounted
     <> " END"
   where
diff --git a/tests/Bots/StoreService/NamesBalancesTests.hs b/tests/Bots/StoreService/NamesBalancesTests.hs
index df038532a7..68cde59f07 100644
--- a/tests/Bots/StoreService/NamesBalancesTests.hs
+++ b/tests/Bots/StoreService/NamesBalancesTests.hs
@@ -81,6 +81,7 @@ namesBalancesTests = describe "StoreService names: balances" $ do
     it "tells each case of pending money and selects confirmed money not all credited, by the order whatever the invoice's status" testLateScans
     it "leaves 0.1 and 0.2 BTC credited against 0.3 confirmed neither pending nor selected" testExactUnits
     it "tells confirmed money not credited as such while its cents still read 0, as Monero's can" testConfirmedBeforeCents
+    it "reads crypto received with no confirmed figure as unconfirmed" testNoConfirmedFigure
     it "alerts on pending money past the cutoff once, again only when more arrives, claimed by one of two instances" testLateAlerts
     it "alerts again on money that could not be counted in units when more of it arrives" testUncountedAlertRepeats
   describe "turns" $ do
@@ -647,6 +648,11 @@ testConfirmedBeforeCents = withServiceStore $ \st -> do
   withTransaction st (\db -> latePending db (InvoiceId "inv-x")) `shouldReturn` Just LPUncredited
   withTransaction st uncreditedLateInvoices `shouldReturn` [InvoiceId "inv-x"]
 
+testNoConfirmedFigure :: IO ()
+testNoConfirmedFigure = withServiceStore $ \st -> do
+  closedWith st "x" False (cryptoPaid 300000 0) {pConfirmedUnits = Nothing} t0
+  withTransaction st (\db -> latePending db (InvoiceId "inv-x")) `shouldReturn` Just LPUnconfirmed
+
 testLateAlerts :: IO ()
 testLateAlerts = withServiceStore $ \st -> do
   closedWith st "old" False (cryptoPaid 300000 0) t0

From 1d5100b5abb611be683deff8c705457bbfa3272b Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:46:54 +0000
Subject: [PATCH 10/13] store: take a difference order's hold from its terms

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

From 2337b52721afb56384c1df141956d971912a0ddf Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:47:03 +0000
Subject: [PATCH 11/13] store: list code order refusals explicitly

---
 apps/simplex-store-service/src/StoreService/Names/Orders.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Orders.hs b/apps/simplex-store-service/src/StoreService/Names/Orders.hs
index eb557138f3..bedf470508 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Orders.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Orders.hs
@@ -238,8 +238,10 @@ codeOrderInsert :: NewRegistration -> PrepaidCode -> DB.Connection -> UTCTime ->
 codeOrderInsert new@NewRegistration {nrgId, nrgOrder = OrderFields {ofLength}} code@PrepaidCode {pcCodeHash} db now =
   createCodeRegistration db new code now >>= \case
     Right () -> pure $ Right ()
+    Left RRLiveOrder -> pure $ Left OROrderExists
     Left RRCodeNotReservable -> Left . ORCode <$> reserveRefusal db now pcCodeHash nrgId ofLength
-    Left _ -> pure $ Left OROrderExists
+    -- a code order holds no balance
+    Left RRBalanceChanged -> pure $ Left OROrderExists
 
 checkTimestamp :: UTCTime -> Word64 -> Either OrderRefusal ()
 checkTimestamp now timestamp =

From bd7fd020aa09664f5c163ece0e43b1373ce995b5 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:47:19 +0000
Subject: [PATCH 12/13] store: retry a refund refused by a late credit

---
 .../src/StoreService/Names/Balances.hs                | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Balances.hs b/apps/simplex-store-service/src/StoreService/Names/Balances.hs
index 52f534614d..2e164ff5be 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Balances.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Balances.hs
@@ -8,7 +8,6 @@ module StoreService.Names.Balances
   )
 where
 
-import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
@@ -34,9 +33,9 @@ recordRefund :: Turns -> DBStore -> Text -> Int -> UTCTime -> IO (Either RefundR
 recordRefund turns st ref cents now =
   withTransaction st (\db -> balanceByReference db ref now) >>= \case
     Nothing -> pure $ Left RefundNoOrder
-    Just (rid, _) -> withBalanceTurn turns rid $ withTransaction st refund
+    Just (rid, _) -> withBalanceTurn turns rid $ withTransaction st (refund True)
   where
-    refund db =
+    refund retry db =
       balanceByReference db ref now >>= \case
         Nothing -> pure $ Left RefundNoOrder
         Just (rid, balance) -> case refusal balance of
@@ -44,8 +43,10 @@ recordRefund turns st ref cents now =
           Nothing ->
             refundBalance db rid cents now >>= \case
               True -> Right . RefundRecord rid cents <$> balanceChain db rid
-              -- only a writer outside the turn, as a late credit, can change the balance between the read and the write
-              False -> Left . fromMaybe (RefundAmount cents) . refusal . (snd =<<) <$> balanceByReference db ref now
+              -- only a writer outside the turn, as a late credit, changes the balance between the read and the write, so it is read again once
+              False
+                | retry -> refund False db
+                | otherwise -> pure $ Left $ RefundAmount $ maybe 0 blAmount balance
     refusal :: Maybe Balance -> Maybe RefundRefusal
     refusal = \case
       Nothing -> Just RefundNoBalance

From e8911221fb999e7338482230ae7fed09e73c162b Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Thu, 22 Oct 2026 13:47:19 +0000
Subject: [PATCH 13/13] store: space insertPrepaidCode's signature

---
 apps/simplex-store-service/src/StoreService/Names/Store.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/apps/simplex-store-service/src/StoreService/Names/Store.hs b/apps/simplex-store-service/src/StoreService/Names/Store.hs
index 860ab972bc..e5bd7a038a 100644
--- a/apps/simplex-store-service/src/StoreService/Names/Store.hs
+++ b/apps/simplex-store-service/src/StoreService/Names/Store.hs
@@ -1137,7 +1137,7 @@ claimLateAlert db LateAlert {laState = LateCreditState {lsInvoice = InvoiceId in
       )
       (truncateToSecond now, laReceived, invId, laAlertedAt, laAlertedReceived)
 
-insertPrepaidCode ::DB.Connection -> NewPrepaidCode -> UTCTime -> IO (Either CodeHashTaken Int64)
+insertPrepaidCode :: DB.Connection -> NewPrepaidCode -> UTCTime -> IO (Either CodeHashTaken Int64)
 insertPrepaidCode db NewPrepaidCode {npcCodeHash, npcMinLength, npcYears, npcPaymentStatus, npcExpiresAt} now = do
   inserted <-
     executeChanging