Merge branch 'master' into ep/fix-async-race

src/Simplex/Chat.hs

@@ -29,6 +29,7 @@ import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime, nominalDay)
 import Simplex.Chat.Controller
+import Simplex.Chat.Badges (BBSPublicKeyStr (..))
 import Simplex.Chat.Library.Commands
 import Simplex.Chat.Operators
 import Simplex.Chat.Operators.Presets
@@ -65,6 +66,17 @@ defaultChatConfig =
             tbqSize = 1024
           },
       chatVRange = supportedChatVRange,
+      badgePublicKeys =
+        M.fromList
+          [ (1, toBBSPublicKey "mW_5Zp1wHnXDF56wOZwFcRjGrf0GLLsfyymIQDqYoWfjfvS7oQWSfi7hH65N8JhuE9x8wbKXHidnQLO4GnOSMP_bRKUMH1qIzv5SQKFHNM8G4PaWcTcri8iZLc-3xhSI"),
+            (2, toBBSPublicKey "odGCB7uVDXTURsHgSvSciByV4Q3-3ZvEB8myDsDJqm-PwOYc5-At36uc7n_pyUDxEQEHr9i4RJgFih2FSArPW-EQBXNPNf4wTtA0znn74qLEGc4fh9pVYPEIm_ZGbnsJ"),
+            (3, toBBSPublicKey "txkT2003WMjc43KvYvPKEcR970NLmw5UZY51eUqgk91sgp53idt1HTlKYvnrEttJDFMlctYf1-bpri0e9DhBQ-xk1J4WoLN2uif_1OcA1pGCobpk9lwtsq1Idek4biy0"),
+            (4, toBBSPublicKey "q_YzegihaLYrEm9z3cAghsfDGNZfXuEpQGMJERJQS4M0Szl4gvSC_fV_muKc3NIMA_8iYuBN8qyvb5U55RctCRn3kleFQ4sqf-WBgoydX6UVo7BsYcUbXWWEFZXlOGIH"),
+            (5, toBBSPublicKey "oqymHASH_okefShrnz4HnTooUNlE1WoDRnSrgd0bTCpOacgJWBsMpwZpdmYlX-vQAKAC_zmI4VdKoOznnhW-sdUXZw6bthCi5JYjGxCR1Co27i1tix5UXCTbR5Jp901-"),
+            (6, toBBSPublicKey "kDqaB6zKSRp_97QPFj5JPDlo0vzfSTLSp9goFx1qajv4q4H6dR6BbkmWZ4xx_9Q2AxmcpqcV0ethz1OH-Jk_Sz2J1mIz1PUVM9LkdLhi_PNtqhezzO5dbVs-HJ1fNqe6"),
+            (7, toBBSPublicKey "rl36D5mg2N3NmmEybxE_RBeU9YZ_zeXNPfp7ZMLtUEuf2Mo4OQM_Up1v5rX_IqICD-AIJcuyptEBsELx_PJQzpmiNuG5I4cWO6HkRKtc6fVFvgZMrDJjaascPd1CIyxX"),
+            (8, toBBSPublicKey "joM3Bnt7JPt5JiwQwERHGjro2iVZ0mPD_clUh4hzkhxvbjuFrWuTmfSNA8PWBqGKEGNl13aRi1pMf6yY14E27c5C71JxWm7T-rZaBrGPEUWifhD-qidWuf3PU7KJCCWd")
+          ],
       confirmMigrations = MCConsole,
       -- this property should NOT use operator = Nothing
       -- non-operator servers can be passed via options
@@ -116,6 +128,7 @@ defaultChatConfig =
       highlyAvailable = False,
       deliveryWorkerDelay = 0,
       deliveryBucketSize = 10000,
+      webPreviewConfig = Nothing,
       channelSubscriberRole = GRObserver,
       relayChecksInterval = 15 * 60, -- 15 minutes
       relayInactiveTTL = nominalDay,
@@ -140,11 +153,11 @@ newChatController
   ChatDatabase {chatStore, agentStore}
   user
   cfg@ChatConfig {agentConfig = aCfg, presetServers, inlineFiles, deviceNameForRemote, confirmMigrations}
-  ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, simpleNetCfg, logLevel, logConnections, logServerHosts, logFile, tbqSize, deviceName, highlyAvailable, yesToUpMigrations}, optFilesFolder, optTempDirectory, showReactions, allowInstantFiles, autoAcceptFileSize}
+  ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, simpleNetCfg, logLevel, logConnections, logServerHosts, logFile, tbqSize, deviceName, webPreviewConfig, highlyAvailable, yesToUpMigrations}, optFilesFolder, optTempDirectory, showReactions, allowInstantFiles, autoAcceptFileSize}
   backgroundMode = do
     let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
         confirmMigrations' = if confirmMigrations == MCConsole && yesToUpMigrations then MCYesUp else confirmMigrations
-        config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, presetServers = presetServers', inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable, confirmMigrations = confirmMigrations'}
+        config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, presetServers = presetServers', inlineFiles = inlineFiles', autoAcceptFileSize, webPreviewConfig, highlyAvailable, confirmMigrations = confirmMigrations'}
     randomPresetServers <- chooseRandomServers presetServers'
     let rndSrvs = L.toList randomPresetServers
         operatorWithId (i, op) = (\o -> o {operatorId = DBEntityId i}) <$> pOperator op
@@ -182,6 +195,7 @@ newChatController
         deliveryJobWorkers <- TM.emptyIO
         relayRequestWorkers <- TM.emptyIO
         relayGroupLinkChecksAsync <- newTVarIO Nothing
+        webPreviewState <- forM webPreviewConfig $ \_ -> newWebPreviewState
         chatRelayTests <- TM.emptyIO
         expireCIThreads <- TM.emptyIO
         expireCIFlags <- TM.emptyIO
@@ -226,6 +240,7 @@ newChatController
               deliveryJobWorkers,
               relayRequestWorkers,
               relayGroupLinkChecksAsync,
+              webPreviewState,
               chatRelayTests,
               expireCIThreads,
               expireCIFlags,

src/Simplex/Chat/Badges.hs

@@ -0,0 +1,414 @@
+{-# 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 (..),
+    BadgeCredential (..),
+    BadgeProof (..),
+    LocalBadge (..),
+    JSONBadge (..),
+    BBSPublicKeyStr (..),
+    localBadgeInfo,
+    localBadgeStatus,
+    maxXFTPFileSize,
+    maxFileSizeSupporter,
+    maxFileSizeLegend,
+    BadgePresHeaderTag (..),
+    BadgePresHeader (..),
+    BadgePurchase (..),
+    BadgeMasterKey (..),
+    BadgeRequest (..),
+    VerifiedBadgeRequest (..),
+    bbsBadgeHeader,
+    generateMasterKey,
+    verifyPayment,
+    issueBadge,
+    verifyCredential,
+    generateBadgeProof,
+    badgeProof,
+    verifyBadge,
+    verifyBadge_,
+    mkBadgeStatus,
+    BadgeRow,
+    badgeToRow,
+    localBadgeToRow,
+    rowToBadge,
+  ) where
+
+import Control.Concurrent.STM
+import Crypto.Random (ChaChaDRG)
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson.TH as JQ
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Either (fromRight)
+import Data.Int (Int64)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.String
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, nominalDay)
+import Simplex.FileTransfer.Description (gb, maxFileSize)
+import Simplex.Messaging.Agent.Store.DB (Binary (..), 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)
+#if defined(dbPostgres)
+import Database.PostgreSQL.Simple.FromField (FromField (..))
+import Database.PostgreSQL.Simple.ToField (ToField (..))
+#else
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
+#endif
+
+-- Badge type
+
+data BadgeType
+  = BTSupporter
+  | BTLegend
+  | BTInvestor
+  | BTUnknown Text
+  deriving (Eq, Show)
+
+instance TextEncoding BadgeType where
+  textEncode = \case
+    BTSupporter -> "supporter"
+    BTLegend -> "legend"
+    BTInvestor -> "investor"
+    BTUnknown tag -> tag
+  textDecode s = Just $ case s of
+    "supporter" -> BTSupporter
+    "legend" -> BTLegend
+    "investor" -> BTInvestor
+    tag -> BTUnknown tag
+
+instance ToJSON BadgeType where
+  toJSON = textToJSON
+  toEncoding = textToEncoding
+
+instance FromJSON BadgeType where
+  parseJSON = textParseJSON "BadgeType"
+
+-- Badge status
+
+data BadgeStatus = BSActive | BSExpired | BSExpiredOld | BSFailed | BSUnknownKey
+  deriving (Eq, Show)
+
+-- Disclosed badge content (BBS messages 1, 2, 3)
+
+data BadgeInfo = BadgeInfo
+  { badgeType :: BadgeType,
+    badgeExpiry :: Maybe UTCTime,
+    badgeExtra :: Text
+  }
+  deriving (Eq, Show)
+
+-- a badge expired longer than this ago is BSExpiredOld and is not shown in the UI
+badgeOldInterval :: NominalDiffTime
+badgeOldInterval = 31 * nominalDay
+
+-- the verification outcome of a received proof: Just True = verified, Just False = failed,
+-- Nothing = the proof's key index is not among this app version's configured keys (BSUnknownKey).
+mkBadgeStatus :: UTCTime -> Maybe Bool -> BadgeInfo -> BadgeStatus
+mkBadgeStatus now verified BadgeInfo {badgeExpiry} = case verified of
+  Nothing -> BSUnknownKey
+  Just False -> BSFailed
+  Just True -> case badgeExpiry of
+    Just e
+      | addUTCTime badgeOldInterval e < now -> BSExpiredOld
+      | e < now -> BSExpired
+    _ -> BSActive
+
+-- A badge credential (own, secret) and a proof (a presentation) are independent records.
+-- badgeKeyIdx is the issuer key index: it tells verifiers which configured key to use.
+-- Only proofs ride the wire (in a profile); credentials come from the badge service. Neither is
+-- ever serialized as a sum - each travels as its own record, so the JSON carries no credential/proof tag.
+
+data BadgeCredential = BadgeCredential
+  { badgeKeyIdx :: Int,
+    masterKey :: BadgeMasterKey,
+    signature :: BBSSignature,
+    badgeInfo :: BadgeInfo
+  }
+  deriving (Eq, Show)
+
+data BadgeProof = BadgeProof
+  { badgeKeyIdx :: Int,
+    presHeader :: BBSPresHeader,
+    proof :: BBSProof,
+    badgeInfo :: BadgeInfo
+  }
+  deriving (Eq, Show)
+
+-- Local badge: a stored badge plus its display status (the in-memory sum; never serialized as a sum).
+--   OwnBadge   - the user's own credential (loaded from the DB).
+--   PeerBadge  - a verified peer proof (from the DB, or received over the wire).
+--   ShownBadge - decoded from a crypto-free profile JSON for display only: no crypto, so it cannot be sent.
+data LocalBadge
+  = OwnBadge BadgeCredential BadgeStatus
+  | PeerBadge BadgeProof BadgeStatus
+  | ShownBadge BadgeInfo BadgeStatus
+  deriving (Eq, Show)
+
+localBadgeInfo :: LocalBadge -> BadgeInfo
+localBadgeInfo = \case
+  OwnBadge BadgeCredential {badgeInfo} _ -> badgeInfo
+  PeerBadge BadgeProof {badgeInfo} _ -> badgeInfo
+  ShownBadge i _ -> i
+
+localBadgeStatus :: LocalBadge -> BadgeStatus
+localBadgeStatus = \case
+  OwnBadge _ st -> st
+  PeerBadge _ st -> st
+  ShownBadge _ st -> st
+
+-- XFTP file size limit raised by an active badge: a legend badge to 5GB, any other to 2GB, otherwise the default.
+maxFileSizeSupporter :: Int64
+maxFileSizeSupporter = gb 2
+
+maxFileSizeLegend :: Int64
+maxFileSizeLegend = gb 5
+
+maxXFTPFileSize :: Maybe LocalBadge -> Int64
+maxXFTPFileSize = \case
+  Just b | localBadgeStatus b == BSActive -> case badgeType (localBadgeInfo b) of
+    BTLegend -> maxFileSizeLegend
+    _ -> maxFileSizeSupporter
+  _ -> maxFileSize
+
+-- Presentation header: a tag char + payload. PHTest is unbound - a fresh random nonce per
+-- presentation, not bound to any context; the 'T' tag marks it so master rejects it.
+-- PHUnknown is the forward-compat catch-all for tags this version does not interpret.
+
+data BadgePresHeaderTag = PHTestTag | PHUnknownTag Char
+
+instance StrEncoding BadgePresHeaderTag where
+  strEncode = B.singleton . \case
+    PHTestTag -> 'T'
+    PHUnknownTag c -> c
+  strP = tag <$> A.anyChar
+    where
+      tag = \case
+        'T' -> PHTestTag
+        c -> PHUnknownTag c
+
+data BadgePresHeader
+  = PHTest ByteString
+  | PHUnknown Char ByteString
+
+instance StrEncoding BadgePresHeader where
+  strEncode = \case
+    PHTest nonce -> strEncode PHTestTag <> nonce
+    PHUnknown c b -> strEncode (PHUnknownTag c) <> b
+  strP =
+    strP >>= \case
+      PHTestTag -> PHTest <$> A.takeByteString
+      PHUnknownTag c -> PHUnknown c <$> A.takeByteString
+
+-- v6.5.x accepts both; v7 will reject PHTest/PHUnknown
+badgePresHeaderAccepted :: BadgePresHeader -> Bool
+badgePresHeaderAccepted = \case
+  PHTest _ -> True
+  PHUnknown _ _ -> True
+
+-- Payment proof
+
+data BadgePurchase
+  = BPAppleReceipt Text
+  | BPGoogleReceipt Text
+  | BPStripeSession
+  | BPRedeemCode Text
+  deriving (Eq, Show)
+
+-- Master key
+
+newtype BadgeMasterKey = BadgeMasterKey ByteString
+  deriving newtype (Eq, Show, StrEncoding)
+
+instance ToJSON BadgeMasterKey where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+instance FromJSON BadgeMasterKey where
+  parseJSON = strParseJSON "BadgeMasterKey"
+
+generateMasterKey :: TVar ChaChaDRG -> IO BadgeMasterKey
+generateMasterKey drg = BadgeMasterKey <$> atomically (C.randomBytes 32 drg)
+
+-- Workflow types
+
+data BadgeRequest = BadgeRequest
+  { masterKey :: BadgeMasterKey,
+    badgeInfo :: BadgeInfo
+  }
+  deriving (Show)
+
+newtype VerifiedBadgeRequest = VerifiedBadgeRequest BadgeRequest
+  deriving (Show)
+
+-- Constants
+
+bbsBadgeHeader :: BBSHeader
+bbsBadgeHeader = BBSHeader "SimpleX badges v1"
+
+bbsBadgeMessageCount :: Int
+bbsBadgeMessageCount = 4
+
+bbsBadgeDisclosedIndexes :: [Int]
+bbsBadgeDisclosedIndexes = [1, 2, 3]
+
+-- Message encoding
+
+encodeExpiry :: Maybe UTCTime -> ByteString
+encodeExpiry = maybe "lifetime" strEncode
+
+badgeMessages :: BadgeMasterKey -> BadgeInfo -> [ByteString]
+badgeMessages (BadgeMasterKey ms) info = ms : badgeInfoMessages info
+
+badgeInfoMessages :: BadgeInfo -> [ByteString]
+badgeInfoMessages BadgeInfo {badgeType, badgeExpiry, badgeExtra} =
+  [encodeExpiry badgeExpiry, encodeUtf8 (textEncode badgeType), encodeUtf8 badgeExtra]
+
+-- Payment verification (stub - always passes)
+
+verifyPayment :: BadgePurchase -> BadgeRequest -> IO (Maybe VerifiedBadgeRequest)
+verifyPayment _payment req = pure $ Just (VerifiedBadgeRequest req)
+
+-- Server-side: issue a badge credential, recording which issuer key signed it
+
+issueBadge :: Int -> BBSSecretKey -> VerifiedBadgeRequest -> IO (Either String BadgeCredential)
+issueBadge keyIdx sk (VerifiedBadgeRequest BadgeRequest {masterKey, badgeInfo})
+  | badgeExtra badgeInfo /= "" = pure $ Left "badgeExtra must be empty (reserved)"
+  | otherwise = fmap (\sig -> BadgeCredential keyIdx masterKey sig badgeInfo) <$> bbsSign sk bbsBadgeHeader (badgeMessages masterKey badgeInfo)
+
+-- Client-side: verify the credential received from server
+
+verifyCredential :: BBSPublicKey -> BadgeCredential -> IO Bool
+verifyCredential pk (BadgeCredential _ masterKey signature badgeInfo) =
+  bbsVerify pk signature bbsBadgeHeader (badgeMessages masterKey badgeInfo)
+
+-- Client-side: generate a proof for a contact/group; the proof carries the credential's key index
+
+generateBadgeProof :: BBSPublicKey -> BadgeCredential -> BBSPresHeader -> IO (Either String BadgeProof)
+generateBadgeProof pk (BadgeCredential keyIdx masterKey signature badgeInfo) ph =
+  fmap (\p -> BadgeProof keyIdx ph p badgeInfo) <$> bbsProofGen pk signature bbsBadgeHeader ph bbsBadgeDisclosedIndexes (badgeMessages masterKey badgeInfo)
+
+-- application-level proof generation with a semantic presentation header
+badgeProof :: BBSPublicKey -> BadgeCredential -> BadgePresHeader -> IO (Either String BadgeProof)
+badgeProof pk cred ph = generateBadgeProof pk cred (BBSPresHeader $ strEncode ph)
+
+-- Recipient-side: verify a badge proof with the configured key its index points to.
+-- Nothing means the key index is not in the configured keys (this app version can't verify it).
+
+verifyBadge :: Map Int BBSPublicKey -> BadgeProof -> IO (Maybe Bool)
+verifyBadge keys b@(BadgeProof keyIdx _ _ _) = case M.lookup keyIdx keys of
+  Nothing -> pure Nothing
+  Just pk -> Just <$> verifyBadgeWith pk b
+
+verifyBadgeWith :: BBSPublicKey -> BadgeProof -> IO Bool
+verifyBadgeWith pk (BadgeProof _ ph@(BBSPresHeader phBytes) proof badgeInfo)
+  | either (const False) badgePresHeaderAccepted (strDecode phBytes) =
+      bbsProofVerify pk proof bbsBadgeHeader ph bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeInfoMessages badgeInfo)
+  | otherwise = pure False
+
+verifyBadge_ :: Map Int BBSPublicKey -> Maybe BadgeProof -> IO (Maybe Bool)
+verifyBadge_ keys = maybe (pure (Just False)) (verifyBadge keys)
+
+-- DB
+
+instance FromField BadgeType where fromField = fromTextField_ textDecode
+
+instance ToField BadgeType where toField = toField . textEncode
+
+-- (proof, pres_header, expiry, type, verified, extra, master_key, signature, key_idx) - binary columns wrapped in Binary (BLOB/bytea)
+type BadgeRow = (Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe UTCTime, Maybe Text, Maybe BoolInt, Maybe Text, Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe Int)
+
+-- receive/store sites have a wire proof + a computed verification outcome;
+-- the status here only drives the stored verified flag, the display status is recomputed on load
+badgeToRow :: Maybe BadgeProof -> Maybe Bool -> BadgeRow
+badgeToRow badge verified = localBadgeToRow $ (`PeerBadge` st) <$> badge
+  where
+    st = case verified of
+      Just True -> BSActive
+      Just False -> BSFailed
+      Nothing -> BSUnknownKey
+
+localBadgeToRow :: Maybe LocalBadge -> BadgeRow
+localBadgeToRow (Just lb) = case lb of
+  OwnBadge (BadgeCredential idx (BadgeMasterKey mk) (BBSSignature sg) BadgeInfo {badgeType, badgeExpiry, badgeExtra}) st ->
+    (Nothing, Nothing, badgeExpiry, Just (textEncode badgeType), verifiedField st, Just badgeExtra, Just (Binary mk), Just (Binary sg), Just idx)
+  PeerBadge (BadgeProof idx (BBSPresHeader ph) (BBSProof p) BadgeInfo {badgeType, badgeExpiry, badgeExtra}) st ->
+    (Just (Binary p), Just (Binary ph), badgeExpiry, Just (textEncode badgeType), verifiedField st, Just badgeExtra, Nothing, Nothing, Just idx)
+  ShownBadge BadgeInfo {badgeType, badgeExpiry, badgeExtra} st ->
+    (Nothing, Nothing, badgeExpiry, Just (textEncode badgeType), verifiedField st, Just badgeExtra, Nothing, Nothing, Nothing)
+  where
+    verifiedField st = case st of
+      BSFailed -> Just (BI False)
+      BSUnknownKey -> Nothing
+      _ -> Just (BI True)
+localBadgeToRow Nothing = (Nothing, Nothing, Nothing, Nothing, Just (BI False), Nothing, Nothing, Nothing, Nothing)
+
+rowToBadge :: UTCTime -> BadgeRow -> Maybe LocalBadge
+rowToBadge now (p_, ph_, badgeExpiry, type_, verified_, extra_, mk_, sg_, idx_) = do
+  btText <- type_
+  bt <- textDecode btText
+  let info = BadgeInfo {badgeType = bt, badgeExpiry, badgeExtra = maybe "" id extra_}
+      -- NULL badge_verified means the key index was unknown when stored (Nothing)
+      st = mkBadgeStatus now (unBI <$> verified_) info
+  case (mk_, sg_, p_, ph_, idx_) of
+    (Just (Binary mk), Just (Binary sg), _, _, Just idx) -> Just $ OwnBadge (BadgeCredential idx (BadgeMasterKey mk) (BBSSignature sg) info) st
+    (_, _, Just (Binary p), Just (Binary ph), Just idx) -> Just $ PeerBadge (BadgeProof idx (BBSPresHeader ph) (BBSProof p) info) st
+    _ -> Just $ ShownBadge info st
+
+-- JSON
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "BS") ''BadgeStatus)
+
+$(JQ.deriveJSON defaultJSON ''BadgeInfo)
+
+$(JQ.deriveJSON defaultJSON ''BadgeRequest)
+
+-- Each record is a plain JSON object (defaultJSON), platform-independent and with no credential/proof
+-- tag - the context (a proof in a profile, a credential from the service) determines which it is.
+
+$(JQ.deriveJSON defaultJSON ''BadgeCredential)
+
+$(JQ.deriveJSON defaultJSON ''BadgeProof)
+
+-- LocalBadge is sent to the UI/clients WITHOUT crypto - only disclosed info + status. The credential/proof
+-- bytes stay core-side. FromJSON reconstructs a display-only badge (empty proof) for read-only consumers
+-- (remote host, UI echoes); the authoritative badge is loaded from the DB (rowToBadge), never from this JSON.
+data JSONBadge = JSONBadge {badge :: BadgeInfo, status :: BadgeStatus}
+
+$(JQ.deriveJSON defaultJSON ''JSONBadge)
+
+instance ToJSON LocalBadge where
+  toJSON lb = toJSON $ JSONBadge (localBadgeInfo lb) (localBadgeStatus lb)
+  toEncoding lb = toEncoding $ JSONBadge (localBadgeInfo lb) (localBadgeStatus lb)
+
+instance FromJSON LocalBadge where
+  parseJSON v = do
+    JSONBadge info st <- parseJSON v
+    pure $ ShownBadge info st
+
+newtype BBSPublicKeyStr = BBSPublicKeyStr {toBBSPublicKey :: BBSPublicKey}
+
+instance IsString BBSPublicKeyStr where
+  fromString = BBSPublicKeyStr . fromRight (error "bad base64 in BBSPublicKey") . strDecode . B.pack

src/Simplex/Chat/Badges/CLI.hs

@@ -0,0 +1,87 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Offline operator tooling for supporter badges, invoked as `simplex-chat badge ...`.
+--   keygen     - the issuer keypair: the "secret" signs, the "public" goes into the app config.
+--   master-key - the user's master secret (their unlinkability secret; generated client-side in the real flow).
+--   sign       - bind a user master secret to a badge with the issuer secret, printed as one-line JSON for `/badge add`.
+module Simplex.Chat.Badges.CLI (runBadgeCommand) where
+
+import qualified Data.Aeson as J
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as LB
+import qualified Data.Text as T
+import Data.Time.Clock (UTCTime)
+import Data.Time.Format (defaultTimeLocale, parseTimeM)
+import Options.Applicative
+import Simplex.Chat.Badges
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.BBS (BBSPublicKey (..), BBSSecretKey (..), bbsKeyGen)
+import Simplex.Messaging.Encoding.String (strDecode, strEncode, textDecode)
+import System.Exit (die)
+
+bbsSecretLen :: Int
+bbsSecretLen = 32
+
+data BadgeCommand
+  = Keygen
+  | MasterKey
+  | Sign Int BBSSecretKey BadgeMasterKey BadgeType (Maybe UTCTime)
+
+runBadgeCommand :: [String] -> IO ()
+runBadgeCommand args =
+  handleParseResult (execParserPure defaultPrefs badgeInfo args) >>= \case
+    Keygen -> keygen
+    MasterKey -> genMasterKey
+    Sign keyIdx sk ms badgeType badgeExpiry -> sign keyIdx sk ms badgeType badgeExpiry
+  where
+    badgeInfo = info (helper <*> hsubparser badgeCmd) fullDesc
+    badgeCmd = command "badge" (info (helper <*> badgeCommandP) (progDesc "SimpleX supporter badge tooling"))
+
+badgeCommandP :: Parser BadgeCommand
+badgeCommandP =
+  hsubparser $
+    command "keygen" (info (pure Keygen) (progDesc "generate an issuer keypair (issuer secret + public, base64url)"))
+      <> command "master-key" (info (pure MasterKey) (progDesc "generate a user master secret (base64url)"))
+      <> command "sign" (info signP (progDesc "sign a badge for a user master secret, printed as one-line JSON"))
+  where
+    signP =
+      Sign
+        <$> option auto (long "key-idx" <> metavar "KEY_IDX" <> help "index of the issuer key in the app config")
+        <*> option (eitherReader secretR) (long "secret" <> metavar "ISSUER_SECRET" <> help "issuer secret from keygen (base64url)")
+        <*> option (eitherReader (strDecode . B.pack)) (long "master" <> metavar "MASTER" <> help "user master secret from master-key (base64url)")
+        <*> option (eitherReader badgeTypeR) (long "type" <> metavar "TYPE" <> help "badge type (supporter, legend, investor)")
+        <*> option (eitherReader expireR) (long "expire" <> metavar "lifetime|YYYY-MM-DD" <> help "expiry date, or 'lifetime'")
+    secretR s = do
+      sk@(BBSSecretKey b) <- strDecode (B.pack s)
+      if B.length b == bbsSecretLen
+        then Right sk
+        else Left "bad issuer secret - use the 'secret' value from keygen"
+    badgeTypeR = maybe (Left "invalid badge type") Right . textDecode . T.pack
+    expireR = \case
+      "lifetime" -> Right Nothing
+      s -> maybe (Left "use 'lifetime' or YYYY-MM-DD") (Right . Just) $ parseTimeM True defaultTimeLocale "%Y-%m-%d" s
+
+keygen :: IO ()
+keygen =
+  bbsKeyGen >>= \case
+    Left e -> die $ "keygen failed: " <> e
+    Right (BBSPublicKey pk, BBSSecretKey sk) -> do
+      B.putStrLn $ "secret " <> strEncode sk
+      B.putStrLn $ "public " <> strEncode pk
+
+genMasterKey :: IO ()
+genMasterKey = do
+  drg <- C.newRandom
+  mk <- generateMasterKey drg
+  B.putStrLn $ strEncode mk
+
+sign :: Int -> BBSSecretKey -> BadgeMasterKey -> BadgeType -> Maybe UTCTime -> IO ()
+sign keyIdx secretKey masterKey badgeType badgeExpiry = do
+  let req = VerifiedBadgeRequest (BadgeRequest {masterKey, badgeInfo = BadgeInfo {badgeType, badgeExpiry, badgeExtra = ""}} :: BadgeRequest)
+  issueBadge keyIdx secretKey req >>= \case
+    Left e -> die $ "sign failed: " <> e
+    -- single-line JSON (master secret + signature + info), pasted into the app via `/badge add`
+    Right cred -> LB.putStrLn $ J.encode cred

src/Simplex/Chat/Controller.hs

@@ -39,6 +39,7 @@ import Data.Char (ord)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
+import Data.Set (Set)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe)
 import Data.String
@@ -81,6 +82,8 @@ import Simplex.Messaging.Agent.Store.DB (SQLError)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Client (HostMode (..), SMPProxyFallback (..), SMPProxyMode (..), SMPWebPortServers (..), SocksMode (..))
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Chat.Badges (BadgeCredential)
+import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Crypto.Ratchet (PQEncryption)
@@ -137,6 +140,8 @@ coreVersionInfo simplexmqCommit =
 data ChatConfig = ChatConfig
   { agentConfig :: AgentConfig,
     chatVRange :: VersionRangeChat,
+    -- issuer public keys by index: credentials and proofs name the key that signed them, for rotation
+    badgePublicKeys :: Map Int BBSPublicKey,
     confirmMigrations :: MigrationConfirmation,
     presetServers :: PresetServers,
     shortLinkPresetServers :: NonEmpty SMPServer,
@@ -158,6 +163,7 @@ data ChatConfig = ChatConfig
     ciExpirationInterval :: Int64, -- microseconds
     deliveryWorkerDelay :: Int64, -- microseconds
     deliveryBucketSize :: Int,
+    webPreviewConfig :: Maybe WebPreviewConfig,
     channelSubscriberRole :: GroupMemberRole, -- TODO [relays] starting role should be communicated in protocol from owner to relays
     relayChecksInterval :: NominalDiffTime,
     relayInactiveTTL :: NominalDiffTime,
@@ -169,6 +175,49 @@ data ChatConfig = ChatConfig
     chatHooks :: ChatHooks
   }
 
