refactor badge types to GADT

bots/src/API/Docs/Types.hs

@@ -34,7 +34,7 @@ import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Operators
 import Simplex.Messaging.Agent.Store.Entity (DBStored (..))
-import Simplex.Chat.Badges (LocalBadge (..), BadgeStatus (..), SupporterBadge (..), BadgeType (..))
+import Simplex.Chat.Badges (BadgeInfo (..), BadgeStatus (..), BadgeType (..))
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
@@ -306,7 +306,7 @@ chatTypesDocsData =
     (sti @LinkContent, STUnion, "LC", [], "", ""),
     (sti @LinkOwnerSig, STRecord, "", [], "", ""),
     (sti @LinkPreview, STRecord, "", [], "", ""),
-    (sti @LocalBadge, STRecord, "", [], "", ""),
+    (sti @BadgeInfo, STRecord, "", [], "", ""),
     (sti @LocalProfile, STRecord, "", [], "", ""),
     (sti @MemberCriteria, STEnum1, "MC", [], "", ""),
     (sti @MsgChatLink, STUnion, "MCL", [], "", "Connection link sent in a message - only short links are allowed."),
@@ -364,7 +364,6 @@ chatTypesDocsData =
     (sti @SrvError, STUnion, "SrvErr", [], "", ""),
     (sti @StoreError, STUnion, "SE", [], "", ""),
     (sti @SubscriptionStatus, STUnion, "SS", [], "", ""),
-    (sti @SupporterBadge, STRecord, "", [], "", ""),
     (sti @SupportGroupPreference, STRecord, "", [], "", ""),
     (sti @SwitchPhase, STEnum, "SP", [], "", ""),
     (sti @TimedMessagesGroupPreference, STRecord, "", [], "", ""),
@@ -531,7 +530,7 @@ deriving instance Generic JSONCIStatus
 deriving instance Generic LinkContent
 deriving instance Generic LinkOwnerSig
 deriving instance Generic LinkPreview
-deriving instance Generic LocalBadge
+deriving instance Generic BadgeInfo
 deriving instance Generic LocalProfile
 deriving instance Generic MemberCriteria
 deriving instance Generic MsgChatLink
@@ -558,7 +557,6 @@ deriving instance Generic ProxyClientError
 deriving instance Generic ProxyError
 deriving instance Generic PublicGroupAccess
 deriving instance Generic PublicGroupData
-deriving instance Generic SupporterBadge
 deriving instance Generic PublicGroupProfile
 deriving instance Generic RatchetSyncState
 deriving instance Generic RCErrorType

src/Simplex/Chat/Badges.hs

@@ -1,27 +1,39 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.Chat.Badges
   ( BadgeType (..),
     BadgeStatus (..),
+    BadgeInfo (..),
+    BadgeCrypto (..),
+    Badge (..),
     LocalBadge (..),
+    localBadgeInfo,
+    localBadgeStatus,
+    BadgePresHeader (..),
+    badgePresHeaderBytes,
+    toBadgePresHeader,
     BadgePurchase (..),
     BadgeMasterKey (..),
     BadgeRequest (..),
     VerifiedBadgeRequest (..),
-    BadgeCredential (..),
-    SupporterBadge (..),
     bbsBadgeHeader,
     generateMasterKey,
     verifyPayment,
     issueBadge,
-    verifyBadgeSignature,
+    verifyCredential,
     generateBadgeProof,
     verifyBadge,
     verifyBadge_,
@@ -30,22 +42,28 @@ module Simplex.Chat.Badges
     srvBadgePublicKey,
     BadgeRow,
     badgeToRow,
+    localBadgeToRow,
     rowToBadge,
   ) where
 
+import Control.Applicative ((<|>))
 import Control.Concurrent.STM
 import Crypto.Random (ChaChaDRG)
-import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
+import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as JQ
+import Data.Aeson.Types (Parser)
 import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime)
