store: credit late XMR only once shown confirmed

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

@@ -340,8 +340,8 @@ data LateWait = LWConfirming | LWCrediting | LWSupport
   deriving (Eq, Show)
 
 -- | Why a closed order's money will not be credited by itself: an invoice made under HighSpeed, an amount that could not be counted in units,
--- a current rate below the floor, or unconfirmed money alerted past the read window.
-data LateSupport = LSHighSpeed | LSUnits | LSRateFloor | LSUnconfirmed
+-- a current rate below the floor, unconfirmed money alerted past the read window, or money the provider shows no confirmation of.
+data LateSupport = LSHighSpeed | LSUnits | LSRateFloor | LSUnconfirmed | LSNoConfirmation
   deriving (Eq, Show, Enum, Bounded)
 
 instance TextEncoding LateSupport where
@@ -350,6 +350,7 @@ instance TextEncoding LateSupport where
     LSUnits -> "units"
     LSRateFloor -> "rate_floor"
     LSUnconfirmed -> "unconfirmed"
+    LSNoConfirmation -> "no_confirmation"
   textDecode t = lookup t [(textEncode s, s) | s <- [minBound .. maxBound]]
 
 instance FromField LateSupport where fromField = fromTextField_ textDecode

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

@@ -221,6 +221,7 @@ lateSupportOf :: Uncreditable -> LateSupport
 lateSupportOf = \case
   UCHighSpeed -> LSHighSpeed
   UCUncounted -> LSUnits
+  UCNoConfirmationShown -> LSNoConfirmation
 
 latePayment :: InvoiceId -> RegistrationId -> IO ()
 latePayment (InvoiceId invText) (RegistrationId rid) =

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

@@ -399,6 +399,7 @@ lateReason :: PollerEnv -> LateAlert -> IO (Text, Maybe LateSupport)
 lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState = LateCreditState {lsInvoice, lsCoin, lsSupport, lsInvoiceRate}} = case laPending of
   LPUncounted -> pure (uncounted, Nothing)
   _ | lsSupport == Just LSHighSpeed -> pure (highSpeed, Nothing)
+  _ | lsSupport == Just LSNoConfirmation -> pure (noConfirmation, Nothing)
   LPUncredited -> case lsCoin of
     Nothing -> pure (cardWaits, Nothing)
     Just coin
@@ -411,6 +412,7 @@ lateReason env@PollerEnv {peStore, peProviders} LateAlert {laPending, laState =
   where
     unconfirmed = "refund by hand only a transaction confirmed on chain that BTCPay no longer monitors; one still Processing there waits"
     highSpeed = "the invoice was made under HighSpeed, so its money is never credited by itself; refund by hand only a transaction confirmed on chain"
+    noConfirmation = "the Monero plugin shows no confirmation of this money (the invoice's settled-confirmation threshold is 0 or not given), so it is never credited by itself; refund by hand only a transaction confirmed on chain"
     rateRead = "confirmed, the credit waits on the rate read; do not refund; fix the rate read"
     cardWaits = "confirmed, the credit waits on the poller's credit pass; do not refund; check the service log"
     rateFloor current = "confirmed; the coin's price fell by more than half since the invoice (" <> fromMaybe "?" lsInvoiceRate <> ", " <> current <> "); the owner decides: credit at the current rate, or refund by hand"

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

@@ -52,8 +52,8 @@ data Confirmed = Confirmed {cfCents :: CurrencyAmount, cfUnits :: Maybe Int64}
   deriving (Eq, Show)
 
 -- | Why money on an invoice is never credited by itself: it was made under a policy that settles at zero confirmations,
--- or its crypto could not be counted in atomic units. Such money confirms nothing.
-data Uncreditable = UCHighSpeed | UCUncounted
+-- its crypto could not be counted in atomic units, or the provider shows no confirmation of it. Such money confirms nothing.
+data Uncreditable = UCHighSpeed | UCUncounted | UCNoConfirmationShown
   deriving (Eq, Show)
 
 -- | A coin's current price in the service's currency, above 0: as the provider wrote it, and as a decimal to compute with.

apps/simplex-store-service/src/StoreService/Providers/BTCPay.hs

@@ -86,7 +86,11 @@ import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
 -- - an invoice's checkout.speedPolicy, GET stores/{storeId}/invoices/{invoiceId} and the list: BTCPayServer.Client/Models/InvoiceData.cs,
 --   nullable; HighSpeed settles at 0 confirmations, MediumSpeed at 1, LowMediumSpeed at 2, LowSpeed at 6
 --   (wwwroot/swagger/v1/swagger.template.json, SpeedPolicy). The Monero plugin (btcpay-monero/btcpayserver-monero-plugin v1.4.0,
---   Plugins/Monero/Services/MoneroListener.cs, ConfirmationsRequired) maps the policies the same way, unless the store sets its own threshold;
+--   Plugins/Monero/Services/MoneroListener.cs, ConfirmationsRequired) maps the policies the same way, unless the store sets its own
+--   InvoiceSettledConfirmationThreshold, which settles a payment at that many confirmations. Greenfield's payment model
+--   (Controllers/GreenField/GreenfieldInvoiceController.cs, ToPaymentModel) carries no payment's confirmations; the method's
+--   additionalData (Payments/MoneroLikeOnChainPaymentMethodDetails.cs, camel-cased by Data/BlobSerializer.cs) carries the invoice's
+--   invoiceSettledConfirmationThreshold, so a Settled XMR payment shows a confirmation only when it is at least 1;
 -- - the store's rates, GET stores/{storeId}/rates?currencyPair=BTC_USD: Controllers/GreenField/GreenfieldStoreRatesController.cs and
 --   Models/StoreRateResult.cs, a list of {currencyPair, errors, rate}, rate null when errors is not empty; it needs canviewstoresettings.
 btcMethodId, xmrMethodId :: Text