+data WebPreviewConfig = WebPreviewConfig
+  { webDomain :: Text,
+    webJsonDir :: FilePath,
+    webCorsFile :: Maybe FilePath,
+    webUpdateInterval :: Int, -- seconds
+    webPreviewItemCount :: Int
+  }
+
+data PublishableGroup = PublishableGroup
+  { pgFileName :: FilePath,
+    pgCorsEntry :: Maybe (Text, CorsOrigin)
+  }
+
+data CorsOrigin = CorsAny | CorsOrigins [Text]
+  deriving (Show)
+
+data WebPreviewState = WebPreviewState
+  { publishableGroupIds :: TVar (Map Int64 PublishableGroup),
+    priorityRender :: TQueue Int64,
+    filesToRemove :: TQueue FilePath,
+    corsNeeded :: TVar Bool,
+    routinePending :: TVar (Set Int64),
+    wakeSignal :: TMVar (),
+    webPreviewWorkerAsync :: TVar (Maybe (Async ()))
+  }
+
+newWebPreviewState :: IO WebPreviewState
+newWebPreviewState = do
+  publishableGroupIds <- newTVarIO mempty
+  priorityRender <- newTQueueIO
+  filesToRemove <- newTQueueIO
+  corsNeeded <- newTVarIO False
+  routinePending <- newTVarIO mempty
+  wakeSignal <- newEmptyTMVarIO
+  webPreviewWorkerAsync <- newTVarIO Nothing
+  pure WebPreviewState {publishableGroupIds, priorityRender, filesToRemove, corsNeeded, routinePending, wakeSignal, webPreviewWorkerAsync}
+
+-- | Builds the read-only context threaded through store functions from chat config.
+-- The single construction point, so new store-wide config (e.g. server keys) is added in one place.
+mkStoreCxt :: ChatConfig -> StoreCxt
+mkStoreCxt ChatConfig {chatVRange, badgePublicKeys} = StoreCxt chatVRange badgePublicKeys
+{-# INLINE mkStoreCxt #-}
+
 data RandomAgentServers = RandomAgentServers
   { smpServers :: NonEmpty (ServerCfg 'PSMP),
     xftpServers :: NonEmpty (ServerCfg 'PXFTP)
@@ -256,6 +305,7 @@ data ChatController = ChatController
     deliveryJobWorkers :: TMap DeliveryWorkerKey Worker,
     relayRequestWorkers :: TMap Int Worker, -- single global worker with key 1 is used to fit into existing worker management framework
     relayGroupLinkChecksAsync :: TVar (Maybe (Async ())),
+    webPreviewState :: Maybe WebPreviewState,
     chatRelayTests :: TMap ConnId RelayTest,
     expireCIThreads :: TMap UserId (Maybe (Async ())),
     expireCIFlags :: TMap UserId Bool,
@@ -545,6 +595,7 @@ data ChatCommand
   | ShowGroupProfile GroupName
   | UpdateGroupDescription GroupName (Maybe Text)
   | ShowGroupDescription GroupName
+  | SetPublicGroupAccess GroupName PublicGroupAccess
   | CreateGroupLink GroupName GroupMemberRole
   | GroupLinkMemberRole GroupName GroupMemberRole
   | DeleteGroupLink GroupName
@@ -570,6 +621,7 @@ data ChatCommand
   | SetBotCommands [ChatBotCommand]
   | UpdateProfile ContactName (Maybe Text) -- UserId (not used in UI)
   | UpdateProfileImage (Maybe ImageData) -- UserId (not used in UI)
+  | AddBadge BadgeCredential -- attach an issued badge credential (testing; credential from `simplex-chat badge sign`)
   | ShowProfileImage
   | SetUserFeature AChatFeature FeatureAllowed -- UserId (not used in UI)
   | SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed)

src/Simplex/Chat/Core.hs

@@ -140,7 +140,7 @@ createActiveUser cc CoreChatOpts {chatRelay} = \case
         displayName <- T.pack <$> withPrompt "display name" getLine
         createUser loop False $ mkProfile displayName
   where
-    mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing}
+    mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing}
     createUser onError clientService p =
       execChatCommand' (CreateActiveUser NewUser {profile = Just p, pastTimestamp = False, userChatRelay = BoolDef chatRelay, clientService = BoolDef clientService}) 0 `runReaderT` cc >>= \case
         Right (CRActiveUser user) -> pure user

src/Simplex/Chat/Help.hs

@@ -187,8 +187,6 @@ contactsHelpInfo =
       indent <> highlight "/verify @<name>          " <> " - clear security code verification",
       indent <> highlight "/info @<name>            " <> " - info about contact connection",
       indent <> highlight "/switch @<name>          " <> " - switch receiving messages to another SMP relay",
-      indent <> highlight "/pq @<name> on/off       " <> " - [BETA] toggle quantum resistant / standard e2e encryption for a contact",
-      indent <>           "                         " <> "   (both have to enable for quantum resistance)",
       "",
       green "Contact chat preferences:",
       indent <> highlight "/set voice @<name> yes/no/always   " <> " - allow/prohibit voice messages with the contact",
@@ -324,16 +322,13 @@ settingsInfo =
   map
     styleMarkdown
     [ green "Chat settings:",
-      indent <> highlight "/pq on/off               " <> " - [BETA] toggle quantum resistant / standard e2e encryption for the new contacts",
       indent <> highlight "/network                 " <> " - show / set network access options",
       indent <> highlight "/smp                     " <> " - show / set configured SMP servers",
       indent <> highlight "/xftp                    " <> " - show / set configured XFTP servers",
       indent <> highlight "/info <contact>          " <> " - information about contact connection",
       indent <> highlight "/info #<group> <member>  " <> " - information about member connection",
       indent <> highlight "/(un)mute <contact>      " <> " - (un)mute contact, the last messages can be printed with /tail command",
-      indent <> highlight "/(un)mute #<group>       " <> " - (un)mute group",
-      indent <> highlight "/get stats               " <> " - get usage statistics",
-      indent <> highlight "/reset stats             " <> " - reset usage statistics"
+      indent <> highlight "/(un)mute #<group>       " <> " - (un)mute group"
     ]
 
 databaseHelpInfo :: [StyledString]

src/Simplex/Chat/Markdown.hs

@@ -18,6 +18,7 @@ import Control.Monad
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as JQ
+import qualified Data.Attoparsec.ByteString.Char8 as AB
 import Data.Attoparsec.Text (Parser)
 import qualified Data.Attoparsec.Text as A
 import Data.ByteString.Char8 (ByteString)
@@ -191,6 +192,16 @@ isLink = \case
 hasLinks :: MarkdownList -> Bool
 hasLinks = any $ \(FormattedText f _) -> maybe False isLink f
 
+hasObfuscatedSimplexLink :: Text -> Bool
+hasObfuscatedSimplexLink t =
+  fromRight False $ AB.parseOnly findLinkP $ encodeUtf8 $ T.filter (not . isSpace) t
+  where
+    findLinkP = do
+      AB.skipWhile (\c -> c /= 's' && c /= 'h') -- links start only with "simplex:" or "https://"
+      (True <$ (strP :: AB.Parser AConnectionLink))
+        <|> (AB.anyChar *> findLinkP)
+        <|> pure False
+
 markdownP :: Parser Markdown
 markdownP = mconcat <$> A.many' fragmentP
   where

src/Simplex/Chat/Messages/Batch.hs

@@ -24,7 +24,6 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as B
 import Data.Char (ord)
 import Data.Function (on)
-import Data.Foldable (foldr')
 import Data.List (foldl', sortBy)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
@@ -79,15 +78,15 @@ batchMessages mode maxLen = addBatch . foldr addToBatch ([], [], [], 0, 0)
           let encoded = encodeBatch mode bodies
            in Right (MsgBatch encoded msgs) : batches
 
--- | Batches delivery tasks into (batch, accepted, large).
+-- | Batches delivery tasks into (batch if any task was accepted, accepted, large).
 -- Always uses binary batch format for relay groups.
-batchDeliveryTasks1 :: VersionRangeChat -> Int -> NonEmpty MessageDeliveryTask -> (ByteString, [MessageDeliveryTask], [MessageDeliveryTask])
+batchDeliveryTasks1 :: VersionRangeChat -> Int -> NonEmpty MessageDeliveryTask -> (Maybe ByteString, [MessageDeliveryTask], [MessageDeliveryTask])
 batchDeliveryTasks1 _vr maxLen = toResult . foldl' addToBatch ([], [], [], 0, 0) . L.toList
   where
     addToBatch :: ([ByteString], [MessageDeliveryTask], [MessageDeliveryTask], Int, Int) -> MessageDeliveryTask -> ([ByteString], [MessageDeliveryTask], [MessageDeliveryTask], Int, Int)
     addToBatch (msgBodies, accepted, large, len, n) task
-      -- too large: skip, record in large
-      | msgLen > maxLen = (msgBodies, accepted, task : large, len, n)
+      -- element can't fit even a singleton batch (4-byte binary-batch framing)
+      | msgLen + 4 > maxLen = (msgBodies, accepted, task : large, len, n)
       -- fits: include in batch
       -- batch overhead: '=' + count (2) + 2-byte length prefix per element
       | len' + (n + 1) * 2 + 2 <= maxLen = (msgBody : msgBodies, task : accepted, large, len', n + 1)
@@ -98,10 +97,11 @@ batchDeliveryTasks1 _vr maxLen = toResult . foldl' addToBatch ([], [], [], 0, 0)
         msgBody = encodeFwdElement GrpMsgForward {fwdSender, fwdBrokerTs} verifiedMsg
         msgLen = B.length msgBody
         len' = len + msgLen
-    toResult :: ([ByteString], [MessageDeliveryTask], [MessageDeliveryTask], Int, Int) -> (ByteString, [MessageDeliveryTask], [MessageDeliveryTask])
+    toResult :: ([ByteString], [MessageDeliveryTask], [MessageDeliveryTask], Int, Int) -> (Maybe ByteString, [MessageDeliveryTask], [MessageDeliveryTask])
     toResult (msgBodies, accepted, large, _, _) =
       let encoded = encodeBinaryBatch (reverse msgBodies)
-       in (encoded, reverse accepted, reverse large)
+          body = if null accepted then Nothing else Just encoded
+       in (body, reverse accepted, reverse large)
 
 -- | Encode a batch element for relay groups: ><GrpMsgForward>[/<sigs>]<body>.
 encodeFwdElement :: GrpMsgForward -> VerifiedMsg 'Json -> ByteString

src/Simplex/Chat/Mobile.hs

@@ -38,6 +38,7 @@ import Simplex.Chat
 import Simplex.Chat.Controller
 import Simplex.Chat.Library.Commands
 import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList, parseUri, sanitizeUri)
+import Simplex.Chat.Mobile.Badges
 import Simplex.Chat.Mobile.File
 import Simplex.Chat.Mobile.Shared
 import Simplex.Chat.Mobile.WebRTC
@@ -138,6 +139,10 @@ foreign export ccall "chat_valid_name" cChatValidName :: CString -> IO CString
 
 foreign export ccall "chat_json_length" cChatJsonLength :: CString -> IO CInt
 
+foreign export ccall "chat_badge_keygen" cChatBadgeKeygen :: IO CJSONString
+
+foreign export ccall "chat_badge_issue" cChatBadgeIssue :: CString -> IO CJSONString
+
 foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CString
 
 foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
@@ -256,6 +261,7 @@ mobileChatOpts dbOptions =
             tbqSize = 4096,
             deviceName = Nothing,
             chatRelay = False,
+            webPreviewConfig = Nothing,
             highlyAvailable = False,
             yesToUpMigrations = False,
             migrationBackupPath = Just "",

src/Simplex/Chat/Mobile/Badges.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Simplex.Chat.Mobile.Badges
+  ( cChatBadgeKeygen,
+    cChatBadgeIssue,
+    BadgeResult (..),
+    BadgeIssueReq (..),
+    IssuerKeyPair (..),
+  )
+where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
+import qualified Data.ByteString as B
+import Data.Text (Text)
+import qualified Data.Text as T
+import Foreign.C (CString)
+import Simplex.Chat.Badges
+import Simplex.Chat.Mobile.Shared (CJSONString, newCStringFromLazyBS)
+import Simplex.Messaging.Crypto.BBS (BBSPublicKey, BBSSecretKey, bbsKeyGen)
+import Simplex.Messaging.Parsers (defaultJSON)
+
+-- FFI envelope for a generated issuer keypair (the BBS keypair tuple serialized with named fields)
+data IssuerKeyPair = IssuerKeyPair
+  { publicKey :: BBSPublicKey,
+    secretKey :: BBSSecretKey
+  }
+
+data BadgeIssueReq = BadgeIssueReq
+  { badgeKeyIdx :: Int,
+    secretKey :: BBSSecretKey,
+    request :: BadgeRequest
+  }
+
+data BadgeResult r
+  = BadgeResult {result :: r}
+  | BadgeError {error :: Text}
+
+$(JQ.deriveJSON defaultJSON ''IssuerKeyPair)
+
+$(JQ.deriveJSON defaultJSON ''BadgeIssueReq)
+
+$(pure [])
+
+instance ToJSON r => ToJSON (BadgeResult r) where
+  toEncoding = $(JQ.mkToEncoding (defaultJSON {J.sumEncoding = J.UntaggedValue}) ''BadgeResult)
+  toJSON = $(JQ.mkToJSON (defaultJSON {J.sumEncoding = J.UntaggedValue}) ''BadgeResult)
+
+instance FromJSON r => FromJSON (BadgeResult r) where
+  parseJSON = $(JQ.mkParseJSON (defaultJSON {J.sumEncoding = J.UntaggedValue}) ''BadgeResult)
+
+cChatBadgeKeygen :: IO CJSONString
+cChatBadgeKeygen =
+  bbsKeyGen >>= \case
+    Right (pk, sk) -> encodeResult $ BadgeResult (IssuerKeyPair pk sk)
+    Left e -> encodeResult @IssuerKeyPair $ BadgeError (T.pack e)
+
+cChatBadgeIssue :: CString -> IO CJSONString
+cChatBadgeIssue cReq = do
+  bs <- B.packCString cReq
+  encodeResult @BadgeCredential =<< case J.eitherDecodeStrict' bs of
+    Left e -> pure $ BadgeError (T.pack e)
+    Right BadgeIssueReq {badgeKeyIdx, secretKey, request} ->
+      either (BadgeError . T.pack) BadgeResult <$> issueBadge badgeKeyIdx secretKey (VerifiedBadgeRequest request)
+
+encodeResult :: ToJSON r => BadgeResult r -> IO CJSONString
+encodeResult = newCStringFromLazyBS . J.encode

src/Simplex/Chat/Options.hs

@@ -28,7 +28,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Numeric.Natural (Natural)
 import Options.Applicative
-import Simplex.Chat.Controller (ChatLogLevel (..), SimpleNetCfg (..), updateStr, versionNumber, versionString)
+import Simplex.Chat.Controller (ChatLogLevel (..), SimpleNetCfg (..), WebPreviewConfig (..), updateStr, versionNumber, versionString)
 import Simplex.FileTransfer.Description (mb)
 import Simplex.Messaging.Client (HostMode (..), SMPWebPortServers (..), SocksMode (..), textToHostMode)
 import Simplex.Messaging.Encoding.String
@@ -66,6 +66,7 @@ data CoreChatOpts = CoreChatOpts
     tbqSize :: Natural,
     deviceName :: Maybe Text,
     chatRelay :: Bool,
+    webPreviewConfig :: Maybe WebPreviewConfig,
     highlyAvailable :: Bool,
     yesToUpMigrations :: Bool,
     migrationBackupPath :: Maybe FilePath,
@@ -240,6 +241,46 @@ coreChatOptsP appDir defaultDbName = do
       ( long "relay"
           <> help "Run as a chat relay client"
       )
+  webPreviewConfig <- do
+    webDomain_ <-
+      optional $
+        strOption
+          ( long "relay-web-domain"
+              <> metavar "DOMAIN"
+              <> help "Domain for channel web previews (relay only)"
+          )
+    webJsonDir_ <-
+      optional $
+        strOption
+          ( long "relay-web-dir"
+              <> metavar "DIR"
+              <> help "Directory for channel web preview JSON files (relay only)"
+          )
+    webCorsFile <-
+      optional $
+        strOption
+          ( long "relay-web-cors-file"
+              <> metavar "FILE"
+              <> help "Path to generated Caddy CORS config file (relay only)"
+          )
+    webUpdateInterval <-
+      option auto
+        ( long "relay-web-interval"
+            <> metavar "SECONDS"
+            <> help "Interval between web preview regeneration in seconds (relay only)"
+            <> value 300
+        )
+    webPreviewItemCount <-
+      option auto
+        ( long "relay-web-item-count"
+            <> metavar "COUNT"
+            <> help "Number of recent messages in channel web preview (relay only)"
+            <> value 50
+        )
+    pure $ case (webDomain_, webJsonDir_) of
+      (Just webDomain, Just webJsonDir) -> Just WebPreviewConfig {webDomain, webJsonDir, webCorsFile, webUpdateInterval, webPreviewItemCount}
+      (Nothing, Nothing) -> Nothing
+      _ -> errorWithoutStackTrace "--relay-web-domain and --relay-web-dir must both be provided"
   highlyAvailable <-
     switch
       ( long "ha"
@@ -283,6 +324,7 @@ coreChatOptsP appDir defaultDbName = do
         tbqSize,
         deviceName,
         chatRelay,
+        webPreviewConfig,
         highlyAvailable,
         yesToUpMigrations,
         migrationBackupPath,

src/Simplex/Chat/ProfileGenerator.hs

@@ -10,7 +10,7 @@ generateRandomProfile :: IO Profile
 generateRandomProfile = do
   adjective <- pick adjectives
   noun <- pickNoun adjective 2
-  pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing}
+  pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing}
   where
     pick :: [a] -> IO a
     pick xs = (xs !!) <$> randomRIO (0, length xs - 1)

src/Simplex/Chat/Protocol.hs

@@ -48,12 +48,14 @@ import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.System (systemToUTCTime, utcToSystemTime)
 import Data.Type.Equality
 import Data.Typeable (Typeable)
-import Data.Word (Word32)
+import Data.Word (Word16, Word32)
+import Simplex.Chat.Badges (LocalBadge)
 import Simplex.Chat.Call
 import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
+import qualified Simplex.FileTransfer.Description as FD
 import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion)
 import Simplex.Messaging.Agent.Store.DB (blobFieldDecoder, fromTextField_)
 import Simplex.Messaging.Compression (Compressed, compress1, decompress1, decompressedSize)
@@ -82,12 +84,14 @@ import Simplex.Messaging.Version hiding (version)
 -- 15 - support specifying message scopes for group messages (2025-03-12)
 -- 16 - support short link data (2025-06-10)
 -- 17 - allow host voice messages during member approval regardless of group voice setting (2026-02-10)
+-- 18 - relay web capabilities (2026-05-31)
+-- 19 - group roster (2026-06-18)
 
 -- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
 -- This indirection is needed for backward/forward compatibility testing.
 -- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
 currentChatVersion :: VersionChat
-currentChatVersion = VersionChat 17
+currentChatVersion = VersionChat 19
 
 -- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
 supportedChatVRange :: VersionRangeChat
@@ -154,6 +158,15 @@ shortLinkDataVersion = VersionChat 16
 memberSupportVoiceVersion :: VersionChat
 memberSupportVoiceVersion = VersionChat 17
 
+-- relay sends web preview capabilities to owner
+relayWebCapVersion :: VersionChat
+relayWebCapVersion = VersionChat 18
+
+-- owner-signed roster (promoted members/moderators/admins) and the relay roster-ack handshake;
+-- a relay below this version is published without the handshake (it can't ack a roster)
+groupRosterVersion :: VersionChat
+groupRosterVersion = VersionChat 19
+
 agentToChatVersion :: VersionSMPA -> VersionChat
 agentToChatVersion v
   | v < pqdrSMPAgentVersion = initialChatVersion
@@ -367,6 +380,36 @@ data GrpMsgForward = GrpMsgForward
   }
   deriving (Eq, Show)
 
+-- | Owner-signed roster header for the privileged (moderator/admin/member) set; owners
+-- are not included, their keys come from the link. The member list itself is not
+-- here: it is sent as a binary blob over the inline file transfer, and this header
+-- carries only its inline-file invitation (size + owner-attested digest).
+data GroupRoster = GroupRoster
+  { version :: VersionRoster,
+    fileInv :: InlineFileInvitation
+  }
+  deriving (Eq, Show)
+
+-- | Lean always-inline file invitation for the roster blob, carried in the signed
+-- header. The digest authenticates the unsigned blob; integrity is entirely the digest.
+data InlineFileInvitation = InlineFileInvitation
+  { fileSize :: Integer,
+    fileDigest :: FD.FileDigest
+  }
+  deriving (Eq, Show)
+
+data RosterMember = RosterMember
+  { memberId :: MemberId,
+    key :: MemberKey, -- trust-on-first-use pinned per memberId
+    role :: GroupMemberRole,
+    privileges :: Word16 -- reserved: serialized as 0, parsed and ignored in v1
+  }
+  deriving (Eq, Show)
+
+-- RosterMember is binary-only: it rides in the roster blob, never in a JSON message.
+instance Encoding RosterMember where
+  smpEncode RosterMember {memberId, key, role, privileges} = smpEncode (memberId, key, role, privileges)
+  smpP = RosterMember <$> smpP <*> smpP <*> smpP <*> smpP
 
 instance Encoding FwdSender where
   smpEncode = \case
@@ -433,6 +476,11 @@ data MsgSigning = MsgSigning
 encodeChatBinding :: ChatBinding -> ByteString -> ByteString
 encodeChatBinding cb bindingData = smpEncode cb <> bindingData
 
+signChatMsgBody :: MsgSigning -> ByteString -> SignedMsg
+signChatMsgBody MsgSigning {bindingTag, bindingData, keyRef, privKey} msgBody =
+  let sig = C.ASignature C.SEd25519 $ C.sign' privKey (encodeChatBinding bindingTag bindingData <> msgBody)
+   in SignedMsg {chatBinding = bindingTag, signatures = MsgSignature keyRef sig L.:| [], signedBody = msgBody}
+
 data ChatMsgEvent (e :: MsgEncoding) where
   XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
   XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
@@ -446,7 +494,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
   XFileCancel :: SharedMsgId -> ChatMsgEvent 'Json
   XInfo :: Profile -> ChatMsgEvent 'Json
   XContact :: {profile :: Profile, contactReqId :: Maybe XContactId, welcomeMsgId :: Maybe SharedMsgId, requestMsg :: Maybe (SharedMsgId, MsgContent)} -> ChatMsgEvent 'Json
-  XMember :: {profile :: Profile, newMemberId :: MemberId, newMemberKey :: MemberKey} -> ChatMsgEvent 'Json
+  XMember :: {profile :: Profile, newMemberId :: MemberId, newMemberKey :: MemberKey, viaRelay :: Maybe MemberId} -> ChatMsgEvent 'Json
   XDirectDel :: ChatMsgEvent 'Json
   XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
   XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
@@ -465,16 +513,18 @@ data ChatMsgEvent (e :: MsgEncoding) where
   XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
   XGrpMemFwd :: MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json
   XGrpMemInfo :: MemberId -> Profile -> ChatMsgEvent 'Json
-  XGrpMemRole :: MemberId -> GroupMemberRole -> ChatMsgEvent 'Json
+  XGrpMemRole :: MemberId -> GroupMemberRole -> Maybe MemberKey -> Maybe VersionRoster -> ChatMsgEvent 'Json
   XGrpMemRestrict :: MemberId -> MemberRestrictions -> ChatMsgEvent 'Json
   XGrpMemCon :: MemberId -> ChatMsgEvent 'Json
   XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
-  XGrpMemDel :: MemberId -> Bool -> ChatMsgEvent 'Json
+  XGrpMemDel :: MemberId -> Bool -> Maybe VersionRoster -> ChatMsgEvent 'Json
   XGrpLeave :: ChatMsgEvent 'Json
   XGrpDel :: ChatMsgEvent 'Json
   XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json
   XGrpPrefs :: GroupPreferences -> ChatMsgEvent 'Json
   XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json
+  XGrpRoster :: GroupRoster -> ChatMsgEvent 'Json
+  XGrpRosterAck :: VersionRoster -> Maybe Text -> ChatMsgEvent 'Json
   XGrpMsgForward :: GrpMsgForward -> ChatMessage 'Json -> ChatMsgEvent 'Json
   XInfoProbe :: Probe -> ChatMsgEvent 'Json
   XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json
@@ -518,6 +568,7 @@ isForwardedGroupMsg ev = case ev of
   XGrpDel -> True
   XGrpInfo _ -> True
   XGrpPrefs _ -> True
+  XGrpRoster _ -> True
   _ -> False
 
 data MsgReaction = MREmoji {emoji :: MREmojiChar} | MRUnknown {tag :: Text, json :: J.Object}
@@ -786,6 +837,8 @@ data MsgMention = MsgMention {memberId :: MemberId}
 newtype MsgMentions = MsgMentions (Map MemberName MsgMention)
   deriving (Eq, Show)
 
+$(JQ.deriveJSON defaultJSON ''InlineFileInvitation)
+
 $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MCL") ''MsgChatLink)
 
 $(JQ.deriveJSON defaultJSON ''LinkOwnerSig)
@@ -886,6 +939,28 @@ maxCompressedMsgLength = 13380
 maxDecompressedMsgLength :: Int
 maxDecompressedMsgLength = 65536
 
