core, badge-service: store subscription charges and carry the subscription state

Add the service migration 20261012_badge_subscriptions: the subscription
charges table, the ledger's charge_id, and the payment's subscription state,
check time and Play token, replacing three subscription columns nothing
wrote. The ledger now stores and reads back charge credits, and the badge
credential response gains an optional subscription state that older clients
ignore and that reads an unknown state without failing. Nothing writes a
charge or a state yet, so no behaviour changes.

Run: 001-badge-subscriptions, slice 2

src/Simplex/Chat/Badges/Ledger.hs

@@ -205,15 +205,16 @@ debitTypeTag = \case
   SDLapse -> "lapse"
   SDUnknown {tag} -> tag
 
--- | Rebuilds only what the columns determine: constructors with no fields, and a payment credit.
+-- | Rebuilds only what the columns determine: constructors with no fields, a payment credit and a charge credit.
 -- payment_ is Nothing when the row references no payment, and Just Nothing when that payment had no
 -- invoice, as a store purchase has none. The rest answer Nothing rather than invent a payload.
 -- The client stores each type's JSON and reads that first, so this is its fallback; the service has none.
--- TODO [badges] rebuild charge, transferIn, upgrade and transferOut from their reference columns,
+-- TODO [badges] rebuild transferIn, upgrade and transferOut from their reference columns,
 -- without which the service cannot re-emit a statement carrying one.
-entryTypeFromColumns :: Maybe (Maybe InvoiceId) -> Text -> Maybe Text -> Maybe Text -> Maybe StatementEntryType
-entryTypeFromColumns payment_ entryType credit_ debit_ = case (entryType, credit_, debit_) of
+entryTypeFromColumns :: Maybe (Maybe InvoiceId) -> Maybe Text -> Text -> Maybe Text -> Maybe Text -> Maybe StatementEntryType
+entryTypeFromColumns payment_ chargeId_ entryType credit_ debit_ = case (entryType, credit_, debit_) of
   ("credit", Just "payment", _) -> SECredit . SCPayment <$> payment_
+  ("credit", Just "charge", _) -> SECredit . SCCharge <$> chargeId_
   ("credit", Just t, _) -> SECredit <$> creditType t
   ("debit", _, Just t) -> SEDebit <$> debitType t
   _ -> Nothing

src/Simplex/Chat/Badges/Service.hs

@@ -18,6 +18,7 @@ module Simplex.Chat.Badges.Service
     BadgeUpgrade (..),
     BadgeServiceResponse (..),
     BadgeServiceErrorCode (..),
+    SubscriptionState (..),
     BadgeCatalog (..),
     BadgePrice (..),
     BadgeOffer (..),
@@ -42,6 +43,7 @@ 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 (TextEncoding (..), textParseJSON, textToEncoding, textToJSON)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, taggedObjectJSON)
 import Simplex.Messaging.Version (VersionRange, VersionScope, mkVersionRange)
 import Simplex.Messaging.Version.Internal (Version (..))
@@ -121,7 +123,8 @@ data BadgeServiceResponse
   | BSPBadgeCredential
       { credential :: Maybe BadgeCredential, -- Nothing when no balance to issueBadge or no current credential for pause
         receipt :: Maybe Text, -- not provided for lifetime badges
-        statement :: BadgeStatement
+        statement :: BadgeStatement,
+        subscription :: Maybe SubscriptionState -- present exactly when a store subscription funds the purchase
       }
   | BSPError
       { code :: BadgeServiceErrorCode,
@@ -129,6 +132,15 @@ data BadgeServiceResponse
         retryAfter :: Maybe Word32
       }
 