+import Data.Word (Word8)
 import Simplex.Messaging.Agent.Store.DB (BoolInt (..), fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.BBS
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 #if defined(dbPostgres)
 import Database.PostgreSQL.Simple.FromField (FromField (..))
 import Database.PostgreSQL.Simple.ToField (ToField (..))
@@ -85,23 +103,90 @@ instance ToJSON BadgeType where
 instance FromJSON BadgeType where
   parseJSON = textParseJSON "BadgeType"
 
--- Badge status and local badge
+-- Badge status
 
 data BadgeStatus = BSActive | BSExpired | BSFailed
   deriving (Eq, Show)
 
-data LocalBadge = LocalBadge
-  { badgeStatus :: BadgeStatus,
-    badge :: SupporterBadge
+-- Disclosed badge content (BBS messages 1, 2, 3)
+
+data BadgeInfo = BadgeInfo
+  { badgeType :: BadgeType,
+    badgeExpiry :: Maybe UTCTime,
+    badgeExtra :: Text
   }
   deriving (Eq, Show)
 
-mkBadgeStatus :: UTCTime -> Bool -> SupporterBadge -> BadgeStatus
-mkBadgeStatus now verified SupporterBadge {badgeExpiry}
+mkBadgeStatus :: UTCTime -> Bool -> BadgeInfo -> BadgeStatus
+mkBadgeStatus now verified BadgeInfo {badgeExpiry}
   | not verified = BSFailed
   | maybe False (now >) badgeExpiry = BSExpired
   | otherwise = BSActive
 
+-- Badge crypto: a credential (own, secret) or a proof (wire, a presentation).
+-- Positional GADT - a record field cannot be shared across constructors with different result types.
+
+data BadgeCrypto = BCCredential | BCProof
+
+data Badge (b :: BadgeCrypto) where
+  BadgeCredential :: BadgeMasterKey -> BBSSignature -> BadgeInfo -> Badge 'BCCredential
+  BadgeProof :: BBSPresHeader -> BBSProof -> BadgeInfo -> Badge 'BCProof
+
+deriving instance Show (Badge b)
+
+deriving instance Eq (Badge 'BCCredential)
+
+deriving instance Eq (Badge 'BCProof)
+
+-- Local badge: a stored badge (own credential or peer proof) plus its display status.
+-- Existential - the inner Badge constructor is the discriminator.
+data LocalBadge = forall b. LocalBadge (Badge b) BadgeStatus
+
+sameBadgeCrypto :: Badge x -> Badge y -> Bool
+sameBadgeCrypto (BadgeCredential mk1 sg1 i1) (BadgeCredential mk2 sg2 i2) = mk1 == mk2 && sg1 == sg2 && i1 == i2
+sameBadgeCrypto (BadgeProof ph1 p1 i1) (BadgeProof ph2 p2 i2) = ph1 == ph2 && p1 == p2 && i1 == i2
+sameBadgeCrypto _ _ = False
+
+instance Show LocalBadge where
+  show (LocalBadge b st) = "LocalBadge (" <> show b <> ") " <> show st
+
+instance Eq LocalBadge where
+  LocalBadge b1 s1 == LocalBadge b2 s2 = s1 == s2 && sameBadgeCrypto b1 b2
+
+localBadgeInfo :: LocalBadge -> BadgeInfo
+localBadgeInfo (LocalBadge b _) = case b of
+  BadgeCredential _ _ i -> i
+  BadgeProof _ _ i -> i
+
+localBadgeStatus :: LocalBadge -> BadgeStatus
+localBadgeStatus (LocalBadge _ st) = st
+
+localBadgeVerified :: Maybe LocalBadge -> Maybe Bool
+localBadgeVerified = fmap $ \lb -> localBadgeStatus lb /= BSFailed
+
+-- Presentation header: unbound test marker (stable) or forward-compat catch-all (master variants)
+
+data BadgePresHeader
+  = PHTest
+  | PHUnknown Word8 ByteString
+
+badgePresHeaderBytes :: BadgePresHeader -> ByteString
+badgePresHeaderBytes = \case
+  PHTest -> B.singleton 0
+  PHUnknown t b -> B.cons t b
+
+toBadgePresHeader :: ByteString -> BadgePresHeader
+toBadgePresHeader bs = case B.uncons bs of
+  Just (0, _) -> PHTest
+  Just (t, b) -> PHUnknown t b
+  Nothing -> PHUnknown 0 ""
+
+-- stable accepts both; master rejects PHTest
+badgePresHeaderAccepted :: BadgePresHeader -> Bool
+badgePresHeaderAccepted = \case
+  PHTest -> True
+  PHUnknown _ _ -> True
+
 -- Payment proof
 
 data BadgePurchase
@@ -130,32 +215,13 @@ generateMasterKey drg = BadgeMasterKey <$> atomically (C.randomBytes 32 drg)
 
 data BadgeRequest = BadgeRequest
   { masterKey :: BadgeMasterKey,
-    badgeType :: BadgeType,
-    expiry :: Maybe UTCTime
+    badgeInfo :: BadgeInfo
   }
   deriving (Show)
 
 newtype VerifiedBadgeRequest = VerifiedBadgeRequest BadgeRequest
   deriving (Show)
 
-data BadgeCredential = BadgeCredential
-  { masterKey :: BadgeMasterKey,
-    signature :: BBSSignature,
-    badgeExpiry :: Maybe UTCTime,
-    badgeType :: BadgeType,
-    badgeExtra :: Text
-  }
-  deriving (Eq, Show)
-
-data SupporterBadge = SupporterBadge
-  { proof :: BBSProof,
-    presHeader :: BBSPresHeader,
-    badgeExpiry :: Maybe UTCTime,
-    badgeType :: BadgeType,
-    badgeExtra :: Text
-  }
-  deriving (Eq, Show)
-
 -- Constants
 
 bbsBadgeHeader :: BBSHeader
@@ -172,11 +238,12 @@ bbsBadgeDisclosedIndexes = [1, 2, 3]
 encodeExpiry :: Maybe UTCTime -> ByteString
 encodeExpiry = maybe "lifetime" strEncode
 
-badgeMessages :: BadgeMasterKey -> Maybe UTCTime -> BadgeType -> Text -> [ByteString]
-badgeMessages (BadgeMasterKey ms) expiry bt extra = [ms, encodeExpiry expiry, encodeUtf8 (textEncode bt), encodeUtf8 extra]
+badgeMessages :: BadgeMasterKey -> BadgeInfo -> [ByteString]
+badgeMessages (BadgeMasterKey ms) info = ms : badgeInfoMessages info
 
-badgeDisclosedMessages :: Maybe UTCTime -> BadgeType -> Text -> [ByteString]
-badgeDisclosedMessages expiry bt extra = [encodeExpiry expiry, encodeUtf8 (textEncode bt), encodeUtf8 extra]
+badgeInfoMessages :: BadgeInfo -> [ByteString]
+badgeInfoMessages BadgeInfo {badgeType, badgeExpiry, badgeExtra} =
+  [encodeExpiry badgeExpiry, encodeUtf8 (textEncode badgeType), encodeUtf8 badgeExtra]
 
 -- Payment verification (stub - always passes)
 
@@ -185,39 +252,34 @@ verifyPayment _payment req = pure $ Just (VerifiedBadgeRequest req)
 
 -- Server-side: issue a badge credential
 
-issueBadge :: BBSSecretKey -> BBSPublicKey -> VerifiedBadgeRequest -> IO (Either String BadgeCredential)
-issueBadge sk pk (VerifiedBadgeRequest BadgeRequest {masterKey, badgeType, expiry}) =
-  fmap mkCred <$> bbsSign sk pk bbsBadgeHeader (badgeMessages masterKey expiry badgeType badgeExtra)
-  where
-    badgeExtra = "" -- reserved, empty for now
-    mkCred sig = BadgeCredential {masterKey, signature = sig, badgeExpiry = expiry, badgeType, badgeExtra}
+issueBadge :: BBSSecretKey -> BBSPublicKey -> VerifiedBadgeRequest -> IO (Either String (Badge 'BCCredential))
+issueBadge sk pk (VerifiedBadgeRequest BadgeRequest {masterKey, badgeInfo})
+  | badgeExtra badgeInfo /= "" = pure $ Left "badgeExtra must be empty (reserved)"
+  | otherwise = fmap (\sig -> BadgeCredential masterKey sig badgeInfo) <$> bbsSign sk pk bbsBadgeHeader (badgeMessages masterKey badgeInfo)
 
 -- Client-side: verify the credential received from server
 
-verifyBadgeSignature :: BBSPublicKey -> BadgeCredential -> IO Bool
-verifyBadgeSignature pk BadgeCredential {masterKey, signature, badgeExpiry, badgeType, badgeExtra} =
-  bbsVerify pk signature bbsBadgeHeader (badgeMessages masterKey badgeExpiry badgeType badgeExtra)
+verifyCredential :: BBSPublicKey -> Badge 'BCCredential -> IO Bool
+verifyCredential pk (BadgeCredential masterKey signature badgeInfo) =
+  bbsVerify pk signature bbsBadgeHeader (badgeMessages masterKey badgeInfo)
 
 -- Client-side: generate a proof for a contact/group
 
-generateBadgeProof :: BBSPublicKey -> BadgeCredential -> BBSPresHeader -> IO (Either String SupporterBadge)
-generateBadgeProof pk BadgeCredential {masterKey, signature, badgeExpiry, badgeType, badgeExtra} ph =
-  fmap mkBadge <$> bbsProofGen pk signature bbsBadgeHeader ph bbsBadgeDisclosedIndexes (badgeMessages masterKey badgeExpiry badgeType badgeExtra)
-  where
-    mkBadge p = SupporterBadge {proof = p, presHeader = ph, badgeExpiry, badgeType, badgeExtra}
+generateBadgeProof :: BBSPublicKey -> Badge 'BCCredential -> BBSPresHeader -> IO (Either String (Badge 'BCProof))
+generateBadgeProof pk (BadgeCredential masterKey signature badgeInfo) ph =
+  fmap (\p -> BadgeProof ph p badgeInfo) <$> bbsProofGen pk signature bbsBadgeHeader ph bbsBadgeDisclosedIndexes (badgeMessages masterKey badgeInfo)
 
 -- Recipient-side: verify a badge proof
 
-verifyBadge :: BBSPublicKey -> SupporterBadge -> IO Bool
-verifyBadge pk SupporterBadge {proof, presHeader, badgeExpiry, badgeType, badgeExtra} =
-  bbsProofVerify pk proof bbsBadgeHeader presHeader bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeDisclosedMessages badgeExpiry badgeType badgeExtra)
+verifyBadge :: BBSPublicKey -> Badge 'BCProof -> IO Bool
+verifyBadge pk (BadgeProof ph@(BBSPresHeader phBytes) proof badgeInfo)
+  | badgePresHeaderAccepted (toBadgePresHeader phBytes) =
+      bbsProofVerify pk proof bbsBadgeHeader ph bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeInfoMessages badgeInfo)
+  | otherwise = pure False
 
-verifyBadge_ :: BBSPublicKey -> Maybe SupporterBadge -> IO Bool
+verifyBadge_ :: BBSPublicKey -> Maybe (Badge 'BCProof) -> IO Bool
 verifyBadge_ = maybe (pure False) . verifyBadge
 
-localBadgeVerified :: Maybe LocalBadge -> Maybe Bool
-localBadgeVerified = fmap $ \LocalBadge {badgeStatus} -> badgeStatus /= BSFailed
-
 -- Server public key (test key - replace with real key when badge service is deployed)
 
 srvBadgePublicKey :: BBSPublicKey
@@ -229,29 +291,80 @@ instance FromField BadgeType where fromField = fromTextField_ textDecode
 
 instance ToField BadgeType where toField = toField . textEncode
 
-type BadgeRow = (Maybe ByteString, Maybe ByteString, Maybe UTCTime, Maybe Text, Maybe BoolInt, Maybe Text)
+-- (proof, pres_header, expiry, type, verified, extra, master_key, signature)
+type BadgeRow = (Maybe ByteString, Maybe ByteString, Maybe UTCTime, Maybe Text, Maybe BoolInt, Maybe Text, Maybe ByteString, Maybe ByteString)
 
-badgeToRow :: Maybe SupporterBadge -> Bool -> BadgeRow
-badgeToRow (Just SupporterBadge {proof = BBSProof p, presHeader = BBSPresHeader ph, badgeExpiry, badgeType, badgeExtra}) verified =
-  (Just p, Just ph, badgeExpiry, Just (textEncode badgeType), Just (BI verified), Just badgeExtra)
-badgeToRow _ _ = (Nothing, Nothing, Nothing, Nothing, Just (BI False), Nothing)
+-- receive/store sites have a wire proof + a computed verified flag
+badgeToRow :: Maybe (Badge 'BCProof) -> Bool -> BadgeRow
+badgeToRow badge verified = localBadgeToRow $ (\b -> LocalBadge b (if verified then BSActive else BSFailed)) <$> badge
+
+localBadgeToRow :: Maybe LocalBadge -> BadgeRow
+localBadgeToRow (Just (LocalBadge b st)) = case b of
+  BadgeCredential (BadgeMasterKey mk) (BBSSignature sg) BadgeInfo {badgeType, badgeExpiry, badgeExtra} ->
+    (Nothing, Nothing, badgeExpiry, Just (textEncode badgeType), Just (BI verified), Just badgeExtra, Just mk, Just sg)
+  BadgeProof (BBSPresHeader ph) (BBSProof p) BadgeInfo {badgeType, badgeExpiry, badgeExtra} ->
+    (Just p, Just ph, badgeExpiry, Just (textEncode badgeType), Just (BI verified), Just badgeExtra, Nothing, Nothing)
+  where
+    verified = st /= BSFailed
+localBadgeToRow Nothing = (Nothing, Nothing, Nothing, Nothing, Just (BI False), Nothing, Nothing, Nothing)
 
 rowToBadge :: UTCTime -> BadgeRow -> Maybe LocalBadge
-rowToBadge now (Just p, Just ph, badgeExpiry, Just btText, verified_, extra_) = do
+rowToBadge now (p_, ph_, badgeExpiry, type_, verified_, extra_, mk_, sg_) = do
+  btText <- type_
   bt <- textDecode btText
-  let b = SupporterBadge {proof = BBSProof p, presHeader = BBSPresHeader ph, badgeExpiry, badgeType = bt, badgeExtra = maybe "" id extra_}
+  let info = BadgeInfo {badgeType = bt, badgeExpiry, badgeExtra = maybe "" id extra_}
       verified = maybe False unBI verified_
-  Just LocalBadge {badgeStatus = mkBadgeStatus now verified b, badge = b}
-rowToBadge _ _ = Nothing
+      st = mkBadgeStatus now verified info
+  case (mk_, sg_, p_, ph_) of
+    (Just mk, Just sg, _, _) -> Just $ LocalBadge (BadgeCredential (BadgeMasterKey mk) (BBSSignature sg) info) st
+    (_, _, Just p, Just ph) -> Just $ LocalBadge (BadgeProof (BBSPresHeader ph) (BBSProof p) info) st
+    _ -> Nothing
 
 -- JSON
 
 $(JQ.deriveJSON (enumJSON $ dropPrefix "BS") ''BadgeStatus)
 
-$(JQ.deriveJSON defaultJSON ''SupporterBadge)
-
-$(JQ.deriveJSON defaultJSON ''LocalBadge)
+$(JQ.deriveJSON defaultJSON ''BadgeInfo)
 
 $(JQ.deriveJSON defaultJSON ''BadgeRequest)
 
-$(JQ.deriveJSON defaultJSON ''BadgeCredential)
+-- The Badge GADT (multi-constructor, different result types) is JSON-encoded via a plain mirror,
+-- the codebase pattern for GADTs (see Messages/CIContent CIDeleted/CIStatus). deriveJSON does the work.
+
+data JBadge
+  = JBadgeCredential {masterKey :: BadgeMasterKey, signature :: BBSSignature, badgeInfo :: BadgeInfo}
+  | JBadgeProof {presHeader :: BBSPresHeader, proof :: BBSProof, badgeInfo :: BadgeInfo}
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JBadge") ''JBadge)
+
+jBadge :: Badge b -> JBadge
+jBadge = \case
+  BadgeCredential mk sg i -> JBadgeCredential mk sg i
+  BadgeProof ph p i -> JBadgeProof ph p i
+
+instance ToJSON (Badge b) where
+  toJSON = toJSON . jBadge
+  toEncoding = toEncoding . jBadge
+
+instance FromJSON (Badge 'BCProof) where
+  parseJSON v =
+    parseJSON v >>= \case
+      JBadgeProof ph p i -> pure (BadgeProof ph p i)
+      _ -> fail "expected badge proof"
+
+instance FromJSON (Badge 'BCCredential) where
+  parseJSON v =
+    parseJSON v >>= \case
+      JBadgeCredential mk sg i -> pure (BadgeCredential mk sg i)
+      _ -> fail "expected badge credential"
+
+-- LocalBadge round-trips (the inner Badge tags which crypto it is).
+instance ToJSON LocalBadge where
+  toJSON (LocalBadge b st) = J.object ["badge" .= b, "status" .= st]
+
+instance FromJSON LocalBadge where
+  parseJSON = J.withObject "LocalBadge" $ \o -> do
+    st <- o .: "status"
+    bv <- o .: "badge"
+    (flip LocalBadge st <$> (parseJSON bv :: Parser (Badge 'BCProof)))
+      <|> (flip LocalBadge st <$> (parseJSON bv :: Parser (Badge 'BCCredential)))

src/Simplex/Chat/Mobile/Badges.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -62,7 +63,7 @@ cChatBadgeKeygen =
 cChatBadgeIssue :: CString -> IO CJSONString
 cChatBadgeIssue cReq = do
   bs <- B.packCString cReq
-  encodeResult @BadgeCredential =<< case J.eitherDecodeStrict' bs of
+  encodeResult @(Badge 'BCCredential) =<< case J.eitherDecodeStrict' bs of
     Left e -> pure $ BadgeError (T.pack e)
     Right BadgeIssueReq {keyPair = BBSKeyPair {secretKey, publicKey}, request} ->
       either (BadgeError . T.pack) BadgeResult <$> issueBadge secretKey publicKey (VerifiedBadgeRequest request)

src/Simplex/Chat/Store/Connections.hs

@@ -116,7 +116,7 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
               p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect, c.welcome_shared_msg_id, c.request_shared_msg_id, c.contact_request_id,
               c.contact_group_member_id, c.contact_grp_inv_sent, c.grp_direct_inv_link, c.grp_direct_inv_from_group_id, c.grp_direct_inv_from_group_member_id, c.grp_direct_inv_from_member_conn_id, c.grp_direct_inv_started_connection,
               c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl,
-              p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra
+              p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature
             FROM contacts c
             JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
             WHERE c.user_id = ? AND c.contact_id = ? AND c.contact_status = ? AND c.deleted = 0
@@ -156,13 +156,13 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
                   mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
                   -- GroupInfo {membership = GroupMember {memberProfile}}
                   pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
-                  pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra,
+                  pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature,
                   mu.created_at, mu.updated_at,
                   mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.relay_link,
                   -- from GroupMember
                   m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
                   m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
-                  p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra,
+                  p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature,
                   m.created_at, m.updated_at,
                   m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link
                 FROM group_members m

src/Simplex/Chat/Store/ContactRequest.hs

@@ -116,7 +116,7 @@ createOrUpdateContactRequest
                   cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
                   ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
                   ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-                  cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra,
+                  cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature,
                   -- Connection
                   c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
                   c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@@ -152,7 +152,7 @@ createOrUpdateContactRequest
                 cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
                 cr.created_at, cr.updated_at,
                 cr.peer_chat_min_version, cr.peer_chat_max_version,
-                p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra
+                p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature
               FROM contact_requests cr
               JOIN contact_profiles p USING (contact_profile_id)
               WHERE cr.user_id = ?
@@ -168,7 +168,7 @@ createOrUpdateContactRequest
           liftIO $
             DB.execute
               db
-              "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
+              "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
               ((displayName, fullName, shortDescr, image, contactLink, userId) :. ("" :: LocalAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
           profileId <- liftIO $ insertedRowId db
           liftIO $
@@ -246,7 +246,9 @@ createOrUpdateContactRequest
                   badge_expiry = ?,
                   badge_type = ?,
                   badge_verified = ?,
-                  badge_extra = ?
+                  badge_extra = ?,
+                  badge_master_key = ?,
+                  badge_signature = ?
               WHERE contact_profile_id IN (
                 SELECT contact_profile_id
                 FROM contact_requests

src/Simplex/Chat/Store/Direct.hs

@@ -320,7 +320,7 @@ getContactByConnReqHash db cxt user@User {userId} cReqHash1 cReqHash2 = do
             cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
             ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
             ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-            cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra,
+            cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature,
             -- Connection
             c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
             c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@@ -712,7 +712,7 @@ updateContactProfile_' db userId profileId Profile {displayName, fullName, short
     [sql|
       UPDATE contact_profiles
       SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?,
-          badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?
+          badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?
       WHERE user_id = ? AND contact_profile_id = ?
     |]
     ((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. (userId, profileId))
@@ -730,7 +730,7 @@ updateMemberContactProfileReset_' db userId profileId Profile {displayName, full
     [sql|
       UPDATE contact_profiles
       SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = NULL, preferences = NULL, updated_at = ?,
-          badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?
+          badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?
       WHERE user_id = ? AND contact_profile_id = ?
     |]
     ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (userId, profileId))
@@ -748,7 +748,7 @@ updateMemberContactProfile_' db userId profileId Profile {displayName, fullName,
     [sql|
       UPDATE contact_profiles
       SET display_name = ?, full_name = ?, short_descr = ?, image = ?, updated_at = ?,
-          badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?
+          badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?
       WHERE user_id = ? AND contact_profile_id = ?
     |]
     ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (userId, profileId))
@@ -809,7 +809,7 @@ contactRequestQuery =
       cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
       cr.created_at, cr.updated_at,
       cr.peer_chat_min_version, cr.peer_chat_max_version,
-      p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra
+      p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature
     FROM contact_requests cr
     JOIN contact_profiles p USING (contact_profile_id)
   |]
@@ -929,7 +929,7 @@ getContact_ db cxt user@User {userId} contactId deleted = do
           cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
           ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
           ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-          cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra,
+          cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature,
           -- Connection
           c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
           c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,

src/Simplex/Chat/Store/Groups.hs

@@ -1734,7 +1734,7 @@ createJoiningMember
       liftIO $
         DB.execute
           db
-          "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
+          "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
           ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
       profileId <- liftIO $ insertedRowId db
       case cReqMemberId_ of
@@ -2095,7 +2095,7 @@ createNewMemberProfile_ db User {userId} Profile {displayName, fullName, shortDe
     badgeVerified <- verifyBadge_ srvBadgePublicKey badge
     DB.execute
       db
-      "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
+      "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
       ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, createdAt, createdAt) :. badgeToRow badge badgeVerified)
     profileId <- insertedRowId db
     pure $ Right (ldn, profileId, badgeVerified)

src/Simplex/Chat/Store/Messages.hs

@@ -707,7 +707,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
               m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
               m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
               p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
-              p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra,
+              p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature,
               m.created_at, m.updated_at,
               m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link
             FROM group_members m
@@ -1131,7 +1131,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = do
           cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
           cr.created_at, cr.updated_at,
           cr.peer_chat_min_version, cr.peer_chat_max_version,
-          p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra
+          p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature
         FROM contact_requests cr
         JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_id
         JOIN user_contact_links uc ON uc.user_contact_link_id = cr.user_contact_link_id
@@ -3041,7 +3041,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
             m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
             m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
             p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
-            p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra,
+            p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature,
             m.created_at, m.updated_at,
             m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link,
             -- quoted ChatItem
@@ -3050,14 +3050,14 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
             rm.group_member_id, rm.group_id, rm.index_in_group, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
             rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
             rp.display_name, rp.full_name, rp.short_descr, rp.image, rp.contact_link, rp.chat_peer_type, rp.local_alias, rp.preferences,
-            rp.badge_proof, rp.badge_pres_header, rp.badge_expiry, rp.badge_type, rp.badge_verified, rp.badge_extra,
+            rp.badge_proof, rp.badge_pres_header, rp.badge_expiry, rp.badge_type, rp.badge_verified, rp.badge_extra, rp.badge_master_key, rp.badge_signature,
             rm.created_at, rm.updated_at,
             rm.support_chat_ts, rm.support_chat_items_unread, rm.support_chat_items_member_attention, rm.support_chat_items_mentions, rm.support_chat_last_msg_from_member_ts, rm.member_pub_key, rm.relay_link,
             -- deleted by GroupMember
             dbm.group_member_id, dbm.group_id, dbm.index_in_group, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
             dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
             dbp.display_name, dbp.full_name, dbp.short_descr, dbp.image, dbp.contact_link, dbp.chat_peer_type, dbp.local_alias, dbp.preferences,
-            dbp.badge_proof, dbp.badge_pres_header, dbp.badge_expiry, dbp.badge_type, dbp.badge_verified, dbp.badge_extra,
+            dbp.badge_proof, dbp.badge_pres_header, dbp.badge_expiry, dbp.badge_type, dbp.badge_verified, dbp.badge_extra, dbp.badge_master_key, dbp.badge_signature,
             dbm.created_at, dbm.updated_at,
             dbm.support_chat_ts, dbm.support_chat_items_unread, dbm.support_chat_items_member_attention, dbm.support_chat_items_mentions, dbm.support_chat_last_msg_from_member_ts, dbm.member_pub_key, dbm.relay_link
           FROM chat_items i

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

@@ -15,11 +15,15 @@ ALTER TABLE contact_profiles ADD COLUMN badge_expiry TEXT;
 ALTER TABLE contact_profiles ADD COLUMN badge_type TEXT;
 ALTER TABLE contact_profiles ADD COLUMN badge_verified SMALLINT NOT NULL DEFAULT 0;
 ALTER TABLE contact_profiles ADD COLUMN badge_extra TEXT;
+ALTER TABLE contact_profiles ADD COLUMN badge_master_key BYTEA;
+ALTER TABLE contact_profiles ADD COLUMN badge_signature BYTEA;
 |]
 
 down_m20260516_supporter_badges :: Text
 down_m20260516_supporter_badges =
   [r|
+ALTER TABLE contact_profiles DROP COLUMN badge_signature;
+ALTER TABLE contact_profiles DROP COLUMN badge_master_key;
 ALTER TABLE contact_profiles DROP COLUMN badge_extra;
 ALTER TABLE contact_profiles DROP COLUMN badge_verified;
 ALTER TABLE contact_profiles DROP COLUMN badge_type;

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

@@ -14,11 +14,15 @@ ALTER TABLE contact_profiles ADD COLUMN badge_expiry TEXT;
 ALTER TABLE contact_profiles ADD COLUMN badge_type TEXT;
 ALTER TABLE contact_profiles ADD COLUMN badge_verified INTEGER NOT NULL DEFAULT 0;
 ALTER TABLE contact_profiles ADD COLUMN badge_extra TEXT;
+ALTER TABLE contact_profiles ADD COLUMN badge_master_key BLOB;
+ALTER TABLE contact_profiles ADD COLUMN badge_signature BLOB;
 |]
 
 down_m20260516_supporter_badges :: Query
 down_m20260516_supporter_badges =
   [sql|
+ALTER TABLE contact_profiles DROP COLUMN badge_signature;
+ALTER TABLE contact_profiles DROP COLUMN badge_master_key;
 ALTER TABLE contact_profiles DROP COLUMN badge_extra;
 ALTER TABLE contact_profiles DROP COLUMN badge_verified;
 ALTER TABLE contact_profiles DROP COLUMN badge_type;

src/Simplex/Chat/Store/Shared.hs

@@ -418,7 +418,7 @@ createContact_ db User {userId} Profile {displayName, fullName, shortDescr, imag
     badgeVerified <- verifyBadge_ srvBadgePublicKey badge
     DB.execute
       db
-      "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
+      "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
       ((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
     profileId <- insertedRowId db
     DB.execute
@@ -525,7 +525,7 @@ getProfileById db userId profileId = do
       db
       [sql|
         SELECT cp.contact_profile_id, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, cp.preferences,
-          cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra
+          cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature
         FROM contact_profiles cp
         WHERE cp.user_id = ? AND cp.contact_profile_id = ?
       |]
@@ -749,7 +749,7 @@ groupMemberQuery =
     SELECT
       m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
       m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
-      p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra,
+      p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature,
       m.created_at, m.updated_at,
       m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link,
       c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -794,7 +794,7 @@ groupInfoQueryFields =
       mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
       mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
       pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
-      pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra,
+      pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature,
       mu.created_at, mu.updated_at,
       mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.relay_link
   |]

src/Simplex/Chat/Types.hs

@@ -47,7 +47,7 @@ import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Typeable (Typeable)
 import Data.Word (Word16)
-import Simplex.Chat.Badges (BadgeStatus (..), LocalBadge (..), SupporterBadge, mkBadgeStatus, srvBadgePublicKey, verifyBadge)
+import Simplex.Chat.Badges (Badge (..), BadgeCrypto (..), BadgeInfo (..), BadgeStatus (..), LocalBadge (..), localBadgeInfo, localBadgeStatus, mkBadgeStatus, srvBadgePublicKey, verifyBadge)
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
@@ -687,7 +687,7 @@ data Profile = Profile
     contactLink :: Maybe ConnLinkContact,
     preferences :: Maybe Preferences,
     peerType :: Maybe ChatPeerType,
-    badge :: Maybe SupporterBadge
+    badge :: Maybe (Badge 'BCProof)
     -- fields that should not be read into this data type to prevent sending them as part of profile to contacts:
     -- - contact_profile_id
     -- - incognito
@@ -772,18 +772,23 @@ toLocalProfile :: ProfileId -> Profile -> LocalAlias -> UTCTime -> Bool -> Local
 toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge} localAlias now verified =
   LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, localAlias}
   where
-    localBadge = (\b -> LocalBadge {badgeStatus = mkBadgeStatus now verified b, badge = b}) <$> badge
+    localBadge = (\b@(BadgeProof _ _ info) -> LocalBadge b (mkBadgeStatus now verified info)) <$> badge
 
 fromLocalProfile :: LocalProfile -> Profile
 fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge} =
-  Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = (\LocalBadge {badge} -> badge) <$> localBadge}
+  Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge}
+  where
+    wireBadge :: LocalBadge -> Maybe (Badge 'BCProof)
+    wireBadge (LocalBadge b _) = case b of
+      BadgeProof {} -> Just b
+      BadgeCredential {} -> Nothing
 
 profileBadgeVerified :: LocalProfile -> Profile -> IO Bool
 profileBadgeVerified LocalProfile {localBadge} Profile {badge = newBadge} =
   case (localBadge, newBadge) of
     (_, Nothing) -> pure False
-    (Just LocalBadge {badge = oldB, badgeStatus}, Just newB)
-      | oldB == newB -> pure (badgeStatus /= BSFailed)
+    (Just lb, Just (BadgeProof _ _ newInfo))
+      | localBadgeInfo lb == newInfo -> pure (localBadgeStatus lb /= BSFailed)
     (_, Just newB) -> verifyBadge srvBadgePublicKey newB
 
 data GroupType

tests/BadgeTests.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -21,32 +23,38 @@ badgeTests = do
   it "should treat lifetime badges as always active" testLifetimeBadge
   it "should accept unknown badge types" testUnknownBadgeType
 
+proofOf :: Badge 'BCProof -> BBSProof
+proofOf (BadgeProof _ p _) = p
+
+proofInfo :: Badge 'BCProof -> BadgeInfo
+proofInfo (BadgeProof _ _ i) = i
+
 testFullWorkflow :: IO ()
 testFullWorkflow = do
   Right (sk, pk) <- bbsKeyGen
   drg <- C.newRandom
   mk <- generateMasterKey drg
-  let req = BadgeRequest {masterKey = mk, badgeType = BTSupporter, expiry = Just futureTime}
+  let req = BadgeRequest {masterKey = mk, badgeInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry = Just futureTime, badgeExtra = ""}}
   Just vreq <- verifyPayment (BPRedeemCode "TEST") req
   Right cred <- issueBadge sk pk vreq
-  let BadgeCredential {masterKey = mk'} = cred
+  let BadgeCredential mk' _ _ = cred
   mk' `shouldBe` mk
-  verifyBadgeSignature pk cred >>= (`shouldBe` True)
+  verifyCredential pk cred >>= (`shouldBe` True)
   Right badge <- generateBadgeProof pk cred (BBSPresHeader "nonce-1")
   verifyBadge pk badge >>= (`shouldBe` True)
   Right badge2 <- generateBadgeProof pk cred (BBSPresHeader "nonce-2")
   verifyBadge pk badge2 >>= (`shouldBe` True)
-  proof badge `shouldNotBe` proof badge2
+  proofOf badge `shouldNotBe` proofOf badge2
 
 testTamperedType :: IO ()
 testTamperedType = do
-  (pk, SupporterBadge {proof, presHeader, badgeExpiry}) <- issueBadgeProof BTSupporter (Just futureTime)
-  verifyBadge pk (SupporterBadge {proof, presHeader, badgeExpiry, badgeType = BTBusiness, badgeExtra = ""}) >>= (`shouldBe` False)
+  (pk, BadgeProof ph p info) <- issueBadgeProof BTSupporter (Just futureTime)
+  verifyBadge pk (BadgeProof ph p info {badgeType = BTBusiness}) >>= (`shouldBe` False)
 
 testTamperedExpiry :: IO ()
 testTamperedExpiry = do
-  (pk, SupporterBadge {proof, presHeader, badgeType}) <- issueBadgeProof BTSupporter (Just futureTime)
-  verifyBadge pk (SupporterBadge {proof, presHeader, badgeExpiry = Just pastTime, badgeType, badgeExtra = ""}) >>= (`shouldBe` False)
+  (pk, BadgeProof ph p info) <- issueBadgeProof BTSupporter (Just futureTime)
+  verifyBadge pk (BadgeProof ph p info {badgeExpiry = Just pastTime}) >>= (`shouldBe` False)
 
 testWrongKey :: IO ()
 testWrongKey = do
@@ -57,18 +65,18 @@ testWrongKey = do
 testExpiryCheck :: IO ()
 testExpiryCheck = do
   now <- getCurrentTime
-  (_, past) <- issueBadgeProof BTSupporter (Just pastTime)
-  mkBadgeStatus now True past `shouldBe` BSExpired
-  (_, future) <- issueBadgeProof BTSupporter (Just futureTime)
-  mkBadgeStatus now True future `shouldBe` BSActive
-  mkBadgeStatus now False future `shouldBe` BSFailed
+  let pastInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry = Just pastTime, badgeExtra = ""}
+      futureInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry = Just futureTime, badgeExtra = ""}
+  mkBadgeStatus now True pastInfo `shouldBe` BSExpired
+  mkBadgeStatus now True futureInfo `shouldBe` BSActive
+  mkBadgeStatus now False futureInfo `shouldBe` BSFailed
 
 testLifetimeBadge :: IO ()
 testLifetimeBadge = do
   now <- getCurrentTime
   (pk, badge) <- issueBadgeProof BTInvestor Nothing
   verifyBadge pk badge >>= (`shouldBe` True)
-  mkBadgeStatus now True badge `shouldBe` BSActive
+  mkBadgeStatus now True (proofInfo badge) `shouldBe` BSActive
 
 testUnknownBadgeType :: IO ()
 testUnknownBadgeType = do
@@ -83,12 +91,12 @@ futureTime = posixSecondsToUTCTime 4102444800 -- 2099-12-31
 pastTime :: UTCTime
 pastTime = posixSecondsToUTCTime 1577836800 -- 2020-01-01
 
-issueBadgeProof :: BadgeType -> Maybe UTCTime -> IO (BBSPublicKey, SupporterBadge)
+issueBadgeProof :: BadgeType -> Maybe UTCTime -> IO (BBSPublicKey, Badge 'BCProof)
 issueBadgeProof bt expiry = do
   Right (sk, pk) <- bbsKeyGen
   drg <- C.newRandom
   mk <- generateMasterKey drg
-  let vreq = VerifiedBadgeRequest BadgeRequest {masterKey = mk, badgeType = bt, expiry}
+  let vreq = VerifiedBadgeRequest BadgeRequest {masterKey = mk, badgeInfo = BadgeInfo {badgeType = bt, badgeExpiry = expiry, badgeExtra = ""}}
   Right cred <- issueBadge sk pk vreq
   Right badge <- generateBadgeProof pk cred (BBSPresHeader "test-nonce")
   pure (pk, badge)

tests/MobileTests.hs

@@ -32,7 +32,7 @@ import Foreign.Storable (peek)
 import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding)
 import JSONFixtures
 import Simplex.Chat
-import Simplex.Chat.Badges (BadgeRequest (..), BadgeType (..), generateMasterKey, verifyBadgeSignature)
+import Simplex.Chat.Badges (BadgeInfo (..), BadgeRequest (..), BadgeType (..), generateMasterKey, verifyCredential)
 import Simplex.Chat.Controller (ChatController (..), ChatDatabase (..))
 import Simplex.Chat.Mobile hiding (error)
 import Simplex.Chat.Mobile.Badges hiding (error)
@@ -321,9 +321,9 @@ testBadgeKeygenIssueCApi _ = do
   keyPair <- ffiResult =<< (peekCString =<< cChatBadgeKeygen)
   let BBSKeyPair {publicKey} = keyPair
   mk <- generateMasterKey g
-  let req = BadgeIssueReq {keyPair, request = BadgeRequest {masterKey = mk, badgeType = BTSupporter, expiry = Nothing}}
+  let req = BadgeIssueReq {keyPair, request = BadgeRequest {masterKey = mk, badgeInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry = Nothing, badgeExtra = ""}}}
   cred <- ffiResult =<< (peekCString =<< cChatBadgeIssue =<< newCString (LB.unpack (J.encode req)))
-  verifyBadgeSignature publicKey cred `shouldReturn` True
+  verifyCredential publicKey cred `shouldReturn` True
 
 -- Decode an FFI `BadgeResult` envelope, returning the result or failing on error.
 ffiResult :: FromJSON r => String -> IO r