+-- Defensive entry-count bound for the roster blob parser (rosterBlobP) and the
+-- promotion cap over the promoted (member/moderator/admin) set.
+maxGroupRosterSize :: Int
+maxGroupRosterSize = 256
+
+-- Receive-side byte bound: reject an owner-signed header whose claimed fileSize exceeds what
+-- maxGroupRosterSize entries can occupy (128 B/entry is a generous worst case), before a file is created.
+-- 128 B/entry ~ memberId + X.509 Ed25519 key (44 B) + role + privileges + 1-byte length prefixes (~2x the ~65 B typical).
+maxGroupRosterBytes :: Integer
+maxGroupRosterBytes = fromIntegral maxGroupRosterSize * 128
+
+-- The byte sequence the owner-signed digest is computed over and verified against
+-- before parsing. Word16 count (smpEncodeList's 1-byte count is too small for the future cap).
+encodeRosterBlob :: [RosterMember] -> ByteString
+encodeRosterBlob ms = smpEncode (fromIntegral (length ms) :: Word16) <> B.concat (map smpEncode ms)
+
+rosterBlobP :: A.Parser [RosterMember]
+rosterBlobP = do
+  n <- fromIntegral <$> smpP @Word16
+  when (n > maxGroupRosterSize) $ fail "roster: too many entries"
+  A.count n smpP
+
 -- maxEncodedMsgLength - delta between MSG and INFO + 100 (returned for forward overhead)
 -- delta between MSG and INFO = e2eEncUserMsgLength (no PQ) - e2eEncConnInfoLength (no PQ) = 1008
 maxEncodedInfoLength :: Int
@@ -931,7 +1006,7 @@ parseChatMessages msg = case B.head msg of
       Right (compressed :: L.NonEmpty Compressed) -> case traverse decompressedSize compressed of
         Nothing -> [Left "compressed size not specified"]
         Just sizes
-          | sum sizes > maxDecompressedMsgLength -> [Left "decompressed size exceeds limit"]
+          | any (maxDecompressedMsgLength <) sizes || maxDecompressedMsgLength < sum sizes -> [Left "decompressed size exceeds limit"]
           | otherwise -> concatMap (either (\e -> [Left e]) parseUncompressed' . decompress1) compressed
     parseUncompressed' "" = [Left "empty string"]
     parseUncompressed' s = parseUncompressed (B.head s) s
@@ -1022,6 +1097,8 @@ data CMEventTag (e :: MsgEncoding) where
   XGrpInfo_ :: CMEventTag 'Json
   XGrpPrefs_ :: CMEventTag 'Json
   XGrpDirectInv_ :: CMEventTag 'Json
+  XGrpRoster_ :: CMEventTag 'Json
+  XGrpRosterAck_ :: CMEventTag 'Json
   XGrpMsgForward_ :: CMEventTag 'Json
   XInfoProbe_ :: CMEventTag 'Json
   XInfoProbeCheck_ :: CMEventTag 'Json
@@ -1082,6 +1159,8 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
     XGrpInfo_ -> "x.grp.info"
     XGrpPrefs_ -> "x.grp.prefs"
     XGrpDirectInv_ -> "x.grp.direct.inv"
+    XGrpRoster_ -> "x.grp.roster"
+    XGrpRosterAck_ -> "x.grp.roster.ack"
     XGrpMsgForward_ -> "x.grp.msg.forward"
     XInfoProbe_ -> "x.info.probe"
     XInfoProbeCheck_ -> "x.info.probe.check"
@@ -1143,6 +1222,8 @@ instance StrEncoding ACMEventTag where
         "x.grp.info" -> XGrpInfo_
         "x.grp.prefs" -> XGrpPrefs_
         "x.grp.direct.inv" -> XGrpDirectInv_
+        "x.grp.roster" -> XGrpRoster_
+        "x.grp.roster.ack" -> XGrpRosterAck_
         "x.grp.msg.forward" -> XGrpMsgForward_
         "x.info.probe" -> XInfoProbe_
         "x.info.probe.check" -> XInfoProbeCheck_
@@ -1190,7 +1271,7 @@ toCMEventTag msg = case msg of
   XGrpMemInv _ _ -> XGrpMemInv_
   XGrpMemFwd _ _ -> XGrpMemFwd_
   XGrpMemInfo _ _ -> XGrpMemInfo_
-  XGrpMemRole _ _ -> XGrpMemRole_
+  XGrpMemRole {} -> XGrpMemRole_
   XGrpMemRestrict _ _ -> XGrpMemRestrict_
   XGrpMemCon _ -> XGrpMemCon_
   XGrpMemConAll _ -> XGrpMemConAll_
@@ -1200,6 +1281,8 @@ toCMEventTag msg = case msg of
   XGrpInfo _ -> XGrpInfo_
   XGrpPrefs _ -> XGrpPrefs_
   XGrpDirectInv {} -> XGrpDirectInv_
+  XGrpRoster _ -> XGrpRoster_
+  XGrpRosterAck {} -> XGrpRosterAck_
   XGrpMsgForward {} -> XGrpMsgForward_
   XInfoProbe _ -> XInfoProbe_
   XInfoProbeCheck _ -> XInfoProbeCheck_
@@ -1258,6 +1341,7 @@ requiresSignature = \case
   XGrpMemRestrict_ -> True
   XGrpLeave_ -> True
   XGrpRelayNew_ -> True
+  XGrpRoster_ -> True
   XInfo_ -> True
   _ -> False
 
@@ -1326,7 +1410,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
         reqContent <- opt "content"
         let requestMsg = (,) <$> reqMsgId <*> reqContent
         pure XContact {profile, contactReqId, welcomeMsgId, requestMsg}
-      XMember_ -> XMember <$> p "profile" <*> p "newMemberId" <*> p "newMemberKey"
+      XMember_ -> XMember <$> p "profile" <*> p "newMemberId" <*> p "newMemberKey" <*> opt "viaRelay"
       XDirectDel_ -> pure XDirectDel
       XGrpInv_ -> XGrpInv <$> p "groupInvitation"
       XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
@@ -1348,16 +1432,18 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
       XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
       XGrpMemFwd_ -> XGrpMemFwd <$> p "memberInfo" <*> p "memberIntro"
       XGrpMemInfo_ -> XGrpMemInfo <$> p "memberId" <*> p "profile"
-      XGrpMemRole_ -> XGrpMemRole <$> p "memberId" <*> p "role"
+      XGrpMemRole_ -> XGrpMemRole <$> p "memberId" <*> p "role" <*> opt "memberKey" <*> opt "rosterVersion"
       XGrpMemRestrict_ -> XGrpMemRestrict <$> p "memberId" <*> p "memberRestrictions"
       XGrpMemCon_ -> XGrpMemCon <$> p "memberId"
       XGrpMemConAll_ -> XGrpMemConAll <$> p "memberId"
-      XGrpMemDel_ -> XGrpMemDel <$> p "memberId" <*> Right (fromRight False $ p "messages")
+      XGrpMemDel_ -> XGrpMemDel <$> p "memberId" <*> Right (fromRight False $ p "messages") <*> opt "rosterVersion"
       XGrpLeave_ -> pure XGrpLeave
       XGrpDel_ -> pure XGrpDel
       XGrpInfo_ -> XGrpInfo <$> p "groupProfile"
       XGrpPrefs_ -> XGrpPrefs <$> p "groupPreferences"
       XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content" <*> opt "scope"
+      XGrpRoster_ -> XGrpRoster <$> (GroupRoster <$> p "version" <*> p "fileInv")
+      XGrpRosterAck_ -> XGrpRosterAck <$> p "version" <*> opt "error"
       XGrpMsgForward_ -> do
         fwdSender <- opt "memberId" >>= \case
           Just memberId -> FwdMember memberId . fromMaybe "" <$> opt "memberName"
@@ -1399,7 +1485,7 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en
       XFileCancel sharedMsgId -> o ["msgId" .= sharedMsgId]
       XInfo profile -> o ["profile" .= profile]
       XContact {profile, contactReqId, welcomeMsgId, requestMsg} -> o $ ("contactReqId" .=? contactReqId) $ ("welcomeMsgId" .=? welcomeMsgId) $ ("msgId" .=? (fst <$> requestMsg)) $ ("content" .=? (snd <$> requestMsg)) $ ["profile" .= profile]
-      XMember {profile, newMemberId, newMemberKey} -> o ["profile" .= profile, "newMemberId" .= newMemberId, "newMemberKey" .= newMemberKey]
+      XMember {profile, newMemberId, newMemberKey, viaRelay} -> o $ ("viaRelay" .=? viaRelay) ["profile" .= profile, "newMemberId" .= newMemberId, "newMemberKey" .= newMemberKey]
       XDirectDel -> JM.empty
       XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
       XGrpAcpt memId -> o ["memberId" .= memId]
@@ -1420,16 +1506,18 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en
       XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]
       XGrpMemFwd memInfo memIntro -> o ["memberInfo" .= memInfo, "memberIntro" .= memIntro]
       XGrpMemInfo memId profile -> o ["memberId" .= memId, "profile" .= profile]
-      XGrpMemRole memId role -> o ["memberId" .= memId, "role" .= role]
+      XGrpMemRole memId role memberKey rosterVersion -> o $ ("memberKey" .=? memberKey) $ ("rosterVersion" .=? rosterVersion) ["memberId" .= memId, "role" .= role]
       XGrpMemRestrict memId memRestrictions -> o ["memberId" .= memId, "memberRestrictions" .= memRestrictions]
       XGrpMemCon memId -> o ["memberId" .= memId]
       XGrpMemConAll memId -> o ["memberId" .= memId]
-      XGrpMemDel memId messages -> o $ ("messages" .=? if messages then Just True else Nothing) ["memberId" .= memId]
+      XGrpMemDel memId messages rosterVersion -> o $ ("rosterVersion" .=? rosterVersion) $ ("messages" .=? if messages then Just True else Nothing) ["memberId" .= memId]
       XGrpLeave -> JM.empty
       XGrpDel -> JM.empty
       XGrpInfo p -> o ["groupProfile" .= p]
       XGrpPrefs p -> o ["groupPreferences" .= p]
       XGrpDirectInv connReq content scope -> o $ ("content" .=? content) $ ("scope" .=? scope) ["connReq" .= connReq]
+      XGrpRoster GroupRoster {version, fileInv} -> o ["version" .= version, "fileInv" .= fileInv]
+      XGrpRosterAck version err -> o $ ("error" .=? err) ["version" .= version]
       XGrpMsgForward GrpMsgForward {fwdSender, fwdBrokerTs} msg -> o $ encodeFwdSender fwdSender ["msg" .= msg, "msgTs" .= fwdBrokerTs]
         where
           encodeFwdSender = \case
@@ -1481,7 +1569,10 @@ instance FromField (ChatMessage 'Json) where
 data ContactShortLinkData = ContactShortLinkData
   { profile :: Profile,
     message :: Maybe MsgContent,
-    business :: Bool
+    business :: Bool,
+    -- set by the receiving client for the UI: the link profile's badge, verified and crypto-free.
+    -- never part of the published link data (the link carries the proof inside profile).
+    localBadge :: Maybe LocalBadge
   }
   deriving (Show)
 

src/Simplex/Chat/Store/Connections.hs

@@ -29,7 +29,8 @@ import Control.Monad.IO.Class
 import Data.Bitraversable (bitraverse)
 import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
-import Data.Time.Clock (getCurrentTime)
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import Simplex.Chat.Badges (rowToBadge)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Groups
@@ -74,8 +75,8 @@ getChatLockEntity db agentConnId = do
 -- TODO consider whether ConnFailed connections should be excluded:
 -- - from receiving: getConnectionEntity, getContactConnEntityByConnReqHash
 -- - from subscribing: getContactConnsToSub, getUCLConnsToSub, getMemberConnsToSub, getPendingConnsToSub
-getConnectionEntity :: DB.Connection -> VersionRangeChat -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
-getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
+getConnectionEntity :: DB.Connection -> StoreCxt -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
+getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
   c@Connection {connType, entityId} <- getConnection_
   case entityId of
     Nothing ->
@@ -90,7 +91,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
   where
     getConnection_ :: ExceptT StoreError IO Connection
     getConnection_ = ExceptT $ do
-      firstRow (toConnection vr) (SEConnectionNotFound agentConnId) $
+      firstRow (toConnection cxt) (SEConnectionNotFound agentConnId) $
         DB.query
           db
           [sql|
@@ -104,8 +105,9 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
           (userId, agentConnId, ConnDeleted)
     getContactRec_ :: Int64 -> Connection -> ExceptT StoreError IO Contact
     getContactRec_ contactId c = ExceptT $ do
+      currentTs <- getCurrentTime
       chatTags <- getDirectChatTags db contactId
-      firstRow (toContact' contactId c chatTags) (SEInternalError "referenced contact not found") $
+      firstRow (toContact' currentTs contactId c chatTags) (SEInternalError "referenced contact not found") $
         DB.query
           db
           [sql|
@@ -113,15 +115,16 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
               c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
               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
+              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_master_key, p.badge_signature, p.badge_key_idx
             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
           |]
           (userId, contactId, CSActive)
-    toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
-    toContact' contactId conn chatTags ((profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL)) =
-      let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, preferences, localAlias}
+    toContact' :: UTCTime -> Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
+    toContact' currentTs contactId conn chatTags ((profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow) =
+      let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localBadge = rowToBadge currentTs badgeRow, preferences, localAlias}
           chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
           mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
           activeConn = Just conn
@@ -130,9 +133,10 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
        in Contact {contactId, localDisplayName, profile, activeConn, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, groupDirectInv, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
     getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
     getGroupAndMember_ groupMemberId c = do
+      currentTs <- liftIO getCurrentTime
       gm <-
         ExceptT $
-          firstRow (toGroupAndMember c) (SEInternalError "referenced group member not found") $
+          firstRow (toGroupAndMember currentTs c) (SEInternalError "referenced group member not found") $
             DB.query
               db
               [sql|
@@ -145,18 +149,20 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
                   g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
                   g.business_chat, g.business_member_id, g.customer_member_id,
                   g.use_relays, g.relay_own_status,
-                  g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
+                  g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
                   g.root_priv_key, g.root_pub_key, g.member_priv_key,
                   -- GroupInfo {membership}
                   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,
                   -- 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_master_key, pu.badge_signature, pu.badge_key_idx,
                   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_master_key, p.badge_signature, p.badge_key_idx,
                   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
@@ -170,10 +176,10 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
               |]
               (groupMemberId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted)
       liftIO $ bitraverse (addGroupChatTags db) pure gm
-    toGroupAndMember :: Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember)
-    toGroupAndMember c (groupInfoRow :. memberRow) =
-      let groupInfo = toGroupInfo vr userContactId [] groupInfoRow
-          member = toGroupMember userContactId memberRow
+    toGroupAndMember :: UTCTime -> Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember)
+    toGroupAndMember currentTs c (groupInfoRow :. memberRow) =
+      let groupInfo = toGroupInfo currentTs cxt userContactId [] groupInfoRow
+          member = toGroupMember currentTs userContactId memberRow
        in (groupInfo, (member :: GroupMember) {activeConn = Just c})
     getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
     getUserContact_ userContactLinkId = ExceptT $ do
@@ -191,17 +197,17 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
         userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId}
         userContact_ _ = Left SEUserContactLinkNotFound
 
-getConnectionEntityByConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
-getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
+getConnectionEntityByConnReq :: DB.Connection -> StoreCxt -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
+getConnectionEntityByConnReq db cxt user@User {userId} (cReqSchema1, cReqSchema2) = do
   connId_ <-
     maybeFirstRow fromOnly $
       DB.query db "SELECT agent_conn_id FROM connections WHERE user_id = ? AND conn_req_inv IN (?,?) LIMIT 1" (userId, cReqSchema1, cReqSchema2)
-  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db cxt user) connId_
 
-getConnectionEntityViaShortLink :: DB.Connection -> VersionRangeChat -> User -> ShortLinkInvitation -> IO (Maybe (ConnReqInvitation, ConnectionEntity))
-getConnectionEntityViaShortLink db vr user@User {userId} shortLink = fmap eitherToMaybe $ runExceptT $ do
+getConnectionEntityViaShortLink :: DB.Connection -> StoreCxt -> User -> ShortLinkInvitation -> IO (Maybe (ConnReqInvitation, ConnectionEntity))
+getConnectionEntityViaShortLink db cxt user@User {userId} shortLink = fmap eitherToMaybe $ runExceptT $ do
   (cReq, connId) <- ExceptT getConnReqConnId
-  (cReq,) <$> getConnectionEntity db vr user connId
+  (cReq,) <$> getConnectionEntity db cxt user connId
   where
     getConnReqConnId =
       firstRow' toConnReqConnId (SEInternalError "connection not found") $
@@ -222,8 +228,8 @@ getConnectionEntityViaShortLink db vr user@User {userId} shortLink = fmap either
 -- multiple connections can have same via_contact_uri_hash if request was repeated;
 -- this function searches for latest connection with contact so that "known contact" plan would be chosen;
 -- deleted connections are filtered out to allow re-connecting via same contact address
-getContactConnEntityByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
-getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2) = do
+getContactConnEntityByConnReqHash :: DB.Connection -> StoreCxt -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
+getContactConnEntityByConnReqHash db cxt user@User {userId} (cReqHash1, cReqHash2) = do
   connId_ <-
     maybeFirstRow fromOnly $
       DB.query
@@ -240,7 +246,7 @@ getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2
           ) c
         |]
         (userId, cReqHash1, cReqHash2, ConnDeleted)
-  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db cxt user) connId_
 
 getContactConnsToSub :: DB.Connection -> User -> Bool -> IO [ConnId]
 getContactConnsToSub db User {userId} filterToSubscribe =

src/Simplex/Chat/Store/ContactRequest.hs

@@ -24,6 +24,7 @@ import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG)
 import Data.Int (Int64)
 import Data.Time.Clock (getCurrentTime)
+import Simplex.Chat.Badges (badgeToRow, verifyBadge_)
 import Simplex.Chat.Protocol (MsgContent, businessChatsVersion)
 import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Groups
@@ -49,7 +50,7 @@ import Database.SQLite.Simple.QQ (sql)
 createOrUpdateContactRequest ::
   DB.Connection ->
   TVar ChaChaDRG ->
-  VersionRangeChat ->
+  StoreCxt ->
   User ->
   Int64 ->
   UserContactLink ->
@@ -65,14 +66,14 @@ createOrUpdateContactRequest ::
 createOrUpdateContactRequest
   db
   gVar
-  vr
+  cxt
   user@User {userId, userContactId}
   uclId
   UserContactLink {addressSettings = AddressSettings {businessAddress}}
   isSimplexTeam
   invId
   cReqChatVRange@(VersionRange minV maxV)
-  profile@Profile {displayName, fullName, shortDescr, image, contactLink, preferences}
+  profile@Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences}
   xContactId_
   welcomeMsgId_
   requestMsg_
@@ -89,7 +90,7 @@ createOrUpdateContactRequest
           Nothing ->
             liftIO (getAcceptedBusinessChat xContactId) >>= \case
               Just gInfo@GroupInfo {businessChat = Just BusinessChatInfo {customerId}} -> do
-                clientMember <- getGroupMemberByMemberId db vr user gInfo customerId
+                clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId
                 cr <- liftIO $ getContactRequestByXContactId xContactId
                 pure $ RSAcceptedRequest cr (REBusinessChat gInfo clientMember)
               Just GroupInfo {businessChat = Nothing} -> throwError SEInvalidBusinessChatContactRequest
@@ -103,8 +104,9 @@ createOrUpdateContactRequest
     where
       getAcceptedContact :: XContactId -> IO (Maybe Contact)
       getAcceptedContact xContactId = do
+        currentTs <- getCurrentTime
         ct_ <-
-          maybeFirstRow (toContact vr user []) $
+          maybeFirstRow (toContact currentTs cxt user []) $
             DB.query
               db
               [sql|
@@ -114,6 +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_master_key, cp.badge_signature, cp.badge_key_idx,
                   -- 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,
@@ -127,26 +130,29 @@ createOrUpdateContactRequest
         mapM (addDirectChatTags db) ct_
       getAcceptedBusinessChat :: XContactId -> IO (Maybe GroupInfo)
       getAcceptedBusinessChat xContactId = do
+        currentTs <- getCurrentTime
         g_ <-
-          maybeFirstRow (toGroupInfo vr userContactId []) $
+          maybeFirstRow (toGroupInfo currentTs cxt userContactId []) $
             DB.query
               db
               (groupInfoQuery <> " WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?")
               (xContactId, userId, userContactId)
         mapM (addGroupChatTags db) g_
       getContactRequestByXContactId :: XContactId -> IO (Maybe UserContactRequest)
-      getContactRequestByXContactId xContactId =
-        maybeFirstRow toContactRequest $
+      getContactRequestByXContactId xContactId = do
+        currentTs <- getCurrentTime
+        maybeFirstRow (toContactRequest currentTs) $
           DB.query
             db
             [sql|
               SELECT
                 cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
                 cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
-                cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
+                cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, cr.xcontact_id,
                 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
+                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_master_key, p.badge_signature, p.badge_key_idx
               FROM contact_requests cr
               JOIN contact_profiles p USING (contact_profile_id)
               WHERE cr.user_id = ?
@@ -157,12 +163,13 @@ createOrUpdateContactRequest
       createContactRequest :: ExceptT StoreError IO RequestStage
       createContactRequest = do
         currentTs <- liftIO $ getCurrentTime
+        badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge
         ExceptT $ withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
           liftIO $
             DB.execute
               db
-              "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
-              (displayName, fullName, shortDescr, image, contactLink, userId, preferences, currentTs, currentTs)
+              "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, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
+              ((displayName, fullName, shortDescr, image, contactLink, userId) :. ("" :: LocalAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
           profileId <- liftIO $ insertedRowId db
           liftIO $
             DB.execute
@@ -200,12 +207,12 @@ createOrUpdateContactRequest
                     "UPDATE contact_requests SET contact_id = ? WHERE contact_request_id = ?"
                     (contactId, contactRequestId)
                 ucr <- getContactRequest db user contactRequestId
-                ct <- getContact db vr user contactId
+                ct <- getContact db cxt user contactId
                 pure $ RSCurrentRequest Nothing ucr (Just $ REContact ct)
               createBusinessChat = do
                 let groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs $ preferences' user
                 (gInfo@GroupInfo {groupId}, clientMember) <-
-                  createBusinessRequestGroup db vr gVar user cReqChatVRange profile profileId ldn groupPreferences
+                  createBusinessRequestGroup db cxt gVar user cReqChatVRange profile profileId ldn groupPreferences
                 liftIO $
                   DB.execute
                     db
@@ -214,7 +221,7 @@ createOrUpdateContactRequest
                 ucr <- getContactRequest db user contactRequestId
                 pure $ RSCurrentRequest Nothing ucr (Just $ REBusinessChat gInfo clientMember)
       updateContactRequest :: UserContactRequest -> ExceptT StoreError IO RequestStage
-      updateContactRequest ucr@UserContactRequest {contactRequestId, contactId_, localDisplayName = oldLdn, profile = Profile {displayName = oldDisplayName}} = do
+      updateContactRequest ucr@UserContactRequest {contactRequestId, contactId_, localDisplayName = oldLdn, profile = LocalProfile {displayName = oldDisplayName}} = do
         currentTs <- liftIO getCurrentTime
         liftIO $ updateProfile currentTs
         updateRequest currentTs
@@ -222,7 +229,8 @@ createOrUpdateContactRequest
         re_ <- getRequestEntity ucr'
         pure $ RSCurrentRequest (Just ucr) ucr' re_
         where
-          updateProfile currentTs =
+          updateProfile currentTs = do
+            badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge
             DB.execute
               db
               [sql|
@@ -232,7 +240,16 @@ createOrUpdateContactRequest
                   short_descr = ?,
                   image = ?,
                   contact_link = ?,
-                  updated_at = ?
+                  updated_at = ?,
+                  badge_proof = ?,
+                  badge_pres_header = ?,
+                  badge_expiry = ?,
+                  badge_type = ?,
+                  badge_verified = ?,
+                  badge_extra = ?,
+                  badge_master_key = ?,
+                  badge_signature = ?,
+                  badge_key_idx = ?
               WHERE contact_profile_id IN (
                 SELECT contact_profile_id
                 FROM contact_requests
@@ -240,7 +257,7 @@ createOrUpdateContactRequest
                   AND contact_request_id = ?
               )
             |]
-              (displayName, fullName, shortDescr, image, contactLink, currentTs, userId, contactRequestId)
+              ((displayName, fullName, shortDescr, image, contactLink, currentTs) :. badgeToRow badge badgeVerified :. (userId, contactRequestId))
           updateRequest currentTs =
             if displayName == oldDisplayName
               then
@@ -278,13 +295,13 @@ createOrUpdateContactRequest
       getRequestEntity UserContactRequest {contactRequestId, contactId_, businessGroupId_} =
         case (contactId_, businessGroupId_) of
           (Just contactId, Nothing) -> do
-            ct <- getContact db vr user contactId
+            ct <- getContact db cxt user contactId
             pure $ Just (REContact ct)
           (Nothing, Just businessGroupId) -> do
-            gInfo <- getGroupInfo db vr user businessGroupId
+            gInfo <- getGroupInfo db cxt user businessGroupId
             case gInfo of
               GroupInfo {businessChat = Just BusinessChatInfo {customerId}} -> do
-                clientMember <- getGroupMemberByMemberId db vr user gInfo customerId
+                clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId
                 pure $ Just (REBusinessChat gInfo clientMember)
               _ -> throwError SEInvalidBusinessChatContactRequest
           (Nothing, Nothing) -> pure Nothing

src/Simplex/Chat/Store/Delivery.hs

@@ -348,8 +348,8 @@ updateDeliveryJobStatus_ db jobId status errReason_ = do
     (status, errReason_, currentTs, jobId)
 
 -- TODO [relays] possible improvement is to prioritize owners and "active" members
-getGroupMembersByCursor :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Maybe GroupMemberId -> Maybe GroupMemberId -> Int -> IO [GroupMember]
-getGroupMembersByCursor db vr user@User {userContactId} GroupInfo {groupId} cursorGMId_ singleSenderGMId_ count = do
+getGroupMembersByCursor :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe GroupMemberId -> Maybe GroupMemberId -> Int -> IO [GroupMember]
+getGroupMembersByCursor db cxt user@User {userContactId} GroupInfo {groupId} cursorGMId_ singleSenderGMId_ count = do
   gmIds :: [Int64] <-
     map fromOnly <$> case cursorGMId_ of
       Nothing ->
@@ -367,13 +367,14 @@ getGroupMembersByCursor db vr user@User {userContactId} GroupInfo {groupId} curs
               :. (cursorGMId, count)
           )
 #if defined(dbPostgres)
-  map (toContactMember vr user) <$>
+  currentTs <- getCurrentTime
+  map (toContactMember currentTs cxt user) <$>
     DB.query
       db
-      (groupMemberQuery <> " WHERE m.group_member_id IN ?")
+      (groupMemberQuery <> " WHERE m.group_member_id IN ? ORDER BY m.group_member_id ASC")
       (Only (In gmIds))
 #else
-  rights <$> mapM (runExceptT . getGroupMemberById db vr user) gmIds
+  rights <$> mapM (runExceptT . getGroupMemberById db cxt user) gmIds
 #endif
   where
     query =

src/Simplex/Chat/Store/Direct.hs

@@ -105,6 +105,7 @@ import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
 import Data.Type.Equality
+import Simplex.Chat.Badges (badgeToRow)
 import Simplex.Chat.Messages
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
@@ -243,8 +244,8 @@ createRelayMemberConnectionAsync db user@User {userId} gInfo GroupMember {groupM
   where
     customUserProfileId_ = localProfileId <$> incognitoMembershipProfile gInfo
 
-createRelayTestConnection :: DB.Connection -> VersionRangeChat -> User -> ConnId -> ConnStatus -> VersionChat -> SubscriptionMode -> ExceptT StoreError IO Connection
-createRelayTestConnection db vr user@User {userId} agentConnId connStatus chatV subMode = do
+createRelayTestConnection :: DB.Connection -> StoreCxt -> User -> ConnId -> ConnStatus -> VersionChat -> SubscriptionMode -> ExceptT StoreError IO Connection
+createRelayTestConnection db cxt user@User {userId} agentConnId connStatus chatV subMode = do
   currentTs <- liftIO getCurrentTime
   liftIO $
     DB.execute
@@ -261,7 +262,7 @@ createRelayTestConnection db vr user@User {userId} agentConnId connStatus chatV
           :. (BI True, currentTs, currentTs)
       )
   connId <- liftIO $ insertedRowId db
-  getConnectionById db vr user connId
+  getConnectionById db cxt user connId
 
 updateConnLinkData :: DB.Connection -> User -> Connection -> ConnReqContact -> ConnReqUriHash -> Maybe GroupLinkId -> VersionChat -> PQSupport -> IO ()
 updateConnLinkData db User {userId} Connection {connId} cReq cReqHash groupLinkId_ chatV pqSup = do
@@ -285,13 +286,13 @@ setPreparedGroupStartedConnection db groupId = do
     "UPDATE groups SET conn_link_started_connection = ?, updated_at = ? WHERE group_id = ?"
     (BI True, currentTs, groupId)
 
-getConnReqContactXContactId :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Either (Maybe Connection) Contact)
-getConnReqContactXContactId db vr user@User {userId} cReqHash1 cReqHash2 =
-  getContactByConnReqHash db vr user cReqHash1 cReqHash2 >>= maybe (Left <$> getConnection) (pure . Right)
+getConnReqContactXContactId :: DB.Connection -> StoreCxt -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Either (Maybe Connection) Contact)
+getConnReqContactXContactId db cxt user@User {userId} cReqHash1 cReqHash2 =
+  getContactByConnReqHash db cxt user cReqHash1 cReqHash2 >>= maybe (Left <$> getConnection) (pure . Right)
   where
     getConnection :: IO (Maybe Connection)
     getConnection =
-      maybeFirstRow (toConnection vr) $
+      maybeFirstRow (toConnection cxt) $
         DB.query
           db
           [sql|
@@ -305,10 +306,11 @@ getConnReqContactXContactId db vr user@User {userId} cReqHash1 cReqHash2 =
           |]
           (userId, cReqHash1, userId, cReqHash2)
 
-getContactByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Maybe Contact)
-getContactByConnReqHash db vr user@User {userId} cReqHash1 cReqHash2 = do
+getContactByConnReqHash :: DB.Connection -> StoreCxt -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Maybe Contact)
+getContactByConnReqHash db cxt user@User {userId} cReqHash1 cReqHash2 = do
+  currentTs <- getCurrentTime
   ct <-
-    maybeFirstRow (toContact vr user []) $
+    maybeFirstRow (toContact currentTs cxt user []) $
       DB.query
         db
         [sql|
@@ -318,6 +320,7 @@ getContactByConnReqHash db vr 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_master_key, cp.badge_signature, cp.badge_key_idx,
             -- 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,
@@ -394,18 +397,18 @@ createIncognitoProfile db User {userId} p = do
   createdAt <- getCurrentTime
   createIncognitoProfile_ db userId createdAt p
 
-createPreparedContact :: DB.Connection -> VersionRangeChat -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact
-createPreparedContact db vr user p connLinkToConnect welcomeSharedMsgId = do
+createPreparedContact :: DB.Connection -> StoreCxt -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact
+createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId = do
   currentTs <- liftIO getCurrentTime
   let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
       ctUserPreferences = newContactUserPrefs user p
-  contactId <- createContact_ db user p ctUserPreferences prepared "" currentTs
-  getContact db vr user contactId
+  contactId <- createContact_ db cxt user p ctUserPreferences prepared "" currentTs
+  getContact db cxt user contactId
 
-updatePreparedContactUser :: DB.Connection -> VersionRangeChat -> User -> Contact -> User -> ExceptT StoreError IO Contact
+updatePreparedContactUser :: DB.Connection -> StoreCxt -> User -> Contact -> User -> ExceptT StoreError IO Contact
 updatePreparedContactUser
   db
-  vr
+  cxt
   user
   Contact {contactId, localDisplayName = oldLDN, profile = profile@LocalProfile {profileId, displayName}}
   newUser@User {userId = newUserId} = do
@@ -438,15 +441,15 @@ updatePreparedContactUser
           |]
           (newUserId, currentTs, contactId)
         safeDeleteLDN db user oldLDN
-      getContact db vr newUser contactId
+      getContact db cxt newUser contactId
 
-createDirectContact :: DB.Connection -> VersionRangeChat -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
-createDirectContact db vr user Connection {connId, localAlias} p = do
+createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
+createDirectContact db cxt user Connection {connId, localAlias} p = do
   currentTs <- liftIO getCurrentTime
   let ctUserPreferences = newContactUserPrefs user p
-  contactId <- createContact_ db user p ctUserPreferences Nothing localAlias currentTs
+  contactId <- createContact_ db cxt user p ctUserPreferences Nothing localAlias currentTs
   liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
-  getContact db vr user contactId
+  getContact db cxt user contactId
 
 deleteContactConnections :: DB.Connection -> User -> Contact -> IO ()
 deleteContactConnections db User {userId} Contact {contactId} = do
@@ -500,13 +503,13 @@ deleteContactWithoutGroups db user@User {userId} ct@Contact {contactId, localDis
         deleteUnusedIncognitoProfileById_ db user profileId
 
 -- TODO remove in future versions: only used for legacy contact cleanup
-getDeletedContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
-getDeletedContacts db vr user@User {userId} = do
+getDeletedContacts :: DB.Connection -> StoreCxt -> User -> IO [Contact]
+getDeletedContacts db cxt user@User {userId} = do
   contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 1" (Only userId)
-  rights <$> mapM (runExceptT . getDeletedContact db vr user) contactIds
+  rights <$> mapM (runExceptT . getDeletedContact db cxt user) contactIds
 
-getDeletedContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
-getDeletedContact db vr user contactId = getContact_ db vr user contactId True
+getDeletedContact :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO Contact
+getDeletedContact db cxt user contactId = getContact_ db cxt user contactId True
 
 deleteContactProfile_ :: DB.Connection -> UserId -> ContactId -> IO ()
 deleteContactProfile_ db userId contactId =
@@ -552,22 +555,25 @@ deleteUnusedProfile_ db userId profileId =
         :. (userId, profileId, userId, profileId, profileId)
     )
 
-updateContactProfile :: DB.Connection -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
-updateContactProfile db user@User {userId} c p'
-  | displayName == newName = do
-      liftIO $ updateContactProfile_ db userId profileId p'
-      pure c {profile, mergedPreferences}
-  | otherwise =
-      ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
-        currentTs <- getCurrentTime
-        updateContactProfile_' db userId profileId p' currentTs
-        updateContactLDN_ db user contactId localDisplayName ldn currentTs
-        pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
+updateContactProfile :: DB.Connection -> StoreCxt -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
+updateContactProfile db cxt user@User {userId} c p' = do
+  currentTs <- liftIO getCurrentTime
+  badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) lp p'
+  let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified
+  updateContactProfile' currentTs badgeVerified profile
   where