+-- | The store's answer as the service last read it. A client reads a state it does not know as not ended.
+data SubscriptionState
+  = SSRenewing
+  | SSCancelled -- auto-renew is off, and the paid period still runs
+  | SSBillingRetry -- a charge failed and the store is retrying it: grace, retry or hold
+  | SSEnded -- no charge will come: expired, revoked or refunded
+  | SSUnknown Text -- forwards-compatible: service is deployed ahead of clients
+  deriving (Eq, Show)
+
 data BadgeCatalog = BadgeCatalog
   { prices :: [BadgePrice],
     offers :: [BadgeOffer]
@@ -236,6 +248,27 @@ instance ToJSON StatementDebitType where
     SDUnknown _ j -> JE.value $ J.Object j
     v -> $(JQ.mkToEncoding (taggedObjectJSON $ dropPrefix "SD") ''StatementDebitType) v
 
+instance TextEncoding SubscriptionState where
+  textEncode = \case
+    SSRenewing -> "renewing"
+    SSCancelled -> "cancelled"
+    SSBillingRetry -> "billingRetry"
+    SSEnded -> "ended"
+    SSUnknown t -> t
+  textDecode s = Just $ case s of
+    "renewing" -> SSRenewing
+    "cancelled" -> SSCancelled
+    "billingRetry" -> SSBillingRetry
+    "ended" -> SSEnded
+    t -> SSUnknown t
+
+instance ToJSON SubscriptionState where
+  toJSON = textToJSON
+  toEncoding = textToEncoding
+
+instance FromJSON SubscriptionState where
+  parseJSON = textParseJSON "SubscriptionState"
+
 $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "SE") ''StatementEntryType)
 
 $(JQ.deriveJSON defaultJSON ''StatementEntry)

src/Simplex/Chat/Store/Badges.hs

@@ -551,7 +551,7 @@ getBadgeLedger db User {userId} badgePurchaseId =
 toStatementEntry :: (Text, Int, Int, UTCTime, UTCTime, BadgeType) :. (Maybe UTCTime, UTCTime, Text, Maybe Text, Maybe Text, Maybe Text) -> Maybe StatementEntry
 toStatementEntry ((entryId, changeMonths, balanceMonths, balanceStartTs, balanceAnchorTs, balanceBadgeType) :. (wasPausedSince, createdAt, entryType_, credit_, debit_, value_)) =
   (\entryType -> StatementEntry {entryId, changeMonths, balanceMonths, balanceStartTs, balanceAnchorTs, balanceBadgeType, wasPausedSince, createdAt, entryType})
-    <$> maybe (entryTypeFromColumns Nothing entryType_ credit_ debit_) (entryTypeFromValue entryType_) value_
+    <$> maybe (entryTypeFromColumns Nothing Nothing entryType_ credit_ debit_) (entryTypeFromValue entryType_) value_
 
 -- | Decodes the stored JSON rather than rebuilding from the tag, so a version that has since
 -- learnt the type reads it with its fields, and one that has not still gets it back verbatim.

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

