store: name the invoice in credit pass warnings

apps/simplex-store-service/src/StoreService/Names/LateCredits.hs

@@ -31,10 +31,12 @@ import Text.Read (readMaybe)
 minCurrentRateFraction :: Rational
 minCurrentRateFraction = 1 % 2
 
--- | CORefused: the credit's number was taken meanwhile, which the invoice's lock rules out.
+-- | CONoInvoiceRate: crypto due with no invoice rate recorded to credit it at. CORefused: the credit's number was taken meanwhile,
+-- which the invoice's lock rules out.
 data CreditOutcome
   = CONothingDue
   | COCredited LateCredit
+  | CONoInvoiceRate
   | CORateFailed ProviderError
   | CORateFloor Text Rate
   | CORefused
@@ -45,12 +47,12 @@ creditLateInvoice st readRate invId now =
   withTransaction st (`lateCreditState` invId) >>= \case
     Just s | creditable s && moneyDue s -> case lsCoin s of
       Nothing -> credit Nothing
-      Just coin ->
-        readRate coin >>= \case
-          Left e -> pure $ CORateFailed e
-          Right rate -> case invoiceRate s of
-            Nothing -> pure $ CORateFailed $ ProviderError "the invoice's rate is not stored"
-            Just (invoiceText, invoiceValue)
+      Just coin -> case invoiceRate s of
+        Nothing -> pure CONoInvoiceRate
+        Just (invoiceText, invoiceValue) ->
+          readRate coin >>= \case
+            Left e -> pure $ CORateFailed e
+            Right rate
               | toRational (rateValue rate) < minCurrentRateFraction * toRational invoiceValue ->
                   CORateFloor invoiceText rate <$ withTransaction st (\db -> setLateSupport db invId LSRateFloor)
               | otherwise -> credit (Just rate)

apps/simplex-store-service/src/StoreService/Poller.hs

@@ -341,7 +341,9 @@ creditPass env@PollerEnv {peStore, peProviders} now = do
       safely ("names: crediting invoice " <> invText) $
         getInvoice peStore invId >>= \case
           Just InvoiceRow {irProvider} | Just p <- find ((== irProvider) . pProvider) peProviders -> void $ creditLate env p now invId
-          _ -> logWarn ("names: invoice " <> invText <> " has late money to credit, but no provider is configured to read its rate")
+          _ -> do
+            due' <- dueToWarn env now ("no rate provider: " <> invText)
+            when due' $ logWarn ("names: invoice " <> invText <> " has late money to credit, but no provider is configured to read its rate")
 
 -- | The pass's rate of a coin at a provider, read at most once.
 cachedRate :: PollerEnv -> Provider -> CryptoCurrency -> IO (Either ProviderError Rate)
@@ -367,6 +369,9 @@ creditLate env@PollerEnv {peStore} p now invId@(InvoiceId invText) = do
       logInfo $
         "names: invoice " <> invText <> " credited " <> tshow lcCents <> " cents to the balance of registration " <> rid
           <> maybe "" (\units -> " for " <> tshow units <> " units at " <> fromMaybe "?" lcRateUsed <> " (invoice " <> fromMaybe "?" lcInvoiceRate <> ", current " <> fromMaybe "?" lcCurrentRate <> ")") lcUnits
+    CONoInvoiceRate -> do
+      due <- dueToWarn env now ("no invoice rate: " <> invText)
+      when due $ logError ("names: invoice " <> invText <> " has confirmed late money, but no invoice rate was recorded to credit it at; check it at the provider")
     CORateFailed (ProviderError e) -> do
       due <- dueToWarn env now ("rate read failed: " <> tshow (pProvider p))
       when due $ logWarn ("names: late credits wait, as the current rate cannot be read; each pass tries again: " <> e)

tests/Bots/StoreService/NamesLateCreditTests.hs

@@ -69,6 +69,7 @@ namesLateCreditTests = describe "StoreService names: balance life" $ do
     it "credits nothing below the rate floor and never after, logging an error, and alerts support naming both rates" testRateFloor
     it "logs the rate floor of an invoice once while the price moves below it" testFloorLoggedOnce
     it "alerts confirmed money waiting on the rate read as such, whatever reason was stored before" testWaitingOutranksStoredReason
+    it "warns once of an invoice no provider reads a rate for, and names an invoice with no recorded rate" testRateProblemsNamed
     it "reads one rate per coin per pass for several invoices, and none when nothing is due" testOneRateReadPerPass
     it "never credits a late Settled payment on an invoice made under HighSpeed, alerting it past the window" testHighSpeed
     it "credits at the next pass a late Settled invoice and a settlement whose credit step did not run" testCreditedByPass
@@ -448,6 +449,17 @@ testWaitingOutranksStoredReason = withLate $ \l@Late {lStore = st} -> do
   alertsAt l (Left $ ProviderError "rates down for outranked") (pastWindow (at 70) 60)
     >>= (`shouldSatisfy` logged "ERROR" "invoice inv-outranked of order outranked: 320000 satoshi received, 320000 satoshi confirmed, 0 satoshi credited; confirmed, the credit waits on the rate read; do not refund; fix the rate read")
 
+testRateProblemsNamed :: IO ()
+testRateProblemsNamed = withLate $ \l@Late {lStore = st} -> do
+  closedOrder l "noprovider" False
+  settleAt l "noprovider" (SigClosed (btcPaid lateUnits lateUnits)) (at 70) `shouldReturn` Right ISExpired
+  withTransaction st $ \db -> DB.execute_ db "UPDATE sx_badge_service_invoices SET provider = 'apple' WHERE invoice_id = 'inv-noprovider'"
+  closedOrder l "norate" False
+  settleAt l "norate" (SigClosed (btcPaid lateUnits lateUnits) {rcvRate = Nothing}) (at 70) `shouldReturn` Right ISExpired
+  logs <- (<>) <$> passAt l (at 71) <*> passAt l (at 72)
+  count "invoice inv-noprovider has late money to credit, but no provider" logs `shouldBe` 1
+  logs `shouldSatisfy` logged "ERROR" "invoice inv-norate has confirmed late money, but no invoice rate was recorded to credit it at"
+
 testOneRateReadPerPass :: IO ()
 testOneRateReadPerPass = withLate $ \l@Late {lStore = st} -> do
   mapM_ (\r -> closedOrder l r False >> settleAt l r (SigClosed (btcPaid lateUnits lateUnits)) (at 70)) ["x", "y", "z"]