badge presentation in groups

plans/2026-09-04-badge-binding-and-file-limits.md

@@ -75,57 +75,59 @@ The file name is not part of either header: `validateFileInvitation` replaces it
 
 One constructor serves every chat type, because the chat binding already encodes the type of chat in its first byte. Each constructor gets a tag character in `ProofPresHeaderTag` and an encoding in the `StrEncoding` instance, in the same style as `PHTest`. The file expiration is optional, because a server may grant none; it is encoded as `strEncode` of the time, or one fixed byte when absent. The badge's own expiry is a time and is encoded with `strEncode` in the disclosed messages (`badgeInfoMessages`, `Badges.hs:296`).
 
-`verifyBadgeWith` today verifies a proof with whatever header the proof contains. After this change the receiver first checks that the header names the sender as the receiver knows them, and only then runs BBS verification with that header. `proofPresHeaderAccepted` is removed. What the receiver knows is already held by existing types, so no new type is added:
+`verifyBadgeWith` today verifies a proof with whatever header the proof contains. After this change the receiver first checks that the header names the sender as the receiver knows them, and only then runs BBS verification with that header. `proofPresHeaderAccepted` is removed; `verifyBadge` runs BBS verification only, and the header rule is applied by its callers:
 
-- A contact request, link data, and the profile in a direct chat: the header must be `PHTest`.
+- A contact request, link data, and the profile in a direct chat: the header must be `PHTest` until direct chats are bound (section 14).
 - A file in a direct chat: the receiver has the contact's connection and obtains its ratchet hash from the agent, as `newContentMessage` does for a contact card (`Subscriber.hs:1883`). The binding in the header must equal `encodeChatBinding CBDirect adHash`.
-- A profile or a file in a group: the receiver has the `GroupInfo` and the sender's `GroupMember`. The binding in the header must equal `groupBindingData` for that member — for a channel the group's public id and the member id; for a p2p group the member id and a key that passes the key check.
+- A profile or a file in a group: the receiver has the `GroupInfo` and the sender's `GroupMember`. The binding in the header must equal `groupBindingData` for that member — for a channel the group's public id and the member id; for a p2p group the member id and the member key.
 
-**The key check.** A p2p binding contains the sender's member key. The receiver may know that member's key from the introduction or from a signed message, or may not know it yet. If the receiver knows a key and it differs from the key in the header, the proof fails. Otherwise the key in the header is used for this verification and never stored; keys are stored only by the introduction and by `storeMemberKey`.
+**The key in a p2p binding.** For a file the receiver may not know the sender's key yet; if it knows one and it differs from the key in the header, the proof fails, otherwise the key in the header is used for this verification and never stored (`proofMemberKey`). For a profile the key is the one the message signature was verified under, section 3; a header key is never used.
 
 The file headers are checked the same way and then further: `PHFileInv` must also name the file size as received; `PHFileDescr` must also hold the hash of the received description and the expiration received with it.
 
 `PHUnknown` fails every check. A proof from a released client, which presents `PHTest` in groups, fails in groups; no badge has been issued yet, so nothing in use is affected. A released client that receives one of the new headers verifies it, because its `proofPresHeaderAccepted` admits unknown tags and BBS verification runs with the header bytes as sent. No protocol version change is needed.
 
-`groupBindingData` moves from `Internal.hs` to `Protocol.hs`, beside `encodeChatBinding`, because the store modules import `Protocol` and not `Internal`. Module order fixes where the check is computed: `Badges.hs` is imported by `Types.hs`, which `Protocol.hs` imports, so the header check in `Badges.hs` takes plain values — the expected binding for a channel or a direct chat, or the member id and the stored key for a p2p group — and the callers in the store compute them from `GroupInfo` and `GroupMember` with `groupBindingData`. `profileBadgeVerified` is in `Types.hs` today and cannot call `groupBindingData`; it moves to `Store/Shared.hs`, beside the other badge-verifying store code.
+The chat layer computes the expected binding and passes it to the store, so `groupBindingData` and `profileBadgeVerified` stay where they are. `Badges.hs` holds the two header predicates: `unboundProof`, true for a `PHTest` header, and `boundProof binding_`, true when the header equals `PHChat` of the given binding and false when there is none. `verifyBadge_` and `profileBadgeVerified` take the predicate as their first argument.
 
 `SimplexDomainProof` (`Names.hs:37`) also uses `ProofPresHeader`, as an opaque value. Its verification is unchanged.
 
 ## 2. Presenting the profile badge
 
-File: `src/Simplex/Chat/Library/Internal.hs`, `presentUserBadge` (`:2178`).
+File: `src/Simplex/Chat/Library/Internal.hs`, `presentUserBadge` (`:2237`).
 
-The function generates the proof for an outgoing profile. It takes a new argument, `Maybe GroupInfo`. With `Nothing` it generates `PHTest` as today. With `Just gInfo` it generates `PHChat` from the group's chat binding and the user's own member key in that group, calling `createUserMemberKey` first when the group has no key yet.
+The function generates the proof for an outgoing profile. It takes a new argument, `Maybe GroupInfo`. With `Nothing` it generates `PHTest` as today. With `Just gInfo` it generates `PHChat` of `sndGroupChatBinding gInfo False`, the user's own member binding in that group; the membership key is stored by `mkGroupKeys` when the group is read with its keys, and a membership with no stored public key presents no badge. The proof is generated by `sndBadgeProof`, as file proofs are.
 