@@ -152,19 +152,7 @@ DROP TABLE @badge_prices;
 |]
 
 {- TODO [badges] deferred draft schema for paid purchases, subscriptions, upgrades and transfers.
-The service added @badge_purchases.payment_id and @badge_ledger.payment_id in its 20260925_badge_store_receipts, so they left this draft; the client's stay deferred with the rest, as nothing writes its @payments yet.
-
-CREATE TABLE @subscription_charges(
-  charge_id TEXT NOT NULL PRIMARY KEY,
-  payment_id TEXT NOT NULL REFERENCES @payments ON DELETE CASCADE,
-  provider_charge_ref TEXT NOT NULL,
-  period_start TIMESTAMPTZ NOT NULL,
-  period_end TIMESTAMPTZ NOT NULL,
-  amount BIGINT NOT NULL,
-  currency TEXT NOT NULL,
-  charged_at TIMESTAMPTZ NOT NULL,
-  UNIQUE(payment_id, provider_charge_ref)
-);
+The service added @badge_purchases.payment_id and @badge_ledger.payment_id in its 20260925_badge_store_receipts, and @subscription_charges and @badge_ledger.charge_id in its 20261012_badge_subscriptions, so they left this draft; the client's stay deferred with the rest, as nothing writes its @payments yet.
 
 CREATE TABLE @badge_invoices(
   invoice_id TEXT NOT NULL PRIMARY KEY REFERENCES @invoices ON DELETE CASCADE,
@@ -197,23 +185,17 @@ CREATE TABLE @badge_subscription_changes(
 
 CREATE INDEX @idx_badge_subscription_changes_purchase ON @badge_subscription_changes(badge_purchase_id);
 
-ALTER TABLE @badge_ledger ADD COLUMN charge_id TEXT REFERENCES @subscription_charges;
-
 ALTER TABLE @badge_ledger ADD COLUMN from_purchase_id BIGINT REFERENCES @badge_purchases;
 
 ALTER TABLE @badge_ledger ADD COLUMN to_purchase_id BIGINT REFERENCES @badge_purchases;
 
-CREATE INDEX @idx_badge_ledger_charge ON @badge_ledger(charge_id);
-
 CREATE INDEX @idx_badge_ledger_from_purchase ON @badge_ledger(from_purchase_id);
 
 CREATE INDEX @idx_badge_ledger_to_purchase ON @badge_ledger(to_purchase_id);
 
 -- down
-DROP INDEX @idx_badge_ledger_charge;
 DROP INDEX @idx_badge_ledger_from_purchase;
 DROP INDEX @idx_badge_ledger_to_purchase;
-ALTER TABLE @badge_ledger DROP COLUMN charge_id;
 ALTER TABLE @badge_ledger DROP COLUMN from_purchase_id;
 ALTER TABLE @badge_ledger DROP COLUMN to_purchase_id;
 DROP INDEX @idx_badge_subscription_changes_purchase;
@@ -222,7 +204,6 @@ DROP INDEX @idx_badge_invoices_purchase;
 DROP INDEX @idx_badge_invoices_offer;
 DROP INDEX @idx_badge_invoices_price;
 DROP TABLE @badge_invoices;
-DROP TABLE @subscription_charges;
 -}
 
 m20260915_user_badges :: Text

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

@@ -153,19 +153,7 @@ DROP TABLE @badge_prices;
 |]
 
 {- TODO [badges] deferred draft schema for paid purchases, subscriptions, upgrades and transfers.
-The service added @badge_purchases.payment_id and @badge_ledger.payment_id in its 20260925_badge_store_receipts, so they left this draft; the client's stay deferred with the rest, as nothing writes its @payments yet.
-
-CREATE TABLE @subscription_charges(
-  charge_id TEXT NOT NULL PRIMARY KEY,
-  payment_id TEXT NOT NULL REFERENCES @payments ON DELETE CASCADE,
-  provider_charge_ref TEXT NOT NULL,
-  period_start TEXT NOT NULL,
-  period_end TEXT NOT NULL,
-  amount INTEGER NOT NULL,
-  currency TEXT NOT NULL,
-  charged_at TEXT NOT NULL,
-  UNIQUE(payment_id, provider_charge_ref)
-) STRICT;
+The service added @badge_purchases.payment_id and @badge_ledger.payment_id in its 20260925_badge_store_receipts, and @subscription_charges and @badge_ledger.charge_id in its 20261012_badge_subscriptions, so they left this draft; the client's stay deferred with the rest, as nothing writes its @payments yet.
 
 CREATE TABLE @badge_invoices(
   invoice_id TEXT NOT NULL PRIMARY KEY REFERENCES @invoices ON DELETE CASCADE,
@@ -198,23 +186,17 @@ CREATE TABLE @badge_subscription_changes(
 
 CREATE INDEX @idx_badge_subscription_changes_purchase ON @badge_subscription_changes(badge_purchase_id);
 
-ALTER TABLE @badge_ledger ADD COLUMN charge_id TEXT REFERENCES @subscription_charges;
-
 ALTER TABLE @badge_ledger ADD COLUMN from_purchase_id INTEGER REFERENCES @badge_purchases;
 
 ALTER TABLE @badge_ledger ADD COLUMN to_purchase_id INTEGER REFERENCES @badge_purchases;
 
-CREATE INDEX @idx_badge_ledger_charge ON @badge_ledger(charge_id);
-
 CREATE INDEX @idx_badge_ledger_from_purchase ON @badge_ledger(from_purchase_id);
 
 CREATE INDEX @idx_badge_ledger_to_purchase ON @badge_ledger(to_purchase_id);
 
 -- down
-DROP INDEX @idx_badge_ledger_charge;
 DROP INDEX @idx_badge_ledger_from_purchase;
 DROP INDEX @idx_badge_ledger_to_purchase;
-ALTER TABLE @badge_ledger DROP COLUMN charge_id;
 ALTER TABLE @badge_ledger DROP COLUMN from_purchase_id;
 ALTER TABLE @badge_ledger DROP COLUMN to_purchase_id;
 DROP INDEX @idx_badge_subscription_changes_purchase;
@@ -223,7 +205,6 @@ DROP INDEX @idx_badge_invoices_purchase;
 DROP INDEX @idx_badge_invoices_offer;
 DROP INDEX @idx_badge_invoices_price;
 DROP TABLE @badge_invoices;
-DROP TABLE @subscription_charges;
 -}
 
 m20260915_user_badges :: Query