From dc392994bf1c185d8bd0607171b7ca29f8f2365a Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 1 Oct 2026 15:53:20 +0400 Subject: [PATCH] core, badge service: share one store transaction reference, and mark a verified transaction as such --- .../src/BadgeService/Poller.hs | 5 ++- .../src/BadgeService/Service.hs | 9 +++-- .../src/BadgeService/Store.hs | 7 ++-- .../src/BadgeService/Store/Invoices.hs | 30 +++----------- .../src/BadgeService/StoreReceipts.hs | 29 ++++++-------- .../src/BadgeService/StoreReceipts/Mock.hs | 10 ++--- src/Simplex/Chat/Library/Commands.hs | 5 ++- src/Simplex/Chat/PaymentService/Types.hs | 40 +++++++++++++++++++ src/Simplex/Chat/Store/Badges.hs | 7 +--- tests/BadgeTests.hs | 15 ++++--- tests/Bots/BadgeService/FakeStore.hs | 16 ++++---- 11 files changed, 93 insertions(+), 80 deletions(-) diff --git a/apps/simplex-badge-service/src/BadgeService/Poller.hs b/apps/simplex-badge-service/src/BadgeService/Poller.hs index c91ffcd22f..f066ed5d0c 100644 --- a/apps/simplex-badge-service/src/BadgeService/Poller.hs +++ b/apps/simplex-badge-service/src/BadgeService/Poller.hs @@ -30,7 +30,7 @@ where import BadgeService.Config (PollConfig (..)) import BadgeService.Orders (decide, settleOrder) import BadgeService.Providers (ListPass (..), PaymentSignal (..), Provider (..), ProviderError (..), Received (..), expiresItself, settleWindow) -import BadgeService.Store.Invoices (InvoiceRow (..), OverdueInvoice (..), expireOverdue, getInvoiceByProviderRef, overdueInvoices, providerText, unpaidRefs) +import BadgeService.Store.Invoices (InvoiceRow (..), OverdueInvoice (..), expireOverdue, getInvoiceByProviderRef, overdueInvoices, unpaidRefs) import BadgeService.Waiters (Waiters, publish, waitingCount, waitingCountSTM) import Control.Concurrent.STM import Control.Exception (SomeAsyncException, SomeException, fromException, throwIO, try) @@ -47,6 +47,7 @@ import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCu import Numeric.Natural (Natural) import Simplex.Chat.PaymentService.Types (InvoiceStatus (..), PaymentProvider) import Simplex.Messaging.Agent.Store.Common (DBStore) +import Simplex.Messaging.Encoding.String (textEncode) import Simplex.Messaging.Util (tshow) -- | Allows for our clock running ahead of the provider's; an expired invoice can still be marked paid. @@ -145,7 +146,7 @@ readsPerPass = 25 coveringProvider :: PollerEnv -> UTCTime -> (Text, Text) -> IO (Maybe Provider) coveringProvider env@PollerEnv {peProviders} now (provider, ref) = - case find ((== provider) . providerText . pProvider) peProviders of + case find ((== provider) . textEncode . pProvider) peProviders of Just p -> pure (Just p) Nothing -> do due <- dueToWarn env now ("no provider for " <> provider) diff --git a/apps/simplex-badge-service/src/BadgeService/Service.hs b/apps/simplex-badge-service/src/BadgeService/Service.hs index ddb9b56d69..6707310e61 100644 --- a/apps/simplex-badge-service/src/BadgeService/Service.hs +++ b/apps/simplex-badge-service/src/BadgeService/Service.hs @@ -66,6 +66,7 @@ import Simplex.Chat.Core (sendChatCmd, simplexChatCore) import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent (CIContent (..), SMsgDirection (..), ciContentToText) import Simplex.Chat.Options (printDbOpts) +import Simplex.Chat.PaymentService.Types (StoreTransactionRef (..)) import Simplex.Chat.Terminal (terminalChatConfig) import Simplex.Chat.Terminal.Main (simplexChatCLI') import Simplex.Chat.Types (AgentInvId (..), Contact, User (..)) @@ -451,7 +452,7 @@ redeemCode key cc purchaseKey masterKey codeText = case parseBadgeCode codeText -- | Every refusal is answered before anything is written, so it leaves the receipt unclaimed; and -- nothing is written until the credential is signed. purchaseWithReceipt :: BadgeIssuerKey -> ChatController -> C.PublicKeyEd25519 -> BadgeMasterKey -> StoreReceipt -> IO BadgeServiceResponse -purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {provider, providerRef, verifyReceipt} = +purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTransactionRef {provider, transactionRef = providerRef}, verifyReceipt} = withDB' "getStorePayment" cc (\db -> getStorePaymentClaim db provider providerRef) >>= \case Left _ -> pure $ errorResponse BSEInternal Right claim @@ -461,9 +462,9 @@ purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {provider, provide verifyReceipt >>= \case Left refusal -> storeRefusalResponse refusal -- the claim was read from the evidence before it was verified, so it must name the transaction the store vouched for - Right StoreTransaction {transactionRef} + Right VerifiedStoreTransaction {transactionRef} | transactionRef /= providerRef -> storeRefusalResponse $ SRVerifierFailed "verified a transaction other than the one claimed" - Right StoreTransaction {environment = SETest} -> storeRefusalResponse $ SRInvalid "test purchase" + Right VerifiedStoreTransaction {testPurchase = True} -> storeRefusalResponse $ SRInvalid "test purchase" -- another key's claim is told only once the store vouched for the receipt, or it would reveal which transactions were credited Right tx -> case claim of Unclaimed -> newPurchase tx @@ -477,7 +478,7 @@ purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {provider, provide Right (Left resp) -> resp _ -> errorResponse BSEInternal -- the product is read only for a receipt not yet credited, so retiring it leaves its replays answered - newPurchase StoreTransaction {productId, quantity, paid} = case storeProduct provider productId of + newPurchase VerifiedStoreTransaction {productId, quantity, paid} = case storeProduct provider productId of Nothing -> pure $ errorResponse BSEProductUnavailable Just StoreProduct {badgeType, months} -> do now <- badgeNow cc diff --git a/apps/simplex-badge-service/src/BadgeService/Store.hs b/apps/simplex-badge-service/src/BadgeService/Store.hs index 946b363cba..0c50220b49 100644 --- a/apps/simplex-badge-service/src/BadgeService/Store.hs +++ b/apps/simplex-badge-service/src/BadgeService/Store.hs @@ -30,7 +30,7 @@ module BadgeService.Store ) where -import BadgeService.Store.Invoices (executeChanging, paymentStatusText, providerText) +import BadgeService.Store.Invoices (executeChanging, paymentStatusText) import qualified Data.Aeson as J import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Lazy.Char8 as LB @@ -46,6 +46,7 @@ import Simplex.Chat.Store.Shared (insertedRowId) import Simplex.Messaging.Agent.Store.DB (Binary (..)) import qualified Simplex.Messaging.Agent.Store.DB as DB import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Encoding.String (textEncode) import Simplex.Messaging.Util (maybeFirstRow, maybeFirstRow') #if defined(dbPostgres) @@ -134,7 +135,7 @@ getStorePaymentClaim db provider providerRef = ORDER BY i.period_end DESC LIMIT 1 |] - (providerText provider, providerRef) + (textEncode provider, providerRef) fundingClaim :: Maybe Int64 -> Maybe C.PublicKeyEd25519 -> Maybe (Binary ByteString) -> FundingClaim fundingClaim purchaseId_ purchaseKey_ credential_ = case (purchaseId_, purchaseKey_) of @@ -297,7 +298,7 @@ createStorePurchase db NewStorePurchase {paymentId, provider, providerRef, paid, VALUES (?,?,?,?,?,?,?,?) ON CONFLICT (provider, provider_ref) DO NOTHING |] - (paymentId, providerText provider, providerRef, (\(CurrencyAmount a) -> a) . fst <$> paid, snd <$> paid, paymentStatusText PSSettled, now, now) + (paymentId, textEncode provider, providerRef, (\(CurrencyAmount a) -> a) . fst <$> paid, snd <$> paid, paymentStatusText PSSettled, now, now) if claimed == 0 then pure Nothing else do diff --git a/apps/simplex-badge-service/src/BadgeService/Store/Invoices.hs b/apps/simplex-badge-service/src/BadgeService/Store/Invoices.hs index a3e177400e..57f9341308 100644 --- a/apps/simplex-badge-service/src/BadgeService/Store/Invoices.hs +++ b/apps/simplex-badge-service/src/BadgeService/Store/Invoices.hs @@ -17,7 +17,6 @@ module BadgeService.Store.Invoices getInvoice, getInvoiceByProviderRef, unpaidRefs, - providerText, codeHashExists, OverdueInvoice (..), overdueInvoices, @@ -59,7 +58,7 @@ import Simplex.Chat.Store.Shared (insertedRowId) import Simplex.Chat.PaymentService.Types (CardProvider (..), CryptoCurrency (..), CurrencyAmount (..), InvoiceId (..), InvoiceStatus (..), PaymentProvider (..), PaymentStatus (..), ServicePaymentDestination (..)) import Simplex.Messaging.Agent.Store.Common (DBStore, withConnection, withTransaction) import qualified Simplex.Messaging.Agent.Store.DB as DB -import Simplex.Messaging.Encoding.String (textEncode) +import Simplex.Messaging.Encoding.String (textDecode, textEncode) import Simplex.Messaging.Util (safeDecodeUtf8, tshow) #if defined(dbPostgres) @@ -290,25 +289,6 @@ qSeedBadgeOffer = "INSERT INTO @badge_offers (offer_id, price_id, months, free_months, discount, status, created_at) " <> "VALUES (?,?,?,?,?,?,?) ON CONFLICT (offer_id) DO NOTHING" -providerText :: PaymentProvider -> Text -providerText = \case - PPApple -> "apple" - PPGoogle -> "google" - PPStripe -> "stripe" - PPCrypto -> "crypto" - PPCode -> "code" - PPReceipt -> "receipt" - -textToProvider :: Text -> Maybe PaymentProvider -textToProvider = \case - "apple" -> Just PPApple - "google" -> Just PPGoogle - "stripe" -> Just PPStripe - "crypto" -> Just PPCrypto - "code" -> Just PPCode - "receipt" -> Just PPReceipt - _ -> Nothing - cryptoCurrencyText :: CryptoCurrency -> Text cryptoCurrencyText CCBtc = "btc" cryptoCurrencyText CCXmr = "xmr" @@ -380,7 +360,7 @@ mkInvoiceRow :. (cryptoAmt, expiresAt, statusTxt, createdAt) :. (pAmount, pCryptoPaid, pCryptoDue, pPaidInFull, pStatus, pUpdatedAt) ) = do - provider <- note "invoices.provider" (textToProvider providerTxt) + provider <- note "invoices.provider" (textDecode providerTxt) status <- note "invoices.status" (textToInvoiceStatus statusTxt) destination <- note "invoice payment destination" (mkDestination url addr cryptoCur cryptoAmt) pure @@ -462,7 +442,7 @@ insertInvoiceRows db NewInvoice {..} = do DB.execute db qInsertInvoice - ( (invId, providerText niProvider, price, discountAmount, Nothing :: Maybe Word32, amount, niCurrency) + ( (invId, textEncode niProvider, price, discountAmount, Nothing :: Maybe Word32, amount, niCurrency) :. (url, addr, cryptoCur, cryptoAmt, expiresAt, invoiceStatusText ISOpen, createdAt, createdAt) ) DB.execute @@ -526,7 +506,7 @@ overdueInvoices st cutoff = withConnection st $ \db -> do rows <- DB.query db qOverdueInvoices (Only (truncateToSecond cutoff)) either (E.throwIO . StoreDecodeError) pure (traverse toOverdue rows) where - toOverdue (i, providerTxt, oiProviderRef, oiCreatedAt) = case textToProvider providerTxt of + toOverdue (i, providerTxt, oiProviderRef, oiCreatedAt) = case textDecode providerTxt of Just oiProvider -> Right OverdueInvoice {oiInvoiceId = InvoiceId i, oiProvider, oiProviderRef, oiCreatedAt} Nothing -> Left ("invoices.provider: " <> providerTxt) @@ -591,7 +571,7 @@ upsertPayment db InvoiceRow {irInvoiceId, irProvider, irProviderRef, irCurrency} DB.execute db qUpsertPayment - ( (invId, invId, providerText irProvider, irProviderRef, amount) + ( (invId, invId, textEncode irProvider, irProviderRef, amount) :. (irCurrency, cryptoAmount, cryptoDue, if paidInFull then 1 :: Int else 0, paymentStatusText status, at, at) ) where diff --git a/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs b/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs index 58f1dbe616..5f9a30ddcf 100644 --- a/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs +++ b/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs @@ -4,8 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} module BadgeService.StoreReceipts - ( StoreTransaction (..), - StoreEnvironment (..), + ( VerifiedStoreTransaction (..), StoreRefusal (..), StoreVerifier (..), StoreReceipt (..), @@ -21,25 +20,22 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import Simplex.Chat.PaymentService (ServicePayment (..), appleTransactionId, googlePurchaseRef) -import Simplex.Chat.PaymentService.Types (CurrencyAmount, PaymentProvider (..)) +import Simplex.Chat.PaymentService.Types (CurrencyAmount, PaymentProvider (..), StoreTransactionRef (..)) import Simplex.Messaging.Util (catchOwn') import System.Timeout (timeout) -- | What a store vouches for about one completed transaction. -data StoreTransaction = StoreTransaction +-- PaymentFunding's PFApple and PFGoogle hold much the same; the two are reconciled when PaymentFunding is built out. +data VerifiedStoreTransaction = VerifiedStoreTransaction { transactionRef :: Text, -- from what was verified: Apple's transactionId, googlePurchaseRef of the token asked about productId :: Text, quantity :: Int, - environment :: StoreEnvironment, + -- costs the buyer nothing: Apple's Sandbox, which a public TestFlight build buys in, and Google's license testers + testPurchase :: Bool, paid :: Maybe (CurrencyAmount, Text) -- in minor units; Google's purchase record carries no price } deriving (Eq, Show) --- | A test purchase costs the buyer nothing: Apple's Sandbox, which a public TestFlight build buys --- in, and Google's license testers. -data StoreEnvironment = SEProduction | SETest - deriving (Eq, Show) - -- | The reasons are for the service's log alone and must never quote the receipt. data StoreRefusal = SRInvalid Text -- a verdict that cannot change, and the client consumes the purchase: forged, malformed, another app's, refunded @@ -52,17 +48,16 @@ data StoreRefusal -- | Not a Provider: a receipt is presented once as proof, with nothing to create, watch or cancel. -- Apple is checked offline, so its verifier is pure and cannot be unreachable; only Google is asked. data StoreVerifier = StoreVerifier - { verifyApple :: Maybe (Text -> Either Text StoreTransaction), -- the JWS; Left is why Apple did not sign it - verifyGoogle :: Maybe (Text -> Text -> IO (Either StoreRefusal StoreTransaction)), -- the product id and the token + { verifyApple :: Maybe (Text -> Either Text VerifiedStoreTransaction), -- the JWS; Left is why Apple did not sign it + verifyGoogle :: Maybe (Text -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction)), -- the product id and the token -- microseconds; requests are answered one at a time, so a verifier that does not finish holds up every other one verifyTimeout :: Int } -- | A store payment, named by the store's own reference before anything is verified. data StoreReceipt = StoreReceipt - { provider :: PaymentProvider, - providerRef :: Text, - verifyReceipt :: IO (Either StoreRefusal StoreTransaction) + { txRef :: StoreTransactionRef, + verifyReceipt :: IO (Either StoreRefusal VerifiedStoreTransaction) } noStoreVerifier :: StoreVerifier @@ -74,14 +69,14 @@ storeReceipt :: StoreVerifier -> ServicePayment -> Maybe (Either StoreRefusal St storeReceipt StoreVerifier {verifyApple, verifyGoogle, verifyTimeout} = \case SPApple {jws} -> Just $ case appleTransactionId jws of Nothing -> Left $ SRInvalid "names no transaction" - Just ref -> Right $ StoreReceipt PPApple ref $ maybe unconfigured (\verify -> offline $ first SRInvalid $ verify jws) verifyApple + Just ref -> Right $ StoreReceipt (StoreTransactionRef PPApple ref) $ maybe unconfigured (\verify -> offline $ first SRInvalid $ verify jws) verifyApple SPGoogle {productId, token} -- the claim is the token's hash, so neither string may name any purchase but the one it claims, -- whatever path a verifier builds from them | not (googleProductId productId) -> Just $ Left $ SRInvalid "not a Play product id" -- Play documents no token grammar, so this is our guess, and refusing to ask Play is not its verdict | not (googleToken token) -> Just $ Left $ SRUnreachable "a Play token this service will not send" - | otherwise -> Just $ Right $ StoreReceipt PPGoogle (googlePurchaseRef token) $ maybe unconfigured (\verify -> online $ verify productId token) verifyGoogle + | otherwise -> Just $ Right $ StoreReceipt (StoreTransactionRef PPGoogle (googlePurchaseRef token)) $ maybe unconfigured (\verify -> online $ verify productId token) verifyGoogle SPInvoice {} -> Nothing SPReceipt {} -> Nothing where diff --git a/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Mock.hs b/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Mock.hs index a0384ba34b..c2fd1ab63d 100644 --- a/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Mock.hs +++ b/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Mock.hs @@ -18,7 +18,7 @@ import Simplex.Messaging.Util (eitherToMaybe) mockStoreVerifier :: StoreVerifier mockStoreVerifier = noStoreVerifier {verifyApple = Just mockApple, verifyGoogle = Just mockGoogle} -mockApple :: Text -> Either Text StoreTransaction +mockApple :: Text -> Either Text VerifiedStoreTransaction mockApple signed = case T.splitOn "." signed of [_, payload, _] -> do o <- case J.decodeStrict' =<< eitherToMaybe (B64U.decodeUnpadded $ encodeUtf8 payload) of @@ -31,11 +31,11 @@ mockApple signed = case T.splitOn "." signed of Right $ vouched transactionRef productId _ -> Left "not three dot-separated parts" -mockGoogle :: Text -> Text -> IO (Either StoreRefusal StoreTransaction) +mockGoogle :: Text -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction) mockGoogle productId token = pure $ Right $ vouched (googlePurchaseRef token) productId -vouched :: Text -> Text -> StoreTransaction +vouched :: Text -> Text -> VerifiedStoreTransaction vouched transactionRef productId = - -- not SETest, though nothing was paid: a test purchase is refused as receipt_invalid, which is + -- not a test purchase, though nothing was paid: a test purchase is refused as receipt_invalid, which is -- terminal and drops the client's keys, so every dev purchase would fail for good - StoreTransaction {transactionRef, productId, quantity = 1, environment = SEProduction, paid = Nothing} + VerifiedStoreTransaction {transactionRef, productId, quantity = 1, testPurchase = False, paid = Nothing} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 3d9362033f..4224cf45fa 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -77,6 +77,7 @@ import Simplex.Chat.Messages.CIContent.Events import Simplex.Chat.Operators import Simplex.Chat.Options import Simplex.Chat.PaymentService (ServicePayment (..), appleTransactionId, googlePurchaseRef) +import Simplex.Chat.PaymentService.Types (PaymentProvider (..), StoreTransactionRef (..)) import Simplex.Chat.ProfileGenerator (generateRandomProfile) import Simplex.Chat.Protocol import Simplex.Chat.Remote @@ -5280,8 +5281,8 @@ purchaseBadge nm presentingUser echoedInvoiceId payment = do -- | The same reference the service claims a transaction by, read without verifying anything. storeTransactionRef :: ServicePayment -> Maybe StoreTransactionRef storeTransactionRef = \case - SPApple {jws} -> StoreTransactionRef "apple" <$> appleTransactionId jws - SPGoogle {token} -> Just $ StoreTransactionRef "google" $ googlePurchaseRef token + SPApple {jws} -> StoreTransactionRef PPApple <$> appleTransactionId jws + SPGoogle {token} -> Just $ StoreTransactionRef PPGoogle $ googlePurchaseRef token SPInvoice {} -> Nothing SPReceipt {} -> Nothing diff --git a/src/Simplex/Chat/PaymentService/Types.hs b/src/Simplex/Chat/PaymentService/Types.hs index 067e170e90..646da675e2 100644 --- a/src/Simplex/Chat/PaymentService/Types.hs +++ b/src/Simplex/Chat/PaymentService/Types.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Simplex.Chat.PaymentService.Types @@ -8,6 +11,7 @@ module Simplex.Chat.PaymentService.Types InvoiceId (..), PaymentId (..), PaymentProvider (..), + StoreTransactionRef (..), CardProvider (..), CryptoCurrency (..), ServicePaymentMethod (..), @@ -26,7 +30,16 @@ import Data.ByteString.Char8 (ByteString) import Data.Text (Text) import Data.Time.Clock (UTCTime) import Data.Word (Word32) +import Simplex.Messaging.Agent.Store.DB (fromTextField_) +import Simplex.Messaging.Encoding.String (TextEncoding (..)) import Simplex.Messaging.Parsers (dropPrefix, enumJSON, taggedObjectJSON) +#if defined(dbPostgres) +import Database.PostgreSQL.Simple.FromField (FromField (..)) +import Database.PostgreSQL.Simple.ToField (ToField (..)) +#else +import Database.SQLite.Simple.FromField (FromField (..)) +import Database.SQLite.Simple.ToField (ToField (..)) +#endif -- USD etc. are in minor units, following Stripe etc. convention newtype CurrencyAmount = CurrencyAmount Word32 @@ -45,6 +58,32 @@ newtype PaymentId = PaymentId Text data PaymentProvider = PPApple | PPGoogle | PPStripe | PPCrypto | PPCode | PPReceipt deriving (Eq, Show) +instance TextEncoding PaymentProvider where + textEncode = \case + PPApple -> "apple" + PPGoogle -> "google" + PPStripe -> "stripe" + PPCrypto -> "crypto" + PPCode -> "code" + PPReceipt -> "receipt" + textDecode = \case + "apple" -> Just PPApple + "google" -> Just PPGoogle + "stripe" -> Just PPStripe + "crypto" -> Just PPCrypto + "code" -> Just PPCode + "receipt" -> Just PPReceipt + _ -> Nothing + +instance FromField PaymentProvider where fromField = fromTextField_ textDecode + +instance ToField PaymentProvider where toField = toField . textEncode + +-- | A store and its own id for one transaction. The evidence is not the key: the store may sign it +-- again, and a retry of the same purchase has to find the same stash. +data StoreTransactionRef = StoreTransactionRef {provider :: PaymentProvider, transactionRef :: Text} + deriving (Eq, Show) + data CardProvider = CPStripe deriving (Eq, Show) @@ -100,6 +139,7 @@ data StoredPayment = StoredPayment deriving (Show) -- to review +-- PFApple and PFGoogle hold much what the service's VerifiedStoreTransaction does; the two are reconciled when this is built out. data PaymentFunding = PFInvoice { invoiceId :: InvoiceId, diff --git a/src/Simplex/Chat/Store/Badges.hs b/src/Simplex/Chat/Store/Badges.hs index 484d634d79..f8a956841a 100644 --- a/src/Simplex/Chat/Store/Badges.hs +++ b/src/Simplex/Chat/Store/Badges.hs @@ -9,7 +9,6 @@ module Simplex.Chat.Store.Badges ( BadgeStash (..), BadgeStashRef (..), - StoreTransactionRef (..), UserBadgePurchase (..), getUserBadgePurchase, getBadgePurchase, @@ -52,6 +51,7 @@ import Simplex.Chat.Badges import Simplex.Chat.Badges.Ledger import Simplex.Chat.Badges.Service (StatementCreditType (..), StatementDebitType (..), StatementEntry (..), StatementEntryType (..)) import Simplex.Chat.Badges.Types (BadgeAlertKind, BadgeIssueError (..), BadgeIssueFailure, BadgePurchaseStatus (..), OpenStorePurchase (..)) +import Simplex.Chat.PaymentService.Types (StoreTransactionRef (..)) import Simplex.Chat.Store.Shared (insertedRowId) import Simplex.Chat.Types import Simplex.Messaging.Agent.Protocol (UserId) @@ -80,11 +80,6 @@ data BadgeStash = BadgeStash data BadgeStashRef = BSRCodeRedemption Int64 | BSRStoreReceipt Int64 --- | A store and its own id for one transaction. The evidence is not the key: the store may sign it --- again, and a retry of the same purchase has to find the same stash. -data StoreTransactionRef = StoreTransactionRef {provider :: Text, transactionRef :: Text} - deriving (Eq, Show) - getBadgeCodeRedemption :: DB.Connection -> User -> Text -> IO (Maybe BadgeStash) getBadgeCodeRedemption db User {userId} code = maybeFirstRow (toBadgeStash BSRCodeRedemption) $ diff --git a/tests/BadgeTests.hs b/tests/BadgeTests.hs index 92b3b6d576..a253c425bd 100644 --- a/tests/BadgeTests.hs +++ b/tests/BadgeTests.hs @@ -10,7 +10,7 @@ module BadgeTests (badgeTests) where import BadgeService.Service (badgeErrorRetryAfter, shownServiceRequest, survive) -import BadgeService.StoreReceipts (StoreEnvironment (..), StoreReceipt (..), StoreRefusal (..), StoreTransaction (..), StoreVerifier (..), storeReceipt) +import BadgeService.StoreReceipts (StoreReceipt (..), StoreRefusal (..), StoreVerifier (..), VerifiedStoreTransaction (..), storeReceipt) import BadgeService.StoreReceipts.Mock (mockStoreVerifier) import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) @@ -39,8 +39,7 @@ import Simplex.Chat (defaultChatConfig) import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..), badgeRetryInterval, chatErrorAgent) import Simplex.Chat.Library.Commands (badgeErrorRetry, badgeFailureTransient, badgeIssueFailure, badgeRetryAfter, badgeServiceErrorText, badgeStalledInterval, storeTransactionRef) import Simplex.Chat.PaymentService (ServicePayment (..)) -import Simplex.Chat.PaymentService.Types (InvoiceId (..), PaymentProvider (..)) -import Simplex.Chat.Store.Badges (StoreTransactionRef (..)) +import Simplex.Chat.PaymentService.Types (InvoiceId (..), PaymentProvider (..), StoreTransactionRef (..)) import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), AgentServiceError (..), SMPAgentError (..)) import Simplex.Messaging.Agent.RetryInterval (RetryInterval (..), nextRetryDelay) import Simplex.Messaging.Crypto.BBS @@ -843,14 +842,14 @@ testStoreTransactionRef = do part = safeDecodeUtf8 . B64U.encodeUnpadded . encodeUtf8 apple = storeTransactionRef . SPApple -- the store may sign the same transaction again, and a retry must find the keys it stashed - apple (jws "2000000812345671" "c2lnbmVkIG9uY2U") `shouldBe` Just (StoreTransactionRef "apple" "2000000812345671") + apple (jws "2000000812345671" "c2lnbmVkIG9uY2U") `shouldBe` Just (StoreTransactionRef PPApple "2000000812345671") apple (jws "2000000812345671" "c2lnbmVkIGFnYWlu") `shouldBe` apple (jws "2000000812345671" "c2lnbmVkIG9uY2U") apple (jws "2000000812345672" "c2lnbmVkIG9uY2U") `shouldNotBe` apple (jws "2000000812345671" "c2lnbmVkIG9uY2U") apple "not.a-jws" `shouldBe` Nothing apple (T.intercalate "." [part "{}", part "{\"productId\":\"BADGE_SUPPORTER_01\"}", "sig"]) `shouldBe` Nothing -- a Play token is a bearer secret, so it is kept only as its hash let google = storeTransactionRef SPGoogle {productId = "badge_supporter_01", token = "play-token"} - google `shouldSatisfy` maybe False (\(StoreTransactionRef provider ref) -> provider == "google" && ref /= "play-token") + google `shouldSatisfy` maybe False (\(StoreTransactionRef provider ref) -> provider == PPGoogle && ref /= "play-token") google `shouldBe` storeTransactionRef SPGoogle {productId = "badge_supporter_01", token = "play-token"} storeTransactionRef SPInvoice {invoiceId = InvoiceId "inv"} `shouldBe` Nothing @@ -873,7 +872,7 @@ testGoogleProductIdPath = do _ -> False mapM_ (\p -> refused p `shouldBe` True) ["badge_legend_01/tokens/other?", "badge_legend_01?x", "badge_legend_01#x", "..", "../badge_legend_01", "Badge_legend_01", ""] case storeReceipt uncalledVerifier SPGoogle {productId = "badge_supporter_01", token = validPlayToken} of - Just (Right StoreReceipt {provider}) -> provider `shouldBe` PPGoogle + Just (Right StoreReceipt {txRef = StoreTransactionRef {provider}}) -> provider `shouldBe` PPGoogle _ -> expectationFailure "a valid product id and token were refused" testGoogleTokenPath :: IO () @@ -894,9 +893,9 @@ testMockVouchesForClaim = do let part = safeDecodeUtf8 . B64U.encodeUnpadded . encodeUtf8 signed = T.intercalate "." [part "{\"alg\":\"ES256\"}", part "{\"transactionId\":\"2000000812345671\",\"productId\":\"BADGE_SUPPORTER_01\"}", "c2lnbmVk"] vouchesForClaim payment = case storeReceipt mockStoreVerifier payment of - Just (Right StoreReceipt {providerRef, verifyReceipt}) -> + Just (Right StoreReceipt {txRef = StoreTransactionRef {transactionRef = providerRef}, verifyReceipt}) -> verifyReceipt >>= \case - Right StoreTransaction {transactionRef, environment} -> (transactionRef, environment) `shouldBe` (providerRef, SEProduction) + Right VerifiedStoreTransaction {transactionRef, testPurchase} -> (transactionRef, testPurchase) `shouldBe` (providerRef, False) Left refusal -> expectationFailure ("the mock refused: " <> show refusal) _ -> expectationFailure "refused before the mock was asked" vouchesForClaim SPApple {jws = signed} diff --git a/tests/Bots/BadgeService/FakeStore.hs b/tests/Bots/BadgeService/FakeStore.hs index c47e4d8bc3..a17a3302b7 100644 --- a/tests/Bots/BadgeService/FakeStore.hs +++ b/tests/Bots/BadgeService/FakeStore.hs @@ -59,11 +59,11 @@ newFakeStore = do pendingSettled <- newIORef False googleDown <- newIORef False let appleReceipts = - [ (appleSupporterJWS, appleTransaction "2000000812345671" "BADGE_SUPPORTER_01" SEProduction 700), - (appleLegendJWS, appleTransaction "2000000812345672" "BADGE_LEGEND_01" SEProduction 7000), - (appleSandboxJWS, appleTransaction "2000000812345673" "BADGE_LEGEND_01" SETest 7000), + [ (appleSupporterJWS, appleTransaction "2000000812345671" "BADGE_SUPPORTER_01" False 700), + (appleLegendJWS, appleTransaction "2000000812345672" "BADGE_LEGEND_01" False 7000), + (appleSandboxJWS, appleTransaction "2000000812345673" "BADGE_LEGEND_01" True 7000), -- a verifier vouching for another transaction than the one the evidence names - (appleMisnamedJWS, appleTransaction "2000000812345671" "BADGE_SUPPORTER_01" SEProduction 700) + (appleMisnamedJWS, appleTransaction "2000000812345671" "BADGE_SUPPORTER_01" False 700) ] verifyApple jws | jws == appleThrowingJWS = error "fake verifier bug" @@ -82,10 +82,10 @@ newFakeStore = do } where fixtureJWS name = unsignedJWS <$> B.readFile (fixtureDir name) - appleTransaction transactionRef productId environment cents = - StoreTransaction {transactionRef, productId, quantity = 1, environment, paid = Just (CurrencyAmount cents, "USD")} + appleTransaction transactionRef productId testPurchase cents = + VerifiedStoreTransaction {transactionRef, productId, quantity = 1, testPurchase, paid = Just (CurrencyAmount cents, "USD")} -googleVerdict :: IORef Bool -> IORef Bool -> Text -> Text -> IO (Either StoreRefusal StoreTransaction) +googleVerdict :: IORef Bool -> IORef Bool -> Text -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction) googleVerdict pendingSettled googleDown productId token = readIORef googleDown >>= \case True -> pure $ Left $ SRUnreachable "fake store is down" @@ -100,7 +100,7 @@ googleVerdict pendingSettled googleDown productId token = | token == googleHangingToken -> forever $ threadDelay 1000000 | otherwise -> pure $ Left $ SRInvalid "not a fake purchase" where - purchased = StoreTransaction {transactionRef = googlePurchaseRef token, productId, quantity = 1, environment = SEProduction, paid = Nothing} + purchased = VerifiedStoreTransaction {transactionRef = googlePurchaseRef token, productId, quantity = 1, testPurchase = False, paid = Nothing} settlePending :: FakeStore -> IO () settlePending FakeStore {pendingSettled} = writeIORef pendingSettled True