core: alert a subscriber that a payment failed, a renewal nears, or it was cancelled or ended

A subscription's alerts were the prepaid ones: a retired subscription said
"support ended", and nothing told the user a payment failed, an annual
renewal was near, or a cancelled subscription still runs. The derived alert
for a subscription is now, in order: subscription_ended once retired,
payment_issue while the store retries, issue_failed as before,
subscription_cancelled before paidThrough, and renewal_approaching from
three days before an annual plan renews, with a wake at that moment. Monthly
plans get no reminder, as there is no opt-out yet.

The unreleased migration's down step clears an acked subscription_cancelled,
which an older core cannot read.

Run: 003-badge-subscriptions-ui, slice 7

src/Simplex/Chat/Badges/Types.hs

@@ -120,13 +120,14 @@ data LedgerDebitType
   deriving (Eq, Show)
 
 -- unconfirmed draft
-data BadgeAlertKind = BARenewalApproaching | BAPaymentIssue | BASubscriptionEnded | BAPrepaidEnding | BASupportEnded | BAIssueFailed
+data BadgeAlertKind = BARenewalApproaching | BAPaymentIssue | BASubscriptionCancelled | BASubscriptionEnded | BAPrepaidEnding | BASupportEnded | BAIssueFailed
   deriving (Eq, Show)
 
 instance TextEncoding BadgeAlertKind where
   textEncode = \case
     BARenewalApproaching -> "renewal_approaching"
     BAPaymentIssue -> "payment_issue"
+    BASubscriptionCancelled -> "subscription_cancelled"
     BASubscriptionEnded -> "subscription_ended"
     BAPrepaidEnding -> "prepaid_ending"
     BASupportEnded -> "support_ended"
@@ -134,6 +135,7 @@ instance TextEncoding BadgeAlertKind where
   textDecode = \case
     "renewal_approaching" -> Just BARenewalApproaching
     "payment_issue" -> Just BAPaymentIssue
+    "subscription_cancelled" -> Just BASubscriptionCancelled
     "subscription_ended" -> Just BASubscriptionEnded
     "prepaid_ending" -> Just BAPrepaidEnding
     "support_ended" -> Just BASupportEnded

src/Simplex/Chat/Library/Commands.hs

@@ -5637,7 +5637,10 @@ updateUserBadge userId emitted now = do
               UserBadgePurchase {alertSnoozeUntil, issueError = failureAfter, purchaseKind = kindAfter} = p'
               snoozeAt = find (> now) alertSnoozeUntil
               stalledAt = if requestDue && not issued then Just $ badgeStalledInterval `addUTCTime` now else Nothing