-    Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, userPreferences} = c
+    Contact {contactId, localDisplayName, profile = lp@LocalProfile {profileId, displayName, localAlias}, userPreferences} = c
     Profile {displayName = newName, preferences} = p'
-    profile = toLocalProfile profileId p' localAlias
     mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c
+    updateContactProfile' currentTs badgeVerified profile
+      | displayName == newName = do
+          liftIO $ updateContactProfile_' db userId profileId p' badgeVerified currentTs
+          pure c {profile, mergedPreferences}
+      | otherwise =
+          ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
+            updateContactProfile_' db userId profileId p' badgeVerified currentTs
+            updateContactLDN_ db user contactId localDisplayName ldn currentTs
+            pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
 
 updateContactUserPreferences :: DB.Connection -> User -> Contact -> Preferences -> IO Contact
 updateContactUserPreferences db user@User {userId} c@Contact {contactId} userPreferences = do
@@ -694,55 +700,58 @@ setQuotaErrCounter db User {userId} Connection {connId} counter = do
   updatedAt <- getCurrentTime
   DB.execute db "UPDATE connections SET quota_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter, updatedAt, userId, connId)
 
-updateContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
-updateContactProfile_ db userId profileId profile = do
+updateContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
+updateContactProfile_ db userId profileId profile badgeVerified = do
   currentTs <- getCurrentTime
-  updateContactProfile_' db userId profileId profile currentTs
+  updateContactProfile_' db userId profileId profile badgeVerified currentTs
 
-updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
-updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType} updatedAt = do
+updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
+updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge} badgeVerified updatedAt =
   DB.execute
     db
     [sql|
       UPDATE contact_profiles
-      SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?
+      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_master_key = ?, badge_signature = ?, badge_key_idx = ?
       WHERE user_id = ? AND contact_profile_id = ?
     |]
-    (displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt, userId, profileId)
+    ((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. (userId, profileId))
 
 -- update only member profile fields (when member doesn't have associated contact - we can reset contactLink and prefs)
-updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
-updateMemberContactProfileReset_ db userId profileId profile = do
+updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
+updateMemberContactProfileReset_ db userId profileId profile badgeVerified = do
   currentTs <- getCurrentTime
-  updateMemberContactProfileReset_' db userId profileId profile currentTs
+  updateMemberContactProfileReset_' db userId profileId profile badgeVerified currentTs
 
-updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
-updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image} updatedAt = do
+updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
+updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, badge} badgeVerified updatedAt =
   DB.execute
     db
     [sql|
       UPDATE contact_profiles
-      SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = NULL, preferences = NULL, updated_at = ?
+      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_master_key = ?, badge_signature = ?, badge_key_idx = ?
       WHERE user_id = ? AND contact_profile_id = ?
     |]
-    (displayName, fullName, shortDescr, image, updatedAt, userId, profileId)
+    ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (userId, profileId))
 
 -- update only member profile fields (when member has associated contact - we keep contactLink and prefs)
-updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
-updateMemberContactProfile_ db userId profileId profile = do
+updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
+updateMemberContactProfile_ db userId profileId profile badgeVerified = do
   currentTs <- getCurrentTime
-  updateMemberContactProfile_' db userId profileId profile currentTs
+  updateMemberContactProfile_' db userId profileId profile badgeVerified currentTs
 
-updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
-updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image} updatedAt = do
+updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
+updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, badge} badgeVerified updatedAt =
   DB.execute
     db
     [sql|
       UPDATE contact_profiles
-      SET display_name = ?, full_name = ?, short_descr = ?, image = ?, updated_at = ?
+      SET display_name = ?, full_name = ?, short_descr = ?, image = ?, updated_at = ?,
+          badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?
       WHERE user_id = ? AND contact_profile_id = ?
     |]
-    (displayName, fullName, shortDescr, image, updatedAt, userId, profileId)
+    ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (userId, profileId))
 
 updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
 updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt = do
@@ -756,15 +765,15 @@ updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt
     (newName, updatedAt, userId, contactId)
   safeDeleteLDN db user displayName
 
-getContactByName :: DB.Connection -> VersionRangeChat -> User -> ContactName -> ExceptT StoreError IO Contact
-getContactByName db vr user localDisplayName = do
+getContactByName :: DB.Connection -> StoreCxt -> User -> ContactName -> ExceptT StoreError IO Contact
+getContactByName db cxt user localDisplayName = do
   cId <- getContactIdByName db user localDisplayName
-  getContact db vr user cId
+  getContact db cxt user cId
 
-getUserContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
-getUserContacts db vr user@User {userId} = do
+getUserContacts :: DB.Connection -> StoreCxt -> User -> IO [Contact]
+getUserContacts db cxt user@User {userId} = do
   contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0" (Only userId)
-  contacts <- rights <$> mapM (runExceptT . getContact db vr user) contactIds
+  contacts <- rights <$> mapM (runExceptT . getContact db cxt user) contactIds
   pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts
 
 getUserContactLinkIdByCReq :: DB.Connection -> Int64 -> ExceptT StoreError IO (Maybe Int64)
@@ -773,18 +782,21 @@ getUserContactLinkIdByCReq db contactRequestId =
     DB.query db "SELECT user_contact_link_id FROM contact_requests WHERE contact_request_id = ?" (Only contactRequestId)
 
 getContactRequest :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO UserContactRequest
-getContactRequest db User {userId} contactRequestId =
-  ExceptT . firstRow toContactRequest (SEContactRequestNotFound contactRequestId) $
+getContactRequest db User {userId} contactRequestId = do
+  currentTs <- liftIO getCurrentTime
+  ExceptT . firstRow (toContactRequest currentTs) (SEContactRequestNotFound contactRequestId) $
     DB.query db (contactRequestQuery <> " WHERE cr.user_id = ? AND cr.contact_request_id = ?") (userId, contactRequestId)
 
 getContactRequest' :: DB.Connection -> User -> Int64 -> IO (Maybe UserContactRequest)
-getContactRequest' db User {userId} contactRequestId =
-  maybeFirstRow toContactRequest $
+getContactRequest' db User {userId} contactRequestId = do
+  currentTs <- getCurrentTime
+  maybeFirstRow (toContactRequest currentTs) $
     DB.query db (contactRequestQuery <> " WHERE cr.user_id = ? AND cr.contact_request_id = ?") (userId, contactRequestId)
 
 getBusinessContactRequest :: DB.Connection -> User -> GroupId -> IO (Maybe UserContactRequest)
-getBusinessContactRequest db _user groupId =
-  maybeFirstRow toContactRequest $
+getBusinessContactRequest db _user groupId = do
+  currentTs <- getCurrentTime
+  maybeFirstRow (toContactRequest currentTs) $
     DB.query db (contactRequestQuery <> " WHERE cr.business_group_id = ?") (Only groupId)
 
 contactRequestQuery :: Query
@@ -793,10 +805,11 @@ contactRequestQuery =
     SELECT
       cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
       cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
-      cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
+      cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, cr.xcontact_id,
       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
+      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_master_key, p.badge_signature, p.badge_key_idx
     FROM contact_requests cr
     JOIN contact_profiles p USING (contact_profile_id)
   |]
@@ -832,7 +845,7 @@ deleteContactRequest db User {userId} contactRequestId = do
     (userId, userId, contactRequestId, userId)
   DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
 
-createContactFromRequest :: DB.Connection -> User -> Maybe Int64 -> ConnId -> VersionChat -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQSupport -> Bool -> IO (Contact, Connection)
+createContactFromRequest :: DB.Connection -> User -> Maybe Int64 -> ConnId -> VersionChat -> VersionRangeChat -> ContactName -> ProfileId -> LocalProfile -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQSupport -> Bool -> IO (Contact, Connection)
 createContactFromRequest db user@User {userId, profile = LocalProfile {preferences}} uclId_ agentConnId connChatVersion cReqChatVRange localDisplayName profileId profile xContactId incognitoProfile subMode pqSup contactUsed = do
   currentTs <- getCurrentTime
   let userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
@@ -848,7 +861,7 @@ createContactFromRequest db user@User {userId, profile = LocalProfile {preferenc
         Contact
           { contactId,
             localDisplayName,
-            profile = toLocalProfile profileId profile "",
+            profile,
             activeConn = Just conn,
             contactUsed,
             contactStatus = CSActive,
@@ -890,22 +903,23 @@ getContactIdByName db User {userId} cName =
   ExceptT . firstRow fromOnly (SEContactNotFoundByName cName) $
     DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND local_display_name = ? AND deleted = 0" (userId, cName)
 
-getContactViaShortLinkToConnect :: forall c. ConnectionModeI c => DB.Connection -> VersionRangeChat -> User -> ConnShortLink c -> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
-getContactViaShortLinkToConnect db vr user@User {userId} shortLink = do
+getContactViaShortLinkToConnect :: forall c. ConnectionModeI c => DB.Connection -> StoreCxt -> User -> ConnShortLink c -> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
+getContactViaShortLinkToConnect db cxt user@User {userId} shortLink = do
   liftIO (maybeFirstRow id $ DB.query db "SELECT contact_id, conn_full_link_to_connect FROM contacts WHERE user_id = ? AND conn_short_link_to_connect = ?" (userId, shortLink)) >>= \case
     Just (ctId :: Int64, Just (ACR cMode cReq)) ->
       case testEquality cMode (sConnectionMode @c) of
-        Just Refl -> Just . (cReq,) <$> getContact db vr user ctId
+        Just Refl -> Just . (cReq,) <$> getContact db cxt user ctId
         Nothing -> pure Nothing
     _ -> pure Nothing
 
-getContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
-getContact db vr user contactId = getContact_ db vr user contactId False
+getContact :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO Contact
+getContact db cxt user contactId = getContact_ db cxt user contactId False
 
-getContact_ :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
-getContact_ db vr user@User {userId} contactId deleted = do
+getContact_ :: DB.Connection -> StoreCxt -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
+getContact_ db cxt user@User {userId} contactId deleted = do
+  currentTs <- liftIO getCurrentTime
   chatTags <- liftIO $ getDirectChatTags db contactId
-  ExceptT . firstRow (toContact vr user chatTags) (SEContactNotFound contactId) $
+  ExceptT . firstRow (toContact currentTs cxt user chatTags) (SEContactNotFound contactId) $
     DB.query
       db
       [sql|
@@ -915,6 +929,7 @@ getContact_ db vr 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_master_key, cp.badge_signature, cp.badge_key_idx,
           -- 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,
@@ -928,12 +943,13 @@ getContact_ db vr user@User {userId} contactId deleted = do
       (userId, contactId, BI deleted)
 
 getUserByContactRequestId :: DB.Connection -> Int64 -> ExceptT StoreError IO User
-getUserByContactRequestId db contactRequestId =
-  ExceptT . firstRow toUser (SEUserNotFoundByContactRequestId contactRequestId) $
+getUserByContactRequestId db contactRequestId = do
+  now <- liftIO getCurrentTime
+  ExceptT . firstRow (toUser now) (SEUserNotFoundByContactRequestId contactRequestId) $
     DB.query db (userQuery <> " JOIN contact_requests cr ON cr.user_id = u.user_id WHERE cr.contact_request_id = ?") (Only contactRequestId)
 
-getContactConnections :: DB.Connection -> VersionRangeChat -> UserId -> Contact -> IO [Connection]
-getContactConnections db vr userId Contact {contactId} =
+getContactConnections :: DB.Connection -> StoreCxt -> UserId -> Contact -> IO [Connection]
+getContactConnections db cxt userId Contact {contactId} =
   connections =<< liftIO getConnections_
   where
     getConnections_ =
@@ -950,11 +966,11 @@ getContactConnections db vr userId Contact {contactId} =
         |]
         (userId, userId, contactId)
     connections [] = pure []
-    connections rows = pure $ map (toConnection vr) rows
+    connections rows = pure $ map (toConnection cxt) rows
 
-getConnectionById :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Connection
-getConnectionById db vr User {userId} connId = ExceptT $ do
-  firstRow (toConnection vr) (SEConnectionNotFoundById connId) $
+getConnectionById :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO Connection
+getConnectionById db cxt User {userId} connId = ExceptT $ do
+  firstRow (toConnection cxt) (SEConnectionNotFoundById connId) $
     DB.query
       db
       [sql|

src/Simplex/Chat/Store/Files.hs

@@ -31,12 +31,19 @@ module Simplex.Chat.Store.Files
     getSharedMsgIdByFileId,
     getFileIdBySharedMsgId,
     getGroupFileIdBySharedMsgId,
+    getGroupRcvFileId,
+    getGroupRosterFileInfo,
+    deleteGroupRosterFile,
+    getRosterTransferFile,
+    deleteRosterTransferFile,
+    getRcvFileLastChunkNo,
     getDirectFileIdBySharedMsgId,
     getChatRefByFileId,
     lookupChatRefByFileId,
     updateSndFileStatus,
     createRcvFileTransfer,
     createRcvGroupFileTransfer,
+    createRosterRcvFile,
     createRcvStandaloneFileTransfer,
     appendRcvFD,
     getRcvFileDescrByRcvFileId,
@@ -79,6 +86,7 @@ import Data.Functor ((<&>))
 import Data.Int (Int64)
 import Data.Maybe (fromMaybe, isJust, listToMaybe)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time (addUTCTime)
 import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
 import Data.Type.Equality
@@ -320,6 +328,64 @@ getGroupFileIdBySharedMsgId db userId groupId sharedMsgId =
       |]
       (userId, groupId, sharedMsgId)
 
+-- Resolve the in-flight received group inline file for a chunk: read its file_type by shared_msg_id
+-- (LIMIT 1 is safe -- all files sharing a shared_msg_id share a type), then look up by type: a roster
+-- file is scoped to its source relay (every relay re-serves the owner's same shared_msg_id, so the source
+-- disambiguates), a normal file is by shared_msg_id. Nothing => no in-flight transfer (orphaned chunk).
+getGroupRcvFileId :: DB.Connection -> UserId -> Int64 -> GroupMemberId -> SharedMsgId -> IO (Maybe Int64)
+getGroupRcvFileId db userId groupId fromMemberId sharedMsgId = do
+  fileType_ <- getFileType
+  case fileType_ of
+    Just FTRoster ->
+      maybeFirstRow fromOnly $
+        DB.query db (rcvFileIdQ <> " AND r.group_member_id = ?") (userId, groupId, sharedMsgId, FTRoster, fromMemberId)
+    Just FTNormal ->
+      maybeFirstRow fromOnly $
+        DB.query db rcvFileIdQ (userId, groupId, sharedMsgId, FTNormal)
+    Nothing -> pure Nothing
+  where
+    getFileType =
+      maybeFirstRow fromOnly $
+        DB.query db "SELECT file_type FROM files WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? LIMIT 1" (userId, groupId, sharedMsgId)
+    rcvFileIdQ =
+      [sql|
+        SELECT f.file_id FROM files f
+        JOIN rcv_files r ON r.file_id = f.file_id
+        WHERE f.user_id = ? AND f.group_id = ? AND f.shared_msg_id = ? AND f.file_type = ?
+      |]
+
+-- The roster scratch file for a transfer (for fs/handle cleanup before deleting the transfer).
+-- A transfer owns exactly one file (created together in one transaction), so this is single-valued.
+getRosterTransferFile :: DB.Connection -> Int64 -> IO (Maybe (Int64, Maybe FilePath))
+getRosterTransferFile db transferId =
+  maybeFirstRow id $ DB.query db "SELECT file_id, file_path FROM files WHERE roster_transfer_id = ?" (Only transferId)
+
+-- Deletes a transfer's file row; rcv_files and rcv_file_chunks cascade on the FK.
+deleteRosterTransferFile :: DB.Connection -> Int64 -> IO ()
+deleteRosterTransferFile db transferId =
+  DB.execute db "DELETE FROM files WHERE roster_transfer_id = ?" (Only transferId)
+
+-- For roster-file cleanup keyed on the group (not a chat item): every matching file_id and its on-disk
+-- path, so the caller evicts the handle and removes the file for each — delete-all like deleteGroupRosterFile.
+getGroupRosterFileInfo :: DB.Connection -> UserId -> Int64 -> IO [(Int64, Maybe FilePath)]
+getGroupRosterFileInfo db userId groupId =
+  DB.query
+    db
+    "SELECT file_id, file_path FROM files WHERE user_id = ? AND group_id = ? AND file_type = ?"
+    (userId, groupId, FTRoster)
+
+-- Deletes the roster files row; rcv_files and rcv_file_chunks cascade on the FK.
+deleteGroupRosterFile :: DB.Connection -> UserId -> Int64 -> IO ()
+deleteGroupRosterFile db userId groupId =
+  DB.execute db "DELETE FROM files WHERE user_id = ? AND group_id = ? AND file_type = ?" (userId, groupId, FTRoster)
+
+-- The highest stored chunk number, or Nothing if no partial chunks exist (used to decide
+-- whether an arriving chunk 1 is a re-driven transfer that must reset).
+getRcvFileLastChunkNo :: DB.Connection -> RcvFileTransfer -> IO (Maybe Integer)
+getRcvFileLastChunkNo db RcvFileTransfer {fileId} =
+  maybeFirstRow fromOnly $
+    DB.query db "SELECT chunk_number FROM rcv_file_chunks WHERE file_id = ? ORDER BY chunk_number DESC LIMIT 1" (Only fileId)
+
 getDirectFileIdBySharedMsgId :: DB.Connection -> User -> Contact -> SharedMsgId -> ExceptT StoreError IO Int64
 getDirectFileIdBySharedMsgId db User {userId} Contact {contactId} sharedMsgId =
   ExceptT . firstRow fromOnly (SEFileIdNotFoundBySharedMsgId sharedMsgId) $
@@ -378,10 +444,10 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
       db
       "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
       (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, rfdId, currentTs, currentTs)
-  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing, cryptoArgs = Nothing}
+  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, fileType = FTNormal, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing, cryptoArgs = Nothing}
 
-createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupInfo -> Maybe GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
-createRcvGroupFileTransfer db userId GroupInfo {groupId, localDisplayName = gName} m_ f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
+createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupInfo -> Maybe GroupMember -> FileType -> Maybe SharedMsgId -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
+createRcvGroupFileTransfer db userId GroupInfo {groupId, localDisplayName = gName} m_ fileType sharedMsgId_ f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
   currentTs <- liftIO getCurrentTime
   rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
   let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_
@@ -393,15 +459,34 @@ createRcvGroupFileTransfer db userId GroupInfo {groupId, localDisplayName = gNam
   fileId <- liftIO $ do
     DB.execute
       db
-      "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
-      (userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, fileProtocol, currentTs, currentTs)
+      "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, file_type, shared_msg_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
+      (userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, fileProtocol, fileType, sharedMsgId_, currentTs, currentTs)
     insertedRowId db
   liftIO $
     DB.execute
       db
       "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
       (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, grpMemberId_, rfdId, currentTs, currentTs)
-  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = senderName, chunkSize, cancelled = False, grpMemberId = grpMemberId_, cryptoArgs = Nothing}
+  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, fileType, rcvFileInline, senderDisplayName = senderName, chunkSize, cancelled = False, grpMemberId = grpMemberId_, cryptoArgs = Nothing}
+
+-- Roster scratch file owned by a per-source transfer: group_member_id is the delivering relay (so chunk
+-- streams from different relays are distinct files), roster_transfer_id links to the metadata record.
+createRosterRcvFile :: DB.Connection -> UserId -> GroupInfo -> GroupMember -> Int64 -> SharedMsgId -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
+createRosterRcvFile db userId GroupInfo {groupId} src@GroupMember {localDisplayName = senderName} transferId sharedMsgId f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
+  currentTs <- liftIO getCurrentTime
+  let grpMemberId_ = groupMemberId' src
+  fileId <- liftIO $ do
+    DB.execute
+      db
+      "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, file_type, shared_msg_id, roster_transfer_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)"
+      ((userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, FPSMP, FTRoster) :. (sharedMsgId, transferId, currentTs, currentTs))
+    insertedRowId db
+  liftIO $
+    DB.execute
+      db
+      "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
+      (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, grpMemberId_, currentTs, currentTs)
+  pure RcvFileTransfer {fileId, xftpRcvFile = Nothing, fileInvitation = f, fileStatus = RFSNew, fileType = FTRoster, rcvFileInline, senderDisplayName = senderName, chunkSize, cancelled = False, grpMemberId = Just grpMemberId_, cryptoArgs = Nothing}
 
 createRcvStandaloneFileTransfer :: DB.Connection -> UserId -> CryptoFile -> Int64 -> Word32 -> ExceptT StoreError IO Int64
 createRcvStandaloneFileTransfer db userId (CryptoFile filePath cfArgs_) fileSize chunkSize = do
@@ -422,7 +507,7 @@ createRcvStandaloneFileTransfer db userId (CryptoFile filePath cfArgs_) fileSize
 
 createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr
 createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
-  when (fileDescrPartNo /= 0) $ throwError SERcvFileInvalidDescrPart
+  when (fileDescrPartNo /= 0 || not (rcvFileDescrWithinLimits fileDescrPartNo fileDescrText)) $ throwError SERcvFileInvalidDescrPart
   fileDescrId <- liftIO $ do
     DB.execute
       db
@@ -450,8 +535,8 @@ appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileD
           fileDescrPartNo = rfdPNo,
           fileDescrComplete = rfdComplete
         } -> do
-        when (fileDescrPartNo /= rfdPNo + 1 || rfdComplete) $ throwError SERcvFileInvalidDescrPart
         let fileDescrText' = rfdText <> fileDescrText
+        when (fileDescrPartNo /= rfdPNo + 1 || rfdComplete || not (rcvFileDescrWithinLimits fileDescrPartNo fileDescrText')) $ throwError SERcvFileInvalidDescrPart
         liftIO $
           DB.execute
             db
@@ -463,6 +548,23 @@ appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileD
             (fileDescrText', fileDescrPartNo, BI fileDescrComplete, fileDescrId)
         pure RcvFileDescr {fileDescrId, fileDescrText = fileDescrText', fileDescrPartNo, fileDescrComplete}
 
+-- Upper bounds sized above the largest legitimate received description; derived from simplexmq's
+-- chunk tiers and redundancy, so a change there must revisit them.
+-- ~1280 chunks max = maxFileSizeHard (5gb) / largest chunk tier (4mb).
+-- ~150 chars per chunk in the description YAML = replicaId 24 + Ed25519 key 64 + SHA-256 digest 44 + chunkNo/colons.
+-- Total ~0.18 MB at 1 replica/chunk (~0.42 MB at 3x), under the 1mb text and 1024 part caps.
+maxRcvFileDescrParts :: Int
+maxRcvFileDescrParts = 1024
+
+maxRcvFileDescrTextLength :: Int
+maxRcvFileDescrTextLength = 1024 * 1024
+
+rcvFileDescrWithinLimits :: Int -> Text -> Bool
+rcvFileDescrWithinLimits partNo descrText =
+  partNo >= 0
+    && partNo <= maxRcvFileDescrParts
+    && T.length descrText <= maxRcvFileDescrTextLength
+
 getRcvFileDescrByRcvFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
 getRcvFileDescrByRcvFileId db fileId = do
   liftIO (getRcvFileDescrByRcvFileId_ db fileId) >>= \case
@@ -530,7 +632,7 @@ getRcvFileTransfer_ db userId fileId = do
           SELECT r.file_status, r.file_queue_info, r.group_member_id, f.file_name,
             f.file_size, f.chunk_size, f.cancelled, cs.local_display_name, m.local_display_name,
             f.file_path, f.file_crypto_key, f.file_crypto_nonce, r.file_inline, r.rcv_file_inline,
-            r.agent_rcv_file_id, r.agent_rcv_file_deleted, r.user_approved_relays, g.local_display_name
+            r.agent_rcv_file_id, r.agent_rcv_file_deleted, r.user_approved_relays, g.local_display_name, f.file_type
           FROM rcv_files r
           JOIN files f USING (file_id)
           LEFT JOIN contacts cs ON cs.contact_id = f.contact_id
@@ -544,9 +646,9 @@ getRcvFileTransfer_ db userId fileId = do
   where
     rcvFileTransfer ::
       Maybe RcvFileDescr ->
-      (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe BoolInt) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, BoolInt, BoolInt) :. Only (Maybe ContactName) ->
+      (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe BoolInt) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, BoolInt, BoolInt) :. (Maybe ContactName, FileType) ->
       ExceptT StoreError IO RcvFileTransfer
-    rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, BI agentRcvFileDeleted, BI userApprovedRelays) :. Only groupName_) =
+    rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, BI agentRcvFileDeleted, BI userApprovedRelays) :. (groupName_, fileType)) =
       case contactName_ <|> memberName_ <|> groupName_ <|> standaloneName_ of
         Nothing -> throwError $ SERcvFileInvalid fileId
         Just name ->
@@ -564,25 +666,25 @@ getRcvFileTransfer_ db userId fileId = do
           let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
               cryptoArgs = CFArgs <$> fileKey <*> fileNonce
               xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted, userApprovedRelays}) <$> rfd_
-           in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId, cryptoArgs}
+           in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, fileType, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId, cryptoArgs}
         filePath = case filePath_ of
           Nothing -> throwError $ SERcvFileInvalid fileId
           Just fp -> pure fp
         cancelled = maybe False unBI cancelled_
 
-acceptRcvInlineFT :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
-acceptRcvInlineFT db vr user fileId filePath = do
+acceptRcvInlineFT :: DB.Connection -> StoreCxt -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
+acceptRcvInlineFT db cxt user fileId filePath = do
   liftIO $ acceptRcvFT_ db user fileId filePath False (Just IFMOffer) =<< getCurrentTime
-  getChatItemByFileId db vr user fileId
+  getChatItemByFileId db cxt user fileId
 
 startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Maybe InlineFileMode -> IO ()
 startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline =
   acceptRcvFT_ db user fileId filePath False rcvFileInline =<< getCurrentTime
 
-xftpAcceptRcvFT :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> FilePath -> Bool -> ExceptT StoreError IO AChatItem
-xftpAcceptRcvFT db vr user fileId filePath userApprovedRelays = do
+xftpAcceptRcvFT :: DB.Connection -> StoreCxt -> User -> FileTransferId -> FilePath -> Bool -> ExceptT StoreError IO AChatItem
+xftpAcceptRcvFT db cxt user fileId filePath userApprovedRelays = do
   liftIO $ acceptRcvFT_ db user fileId filePath userApprovedRelays Nothing =<< getCurrentTime
-  getChatItemByFileId db vr user fileId
+  getChatItemByFileId db cxt user fileId
 
 acceptRcvFT_ :: DB.Connection -> User -> FileTransferId -> FilePath -> Bool -> Maybe InlineFileMode -> UTCTime -> IO ()
 acceptRcvFT_ db User {userId} fileId filePath userApprovedRelays rcvFileInline currentTs = do
@@ -660,7 +762,15 @@ createRcvFileChunk db RcvFileTransfer {fileId, fileInvitation = FileInvitation {
     currentTs <- getCurrentTime
     DB.execute
       db
-      "INSERT OR REPLACE INTO rcv_file_chunks (file_id, chunk_number, chunk_agent_msg_id, created_at, updated_at) VALUES (?,?,?,?,?)"
+      [sql|
+        INSERT INTO rcv_file_chunks (file_id, chunk_number, chunk_agent_msg_id, created_at, updated_at)
+        VALUES (?,?,?,?,?)
+        ON CONFLICT (file_id, chunk_number) DO UPDATE SET
+          chunk_agent_msg_id = excluded.chunk_agent_msg_id,
+          chunk_stored = 0,
+          created_at = excluded.created_at,
+          updated_at = excluded.updated_at
+      |]
       (fileId, chunkNo, msgId, currentTs, currentTs)
   pure status
   where
@@ -860,9 +970,9 @@ getLocalCryptoFile db userId fileId sent =
       pure $ CryptoFile filePath fileCryptoArgs
     _ -> throwError $ SEFileNotFound fileId
 
-updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRangeChat -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
-updateDirectCIFileStatus db vr user fileId fileStatus = do
-  aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db vr user fileId
+updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> StoreCxt -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
+updateDirectCIFileStatus db cxt user fileId fileStatus = do
+  aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db cxt user fileId
   case (cType, testEquality d $ msgDirection @d) of
     (SCTDirect, Just Refl) -> do
       liftIO $ updateCIFileStatus db user fileId fileStatus

src/Simplex/Chat/Store/Messages.hs

@@ -137,6 +137,7 @@ module Simplex.Chat.Store.Messages
     getGroupSndStatuses,
     getGroupSndStatusCounts,
     getGroupHistoryItems,
+    getGroupWebPreviewItems,
   )
 where
 
@@ -237,10 +238,7 @@ createNewSndMessage db gVar connOrGroupId chatMsgEvent msgSigning_ encodeMessage
     case encodeMessage (SharedMsgId sharedMsgId) of
       ECMLarge -> pure $ Left SELargeMsg
       ECMEncoded msgBody -> do
-        let signedMsg_ = signBody <$> msgSigning_
-            signBody MsgSigning {bindingTag, bindingData, keyRef, privKey} =
-              let sig = C.ASignature C.SEd25519 $ C.sign' privKey (encodeChatBinding bindingTag bindingData <> msgBody)
-               in SignedMsg {chatBinding = bindingTag, signatures = MsgSignature keyRef sig :| [], signedBody = msgBody}
+        let signedMsg_ = (`signChatMsgBody` msgBody) <$> msgSigning_
         createdAt <- getCurrentTime
         DB.execute
           db
@@ -406,8 +404,8 @@ data MemberAttention
   | MAReset
   deriving (Show)
 
-updateChatTsStats :: DB.Connection -> VersionRangeChat -> User -> ChatDirection c d -> UTCTime -> Maybe (Int, MemberAttention, Int) -> IO (ChatInfo c)
-updateChatTsStats db vr user@User {userId} chatDirection chatTs chatStats_ = case toChatInfo chatDirection of
+updateChatTsStats :: DB.Connection -> StoreCxt -> User -> ChatDirection c d -> UTCTime -> Maybe (Int, MemberAttention, Int) -> IO (ChatInfo c)
+updateChatTsStats db cxt user@User {userId} chatDirection chatTs chatStats_ = case toChatInfo chatDirection of
   DirectChat ct@Contact {contactId} -> do
     DB.execute
       db
@@ -516,7 +514,7 @@ updateChatTsStats db vr user@User {userId} chatDirection chatTs chatStats_ = cas
                 WHERE group_member_id = ?
               |]
               (chatTs, unread, mentions, groupMemberId)