@@ -199,7 +203,8 @@ data GPaymentMethod = GPaymentMethod
     gpmRate :: Maybe WireNum,
     gpmPaid :: Maybe WireNum,
     gpmDue :: Maybe WireNum,
-    gpmPayments :: [GPayment]
+    gpmPayments :: [GPayment],
+    gpmSettledThreshold :: Maybe Int
   }
   deriving (Show)
 
@@ -213,6 +218,12 @@ instance J.FromJSON GPaymentMethod where
       <*> o J..:? "paymentMethodPaid"
       <*> o J..:? "due"
       <*> (fromMaybe [] <$> o J..:? "payments")
+      <*> (settledThreshold <$> o J..:? "additionalData")
+    where
+      -- read leniently: another plugin's additionalData must not fail the read
+      settledThreshold = \case
+        Just (J.Object d) | Just (J.Number n) <- KM.lookup "invoiceSettledConfirmationThreshold" d -> toBoundedInteger n
+        _ -> Nothing
 
 -- | A payment without a value is read, and only its units cannot be counted.
 data GPayment = GPayment
@@ -428,12 +439,13 @@ paymentMethodsSignal now ref status policy body =
 -- Complete is the old API's status name and never matches, so it has no case here.
 invoiceSignal :: UTCTime -> Text -> Text -> Maybe Text -> [GPaymentMethod] -> Either ProviderError (Maybe PaymentSignal)
 invoiceSignal now ref status policy ms = do
-  (m@GPaymentMethod {gpmRate, gpmPaid, gpmDue, gpmPayments}, cc) <- chooseMethod ref ms
+  (m@GPaymentMethod {gpmRate, gpmPaid, gpmDue, gpmPayments, gpmSettledThreshold}, cc) <- chooseMethod ref ms
   rate <- priced "rate" gpmRate
   paid <- priced "paymentMethodPaid" gpmPaid
   let decimals = unitDecimals cc
       confirming = maybe False (`elem` map speedPolicyName confirmingPolicies) policy
-      received = receivedOf decimals confirming (status == "Settled") rate paid gpmDue gpmPayments
+      shown = cc /= CCXmr || maybe False (>= 1) gpmSettledThreshold
+      received = receivedOf decimals confirming shown (status == "Settled") rate paid gpmDue gpmPayments
   case status of
     "Settled" -> Right (Just (SigSettled received (fromMaybe now (latestSettledAt m))))
     "Processing" -> Right (Just (SigFunded received PaidInFull))
@@ -475,8 +487,8 @@ findMethod what ref methodId body = do
 
 -- | The confirmed crypto shares paymentMethodPaid's basis, whatever it nets out: all of it once the invoice or every payment is Settled,
 -- else the Settled payments' value capped at it. An amount with a non-zero digit past its unit leaves every figure in units out.
