review: round 2 fixes

- R2-1: a granted tier change clears an ended state the device reported before it. A renewing report never replaces ended, and a charge of the new tier granted proves the subscription has not ended, so without this the worker retired the new tier's badge at its paid-through while the subscription renewed.
- R1-B3: test a tier change whose credential does not verify: the failure stays on the receipt record, not the purchase, and Supporter stays shown.
- R2-3: the refused tier change's test buys Supporter through an invoice, so it shows the refusal announces nothing.
- R2-2: the changeTier comment says what follows each way the record settles.

Run: 015-badge-fixes, review round 2

src/Simplex/Chat/Library/Commands.hs

@@ -5781,8 +5781,9 @@ creditStoreReceipt a userId receiptId stash@BadgeStash {masterKey} invoiceId_ pa
                   pure $ SROCredited (Just user')
             -- the service's own check interval
             _ -> notCredited $ failed ri delay BIFServiceError {code = BSEPaymentPending, retryable = True} (Just 3600)
-    -- Past the window, once the purchase's ledger holds the tier charged, or once its badge is no longer shown, the record
-    -- settles with nothing to announce: the service grants the change at its next renewal check.
+    -- The record settles with nothing to announce past the window, when the service grants the change at its next renewal
+    -- check; once the purchase's ledger holds the tier charged, when there is nothing to change; or once its badge is no
+    -- longer shown, when the charge's next hand-over resumes the purchase.
     changeTier ri delay purchaseId = do
       user <- withStore $ \db -> getUser db userId
       p_ <- withStore' (`getBadgePurchase` purchaseId)

src/Simplex/Chat/Store/Badges.hs

@@ -66,7 +66,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 (..), BadgeServiceErrorCode (..), BadgeSubscription (..), OpenStorePurchase (..), StoreReceiptOrigin (..), SubscriptionState)
+import Simplex.Chat.Badges.Types (BadgeAlertKind, BadgeIssueError (..), BadgeIssueFailure (..), BadgePurchaseStatus (..), BadgeServiceErrorCode (..), BadgeSubscription (..), OpenStorePurchase (..), StoreReceiptOrigin (..), SubscriptionState (..))
 import Simplex.Chat.PaymentService (AppleTransactionFacts (..), ServicePayment (..), appleTransactionFacts)
 import Simplex.Chat.PaymentService.Types (StoreTransactionRef (..))
 import Simplex.Chat.Store.Shared (StoreError, insertedRowId)
@@ -416,10 +416,11 @@ showResumedPurchase db User {userId} receiptId badgePurchaseId state = do
   DB.execute db "UPDATE badge_purchases SET subscription_status = ? WHERE badge_purchase_id = ?" (state, badgePurchaseId)
   DB.execute db "UPDATE users SET shown_badge_id = ? WHERE user_id = ?" (badgePurchaseId, userId)
 
--- | A tier change's credit, which shows the purchase again if a retire cleared it while the change was with the service.
+-- | A tier change's credit: shows the purchase again if a retire cleared it meanwhile, and drops an ended its grant disproves.
 showTierChangedPurchase :: DB.Connection -> User -> Int64 -> Int64 -> IO ()
 showTierChangedPurchase db User {userId} receiptId badgePurchaseId = do
   settleStoreReceipt db receiptId
+  DB.execute db "UPDATE badge_purchases SET subscription_status = NULL WHERE badge_purchase_id = ? AND subscription_status = ?" (badgePurchaseId, SSEnded)
   DB.execute db "UPDATE users SET shown_badge_id = ? WHERE user_id = ?" (badgePurchaseId, userId)
 
 -- | A held record is paid for and a credited one is referenced by its purchase, so neither is deleted.

tests/Bots/BadgeService/BotTests.hs

@@ -277,6 +277,8 @@ badgeServiceTests = do
     it "should show the purchase a tier change credits, though a retire cleared it while the change was with the service" testAppleTierChangeKeepsPurchaseShown
     it "should refuse in silence an Apple tier change the store does not vouch for, keeping the badge shown, and answer it again from the record" testAppleTierChangeRefused
     it "should hold and credit an Apple tier change while another receipt of the owner is held" testAppleTierChangeBesideHeldReceipt
+    it "should keep renewing a tier change's purchase that the device reported ended before the change" testAppleTierChangeClearsEnded
+    it "should record on the receipt, not the purchase, a tier change whose credential does not verify" testAppleTierChangeCredentialUnverified
     it "should answer an Apple resubscription from the record when it cannot resume, refuse a held one that stops being resumable or that the service does not grant within its hold, and keep one behind another held receipt unfinished" testAppleResubscribeBounded
     it "should ask the App Store about a subscription claim at most once an hour, whoever presents it and as any of its transactions" testApplePurchaseChecksBounded
     it "should ask Play about a subscription token at most once an hour, whoever presents it, credited to another key or not" testPlayPurchaseChecksBounded
@@ -4179,12 +4181,22 @@ legendBoughtAt = posixSecondsToUTCTime 1769904000
 
 -- | A monthly Apple Supporter subscription bought five days before the Legend transaction, shown; the clock an hour into that transaction.
 appleSupporterBeforeLegend :: HasCallStack => BadgeServiceEnv -> TestCC -> IO ()
-appleSupporterBeforeLegend BadgeServiceEnv {bsClock, bsStore = store@FakeStore {appleSubscriptionJWS}} alice = do
+appleSupporterBeforeLegend env alice = appleSupporterBeforeLegendWith env alice Nothing
+
+-- | The same, handed over with the invoice given, if any.
+appleSupporterBeforeLegendWith :: HasCallStack => BadgeServiceEnv -> TestCC -> Maybe String -> IO ()
+appleSupporterBeforeLegendWith BadgeServiceEnv {bsClock, bsStore = store@FakeStore {appleSubscriptionJWS}} alice invoiceId_ = do
   let firstStart = addUTCTime (-5 * nominalDay) legendBoughtAt