-Call sites that send a profile into a group pass the group: `Commands.hs:3953` (join via group link, the group case), `:4291` (the owner's profile to a relay); `Subscriber.hs:480` (the group case), `:611`, `:799`, `:813`, `:941`, `:1220`, `:3271`; `Internal.hs:2539` (`sendGroupProfileUpdate`). All other call sites send a direct profile and pass `Nothing`.
+Call sites that send a profile into a group pass the group: `Commands.hs:3976` (join via group link, the relay case), `:4315` (the owner's profile to a relay); `Subscriber.hs:505` (the group case), `:637`, `:826`, `:840`, `:967`, `:1249`, `:3335`; `Internal.hs:2652` (`sendGroupProfileUpdate`). All other call sites send a direct profile and pass `Nothing`.
 
-The profile in a direct chat keeps `PHTest`; moving it to `PHChat` is a later change.
+A join by `XContact` (`Commands.hs:3976`, a p2p group or a group not yet known) sends the profile without a badge, since section 3 does not accept one there. The two handshake sends (section 4) present the badge only when the peer version is at least `relayWebCapVersion`.
 
 ## 3. Accepting the profile badge
 
-A received badge is verified today at seven places in the store layer, each verifying the proof with no knowledge of the sender: `profileBadgeVerified` (`Types.hs:834`), `createContact_` (`Store/Shared.hs:420`), `createJoiningMember` (`Store/Groups.hs:2089`), `createNewMemberProfile_` (`Store/Groups.hs:2459`), two contact request sites (`Store/ContactRequest.hs:169, 236`), and `linkDataBadge` (`Internal.hs:2194`).
+A received badge is verified today at seven places in the store layer, each verifying the proof with no knowledge of the sender: `profileBadgeVerified` (`Types.hs:851`), `createContact_` (`Store/Shared.hs:421`), `createJoiningMember` (`Store/Groups.hs:2085`), `createNewMemberProfile_` (`Store/Groups.hs:2440`), two contact request sites (`Store/ContactRequest.hs:170, 237`), and `linkDataBadge` (`Internal.hs:2253`).
 
-The direct sites keep verifying with `PHTest`. The group sites gain the `GroupInfo` and the sender's `GroupMember` where they do not have them already: `updateMemberProfile` and `updateContactMemberProfile` (`Store/Groups.hs:3430, 3453`) have the member and gain the group, and pass both to `profileBadgeVerified`; `createNewMemberProfile_` gains both from `createNewGroupMember`. A badge from a message that was not verified with the member's key is not verified at all: the caller removes it from the profile before storing, so the store function sees no badge.
+The direct sites verify with `unboundProof`. The group store functions take the expected binding, `Maybe ByteString`, and verify with `boundProof`: `updateMemberProfile`, `updateContactMemberProfile` (`Store/Groups.hs:3411, 3434`), `createJoiningMember`, `createNewGroupMember`, `createIntroReMember`, and the functions that call `updateMemberProfile` inside the store — `updateUnknownMemberAnnounced`, `updateRosterMemberAnnounced`, `updatePreparedChannelMember`, `setRelayLinkAccepted`, `updateRelayMemberData`; the callers that build a profile from a name alone pass `Nothing`. A badge with no binding, or with a header that names another binding, is stored as failed, as a proof that fails BBS verification is today.
 
-Where a badge is accepted in a p2p group:
+The chat layer computes the binding with `memberChatBinding gInfo memberId key_` (`Internal.hs`): for a channel `encodeChatBinding CBGroup (publicGroupId, memberId)`, whatever the key; for a p2p group `encodeChatBinding CBGroup (memberId, key)`, or `Nothing` without a key. `rcvGroupChatBinding` uses it for its member alternatives. The key passed is the one the message was verified under:
 
-- `xInfoMember` (`Subscriber.hs:2738`): only when the `XInfo` was verified with the member's key. `RcvMessage.msgSigned` is `MSSVerified` when a stored key verified it. When the same message delivers the key, `storeMemberKey` has verified the signature with that key, and the badge is kept on the same basis. Otherwise the badge is removed from the profile before `processMemberProfileUpdate`.
-- `xGrpLinkMem` (`:2744`): the host's profile to the joiner, signed on this branch.
-- The member connection handshake, section 4.
+- `xInfoMember` (`Subscriber.hs:2798`) and `xGrpLinkMem` (`:2804`): the stored key when `RcvMessage.msgSigned` is `MSSVerified`; otherwise the key the message delivers, when `storeMemberKey` verified the signature with it and stored it — `storeMemberKey` returns that key; otherwise none.
+- The member connection handshake, section 4: the stored key when it verifies the signature.
+- `createJoiningMember`, `createNewGroupMember`, `createIntroReMember`, `updateUnknownMemberAnnounced`, `updateRosterMemberAnnounced`, `updatePreparedChannelMember`, and `updateMemberProfile` in `acceptGroupJoinRequestAsync`: no key. In a channel the binding is complete without it; in a p2p group a join by `XContact` (unsigned JSON) or an introduction (the key is asserted by the introducer) yields no binding, and the member's badge arrives at the handshake. A relay's profile, from its link data, passes `Nothing`.
 
-Where a badge is dropped in a p2p group: `createJoiningMember` and `createNewMemberProfile_`. The profile is stored without the badge, and the member's badge arrives at the handshake.
-
-In a channel a member's profile arrives in three ways: in `XMember` when the member joins, which the member signs and the owner verifies with the roster key (`verifyKey`, `Subscriber.hs:1656`) before `createJoiningMember`; in the introduction from a relay, stored by `createNewMemberProfile_`; and in `XInfo`. A badge in any of them is kept and verified, because member keys in a channel are established by the roster, which the owner signs, and `xGrpMemNew` rejects a relay that asserts a different key (`Subscriber.hs:3127-3134`).
+So in a channel a badge is accepted from any profile message: from `XMember` when the member joins, from the introduction by a relay, and from `XInfo`. The binding names the member id and the group only, and a proof can be replayed only for the member who made it. In a p2p group a badge is accepted only from a message whose signature was verified under the member's key; `withVerifiedMsg` treats signatures as optional there, so the check is made at the three sites above.
 
 ## 4. The member connection handshake
 
-When two p2p members connect, each sends `XGrpMemInfo` with its group profile. It is sent from two places: the reply on the member connection (`Subscriber.hs:816`) and the join of the member connection and of the direct connection to the same member (`:3272`, both joined with the same message at `:3282-3283`). The four receiving sites — `:590, 620` on the direct connection, `:810, 823` on the member connection — each have a "TODO update member profile" comment.
+When two p2p members connect, each sends `XGrpMemInfo` with its group profile. It is sent from two places: the reply on the member connection (`Subscriber.hs:843`) and the join of the member connection and of the direct connection to the same member (`:3336`, both joined with the same message at `:3345-3347`). The four receiving sites — `:615, 647` on the direct connection, `:837, 850` on the member connection — each have a "TODO update member profile" comment.
 
-- **Sign the join side.** `xGrpMemFwd` sends `encodeConnInfo $ XGrpMemInfo ...` (`:3272`), plain JSON. Change it to `encodeSignedConnInfo` with `groupMsgSigning` when the agreed version is at least `relayWebCapVersion`. The agreed version is computed three lines below, as `chatV`; move that computation above the send. Call `createUserMemberKey` before signing, here and at the reply site, as every other signing site does.
-- **Parse the signature on CONF.** The member CONF site parses with `parseChatMessage` (`:745`), which discards the signature. Change it to `parseChatMessage'`, as INFO already does (`:823`).
-- **Verify the signature.** At `:810` and `:823` verify the signed `XGrpMemInfo` with the member's stored key. `XGrpMemInfo` names no key, and the handshake follows the introduction, which stored the key. A member with no stored key is not verified.
-- **Store the profile.** At `:810` and `:823` call `processMemberProfileUpdate` with the profile, with the badge removed when the signature did not verify.
-- `:590` and `:620` stay as they are. The profile there is the same group profile, received over the direct connection to the member. The contact for a member shares the member's profile row (`createIntroToMemberContact`, `Store/Groups.hs:2684-2685`), so storing it once, on the member connection, updates both.
+`XGrpMemInfo` is not in `requiresSignature`: the recipient enforces that list only in channels, where the handshake does not occur, and a signature needs the binary encoding, which the peer version decides. Instead `groupMsgSigning` signs `XGrpMemInfo` when its profile carries a badge, and the badge is presented only when the peer version is at least `relayWebCapVersion`, so a presented badge is always signed. The recipient keeps a badge only from a verified signature, so a profile without a badge needs none.
+
+- **Sign the join side.** `xGrpMemFwd` sends `encodeConnInfo $ XGrpMemInfo ...` (`:3336`), plain JSON. It takes `GroupInfoKeys` from the dispatch and encodes with `encodeSignedConnInfo` when `groupMsgSigning` returns a signing. The agreed version is computed below the send, as `chatV`; that computation moves above it, and the badge is presented when `chatV` is at least `relayWebCapVersion`.
+- **The reply side** (`:843`) presents the badge when `peerChatVRange` of the connection allows, and `allowAgentConnectionAsync` signs by the same rule.
+- **Parse the signature on CONF.** The member CONF site parses with `parseChatMessage` (`:781`), which discards the signature. Change it to `parseChatMessage'`, as INFO already does (`:850`).
+- **Verify and store.** At `:837` and `:850` the signature is verified with the member's stored key, as `storeMemberKey` does; `XGrpMemInfo` names no key, and the handshake follows the introduction, which stored the key. `processMemberProfileUpdate` stores the profile with the binding from the verified key, or with no binding.
+- `:615` and `:647` stay as they are. The profile there is the same group profile, received over the direct connection to the member. The contact for a member shares the member's profile row (`createIntroToMemberContact`), so storing it once, on the member connection, updates both.
+
+A member whose key was never introduced shows no badge until a signed `XInfo` that delivers the key arrives.
 
 ## 5. The file size limit at send
 
@@ -258,7 +260,52 @@ The six proof columns are the fields of `BadgeProof` — the proof, the presenta
 - `ChatTests/Files.hs`, beside `testXFTPGroupFileTransfer`: a file above the default limit from a badge holder is received in a group and in a direct chat; an invitation whose proof was made for another member is refused; a description with a changed hash fails before download; a file above the limit received as history is received by the new member; a forward into an incognito membership above the default limit fails the command before any upload.
 - `ProtocolTests.hs`: the new fields in `FileInvitation` and `XMsgFileDescr`.
 
+## 14. Direct chats
+
+The binding of a direct chat is the ratchet associated data, `rcAD = k1_snd ‖ k1_rcv` (simplexmq `Ratchet.hs:498`), hashed: the value `getConnectionRatchetAdHash` returns, already the `CBDirect` payload of file proofs and shared contact cards. A contact request to an address without ratchet keys has no ratchet yet; its binding is the request itself. Both are made available by the agent before the chat composes the message, so every profile message is bound and nothing is sent after connection. Implementation starts in simplexmq, in `/code/simplexmq-4`; the chat then builds against it.
+
+### 14.1 Agent
+
+**Second verification code.** `RatchetInitParams` gains `rcVerifyCodePQ` and `Ratchet` gains `rcVCPQ :: Maybe Str`. `pqX3dh` expands the KDF to 128 bytes with `hkdf4` and takes the last 32 as the code; the first 96 bytes are the same output as today, so peers on either version derive the same keys, and `rcAD` stays the AEAD associated data. It is not associated data itself — it is exported keying material, the fourth of the paper's mitigations, and it covers every handshake input, the KEM included. A ratchet created before this change decodes with `rcVCPQ = Nothing`, and the value cannot be computed for it afterwards — the handshake secrets are gone — so it appears at the next ratchet resync or not at all. For that reason the chat keeps using the AD code, `codeAD`, for the security code and for badge bindings; `codePQ` is stored now and used when connections have it.
+
+**Columns.** Migration `M20260919_ratchet_ad`, SQLite and Postgres, both schema dumps: `ratchets` gains `ratchet_ad BLOB` and `ratchet_ad_pq BLOB` (`BYTEA` on Postgres). `createRatchet` and `createSndRatchet` write both, also through their `ON CONFLICT` update, which is how a resync recreates the ratchet.
+
+One store function, `getRatchetADs :: DB.Connection -> [ConnId] -> IO (Map ConnId (ByteString, Maybe ByteString))`, serves one id or many, with one SELECT and at most one batched UPDATE:
+
+```sql
+SELECT conn_id, ratchet_ad, ratchet_ad_pq, CASE WHEN ratchet_ad IS NULL THEN ratchet_state END
+FROM ratchets
+WHERE conn_id IN (?, ?, ...)
+```
+
+The blob column is NULL in every row that has `ratchet_ad`, so an established connection costs one small row and no JSON decoding. Rows are `(ConnId, Maybe ByteString, Maybe ByteString, Maybe RatchetX448)`; a row with the AD is used as is; a row with the blob is decoded for `rcAD` and `rcADPQ` and collected; a row with neither (a ratchet row holding only x3dh keys, before CONF) is skipped. The collected rows are written back with one `executeMany "UPDATE ratchets SET ratchet_ad = ?, ratchet_ad_pq = ? WHERE conn_id = ?"`. On Postgres the list is `In connIds`; on SQLite the placeholder list is built from the id count, in chunks of 500 to stay under the variable limit. Only a NULL `ratchet_ad` selects the blob: `ratchet_ad_pq` stays NULL for a ratchet created before the change and never causes a second read.
+
+`getConnectionVerifyCodes` uses it with one id, `getConnectionsVerifyCodes` with many; both return `ConnVerifyCodes {codeAD, codePQ}`, defined in `Agent/Protocol.hs`, where `codeAD = sha256 rcAD` and `codePQ` is the PQ code as derived.
+
+**Prepare step.** `prepareConnectionToJoin` returns `(ConnId, ConnVerifyCodes)`, the binding for the message the chat composes next:
+
+- `CRInvitationUri`: creates the sender ratchet (`createRatchet_`, local — the link's keys and a fresh keypair) and returns its codes.
+- `CRContactUri` with ratchet keys: the same, from the address keys.
+- `CRContactUri` without keys: generates the x3dh keys (`generateRcvE2EParams`, `createRatchetX3dhKeys`) and returns `codeAD = sha256 (k1 ‖ k2 ‖ kem ‖ senderId)` with no `codePQ` — the request's public keys and the queue id from the link's `SMPQueueUri`.
+
+`prepareConnectionToAccept` returns the same pair: for `CRInvitation` it creates the ratchet from the invitation's keys, for `CRInvitationDR` it takes the ratchet stored in the invitation. `startJoinInvitation` reads the ratchet before creating one, as the contact path and its retry branch already do; `createConnReq` reads the x3dh keys before generating them, as `mkJoinInvitation` does. Async joins and accepts then find the ratchet in place. Nothing in the prepare step touches the network.
+
+**Events.** `REQ` gains a `ConnVerifyCodes` field: `smpInvitation` computes `codeAD` from the received `CRInvitationUri` and the queue it arrived on; `smpContactRequest` passes the codes of the ratchet it initialised. `CONF` and `INFO` are unchanged: the receiver's ratchet is stored before the notification, so the getter serves. A request without a ratchet proves no key possession; X448 keys cannot sign, and a forged request with copied public keys shows the badge in the request list and then fails to connect — accepted.
+
+**Tests.** `DoubleRatchetTests`: the parties agree on `rcVerifyCodePQ`, a substituted KEM key makes it differ while `assocData` matches, and a ratchet stored before the change decodes with `rcVCPQ = Nothing`. `FunctionalAPITests`: both peers get the same codes, and codes cleared from a row are recomputed and saved on the next read.
+
+### 14.2 Chat
+
+The chat uses `codeAD` — for the security code it shows today and for every badge binding. `codePQ` is stored by the agent and used later, once connections have it on both sides; a ratchet created before the change never does without a resync.
+
+`presentUserBadge` takes the binding, `Maybe ByteString`, for both chat kinds — `sndGroupChatBinding gInfo False` for a group, `codeAD` for a direct chat — and generates `PHChat`; the `PHTest` branch, `unboundProof` and the `PHTest` acceptance go.
+
+Sending: a join via one-time link (`Commands.hs:3826`, member contact `:3408`, `Subscriber.hs:3933`) and a request (`joinContact`, `Commands.hs:3980`) use the value from `prepareConnectionToJoin`; accepting (`Internal.hs:998, 1010`) the value from `prepareConnectionToAccept`; INFO (`Subscriber.hs:505` direct case, `:624`) the getter on the connection; `XInfo` to contacts (`Commands.hs:4062, 4095`, `presentUserBadgeToContacts`) the bulk getter, once per command.
+
+Receiving: `updateContactProfile` (`Direct.hs:566`), `createContact_` (`Shared.hs:419`), the request sites (`ContactRequest.hs:170, 237`) and `linkDataBadge` take `Maybe ByteString` and verify with `boundProof`; `processContactProfileUpdate` (`Subscriber.hs:2758`) and the contact creation at CONF (`:3173`) pass the getter's value, the request sites the `REQ` field. After a resync the value changes on both sides; a badge received under the old one fails and is re-verified with the next update, which `badgeNeedsReverify` already does.
+
+Link data: bound to the link key with a new `ChatBinding` constructor, `CBLink`, payload `strEncode linkKey` from `CSLContact` or `CSLInvitation`, which both the owner and anyone with the link hold. The key is derived from local data (`encodeSignLinkData`), so `prepareConnectionLink` is generalised to addresses and invitation links and the badge is bound before `createConnectionForLink` uploads the data; updates (`setMyAddressData`, `updatePCCShortLinkData`) already hold the link.
+
 ## Out of scope
 
-- Moving the direct chat profile proof to `PHChat`.
 - Requiring an expiration in the description proof, once servers grant one.

src/Simplex/Chat/Badges.hs

@@ -48,6 +48,8 @@ module Simplex.Chat.Badges
     badgeProof,
     verifyBadge,
     verifyBadge_,
+    unboundProof,
+    boundProof,
     mkBadgeStatus,
     BadgeRow,
     BadgeProofKind (..),
@@ -318,14 +320,13 @@ instance StrEncoding ProofPresHeader where
         pure PHFileDescr {chatBinding, fileSize, descrHash, fileExpires = systemToUTCTime <$> expires_}
       PHUnknownTag c -> PHUnknown c <$> A.takeByteString
 
--- v6.5.x accepts both; v7 will reject PHTest/PHUnknown
-proofPresHeaderAccepted :: ProofPresHeader -> Bool
-proofPresHeaderAccepted = \case
-  PHTest _ -> True
-  PHChat _ -> True
-  PHFileInv {} -> True
-  PHFileDescr {} -> True
-  PHUnknown _ _ -> True
+unboundProof :: BadgeProof -> Bool
+unboundProof BadgeProof {presHeader = BBSPresHeader ph} = case strDecode ph of
+  Right (PHTest _) -> True
+  _ -> False
+
+boundProof :: Maybe ByteString -> BadgeProof -> Bool
+boundProof binding_ BadgeProof {presHeader} = maybe False (\b -> presHeader == BBSPresHeader (strEncode (PHChat b))) binding_
 
 -- Payment proof
 
@@ -419,13 +420,13 @@ verifyBadge keys b@(BadgeProof keyIdx _ _ _) = case M.lookup keyIdx keys of
   Just pk -> Just <$> verifyBadgeWith pk b
 
 verifyBadgeWith :: BBSPublicKey -> BadgeProof -> IO Bool
-verifyBadgeWith pk (BadgeProof _ ph@(BBSPresHeader phBytes) proof badgeInfo)
-  | either (const False) proofPresHeaderAccepted (strDecode phBytes) =
-      bbsProofVerify pk proof bbsBadgeHeader ph bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeInfoMessages badgeInfo)
-  | otherwise = pure False
+verifyBadgeWith pk (BadgeProof _ ph proof badgeInfo) =
+  bbsProofVerify pk proof bbsBadgeHeader ph bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeInfoMessages badgeInfo)
 
-verifyBadge_ :: Map Int BBSPublicKey -> Maybe BadgeProof -> IO (Maybe Bool)
-verifyBadge_ keys = maybe (pure (Just False)) (verifyBadge keys)
+verifyBadge_ :: (BadgeProof -> Bool) -> Map Int BBSPublicKey -> Maybe BadgeProof -> IO (Maybe Bool)
+verifyBadge_ accepted keys = \case
+  Just b | accepted b -> verifyBadge keys b
+  _ -> pure (Just False)
 
 -- DB
 

src/Simplex/Chat/Library/Commands.hs

@@ -2119,7 +2119,7 @@ processChatCommand cxt nm = \case
     incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
     subMode <- chatReadVar subscriptionMode
     -- TODO [badges] bind link and badge to handshake context
-    linkProfile <- presentUserBadge user incognitoProfile $ userProfileDirect user incognitoProfile Nothing True
+    linkProfile <- presentUserBadge user incognitoProfile Nothing $ userProfileDirect user incognitoProfile Nothing True
     let userData = contactShortLinkData linkProfile {contactDomain = Nothing} Nothing
         userLinkData = UserInvLinkData userData
     (connId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation (Just userLinkData) Nothing IKUsePQ True subMode
@@ -2141,7 +2141,7 @@ processChatCommand cxt nm = \case
           updatePCCIncognito db user conn (Just pId) sLnk
         pure $ CRConnectionIncognitoUpdated user conn' (Just incognitoProfile)
       (ConnNew, Just pId, False) -> do
-        sLnk <- updatePCCShortLinkData conn =<< presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True)
+        sLnk <- updatePCCShortLinkData conn =<< presentUserBadge user Nothing Nothing (userProfileDirect user Nothing Nothing True)
         conn' <- withFastStore' $ \db -> do
           deletePCCIncognitoProfile db user pId
           updatePCCIncognito db user conn Nothing sLnk
@@ -2162,7 +2162,7 @@ processChatCommand cxt nm = \case
         let short = isJust $ connShortLink' =<< connLinkInv
         userLinkData_ <-
           if short
-            then Just . UserInvLinkData . (`contactShortLinkData` Nothing) <$> presentUserBadge newUser Nothing (userProfileDirect newUser Nothing Nothing True)
+            then Just . UserInvLinkData . (`contactShortLinkData` Nothing) <$> presentUserBadge newUser Nothing Nothing (userProfileDirect newUser Nothing Nothing True)
             else pure Nothing
         (agConnId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId newUser) True False SCMInvitation userLinkData_ Nothing IKPQOn True subMode
         ccLink' <- shortenCreatedLink ccLink
@@ -2467,7 +2467,7 @@ processChatCommand cxt nm = \case
     userData <-
       if isTrue userChatRelay
         then pure $ relayShortLinkData (userProfileDirect user Nothing Nothing True)
-        else (`contactShortLinkData` Nothing) <$> presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True)
+        else (`contactShortLinkData` Nothing) <$> presentUserBadge user Nothing Nothing (userProfileDirect user Nothing Nothing True)
     let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
     connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode
     let ccLink'' = if isTrue userChatRelay then setShortLinkType CCTRelay ccLink' else ccLink'