-        m_ <- runExceptT $ getGroupMemberById db vr user groupMemberId
+        m_ <- runExceptT $ getGroupMemberById db cxt user groupMemberId
         pure $ either (const m) id m_ -- Left shouldn't happen, but types require it
   LocalChat nf@NoteFolder {noteFolderId} -> do
     DB.execute
@@ -530,8 +528,8 @@ setSupportChatTs :: DB.Connection -> GroupMemberId -> UTCTime -> IO ()
 setSupportChatTs db groupMemberId chatTs =
   DB.execute db "UPDATE group_members SET support_chat_ts = ? WHERE group_member_id = ?" (chatTs, groupMemberId)
 
-setSupportChatMemberAttention :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> Int64 -> IO (GroupInfo, GroupMember)
-setSupportChatMemberAttention db vr user g m memberAttention = do
+setSupportChatMemberAttention :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> Int64 -> IO (GroupInfo, GroupMember)
+setSupportChatMemberAttention db cxt user g m memberAttention = do
   m' <- updateGMAttention
   g' <- updateGroupMembersRequireAttention db user g m m'
   pure (g', m')
@@ -542,7 +540,7 @@ setSupportChatMemberAttention db vr user g m memberAttention = do
         db
         "UPDATE group_members SET support_chat_items_member_attention = ?, updated_at = ? WHERE group_member_id = ?"
         (memberAttention, currentTs, groupMemberId' m)
-      m_ <- runExceptT $ getGroupMemberById db vr user (groupMemberId' m)
+      m_ <- runExceptT $ getGroupMemberById db cxt user (groupMemberId' m)
       pure $ either (const m) id m_ -- Left shouldn't happen, but types require it
 
 createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> ShowGroupAsSender -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> UTCTime -> IO ChatItemId
@@ -583,9 +581,9 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, msgS
           CDChannelRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ ->
             (Just $ Just userMemberId == memberId, memberId)
 
-createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Bool -> UTCTime -> UTCTime -> IO ChatItemId
-createNewChatItemNoMsg db user chatDirection showGroupAsSender ciContent sharedMsgId_ hasLink itemTs =
-  createNewChatItem_ db user chatDirection showGroupAsSender Nothing sharedMsgId_ ciContent quoteRow Nothing Nothing False False hasLink itemTs Nothing Nothing
+createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Bool -> Maybe MsgSigStatus -> UTCTime -> UTCTime -> IO ChatItemId
+createNewChatItemNoMsg db user chatDirection showGroupAsSender ciContent sharedMsgId_ hasLink msgSigned itemTs =
+  createNewChatItem_ db user chatDirection showGroupAsSender Nothing sharedMsgId_ ciContent quoteRow Nothing Nothing False False hasLink itemTs Nothing msgSigned
   where
     quoteRow :: NewQuoteRow
     quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
@@ -662,7 +660,8 @@ insertChatItemMessage_ :: DB.Connection -> ChatItemId -> MessageId -> UTCTime ->
 insertChatItemMessage_ db ciId msgId ts = DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" (ciId, msgId, ts, ts)
 
 getChatItemQuote_ :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
-getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId}, content} =
+getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId}, content} = do
+  currentTs <- getCurrentTime
   case chatDirection of
     CDDirectRcv Contact {contactId} -> getDirectChatItemQuote_ contactId (not sent)
     CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} _s sender@GroupMember {groupMemberId = senderGMId, memberId = senderMemberId} ->
@@ -670,13 +669,13 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
         Just mId
           | mId == userMemberId -> (`ciQuote` CIQGroupSnd) <$> getUserGroupChatItemId_ groupId
           | mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender)) <$> getGroupChatItemId_ groupId senderGMId
-          | otherwise -> getGroupChatItemQuote_ groupId mId
+          | otherwise -> getGroupChatItemQuote_ currentTs groupId mId
         _ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing
     CDChannelRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} _s ->
       case memberId of
         Just mId
           | mId == userMemberId -> (`ciQuote` CIQGroupSnd) <$> getUserGroupChatItemId_ groupId
-          | otherwise -> getGroupChatItemQuote_ groupId mId
+          | otherwise -> getGroupChatItemQuote_ currentTs groupId mId
         _ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing
   where
     ciQuote :: Maybe ChatItemId -> CIQDirection c -> CIQuote c
@@ -705,8 +704,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
           db
           "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? AND item_sent = ? AND group_member_id = ?"
           (userId, groupId, msgId, MDRcv, groupMemberId)
-    getGroupChatItemQuote_ :: Int64 -> MemberId -> IO (CIQuote 'CTGroup)
-    getGroupChatItemQuote_ groupId mId = do
+    getGroupChatItemQuote_ :: UTCTime -> Int64 -> MemberId -> IO (CIQuote 'CTGroup)
+    getGroupChatItemQuote_ currentTs groupId mId = do
       ciQuoteGroup
         <$> DB.query
           db
@@ -716,6 +715,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_master_key, p.badge_signature, p.badge_key_idx,
               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
@@ -731,10 +731,10 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
       where
         ciQuoteGroup :: [Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup
         ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing
-        ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow
+        ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember currentTs userContactId memberRow
 
-getChatPreviews :: DB.Connection -> VersionRangeChat -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
-getChatPreviews db vr user withPCC pagination query = do
+getChatPreviews :: DB.Connection -> StoreCxt -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
+getChatPreviews db cxt user withPCC pagination query = do
   directChats <- findDirectChatPreviews_ db user pagination query
   groupChats <- findGroupChatPreviews_ db user pagination query
   localChats <- findLocalChatPreviews_ db user pagination query
@@ -756,8 +756,8 @@ getChatPreviews db vr user withPCC pagination query = do
       PTBefore _ count -> take count . sortBy (comparing $ Down . ts)
     getChatPreview :: AChatPreviewData -> ExceptT StoreError IO AChat
     getChatPreview (ACPD cType cpd) = case cType of
-      SCTDirect -> getDirectChatPreview_ db vr user cpd
-      SCTGroup -> getGroupChatPreview_ db vr user cpd
+      SCTDirect -> getDirectChatPreview_ db cxt user cpd
+      SCTGroup -> getGroupChatPreview_ db cxt user cpd
       SCTLocal -> getLocalChatPreview_ db user cpd
       SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat
       SCTContactConnection -> let (ContactConnectionPD _ chat) = cpd in pure chat
@@ -874,9 +874,9 @@ findDirectChatPreviews_ db User {userId} pagination clq =
       PTAfter ts count -> DB.query db (query <> " AND ct.chat_ts > ? ORDER BY ct.chat_ts ASC LIMIT ?") (params :. (ts, count))
       PTBefore ts count -> DB.query db (query <> " AND ct.chat_ts < ? ORDER BY ct.chat_ts DESC LIMIT ?") (params :. (ts, count))
 
-getDirectChatPreview_ :: DB.Connection -> VersionRangeChat -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
-getDirectChatPreview_ db vr user (DirectChatPD _ contactId lastItemId_ stats) = do
-  contact <- getContact db vr user contactId
+getDirectChatPreview_ :: DB.Connection -> StoreCxt -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
+getDirectChatPreview_ db cxt user (DirectChatPD _ contactId lastItemId_ stats) = do
+  contact <- getContact db cxt user contactId
   ts <- liftIO getCurrentTime
   lastItem <- case lastItemId_ of
     Just lastItemId -> do
@@ -985,9 +985,9 @@ findGroupChatPreviews_ db User {userId} pagination clq =
       PTAfter ts count -> DB.query db (query <> " AND g.chat_ts > ? ORDER BY g.chat_ts ASC LIMIT ?") (params :. (ts, count))
       PTBefore ts count -> DB.query db (query <> " AND g.chat_ts < ? ORDER BY g.chat_ts DESC LIMIT ?") (params :. (ts, count))
 
-getGroupChatPreview_ :: DB.Connection -> VersionRangeChat -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
-getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do
-  groupInfo <- getGroupInfo db vr user groupId
+getGroupChatPreview_ :: DB.Connection -> StoreCxt -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
+getGroupChatPreview_ db cxt user (GroupChatPD _ groupId lastItemId_ stats) = do
+  groupInfo <- getGroupInfo db cxt user groupId
   ts <- liftIO getCurrentTime
   lastItem <- case lastItemId_ of
     Just lastItemId -> do
@@ -1121,22 +1121,25 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
     ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
 
 getContactRequestChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
-getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
-  CLQFilters {favorite = False, unread = False} -> map toPreview <$> getPreviews ""
-  CLQFilters {favorite = True, unread = False} -> pure []
-  CLQFilters {favorite = False, unread = True} -> map toPreview <$> getPreviews ""
-  CLQFilters {favorite = True, unread = True} -> map toPreview <$> getPreviews ""
-  CLQSearch {search} -> map toPreview <$> getPreviews search
+getContactRequestChatPreviews_ db User {userId} pagination clq = do
+  currentTs <- getCurrentTime
+  case clq of
+    CLQFilters {favorite = False, unread = False} -> map (toPreview currentTs) <$> getPreviews ""
+    CLQFilters {favorite = True, unread = False} -> pure []
+    CLQFilters {favorite = False, unread = True} -> map (toPreview currentTs) <$> getPreviews ""
+    CLQFilters {favorite = True, unread = True} -> map (toPreview currentTs) <$> getPreviews ""
+    CLQSearch {search} -> map (toPreview currentTs) <$> getPreviews search
   where
     query =
       [sql|
         SELECT
           cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
           cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
-          cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
+          cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, cr.xcontact_id,
           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
+          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_master_key, p.badge_signature, p.badge_key_idx
         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
@@ -1158,9 +1161,9 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
       PTLast count -> DB.query db (query <> " ORDER BY cr.updated_at DESC LIMIT ?") (params search :. Only count)
       PTAfter ts count -> DB.query db (query <> " AND cr.updated_at > ? ORDER BY cr.updated_at ASC LIMIT ?") (params search :. (ts, count))
       PTBefore ts count -> DB.query db (query <> " AND cr.updated_at < ? ORDER BY cr.updated_at DESC LIMIT ?") (params search :. (ts, count))
-    toPreview :: ContactRequestRow -> AChatPreviewData
-    toPreview cReqRow =
-      let cReq@UserContactRequest {updatedAt} = toContactRequest cReqRow
+    toPreview :: UTCTime -> ContactRequestRow -> AChatPreviewData
+    toPreview now cReqRow =
+      let cReq@UserContactRequest {updatedAt} = toContactRequest now cReqRow
           aChat = AChat SCTContactRequest $ Chat (ContactRequest cReq) [] emptyChatStats
        in ACPD SCTContactRequest $ ContactRequestPD updatedAt aChat
 
@@ -1223,10 +1226,10 @@ getChatContentTypes db User {userId} (ChatRef cType chatId chatScope_) = case cT
           ("SELECT DISTINCT msg_content_tag FROM chat_items WHERE user_id = ? AND " <> cond <> " AND msg_content_tag IS NOT NULL ORDER BY msg_content_tag")
           ((userId, chatId) :. params)
 
-getDirectChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
-getDirectChat db vr user contactId contentFilter pagination search_ = do
+getDirectChat :: DB.Connection -> StoreCxt -> User -> Int64 -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
+getDirectChat db cxt user contactId contentFilter pagination search_ = do
   let search = fromMaybe "" search_
-  ct <- getContact db vr user contactId
+  ct <- getContact db cxt user contactId
   case pagination of
     CPLast count -> (,Nothing) <$> getDirectChatLast_ db user ct contentFilter count search
     CPAfter afterId count -> (,Nothing) <$> getDirectChatAfter_ db user ct contentFilter afterId count search
@@ -1443,11 +1446,11 @@ getContactNavInfo_ db User {userId} Contact {contactId} afterCI = do
               :. (userId, contactId, ciCreatedAt afterCI, cChatItemId afterCI)
           )
 
-getGroupChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Maybe GroupChatScope -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
-getGroupChat db vr user groupId scope_ contentFilter pagination search_ = do
+getGroupChat :: DB.Connection -> StoreCxt -> User -> Int64 -> Maybe GroupChatScope -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
+getGroupChat db cxt user groupId scope_ contentFilter pagination search_ = do
   let search = fromMaybe "" search_
-  g <- getGroupInfo db vr user groupId
-  scopeInfo <- mapM (getCreateGroupChatScopeInfo db vr user g) scope_
+  g <- getGroupInfo db cxt user groupId
+  scopeInfo <- mapM (getCreateGroupChatScopeInfo db cxt user g) scope_
   case pagination of
     CPLast count -> (,Nothing) <$> getGroupChatLast_ db user g scopeInfo contentFilter count search emptyChatStats
     CPAfter afterId count -> (,Nothing) <$> getGroupChatAfter_ db user g scopeInfo contentFilter afterId count search
@@ -1457,31 +1460,31 @@ getGroupChat db vr user groupId scope_ contentFilter pagination search_ = do
       unless (T.null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
       getGroupChatInitial_ db user g scopeInfo contentFilter count
 
-getCreateGroupChatScopeInfo :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
-getCreateGroupChatScopeInfo db vr user GroupInfo {membership} = \case
+getCreateGroupChatScopeInfo :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
+getCreateGroupChatScopeInfo db cxt user GroupInfo {membership} = \case
   GCSMemberSupport Nothing -> do
     when (isNothing $ supportChat membership) $ do
       ts <- liftIO getCurrentTime
       liftIO $ setSupportChatTs db (groupMemberId' membership) ts
     pure $ GCSIMemberSupport {groupMember_ = Nothing}
   GCSMemberSupport (Just gmId) -> do
-    m <- getGroupMemberById db vr user gmId
+    m <- getGroupMemberById db cxt user gmId
     when (isNothing $ supportChat m) $ do
       ts <- liftIO getCurrentTime
       liftIO $ setSupportChatTs db gmId ts
     pure GCSIMemberSupport {groupMember_ = Just m}
 
-getGroupChatScopeInfoForItem :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ChatItemId -> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
-getGroupChatScopeInfoForItem db vr user g itemId =
-  getGroupChatScopeForItem_ db itemId >>= mapM (getGroupChatScopeInfo db vr user g)
+getGroupChatScopeInfoForItem :: DB.Connection -> StoreCxt -> User -> GroupInfo -> ChatItemId -> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
+getGroupChatScopeInfoForItem db cxt user g itemId =
+  getGroupChatScopeForItem_ db itemId >>= mapM (getGroupChatScopeInfo db cxt user g)
 
-getGroupChatScopeInfo :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
-getGroupChatScopeInfo db vr user GroupInfo {membership} = \case
+getGroupChatScopeInfo :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
+getGroupChatScopeInfo db cxt user GroupInfo {membership} = \case
   GCSMemberSupport Nothing -> case supportChat membership of
     Nothing -> throwError $ SEInternalError "no moderators support chat"
     Just _supportChat -> pure $ GCSIMemberSupport {groupMember_ = Nothing}
   GCSMemberSupport (Just gmId) -> do
-    m <- getGroupMemberById db vr user gmId
+    m <- getGroupMemberById db cxt user gmId
     case supportChat m of
       Nothing -> throwError $ SEInternalError "no support chat"
       Just _supportChat -> pure GCSIMemberSupport {groupMember_ = Just m}
@@ -2087,8 +2090,8 @@ updateGroupChatItemsRead db User {userId} GroupInfo {groupId} = do
     |]
     (CISRcvRead, currentTs, userId, groupId, CISRcvNew)
 
-updateSupportChatItemsRead :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScopeInfo -> IO (GroupInfo, GroupMember)
-updateSupportChatItemsRead db vr user@User {userId} g@GroupInfo {groupId, membership} scopeInfo = do
+updateSupportChatItemsRead :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupChatScopeInfo -> IO (GroupInfo, GroupMember)
+updateSupportChatItemsRead db cxt user@User {userId} g@GroupInfo {groupId, membership} scopeInfo = do
   currentTs <- getCurrentTime
   case scopeInfo of
     GCSIMemberSupport {groupMember_} -> do
@@ -2126,7 +2129,7 @@ updateSupportChatItemsRead db vr user@User {userId} g@GroupInfo {groupId, member
           WHERE group_member_id = ?
         |]
         (currentTs, groupMemberId)
-      m_ <- runExceptT $ getGroupMemberById db vr user groupMemberId
+      m_ <- runExceptT $ getGroupMemberById db cxt user groupMemberId
       pure $ either (const m) id m_ -- Left shouldn't happen, but types require it
 
 getGroupUnreadTimedItems :: DB.Connection -> User -> GroupId -> Maybe GroupChatScope -> IO [(ChatItemId, Int)]
@@ -2154,8 +2157,8 @@ getGroupUnreadTimedItems db User {userId} groupId scope =
         |]
         (userId, groupId, GCSTMemberSupport_, groupMemberId_, CISRcvNew)
 
-updateGroupChatItemsReadList :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> NonEmpty ChatItemId -> ExceptT StoreError IO ([(ChatItemId, Int)], GroupInfo)
-updateGroupChatItemsReadList db vr user@User {userId} g@GroupInfo {groupId} scopeInfo_ itemIds = do
+updateGroupChatItemsReadList :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> NonEmpty ChatItemId -> ExceptT StoreError IO ([(ChatItemId, Int)], GroupInfo)
+updateGroupChatItemsReadList db cxt user@User {userId} g@GroupInfo {groupId} scopeInfo_ itemIds = do
   currentTs <- liftIO getCurrentTime
   -- Possible improvement is to differentiate retrieval queries for each scope,
   -- but we rely on UI to not pass item IDs from incorrect scope.
@@ -2164,7 +2167,7 @@ updateGroupChatItemsReadList db vr user@User {userId} g@GroupInfo {groupId} scop
     Nothing -> pure g
     Just scopeInfo@GCSIMemberSupport {groupMember_} -> do
       let decStats = countReadItems groupMember_ readItemsData
-      liftIO $ updateGroupScopeUnreadStats db vr user g scopeInfo decStats
+      liftIO $ updateGroupScopeUnreadStats db cxt user g scopeInfo decStats
   pure (timedItems readItemsData, g')
   where
     getUpdateGroupItem :: UTCTime -> ChatItemId -> IO (Maybe (ChatItemId, Maybe Int, Maybe UTCTime, Maybe GroupMemberId, Maybe BoolInt))
@@ -2199,8 +2202,8 @@ updateGroupChatItemsReadList db vr user@User {userId} g@GroupInfo {groupId} scop
         addTimedItem acc (itemId, Just ttl, Nothing, _, _) = (itemId, ttl) : acc
         addTimedItem acc _ = acc
 
-updateGroupScopeUnreadStats :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScopeInfo -> (Int, Int, Int) -> IO GroupInfo
-updateGroupScopeUnreadStats db vr user g@GroupInfo {membership} scopeInfo (unread, unanswered, mentions) =
+updateGroupScopeUnreadStats :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupChatScopeInfo -> (Int, Int, Int) -> IO GroupInfo
+updateGroupScopeUnreadStats db cxt user g@GroupInfo {membership} scopeInfo (unread, unanswered, mentions) =
   case scopeInfo of
     GCSIMemberSupport {groupMember_} -> case groupMember_ of
       Nothing -> do
@@ -2238,7 +2241,7 @@ updateGroupScopeUnreadStats db vr user g@GroupInfo {membership} scopeInfo (unrea
         |]
 #endif
         (unread, unanswered, mentions, currentTs, groupMemberId)
-      m_ <- runExceptT $ getGroupMemberById db vr user groupMemberId
+      m_ <- runExceptT $ getGroupMemberById db cxt user groupMemberId
       pure $ either (const m) id m_ -- Left shouldn't happen, but types require it
 
 setGroupChatItemsDeleteAt :: DB.Connection -> User -> GroupId -> [(ChatItemId, Int)] -> UTCTime -> IO [(ChatItemId, UTCTime)]
@@ -2368,9 +2371,9 @@ toGroupChatItem
     ) = do
     chatItem $ fromRight invalid $ dbParseACIContent itemContentText
     where
-      member_ = toMaybeGroupMember userContactId memberRow_
-      quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_
-      deletedByGroupMember_ = toMaybeGroupMember userContactId deletedByGroupMemberRow_
+      member_ = toMaybeGroupMember currentTs userContactId memberRow_
+      quotedMember_ = toMaybeGroupMember currentTs userContactId quotedMemberRow_
+      deletedByGroupMember_ = toMaybeGroupMember currentTs userContactId deletedByGroupMemberRow_
       invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
       chatItem itemContent = case (itemContent, itemStatus, member_, fileStatus_) of
         (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Just (AFS SMDSnd fileStatus)) ->
@@ -2413,8 +2416,8 @@ toGroupChatItem
       ciTimed :: Maybe CITimed
       ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
 
-getAllChatItems :: DB.Connection -> VersionRangeChat -> User -> ChatPagination -> Maybe Text -> ExceptT StoreError IO [AChatItem]
-getAllChatItems db vr user@User {userId} pagination search_ = do
+getAllChatItems :: DB.Connection -> StoreCxt -> User -> ChatPagination -> Maybe Text -> ExceptT StoreError IO [AChatItem]
+getAllChatItems db cxt user@User {userId} pagination search_ = do
   itemRefs <-
     rights . map toChatItemRef <$> case pagination of
       CPLast count -> liftIO $ getAllChatItemsLast_ count
@@ -2426,12 +2429,12 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
         liftIO getFirstUnreadItemId_ >>= \case
           Just itemId -> liftIO . getAllChatItemsAround_ itemId count . aChatItemTs =<< getAChatItem_ itemId
           Nothing -> liftIO $ getAllChatItemsLast_ count
-  mapM (uncurry (getAChatItem db vr user)) itemRefs
+  mapM (uncurry (getAChatItem db cxt user)) itemRefs
   where
     search = fromMaybe "" search_
     getAChatItem_ itemId = do
       chatRef <- getChatRefViaItemId db user itemId
-      getAChatItem db vr user chatRef itemId
+      getAChatItem db cxt user chatRef itemId
     getAllChatItemsLast_ count =
       reverse
         <$> DB.query
@@ -3067,6 +3070,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_master_key, p.badge_signature, p.badge_key_idx,
             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
@@ -3075,12 +3079,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_master_key, rp.badge_signature, rp.badge_key_idx,
             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_master_key, dbp.badge_signature, dbp.badge_key_idx,
             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
@@ -3239,8 +3245,8 @@ deleteLocalChatItem db User {userId} NoteFolder {noteFolderId} ci = do
     |]
     (userId, noteFolderId, itemId)
 
-getChatItemByFileId :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO AChatItem
-getChatItemByFileId db vr user@User {userId} fileId = do
+getChatItemByFileId :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO AChatItem
+getChatItemByFileId db cxt user@User {userId} fileId = do
   (chatRef, itemId) <-
     ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $
       DB.query
@@ -3253,16 +3259,16 @@ getChatItemByFileId db vr user@User {userId} fileId = do
             LIMIT 1
           |]
         (userId, fileId)
-  getAChatItem db vr user chatRef itemId
+  getAChatItem db cxt user chatRef itemId
 
-lookupChatItemByFileId :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
-lookupChatItemByFileId db vr user fileId = do
-  fmap Just (getChatItemByFileId db vr user fileId) `catchError` \case
+lookupChatItemByFileId :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
+lookupChatItemByFileId db cxt user fileId = do
+  fmap Just (getChatItemByFileId db cxt user fileId) `catchError` \case
     SEChatItemNotFoundByFileId {} -> pure Nothing
     e -> throwError e
 
-getChatItemByGroupId :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO AChatItem
-getChatItemByGroupId db vr user@User {userId} groupId = do
+getChatItemByGroupId :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO AChatItem
+getChatItemByGroupId db cxt user@User {userId} groupId = do
   (chatRef, itemId) <-
     ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $
       DB.query
@@ -3275,7 +3281,7 @@ getChatItemByGroupId db vr user@User {userId} groupId = do
           LIMIT 1
         |]
         (userId, groupId)
-  getAChatItem db vr user chatRef itemId
+  getAChatItem db cxt user chatRef itemId
 
 getChatRefViaItemId :: DB.Connection -> User -> ChatItemId -> ExceptT StoreError IO ChatRef
 getChatRefViaItemId db User {userId} itemId = do