-receivedOf :: Int -> Bool -> Bool -> WireNum -> WireNum -> Maybe WireNum -> [GPayment] -> Received
-receivedOf decimals confirming invoiceSettled rate paid due payments =
+receivedOf :: Int -> Bool -> Bool -> Bool -> WireNum -> WireNum -> Maybe WireNum -> [GPayment] -> Received
+receivedOf decimals confirming shown invoiceSettled rate paid due payments =
   Received
     { rcvAmount = toMinorUnits (wnValue paid * wnValue rate),
       rcvCrypto = if wnValue paid > 0 then Just (wnText paid) else Nothing,
@@ -498,6 +510,7 @@ receivedOf decimals confirming invoiceSettled rate paid due payments =
     uncreditable
       | isNothing counted = Just UCUncounted
       | not confirming = Just UCHighSpeed
+      | not shown = Just UCNoConfirmationShown
       | otherwise = Nothing
     toUnits v
       | v < 0 = Nothing

apps/simplex-store-service/src/StoreService/Store/Postgres/Migrations.hs

@@ -442,7 +442,7 @@ DROP INDEX @idx_name_balances_reserved_by;
 DROP TABLE @name_balances;
 |]
 
--- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor or unconfirmed. Never cleared.
+-- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor, unconfirmed or no_confirmation. Never cleared.
 m20261022_name_late_wait :: Text
 m20261022_name_late_wait =
   withPrefix

apps/simplex-store-service/src/StoreService/Store/SQLite/Migrations.hs

@@ -444,7 +444,7 @@ DROP INDEX @idx_name_balances_reserved_by;
 DROP TABLE @name_balances;
 |]
 
--- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor or unconfirmed. Never cleared.
+-- Why a closed order's late money will not be credited by itself: high_speed, units, rate_floor, unconfirmed or no_confirmation. Never cleared.
 m20261022_name_late_wait :: Query
 m20261022_name_late_wait =
   withPrefix

tests/Bots/StoreService/BTCPayTests.hs

@@ -82,6 +82,7 @@ badgeBTCPayTests = describe "badge btcpay adapter" $ do
     it "confirms all of paymentMethodPaid when every payment reads Settled, whatever their values" testConfirmedAllSettled
     it "confirms the Settled payments' value otherwise, rounded to cents once and capped at paymentMethodPaid" testConfirmedSettledSum
     it "counts BTC in satoshi and XMR in piconero" testConfirmedUnits
+    it "confirms XMR only when the invoice's settled-confirmation threshold is at least 1, never with 0 or none" testXmrConfirmations
     it "confirms nothing under HighSpeed, or with no or an unknown speed policy, an invoice-level Settled included" testHighSpeedConfirmsNothing
     it "accepts trailing zeros past the unit" testTrailingZeros
     it "drops only the units of an amount with a non-zero digit past its unit, the signal and its cents as before" testDigitPastUnit
@@ -144,8 +145,9 @@ paymentOf status value =
       "fee" .= ("0.00000100" :: Text)
     ]
 
-xmrPaid :: Text -> [J.Value] -> J.Value
-xmrPaid paid payments =
+-- | The Monero plugin's method, its additionalData carrying the invoice's settled-confirmation threshold when given.
+xmrPaid :: Maybe Int -> Text -> [J.Value] -> J.Value
+xmrPaid threshold paid payments =
   J.object
     [ "paymentMethodId" .= xmrMethodId,
       "destination" .= ("44AFFq5kSiGBoZ4NMDwYtN18obc8AemS33DBLWs3H7otXft3XjrpDtQGv7SqSsaBYBb98uNbr2VBBEt7f2wfn3RVGQBEP3A" :: Text),
@@ -153,7 +155,8 @@ xmrPaid paid payments =
       "rate" .= ("168.25" :: Text),
       "paymentMethodPaid" .= paid,
       "due" .= ("0.00000000" :: Text),
-      "payments" .= payments
+      "payments" .= payments,
+      "additionalData" .= J.object (maybe [] (\n -> ["invoiceSettledConfirmationThreshold" .= n]) threshold)
     ]
 
 testConfirmedInvoiceSettled :: IO ()
@@ -178,8 +181,20 @@ testConfirmedSettledSum = do
 testConfirmedUnits :: IO ()
 testConfirmedUnits = do
   (rcvUnitsOf =<<) <$> signalOf "Settled" [btcPaid "0.00050000" []] `shouldBe` Right (Just 50000)
