From 150897d637c0dba0a4c7d61421574f7c5fceba85 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Tue, 22 Sep 2026 12:55:08 +0000 Subject: [PATCH] core, ui: alert the user when badge renewal is failing (#7532) --- apps/ios/Shared/Model/AppAPITypes.swift | 1 + apps/ios/Shared/Model/ChatModel.swift | 1 + apps/ios/Shared/Model/SimpleXAPI.swift | 7 +- .../Views/Badges/BadgesYourBadgeView.swift | 38 ++- .../Views/Badges/SupportSimpleXBanner.swift | 3 +- .../Shared/Views/ChatList/ChatListView.swift | 26 +- apps/ios/SimpleXChat/APITypes.swift | 14 + apps/ios/SimpleXChat/ChatTypes.swift | 45 +++- apps/ios/spec/client/chat-list.md | 2 +- .../chat/simplex/common/model/ChatModel.kt | 43 ++- .../chat/simplex/common/model/SimpleXAPI.kt | 21 +- .../views/badges/BadgesYourBadgeView.kt | 31 +++ .../views/badges/SupportSimpleXBanner.kt | 4 +- .../common/views/chatlist/ChatListView.kt | 19 +- .../common/views/newchat/OnboardingCards.kt | 5 +- .../commonMain/resources/MR/base/strings.xml | 15 +- apps/multiplatform/spec/client/chat-list.md | 2 +- ...2026-09-17-badge-renewal-failure-alerts.md | 89 +++++++ simplex-chat.cabal | 2 + src/Simplex/Chat/Badges/Service.hs | 69 ----- src/Simplex/Chat/Badges/Types.hs | 144 +++++++++- src/Simplex/Chat/Library/Commands.hs | 196 +++++++++----- src/Simplex/Chat/Store/Badges.hs | 40 ++- src/Simplex/Chat/Store/Postgres/Migrations.hs | 4 +- .../M20260918_badge_issue_errors.hs | 31 +++ .../Store/Postgres/Migrations/chat_schema.sql | 6 +- src/Simplex/Chat/Store/SQLite/Migrations.hs | 4 +- .../M20260918_badge_issue_errors.hs | 30 +++ .../SQLite/Migrations/chat_query_plans.txt | 23 +- .../Store/SQLite/Migrations/chat_schema.sql | 4 + src/Simplex/Chat/View.hs | 15 +- tests/BadgeTests.hs | 71 ++++- tests/Bots/BadgeServiceTests.hs | 245 +++++++++++++++++- 33 files changed, 1068 insertions(+), 182 deletions(-) create mode 100644 plans/2026-09-17-badge-renewal-failure-alerts.md create mode 100644 src/Simplex/Chat/Store/Postgres/Migrations/M20260918_badge_issue_errors.hs create mode 100644 src/Simplex/Chat/Store/SQLite/Migrations/M20260918_badge_issue_errors.hs diff --git a/apps/ios/Shared/Model/AppAPITypes.swift b/apps/ios/Shared/Model/AppAPITypes.swift index 4ae103d746..eadca9f71e 100644 --- a/apps/ios/Shared/Model/AppAPITypes.swift +++ b/apps/ios/Shared/Model/AppAPITypes.swift @@ -704,6 +704,7 @@ enum ChatCommand: ChatCmdProtocol { case .subscriptionEnded: "subscription_ended" case .prepaidEnding: "prepaid_ending" case .supportEnded: "support_ended" + case .issueFailed: "issue_failed" } } diff --git a/apps/ios/Shared/Model/ChatModel.swift b/apps/ios/Shared/Model/ChatModel.swift index ef1f01c84d..6a5b1de353 100644 --- a/apps/ios/Shared/Model/ChatModel.swift +++ b/apps/ios/Shared/Model/ChatModel.swift @@ -385,6 +385,7 @@ class BadgeModel: ObservableObject { enum ChatListBanner { case badgeExpired + case badgeIssueFailed case badgePitch case getStake } diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift index d4de1205c7..742ef20688 100644 --- a/apps/ios/Shared/Model/SimpleXAPI.swift +++ b/apps/ios/Shared/Model/SimpleXAPI.swift @@ -2203,12 +2203,7 @@ func redeemErrorText(_ error: Error) -> String { case .invalidCode: return NSLocalizedString("This code is not valid.", comment: "alert message") case .serviceNotConfigured: return NSLocalizedString("This app version cannot redeem badge codes.", comment: "alert message") case .badgeActive: return NSLocalizedString("This profile already has a badge. Redeem the code on another profile, or once this badge ends.", comment: "alert message") - case .serviceError(.codeInvalid): return NSLocalizedString("This code was not recognised.", comment: "alert message") - case .serviceError(.codeUsed): return NSLocalizedString("This code has already been used.", comment: "alert message") - case .serviceError(.codeExpired): return NSLocalizedString("This code has expired.", comment: "alert message") - case .serviceError(.rateLimited): return NSLocalizedString("Too many attempts. Please try again later.", comment: "alert message") - case .serviceError(.unsupportedVersion): return NSLocalizedString("This app version is too old for the badge service. Please update the app.", comment: "alert message") - case .serviceError: break + case let .serviceError(code): if let text = badgeServiceErrorText(code) { return text } case let .invalidResponse(message): return String.localizedStringWithFormat(NSLocalizedString("The badge service sent an unexpected response: %@", comment: "alert message"), message) case .unknownKeyIndex, .credentialNotVerified: return NSLocalizedString("This app version cannot verify this badge. Please update the app.", comment: "alert message") diff --git a/apps/ios/Shared/Views/Badges/BadgesYourBadgeView.swift b/apps/ios/Shared/Views/Badges/BadgesYourBadgeView.swift index 5654d6e5aa..60c6a0ab77 100644 --- a/apps/ios/Shared/Views/Badges/BadgesYourBadgeView.swift +++ b/apps/ios/Shared/Views/Badges/BadgesYourBadgeView.swift @@ -12,6 +12,7 @@ import SimpleXChat struct BadgesYourBadgeView: View { @EnvironmentObject var theme: AppTheme @EnvironmentObject var chatModel: ChatModel + @Environment(\.dismiss) private var dismiss @AppStorage(DEFAULT_DEVELOPER_TOOLS) private var developerTools = false let badgeState: BadgeState var showsAsSheet: Bool = false @@ -52,14 +53,45 @@ struct BadgesYourBadgeView: View { } } } + if let issueError = badgeState.issueError { + Section { + Text(issueError.reason.text) + .foregroundColor(theme.colors.secondary) + infoRow("Since", badgeTimestamp(issueError.failedSince)) + if issueError.lastAttemptAt != issueError.failedSince { + infoRow("Last attempt", badgeTimestamp(issueError.lastAttemptAt)) + } + settingsRow("number", color: theme.colors.secondary) { + Button("Contact SimpleX team") { + dismiss() + DispatchQueue.main.async { + // simplexTeamURL targets this same app; route to the in-app connect flow + ChatModel.shared.appOpenUrl = simplexTeamURL + } + } + } + } header: { + HStack(spacing: 6) { + Image(systemName: "exclamationmark.triangle") + .foregroundColor(.red) + Text("Error") + } + } + } if developerTools { Section(header: Text("Credential").foregroundColor(theme.colors.secondary)) { if let badge = chatModel.currentUser?.profile.localBadge { infoRow("Status", badge.status.rawValue) - infoRow("Expires", DateFormatter.localizedString(from: badge.badge.badgeExpiry, dateStyle: .medium, timeStyle: .short)) + infoRow("Expires", badgeTimestamp(badge.badge.badgeExpiry)) } infoRow("Months left", "\(badgeState.monthsLeft)") infoRow("Purchase ID", "\(badgeState.badgePurchaseId)") + if let nextWakeAt = badgeState.nextWakeAt { + infoRow("Next check", badgeTimestamp(nextWakeAt)) + } + if let issueError = badgeState.issueError { + infoRow("Error", issueError.reason.tag) + } Button("Copy purchase key") { UIPasteboard.general.string = badgeState.purchaseKey } @@ -77,6 +109,10 @@ struct BadgesYourBadgeView: View { .navigationBarTitleDisplayMode(showsAsSheet ? .inline : .large) .modifier(ThemedBackground(grouped: true)) } + + private func badgeTimestamp(_ date: Date) -> String { + DateFormatter.localizedString(from: date, dateStyle: .medium, timeStyle: .short) + } } struct BadgeSummary: View { diff --git a/apps/ios/Shared/Views/Badges/SupportSimpleXBanner.swift b/apps/ios/Shared/Views/Badges/SupportSimpleXBanner.swift index 1ff47c9ed9..d37c1e45e6 100644 --- a/apps/ios/Shared/Views/Badges/SupportSimpleXBanner.swift +++ b/apps/ios/Shared/Views/Badges/SupportSimpleXBanner.swift @@ -14,6 +14,7 @@ struct SupportSimpleXBanner: View { @Environment(\.colorScheme) var colorScheme: ColorScheme var title: LocalizedStringKey = "Support SimpleX" var subtitle: LocalizedStringKey = "Get badge + better files" + var warning: Bool = false let onTap: () -> Void let onDismiss: () -> Void @@ -37,7 +38,7 @@ struct SupportSimpleXBanner: View { VStack(alignment: .leading, spacing: 4) { Text(title) .font(.headline) - .foregroundColor(theme.colors.primary) + .foregroundColor(warning ? .red : theme.colors.primary) .lineLimit(2) Text(subtitle) .font(.subheadline) diff --git a/apps/ios/Shared/Views/ChatList/ChatListView.swift b/apps/ios/Shared/Views/ChatList/ChatListView.swift index ad2c411172..2a9647ba5a 100644 --- a/apps/ios/Shared/Views/ChatList/ChatListView.swift +++ b/apps/ios/Shared/Views/ChatList/ChatListView.swift @@ -381,21 +381,25 @@ struct ChatListView: View { // the onboarding cards replace the whole chat list, and the support-ended banner lives in the // list - a lapsed supporter is not a newcomer, and must be told even with no conversations yet private var shouldShowOnboarding: Bool { - !addressCreationCardShown && !chatModel.chats.isEmpty && !hasConversations && !supportEnded + !addressCreationCardShown && !chatModel.chats.isEmpty && !hasConversations && !supportEnded && !badgeIssueFailed } private var supportEnded: Bool { badgeModel.alert?.kind == .supportEnded && badgeModel.userId == chatModel.currentUser?.userId } + private var badgeIssueFailed: Bool { + badgeModel.alert?.kind == .issueFailed && badgeModel.userId == chatModel.currentUser?.userId + } + // false until the badge state loads: if the pitch rendered before that, it would lock the slot, and a supporter's badge // arriving a moment later would hide it, leaving the slot empty for the session private var noShownBadge: Bool { badgeModel.badgeState?.shown != true && badgeModel.userId == chatModel.currentUser?.userId } - private func showSupportEndedDismissAlert() { - showAlert(NSLocalizedString("Your badge expired", comment: "alert title")) { + private func showBadgeAlertDismissAlert(_ title: String) { + showAlert(title) { [ UIAlertAction(title: NSLocalizedString("Remind me later", comment: "alert button"), style: .default) { _ in Task { await ackBadgeAlert(snooze: true) } @@ -488,7 +492,7 @@ struct ChatListView: View { title: "Your badge expired", subtitle: "Your badge expired on \(alert.dateText).", onTap: { showBadgesSheet = true }, - onDismiss: showSupportEndedDismissAlert + onDismiss: { showBadgeAlertDismissAlert(NSLocalizedString("Your badge expired", comment: "alert title")) } ) .padding(.vertical, 3) .scaleEffect(x: 1, y: oneHandUI ? -1 : 1, anchor: .center) @@ -496,6 +500,20 @@ struct ChatListView: View { .listRowBackground(Color.clear) .zIndex(1) .onAppear { chatModel.chatListBanner = .badgeExpired } + } else if badgeIssueFailed { + SupportSimpleXBanner( + title: "Badge renewal failed", + subtitle: "Tap for details", + warning: true, + onTap: { showBadgesSheet = true }, + onDismiss: { showBadgeAlertDismissAlert(NSLocalizedString("Badge renewal failed", comment: "alert title")) } + ) + .padding(.vertical, 3) + .scaleEffect(x: 1, y: oneHandUI ? -1 : 1, anchor: .center) + .listRowSeparator(.hidden) + .listRowBackground(Color.clear) + .zIndex(1) + .onAppear { chatModel.chatListBanner = .badgeIssueFailed } } else if chatModel.bannerSlotFree(for: .badgePitch) && !supporterBannerShown && noShownBadge && chatModel.chats.count > 3 { SupportSimpleXBanner( onTap: { showBadgesSheet = true }, diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index d7b8623ab3..75d66ebb6f 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -902,6 +902,20 @@ public enum BadgeServiceErrorCode: Decodable, Hashable { } } +public func badgeServiceErrorText(_ code: BadgeServiceErrorCode) -> String? { + switch code { + case .codeInvalid: NSLocalizedString("This code was not recognized.", comment: "alert message") + case .codeUsed: NSLocalizedString("This code has already been used.", comment: "alert message") + case .codeExpired: NSLocalizedString("This code has expired.", comment: "alert message") + case .rateLimited: NSLocalizedString("Too many attempts. Please try again later.", comment: "alert message") + case .unsupportedVersion: NSLocalizedString("This app version is too old for the badge service. Please update the app.", comment: "alert message") + case .unknownPurchaseKey: NSLocalizedString("The badge service does not recognize this badge.", comment: "alert message") + case .internalError: NSLocalizedString("The badge service reported an internal error.", comment: "alert message") + case .badRequest, .unknownOfferId, .offerDisabled, .offerMismatch, .productUnavailable, + .paymentNotEntitled, .paymentPending, .providerUnavailable, .receiptInvalid, .receiptUsed, .unknown: nil + } +} + public enum StoreError: Decodable, Hashable { case duplicateName case userNotFound(userId: Int64) diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index ae3c8d662b..84275caf64 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -324,7 +324,8 @@ public struct LocalBadge: Codable, Hashable { // paidThrough is the only date to show the user: BadgeInfo.badgeExpiry is the credential's expiry, // which outlives entitlement so the credential's window can cover a renewal. -public struct BadgeState: Codable, Hashable { +// Decodable only: BadgeIssueFailure below is, and nothing encodes badge state. +public struct BadgeState: Decodable, Hashable { public var badgePurchaseId: Int64 public var purchaseKey: String public var badgeType: BadgeType @@ -334,10 +335,51 @@ public struct BadgeState: Codable, Hashable { public var renewsAt: Date? public var willRenew: Bool public var alert: BadgeAlert? + public var issueError: BadgeIssueError? + public var nextWakeAt: Date? public var paidThroughText: String { badgeDateText(paidThrough) } } +public struct BadgeIssueError: Decodable, Hashable { + public var failedSince: Date + public var lastAttemptAt: Date + public var reason: BadgeIssueFailure +} + +public enum BadgeIssueFailure: Decodable, Hashable { + // retryable is the service's own view of transience: it gave retryAfter + case serviceError(code: BadgeServiceErrorCode, retryable: Bool) + case serviceTimeout + case network(agentError: String) + case invalidCredential + case unexpected(message: String) + + public var text: String { + switch self { + case let .serviceError(code, _): + badgeServiceErrorText(code) + ?? String.localizedStringWithFormat(NSLocalizedString("The badge service refused the renewal: %@", comment: "badge renewal error"), code.text) + case .serviceTimeout: NSLocalizedString("The badge service did not respond.", comment: "badge renewal error") + case .network: NSLocalizedString("The badge service could not be reached.", comment: "badge renewal error") + case .invalidCredential: NSLocalizedString("The badge issued by the service cannot be verified.", comment: "badge renewal error") + case let .unexpected(message): + String.localizedStringWithFormat(NSLocalizedString("Unexpected error: %@", comment: "badge renewal error"), message) + } + } + + // the stored form, for support + public var tag: String { + switch self { + case let .serviceError(code, retryable): "serviceError \(retryable ? "retry" : "final") \(code.text)" + case .serviceTimeout: "serviceTimeout" + case let .network(agentError): "network \(agentError)" + case .invalidCredential: "invalidCredential" + case let .unexpected(message): "unexpected \(message)" + } + } +} + public struct StatementEntry: Codable, Hashable { public var entryId: String public var changeMonths: Int @@ -519,6 +561,7 @@ public enum BadgeAlertKind: String, Codable, Hashable { case subscriptionEnded case prepaidEnding case supportEnded + case issueFailed } // the wire proof carried on a profile - opaque to the UI, only round-tripped back to the core (apiPrepareContact) diff --git a/apps/ios/spec/client/chat-list.md b/apps/ios/spec/client/chat-list.md index ece1b4d045..ef131cfec0 100644 --- a/apps/ios/spec/client/chat-list.md +++ b/apps/ios/spec/client/chat-list.md @@ -293,7 +293,7 @@ Gradient card inviting the user to invest on Wefunder. Shown only when [`isInUS` | Chat list | rendered whenever [`chatListContent`](../../Shared/Views/ChatList/ChatListView.swift#L413) is, in the `List` after `OneHandUICard` and before the chats | `.padding(.vertical, 3)`, flipped for one-hand UI, `.zIndex(1)` | | Onboarding | below [`ConnectOnboardingView`](../../Shared/Views/NewChat/OnboardingCards.swift#L135) when `shouldShowOnboarding` | `.padding(.horizontal, 20)` (the onboarding cards' margin), `.padding(.bottom, 8)` | -The list has a single banner slot, filled by an `if`/`else if` chain in priority order: the support-ended alert (`supportEnded`), the pitch, then the Wefunder banner. Each banner records itself in `ChatModel.chatListBanner` (`.badgeExpired`, `.badgePitch`, `.getStake`) in its `onAppear`, and the pitch and Wefunder conditions start with `chatModel.bannerSlotFree(for:)` — true only while nothing else was shown this app session — so dismissing a banner never puts another in its place until restart. The alert has no such check: it takes the slot whenever present, and once shown it holds it. The pitch also requires `noShownBadge`, false until `BadgeModel` holds the current user's state, so it cannot take the slot from a supporter whose badge loads a moment later. The onboarding placement applies the same `bannerSlotFree` check and records `.getStake`. +The list has a single banner slot, filled by an `if`/`else if` chain in priority order: the support-ended alert (`supportEnded`), the renewal-failure alert (`badgeIssueFailed`), the pitch, then the Wefunder banner. Each banner records itself in `ChatModel.chatListBanner` (`.badgeExpired`, `.badgeIssueFailed`, `.badgePitch`, `.getStake`) in its `onAppear`, and the pitch and Wefunder conditions start with `chatModel.bannerSlotFree(for:)` — true only while nothing else was shown this app session — so dismissing a banner never puts another in its place until restart. The alerts have no such check: an alert takes the slot whenever present, and once shown it holds it. The pitch also requires `noShownBadge`, false until `BadgeModel` holds the current user's state, so it cannot take the slot from a supporter whose badge loads a moment later. The onboarding placement applies the same `bannerSlotFree` check and records `.getStake`. In the onboarding branch the `.scaleEffect` and `ThemedBackground` are applied to the enclosing `VStack` rather than to each child, so the banner stays below the pages in both toolbar modes. diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt index 929f19436d..6d82214ad6 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt @@ -130,7 +130,7 @@ object BadgeModel { this.rhId.value == rhId && this.userId.value == userId } -enum class ChatListBanner { BadgeExpired, BadgePitch, GetStake } +enum class ChatListBanner { BadgeExpired, BadgeIssueFailed, BadgePitch, GetStake } /* * Without this annotation an animation from ChatList to ChatView has 1 frame per the whole animation. Don't delete it @@ -2240,11 +2240,47 @@ data class BadgeState( val paidThrough: Instant, val renewsAt: Instant? = null, val willRenew: Boolean, - val alert: BadgeAlert? = null + val alert: BadgeAlert? = null, + val issueError: BadgeIssueError? = null, + val nextWakeAt: Instant? = null ) { val paidThroughText: String get() = badgeDateText(paidThrough) } +@Serializable +data class BadgeIssueError( + val failedSince: Instant, + val lastAttemptAt: Instant, + val reason: BadgeIssueFailure +) + +@Serializable +sealed class BadgeIssueFailure { + // retryable is the service's own view of transience: it gave retryAfter + @Serializable @SerialName("serviceError") data class ServiceError(val code: BadgeServiceErrorCode, val retryable: Boolean) : BadgeIssueFailure() + @Serializable @SerialName("serviceTimeout") object ServiceTimeout : BadgeIssueFailure() + @Serializable @SerialName("network") data class Network(val agentError: String) : BadgeIssueFailure() + @Serializable @SerialName("invalidCredential") object InvalidCredential : BadgeIssueFailure() + @Serializable @SerialName("unexpected") data class Unexpected(val message: String) : BadgeIssueFailure() + + val text: String get() = when (this) { + is ServiceError -> badgeServiceErrorText(code) ?: String.format(generalGetString(MR.strings.badges_error_service_refused), code.text) + is ServiceTimeout -> generalGetString(MR.strings.badges_error_no_response) + is Network -> generalGetString(MR.strings.badges_error_unreachable) + is InvalidCredential -> generalGetString(MR.strings.badges_error_credential_invalid) + is Unexpected -> String.format(generalGetString(MR.strings.badges_error_unexpected), message) + } + + // the stored form, for support + val tag: String get() = when (this) { + is ServiceError -> "serviceError ${if (retryable) "retry" else "final"} ${code.text}" + is ServiceTimeout -> "serviceTimeout" + is Network -> "network $agentError" + is InvalidCredential -> "invalidCredential" + is Unexpected -> "unexpected $message" + } +} + @Serializable data class StatementEntry( val entryId: String, @@ -2395,7 +2431,8 @@ enum class BadgeAlertKind { @SerialName("paymentIssue") PaymentIssue, @SerialName("subscriptionEnded") SubscriptionEnded, @SerialName("prepaidEnding") PrepaidEnding, - @SerialName("supportEnded") SupportEnded + @SerialName("supportEnded") SupportEnded, + @SerialName("issueFailed") IssueFailed } private fun badgeDateText(date: Instant): String { diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt index 92f4c6d5c0..ca13924e47 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt @@ -591,14 +591,7 @@ object ChatController { is BadgeRedeemError.InvalidCode -> return generalGetString(MR.strings.badges_error_invalid_code) is BadgeRedeemError.ServiceNotConfigured -> return generalGetString(MR.strings.badges_error_service_not_configured) is BadgeRedeemError.BadgeActive -> return generalGetString(MR.strings.badges_error_already_active) - is BadgeRedeemError.ServiceError -> when (e.serviceError) { - is BadgeServiceErrorCode.CodeInvalid -> return generalGetString(MR.strings.badges_error_code_invalid) - is BadgeServiceErrorCode.CodeUsed -> return generalGetString(MR.strings.badges_error_code_used) - is BadgeServiceErrorCode.CodeExpired -> return generalGetString(MR.strings.badges_error_code_expired) - is BadgeServiceErrorCode.RateLimited -> return generalGetString(MR.strings.badges_error_rate_limited) - is BadgeServiceErrorCode.UnsupportedVersion -> return generalGetString(MR.strings.badges_error_unsupported_version) - else -> {} - } + is BadgeRedeemError.ServiceError -> badgeServiceErrorText(e.serviceError)?.let { return it } is BadgeRedeemError.InvalidResponse -> return String.format(generalGetString(MR.strings.badges_error_bad_service_response), e.message) is BadgeRedeemError.UnknownKeyIndex, is BadgeRedeemError.CredentialNotVerified -> return generalGetString(MR.strings.badges_error_credential_not_verified) } @@ -4545,6 +4538,7 @@ private fun badgeAlertKindParam(kind: BadgeAlertKind): String = when (kind) { BadgeAlertKind.SubscriptionEnded -> "subscription_ended" BadgeAlertKind.PrepaidEnding -> "prepaid_ending" BadgeAlertKind.SupportEnded -> "support_ended" + BadgeAlertKind.IssueFailed -> "issue_failed" } @Serializable @@ -7387,6 +7381,17 @@ sealed class BadgeServiceErrorCode { } } +fun badgeServiceErrorText(code: BadgeServiceErrorCode): String? = when (code) { + is BadgeServiceErrorCode.CodeInvalid -> generalGetString(MR.strings.badges_error_code_invalid) + is BadgeServiceErrorCode.CodeUsed -> generalGetString(MR.strings.badges_error_code_used) + is BadgeServiceErrorCode.CodeExpired -> generalGetString(MR.strings.badges_error_code_expired) + is BadgeServiceErrorCode.RateLimited -> generalGetString(MR.strings.badges_error_rate_limited) + is BadgeServiceErrorCode.UnsupportedVersion -> generalGetString(MR.strings.badges_error_unsupported_version) + is BadgeServiceErrorCode.UnknownPurchaseKey -> generalGetString(MR.strings.badges_error_unknown_purchase) + is BadgeServiceErrorCode.Internal -> generalGetString(MR.strings.badges_error_service_internal) + else -> null +} + object BadgeServiceErrorCodeSerializer : KSerializer { override val descriptor: SerialDescriptor = PrimitiveSerialDescriptor("BadgeServiceErrorCode", PrimitiveKind.STRING) override fun deserialize(decoder: Decoder): BadgeServiceErrorCode = diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/BadgesYourBadgeView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/BadgesYourBadgeView.kt index 035eb64846..34a59343ce 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/BadgesYourBadgeView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/BadgesYourBadgeView.kt @@ -12,8 +12,10 @@ import androidx.compose.material.Text import androidx.compose.runtime.Composable import androidx.compose.ui.Alignment import androidx.compose.ui.Modifier +import androidx.compose.ui.graphics.Color import androidx.compose.ui.layout.ContentScale import androidx.compose.ui.platform.LocalClipboardManager +import androidx.compose.ui.platform.LocalUriHandler import androidx.compose.ui.text.AnnotatedString import androidx.compose.ui.text.font.FontWeight import androidx.compose.ui.unit.dp @@ -29,7 +31,9 @@ import chat.simplex.common.views.helpers.AppBarTitle import chat.simplex.common.views.helpers.ModalManager import chat.simplex.common.views.helpers.badgeImage import chat.simplex.common.views.helpers.badgeTypeName +import chat.simplex.common.views.helpers.openVerifiedSimplexUri import chat.simplex.common.views.usersettings.SettingsActionItem +import chat.simplex.common.views.usersettings.simplexTeamUri import chat.simplex.res.MR @Composable @@ -54,6 +58,26 @@ fun BadgesYourBadgeView(badgeState: BadgeState) { ) } SectionSpacer() + val issueError = badgeState.issueError + if (issueError != null) { + val uriHandler = LocalUriHandler.current + SectionView(title = stringResource(MR.strings.error), icon = painterResource(MR.images.ic_warning), iconTint = Color.Red, leadingIcon = true) { + SectionItemView { + Text(issueError.reason.text, color = MaterialTheme.colors.secondary) + } + InfoRow(stringResource(MR.strings.badges_error_since), localTimestamp(issueError.failedSince)) + if (issueError.lastAttemptAt != issueError.failedSince) { + InfoRow(stringResource(MR.strings.badges_error_last_attempt), localTimestamp(issueError.lastAttemptAt)) + } + SettingsActionItem( + painterResource(MR.images.ic_tag), + stringResource(MR.strings.badges_contact_team), + { uriHandler.openVerifiedSimplexUri(simplexTeamUri) }, + textColor = MaterialTheme.colors.primary + ) + } + SectionSpacer() + } if (appPrefs.developerTools.get()) { val clipboard = LocalClipboardManager.current SectionView(stringResource(MR.strings.badges_credential)) { @@ -64,6 +88,13 @@ fun BadgesYourBadgeView(badgeState: BadgeState) { } InfoRow(stringResource(MR.strings.badges_credential_months_left), badgeState.monthsLeft.toString()) InfoRow(stringResource(MR.strings.badges_credential_purchase_id), badgeState.badgePurchaseId.toString()) + val nextWakeAt = badgeState.nextWakeAt + if (nextWakeAt != null) { + InfoRow(stringResource(MR.strings.badges_credential_next_check), localTimestamp(nextWakeAt)) + } + if (issueError != null) { + InfoRow(stringResource(MR.strings.error), issueError.reason.tag) + } SectionItemView({ clipboard.setText(AnnotatedString(badgeState.purchaseKey)) }) { Text(stringResource(MR.strings.badges_copy_purchase_key), color = MaterialTheme.colors.primary) } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/SupportSimpleXBanner.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/SupportSimpleXBanner.kt index 36737c0c1b..9bcc1215b2 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/SupportSimpleXBanner.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/SupportSimpleXBanner.kt @@ -6,6 +6,7 @@ import androidx.compose.material.* import androidx.compose.runtime.* import androidx.compose.ui.Alignment import androidx.compose.ui.Modifier +import androidx.compose.ui.graphics.Color import androidx.compose.ui.layout.ContentScale import androidx.compose.ui.layout.Layout import androidx.compose.ui.text.font.FontWeight @@ -25,6 +26,7 @@ import chat.simplex.res.MR fun SupportSimpleXBanner( title: String = generalGetString(MR.strings.badges_banner_title), subtitle: String = generalGetString(MR.strings.badges_banner_subtitle), + warning: Boolean = false, onTap: () -> Unit, onDismiss: () -> Unit ) { @@ -59,7 +61,7 @@ fun SupportSimpleXBanner( title, style = MaterialTheme.typography.body1, fontWeight = FontWeight.SemiBold, - color = MaterialTheme.colors.primary, + color = if (warning) Color.Red else MaterialTheme.colors.primary, maxLines = 2, overflow = TextOverflow.Ellipsis ) diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt index 36b636653c..1d893ff858 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt @@ -64,9 +64,9 @@ sealed class ActiveFilter { data object Unread: ActiveFilter() } -private fun showSupportEndedDismissAlert() { +private fun showBadgeAlertDismissAlert(title: String) { AlertManager.shared.showAlertDialogButtonsColumn( - title = generalGetString(MR.strings.badges_support_ended), + title = title, buttons = { Column { SectionItemView({ @@ -1052,7 +1052,20 @@ private fun BoxScope.ChatList(searchText: MutableState, listStat title = stringResource(MR.strings.badges_support_ended), subtitle = String.format(stringResource(MR.strings.badges_support_ended_on), alert.dateText), onTap = { ModalManager.start.showCustomModal { close -> BadgesView(close) } }, - onDismiss = ::showSupportEndedDismissAlert + onDismiss = { showBadgeAlertDismissAlert(generalGetString(MR.strings.badges_support_ended)) } + ) + } + } + } else if (badgeIssueFailed()) { + item { + SideEffect { chatModel.chatListBanner = ChatListBanner.BadgeIssueFailed } + Box(Modifier.zIndex(1f).padding(16.dp)) { + SupportSimpleXBanner( + title = stringResource(MR.strings.badges_renewal_failed), + subtitle = stringResource(MR.strings.badges_tap_for_details), + warning = true, + onTap = { ModalManager.start.showCustomModal { close -> BadgesView(close) } }, + onDismiss = { showBadgeAlertDismissAlert(generalGetString(MR.strings.badges_renewal_failed)) } ) } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/OnboardingCards.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/OnboardingCards.kt index d9df033018..661e752751 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/OnboardingCards.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/OnboardingCards.kt @@ -52,12 +52,15 @@ private const val GRADIENT_ANGLE_RAD = 80.0 * Math.PI / 180.0 fun shouldShowOnboarding(): Boolean { val addressCreationCardShown = remember { appPrefs.addressCreationCardShown.state } val chats = chatModel.chats.value - return !addressCreationCardShown.value && chats.isNotEmpty() && !hasConversations(chats) && !supportEnded() + return !addressCreationCardShown.value && chats.isNotEmpty() && !hasConversations(chats) && !supportEnded() && !badgeIssueFailed() } fun supportEnded(): Boolean = BadgeModel.alert.value?.kind == BadgeAlertKind.SupportEnded && BadgeModel.isCurrent(chatModel.remoteHostId(), chatModel.currentUser.value?.userId) +fun badgeIssueFailed(): Boolean = + BadgeModel.alert.value?.kind == BadgeAlertKind.IssueFailed && BadgeModel.isCurrent(chatModel.remoteHostId(), chatModel.currentUser.value?.userId) + // false until the badge state loads: if the pitch rendered before that, it would lock the slot, and a supporter's badge // arriving a moment later would hide it, leaving the slot empty for the session fun noShownBadge(): Boolean = diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml index feed7b3c8e..900897fc8a 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml @@ -3189,13 +3189,15 @@ This code is not valid. This app version cannot redeem badge codes. This profile already has a badge. Redeem the code on another profile, or once this badge ends. - This code was not recognised. + This code was not recognized. This code has already been used. This code has expired. Too many attempts. Please try again later. The badge service sent an unexpected response: %1$s This app version cannot verify this badge. Please update the app. This app version is too old for the badge service. Please update the app. + The badge service does not recognize this badge. + The badge service reported an internal error. The code was accepted, but the badge it grants has already ended. The code could not be redeemed. The code you scanned is not a badge code. @@ -3227,6 +3229,17 @@ Charge ID From purchase key To purchase key + Badge renewal failed + Tap for details + The badge service refused the renewal: %1$s + The badge service did not respond. + The badge service could not be reached. + The badge issued by the service cannot be verified. + Unexpected error: %1$s + Since + Last attempt + Contact SimpleX team + Next check Supporter perks Supporter badge ❤️ Help keep the network running — send files up to 2 GB. diff --git a/apps/multiplatform/spec/client/chat-list.md b/apps/multiplatform/spec/client/chat-list.md index 47cb39e344..fc310e84c1 100644 --- a/apps/multiplatform/spec/client/chat-list.md +++ b/apps/multiplatform/spec/client/chat-list.md @@ -336,7 +336,7 @@ Gradient card inviting the user to invest on Wefunder. Shown only when `crowdfun | Chat list | in `ChatList`'s `LazyColumn`, after `ToggleChatListCard` and before the chats | `Box(Modifier.zIndex(1f).padding(16.dp))` | | Onboarding | inside `ConnectOnboardingView` (`views/newchat/OnboardingCards.kt`), below the pager, so it shares the pages' width limit on desktop and their dimming while a start modal is open; opens the page in `ModalManager.center` on desktop, `ModalManager.start` on Android | `padding(start/end = DEFAULT_PADDING, bottom = 8.dp)`, in a `Column` where the pager takes `weight(1f)` | -The list has a single banner slot, filled by an `if`/`else if` chain in priority order: the support-ended alert (`supportEnded()`), the pitch, then the Wefunder banner. Each banner's `item` records itself in `ChatModel.chatListBanner` (`BadgeExpired`, `BadgePitch`, `GetStake`) in a `SideEffect`, and the pitch and Wefunder conditions start with `chatModel.bannerSlotFree(banner)` — true only while nothing else was shown this app session — so dismissing a banner never puts another in its place until restart. The alert has no such check: it takes the slot whenever present, and once shown it holds it. The pitch also requires `noShownBadge()` (`views/newchat/OnboardingCards.kt`), false until `BadgeModel.isCurrent` for the current user, so it cannot take the slot from a supporter whose badge loads a moment later. `ConnectOnboardingView` applies the same `bannerSlotFree` check and records `GetStake`. +The list has a single banner slot, filled by an `if`/`else if` chain in priority order: the support-ended alert (`supportEnded()`), the renewal-failure alert (`badgeIssueFailed()`), the pitch, then the Wefunder banner. Each banner's `item` records itself in `ChatModel.chatListBanner` (`BadgeExpired`, `BadgeIssueFailed`, `BadgePitch`, `GetStake`) in a `SideEffect`, and the pitch and Wefunder conditions start with `chatModel.bannerSlotFree(banner)` — true only while nothing else was shown this app session — so dismissing a banner never puts another in its place until restart. The alerts have no such check: an alert takes the slot whenever present, and once shown it holds it. The pitch also requires `noShownBadge()` (`views/newchat/OnboardingCards.kt`), false until `BadgeModel.isCurrent` for the current user, so it cannot take the slot from a supporter whose badge loads a moment later. `ConnectOnboardingView` applies the same `bannerSlotFree` check and records `GetStake`. `crowdfundingAvailable()` launches an effect to load the store country, so both call sites read it in the composable body rather than inside the `LazyColumn` builder. diff --git a/plans/2026-09-17-badge-renewal-failure-alerts.md b/plans/2026-09-17-badge-renewal-failure-alerts.md new file mode 100644 index 0000000000..c2002b1d58 --- /dev/null +++ b/plans/2026-09-17-badge-renewal-failure-alerts.md @@ -0,0 +1,89 @@ +# Plan: tell the user when badge renewal is failing + +## The problem + +When the monthly renewal fails, the worker retries silently — with backoff for network failures, a day later for anything else — and the user learns nothing. Nothing else marks the failure: the badge is retired only when the paid months run out (`retireExpiredBadge`), so a badge whose renewal keeps failing stays on the profile with an expired credential, and contacts see it as expired. + +## What changes + +**1. Core remembers the failure.** Four new columns on `badge_purchases`. Three are written only by the renewal request path (`requestBadgeIssue`), never by retirement or presentation: `issue_failed_since` (the first failed attempt of the current run), `issue_error_at` and `issue_error` (the last failure: when, and what). A renewal request counts as failed when it ends without a new credential stored: the service refused, the request threw (timeout, network, undecodable or unexpected reply), or the issued credential did not verify — that last case stores the ledger row today and is still recorded as a failure. A stored issuance clears the three columns; nothing else does, so a purchase retired while failing keeps its last failure. The fourth column, `next_wake_at`, is the wake the worker is about to wait for, written at the end of every pass whether it failed or not. + +`BadgeState` gains `issueError :: Maybe BadgeIssueError` — `{failedSince, lastAttemptAt, reason}`, present once the recorded failure is worth telling the user about by §2's rule, so a failure that is still being retried is not shown — and `nextWakeAt :: Maybe UTCTime`. `reason` is a sum of the failure kinds below. That is the whole UI contract; nothing else is added to the wire. + +**2. Core decides when it is an alert.** A new alert kind, `BAIssueFailed`, derived from stored state like the others. It is raised when a failure is recorded and either + +- the reason is terminal — a service refusal without `retryAfter`, an invalid credential, an unexpected response — at once; or +- the reason is transient — timeout, network, a refusal with `retryAfter` (rate-limited, provider unavailable, payment pending) — and the shown credential's expiry has passed: from that moment contacts see the badge as expired, so the failure is visible and worth a word. Requests start a day before expiry, so this is roughly "failing for a day". Whether the service gave `retryAfter` is the service's own view of transience and holds for codes this version does not know. + +Once `paidThrough` has passed, the alert is the usual Support ended, which takes precedence; `derivedBadgeAlert` raises Support ended on `paidThrough <= now` alone, without today's `balanceMonths == 0` condition. + +`episode` is `issue_failed_since`, so one alert per run of failures; acknowledging it (the existing `/_badge ack`, snooze included) silences that run and a later run alerts again. A successful renewal clears the state, and with it the alert and the Error section; a failure after that is a new run with a new episode. + +**3. Chat list: the banner slot, in error dress.** The existing one-slot banner (`SupportSimpleXBanner`) gets a warning variant — the same hero, title "Badge renewal failed" in red, subtitle "Tap for details" — shown for `BAIssueFailed` under the same conditions as Support ended (same user, same slot before the pitch, also suppresses the onboarding cards). Tapping opens the badges screen as the other banners do — the badge is still shown while renewal fails, so the router lands on Your Badge. Dismiss offers "Remind me later" / "Dismiss" through the same ack calls as Support ended. Not a one-shot modal alert: the failure lasts days and a modal is gone after one tap. + +**4. Your Badge: an "Error" section** below "How it works", above the developer-tools section, shown while `issueError` is present — that is, from the moment the failure meets §2's criteria, and still after the banner has been dismissed: the ack answers the alert, not the failure. It is built like the "Connection failed" section of `GroupMemberInfoView`: on iOS a `Section` whose header is `HStack(spacing: 6) { Image(systemName: "exclamationmark.triangle").foregroundColor(.red); Text("Error") }`, on Kotlin `SectionView(title = stringResource(MR.strings.error), icon = painterResource(MR.images.ic_warning), iconTint = Color.Red, leadingIcon = true)`, and the reason as a sentence in `secondary` color the way `connFailedErr` is shown there. Then `infoRow`s "Since" with `failedSince` and, only when it differs, "Last attempt" with `lastAttemptAt`; then a "Contact SimpleX team" button that opens the team address as "Send questions and ideas" does (iOS: dismiss, then `ChatModel.shared.appOpenUrl = simplexTeamURL`; Kotlin: `uriHandler.openVerifiedSimplexUri(simplexTeamUri)`). No "Retry" button: opening Your Badge signals the worker (`APIGetBadgeState` → `startBadgeWork`), which runs a pass at once after a terminal failure; during a transient one it is already retrying on its own schedule (30 s, doubling to an hour) and takes the signal up when that loop ends. + +The sentences: for a service refusal, the code's own text from `badgeServiceErrorText` — one table per app, shared with the redeem alert, with sentences for `code_invalid`, `code_used`, `code_expired`, `rate_limited`, `unsupported_version`, `unknown_purchase_key` ("The badge service does not recognize this badge.") and `internal` ("The badge service reported an internal error.") — and for any other code "The badge service refused the renewal: %@" with the code; "The badge service did not respond."; "The badge service could not be reached."; "The badge issued by the service cannot be verified."; "Unexpected error: %@". + +**5. Developer tools** (the Credential section): "Next check" from `nextWakeAt` when present, and while `issueError` is present "Error" with the raw reason (tag plus payload, e.g. `serviceError final code_used`), for support. The CLI's `/_badge state` prints the same: `, next check YYYY-MM-DD HH:MM` on the state line, and a second line `renewal failing since YYYY-MM-DD, last YYYY-MM-DD HH:MM: `. + +## Specifics + +**Types** (`Simplex.Chat.Badges.Types`, next to `BadgeAlert`): + +```haskell +data BadgeIssueFailure + = BIFServiceError {code :: BadgeServiceErrorCode, retryable :: Bool} -- retryable = the service gave retryAfter + | BIFServiceTimeout -- the agent's own service-request timeout + | BIFNetwork {agentError :: Text} -- the agent error as text, for support + | BIFInvalidCredential + | BIFUnexpected {message :: Text} -- undecodable or unexpected reply, or any other throw + +data BadgeIssueError = BadgeIssueError {failedSince :: UTCTime, lastAttemptAt :: UTCTime, reason :: BadgeIssueFailure} +``` + +`BadgeIssueFailure` is stored as text the way `CIStatus` is (`Messages.hs`, `instance StrEncoding (CIStatus d)` and its `ToField`/`FromField` through `strEncode`/`strDecode`): a tag and space-separated payload — `service_error retry|final `, `service_timeout`, `network `, `invalid_credential`, `unexpected ` (the unbounded field always last, so any content parses). To the UI it goes as `sumTypeJSON $ dropPrefix "BIF"`, exactly as `BadgeRedeemError` does (`sumTypeJSON $ dropPrefix "BRE"`), so both apps mirror it the way they mirror that one — an iOS `enum … : Decodable, Hashable`, a Kotlin `@Serializable sealed class` with `@SerialName` per case — with no hand-written decoder. `BadgeIssueError` and the new `BadgeState` fields use `defaultJSON`. `BadgeAlertKind` gains `BAIssueFailed`, text `issue_failed` in its `TextEncoding` (the ack command and the `alert_acked_kind` column), JSON `issueFailed` from the existing `enumJSON` derivation. + +Classification of a thrown request error, next to `badgeErrorRetry` and by its rule: `AGENT (A_SERVICE ASETimeout)` → `BIFServiceTimeout`; `temporaryOrHostError` → `BIFNetwork` with the agent error's text; any other agent error → `BIFUnexpected` with the agent error's text; anything else → `BIFUnexpected` with the error's text. Transient: `BIFServiceTimeout`, `BIFNetwork`, `BIFServiceError` with `retryable`, and `BIFServiceError` with code `internal` — the service withholds `retryAfter` from it so as not to be pressed while failing, not because the fault is final. Terminal: the rest. + +`BadgeIssueFailure`'s parser falls back, as `CIStatus`'s does, to `BIFUnexpected` with the row's text for a value it cannot read, so a row written by another version or by hand cannot fail every read of the purchase. + +**Schema.** `M20260918_badge_issue_errors`, SQLite and Postgres, registered in both `Migrations.hs` and the cabal file, with a down migration: + +```sql +ALTER TABLE badge_purchases ADD COLUMN issue_failed_since TEXT; -- TIMESTAMPTZ in Postgres, as alert_snooze_until +ALTER TABLE badge_purchases ADD COLUMN issue_error_at TEXT; +ALTER TABLE badge_purchases ADD COLUMN issue_error TEXT; +ALTER TABLE badge_purchases ADD COLUMN next_wake_at TEXT; +``` + +**Store** (`Store/Badges.hs`): `UserBadgePurchase` gains `issueError :: Maybe BadgeIssueError` and `nextWakeAt :: Maybe UTCTime`. `getBadgePurchase` reads the three columns; `issueError` is present when all three are. `setBadgeIssueError db purchaseId now failure`: `SET issue_failed_since = COALESCE(issue_failed_since, ?), issue_error_at = ?, issue_error = ?`. `storeBadgeIssuance` sets the three to `NULL`, so an issuance and the clearing are one transaction. `setBadgeNextWake db purchaseId at_`. + +**Worker** (`Library/Commands.hs`): + +- `requestBadgeIssue` records every failing outcome through `setBadgeIssueError` before it returns or rethrows: the `BSPError` branch (`BIFServiceError code (isJust retryAfter)`), the unexpected-response branch (`BIFUnexpected`), a credential that does not verify (`BIFInvalidCredential`, alongside the statement it still applies), no credential while the ledger as restated by the statement still has months (`BIFUnexpected`, "badge service issued no credential"), `applyBadgeStatement` answering `False` (`BIFUnexpected` with the internal error's text), and any throw from the request itself, caught with `catchAllErrors`, recorded by the classification above and rethrown so `retryBadgeError` still decides the retry. No credential with the months run out is not a failure: the statement's debits bring the balance to nothing and Support ended follows from `paidThrough`. A successful issuance clears through `storeBadgeIssuance`. +- `updateUserBadge` writes the wake it returns with `setBadgeNextWake` before emitting, and emits `CEvtBadgeChanged` when `retired || issued || failed`, where `failed` is a `Left` from `requestBadgeIssue` (the invalid-credential case is covered by `issued`). `retryBadgeError` gets the user id and the delay, writes `next_wake_at` (now plus the delay `withRetryInterval` hands the callback, or plus `badgeStalledInterval`) and emits `CEvtBadgeChanged` before it loops or stalls. So the state the apps receive after a failure already carries the next attempt. +- `shownIssueError now purchase shownCred`: the recorded failure filtered by §2's rule, with the transient threshold read off `shownBadgeCredential`. `derivedBadgeAlert now purchase shownCred balance`: Support ended when `paidThrough <= now`; else `BAIssueFailed {episode = strEncode failedSince, date = failedSince}` from `shownIssueError`; else nothing. `unansweredBadgeAlert` and `getUserBadgeState` pass the purchase and the shown credential through; ack, snooze and the emitted-occurrence key work unchanged. +- `getUserBadgeState` fills `issueError` from `shownIssueError` and `nextWakeAt` from the purchase, so state and alert cannot disagree on what is shown. + +**Apps.** `BadgeState` gains the two optional fields; `BadgeIssueError` and `BadgeIssueFailure` are mirrored as ordinary decodable types (iOS: `BadgeState` becomes `Decodable, Hashable`, nothing encodes it; Kotlin: sealed class with `@SerialName` tags `serviceError`, `serviceTimeout`, `network`, `invalidCredential`, `unexpected`). `BadgeAlertKind` gains `issueFailed`, and `badgeAlertKindParam` maps it to `issue_failed`. `SupportSimpleXBanner` takes a `warning` flag for §3; the chat list computes `badgeIssueFailed` next to `supportEnded` and shows the banner under the same conditions, with the dismiss alert titled "Badge renewal failed". Your Badge gets §4 and §5. New Kotlin strings: about thirteen keys. + +## Tests + +`BadgeServiceTests`, with the test clock: a refusal (delete the purchase from the service's table, so it answers `unknown_purchase_key` without `retryAfter`) alerts on the next pass and `/_badge state` shows the error; a stopped service alerts only once the clock passes the credential's expiry, not before (the request timeout may need to be configurable for the test to run in seconds); a restart in between keeps `issue_failed_since`; the service back and a successful renewal clears state and alert; ack silences the run, and a new run after a success alerts again with a new episode; a service reply with no credential records nothing when the statement's debit ran the months out (Support ended follows), and records `unexpected` when months are left. + +`BadgeTests`: `internal` counts as transient and other refusals without `retryAfter` do not; an agent error is recorded as the agent error's text; a stored value the parser does not know reads back as `unexpected` with that text. + +## Decisions taken without asking + +- Persist in the DB, not in memory: the run's first-failure time must survive a restart, or every restart re-alerts. +- A new migration, not an edit of `M20260915`: 7.1 beta devices have applied it. +- Terminal vs transient is decided from the failure's kind, not from a count of attempts: counts depend on backoff timing, kinds do not. +- The transient threshold is the credential's expiry rather than a fixed 24 h, because that is when the failure becomes visible to contacts; the two nearly coincide. +- The banner, not a modal, for the reason in §3; a modal can be added later if the banner is missed. +- `reason` is typed (not a text) so the sentences in §4 are localizable, and the service code inside it is the `BadgeServiceErrorCode` the apps already decode. +- "Contact SimpleX team" reuses the existing address flow rather than pre-filling a message. + +## Not in this plan + +The service-side `//purchase ` lookup; a user-facing ledger; alerts for the other kinds (`BARenewalApproaching`, `BAPaymentIssue`) that need payments. diff --git a/simplex-chat.cabal b/simplex-chat.cabal index f5fda29685..72f162d7d8 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -166,6 +166,7 @@ library Simplex.Chat.Store.Postgres.Migrations.M20260828_file_expiry Simplex.Chat.Store.Postgres.Migrations.M20260904_file_badges Simplex.Chat.Store.Postgres.Migrations.M20260915_user_badges + Simplex.Chat.Store.Postgres.Migrations.M20260918_badge_issue_errors else exposed-modules: Simplex.Chat.Archive @@ -341,6 +342,7 @@ library Simplex.Chat.Store.SQLite.Migrations.M20260828_file_expiry Simplex.Chat.Store.SQLite.Migrations.M20260904_file_badges Simplex.Chat.Store.SQLite.Migrations.M20260915_user_badges + Simplex.Chat.Store.SQLite.Migrations.M20260918_badge_issue_errors other-modules: Paths_simplex_chat hs-source-dirs: diff --git a/src/Simplex/Chat/Badges/Service.hs b/src/Simplex/Chat/Badges/Service.hs index d876dbb059..725009d839 100644 --- a/src/Simplex/Chat/Badges/Service.hs +++ b/src/Simplex/Chat/Badges/Service.hs @@ -42,7 +42,6 @@ import Simplex.Chat.Badges import Simplex.Chat.Badges.Types import Simplex.Chat.PaymentService import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, taggedObjectJSON) import Simplex.Messaging.Version (VersionRange, VersionScope, mkVersionRange) import Simplex.Messaging.Version.Internal (Version (..)) @@ -205,74 +204,6 @@ data StatementDebitType | SDUnknown {tag :: Text, json :: J.Object} deriving (Show) -data BadgeServiceErrorCode - = BSEBadRequest - | BSEUnsupportedVersion - | BSEUnknownPurchaseKey - | BSEUnknownOfferId - | BSEOfferDisabled - | BSEOfferMismatch - | BSEProductUnavailable - | BSEPaymentNotEntitled - | BSEPaymentPending - | BSEProviderUnavailable - | BSERateLimited - | BSECodeInvalid - | BSECodeUsed - | BSECodeExpired - | BSEReceiptInvalid - | BSEReceiptUsed - | BSEInternal - | BSEUnknown Text -- forwards-compatible: service is deployed ahead of clients - deriving (Eq, Show) - -instance TextEncoding BadgeServiceErrorCode where - textEncode = \case - BSEBadRequest -> "bad_request" - BSEUnsupportedVersion -> "unsupported_version" - BSEUnknownPurchaseKey -> "unknown_purchase_key" - BSEUnknownOfferId -> "unknown_offer_id" - BSEOfferDisabled -> "offer_disabled" - BSEOfferMismatch -> "offer_mismatch" - BSEProductUnavailable -> "product_unavailable" - BSEPaymentNotEntitled -> "payment_not_entitled" - BSEPaymentPending -> "payment_pending" - BSEProviderUnavailable -> "provider_unavailable" - BSERateLimited -> "rate_limited" - BSECodeInvalid -> "code_invalid" - BSECodeUsed -> "code_used" - BSECodeExpired -> "code_expired" - BSEReceiptInvalid -> "receipt_invalid" - BSEReceiptUsed -> "receipt_used" - BSEInternal -> "internal" - BSEUnknown t -> t - textDecode s = Just $ case s of - "bad_request" -> BSEBadRequest - "unsupported_version" -> BSEUnsupportedVersion - "unknown_purchase_key" -> BSEUnknownPurchaseKey - "unknown_offer_id" -> BSEUnknownOfferId - "offer_disabled" -> BSEOfferDisabled - "offer_mismatch" -> BSEOfferMismatch - "product_unavailable" -> BSEProductUnavailable - "payment_not_entitled" -> BSEPaymentNotEntitled - "payment_pending" -> BSEPaymentPending - "provider_unavailable" -> BSEProviderUnavailable - "rate_limited" -> BSERateLimited - "code_invalid" -> BSECodeInvalid - "code_used" -> BSECodeUsed - "code_expired" -> BSECodeExpired - "receipt_invalid" -> BSEReceiptInvalid - "receipt_used" -> BSEReceiptUsed - "internal" -> BSEInternal - t -> BSEUnknown t - -instance ToJSON BadgeServiceErrorCode where - toJSON = textToJSON - toEncoding = textToEncoding - -instance FromJSON BadgeServiceErrorCode where - parseJSON = textParseJSON "BadgeServiceErrorCode" - $(pure []) instance FromJSON StatementCreditType where diff --git a/src/Simplex/Chat/Badges/Types.hs b/src/Simplex/Chat/Badges/Types.hs index cc205458c7..1038b2b64f 100644 --- a/src/Simplex/Chat/Badges/Types.hs +++ b/src/Simplex/Chat/Badges/Types.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -18,6 +19,9 @@ module Simplex.Chat.Badges.Types LedgerCreditType (..), LedgerDebitType (..), BadgeAlertKind (..), + BadgeServiceErrorCode (..), + BadgeIssueFailure (..), + BadgeIssueError (..), BadgeFunding (..), BadgePurchase (..), BadgeLedgerEntry (..), @@ -28,11 +32,14 @@ module Simplex.Chat.Badges.Types BadgeState (..), ) where -import Data.Aeson (FromJSON, ToJSON) +import Control.Applicative ((<|>)) +import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as J import qualified Data.Aeson.TH as JQ +import qualified Data.Attoparsec.ByteString.Char8 as A import Data.Int (Int64) import Data.Text (Text) +import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Time.Clock (UTCTime) import Data.Word (Word8) import Simplex.Chat.Badges hiding (BadgePurchase (..)) @@ -42,7 +49,8 @@ import Simplex.Messaging.Agent.Protocol (UserId) import Simplex.Messaging.Agent.Store.DB (fromTextField_) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, taggedObjectJSON) +import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON, taggedObjectJSON) +import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8) #if defined(dbPostgres) import Database.PostgreSQL.Simple.FromField (FromField (..)) import Database.PostgreSQL.Simple.ToField (ToField (..)) @@ -108,7 +116,7 @@ data LedgerDebitType deriving (Eq, Show) -- unconfirmed draft -data BadgeAlertKind = BARenewalApproaching | BAPaymentIssue | BASubscriptionEnded | BAPrepaidEnding | BASupportEnded +data BadgeAlertKind = BARenewalApproaching | BAPaymentIssue | BASubscriptionEnded | BAPrepaidEnding | BASupportEnded | BAIssueFailed deriving (Eq, Show) instance TextEncoding BadgeAlertKind where @@ -118,12 +126,14 @@ instance TextEncoding BadgeAlertKind where BASubscriptionEnded -> "subscription_ended" BAPrepaidEnding -> "prepaid_ending" BASupportEnded -> "support_ended" + BAIssueFailed -> "issue_failed" textDecode = \case "renewal_approaching" -> Just BARenewalApproaching "payment_issue" -> Just BAPaymentIssue "subscription_ended" -> Just BASubscriptionEnded "prepaid_ending" -> Just BAPrepaidEnding "support_ended" -> Just BASupportEnded + "issue_failed" -> Just BAIssueFailed _ -> Nothing instance FromField BadgeAlertKind where fromField = fromTextField_ textDecode @@ -215,6 +225,44 @@ data BadgeAlertPrice = BadgeAlertPrice } deriving (Show) +data BadgeServiceErrorCode + = BSEBadRequest + | BSEUnsupportedVersion + | BSEUnknownPurchaseKey + | BSEUnknownOfferId + | BSEOfferDisabled + | BSEOfferMismatch + | BSEProductUnavailable + | BSEPaymentNotEntitled + | BSEPaymentPending + | BSEProviderUnavailable + | BSERateLimited + | BSECodeInvalid + | BSECodeUsed + | BSECodeExpired + | BSEReceiptInvalid + | BSEReceiptUsed + | BSEInternal + | BSEUnknown Text -- forwards-compatible: service is deployed ahead of clients + deriving (Eq, Show) + +-- | Why a renewal request ended without a credential stored. retryable is the service's own view of +-- transience: it gave retryAfter, which holds for codes this version does not know. +data BadgeIssueFailure + = BIFServiceError {code :: BadgeServiceErrorCode, retryable :: Bool} + | BIFServiceTimeout + | BIFNetwork {agentError :: Text} + | BIFInvalidCredential + | BIFUnexpected {message :: Text} + deriving (Eq, Show) + +data BadgeIssueError = BadgeIssueError + { failedSince :: UTCTime, + lastAttemptAt :: UTCTime, + reason :: BadgeIssueFailure + } + deriving (Eq, Show) + -- | The user's badge as the badge surfaces render it. The private purchase key is deliberately -- absent: this travels to the UI and over remote control, and it is a secret that stays in core. data BadgeState = BadgeState @@ -227,7 +275,9 @@ data BadgeState = BadgeState -- payments returns here with the payment types, which this slice neither writes nor encodes renewsAt :: Maybe UTCTime, willRenew :: Bool, - alert :: Maybe BadgeAlert + alert :: Maybe BadgeAlert, + issueError :: Maybe BadgeIssueError, + nextWakeAt :: Maybe UTCTime } deriving (Show) @@ -263,6 +313,88 @@ instance FromField BadgeCodePaymentStatus where fromField = fromTextField_ textD instance ToField BadgeCodePaymentStatus where toField = toField . textEncode +instance TextEncoding BadgeServiceErrorCode where + textEncode = \case + BSEBadRequest -> "bad_request" + BSEUnsupportedVersion -> "unsupported_version" + BSEUnknownPurchaseKey -> "unknown_purchase_key" + BSEUnknownOfferId -> "unknown_offer_id" + BSEOfferDisabled -> "offer_disabled" + BSEOfferMismatch -> "offer_mismatch" + BSEProductUnavailable -> "product_unavailable" + BSEPaymentNotEntitled -> "payment_not_entitled" + BSEPaymentPending -> "payment_pending" + BSEProviderUnavailable -> "provider_unavailable" + BSERateLimited -> "rate_limited" + BSECodeInvalid -> "code_invalid" + BSECodeUsed -> "code_used" + BSECodeExpired -> "code_expired" + BSEReceiptInvalid -> "receipt_invalid" + BSEReceiptUsed -> "receipt_used" + BSEInternal -> "internal" + BSEUnknown t -> t + textDecode s = Just $ case s of + "bad_request" -> BSEBadRequest + "unsupported_version" -> BSEUnsupportedVersion + "unknown_purchase_key" -> BSEUnknownPurchaseKey + "unknown_offer_id" -> BSEUnknownOfferId + "offer_disabled" -> BSEOfferDisabled + "offer_mismatch" -> BSEOfferMismatch + "product_unavailable" -> BSEProductUnavailable + "payment_not_entitled" -> BSEPaymentNotEntitled + "payment_pending" -> BSEPaymentPending + "provider_unavailable" -> BSEProviderUnavailable + "rate_limited" -> BSERateLimited + "code_invalid" -> BSECodeInvalid + "code_used" -> BSECodeUsed + "code_expired" -> BSECodeExpired + "receipt_invalid" -> BSEReceiptInvalid + "receipt_used" -> BSEReceiptUsed + "internal" -> BSEInternal + t -> BSEUnknown t + +instance ToJSON BadgeServiceErrorCode where + toJSON = textToJSON + toEncoding = textToEncoding + +instance FromJSON BadgeServiceErrorCode where + parseJSON = textParseJSON "BadgeServiceErrorCode" + +instance StrEncoding BadgeIssueFailure where + strEncode = \case + BIFServiceError {code, retryable} -> "service_error " <> (if retryable then "retry " else "final ") <> encodeUtf8 (textEncode code) + BIFServiceTimeout -> "service_timeout" + BIFNetwork {agentError} -> "network " <> encodeUtf8 agentError + BIFInvalidCredential -> "invalid_credential" + BIFUnexpected {message} -> "unexpected " <> encodeUtf8 message + -- a row this version cannot read is reported as it stands rather than failing every read of the purchase + strP = (knownP <* A.endOfInput) <|> (BIFUnexpected . safeDecodeUtf8 <$> A.takeByteString) + where + knownP = + A.takeWhile1 (/= ' ') >>= \case + "service_error" -> serviceErrorP + "service_timeout" -> pure BIFServiceTimeout + "network" -> BIFNetwork <$> restP + "invalid_credential" -> pure BIFInvalidCredential + "unexpected" -> BIFUnexpected <$> restP + _ -> fail "bad BadgeIssueFailure" + -- the code is encoded last and read to the end, so a code this version does not know reads back whole + serviceErrorP = do + retryable_ <- A.space *> retryableP + code_ <- A.space *> codeP + pure BIFServiceError {code = code_, retryable = retryable_} + retryableP = + A.takeWhile1 (/= ' ') >>= \case + "retry" -> pure True + "final" -> pure False + _ -> fail "bad BadgeIssueFailure retry flag" + codeP = A.takeByteString >>= maybe (fail "bad BadgeServiceErrorCode") pure . textDecode . safeDecodeUtf8 + restP = safeDecodeUtf8 <$> (A.space *> A.takeByteString) + +instance ToField BadgeIssueFailure where toField = toField . decodeLatin1 . strEncode + +instance FromField BadgeIssueFailure where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8 + $(JQ.deriveJSON (enumJSON $ dropPrefix "BIS") ''BadgeItemStatus) $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "OD") ''OfferDiscount) @@ -273,4 +405,8 @@ $(JQ.deriveJSON defaultJSON ''BadgeAlertPrice) $(JQ.deriveJSON defaultJSON ''BadgeAlert) +$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "BIF") ''BadgeIssueFailure) + +$(JQ.deriveJSON defaultJSON ''BadgeIssueError) + $(JQ.deriveJSON defaultJSON ''BadgeState) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 89c6305d73..91ef260bfa 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 (..), BadgeState (..)) +import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind (..), BadgeIssueError (..), BadgeIssueFailure (..), BadgeState (..)) import Simplex.Chat.Badges.Code (badgeCodeText, parseBadgeCode) import Simplex.Chat.Badges.Service (BadgeBalance (..), BadgeServiceCommand (..), BadgeServiceErrorCode (..), BadgeServiceRequest (..), BadgeServiceResponse (..), BadgeStatement (..), StatementDebitType (..), StatementEntry (..), StatementEntryType (..), currentBadgeServiceVersion) import Simplex.Chat.Names (SimplexDomainProof (..), SimplexDomainClaim (..), claimDomain, mkDomainClaim) @@ -5256,14 +5256,18 @@ redeemBadgeCode nm user@User {userId} codeText = do throwRedeemError :: BadgeRedeemError -> CM a throwRedeemError = throwChatError . CEBadgeRedeemError --- | An unknown code is reported, since the service is deployed ahead of clients, but its text is --- the service's - so it is bounded and stripped before reaching a terminal that acts on controls. badgeServiceErrorText :: BadgeServiceErrorCode -> Text -badgeServiceErrorText = \case - BSEUnknown t -> case T.filter errorCodeChar (T.take 32 t) of +badgeServiceErrorText = textEncode . boundedServiceErrorCode + +-- | An unknown code is reported and recorded, since the service is deployed ahead of clients, but +-- its text is the service's - so it is bounded and stripped before it reaches a terminal that acts +-- on controls, or a sentence the app shows the user as its own. +boundedServiceErrorCode :: BadgeServiceErrorCode -> BadgeServiceErrorCode +boundedServiceErrorCode = \case + BSEUnknown t -> BSEUnknown $ case T.filter errorCodeChar (T.take 32 t) of "" -> "unknown" t' -> t' - code -> textEncode code + code -> code where errorCodeChar c = isAsciiLower c || isDigit c || c == '_' @@ -5286,7 +5290,7 @@ getBadgeWorker User {userId} = do withGetSessVar' seq' userId ws now startWorker signalWorker where startWorker v = do - badgeWork <- newTMVarIO () + badgeWork <- newEmptyTMVarIO badgeWorkerAsync <- async $ void $ runExceptT $ runBadgeWorker userId badgeWork let w = BadgeWorker {badgeWorkerAsync, badgeWork} w <$ atomically (putTMVar (sessionVar v) w) @@ -5305,16 +5309,33 @@ runBadgeWorker userId badgeWork = do emitted <- newTVarIO Nothing ri <- asks $ badgeRetryInterval . config forever $ do - at_ <- withRetryInterval ri $ \_ loop -> do + at_ <- withRetryInterval ri $ \delay loop -> do lift waitChatStartedAndActivated now <- badgeNow - let stalled = pure $ Just $ badgeStalledInterval `addUTCTime` now - updateUserBadge userId emitted now `catchAllErrors` retryBadgeError loop stalled + updateUserBadge userId emitted now `catchAllErrors` retryBadgeError userId delay loop now <- badgeNow liftIO $ waitBadgeWake badgeWork now at_ -retryBadgeError :: CM a -> CM a -> ChatError -> CM a -retryBadgeError loop stalled e = eToView e >> if badgeErrorRetry e then loop else stalled +-- | Records the wake before waiting it out, so the state the apps hold carries the next attempt +-- however the pass ended. +retryBadgeError :: UserId -> Int64 -> CM (Maybe UTCTime) -> ChatError -> CM (Maybe UTCTime) +retryBadgeError userId delay loop e = do + eToView e + now <- badgeNow + let retrying = badgeErrorRetry e + at = (if retrying then fromIntegral delay / 1000000 else badgeStalledInterval) `addUTCTime` now + badgeNextWakeChanged userId at + if retrying then loop else pure (Just at) + +-- | Runs in the worker's error handler, so its own errors are reported and dropped: a throw here +-- would end the worker. +badgeNextWakeChanged :: UserId -> UTCTime -> CM () +badgeNextWakeChanged userId at = (`catchAllErrors` eToView) $ do + user <- withStore $ \db -> getUser db userId + written <- withStore' $ \db -> do + p_ <- getUserBadgePurchase db user + forM p_ $ \UserBadgePurchase {badgePurchaseId} -> setBadgeNextWake db badgePurchaseId (Just at) + when (isJust written) $ toView . CEvtBadgeChanged user =<< getUserBadgeState user -- | The signal is taken only by the wait that reports it - the take and the timer read are one -- transaction. now is the badge clock, so the remaining time counts down rather than re-reading it. @@ -5367,40 +5388,52 @@ updateUserBadge userId emitted now = do let issued = balanceStartTs balance' /= balanceStartTs balance -- outside the badge lock: the chat lock must not be taken under it unless retired $ presentIssuedBadge user' p' now - emitBadgeAlert user' emitted p' now balance' -- retiring and presenting both replace the badge on the record read above, so it is read again user'' <- withStore $ \db -> getUser db userId - when (retired || issued) $ toView . CEvtBadgeChanged user'' =<< getUserBadgeState user'' + emitBadgeAlert user'' emitted p' (shownBadgeCredential user'' p') now balance' -- a snooze is the one wake that is not in the ledger: nothing else brings the alert back, -- since support having ended leaves both ledger boundaries in the past - let UserBadgePurchase {alertSnoozeUntil} = p' + let UserBadgePurchase {issueError = failureBefore} = p + UserBadgePurchase {alertSnoozeUntil, issueError = failureAfter} = p' snoozeAt = find (> now) alertSnoozeUntil stalledAt = if requestDue && not issued then Just $ badgeStalledInterval `addUTCTime` now else Nothing - pure $ earliestTime [serviceAt, snoozeAt, stalledAt, badgeBoundary now (shownBadgeCredential user'' p') balance'] + wakeAt = earliestTime [serviceAt, snoozeAt, stalledAt, badgeBoundary now (shownBadgeCredential user'' p') balance'] + failed = failureAfter /= failureBefore + -- written before the event, so the state it reports carries the attempt it leads to + withStore' $ \db -> setBadgeNextWake db badgePurchaseId wakeAt + when (retired || issued || failed) $ toView . CEvtBadgeChanged user'' =<< getUserBadgeState user'' + pure wakeAt --- | Support ended is the only alert raised here: the others need subscriptions, and warning before --- a prepaid badge ends is not actionable while topping up cannot credit months without issuing. +-- | The other kinds need subscriptions, and 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 -> StatementEntry -> Maybe BadgeAlert -derivedBadgeAlert now b - | balanceMonths b == 0 && endsAt <= now = - Just BadgeAlert {kind = BASupportEnded, episode = safeDecodeUtf8 $ strEncode endsAt, date = endsAt, price = Nothing} - | otherwise = Nothing +derivedBadgeAlert :: UTCTime -> UserBadgePurchase -> Maybe BadgeCredential -> StatementEntry -> Maybe BadgeAlert +derivedBadgeAlert now p shownCred b + | endsAt <= now = Just $ alertOf BASupportEnded endsAt + | otherwise = (\BadgeIssueError {failedSince} -> alertOf BAIssueFailed failedSince) <$> shownIssueError now p shownCred where endsAt = L.paidThrough b + alertOf kind date = BadgeAlert {kind, episode = safeDecodeUtf8 $ strEncode date, date, price = Nothing} + +-- | 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 + Just e@BadgeIssueError {reason} + | not (badgeFailureTransient reason) || maybe False ((<= now) . credentialExpiry) shownCred -> Just e + _ -> Nothing -- | Derived from state rather than kept pending: raised unless this occurrence is the one already -- answered, and raised again once a snooze that answered it lapses. -unansweredBadgeAlert :: UTCTime -> UserBadgePurchase -> StatementEntry -> Maybe BadgeAlert -unansweredBadgeAlert now UserBadgePurchase {alertAcked, alertSnoozeUntil} balance = - case derivedBadgeAlert now balance of +unansweredBadgeAlert :: UTCTime -> UserBadgePurchase -> Maybe BadgeCredential -> StatementEntry -> Maybe BadgeAlert +unansweredBadgeAlert now p@UserBadgePurchase {alertAcked, alertSnoozeUntil} shownCred balance = + case derivedBadgeAlert now p shownCred balance of Just alert@BadgeAlert {kind, episode} | alertAcked /= Just (kind, episode) || maybe False (now >=) alertSnoozeUntil -> Just alert _ -> Nothing -emitBadgeAlert :: User -> TVar (Maybe BadgeOccurrence) -> UserBadgePurchase -> UTCTime -> StatementEntry -> CM () -emitBadgeAlert user emitted p@UserBadgePurchase {alertSnoozeUntil} now balance = - forM_ (unansweredBadgeAlert now p balance) $ \alert@BadgeAlert {kind, episode} -> do +emitBadgeAlert :: User -> TVar (Maybe BadgeOccurrence) -> UserBadgePurchase -> Maybe BadgeCredential -> UTCTime -> StatementEntry -> CM () +emitBadgeAlert user emitted p@UserBadgePurchase {alertSnoozeUntil} shownCred now balance = + forM_ (unansweredBadgeAlert now p shownCred balance) $ \alert@BadgeAlert {kind, episode} -> do let occurrence = Just (kind, episode, alertSnoozeUntil) raised <- atomically $ stateTVar emitted (,occurrence) when (raised /= occurrence) $ toView $ CEvtBadgeAlert user alert @@ -5414,18 +5447,21 @@ getUserBadgeState user = do Just p@UserBadgePurchase {badgePurchaseId} -> fmap (badgeStateOf now p) <$> withStore' (`getBadgeLedgerLastEntry` badgePurchaseId) where - badgeStateOf now p@UserBadgePurchase {badgePurchaseId, purchaseKey, badgeType, shown} balance = - BadgeState - { badgePurchaseId, - purchaseKey, - badgeType, - shown = BoolDef shown, - monthsLeft = balanceMonths balance, - paidThrough = L.paidThrough balance, - renewsAt = Nothing, - willRenew = False, - alert = unansweredBadgeAlert now p balance - } + badgeStateOf now p@UserBadgePurchase {badgePurchaseId, purchaseKey, badgeType, shown, nextWakeAt} balance = + let shownCred = shownBadgeCredential user p + in BadgeState + { badgePurchaseId, + purchaseKey, + badgeType, + shown = BoolDef shown, + monthsLeft = balanceMonths balance, + paidThrough = L.paidThrough balance, + renewsAt = Nothing, + willRenew = False, + alert = unansweredBadgeAlert now p shownCred balance, + issueError = shownIssueError now p shownCred, + nextWakeAt + } -- | How long a month that did not issue waits before it is tried again, whatever stopped it. Not -- derived from the failure, so a misclassified one cannot leave a funded badge to expire. @@ -5485,22 +5521,39 @@ earliestTime ts = case catMaybes ts of [] -> Nothing ts' -> Just $ minimum ts' +-- | temporaryOrHostError covers failing to reach the server; the service timeout is a request sent and not answered. +badgeIssueFailure :: ChatError -> BadgeIssueFailure +badgeIssueFailure e = case e of + ChatErrorAgent {agentError = AGENT (A_SERVICE ASETimeout)} -> BIFServiceTimeout + ChatErrorAgent {agentError} + | temporaryOrHostError agentError -> BIFNetwork {agentError = tshow agentError} + | otherwise -> BIFUnexpected {message = tshow agentError} + ChatError (CECommandError m) -> BIFUnexpected {message = T.pack m} + ChatError (CEInternalError m) -> BIFUnexpected {message = T.pack m} + _ -> BIFUnexpected {message = tshow e} + +-- | Whether a failure can clear on its own, which decides whether the alert waits for the shown +-- credential to lapse - and, for a thrown error, whether the pass retries it. +badgeFailureTransient :: BadgeIssueFailure -> Bool +badgeFailureTransient = \case + -- the service withholds retryAfter from internal to avoid being pressed while failing, not because it is final + BIFServiceError {code = BSEInternal} -> True + BIFServiceError {retryable} -> retryable + BIFServiceTimeout -> True + BIFNetwork {} -> True + BIFInvalidCredential -> False + BIFUnexpected {} -> False + -- | Only a failure that can clear on its own is repeated; every other throw is terminal, and -- repeating it would spin. Service errors are classified by retryAfter in requestBadgeIssue. badgeErrorRetry :: ChatError -> Bool -badgeErrorRetry = \case - ChatErrorAgent {agentError} -> retryable agentError - _ -> False - where - -- an unanswered request is the likeliest renewal failure and temporaryOrHostError does not - -- cover it: that classifies reaching the server, and this timeout is the agent's own - retryable = \case - AGENT (A_SERVICE ASETimeout) -> True - e -> temporaryOrHostError e +badgeErrorRetry = badgeFailureTransient . badgeIssueFailure --- | Ask the service for the month that is due and apply the response. A timeout writes nothing, so --- the same request is sent again on the next pass. 'Left' is a service error, already reported, and --- carries when to try again, since a service error is answered rather than thrown. +-- | Ask the service for the month that is due and apply the response. A timeout stores no ledger row, +-- so the same request is sent again on the next pass. 'Left' is a service error, already reported, and +-- carries when to try again, since a service error is answered rather than thrown. Any request that +-- ends without a credential the ledger still owes is recorded on the purchase as a failed renewal; +-- nothing else records one. requestBadgeIssue :: UserId -> UserBadgePurchase -> UTCTime -> CM (Either UTCTime StatementEntry) requestBadgeIssue userId UserBadgePurchase {badgePurchaseId, badgeType, purchaseKey, purchasePrivKey, masterKey} now = do sendTarget <- asks (badgeServiceAddress . config) >>= maybe (throwCmdError "badge service not configured") pure @@ -5513,24 +5566,43 @@ requestBadgeIssue userId UserBadgePurchase {badgePurchaseId, badgeType, purchase purchaseKey = Just purchaseKey, request = BSCIssueBadge {balance = BadgeBalance {lastEntry}} } - respData <- sendServiceRequestTo NRMBackground user sendTarget Nothing (Just purchasePrivKey) req + respData <- + sendServiceRequestTo NRMBackground user sendTarget Nothing (Just purchasePrivKey) req + `catchAllErrors` \e -> recordFailure (badgeIssueFailure e) >> throwError e case J.fromJSON (J.Object respData) of - J.Success BSPBadgeCredential {credential, statement} -> do - cred_ <- verifyIssuedCredential masterKey credential - -- TODO [badges] the statement is applied either way, so a failed verification spends the - -- month with nothing to show for it; that needs an alert, not only a line in the log + J.Success BSPBadgeCredential {credential = sentCred_, statement} -> do + verifiedCred_ <- verifyIssuedCredential masterKey sentCred_ g <- asks random -- read again: now was taken before a lock wait and an untimed request, and the check reads -- it as the client's clock against the timestamps the service put on the rows storedAt <- badgeNow - applied <- withStore' $ \db -> applyBadgeStatement db g badgePurchaseId badgeType statement cred_ storedAt - unless applied $ eToView $ ChatError $ CEInternalError "issued badge credential has no ledger row to store it against" - Right <$> (withStore' (`getBadgeLedgerLastEntry` badgePurchaseId) >>= maybe (throwCmdError "badge ledger has no balance") pure) + (applied, balance_) <- withStore' $ \db -> do + applied <- applyBadgeStatement db g badgePurchaseId badgeType statement verifiedCred_ storedAt + (applied,) <$> getBadgeLedgerLastEntry db badgePurchaseId + -- the statement is applied either way, so a month can be spent with nothing to show for it + case (sentCred_, verifiedCred_, applied) of + (Just _, Nothing, _) -> recordFailure BIFInvalidCredential + (_, _, False) -> recordUnexpected "issued badge credential has no ledger row to store it against" + -- no credential is the service saying the months ran out, which its statement then shows + (Nothing, _, _) | maybe False ((> 0) . balanceMonths) balance_ -> recordUnexpected "badge service issued no credential" + _ -> pure () + maybe (throwCmdError "badge ledger has no balance") (pure . Right) balance_ J.Success BSPError {code, retryAfter} -> do eToView $ ChatError $ CECommandError $ "badge service error: " <> T.unpack (badgeServiceErrorText code) + recordFailure BIFServiceError {code = boundedServiceErrorCode code, retryable = isJust retryAfter} ri <- asks $ badgeRetryInterval . config pure $ Left $ badgeRetryAfter ri retryAfter `addUTCTime` now - _ -> throwCmdError "unexpected badge service response" + _ -> do + recordFailure BIFUnexpected {message = unexpectedResponse} + throwCmdError $ T.unpack unexpectedResponse + where + unexpectedResponse = "unexpected badge service response" + recordUnexpected message = do + eToView $ ChatError $ CEInternalError $ T.unpack message + recordFailure BIFUnexpected {message} + recordFailure failure = do + failedAt <- badgeNow + withStore' $ \db -> setBadgeIssueError db badgePurchaseId failedAt failure -- | The signature covers the master key inside the credential, so it verifies no matter which key -- that is - the credential is stored only when that key is also this purchase's. diff --git a/src/Simplex/Chat/Store/Badges.hs b/src/Simplex/Chat/Store/Badges.hs index d581150df8..19d6d2efef 100644 --- a/src/Simplex/Chat/Store/Badges.hs +++ b/src/Simplex/Chat/Store/Badges.hs @@ -13,6 +13,8 @@ module Simplex.Chat.Store.Badges getBadgePurchase, userHasBadge, setBadgeAlertAcked, + setBadgeIssueError, + setBadgeNextWake, clearShownBadge, getBadgeCodeRedemption, createBadgeCodeRedemption, @@ -39,7 +41,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, BadgePurchaseStatus (..)) +import Simplex.Chat.Badges.Types (BadgeAlertKind, BadgeIssueError (..), BadgeIssueFailure, BadgePurchaseStatus (..)) import Simplex.Chat.Store.Shared (insertedRowId) import Simplex.Chat.Types import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..)) @@ -146,6 +148,11 @@ storeBadgeIssuance db g badgePurchaseId entryId credential now = ON CONFLICT (badge_purchase_id, entry_id) DO NOTHING |] ((issuanceId, badgePurchaseId, entryId, badgeType) :. (periodStart, periodEnd, badgeExpiry, Binary (LB.toStrict $ J.encode credential), now)) + -- a month stored ends the run of failures + DB.execute + db + "UPDATE badge_purchases SET issue_failed_since = NULL, issue_error_at = NULL, issue_error = NULL WHERE badge_purchase_id = ?" + (Only badgePurchaseId) pure True where BadgeCredential {badgeInfo = BadgeInfo {badgeType, badgeExpiry}} = credential @@ -200,7 +207,9 @@ data UserBadgePurchase = UserBadgePurchase badgeType :: BadgeType, shown :: Bool, alertAcked :: Maybe (BadgeAlertKind, Text), - alertSnoozeUntil :: Maybe UTCTime + alertSnoozeUntil :: Maybe UTCTime, + issueError :: Maybe BadgeIssueError, + nextWakeAt :: Maybe UTCTime } -- | Newest, not the one shown_badge_id points at - retirement clears that, and the support ended @@ -229,14 +238,15 @@ getBadgePurchase db purchaseId = [sql| SELECT p.badge_purchase_id, p.purchase_key, p.purchase_priv_key, p.master_key, p.current_badge_type, (CASE WHEN u.shown_badge_id = p.badge_purchase_id THEN 1 ELSE 0 END), - p.alert_acked_kind, p.alert_acked_episode, p.alert_snooze_until + p.alert_acked_kind, p.alert_acked_episode, p.alert_snooze_until, + p.issue_failed_since, p.issue_error_at, p.issue_error, p.next_wake_at FROM badge_purchases p JOIN users u ON u.user_id = p.user_id WHERE p.badge_purchase_id = ? AND p.purchase_priv_key IS NOT NULL |] (Only purchaseId) where - toPurchase (badgePurchaseId, purchaseKey, purchasePrivKey, Binary mk, badgeType, shown_, ackedKind_, ackedEpisode_, alertSnoozeUntil) = + toPurchase ((badgePurchaseId, purchaseKey, purchasePrivKey, Binary mk, badgeType, shown_, ackedKind_, ackedEpisode_, alertSnoozeUntil) :. (failedSince_, lastAttemptAt_, reason_, nextWakeAt)) = UserBadgePurchase { badgePurchaseId, purchaseKey, @@ -245,7 +255,9 @@ getBadgePurchase db purchaseId = badgeType, shown = unBI shown_, alertAcked = (,) <$> ackedKind_ <*> ackedEpisode_, - alertSnoozeUntil + alertSnoozeUntil, + issueError = BadgeIssueError <$> failedSince_ <*> lastAttemptAt_ <*> reason_, + nextWakeAt } -- | Whether a badge is on the profile now: set when a redemption stores one, cleared when it is @@ -267,6 +279,24 @@ setBadgeAlertAcked db User {userId} badgePurchaseId kind episode snoozeUntil = "UPDATE badge_purchases SET alert_acked_kind = ?, alert_acked_episode = ?, alert_snooze_until = ? WHERE badge_purchase_id = ? AND user_id = ?" (kind, episode, snoozeUntil, badgePurchaseId, userId) +-- | Record a renewal that ended without a credential. The COALESCE keeps the start of the current +-- run of failures, which is the alert's episode and must survive a restart. +setBadgeIssueError :: DB.Connection -> Int64 -> UTCTime -> BadgeIssueFailure -> IO () +setBadgeIssueError db badgePurchaseId now failure = + DB.execute + db + [sql| + UPDATE badge_purchases + SET issue_failed_since = COALESCE(issue_failed_since, ?), issue_error_at = ?, issue_error = ? + WHERE badge_purchase_id = ? + |] + (now, now, failure, badgePurchaseId) + +-- | The wake the worker is about to wait for, so the state the apps hold says when it will try again. +setBadgeNextWake :: DB.Connection -> Int64 -> Maybe UTCTime -> IO () +setBadgeNextWake db badgePurchaseId at_ = + DB.execute db "UPDATE badge_purchases SET next_wake_at = ? WHERE badge_purchase_id = ?" (at_, badgePurchaseId) + -- | Stop showing a badge that has expired unrenewed; the profile update is broadcast by the caller. clearShownBadge :: DB.Connection -> User -> Int64 -> IO () clearShownBadge db User {userId} badgePurchaseId = diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index 9e5a1aa5aa..40c13527d9 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -51,6 +51,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260822_forward_link import Simplex.Chat.Store.Postgres.Migrations.M20260828_file_expiry import Simplex.Chat.Store.Postgres.Migrations.M20260904_file_badges import Simplex.Chat.Store.Postgres.Migrations.M20260915_user_badges +import Simplex.Chat.Store.Postgres.Migrations.M20260918_badge_issue_errors import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] @@ -101,7 +102,8 @@ schemaMigrations = ("20260822_forward_link", m20260822_forward_link, Just down_m20260822_forward_link), ("20260828_file_expiry", m20260828_file_expiry, Just down_m20260828_file_expiry), ("20260904_file_badges", m20260904_file_badges, Just down_m20260904_file_badges), - ("20260915_user_badges", m20260915_user_badges, Just down_m20260915_user_badges) + ("20260915_user_badges", m20260915_user_badges, Just down_m20260915_user_badges), + ("20260918_badge_issue_errors", m20260918_badge_issue_errors, Just down_m20260918_badge_issue_errors) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20260918_badge_issue_errors.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20260918_badge_issue_errors.hs new file mode 100644 index 0000000000..3edfc5b9ef --- /dev/null +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20260918_badge_issue_errors.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.Postgres.Migrations.M20260918_badge_issue_errors where + +import Data.Text (Text) +import Text.RawString.QQ (r) + +m20260918_badge_issue_errors :: Text +m20260918_badge_issue_errors = + [r| +ALTER TABLE badge_purchases ADD COLUMN issue_failed_since TIMESTAMPTZ; + +ALTER TABLE badge_purchases ADD COLUMN issue_error_at TIMESTAMPTZ; + +ALTER TABLE badge_purchases ADD COLUMN issue_error TEXT; + +ALTER TABLE badge_purchases ADD COLUMN next_wake_at TIMESTAMPTZ; +|] + +down_m20260918_badge_issue_errors :: Text +down_m20260918_badge_issue_errors = + [r| +ALTER TABLE badge_purchases DROP COLUMN issue_failed_since; + +ALTER TABLE badge_purchases DROP COLUMN issue_error_at; + +ALTER TABLE badge_purchases DROP COLUMN issue_error; + +ALTER TABLE badge_purchases DROP COLUMN next_wake_at; +|] diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql index 1e2a26d74e..0c7bf85cb6 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql @@ -275,7 +275,11 @@ CREATE TABLE test_chat_schema.badge_purchases ( alert_acked_kind text, alert_acked_episode text, alert_snooze_until timestamp with time zone, - badge_code_redemption_id bigint + badge_code_redemption_id bigint, + issue_failed_since timestamp with time zone, + issue_error_at timestamp with time zone, + issue_error text, + next_wake_at timestamp with time zone ); diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index 0bbd7c06b6..f49495168e 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -174,6 +174,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260822_forward_link import Simplex.Chat.Store.SQLite.Migrations.M20260828_file_expiry import Simplex.Chat.Store.SQLite.Migrations.M20260904_file_badges import Simplex.Chat.Store.SQLite.Migrations.M20260915_user_badges +import Simplex.Chat.Store.SQLite.Migrations.M20260918_badge_issue_errors import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -347,7 +348,8 @@ schemaMigrations = ("20260822_forward_link", m20260822_forward_link, Just down_m20260822_forward_link), ("20260828_file_expiry", m20260828_file_expiry, Just down_m20260828_file_expiry), ("20260904_file_badges", m20260904_file_badges, Just down_m20260904_file_badges), - ("20260915_user_badges", m20260915_user_badges, Just down_m20260915_user_badges) + ("20260915_user_badges", m20260915_user_badges, Just down_m20260915_user_badges), + ("20260918_badge_issue_errors", m20260918_badge_issue_errors, Just down_m20260918_badge_issue_errors) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20260918_badge_issue_errors.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20260918_badge_issue_errors.hs new file mode 100644 index 0000000000..ed50354bf9 --- /dev/null +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20260918_badge_issue_errors.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.SQLite.Migrations.M20260918_badge_issue_errors where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20260918_badge_issue_errors :: Query +m20260918_badge_issue_errors = + [sql| +ALTER TABLE badge_purchases ADD COLUMN issue_failed_since TEXT; + +ALTER TABLE badge_purchases ADD COLUMN issue_error_at TEXT; + +ALTER TABLE badge_purchases ADD COLUMN issue_error TEXT; + +ALTER TABLE badge_purchases ADD COLUMN next_wake_at TEXT; +|] + +down_m20260918_badge_issue_errors :: Query +down_m20260918_badge_issue_errors = + [sql| +ALTER TABLE badge_purchases DROP COLUMN issue_failed_since; + +ALTER TABLE badge_purchases DROP COLUMN issue_error_at; + +ALTER TABLE badge_purchases DROP COLUMN issue_error; + +ALTER TABLE badge_purchases DROP COLUMN next_wake_at; +|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index e887bb2548..4062a1e8f6 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -4061,7 +4061,8 @@ SEARCH p USING INTEGER PRIMARY KEY (rowid=?) Query: SELECT p.badge_purchase_id, p.purchase_key, p.purchase_priv_key, p.master_key, p.current_badge_type, (CASE WHEN u.shown_badge_id = p.badge_purchase_id THEN 1 ELSE 0 END), - p.alert_acked_kind, p.alert_acked_episode, p.alert_snooze_until + p.alert_acked_kind, p.alert_acked_episode, p.alert_snooze_until, + p.issue_failed_since, p.issue_error_at, p.issue_error, p.next_wake_at FROM badge_purchases p JOIN users u ON u.user_id = p.user_id WHERE p.badge_purchase_id = ? AND p.purchase_priv_key IS NOT NULL @@ -5152,6 +5153,14 @@ SEARCH f USING INTEGER PRIMARY KEY (rowid=?) SEARCH s USING COVERING INDEX idx_snd_files_file_id (file_id=?) LEFT-JOIN SEARCH r USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN +Query: + UPDATE badge_purchases + SET issue_failed_since = COALESCE(issue_failed_since, ?), issue_error_at = ?, issue_error = ? + WHERE badge_purchase_id = ? + +Plan: +SEARCH badge_purchases USING INTEGER PRIMARY KEY (rowid=?) + Query: UPDATE chat_items SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ? @@ -7576,6 +7585,10 @@ Query: SELECT image FROM contact_profiles WHERE display_name = ? LIMIT 1 Plan: SEARCH contact_profiles USING INDEX contact_profiles_index (display_name=?) +Query: SELECT issue_failed_since, issue_error FROM badge_purchases +Plan: +SCAN badge_purchases + Query: SELECT last_insert_rowid() Plan: SCAN CONSTANT ROW @@ -7764,6 +7777,14 @@ Query: UPDATE badge_purchases SET alert_acked_kind = ?, alert_acked_episode = ?, Plan: SEARCH badge_purchases USING INTEGER PRIMARY KEY (rowid=?) +Query: UPDATE badge_purchases SET issue_failed_since = NULL, issue_error_at = NULL, issue_error = NULL WHERE badge_purchase_id = ? +Plan: +SEARCH badge_purchases USING INTEGER PRIMARY KEY (rowid=?) + +Query: UPDATE badge_purchases SET next_wake_at = ? WHERE badge_purchase_id = ? +Plan: +SEARCH badge_purchases USING INTEGER PRIMARY KEY (rowid=?) + Query: UPDATE chat_items SET item_msg_body = ?, item_chat_binding = ?, item_signatures = ?, item_signed_by_group_member_id = ? WHERE chat_item_id = ? AND include_in_history = 1 Plan: SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?) diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 090b6332ab..b6eddbaf0f 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -932,6 +932,10 @@ CREATE TABLE badge_purchases( alert_acked_episode TEXT, alert_snooze_until TEXT, badge_code_redemption_id INTEGER REFERENCES badge_code_redemptions, + issue_failed_since TEXT, + issue_error_at TEXT, + issue_error TEXT, + next_wake_at TEXT, UNIQUE(purchase_key) ) STRICT; CREATE TABLE badge_ledger( diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 66158303f9..1c62bc267b 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -46,7 +46,7 @@ import Simplex.Chat.Markdown import Simplex.Chat.Badges (BadgeInfo (..), BadgeStatus (..), BadgeType (..), LocalBadge, localBadgeInfo, localBadgeStatus) import Simplex.Chat.Badges.Ledger (creditTypeTag, debitTypeTag) import Simplex.Chat.Badges.Service (StatementEntry (..), StatementEntryType (..)) -import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeState (..)) +import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeIssueError (..), BadgeState (..)) import Simplex.Chat.Messages hiding (NewChatItem (..)) import Simplex.Chat.Messages.CIContent import Simplex.Chat.Operators @@ -1842,7 +1842,7 @@ viewContactBadge = maybe [] $ \lb -> viewUserBadgeState :: Maybe BadgeState -> [StyledString] viewUserBadgeState = maybe [] viewBadge where - viewBadge BadgeState {badgePurchaseId, badgeType, monthsLeft, paidThrough, alert} = + viewBadge BadgeState {badgePurchaseId, badgeType, monthsLeft, paidThrough, alert, issueError, nextWakeAt} = plain ( tshow badgePurchaseId <> ": " @@ -1851,8 +1851,14 @@ viewUserBadgeState = maybe [] viewBadge <> tshow monthsLeft <> " months left, paid through " <> day paidThrough + <> maybe "" ((", next check " <>) . dayTime) nextWakeAt ) - : maybe [] viewBadgeAlert alert + : maybe [] viewBadgeIssueError issueError + <> maybe [] viewBadgeAlert alert + +viewBadgeIssueError :: BadgeIssueError -> [StyledString] +viewBadgeIssueError BadgeIssueError {failedSince, lastAttemptAt, reason} = + [plain $ "renewal failing since " <> day failedSince <> ", last " <> dayTime lastAttemptAt <> ": " <> safeDecodeUtf8 (strEncode reason)] viewBadgeAlert :: BadgeAlert -> [StyledString] viewBadgeAlert BadgeAlert {kind, date} = [plain $ "badge alert: " <> textEncode kind <> " " <> day date] @@ -1871,6 +1877,9 @@ viewBadgeLedger entries = map viewEntry entries day :: UTCTime -> Text day = T.pack . formatTime defaultTimeLocale "%Y-%m-%d" +dayTime :: UTCTime -> Text +dayTime = T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M" + viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString] viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge, contactDomain, contactDomainVerified, description}, activeConn, uiThemes, customData} stats incognitoProfile = ["contact ID: " <> sShow contactId] diff --git a/tests/BadgeTests.hs b/tests/BadgeTests.hs index 06c5ccfe86..bd8f62d3fd 100644 --- a/tests/BadgeTests.hs +++ b/tests/BadgeTests.hs @@ -27,14 +27,16 @@ import Simplex.Chat.Badges import Simplex.Chat.Badges.Code import Simplex.Chat.Badges.Ledger import Simplex.Chat.Badges.Service +import Simplex.Chat.Badges.Types (BadgeIssueFailure (..)) import Simplex.Chat (defaultChatConfig) import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..), badgeRetryInterval, chatErrorAgent) -import Simplex.Chat.Library.Commands (badgeErrorRetry, badgeRetryAfter, badgeStalledInterval) +import Simplex.Chat.Library.Commands (badgeErrorRetry, badgeFailureTransient, badgeIssueFailure, badgeRetryAfter, badgeServiceErrorText, badgeStalledInterval) import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), AgentServiceError (..), SMPAgentError (..)) import Simplex.Messaging.Agent.RetryInterval (RetryInterval (..), nextRetryDelay) import Simplex.Messaging.Crypto.BBS import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Protocol (BrokerErrorType (..), NetworkError (..)) +import Simplex.Messaging.Protocol (BrokerErrorType (..), ErrorType (AUTH), NetworkError (..)) +import Simplex.Messaging.Util (tshow) import Simplex.Messaging.Version.Internal (Version (..)) import Test.Hspec @@ -83,6 +85,11 @@ badgeTests = do it "backs off to the cap" testRetryBackoff it "floors the wait a service asks for, and honours anything above it" testServiceRetryFloor it "sends retryAfter with the transient service codes and no other" testServiceRetryAfter + describe "recording a failed renewal" $ do + it "records the agent error a request failed with, not the chat error around it" testIssueFailureClassification + it "waits for the credential to lapse on internal, as on a refusal the service marks transient" testServiceErrorTransience + it "stores every failure so that it reads back, whatever the service called its code" testIssueFailureEncoding + it "bounds and strips a code this version does not know" testServiceErrorCodeBounded describe "service protocol JSON" $ do it "redeemBadgeCode request matches the schema" testRedeemRequestJSON it "badgeCredential response matches the schema" testCredentialResponseJSON @@ -677,6 +684,66 @@ testServiceRetryAfter = do (\code -> badgeErrorRetryAfter code `shouldBe` Nothing) [BSEBadRequest, BSEUnsupportedVersion, BSEUnknownPurchaseKey, BSECodeInvalid, BSECodeUsed, BSECodeExpired, BSEUnknown "future_code"] +-- The app shows the recorded failure in a sentence, so an agent error is stored as the agent +-- error and not as the chat error wrapping it, whether or not it can clear on its own. +testIssueFailureClassification :: IO () +testIssueFailureClassification = do + let failureFor = badgeIssueFailure . chatErrorAgent + timeout = BROKER "localhost" TIMEOUT + auth = SMP "localhost" AUTH + failureFor (AGENT (A_SERVICE ASETimeout)) `shouldBe` BIFServiceTimeout + failureFor timeout `shouldBe` BIFNetwork {agentError = tshow timeout} + failureFor auth `shouldBe` BIFUnexpected {message = tshow auth} + badgeIssueFailure (ChatError (CECommandError "unexpected badge service response")) `shouldBe` BIFUnexpected {message = "unexpected badge service response"} + +-- A refusal the service marks transient is not worth a word before the credential lapses. Internal +-- comes without retryAfter so that a failing service is not pressed, not because the fault is +-- final, so it waits the same way; any other refusal is told at once. +testServiceErrorTransience :: IO () +testServiceErrorTransience = do + badgeFailureTransient BIFServiceError {code = BSERateLimited, retryable = True} `shouldBe` True + badgeFailureTransient BIFServiceError {code = BSEInternal, retryable = False} `shouldBe` True + badgeFailureTransient BIFServiceError {code = BSEUnknownPurchaseKey, retryable = False} `shouldBe` False + badgeFailureTransient BIFServiceError {code = BSEUnknown "future_code", retryable = False} `shouldBe` False + badgeFailureTransient BIFServiceError {code = BSEUnknown "future_code", retryable = True} `shouldBe` True + +-- The failure is stored as text and read back by getBadgePurchase, so every value this version +-- writes must read back as itself, and any other value must still read: a row it cannot parse +-- would otherwise fail every read of the purchase. +testIssueFailureEncoding :: IO () +testIssueFailureEncoding = do + mapM_ + (\f -> strDecode (strEncode f) `shouldBe` Right f) + [ BIFServiceError {code = BSEUnknownPurchaseKey, retryable = False}, + BIFServiceError {code = BSERateLimited, retryable = True}, + BIFServiceError {code = BSEUnknown "future_code", retryable = True}, + BIFServiceError {code = BSEUnknown "code with spaces", retryable = False}, + BIFServiceError {code = BSEUnknown "", retryable = False}, + BIFServiceTimeout, + BIFNetwork {agentError = "BROKER \"smp://x\" NETWORK"}, + BIFInvalidCredential, + BIFUnexpected {message = "unexpected badge service response"}, + BIFUnexpected {message = "several words and : punctuation"} + ] + -- the row the CLI prints, and what a reader of the database sees + strEncode BIFServiceError {code = BSECodeUsed, retryable = False} `shouldBe` "service_error final code_used" + strEncode BIFServiceError {code = BSERateLimited, retryable = True} `shouldBe` "service_error retry rate_limited" + strEncode BIFServiceTimeout `shouldBe` "service_timeout" + -- a row a later version wrote, or one edited by hand, still reads - as the text it holds + strDecode "future_failure with text" `shouldBe` Right BIFUnexpected {message = "future_failure with text"} + strDecode "service_timeout trailing" `shouldBe` Right BIFUnexpected {message = "service_timeout trailing"} + strDecode "service_error maybe code_used" `shouldBe` Right BIFUnexpected {message = "service_error maybe code_used"} + +-- The text of a code this version does not know is chosen by the service, and the app shows it in +-- a sentence of its own - so it is bounded and stripped of anything but a code before it is stored. +testServiceErrorCodeBounded :: IO () +testServiceErrorCodeBounded = do + badgeServiceErrorText BSECodeUsed `shouldBe` "code_used" + badgeServiceErrorText (BSEUnknown "future_code") `shouldBe` "future_code" + badgeServiceErrorText (BSEUnknown "two words") `shouldBe` "twowords" + badgeServiceErrorText (BSEUnknown (T.replicate 100 "a")) `shouldBe` T.replicate 32 "a" + badgeServiceErrorText (BSEUnknown "Visit evil.example.com!") `shouldBe` "isitevilexamplecom" + -- The client replicates entry_credit_type / entry_debit_type verbatim, so a stored tag that -- disagreed with the wire tag would put a different row on each side. testEntryTypeColumns :: IO () diff --git a/tests/Bots/BadgeServiceTests.hs b/tests/Bots/BadgeServiceTests.hs index 4897722683..a5e3cb82c8 100644 --- a/tests/Bots/BadgeServiceTests.hs +++ b/tests/Bots/BadgeServiceTests.hs @@ -20,6 +20,7 @@ import Control.Concurrent.STM (atomically, readTMVar) import Control.Monad (forM_, void, when) import Control.Exception (finally) import qualified Data.Aeson as J +import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Char (toLower) import Data.Either (isLeft, isRight) @@ -41,8 +42,10 @@ import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatRespon import Simplex.Chat.Core (sendChatCmdStr) import Simplex.Chat.Options (CoreChatOpts (..)) import Simplex.Chat.Options.DB +import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..)) +import Simplex.Messaging.Agent.RetryInterval (RetryInterval (..)) import Simplex.Messaging.Agent.Store.Common (withTransaction) -import Simplex.Messaging.Agent.Store.DB (BoolInt (..)) +import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..)) import qualified Simplex.Messaging.Agent.Store.DB as DB import Simplex.Chat.Types (ChatPeerType (..), Profile (..)) import qualified Simplex.Messaging.Crypto as C @@ -83,6 +86,11 @@ badgeServiceTests = do it "should retire when entitlement ends, not when the credential expires" testRetiresWhenEntitlementEnds it "should alert that support ended, survive a restart, and go silent once acknowledged" testEndedAlert it "should raise a snoozed alert once more when the snooze lapses" testSnoozedAlertReturns + it "should alert that renewal failed when the service refuses it" testIssueFailedAlert + it "should wait for the shown credential to lapse before alerting on a failure that can clear" testIssueFailedWaitsForExpiry + it "should silence an acknowledged run of failures, and alert again on the next run" testIssueFailedAckAndNewRun + it "should record no failure when the service issues nothing because the months ran out" testNoCredentialMonthsRanOut + it "should record a failure when the service issues nothing though months are left" testNoCredentialMonthsLeft it "should renew a badge on a profile that is not active, without switching to it" testRenewalKeepsActiveProfile it "should broadcast the current profile when a renewal presents a badge" testRenewalKeepsProfileEdits it "should present the month already issued when a previous pass did not" testPresentationCatchesUp @@ -143,6 +151,11 @@ data BadgeServiceEnv = BadgeServiceEnv bsController :: ChatController } +-- | Stop the service for good: requests sent after it go unanswered until they time out. Stopping +-- chat unsubscribes its queues, where killing the thread could still let a request arrive mid-teardown. +stopBadgeService :: ChatController -> IO () +stopBadgeService cc = void $ sendChatCmdStr cc "/_stop" + -- | Start the badge service on a fresh issuer key, and hand the test body what depends on it: -- the client config trusting that key and addressing the service, the address, and the controller. withBadgeService :: HasCallStack => TestParams -> (ChatConfig -> String -> ChatController -> IO ()) -> IO () @@ -931,6 +944,236 @@ testEndedAlert ps = alice <## "user profile: alice (Alice)" alice <## "use /p [] to change it" +-- A refusal the service will not take back is worth telling the user at once: the badge is still +-- worn and will start showing as expired. +testIssueFailedAlert :: HasCallStack => TestParams -> IO () +testIssueFailedAlert ps = + withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClock, bsClientCfg, bsController = cc} -> + withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + code <- issueCode cc BTSupporter 3 + redeemFirstBadge alice code + rows <- ledgerRows (chatController alice) "badge_ledger" + -- the service no longer knows this purchase, so it refuses with no retryAfter: terminal + setServicePurchaseKey cc "not the purchase key" + setClockAt bsClock $ fst $ renewalMoments rows + alice ##> "/_app activate" + alice <## "ok" + alice <## badgeServiceRefused + alice <##. "badge alert: issue_failed " + -- the state reports the failure, when the next attempt is due, and the alert it raised + alice <##. "1: supporter" + alice <##. "renewal failing since " + alice <##. "badge alert: issue_failed " + issueErrorRow (chatController alice) >>= \(_, reason) -> + reason `shouldBe` Just "service_error final unknown_purchase_key" + +-- A failure that can clear on its own is not worth a word while contacts still see the badge as +-- valid: neither the alert nor the state shows it until the shown credential lapses, which is when +-- they stop. It is recorded from the first attempt, so the run's start is not lost. +testIssueFailedWaitsForExpiry :: HasCallStack => TestParams -> IO () +testIssueFailedWaitsForExpiry ps = + withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClock, bsClientCfg, bsController = cc} -> do + -- the redemption runs against the service, so it keeps the ordinary request timeout + (requestAt, presentAt) <- withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + code <- issueCode cc BTSupporter 3 + redeemFirstBadge alice code + renewalMoments <$> ledgerRows (chatController alice) "badge_ledger" + stopBadgeService cc + let cfg = failingServiceCfg bsClientCfg + -- the request goes unanswered and times out, which is a failure that can clear on its own + setClockAt bsClock requestAt + failedSince <- withTestChatCfg ps cfg "alice" $ \alice -> do + alice <##. "1: supporter" + -- the state carries no failure and no alert: /p prints only its own output + alice ##> "/p" + alice <## "user profile: alice (Alice, * supporter)" + alice <## "use /p [] to change it" + (since, reason) <- issueErrorRow (chatController alice) + reason `shouldBe` Just "service_timeout" + pure since + -- the shown credential lapses: from here contacts see the badge as expired, and it is worth a word + setClockAt bsClock presentAt + withTestChatCfg ps cfg "alice" $ \alice -> do + alice <##. "1: supporter" + alice <##. "renewal failing since " + alice <##. "badge alert: issue_failed " + -- still the one run: the alert's episode is when it started, not this pass + issueErrorRow (chatController alice) >>= \(since, _) -> since `shouldBe` failedSince + +-- Acknowledging answers the run that is failing, not the failure: the error stays on the badge +-- screen while the alert goes quiet, and a later run raises it again under a new episode. +testIssueFailedAckAndNewRun :: HasCallStack => TestParams -> IO () +testIssueFailedAckAndNewRun ps = + withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClock, bsClientCfg, bsController = cc} -> + withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + code <- issueCode cc BTSupporter 3 + redeemFirstBadge alice code + rows <- ledgerRows (chatController alice) "badge_ledger" + purchaseKey <- servicePurchaseKey cc + setServicePurchaseKey cc "not the purchase key" + let (requestAt, presentAt) = renewalMoments rows + setClockAt bsClock requestAt + alice ##> "/_app activate" + alice <## "ok" + alice <## badgeServiceRefused + alice <##. "badge alert: issue_failed " + alice <##. "1: supporter" + alice <##. "renewal failing since " + alice <##. "badge alert: issue_failed " + episode <- episodeOf . fst <$> issueErrorRow (chatController alice) + alice ##> ("/_badge ack 1 1 issue_failed off " <> T.unpack episode) + -- the state still carries the error, and no alert with it + alice <##. "1: supporter" + alice <##. "renewal failing since " + -- the ack signalled the worker, and the pass it ran failed again and raised nothing + alice <## badgeServiceRefused + alice <##. "1: supporter" + alice <##. "renewal failing since " + ackedEpisode (chatController alice) `shouldReturn` (Just "issue_failed", Just episode) + -- the service is back: the month it owes is issued, which ends the run + setServicePurchaseKey cc purchaseKey + alice ##> "/_app activate" + alice <## "ok" + renewed <- waitLedgerRows (chatController alice) 3 + alice <##. "1: supporter" + waitIssueErrorCleared (chatController alice) + -- the month issued is presented when the one on the profile lapses, and only then is the + -- next renewal asked for - so the run that fails next is a new one + setClockAt bsClock presentAt + alice ##> "/_app activate" + alice <## "ok" + waitShownIssued (chatController alice) + setServicePurchaseKey cc "not the purchase key" + setClockAt bsClock $ fst $ renewalMoments renewed + alice ##> "/_app activate" + alice <## "ok" + alice <## badgeServiceRefused + alice <##. "badge alert: issue_failed " + alice <##. "1: supporter" + alice <##. "renewal failing since " + alice <##. "badge alert: issue_failed " + -- a new run, so acknowledging the first one does not silence this one + newEpisode <- episodeOf . fst <$> issueErrorRow (chatController alice) + newEpisode `shouldNotBe` episode + +-- The service issues nothing when the months it holds have run out - here through a debit the +-- client had not seen. That is support ending, not a failed renewal: the statement brings the +-- balance to nothing and the usual alert follows, where a recorded failure would name a +-- credential that was never issued. +testNoCredentialMonthsRanOut :: HasCallStack => TestParams -> IO () +testNoCredentialMonthsRanOut ps = + withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClock, bsClientCfg, bsController = cc} -> + withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + code <- issueCode cc BTSupporter 3 + redeemFirstBadge alice code + rows <- ledgerRows (chatController alice) "badge_ledger" + insertServiceSupportDebit cc + -- at the credential's expiry the issued period has ended, so the service holds no current credential either + setClockAt bsClock $ snd $ renewalMoments rows + alice ##> "/_app activate" + alice <## "ok" + alice <##. "badge alert: support_ended " + issueErrorRow (chatController alice) `shouldReturn` (Nothing, Nothing) + -- the debit is the client's now, and the next pass retires the badge on it + rows' <- ledgerRows (chatController alice) "badge_ledger" + map (\(_, ch, m, _, _, t) -> (ch, m, t)) rows' `shouldBe` [(3, 3, Just "code"), (-1, 2, Just "badge"), (-2, 0, Just "support")] + alice ##> "/_app activate" + alice <## "ok" + alice <##. "1: supporter" + alice <##. "badge alert: support_ended " + waitShownBadge (chatController alice) Nothing + +-- The service issuing nothing while the ledger still owes a month is a fault the client cannot +-- resolve, so it is recorded and told at once. +testNoCredentialMonthsLeft :: HasCallStack => TestParams -> IO () +testNoCredentialMonthsLeft ps = + withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClock, bsClientCfg, bsController = cc} -> + withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + code <- issueCode cc BTSupporter 3 + redeemFirstBadge alice code + rows <- ledgerRows (chatController alice) "badge_ledger" + zeroServiceLedgerTip cc + setClockAt bsClock $ snd $ renewalMoments rows + alice ##> "/_app activate" + alice <## "ok" + alice <## "internal chat error: badge service issued no credential" + alice <##. "badge alert: issue_failed " + alice <##. "1: supporter" + alice <##. "renewal failing since " + alice <##. "badge alert: issue_failed " + (_, reason) <- issueErrorRow (chatController alice) + reason `shouldBe` Just "unexpected badge service issued no credential" + +-- | A debit the service wrote on its own, taking back the months the purchase had: copied from +-- the tip so that it follows it in every column the client checks. +insertServiceSupportDebit :: ChatController -> IO () +insertServiceSupportDebit ChatController {chatStore} = + withTransaction chatStore $ \db -> + DB.execute_ db . fromString $ + "INSERT INTO sx_badge_service_badge_ledger" + <> " (entry_uuid, badge_purchase_id, change_months, balance_months, balance_start_ts, balance_anchor_ts," + <> " balance_badge_type, service_created_at, created_at, entry_type, entry_debit_type)" + <> " SELECT 'support-debit', badge_purchase_id, -balance_months, 0, balance_start_ts, balance_anchor_ts," + <> " balance_badge_type, service_created_at, created_at, 'debit', 'support'" + <> " FROM sx_badge_service_badge_ledger ORDER BY entry_id DESC LIMIT 1" + +-- | The service's tip with its months struck out: nothing to issue, and no row restating the ledger. +zeroServiceLedgerTip :: ChatController -> IO () +zeroServiceLedgerTip ChatController {chatStore} = + withTransaction chatStore $ \db -> + DB.execute_ db "UPDATE sx_badge_service_badge_ledger SET balance_months = 0 WHERE entry_id = (SELECT MAX(entry_id) FROM sx_badge_service_badge_ledger)" + +badgeServiceRefused :: String +badgeServiceRefused = "bad chat command: badge service error: unknown_purchase_key" + +-- | The alert's episode is the start of the run of failures, as the ack command spells it. +episodeOf :: HasCallStack => Maybe UTCTime -> Text +episodeOf = maybe (error "no failure recorded") (safeDecodeUtf8 . strEncode) + +-- | A client that gives up on an unanswered service request in seconds rather than half a minute, +-- and does not retry a failed pass on its own - so every pass is one the test asked for. +failingServiceCfg :: ChatConfig -> ChatConfig +failingServiceCfg cfg = + cfg + { agentConfig = (agentConfig cfg) {serviceRequestTimeout = 2}, + badgeRetryInterval = RetryInterval {initialInterval = 3600000000, increaseAfter = 0, maxInterval = 3600000000} + } + +-- | The service reaches a purchase by the verified signer's key and no other way, so changing the +-- key it holds makes it answer unknown_purchase_key, and putting it back makes renewals work again. +servicePurchaseKey :: HasCallStack => ChatController -> IO ByteString +servicePurchaseKey ChatController {chatStore} = do + rows :: [(Binary ByteString, Int64)] <- + withTransaction chatStore $ \db -> + DB.query_ db "SELECT purchase_key, badge_purchase_id FROM sx_badge_service_badge_purchases" + pure $ case rows of + [(Binary k, _)] -> k + _ -> error $ "expected one service purchase, got " <> show (length rows) + +setServicePurchaseKey :: ChatController -> ByteString -> IO () +setServicePurchaseKey ChatController {chatStore} k = + withTransaction chatStore $ \db -> + DB.execute db "UPDATE sx_badge_service_badge_purchases SET purchase_key = ?" (Only (Binary k)) + +-- the run of failed renewals the purchase carries: when it started, and the last failure as stored +issueErrorRow :: HasCallStack => ChatController -> IO (Maybe UTCTime, Maybe Text) +issueErrorRow ChatController {chatStore} = do + rows :: [(Maybe UTCTime, Maybe Text)] <- + withTransaction chatStore $ \db -> + DB.query_ db "SELECT issue_failed_since, issue_error FROM badge_purchases" + pure $ case rows of + [r] -> r + _ -> error $ "expected one badge purchase, got " <> show (length rows) + +-- the clearing is written by the pass that stored the issuance, which the test waits for +waitIssueErrorCleared :: HasCallStack => ChatController -> IO () +waitIssueErrorCleared cc = loop (100 :: Int) + where + loop 0 = issueErrorRow cc >>= (`shouldBe` (Nothing, Nothing)) + loop i = + issueErrorRow cc >>= \r -> + if r == (Nothing, Nothing) then pure () else threadDelay 50000 >> loop (i - 1) + -- A worker runs for every profile, not only the one in use, so presenting a renewed badge must not -- make its profile active - the next message would then be sent from the wrong identity. testRenewalKeepsActiveProfile :: HasCallStack => TestParams -> IO ()