@@ -3288,17 +3294,17 @@ getChatRefViaItemId db User {userId} itemId = do
       (Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId Nothing
       (_, _) -> Left $ SEBadChatItem itemId Nothing
 
-getAChatItem :: DB.Connection -> VersionRangeChat -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
-getAChatItem db vr user (ChatRef cType chatId scope) itemId = do
+getAChatItem :: DB.Connection -> StoreCxt -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
+getAChatItem db cxt user (ChatRef cType chatId scope) itemId = do
   aci <- case cType of
     CTDirect -> do
-      ct <- getContact db vr user chatId
+      ct <- getContact db cxt user chatId
       (CChatItem msgDir ci) <- getDirectChatItem db user chatId itemId
       pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci
     CTGroup -> do
-      gInfo <- getGroupInfo db vr user chatId
+      gInfo <- getGroupInfo db cxt user chatId
       (CChatItem msgDir ci) <- getGroupChatItem db user chatId itemId
-      scopeInfo <- mapM (getGroupChatScopeInfo db vr user gInfo) scope
+      scopeInfo <- mapM (getGroupChatScopeInfo db cxt user gInfo) scope
       pure $ AChatItem SCTGroup msgDir (GroupChat gInfo scopeInfo) ci
     CTLocal -> do
       nf <- getNoteFolder db user chatId
@@ -3474,8 +3480,8 @@ setGroupReaction db GroupInfo {groupId} m itemMemberId itemSharedMId sent reacti
         |]
         (groupId, groupMemberId' m, itemSharedMId, itemMemberId, BI sent, reaction)
 
-getReactionMembers :: DB.Connection -> VersionRangeChat -> User -> GroupId -> SharedMsgId -> MsgReaction -> IO [MemberReaction]
-getReactionMembers db vr user groupId itemSharedMId reaction = do
+getReactionMembers :: DB.Connection -> StoreCxt -> User -> GroupId -> SharedMsgId -> MsgReaction -> IO [MemberReaction]
+getReactionMembers db cxt user groupId itemSharedMId reaction = do
   reactions <-
     DB.query
       db
@@ -3489,7 +3495,7 @@ getReactionMembers db vr user groupId itemSharedMId reaction = do
   where
     toMemberReaction :: (GroupMemberId, UTCTime) -> ExceptT StoreError IO MemberReaction
     toMemberReaction (groupMemberId, reactionTs) = do
-      groupMember <- getGroupMemberById db vr user groupMemberId
+      groupMember <- getGroupMemberById db cxt user groupMemberId
       pure MemberReaction {groupMember, reactionTs}
 
 getTimedItems :: DB.Connection -> User -> UTCTime -> IO [((ChatRef, ChatItemId), UTCTime)]
@@ -3587,9 +3593,9 @@ createCIModeration db GroupInfo {groupId} moderatorMember itemMemberId itemShare
     |]
     (groupId, groupMemberId' moderatorMember, itemMemberId, itemSharedMId, msgId, moderatedAtTs)
 
-getCIModeration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
+getCIModeration :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
 getCIModeration _ _ _ _ _ Nothing = pure Nothing
-getCIModeration db vr user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do
+getCIModeration db cxt user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do
   r_ <-
     maybeFirstRow id $
       DB.query
@@ -3603,7 +3609,7 @@ getCIModeration db vr user GroupInfo {groupId} itemMemberId (Just sharedMsgId) =
         (groupId, itemMemberId, sharedMsgId)
   case r_ of
     Just (moderationId, moderatorId, createdByMsgId, moderatedAt) -> do
-      runExceptT (getGroupMember db vr user groupId moderatorId) >>= \case
+      runExceptT (getGroupMember db cxt user groupId moderatorId) >>= \case
         Right moderatorMember -> pure (Just CIModeration {moderationId, moderatorMember, createdByMsgId, moderatedAt})
         _ -> pure Nothing
     _ -> pure Nothing
@@ -3708,3 +3714,21 @@ getGroupHistoryItems db user@User {userId} g@GroupInfo {groupId} m count = do
             LIMIT ?
           |]
           (groupMemberId' m, userId, groupId, count)
+
+getGroupWebPreviewItems :: DB.Connection -> User -> GroupInfo -> Int -> IO [Either StoreError (CChatItem 'CTGroup)]
+getGroupWebPreviewItems db user@User {userId} g@GroupInfo {groupId} count = do
+  ciIds <-
+    map fromOnly
+      <$> DB.query
+        db
+        [sql|
+          SELECT i.chat_item_id
+          FROM chat_items i
+          WHERE i.user_id = ? AND i.group_id = ?
+            AND i.include_in_history = 1
+            AND i.item_deleted = 0
+          ORDER BY i.item_ts DESC, i.chat_item_id DESC
+          LIMIT ?
+        |]
+        (userId, groupId, count)
+  reverse <$> mapM (runExceptT . getGroupCIWithReactions db user g) ciIds

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

@@ -32,9 +32,12 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260429_relay_request_retries
 import Simplex.Chat.Store.Postgres.Migrations.M20260507_relay_inactive_at
 import Simplex.Chat.Store.Postgres.Migrations.M20260514_relay_request_group_link_index
 import Simplex.Chat.Store.Postgres.Migrations.M20260515_public_group_access
+import Simplex.Chat.Store.Postgres.Migrations.M20260516_supporter_badges
 import Simplex.Chat.Store.Postgres.Migrations.M20260529_delivery_job_senders
 import Simplex.Chat.Store.Postgres.Migrations.M20260530_client_services
 import Simplex.Chat.Store.Postgres.Migrations.M20260531_member_removed_at
+import Simplex.Chat.Store.Postgres.Migrations.M20260601_relay_sent_web_domain
+import Simplex.Chat.Store.Postgres.Migrations.M20260602_group_roster
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Text, Maybe Text)]
@@ -67,9 +70,12 @@ schemaMigrations =
     ("20260507_relay_inactive_at", m20260507_relay_inactive_at, Just down_m20260507_relay_inactive_at),
     ("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index),
     ("20260515_public_group_access", m20260515_public_group_access, Just down_m20260515_public_group_access),
+    ("20260516_supporter_badges", m20260516_supporter_badges, Just down_m20260516_supporter_badges),
     ("20260529_delivery_job_senders", m20260529_delivery_job_senders, Just down_m20260529_delivery_job_senders),
     ("20260530_client_services", m20260530_client_services, Just down_m20260530_client_services),
-    ("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at)
+    ("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at),
+    ("20260601_relay_sent_web_domain", m20260601_relay_sent_web_domain, Just down_m20260601_relay_sent_web_domain),
+    ("20260602_group_roster", m20260602_group_roster, Just down_m20260602_group_roster)
   ]
 
 -- | The list of migrations in ascending order by date

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

@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.Postgres.Migrations.M20260516_supporter_badges where
+
+import Data.Text (Text)
+import Text.RawString.QQ (r)
+
+m20260516_supporter_badges :: Text
+m20260516_supporter_badges =
+  [r|
+ALTER TABLE contact_profiles ADD COLUMN badge_proof BYTEA;
+ALTER TABLE contact_profiles ADD COLUMN badge_pres_header BYTEA;
+ALTER TABLE contact_profiles ADD COLUMN badge_expiry TIMESTAMPTZ;
+ALTER TABLE contact_profiles ADD COLUMN badge_type TEXT;
+ALTER TABLE contact_profiles ADD COLUMN badge_verified SMALLINT;
+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;
+ALTER TABLE contact_profiles ADD COLUMN badge_key_idx BIGINT;
+|]
+
+down_m20260516_supporter_badges :: Text
+down_m20260516_supporter_badges =
+  [r|
+ALTER TABLE contact_profiles DROP COLUMN badge_key_idx;
+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;
+ALTER TABLE contact_profiles DROP COLUMN badge_proof;
+ALTER TABLE contact_profiles DROP COLUMN badge_pres_header;
+ALTER TABLE contact_profiles DROP COLUMN badge_expiry;
+|]

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

@@ -0,0 +1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.Postgres.Migrations.M20260601_relay_sent_web_domain where
+
+import Data.Text (Text)
+import Text.RawString.QQ (r)
+
+m20260601_relay_sent_web_domain :: Text
+m20260601_relay_sent_web_domain =
+  [r|
+ALTER TABLE groups ADD COLUMN relay_sent_web_domain TEXT;
+|]
+
+down_m20260601_relay_sent_web_domain :: Text
+down_m20260601_relay_sent_web_domain =
+  [r|
+ALTER TABLE groups DROP COLUMN relay_sent_web_domain;
+|]

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

@@ -0,0 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.Postgres.Migrations.M20260602_group_roster where
+
+import Data.Text (Text)
+import Text.RawString.QQ (r)
+
+m20260602_group_roster :: Text
+m20260602_group_roster =
+  [r|
+ALTER TABLE groups ADD COLUMN roster_version BIGINT;
+ALTER TABLE groups ADD COLUMN roster_msg_body BYTEA;
+ALTER TABLE groups ADD COLUMN roster_msg_chat_binding TEXT;
+ALTER TABLE groups ADD COLUMN roster_msg_signatures BYTEA;
+ALTER TABLE groups ADD COLUMN roster_sending_owner_gm_id BIGINT;
+ALTER TABLE groups ADD COLUMN roster_broker_ts TIMESTAMPTZ;
+ALTER TABLE groups ADD COLUMN roster_blob BYTEA;
+
+CREATE TABLE rcv_roster_transfers(
+  roster_transfer_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  group_id BIGINT NOT NULL REFERENCES groups ON DELETE CASCADE,
+  from_member_id BIGINT NOT NULL REFERENCES group_members ON DELETE CASCADE,
+  roster_version BIGINT NOT NULL,
+  roster_digest BYTEA NOT NULL,
+  sending_owner_gm_id BIGINT NOT NULL,
+  broker_ts TIMESTAMPTZ NOT NULL,
+  roster_msg_body BYTEA,
+  roster_msg_chat_binding TEXT,
+  roster_msg_signatures BYTEA,
+  created_at TEXT NOT NULL DEFAULT (now()),
+  updated_at TEXT NOT NULL DEFAULT (now())
+);
+CREATE UNIQUE INDEX idx_rcv_roster_transfers_group_id_from_member_id ON rcv_roster_transfers(group_id, from_member_id);
+CREATE INDEX idx_rcv_roster_transfers_from_member_id ON rcv_roster_transfers(from_member_id);
+
+ALTER TABLE files ADD COLUMN shared_msg_id BYTEA;
+ALTER TABLE files ADD COLUMN file_type TEXT NOT NULL DEFAULT 'normal';
+ALTER TABLE files ADD COLUMN roster_transfer_id BIGINT;
+CREATE INDEX idx_files_group_id_shared_msg_id ON files(group_id, shared_msg_id);
+CREATE INDEX idx_files_roster_transfer_id ON files(roster_transfer_id);
+|]
+
+down_m20260602_group_roster :: Text
+down_m20260602_group_roster =
+  [r|
+DROP INDEX idx_files_roster_transfer_id;
+DROP INDEX idx_files_group_id_shared_msg_id;
+ALTER TABLE files DROP COLUMN roster_transfer_id;
+ALTER TABLE files DROP COLUMN file_type;
+ALTER TABLE files DROP COLUMN shared_msg_id;
+
+DROP INDEX idx_rcv_roster_transfers_from_member_id;
+DROP INDEX idx_rcv_roster_transfers_group_id_from_member_id;
+DROP TABLE rcv_roster_transfers;
+
+ALTER TABLE groups DROP COLUMN roster_blob;
+ALTER TABLE groups DROP COLUMN roster_broker_ts;
+ALTER TABLE groups DROP COLUMN roster_sending_owner_gm_id;
+ALTER TABLE groups DROP COLUMN roster_msg_signatures;
+ALTER TABLE groups DROP COLUMN roster_msg_chat_binding;
+ALTER TABLE groups DROP COLUMN roster_msg_body;
+ALTER TABLE groups DROP COLUMN roster_version;
+|]

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

@@ -531,7 +531,16 @@ CREATE TABLE test_chat_schema.contact_profiles (
     preferences text,
     contact_link bytea,
     short_descr text,
-    chat_peer_type text
+    chat_peer_type text,
+    badge_proof bytea,
+    badge_pres_header bytea,
+    badge_expiry timestamp with time zone,
+    badge_type text,
+    badge_verified smallint,
+    badge_extra text,
+    badge_master_key bytea,
+    badge_signature bytea,
+    badge_key_idx bigint
 );
 
 
@@ -743,7 +752,10 @@ CREATE TABLE test_chat_schema.files (
     file_crypto_key bytea,
     file_crypto_nonce bytea,
     note_folder_id bigint,
-    redirect_file_id bigint
+    redirect_file_id bigint,
+    shared_msg_id bytea,
+    file_type text DEFAULT 'normal'::text NOT NULL,
+    roster_transfer_id bigint
 );
 
 
@@ -968,8 +980,16 @@ CREATE TABLE test_chat_schema.groups (
     public_member_count bigint,
     relay_request_retries bigint DEFAULT 0 NOT NULL,
     relay_request_delay bigint DEFAULT 0 NOT NULL,
-    relay_request_execute_at timestamp with time zone DEFAULT '1970-01-01 01:00:00+01'::timestamp with time zone NOT NULL,
-    relay_inactive_at timestamp with time zone
+    relay_request_execute_at timestamp with time zone DEFAULT '1970-01-01 04:00:00+04'::timestamp with time zone NOT NULL,
+    relay_inactive_at timestamp with time zone,
+    relay_sent_web_domain text,
+    roster_version bigint,
+    roster_msg_body bytea,
+    roster_msg_chat_binding text,
+    roster_msg_signatures bytea,
+    roster_sending_owner_gm_id bigint,
+    roster_broker_ts timestamp with time zone,
+    roster_blob bytea
 );
 
 
@@ -1196,6 +1216,34 @@ CREATE TABLE test_chat_schema.rcv_files (
 
 
 
+CREATE TABLE test_chat_schema.rcv_roster_transfers (
+    roster_transfer_id bigint NOT NULL,
+    group_id bigint NOT NULL,
+    from_member_id bigint NOT NULL,
+    roster_version bigint NOT NULL,
+    roster_digest bytea NOT NULL,
+    sending_owner_gm_id bigint NOT NULL,
+    broker_ts timestamp with time zone NOT NULL,
+    roster_msg_body bytea,
+    roster_msg_chat_binding text,
+    roster_msg_signatures bytea,
+    created_at text DEFAULT now() NOT NULL,
+    updated_at text DEFAULT now() NOT NULL
+);
+
+
+
+ALTER TABLE test_chat_schema.rcv_roster_transfers ALTER COLUMN roster_transfer_id ADD GENERATED ALWAYS AS IDENTITY (
+    SEQUENCE NAME test_chat_schema.rcv_roster_transfers_roster_transfer_id_seq
+    START WITH 1
+    INCREMENT BY 1
+    NO MINVALUE
+    NO MAXVALUE
+    CACHE 1
+);
+
+
+
 CREATE TABLE test_chat_schema.received_probes (
     received_probe_id bigint NOT NULL,
     contact_id bigint,
@@ -1729,6 +1777,11 @@ ALTER TABLE ONLY test_chat_schema.rcv_files
 
 
 
+ALTER TABLE ONLY test_chat_schema.rcv_roster_transfers
+    ADD CONSTRAINT rcv_roster_transfers_pkey PRIMARY KEY (roster_transfer_id);
+
+
+
 ALTER TABLE ONLY test_chat_schema.received_probes
     ADD CONSTRAINT received_probes_pkey PRIMARY KEY (received_probe_id);
 
@@ -2262,10 +2315,18 @@ CREATE INDEX idx_files_group_id ON test_chat_schema.files USING btree (group_id)
 
 
 
+CREATE INDEX idx_files_group_id_shared_msg_id ON test_chat_schema.files USING btree (group_id, shared_msg_id);
+
+
+
 CREATE INDEX idx_files_redirect_file_id ON test_chat_schema.files USING btree (redirect_file_id);
 
 
 
+CREATE INDEX idx_files_roster_transfer_id ON test_chat_schema.files USING btree (roster_transfer_id);
+
+
+
 CREATE INDEX idx_files_user_id ON test_chat_schema.files USING btree (user_id);
 
 
@@ -2438,6 +2499,14 @@ CREATE INDEX idx_rcv_files_group_member_id ON test_chat_schema.rcv_files USING b
 
 
 
+CREATE INDEX idx_rcv_roster_transfers_from_member_id ON test_chat_schema.rcv_roster_transfers USING btree (from_member_id);
+
+
+
+CREATE UNIQUE INDEX idx_rcv_roster_transfers_group_id_from_member_id ON test_chat_schema.rcv_roster_transfers USING btree (group_id, from_member_id);
+
+
+
 CREATE INDEX idx_received_probes_contact_id ON test_chat_schema.received_probes USING btree (contact_id);
 
 
@@ -3123,6 +3192,16 @@ ALTER TABLE ONLY test_chat_schema.rcv_files
 
 
 
+ALTER TABLE ONLY test_chat_schema.rcv_roster_transfers
+    ADD CONSTRAINT rcv_roster_transfers_from_member_id_fkey FOREIGN KEY (from_member_id) REFERENCES test_chat_schema.group_members(group_member_id) ON DELETE CASCADE;
+
+
+
+ALTER TABLE ONLY test_chat_schema.rcv_roster_transfers
+    ADD CONSTRAINT rcv_roster_transfers_group_id_fkey FOREIGN KEY (group_id) REFERENCES test_chat_schema.groups(group_id) ON DELETE CASCADE;
+
+
+
 ALTER TABLE ONLY test_chat_schema.received_probes
     ADD CONSTRAINT received_probes_contact_id_fkey FOREIGN KEY (contact_id) REFERENCES test_chat_schema.contacts(contact_id) ON DELETE CASCADE;
 

src/Simplex/Chat/Store/Profiles.hs

@@ -43,6 +43,7 @@ module Simplex.Chat.Store.Profiles
     updateUserGroupReceipts,
     updateUserAutoAcceptMemberContacts,
     updateUserProfile,
+    setUserBadge,
     setUserProfileContactLink,
     getUserContactProfiles,
     createUserContactLink,
@@ -97,6 +98,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
+import Simplex.Chat.Badges (LocalBadge, localBadgeToRow)
 import Simplex.Chat.Call
 import Simplex.Chat.Messages
 import Simplex.Chat.Operators
@@ -159,7 +161,7 @@ createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {di
       (profileId, displayName, userId, BI True, currentTs, currentTs, currentTs)
     contactId <- insertedRowId db
     DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
-    pure $ toUser $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing)
+    pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing
 
 -- TODO [mentions]
 getUsersInfo :: DB.Connection -> IO [UserInfo]
@@ -193,8 +195,9 @@ getUsersInfo db = getUsers db >>= mapM getUserInfo
       pure UserInfo {user, unreadCount = fromMaybe 0 ctCount + fromMaybe 0 gCount}
 
 getUsers :: DB.Connection -> IO [User]
-getUsers db =
-  map toUser <$> DB.query_ db userQuery
+getUsers db = do
+  now <- getCurrentTime
+  map (toUser now) <$> DB.query_ db userQuery
 
 setActiveUser :: DB.Connection -> User -> IO User
 setActiveUser db user@User {userId} = do
@@ -211,13 +214,15 @@ getNextActiveOrder db = do
     else pure $ order + 1
 
 getUser :: DB.Connection -> UserId -> ExceptT StoreError IO User
-getUser db userId =
-  ExceptT . firstRow toUser (SEUserNotFound userId) $
+getUser db userId = do
+  now <- liftIO getCurrentTime
+  ExceptT . firstRow (toUser now) (SEUserNotFound userId) $
     DB.query db (userQuery <> " WHERE u.user_id = ?") (Only userId)
 
 getRelayUser :: DB.Connection -> ExceptT StoreError IO User
-getRelayUser db =
-  ExceptT . firstRow toUser SERelayUserNotFound $
+getRelayUser db = do
+  now <- liftIO getCurrentTime
+  ExceptT . firstRow (toUser now) SERelayUserNotFound $
     DB.query_ db (userQuery <> " WHERE u.is_user_chat_relay = 1")
 
 getUserIdByName :: DB.Connection -> UserName -> ExceptT StoreError IO Int64
@@ -226,38 +231,45 @@ getUserIdByName db uName =
     DB.query db "SELECT user_id FROM users WHERE local_display_name = ?" (Only uName)
 
 getUserByAConnId :: DB.Connection -> AgentConnId -> IO (Maybe User)
-getUserByAConnId db agentConnId =
-  maybeFirstRow toUser $
+getUserByAConnId db agentConnId = do
+  now <- getCurrentTime
+  maybeFirstRow (toUser now) $
     DB.query db (userQuery <> " JOIN connections c ON c.user_id = u.user_id WHERE c.agent_conn_id = ?") (Only agentConnId)
 
 getUserByASndFileId :: DB.Connection -> AgentSndFileId -> IO (Maybe User)
-getUserByASndFileId db aSndFileId =
-  maybeFirstRow toUser $
+getUserByASndFileId db aSndFileId = do
+  now <- getCurrentTime
+  maybeFirstRow (toUser now) $
     DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id WHERE f.agent_snd_file_id = ?") (Only aSndFileId)
 
 getUserByARcvFileId :: DB.Connection -> AgentRcvFileId -> IO (Maybe User)
-getUserByARcvFileId db aRcvFileId =
-  maybeFirstRow toUser $
+getUserByARcvFileId db aRcvFileId = do
+  now <- getCurrentTime
+  maybeFirstRow (toUser now) $
     DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id JOIN rcv_files r ON r.file_id = f.file_id WHERE r.agent_rcv_file_id = ?") (Only aRcvFileId)
 
 getUserByContactId :: DB.Connection -> ContactId -> ExceptT StoreError IO User
-getUserByContactId db contactId =
-  ExceptT . firstRow toUser (SEUserNotFoundByContactId contactId) $
+getUserByContactId db contactId = do
+  now <- liftIO getCurrentTime
+  ExceptT . firstRow (toUser now) (SEUserNotFoundByContactId contactId) $
     DB.query db (userQuery <> " JOIN contacts ct ON ct.user_id = u.user_id WHERE ct.contact_id = ? AND ct.deleted = 0") (Only contactId)
 
 getUserByGroupId :: DB.Connection -> GroupId -> ExceptT StoreError IO User
-getUserByGroupId db groupId =
-  ExceptT . firstRow toUser (SEUserNotFoundByGroupId groupId) $
+getUserByGroupId db groupId = do
+  now <- liftIO getCurrentTime
+  ExceptT . firstRow (toUser now) (SEUserNotFoundByGroupId groupId) $
     DB.query db (userQuery <> " JOIN groups g ON g.user_id = u.user_id WHERE g.group_id = ?") (Only groupId)
 
 getUserByNoteFolderId :: DB.Connection -> NoteFolderId -> ExceptT StoreError IO User
-getUserByNoteFolderId db contactId =
-  ExceptT . firstRow toUser (SEUserNotFoundByContactId contactId) $
+getUserByNoteFolderId db contactId = do
+  now <- liftIO getCurrentTime
+  ExceptT . firstRow (toUser now) (SEUserNotFoundByContactId contactId) $
     DB.query db (userQuery <> " JOIN note_folders nf ON nf.user_id = u.user_id WHERE nf.note_folder_id = ?") (Only contactId)
 
 getUserByFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO User
-getUserByFileId db fileId =
-  ExceptT . firstRow toUser (SEUserNotFoundByFileId fileId) $
+getUserByFileId db fileId = do
+  now <- liftIO getCurrentTime
+  ExceptT . firstRow (toUser now) (SEUserNotFoundByFileId fileId) $
     DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id WHERE f.file_id = ?") (Only fileId)
 
 getUserFileInfo :: DB.Connection -> User -> IO [CIFileInfo]
@@ -317,10 +329,10 @@ updateUserAutoAcceptMemberContacts db User {userId} autoAccept =
 updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User
 updateUserProfile db user p'
   | displayName == newName = liftIO $ do
-      updateContactProfile_ db userId profileId p'
       currentTs <- getCurrentTime
+      updateUserProfileFields_' db userId profileId p' currentTs
       userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
-      pure user {profile, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
+      pure user {profile = (toLocalProfile profileId p' localAlias currentTs (Just False)) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
   | otherwise =
       checkConstraint SEDuplicateName . liftIO $ do
         currentTs <- getCurrentTime
@@ -330,9 +342,9 @@ updateUserProfile db user p'
           db
           "INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
           (newName, newName, userId, currentTs, currentTs)
-        updateContactProfile_' db userId profileId p' currentTs
+        updateUserProfileFields_' db userId profileId p' currentTs
         updateContactLDN_ db user userContactId localDisplayName newName currentTs
-        pure user {localDisplayName = newName, profile, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
+        pure user {localDisplayName = newName, profile = (toLocalProfile profileId p' localAlias currentTs (Just False)) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
   where
     updateUserMemberProfileUpdatedAt_ currentTs
       | userMemberProfileChanged = do
@@ -340,11 +352,38 @@ updateUserProfile db user p'
           pure $ Just currentTs
       | otherwise = pure userMemberProfileUpdatedAt
     userMemberProfileChanged = newName /= displayName || fn' /= fullName || d' /= shortDescr || img' /= image
-    User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, localAlias}, userMemberProfileUpdatedAt} = user
+    User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, localBadge, localAlias}, userMemberProfileUpdatedAt} = user
     Profile {displayName = newName, fullName = fn', shortDescr = d', image = img', preferences} = p'
-    profile = toLocalProfile profileId p' localAlias
     fullPreferences = fullPreferences' preferences
 
+-- own profile field update; leaves the badge columns alone (the credential is owned by setUserBadge/addUserBadge)
+updateUserProfileFields_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
+updateUserProfileFields_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType} updatedAt =
+  DB.execute
+    db
+    [sql|
+      UPDATE contact_profiles
+      SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?
+      WHERE user_id = ? AND contact_profile_id = ?
+    |]
+    ((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. (userId, profileId))
+
+-- 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}
+
 setUserProfileContactLink :: DB.Connection -> User -> Maybe UserContactLink -> IO User
 setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId}} ucl_ = do
   ts <- getCurrentTime
@@ -374,7 +413,7 @@ getUserContactProfiles db User {userId} =
       (Only userId)
   where
     toContactProfile :: (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) -> Profile
-    toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, peerType, preferences}
+    toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, peerType, preferences, badge = Nothing}
 
 createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> SubscriptionMode -> ExceptT StoreError IO ()
 createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMode =
@@ -388,9 +427,9 @@ createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMo
     userContactLinkId <- insertedRowId db
     void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff
 
-getUserAddressConnection :: DB.Connection -> VersionRangeChat -> User -> ExceptT StoreError IO Connection
-getUserAddressConnection db vr User {userId} = do
-  ExceptT . firstRow (toConnection vr) SEUserContactLinkNotFound $
+getUserAddressConnection :: DB.Connection -> StoreCxt -> User -> ExceptT StoreError IO Connection
+getUserAddressConnection db cxt User {userId} = do
+  ExceptT . firstRow (toConnection cxt) SEUserContactLinkNotFound $
     DB.query
       db
       [sql|
@@ -533,8 +572,8 @@ setUserContactLinkShortLink db userContactLinkId shortLink =
     |]
     (shortLink, BI True, BI True, BI False, userContactLinkId)
 
-getContactWithoutConnViaAddress :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
-getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
+getContactWithoutConnViaAddress :: DB.Connection -> StoreCxt -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
+getContactWithoutConnViaAddress db cxt user@User {userId} (cReqSchema1, cReqSchema2) = do
   ctId_ <-
     maybeFirstRow fromOnly $
       DB.query
@@ -547,10 +586,10 @@ getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchem
           WHERE cp.user_id = ? AND cp.contact_link IN (?,?) AND c.connection_id IS NULL
         |]
         (userId, cReqSchema1, cReqSchema2)
-  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) ctId_
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db cxt user) ctId_
 
-getContactWithoutConnViaShortAddress :: DB.Connection -> VersionRangeChat -> User -> ShortLinkContact -> IO (Maybe Contact)
-getContactWithoutConnViaShortAddress db vr user@User {userId} shortLink = do
+getContactWithoutConnViaShortAddress :: DB.Connection -> StoreCxt -> User -> ShortLinkContact -> IO (Maybe Contact)
+getContactWithoutConnViaShortAddress db cxt user@User {userId} shortLink = do
   ctId_ <-
     maybeFirstRow fromOnly $
       DB.query
@@ -563,7 +602,7 @@ getContactWithoutConnViaShortAddress db vr user@User {userId} shortLink = do
           WHERE cp.user_id = ? AND cp.contact_link = ? AND c.connection_id IS NULL
         |]
         (userId, shortLink)
-  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) ctId_
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db cxt user) ctId_
 
 updateUserAddressSettings :: DB.Connection -> Int64 -> AddressSettings -> IO ()
 updateUserAddressSettings db userContactLinkId AddressSettings {businessAddress, autoAccept, autoReply} =

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

@@ -155,9 +155,12 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260429_relay_request_retries
 import Simplex.Chat.Store.SQLite.Migrations.M20260507_relay_inactive_at
 import Simplex.Chat.Store.SQLite.Migrations.M20260514_relay_request_group_link_index
 import Simplex.Chat.Store.SQLite.Migrations.M20260515_public_group_access
+import Simplex.Chat.Store.SQLite.Migrations.M20260516_supporter_badges
 import Simplex.Chat.Store.SQLite.Migrations.M20260529_delivery_job_senders
 import Simplex.Chat.Store.SQLite.Migrations.M20260530_client_services
 import Simplex.Chat.Store.SQLite.Migrations.M20260531_member_removed_at