-  signalOf "Settled" [xmrPaid "0.32095000" [paymentOf "Settled" "0.32095000"]]
-    `shouldBe` Right (Just (SigSettled xmrReceived {rcvConfirmed = Confirmed {cfCents = CurrencyAmount 5400, cfUnits = Just 320950000000}} (posixSecondsToUTCTime 1700000000)))
+  signalOf "Settled" [xmrPaid (Just 1) "0.32095000" [paymentOf "Settled" "0.32095000"]]
+    `shouldBe` Right (Just (SigSettled xmrConfirmed (posixSecondsToUTCTime 1700000000)))
+
+xmrConfirmed :: Received
+xmrConfirmed = xmrReceived {rcvConfirmed = Confirmed {cfCents = CurrencyAmount 5400, cfUnits = Just 320950000000}, rcvUncreditable = Nothing}
+
+-- | A Monero payment's own confirmations are not in Greenfield's payment model, so only the invoice's threshold shows one.
+testXmrConfirmations :: IO ()
+testXmrConfirmations = do
+  let settledWith threshold = signalOf "Settled" [xmrPaid threshold "0.32095000" [paymentOf "Settled" "0.32095000"]]
+      settled r = Right (Just (SigSettled r (posixSecondsToUTCTime 1700000000)))
+  settledWith (Just 0) `shouldBe` settled xmrReceived
+  settledWith Nothing `shouldBe` settled xmrReceived
+  mapM_ (\n -> settledWith (Just n) `shouldBe` settled xmrConfirmed) [1, 10]
 
 rcvUnitsOf :: PaymentSignal -> Maybe Int64
 rcvUnitsOf = \case
@@ -618,7 +633,7 @@ xmrReceived =
       rcvUnits = Just 320950000000,
       rcvRate = Just "168.25",
       rcvConfirmed = Confirmed {cfCents = CurrencyAmount 0, cfUnits = Just 0},
-      rcvUncreditable = Nothing
+      rcvUncreditable = Just UCNoConfirmationShown
     }
 
 fiftyFourDollars :: OrderDraft

tests/Bots/StoreService/NamesLateCreditTests.hs

@@ -75,6 +75,7 @@ namesLateCreditTests = describe "StoreService names: balance life" $ do
     it "keeps the confirmed figure and the credit when the settled sum falls, crediting nothing on the same sum again" testFallingSum
     it "credits an invoice past the read window after a hinted read" testHintPastWindow
     it "credits Stripe's succeeded amount without reading a rate" testStripeCredited
+    it "credits late XMR in piconero when the plugin shows a confirmation, and alerts it to support when it shows none" testXmrLate
   describe "balances with late credits" $ do
     it "keeps a credit made while the balance is held, the held spend settling" testCreditWhileHeld
     it "refuses a covered spend that read the amount before a credit" testSpendBeforeCredit
@@ -507,6 +508,35 @@ testStripeCredited = withLate $ \l@Late {lStore = st} -> do
   balanceOf st "c" `shouldReturn` Just (20000, 20000, 0)
   rateCalls l `shouldReturn` 0
 
+-- | 0.32095 XMR at the invoice's rate of 168.25, all of it Settled; uncreditable unless the plugin shows a confirmation.
+xmrPaid :: Maybe Uncreditable -> Received
+xmrPaid uncreditable =
+  Received
+    { rcvAmount = CurrencyAmount 5400,
+      rcvCrypto = Just "0.32095000",
+      rcvDue = Nothing,
+      rcvUnits = Just xmrUnits,
+      rcvRate = Just "168.25",
+      rcvConfirmed = maybe (Confirmed {cfCents = CurrencyAmount 5400, cfUnits = Just xmrUnits}) (const Confirmed {cfCents = CurrencyAmount 0, cfUnits = Just 0}) uncreditable,
+      rcvUncreditable = uncreditable
+    }
+  where
+    xmrUnits = 320950000000
+
+testXmrLate :: IO ()
+testXmrLate = withLate $ \l@Late {lStore = st} -> do
+  mapM_ (\r -> closedOrder l r False) ["xmrshown", "xmrnone"]
+  withTransaction st $ \db -> DB.execute_ db "UPDATE sx_badge_service_invoices SET payment_crypto_currency = 'xmr' WHERE invoice_id IN ('inv-xmrshown', 'inv-xmrnone')"
+  setRate l (Right $ rateOf "150" 150)
+  void $ readSignal l "xmrshown" (SigSettled (xmrPaid Nothing) (at 70))
+  creditsOf st "xmrshown" `shouldReturn` [(Just 320950000000, Just "168.25", Just "150", Just "150", 4814)]
+  void $ readSignal l "xmrnone" (SigSettled (xmrPaid $ Just UCNoConfirmationShown) (at 70))
+  balanceOf st "xmrnone" `shouldReturn` Nothing
+  lateWaitOf st "xmrnone" `shouldReturn` Just LWSupport
+  now <- getCurrentTime
+  alertsAt l (Right stubRate) (pastWindow now 60)
+    >>= (`shouldSatisfy` logged "ERROR" "invoice inv-xmrnone of order xmrnone: 320950000000 piconero received, 0 piconero confirmed, 0 piconero credited; the Monero plugin shows no confirmation")
+
 -- balances with late credits
 
 testCreditWhileHeld :: IO ()