-              wakeAt = earliestTime [serviceAt, snoozeAt, stalledAt, badgeBoundary now (shownBadgeCredential user'' p') balance']
+              reminderAt = case kindAfter of
+                PKSubscription s -> find (> now) $ renewalReminderAt s balance'
+                PKPrepaid -> Nothing
+              wakeAt = earliestTime [serviceAt, snoozeAt, stalledAt, reminderAt, badgeBoundary now (shownBadgeCredential user'' p') balance']
               failed = failureAfter /= failureBefore
               subscriptionChanged = kindAfter /= purchaseKind
           -- written before the event, so the state it reports carries the attempt it leads to
@@ -5645,21 +5648,35 @@ updateUserBadge userId emitted now = do
           when (retired || issued || failed || subscriptionChanged) $ toView . CEvtBadgeChanged user'' =<< getUserBadgeState user''
           pure wakeAt
 
--- | The other kinds need subscriptions, and warning before a prepaid badge ends is not actionable
--- while topping up cannot credit months without issuing.
+-- | Warning before a prepaid badge ends is not actionable while topping up cannot credit months without issuing.
 -- TODO [badges] BAPrepaidEnding belongs here, three days before paidThrough, once that exists.
 derivedBadgeAlert :: UTCTime -> UserBadgePurchase -> Maybe BadgeCredential -> StatementEntry -> Maybe BadgeAlert
-derivedBadgeAlert now p@UserBadgePurchase {purchaseKind, shown} shownCred b
-  -- a subscription still shown past paidThrough is waiting for its store to charge, not ended
-  | endsAt <= now && not (subscribed && shown) = Just $ alertOf BASupportEnded endsAt
-  | otherwise = (\BadgeIssueError {failedSince} -> alertOf BAIssueFailed failedSince) <$> shownIssueError now p shownCred
+derivedBadgeAlert now p@UserBadgePurchase {purchaseKind, shown} shownCred b = case purchaseKind of
+  PKPrepaid
+    | endsAt <= now -> Just $ alertOf BASupportEnded endsAt
+    | otherwise -> issueFailed
+  PKSubscription s@BadgeSubscription {status}
+    -- a subscription still shown past paidThrough is waiting for its store to charge, not ended
+    | endsAt <= now && not shown -> Just $ alertOf BASubscriptionEnded endsAt
+    | status == Just SSBillingRetry -> Just $ alertOf BAPaymentIssue endsAt
+    | isJust issueFailed -> issueFailed
+    | now < endsAt && status == Just SSCancelled -> Just $ alertOf BASubscriptionCancelled endsAt
+    | now < endsAt && maybe False (<= now) (renewalReminderAt s b) -> Just $ alertOf BARenewalApproaching endsAt
+    | otherwise -> Nothing
   where
-    subscribed = case purchaseKind of
-      PKSubscription _ -> True
-      PKPrepaid -> False
     endsAt = L.paidThrough b
+    issueFailed = (\BadgeIssueError {failedSince} -> alertOf BAIssueFailed failedSince) <$> shownIssueError now p shownCred
     alertOf kind date = BadgeAlert {kind, episode = safeDecodeUtf8 $ strEncode date, date, price = Nothing}
 
+-- | Only an annual plan is reminded of: with no way to turn reminders off, a monthly one would come every month.
+renewalReminderAt :: BadgeSubscription -> StatementEntry -> Maybe UTCTime
+renewalReminderAt BadgeSubscription {planMonths, status} b
+  | planMonths == 12 && status == Just SSRenewing = Just $ negate renewalReminderLead `addUTCTime` L.paidThrough b
+  | otherwise = Nothing
+
+renewalReminderLead :: NominalDiffTime
+renewalReminderLead = 3 * nominalDay
+
 -- | A failure that can clear on its own is only shown once the credential lapses and contacts see it.
 shownIssueError :: UTCTime -> UserBadgePurchase -> Maybe BadgeCredential -> Maybe BadgeIssueError
 shownIssueError now UserBadgePurchase {issueError} shownCred = case issueError of

src/Simplex/Chat/Store/Postgres/Migrations/M20260925_badge_store_receipts.hs

@@ -43,6 +43,8 @@ ALTER TABLE badge_purchases ADD COLUMN subscription_status TEXT;
 down_m20260925_badge_store_receipts :: Text
 down_m20260925_badge_store_receipts =
   [r|
+UPDATE badge_purchases SET alert_acked_kind = NULL, alert_acked_episode = NULL, alert_snooze_until = NULL WHERE alert_acked_kind = 'subscription_cancelled';
+
 ALTER TABLE badge_purchases DROP COLUMN subscription_status;
 
 DROP INDEX idx_badge_purchases_store_receipt;

src/Simplex/Chat/Store/SQLite/Migrations/M20260925_badge_store_receipts.hs

@@ -42,6 +42,8 @@ ALTER TABLE badge_purchases ADD COLUMN subscription_status TEXT;
 down_m20260925_badge_store_receipts :: Query
 down_m20260925_badge_store_receipts =
   [sql|
+UPDATE badge_purchases SET alert_acked_kind = NULL, alert_acked_episode = NULL, alert_snooze_until = NULL WHERE alert_acked_kind = 'subscription_cancelled';
+
 ALTER TABLE badge_purchases DROP COLUMN subscription_status;
 
 DROP INDEX idx_badge_purchases_store_receipt;