+import Simplex.Chat.Store.SQLite.Migrations.M20260601_relay_sent_web_domain
+import Simplex.Chat.Store.SQLite.Migrations.M20260602_group_roster
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -313,9 +316,12 @@ schemaMigrations =
     ("20260507_relay_inactive_at", m20260507_relay_inactive_at, Just down_m20260507_relay_inactive_at),
     ("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index),
     ("20260515_public_group_access", m20260515_public_group_access, Just down_m20260515_public_group_access),
+    ("20260516_supporter_badges", m20260516_supporter_badges, Just down_m20260516_supporter_badges),
     ("20260529_delivery_job_senders", m20260529_delivery_job_senders, Just down_m20260529_delivery_job_senders),
     ("20260530_client_services", m20260530_client_services, Just down_m20260530_client_services),
-    ("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at)
+    ("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at),
+    ("20260601_relay_sent_web_domain", m20260601_relay_sent_web_domain, Just down_m20260601_relay_sent_web_domain),
+    ("20260602_group_roster", m20260602_group_roster, Just down_m20260602_group_roster)
   ]
 
 -- | The list of migrations in ascending order by date

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

@@ -0,0 +1,34 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.SQLite.Migrations.M20260516_supporter_badges where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20260516_supporter_badges :: Query
+m20260516_supporter_badges =
+  [sql|
+ALTER TABLE contact_profiles ADD COLUMN badge_proof BLOB;
+ALTER TABLE contact_profiles ADD COLUMN badge_pres_header BLOB;
+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;
+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;
+ALTER TABLE contact_profiles ADD COLUMN badge_key_idx INTEGER;
+|]
+
+down_m20260516_supporter_badges :: Query
+down_m20260516_supporter_badges =
+  [sql|
+ALTER TABLE contact_profiles DROP COLUMN badge_key_idx;
+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;
+ALTER TABLE contact_profiles DROP COLUMN badge_expiry;
+ALTER TABLE contact_profiles DROP COLUMN badge_proof;
+ALTER TABLE contact_profiles DROP COLUMN badge_pres_header;
+|]

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

@@ -0,0 +1,18 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.SQLite.Migrations.M20260601_relay_sent_web_domain where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20260601_relay_sent_web_domain :: Query
+m20260601_relay_sent_web_domain =
+  [sql|
+ALTER TABLE groups ADD COLUMN relay_sent_web_domain TEXT;
+|]
+
+down_m20260601_relay_sent_web_domain :: Query
+down_m20260601_relay_sent_web_domain =
+  [sql|
+ALTER TABLE groups DROP COLUMN relay_sent_web_domain;
+|]

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

@@ -0,0 +1,63 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.SQLite.Migrations.M20260602_group_roster where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20260602_group_roster :: Query
+m20260602_group_roster =
+  [sql|
+ALTER TABLE groups ADD COLUMN roster_version INTEGER;
+ALTER TABLE groups ADD COLUMN roster_msg_body BLOB;
+ALTER TABLE groups ADD COLUMN roster_msg_chat_binding TEXT;
+ALTER TABLE groups ADD COLUMN roster_msg_signatures BLOB;
+ALTER TABLE groups ADD COLUMN roster_sending_owner_gm_id INTEGER;
+ALTER TABLE groups ADD COLUMN roster_broker_ts TEXT;
+ALTER TABLE groups ADD COLUMN roster_blob BLOB;
+
+CREATE TABLE rcv_roster_transfers(
+  roster_transfer_id INTEGER PRIMARY KEY,
+  group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
+  from_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
+  roster_version INTEGER NOT NULL,
+  roster_digest BLOB NOT NULL,
+  sending_owner_gm_id INTEGER NOT NULL,
+  broker_ts TEXT NOT NULL,
+  roster_msg_body BLOB,
+  roster_msg_chat_binding TEXT,
+  roster_msg_signatures BLOB,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+) STRICT;
+CREATE UNIQUE INDEX idx_rcv_roster_transfers_group_id_from_member_id ON rcv_roster_transfers(group_id, from_member_id);
+CREATE INDEX idx_rcv_roster_transfers_from_member_id ON rcv_roster_transfers(from_member_id);
+
+ALTER TABLE files ADD COLUMN shared_msg_id BLOB;
+ALTER TABLE files ADD COLUMN file_type TEXT NOT NULL DEFAULT 'normal';
+ALTER TABLE files ADD COLUMN roster_transfer_id INTEGER;
+CREATE INDEX idx_files_group_id_shared_msg_id ON files(group_id, shared_msg_id);
+CREATE INDEX idx_files_roster_transfer_id ON files(roster_transfer_id);
+|]
+
+down_m20260602_group_roster :: Query
+down_m20260602_group_roster =
+  [sql|
+DROP INDEX idx_files_roster_transfer_id;
+DROP INDEX idx_files_group_id_shared_msg_id;
+ALTER TABLE files DROP COLUMN roster_transfer_id;
+ALTER TABLE files DROP COLUMN file_type;
+ALTER TABLE files DROP COLUMN shared_msg_id;
+
+DROP INDEX idx_rcv_roster_transfers_from_member_id;
+DROP INDEX idx_rcv_roster_transfers_group_id_from_member_id;
+DROP TABLE rcv_roster_transfers;
+
+ALTER TABLE groups DROP COLUMN roster_blob;
+ALTER TABLE groups DROP COLUMN roster_broker_ts;
+ALTER TABLE groups DROP COLUMN roster_sending_owner_gm_id;
+ALTER TABLE groups DROP COLUMN roster_msg_signatures;
+ALTER TABLE groups DROP COLUMN roster_msg_chat_binding;
+ALTER TABLE groups DROP COLUMN roster_msg_body;
+ALTER TABLE groups DROP COLUMN roster_version;
+|]

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

@@ -548,15 +548,6 @@ Plan:
 SEARCH s USING PRIMARY KEY (conn_id=? AND internal_snd_id=?)
 SEARCH m USING PRIMARY KEY (conn_id=? AND internal_id=?)
 
-Query: 
-        UPDATE rcv_messages
-        SET receive_attempts = receive_attempts + 1
-        WHERE conn_id = ? AND internal_id = ?
-        RETURNING receive_attempts
-      
-Plan:
-SEARCH rcv_messages USING COVERING INDEX idx_rcv_messages_conn_id_internal_id (conn_id=? AND internal_id=?)
-
 Query: 
       DELETE FROM conn_confirmations
       WHERE conn_id = ?

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

@@ -19,7 +19,16 @@ CREATE TABLE contact_profiles(
   preferences TEXT,
   contact_link BLOB,
   short_descr TEXT,
-  chat_peer_type TEXT
+  chat_peer_type TEXT,
+  badge_proof BLOB,
+  badge_pres_header BLOB,
+  badge_expiry TEXT,
+  badge_type TEXT,
+  badge_verified INTEGER,
+  badge_extra TEXT,
+  badge_master_key BLOB,
+  badge_signature BLOB,
+  badge_key_idx INTEGER
 ) STRICT;
 CREATE TABLE users(
   user_id INTEGER PRIMARY KEY,
@@ -182,7 +191,15 @@ CREATE TABLE groups(
   relay_request_retries INTEGER NOT NULL DEFAULT 0,
   relay_request_delay INTEGER NOT NULL DEFAULT 0,
   relay_request_execute_at TEXT NOT NULL DEFAULT '1970-01-01 00:00:00',
-  relay_inactive_at TEXT, -- received
+  relay_inactive_at TEXT,
+  relay_sent_web_domain TEXT,
+  roster_version INTEGER,
+  roster_msg_body BLOB,
+  roster_msg_chat_binding TEXT,
+  roster_msg_signatures BLOB,
+  roster_sending_owner_gm_id INTEGER,
+  roster_broker_ts TEXT,
+  roster_blob BLOB, -- received
   FOREIGN KEY(user_id, local_display_name)
   REFERENCES display_names(user_id, local_display_name)
   ON DELETE CASCADE
@@ -268,7 +285,10 @@ CREATE TABLE files(
   file_crypto_key BLOB,
   file_crypto_nonce BLOB,
   note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE,
-  redirect_file_id INTEGER REFERENCES files ON DELETE CASCADE
+  redirect_file_id INTEGER REFERENCES files ON DELETE CASCADE,
+  shared_msg_id BLOB,
+  file_type TEXT NOT NULL DEFAULT 'normal',
+  roster_transfer_id INTEGER
 ) STRICT;
 CREATE TABLE snd_files(
   file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
@@ -788,6 +808,20 @@ CREATE TABLE group_relays(
   ,
   base_web_url TEXT
 ) STRICT;
+CREATE TABLE rcv_roster_transfers(
+  roster_transfer_id INTEGER PRIMARY KEY,
+  group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
+  from_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
+  roster_version INTEGER NOT NULL,
+  roster_digest BLOB NOT NULL,
+  sending_owner_gm_id INTEGER NOT NULL,
+  broker_ts TEXT NOT NULL,
+  roster_msg_body BLOB,
+  roster_msg_chat_binding TEXT,
+  roster_msg_signatures BLOB,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+) STRICT;
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
   full_name
@@ -1307,6 +1341,18 @@ ON groups(
   relay_request_group_link
 )
 WHERE relay_request_group_link IS NOT NULL;
+CREATE UNIQUE INDEX idx_rcv_roster_transfers_group_id_from_member_id ON rcv_roster_transfers(
+  group_id,
+  from_member_id
+);
+CREATE INDEX idx_rcv_roster_transfers_from_member_id ON rcv_roster_transfers(
+  from_member_id
+);
+CREATE INDEX idx_files_group_id_shared_msg_id ON files(
+  group_id,
+  shared_msg_id
+);
+CREATE INDEX idx_files_roster_transfer_id ON files(roster_transfer_id);
 CREATE TRIGGER on_group_members_insert_update_summary
 AFTER INSERT ON group_members
 FOR EACH ROW

src/Simplex/Chat/Store/Shared.hs

@@ -32,6 +32,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
 import Data.Type.Equality
+import Simplex.Chat.Badges (BadgeRow, badgeToRow, rowToBadge, verifyBadge_)
 import Simplex.Chat.Messages
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Types
@@ -228,12 +229,12 @@ type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, BoolInt, May
 
 type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe BoolInt, Maybe GroupLinkId, Maybe XContactId) :. (Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe BoolInt, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQSupport, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Maybe Int, Maybe Int, Maybe VersionChat, Maybe VersionChat, Maybe VersionChat)
 
-toConnection :: VersionRangeChat -> ConnectionRow -> Connection
-toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, BI viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, BI contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, quotaErrCounter, chatV, minVer, maxVer)) =
+toConnection :: StoreCxt -> ConnectionRow -> Connection
+toConnection cxt ((connId, acId, connLevel, viaContact, viaUserContactLink, BI viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, BI contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, quotaErrCounter, chatV, minVer, maxVer)) =
   Connection
     { connId,
       agentConnId = AgentConnId acId,
-      connChatVersion = fromMaybe (vr `peerConnChatVersion` peerChatVRange) chatV,
+      connChatVersion = fromMaybe (vr cxt `peerConnChatVersion` peerChatVRange) chatV,
       peerChatVRange = peerChatVRange,
       connLevel,
       viaContact,
@@ -263,9 +264,9 @@ toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, BI vi
     entityId_ ConnMember = groupMemberId
     entityId_ ConnUserContact = userContactLinkId
 
-toMaybeConnection :: VersionRangeChat -> MaybeConnectionRow -> Maybe Connection
-toMaybeConnection vr ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, Just quotaErrCounter, connChatVersion, Just minVer, Just maxVer)) =
-  Just $ toConnection vr ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, quotaErrCounter, connChatVersion, minVer, maxVer))
+toMaybeConnection :: StoreCxt -> MaybeConnectionRow -> Maybe Connection
+toMaybeConnection cxt ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, Just quotaErrCounter, connChatVersion, Just minVer, Just maxVer)) =
+  Just $ toConnection cxt ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, quotaErrCounter, connChatVersion, minVer, maxVer))
 toMaybeConnection _ _ = Nothing
 
 createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> ConnStatus -> VersionChat -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQSupport -> IO Connection
@@ -406,18 +407,19 @@ setCommandConnId db User {userId} cmdId connId = do
     |]
     (connId, updatedAt, userId, cmdId)
 
-createContact :: DB.Connection -> User -> Profile -> ExceptT StoreError IO ()
-createContact db user profile = do
+createContact :: DB.Connection -> StoreCxt -> User -> Profile -> ExceptT StoreError IO ()
+createContact db cxt user profile = do
   currentTs <- liftIO getCurrentTime
-  void $ createContact_ db user profile emptyChatPrefs Nothing "" currentTs
+  void $ createContact_ db cxt user profile emptyChatPrefs Nothing "" currentTs
 
-createContact_ :: DB.Connection -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId
-createContact_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, peerType, preferences} ctUserPreferences prepared localAlias currentTs =
+createContact_ :: DB.Connection -> StoreCxt -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId
+createContact_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
   ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
+    badgeVerified <- verifyBadge_ (badgeKeys cxt) 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) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
-      ((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs))
+      "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, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
+      ((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
     profileId <- insertedRowId db
     DB.execute
       db
@@ -484,14 +486,14 @@ type PreparedContactRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink, Ma
 
 type GroupDirectInvitationRow = (Maybe ConnReqInvitation, Maybe GroupId, Maybe GroupMemberId, Maybe Int64, BoolInt)
 
-type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64)
+type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64) :. BadgeRow
 
 type ContactRow = Only ContactId :. ContactRow'
 
-toContact :: VersionRangeChat -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
-toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
-  let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, preferences, localAlias}
-      activeConn = toMaybeConnection vr connRow
+toContact :: UTCTime -> StoreCxt -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
+toContact now cxt user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow) :. connRow) =
+  let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localBadge = rowToBadge now badgeRow, preferences, localAlias}
+      activeConn = toMaybeConnection cxt connRow
       chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
       incognito = maybe False connIncognito activeConn
       mergedPreferences = contactUserPreferences user userPreferences preferences incognito
@@ -516,22 +518,24 @@ toGroupDirectInvitation (Just groupDirectInvLink, fromGroupId_, fromGroupMemberI
   Just $ GroupDirectInvitation {groupDirectInvLink, fromGroupId_, fromGroupMemberId_, fromGroupMemberConnId_, groupDirectInvStartedConnection}
 
 getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
-getProfileById db userId profileId =
-  ExceptT . firstRow rowToLocalProfile (SEProfileNotFound profileId) $
+getProfileById db userId profileId = do
+  currentTs <- liftIO getCurrentTime
+  ExceptT . firstRow (rowToLocalProfile currentTs) (SEProfileNotFound profileId) $
     DB.query
       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 -- , ct.user_preferences
+        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_master_key, cp.badge_signature, cp.badge_key_idx
         FROM contact_profiles cp
         WHERE cp.user_id = ? AND cp.contact_profile_id = ?
       |]
       (userId, profileId)
 
-type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupId, Maybe Int64) :. (Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType) :. (Maybe XContactId, PQSupport, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat)
+type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupId, Maybe Int64) :. (Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias) :. (Maybe XContactId, PQSupport, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat) :. BadgeRow
 
-toContactRequest :: ContactRequestRow -> UserContactRequest
-toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType) :. (xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
-  let profile = Profile {displayName, fullName, shortDescr, image, contactLink, peerType, preferences}
+toContactRequest :: UTCTime -> ContactRequestRow -> UserContactRequest
+toContactRequest now ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias) :. (xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer) :. badgeRow) = do
+  let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, preferences, localBadge = rowToBadge now badgeRow, localAlias}
       cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
    in UserContactRequest {contactRequestId, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, createdAt, updatedAt}
 
@@ -539,17 +543,18 @@ userQuery :: Query
 userQuery =
   [sql|
     SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
-      u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes
+      u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
+      ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx
     FROM users u
     JOIN contacts uct ON uct.contact_id = u.contact_id
     JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
   |]
 
-toUser :: (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) -> User
-toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes)) =
+toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) :. BadgeRow -> User
+toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow) =
   User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts, viewPwdHash, userMemberProfileUpdatedAt, userChatRelay = BoolDef userChatRelay, clientService = BoolDef clientService, uiThemes}
   where
-    profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, preferences = userPreferences, localAlias = ""}
+    profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""}
     fullPreferences = fullPreferences' userPreferences
     viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_
 
@@ -665,17 +670,17 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member
 
 type GroupKeysRow = (Maybe C.PrivateKeyEd25519, Maybe C.PublicKeyEd25519, Maybe C.PrivateKeyEd25519)
 
-type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow
+type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe VersionRoster, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow
 
 type PublicGroupAccessRow = (Maybe Text, Maybe Text, Maybe BoolInt, Maybe BoolInt)
 
 type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)
 
-type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences)
+type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) :. BadgeRow
 
-toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
-toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
-  let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
+toGroupInfo :: UTCTime -> StoreCxt -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
+toGroupInfo now cxt userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
+  let membership = (toGroupMember now userContactId userMemberRow) {memberChatVRange = vr cxt}
       chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
       fullGroupPreferences = mergeGroupPreferences groupPreferences
       publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ (toPublicGroupAccess accessRow)
@@ -684,7 +689,7 @@ toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName,
       businessChat = toBusinessChatInfo businessRow
       preparedGroup = toPreparedGroup preparedGroupRow
       groupSummary = GroupSummary {currentMembers, publicMemberCount}
-   in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, customData, membersRequireAttention, viaGroupLinkUri, groupKeys}
+   in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, rosterVersion, customData, membersRequireAttention, viaGroupLinkUri, groupKeys}
 
 toPreparedGroup :: PreparedGroupRow -> Maybe PreparedGroup
 toPreparedGroup = \case
@@ -718,9 +723,9 @@ toGroupKeys (Just publicGroupId) (rootPrivKey_, rootPubKey_, Just memberPrivKey)
     <$> (GRKPrivate <$> rootPrivKey_ <|> GRKPublic <$> rootPubKey_)
 toGroupKeys _ _ = Nothing
 
-toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
-toGroupMember userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. profileRow :. (createdAt, updatedAt) :. (supportChatTs_, supportChatUnread, supportChatMemberAttention, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink)) =
-  let memberProfile = rowToLocalProfile profileRow
+toGroupMember :: UTCTime -> Int64 -> GroupMemberRow -> GroupMember
+toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. profileRow :. (createdAt, updatedAt) :. (supportChatTs_, supportChatUnread, supportChatMemberAttention, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink)) =
+  let memberProfile = rowToLocalProfile now profileRow
       memberSettings = GroupMemberSettings {showMessages}
       blockedByAdmin = maybe False mrsBlocked memberRestriction_
       invitedBy = toInvitedBy userContactId invitedById
@@ -745,6 +750,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_master_key, p.badge_signature, p.badge_key_idx,
       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,
@@ -756,13 +762,13 @@ groupMemberQuery =
     LEFT JOIN connections c ON c.group_member_id = m.group_member_id
   |]
 
-toContactMember :: VersionRangeChat -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
-toContactMember vr User {userContactId} (memberRow :. connRow) =
-  (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection vr connRow}
+toContactMember :: UTCTime -> StoreCxt -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
+toContactMember now cxt User {userContactId} (memberRow :. connRow) =
+  (toGroupMember now userContactId memberRow) {activeConn = toMaybeConnection cxt connRow}
 
-rowToLocalProfile :: ProfileRow -> LocalProfile
-rowToLocalProfile (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) =
-  LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences}
+rowToLocalProfile :: UTCTime -> ProfileRow -> LocalProfile
+rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) :. badgeRow) =
+  LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences}
 
 toBusinessChatInfo :: BusinessChatInfoRow -> Maybe BusinessChatInfo
 toBusinessChatInfo (Just chatType, Just businessId, Just customerId) = Just BusinessChatInfo {chatType, businessId, customerId}
@@ -783,12 +789,13 @@ groupInfoQueryFields =
       g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
       g.business_chat, g.business_member_id, g.customer_member_id,
       g.use_relays, g.relay_own_status,
-      g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
+      g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
       g.root_priv_key, g.root_pub_key, g.member_priv_key,
       -- GroupMember - membership
       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_master_key, pu.badge_signature, pu.badge_key_idx,
       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
   |]
@@ -875,10 +882,11 @@ addGroupChatTags db g@GroupInfo {groupId} = do
   chatTags <- getGroupChatTags db groupId
   pure (g :: GroupInfo) {chatTags}
 
-getGroupInfo :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO GroupInfo
-getGroupInfo db vr User {userId, userContactId} groupId = ExceptT $ do
+getGroupInfo :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO GroupInfo
+getGroupInfo db cxt User {userId, userContactId} groupId = ExceptT $ do
+  currentTs <- getCurrentTime
   chatTags <- getGroupChatTags db groupId
-  firstRow (toGroupInfo vr userContactId chatTags) (SEGroupNotFound groupId) $
+  firstRow (toGroupInfo currentTs cxt userContactId chatTags) (SEGroupNotFound groupId) $
     DB.query
       db
       (groupInfoQuery <> " WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?")

src/Simplex/Chat/Types.hs

@@ -40,6 +40,7 @@ import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
 import Data.Functor (($>))
 import Data.Int (Int64)
+import Data.Map.Strict (Map)
 import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -47,6 +48,8 @@ import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Typeable (Typeable)
 import Data.Word (Word16)
+import Simplex.Chat.Badges (BadgeInfo (..), BadgeProof (..), BadgeStatus (..), LocalBadge (..), localBadgeInfo, localBadgeStatus, mkBadgeStatus, verifyBadge)
+import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
@@ -369,7 +372,7 @@ data UserContactRequest = UserContactRequest
     cReqChatVRange :: VersionRangeChat,
     localDisplayName :: ContactName,
     profileId :: Int64,
-    profile :: Profile,
+    profile :: LocalProfile,
     createdAt :: UTCTime,
     updatedAt :: UTCTime,
     xContactId :: Maybe XContactId,
@@ -487,6 +490,7 @@ data GroupInfo = GroupInfo
     uiThemes :: Maybe UIThemeEntityOverrides,
     customData :: Maybe CustomData,
     groupSummary :: GroupSummary,
+    rosterVersion :: Maybe VersionRoster,
     membersRequireAttention :: Int,
     viaGroupLinkUri :: Maybe ConnReqContact,
     groupKeys :: Maybe GroupKeys
@@ -637,6 +641,12 @@ groupFeatureUserAllowed :: GroupFeatureRoleI f => SGroupFeature f -> GroupInfo -
 groupFeatureUserAllowed feature GroupInfo {membership = GroupMember {memberRole}, fullGroupPreferences} =
   groupFeatureMemberAllowed' feature memberRole fullGroupPreferences
 
+-- A connection link in a profile description enables a direct connection, so a description
+-- keeps its links only when both SimpleX links and direct messages are allowed.
+groupUserAllowSimplexLinks :: GroupInfo -> Bool
+groupUserAllowSimplexLinks g =
+  groupFeatureUserAllowed SGFSimplexLinks g && groupFeatureUserAllowed SGFDirectMessages g
+
 mergeUserChatPrefs :: User -> Contact -> FullPreferences
 mergeUserChatPrefs user ct = mergeUserChatPrefs' user (contactConnIncognito ct) (userPreferences ct)
 
@@ -687,7 +697,8 @@ data Profile = Profile
     image :: Maybe ImageData,
     contactLink :: Maybe ConnLinkContact,
     preferences :: Maybe Preferences,
-    peerType :: Maybe ChatPeerType
+    peerType :: Maybe ChatPeerType,
+    badge :: Maybe BadgeProof
     -- fields that should not be read into this data type to prevent sending them as part of profile to contacts:
     -- - contact_profile_id
     -- - incognito
@@ -720,7 +731,7 @@ instance TextEncoding ChatPeerType where
 
 profileFromName :: ContactName -> Profile
 profileFromName displayName =
-  Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing}
+  Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing, badge = Nothing}
 
 -- check if profiles match ignoring preferences
 profilesMatch :: LocalProfile -> LocalProfile -> Bool
@@ -729,6 +740,15 @@ profilesMatch
   LocalProfile {displayName = n2, fullName = fn2, image = i2} =
     n1 == n2 && fn1 == fn2 && i1 == i2
 
+-- equal for profile-update detection: badge proofs are re-generated for every presentation,
+-- so compare badges by disclosed info (not proof bytes) - a re-presentation of the same badge is a no-op
+sameProfileContent :: Profile -> Profile -> Bool
+sameProfileContent p@Profile {badge = b} p'@Profile {badge = b'} =
+  p {badge = Nothing} == p' {badge = Nothing} && (proofInfo <$> b) == (proofInfo <$> b')
+  where
+    proofInfo :: BadgeProof -> BadgeInfo
+    proofInfo (BadgeProof _ _ _ info) = info
+
 data IncognitoProfile = NewIncognito Profile | ExistingIncognito LocalProfile
 
 fromIncognitoProfile :: IncognitoProfile -> Profile
@@ -760,6 +780,7 @@ data LocalProfile = LocalProfile
     contactLink :: Maybe ConnLinkContact,
     preferences :: Maybe Preferences,
     peerType :: Maybe ChatPeerType,
+    localBadge :: Maybe LocalBadge,
     localAlias :: LocalAlias
   }
   deriving (Eq, Show)
@@ -767,13 +788,37 @@ data LocalProfile = LocalProfile
 localProfileId :: LocalProfile -> ProfileId
 localProfileId LocalProfile {profileId} = profileId
 
-toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile
-toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType} localAlias =
-  LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localAlias}
+toLocalProfile :: ProfileId -> Profile -> LocalAlias -> UTCTime -> Maybe Bool -> LocalProfile
+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@(BadgeProof _ _ _ info) -> PeerBadge b (mkBadgeStatus now verified info)) <$> badge
 
 fromLocalProfile :: LocalProfile -> Profile
-fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType} =
-  Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType}
+fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge} =
+  Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge}
+  where
+    -- any stored peer proof rides the wire (receivers verify independently); the own credential is presented fresh, and a display-only badge never sends
+    wireBadge :: LocalBadge -> Maybe BadgeProof
+    wireBadge = \case
+      PeerBadge b _ -> Just b
+      OwnBadge _ _ -> Nothing
+      ShownBadge _ _ -> Nothing
+
+profileBadgeVerified :: Map Int BBSPublicKey -> LocalProfile -> Profile -> IO (Maybe Bool)
+profileBadgeVerified keys LocalProfile {localBadge} Profile {badge = newBadge} =
+  case (localBadge, newBadge) of
+    (_, Nothing) -> pure (Just False)
+    -- an unchanged badge that verified before stays verified; failed or unknown-key badges
+    -- are re-verified, so an unknown key heals once an app update adds it
+    (Just lb, Just (BadgeProof _ _ _ newInfo))
+      | localBadgeInfo lb == newInfo && localBadgeStatus lb `notElem` [BSFailed, BSUnknownKey] -> pure (Just True)
+    (_, Just newB) -> verifyBadge keys newB
+
+-- a failed or unknown-key badge is re-verified on the next profile update even when its disclosed content
+-- is unchanged, so it heals once an app update adds the issuer key
+badgeNeedsReverify :: LocalProfile -> Bool
+badgeNeedsReverify LocalProfile {localBadge} = maybe False ((`elem` [BSFailed, BSUnknownKey]) . localBadgeStatus) localBadge
 
 data GroupType
   = GTChannel
@@ -843,8 +888,13 @@ instance FromJSON ImageData where
   parseJSON = fmap ImageData . J.parseJSON
 
 instance ToJSON ImageData where
-  toJSON (ImageData t) = J.toJSON t
-  toEncoding (ImageData t) = J.toEncoding t
+  toJSON (ImageData t) = J.toJSON $ safeImageData t
+  toEncoding (ImageData t) = J.toEncoding $ safeImageData t
+
+safeImageData :: Text -> Text
+safeImageData t
+  | "data:" `T.isPrefixOf` t = t
+  | otherwise = ""
 
 instance ToField ImageData where toField (ImageData t) = toField t
 
@@ -972,6 +1022,11 @@ newtype MemberKey = MemberKey C.PublicKeyEd25519
   deriving (Eq, Show)
   deriving newtype (StrEncoding)
 
+-- Binary encoding for the roster blob; delegates to the Ed25519 key.
+instance Encoding MemberKey where
+  smpEncode (MemberKey k) = smpEncode k
+  smpP = MemberKey <$> smpP
+
 instance FromJSON MemberKey where
   parseJSON = strParseJSON "MemberKey"
 
@@ -1493,11 +1548,38 @@ instance ToJSON InlineFileMode where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
 
+-- Discriminates ordinary chat files from the roster blob file, so the receive
+-- completion / cancel paths branch on the type rather than on chat_item_id (note
+-- folders and redirects also lack a chat item).
+data FileType = FTNormal | FTRoster
+  deriving (Eq, Show)
+
+instance TextEncoding FileType where
+  textEncode = \case
+    FTNormal -> "normal"
+    FTRoster -> "roster"
+  textDecode = \case
+    "normal" -> Just FTNormal
+    "roster" -> Just FTRoster
+    _ -> Nothing
+
+instance FromField FileType where fromField = fromTextField_ textDecode
+
+instance ToField FileType where toField = toField . textEncode
+
+instance FromJSON FileType where
+  parseJSON = textParseJSON "FileType"
+
+instance ToJSON FileType where
+  toJSON = J.String . textEncode
+  toEncoding = JE.text . textEncode
+
 data RcvFileTransfer = RcvFileTransfer
   { fileId :: FileTransferId,
     xftpRcvFile :: Maybe XFTPRcvFile,
     fileInvitation :: FileInvitation,
     fileStatus :: RcvFileStatus,
+    fileType :: FileType,
     rcvFileInline :: Maybe InlineFileMode,
     senderDisplayName :: ContactName,
     chunkSize :: Integer,
@@ -2035,9 +2117,19 @@ type VersionChat = Version ChatVersion
 
 type VersionRangeChat = VersionRange ChatVersion
 
+-- | Store-wide context passed to store functions in place of the bare `vr`
+-- parameter. Built from config by mkStoreCxt; more fields are added here over time.
+data StoreCxt = StoreCxt {vr :: VersionRangeChat, badgeKeys :: Map Int BBSPublicKey}
+
 pattern VersionChat :: Word16 -> VersionChat
 pattern VersionChat v = Version v
 
+-- A monotonic per-change counter, not a negotiated protocol version: Int64 rather than the Word16 of
+-- Version, so a long-lived high-churn channel cannot wrap and be permanently rejected by relays (v >= cur).
+newtype VersionRoster = VersionRoster Int64
+  deriving (Eq, Ord, Show)
+  deriving newtype (FromJSON, ToJSON, FromField, ToField)
+
 -- this newtype exists to have a concise JSON encoding of version ranges in chat protocol messages in the form of "1-2" or just "1"
 newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRangeChat} deriving (Eq, Show)
 

src/Simplex/Chat/Types/Shared.hs

@@ -11,6 +11,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Text (Text)
 import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Messaging.Agent.Store.DB (fromTextField_)
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON)
 import Simplex.Messaging.Util ((<$?>))
@@ -57,6 +58,12 @@ instance ToJSON GroupMemberRole where
   toJSON = textToJSON
   toEncoding = textToEncoding
 
+-- Binary encoding for the roster blob; delegates to the canonical TextEncoding
+-- (same member/moderator/admin form JSON and the DB use). GRUnknown round-trips.
+instance Encoding GroupMemberRole where
+  smpEncode = smpEncode . textEncode
+  smpP = maybe (fail "bad GroupMemberRole") pure . textDecode =<< smpP
+
 data GroupAcceptance = GAAccepted | GAPendingApproval | GAPendingReview  deriving (Eq, Show)
 
 instance StrEncoding GroupAcceptance where
@@ -82,6 +89,7 @@ data RelayStatus
   = RSNew -- only for owner
   | RSInvited
   | RSAccepted
+  | RSAcknowledgedRoster
   | RSActive
   | RSInactive
   | RSRejected
@@ -92,6 +100,7 @@ relayStatusText = \case
   RSNew -> "new"
   RSInvited -> "invited"
   RSAccepted -> "accepted"
+  RSAcknowledgedRoster -> "acknowledged_roster"
   RSActive -> "active"
   RSInactive -> "inactive"
   RSRejected -> "rejected"
@@ -101,6 +110,7 @@ instance TextEncoding RelayStatus where
     RSNew -> "new"
     RSInvited -> "invited"
     RSAccepted -> "accepted"
+    RSAcknowledgedRoster -> "acknowledged_roster"
     RSActive -> "active"
     RSInactive -> "inactive"
     RSRejected -> "rejected"
@@ -108,6 +118,7 @@ instance TextEncoding RelayStatus where
     "new" -> Just RSNew
     "invited" -> Just RSInvited
     "accepted" -> Just RSAccepted
+    "acknowledged_roster" -> Just RSAcknowledgedRoster
     "active" -> Just RSActive
     "inactive" -> Just RSInactive
     "rejected" -> Just RSRejected

src/Simplex/Chat/View.hs

@@ -43,6 +43,7 @@ import Simplex.Chat.Controller
 import Simplex.Chat.Help
 import Simplex.Chat.Library.Commands (maxImageSize)
 import Simplex.Chat.Markdown
+import Simplex.Chat.Badges (BadgeInfo (..), BadgeStatus (..), BadgeType (..), LocalBadge, localBadgeInfo, localBadgeStatus)
 import Simplex.Chat.Messages hiding (NewChatItem (..))
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Operators
@@ -111,7 +112,7 @@ chatErrorToView isCmd ChatConfig {logLevel, testView} = viewChatError isCmd logL
 
 chatResponseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
 chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveItems ts tz outputRH = \case
-  CRActiveUser User {profile, uiThemes} -> viewUserProfile (fromLocalProfile profile) <> viewUITheme uiThemes
+  CRActiveUser User {profile = p@LocalProfile {localBadge}, uiThemes} -> viewUserProfile localBadge (fromLocalProfile p) <> viewUITheme uiThemes
   CRUsersList users -> viewUsersList users
   CRChatStarted -> ["chat started"]
   CRChatRunning -> ["chat is running"]
@@ -193,7 +194,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
   CRSentGroupInvitation u g c _ -> ttyUser u $ viewSentGroupInvitation g c
   CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
   CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci
-  CRUserProfile u p -> ttyUser u $ viewUserProfile p
+  CRUserProfile u@User {profile = LocalProfile {localBadge}} p -> ttyUser u $ viewUserProfile localBadge p
   CRUserProfileNoChange u -> ttyUser u ["user profile did not change"]
   CRUserPrivacy u u' -> ttyUserPrefix hu outputRH u $ viewUserPrivacy u u'
   CRVersionInfo info _ _ -> viewVersionInfo logLevel info
@@ -452,7 +453,7 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView}
   CEvtRcvFileProgressXFTP {} -> []
   CEvtContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
   CEvtGroupMemberUpdated {} -> []
-  CEvtReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} _chat -> ttyUser u $ viewReceivedContactRequest c profile
+  CEvtReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} _chat -> ttyUser u $ viewReceivedContactRequest c (fromLocalProfile profile)
   CEvtRcvFileStart u ci -> ttyUser u $ receivingFile_' hu testView "started" ci
   CEvtRcvFileComplete u ci -> ttyUser u $ receivingFile_' hu testView "completed" ci
   CEvtRcvStandaloneFileComplete u _ ft -> ttyUser u $ receivingFileStandalone "completed" ft
@@ -619,8 +620,8 @@ viewUsersList us =
    in if null ss then ["no users"] else ss
   where
     ldn (UserInfo User {localDisplayName = n} _) = T.toLower n