+      supporter = SPApple {jws = appleSubscriptionJWS}
   setClockAt bsClock $ addUTCTime 3600 firstStart
   appleStoreReports store $ subscriptionCheck SSRenewing $ Just $ storeCharge "SUBSCR_BADGE_SUPPORTER_MONTH_01" firstStart 1
-  alice ##> ("/_badge purchase 1 " <> paymentArg SPApple {jws = appleSubscriptionJWS})
-  inAnyOrder alice [[openPurchase ""], ["1: supporter"]]
+  case invoiceId_ of
+    Nothing -> do
+      alice ##> ("/_badge purchase 1 " <> paymentArg supporter)
+      inAnyOrder alice [[openPurchase ""], ["1: supporter"]]
+    Just invoiceId -> do
+      alice ##> purchaseWithInvoice 1 invoiceId supporter
+      inAnyOrder alice [[invoicePurchase "" invoiceId], creditedLines "" invoiceId "1: supporter"]
   waitWakeArmed (chatController alice)
   setClockAt bsClock $ addUTCTime 3600 legendBoughtAt
 
@@ -4285,7 +4297,8 @@ testAppleTierChangeRefused :: HasCallStack => TestParams -> IO ()
 testAppleTierChangeRefused ps =
   withBadgeServiceEnv ps $ \env@BadgeServiceEnv {bsClientCfg, bsStore = store} ->
     withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do
-      appleSupporterBeforeLegend env alice
+      invoiceId <- createInvoice alice 1
+      appleSupporterBeforeLegendWith env alice (Just invoiceId)
       let unvouched = subscriptionJWS appleSubscriptionOriginalId "2000000812345696" ["purchaseDate" J..= (1769904000000 :: Int64), "productId" J..= ("SUBSCR_BADGE_LEGEND_YEAR_01" :: Text)]
           handOver = alice ##> ("/_badge purchase 1 " <> paymentArg SPApple {jws = unvouched})
       checks <- subscriptionChecks store
@@ -4316,6 +4329,43 @@ testAppleTierChangeBesideHeldReceipt ps =
       waitShownIssued (chatController alice)
       heldStoreReceipts (chatController alice) `shouldReturn` 1
 
+testAppleTierChangeClearsEnded :: HasCallStack => TestParams -> IO ()
+testAppleTierChangeClearsEnded ps =
+  withBadgeServiceEnv ps $ \env@BadgeServiceEnv {bsClock, bsClientCfg, bsStore = store@FakeStore {appleSubscriptionJWS, appleLegendSubscriptionJWS}} ->
+    withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do
+      appleSupporterBeforeLegend env alice
+      alice ##> ("/_badge subscription ended " <> paymentArg SPApple {jws = appleSubscriptionJWS})
+      alice <### ["ok", Predicate (\l -> "1: supporter" `isPrefixOf` l && ", subscription ended" `isInfixOf` l)]
+      -- a monthly Legend charge, so the month it funds ends within the test
+      appleStoreReports store $ subscriptionCheck SSRenewing $ Just (storeCharge "SUBSCR_BADGE_LEGEND_MONTH_01" legendBoughtAt 1) {chargeRef = "apple.legend"}
+      alice ##> ("/_badge purchase 1 " <> paymentArg SPApple {jws = appleLegendSubscriptionJWS})
+      expectLinesWithin 30 alice ["1: legend"] ["1: supporter", "store purchase open", "subscribed "]
+      waitShownIssued (chatController alice)
+      paidThrough <- dueAtOf <$> ledgerRows (chatController alice) "badge_ledger"
+      (Just expiry, _) <- shownAndIssuedExpiry (chatController alice)
+      let pastPaidThrough = addUTCTime 3600 paidThrough
+          requestAt = addUTCTime (-nominalDay) expiry
+      pastPaidThrough `shouldSatisfy` (< requestAt)
+      setClockAt bsClock pastPaidThrough
+      alice ##> "/_app activate"
+      alice <## "ok"
+      waitWakeFrom (chatController alice) requestAt
+      shownBadgeId (chatController alice) `shouldReturn` Just 1
+      subscriptionStatuses (chatController alice) `shouldReturn` [Nothing]
+
+testAppleTierChangeCredentialUnverified :: HasCallStack => TestParams -> IO ()
+testAppleTierChangeCredentialUnverified ps =
+  withBadgeServiceEnv ps $ \env@BadgeServiceEnv {bsClientCfg, bsStore = store@FakeStore {appleLegendSubscriptionJWS}} -> do
+    withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> appleSupporterBeforeLegend env alice
+    appleReportsLegend store
+    -- trusting no issuer key, so the Legend credential the service issues does not verify
+    withTestChatCfg ps bsClientCfg {badgePublicKeys = M.empty} "alice" $ \alice -> do
+      alice ##> ("/_badge purchase 1 " <> paymentArg SPApple {jws = appleLegendSubscriptionJWS})
+      expectLinesWithin 30 alice ["1: supporter", "internal chat error: issued badge credential does not verify"] ["store purchase open", "subscribed "]
+      heldStoreReceiptErrors (chatController alice) `shouldEventuallyReturn` ["invalid_credential"]
+      issueErrorRow (chatController alice) `shouldReturn` (Nothing, Nothing)
+      shownBadgeId (chatController alice) `shouldReturn` Just 1
+
 -- | A monthly Apple subscription bought an hour into its first period and retired past its coverage, at its request
 -- moment, on the service's answer that it ended: that moment.
 appleSubscriptionRetired :: HasCallStack => BadgeServiceEnv -> TestCC -> IO UTCTime