@@ -3405,7 +3405,7 @@ processChatCommand cxt nm = \case
             joinPreparedConn subMode conn
           joinPreparedConn subMode conn = do
             -- [incognito] send membership incognito profile
-            p <- presentUserBadge user (incognitoMembershipProfile gInfo) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile gInfo) Nothing True
+            p <- presentUserBadge user (incognitoMembershipProfile gInfo) Nothing $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile gInfo) Nothing True
             dm <- encodeConnInfo $ XInfo p Nothing
             sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm PQSupportOff subMode
             let newStatus = if sqSecured then ConnSndReady else ConnJoined
@@ -3823,7 +3823,7 @@ processChatCommand cxt nm = \case
                 conn <- withFastStore' $ \db -> createDirectConnection' db userId connId ccLink contactId_ ConnPrepared incognitoProfile subMode chatV pqSup'
                 joinPreparedConn conn incognitoProfile
               joinPreparedConn conn incognitoProfile = do
-                profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user incognitoProfile Nothing True
+                profileToSend <- presentUserBadge user incognitoProfile Nothing $ userProfileDirect user incognitoProfile Nothing True
                 dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend Nothing
                 sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup' subMode
                 let newStatus = if sqSecured then ConnSndReady else ConnJoined
@@ -3932,7 +3932,7 @@ processChatCommand cxt nm = \case
         relayLinkData_ <- liftIO $ decodeLinkUserData cData
         relayMemberId <- case (relayLinkData_, linkEntityId) of
           (Just RelayShortLinkData {relayProfile = p}, Just entityId) -> do
-            withFastStore $ \db -> updateRelayMemberData db cxt user relayMember (MemberId entityId) (MemberKey relayKey) p
+            withFastStore $ \db -> updateRelayMemberData db cxt user relayMember (MemberId entityId) (MemberKey relayKey) Nothing p
             pure $ MemberId entityId
           _ -> throwChatError $ CEException "relay link: no relay link data or entity id"
         let relayLinkToConnect = CCLink cReq (Just relayLink)
@@ -3972,10 +3972,13 @@ processChatCommand cxt nm = \case
     joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Maybe (Maybe GroupInfoKeys) -> Maybe MemberId -> PQSupport -> CM Connection
     joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup = do
       -- gInfo_ is Maybe (Maybe GroupInfo), where Just Nothing means "some unknown group", e.g. when joining via link without profile
-      profileToSend <-
-        presentUserBadge user incognitoProfile $ case gInfo_ of
-          Just gInfo_' -> userProfileInGroup' user ((\(GIK g _) -> g) <$> gInfo_') incognitoProfile
-          Nothing -> userProfileDirect user incognitoProfile Nothing True
+      profileToSend <- case gInfo_ of
+        Just gInfo_' -> do
+          let p = userProfileInGroup' user ((\(GIK g _) -> g) <$> gInfo_') incognitoProfile
+          case gInfo_' of
+            Just (GIK g _) | useRelays' g -> presentUserBadge user incognitoProfile (Just g) p
+            _ -> pure p
+        Nothing -> presentUserBadge user incognitoProfile Nothing $ userProfileDirect user incognitoProfile Nothing True
       dm <- case gInfo_ of
         Just (Just gInfo@(GIK g gks))
           | useRelays' g -> case relayMemberId_ of
@@ -4059,7 +4062,7 @@ processChatCommand cxt nm = \case
             -- non-incognito (filtered above), so the user's badge is presented; a profile update keeps the badge instead of clearing it
             ctSndEvent :: ChangedProfileContact -> CM (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent 'Json)
             ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = do
-              p'' <- presentUserBadge user' Nothing mergedProfile'
+              p'' <- presentUserBadge user' Nothing Nothing mergedProfile'
               pure (ConnectionId connId, Nothing, XInfo p'' Nothing)
             ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq
             ctMsgReq ChangedProfileContact {conn} =
@@ -4068,7 +4071,7 @@ processChatCommand cxt nm = \case
     setMyAddressData :: Bool -> Maybe InitialKeys -> User -> UserContactLink -> CM UserContactLink
     setMyAddressData rotateKeys pqInitKeys user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _, addressSettings} = do
       conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
-      shortLinkProfile <- presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True)
+      shortLinkProfile <- presentUserBadge user Nothing Nothing (userProfileDirect user Nothing Nothing True)
       -- TODO [short links] do not save address to server if data did not change, spinners, error handling
       let userData
             | isTrue userChatRelay = relayShortLinkData shortLinkProfile