-    userInfo (UserInfo User {localDisplayName = n, profile = LocalProfile {fullName, shortDescr, peerType}, activeUser, showNtfs, viewPwdHash, clientService} count)
-      | activeUser || isNothing viewPwdHash = Just $ ttyFullName n fullName shortDescr <> infoStr <> bot
+    userInfo (UserInfo User {localDisplayName = n, profile = LocalProfile {fullName, shortDescr, peerType, localBadge}, activeUser, showNtfs, viewPwdHash, clientService} count)
+      | activeUser || isNothing viewPwdHash = Just $ ttyFullNameBadge n fullName shortDescr localBadge <> infoStr <> bot
       | otherwise = Nothing
       where
         infoStr = if null info then "" else " (" <> mconcat (intersperse ", " info) <> ")"
@@ -1206,8 +1207,8 @@ viewReceivedContactRequest c Profile {fullName, shortDescr} =
   ]
 
 showRelay :: GroupRelay -> StyledString
-showRelay GroupRelay {groupRelayId, relayStatus} =
-  "  - relay id " <> sShow groupRelayId <> ": " <> plain (relayStatusText relayStatus)
+showRelay GroupRelay {groupRelayId, relayStatus, relayCap = RelayCapabilities {webDomain}} =
+  "  - relay id " <> sShow groupRelayId <> ": " <> plain (relayStatusText relayStatus) <> maybe "" (\d -> ", web: " <> plain d) webDomain
 
 viewGroupRelays :: GroupInfo -> [GroupRelay] -> [StyledString]
 viewGroupRelays g relays =
@@ -1509,9 +1510,9 @@ viewContactAndMemberAssociated ct g m ct' =
     "use " <> ttyToContact' ct' <> highlight' "<message>" <> " to send messages"
   ]
 
-viewUserProfile :: Profile -> [StyledString]
-viewUserProfile Profile {displayName, fullName, shortDescr, peerType, preferences} =
-  [ "user profile: " <> ttyFullName displayName fullName shortDescr <> bot,
+viewUserProfile :: Maybe LocalBadge -> Profile -> [StyledString]
+viewUserProfile localBadge Profile {displayName, fullName, shortDescr, peerType, preferences} =
+  [ "user profile: " <> ttyFullNameBadge displayName fullName shortDescr localBadge <> bot,
     "use " <> highlight' "/p <name> [<bio>]" <> " to change it"
   ]
     ++ viewCommands
@@ -1764,9 +1765,22 @@ smpProxyModeStr :: SMPProxyMode -> SMPProxyFallback -> String
 smpProxyModeStr SPMNever _ = "private message routing disabled."
 smpProxyModeStr mode fallback = T.unpack $ safeDecodeUtf8 $ "private message routing mode: " <> strEncode mode <> ", fallback: " <> strEncode fallback
 
+viewContactBadge :: Maybe LocalBadge -> [StyledString]
+viewContactBadge = maybe [] $ \lb ->
+  let BadgeInfo {badgeType, badgeExpiry} = localBadgeInfo lb
+      st = case localBadgeStatus lb of
+        BSActive -> "active"
+        BSExpired -> "expired"
+        BSExpiredOld -> "expired (old)"
+        BSFailed -> "verification failed"
+        BSUnknownKey -> "unknown key"
+      expiry = maybe "no expiry" (("expires " <>) . T.pack . formatTime defaultTimeLocale "%Y-%m-%d") badgeExpiry
+   in [plain (textEncode badgeType <> " badge - " <> st), plain expiry]
+
 viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString]
-viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}, activeConn, uiThemes, customData} stats incognitoProfile =
+viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge}, activeConn, uiThemes, customData} stats incognitoProfile =
   ["contact ID: " <> sShow contactId]
+    <> viewContactBadge localBadge
     <> maybe [] viewConnectionStats stats
     <> maybe [] (\l -> ["contact address: " <> (plain . strEncode) (simplexChatContact' l)]) contactLink
     <> maybe
@@ -1799,10 +1813,11 @@ viewCustomData :: Maybe CustomData -> [StyledString]
 viewCustomData = maybe [] (\(CustomData v) -> ["custom data: " <> viewJSON (J.Object v)])
 
 viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [StyledString]
-viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias, contactLink}, activeConn} stats =
+viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias, contactLink, localBadge}, activeConn} stats =
   [ "group ID: " <> sShow groupId,
     "member ID: " <> sShow groupMemberId
   ]
+    <> viewContactBadge localBadge
     <> maybe ["member not connected"] viewConnectionStats stats
     <> maybe [] (\l -> ["contact address: " <> (plain . strEncode) (simplexChatContact' l)]) contactLink
     <> ["alias: " <> plain localAlias | localAlias /= ""]
@@ -1967,10 +1982,10 @@ countactUserPrefText cup = case cup of
 
 viewGroupUpdated :: GroupInfo -> GroupInfo -> Maybe GroupMember -> Maybe MsgSigStatus -> [StyledString]
 viewGroupUpdated
-  GroupInfo {localDisplayName = n, groupProfile = GroupProfile {fullName, shortDescr, description, image, groupPreferences = gps, memberAdmission = ma}}
-  g'@GroupInfo {localDisplayName = n', groupProfile = GroupProfile {fullName = fullName', shortDescr = shortDescr', description = description', image = image', groupPreferences = gps', memberAdmission = ma'}}
+  GroupInfo {localDisplayName = n, groupProfile = GroupProfile {fullName, shortDescr, description, image, groupPreferences = gps, memberAdmission = ma, publicGroup = pg}}
+  g'@GroupInfo {localDisplayName = n', groupProfile = GroupProfile {fullName = fullName', shortDescr = shortDescr', description = description', image = image', groupPreferences = gps', memberAdmission = ma', publicGroup = pg'}}
   m signed = do
-    let update = groupProfileUpdated <> groupPrefsUpdated <> memberAdmissionUpdated
+    let update = groupProfileUpdated <> groupPrefsUpdated <> memberAdmissionUpdated <> publicGroupAccessUpdated
     if null update
       then []
       else memberUpdated <> update
@@ -1995,6 +2010,18 @@ viewGroupUpdated
       memberAdmissionUpdated
         | ma == ma' = []
         | otherwise = ["changed member admission rules"]
+      publicGroupAccessUpdated
+        | access == access' = []
+        | otherwise = ["updated public group access:" <> viewAccess access']
+        where
+          access = pg >>= publicGroupAccess
+          access' = pg' >>= publicGroupAccess
+          viewAccess Nothing = " removed"
+          viewAccess (Just PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding}) =
+            maybe "" (\u -> " web=" <> plain u) groupWebPage
+              <> maybe "" (\d -> " domain=" <> plain d) groupDomain
+              <> (if domainWebPage then " domain_page=on" else "")
+              <> (if allowEmbedding then " embed=on" else "")
 
 viewGroupProfile :: GroupInfo -> [StyledString]
 viewGroupProfile g@GroupInfo {groupProfile = GroupProfile {shortDescr, description, image, groupPreferences = gps}} =
@@ -2796,9 +2823,47 @@ ttyContact = styled (colored Green) . viewName
 ttyContact' :: Contact -> StyledString
 ttyContact' Contact {localDisplayName = c} = ttyContact c
 
+-- Supporter badge: a colored star marks an active badge (only the star is colored).
+-- supporter cyan, legend blue, investor yellow, unknown cyan; business has no star.
+badgeStarColor :: BadgeType -> Maybe Color
+badgeStarColor = \case
+  BTSupporter -> Just Cyan
+  BTLegend -> Just Blue
+  BTInvestor -> Just Yellow
+  BTUnknown _ -> Just Cyan
+
+-- (star color, type word) for an active, colorable badge
+activeBadge :: Maybe LocalBadge -> Maybe (Color, Text)
+activeBadge lb_ = do
+  lb <- lb_
+  case localBadgeStatus lb of
+    BSActive -> let BadgeInfo {badgeType} = localBadgeInfo lb in (\col -> (col, textEncode badgeType)) <$> badgeStarColor badgeType
+    _ -> Nothing
+
+badgeStar :: Color -> StyledString
+badgeStar col = styled (colored col) ("*" :: Text)
+
+-- " *" (space + colored star) for sender prefixes, "" if no active badge
+badgeStarSep :: Maybe LocalBadge -> StyledString
+badgeStarSep lb_ = maybe "" (\(c, _) -> " " <> badgeStar c) (activeBadge lb_)
+
+-- name + badge for full-name contexts: "alice (Alice, * supporter)" / "alice (* supporter)" / "alice (Alice)" / "alice"
+ttyFullNameBadge :: ContactName -> Text -> Maybe Text -> Maybe LocalBadge -> StyledString
+ttyFullNameBadge c fullName shortDescr lb_ = ttyContact c <> optFullNameBadge c fullName shortDescr lb_
+
+optFullNameBadge :: ContactName -> Text -> Maybe Text -> Maybe LocalBadge -> StyledString
+optFullNameBadge c fullName shortDescr lb_ = case activeBadge lb_ of
+  Nothing -> optFullName c fullName shortDescr
+  Just (color, typeWord) -> " (" <> nameInner <> badgeStar color <> plain (" " <> typeWord) <> ")"
+  where
+    nameInner = maybe "" (\t -> plain (t <> ", ")) innerName
+    innerName
+      | T.null fullName || c == fullName = shortDescr
+      | otherwise = Just fullName
+
 ttyFullContact :: Contact -> StyledString
-ttyFullContact Contact {localDisplayName, profile = LocalProfile {fullName, shortDescr}} =
-  ttyFullName localDisplayName fullName shortDescr
+ttyFullContact Contact {localDisplayName, profile = LocalProfile {fullName, shortDescr, localBadge}} =
+  ttyFullNameBadge localDisplayName fullName shortDescr localBadge
 
 ttyMember :: GroupMember -> StyledString
 ttyMember GroupMember {localDisplayName} = ttyContact localDisplayName
@@ -2827,7 +2892,8 @@ ttyQuotedMember (Just GroupMember {localDisplayName = c}) = "> " <> ttyFrom (vie
 ttyQuotedMember Nothing = ">"
 
 ttyFromContact :: Contact -> StyledString
-ttyFromContact ct@Contact {localDisplayName = c} = ctIncognito ct <> ttyFrom (viewName c <> "> ")
+ttyFromContact ct@Contact {localDisplayName = c, profile = LocalProfile {localBadge}} =
+  ctIncognito ct <> ttyFrom (viewName c) <> badgeStarSep localBadge <> ttyFrom "> "
 
 ttyFromContactEdited :: Contact -> StyledString
 ttyFromContactEdited ct@Contact {localDisplayName = c} = ctIncognito ct <> ttyFrom (viewName c <> "> [edited] ")

src/Simplex/Chat/Web.hs

@@ -0,0 +1,435 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
+module Simplex.Chat.Web
+  ( WebChannelPreview (..),
+    WebMessage (..),
+    WebMemberProfile (..),
+    WebFileInfo (..),
+    webPreviewWorker,
+    writeCorsConfig,
+    removeStaleFiles,
+    channelContentChanged,
+    channelProfileUpdated,
+    channelRemoved,
+    extractOrigin,
+  )
+where
+
+import Control.Concurrent.STM (check, flushTQueue)
+import Control.Exception (SomeException, catch)
+import Control.Logger.Simple
+import Control.Monad
+import Control.Monad.Except (runExceptT)
+import Data.Either (rights)
+import Data.Int (Int64)
+import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as LB
+import Data.Text.Encoding (encodeUtf8)
+import qualified Data.Map.Strict as M
+import qualified Data.Set as S
+import Data.Maybe (isJust, mapMaybe, maybeToList)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import Simplex.Chat.Controller (ChatController (..), CorsOrigin (..), PublishableGroup (..), WebPreviewConfig (..), WebPreviewState (..), mkStoreCxt)
+import Simplex.Chat.Markdown (FormattedText (..), MarkdownList, parseMaybeMarkdownList)
+import Simplex.Chat.Messages
+  ( CChatItem (..),
+    CIDirection (..),
+    CIFile (..),
+    CIMeta (..),
+    CIQDirection (..),
+    CIQuote (..),
+    CIReactionCount,
+    ChatItem (..),
+    ChatType (..),
+  )
+import Simplex.Chat.Messages.CIContent (ciMsgContent)
+import Simplex.Chat.Protocol (MsgContent, MsgRef (..), QuotedMsg (..), isReport)
+import Simplex.Chat.Store.Groups (getGroupOwners, getRelayPublishableGroups, updatePublicMemberCount)
+import Simplex.Chat.Store.Messages (getGroupWebPreviewItems)
+import Simplex.Chat.Store.Shared (getGroupInfo)
+import Simplex.Chat.Types
+  ( B64UrlByteString,
+    GroupInfo (..),
+    GroupMember (..),
+    GroupProfile (..),
+    GroupSummary (..),
+    ImageData,
+    LocalProfile (..),
+    MemberId,
+    PublicGroupAccess (..),
+    PublicGroupProfile (..),
+    User (..),
+  )
+import Simplex.Messaging.Agent.Store.Common (withTransaction)
+import Simplex.Messaging.Encoding.String (strEncode)
+import Simplex.Messaging.Util (catchOwn, eitherToMaybe, safeDecodeUtf8, tshow)
+import Simplex.Messaging.Parsers (defaultJSON)
+import System.Directory (createDirectoryIfMissing, listDirectory, removeFile, renameFile)
+import System.FilePath (dropExtension, takeExtension, (</>))
+import qualified URI.ByteString as U
+import UnliftIO.STM
+
+data WebFileInfo = WebFileInfo
+  { fileName :: String,
+    fileSize :: Integer
+  }
+  deriving (Show)
+
+data WebMemberProfile = WebMemberProfile
+  { memberId :: MemberId,
+    displayName :: Text,
+    image :: Maybe ImageData
+  }
+  deriving (Show)
+
+data WebMessage = WebMessage
+  { sender :: Maybe MemberId,
+    ts :: UTCTime,
+    content :: MsgContent,
+    formattedText :: Maybe MarkdownList,
+    file :: Maybe WebFileInfo,
+    quote :: Maybe QuotedMsg,
+    reactions :: [CIReactionCount],
+    forward :: Maybe Bool,
+    edited :: Bool
+  }
+  deriving (Show)
+
+data WebChannelPreview = WebChannelPreview
+  { channel :: GroupProfile,
+    shortDescription :: Maybe MarkdownList,
+    welcomeMessage :: Maybe MarkdownList,
+    members :: [WebMemberProfile],
+    subscribers :: Maybe Int64,
+    messages :: [WebMessage],
+    updatedAt :: UTCTime
+  }
+  deriving (Show)
+
+$(JQ.deriveJSON defaultJSON ''WebFileInfo)
+
+$(JQ.deriveJSON defaultJSON ''WebMemberProfile)
+
+$(JQ.deriveJSON defaultJSON ''WebMessage)
+
+$(JQ.deriveJSON defaultJSON ''WebChannelPreview)
+
+webPreviewWorker :: WebPreviewConfig -> ChatController -> [User] -> IO ()
+webPreviewWorker cfg@WebPreviewConfig {webJsonDir, webCorsFile, webUpdateInterval} cc users =
+  forM_ (webPreviewState cc) $ \wps -> do
+    createDirectoryIfMissing True webJsonDir
+    initPublishableGroups wps
+    cleanStaleFiles wps
+    regenerateCors wps
+    seedRoutinePending wps
+    forever $ workerLoop wps `catchOwn` \e -> logError ("web preview worker error: " <> tshow e)
+  where
+    cxt = mkStoreCxt (config cc)
+
+    workerLoop wps@WebPreviewState {priorityRender, filesToRemove, corsNeeded, routinePending, wakeSignal} = do
+      drainRemovals
+      drainPriority
+      handleCors
+      renderRoutine
+      noRoutine <- atomically $ S.null <$> readTVar routinePending
+      when noRoutine waitRefresh
+      where
+        drainRemovals = atomically (tryReadTQueue filesToRemove) >>= \case
+          Nothing -> pure ()
+          Just f -> do
+            removeFile (webJsonDir </> f) `catch` \(_ :: SomeException) -> pure ()
+            drainRemovals
+
+        -- flush the whole queue and render each group once: a burst of changes in one
+        -- channel enqueues its id many times, but only needs a single render
+        drainPriority = do
+          gIds <- atomically $ flushTQueue priorityRender
+          forM_ (S.fromList gIds) $ renderOneGroup wps
+
+        handleCors = do
+          needed <- atomically $ swapTVar corsNeeded False
+          when needed $ regenerateCors wps
+
+        -- render a single routine item; the main loop calls this once per iteration
+        renderRoutine = do
+          mGId <- atomically $ do
+            pending <- readTVar routinePending
+            case S.minView pending of
+              Nothing -> pure Nothing
+              Just (gId, rest) -> writeTVar routinePending rest >> pure (Just gId)
+          forM_ mGId $ renderOneGroup wps
+
+        -- routine list drained: wait for the refresh timer or a change signal; only the timer
+        -- seeds the next full sweep, a change just returns to let the main loop service it
+        waitRefresh = do
+          delay <- registerDelay (webUpdateInterval * 1000000)
+          timerFired <- atomically $
+            (True <$ (readTVar delay >>= check)) `orElse` (False <$ takeTMVar wakeSignal)
+          when timerFired $ seedRoutinePending wps
+
+    initPublishableGroups WebPreviewState {publishableGroupIds} = do
+      rows <- withTransaction (chatStore cc) $ \db ->
+        concat <$> mapM (getRelayPublishableGroups db) users
+      let gIds = M.fromList [(gId, toPublishableGroup pgId access) | (gId, pgId, access) <- rows]
+      atomically $ writeTVar publishableGroupIds gIds
+
+    cleanStaleFiles WebPreviewState {publishableGroupIds} = do
+      ids <- readTVarIO publishableGroupIds
+      let activeFiles = S.fromList $ map pgFileName $ M.elems ids
+      removeStaleFiles webJsonDir activeFiles
+
+    regenerateCors WebPreviewState {publishableGroupIds} = do
+      ids <- readTVarIO publishableGroupIds
+      let entries = mapMaybe pgCorsEntry $ M.elems ids
+      forM_ webCorsFile $ writeCorsConfig entries
+
+    seedRoutinePending WebPreviewState {publishableGroupIds, routinePending} =
+      atomically $ M.keysSet <$> readTVar publishableGroupIds >>= writeTVar routinePending
+
+    renderOneGroup WebPreviewState {publishableGroupIds} gId = do
+      publishable <- atomically $ M.member gId <$> readTVar publishableGroupIds
+      when publishable $
+        renderOrRemoveStale `catch` \(e :: SomeException) ->
+          logError $ "web preview: error rendering group " <> T.pack (show gId) <> ": " <> T.pack (show e)
+      where
+        renderOrRemoveStale = do
+          r <- withTransaction (chatStore cc) $ \db ->
+            findUser $ \u -> fmap (\g -> (u, g)) <$> runExceptT (getGroupInfo db cxt u gId)
+          case r of
+            Just (u, gInfo) | hasPublicGroup gInfo ->
+              void $ renderGroupPreview cfg cc u gInfo
+            _ -> do
+              fName <- atomically $ do
+                pg <- M.lookup gId <$> readTVar publishableGroupIds
+                modifyTVar' publishableGroupIds (M.delete gId)
+                pure $ pgFileName <$> pg
+              forM_ fName $ \f ->
+                removeFile (webJsonDir </> f) `catch` \(_ :: SomeException) -> pure ()
+              logInfo $ "web preview: group " <> T.pack (show gId) <> " no longer publishable"
+
+    findUser f = go users
+      where
+        go [] = pure Nothing
+        go (u : us) = f u >>= \case
+          Right a -> pure (Just a)
+          Left _ -> go us
+
+renderGroupPreview :: WebPreviewConfig -> ChatController -> User -> GroupInfo -> IO (Maybe (Text, CorsOrigin))
+renderGroupPreview WebPreviewConfig {webJsonDir, webPreviewItemCount} cc user gInfo@GroupInfo {groupProfile = gp@GroupProfile {shortDescr = sd, description = wd, publicGroup}, groupSummary = GroupSummary {publicMemberCount}} =
+  case publicGroup of
+    Just PublicGroupProfile {publicGroupId, publicGroupAccess} -> do
+      let fName = publicGroupIdFileName publicGroupId <> ".json"
+      -- backfill the subscriber count for channels created before it was tracked
+      subscribers <- case publicMemberCount of
+        Just _ -> pure publicMemberCount
+        Nothing -> do
+          g_ <- withTransaction (chatStore cc) (\db -> runExceptT $ updatePublicMemberCount db cxt user gInfo)
+          pure $ eitherToMaybe g_ >>= \GroupInfo {groupSummary = GroupSummary {publicMemberCount = pmc}} -> pmc
+      (items, owners) <- withTransaction (chatStore cc) $ \db -> do
+        is <- getGroupWebPreviewItems db user gInfo webPreviewItemCount
+        os <- getGroupOwners db cxt user gInfo
+        pure (is, os)
+      ts <- getCurrentTime
+      let rendered = mapMaybe toRenderedItem $ rights items
+          msgs = map fst rendered
+          senders = collectSenders $ map memberToProfile owners <> concatMap snd rendered
+          preview = WebChannelPreview
+            { channel = gp,
+              shortDescription = toFormattedText =<< sd,
+              welcomeMessage = toFormattedText =<< wd,
+              members = senders,
+              subscribers,
+              messages = msgs,
+              updatedAt = ts
+            }
+      let destPath = webJsonDir </> fName
+          tmpPath = destPath <> ".tmp"
+      LB.writeFile tmpPath (J.encode preview)
+      renameFile tmpPath destPath
+      pure $ corsEntry publicGroupId <$> publicGroupAccess
+    Nothing -> pure Nothing
+  where
+    cxt = mkStoreCxt (config cc)
+
+channelContentChanged :: ChatController -> Int64 -> STM ()
+channelContentChanged cc gId =
+  forM_ (webPreviewState cc) $ \WebPreviewState {publishableGroupIds, priorityRender, routinePending, wakeSignal} -> do
+    ids <- readTVar publishableGroupIds
+    when (M.member gId ids) $ do
+      writeTQueue priorityRender gId
+      modifyTVar' routinePending (S.delete gId)
+      void $ tryPutTMVar wakeSignal ()
+
+channelProfileUpdated :: ChatController -> Int64 -> GroupProfile -> STM ()
+channelProfileUpdated cc gId GroupProfile {publicGroup} =
+  forM_ (webPreviewState cc) $ \WebPreviewState {publishableGroupIds, priorityRender, filesToRemove, corsNeeded, routinePending, wakeSignal} ->
+    case publicGroup of
+      Just PublicGroupProfile {publicGroupId, publicGroupAccess} -> do
+        let pg = PublishableGroup
+              { pgFileName = publicGroupIdFileName publicGroupId <> ".json",
+                pgCorsEntry = corsEntry publicGroupId <$> publicGroupAccess
+              }
+        modifyTVar' publishableGroupIds (M.insert gId pg)
+        writeTQueue priorityRender gId
+        modifyTVar' routinePending (S.delete gId)
+        writeTVar corsNeeded True
+        void $ tryPutTMVar wakeSignal ()
+      Nothing -> do
+        ids <- readTVar publishableGroupIds
+        forM_ (pgFileName <$> M.lookup gId ids) $ writeTQueue filesToRemove
+        modifyTVar' publishableGroupIds (M.delete gId)
+        modifyTVar' routinePending (S.delete gId)
+        writeTVar corsNeeded True
+        void $ tryPutTMVar wakeSignal ()
+
+channelRemoved :: ChatController -> Int64 -> STM ()
+channelRemoved cc gId =
+  forM_ (webPreviewState cc) $ \WebPreviewState {publishableGroupIds, filesToRemove, corsNeeded, routinePending, wakeSignal} -> do
+    ids <- readTVar publishableGroupIds
+    forM_ (pgFileName <$> M.lookup gId ids) $ writeTQueue filesToRemove
+    modifyTVar' publishableGroupIds (M.delete gId)
+    modifyTVar' routinePending (S.delete gId)
+    writeTVar corsNeeded True
+    void $ tryPutTMVar wakeSignal ()
+
+toRenderedItem :: CChatItem 'CTGroup -> Maybe (WebMessage, [WebMemberProfile])
+toRenderedItem (CChatItem _ ChatItem {chatDir, meta = CIMeta {itemTs, itemTimed, itemForwarded, itemEdited}, content, formattedText, quotedItem, reactions, file})
+  | isJust itemTimed = Nothing
+  | otherwise = case ciMsgContent content of
+      Just mc | not (isReport mc) ->
+        let (sender, senderProfile) = case chatDir of
+              CIGroupRcv m@GroupMember {memberId} -> (Just memberId, [memberToProfile m])
+              _ -> (Nothing, [])
+            quotedProfile = case quotedItem of
+              Just CIQuote {chatDir = CIQGroupRcv (Just m)} -> [memberToProfile m]
+              _ -> []
+         in Just
+              ( WebMessage
+                  { sender,
+                    ts = itemTs,
+                    content = mc,
+                    formattedText,
+                    file = webFileInfo <$> file,
+                    quote = quotedItem >>= ciQuoteToQuotedMsg,
+                    reactions,
+                    forward = if isJust itemForwarded then Just True else Nothing,
+                    edited = itemEdited
+                  },
+                senderProfile <> quotedProfile
+              )
+      _ -> Nothing
+
+ciQuoteToQuotedMsg :: CIQuote c -> Maybe QuotedMsg
+ciQuoteToQuotedMsg CIQuote {chatDir = qDir, sharedMsgId, sentAt, content = qContent} =
+  Just QuotedMsg
+    { msgRef = MsgRef
+        { msgId = sharedMsgId,
+          sentAt,
+          sent = case qDir of
+            CIQDirectSnd -> True
+            CIQGroupSnd -> True
+            _ -> False,
+          memberId = case qDir of
+            CIQGroupRcv (Just GroupMember {memberId}) -> Just memberId
+            _ -> Nothing
+        },
+      content = qContent
+    }
+
+webFileInfo :: CIFile d -> WebFileInfo
+webFileInfo CIFile {fileName, fileSize} = WebFileInfo {fileName, fileSize}
+
+collectSenders :: [WebMemberProfile] -> [WebMemberProfile]
+collectSenders = M.elems . M.fromList . map (\p@WebMemberProfile {memberId} -> (memberId, p))
+
+memberToProfile :: GroupMember -> WebMemberProfile
+memberToProfile GroupMember {memberId, memberProfile = LocalProfile {displayName, image}} =
+  WebMemberProfile {memberId, displayName, image}
+
+toPublishableGroup :: B64UrlByteString -> Maybe PublicGroupAccess -> PublishableGroup
+toPublishableGroup pgId access =
+  PublishableGroup
+    { pgFileName = publicGroupIdFileName pgId <> ".json",
+      pgCorsEntry = corsEntry pgId <$> access
+    }
+
+corsEntry :: B64UrlByteString -> PublicGroupAccess -> (Text, CorsOrigin)
+corsEntry publicGroupId PublicGroupAccess {groupWebPage, allowEmbedding} =
+  let fName = T.pack $ publicGroupIdFileName publicGroupId <> ".json"
+      origin
+        | allowEmbedding = CorsAny
+        | otherwise = CorsOrigins $ mapMaybe extractOrigin $ maybeToList groupWebPage
+   in (fName, origin)
+
+extractOrigin :: Text -> Maybe Text
+extractOrigin url =
+  case U.parseURI U.laxURIParserOptions (encodeUtf8 url) of
+    Right uri@U.URI {uriScheme = U.Scheme sch, uriAuthority = Just _}
+      | sch == "https" || sch == "http" ->
+          let originUri = uri {U.uriPath = "", U.uriQuery = U.Query [], U.uriFragment = Nothing}
+              origin = safeDecodeUtf8 $ U.serializeURIRef' originUri
+           in if T.all safeOriginChar origin then Just origin else Nothing
+    _ -> Nothing
+  where
+    -- percent-encoded bytes in the host (e.g. %22, %0a) are decoded by serializeURIRef',
+    -- so reject any origin with characters that could break out of the Caddy CORS config or header
+    safeOriginChar c =
+      (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c `elem` (".-:/[]" :: [Char])
+
+channelPath :: Text
+channelPath = "/channel/"
+
+writeCorsConfig :: [(Text, CorsOrigin)] -> FilePath -> IO ()
+writeCorsConfig entries path =
+  TIO.writeFile path $ T.unlines $
+    ["map {path} {cors_origin} {"]
+    <> map corsLine entries
+    <> [ "    default \"\"",
+         "}",
+         "header " <> channelPath <> "*.json Access-Control-Allow-Origin {cors_origin}",
+         "header " <> channelPath <> "*.json Access-Control-Allow-Methods \"GET, OPTIONS\""
+       ]
+  where
+    corsLine (fName, origin) = case origin of
+      CorsAny -> "    " <> channelPath <> fName <> " \"*\""
+      CorsOrigins origins -> case origins of
+        [] -> "    # " <> fName <> " (no origin configured)"
+        (o : _) -> "    " <> channelPath <> fName <> " \"" <> o <> "\""
+
+removeStaleFiles :: FilePath -> S.Set FilePath -> IO ()
+removeStaleFiles dir activeFiles = do
+  let -- matches "<base64url>.json" and leftover "<base64url>.json.tmp" from an interrupted write
+      isPreviewFile f =
+        let f' = if takeExtension f == ".tmp" then dropExtension f else f
+            base = dropExtension f'
+         in takeExtension f' == ".json" && not (null base) && all isBase64Url base
+      isBase64Url c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c == '-' || c == '_'
+  allFiles <- S.filter isPreviewFile . S.fromList <$> listDirectory dir
+  mapM_ (\f -> removeFile (dir </> f)) $ S.difference allFiles activeFiles
+
+toFormattedText :: Text -> Maybe MarkdownList
+toFormattedText t = case parseMaybeMarkdownList t of
+  Just fts | any hasFormat fts -> Just fts
+  _ -> Nothing
+  where
+    hasFormat (FormattedText fmt _) = isJust fmt
+
+publicGroupIdFileName :: B64UrlByteString -> String
+publicGroupIdFileName = B.unpack . strEncode
+
+hasPublicGroup :: GroupInfo -> Bool
+hasPublicGroup GroupInfo {groupProfile = GroupProfile {publicGroup}} = isJust publicGroup
+