diff --git a/bots/src/API/Docs/Responses.hs b/bots/src/API/Docs/Responses.hs index 674620487f..fc1629c393 100644 --- a/bots/src/API/Docs/Responses.hs +++ b/bots/src/API/Docs/Responses.hs @@ -208,6 +208,7 @@ undocumentedResponses = "CRSndStandaloneFileCreated", "CRSQLResult", "CRStandaloneFileInfo", + "CRStoreReceiptNotRecorded", "CRTagsUpdated", "CRUsageConditions", "CRUserPrivacy", diff --git a/src/Simplex/Chat/Badges/Types.hs b/src/Simplex/Chat/Badges/Types.hs index 88f5c03cc5..679142b2ce 100644 --- a/src/Simplex/Chat/Badges/Types.hs +++ b/src/Simplex/Chat/Badges/Types.hs @@ -33,6 +33,7 @@ module Simplex.Chat.Badges.Types BadgeSubscription (..), BadgeState (..), OpenStorePurchase (..), + StoreReceiptOrigin (..), ) where import Control.Applicative ((<|>)) @@ -314,6 +315,13 @@ data OpenStorePurchase = OpenStorePurchase } deriving (Show) +-- | Where the app found a store transaction it hands over. The store lists an account's purchases on every +-- device signed into it, so a listed one is claimed only by a core that already has a record for it. +data StoreReceiptOrigin + = SROPurchased -- the app's own purchase call, or Restore + | SROListed -- the store's list of unfinished transactions, or its updates + deriving (Eq, Show) + instance TextEncoding BadgePurchaseStatus where textEncode = \case PSAcquiring -> "acquiring" diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 07d100d872..0c2f13405c 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -85,7 +85,7 @@ import Simplex.Messaging.Client (HostMode (..), SMPProxyFallback (..), SMPProxyM import qualified Simplex.Messaging.Crypto as C import Simplex.Chat.Badges (BadgeCredential, FileSizeLimits, LocalBadge) import Simplex.Chat.Badges.Service (BadgeServiceErrorCode, StatementEntry) -import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind, BadgeIssueFailure, BadgeState (..), OpenStorePurchase (..), SubscriptionState) +import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind, BadgeIssueFailure, BadgeState (..), OpenStorePurchase (..), StoreReceiptOrigin, SubscriptionState) import Simplex.Chat.PaymentService (ServicePayment) import Simplex.Messaging.Crypto.BBS (BBSPublicKey) import Simplex.Messaging.Crypto.File (CryptoFile (..)) @@ -665,7 +665,7 @@ data ChatCommand | UpdateProfileImageFromFile FilePath -- set profile image from a .png/.jpg/.jpeg file | AddBadge BadgeCredential -- attach an issued badge credential (testing; credential from `simplex-chat badge sign`) | APIRedeemBadgeCode {userId :: UserId, code :: Text} -- redeem a badge code with the configured badge service - | APIPurchaseBadge {userId :: UserId, echoedInvoiceId :: Maybe Text, payment :: ServicePayment} -- hand over an App Store or Google Play receipt, held until a worker credits it; answers from the record and sends nothing + | APIPurchaseBadge {userId :: UserId, echoedInvoiceId :: Maybe Text, origin :: StoreReceiptOrigin, payment :: ServicePayment} -- hand over an App Store or Google Play receipt, held until a worker credits it; answers from the record and sends nothing | APISetBadgeSubscriptionStatus {status :: SubscriptionState, payment :: ServicePayment} -- the device store's view of a credited subscription, which changes only what is shown and alerted | APICreateBadgeInvoice {userId :: UserId} -- the record of a store purchase, created before the store charges; answers the id the store echoes | APIGetBadgeState {userId :: UserId} -- the user's badges, their balances and any current alert @@ -879,6 +879,7 @@ data ChatResponse | CRServiceReplyAccepted {user :: User, connectionId :: AgentConnId} | CRBadgeRedeemed {user :: User, redeemedBadge :: LocalBadge, newBadge :: Bool, badgeState :: Maybe BadgeState} | CRBadgeInvoice {user :: User, invoiceId :: Text} + | CRStoreReceiptNotRecorded {user :: User} | CRBadgeState {user :: User, badgeState :: Maybe BadgeState, storePurchases :: [OpenStorePurchase]} | CRBadgeLedger {user :: User, badgeLedger :: [StatementEntry]} | CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 5ef428c754..01a5931a0e 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -61,7 +61,7 @@ import Crypto.Random (ChaChaDRG) import Simplex.Messaging.Session (SessionVar (..), withGetSessVar') import Simplex.Chat.Badges (BadgeCredential (..), BadgeInfo (..), BadgeMasterKey, BadgeType, LocalBadge (..), badgeServerCredential, mkBadgeStatus, maxSndXFTPFileSize, verifyCredential) import qualified Simplex.Chat.Badges.Ledger as L -import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind (..), BadgeIssueError (..), BadgeIssueFailure (..), BadgeState (..), BadgeSubscription (..), OpenStorePurchase (..)) +import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind (..), BadgeIssueError (..), BadgeIssueFailure (..), BadgeState (..), BadgeSubscription (..), OpenStorePurchase (..), StoreReceiptOrigin (..)) import Simplex.Chat.Badges.Code (badgeCodeText, parseBadgeCode) import Simplex.Chat.Badges.Service (BadgeBalance (..), BadgeServiceCommand (..), BadgeServiceErrorCode (..), BadgeServiceRequest (..), BadgeServiceResponse (..), BadgeStatement (..), StatementDebitType (..), StatementEntry (..), StatementEntryType (..), SubscriptionState (..), currentBadgeServiceVersion) import Simplex.Chat.Names (SimplexDomainProof (..), SimplexDomainClaim (..), claimDomain, mkDomainClaim) @@ -3581,7 +3581,7 @@ processChatCommand cxt nm = \case ShowProfile -> withUser $ \user@User {profile} -> pure $ CRUserProfile user (fromLocalProfile profile) AddBadge cred -> withUser $ \user -> addUserBadge user cred >> ok user APIRedeemBadgeCode userId codeText -> withUserId userId $ \user -> redeemBadgeCode nm user codeText - APIPurchaseBadge userId echoedInvoiceId payment -> withUserId userId $ \user -> handOverStoreReceipt user echoedInvoiceId payment + APIPurchaseBadge userId echoedInvoiceId origin payment -> withUserId userId $ \user -> handOverStoreReceipt user echoedInvoiceId origin payment APISetBadgeSubscriptionStatus status payment -> recordStoreSubscriptionStatus status payment >> ok_ APICreateBadgeInvoice userId -> withUserId userId $ \user -> do void requireBadgeService @@ -5285,24 +5285,26 @@ redeemBadgeCode nm user@User {userId} codeText = do -- | The app hands a receipt over until it is answered credited or refused, under whichever profile is -- active; the answer is the owner's, read from the record. Nothing is sent: the owner's receipt worker is. -handOverStoreReceipt :: User -> Maybe Text -> ServicePayment -> CM ChatResponse -handOverStoreReceipt presentingUser echoedInvoiceId payment = do +handOverStoreReceipt :: User -> Maybe Text -> StoreReceiptOrigin -> ServicePayment -> CM ChatResponse +handOverStoreReceipt presentingUser echoedInvoiceId origin payment = do txRef <- maybe (throwRedeemError BREInvalidReceipt) pure $ storeTransactionRef payment void requireBadgeService g <- asks random now <- badgeNow - BadgeReceiptRecord {ownerId, status} <- - withStore' (\db -> holdStoreReceipt db g presentingUser echoedInvoiceId txRef payment now) - >>= maybe (throwChatError $ CEInternalError "store receipt was not recorded") pure - owner <- withStore $ \db -> getUser db ownerId - case status of - RSHeld {} -> lift (resumeStoreReceiptWork ownerId) >> badgeStateResponse owner - RSCredited {badgePurchaseId} -> do - cred_ <- withStore' (`getLatestIssuedCredential` badgePurchaseId) - cred@(BadgeCredential _ _ _ info) <- maybe (throwChatError $ CEInternalError "credited store purchase has no credential") pure cred_ - CRBadgeRedeemed owner (OwnBadge cred (mkBadgeStatus now (Just True) info)) False <$> getUserBadgeState owner - RSRefused {refusal = Just BIFServiceError {code}} -> throwRedeemError $ BREServiceError code - RSRefused {} -> throwChatError $ CEInternalError "store purchase refused for no recorded reason" + withStore' (\db -> holdStoreReceipt db g presentingUser origin echoedInvoiceId txRef payment now) >>= \case + Nothing -> case origin of + SROListed -> pure $ CRStoreReceiptNotRecorded presentingUser + SROPurchased -> throwChatError $ CEInternalError "store receipt was not recorded" + Just BadgeReceiptRecord {ownerId, status} -> do + owner <- withStore $ \db -> getUser db ownerId + case status of + RSHeld {} -> lift (resumeStoreReceiptWork ownerId) >> badgeStateResponse owner + RSCredited {badgePurchaseId} -> do + cred_ <- withStore' (`getLatestIssuedCredential` badgePurchaseId) + cred@(BadgeCredential _ _ _ info) <- maybe (throwChatError $ CEInternalError "credited store purchase has no credential") pure cred_ + CRBadgeRedeemed owner (OwnBadge cred (mkBadgeStatus now (Just True) info)) False <$> getUserBadgeState owner + RSRefused {refusal = Just BIFServiceError {code}} -> throwRedeemError $ BREServiceError code + RSRefused {} -> throwChatError $ CEInternalError "store purchase refused for no recorded reason" -- | Renewing does not replace billing retry or ended: Play lists a subscription in its grace period as renewing, -- and the service's answer clears billing retry once the store charges. @@ -6376,7 +6378,7 @@ chatCommandP = "/_reject " *> (APIRejectContact <$> A.decimal <*> (" notify=" *> onOffP <|> pure False)), "/_service_request " *> (APISendServiceRequest <$> A.decimal <* A.space <*> strP <*> optional (" timeout=" *> (realToFrac <$> A.double)) <*> optional (" sign_key=" *> strP) <* A.space <*> jsonP), "/_redeem_badge_code " *> (APIRedeemBadgeCode <$> A.decimal <* A.space <*> textP), - "/_badge purchase " *> (APIPurchaseBadge <$> A.decimal <*> optional (" invoice=" *> (safeDecodeUtf8 <$> A.takeTill (== ' '))) <* A.space <*> jsonP), + "/_badge purchase " *> (APIPurchaseBadge <$> A.decimal <*> optional (" invoice=" *> (safeDecodeUtf8 <$> A.takeTill (== ' '))) <*> (" listed" $> SROListed <|> pure SROPurchased) <* A.space <*> jsonP), "/_badge subscription " *> (APISetBadgeSubscriptionStatus <$> subscriptionStateP <* A.space <*> jsonP), "/_badge invoice " *> (APICreateBadgeInvoice <$> A.decimal), "/_badge state " *> (APIGetBadgeState <$> A.decimal), diff --git a/src/Simplex/Chat/Store/Badges.hs b/src/Simplex/Chat/Store/Badges.hs index 55d02559c9..9693e5c3e5 100644 --- a/src/Simplex/Chat/Store/Badges.hs +++ b/src/Simplex/Chat/Store/Badges.hs @@ -56,7 +56,7 @@ import Data.Time.Clock (UTCTime) 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 (..), BadgeSubscription (..), OpenStorePurchase (..), SubscriptionState) +import Simplex.Chat.Badges.Types (BadgeAlertKind, BadgeIssueError (..), BadgeIssueFailure, BadgePurchaseStatus (..), BadgeSubscription (..), OpenStorePurchase (..), StoreReceiptOrigin (..), SubscriptionState) import Simplex.Chat.PaymentService (ServicePayment) import Simplex.Chat.PaymentService.Types (StoreTransactionRef (..)) import Simplex.Chat.Store.Shared (StoreError, insertedRowId) @@ -130,9 +130,10 @@ data BadgeReceiptStatus -- concurrent hand-over of the same transaction may win either write. It stays with the record that already has -- it, whose keys the service may have credited; failing that it joins the record Buy created; and when no record -- can take it - the store echoed no invoice, or the one it echoed is already held by another transaction - the --- presenting profile gets a new one, nothing else saying who paid. -holdStoreReceipt :: DB.Connection -> TVar ChaChaDRG -> User -> Maybe Text -> StoreTransactionRef -> ServicePayment -> UTCTime -> IO (Maybe BadgeReceiptRecord) -holdStoreReceipt db g User {userId} invoiceId_ txRef@StoreTransactionRef {provider, transactionRef} payment now = +-- presenting profile gets a new one, nothing else saying who paid, unless the app found the transaction in the +-- store's list: then it may be another device's, and nothing is recorded. +holdStoreReceipt :: DB.Connection -> TVar ChaChaDRG -> User -> StoreReceiptOrigin -> Maybe Text -> StoreTransactionRef -> ServicePayment -> UTCTime -> IO (Maybe BadgeReceiptRecord) +holdStoreReceipt db g User {userId} origin invoiceId_ txRef@StoreTransactionRef {provider, transactionRef} payment now = getReceiptRecord db txRef >>= \case Just r@BadgeReceiptRecord {receiptId} -> do -- a resolved record stays resolved, so a hand-over landing just after its credit cannot hold it again @@ -146,9 +147,11 @@ holdStoreReceipt db g User {userId} invoiceId_ txRef@StoreTransactionRef {provid (provider, transactionRef, paymentJSON, now, invoiceId) getReceiptRecord db txRef >>= \case Just r -> pure $ Just r - Nothing -> do - insertReceipt - getReceiptRecord db txRef + Nothing -> case origin of + SROPurchased -> do + insertReceipt + getReceiptRecord db txRef + SROListed -> pure Nothing where paymentJSON = safeDecodeUtf8 . LB.toStrict $ J.encode payment insertReceipt = do diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 4672699a33..40fd52dfbf 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -194,6 +194,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, showFullLinks, te -- the badge is only shown when it is the one now on the profile; a replayed code's badge may not be CRBadgeRedeemed u badge newBadge _ -> ttyUser u $ if newBadge then "badge redeemed" : viewContactBadge (Just badge) else ["badge already redeemed"] CRBadgeInvoice u invoiceId -> ttyUser u ["badge invoice: " <> plain invoiceId] + CRStoreReceiptNotRecorded u -> ttyUser u ["store purchase not recorded"] CRBadgeState u st storePurchases -> ttyUser u $ viewUserBadgeState st <> map viewOpenStorePurchase storePurchases CRBadgeLedger u entries -> ttyUser u $ viewBadgeLedger entries CRGroupCreated u g -> ttyUser u $ viewGroupCreated g testView diff --git a/tests/Bots/BadgeService/BotTests.hs b/tests/Bots/BadgeService/BotTests.hs index 25e607286d..48168bb5dc 100644 --- a/tests/Bots/BadgeService/BotTests.hs +++ b/tests/Bots/BadgeService/BotTests.hs @@ -165,6 +165,7 @@ badgeServiceTests = do it "should hold a Play token the service will not send to Play" testPurchaseUnsentPlayToken it "should credit a purchase first handed over under another profile to that profile" testPurchaseStrandedUnderOtherProfile it "should credit a purchase to a hidden profile without naming it" testPurchaseDeliveredToHiddenProfile + it "should record a listed transaction only into a record it already has, and a Restore hand-over as its own" testListedReceiptNotRecorded describe "invoice first" $ do it "should credit a receipt to the profile that created its invoice however late it arrives, and answer as that profile" testInvoiceOtherProfile it "should credit a receipt naming an unknown invoice to the presenting profile" testInvoiceUnknown @@ -2661,6 +2662,32 @@ testInvoiceOtherProfile ps = alice ##> "/user alice" showActiveUser alice "alice (Alice, * supporter)" +-- | The store lists an account's purchases on every device signed into it, so a listed one may be another device's. +testListedReceiptNotRecorded :: HasCallStack => TestParams -> IO () +testListedReceiptNotRecorded ps = + withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClientCfg, bsController = cc} -> + withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + let listed invoiceId_ payment = "/_badge purchase 1" <> maybe "" (" invoice=" <>) invoiceId_ <> " listed " <> paymentArg payment + alice ##> listed (Just "0b6a5e6c-4f3e-4d51-9f55-3a0f7c2f9e11") supporterPlay + alice <## "store purchase not recorded" + storeReceiptRows (chatController alice) `shouldReturn` [] + nothingPurchased cc + invoiceId <- createInvoice alice 1 + alice ##> listed (Just invoiceId) supporterPlay + inAnyOrder alice [[invoicePurchase "" invoiceId], creditedLines "" invoiceId "1: supporter"] + alice ##> listed Nothing supporterPlay + alice <## "badge already redeemed" + alice ##> listed Nothing subscriptionPlay + alice <## "store purchase not recorded" + storeReceiptRows (chatController alice) `shouldReturn` [(1, Just (T.pack invoiceId), True)] + -- unmarked, as Restore sends it, the same transaction is recorded; held, as a badge is shown + alice ##> ("/_badge purchase 1 " <> paymentArg subscriptionPlay) + alice <##. "1: supporter" + storePurchaseOpen alice "" + storeReceiptRows (chatController alice) `shouldReturn` [(1, Just (T.pack invoiceId), True), (1, Nothing, True)] + heldStoreReceipts (chatController alice) `shouldReturn` 1 + rowCount cc "sx_badge_service_payments" `shouldReturn` 1 + testInvoiceUnknown :: HasCallStack => TestParams -> IO () testInvoiceUnknown ps = withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClientCfg} ->