store: merge balance storage

2026-11-04 06:32:59 +00:00 · 2026-10-22 13:56:31 +00:00
commit ba65a718fa
@@ -0,0 +1,56 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module StoreService.Names.Balances
+  ( RefundRefusal (..),
+    RefundRecord (..),
+    recordRefund,
+  )
+where
+
+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 True)
+  where
+    refund retry 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, 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
+      Just Balance {blHold = Just hold} -> Just $ RefundHeld hold
+      Just Balance {blAmount}
+        | blAmount /= cents || blAmount <= 0 -> Just $ RefundAmount blAmount
+        | otherwise -> Nothing
@@ -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,7 +231,7 @@ 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 ())
@@ -229,6 +240,8 @@ codeOrderInsert new@NewRegistration {nrgId, nrgOrder = OrderFields {ofLength}} c
    Right () -> pure $ Right ()
    Left RRLiveOrder -> pure $ Left OROrderExists
    Left RRCodeNotReservable -> Left . ORCode <$> reserveRefusal db now pcCodeHash nrgId ofLength
+    -- a code order holds no balance
+    Left RRBalanceChanged -> pure $ Left OROrderExists

 checkTimestamp :: UTCTime -> Word64 -> Either OrderRefusal ()
 checkTimestamp now timestamp =
@@ -267,6 +280,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 +311,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 +358,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
@@ -16,6 +16,14 @@ module StoreService.Names.Store
    VersionWrite (..),
    LiveOrder (..),
    OrderTerms (..),
+    Balance (..),
+    BalanceHold (..),
+    BalanceLink (..),
+    LateCredit (..),
+    LateCreditState (..),
+    LatePending (..),
+    LateAlert (..),
+    CleanupKept (..),
    PrepaidCode (..),
    NewPrepaidCode (..),
    CodeHashTaken (..),
@@ -35,6 +43,7 @@ module StoreService.Names.Store
    textMethod,
    createPaidRegistration,
    createCodeRegistration,
+    createBalanceRegistration,
    getRegistration,
    getRegistrationByOrderHash,
    getLiveOrders,
@@ -47,6 +56,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 +102,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 +163,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 +195,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 +232,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 +247,99 @@ 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)
+
+-- | 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 +452,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 +469,70 @@ 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 (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'
-      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
+      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
+      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) (\(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.
 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,
@@ -502,14 +650,15 @@ 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,
-- since the invoice is written before the registration, as settlement, cancel and the sweep write them.
+-- 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 = 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
@@ -519,17 +668,17 @@ closeOverdue db r@NameRegistration {nrId = RegistrationId rid, nrVersion, nrPaym
            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
-        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,6 +840,303 @@ failedCodeOrdersBefore db cutoff =
      |]
      (PFailed, truncateToSecond cutoff)

+-- | 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, 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 ? > 0 AND reserved_by IS NULL"
+      (price, now, rid, seen, price, price)
+
+-- | 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 ? > 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, 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 >= ? AND ? > 0"
+      (used, truncateToSecond now, holder, used, 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.
+-- Confirmed money waiting comes first, so its alert never asks for a refund by hand.
+pendingCase :: Query
+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 > 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
+    literal p = fromString $ "'" <> T.unpack (textEncode p) <> "'"
+
+-- | 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 COALESCE(p.received_units, p.amount) 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
+        <> " > COALESCE(ni.late_alerted_units, -1)) 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 <-
@@ -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 ->
@@ -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
@@ -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
@@ -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.
@@ -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)

@@ -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 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,
+  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 CHECK (cents >= 0),
+  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;
@@ -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 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,
+  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 CHECK (cents >= 0),
+  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;
@@ -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 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)]
@@ -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"
@@ -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
@@ -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
@@ -767,6 +768,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
@@ -806,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
@@ -0,0 +1,756 @@
+{-# 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.Balances
+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 "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
+    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 "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
+  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 "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
+    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} 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} 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
+
+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
+  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)) (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"
+
+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
+  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)
+
+-- 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 ()
+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
+
+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"]
+
+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
+  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)]
+
+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 ()
+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
@@ -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") 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)
@@ -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) 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") (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) (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
@@ -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]
@@ -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