core: renew badges monthly and alert when support ends (#7448)

src/Simplex/Chat/Store/Badges.hs

@@ -7,10 +7,22 @@
 
 module Simplex.Chat.Store.Badges
   ( BadgeCodeRedemption (..),
+    UserBadgePurchase (..),
+    getUserBadgePurchase,
+    getBadgePurchase,
+    userHasBadge,
+    setBadgeAlertAcked,
+    clearShownBadge,
     getBadgeCodeRedemption,
     createBadgeCodeRedemption,
     deleteBadgeCodeRedemption,
     createCodeBadgePurchase,
+    getCodeBadgePurchase,
+    storeBadgeIssuance,
+    getLatestIssuedCredential,
+    storeBadgeStatement,
+    getBadgeLedgerLastEntry,
+    getBadgeLedgerEntryId,
   )
 where
 
@@ -19,23 +31,26 @@ import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
+import Data.Maybe (isJust)
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Simplex.Chat.Badges
-import Simplex.Chat.Badges.Types (BadgePurchaseStatus (..))
+import Simplex.Chat.Badges.Ledger
+import Simplex.Chat.Badges.Service (StatementCreditType (..), StatementDebitType (..), StatementEntry (..), StatementEntryType (..))
+import Simplex.Chat.Badges.Types (BadgeAlertKind, BadgePurchaseStatus (..))
 import Simplex.Chat.Store.Shared (insertedRowId)
 import Simplex.Chat.Types
-import Simplex.Messaging.Agent.Store.DB (Binary (..))
+import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (strEncode)
-import Simplex.Messaging.Util (maybeFirstRow, safeDecodeUtf8)
+import Simplex.Messaging.Util (decodeJSON, maybeFirstRow, maybeFirstRow', safeDecodeUtf8)
 
 #if defined(dbPostgres)
-import Database.PostgreSQL.Simple (Only (..))
+import Database.PostgreSQL.Simple (Only (..), (:.) (..))
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 #else
-import Database.SQLite.Simple (Only (..))
+import Database.SQLite.Simple (Only (..), (:.) (..))
 import Database.SQLite.Simple.QQ (sql)
 #endif
 
@@ -90,21 +105,13 @@ deleteBadgeCodeRedemption db redemptionId =
     |]
     (redemptionId, redemptionId)
 
--- | The purchase a redeemed code created, its issuance, and the profile's pointer to it.
--- False when the code was already redeemed here: the service replays the credential it issued,
--- and that must add no purchase and leave the shown badge alone.
-createCodeBadgePurchase :: DB.Connection -> TVar ChaChaDRG -> User -> BadgeCodeRedemption -> BadgeCredential -> UTCTime -> UTCTime -> IO Bool
-createCodeBadgePurchase db g User {userId} redemption credential expiry now =
+-- | 'False' when the code was already redeemed here: the service replays the credential it
+-- issued, and that must add no purchase and leave the shown badge alone.
+createCodeBadgePurchase :: DB.Connection -> User -> BadgeCodeRedemption -> BadgeCredential -> UTCTime -> IO (Int64, Bool)
+createCodeBadgePurchase db User {userId} redemption credential now =
   getCodeBadgePurchase db redemption >>= \case
-    Just _ -> pure False
+    Just purchaseId -> pure (purchaseId, False)
     Nothing -> do
-      purchaseId <- insertPurchase
-      DB.execute db "UPDATE users SET shown_badge_id = ? WHERE user_id = ?" (purchaseId, userId)
-      pure True
-  where
-    BadgeCodeRedemption {redemptionId, purchaseKey, purchasePrivKey, masterKey = BadgeMasterKey mk} = redemption
-    BadgeCredential {badgeInfo = BadgeInfo {badgeType}} = credential
-    insertPurchase = do
       DB.execute
         db
         [sql|
@@ -114,19 +121,217 @@ createCodeBadgePurchase db g User {userId} redemption credential expiry now =
         |]
         (userId, purchaseKey, purchasePrivKey, Binary mk, badgeType, badgeType, PSIssued, redemptionId, now, now)
       purchaseId <- insertedRowId db
+      DB.execute db "UPDATE users SET shown_badge_id = ? WHERE user_id = ?" (purchaseId, userId)
+      pure (purchaseId, True)
+  where
+    BadgeCodeRedemption {redemptionId, purchaseKey, purchasePrivKey, masterKey = BadgeMasterKey mk} = redemption
+    BadgeCredential {badgeInfo = BadgeInfo {badgeType}} = credential
+
+-- | The period comes from the ledger, the expiry from the credential, which runs a week longer.
+-- 'False' means no issuance row was written, which the caller reports rather than drop in silence.
+-- A replayed statement names a month already issued, and one month has one issuance.
+storeBadgeIssuance :: DB.Connection -> TVar ChaChaDRG -> Int64 -> Int64 -> BadgeCredential -> UTCTime -> IO Bool
+storeBadgeIssuance db g badgePurchaseId entryId credential now =
+  getIssuedPeriod db badgePurchaseId entryId >>= \case
+    Nothing -> pure False
+    Just (periodStart, periodEnd) -> do
       issuanceId <- safeDecodeUtf8 . strEncode <$> atomically (C.randomBytes 16 g)
-      -- TODO [badges] the credential's expiry stands in for the period end, which is up to a
-      -- week later, until the statement carries the real period
       DB.execute
         db
         [sql|
-          INSERT INTO badge_issuances (issuance_id, badge_purchase_id, badge_type, period_start, period_end, expiry, credential, created_at)
-          VALUES (?,?,?,?,?,?,?,?)
+          INSERT INTO badge_issuances (issuance_id, badge_purchase_id, entry_id, badge_type, period_start, period_end, expiry, credential, created_at)
+          VALUES (?,?,?,?,?,?,?,?,?)
+          ON CONFLICT (badge_purchase_id, entry_id) DO NOTHING
         |]
-        (issuanceId, purchaseId, badgeType, now, expiry, expiry, Binary (LB.toStrict $ J.encode credential), now)
-      pure purchaseId
+        ((issuanceId, badgePurchaseId, entryId, badgeType) :. (periodStart, periodEnd, badgeExpiry, Binary (LB.toStrict $ J.encode credential), now))
+      pure True
+  where
+    BadgeCredential {badgeInfo = BadgeInfo {badgeType, badgeExpiry}} = credential
+
+getLatestIssuedCredential :: DB.Connection -> Int64 -> IO (Maybe BadgeCredential)
+getLatestIssuedCredential db badgePurchaseId = do
+  rows <-
+    DB.query
+      db
+      [sql|
+        SELECT credential FROM badge_issuances
+        WHERE badge_purchase_id = ?
+        ORDER BY period_end DESC
+        LIMIT 1
+      |]
+      (Only badgePurchaseId)
+  pure $ case rows of
+    [Only (Binary bs)] -> J.decodeStrict' bs
+    _ -> Nothing
+
+-- the start is read from the row before rather than by subtracting a month, which clips
+getIssuedPeriod :: DB.Connection -> Int64 -> Int64 -> IO (Maybe (UTCTime, UTCTime))
+getIssuedPeriod db badgePurchaseId entryId = do
+  rows <-
+    DB.query
+      db
+      [sql|
+        SELECT
+          (SELECT prev.balance_start_ts FROM badge_ledger prev
+           WHERE prev.badge_purchase_id = issued.badge_purchase_id AND prev.entry_id < issued.entry_id
+           ORDER BY prev.entry_id DESC LIMIT 1),
+          issued.balance_start_ts
+        FROM badge_ledger issued
+        WHERE issued.badge_purchase_id = ? AND issued.entry_id = ?
+      |]
+      (badgePurchaseId, entryId)
+  -- no preceding row means no credit was ever stored, so the period this row issued is unknown
+  pure $ case rows of
+    [(Just periodStart, periodEnd)] -> Just (periodStart, periodEnd)
+    _ -> Nothing
 
 getCodeBadgePurchase :: DB.Connection -> BadgeCodeRedemption -> IO (Maybe Int64)
 getCodeBadgePurchase db BadgeCodeRedemption {redemptionId} =
   maybeFirstRow fromOnly $
     DB.query db "SELECT badge_purchase_id FROM badge_purchases WHERE badge_code_redemption_id = ?" (Only redemptionId)
+
+data UserBadgePurchase = UserBadgePurchase
+  { badgePurchaseId :: Int64,
+    purchaseKey :: C.PublicKeyEd25519,
+    purchasePrivKey :: C.PrivateKeyEd25519,
+    masterKey :: BadgeMasterKey,
+    badgeType :: BadgeType,
+    shown :: Bool,
+    alertAcked :: Maybe (BadgeAlertKind, Text),
+    alertSnoozeUntil :: Maybe UTCTime
+  }
+
+-- | Newest, not the one shown_badge_id points at - retirement clears that, and the support ended
+-- alert is recomputed from this purchase after the badge stops being shown.
+getUserBadgePurchase :: DB.Connection -> User -> IO (Maybe UserBadgePurchase)
+getUserBadgePurchase db User {userId} =
+  maybeFirstRow fromOnly newestId >>= maybe (pure Nothing) (getBadgePurchase db)
+  where
+    newestId =
+      DB.query
+        db
+        [sql|
+          SELECT badge_purchase_id FROM badge_purchases
+          WHERE user_id = ? AND purchase_priv_key IS NOT NULL
+          ORDER BY badge_purchase_id DESC
+          LIMIT 1
+        |]
+        (Only userId)
+
+-- shown is a CASE because in Postgres a comparison is boolean, which BoolInt rejects.
+getBadgePurchase :: DB.Connection -> Int64 -> IO (Maybe UserBadgePurchase)
+getBadgePurchase db purchaseId =
+  maybeFirstRow toPurchase $
+    DB.query
+      db
+      [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
+        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) =
+      UserBadgePurchase
+        { badgePurchaseId,
+          purchaseKey,
+          purchasePrivKey,
+          masterKey = BadgeMasterKey mk,
+          badgeType,
+          shown = unBI shown_,
+          alertAcked = (,) <$> ackedKind_ <*> ackedEpisode_,
+          alertSnoozeUntil
+        }
+
+-- | Whether a badge is on the profile now: set when a redemption stores one, cleared when it is
+-- retired. Read as the id rather than as a comparison, which in Postgres would be a boolean.
+userHasBadge :: DB.Connection -> User -> IO Bool
+userHasBadge db User {userId} =
+  maybeFirstRow' False shownBadge $
+    DB.query db "SELECT shown_badge_id FROM users WHERE user_id = ?" (Only userId)
+  where
+    shownBadge :: Only (Maybe Int64) -> Bool
+    shownBadge = isJust . fromOnly
+
+-- | An ack and a snooze both record the occurrence answered; a snooze also records how long it
+-- holds, so that it silences that occurrence and not whichever one is derived next.
+setBadgeAlertAcked :: DB.Connection -> Int64 -> BadgeAlertKind -> Text -> Maybe UTCTime -> IO ()
+setBadgeAlertAcked db badgePurchaseId kind episode snoozeUntil =
+  DB.execute
+    db
+    "UPDATE badge_purchases SET alert_acked_kind = ?, alert_acked_episode = ?, alert_snooze_until = ? WHERE badge_purchase_id = ?"
+    (kind, episode, snoozeUntil, 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 =
+  DB.execute db "UPDATE users SET shown_badge_id = NULL WHERE user_id = ? AND shown_badge_id = ?" (userId, badgePurchaseId)
+
+-- | Verbatim, entry_uuid and type included: the client authors no row, or the two sides stop
+-- holding the same ledger. DO NOTHING makes a re-applied statement a no-op rather than a throw.
+-- An entry whose balance does not follow from the one before it is stored and marked, not refused.
+storeBadgeStatement :: DB.Connection -> Int64 -> Maybe StatementEntry -> [StatementEntry] -> UTCTime -> IO ()
+storeBadgeStatement db badgePurchaseId tip entries now =
+  mapM_ storeEntry $ balanceChecked tip entries
+  where
+    storeEntry (StatementEntry {entryId, changeMonths, balanceMonths, balanceStartTs, balanceAnchorTs, balanceBadgeType, wasPausedSince, createdAt, entryType}, checked) =
+      DB.execute
+        db
+        [sql|
+          INSERT INTO badge_ledger
+            (entry_uuid, badge_purchase_id, change_months, balance_months, balance_start_ts, balance_anchor_ts, balance_badge_type,
+             was_paused_since, service_created_at, created_at, entry_type, entry_credit_type, entry_debit_type,
+             entry_type_unknown, entry_type_value, balance_checked)
+          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+          ON CONFLICT (entry_uuid) DO NOTHING
+        |]
+        ( (entryId, badgePurchaseId, changeMonths, balanceMonths, balanceStartTs, balanceAnchorTs, balanceBadgeType, wasPausedSince)
+            :. (createdAt, now, entryTypeT, creditType, debitType, BI typeUnknown, entryTypeValue, BI <$> checked)
+        )
+      where
+        (entryTypeT, creditType, debitType) = entryTypeColumns entryType
+        -- kept for every entry, not only for a type this version cannot decode: a tag alone does
+        -- not rebuild the types that name an invoice, a charge or another purchase
+        entryTypeValue = safeDecodeUtf8 . LB.toStrict $ case entryType of
+          SECredit c -> J.encode c
+          SEDebit d -> J.encode d
+        typeUnknown = case entryType of
+          SECredit SCUnknown {} -> True
+          SEDebit SDUnknown {} -> True
+          _ -> False
+
+-- | The balance is the last row; nothing derives it by summing the history.
+getBadgeLedgerLastEntry :: DB.Connection -> Int64 -> IO (Maybe StatementEntry)
+getBadgeLedgerLastEntry db badgePurchaseId =
+  maybeFirstRow' Nothing toEntry $
+    DB.query
+      db
+      [sql|
+        SELECT entry_uuid, change_months, balance_months, balance_start_ts, balance_anchor_ts, balance_badge_type,
+               was_paused_since, service_created_at, entry_type, entry_credit_type, entry_debit_type, entry_type_value
+        FROM badge_ledger
+        WHERE badge_purchase_id = ?
+        ORDER BY entry_id DESC
+        LIMIT 1
+      |]
+      (Only badgePurchaseId)
+  where
+    toEntry ((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 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.
+entryTypeFromValue :: Text -> Text -> Maybe StatementEntryType
+entryTypeFromValue entryTypeT value_ = case entryTypeT of
+  "credit" -> SECredit <$> decodeJSON value_
+  "debit" -> SEDebit <$> decodeJSON value_
+  _ -> Nothing
+
+getBadgeLedgerEntryId :: DB.Connection -> Int64 -> Text -> IO (Maybe Int64)
+getBadgeLedgerEntryId db badgePurchaseId entryUuid =
+  maybeFirstRow fromOnly $
+    DB.query db "SELECT entry_id FROM badge_ledger WHERE badge_purchase_id = ? AND entry_uuid = ?" (badgePurchaseId, entryUuid)

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

@@ -143,6 +143,7 @@ CREATE TABLE @badge_ledger(
   change_months SMALLINT NOT NULL,
   balance_months SMALLINT NOT NULL,
   balance_start_ts TIMESTAMPTZ NOT NULL,
+  balance_anchor_ts TIMESTAMPTZ NOT NULL,
   balance_badge_type TEXT NOT NULL,
   was_paused_since TIMESTAMPTZ,
   service_created_at TIMESTAMPTZ NOT NULL,
@@ -183,6 +184,8 @@ CREATE TABLE @badge_issuances(
 CREATE INDEX @idx_badge_issuances_purchase ON @badge_issuances(badge_purchase_id, issuance_id);
 
 CREATE INDEX @idx_badge_issuances_entry ON @badge_issuances(entry_id);
+
+CREATE UNIQUE INDEX @idx_badge_issuances_purchase_entry ON @badge_issuances(badge_purchase_id, entry_id);
 |]
 
 badgeSchemaTablesDown :: Text
@@ -190,6 +193,7 @@ badgeSchemaTablesDown =
   [r|
 DROP INDEX @idx_badge_issuances_purchase;
 DROP INDEX @idx_badge_issuances_entry;
+DROP INDEX @idx_badge_issuances_purchase_entry;
 DROP TABLE @badge_issuances;
 DROP INDEX @idx_badge_ledger_uuid;
 DROP INDEX @idx_badge_ledger_purchase;
@@ -237,6 +241,8 @@ ALTER TABLE badge_ledger ADD COLUMN entry_type_unknown SMALLINT NOT NULL DEFAULT
 
 ALTER TABLE badge_ledger ADD COLUMN entry_type_value TEXT;
 
+ALTER TABLE badge_ledger ADD COLUMN balance_checked SMALLINT;
+
 CREATE INDEX idx_badge_purchases_user ON badge_purchases(user_id);
 
 ALTER TABLE users ADD COLUMN shown_badge_id BIGINT REFERENCES badge_purchases ON DELETE SET NULL;

src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql

@@ -223,6 +223,7 @@ CREATE TABLE test_chat_schema.badge_ledger (
     change_months smallint NOT NULL,
     balance_months smallint NOT NULL,
     balance_start_ts timestamp with time zone NOT NULL,
+    balance_anchor_ts timestamp with time zone NOT NULL,
     balance_badge_type text NOT NULL,
     was_paused_since timestamp with time zone,
     service_created_at timestamp with time zone NOT NULL,
@@ -235,7 +236,8 @@ CREATE TABLE test_chat_schema.badge_ledger (
     from_purchase_id bigint,
     to_purchase_id bigint,
     entry_type_unknown smallint DEFAULT 0 NOT NULL,
-    entry_type_value text
+    entry_type_value text,
+    balance_checked smallint
 );
 
 
@@ -2214,6 +2216,10 @@ CREATE INDEX idx_badge_issuances_purchase ON test_chat_schema.badge_issuances US
 
 
 
+CREATE UNIQUE INDEX idx_badge_issuances_purchase_entry ON test_chat_schema.badge_issuances USING btree (badge_purchase_id, entry_id);
+
+
+
 CREATE INDEX idx_badge_ledger_charge ON test_chat_schema.badge_ledger USING btree (charge_id);
 
 

src/Simplex/Chat/Store/Profiles.hs

@@ -382,19 +382,21 @@ updateUserProfileFields_' db userId profileId Profile {displayName, fullName, sh
 
 -- store the user's own badge credential; touches only the badge columns.
 -- bumps user_member_profile_updated_at so groups receive the updated profile (with the badge) on the next message.
-setUserBadge :: DB.Connection -> User -> Maybe LocalBadge -> IO User
-setUserBadge db user@User {userId, profile = p@LocalProfile {profileId}} localBadge = do
-  ts <- getCurrentTime
-  DB.execute
-    db
-    [sql|
-      UPDATE contact_profiles
-      SET badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?, updated_at = ?
-      WHERE user_id = ? AND contact_profile_id = ?
-    |]
-    (localBadgeToRow localBadge :. (ts, userId, profileId))
-  DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (ts, userId)
-  pure (user :: User) {profile = p {localBadge}, userMemberProfileUpdatedAt = Just ts}
+-- answers the row as stored, or a profile edit landing since the caller's read is broadcast back stale.
+setUserBadge :: DB.Connection -> User -> Maybe LocalBadge -> ExceptT StoreError IO User
+setUserBadge db User {userId, profile = LocalProfile {profileId}} localBadge = do
+  liftIO $ do
+    ts <- getCurrentTime
+    DB.execute
+      db
+      [sql|
+        UPDATE contact_profiles
+        SET badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?, updated_at = ?
+        WHERE user_id = ? AND contact_profile_id = ?
+      |]
+      (localBadgeToRow localBadge :. (ts, userId, profileId))
+    DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (ts, userId)
+  getUser db userId
 
 setUserSimplexDomain :: DB.Connection -> User -> Maybe SimplexDomain -> IO User
 setUserSimplexDomain db user@User {userId, profile = p@LocalProfile {profileId}} domain_ = do

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

@@ -144,6 +144,7 @@ CREATE TABLE @badge_ledger(
   change_months INTEGER NOT NULL,
   balance_months INTEGER NOT NULL,
   balance_start_ts TEXT NOT NULL,
+  balance_anchor_ts TEXT NOT NULL,
   balance_badge_type TEXT NOT NULL,
   was_paused_since TEXT,
   service_created_at TEXT NOT NULL,
@@ -184,6 +185,8 @@ CREATE TABLE @badge_issuances(
 CREATE INDEX @idx_badge_issuances_purchase ON @badge_issuances(badge_purchase_id, issuance_id);
 
 CREATE INDEX @idx_badge_issuances_entry ON @badge_issuances(entry_id);
+
+CREATE UNIQUE INDEX @idx_badge_issuances_purchase_entry ON @badge_issuances(badge_purchase_id, entry_id);
 |]
 
 badgeSchemaTablesDown :: Query
@@ -191,6 +194,7 @@ badgeSchemaTablesDown =
   [sql|
 DROP INDEX @idx_badge_issuances_purchase;
 DROP INDEX @idx_badge_issuances_entry;
+DROP INDEX @idx_badge_issuances_purchase_entry;
 DROP TABLE @badge_issuances;
 DROP INDEX @idx_badge_ledger_uuid;
 DROP INDEX @idx_badge_ledger_purchase;
@@ -238,6 +242,8 @@ ALTER TABLE badge_ledger ADD COLUMN entry_type_unknown INTEGER NOT NULL DEFAULT
 
 ALTER TABLE badge_ledger ADD COLUMN entry_type_value TEXT;
 
+ALTER TABLE badge_ledger ADD COLUMN balance_checked INTEGER;
+
 CREATE INDEX idx_badge_purchases_user ON badge_purchases(user_id);
 
 ALTER TABLE users ADD COLUMN shown_badge_id INTEGER REFERENCES badge_purchases ON DELETE SET NULL;

src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt

@@ -1204,8 +1204,19 @@ Plan:
 SEARCH chat_item_reactions USING INDEX idx_chat_item_reactions_group (group_id=? AND shared_msg_id=?)
 
 Query: 
-          INSERT INTO badge_issuances (issuance_id, badge_purchase_id, badge_type, period_start, period_end, expiry, credential, created_at)
-          VALUES (?,?,?,?,?,?,?,?)
+          INSERT INTO badge_issuances (issuance_id, badge_purchase_id, entry_id, badge_type, period_start, period_end, expiry, credential, created_at)
+          VALUES (?,?,?,?,?,?,?,?,?)
+          ON CONFLICT (badge_purchase_id, entry_id) DO NOTHING
+        
+Plan:
+
+Query: 
+          INSERT INTO badge_ledger
+            (entry_uuid, badge_purchase_id, change_months, balance_months, balance_start_ts, balance_anchor_ts, balance_badge_type,
+             was_paused_since, service_created_at, created_at, entry_type, entry_credit_type, entry_debit_type,
+             entry_type_unknown, entry_type_value, balance_checked)
+          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+          ON CONFLICT (entry_uuid) DO NOTHING
         
 Plan:
 
@@ -2017,6 +2028,20 @@ Query:
       
 Plan:
 
+Query: 
+        SELECT
+          (SELECT prev.balance_start_ts FROM badge_ledger prev
+           WHERE prev.badge_purchase_id = issued.badge_purchase_id AND prev.entry_id < issued.entry_id
+           ORDER BY prev.entry_id DESC LIMIT 1),
+          issued.balance_start_ts
+        FROM badge_ledger issued
+        WHERE issued.badge_purchase_id = ? AND issued.entry_id = ?
+      
+Plan:
+SEARCH issued USING INTEGER PRIMARY KEY (rowid=?)
+CORRELATED SCALAR SUBQUERY 1
+SEARCH prev USING INDEX idx_badge_ledger_purchase (badge_purchase_id=? AND entry_id<?)
+
 Query: 
         SELECT
           -- Contact
@@ -3729,6 +3754,16 @@ Query:
 Plan:
 SEARCH cp USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: 
+        SELECT credential FROM badge_issuances
+        WHERE badge_purchase_id = ?
+        ORDER BY period_end DESC
+        LIMIT 1
+      
+Plan:
+SEARCH badge_issuances USING INDEX idx_badge_issuances_purchase_entry (badge_purchase_id=?)
+USE TEMP B-TREE FOR ORDER BY
+
 Query: 
         SELECT ct.contact_id
         FROM contacts ct
@@ -3781,6 +3816,17 @@ Query:
 Plan:
 SEARCH contact_profiles USING INDEX idx_contact_profiles_user_id (user_id=?)
 
+Query: 
+        SELECT entry_uuid, change_months, balance_months, balance_start_ts, balance_anchor_ts, balance_badge_type,
+               was_paused_since, service_created_at, entry_type, entry_credit_type, entry_debit_type, entry_type_value
+        FROM badge_ledger
+        WHERE badge_purchase_id = ?
+        ORDER BY entry_id DESC
+        LIMIT 1
+      
+Plan:
+SEARCH badge_ledger USING INDEX idx_badge_ledger_purchase (badge_purchase_id=?)
+
 Query: 
         SELECT f.file_id
         FROM files f
@@ -3981,6 +4027,20 @@ Plan:
 SEARCH m USING INDEX idx_group_members_user_id (user_id=?)
 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
+        FROM badge_purchases p
+        JOIN users u ON u.user_id = p.user_id
+        WHERE p.user_id = ? AND p.purchase_priv_key IS NOT NULL
+        ORDER BY p.badge_purchase_id DESC
+        LIMIT 1
+      
+Plan:
+SEARCH u USING INTEGER PRIMARY KEY (rowid=?)
+SEARCH p USING INDEX idx_badge_purchases_user (user_id=?)
+
 Query: 
         SELECT pgm.message_id, m.shared_msg_id, m.msg_body, m.msg_chat_binding, m.msg_signatures
         FROM pending_group_messages pgm
@@ -7018,6 +7078,11 @@ Plan:
 Query: INSERT INTO app_settings (app_settings) VALUES (?)
 Plan:
 
+Query: INSERT INTO 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_credit_type,  entry_type_unknown, entry_type_value) SELECT 'unknown-entry', badge_purchase_id, 0, balance_months, balance_start_ts, balance_anchor_ts,  balance_badge_type, service_created_at, created_at, 'credit', 'grant', 1, '{"type":"grant"}' FROM badge_ledger ORDER BY entry_id DESC LIMIT 1
+Plan:
+SCAN badge_ledger
+SEARCH badge_issuances USING COVERING INDEX idx_badge_issuances_entry (entry_id=?)
+
 Query: INSERT INTO chat_item_mentions (chat_item_id, group_id, member_id, display_name) VALUES (?, ?, ?, ?)
 Plan:
 
@@ -7205,6 +7270,10 @@ Query: SELECT agent_conn_id FROM connections WHERE user_id = ? AND conn_req_inv
 Plan:
 SEARCH connections USING INDEX idx_connections_conn_req_inv (user_id=? AND conn_req_inv=?)
 
+Query: SELECT alert_acked_kind, alert_acked_episode FROM badge_purchases
+Plan:
+SCAN badge_purchases
+
 Query: SELECT app_settings FROM app_settings
 Plan:
 SCAN app_settings
@@ -7217,6 +7286,14 @@ Query: SELECT auth_err_counter FROM connections WHERE user_id = ? AND connection
 Plan:
 SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: SELECT badge_expiry, contact_profile_id FROM contact_profiles WHERE badge_proof IS NOT NULL ORDER BY contact_profile_id
+Plan:
+SCAN contact_profiles
+
+Query: SELECT badge_expiry, contact_profile_id FROM contact_profiles WHERE badge_signature IS NOT NULL ORDER BY contact_profile_id
+Plan:
+SCAN contact_profiles
+
 Query: SELECT badge_purchase_id FROM badge_purchases WHERE badge_code_redemption_id = ?
 Plan:
 SEARCH badge_purchases USING COVERING INDEX idx_badge_purchases_code_redemption (badge_code_redemption_id=?)
@@ -7354,6 +7431,24 @@ Query: SELECT count(1) FROM pending_group_messages
 Plan:
 SCAN pending_group_messages USING COVERING INDEX idx_pending_group_messages_group_member_id
 
+Query: SELECT entry_id FROM badge_ledger WHERE badge_purchase_id = ? AND entry_uuid = ?
+Plan:
+SEARCH badge_ledger USING INDEX idx_badge_ledger_uuid (entry_uuid=?)
+
+Query: SELECT entry_uuid, change_months, balance_months, balance_start_ts, balance_badge_type, COALESCE(entry_credit_type, entry_debit_type) FROM badge_ledger ORDER BY entry_id
+Plan:
+SCAN badge_ledger
+
+Query: SELECT expiry, badge_purchase_id FROM badge_issuances ORDER BY period_end
+Plan:
+SCAN badge_issuances
+USE TEMP B-TREE FOR ORDER BY
+
+Query: SELECT expiry, badge_purchase_id FROM badge_issuances ORDER BY period_end DESC LIMIT 1
+Plan:
+SCAN badge_issuances
+USE TEMP B-TREE FOR ORDER BY
+
 Query: SELECT file_id FROM files WHERE user_id = ? AND redirect_file_id = ?
 Plan:
 SEARCH files USING INDEX idx_files_redirect_file_id (redirect_file_id=?)
@@ -7554,6 +7649,14 @@ Query: SELECT should_sync FROM connections_sync WHERE connections_sync_id = 1
 Plan:
 SEARCH connections_sync USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: SELECT shown_badge_id FROM users WHERE user_id = ?
+Plan:
+SEARCH users USING INTEGER PRIMARY KEY (rowid=?)
+
+Query: SELECT shown_badge_id, user_id FROM users WHERE user_id = 1
+Plan:
+SEARCH users USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: SELECT stored_roster_version FROM groups WHERE group_id = ?
 Plan:
 SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
@@ -7582,6 +7685,10 @@ Query: SELECT xgrplinkmem_received FROM group_members WHERE group_member_id = ?
 Plan:
 SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: UPDATE badge_purchases SET alert_acked_kind = ?, alert_acked_episode = ?, alert_snooze_until = ? 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=?)
@@ -7646,6 +7753,14 @@ Query: UPDATE connections_sync SET should_sync = 1 WHERE connections_sync_id = 1
 Plan:
 SEARCH connections_sync USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: UPDATE contact_profiles SET badge_expiry = ? WHERE badge_proof IS NOT NULL
+Plan:
+SCAN contact_profiles
+
+Query: UPDATE contact_profiles SET badge_expiry = ? WHERE badge_signature IS NOT NULL
+Plan:
+SCAN contact_profiles
+
 Query: UPDATE contact_profiles SET contact_domain = ?, updated_at = ? WHERE user_id = ? AND contact_profile_id = ?
 Plan:
 SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
@@ -8034,6 +8149,10 @@ Query: UPDATE users SET shown_badge_id = ? WHERE user_id = ?
 Plan:
 SEARCH users USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: UPDATE users SET shown_badge_id = NULL WHERE user_id = ? AND shown_badge_id = ?
+Plan:
+SEARCH users USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: UPDATE users SET ui_themes = ?, updated_at = ? WHERE user_id = ?
 Plan:
 SEARCH users USING INTEGER PRIMARY KEY (rowid=?)

src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql

@@ -963,6 +963,7 @@ CREATE TABLE badge_ledger(
   change_months INTEGER NOT NULL,
   balance_months INTEGER NOT NULL,
   balance_start_ts TEXT NOT NULL,
+  balance_anchor_ts TEXT NOT NULL,
   balance_badge_type TEXT NOT NULL,
   was_paused_since TEXT,
   service_created_at TEXT NOT NULL,
@@ -976,7 +977,8 @@ CREATE TABLE badge_ledger(
   to_purchase_id INTEGER REFERENCES badge_purchases
   ,
   entry_type_unknown INTEGER NOT NULL DEFAULT 0,
-  entry_type_value TEXT
+  entry_type_value TEXT,
+  balance_checked INTEGER
 ) STRICT;
 CREATE TABLE badge_issuances(
   issuance_id TEXT NOT NULL PRIMARY KEY,
@@ -1556,6 +1558,10 @@ CREATE INDEX idx_badge_issuances_purchase ON badge_issuances(
   issuance_id
 );
 CREATE INDEX idx_badge_issuances_entry ON badge_issuances(entry_id);
+CREATE UNIQUE INDEX idx_badge_issuances_purchase_entry ON badge_issuances(
+  badge_purchase_id,
+  entry_id
+);
 CREATE INDEX idx_badge_purchases_user ON badge_purchases(user_id);
 CREATE INDEX idx_users_shown_badge ON users(shown_badge_id);
 CREATE INDEX idx_badge_code_redemptions_user ON badge_code_redemptions(

src/Simplex/Chat/Store/Shared.hs

@@ -73,6 +73,7 @@ data ChatLockEntity
   | CLUserContact Int64
   | CLContactRequest Int64
   | CLFile Int64
+  | CLBadgeUser Int64 -- one signed badge request per profile in flight
   deriving (Eq, Ord)
 
 -- These error type constructors must be added to mobile apps