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