@@ -4092,7 +4095,7 @@ processChatCommand cxt nm = \case
               mergedProfile' = userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') False
           when (mergedProfile' /= mergedProfile) $
             withContactLock "updateContactPrefs" (contactId' ct) $ do
-              p <- presentUserBadge user incognitoProfile mergedProfile'
+              p <- presentUserBadge user incognitoProfile Nothing mergedProfile'
               void (sendDirectContactMessage user ct' $ XInfo p Nothing) `catchAllErrors` eToView
               lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct'
           pure $ CRContactPrefsUpdated user ct ct'
@@ -4312,7 +4315,7 @@ processChatCommand cxt nm = \case
                 pure (relayMember, conn, groupRelay)
               let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
                   GroupMember {memberId = relayMemberId} = relayMember
-              membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
+              membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) (Just gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
               let relayInv = GroupRelayInvitation {
                     fromMember = MemberIdRole userMemberId userRole,
                     fromMemberProfile = membershipProfile,
@@ -5208,7 +5211,7 @@ presentUserBadgeToContacts user'@User {userId, profile = LocalProfile {localBadg
       Right conn
         | not (connIncognito conn) -> do
             let ct' = updateMergedPreferences user' ct
-            p <- presentUserBadge user' Nothing $ userProfileDirect user' Nothing (Just ct') False
+            p <- presentUserBadge user' Nothing Nothing $ userProfileDirect user' Nothing (Just ct') False
             void (sendDirectContactMessage user' ct' (XInfo p Nothing)) `catchAllErrors` eToView
       _ -> pure ()
 

src/Simplex/Chat/Library/Internal.hs

@@ -53,7 +53,7 @@ import Data.Text.Encoding (encodeUtf8)
 import Data.Time (addUTCTime)
 import Data.Time.Calendar (fromGregorian)
 import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds, secondsToDiffTime)
-import Simplex.Chat.Badges (BadgeCredential (..), BadgeInfo (..), ProofPresHeader (..), BadgeProof (..), BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), LocalBadge (..), badgeProof, badgeSndGraceInterval, generateBadgeProof, localBadgeStatus, maxXFTPFileSize, mkBadgeStatus, verifyBadge)
+import Simplex.Chat.Badges (BadgeCredential (..), BadgeInfo (..), ProofPresHeader (..), BadgeProof (..), BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), LocalBadge (..), badgeSndGraceInterval, generateBadgeProof, localBadgeStatus, maxXFTPFileSize, mkBadgeStatus, unboundProof, verifyBadge, verifyBadge_)
 import Simplex.Chat.Names (SimplexDomainClaim (..), claimDomain)
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
@@ -995,7 +995,7 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId
         Just conn@Connection {customUserProfileId} -> do
           incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
           pure (ct, conn, ExistingIncognito <$> incognitoProfile)
-  profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
+  profileToSend <- presentUserBadge user incognitoProfile Nothing $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
   dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend Nothing
   (ct,conn,) <$> withAgent (\a -> acceptContact a nm (aUserId user) (aConnId conn) True invId dm pqSup' subMode)
 
@@ -1007,7 +1007,7 @@ acceptContactRequestAsync
   UserContactRequest {agentInvitationId = AgentInvId cReqInvId, cReqChatVRange, xContactId, pqSupport = cReqPQSup}
   incognitoProfile = do
     subMode <- chatReadVar subscriptionMode
-    profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
+    profileToSend <- presentUserBadge user incognitoProfile Nothing $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
     cxt <- chatStoreCxt
     let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
     (cmdId, acId) <- prepareAgentAccept user True cReqInvId cReqPQSup
@@ -1041,15 +1041,16 @@ acceptGroupJoinRequestAsync
     -- a roster-established privileged member attaches a connection to its existing record (keeping
     -- owner-authoritative role + key); everyone else is created fresh with the group-link role
     cxt <- chatStoreCxt
+    let binding_ = (\mId -> memberChatBinding gInfo mId Nothing) =<< cReqMemberId_
     (groupMemberId, memberId) <- case existingMem_ of
       Just m -> do
         -- refresh the hash placeholder name from the authenticated join profile; role + key stay roster-authoritative
         withStore $ \db -> do
           liftIO $ updateGroupMemberStatus db userId m initialStatus
-          void $ updateMemberProfile db cxt user m cReqProfile
+          void $ updateMemberProfile db cxt user m binding_ cReqProfile
         pure (groupMemberId' m, memberId' m)
       Nothing -> withStore $ \db ->
-        createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_
+        createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile binding_ cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_
     let currentMemCount = fromIntegral $ currentMembers $ groupSummary gInfo
     let Profile {displayName} = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile)
         GroupMember {memberRole = userRole, memberId = userMemberId} = membership
@@ -1087,7 +1088,7 @@ acceptGroupJoinSendRejectAsync
     gVar <- asks random
     cxt <- chatStoreCxt
     (groupMemberId, memberId) <- withStore $ \db ->
-      createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ Nothing Nothing GRObserver GSMemRejected Nothing
+      createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile Nothing cReqXContactId_ Nothing Nothing GRObserver GSMemRejected Nothing
     let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
         msg =
           XGrpLinkReject $
@@ -2234,17 +2235,14 @@ sendDirectContactMessages user ct events = do
 -- present the user's own badge on an outgoing profile: a fresh, single-use proof from the stored credential.
 -- the send's incognito profile (when set) suppresses it - an incognito identity must never carry the badge.
 -- a long-expired badge is not presented at all (receivers would hide it anyway).
-presentUserBadge :: User -> Maybe i -> Profile -> CM Profile
-presentUserBadge User {profile = LocalProfile {localBadge}} incognitoProfile p = case (incognitoProfile, localBadge) of
-  (Nothing, Just (OwnBadge cred@(BadgeCredential keyIdx _ _ _) st)) | st == BSActive || st == BSExpired -> do
-    keys <- asks $ badgePublicKeys . config
-    case M.lookup keyIdx keys of
-      Nothing -> p <$ logError "presentUserBadge: badge key index not in config"
-      Just key -> do
-        nonce <- drgRandomBytes 16
-        liftIO (badgeProof key cred (PHTest nonce)) >>= \case
-          Right proof -> pure p {badge = Just proof}
-          Left e -> p <$ logError ("presentUserBadge: proof generation failed: " <> T.pack e)
+presentUserBadge :: User -> Maybe i -> Maybe GroupInfo -> Profile -> CM Profile
+presentUserBadge user@User {profile = LocalProfile {localBadge}} incognitoProfile gInfo_ p = case (incognitoProfile, localBadge) of
+  (Nothing, Just (OwnBadge _ st)) | st == BSActive || st == BSExpired -> do
+    ph_ <- case gInfo_ of
+      Nothing -> Just . PHTest <$> drgRandomBytes 16
+      Just gInfo -> pure $ PHChat <$> sndGroupChatBinding gInfo False
+    badge <- join <$> mapM (sndBadgeProof user) ph_
+    pure p {badge}
   _ -> pure p
 
 
@@ -2255,7 +2253,7 @@ linkDataBadge cld@ContactShortLinkData {profile = Profile {badge}} = case badge
   Nothing -> pure cld
   Just b@(BadgeProof _ _ _ info) -> do
     keys <- asks $ badgePublicKeys . config
-    verified <- liftIO $ verifyBadge keys b
+    verified <- liftIO $ verifyBadge_ unboundProof keys badge
     now <- liftIO getCurrentTime
     pure (cld :: ContactShortLinkData) {localBadge = Just $ ShownBadge info (mkBadgeStatus now verified info)}
 
@@ -2315,7 +2313,10 @@ groupMsgSigning sign (GIK gInfo@GroupInfo {membership = GroupMember {memberId}}
   where
     memberPrivKey' = memberPrivKey gks
     tag = toCMEventTag evt
-    shouldSign = requiresSignature tag || (sign && signableContent tag)
+    shouldSign = requiresSignature tag || (sign && signableContent tag) || badgePresented
+    badgePresented = case evt of
+      XGrpMemInfo _ Profile {badge} -> isJust badge
+      _ -> False
     bindingData = groupBindingData gInfo memberId (C.publicKey memberPrivKey')
 
 groupBindingData :: GroupInfo -> MemberId -> C.PublicKeyEd25519 -> ByteString
@@ -2335,12 +2336,15 @@ rcvGroupChatBinding gInfo m_ asGroup badge_ =
   case (publicGroup' gInfo, asGroup, m_) of
     (Just PublicGroupProfile {publicGroupId}, True, _) ->
       Just $ encodeChatBinding CBChannel $ smpEncode publicGroupId
-    (Just PublicGroupProfile {publicGroupId}, False, Just GroupMember {memberId}) ->
-      Just $ encodeChatBinding CBGroup $ smpEncode (publicGroupId, memberId)
-    (Nothing, False, Just GroupMember {memberId, memberPubKey}) ->
-      (\k -> encodeChatBinding CBGroup $ smpEncode (memberId, k)) <$> (memberPubKey <|> proofMemberKey memberId badge_)
+    (_, False, Just GroupMember {memberId, memberPubKey}) ->
+      memberChatBinding gInfo memberId (memberPubKey <|> proofMemberKey memberId badge_)
     _ -> Nothing
 
+memberChatBinding :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ByteString
+memberChatBinding gInfo memberId key_ = case publicGroup' gInfo of
+  Just PublicGroupProfile {publicGroupId} -> Just $ encodeChatBinding CBGroup $ smpEncode (publicGroupId, memberId)
+  Nothing -> (\k -> encodeChatBinding CBGroup $ smpEncode (memberId, k)) <$> key_
+
 proofMemberKey :: MemberId -> Maybe BadgeProof -> Maybe C.PublicKeyEd25519
 proofMemberKey memberId badge_ = do
   BadgeProof _ (BBSPresHeader phBytes) _ _ <- badge_
@@ -2649,7 +2653,7 @@ sendGroupProfileUpdate user g@(GIK gInfo gks) scope asGroup members =
             _ -> False
     sendProfileUpdate = do
       -- shouldSendProfileUpdate excludes incognito membership, so the badge is presented
-      profileUpdate <- presentUserBadge user Nothing $ redactedMemberProfile gInfo (membership gInfo) $ fromLocalProfile p
+      profileUpdate <- presentUserBadge user Nothing (Just gInfo) $ redactedMemberProfile gInfo (membership gInfo) $ fromLocalProfile p
       void $ sendGroupMessage' user g members $ XInfo profileUpdate (Just $ groupMemberKey gks)
       currentTs <- liftIO getCurrentTime
       withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs

src/Simplex/Chat/Library/Subscriber.hs

@@ -502,7 +502,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               (conn'', gInfo_) <- saveConnInfo conn' connInfo
               incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
               profileToSend <-
-                presentUserBadge user incognitoProfile $ case gInfo_ of
+                presentUserBadge user incognitoProfile ((\(GIK gInfo _) -> gInfo) <$> gInfo_) $ case gInfo_ of
                   Just (GIK gInfo _) -> userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
                   Nothing -> userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True
               -- [async agent commands] no continuation needed, but command should be asynchronous for stability
@@ -621,7 +621,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               ct' <- processContactProfileUpdate ct profile False `catchAllErrors` const (pure ct)
               -- [incognito] send incognito profile
               incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId
-              p <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True
+              p <- presentUserBadge user incognitoProfile Nothing $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True
               allowAgentConnectionAsync user conn'' confId Nothing $ XInfo p Nothing
               void $ withStore' $ \db -> resetMemberContactFields db ct'
             XGrpLinkInv glInv -> do
@@ -634,7 +634,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart)
               -- [incognito] send saved profile
               incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId)
-              profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
+              profileToSend <- presentUserBadge user incognitoProfile (Just gInfo) $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
               let gks = GKGroup {memberPrivKey = snd memberKeys}
               allowAgentConnectionAsync user conn'' confId (Just $ GIK gInfo gks) $ XInfo profileToSend (Just $ groupMemberKey gks)
               toView $ CEvtBusinessLinkConnecting user gInfo host ct
@@ -778,7 +778,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               _ -> throwChatError $ CECommandError "unexpected cmdFunction"
             CRContactUri _ _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
       CONF confId _pqSupport _ connInfo -> do
-        ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
+        (signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo
         conn' <- updatePeerChatVRange conn chatVRange
         case memberCategory m of
           GCInviteeMember ->
@@ -823,7 +823,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
                     (gInfo', m') <- withStore $ \db -> updatePreparedUserAndHostMembersInvited db cxt user gInfo m glInv
                     -- [incognito] send saved profile
                     incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId)
-                    profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo' (fromLocalProfile <$> incognitoProfile)
+                    profileToSend <- presentUserBadge user incognitoProfile (Just gInfo') $ userProfileInGroup user gInfo' (fromLocalProfile <$> incognitoProfile)
                     allowAgentConnectionAsync user conn' confId (Just $ GIK gInfo' gks) $ XInfo profileToSend (Just $ groupMemberKey gks)
                     toView $ CEvtGroupLinkConnecting user gInfo' m'
                 | otherwise -> messageError "x.grp.link.inv: publicGroupId mismatch"
@@ -834,23 +834,26 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               _ -> messageError "CONF from host member in prepared group must have x.grp.link.inv or x.grp.link.reject"
           _ ->
             case chatMsgEvent of
-              XGrpMemInfo memId _memProfile
+              XGrpMemInfo memId memProfile
                 | sameMemberId memId m -> do
                     let GroupMember {memberId = membershipMemId} = membership
-                    membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
-                    -- TODO update member profile
+                        p = redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
+                    membershipProfile <-
+                      if maxVersion (peerChatVRange conn') >= relayWebCapVersion
+                        then presentUserBadge user (incognitoMembershipProfile gInfo) (Just gInfo) p
+                        else pure p
                     -- [async agent commands] no continuation needed, but command should be asynchronous for stability
                     allowAgentConnectionAsync user conn' confId (Just g) $ XGrpMemInfo membershipMemId membershipProfile
+                    void $ processMemberProfileUpdate gInfo m (signedMemberBinding gInfo m signedMsg_) memProfile Nothing
                 | otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
               _ -> messageError "CONF from member must have x.grp.mem.info"
       INFO _pqSupport connInfo -> do
         (signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo
         _conn' <- updatePeerChatVRange conn chatVRange
         case chatMsgEvent of
-          XGrpMemInfo memId _memProfile
-            | sameMemberId memId m -> do
-                -- TODO update member profile
-                pure ()
+          XGrpMemInfo memId memProfile
+            | sameMemberId memId m ->
+                void $ processMemberProfileUpdate gInfo m (signedMemberBinding gInfo m signedMsg_) memProfile Nothing
             | otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
           -- sent when connecting via group link
           XInfo _ mKey
@@ -964,7 +967,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
             where
               sendXGrpLinkMem gInfo'' m' = do
                 let incognitoProfile = ExistingIncognito <$> incognitoMembershipProfile gInfo''
-                profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo'' (fromIncognitoProfile <$> incognitoProfile)
+                profileToSend <- presentUserBadge user incognitoProfile (Just gInfo'') $ userProfileInGroup user gInfo'' (fromIncognitoProfile <$> incognitoProfile)
                 sendGroupMemberMessages user (GIK gInfo'' gks) conn [XGrpLinkMem profileToSend (Just $ groupMemberKey gks)]
           _ -> do
             unless (memberPending m) $ withStore' $ \db -> updateGroupMemberStatus db userId m GSMemConnected
@@ -1089,7 +1092,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               XGrpMemNew memInfo msgScope -> fmap ctx <$> xGrpMemNew (GIK gInfo' gks) m'' memInfo msgScope msg brokerTs
               XGrpMemIntro memInfo memRestrictions_ -> Nothing <$ xGrpMemIntro gInfo' m'' memInfo memRestrictions_
               XGrpMemInv memId introInv -> Nothing <$ xGrpMemInv gInfo' m'' memId introInv
-              XGrpMemFwd memInfo introInv -> Nothing <$ xGrpMemFwd gInfo' m'' memInfo introInv
+              XGrpMemFwd memInfo introInv -> Nothing <$ xGrpMemFwd (GIK gInfo' gks) m'' memInfo introInv
               XGrpMemRole memId memRole memberKey rosterVer -> fmap ctx <$> xGrpMemRole (GIK gInfo' gks) Nothing m'' memId memRole memberKey rosterVer msg brokerTs
               XGrpMemRestrict memId memRestrictions -> fmap ctx <$> xGrpMemRestrict gInfo' m'' memId memRestrictions msg brokerTs
               XGrpMemCon memId -> Nothing <$ xGrpMemCon gInfo' m'' memId
@@ -1231,7 +1234,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               relayLinkData_ <- liftIO $ decodeLinkUserData cData
               relayMemberId <- case (relayLinkData_, linkEntityId) of
                 (Just RelayShortLinkData {relayProfile = p}, Just entityId) -> do
-                  withStore $ \db -> updateRelayMemberData db cxt user m (MemberId entityId) (MemberKey relayKey) p
+                  withStore $ \db -> updateRelayMemberData db cxt user m (MemberId entityId) (MemberKey relayKey) Nothing p
                   pure $ MemberId entityId
                 _ -> throwChatError $ CEException "relay link: no relay link data or entity id"
               case cReq of
@@ -1246,7 +1249,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
                       -- Update connection with data derived from cReq, now available after getConnShortLinkAsync
                       withStore' $ \db -> updateConnLinkData db user conn cReq cReqHash groupLinkId chatV pqSup
                       let incognitoProfile = fromLocalProfile <$> incognitoMembershipProfile gInfo
-                      profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo incognitoProfile
+                      profileToSend <- presentUserBadge user incognitoProfile (Just gInfo) $ userProfileInGroup user gInfo incognitoProfile
                       dm <- encodeXMemberConnInfo g relayMemberId profileToSend
                       subMode <- chatReadVar subscriptionMode
                       (cmdId, connId') <- prepareAgentJoin user (Just conn) True cReq
@@ -1261,7 +1264,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
                   (confId, m', relay)  <- withStore $ \db -> do
                     confId <- getRelayConfId db m
                     liftIO $ updateGroupMemberStatus db userId m GSMemAccepted
-                    (m', relay) <- setRelayLinkAccepted db cxt user m (MemberKey relayKey) relayProfile
+                    (m', relay) <- setRelayLinkAccepted db cxt user m (MemberKey relayKey) Nothing relayProfile
                     pure (confId, m', relay)
                   allowAgentConnectionAsync user conn confId (Just g) XOk
                   toView $ CEvtGroupRelayUpdated user gInfo m' relay
@@ -2796,33 +2799,44 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
             Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p'
 
     xInfoMember :: GroupInfo -> GroupMember -> Profile -> Maybe MemberKey -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
-    xInfoMember gInfo m p' mKey msg@RcvMessage {signedMsg_} brokerTs = do
-      mapM_ (storeMemberKey gInfo m signedMsg_) mKey
-      void $ processMemberProfileUpdate gInfo m p' (Just (msg, brokerTs))
+    xInfoMember gInfo m p' mKey msg brokerTs = do
+      binding_ <- verifiedMemberBinding gInfo m mKey msg
+      void $ processMemberProfileUpdate gInfo m binding_ p' (Just (msg, brokerTs))
       pure $ memberEventDeliveryScope m
 
     xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> Maybe MemberKey -> RcvMessage -> CM ()
-    xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' mKey RcvMessage {signedMsg_} = do
+    xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' mKey msg = do
       xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId
       if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived
         then do
-          mapM_ (storeMemberKey gInfo m signedMsg_) mKey
-          m' <- processMemberProfileUpdate gInfo m p' Nothing
+          binding_ <- verifiedMemberBinding gInfo m mKey msg
+          m' <- processMemberProfileUpdate gInfo m binding_ p' Nothing
           withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True
           let connectedIncognito = memberIncognito membership
           probeMatchingMemberContact m' connectedIncognito
         else messageError "x.grp.link.mem error: invalid group link host profile update"
 
-    storeMemberKey :: GroupInfo -> GroupMember -> Maybe SignedMsg -> MemberKey -> CM ()
+    verifiedMemberBinding :: GroupInfo -> GroupMember -> Maybe MemberKey -> RcvMessage -> CM (Maybe ByteString)
+    verifiedMemberBinding gInfo m@GroupMember {memberId, memberPubKey} mKey RcvMessage {msgSigned, signedMsg_} = do
+      storedKey_ <- maybe (pure Nothing) (storeMemberKey gInfo m signedMsg_) mKey
+      let key_ = if msgSigned == Just MSSVerified then memberPubKey else storedKey_
+      pure $ memberChatBinding gInfo memberId key_
+
+    signedMemberBinding :: GroupInfo -> GroupMember -> Maybe SignedMsg -> Maybe ByteString
+    signedMemberBinding gInfo GroupMember {memberId, memberPubKey} signedMsg_ =
+      memberChatBinding gInfo memberId $ mfilter (\k -> memberSigned gInfo memberId k signedMsg_) memberPubKey
+
+    memberSigned :: GroupInfo -> MemberId -> C.PublicKeyEd25519 -> Maybe SignedMsg -> Bool
+    memberSigned gInfo memberId k = \case
+      Just SignedMsg {chatBinding = CBGroup, signatures, signedBody} -> verifyGroupSig k gInfo memberId signatures signedBody
+      _ -> False
+
+    storeMemberKey :: GroupInfo -> GroupMember -> Maybe SignedMsg -> MemberKey -> CM (Maybe C.PublicKeyEd25519)
     storeMemberKey gInfo GroupMember {groupMemberId, memberPubKey, memberId} signedMsg_ (MemberKey k) = case memberPubKey of
-      Just k0 -> when (k /= k0) $ messageError "member key change rejected, keeping current key"
+      Just k0 -> Nothing <$ when (k /= k0) (messageError "member key change rejected, keeping current key")
       Nothing
-        | signed -> withStore' $ \db -> setMemberPubKey db groupMemberId k
-        | otherwise -> messageError "member key not signed by that key, ignored"
-      where
-        signed = case signedMsg_ of
-          Just SignedMsg {chatBinding = CBGroup, signatures, signedBody} -> verifyGroupSig k gInfo memberId signatures signedBody
-          _ -> False
+        | memberSigned gInfo memberId k signedMsg_ -> Just k <$ withStore' (\db -> setMemberPubKey db groupMemberId k)
+        | otherwise -> Nothing <$ messageError "member key not signed by that key, ignored"
 
     xGrpLinkAcpt :: GroupInfoKeys -> GroupMember -> GroupAcceptance -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM ()
     xGrpLinkAcpt g@(GIK gInfo@GroupInfo {membership} _) m acceptance role memberId msg brokerTs
@@ -2882,14 +2896,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
       unless (groupFeatureAllowed SGFHistory gInfo) $ forM_ description $ \descr ->
         createInternalChatItem user (CDGroupRcv gInfo Nothing m) (CIRcvMsgContent $ MCText descr) Nothing
 
-    processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Maybe (RcvMessage, UTCTime) -> CM GroupMember
-    processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' msgTs_
+    processMemberProfileUpdate :: GroupInfo -> GroupMember -> Maybe ByteString -> Profile -> Maybe (RcvMessage, UTCTime) -> CM GroupMember
+    processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} binding_ p' msgTs_
       -- a failed/unknown-key badge is re-verified even when content is unchanged, so it heals after an app update adds the key
       | contentChanged || badgeNeedsReverify p = do
           when contentChanged $ updateBusinessChatProfile gInfo
           case memberContactId of
             Nothing -> do
-              m' <- withStore $ \db -> updateMemberProfile db cxt user m p''
+              m' <- withStore $ \db -> updateMemberProfile db cxt user m binding_ p''
               unless (muteEventInChannel gInfo m') $ do
                 when contentChanged $ forM_ msgTs_ $ createProfileUpdatedItem m'
                 toView $ CEvtGroupMemberUpdated user gInfo m m'
@@ -2898,7 +2912,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               mCt <- withStore $ \db -> getContact db cxt user mContactId
               if canUpdateProfile mCt
                 then do
-                  (m', ct') <- withStore $ \db -> updateContactMemberProfile db cxt user m mCt p'
+                  (m', ct') <- withStore $ \db -> updateContactMemberProfile db cxt user m mCt binding_ p'
                   unless (muteEventInChannel gInfo m') $ do
                     when contentChanged $ forM_ msgTs_ $ createProfileUpdatedItem m'
                     toView $ CEvtGroupMemberUpdated user gInfo m m'
@@ -3180,6 +3194,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
     xGrpMemNew :: GroupInfoKeys -> GroupMember -> MemberInfo -> Maybe MsgScope -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
     xGrpMemNew (GIK gInfo gks) m memInfo@(MemberInfo memId memRole _ _ assertedKey_) msgScope_ msg brokerTs = do
       unless (useRelays' gInfo) $ checkHostRole m memRole
+      let binding_ = memberChatBinding gInfo memId Nothing
       if sameMemberId memId (membership gInfo)
         then pure Nothing
         else
@@ -3196,7 +3211,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
                   -- TODO [relays] member: surface relay-key-mismatch as a dedicated event / chat item / relay state
                   when (assertedKey /= memberPubKey unknownMember) $
                     messageWarning $ "x.grp.mem.new: relay asserted key differs from roster-established key, keeping roster key, memberId=" <> safeDecodeUtf8 (strEncode memId)
-                  updatedMember <- withStore $ \db -> updateRosterMemberAnnounced db cxt user m unknownMember memInfo initialStatus
+                  updatedMember <- withStore $ \db -> updateRosterMemberAnnounced db cxt user m unknownMember memInfo binding_ initialStatus
                   -- roster members can't be pending, so no members-require-attention update
                   gInfo' <- updatePublicGroupData user gInfo gks
                   toView $ CEvtUnknownMemberAnnounced user gInfo' m unknownMember updatedMember
@@ -3207,7 +3222,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
                   messageError "x.grp.mem.new: privileged role not established by roster" $> Nothing
               | otherwise -> do
                   (updatedMember, gInfo') <- withStore $ \db -> do
-                    updatedMember <- updateUnknownMemberAnnounced db cxt user m unknownMember memInfo initialStatus
+                    updatedMember <- updateUnknownMemberAnnounced db cxt user m unknownMember memInfo binding_ initialStatus
                     gInfo' <-
                       if memberPending updatedMember
                         then liftIO $ increaseGroupMembersRequireAttention db user gInfo
@@ -3225,7 +3240,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               | useRelays' gInfo && isPrivilegedRole memRole -> messageError "x.grp.mem.new: privileged member not established by roster" $> Nothing
               | otherwise -> do
                   (newMember, gInfo') <- withStore $ \db -> do
-                    newMember <- createNewGroupMember db cxt user gInfo m memInfo GCPostMember initialStatus
+                    newMember <- createNewGroupMember db cxt user gInfo m memInfo binding_ GCPostMember initialStatus
                     gInfo' <-
                       if memberPending newMember
                         then liftIO $ increaseGroupMembersRequireAttention db user gInfo
@@ -3261,12 +3276,13 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
 
     xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> CM ()
     xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _ _) memRestrictions = do
+      let binding_ = memberChatBinding gInfo memId Nothing
       case memberCategory m of
         GCHostMember ->
           withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
             Right existingMember
               | useRelays' gInfo -> do
-                  updatedMember <- withStore $ \db -> updatePreparedChannelMember db cxt user existingMember memInfo
+                  updatedMember <- withStore $ \db -> updatePreparedChannelMember db cxt user existingMember memInfo binding_
                   toView $ CEvtGroupMemberUpdated user gInfo existingMember updatedMember
               | otherwise ->
                   messageError "x.grp.mem.intro ignored: member already exists"
@@ -3279,7 +3295,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
                         MemberInfo mId mRole v p _
                           | mRole >= GRMember -> MemberInfo mId defaultRole v p Nothing
                         _ -> memInfo
-                  void $ withStore $ \db -> createIntroReMember db cxt user gInfo memInfo' memRestrictions
+                  void $ withStore $ \db -> createIntroReMember db cxt user gInfo memInfo' binding_ memRestrictions
               | otherwise -> do
                   when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c)
                   case memChatVRange of
@@ -3289,7 +3305,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
                       groupConnIds@(cmdId, connId) <- prepareAgentCreation user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation
                       let chatV = maybe (minVersion (vr cxt)) (\peerVR -> vr cxt `peerConnChatVersion` fromChatVRange peerVR) memChatVRange
                       void $ withStore $ \db -> do
-                        reMember <- createIntroReMember db cxt user gInfo memInfo memRestrictions
+                        reMember <- createIntroReMember db cxt user gInfo memInfo binding_ memRestrictions
                         createIntroReMemberConn db user m reMember chatV memInfo groupConnIds subMode
                       withAgent $ \a -> createConnectionAsync a (aCorrId cmdId) connId (chatHasNtfs chatSettings) SCMInvitation CR.IKPQOff True subMode
         _ -> messageError "x.grp.mem.intro can be only sent by host member"
@@ -3310,8 +3326,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
             Right reMember -> sendGroupMemberMessage gInfo reMember $ XGrpMemFwd (memberInfo gInfo m) introInv
         _ -> messageError "x.grp.mem.inv can be only sent by invitee member"
 
-    xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> CM ()
-    xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memChatVRange _ _) IntroInvitation {groupConnReq, directConnReq} = do
+    xGrpMemFwd :: GroupInfoKeys -> GroupMember -> MemberInfo -> IntroInvitation -> CM ()
+    xGrpMemFwd g@(GIK gInfo@GroupInfo {membership, chatSettings} _) m memInfo@(MemberInfo memId memRole memChatVRange _ _) IntroInvitation {groupConnReq, directConnReq} = do
       let GroupMember {memberId = membershipMemId} = membership
       checkHostRole m memRole
       toMember <- withStore $ \db -> do
@@ -3322,7 +3338,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
             -- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
             -- For now, this branch compensates for the lack of delayed message delivery.
             `catchError` \case
-              SEGroupMemberNotFoundByMemberId _ -> createNewGroupMember db cxt user gInfo m memInfo GCPostMember GSMemAnnounced
+              SEGroupMemberNotFoundByMemberId _ -> createNewGroupMember db cxt user gInfo m memInfo (memberChatBinding gInfo memId Nothing) GCPostMember GSMemAnnounced
               e -> throwError e
         -- TODO [knocking] separate pending statuses from GroupMemberStatus?
         -- TODO            add GSMemIntroInvitedPending, GSMemConnectedPending, etc.?
@@ -3331,16 +3347,21 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
         liftIO $ updateGroupMemberStatus db userId toMember newMemberStatus
         pure toMember
       subMode <- chatReadVar subscriptionMode
+      let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
+          chatV = vr cxt `peerConnChatVersion` mcvr
+          p = redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
       -- [incognito] send membership incognito profile, create direct connection as incognito
-      membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
-      dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile
+      membershipProfile <-
+        if chatV >= relayWebCapVersion
+          then presentUserBadge user (incognitoMembershipProfile gInfo) (Just gInfo) p
+          else pure p
+      let msg = XGrpMemInfo membershipMemId membershipProfile
+      dm <- maybe (encodeConnInfo msg) (`encodeSignedConnInfo` msg) (groupMsgSigning False g msg)
       -- [async agent commands] no continuation needed, but commands should be asynchronous for stability
       let enableNtfsGrp = chatHasNtfs chatSettings
       groupConnIds@(gCmdId, gAcId) <- prepareAgentJoin user Nothing enableNtfsGrp groupConnReq
       directConnIds <- mapM (prepareAgentJoin user Nothing True) directConnReq
       let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
-          mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
-          chatV = vr cxt `peerConnChatVersion` mcvr
       withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds directConnIds customUserProfileId subMode
       joinAgentConnectionAsync gCmdId False gAcId enableNtfsGrp groupConnReq dm subMode
       forM_ ((,) <$> directConnIds <*> directConnReq) $ \((dCmdId, dAcId), dcr) ->
@@ -3909,7 +3930,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
               createItems mCt m'
         joinMemberContactAsync cmdId acId subMode = do
           -- [incognito] send membership incognito profile
-          p <- presentUserBadge user (incognitoMembershipProfile g) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing True
+          p <- presentUserBadge user (incognitoMembershipProfile g) Nothing $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing True
           -- TODO PQ should negotitate contact connection with PQSupportOn? (use encodeConnInfoPQ)
           dm <- encodeConnInfo $ XInfo p Nothing
           joinAgentConnectionAsync cmdId False acId True connReq dm subMode

src/Simplex/Chat/Store/ContactRequest.hs

@@ -24,7 +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.Badges (badgeToRow, unboundProof, verifyBadge_)
 import Simplex.Chat.Protocol (MsgContent, businessChatsVersion)
 import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Groups
@@ -167,7 +167,7 @@ createOrUpdateContactRequest
       createContactRequest :: ExceptT StoreError IO RequestStage
       createContactRequest = do
         currentTs <- liftIO $ getCurrentTime
-        badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge
+        badgeVerified <- liftIO $ verifyBadge_ unboundProof (badgeKeys cxt) badge
         ExceptT $ withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
           liftIO $
             DB.execute
@@ -234,7 +234,7 @@ createOrUpdateContactRequest
         pure $ RSCurrentRequest (Just ucr) ucr' re_
         where
           updateProfile currentTs = do
-            badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge
+            badgeVerified <- liftIO $ verifyBadge_ unboundProof (badgeKeys cxt) badge
             DB.execute
               db
               [sql|

src/Simplex/Chat/Store/Direct.hs

@@ -108,7 +108,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.Badges (badgeToRow, unboundProof)
 import Simplex.Chat.Messages
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Names (SimplexDomainClaim (..))
@@ -565,7 +565,7 @@ deleteUnusedProfile_ db userId profileId =
 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'
+  badgeVerified <- liftIO $ profileBadgeVerified unboundProof (badgeKeys cxt) lp p'
   let nameVerified = if claimChanged then Nothing else prevVerification
       profile = toLocalProfile profileId p'' localAlias currentTs badgeVerified nameVerified
   updateContactProfile' currentTs badgeVerified profile

src/Simplex/Chat/Store/Groups.hs

@@ -230,7 +230,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (NominalDiffTime, UTCTime (..), addUTCTime, getCurrentTime)
 import Data.Text.Encoding (encodeUtf8)
-import Simplex.Chat.Badges (BadgeRow, badgeToRow, verifyBadge_)
+import Simplex.Chat.Badges (BadgeRow, badgeToRow, boundProof, verifyBadge_)
 import Simplex.Chat.Names (SimplexDomainClaim (..))
 import Simplex.Chat.Messages
 import Simplex.Chat.Operators
@@ -677,7 +677,7 @@ createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile b
       randHostId <- liftIO $ encodedRandomBytes gVar 12
       let memberId = MemberId $ encodeUtf8 groupLDN <> "_unknown_host_" <> randHostId
           hostProfile = profileFromName $ nameFromBS randHostId
-      (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user hostProfile currentTs
+      (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user hostProfile Nothing currentTs
       indexInGroup <- getUpdateNextIndexInGroup_ db groupId
       liftIO $ do
         DB.execute
@@ -834,7 +834,7 @@ updatePreparedUserAndHostMembers'
           |]
           (memberId, memberRole, membershipStatus, currentTs, groupMemberId' membership)
       updateHostMember currentTs = do
-        _ <- updateMemberProfile db cxt user hostMember fromMemberProfile
+        _ <- updateMemberProfile db cxt user hostMember Nothing fromMemberProfile
         let MemberIdRole memberId memberRole = fromMember
             gmId = groupMemberId' hostMember
         liftIO $
@@ -885,7 +885,7 @@ createGroupViaLink'
     (,) <$> getGroupInfo db cxt user groupId <*> getGroupMemberById db cxt user hostMemberId
     where
       insertHost_ currentTs groupId = do
-        (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile currentTs
+        (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile Nothing currentTs
         let MemberIdRole {memberId, memberRole} = fromMember
         indexInGroup <- getUpdateNextIndexInGroup_ db groupId
         liftIO $ do
@@ -1713,7 +1713,7 @@ createRelayForOwner :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> Gr
 createRelayForOwner db cxt gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do
   currentTs <- liftIO getCurrentTime
   let relayProfile = profileFromName displayName
-  (localDisplayName, memProfileId, _) <- createNewMemberProfile_ db cxt user relayProfile currentTs
+  (localDisplayName, memProfileId, _) <- createNewMemberProfile_ db cxt user relayProfile Nothing currentTs
   groupMemberId <- createWithRandomId' db gVar $ \memId -> runExceptT $ do
     indexInGroup <- getUpdateNextIndexInGroup_ db groupId
     liftIO $
@@ -1752,7 +1752,7 @@ getCreateRelayForMember db cxt gVar user@User {userId, userContactId} GroupInfo
       randRelayId <- liftIO $ encodedRandomBytes gVar 12
       let memberId = MemberId $ encodeUtf8 groupLDN <> "_unknown_relay_" <> randRelayId
           relayProfile = profileFromName $ nameFromBS randRelayId
-      (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user relayProfile currentTs
+      (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user relayProfile Nothing currentTs
       indexInGroup <- getUpdateNextIndexInGroup_ db groupId
       groupMemberId <- liftIO $ do
         DB.execute
@@ -1805,8 +1805,8 @@ updateRelayStatus_ db relayId relayStatus = do
   currentTs <- getCurrentTime
   DB.execute db "UPDATE group_relays SET relay_status = ?, updated_at = ? WHERE group_relay_id = ?" (relayStatus, currentTs, relayId)
 
-setRelayLinkAccepted :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberKey -> Profile -> ExceptT StoreError IO (GroupMember, GroupRelay)
-setRelayLinkAccepted db cxt user m (MemberKey relayKey) profile = do
+setRelayLinkAccepted :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberKey -> Maybe ByteString -> Profile -> ExceptT StoreError IO (GroupMember, GroupRelay)
+setRelayLinkAccepted db cxt user m (MemberKey relayKey) binding_ profile = do
   let gmId = groupMemberId' m
   currentTs <- liftIO getCurrentTime
   liftIO $ DB.execute
@@ -1825,7 +1825,7 @@ setRelayLinkAccepted db cxt user m (MemberKey relayKey) profile = do
       WHERE group_member_id = ?
     |]
     (relayKey, currentTs, gmId)
-  void $ updateMemberProfile db cxt user m profile
+  void $ updateMemberProfile db cxt user m binding_ profile
   (,) <$> getGroupMemberById db cxt user gmId <*> getGroupRelayByGMId db gmId
 
 setRelayLinkConfId :: DB.Connection -> GroupMember -> ConfirmationId -> ShortLinkContact -> IO ()
@@ -1872,8 +1872,8 @@ getRelayConfId db m =
       |]
       (Only (groupMemberId' m))
 
-updateRelayMemberData :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberId -> MemberKey -> Profile -> ExceptT StoreError IO ()
-updateRelayMemberData db cxt user m memberId (MemberKey relayKey) profile = do
+updateRelayMemberData :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberId -> MemberKey -> Maybe ByteString -> Profile -> ExceptT StoreError IO ()
+updateRelayMemberData db cxt user m memberId (MemberKey relayKey) binding_ profile = do
   currentTs <- liftIO getCurrentTime
   liftIO $
     DB.execute
@@ -1884,7 +1884,7 @@ updateRelayMemberData db cxt user m memberId (MemberKey relayKey) profile = do
         WHERE group_member_id = ?
       |]
       (memberId, relayKey, currentTs, groupMemberId' m)
-  void $ updateMemberProfile db cxt user m profile
+  void $ updateMemberProfile db cxt user m binding_ profile
 
 setGroupInProgressDone :: DB.Connection -> GroupInfo -> IO ()
 setGroupInProgressDone db GroupInfo {groupId} = do
@@ -1937,7 +1937,7 @@ createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMemb
     insertOwner_ currentTs groupId = do
       let MemberIdRole {memberId, memberRole} = fromMember
           VersionRange minV maxV = reqChatVRange
-      (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile currentTs
+      (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile Nothing currentTs
       indexInGroup <- getUpdateNextIndexInGroup_ db groupId
       liftIO $ do
         DB.execute
@@ -2066,7 +2066,7 @@ getRelayInactiveGroups db cxt User {userId, userContactId} ttl = do
       )
       (userId, userContactId, RSInactive, cutoffTs)
 
-createJoiningMember :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId)
+createJoiningMember :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe ByteString -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId)
 createJoiningMember
   db
   cxt
@@ -2075,6 +2075,7 @@ createJoiningMember
   GroupInfo {groupId, membership}
   cReqChatVRange
   Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences}
+  binding_
   cReqXContactId_
   cReqMemberId_
   welcomeMsgId_
@@ -2082,7 +2083,7 @@ createJoiningMember
   memberStatus
   memberKey_ = do
     currentTs <- liftIO getCurrentTime
-    badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge
+    badgeVerified <- liftIO $ verifyBadge_ (boundProof binding_) (badgeKeys cxt) badge
     ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
       liftIO $
         DB.execute
@@ -2416,10 +2417,10 @@ increaseGroupMembersRequireAttention db User {userId} g@GroupInfo {groupId, memb
   pure g {membersRequireAttention = membersRequireAttention + 1}
 
 -- | add new member with profile
-createNewGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
-createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profile} memCategory memStatus = do
+createNewGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> MemberInfo -> Maybe ByteString -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
+createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profile} binding_ memCategory memStatus = do
   currentTs <- liftIO getCurrentTime
-  (localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user profile currentTs
+  (localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user profile binding_ currentTs
   let newMember =
         NewGroupMember
           { memInfo,
@@ -2434,10 +2435,10 @@ createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profil
           }
   createNewMember_ db user gInfo newMember badgeVerified currentTs
 
-createNewMemberProfile_ :: DB.Connection -> StoreCxt -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId, Maybe Bool)
-createNewMemberProfile_ db cxt User {userId} Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences} createdAt =
+createNewMemberProfile_ :: DB.Connection -> StoreCxt -> User -> Profile -> Maybe ByteString -> UTCTime -> ExceptT StoreError IO (Text, ProfileId, Maybe Bool)
+createNewMemberProfile_ db cxt User {userId} Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences} binding_ createdAt =
   ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
-    badgeVerified <- verifyBadge_ (badgeKeys cxt) badge
+    badgeVerified <- verifyBadge_ (boundProof binding_) (badgeKeys cxt) badge
     DB.execute
       db
       "INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
@@ -2614,16 +2615,17 @@ getMemberRelationsVector db GroupMember {groupMemberId} =
       "SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
       (Only groupMemberId)
 
-createIntroReMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberInfo -> Maybe MemberRestrictions -> ExceptT StoreError IO GroupMember
+createIntroReMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberInfo -> Maybe ByteString -> Maybe MemberRestrictions -> ExceptT StoreError IO GroupMember
 createIntroReMember
   db
   cxt
   user
   gInfo
   memInfo@(MemberInfo _ _ _ memberProfile _)
+  binding_
   memRestrictions_ = do
     currentTs <- liftIO getCurrentTime
-    (localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user memberProfile currentTs
+    (localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user memberProfile binding_ currentTs
     let memRestriction = restriction <$> memRestrictions_
         newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
     createNewMember_ db user gInfo newMember badgeVerified currentTs
@@ -3408,10 +3410,10 @@ setMemberContactStartedConnection db Contact {contactId} = do
     "UPDATE contacts SET grp_direct_inv_started_connection = ?, updated_at = ? WHERE contact_id = ?"
     (BI True, currentTs, contactId)
 
-updateMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
-updateMemberProfile db cxt user@User {userId} m p' = do
+updateMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Maybe ByteString -> Profile -> ExceptT StoreError IO GroupMember
+updateMemberProfile db cxt user@User {userId} m binding_ p' = do
   currentTs <- liftIO getCurrentTime
-  badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p'
+  badgeVerified <- liftIO $ profileBadgeVerified (boundProof binding_) (badgeKeys cxt) (memberProfile m) p'
   let memberProfile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing
   updateMemberProfile' currentTs badgeVerified memberProfile
   where
@@ -3431,10 +3433,10 @@ updateMemberProfile db cxt user@User {userId} m p' = do
             safeDeleteLDN db user localDisplayName
             pure $ Right m {localDisplayName = ldn, memberProfile}
 
-updateContactMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
-updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} p' = do
+updateContactMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Contact -> Maybe ByteString -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
+updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} binding_ p' = do
   currentTs <- liftIO getCurrentTime
-  badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p'
+  badgeVerified <- liftIO $ profileBadgeVerified (boundProof binding_) (badgeKeys cxt) (memberProfile m) p'
   let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing
   updateContactMemberProfile' currentTs badgeVerified profile
   where
@@ -3467,7 +3469,7 @@ createNewUnknownGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo ->
 createNewUnknownGroupMember db cxt user@User {userId, userContactId} GroupInfo {groupId} memberId memberName unknownMemberRole = do
   currentTs <- liftIO getCurrentTime
   let memberProfile = profileFromName memberName
-  (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile currentTs
+  (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile Nothing currentTs
   indexInGroup <- getUpdateNextIndexInGroup_ db groupId
   liftIO $
     DB.execute
@@ -3492,7 +3494,7 @@ createLinkOwnerMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe
 createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupId} contactId_ memberId ownerKey = do
   currentTs <- liftIO getCurrentTime
   let memberProfile = profileFromName $ nameFromMemberId memberId
-  (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile currentTs
+  (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile Nothing currentTs
   indexInGroup <- getUpdateNextIndexInGroup_ db groupId
   liftIO $
     DB.execute
@@ -3516,9 +3518,9 @@ createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupI
 -- Intro refreshes only profile / status / peer version. Role and key stay owner-authoritative
 -- (the owner-signed roster for members/moderators/admins, link data for owners), so taking either from
 -- an in-band relayed intro would let a compromised relay substitute them.
-updatePreparedChannelMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
-updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} = do
-  _ <- updateMemberProfile db cxt user member profile
+updatePreparedChannelMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberInfo -> Maybe ByteString -> ExceptT StoreError IO GroupMember
+updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} binding_ = do
+  _ <- updateMemberProfile db cxt user member binding_ profile
   currentTs <- liftIO getCurrentTime
   liftIO $
     DB.execute
@@ -3536,9 +3538,9 @@ updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupM
   where
     VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
 
-updateUnknownMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
-updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} status = do
-  _ <- updateMemberProfile db cxt user unknownMember profile
+updateUnknownMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> Maybe ByteString -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
+updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} binding_ status = do
+  _ <- updateMemberProfile db cxt user unknownMember binding_ profile
   currentTs <- liftIO getCurrentTime
   liftIO $
     DB.execute
@@ -3565,9 +3567,9 @@ updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMem
 
 -- Like updateUnknownMemberAnnounced but preserves member_role and member_pub_key
 -- (roster-established for moderators/admins; the dissemination carries only the profile).
-updateRosterMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
-updateRosterMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} status = do
-  _ <- updateMemberProfile db cxt user unknownMember profile
+updateRosterMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> Maybe ByteString -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
+updateRosterMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} binding_ status = do
+  _ <- updateMemberProfile db cxt user unknownMember binding_ profile
   currentTs <- liftIO getCurrentTime
   liftIO $
     DB.execute

src/Simplex/Chat/Store/Shared.hs

@@ -32,7 +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.Badges (BadgeRow, badgeToRow, rowToBadge, unboundProof, verifyBadge_)
 import Simplex.Chat.Names (SimplexDomainProof, SimplexDomainClaim (..), claimDomain)
 import Simplex.Chat.Messages
 import Simplex.Chat.Remote.Types
@@ -418,7 +418,7 @@ createContact db cxt user profile = do
 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, description, image, contactLink, contactDomain, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
   ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
-    badgeVerified <- verifyBadge_ (badgeKeys cxt) badge
+    badgeVerified <- verifyBadge_ unboundProof (badgeKeys cxt) badge
     DB.execute
       db
       "INSERT INTO contact_profiles (display_name, full_name, short_descr, description, 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, contact_domain, contact_domain_proof) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"

src/Simplex/Chat/Types.hs

@@ -848,10 +848,11 @@ fromLocalProfile LocalProfile {displayName, fullName, shortDescr, description, i
       OwnBadge _ _ -> Nothing -- the own credential is not sent, proof is generated on send
       ShownBadge _ _ -> Nothing -- a display-only badge is not sent
 
-profileBadgeVerified :: Map Int BBSPublicKey -> LocalProfile -> Profile -> IO (Maybe Bool)
-profileBadgeVerified keys LocalProfile {localBadge} Profile {badge = newBadge} =
+profileBadgeVerified :: (BadgeProof -> Bool) -> Map Int BBSPublicKey -> LocalProfile -> Profile -> IO (Maybe Bool)
+profileBadgeVerified accepted keys LocalProfile {localBadge} Profile {badge = newBadge} =
   case (localBadge, newBadge) of
     (_, Nothing) -> pure (Just False)
+    (_, Just newB) | not (accepted newB) -> 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))

tests/BadgeTests.hs

@@ -50,6 +50,7 @@ badgeTests = do
   it "credential serializes to a paste-able token and back" testCredentialSerialization
   it "presentation headers encode and decode" testPresHeaderEncoding
   it "should reject a proof presented under another chat binding" testOtherChatBinding
+  it "should accept a profile proof only with the header of its chat" testProfileProofHeader
   describe "redemption codes" $ do
     it "a generated code reads back" testCodeRoundTrip
     it "reads a code as typed - any case, separators, ambiguous characters" testCodeNormalisation
@@ -210,6 +211,22 @@ testOtherChatBinding = do
   verifyBadge (keysFor pk) (BadgeProof idx (BBSPresHeader $ strEncode ph) p info) >>= (`shouldBe` Just True)
   verifyBadge (keysFor pk) (BadgeProof idx (BBSPresHeader $ strEncode otherPh) p info) >>= (`shouldBe` Just False)
 
+testProfileProofHeader :: IO ()
+testProfileProofHeader = do
+  (pk, unbound) <- issueBadgeProof BTSupporter futureTime
+  (pk', bound) <- issueBadgeProofHeader BTSupporter futureTime (PHChat aliceBinding)
+  unboundProof unbound `shouldBe` True
+  unboundProof bound `shouldBe` False
+  boundProof (Just aliceBinding) bound `shouldBe` True
+  boundProof (Just bobBinding) bound `shouldBe` False
+  boundProof Nothing bound `shouldBe` False
+  boundProof (Just aliceBinding) unbound `shouldBe` False
+  verifyBadge_ unboundProof (keysFor pk) (Just unbound) >>= (`shouldBe` Just True)
+  verifyBadge_ unboundProof (keysFor pk') (Just bound) >>= (`shouldBe` Just False)
+  verifyBadge_ (boundProof (Just aliceBinding)) (keysFor pk') (Just bound) >>= (`shouldBe` Just True)
+  verifyBadge_ (boundProof (Just aliceBinding)) (keysFor pk) (Just unbound) >>= (`shouldBe` Just False)
+  verifyBadge_ (boundProof (Just aliceBinding)) (keysFor pk') Nothing >>= (`shouldBe` Just False)
+
 aliceBinding :: ByteString
 aliceBinding = "Galice-member-id"
 

tests/ChatTests/Profiles.hs

@@ -58,6 +58,8 @@ chatProfileTests = do
     it "present supporter badge to contacts" testUserBadgeBroadcast
     it "supporter badge sent to contact connecting after attach" testUserBadgeOnConnect
     it "supporter badge sent to member joining via group link" testUserBadgeGroupLink
+    it "supporter badge sent to member connecting in group" testUserBadgeGroupHandshake
+    it "supporter badge sent to group members with profile update" testUserBadgeGroupUpdate
     it "expired supporter badge shows as expired" testUserBadgeExpired
     it "long-expired supporter badge is not presented" testUserBadgeExpiredOld
     it "incognito connection does not carry supporter badge" testUserBadgeIncognito
@@ -376,6 +378,59 @@ testUserBadgeGroupLink ps = do
       bob <## "connection not verified, use /code command to see security code"
       bob <## currentChatVRangeInfo
 
+testUserBadgeGroupHandshake :: HasCallStack => TestParams -> IO ()
+testUserBadgeGroupHandshake ps = do
+  Right (pk, sk) <- bbsKeyGen
+  testChatCfg3 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile cathProfile (test sk) ps
+  where
+    test sk alice bob cath = do
+      createGroup2 "team" alice bob
+      addTestBadge bob =<< issueTestBadge sk futureDate
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          do
+            cath <## "#team: you joined the group"
+            cath <## "#team: member bob (Bob) is connected",
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+      -- bob sent nothing to the group, so the badge reached cath in the member connection handshake
+      cath ##> "/i #team bob"
+      cath <## "group ID: 1"
+      cath <##. "member ID: "
+      cath <## "supporter badge - active"
+      cath <## "expires 2100-01-01"
+      cath <## "receiving messages via: localhost"
+      cath <## "sending messages via: localhost"
+      cath <## "connection not verified, use /code command to see security code"
+      cath <## currentChatVRangeInfo
+
+testUserBadgeGroupUpdate :: HasCallStack => TestParams -> IO ()
+testUserBadgeGroupUpdate ps = do
+  Right (pk, sk) <- bbsKeyGen
+  testChatCfg3 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile cathProfile (test sk) ps
+  where
+    test sk alice bob cath = do
+      createGroup3 "team" alice bob cath
+      addTestBadge bob =<< issueTestBadge sk futureDate
+      -- the profile with the badge is sent to the group with the next message
+      bob #> "#team hello"
+      alice <# "#team bob> hello"
+      cath <# "#team bob> hello"
+      cath ##> "/i #team bob"
+      cath <## "group ID: 1"
+      cath <##. "member ID: "
+      cath <## "supporter badge - active"
+      cath <## "expires 2100-01-01"
+      cath <## "receiving messages via: localhost"
+      cath <## "sending messages via: localhost"
+      cath <## "connection not verified, use /code command to see security code"
+      cath <## currentChatVRangeInfo
+
 testUserBadgeContactAddress :: HasCallStack => TestParams -> IO ()
 testUserBadgeContactAddress ps = do
   Right (pk, sk) <- bbsKeyGen