fixup! core: resume a retired Apple subscription when its store charges it again

Review round 1 fixes:
- R1-1: a resumable charge waiting behind another held receipt of the owner is answered held and left unfinished, rather than answered from the record and finished uncredited.
- R1-3: a resume shows the purchase again only with a credential that has not expired.
- R1-2, R1-8: tests of the resumable-charge rule and the hold's edge, of a held charge whose paid period ends before it is sent, and that a resumed profile shows the newest credential. The resume test is split in two, one environment each.
- R2-V1: a test comment that the reordered steps made false.

Run: 011-subscription-resume, review rounds 1 and 2

src/Simplex/Chat/Library/Commands.hs

@@ -5377,12 +5377,12 @@ handOverStoreReceipt presentingUser echoedInvoiceId origin payment = do
       case status of
         RSHeld {} -> lift (resumeStoreReceiptWork ownerId) >> badgeStateResponse owner
         RSCredited {badgePurchaseId, refusalRecorded} -> do
-          resumed <- case resumableCharge now payment of
+          answeredHeld <- case resumableCharge now payment of
             -- a charge refused after its hold is answered from the record, or the app's sweep would hold it again at every launch
             Just purchasedAt | not (refusalRecorded && resumeHoldEnded now purchasedAt) ->
               withStore' $ \db -> reholdStoreReceipt db owner receiptId badgePurchaseId payment now
             _ -> pure False
-          if resumed
+          if answeredHeld
             then lift (resumeStoreReceiptWork ownerId) >> badgeStateResponse owner
             else do
               cred_ <- withStore' (`getLatestIssuedCredential` badgePurchaseId)
@@ -5732,7 +5732,7 @@ creditStoreReceipt a userId receiptId stash@BadgeStash {masterKey} invoiceId_ pa
         Right (Right (balance, stored)) ->
           withStore' (`getLatestIssuedCredential` badgePurchaseId) >>= \case
             Just cred@(BadgeCredential _ _ _ info)
-              | L.paidThrough balance > answeredAt && stored /= Just SSEnded -> do
+              | L.paidThrough balance > answeredAt && credentialExpiry cred > answeredAt && stored /= Just SSEnded -> do
                   user' <- withStore $ \db -> do
                     liftIO $ showResumedPurchase db user receiptId badgePurchaseId stored
                     setUserBadge db user (Just $ OwnBadge cred (mkBadgeStatus answeredAt (Just True) info))

src/Simplex/Chat/Store/Badges.hs

@@ -50,7 +50,7 @@ module Simplex.Chat.Store.Badges
 where
 
 import Control.Concurrent.STM (TVar, atomically)
-import Control.Monad (forM, forM_, join)
+import Control.Monad (forM, forM_, join, when)
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
@@ -298,20 +298,22 @@ settleStoreReceipt db receiptId =
     "UPDATE badge_store_receipts SET payment = NULL, next_attempt_at = NULL, retry_delay = NULL, retry_count = 0, credit_error = NULL WHERE badge_store_receipt_id = ?"
     (Only receiptId)
 
--- | Holds a credited record again for a later charge of its subscription while its purchase is its owner's newest,
--- a subscription and not shown, and no other receipt of the owner is held: the receipt worker would credit that one
--- first, and then skip this one while its badge is shown.
+-- | Whether a later charge of a credited record's subscription is answered as held: its purchase must be its owner's
+-- newest, a subscription and not shown. The record is held again only while no other receipt of the owner is held,
+-- which the receipt worker would credit first and then skip this one while its badge is shown; until then the app
+-- keeps the charge unfinished and hands it over again.
 reholdStoreReceipt :: DB.Connection -> User -> Int64 -> Int64 -> ServicePayment -> UTCTime -> IO Bool
 reholdStoreReceipt db owner receiptId badgePurchaseId payment now = do
   newest_ <- getUserBadgePurchase db owner
   pending <- getPendingStoreReceipts db owner
   case newest_ of
     Just UserBadgePurchase {badgePurchaseId = newestId, shown = False, purchaseKind = PKSubscription _}
-      | newestId == badgePurchaseId && null pending -> do
-          DB.execute
-            db
-            "UPDATE badge_store_receipts SET payment = ?, next_attempt_at = ?, retry_delay = NULL, retry_count = 0, credit_error = NULL WHERE badge_store_receipt_id = ? AND payment IS NULL"
-            (safeDecodeUtf8 . LB.toStrict $ J.encode payment, now, receiptId)
+      | newestId == badgePurchaseId -> do
+          when (null pending) $
+            DB.execute
+              db
+              "UPDATE badge_store_receipts SET payment = ?, next_attempt_at = ?, retry_delay = NULL, retry_count = 0, credit_error = NULL WHERE badge_store_receipt_id = ? AND payment IS NULL"
+              (safeDecodeUtf8 . LB.toStrict $ J.encode payment, now, receiptId)
           pure True
     _ -> pure False