diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs index 98226805bc..02a2d2f5be 100644 --- a/apps/simplex-directory-service/src/Directory/Store.hs +++ b/apps/simplex-directory-service/src/Directory/Store.hs @@ -74,7 +74,7 @@ import Simplex.Chat.Names (claimDomain) import Simplex.Chat.Options.DB (FromField (..), ToField (..)) import Simplex.Chat.Store import Simplex.Chat.Store.Groups -import Simplex.Chat.Store.Shared (GroupKeysRow, groupInfoQueryFields, groupInfoQueryFrom, mkGroupKeys, toGroupInfo_) +import Simplex.Chat.Store.Shared (GroupKeysRow, groupInfoQueryFields, groupInfoQueryFrom, mkGroupInfoKeys, toGroupInfo_) import Simplex.Chat.Types import Simplex.Chat.Types.Shared (GroupMemberRole (..)) import Simplex.Messaging.Agent.Protocol (CreatedConnLink (..), SimplexDomain) @@ -316,8 +316,8 @@ getGroupAndRegLink cc user@User {userId, userContactId} gId = (g, gksData, gr, gLink_) <- ExceptT $ firstRow (toGroupInfoKeysRegLink currentTs cxt user) ("group " ++ show gId ++ " not found") $ DB.query db (groupReqQuery <> " AND g.group_id = ?") (userId, userContactId, gId) - gks <- withExceptT groupDBError $ mkGroupKeys db cxt g gksData - pure (GIK g gks, gr, gLink_) + gks <- withExceptT groupDBError $ mkGroupInfoKeys db cxt g gksData + pure (gks, gr, gLink_) where cxt = storeCxt cc diff --git a/bots/src/API/Docs/Types.hs b/bots/src/API/Docs/Types.hs index ac5992770e..3adcaef783 100644 --- a/bots/src/API/Docs/Types.hs +++ b/bots/src/API/Docs/Types.hs @@ -298,7 +298,7 @@ chatTypesDocsData = (sti @GroupLink, STRecord, "", [], "", ""), (sti @GroupLinkOwner, STRecord, "", [], "", ""), (sti @GroupLinkPlan, STUnion, "GLP", [], "", ""), - (sti @GroupMember, STRecord, "", [], "", ""), + (removeField "memberBadgeProof" $ sti @GroupMember, STRecord, "", [], "", ""), (sti @GroupMemberAdmission, STRecord, "", [], "", ""), (sti @GroupMemberCategory, STEnum' (dropPfxSfx "GC" "Member"), "", [], "", ""), (sti @GroupMemberRef, STRecord, "", [], "", ""), diff --git a/cabal.project b/cabal.project index e5f2c65eda..2614f4332d 100644 --- a/cabal.project +++ b/cabal.project @@ -21,7 +21,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: e24d537eaaa32230eec1fefcd957d474d7b8d4d5 + tag: ee66dd68d4429e769da7f2506a48af5887e0f7af source-repository-package type: git diff --git a/docs/protocol/channels-protocol.md b/docs/protocol/channels-protocol.md index 6a232ea2ff..fe34bf3576 100644 --- a/docs/protocol/channels-protocol.md +++ b/docs/protocol/channels-protocol.md @@ -44,11 +44,11 @@ Creating a channel involves generating cryptographic material, creating the chan When a relay receives an invitation to serve a channel, it validates the channel and creates its own relay link. This flow is currently part of channel creation; adding relays to an existing channel is planned but not yet implemented. -1. Owner sends `x.grp.relay.inv` to the relay's contact address. This message includes the relay's member ID and role, the owner's profile, and the channel's short link. +1. Owner sends `x.grp.relay.inv` to the relay's contact address. This message includes the relay's member ID and role, the owner's profile, the channel's short link, the channel's public group ID, and the owner's member key. The message is signed with the owner's member key over the public group ID and the owner's member ID. -2. Relay receives the invitation and creates a relay request record. A relay request worker processes it asynchronously. +2. Relay receives the invitation and creates a relay request record. From chat protocol version 22 of the owner, an invitation without a valid signature is ignored. The owner's badge is verified under the public group ID, the owner's member ID and the owner's member key from a signed invitation. A relay request worker processes it asynchronously. -3. The worker retrieves the channel's link data from the SMP server, extracts and validates the channel profile and owner authorization. +3. The worker retrieves the channel's link data from the SMP server, extracts and validates the channel profile and owner authorization. The request fails when the link's entity ID differs from the public group ID in the invitation, or when the owner's key in the link data differs from the owner's member key in the invitation. 4. The relay creates its own contact address link (the relay link) with the channel's entity ID in the immutable fixed data. diff --git a/docs/protocol/simplex-chat.md b/docs/protocol/simplex-chat.md index 066b465d0d..aa1c889528 100644 --- a/docs/protocol/simplex-chat.md +++ b/docs/protocol/simplex-chat.md @@ -232,7 +232,7 @@ Currently members can have one of four roles - `owner`, `admin`, `member` and `o `x.grp.inv` message is sent to invite contact to the group via contact's direct connection and includes group member connection address. This message MUST only be sent by members with `admin` or `owner` role. Optional `groupLinkId` is included when this message is sent to contacts connected via the user's group link. This identifier is a random byte sequence, with no global or even local uniqueness - it is only used for the user's invitations to a given group to provide confirmation to the contact that the group invitation is for the same group the contact was connecting to via the group link, so that the invitation can be automatically accepted by the contact - the contact compares it with the group link id contained in the group link uri's data field. -`x.grp.acpt` message is sent as part of group member connection handshake, only to the inviting user. +`x.grp.acpt` message is sent as part of group member connection handshake, only to the inviting user. It optionally includes the invited member's group profile. The inviting user replies with `x.grp.mem.info` that includes the inviting member's group profile. `x.grp.link.inv` message is sent as part of connection handshake to member joining via group link, and contains group profile and initial information about inviting and joining member. diff --git a/docs/protocol/simplex-chat.schema.json b/docs/protocol/simplex-chat.schema.json index a2400e9947..4e9c3c73a0 100644 --- a/docs/protocol/simplex-chat.schema.json +++ b/docs/protocol/simplex-chat.schema.json @@ -568,6 +568,9 @@ "params": { "properties": { "memberId": {"ref": "base64url"} + }, + "optionalProperties": { + "profile": {"ref": "profile"} } } } diff --git a/plans/2026-09-04-badge-binding-and-file-limits.md b/plans/2026-09-04-badge-binding-and-file-limits.md index 72890d8ac7..2783064a88 100644 --- a/plans/2026-09-04-badge-binding-and-file-limits.md +++ b/plans/2026-09-04-badge-binding-and-file-limits.md @@ -11,14 +11,14 @@ The same badge raises the size limit for files the user sends. Today each app de The changes: -1. Three new presentation headers: one for a profile shown in a chat, one for a file invitation, one for a file description. The random header stays valid where there is no chat yet, and for the profile in direct chats until the direct binding reaches the handshake. -2. In p2p groups a badge is accepted only from a message signed by the member. The member connection handshake is signed in both directions, and the profile sent in it is stored, so the badge appears when two members connect. -3. In channels a badge is accepted from any profile message, because member keys there come from the roster, the member list signed by the channel owner. +1. Five new presentation headers: a profile shown in a chat, a file invitation, a file description, a contact request, and a link. The random header of released clients stays accepted until v7.2. +2. Every profile badge is bound to the chat it is shown in: a direct chat, a contact request, a link, or a group membership (section 14). A proof bound to another chat is ignored. +3. In p2p groups a badge is accepted from a message signed by the member, from a join request under the request header, and from an introduction under the key in the introduction. In channels it is accepted from a message signed by the member and from the relay's introduction under the key stored for the member: the key from the owner-signed roster for roles from member up, the key in the introduction for lower roles. 4. Files above the default limit include a proof in the invitation and a proof in the description, in every chat type. The core library verifies both. The decision is stored on the file and shown by the apps from one field. 5. Forwarding a file above the forwarder's limit is refused with an alert before the forwarding sheet opens, and again, for the chosen destination, before anything is uploaded. 6. A received file keeps its two proofs, so a file re-sent to a new member as part of history keeps them; the sender's own files get fresh proofs from the credential. -Two new columns on `files`, and a new table `file_badge_proofs` holding the invitation proof and the description proof of a file, kept for history. One new function in simplexmq, the hash of the fields shared by all descriptions of one upload. +Two new columns on `files`, and a new table `file_badge_proofs` holding the invitation proof and the description proof of a file, kept for history. A new table `group_member_badge_proofs` holding the proof a member presented in a group, forwarded in introductions. A new column on `connections`, the request header of a prepared connection. The relay invitation includes the channel's public group id and the owner's member key. In simplexmq: the hash of the fields shared by all descriptions of one upload, the verification codes of a connection, links and invitations before link data is signed, and the minimum SMP version raised to 15. ## Terms @@ -46,7 +46,7 @@ Two new columns on `files`, and a new table `file_badge_proofs` holding the invi **Presentation header.** A byte string that is an input to proof generation and to proof verification. A proof verifies only with the header it was generated with. Type `ProofPresHeader` in `Badges.hs`. `PHTest` is a random nonce. -**Chat binding.** The byte string that identifies the sender in one conversation, produced by `encodeChatBinding` (`Protocol.hs:444`). Message signatures and shared contact cards are computed over it. For a direct chat it is `encodeChatBinding CBDirect adHash`, where `adHash` is the hash of the connection's ratchet data, which both sides obtain with `getConnectionRatchetAdHash`. For a p2p group it is `encodeChatBinding CBGroup (smpEncode (memberId, memberKey))`. For a channel it is `encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId))`. `groupBindingData` (`Internal.hs:2261`) computes the inner part for groups. +**Chat binding.** The byte string that identifies the sender in one conversation, produced by `encodeChatBinding` (`Protocol.hs:444`). Message signatures and shared contact cards are computed over it. For a direct chat it is `encodeChatBinding CBDirect codeAD`, where `codeAD` is the hash of the connection's ratchet data, which both sides obtain with `getConnectionVerifyCodes`. For a p2p group it is `encodeChatBinding CBGroup (smpEncode (memberId, memberKey))`. For a channel it is `encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId))`. `groupBindingData` (`Internal.hs:2322`) computes the inner part for groups. **Member key.** The Ed25519 key a member holds for one group. It is created when first needed — at group creation on this branch, or by `createUserMemberKey` before the first signed message — and the public key is sent in introductions and in `XInfo`. @@ -64,10 +64,14 @@ data ProofPresHeader | PHChat ByteString | PHFileInv ByteString String Integer | PHFileDescr ByteString String Integer ByteString (Maybe UTCTime) + | PHRequest ByteString + | PHLink ByteString | PHUnknown Char ByteString ``` - `PHChat` holds the chat binding. +- `PHRequest` holds the request code (section 14.1). +- `PHLink` holds the link key. - `PHFileInv` holds the chat binding and the file size from the invitation. - `PHFileDescr` holds the same two values, then the shared description hash (section 8) and the file expiration. @@ -75,57 +79,63 @@ 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; only BBS verification is run by `verifyBadge`, 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 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 contact request, link data, and the profile in a direct chat: the header of 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 codeAD`. +- 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. +- A profile in a group: for a channel the group's public id, the member id and the member key; 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. +`PHUnknown` fails every check. `PHTest`, presented by released clients, is accepted everywhere; its acceptance is dropped in v7.2. 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 expected header is computed in the chat layer and passed to the store; `groupBindingData` and `profileBadgeVerified` remain in `Internal.hs` and `Types.hs`. One predicate is defined in `Badges.hs`: `acceptedProof`, true for `PHTest` and for a header equal to the expected one (section 14.3). `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` (`:2238`). -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 proof for an outgoing profile is generated with `sndBadgeProof`, as file proofs are. The header, `Maybe ProofPresHeader`, is a parameter; with `Nothing`, no badge is presented. For a send into a group the header is `groupPresHeader`, `memberPresHeader` of the user's own member id and key in that group. The membership key is generated and stored by `mkGroupInfoKeys` when the group is read with its keys, and it is set on the membership of the returned group; for a membership without a public key, no badge is presented. The header of every call site is listed in section 14.3. -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`. - -The profile in a direct chat keeps `PHTest`; moving it to `PHChat` is a later change. +In the handshake sends (section 4) and in `XGrpAcpt` (section 14.3, item 9), the badge is presented at every peer version; the message is signed only when the peer version is at least `relayWebCapVersion`. A peer below `relayWebCapVersion` does not store the proof; the proof is generated for it anyway, and no version check is added for it. ## 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 expected header, `Maybe ProofPresHeader`, is a parameter of the store functions and is checked with `acceptedProof` (section 14.3); `Nothing` is passed where a profile is built from a name alone. A proof rejected by `acceptedProof` is ignored: at creation no badge is stored, at update the stored badge is kept. A proof that fails BBS verification is stored as failed. -Where a badge is accepted in a p2p group: +The header is computed in the chat layer by `memberPresHeader gInfo memberId key_` (`Internal.hs`): for a channel `PHChat (encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId, key)))`; for a p2p group `PHChat (encodeChatBinding CBGroup (smpEncode (memberId, key)))`; `Nothing` without a key. File proofs keep the binding of message signatures (`rcvGroupChatBinding`). The key passed at each site: -- `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 the message signature is verified with it, otherwise no key. A key delivered by the message is first stored by `storeMemberKey` when the signature is verified with it; the member with the stored key is returned by `storeMemberKey`. +- The member connection handshake, section 4: the stored key when the signature is verified with it. +- Introductions — `createNewGroupMember`, `createIntroReMember`, `updateUnknownMemberAnnounced`, `updateRosterMemberAnnounced`, `updatePreparedChannelMember`: in a channel the key stored for the member after the introduction — the roster key for roles from member up, the key in the `MemberInfo` for lower roles; in a p2p group the key in the `MemberInfo`. +- A join via a relay (`createJoiningMember`, `updateMemberProfile`): the key in `XMember` when the message signature is verified with it. +- The channel owner at a relay (`createRelayRequestGroup`, `relayInvPresHeader`): the owner's key claimed in the invitation, when the invitation is signed with it. +- `XGrpAcpt` at the inviting host: the key delivered by the message, stored before the profile; the binding includes it when the message signature is verified with it. +- A join by `XContact` to a p2p group: the request header (section 14.3). +- A relay's profile, from its link data: `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`). +In a channel a badge is accepted from `XMember` and `XInfo` whose signature was verified under the member's key, and from the introduction by a relay under the key stored for the member (section 14.3, item 9). In a p2p group a badge is accepted from a message whose signature was verified under the member's key, from a join request under the request header, and from an introduction under the key in the introduction. ## 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. +The badge is presented in `XGrpMemInfo` at every peer version, by `membershipHandshakeProfile`. `XGrpMemInfo` is signed by `groupMsgSigning` when its profile includes a badge and the peer version is at least `relayWebCapVersion`. A `PHChat` proof is kept only from a verified signature. + +- **Sign the join side.** In `xGrpMemFwd` (`:3336`), `XGrpMemInfo` is encoded with `encodeSignedConnInfo` when a signing is returned by `groupMsgSigning` and the agreed version, `chatV`, is at least `relayWebCapVersion`; `GroupInfoKeys` is passed from the dispatch. +- **The reply side** (`:843`): the message is signed by `allowAgentConnectionAsync` when the maximum of the connection's `peerChatVRange` is at least `relayWebCapVersion`. +- **Parse the signature on CONF.** The member CONF site (`:781`) is parsed with `parseChatMessage'`, as INFO is (`:847`). +- **Verify and store.** At `:837` and `:850` the signed message is passed to `processMemberProfileUpdate`, and the signature is verified by `signedMemberPresHeader` with the stored member key: the key from the introduction, or, at `:850` for the inviting host, the key from `XGrpInv`. The profile is stored with the binding of the verified key, or with no binding. +- `:615` and `:647` are unchanged: the profile there is the same group profile, received over the direct connection to the member, and the member's profile row is used by the contact for the member (`createIntroToMemberContact`). + +For a member whose key was never introduced, a `PHChat` proof is accepted only from a message that delivers the key and is signed with it. ## 5. The file size limit at send @@ -254,11 +264,355 @@ The six proof columns are the fields of `BadgeProof` — the proof, the presenta ## 13. Tests - `BadgeTests.hs`: each header encodes and decodes; a proof generated with one header fails with another; the key check accepts an unknown key, accepts an equal key, rejects a different one. -- `ChatTests/Profiles.hs`, beside the seven badge tests: a badge in a p2p group appears at the other member after the connection handshake and not before; a proof presented under another member's binding is rejected; a badge in a channel appears on presentation. Existing tests that assert a badge at introduction time are updated. +- `ChatTests/Profiles.hs`, beside the seven badge tests: a badge in a p2p group is shown at the other member from the introduction and from the connection handshake; a proof presented under another member's binding is ignored; a badge in a channel is shown on presentation. The tests of section 14.3 follow. - `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. Bindings in every chat + +Every profile badge is bound to the chat it is shown in. The sender presents the proof under the header of that chat; the receiver computes the expected header and accepts the proof under it, and under `PHTest`. Implementation starts in simplexmq, in `/code/simplexmq-4`; the chat then builds against it. Line references in this section are to the branch; in sections 1-13, to master. + +Rules: + +1. A ratchet held by both sides: the ratchet code. +2. A connection request before the ratchet: the request code — the proposing party's X448 keys, its PQ key when present, and the id of the queue the joining party sends to. +3. A link shown to anyone who holds it: the link key. +4. A group: the member identity. + +| Context | Received by | Header | +|---|---|---| +| Direct chat: `XInfo`, `CONF` and `INFO` replies, accept, one-time link join, member contacts | contact | `PHChat (encodeChatBinding CBDirect (sha256 ("SimpleX badge" <> codeAD)))` | +| Request to an address with ratchet keys | address owner | `PHChat (encodeChatBinding CBDirect (sha256 ("SimpleX badge" <> codeAD)))` | +| Request to an address without ratchet keys | address owner, group host | `PHRequest code` — the joining party's keys, the address queue | +| One-time invitation link data | joining party | `PHLink linkKey` | +| Address link data | anyone with the link | `PHLink linkKey` | +| P2p group | members | `PHChat (encodeChatBinding CBGroup (smpEncode (memberId, memberKey)))` | +| Channel | subscribers | `PHChat (encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId, memberKey)))` | + +An address is a contact address, a business address, or a group link. The link key is part of the link: `sha3_256` of the fixed link data — the agent version range, the root key, the connection request with its server and queue id, and the entity id of an address (`encodeSignFixedData`, `ShortLink.hs`). + +### 14.1 Agent: verification codes + +Merged in simplexmq `5294b7d8`, except the ratchet stored by `newConnToAcceptDR`, its use in `startJoinInvitationDR`, and their tests. + +**Second verification code.** `RatchetInitParams` gains `rcVerifyCodePQ` and `Ratchet` gains `rcVCPQ :: Maybe Str`. The code is derived in `pqX3dh` with a separate HKDF over the same inputs, info `SimpleXVerifyCode`, 32 bytes; the ratchet keys and `rcAD` are unchanged. The code is exported keying material over every handshake input, the KEM included — the fourth of the paper's mitigations. A ratchet created before this change is decoded with `rcVCPQ = Nothing`, and its code is set at the next ratchet resync. The chat uses the AD code, `codeAD`, for the security code and for badge bindings; `codePQ` is stored. + +**Columns.** Migration `M20260919_ratchet_verify_codes`, SQLite and Postgres, both schema dumps: + +```sql +ALTER TABLE ratchets ADD COLUMN rc_verify_code_ad BLOB; +ALTER TABLE ratchets ADD COLUMN rc_verify_code_pq BLOB; +``` + +`BYTEA` on Postgres. Both are written by `createRatchet` and `createSndRatchet`, also through their `ON CONFLICT` update, by which a ratchet is recreated at a resync. + +One store function, `getRatchetVerifyCodes :: DB.Connection -> [ConnId] -> IO (Map ConnId ConnVerifyCodes)`, is used for one id or many: + +```sql +SELECT conn_id, rc_verify_code_ad, rc_verify_code_pq, CASE WHEN rc_verify_code_ad IS NULL THEN ratchet_state END +FROM ratchets +``` + +- A row with `rc_verify_code_ad` is used as is. +- A row with the ratchet state is decoded, and its codes are computed and saved. +- A row with x3dh keys only is skipped. +- SQLite: one SELECT per id; the computed codes are saved with one `executeMany` UPDATE. +- Postgres: one SELECT with `In connIds`; the computed codes are saved with one `UPDATE ... FROM (VALUES ...) RETURNING`; codes saved by a concurrent read are kept. + +It is used by `getConnectionVerifyCodes` with one id, with `CONN NOT_FOUND` for a connection without codes, and by `getConnectionsVerifyCodes` with many. The result is `ConnVerifyCodes {codeAD, codePQ}`, defined in `Agent/Protocol.hs`, where `codeAD = sha256 rcAD` and `codePQ` is the PQ code as derived. + +**Prepare step.** The result of `prepareConnectionToJoin` is `(ConnId, ContactRequestBinding)`, the binding for the message the chat composes next: + +```haskell +data ContactRequestBinding = CRBRatchet ConnVerifyCodes | CRBRequest ByteString +``` + +- `CRInvitationUri`: the sender ratchet is created (`createRatchet_`, local — the link's keys and a fresh keypair); the binding is `CRBRatchet` of its codes. +- `CRContactUri` with ratchet keys: the same, from the address keys. +- `CRContactUri` without keys: the x3dh keys are generated and stored (`generateRcvE2EParams`, `createRatchetX3dhKeys`); the binding is `CRBRequest (sha256 (smpEncode (k1, k2, kem, senderId)))` — the request's public keys and the queue id from the link's `SMPQueueUri`. + +The same pair is returned by `prepareConnectionToAccept`: for `CRInvitation` the ratchet is created from the invitation's keys, for `CRInvitationDR` the ratchet in the invitation is stored with the connection by `newConnToAcceptDR`. In `startJoinInvitation` the stored ratchet is used, and a ratchet is created only for a connection without one, as in the contact path and its retry branch. In `startJoinInvitationDR` the ratchet in the invitation is written by `createRatchet` after `updateNewConnSnd`, in one transaction: it is written only while the connection has no send queue, and a ratchet used in a send is never replaced. In `createConnReq` the x3dh keys are read before they are generated, as in `mkJoinInvitation`. The stored ratchet is used by async joins and accepts. The prepare step is local. + +**Events.** A `ContactRequestBinding` field in `REQ`: `CRBRequest` in `smpInvitation`, computed from the received `CRInvitationUri` and the queue of the request; `CRBRatchet` in `smpContactRequest`, from the ratchet initialised there. `CONF` and `INFO` are unchanged: the receiver's ratchet is stored before the notification, so its codes are available to `getConnectionVerifyCodes`. + +**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. For an address with ratchet keys, the codes of the requester's prepare step, of `REQ`, of the acceptor's prepare step and of the stored ratchet are equal before `acceptContact`; an accept of a prepared connection without a ratchet is completed by `acceptContact`. + +### 14.2 Agent: links before link data + +Files: `Agent.hs`, `Agent/Client.hs`, `Agent/Protocol.hs`, `Crypto/ShortLink.hs`, `Protocol.hs`, `Transport.hs`, `tests/AgentTests/FunctionalAPITests.hs`. + +The chat pins the simplexmq commit in `cabal.project` and `scripts/nix/sha256map.nix`. + +A link prepared by `prepareConnectionLink` is available to the chat before its link data is signed: a contact link with its short link, an invitation as its full link and its link key; one network request is made per creation. + +**New links.** The contact link with its short link, or the invitation with its link key `plpLinkKey`, is returned by `prepareConnectionLink` before the user data is signed; the short link of an invitation, with the link id assigned by the server, is returned by `createConnectionForLink`: + +```haskell +prepareConnectionLink :: AgentClient -> UserId -> SConnectionMode c -> C.KeyPairEd25519 -> Maybe ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AE (CreatedConnLink c, PreparedLinkParams c) + +createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink c -> PreparedLinkParams c -> UserConnLinkData c -> SubscriptionMode -> AE (ConnId, CreatedConnLink c) +``` + +- The link entity id is optional; `Nothing` for an invitation. +- `PreparedLinkParams` is indexed by the connection mode. The ratchet keys are one field, `plpRatchetKeys :: PreparedRatchetKeys m`, in place of `plpAddressKeys`: + + ```haskell + data PreparedRatchetKeys (m :: ConnectionMode) where + PRKInvitation :: RcvE2EPrivRatchetParams 'C.X448 -> PreparedRatchetKeys 'CMInvitation + PRKContact :: Maybe (RatchetKeyId, RcvE2EPrivRatchetParams 'C.X448) -> PreparedRatchetKeys 'CMContact + ``` + +- Client notices are checked for contact mode only. +- Contact mode: the link given to `createConnectionForLink` is returned. +- Invitation mode, prepare: + - x3dh keys from `CR.generateRcvE2EParams`, PQ support from `CR.initialPQEncryption True pqInitKeys` + - `connReq = CRInvitationUri crData e2eRcvParams`, queue mode `QMMessaging` + - the returned link is `CCLink connReq Nothing`; the key is `plpLinkKey` + - `useDR` is ignored +- Invitation mode, create: + - link data: `SL.encodeSignUserData SCMInvitation`, encrypted by `encryptInvLinkData` with `SL.invShortLinkKdf plpLinkKey`; `newRcvConnSrv` uses the same function + - queue request: `CQRMessaging (Just CQRData {linkKey, privSigKey, srvReq = (sndId, srvData)})` +- In both modes the link data is encrypted before the connection is created, and the queue is created by the local `createLinkQueue`: + - the ratchet keys are stored: `PRKContact` keys by `storeAddressRatchetKeys`, `PRKInvitation` keys by `createRatchetX3dhKeys` + - `createRcvQueue` + - the connection is deleted when either step fails + - the returned link from `connReqWithShortLink`, moved from `newRcvConnSrv` to top level, with the created `RcvQueue` as a parameter — `CSLInvitation` with the link id from the server, PQ keys removed from the full link for `IKPQOn` +- Tests: + - a connection via an invitation made by prepare and create; its link data is read by the joining party; `plpLinkKey` equals the key in the returned `CSLInvitation` + - a contact link returned by `createConnectionForLink` equals the prepared link + - for link data above the size limit, `CMD LARGE` is returned in both modes and no connection is stored + - the six existing test calls are updated for the mode and the pair + +**Existing connections.** The link of a connection is returned without a network call: + +```haskell +prepareConnShortLink :: AgentClient -> ConnId -> Maybe CRClientData -> AE (ConnShortLink 'CMContact) +``` + +- A stored link is returned as is. +- Otherwise the credentials are created and stored by `newContactLinkCreds :: AgentClient -> RcvQueue -> Maybe CRClientData -> AM (ShortLinkCreds, C.SbKey)`: the signing key pair is generated, the fixed data is built from the connection request without ratchet keys, signed and encrypted (`SL.encryptFixedData`), and `ShortLinkCreds` are stored; the link data key is returned with them. +- In `setConnShortLink`, `newContactLinkCreds` is used for a connection without stored credentials, and the user data is then encrypted with the returned key and uploaded with one `LSET`. For stored credentials, the key is derived once, by the link id check. +- Tests: for an address without a short link, the link is the same from two `prepareConnShortLink` calls and from `setConnShortLink`; a requester connects via it. + +**SMP versions below 15.** The minimum SMP version of clients and servers is 15, and the code for older versions is removed: + +- `NEW` and `IDS` (`Protocol.hs`): the encodings and parsers for versions below 15, with `qReq` and `qm`. +- `mkShortLinkCreds` (`Agent/Client.hs`): link data without a link id in the response is an error; the `THandleParams` parameter is removed. +- `connReqWithShortLink`: absent short link credentials are an `INTERNAL` error. +- `createConnectionForLink'`: the sender id check of master, error `sender ID mismatch`, is removed; the sender id is compared by `mkShortLinkCreds` and by `connReqWithShortLink`. +- `Transport.hs`: `shortLinksSMPVersion` is renamed `_shortLinksSMPVersion` and is not exported; `_proxyServerHandshakeSMPVersion` is removed. +- Tests: `testInvitationShortLinkPrev` and `testProxyMatrixWithPrev` are removed. + +### 14.3 Chat + +In implementation order. A badge is presented only with a header: no badge is presented at a direct send for a connection without codes or for a retry without a stored request header, and at a send into a group for a `Nothing` from `groupPresHeader`. The agent is asked for codes or a link only when a badge is presented, or when a received proof has a header other than `PHTest`. An agent error is returned as a chat error. A failed read of verification codes fails the whole operation — a profile update, a badge broadcast, or a reply to a confirmation; the profile is not sent to the contacts whose codes were read, and no partial delivery is reported. + +**1. Headers** — `Badges.hs` + +- `PHRequest ByteString` in `ProofPresHeader`, tag `'R'`. +- `PHLink ByteString` in `ProofPresHeader`, tag `'L'`; payload: the link key bytes. +- `acceptedProof :: Maybe ProofPresHeader -> BadgeProof -> Bool`: true for `PHTest`, and for a header equal to `strEncode` of the expected one. `proofPresHeaderAccepted` and `verifyBadge_` are removed. +- `acceptedBadge :: Maybe ProofPresHeader -> Maybe BadgeProof -> Maybe BadgeProof -> Maybe BadgeProof`: the received proof when it is accepted or absent, otherwise the stored one. Used by `profileBadgeVerified`, `processContactProfileUpdate`, `processMemberProfileUpdate` and `setMemberBadgeProof`. +- `sameBadgeProof :: Maybe BadgeProof -> Maybe BadgeProof -> Bool`: equal disclosed information and equal headers, where the random header of `PHTest` is not compared. Used by `processMemberProfileUpdate` and `setMemberBadgeProof`. +- `unboundProof :: BadgeProof -> Bool`: true for `PHTest`. +- `ToField` and `FromField` for `ProofPresHeader`: the `strEncode` bytes as a blob. + +**2. Ignored proofs** — `Types.hs`, store modules + +- A proof rejected by `acceptedProof` is ignored. +- At creation no badge is stored: `createContact_`, `createContactRequest` (`ContactRequest.hs:170`), `createJoiningMember`, `createNewMemberProfile_`. +- At update the stored badge is kept: the badge to store and its verification are returned by `profileBadgeVerified` — for a rejected proof, the stored proof, verified again when its stored status is `BSFailed` or `BSUnknownKey`. Used in `updateContactProfile`, `updateMemberProfile`, `updateContactMemberProfile`, and the request update (`ContactRequest.hs:239`). +- `proofPresHeaderAccepted` is removed from `verifyBadgeWith`, and `verifyBadge_` is removed; at the creation sites `profileBadgeVerified` is called with no stored profile. `BSFailed` is stored only for a failed BBS verification. + +**3. Expected header in the store** + +The expected header, `Maybe ProofPresHeader`, is a parameter of: + +- `updateContactProfile` +- `createDirectContact` +- `createPreparedContact` +- `createOrUpdateContactRequest` +- `updateMemberProfile` +- `updateContactMemberProfile` +- `createJoiningMember` +- `createNewGroupMember` +- `createIntroReMember` +- `updateUnknownMemberAnnounced` +- `updateRosterMemberAnnounced` +- `updatePreparedChannelMember` +- `createRelayRequestGroup` + +`Nothing` is passed by `createContact` for the preset contact card, by `setRelayLinkAccepted` and `updateRelayMemberData` for a relay profile, by `updatePreparedUserAndHostMembers'` for a host profile built from a name, and by `acceptGroupJoinSendRejectAsync`. In `processMemberProfileUpdate` the header is computed from the signed message by `signedMemberPresHeader`. Other group headers are computed by `memberPresHeader` or `memberInfoPresHeader`; the request header is passed for a join by `XContact`, and `relayInvPresHeader` for a relay invitation. + +**4. Presenting** — `Internal.hs` + +```haskell +presentUserBadge :: User -> Maybe i -> Maybe ProofPresHeader -> Profile -> CM Profile + +presentUserBadgeWith :: User -> Maybe i -> CM (Maybe ProofPresHeader) -> Profile -> CM Profile +``` + +With `Nothing`, no badge is presented. A badge is presented only when `presentsUserBadge :: User -> Bool` holds, for a profile that is not incognito: the user's own badge is active or expired. `presentUserBadgeWith` runs the header action only in that case; `presentUserBadge` is `presentUserBadgeWith` of a known header. Header helpers: + +- `groupPresHeader :: GroupInfo -> Maybe ProofPresHeader` — `memberPresHeader` of the membership's id and key +- `directPresHeader :: ContactRequestBinding -> ProofPresHeader` — `PHChat (encodeChatBinding CBDirect (sha256 ("SimpleX badge" <> codeAD)))` for `CRBRatchet`, `PHRequest code` for `CRBRequest`. The profile header holds the labelled hash, so a profile proof does not include the input of the security code; file proofs keep `encodeChatBinding CBDirect codeAD`. +- `linkPresHeader :: ConnShortLink c -> ProofPresHeader` — `PHLink` of the link key +- `memberKeyPresHeader :: Maybe B64UrlByteString -> MemberId -> C.PublicKeyEd25519 -> ProofPresHeader` — `PHChat (encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId, key)))` with a channel id, `PHChat (encodeChatBinding CBGroup (smpEncode (memberId, key)))` without one +- `memberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader` — `memberKeyPresHeader` of the channel id in a channel and of no id in a p2p group; `Nothing` without a key +- `memberInfoPresHeader :: GroupInfo -> MemberInfo -> Maybe ProofPresHeader` — `memberPresHeader` of the id and key in the `MemberInfo` +- `relayInvPresHeader :: Maybe SignedMsg -> GroupRelayInvitation -> Maybe ProofPresHeader` — `memberKeyPresHeader` of the channel id, the owner's id and the key in the invitation, for an invitation signed with that key (item 12) +- `connPresHeader :: Connection -> CM (Maybe ProofPresHeader)` — `connsPresHeaders` of one connection +- `connsPresHeaders :: [Connection] -> CM (Map ConnId ProofPresHeader)` — `directPresHeader . CRBRatchet` of `getConnectionsVerifyCodes`; the map includes the connections with codes + +**5. The binding from prepare steps** + +The result of each includes `directPresHeader` of the agent binding: + +- `prepareContact :: User -> ConnReqContact -> PQSupport -> CM (ConnId, VersionChat, ProofPresHeader)` +- `prepareAgentJoin :: User -> Bool -> ConnectionRequestUri c -> CM ((CommandId, ConnId), ProofPresHeader)` +- `prepareAgentAccept :: User -> Bool -> InvitationId -> PQSupport -> CM ((CommandId, ConnId), ProofPresHeader)` + +**6. Stored request header** + +Migration `M20260925_badge_bindings`, SQLite and Postgres, first statement; the rest is in item 11: + +```sql +ALTER TABLE connections ADD COLUMN pres_header BLOB; +``` + +`BYTEA` on Postgres. Both schema dumps and `chat_query_plans.txt` are updated. + +- `createConnReqConnection`: the request header is a parameter, written to `pres_header`. +- `getConnReqContact`: the result is `(ConnReqContact, Maybe ProofPresHeader)`, read from `via_contact_uri` and `pres_header`. + +**7. Direct sends** + +- `joinContact` (`Commands.hs:3982`): the request header, `Maybe ProofPresHeader`, is a parameter, set in `connect'`, `joinPreparedConn'` and `connectContactViaAddress` — the `prepareContact` header for a new connection, the stored header for a retry. The badge is presented with `groupPresHeader` in a relay group, and with the request header otherwise. +- `connectViaInvitation` (`Commands.hs:3808-3845`) and `connectMemberContact` (`:3395-3422`): the prepare binding for a new connection; `connPresHeader` for a prepared one, by `presentUserBadgeWith`. +- `joinMemberContactAsync` (`Subscriber.hs:3952`): the header is a parameter, set in `xGrpDirectInv` to the `prepareAgentJoin` header. +- `acceptContactRequest` (`Internal.hs:984-1014`): the prepare binding for a new connection; `connPresHeader` for an existing one, by `presentUserBadgeWith`. +- `acceptContactRequestAsync` (`Internal.hs:1016-1035`): the profile is built after `prepareAgentAccept`, from its header. +- `CONF` replies (`Subscriber.hs:506` direct case, `:623`) and `updateContactPrefs` (`Commands.hs:4099`): `connPresHeader`, by `presentUserBadgeWith`. +- `sendUpdateToContacts` (`Commands.hs:4043-4082`) and `presentUserBadgeToContacts` (`:5215-5230`): one `connsPresHeaders` call per command, when `presentsUserBadge` holds. + +**8. Direct receipts** + +- `REQ` (`Subscriber.hs:1399`): `directPresHeader` of the `REQ` binding is a parameter of `profileContactRequest`, passed to `createOrUpdateContactRequest` and to `acceptGroupJoinRequestAsync`. +- `processContactProfileUpdate` (`Subscriber.hs:2761`) and `saveConnInfo` (`:3185`, for `createDirectContact`): `connPresHeader` of the connection the profile was received on, read only for a received proof with a header other than `PHTest`. +- In `processContactProfileUpdate` the profile with the stored proof in place of a rejected one is used for the comparison and the chat item, as for members (item 11). + +**9. Groups** + +- `groupPresHeader` at every send into a group: `Commands.hs:4002` (`joinContact`, relay group), `:4331`; `Subscriber.hs:505` group case, `:636`, `:829`, `:971`, `:1253`, and `membershipHandshakeProfile :: User -> GroupInfo -> CM Profile` (`Internal.hs`) for `:791`, `:843`, `:3371` and `addRelays`; `Internal.hs:2546` (`encodeXGrpAcpt`) and `:2730`. +- `acceptGroupJoinRequestAsync` (`Internal.hs:1037`): the expected header is a new parameter, passed to `createJoiningMember` and `updateMemberProfile` — in `memberJoinRequestViaRelay`, `memberPresHeader` of the joining member's id and the key in `XMember` when the message signature is verified with it. The signature is verified once, for the roster key check and for the header. `Nothing` is passed to `createJoiningMember` in `acceptGroupJoinSendRejectAsync`. +- Host `INFO` with `XInfo` (`Subscriber.hs:858-865`): after `storeMemberKey`, the profile is stored by `processMemberProfileUpdate` with `signedMemberPresHeader`, under the member's key. +- The profile is also stored by `processMemberProfileUpdate` when the received proof is accepted and differs from the stored member proof in its header or its disclosed information, and when a profile without a proof is received for a member with a stored proof; proofs are compared by `sameBadgeProof`. +- The member event is sent when the profile content or the badge status of the member changes; a change of the proof alone sends no event. +- Introductions: + - In `memberInfo` (`Internal.hs:1344`) the stored proof (item 11) is included when `acceptedProof` holds under `memberPresHeader` of the member's id and stored key, in channels and in p2p groups. + - In `xGrpMemNew`, `xGrpMemIntro` and `xGrpMemFwd` (`Subscriber.hs:3213, 3296, 3347`) the header is built from the key stored for the member after the introduction: + - a roster member in `xGrpMemNew` and an existing member in `xGrpMemIntro`, in a channel: `memberPresHeader` of the stored key; + - a new member in `xGrpMemIntro` in a channel: `memberInfoPresHeader` of the introduction with the key removed for roles from member up; + - other introductions, in channels and in p2p groups: `memberInfoPresHeader` of the introduction, whose key is stored. +- Invitation via contact: + - `profile :: Maybe Profile` in `XGrpAcpt`, the optional JSON field `profile`. + - The invitee (`Commands.hs:2851`, `Subscriber.hs:2700`, both by `encodeXGrpAcpt`, `Internal.hs:2541-2549`) includes its group profile, with `groupPresHeader`; the message is encoded by `encodeConnInfoSigning`, signed when a signing is returned by `groupMsgSigning` and the maximum of the contact connection's `peerChatVRange` is at least `relayWebCapVersion`. + - `XGrpAcpt` with a badge in its profile is signed by `groupMsgSigning` (`Internal.hs:2360-2363`). + - `encodeConnInfoSigning :: PQSupport -> Maybe MsgSigning -> ChatMsgEvent e -> CM ByteString` — `encodeSignedConnInfo` with a signing, `encodeConnInfoPQ` without one; used by `encodeXGrpAcpt`, `xGrpMemFwd` and `allowAgentConnectionAsync`. + - The host (`Subscriber.hs:785-795`) stores the key, allows the connection, then stores the profile by `processMemberProfileUpdate` with the signed message. For an invitee whose contact is active, the profile row is kept by `contactUpdatableFromMember` and the proof is stored on the membership (item 11). + - The host replies with `XGrpMemInfo` and its group profile in place of `XOk` (`Subscriber.hs:791-793`); the badge is presented at every version, and the reply is signed by `allowAgentConnectionAsync` from `relayWebCapVersion`, as at `:843-845`. + +**10. Link data** + +- Invitation links (`APIAddContact`, `recreateConn`): the chat generates the root key pair and calls `prepareConnectionLink SCMInvitation`; the badge is presented with `PHLink` of `plpLinkKey`; then `createConnectionForLink` is called. +- Invitation updates (`updatePCCShortLinkData`, `APISetConnectionIncognito`): `linkPresHeader` of the stored invitation short link. +- Address (`APICreateMyAddress`): `linkPresHeader` of the key in the prepared `CSLContact`. +- Address updates (`setMyAddressData`): the key of the stored short link. For an address without a short link, the key is taken from `prepareConnShortLink` when a badge is presented, then `setConnShortLink` is called once. +- Receipts: + - `linkDataBadge` (`Internal.hs:2285`): the expected header is a parameter — `linkPresHeader` of the short link, for an invitation (`Commands.hs:4415`) and for an address (`:4469-4470`). For a rejected proof the display badge, `localBadge`, is cleared. + - `createPreparedContact` (`Commands.hs:2206`): `linkPresHeader` of the short link in `accLink`; `Nothing` without a short link. + - `updateContactFromLinkData` (`Internal.hs:1644`): the header of the address link is a parameter. + +**11. Member proofs** — `Badges.hs`, `Types.hs`, `Types/Preferences.hs`, `Store/Shared.hs`, `Store/Groups.hs`, `Store/Connections.hs`, `Internal.hs`, `Subscriber.hs` + +A member's accepted proof is stored on the membership, in `group_member_badge_proofs`, and forwarded in introductions. The badge in the profile row is kept for display: the profile row of a member linked to a contact is the contact's. + +Migration `M20260925_badge_bindings`, after the statement of item 6, SQLite: + +```sql +CREATE TABLE group_member_badge_proofs( + group_member_id INTEGER PRIMARY KEY REFERENCES group_members ON DELETE CASCADE, + badge_proof BLOB NOT NULL, + badge_pres_header BLOB NOT NULL, + badge_key_idx INTEGER NOT NULL, + badge_type TEXT NOT NULL, + badge_expiry TEXT NOT NULL, + badge_extra TEXT NOT NULL, + created_at TEXT NOT NULL, + updated_at TEXT NOT NULL +) STRICT; +``` + +Postgres: `BIGINT`, `BYTEA` and `TIMESTAMPTZ`. Both schema dumps and `chat_query_plans.txt` are updated. + +- One row per member, keyed by the member id, as `rcv_files` is keyed by the file id. +- `MaybeBadgeProofRow` and `maybeRowToBadgeProof` in `Badges.hs`: the six proof columns of a `LEFT JOIN`. +- `PrefsJSON` is generalised: + + ```haskell + newtype NoJSON a = NoJSON {unNoJSON :: Maybe a} + + type PrefsJSON = NoJSON Object + ``` + + The field is omitted by `ToJSON`; `NoJSON Nothing` is returned by `FromJSON`. `NoJSON` is used at the construction sites. +- `GroupMember` gains `memberBadgeProof :: NoJSON BadgeProof`. It is removed from the bot API docs: `removeField "memberBadgeProof" $ sti @GroupMember`. +- Reads: + - The proof columns are selected by `groupMemberQuery` after the connection columns, with `LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id`; the field is set by `toContactMember`. + - They are selected the same way by the member read of `getConnectionEntity` (`Connections.hs:145-194`); the field is set by `toGroupAndMember`. + - `NoJSON Nothing` is set by `toGroupMember`, for the membership, chat item members and quoted members. +- Writes, for a received profile: + - a badge accepted by `acceptedProof` under the expected header, different from the stored proof, and verified by `verifyBadge` is upserted by `createMemberBadgeProof` (`INSERT ... ON CONFLICT (group_member_id) DO UPDATE`); a badge that does not verify keeps the row; + - for a profile without a badge and a member with a stored proof, the row is deleted; + - for a badge not accepted, or equal to the stored proof by `sameBadgeProof`, the row is kept. +- These rules are applied by `setMemberBadgeProof :: DB.Connection -> StoreCxt -> GroupMember -> Maybe ProofPresHeader -> Profile -> IO GroupMember`, and the member with the field set is returned. Used by `updateMemberProfile` and `updateContactMemberProfile`, and by `processMemberProfileUpdate` when `contactUpdatableFromMember` is false. +- The received profile is passed to `updateMemberProfile` after `redactedMemberProfile`, and unredacted to `updateContactMemberProfile` and `setMemberBadgeProof`. The profile with the stored proof in place of a rejected one is used for the comparisons, the business chat profile and the chat item. +- At creation the accepted proof is inserted when its verification succeeded (`verifiedProof`): `createNewMember_` (for `createNewGroupMember` and `createIntroReMember`), `createJoiningMember`, and the owner in `createRelayRequestGroup`. +- `memberBadgeProof`, or the profile's proof when it is absent, is included by `memberInfo`, filtered by `acceptedProof` under `memberPresHeader g memberId memberPubKey`. + +**12. The channel owner at the relay** — `Types.hs`, `Commands.hs`, `Subscriber.hs`, `Internal.hs`, `Store/Groups.hs`, `Store/RelayRequests.hs` + +- `GroupRelayInvitation` gains `publicGroupId :: Maybe B64UrlByteString` and `fromMemberKey :: Maybe MemberKey`, the optional JSON fields `publicGroupId` and `fromMemberKey`. The owner sets them in `addRelays` from `publicGroup' gInfo` and from `groupMemberKey` of the group keys; `addRelays` takes `GroupInfoKeys`. +- The invitation is always signed: `XGrpRelayInv_` is in `requiresSignature`, and the invitation is encoded by `encodeConnInfoSigning` with `groupMsgSigning`. Released relays parse the signed message and ignore the signature. +- `relayInvPresHeader :: Maybe SignedMsg -> GroupRelayInvitation -> Maybe ProofPresHeader` (`Subscriber.hs`) — `PHChat (encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId, memberKey)))` with the owner's member id and key, when the signature is verified with that key under `smpEncode (publicGroupId, memberId)`; `Nothing` without both claims or without the signature. The signature is verified by `verifyMemberSig`, which `verifyGroupSig` uses with `groupBindingData`. +- It is computed in `xGrpRelayInv` and passed to `createRelayRequestGroup` as the expected header, there and through `rejectRelayInvitationAsync`. The owner's profile and membership proof are stored under it. +- Chat version 22, `signedRelayInvVersion`; `currentChatVersion` is 22. From this version of the owner's range, an invitation without both claims and a verified signature is ignored by `xGrpRelayInv` with a message error, and no request is created. An invitation from an owner below this version is accepted unsigned. +- The group id claim is written to `groups.relay_request_public_group_id` with the other relay request fields, and read by `getRelayRequestData` into `RelayRequestData`, which gains `reqPublicGroupId :: Maybe B64UrlByteString`. `group_profiles.public_group_id` holds only ids taken from link data. +- Migration `M20260925_badge_bindings`, SQLite and Postgres: `ALTER TABLE groups ADD COLUMN relay_request_public_group_id BLOB;`, `BYTEA` on Postgres. +- The key claim is written to the owner's `group_members.member_pub_key`. +- The owner member is read by `processRelayRequest` in the transaction that reads the group, and passed to `getLinkDataCreateRelayLink` and `acceptOwnerConnection`. +- The request is failed by `getLinkDataCreateRelayLink`: + - when the group id claim differs from the link's entity id; + - when the key claim differs from the key of the link data owner with the owner's member id. +- Each comparison is skipped for a request without that claim. +- The public group id and the owner keys are written from the link data by `updateRelayGroupKeys`. + +**13. Tests** — `ChatTests/Profiles.hs`, `ChatTests/ChatRelays.hs`, `ChatTests/Groups.hs` + +- Direct: the badge is shown after a request to an address with and without ratchet keys, after accepting, after joining a one-time link, after a retried join, and after a profile update. +- A proof bound to another chat is ignored, and the stored badge is kept. +- P2p group: the joiner's badge is shown at the host at the request and after `INFO`; an introduced member's badge is shown from the introduction; the badge is shown on both sides of an invitation via contact. +- Invitation via contact: the invitee's badge is stored on the membership at the host, and a later member receives it in the introduction. +- Channel: the owner's badge is shown at a subscriber and the subscriber's badge at the owner, forwarded by the relay (`testChannelMemberBadges`). +- Channel: a relay invitation with an owner key pair that differs from the link data is failed by the relay, and the relay stays invited (`testChannelAddRelayOwnerKeyMismatch`). +- Link data: the badge is shown from an invitation link under `PHLink`, an address, and an address that gets its first short link. +- Member proofs: the stored proof is deleted when a profile without a badge is received, for a member joined by a group link and for a member with a contact. +- Peers below `relayWebCapVersion`: `XGrpAcpt` to an inviting host and `XGrpMemInfo` to a joining member include the badge unsigned, the handshakes complete, and neither receiver stores the proof. + +The profile update and app changes are not part of this plan; they were merged in #7663. + +`PHTest` proofs are generated only by released clients. For a connection prepared by a released client and joined after the update, the badge is presented only when its ratchet was stored by an earlier attempt; a retried request to an address prepared by a released client is sent without a badge. + ## Out of scope -- Moving the direct chat profile proof to `PHChat`. - Requiring an expiration in the description proof, once servers grant one. diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index d6c932df39..2e0ecfead3 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."e24d537eaaa32230eec1fefcd957d474d7b8d4d5" = "1ximwqi1jaiq1ml05y0mcsrgvabhp5is1ry2h91w5jjarjb1a5fj"; + "https://github.com/simplex-chat/simplexmq.git"."ee66dd68d4429e769da7f2506a48af5887e0f7af" = "0k58ayni6d36fjcahj8lvwkmg6yabmv60g8va6hh9z2ph09lhj2i"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."2330df3dc8c4b660674d3c02d76bb86f66c2abee" = "11pfj1vqsjdl26nplkr2l6z1xj7cn153qijj5gknmlzq3krn7x1i"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/simplex-chat.cabal b/simplex-chat.cabal index daa16691e6..cb0e3387ed 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -168,6 +168,7 @@ library Simplex.Chat.Store.Postgres.Migrations.M20260915_user_badges Simplex.Chat.Store.Postgres.Migrations.M20260918_badge_issue_errors Simplex.Chat.Store.Postgres.Migrations.M20260923_preferences_json + Simplex.Chat.Store.Postgres.Migrations.M20260925_badge_bindings else exposed-modules: Simplex.Chat.Archive @@ -345,6 +346,7 @@ library Simplex.Chat.Store.SQLite.Migrations.M20260915_user_badges Simplex.Chat.Store.SQLite.Migrations.M20260918_badge_issue_errors Simplex.Chat.Store.SQLite.Migrations.M20260923_preferences_json + Simplex.Chat.Store.SQLite.Migrations.M20260925_badge_bindings other-modules: Paths_simplex_chat hs-source-dirs: diff --git a/src/Simplex/Chat/Badges.hs b/src/Simplex/Chat/Badges.hs index f34ba8ef93..437b55e24d 100644 --- a/src/Simplex/Chat/Badges.hs +++ b/src/Simplex/Chat/Badges.hs @@ -47,13 +47,18 @@ module Simplex.Chat.Badges generateBadgeProof, badgeProof, verifyBadge, - verifyBadge_, + acceptedProof, + acceptedBadge, + sameBadgeProof, + unboundProof, mkBadgeStatus, BadgeRow, BadgeProofKind (..), BadgeProofRow, badgeProofToRow, rowToBadgeProof, + MaybeBadgeProofRow, + maybeRowToBadgeProof, badgeToRow, localBadgeToRow, rowToBadge, @@ -76,7 +81,7 @@ import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, nominalDay) import Data.Time.Clock.System (systemToUTCTime, utcToSystemTime) import Simplex.FileTransfer.Description (gb, maxFileSize) -import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), fromTextField_) +import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), blobFieldDecoder, fromTextField_) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.BBS import Simplex.Messaging.Crypto.Entitlement (Entitlement (Entitlement), EntitlementCredential (EntitlementCredential), MasterKey (MasterKey), entitlementBBSHeader) @@ -267,10 +272,17 @@ maxSndXFTPFileSize lims now = \case _ -> noBadge lims -- Presentation header: a tag char + payload. PHTest is unbound - a fresh random nonce per --- presentation, not bound to any context; the 'T' tag marks it so master rejects it. +-- presentation, not bound to any context. -- PHUnknown is the forward-compat catch-all for tags this version does not interpret. -data ProofPresHeaderTag = PHTestTag | PHChatTag | PHFileInvTag | PHFileDescrTag | PHUnknownTag Char +data ProofPresHeaderTag + = PHTestTag -- random nonce: released clients + | PHChatTag -- direct chat ratchet, group member key + | PHFileInvTag -- file invitation + | PHFileDescrTag -- file description + | PHRequestTag -- request to address without ratchet keys + | PHLinkTag -- invitation and address link data + | PHUnknownTag Char -- tags of newer versions instance StrEncoding ProofPresHeaderTag where strEncode = B.singleton . \case @@ -278,6 +290,8 @@ instance StrEncoding ProofPresHeaderTag where PHChatTag -> 'C' PHFileInvTag -> 'F' PHFileDescrTag -> 'D' + PHRequestTag -> 'R' + PHLinkTag -> 'L' PHUnknownTag c -> c strP = tag <$> A.anyChar where @@ -286,6 +300,8 @@ instance StrEncoding ProofPresHeaderTag where 'C' -> PHChatTag 'F' -> PHFileInvTag 'D' -> PHFileDescrTag + 'R' -> PHRequestTag + 'L' -> PHLinkTag c -> PHUnknownTag c data ProofPresHeader @@ -293,6 +309,8 @@ data ProofPresHeader | PHChat ByteString | PHFileInv {chatBinding :: ByteString, fileSize :: Int64} | PHFileDescr {chatBinding :: ByteString, fileSize :: Int64, descrHash :: ByteString, fileExpires :: Maybe UTCTime} + | PHRequest ByteString + | PHLink ByteString | PHUnknown Char ByteString deriving (Eq, Show) @@ -311,6 +329,8 @@ instance StrEncoding ProofPresHeader where strEncode PHFileInvTag <> smpEncode (chatBinding, fileSize) PHFileDescr {chatBinding, fileSize, descrHash, fileExpires} -> strEncode PHFileDescrTag <> smpEncode (chatBinding, fileSize, descrHash, utcToSystemTime <$> fileExpires) + PHRequest code -> strEncode PHRequestTag <> code + PHLink linkKey -> strEncode PHLinkTag <> linkKey PHUnknown c b -> strEncode (PHUnknownTag c) <> b strP = strP >>= \case @@ -322,16 +342,25 @@ instance StrEncoding ProofPresHeader where PHFileDescrTag -> do (chatBinding, fileSize, descrHash, expires_) <- smpP pure PHFileDescr {chatBinding, fileSize, descrHash, fileExpires = systemToUTCTime <$> expires_} + PHRequestTag -> PHRequest <$> A.takeByteString + PHLinkTag -> PHLink <$> A.takeByteString 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 +acceptedProof :: Maybe ProofPresHeader -> BadgeProof -> Bool +acceptedProof expected_ b@BadgeProof {presHeader = BBSPresHeader ph} = unboundProof b || any ((ph ==) . strEncode) expected_ + +acceptedBadge :: Maybe ProofPresHeader -> Maybe BadgeProof -> Maybe BadgeProof -> Maybe BadgeProof +acceptedBadge expected_ stored_ received_ = if all (acceptedProof expected_) received_ then received_ else stored_ + +sameBadgeProof :: Maybe BadgeProof -> Maybe BadgeProof -> Bool +sameBadgeProof b_ b_' = (proofContent <$> b_) == (proofContent <$> b_') + where + proofContent b@BadgeProof {presHeader, badgeInfo} = (if unboundProof b then Nothing else Just presHeader, badgeInfo) + +unboundProof :: BadgeProof -> Bool +unboundProof BadgeProof {presHeader = BBSPresHeader ph} = case strDecode ph of + Right (PHTest _) -> True + _ -> False -- Payment proof @@ -425,16 +454,15 @@ 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 - -verifyBadge_ :: Map Int BBSPublicKey -> Maybe BadgeProof -> IO (Maybe Bool) -verifyBadge_ keys = maybe (pure (Just False)) (verifyBadge keys) +verifyBadgeWith pk (BadgeProof _ ph proof badgeInfo) = + bbsProofVerify pk proof bbsBadgeHeader ph bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeInfoMessages badgeInfo) -- DB +instance FromField ProofPresHeader where fromField = blobFieldDecoder strDecode + +instance ToField ProofPresHeader where toField = toField . Binary . strEncode + instance FromField BadgeType where fromField = fromTextField_ textDecode instance ToField BadgeType where toField = toField . textEncode @@ -459,6 +487,12 @@ rowToBadgeProof (Binary p, Binary ph, idx, type_, badgeExpiry, badgeExtra) = do badgeType <- textDecode type_ pure $ BadgeProof idx (BBSPresHeader ph) (BBSProof p) BadgeInfo {badgeType, badgeExpiry, badgeExtra} +type MaybeBadgeProofRow = (Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe Int, Maybe Text, Maybe UTCTime, Maybe Text) + +maybeRowToBadgeProof :: MaybeBadgeProofRow -> Maybe BadgeProof +maybeRowToBadgeProof (p_, ph_, idx_, type_, expiry_, extra_) = + rowToBadgeProof =<< (,,,,,) <$> p_ <*> ph_ <*> idx_ <*> type_ <*> expiry_ <*> extra_ + -- (proof, pres_header, expiry, type, verified, extra, master_key, signature, key_idx) - binary columns wrapped in Binary (BLOB/bytea) type BadgeRow = (Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe UTCTime, Maybe Text, Maybe BoolInt, Maybe Text, Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe Int) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 4ffd27f428..f1b2ad3f7a 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -59,7 +59,7 @@ import qualified Data.UUID.V4 as V4 import Simplex.Chat.Library.Subscriber import Crypto.Random (ChaChaDRG) import Simplex.Messaging.Session (SessionVar (..), withGetSessVar') -import Simplex.Chat.Badges (BadgeCredential (..), BadgeInfo (..), BadgeMasterKey, BadgeType, LocalBadge (..), badgeServerCredential, mkBadgeStatus, maxSndXFTPFileSize, verifyCredential) +import Simplex.Chat.Badges (BadgeCredential (..), BadgeInfo (..), BadgeMasterKey, BadgeType, LocalBadge (..), ProofPresHeader (..), badgeServerCredential, mkBadgeStatus, maxSndXFTPFileSize, verifyCredential) import qualified Simplex.Chat.Badges.Ledger as L import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind (..), BadgeIssueError (..), BadgeIssueFailure (..), BadgeState (..)) import Simplex.Chat.Badges.Code (badgeCodeText, parseBadgeCode) @@ -2124,11 +2124,12 @@ processChatCommand cxt nm = \case -- [incognito] generate profile for connection 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 + rootKey <- atomically . C.generateKeyPair =<< asks random + (preparedLink, preparedParams@PreparedLinkParams {plpLinkKey = LinkKey linkKey}) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) SCMInvitation rootKey Nothing False Nothing IKUsePQ False Nothing + linkProfile <- presentUserBadge user incognitoProfile (Just $ PHLink linkKey) $ 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 + (connId, ccLink) <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True preparedLink preparedParams userLinkData subMode ccLink' <- shortenCreatedLink ccLink -- TODO PQ pass minVersion from the current range conn <- withFastStore' $ \db -> createDirectConnection db user connId ccLink' Nothing ConnNew incognitoProfile subMode initialChatVersion PQSupportOn @@ -2137,7 +2138,7 @@ processChatCommand cxt nm = \case processChatCommand cxt nm $ APIAddContact userId incognito APISetConnectionIncognito connId incognito -> withUser $ \user@User {userId} -> do conn <- withFastStore $ \db -> getPendingContactConnection db userId connId - let PendingContactConnection {pccConnStatus, customUserProfileId} = conn + let PendingContactConnection {pccConnStatus, customUserProfileId, connLinkInv} = conn case (pccConnStatus, customUserProfileId, incognito) of (ConnNew, Nothing, True) -> do incognitoProfile <- liftIO generateRandomProfile @@ -2147,7 +2148,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 (linkPresHeader <$> (connShortLink' =<< connLinkInv)) (userProfileDirect user Nothing Nothing True) conn' <- withFastStore' $ \db -> do deletePCCIncognitoProfile db user pId updatePCCIncognito db user conn Nothing sLnk @@ -2166,11 +2167,14 @@ processChatCommand cxt nm = \case recreateConn user conn@PendingContactConnection {customUserProfileId, connLinkInv} newUser = do subMode <- chatReadVar subscriptionMode let short = isJust $ connShortLink' =<< connLinkInv - userLinkData_ <- + (agConnId, ccLink) <- if short - then Just . UserInvLinkData . (`contactShortLinkData` Nothing) <$> presentUserBadge newUser 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 + then do + rootKey <- atomically . C.generateKeyPair =<< asks random + (preparedLink, preparedParams@PreparedLinkParams {plpLinkKey = LinkKey linkKey}) <- withAgent $ \a -> prepareConnectionLink a (aUserId newUser) SCMInvitation rootKey Nothing False Nothing IKPQOn False Nothing + userLinkData <- UserInvLinkData . (`contactShortLinkData` Nothing) <$> presentUserBadge newUser Nothing (Just $ PHLink linkKey) (userProfileDirect newUser Nothing Nothing True) + withAgent $ \a -> createConnectionForLink a nm (aUserId newUser) True preparedLink preparedParams userLinkData subMode + else withAgent $ \a -> createConnection a nm (aUserId newUser) True False SCMInvitation Nothing Nothing IKPQOn True subMode ccLink' <- shortenCreatedLink ccLink conn' <- withFastStore' $ \db -> do deleteConnectionRecord db user connId @@ -2205,8 +2209,8 @@ processChatCommand cxt nm = \case Just (AChatItem SCTGroup dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci} _ -> Chat cInfo [] emptyChatStats pure $ CRNewPreparedChat user $ AChat SCTGroup chat - ACCL _ (CCLink cReq _) -> do - ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink welcomeSharedMsgId (True <$ verifiedDomain) + ACCL _ (CCLink cReq sLnk) -> do + ct <- withStore $ \db -> createPreparedContact db cxt user (linkPresHeader <$> sLnk) profile accLink welcomeSharedMsgId (True <$ verifiedDomain) void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing Nothing (Just epochStart) let cd = CDDirectRcv ct createItem sharedMsgId content = createChatItem user cd False content sharedMsgId Nothing Nothing @@ -2468,15 +2472,15 @@ processChatCommand cxt nm = \case Just True -> (IKUsePQ, True) Just False -> (IKPQOn, True) Nothing -> (IKPQOn, False) - (ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True Nothing pqInitKeys useDR server_ + (ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) SCMContact rootKey (Just entityId) True Nothing pqInitKeys useDR server_ ccLink' <- shortenCreatedLink ccLink -- TODO [relays] relay: add identity, key to link data? 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 (linkPresHeader <$> connShortLink' ccLink) (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 + (connId, _) <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode let ccLink'' = if isTrue userChatRelay then setShortLinkType CCTRelay ccLink' else ccLink' withFastStore $ \db -> createUserContactLink db user connId ccLink'' subMode rootPrivKey pure $ CRUserContactLinkCreated user ccLink'' @@ -2745,7 +2749,7 @@ processChatCommand cxt nm = \case let entityId = C.sha256Hash $ C.pubKeyBytes rootPubKey crClientData = encodeJSON $ CRDataGroup groupLinkId -- prepare link with entityId as linkEntityId (no server request) - (ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True (Just crClientData) IKPQOff False Nothing + (ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) SCMContact rootKey (Just entityId) True (Just crClientData) IKPQOff False Nothing ccLink' <- setShortLinkType CCTChannel <$> shortenCreatedLink ccLink sLnk <- case connShortLink' ccLink' of Just sl -> pure sl @@ -2758,14 +2762,14 @@ processChatCommand cxt nm = \case userData = encodeShortLinkData $ GroupShortLinkData {groupProfile = groupProfile', publicGroupData = Just (PublicGroupData 1)} userLinkData = UserContactLinkData UserContactData {direct = False, owners = [ownerAuth], relays = [], userData, ratchetKeys = Nothing} -- create connection with prepared link (single network call) - connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode + (connId, _) <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode let groupKeys = GKPublicGroup {groupRootKey = GRKPrivate rootPrivKey, memberPrivKey} setupLink gInfo = do -- TODO [relays] starting role should be communicated in protocol from owner to relays subRole <- asks $ channelSubscriberRole . config gLink <- withFastStore $ \db -> createGroupLink db gVar user gInfo connId ccLink' groupLinkId subRole subMode relays <- withFastStore $ \db -> mapM (getChatRelayById db user) (L.toList relayIds) - results <- addRelays user gInfo sLnk relays + results <- addRelays user (GIK gInfo groupKeys) sLnk relays pure (gLink, results) pure (groupProfile', memberId, groupKeys, setupLink) NewPublicGroup incognito relayIds gProfile -> withUser $ \User {userId} -> @@ -2777,10 +2781,10 @@ processChatCommand cxt nm = \case pure (gInfo, relays) pure $ CRGroupRelays user gInfo relays APIAddGroupRelays groupId relayIds -> withUser $ \user -> withGroupLock "addGroupRelays" groupId $ do - (gInfo, existingRelays) <- withFastStore $ \db -> do - gi <- getGroupInfo db cxt user groupId + (g@(GIK gInfo _), existingRelays) <- withFastStore $ \db -> do + g@(GIK gi _) <- getGroupInfoKeys db cxt user groupId rs <- liftIO $ getGroupRelays db gi - pure (gi, rs) + pure (g, rs) assertUserGroupRole gInfo GROwner unless (useRelays' gInfo) $ throwCmdError "group does not use relays" let existingRelayIds = map (\GroupRelay {userChatRelay = UserChatRelay {chatRelayId = DBEntityId rId}} -> rId) existingRelays @@ -2790,7 +2794,7 @@ processChatCommand cxt nm = \case Just sl -> pure sl Nothing -> throwChatError $ CEException "group link has no short link" relays <- withFastStore $ \db -> mapM (getChatRelayById db user) (L.toList relayIds) - results <- addRelays user gInfo sLnk relays + results <- addRelays user g sLnk relays case partitionEithers (map snd results) of ([], _) -> do relays' <- withFastStore $ \db -> liftIO $ getGroupRelays db gInfo @@ -2843,12 +2847,11 @@ processChatCommand cxt nm = \case inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db cxt user groupId (inv,) <$> getContactViaMember db cxt user fromMember let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership, chatSettings}, groupKeys = gks} = invitation - GroupMember {memberId = membershipMemId} = membership Contact {activeConn} = ct case activeConn of Just Connection {peerChatVRange} -> do subMode <- chatReadVar subscriptionMode - dm <- encodeConnInfo $ XGrpAcpt membershipMemId (Just $ groupMemberKey gks) + dm <- encodeXGrpAcpt user (GIK g gks) peerChatVRange agentConnId <- case memberConn fromMember of Nothing -> do (agentConnId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff @@ -3401,21 +3404,21 @@ processChatCommand cxt nm = \case -- so incognito profile can be attached to it and be visible in UI before accepting Nothing -> joinNewConn subMode Just conn@Connection {connStatus} -> case connStatus of - ConnPrepared -> joinPreparedConn subMode conn + ConnPrepared -> joinPreparedConn subMode conn $ connPresHeader conn _ -> throwChatError $ CEException "connection already started (past prepared status)" where joinNewConn subMode = do -- possible improvement: use agent connRequestAgentVersion to determine pqSupport here; -- for joinPreparedConn below - same + encodeConnInfoPQ; -- same for auto-accept on xGrpDirectInv - (acId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq PQSupportOff + (acId, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq PQSupportOff conn <- withStore $ \db -> do connId <- liftIO $ createMemberContactConn db user acId Nothing gInfo mConn ConnPrepared contactId subMode getConnectionById db cxt user connId - joinPreparedConn subMode conn - joinPreparedConn subMode conn = do + joinPreparedConn subMode conn $ pure $ Just $ directPresHeader binding + joinPreparedConn subMode conn getPresHeader = do -- [incognito] send membership incognito profile - p <- presentUserBadge user (incognitoMembershipProfile gInfo) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile gInfo) Nothing True + p <- presentUserBadgeWith user (incognitoMembershipProfile gInfo) getPresHeader $ 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 @@ -3821,7 +3824,7 @@ processChatCommand cxt nm = \case | connStatus == ConnNew && contactConnInitiated -> joinNewConn chatV -- own connection link | connStatus == ConnPrepared -> do -- retrying join after error localIncognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId - joinPreparedConn conn (fromLocalProfile <$> localIncognitoProfile) + joinPreparedConn conn (fromLocalProfile <$> localIncognitoProfile) $ connPresHeader conn Just ent -> throwCmdError $ "connection is not RcvDirectMsgConnection: " <> show (connEntityInfo ent) where -- all supported versions support PQ encryption @@ -3829,12 +3832,12 @@ processChatCommand cxt nm = \case joinNewConn chatV = do -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing - (connId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup' + (connId, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup' let ccLink = CCLink cReq $ serverShortLink <$> sLnk_ 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 + joinPreparedConn conn incognitoProfile $ pure $ Just $ directPresHeader binding + joinPreparedConn conn incognitoProfile getPresHeader = do + profileToSend <- presentUserBadgeWith user incognitoProfile getPresHeader $ 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 @@ -3888,14 +3891,14 @@ processChatCommand cxt nm = \case when (incognito /= isJust customUserProfileId) $ throwCmdError "incognito mode is different from prepared connection" -- TODO [relays] member: refactor joinContact and up avoiding parallel ifs, xContactId is not used xContactId <- mkXContactId xContactId_ - (cReq', localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId) + ((cReq', reqHeader_), localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId) let incognitoProfile = fromLocalProfile <$> localIncognitoProfile - conn' <- joinContact user conn cReq' incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ PQSupportOn + conn' <- joinContact user conn cReq' incognitoProfile reqHeader_ xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ PQSupportOn pure $ CVRSentInvitation conn' incognitoProfile connect' groupLinkId xContactId_ gInfo_ = do let inGroup = isJust groupLinkId pqSup = if inGroup then PQSupportOff else PQSupportOn - (connId, chatV) <- prepareContact user cReq pqSup + (connId, chatV, reqHeader) <- prepareContact user cReq pqSup xContactId <- mkXContactId xContactId_ -- [incognito] generate profile to send, or use membership profile for relay groups incognitoProfile_ <- case gInfo_ of @@ -3904,8 +3907,8 @@ processChatCommand cxt nm = \case let incognitoProfile = fromIncognitoProfile <$> incognitoProfile_ subMode <- chatReadVar subscriptionMode let sLnk' = serverShortLink <$> sLnk - conn <- withFastStore' $ \db -> createConnReqConnection db userId connId preparedEntity_ cReq cReqHash1 sLnk' xContactId incognitoProfile_ groupLinkId subMode chatV pqSup - conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup + conn <- withFastStore' $ \db -> createConnReqConnection db userId connId preparedEntity_ cReq reqHeader cReqHash1 sLnk' xContactId incognitoProfile_ groupLinkId subMode chatV pqSup + conn' <- joinContact user conn cReq incognitoProfile (Just reqHeader) xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup pure $ CVRSentInvitation conn' incognitoProfile connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> CreatedLinkContact -> CM ChatResponse connectContactViaAddress user@User {userId} incognito ct@Contact {contactId, activeConn} (CCLink cReq shortLink) = @@ -3913,23 +3916,23 @@ processChatCommand cxt nm = \case case activeConn of Nothing -> do let pqSup = PQSupportOn - (connId, chatV) <- prepareContact user cReq pqSup + (connId, chatV, reqHeader) <- prepareContact user cReq pqSup newXContactId <- XContactId <$> drgRandomBytes 16 -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing subMode <- chatReadVar subscriptionMode let cReqHash = contactCReqHash cReq - conn <- withFastStore' $ \db -> createConnReqConnection db userId connId (Just $ PCEContact ct) cReq cReqHash shortLink newXContactId (NewIncognito <$> incognitoProfile) Nothing subMode chatV pqSup - void $ joinContact user conn cReq incognitoProfile newXContactId Nothing Nothing Nothing Nothing pqSup + conn <- withFastStore' $ \db -> createConnReqConnection db userId connId (Just $ PCEContact ct) cReq reqHeader cReqHash shortLink newXContactId (NewIncognito <$> incognitoProfile) Nothing subMode chatV pqSup + void $ joinContact user conn cReq incognitoProfile (Just reqHeader) newXContactId Nothing Nothing Nothing Nothing pqSup ct' <- withStore $ \db -> getContact db cxt user contactId pure $ CRSentInvitationToContact user ct' incognitoProfile Just conn@Connection {connId, connStatus, xContactId = xContactId_, customUserProfileId} -> case connStatus of ConnPrepared -> do when (incognito /= isJust customUserProfileId) $ throwCmdError "incognito mode is different from prepared connection" xContactId <- mkXContactId xContactId_ - (cReq', localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId) + ((cReq', reqHeader_), localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId) let incognitoProfile = fromLocalProfile <$> localIncognitoProfile - void $ joinContact user conn cReq' incognitoProfile xContactId Nothing Nothing Nothing Nothing PQSupportOn + void $ joinContact user conn cReq' incognitoProfile reqHeader_ xContactId Nothing Nothing Nothing Nothing PQSupportOn ct' <- withStore $ \db -> getContact db cxt user contactId pure $ CRSentInvitationToContact user ct' incognitoProfile _ -> throwCmdError "contact already has connection" @@ -3970,21 +3973,21 @@ processChatCommand cxt nm = \case deleteMemberConnection m deleteOrUpdateMemberRecord user gInfo m _ -> pure () - prepareContact :: User -> ConnReqContact -> PQSupport -> CM (ConnId, VersionChat) + prepareContact :: User -> ConnReqContact -> PQSupport -> CM (ConnId, VersionChat, ProofPresHeader) prepareContact user cReq pqSup = do lift (withAgent' (`connRequestAgentVersion` cReq)) >>= \case Nothing -> throwChatError CEInvalidConnReq Just _ -> do let chatV = initialChatVersion - (connId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup - pure (connId, chatV) + (connId, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup + pure (connId, chatV, directPresHeader binding) mkXContactId :: Maybe XContactId -> CM XContactId mkXContactId = maybe (XContactId <$> drgRandomBytes 16) pure - 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 + joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> Maybe ProofPresHeader -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Maybe (Maybe GroupInfoKeys) -> Maybe MemberId -> PQSupport -> CM Connection + joinContact user conn cReq incognitoProfile reqHeader_ 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 + presentUserBadge user incognitoProfile presHeader_ $ case gInfo_ of Just gInfo_' -> userProfileInGroup' user ((\(GIK g _) -> g) <$> gInfo_') incognitoProfile Nothing -> userProfileDirect user incognitoProfile Nothing True dm <- case gInfo_ of @@ -3998,6 +4001,10 @@ processChatCommand cxt nm = \case subMode <- chatReadVar subscriptionMode void $ withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup subMode withFastStore' $ \db -> updateConnectionStatusFromTo db conn ConnPrepared ConnJoined + where + presHeader_ = case gInfo_ of + Just (Just (GIK g _)) | useRelays' g -> groupPresHeader g + _ -> reqHeader_ contactMember :: Contact -> [GroupMember] -> Maybe GroupMember contactMember Contact {contactId} = find $ \GroupMember {memberContactId = cId, memberStatus = s} -> @@ -4052,7 +4059,8 @@ processChatCommand cxt nm = \case case changedCts_ of Nothing -> pure $ UserProfileUpdateSummary 0 0 [] Just changedCts -> do - idsEvts <- mapM ctSndEvent changedCts + presHeaders <- if presentsUserBadge user' then connsPresHeaders $ map (\ChangedProfileContact {conn} -> conn) $ L.toList changedCts else pure M.empty + idsEvts <- mapM (ctSndEvent presHeaders) changedCts msgReqs_ <- lift $ L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts (errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_ unless (null errs) $ toView $ CEvtChatErrors errs @@ -4077,18 +4085,19 @@ processChatCommand cxt nm = \case ct' = updateMergedPreferences user' ct mergedProfile' = userProfileDirect user' Nothing (Just ct') False -- 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' + ctSndEvent :: Map ConnId ProofPresHeader -> ChangedProfileContact -> CM (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent 'Json) + ctSndEvent presHeaders ChangedProfileContact {mergedProfile', conn = conn@Connection {connId}} = do + p'' <- presentUserBadge user' Nothing (M.lookup (aConnId conn) presHeaders) mergedProfile' pure (ConnectionId connId, Nothing, XInfo p'' Nothing) ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq ctMsgReq ChangedProfileContact {conn} = fmap $ \SndMessage {msgId, msgBody} -> (conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId])) setMyAddressData :: Bool -> Maybe InitialKeys -> User -> UserContactLink -> CM UserContactLink - setMyAddressData rotateKeys pqInitKeys user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _, addressSettings} = do + setMyAddressData rotateKeys pqInitKeys user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink sLnk_, addressSettings} = do conn <- withFastStore $ \db -> getUserAddressConnection db cxt user - shortLinkProfile <- presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True) + let getPresHeader = Just . linkPresHeader <$> maybe (withAgent $ \a -> prepareConnShortLink a (aConnId conn) Nothing) pure sLnk_ + shortLinkProfile <- presentUserBadgeWith user Nothing getPresHeader (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 @@ -4102,7 +4111,7 @@ processChatCommand cxt nm = \case pure ucl' updateContactPrefs :: User -> Contact -> Preferences -> CM ChatResponse updateContactPrefs _ ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotActive ct - updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' + updateContactPrefs user@User {userId} ct@Contact {activeConn = Just conn@Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated user ct ct | otherwise = do assertDirectAllowed user MDSnd ct XInfo_ @@ -4112,7 +4121,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 <- presentUserBadgeWith user incognitoProfile (connPresHeader conn) mergedProfile' void (sendDirectContactMessage user ct' $ XInfo p Nothing) `catchAllErrors` eToView lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct' pure $ CRContactPrefsUpdated user ct ct' @@ -4311,8 +4320,8 @@ processChatCommand cxt nm = \case toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] forM_ (timed_ >>= timedDeleteAt') $ startProximateTimedItemThread user (ChatRef CTDirect contactId Nothing, chatItemId' ci) - addRelays :: User -> GroupInfo -> ShortLinkContact -> [UserChatRelay] -> CM [(UserChatRelay, Either ChatError GroupRelay)] - addRelays user gInfo@GroupInfo {membership} groupSLink relays = + addRelays :: User -> GroupInfoKeys -> ShortLinkContact -> [UserChatRelay] -> CM [(UserChatRelay, Either ChatError GroupRelay)] + addRelays user g@(GIK gInfo@GroupInfo {membership} gks) groupSLink relays = mapConcurrently addRelay relays where addRelay :: UserChatRelay -> CM (UserChatRelay, Either ChatError GroupRelay) @@ -4332,14 +4341,17 @@ 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 <- membershipHandshakeProfile user gInfo let relayInv = GroupRelayInvitation { fromMember = MemberIdRole userMemberId userRole, fromMemberProfile = membershipProfile, relayMemberId, - groupLink = groupSLink + groupLink = groupSLink, + publicGroupId = (\PublicGroupProfile {publicGroupId = gId} -> gId) <$> publicGroup' gInfo, + fromMemberKey = Just $ groupMemberKey gks } - dm <- encodeConnInfo $ XGrpRelayInv relayInv + msg = XGrpRelayInv relayInv + dm <- encodeConnInfoSigning PQSupportOff (groupMsgSigning False g msg) msg sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm PQSupportOff subMode let newConnStatus = if sqSecured then ConnSndReady else ConnJoined withFastStore' $ \db -> do @@ -4417,7 +4429,7 @@ processChatCommand cxt nm = \case Just (createdLink, p) -> pure (createdLink, Nothing, Nothing, p) Nothing -> do (FixedLinkData {rootKey}, cData, cReq) <- getShortLinkConnReq nm user l' - contactSLinkData_ <- mapM linkDataBadge =<< liftIO (decodeLinkUserData cData) + contactSLinkData_ <- mapM (linkDataBadge $ linkPresHeader l') =<< liftIO (decodeLinkUserData cData) let ov = verifyLinkOwner rootKey [] l sig_ invitationReqAndPlan cReq (Just l') contactSLinkData_ ov where @@ -4471,12 +4483,13 @@ processChatCommand cxt nm = \case when (resolveMode == PRMNever) $ throwChatError CENotResolvedLocally l' <- resolveSLink (FixedLinkData {rootKey}, cData, cReq) <- getShortLinkConnReq nm user l' - contactSLinkData_ <- mapM linkDataBadge =<< liftIO (decodeLinkUserData cData) + let presHeader = linkPresHeader l' + contactSLinkData_ <- mapM (linkDataBadge presHeader) =<< liftIO (decodeLinkUserData cData) let linkProfile_ = (\ContactShortLinkData {profile} -> profile) <$> contactSLinkData_ linkDomain_ = linkProfile_ >>= \Profile {contactDomain} -> claimDomain <$> contactDomain planDomain = case nl of CTName ni -> Just (nameDomain ni); _ -> Nothing refreshContact ct' = case (planDomain, linkProfile_) of - (Just _, Just p) -> updateContactFromLinkData user ct' p + (Just _, Just p) -> updateContactFromLinkData user ct' presHeader p _ -> pure ct' forM_ planDomain $ \nameDomain -> unless (linkDomain_ == Just nameDomain) $ throwChatError $ CESimplexDomainNotReady nameDomain SDEUnknownDomain @@ -5223,14 +5236,12 @@ presentUserBadgeToContacts user'@User {userId, profile = LocalProfile {localBadg lift $ withAgent' $ \a -> setUserEntitlement a (aUserId user') (badgeServerCredential localBadge) cxt <- chatStoreCxt contacts <- withFastStore' $ \db -> getUserContacts db cxt user' - withChatLock "presentUserBadge" $ forM_ contacts $ \ct -> - case contactSendConn_ ct of - Right conn - | not (connIncognito conn) -> do - let ct' = updateMergedPreferences user' ct - p <- presentUserBadge user' Nothing $ userProfileDirect user' Nothing (Just ct') False - void (sendDirectContactMessage user' ct' (XInfo p Nothing)) `catchAllErrors` eToView - _ -> pure () + let sendConns = [(ct, conn) | ct <- contacts, Right conn <- [contactSendConn_ ct], not (connIncognito conn)] + presHeaders <- if presentsUserBadge user' then connsPresHeaders $ map snd sendConns else pure M.empty + withChatLock "presentUserBadge" $ forM_ sendConns $ \(ct, conn) -> do + let ct' = updateMergedPreferences user' ct + p <- presentUserBadge user' Nothing (M.lookup (aConnId conn) presHeaders) $ userProfileDirect user' Nothing (Just ct') False + void (sendDirectContactMessage user' ct' (XInfo p Nothing)) `catchAllErrors` eToView -- | The check character is verified before anything leaves the device, and the signing keys are -- stashed before the request is sent, so a retry reaches the service as the same signer. diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 4008bc2727..6ea428ac1f 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/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 (..), acceptedProof, badgeSndGraceInterval, generateBadgeProof, localBadgeStatus, maxXFTPFileSize, mkBadgeStatus, verifyBadge) import Simplex.Chat.Names (SimplexDomainClaim (..), claimDomain) import Simplex.Chat.Call import Simplex.Chat.Controller @@ -992,28 +992,28 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId pqSup' = pqSup `CR.pqSupportAnd` pqSupport cxt <- chatStoreCxt let chatV = vr cxt `peerConnChatVersion` cReqChatVRange - (ct, conn, incognitoProfile) <- case contactId_ of + (ct, conn, incognitoProfile, getPresHeader) <- case contactId_ of Nothing -> do incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing - (connId, _) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup' + (connId, binding) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup' (ct, conn) <- withStore' $ \db -> createContactFromRequest db user userContactLinkId_ connId chatV cReqChatVRange cName profileId cp xContactId incognitoProfile subMode pqSup' False - pure (ct, conn, incognitoProfile) + pure (ct, conn, incognitoProfile, pure $ Just $ directPresHeader binding) Just contactId -> do ct <- withFastStore $ \db -> getContact db cxt user contactId case contactConn ct of Nothing -> do incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing - (connId, _) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup' + (connId, binding) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup' currentTs <- liftIO getCurrentTime conn <- withStore' $ \db -> do forM_ xContactId $ \xcId -> setContactAcceptedXContactId db ct xcId createAcceptedContactConn db user userContactLinkId_ contactId connId chatV cReqChatVRange pqSup' incognitoProfile subMode currentTs - pure (ct {activeConn = Just conn} :: Contact, conn, incognitoProfile) + pure (ct {activeConn = Just conn} :: Contact, conn, incognitoProfile, pure $ Just $ directPresHeader binding) 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 + pure (ct, conn, ExistingIncognito <$> incognitoProfile, connPresHeader conn) + profileToSend <- presentUserBadgeWith user incognitoProfile getPresHeader $ 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) @@ -1025,10 +1025,10 @@ 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 cxt <- chatStoreCxt let chatV = vr cxt `peerConnChatVersion` cReqChatVRange - (cmdId, acId) <- prepareAgentAccept user True cReqInvId cReqPQSup + ((cmdId, acId), presHeader) <- prepareAgentAccept user True cReqInvId cReqPQSup + profileToSend <- presentUserBadge user incognitoProfile (Just presHeader) $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True currentTs <- liftIO getCurrentTime ct' <- withStore $ \db -> do forM_ xContactId $ \xcId -> liftIO $ setContactAcceptedXContactId db ct xcId @@ -1038,7 +1038,7 @@ acceptContactRequestAsync agentAcceptContactAsync cmdId acId True cReqInvId (XInfo profileToSend Nothing) cReqPQSup subMode pure ct' -acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfoKeys -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> Maybe GroupMember -> CM GroupMember +acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfoKeys -> InvitationId -> VersionRangeChat -> Profile -> Maybe ProofPresHeader -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> Maybe GroupMember -> CM GroupMember acceptGroupJoinRequestAsync user@User {userId} uclId @@ -1046,6 +1046,7 @@ acceptGroupJoinRequestAsync cReqInvId cReqChatVRange cReqProfile + presHeader_ cReqXContactId_ cReqMemberId_ welcomeMsgId_ @@ -1064,10 +1065,10 @@ acceptGroupJoinRequestAsync -- 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 presHeader_ 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 presHeader_ 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 @@ -1085,7 +1086,7 @@ acceptGroupJoinRequestAsync } subMode <- chatReadVar subscriptionMode let chatV = vr cxt `peerConnChatVersion` cReqChatVRange - (cmdId, acId) <- prepareAgentAccept user True cReqInvId PQSupportOff + ((cmdId, acId), _) <- prepareAgentAccept user True cReqInvId PQSupportOff m <- withStore $ \db -> do liftIO $ createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode getGroupMemberById db cxt user groupMemberId @@ -1105,7 +1106,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 $ @@ -1117,7 +1118,7 @@ acceptGroupJoinSendRejectAsync } subMode <- chatReadVar subscriptionMode let chatV = vr cxt `peerConnChatVersion` cReqChatVRange - (cmdId, acId) <- prepareAgentAccept user False cReqInvId PQSupportOff + ((cmdId, acId), _) <- prepareAgentAccept user False cReqInvId PQSupportOff m <- withStore $ \db -> do liftIO $ createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode getGroupMemberById db cxt user groupMemberId @@ -1152,7 +1153,7 @@ acceptBusinessJoinRequestAsync } subMode <- chatReadVar subscriptionMode let chatV = vr cxt `peerConnChatVersion` cReqChatVRange - (cmdId, acId) <- prepareAgentAccept user True cReqInvId PQSupportOff + ((cmdId, acId), _) <- prepareAgentAccept user True cReqInvId PQSupportOff withStore' $ \db -> do forM_ xContactId $ \xcId -> setBusinessChatAcceptedXContactId db gInfo xcId createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode @@ -1179,7 +1180,7 @@ acceptRelayJoinRequestAsync subMode <- chatReadVar subscriptionMode cxt <- chatStoreCxt let chatV = vr cxt `peerConnChatVersion` cReqChatVRange - (cmdId, acId) <- prepareAgentAccept user True cReqInvId PQSupportOff + ((cmdId, acId), _) <- prepareAgentAccept user True cReqInvId PQSupportOff r <- withStore $ \db -> do liftIO $ createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode gInfo' <- liftIO $ updateRelayOwnStatusFromTo db gInfo RSInvited RSAccepted @@ -1193,20 +1194,21 @@ rejectRelayInvitationAsync -> Int64 -> StoreCxt -> GroupRelayInvitation + -> Maybe ProofPresHeader -> InvitationId -> VersionRangeChat -> Int64 -> RelayRejectionReason -> CM () -rejectRelayInvitationAsync user uclId cxt groupRelayInv invId reqChatVRange initialDelay reason = do +rejectRelayInvitationAsync user uclId cxt groupRelayInv presHeader_ invId reqChatVRange initialDelay reason = do (_gInfo, ownerMember) <- withStore $ \db -> - createRelayRequestGroup db cxt user groupRelayInv invId reqChatVRange initialDelay GSMemInvited RSRejected + createRelayRequestGroup db cxt user groupRelayInv presHeader_ invId reqChatVRange initialDelay GSMemInvited RSRejected let GroupMember {groupMemberId} = ownerMember msg = XGrpRelayReject reason subMode <- chatReadVar subscriptionMode chatVR <- chatVersionRange let chatV = chatVR `peerConnChatVersion` reqChatVRange - (cmdId, acId) <- prepareAgentAccept user False invId PQSupportOff + ((cmdId, acId), _) <- prepareAgentAccept user False invId PQSupportOff withStore' $ \db -> createJoiningMemberConnection db user uclId (cmdId, acId) chatV reqChatVRange groupMemberId subMode agentAcceptContactAsync cmdId acId False invId msg PQSupportOff subMode @@ -1345,14 +1347,16 @@ userProfileInGroup' User {profile = p} mg incognitoProfile = in maybe p' (\g -> redactedMemberProfile g (membership g) p') mg memberInfo :: GroupInfo -> GroupMember -> MemberInfo -memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, activeConn} = +memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, activeConn, memberBadgeProof} = MemberInfo { memberId, memberRole, v = ChatVersionRange . peerChatVRange <$> activeConn, - profile = redactedMemberProfile g m $ fromLocalProfile memberProfile, + profile = (p :: Profile) {badge = mfilter (acceptedProof $ memberPresHeader g memberId memberPubKey) (unNoJSON memberBadgeProof <|> badge)}, memberKey = MemberKey <$> memberPubKey } + where + p@Profile {badge} = redactedMemberProfile g m $ fromLocalProfile memberProfile redactedMemberProfile :: GroupInfo -> GroupMember -> Profile -> Profile redactedMemberProfile g m Profile {displayName, fullName, shortDescr, description, image, contactLink = lnk, peerType, badge, contactDomain} = @@ -1649,12 +1653,12 @@ updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupSummary = G newClaim = groupClaim groupProfile verifyResolved = isJust resolvedDomain_ && resolvedDomain_ == newClaim -updateContactFromLinkData :: User -> Contact -> Profile -> CM Contact -updateContactFromLinkData user ct@Contact {profile = profile@LocalProfile {contactDomain = prevClaim, contactDomainVerified}} linkProfile@Profile {contactDomain = newClaim} +updateContactFromLinkData :: User -> Contact -> ProofPresHeader -> Profile -> CM Contact +updateContactFromLinkData user ct@Contact {profile = profile@LocalProfile {contactDomain = prevClaim, contactDomainVerified}} presHeader linkProfile@Profile {contactDomain = newClaim} | profileChanged || verifyChanged = do cxt <- chatStoreCxt withFastStore $ \db -> do - ct' <- updateContactProfile db cxt user ct linkProfile + ct' <- updateContactProfile db cxt user ct (Just presHeader) linkProfile if verifyChanged then liftIO $ setContactDomainVerified db user ct' True else pure ct' | otherwise = pure ct where @@ -2250,25 +2254,49 @@ 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) - _ -> pure p +presentUserBadge :: User -> Maybe i -> Maybe ProofPresHeader -> Profile -> CM Profile +presentUserBadge user incognitoProfile = presentUserBadgeWith user incognitoProfile . pure +presentUserBadgeWith :: User -> Maybe i -> CM (Maybe ProofPresHeader) -> Profile -> CM Profile +presentUserBadgeWith user incognitoProfile getPresHeader p + | isNothing incognitoProfile && presentsUserBadge user = do + badge <- getPresHeader $>>= sndBadgeProof user + pure p {badge} + | otherwise = pure p + +presentsUserBadge :: User -> Bool +presentsUserBadge User {profile = LocalProfile {localBadge}} = case localBadge of + Just (OwnBadge _ st) -> st == BSActive || st == BSExpired + _ -> False + +groupPresHeader :: GroupInfo -> Maybe ProofPresHeader +groupPresHeader gInfo@GroupInfo {membership = GroupMember {memberId, memberPubKey}} = memberPresHeader gInfo memberId memberPubKey + +membershipHandshakeProfile :: User -> GroupInfo -> CM Profile +membershipHandshakeProfile user gInfo@GroupInfo {membership} = + presentUserBadge user (incognitoMembershipProfile gInfo) (groupPresHeader gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership + +directPresHeader :: ContactRequestBinding -> ProofPresHeader +directPresHeader = \case + CRBRatchet ConnVerifyCodes {codeAD} -> PHChat $ encodeChatBinding CBDirect $ C.sha256Hash $ "SimpleX badge" <> codeAD + CRBRequest code -> PHRequest code + +linkPresHeader :: ConnShortLink c -> ProofPresHeader +linkPresHeader = \case + CSLInvitation _ _ _ (LinkKey key) -> PHLink key + CSLContact _ _ _ (LinkKey key) -> PHLink key + +connPresHeader :: Connection -> CM (Maybe ProofPresHeader) +connPresHeader conn = M.lookup (aConnId conn) <$> connsPresHeaders [conn] + +connsPresHeaders :: [Connection] -> CM (Map ConnId ProofPresHeader) +connsPresHeaders conns = M.map (directPresHeader . CRBRatchet) <$> withAgent (`getConnectionsVerifyCodes` map aConnId conns) -- receiving side of contact/invitation link data: verify the badge proof from the link profile -- and set the crypto-free display badge for the UI (the raw proof stays in profile for APIPrepareContact) -linkDataBadge :: ContactShortLinkData -> CM ContactShortLinkData -linkDataBadge cld@ContactShortLinkData {profile = Profile {badge}} = case badge of - Nothing -> pure cld +linkDataBadge :: ProofPresHeader -> ContactShortLinkData -> CM ContactShortLinkData +linkDataBadge presHeader cld@ContactShortLinkData {profile = Profile {badge}} = case mfilter (acceptedProof (Just presHeader)) badge of + Nothing -> pure (cld :: ContactShortLinkData) {localBadge = Nothing} Just b@(BadgeProof _ _ _ info) -> do keys <- asks $ badgePublicKeys . config verified <- liftIO $ verifyBadge keys b @@ -2331,7 +2359,11 @@ 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 + XGrpAcpt _ _ (Just Profile {badge}) -> isJust badge + _ -> False bindingData = groupBindingData gInfo memberId (C.publicKey memberPrivKey') groupBindingData :: GroupInfo -> MemberId -> C.PublicKeyEd25519 -> ByteString @@ -2357,6 +2389,16 @@ rcvGroupChatBinding gInfo m_ asGroup badge_ = (\k -> encodeChatBinding CBGroup $ smpEncode (memberId, k)) <$> (memberPubKey <|> proofMemberKey memberId badge_) _ -> Nothing +memberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader +memberPresHeader gInfo memberId = fmap $ memberKeyPresHeader ((\PublicGroupProfile {publicGroupId} -> publicGroupId) <$> publicGroup' gInfo) memberId + +memberKeyPresHeader :: Maybe B64UrlByteString -> MemberId -> C.PublicKeyEd25519 -> ProofPresHeader +memberKeyPresHeader publicGroupId_ memberId k = + PHChat $ encodeChatBinding CBGroup $ maybe (smpEncode (memberId, k)) (\publicGroupId -> smpEncode (publicGroupId, memberId, k)) publicGroupId_ + +memberInfoPresHeader :: GroupInfo -> MemberInfo -> Maybe ProofPresHeader +memberInfoPresHeader gInfo MemberInfo {memberId, memberKey} = memberPresHeader gInfo memberId ((\(MemberKey k) -> k) <$> memberKey) + proofMemberKey :: MemberId -> Maybe BadgeProof -> Maybe C.PublicKeyEd25519 proofMemberKey memberId badge_ = do BadgeProof _ (BBSPresHeader phBytes) _ _ <- badge_ @@ -2484,6 +2526,9 @@ encodeSignedConnInfo pqSup signing chatMsgEvent = do ECMEncoded body -> compressConnInfo pqSup $ encodeBatchElement (Just $ signChatMsgBody signing body) body ECMLarge -> throwChatError $ CEException "large signed info" +encodeConnInfoSigning :: MsgEncodingI e => PQSupport -> Maybe MsgSigning -> ChatMsgEvent e -> CM ByteString +encodeConnInfoSigning pqSup = maybe (encodeConnInfoPQ pqSup) (encodeSignedConnInfo pqSup) + -- signed XMember for a relay-group join: proves the joiner holds the member key it asserts, and carries -- viaRelay = the target relay's memberId inside the signed body so a sibling relay can't accept a replay encodeXMemberConnInfo :: PQSupport -> GroupInfoKeys -> MemberId -> Profile -> CM ByteString @@ -2494,6 +2539,14 @@ encodeXMemberConnInfo pqSup (GIK gInfo@GroupInfo {membership = GroupMember {memb signing = MsgSigning CBGroup bindingData KRMember memberPrivKey' in encodeSignedConnInfo pqSup signing xMemberEvt +encodeXGrpAcpt :: User -> GroupInfoKeys -> VersionRangeChat -> CM ByteString +encodeXGrpAcpt user g@(GIK gInfo@GroupInfo {membership = GroupMember {memberId}} gks) peerVRange = do + let incognitoProfile = incognitoMembershipProfile gInfo + profile <- presentUserBadge user incognitoProfile (groupPresHeader gInfo) (userProfileInGroup user gInfo $ fromLocalProfile <$> incognitoProfile) + let msg = XGrpAcpt memberId (Just $ groupMemberKey gks) (Just profile) + signing_ = if maxVersion peerVRange >= relayWebCapVersion then groupMsgSigning False g msg else Nothing + encodeConnInfoSigning PQSupportOff signing_ msg + deliverMessage :: Connection -> CMEventTag e -> MsgBody -> MessageId -> CM (Int64, PQEncryption) deliverMessage conn cmEventTag msgBody msgId = do let msgFlags = MsgFlags {notification = hasNotification cmEventTag} @@ -2673,7 +2726,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 (groupPresHeader 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 @@ -3047,13 +3100,11 @@ prepareAgentCreation user cmdFunction enableNtfs cMode = do connId <- withAgent $ \a -> prepareConnectionToCreate a (aUserId user) enableNtfs cMode PQSupportOff pure (cmdId, connId) -prepareAgentJoin :: User -> Maybe Connection -> Bool -> ConnectionRequestUri c -> CM (CommandId, ConnId) -prepareAgentJoin user conn_ enableNtfs cReqUri = do - cmdId <- withStore' $ \db -> createCommand db user (dbConnId <$> conn_) CFJoinConn - connId <- case conn_ of - Just conn -> pure $ aConnId conn - Nothing -> fst <$> withAgent (\a -> prepareConnectionToJoin a (aUserId user) enableNtfs cReqUri PQSupportOff) - pure (cmdId, connId) +prepareAgentJoin :: User -> Bool -> ConnectionRequestUri c -> CM ((CommandId, ConnId), ProofPresHeader) +prepareAgentJoin user enableNtfs cReqUri = do + cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn + (connId, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) enableNtfs cReqUri PQSupportOff + pure ((cmdId, connId), directPresHeader binding) joinAgentConnectionAsync :: CommandId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM () joinAgentConnectionAsync cmdId updateConn connId enableNtfs cReqUri cInfo subMode = @@ -3064,9 +3115,7 @@ allowAgentConnectionAsync user conn@Connection {pqSupport} confId gInfo_ msg = d let signing_ = case gInfo_ of Just gInfo@(GIK g _) | useRelays' g || maxVersion (peerChatVRange conn) >= relayWebCapVersion -> groupMsgSigning False gInfo msg _ -> Nothing - dm <- case signing_ of - Just signing -> encodeSignedConnInfo pqSupport signing msg - Nothing -> encodeConnInfoPQ pqSupport msg + dm <- encodeConnInfoSigning pqSupport signing_ msg allowAgentConnectionInfo user conn confId dm allowAgentConnectionInfo :: User -> Connection -> ConfirmationId -> ByteString -> CM () @@ -3075,11 +3124,11 @@ allowAgentConnectionInfo user conn@Connection {connId} confId dm = do withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm withStore' $ \db -> updateConnectionStatus db conn ConnAccepted -prepareAgentAccept :: User -> Bool -> InvitationId -> PQSupport -> CM (CommandId, ConnId) +prepareAgentAccept :: User -> Bool -> InvitationId -> PQSupport -> CM ((CommandId, ConnId), ProofPresHeader) prepareAgentAccept user enableNtfs invId pqSup = do cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact - (connId, _) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) enableNtfs invId pqSup - pure (cmdId, connId) + (connId, binding) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) enableNtfs invId pqSup + pure ((cmdId, connId), directPresHeader binding) agentAcceptContactAsync :: MsgEncodingI e => CommandId -> ConnId -> Bool -> InvitationId -> ChatMsgEvent e -> PQSupport -> SubscriptionMode -> CM () agentAcceptContactAsync cmdId connId enableNtfs invId msg pqSup subMode = do diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 4ff32429b9..3631331f75 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -46,7 +46,7 @@ import Data.Time.Format (defaultTimeLocale, formatTime) import qualified Data.UUID as UUID import qualified Data.UUID.V4 as V4 import Data.Word (Word32) -import Simplex.Chat.Badges (BadgeProof, BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), ProofPresHeader (..)) +import Simplex.Chat.Badges (BadgeProof (..), BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), ProofPresHeader (..), acceptedBadge, localBadgeStatus, sameBadgeProof, unboundProof) import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Delivery @@ -116,10 +116,21 @@ smallGroupsRcptsMemLimit = 20 -- Verifies member signatures over CBGroup <> (publicGroupId, memberId) or (memberId, pubKey) <> signedBody under the given key. -- signatures is NonEmpty so the verification can't be vacuously true. verifyGroupSig :: C.PublicKeyEd25519 -> GroupInfo -> MemberId -> NonEmpty MsgSignature -> ByteString -> Bool -verifyGroupSig key gInfo memberId signatures signedBody = - let prefix = encodeChatBinding CBGroup $ groupBindingData gInfo memberId key +verifyGroupSig key gInfo memberId = verifyMemberSig key (groupBindingData gInfo memberId key) + +verifyMemberSig :: C.PublicKeyEd25519 -> ByteString -> NonEmpty MsgSignature -> ByteString -> Bool +verifyMemberSig key bindingData signatures signedBody = + let prefix = encodeChatBinding CBGroup bindingData in all (\case (MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 key) sig (prefix <> signedBody)) signatures +relayInvPresHeader :: Maybe SignedMsg -> GroupRelayInvitation -> Maybe ProofPresHeader +relayInvPresHeader signedMsg_ GroupRelayInvitation {fromMember = MemberIdRole {memberId}, publicGroupId, fromMemberKey} = do + gId <- publicGroupId + MemberKey k <- fromMemberKey + SignedMsg {chatBinding = CBGroup, signatures, signedBody} <- signedMsg_ + guard $ verifyMemberSig k (smpEncode (gId, memberId)) signatures signedBody + pure $ memberKeyPresHeader (Just gId) memberId k + processAgentMessage :: ACorrId -> ConnId -> AEvent 'AEConn -> CM () processAgentMessage _ _ (DEL_RCVQS delQs) = toView $ CEvtAgentRcvQueuesDeleted $ L.map rcvQ delQs @@ -141,13 +152,13 @@ processAgentMessage corrId connId msg = do Just (user, entity, gks_) -> processAgentMessageConn cxt user entity gks_ corrId connId msg `catchAllErrors` eToView _ -> throwChatError $ CENoConnectionUser (AgentConnId connId) where - getUserEntity :: StoreCxt -> DB.Connection -> ExceptT StoreError IO (Maybe (User, ConnectionEntity, Maybe GroupKeys)) + getUserEntity :: StoreCxt -> DB.Connection -> ExceptT StoreError IO (Maybe (User, ConnectionEntity, Maybe GroupInfoKeys)) getUserEntity cxt db = liftIO (getUserByAConnId db $ AgentConnId connId) >>= mapM (\user -> do (entity, groupKeysData_) <- getConnectionEntityKeys db cxt user (AgentConnId connId) gks_ <- case entity of - RcvGroupMsgConnection _ gInfo _ -> mapM (mkGroupKeys db cxt gInfo) groupKeysData_ + RcvGroupMsgConnection _ gInfo _ -> mapM (mkGroupInfoKeys db cxt gInfo) groupKeysData_ _ -> pure Nothing (user,,gks_) <$> liftIO (updateConnStatus db entity)) @@ -436,7 +447,7 @@ processAgentMsgRcvFile _corrId aFileId msg = do type ShouldDeleteGroupConns = Bool -processAgentMessageConn :: StoreCxt -> User -> ConnectionEntity -> Maybe GroupKeys -> ACorrId -> ConnId -> AEvent 'AEConn -> CM () +processAgentMessageConn :: StoreCxt -> User -> ConnectionEntity -> Maybe GroupInfoKeys -> ACorrId -> ConnId -> AEvent 'AEConn -> CM () processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId agentMessage = case agentMessage of END -> case entity of @@ -446,8 +457,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag _ -> case entity of RcvDirectMsgConnection conn contact_ -> processDirectMessage agentMessage entity conn contact_ - RcvGroupMsgConnection conn gInfo m -> case gks_ of - Just gks -> processGroupMessage agentMessage entity conn (GIK gInfo gks) m + RcvGroupMsgConnection conn _ m -> case gks_ of + Just gks -> processGroupMessage agentMessage entity conn gks m Nothing -> throwChatError $ CEInternalError "group connection entity without group keys" UserContactConnection conn uc -> processContactConnMessage agentMessage entity conn uc @@ -501,10 +512,9 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag -- [incognito] send saved profile (conn'', gInfo_) <- saveConnInfo conn' connInfo incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) - profileToSend <- - presentUserBadge user incognitoProfile $ case gInfo_ of - Just (GIK gInfo _) -> userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) - Nothing -> userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True + profileToSend <- case gInfo_ of + Just (GIK gInfo _) -> presentUserBadge user incognitoProfile (groupPresHeader gInfo) $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) + Nothing -> presentUserBadgeWith user incognitoProfile (connPresHeader conn'') $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True -- [async agent commands] no continuation needed, but command should be asynchronous for stability allowAgentConnectionAsync user conn'' confId gInfo_ $ XInfo profileToSend ((\(GIK _ gks) -> groupMemberKey gks) <$> gInfo_) INFO pqSupport connInfo -> do @@ -621,7 +631,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 <- presentUserBadgeWith user incognitoProfile (connPresHeader conn'') $ 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 +644,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 (groupPresHeader 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,17 +788,21 @@ 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 -> case chatMsgEvent of - XGrpAcpt memId mKey + XGrpAcpt memId mKey memProfile_ | sameMemberId memId m -> do withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted - forM_ mKey $ \(MemberKey k) -> withStore' $ \db -> setMemberPubKey db (groupMemberId' m) k + m' <- case mKey of + Just (MemberKey k) -> m {memberPubKey = Just k} <$ withStore' (\db -> setMemberPubKey db (groupMemberId' m) k) + Nothing -> pure m + membershipProfile <- membershipHandshakeProfile user gInfo -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId (Just g) XOk + allowAgentConnectionAsync user conn' confId (Just g) $ XGrpMemInfo (memberId' membership) membershipProfile + forM_ memProfile_ $ \memProfile -> processMemberProfileUpdate gInfo m' signedMsg_ memProfile Nothing | otherwise -> messageError "x.grp.acpt: memberId is different from expected" XGrpRelayAcpt relayLink relayCap | memberRole' membership == GROwner && isRelay m -> do @@ -823,7 +837,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 (groupPresHeader 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,31 +848,32 @@ 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 + membershipProfile <- membershipHandshakeProfile user gInfo -- [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 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 signedMsg_ memProfile Nothing | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" -- sent when connecting via group link - XInfo _ mKey + XInfo memProfile mKey -- TODO Keep rejected member to allow them to appeal against rejection. | memberStatus m == GSMemRejected -> do deleteMemberConnection' m True withStore' $ \db -> deleteGroupMember db user m - | otherwise -> mapM_ (storeMemberKey gInfo m signedMsg_) mKey + | otherwise -> do + m' <- maybe (pure m) (storeMemberKey gInfo m signedMsg_) mKey + void $ processMemberProfileUpdate gInfo m' signedMsg_ memProfile Nothing XOk -> -- transient relay-reject row cleanup after the rejection handshake completes when (memberCategory m == GCHostMember && not (relayServesGroup gInfo)) $ do @@ -967,7 +982,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 (groupPresHeader 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 @@ -1092,7 +1107,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 @@ -1249,11 +1264,11 @@ 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 (groupPresHeader gInfo) $ userProfileInGroup user gInfo incognitoProfile dm <- encodeXMemberConnInfo pqSup g relayMemberId profileToSend subMode <- chatReadVar subscriptionMode - (cmdId, connId') <- prepareAgentJoin user (Just conn) True cReq - joinAgentConnectionAsync cmdId True connId' True cReq dm subMode + cmdId <- withStore' $ \db -> createCommand db user (Just $ dbConnId conn) CFJoinConn + joinAgentConnectionAsync cmdId True (aConnId conn) True cReq dm subMode CFGetRelayDataAccept -> do let GroupMember {memberId = MemberId expectedMemberId} = m if linkEntityId == Just expectedMemberId @@ -1393,13 +1408,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag processContactConnMessage :: AEvent e -> ConnectionEntity -> Connection -> UserContact -> CM () processContactConnMessage agentMsg connEntity conn UserContact {userContactLinkId = uclId, groupId = ucGroupId_} = case agentMsg of - REQ invId pqSupport _ connInfo _ rejectionSupported -> do + REQ invId pqSupport _ connInfo binding rejectionSupported -> do (signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo + let reqHeader = directPresHeader binding case chatMsgEvent of - XContact p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ pqSupport rejectionSupported + XContact p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange reqHeader p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ pqSupport rejectionSupported XMember p joiningMemberId joiningMemberKey viaRelay -> memberJoinRequestViaRelay invId chatVRange signedMsg_ p joiningMemberId joiningMemberKey viaRelay - XInfo p _ -> profileContactRequest invId chatVRange p Nothing Nothing Nothing Nothing pqSupport rejectionSupported - XGrpRelayInv groupRelayInv -> xGrpRelayInv invId chatVRange groupRelayInv + XInfo p _ -> profileContactRequest invId chatVRange reqHeader p Nothing Nothing Nothing Nothing pqSupport rejectionSupported + XGrpRelayInv groupRelayInv -> xGrpRelayInv invId chatVRange signedMsg_ groupRelayInv XGrpRelayTest challenge _ -> xGrpRelayTest invId chatVRange challenge -- TODO show/log error, other events in contact request _ -> pure () @@ -1472,8 +1488,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag -- TODO add debugging output _ -> pure () where - profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe MemberKey -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> Bool -> CM () - profileContactRequest invId chatVRange p@Profile {displayName} memberKey_ xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported = do + profileContactRequest :: InvitationId -> VersionRangeChat -> ProofPresHeader -> Profile -> Maybe MemberKey -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> Bool -> CM () + profileContactRequest invId chatVRange reqHeader p@Profile {displayName} memberKey_ xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported = do (ucl, gLinkInfo_) <- withStore $ \db -> getUserContactLinkById db userId uclId let v = maxVersion chatVRange case gLinkInfo_ of @@ -1483,7 +1499,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag AddressSettings {autoAccept} = addressSettings isSimplexTeam = sameConnReqContact connReq adminContactReq gVar <- asks random - withStore (\db -> createOrUpdateContactRequest db gVar cxt user uclId ucl isSimplexTeam invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported) >>= \case + withStore (\db -> createOrUpdateContactRequest db gVar cxt user uclId ucl isSimplexTeam invId chatVRange (Just reqHeader) p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported) >>= \case RSAcceptedRequest _ucr re -> case re of REContact ct -> -- TODO [short links] update request msg @@ -1626,7 +1642,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag maybe (pure $ Right (GAAccepted, gLinkMemRole)) (\am -> liftIO $ am gInfo gli p) acceptMember_ >>= \case Right (acceptance, useRole) -> do let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo - mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode memberKey_ Nothing + mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p (Just reqHeader) xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode memberKey_ Nothing (gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem' @@ -1636,16 +1652,21 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag | otherwise -> do mem <- acceptGroupJoinSendRejectAsync user uclId gInfo invId chatVRange p xContactId_ rjctReason toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason - xGrpRelayInv :: InvitationId -> VersionRangeChat -> GroupRelayInvitation -> CM () - xGrpRelayInv invId chatVRange groupRelayInv@GroupRelayInvitation {groupLink} = do - rejected <- withStore' $ \db -> isRelayGroupRejected db user groupLink - initialDelay <- asks $ initialInterval . relayRequestRetryInterval . config - if rejected - then rejectRelayInvitationAsync user uclId cxt groupRelayInv invId chatVRange initialDelay RRRRejoinRejected - else do - (_gInfo, _ownerMember) <- withStore $ \db -> - createRelayRequestGroup db cxt user groupRelayInv invId chatVRange initialDelay GSMemAccepted RSInvited - lift $ void $ getRelayRequestWorker True + xGrpRelayInv :: InvitationId -> VersionRangeChat -> Maybe SignedMsg -> GroupRelayInvitation -> CM () + xGrpRelayInv invId chatVRange signedMsg_ groupRelayInv@GroupRelayInvitation {groupLink} + | maxVersion chatVRange >= signedRelayInvVersion && isNothing presHeader_ = + messageError "x.grp.relay.inv: invitation is not signed by the owner" + | otherwise = do + rejected <- withStore' $ \db -> isRelayGroupRejected db user groupLink + initialDelay <- asks $ initialInterval . relayRequestRetryInterval . config + if rejected + then rejectRelayInvitationAsync user uclId cxt groupRelayInv presHeader_ invId chatVRange initialDelay RRRRejoinRejected + else do + (_gInfo, _ownerMember) <- withStore $ \db -> + createRelayRequestGroup db cxt user groupRelayInv presHeader_ invId chatVRange initialDelay GSMemAccepted RSInvited + lift $ void $ getRelayRequestWorker True + where + presHeader_ = relayInvPresHeader signedMsg_ groupRelayInv xGrpRelayTest :: InvitationId -> VersionRangeChat -> ByteString -> CM () xGrpRelayTest invId chatVRange challenge | isTrue userChatRelay && isNothing ucGroupId_ = @@ -1656,7 +1677,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag msg = XGrpRelayTest challenge (Just sig) subMode <- chatReadVar subscriptionMode let chatV = vr cxt `peerConnChatVersion` chatVRange - (cmdId, acId) <- prepareAgentAccept user True invId PQSupportOff + ((cmdId, acId), _) <- prepareAgentAccept user True invId PQSupportOff withStore $ \db -> do Connection {connId = testCId} <- createRelayTestConnection db cxt user acId ConnAccepted chatV subMode liftIO $ setCommandConnId db user cmdId testCId @@ -1672,27 +1693,27 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag Just GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do g@(GIK gInfo _) <- withStore $ \db -> getGroupInfoKeys db cxt user groupId existing_ <- withStore' $ \db -> eitherToMaybe <$> runExceptT (getGroupMemberByMemberId db cxt user gInfo joiningMemberId) + let signed = memberSigned gInfo joiningMemberId joiningKey signedMsg_ case existing_ of Just rosterMem -- a privileged memberId's key is owner-authoritative (the roster); the joiner must prove -- possession of that exact key, otherwise this is an attempt to impersonate it | isRosterRole (memberRole' rosterMem) -> - if verifyKey gInfo rosterMem - then acceptJoin g (Just rosterMem) (memberRole' rosterMem) + if verifyKey gInfo rosterMem signed + then acceptJoin g signed (Just rosterMem) (memberRole' rosterMem) else messageError "memberJoinRequestViaRelay: rejected join claiming privileged memberId (key mismatch or invalid signature)" - _ -> acceptJoin g Nothing gLinkMemRole + _ -> acceptJoin g signed Nothing gLinkMemRole Nothing -> messageError "memberJoinRequestViaRelay: no group link info for relay link" where -- replay defense: the viaRelay == own memberId check (viaRelay is in the signed body); without it a sibling relay could replay a privileged member's signed join - verifyKey gInfo rosterMem = case signedMsg_ of - Just SignedMsg {chatBinding = CBGroup, signatures, signedBody} -> - memberPubKey rosterMem == Just joiningKey - && verifyGroupSig joiningKey gInfo joiningMemberId signatures signedBody - && viaRelay == Just (memberId' (membership gInfo)) - _ -> False - acceptJoin g@(GIK gInfo _) existingMem_ acceptRole = do - mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p Nothing (Just joiningMemberId) Nothing GAAccepted acceptRole Nothing (Just joiningMemberKey) existingMem_ + verifyKey gInfo rosterMem signed = + memberPubKey rosterMem == Just joiningKey + && signed + && viaRelay == Just (memberId' (membership gInfo)) + acceptJoin g@(GIK gInfo _) signed existingMem_ acceptRole = do + let presHeader_ = memberPresHeader gInfo joiningMemberId $ if signed then Just joiningKey else Nothing + mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p presHeader_ Nothing (Just joiningMemberId) Nothing GAAccepted acceptRole Nothing (Just joiningMemberKey) existingMem_ (gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem' @@ -2689,13 +2710,13 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag memberKeys <- atomically . C.generateKeyPair =<< asks random (GIK gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership} gks, hostId) <- withStore $ \db -> createGroupInvitation db cxt user ct inv customUserProfileId memberKeys void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart) - let GroupMember {groupMemberId, memberId = membershipMemId} = membership + let GroupMember {groupMemberId} = membership -- hostContact is only reported for group links, where the client replaces -- the transient host connection view with the group and removes its chat joinGroupAsync hostContact_ sameLink = do subMode <- chatReadVar subscriptionMode - dm <- encodeConnInfo $ XGrpAcpt membershipMemId (Just $ groupMemberKey gks) - connIds@(cmdId, acId) <- prepareAgentJoin user Nothing True connRequest + dm <- encodeXGrpAcpt user (GIK gInfo gks) peerChatVRange + (connIds@(cmdId, acId), _) <- prepareAgentJoin user True connRequest withStore' $ \db -> do when sameLink $ setViaGroupLinkUri db groupId connId createMemberConnectionAsync db user hostId connIds connChatVersion peerChatVRange subMode @@ -2756,25 +2777,28 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag brokerTs = metaBrokerTs msgMeta processContactProfileUpdate :: Contact -> Profile -> Bool -> CM Contact - processContactProfileUpdate c@Contact {profile = lp} p' createItems + processContactProfileUpdate c@Contact {profile = lp} p'@Profile {badge = rcvBadge} createItems = do + presHeader_ <- if any (not . unboundProof) rcvBadge then pure (contactConn c) $>>= connPresHeader else pure Nothing + let p'' = p' {badge = acceptedBadge presHeader_ storedBadge rcvBadge} + contentChanged = not (sameProfileContent p p'') -- 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 lp = do - c' <- withStore $ \db -> - if userTTL == rcvTTL - then updateContactProfile db cxt user c p' - else do - c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs' - updateContactProfile db cxt user c' p' - when (contentChanged && directOrUsed c' && createItems) $ do - createProfileUpdatedItem c' - lift $ createRcvFeatureItems user c c' - toView $ CEvtContactUpdated user c c' - pure c' - | otherwise = - pure c + if + | contentChanged || badgeNeedsReverify lp -> do + c' <- withStore $ \db -> + if userTTL == rcvTTL + then updateContactProfile db cxt user c presHeader_ p' + else do + c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs' + updateContactProfile db cxt user c' presHeader_ p' + when (contentChanged && directOrUsed c' && createItems) $ do + createProfileUpdatedItem c' p'' + lift $ createRcvFeatureItems user c c' + toView $ CEvtContactUpdated user c c' + pure c' + | otherwise -> + pure c where - contentChanged = not (sameProfileContent p p') - p = fromLocalProfile lp + p@Profile {badge = storedBadge} = fromLocalProfile lp Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs Profile {preferences = rcvPrefs_} = p' @@ -2788,20 +2812,20 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag | rcvTTL /= userDefaultTTL -> Just (userDefault :: TimedMessagesPreference) {ttl = rcvTTL} | otherwise -> Nothing in setPreference_ SCFTimedMessages ctUserTMPref' ctUserPrefs - createProfileUpdatedItem c' = + createProfileUpdatedItem c' p'' = when visibleProfileUpdated $ do - let ciContent = CIRcvDirectEvent $ RDEProfileUpdated p p' + let ciContent = CIRcvDirectEvent $ RDEProfileUpdated p p'' createInternalChatItem user (CDDirectRcv c') ciContent Nothing where visibleProfileUpdated = n' /= n || fn' /= fn || sd /= sd' || i' /= i || cl' /= cl Profile {displayName = n, fullName = fn, shortDescr = sd, image = i, contactLink = cl} = p - Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p' + 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)) + m' <- maybe (pure m) (storeMemberKey gInfo m signedMsg_) mKey + void $ processMemberProfileUpdate gInfo m' signedMsg_ p' (Just (msg, brokerTs)) pure $ memberEventDeliveryScope m xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> Maybe MemberKey -> RcvMessage -> CM () @@ -2809,23 +2833,30 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag 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 + m' <- maybe (pure m) (storeMemberKey gInfo m signedMsg_) mKey + m'' <- processMemberProfileUpdate gInfo m' signedMsg_ p' Nothing withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True let connectedIncognito = memberIncognito membership - probeMatchingMemberContact m' connectedIncognito + probeMatchingMemberContact m'' connectedIncognito else messageError "x.grp.link.mem error: invalid group link host profile update" - storeMemberKey :: GroupInfo -> GroupMember -> Maybe SignedMsg -> MemberKey -> CM () - 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" + storeMemberKey :: GroupInfo -> GroupMember -> Maybe SignedMsg -> MemberKey -> CM GroupMember + storeMemberKey gInfo m@GroupMember {groupMemberId, memberPubKey, memberId} signedMsg_ (MemberKey k) = case memberPubKey of + Just k0 -> m <$ 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" + | signed -> m {memberPubKey = Just k} <$ withStore' (\db -> setMemberPubKey db groupMemberId k) + | otherwise -> m <$ 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 + signed = memberSigned gInfo memberId k signedMsg_ + + 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 + + signedMemberPresHeader :: GroupInfo -> GroupMember -> Maybe SignedMsg -> Maybe ProofPresHeader + signedMemberPresHeader gInfo GroupMember {memberId, memberPubKey} signedMsg_ = + memberPresHeader gInfo memberId $ mfilter (\k -> memberSigned gInfo memberId k signedMsg_) memberPubKey xGrpLinkAcpt :: GroupInfoKeys -> GroupMember -> GroupAcceptance -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM () xGrpLinkAcpt g@(GIK gInfo@GroupInfo {membership} _) m acceptance role memberId msg brokerTs @@ -2886,15 +2917,15 @@ 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 SignedMsg -> Profile -> Maybe (RcvMessage, UTCTime) -> CM GroupMember + processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId, memberBadgeProof = NoJSON storedMemberProof} signedMsg_ rcvProfile@Profile {badge = rcvBadge} 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 + | contentChanged || badgeNeedsReverify p || memberProofChanged = do when contentChanged $ updateBusinessChatProfile gInfo case memberContactId of Nothing -> do - m' <- withStore $ \db -> updateMemberProfile db cxt user m p'' - unless (muteEventInChannel gInfo m') $ do + m' <- withStore $ \db -> updateMemberProfile db cxt user m presHeader_ (redactedMemberProfile gInfo m rcvProfile) + unless (muteEventInChannel gInfo m' || noVisibleChange m') $ do when contentChanged $ forM_ msgTs_ $ createProfileUpdatedItem m' toView $ CEvtGroupMemberUpdated user gInfo m m' pure m' @@ -2902,16 +2933,22 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag mCt <- withStore $ \db -> getContact db cxt user mContactId if contactUpdatableFromMember mCt then do - (m', ct') <- withStore $ \db -> updateContactMemberProfile db cxt user m mCt p' - unless (muteEventInChannel gInfo m') $ do + (m', ct') <- withStore $ \db -> updateContactMemberProfile db cxt user m mCt presHeader_ rcvProfile + unless (muteEventInChannel gInfo m' || noVisibleChange m') $ do when contentChanged $ forM_ msgTs_ $ createProfileUpdatedItem m' toView $ CEvtGroupMemberUpdated user gInfo m m' toView $ CEvtContactUpdated user mCt ct' pure m' - else pure m + else withStore' $ \db -> setMemberBadgeProof db cxt m presHeader_ rcvProfile | otherwise = pure m where + noVisibleChange m' = not contentChanged && memberBadgeStatus m' == memberBadgeStatus m + memberBadgeStatus GroupMember {memberProfile = LocalProfile {localBadge}} = localBadgeStatus <$> localBadge + presHeader_ = signedMemberPresHeader gInfo m signedMsg_ + p' = rcvProfile {badge = acceptedBadge presHeader_ storedProof rcvBadge} + memberProofChanged = not $ sameBadgeProof (acceptedBadge presHeader_ storedMemberProof rcvBadge) storedMemberProof + Profile {badge = storedProof} = fromLocalProfile p p'' = redactedMemberProfile gInfo m p' contentChanged = not (sameProfileContent (redactedMemberProfile gInfo m (fromLocalProfile p)) p'') updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of @@ -3165,8 +3202,9 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo conn' <- updatePeerChatVRange activeConn chatVRange case chatMsgEvent of - XInfo p _ -> do - ct <- withStore $ \db -> createDirectContact db cxt user conn' p + XInfo p@Profile {badge} _ -> do + presHeader_ <- if any (not . unboundProof) badge then connPresHeader conn' else pure Nothing + ct <- withStore $ \db -> createDirectContact db cxt user conn' presHeader_ p toView $ CEvtContactConnecting user ct pure (conn', Nothing) XGrpLinkInv glInv -> do @@ -3190,6 +3228,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 presHeader_ = memberInfoPresHeader gInfo memInfo if sameMemberId memId (membership gInfo) then pure Nothing else @@ -3206,7 +3245,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 (memberPresHeader gInfo memId (memberPubKey unknownMember)) 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 @@ -3217,7 +3256,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 presHeader_ initialStatus gInfo' <- if memberPending updatedMember then liftIO $ increaseGroupMembersRequireAttention db user gInfo @@ -3235,7 +3274,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 presHeader_ GCPostMember initialStatus gInfo' <- if memberPending newMember then liftIO $ increaseGroupMembersRequireAttention db user gInfo @@ -3276,7 +3315,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag 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 (memberPresHeader gInfo memId (memberPubKey existingMember)) toView $ CEvtGroupMemberUpdated user gInfo existingMember updatedMember | otherwise -> messageError "x.grp.mem.intro ignored: member already exists" @@ -3289,7 +3328,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' (memberInfoPresHeader gInfo memInfo') memRestrictions | otherwise -> do when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c) case memChatVRange of @@ -3299,7 +3338,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 (memberInfoPresHeader gInfo memInfo) 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" @@ -3320,8 +3359,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} = do + xGrpMemFwd :: GroupInfoKeys -> GroupMember -> MemberInfo -> IntroInvitation -> CM () + xGrpMemFwd g@(GIK gInfo@GroupInfo {membership, chatSettings} _) m memInfo@(MemberInfo memId memRole memChatVRange _ _) IntroInvitation {groupConnReq} = do let GroupMember {memberId = membershipMemId} = membership checkHostRole m memRole toMember <- withStore $ \db -> do @@ -3332,7 +3371,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 (memberInfoPresHeader gInfo memInfo) GCPostMember GSMemAnnounced e -> throwError e -- TODO [knocking] separate pending statuses from GroupMemberStatus? -- TODO add GSMemIntroInvitedPending, GSMemConnectedPending, etc.? @@ -3341,14 +3380,16 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag liftIO $ updateGroupMemberStatus db userId toMember newMemberStatus pure toMember subMode <- chatReadVar subscriptionMode - -- [incognito] send membership incognito profile - membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership - dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile - -- [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 let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange chatV = vr cxt `peerConnChatVersion` mcvr + -- [incognito] send membership incognito profile + membershipProfile <- membershipHandshakeProfile user gInfo + let msg = XGrpMemInfo membershipMemId membershipProfile + signing_ = if chatV >= relayWebCapVersion then groupMsgSigning False g msg else Nothing + dm <- encodeConnInfoSigning PQSupportOff signing_ msg + -- [async agent commands] no continuation needed, but commands should be asynchronous for stability + let enableNtfsGrp = chatHasNtfs chatSettings + (groupConnIds@(gCmdId, gAcId), _) <- prepareAgentJoin user enableNtfsGrp groupConnReq withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds subMode joinAgentConnectionAsync gCmdId False gAcId enableNtfsGrp groupConnReq dm subMode @@ -3874,12 +3915,12 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag } joinExistingContact subMode mCt@Contact {contactId = mContactId} | autoAcceptMemberContacts user = do - (cmdId, acId) <- prepareAgentJoin user Nothing True connReq + ((cmdId, acId), presHeader) <- prepareAgentJoin user True connReq mCt' <- withStore $ \db -> do updateMemberContactInvited db user mCt groupDirectInv void $ liftIO $ createMemberContactConn db user acId (Just cmdId) g mConn ConnJoined mContactId subMode getContact db cxt user mContactId - joinMemberContactAsync cmdId acId subMode + joinMemberContactAsync cmdId acId presHeader subMode securityCodeChanged mCt' createItems mCt' m | otherwise = do @@ -3893,14 +3934,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag createItems mCt' m createNewContact subMode | autoAcceptMemberContacts user = do - (cmdId, acId) <- prepareAgentJoin user Nothing True connReq + ((cmdId, acId), presHeader) <- prepareAgentJoin user True connReq -- [incognito] reuse membership incognito profile (mCt, m') <- withStore $ \db -> do (mContactId, m') <- liftIO $ createMemberContactInvited db user g m groupDirectInv void $ liftIO $ createMemberContactConn db user acId (Just cmdId) g mConn ConnJoined mContactId subMode mCt <- getContact db cxt user mContactId pure (mCt, m') - joinMemberContactAsync cmdId acId subMode + joinMemberContactAsync cmdId acId presHeader subMode createInternalChatItem user (CDDirectSnd mCt) CIChatBanner (Just epochStart) createItems mCt m' | otherwise = do @@ -3913,9 +3954,9 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag createInternalChatItem user (CDDirectSnd mCt) CIChatBanner (Just epochStart) createInternalChatItem user (CDDirectRcv mCt) (CIRcvDirectEvent $ RDEGroupInvLinkReceived gp) Nothing createItems mCt m' - joinMemberContactAsync cmdId acId subMode = do + joinMemberContactAsync cmdId acId presHeader subMode = do -- [incognito] send membership incognito profile - p <- presentUserBadge user (incognitoMembershipProfile g) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing True + p <- presentUserBadge user (incognitoMembershipProfile g) (Just presHeader) $ 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 @@ -4494,22 +4535,23 @@ runRelayRequestWorker a Worker {doWork} = do eToView e processRelayRequest :: GroupId -> RelayRequestData -> CM () processRelayRequest groupId rrd = do - (g@(GIK gInfo _), groupLink_) <- withStore $ \db -> do + (g@(GIK gInfo _), groupLink_, ownerMember) <- withStore $ \db -> do g@(GIK gInfo _) <- getGroupInfoKeys db cxt user groupId groupLink_ <- liftIO $ runExceptT $ getGroupLink db user gInfo - pure (g, groupLink_) + ownerMember <- getHostMember db cxt user groupId + pure (g, groupLink_, ownerMember) -- Check if relay link already exists (recovery case) case groupLink_ of Right GroupLink {connLinkContact = CCLink _ sLnk_} -> case sLnk_ of - Just sLnk -> acceptOwnerConnection rrd gInfo sLnk + Just sLnk -> acceptOwnerConnection rrd gInfo ownerMember sLnk Nothing -> throwChatError $ CEException "processRelayRequest: relay link doesn't have short link" Left _ -> do - (gInfo', sLnk) <- getLinkDataCreateRelayLink rrd g - acceptOwnerConnection rrd gInfo' sLnk + (gInfo', sLnk) <- getLinkDataCreateRelayLink rrd g ownerMember + acceptOwnerConnection rrd gInfo' ownerMember sLnk where - getLinkDataCreateRelayLink :: RelayRequestData -> GroupInfoKeys -> CM (GroupInfo, ShortLinkContact) - getLinkDataCreateRelayLink RelayRequestData {reqGroupLink} (GIK gInfo gks) = do + getLinkDataCreateRelayLink :: RelayRequestData -> GroupInfoKeys -> GroupMember -> CM (GroupInfo, ShortLinkContact) + getLinkDataCreateRelayLink RelayRequestData {reqGroupLink, reqPublicGroupId} (GIK gInfo gks) GroupMember {memberId = MemberId ownerMemberId, memberPubKey = claimedOwnerKey_} = do memberPrivKey' <- case gks of GKRelayRequest {memberPrivKey} -> pure memberPrivKey _ -> throwChatError $ CEException "getLinkDataCreateRelayLink: group is not a relay request" @@ -4519,8 +4561,10 @@ runRelayRequestWorker a Worker {doWork} = do Just GroupShortLinkData {groupProfile = gp@GroupProfile {publicGroup}} -> do pg <- case (linkEntityId, publicGroup) of (Just entityId, Just pg@PublicGroupProfile {publicGroupId}) - | B64UrlByteString entityId == publicGroupId -> pure pg - _ -> throwChatError $ CEException "getLinkDataCreateRelayLink: linkEntityId does not match profile publicGroupId" + | B64UrlByteString entityId == publicGroupId && all (== publicGroupId) reqPublicGroupId -> pure pg + _ -> throwChatError $ CEException "getLinkDataCreateRelayLink: linkEntityId does not match publicGroupId of profile or invitation" + unless (all (\k -> any (\OwnerAuth {ownerId, ownerKey} -> ownerId == ownerMemberId && ownerKey == k) owners) claimedOwnerKey_) $ + throwChatError $ CEException "getLinkDataCreateRelayLink: owner key of invitation does not match link data" validateGroupProfile gp sLnk <- createRelayLink gInfo (C.publicKey memberPrivKey', memberPrivKey') gInfo' <- withStore $ \db -> do @@ -4542,7 +4586,7 @@ runRelayRequestWorker a Worker {doWork} = do subMode <- chatReadVar subscriptionMode let crClientData = encodeJSON $ CRDataGroup groupLinkId -- prepare link with relayMemId as linkEntityId (no server request) - (ccLink, preparedParams) <- withAgent $ \a' -> prepareConnectionLink a' (aUserId user) sigKeys relayMemId True (Just crClientData) CR.IKPQOff False Nothing + (ccLink, preparedParams) <- withAgent $ \a' -> prepareConnectionLink a' (aUserId user) SCMContact sigKeys (Just relayMemId) True (Just crClientData) CR.IKPQOff False Nothing ccLink' <- setShortLinkType CCTGroup <$> shortenCreatedLink ccLink sLnk <- case connShortLink' ccLink' of Just sl -> pure sl @@ -4550,12 +4594,11 @@ runRelayRequestWorker a Worker {doWork} = do let userData = encodeShortLinkData $ RelayShortLinkData {relayProfile = fromLocalProfile p} userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} -- create connection with prepared link (single network call) - connId <- withAgent $ \a' -> createConnectionForLink a' NRMBackground (aUserId user) True ccLink preparedParams userLinkData subMode + (connId, _) <- withAgent $ \a' -> createConnectionForLink a' NRMBackground (aUserId user) True ccLink preparedParams userLinkData subMode -- TODO [relays] starting role should be communicated in protocol from owner to relays subRole <- asks $ channelSubscriberRole . config void $ withFastStore $ \db -> createGroupLink db gVar user gi connId ccLink' groupLinkId subRole subMode pure sLnk - acceptOwnerConnection :: RelayRequestData -> GroupInfo -> ShortLinkContact -> CM () - acceptOwnerConnection RelayRequestData {relayInvId, reqChatVRange} gi relayLink = do - ownerMember <- withStore $ \db -> getHostMember db cxt user groupId + acceptOwnerConnection :: RelayRequestData -> GroupInfo -> GroupMember -> ShortLinkContact -> CM () + acceptOwnerConnection RelayRequestData {relayInvId, reqChatVRange} gi ownerMember relayLink = void $ acceptRelayJoinRequestAsync user uclId gi ownerMember relayInvId reqChatVRange relayLink diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 01cb868e83..aad0254b52 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -92,7 +92,7 @@ import Simplex.Messaging.Version hiding (version) -- This indirection is needed for backward/forward compatibility testing. -- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code. currentChatVersion :: VersionChat -currentChatVersion = VersionChat 21 +currentChatVersion = VersionChat 22 -- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above) supportedChatVRange :: VersionRangeChat @@ -143,6 +143,9 @@ groupMemberKeyVersion = VersionChat 20 anyTextCommandsVersion :: VersionChat anyTextCommandsVersion = VersionChat 21 +signedRelayInvVersion :: VersionChat +signedRelayInvVersion = VersionChat 22 + data ConnectionEntity = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact} | RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember} @@ -468,7 +471,7 @@ data ChatMsgEvent (e :: MsgEncoding) where XMember :: {profile :: Profile, newMemberId :: MemberId, newMemberKey :: MemberKey, viaRelay :: Maybe MemberId} -> ChatMsgEvent 'Json XDirectDel :: ChatMsgEvent 'Json XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json - XGrpAcpt :: MemberId -> Maybe MemberKey -> ChatMsgEvent 'Json + XGrpAcpt :: MemberId -> Maybe MemberKey -> Maybe Profile -> ChatMsgEvent 'Json XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json XGrpLinkMem :: Profile -> Maybe MemberKey -> ChatMsgEvent 'Json @@ -1362,6 +1365,7 @@ requiresSignature = \case XGrpRoster_ -> True XInfo_ -> True XGrpLinkMem_ -> True + XGrpRelayInv_ -> True _ -> False -- | Content events a member may sign (XMsgNew opt-in; XMsgUpdate/XMsgDel when the target was signed). @@ -1441,7 +1445,7 @@ appJsonToCM fwdDepth AppMessageJson {v, msgId, event, params} = do XMember_ -> XMember <$> p "profile" <*> p "newMemberId" <*> p "newMemberKey" <*> opt "viaRelay" XDirectDel_ -> pure XDirectDel XGrpInv_ -> XGrpInv <$> p "groupInvitation" - XGrpAcpt_ -> XGrpAcpt <$> p "memberId" <*> opt "memberKey" + XGrpAcpt_ -> XGrpAcpt <$> p "memberId" <*> opt "memberKey" <*> opt "profile" XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation" XGrpLinkReject_ -> XGrpLinkReject <$> p "groupLinkRejection" XGrpLinkMem_ -> XGrpLinkMem <$> p "profile" <*> opt "memberKey" @@ -1518,7 +1522,7 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en XMember {profile, newMemberId, newMemberKey, viaRelay} -> o $ ("viaRelay" .=? viaRelay) ["profile" .= profile, "newMemberId" .= newMemberId, "newMemberKey" .= newMemberKey] XDirectDel -> JM.empty XGrpInv groupInv -> o ["groupInvitation" .= groupInv] - XGrpAcpt memId memberKey -> o $ ("memberKey" .=? memberKey) ["memberId" .= memId] + XGrpAcpt memId memberKey profile -> o $ ("profile" .=? profile) $ ("memberKey" .=? memberKey) ["memberId" .= memId] XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv] XGrpLinkReject groupLinkRjct -> o ["groupLinkRejection" .= groupLinkRjct] XGrpLinkMem profile memberKey -> o $ ("memberKey" .=? memberKey) ["profile" .= profile] diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 0867118cb6..0a58b1cfd9 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -31,7 +31,7 @@ import Data.Bitraversable (bitraverse) import Data.Int (Int64) import Data.Maybe (fromMaybe) import Data.Time.Clock (UTCTime, getCurrentTime) -import Simplex.Chat.Badges (rowToBadge) +import Simplex.Chat.Badges (MaybeBadgeProofRow, maybeRowToBadgeProof, rowToBadge) import Simplex.Chat.Protocol import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Groups @@ -175,23 +175,25 @@ getConnectionEntityKeys db cxt user@User {userId, userContactId} agentConnId = d m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, p.preferences_json, p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified, m.created_at, m.updated_at, - m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link, m.member_security_code, m.member_security_code_verified_at + m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link, m.member_security_code, m.member_security_code_verified_at, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) JOIN groups g ON g.group_id = m.group_id JOIN group_profiles gp USING (group_profile_id) JOIN group_members mu ON g.group_id = mu.group_id JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id) + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ? AND mu.member_status NOT IN (?,?,?) |] (groupMemberId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted) liftIO $ bitraverse (\(g, keysData) -> (,keysData) <$> addGroupChatTags db g) pure gm - toGroupAndMember :: UTCTime -> Connection -> GroupInfoRow :. GroupMemberRow -> ((GroupInfo, GroupKeysRow), GroupMember) - toGroupAndMember currentTs c (groupInfoRow :. memberRow) = + toGroupAndMember :: UTCTime -> Connection -> GroupInfoRow :. GroupMemberRow :. MaybeBadgeProofRow -> ((GroupInfo, GroupKeysRow), GroupMember) + toGroupAndMember currentTs c (groupInfoRow :. memberRow :. proofRow) = let groupInfo = toGroupInfo currentTs cxt userContactId [] groupInfoRow member = toGroupMember currentTs userContactId memberRow - in (groupInfo, (member :: GroupMember) {activeConn = Just c}) + in (groupInfo, (member :: GroupMember) {activeConn = Just c, memberBadgeProof = NoJSON $ maybeRowToBadgeProof proofRow}) getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact getUserContact_ userContactLinkId = ExceptT $ do userContact_ diff --git a/src/Simplex/Chat/Store/ContactRequest.hs b/src/Simplex/Chat/Store/ContactRequest.hs index 5ef9cbe723..35a5138ed1 100644 --- a/src/Simplex/Chat/Store/ContactRequest.hs +++ b/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 (ProofPresHeader, badgeToRow) import Simplex.Chat.Protocol (MsgContent, businessChatsVersion) import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Groups @@ -57,6 +57,7 @@ createOrUpdateContactRequest :: Bool -> InvitationId -> VersionRangeChat -> + Maybe ProofPresHeader -> Profile -> Maybe XContactId -> Maybe SharedMsgId -> @@ -74,7 +75,8 @@ createOrUpdateContactRequest isSimplexTeam invId cReqChatVRange@(VersionRange minV maxV) - profile@Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences} + presHeader_ + profile@Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences} xContactId_ welcomeMsgId_ requestMsg_ @@ -94,8 +96,8 @@ createOrUpdateContactRequest Just (gInfo@GroupInfo {businessChat = Just BusinessChatInfo {customerId}}, keysData) -> do clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId cr <- liftIO $ getContactRequestByXContactId xContactId - gks <- mkGroupKeys db cxt gInfo keysData - pure $ RSAcceptedRequest cr (REBusinessChat (GIK gInfo gks) clientMember) + gks <- mkGroupInfoKeys db cxt gInfo keysData + pure $ RSAcceptedRequest cr (REBusinessChat gks clientMember) Just (GroupInfo {businessChat = Nothing}, _) -> throwError SEInvalidBusinessChatContactRequest -- 2) if no legacy accepted contact or business chat was found, next we try to find an existing request Nothing -> @@ -167,7 +169,7 @@ createOrUpdateContactRequest createContactRequest :: ExceptT StoreError IO RequestStage createContactRequest = do currentTs <- liftIO $ getCurrentTime - badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge + (Profile {badge}, badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) Nothing profile ExceptT $ withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do liftIO $ DB.execute @@ -225,7 +227,7 @@ createOrUpdateContactRequest ucr <- getContactRequest db user contactRequestId pure $ RSCurrentRequest Nothing ucr (Just $ REBusinessChat gInfo clientMember) updateContactRequest :: UserContactRequest -> ExceptT StoreError IO RequestStage - updateContactRequest ucr@UserContactRequest {contactRequestId, contactId_, localDisplayName = oldLdn, profile = LocalProfile {displayName = oldDisplayName}} = do + updateContactRequest ucr@UserContactRequest {contactRequestId, contactId_, localDisplayName = oldLdn, profile = oldProfile@LocalProfile {displayName = oldDisplayName}} = do currentTs <- liftIO getCurrentTime liftIO $ updateProfile currentTs updateRequest currentTs @@ -234,7 +236,7 @@ createOrUpdateContactRequest pure $ RSCurrentRequest (Just ucr) ucr' re_ where updateProfile currentTs = do - badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge + (Profile {badge}, badgeVerified) <- profileBadgeVerified presHeader_ (badgeKeys cxt) (Just oldProfile) profile DB.execute db [sql| @@ -307,8 +309,8 @@ createOrUpdateContactRequest case gInfo of GroupInfo {businessChat = Just BusinessChatInfo {customerId}} -> do clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId - gks <- mkGroupKeys db cxt gInfo keysData - pure $ Just (REBusinessChat (GIK gInfo gks) clientMember) + gks <- mkGroupInfoKeys db cxt gInfo keysData + pure $ Just (REBusinessChat gks clientMember) _ -> throwError SEInvalidBusinessChatContactRequest (Nothing, Nothing) -> pure Nothing _ -> throwError $ SEInvalidContactRequestEntity contactRequestId diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 76029b4a4f..462b3629f1 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/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 (ProofPresHeader, badgeToRow) import Simplex.Chat.Messages import Simplex.Chat.Store.Shared import Simplex.Chat.Names (SimplexDomainClaim (..)) @@ -163,8 +163,8 @@ deletePendingContactConnection db userId connId = |] (userId, connId, ConnContact) -createConnReqConnection :: DB.Connection -> UserId -> ConnId -> Maybe PreparedChatEntity -> ConnReqContact -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe IncognitoProfile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO Connection -createConnReqConnection db userId acId preparedEntity_ cReq cReqHash sLnk xContactId incognitoProfile groupLinkId subMode chatV pqSup = do +createConnReqConnection :: DB.Connection -> UserId -> ConnId -> Maybe PreparedChatEntity -> ConnReqContact -> ProofPresHeader -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe IncognitoProfile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO Connection +createConnReqConnection db userId acId preparedEntity_ cReq presHeader cReqHash sLnk xContactId incognitoProfile groupLinkId subMode chatV pqSup = do currentTs <- getCurrentTime customUserProfileId <- forM incognitoProfile $ \case NewIncognito p -> createIncognitoProfile_ db userId currentTs p @@ -175,13 +175,13 @@ createConnReqConnection db userId acId preparedEntity_ cReq cReqHash sLnk xConta [sql| INSERT INTO connections ( user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated, - via_contact_uri, via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id, + via_contact_uri, pres_header, via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id, xcontact_id, custom_user_profile_id, via_group_link, group_link_id, created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ( (userId, acId, connStatus, connType, BI True) - :. (cReq, cReqHash, sLnk, contactId_, groupMemberId_) + :. (cReq, presHeader, cReqHash, sLnk, contactId_, groupMemberId_) :. (xContactId, customUserProfileId, BI (isJust groupLinkId), groupLinkId) :. (currentTs, currentTs, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup) ) @@ -404,12 +404,12 @@ createIncognitoProfile db User {userId} p = do createdAt <- getCurrentTime createIncognitoProfile_ db userId createdAt p -createPreparedContact :: DB.Connection -> StoreCxt -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> Maybe Bool -> ExceptT StoreError IO Contact -createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId verified_ = do +createPreparedContact :: DB.Connection -> StoreCxt -> User -> Maybe ProofPresHeader -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> Maybe Bool -> ExceptT StoreError IO Contact +createPreparedContact db cxt user presHeader_ p connLinkToConnect welcomeSharedMsgId verified_ = do currentTs <- liftIO getCurrentTime let prepared = Just (connLinkToConnect, welcomeSharedMsgId) ctUserPreferences = newContactUserPrefs user p - ct <- getContact db cxt user =<< createContact_ db cxt user p ctUserPreferences prepared "" currentTs + ct <- getContact db cxt user =<< createContact_ db cxt user presHeader_ p ctUserPreferences prepared "" currentTs liftIO $ maybe (pure ct) (setContactDomainVerified db user ct) verified_ updatePreparedContactUser :: DB.Connection -> StoreCxt -> User -> Contact -> User -> ExceptT StoreError IO Contact @@ -450,11 +450,11 @@ updatePreparedContactUser safeDeleteLDN db user oldLDN getContact db cxt newUser contactId -createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Profile -> ExceptT StoreError IO Contact -createDirectContact db cxt user Connection {connId, localAlias} p = do +createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO Contact +createDirectContact db cxt user Connection {connId, localAlias} presHeader_ p = do currentTs <- liftIO getCurrentTime let ctUserPreferences = newContactUserPrefs user p - contactId <- createContact_ db cxt user p ctUserPreferences Nothing localAlias currentTs + contactId <- createContact_ db cxt user presHeader_ p ctUserPreferences Nothing localAlias currentTs liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId) getContact db cxt user contactId @@ -562,23 +562,23 @@ deleteUnusedProfile_ db userId profileId = :. (userId, profileId, userId, profileId, profileId) ) -updateContactProfile :: DB.Connection -> StoreCxt -> User -> Contact -> Profile -> ExceptT StoreError IO Contact -updateContactProfile db cxt user@User {userId} c p' = do +updateContactProfile :: DB.Connection -> StoreCxt -> User -> Contact -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO Contact +updateContactProfile db cxt user@User {userId} c presHeader_ p' = do currentTs <- liftIO getCurrentTime - badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) lp p' + (p'', badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) (Just lp) claimProfile let nameVerified = if claimChanged then Nothing else prevVerification profile = toLocalProfile profileId p'' localAlias currentTs badgeVerified nameVerified - updateContactProfile' currentTs badgeVerified profile + updateContactProfile' currentTs p'' badgeVerified profile where Contact {contactId, localDisplayName, profile = lp@LocalProfile {profileId, displayName, localAlias, contactDomain = prevClaim, contactDomainVerified = prevVerification}, userPreferences} = c Profile {displayName = newName, contactDomain, preferences} = p' mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c claimChanged = (domain <$> prevClaim) /= (domain <$> contactDomain) - p'' = (p' :: Profile) {contactDomain = (\d -> d {proof = if claimChanged then Nothing else proof =<< prevClaim}) <$> contactDomain} + claimProfile = (p' :: Profile) {contactDomain = (\d -> d {proof = if claimChanged then Nothing else proof =<< prevClaim}) <$> contactDomain} clearVerificationIfClaimChanged = when claimChanged $ DB.execute db "UPDATE contact_profiles SET contact_domain_verified = NULL WHERE user_id = ? AND contact_profile_id = ?" (userId, profileId) - updateContactProfile' currentTs badgeVerified profile + updateContactProfile' currentTs p'' badgeVerified profile | displayName == newName = do liftIO $ updateContactProfile_' db userId profileId p'' badgeVerified currentTs liftIO clearVerificationIfClaimChanged diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index a376ee7ca5..6f9ca5a068 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -193,6 +193,7 @@ module Simplex.Chat.Store.Groups resetMemberContactFields, updateMemberProfile, updateContactMemberProfile, + setMemberBadgeProof, getXGrpLinkMemReceived, setXGrpLinkMemReceived, createNewUnknownGroupMember, @@ -230,7 +231,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 (BadgeProof, BadgeRow, ProofPresHeader, acceptedBadge, badgeProofToRow, badgeToRow, sameBadgeProof, verifyBadge) import Simplex.Chat.Names (SimplexDomainClaim (..)) import Simplex.Chat.Messages import Simplex.Chat.Operators @@ -597,7 +598,8 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe supportChat = Nothing, memberPubKey, relayLink = Nothing, - memberVerifiedCode = Nothing + memberVerifiedCode = Nothing, + memberBadgeProof = NoJSON Nothing } where memberChatVRange@(VersionRange minV maxV) = vr @@ -677,7 +679,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 +836,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 +887,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 @@ -1412,7 +1414,8 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, supportChat = Nothing, memberPubKey = Nothing, relayLink = Nothing, - memberVerifiedCode = Nothing + memberVerifiedCode = Nothing, + memberBadgeProof = NoJSON Nothing } where insertMember_ = do @@ -1713,7 +1716,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 +1755,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 @@ -1825,7 +1828,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 Nothing profile (,) <$> getGroupMemberById db cxt user gmId <*> getGroupRelayByGMId db gmId setRelayLinkConfId :: DB.Connection -> GroupMember -> ConfirmationId -> ShortLinkContact -> IO () @@ -1884,7 +1887,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 Nothing profile setGroupInProgressDone :: DB.Connection -> GroupInfo -> IO () setGroupInProgressDone db GroupInfo {groupId} = do @@ -1894,8 +1897,8 @@ setGroupInProgressDone db GroupInfo {groupId} = do "UPDATE groups SET creating_in_progress = 0, updated_at = ? WHERE group_id = ?" (currentTs, groupId) -createRelayRequestGroup :: DB.Connection -> StoreCxt -> User -> GroupRelayInvitation -> InvitationId -> VersionRangeChat -> Int64 -> GroupMemberStatus -> RelayStatus -> ExceptT StoreError IO (GroupInfo, GroupMember) -createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMember, fromMemberProfile, relayMemberId, groupLink} invId reqChatVRange initialDelay memberStatus relayStatus = do +createRelayRequestGroup :: DB.Connection -> StoreCxt -> User -> GroupRelayInvitation -> Maybe ProofPresHeader -> InvitationId -> VersionRangeChat -> Int64 -> GroupMemberStatus -> RelayStatus -> ExceptT StoreError IO (GroupInfo, GroupMember) +createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMember, fromMemberProfile, relayMemberId, groupLink, publicGroupId, fromMemberKey} presHeader_ invId reqChatVRange initialDelay memberStatus relayStatus = do currentTs <- liftIO getCurrentTime -- Create group with placeholder profile let Profile {displayName = fromMemberLDN} = fromMemberProfile @@ -1927,17 +1930,18 @@ createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMemb UPDATE groups SET relay_request_inv_id = ?, relay_request_group_link = ?, + relay_request_public_group_id = ?, relay_request_peer_chat_min_version = ?, relay_request_peer_chat_max_version = ?, relay_request_delay = ?, relay_request_execute_at = ? WHERE group_id = ? |] - (Binary invId, groupLink, minVersion reqChatVRange, maxVersion reqChatVRange, initialDelay, currentTs, groupId) + (Binary invId, groupLink, publicGroupId, minVersion reqChatVRange, maxVersion reqChatVRange, initialDelay, currentTs, groupId) insertOwner_ currentTs groupId = do let MemberIdRole {memberId, memberRole} = fromMember VersionRange minV maxV = reqChatVRange - (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile currentTs + (localDisplayName, profileId, Profile {badge}, badgeVerified) <- createNewMemberProfile_ db cxt user fromMemberProfile presHeader_ currentTs indexInGroup <- getUpdateNextIndexInGroup_ db groupId liftIO $ do DB.execute @@ -1946,14 +1950,16 @@ createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMemb INSERT INTO group_members ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at, - peer_chat_min_version, peer_chat_max_version) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + peer_chat_min_version, peer_chat_max_version, member_pub_key) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ( (groupId, indexInGroup, memberId, memberRole, GCHostMember, memberStatus, Binary B.empty) :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs) - :. (minV, maxV) + :. (minV, maxV, (\(MemberKey k) -> k) <$> fromMemberKey) ) - insertedRowId db + ownerMemberId <- insertedRowId db + forM_ (verifiedProof badgeVerified badge) $ createMemberBadgeProof db ownerMemberId + pure ownerMemberId updateRelayOwnStatusFromTo :: DB.Connection -> GroupInfo -> RelayStatus -> RelayStatus -> IO GroupInfo updateRelayOwnStatusFromTo db gInfo@GroupInfo {groupId} fromStatus toStatus = do @@ -2020,7 +2026,7 @@ getRelayServedGroups db cxt User {userId, userContactId} = do <> " WHERE g.user_id = ? AND mu.contact_id = ? AND g.relay_own_status IN (?, ?, ?)" ) (userId, userContactId, RSAccepted, RSAcknowledgedRoster, RSActive) - forM rows $ \(g, keysData) -> GIK g <$> mkGroupKeys db cxt g keysData + forM rows $ uncurry (mkGroupInfoKeys db cxt) getRelayPublishableGroups :: DB.Connection -> User -> IO [(Int64, B64UrlByteString, Maybe PublicGroupAccess)] getRelayPublishableGroups db User {userId, userContactId} = @@ -2066,7 +2072,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 ProofPresHeader -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId) createJoiningMember db cxt @@ -2074,7 +2080,8 @@ createJoiningMember User {userId, userContactId} GroupInfo {groupId, membership} cReqChatVRange - Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences} + p@Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences} + presHeader_ cReqXContactId_ cReqMemberId_ welcomeMsgId_ @@ -2082,7 +2089,7 @@ createJoiningMember memberStatus memberKey_ = do currentTs <- liftIO getCurrentTime - badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge + (Profile {badge}, badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) Nothing p ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do liftIO $ DB.execute @@ -2090,7 +2097,7 @@ createJoiningMember "INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, user_id, 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, preferences, preferences_json) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" ((displayName, fullName, shortDescr, description, image, contactLink, userId, currentTs, currentTs) :. badgeToRow badge badgeVerified :. prefsToRow preferences) profileId <- liftIO $ insertedRowId db - case cReqMemberId_ of + r@(groupMemberId, _) <- case cReqMemberId_ of Just memberId -> do checkMemberNotExists memberId insertMember_ ldn profileId memberId currentTs @@ -2101,6 +2108,8 @@ createJoiningMember insertMember_ ldn profileId (MemberId memId) currentTs groupMemberId <- liftIO $ insertedRowId db pure (groupMemberId, MemberId memId) + liftIO $ forM_ (verifiedProof badgeVerified badge) $ createMemberBadgeProof db groupMemberId + pure r where VersionRange minV maxV = cReqChatVRange -- TODO [relays] relay: TBC communicate rejection @@ -2416,13 +2425,13 @@ 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 ProofPresHeader -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember +createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profile} presHeader_ memCategory memStatus = do currentTs <- liftIO getCurrentTime - (localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user profile currentTs + (localDisplayName, memProfileId, memProfile, badgeVerified) <- createNewMemberProfile_ db cxt user profile presHeader_ currentTs let newMember = NewGroupMember - { memInfo, + { memInfo = (memInfo :: MemberInfo) {profile = memProfile}, memCategory, memStatus, memRestriction = Nothing, @@ -2434,16 +2443,16 @@ 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 ProofPresHeader -> UTCTime -> ExceptT StoreError IO (Text, ProfileId, Profile, Maybe Bool) +createNewMemberProfile_ db cxt User {userId} p@Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences} presHeader_ createdAt = ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do - badgeVerified <- verifyBadge_ (badgeKeys cxt) badge + (p'@Profile {badge}, badgeVerified) <- profileBadgeVerified presHeader_ (badgeKeys cxt) Nothing p DB.execute db "INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, user_id, 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, preferences, preferences_json) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" ((displayName, fullName, shortDescr, description, image, contactLink, userId, createdAt, createdAt) :. badgeToRow badge badgeVerified :. prefsToRow preferences) profileId <- insertedRowId db - pure $ Right (ldn, profileId, badgeVerified) + pure $ Right (ldn, profileId, p', badgeVerified) createNewMember_ :: DB.Connection -> User -> GroupInfo -> NewGroupMember -> Maybe Bool -> UTCTime -> ExceptT StoreError IO GroupMember createNewMember_ @@ -2451,7 +2460,7 @@ createNewMember_ User {userId, userContactId} GroupInfo {groupId} NewGroupMember - { memInfo = MemberInfo memberId memberRole memChatVRange memberProfile memKey, + { memInfo = MemberInfo memberId memberRole memChatVRange memberProfile@Profile {badge} memKey, memCategory = memberCategory, memStatus = memberStatus, memRestriction, @@ -2467,6 +2476,7 @@ createNewMember_ activeConn = Nothing memberChatVRange@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange memberPubKey = (\(MemberKey k) -> k) <$> memKey + memberProof = verifiedProof badgeVerified badge indexInGroup <- getUpdateNextIndexInGroup_ db groupId liftIO $ DB.execute @@ -2485,6 +2495,7 @@ createNewMember_ :. (minV, maxV) ) groupMemberId <- liftIO $ insertedRowId db + liftIO $ forM_ memberProof $ createMemberBadgeProof db groupMemberId pure GroupMember { groupMemberId, @@ -2509,7 +2520,8 @@ createNewMember_ supportChat = Nothing, memberPubKey, relayLink = Nothing, - memberVerifiedCode = Nothing + memberVerifiedCode = Nothing, + memberBadgeProof = NoJSON memberProof } checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId) @@ -2614,18 +2626,19 @@ 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 ProofPresHeader -> Maybe MemberRestrictions -> ExceptT StoreError IO GroupMember createIntroReMember db cxt user gInfo memInfo@(MemberInfo _ _ _ memberProfile _) + presHeader_ memRestrictions_ = do currentTs <- liftIO getCurrentTime - (localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user memberProfile currentTs + (localDisplayName, memProfileId, memberProfile', badgeVerified) <- createNewMemberProfile_ db cxt user memberProfile presHeader_ currentTs let memRestriction = restriction <$> memRestrictions_ - newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId} + newMember = NewGroupMember {memInfo = (memInfo :: MemberInfo) {profile = memberProfile'}, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId} createNewMember_ db user gInfo newMember badgeVerified currentTs createIntroReMemberConn :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> MemberInfo -> (CommandId, ConnId) -> SubscriptionMode -> ExceptT StoreError IO GroupMember @@ -3381,25 +3394,26 @@ 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 m@GroupMember {memberContactId} p' = case memberContactId of - Nothing -> updateUnlinkedMemberProfile db cxt user m p' +updateMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO GroupMember +updateMemberProfile db cxt user m@GroupMember {memberContactId} presHeader_ p = case memberContactId of + Nothing -> updateUnlinkedMemberProfile db cxt user m presHeader_ p Just ctId -> do ct <- getContact db cxt user ctId if contactUpdatableFromMember ct - then fst <$> updateContactMemberProfile db cxt user m ct p' - else pure m + then fst <$> updateContactMemberProfile db cxt user m ct presHeader_ p + else liftIO $ setMemberBadgeProof db cxt m presHeader_ p -updateUnlinkedMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember -updateUnlinkedMemberProfile db cxt user@User {userId} m p' = do +updateUnlinkedMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO GroupMember +updateUnlinkedMemberProfile db cxt user@User {userId} m presHeader_ p = do currentTs <- liftIO getCurrentTime - badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p' + (p', badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) (Just $ memberProfile m) p let memberProfile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing - updateMemberProfile' currentTs badgeVerified memberProfile + m' <- updateMemberProfile' currentTs p' badgeVerified memberProfile + liftIO $ setMemberBadgeProof db cxt m' presHeader_ p where GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m - Profile {displayName = newName} = p' - updateMemberProfile' currentTs badgeVerified memberProfile + Profile {displayName = newName} = p + updateMemberProfile' currentTs p' badgeVerified memberProfile | displayName == newName = do liftIO $ updateMemberContactProfileReset_' db userId profileId p' badgeVerified currentTs pure m {memberProfile} @@ -3413,16 +3427,17 @@ updateUnlinkedMemberProfile 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 ProofPresHeader -> Profile -> ExceptT StoreError IO (GroupMember, Contact) +updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} presHeader_ p = do currentTs <- liftIO getCurrentTime - badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p' + (p', badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) (Just $ memberProfile m) p let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing - updateContactMemberProfile' currentTs badgeVerified profile + (m', ct') <- updateContactMemberProfile' currentTs p' badgeVerified profile + (,ct') <$> liftIO (setMemberBadgeProof db cxt m' presHeader_ p) where GroupMember {localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m - Profile {displayName = newName} = p' - updateContactMemberProfile' currentTs badgeVerified profile + Profile {displayName = newName} = p + updateContactMemberProfile' currentTs p' badgeVerified profile | displayName == newName = do liftIO $ updateMemberContactProfile_' db userId profileId p' badgeVerified currentTs pure (m {memberProfile = profile}, ct {profile} :: Contact) @@ -3432,6 +3447,37 @@ updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} p' updateContactLDN_ db user contactId localDisplayName ldn currentTs pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile} :: Contact) +setMemberBadgeProof :: DB.Connection -> StoreCxt -> GroupMember -> Maybe ProofPresHeader -> Profile -> IO GroupMember +setMemberBadgeProof db cxt m@GroupMember {groupMemberId, memberBadgeProof = NoJSON storedProof} presHeader_ Profile {badge} = case acceptedBadge presHeader_ storedProof badge of + badge' | sameBadgeProof badge' storedProof -> pure m + Nothing -> m {memberBadgeProof = NoJSON Nothing} <$ DB.execute db "DELETE FROM group_member_badge_proofs WHERE group_member_id = ?" (Only groupMemberId) + Just b -> + verifyBadge (badgeKeys cxt) b >>= \case + Just True -> m {memberBadgeProof = NoJSON (Just b)} <$ createMemberBadgeProof db groupMemberId b + _ -> pure m + +verifiedProof :: Maybe Bool -> Maybe BadgeProof -> Maybe BadgeProof +verifiedProof badgeVerified = mfilter (const $ badgeVerified == Just True) + +createMemberBadgeProof :: DB.Connection -> GroupMemberId -> BadgeProof -> IO () +createMemberBadgeProof db groupMemberId badge = do + currentTs <- getCurrentTime + DB.execute + db + [sql| + INSERT INTO group_member_badge_proofs (group_member_id, badge_proof, badge_pres_header, badge_key_idx, badge_type, badge_expiry, badge_extra, created_at, updated_at) + VALUES (?,?,?,?,?,?,?,?,?) + ON CONFLICT (group_member_id) DO UPDATE SET + badge_proof = excluded.badge_proof, + badge_pres_header = excluded.badge_pres_header, + badge_key_idx = excluded.badge_key_idx, + badge_type = excluded.badge_type, + badge_expiry = excluded.badge_expiry, + badge_extra = excluded.badge_extra, + updated_at = excluded.updated_at + |] + (Only groupMemberId :. badgeProofToRow badge :. (currentTs, currentTs)) + getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool getXGrpLinkMemReceived db mId = ExceptT . firstRow fromOnlyBI (SEGroupMemberNotFound mId) $ @@ -3449,7 +3495,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 @@ -3494,7 +3540,7 @@ createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupI where VersionRange minV maxV = vr cxt newOwnerProfile currentTs = do - (ldn, pId, _) <- createNewMemberProfile_ db cxt user (profileFromName $ nameFromMemberId memberId) currentTs + (ldn, pId, _, _) <- createNewMemberProfile_ db cxt user (profileFromName $ nameFromMemberId memberId) Nothing currentTs pure (ldn, pId) contactNameAndProfile ctId = do Contact {localDisplayName = ldn, profile = LocalProfile {profileId = pId}} <- getContact db cxt user ctId @@ -3503,9 +3549,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 ProofPresHeader -> ExceptT StoreError IO GroupMember +updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} presHeader_ = do + _ <- updateMemberProfile db cxt user member presHeader_ profile currentTs <- liftIO getCurrentTime liftIO $ DB.execute @@ -3523,9 +3569,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 ProofPresHeader -> GroupMemberStatus -> ExceptT StoreError IO GroupMember +updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} presHeader_ status = do + _ <- updateMemberProfile db cxt user unknownMember presHeader_ profile currentTs <- liftIO getCurrentTime liftIO $ DB.execute @@ -3552,9 +3598,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 ProofPresHeader -> GroupMemberStatus -> ExceptT StoreError IO GroupMember +updateRosterMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} presHeader_ status = do + _ <- updateMemberProfile db cxt user unknownMember presHeader_ profile currentTs <- liftIO getCurrentTime liftIO $ DB.execute diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index 24ed45c9a9..36f594560a 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -53,6 +53,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260904_file_badges import Simplex.Chat.Store.Postgres.Migrations.M20260915_user_badges import Simplex.Chat.Store.Postgres.Migrations.M20260918_badge_issue_errors import Simplex.Chat.Store.Postgres.Migrations.M20260923_preferences_json +import Simplex.Chat.Store.Postgres.Migrations.M20260925_badge_bindings import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] @@ -105,7 +106,8 @@ schemaMigrations = ("20260904_file_badges", m20260904_file_badges, Just down_m20260904_file_badges), ("20260915_user_badges", m20260915_user_badges, Just down_m20260915_user_badges), ("20260918_badge_issue_errors", m20260918_badge_issue_errors, Just down_m20260918_badge_issue_errors), - ("20260923_preferences_json", m20260923_preferences_json, Just down_m20260923_preferences_json) + ("20260923_preferences_json", m20260923_preferences_json, Just down_m20260923_preferences_json), + ("20260925_badge_bindings", m20260925_badge_bindings, Just down_m20260925_badge_bindings) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20260925_badge_bindings.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20260925_badge_bindings.hs new file mode 100644 index 0000000000..596c557c99 --- /dev/null +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20260925_badge_bindings.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.Postgres.Migrations.M20260925_badge_bindings where + +import Data.Text (Text) +import Text.RawString.QQ (r) + +m20260925_badge_bindings :: Text +m20260925_badge_bindings = + [r| +ALTER TABLE connections ADD COLUMN pres_header BYTEA; + +ALTER TABLE groups ADD COLUMN relay_request_public_group_id BYTEA; + +CREATE TABLE group_member_badge_proofs( + group_member_id BIGINT PRIMARY KEY REFERENCES group_members ON DELETE CASCADE, + badge_proof BYTEA NOT NULL, + badge_pres_header BYTEA NOT NULL, + badge_key_idx BIGINT NOT NULL, + badge_type TEXT NOT NULL, + badge_expiry TIMESTAMPTZ NOT NULL, + badge_extra TEXT NOT NULL, + created_at TIMESTAMPTZ NOT NULL, + updated_at TIMESTAMPTZ NOT NULL +); +|] + +down_m20260925_badge_bindings :: Text +down_m20260925_badge_bindings = + [r| +DROP TABLE group_member_badge_proofs; + +ALTER TABLE groups DROP COLUMN relay_request_public_group_id; + +ALTER TABLE connections DROP COLUMN pres_header; +|] diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql index ad975874db..9c7ab5aa32 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql @@ -618,7 +618,8 @@ CREATE TABLE test_chat_schema.connections ( short_link_inv bytea, via_short_link_contact bytea, via_contact_uri bytea, - relay_test smallint DEFAULT 0 NOT NULL + relay_test smallint DEFAULT 0 NOT NULL, + pres_header bytea ); @@ -944,6 +945,20 @@ ALTER TABLE test_chat_schema.files ALTER COLUMN file_id ADD GENERATED ALWAYS AS +CREATE TABLE test_chat_schema.group_member_badge_proofs ( + group_member_id bigint NOT NULL, + badge_proof bytea NOT NULL, + badge_pres_header bytea NOT NULL, + badge_key_idx bigint NOT NULL, + badge_type text NOT NULL, + badge_expiry timestamp with time zone NOT NULL, + badge_extra text NOT NULL, + created_at timestamp with time zone NOT NULL, + updated_at timestamp with time zone NOT NULL +); + + + CREATE TABLE test_chat_schema.group_member_intros ( group_member_intro_id bigint NOT NULL, re_group_member_id bigint NOT NULL, @@ -1170,7 +1185,8 @@ CREATE TABLE test_chat_schema.groups ( roster_blob bytea, group_domain_verified smallint, stored_roster_version bigint, - applied_complete_roster_version bigint + applied_complete_roster_version bigint, + relay_request_public_group_id bytea ); @@ -1938,6 +1954,11 @@ ALTER TABLE ONLY test_chat_schema.files +ALTER TABLE ONLY test_chat_schema.group_member_badge_proofs + ADD CONSTRAINT group_member_badge_proofs_pkey PRIMARY KEY (group_member_id); + + + ALTER TABLE ONLY test_chat_schema.group_member_intros ADD CONSTRAINT group_member_intros_pkey PRIMARY KEY (group_member_intro_id); @@ -3404,6 +3425,11 @@ ALTER TABLE ONLY test_chat_schema.users +ALTER TABLE ONLY test_chat_schema.group_member_badge_proofs + ADD CONSTRAINT group_member_badge_proofs_group_member_id_fkey FOREIGN KEY (group_member_id) REFERENCES test_chat_schema.group_members(group_member_id) ON DELETE CASCADE; + + + ALTER TABLE ONLY test_chat_schema.group_member_intros ADD CONSTRAINT group_member_intros_re_group_member_id_fkey FOREIGN KEY (re_group_member_id) REFERENCES test_chat_schema.group_members(group_member_id) ON DELETE CASCADE; diff --git a/src/Simplex/Chat/Store/RelayRequests.hs b/src/Simplex/Chat/Store/RelayRequests.hs index 2e590a1696..b7c081ffa6 100644 --- a/src/Simplex/Chat/Store/RelayRequests.hs +++ b/src/Simplex/Chat/Store/RelayRequests.hs @@ -77,7 +77,7 @@ getNextPendingRelayRequest db = db [sql| SELECT - relay_request_inv_id, relay_request_group_link, + relay_request_inv_id, relay_request_group_link, relay_request_public_group_id, relay_request_peer_chat_min_version, relay_request_peer_chat_max_version, relay_request_delay, relay_request_retries, created_at, relay_request_execute_at FROM groups @@ -85,10 +85,10 @@ getNextPendingRelayRequest db = |] (Only groupId) where - toRelayRequestData :: (Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat, Maybe VersionChat, Int64, Int, UTCTime, UTCTime) -> Either StoreError (GroupId, RelayRequestData) + toRelayRequestData :: (Maybe InvitationId, Maybe ShortLinkContact, Maybe B64UrlByteString, Maybe VersionChat, Maybe VersionChat, Int64, Int, UTCTime, UTCTime) -> Either StoreError (GroupId, RelayRequestData) toRelayRequestData = \case - (Just relayInvId, Just reqGroupLink, Just minV, Just maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt) -> - Right (groupId, RelayRequestData {relayInvId, reqGroupLink, reqChatVRange = fromMaybe (versionToRange maxV) $ safeVersionRange minV maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt}) + (Just relayInvId, Just reqGroupLink, reqPublicGroupId, Just minV, Just maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt) -> + Right (groupId, RelayRequestData {relayInvId, reqGroupLink, reqPublicGroupId, reqChatVRange = fromMaybe (versionToRange maxV) $ safeVersionRange minV maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt}) _ -> Left $ SEInternalError "missing relay request data" updateRelayRequestRetries :: DB.Connection -> GroupId -> Int64 -> UTCTime -> IO () diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index 4dcefa1598..f16351f6c2 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -176,6 +176,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260904_file_badges import Simplex.Chat.Store.SQLite.Migrations.M20260915_user_badges import Simplex.Chat.Store.SQLite.Migrations.M20260918_badge_issue_errors import Simplex.Chat.Store.SQLite.Migrations.M20260923_preferences_json +import Simplex.Chat.Store.SQLite.Migrations.M20260925_badge_bindings import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -351,7 +352,8 @@ schemaMigrations = ("20260904_file_badges", m20260904_file_badges, Just down_m20260904_file_badges), ("20260915_user_badges", m20260915_user_badges, Just down_m20260915_user_badges), ("20260918_badge_issue_errors", m20260918_badge_issue_errors, Just down_m20260918_badge_issue_errors), - ("20260923_preferences_json", m20260923_preferences_json, Just down_m20260923_preferences_json) + ("20260923_preferences_json", m20260923_preferences_json, Just down_m20260923_preferences_json), + ("20260925_badge_bindings", m20260925_badge_bindings, Just down_m20260925_badge_bindings) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20260925_badge_bindings.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20260925_badge_bindings.hs new file mode 100644 index 0000000000..fdb4d86910 --- /dev/null +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20260925_badge_bindings.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.SQLite.Migrations.M20260925_badge_bindings where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20260925_badge_bindings :: Query +m20260925_badge_bindings = + [sql| +ALTER TABLE connections ADD COLUMN pres_header BLOB; + +ALTER TABLE groups ADD COLUMN relay_request_public_group_id BLOB; + +CREATE TABLE group_member_badge_proofs( + group_member_id INTEGER PRIMARY KEY REFERENCES group_members ON DELETE CASCADE, + badge_proof BLOB NOT NULL, + badge_pres_header BLOB NOT NULL, + badge_key_idx INTEGER NOT NULL, + badge_type TEXT NOT NULL, + badge_expiry TEXT NOT NULL, + badge_extra TEXT NOT NULL, + created_at TEXT NOT NULL, + updated_at TEXT NOT NULL +) STRICT; +|] + +down_m20260925_badge_bindings :: Query +down_m20260925_badge_bindings = + [sql| +DROP TABLE group_member_badge_proofs; + +ALTER TABLE groups DROP COLUMN relay_request_public_group_id; + +ALTER TABLE connections DROP COLUMN pres_header; +|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt index 00886165b5..d12b3c98cf 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt @@ -1393,7 +1393,7 @@ SEARCH connections USING COVERING INDEX idx_connections_user (user_id=?) Query: SELECT conn_id FROM rcv_queues WHERE switch_status = ? AND deleted = 0 Plan: -SCAN rcv_queues +SEARCH rcv_queues USING INDEX idx_rcv_queues_switch_status (switch_status=?) Query: SELECT conn_id, rc_verify_code_ad, rc_verify_code_pq, CASE WHEN rc_verify_code_ad IS NULL THEN ratchet_state END FROM ratchets WHERE conn_id = ? Plan: diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index 7b76c06527..535ca23fca 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -30,6 +30,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -84,6 +85,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -169,13 +171,15 @@ Query: m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, p.preferences_json, p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified, m.created_at, m.updated_at, - m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link, m.member_security_code, m.member_security_code_verified_at + m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link, m.member_security_code, m.member_security_code_verified_at, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) JOIN groups g ON g.group_id = m.group_id JOIN group_profiles gp USING (group_profile_id) JOIN group_members mu ON g.group_id = mu.group_id JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id) + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ? AND mu.member_status NOT IN (?,?,?) @@ -186,6 +190,7 @@ SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH gp USING INTEGER PRIMARY KEY (rowid=?) SEARCH mu USING INDEX idx_group_members_contact_id (contact_id=?) SEARCH pu USING INTEGER PRIMARY KEY (rowid=?) +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT delivery_task_id @@ -292,6 +297,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -328,6 +334,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -364,6 +371,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -584,10 +592,11 @@ Query: INSERT INTO group_members ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at, - peer_chat_min_version, peer_chat_max_version) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + peer_chat_min_version, peer_chat_max_version, member_pub_key) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -623,6 +632,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -659,6 +669,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -695,6 +706,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -762,7 +774,7 @@ SEARCH delivery_jobs USING INTEGER PRIMARY KEY (rowid=?) Query: SELECT - relay_request_inv_id, relay_request_group_link, + relay_request_inv_id, relay_request_group_link, relay_request_public_group_id, relay_request_peer_chat_min_version, relay_request_peer_chat_max_version, relay_request_delay, relay_request_retries, created_at, relay_request_execute_at FROM groups @@ -1267,6 +1279,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -1304,6 +1317,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -1897,6 +1911,7 @@ Query: UPDATE groups SET relay_request_inv_id = ?, relay_request_group_link = ?, + relay_request_public_group_id = ?, relay_request_peer_chat_min_version = ?, relay_request_peer_chat_max_version = ?, relay_request_delay = ?, @@ -1957,6 +1972,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -1993,6 +2009,7 @@ Query: VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -5010,10 +5027,10 @@ Plan: Query: INSERT INTO connections ( user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated, - via_contact_uri, via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id, + via_contact_uri, pres_header, via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id, xcontact_id, custom_user_profile_id, via_group_link, group_link_id, created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: @@ -5068,6 +5085,20 @@ Query: Plan: +Query: + INSERT INTO group_member_badge_proofs (group_member_id, badge_proof, badge_pres_header, badge_key_idx, badge_type, badge_expiry, badge_extra, created_at, updated_at) + VALUES (?,?,?,?,?,?,?,?,?) + ON CONFLICT (group_member_id) DO UPDATE SET + badge_proof = excluded.badge_proof, + badge_pres_header = excluded.badge_pres_header, + badge_key_idx = excluded.badge_key_idx, + badge_type = excluded.badge_type, + badge_expiry = excluded.badge_expiry, + badge_extra = excluded.badge_extra, + updated_at = excluded.updated_at + +Plan: + Query: INSERT INTO msg_deliveries (message_id, connection_id, agent_msg_id, chat_ts, created_at, updated_at, delivery_status) @@ -5883,10 +5914,12 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_id = ? AND m.user_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_status IN (?, ?, ?, ?) @@ -5900,6 +5933,7 @@ LIST SUBQUERY 1 SCAN chat_items USING COVERING INDEX idx_chat_items_group_member_id SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -5911,16 +5945,19 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id JOIN group_member_status_predicates sp ON m.member_status = sp.member_status WHERE m.group_id = ? AND m.relay_link = ? AND sp.current_member = 1 Plan: SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=?) SEARCH sp USING INDEX sqlite_autoindex_group_member_status_predicates_1 (member_status=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -5932,15 +5969,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ? Plan: SEARCH m USING INTEGER PRIMARY KEY (rowid=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -5952,15 +5992,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_id = ? AND m.index_in_group = ? Plan: SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=? AND index_in_group=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -5972,15 +6015,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_id = ? AND m.index_in_group = ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?) Plan: SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=? AND index_in_group=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -5992,15 +6038,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_id = ? AND m.member_category = ? Plan: SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -6012,15 +6061,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_id = ? AND m.member_id = ? Plan: SEARCH m USING INDEX sqlite_autoindex_group_members_1 (group_id=? AND member_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -6032,15 +6084,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_member_id = ? AND m.user_id = ? Plan: SEARCH m USING INTEGER PRIMARY KEY (rowid=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -6052,15 +6107,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.group_member_id = ? AND m.user_id = ? AND m.member_status NOT IN (?,?,?,?) Plan: SEARCH m USING INTEGER PRIMARY KEY (rowid=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -6072,15 +6130,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) Plan: SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -6092,15 +6153,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role = ? Plan: SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -6112,15 +6176,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?) Plan: SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -6132,15 +6199,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?) Plan: SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -6152,15 +6222,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.user_id = ? AND m.group_id = ? AND m.contact_id IS DISTINCT FROM ? AND m.member_role = ? Plan: SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT @@ -6172,15 +6245,18 @@ Query: c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id WHERE m.user_id = ? AND m.removed_at < ? Plan: SEARCH m USING INDEX idx_group_members_user_id (user_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN +SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN Query: SELECT f.file_id, f.ci_file_status, f.file_path @@ -6898,9 +6974,14 @@ SEARCH rcv_files USING INTEGER PRIMARY KEY (rowid=?) SEARCH snd_files USING COVERING INDEX idx_snd_files_file_id (file_id=?) SEARCH files USING COVERING INDEX idx_files_redirect_file_id (redirect_file_id=?) +Query: DELETE FROM group_member_badge_proofs WHERE group_member_id = ? +Plan: +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) + Query: DELETE FROM group_members WHERE member_id = ? Plan: SCAN group_members +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -6932,6 +7013,7 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta Query: DELETE FROM group_members WHERE user_id = ? AND group_id = ? Plan: SEARCH group_members USING COVERING INDEX idx_group_members_group_id (user_id=? AND group_id=?) +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -6963,6 +7045,7 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta Query: DELETE FROM group_members WHERE user_id = ? AND group_member_id = ? Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) +SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?) SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?) SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?) @@ -7345,6 +7428,10 @@ Query: SELECT accepted_at FROM operator_usage_conditions WHERE server_operator_i Plan: SEARCH operator_usage_conditions USING INDEX idx_operator_usage_conditions_conditions_commit (conditions_commit=? AND server_operator_id=?) +Query: SELECT agent_conn_id FROM connections +Plan: +SCAN connections USING COVERING INDEX sqlite_autoindex_connections_1 + Query: SELECT agent_conn_id FROM connections WHERE user_id = ? AND conn_req_inv IN (?,?) LIMIT 1 Plan: SEARCH connections USING INDEX idx_connections_conn_req_inv (user_id=? AND conn_req_inv=?) @@ -7808,7 +7895,7 @@ Query: SELECT user_id FROM users WHERE local_display_name = ? Plan: SEARCH users USING COVERING INDEX sqlite_autoindex_users_2 (local_display_name=?) -Query: SELECT via_contact_uri FROM connections WHERE connection_id = ? +Query: SELECT via_contact_uri, pres_header FROM connections WHERE connection_id = ? Plan: SEARCH connections USING INTEGER PRIMARY KEY (rowid=?) @@ -8056,6 +8143,10 @@ Query: UPDATE group_members SET member_profile_id = ?, updated_at = ? WHERE grou Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) +Query: UPDATE group_members SET member_pub_key = ? WHERE member_category = 'user' +Plan: +SCAN group_members + Query: UPDATE group_members SET member_pub_key = ?, member_role = ?, updated_at = ? WHERE group_member_id = ? Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) @@ -8112,6 +8203,10 @@ Query: UPDATE group_profiles SET description = ? WHERE display_name = ? Plan: SCAN group_profiles +Query: UPDATE group_profiles SET public_group_id = ? +Plan: +SCAN group_profiles + Query: UPDATE group_relays SET relay_status = ?, updated_at = ? WHERE group_relay_id = ? Plan: SEARCH group_relays USING INTEGER PRIMARY KEY (rowid=?) @@ -8168,6 +8263,10 @@ Query: UPDATE groups SET local_display_name = ?, updated_at = ? WHERE user_id = Plan: SEARCH groups USING INTEGER PRIMARY KEY (rowid=?) +Query: UPDATE groups SET member_priv_key = ? +Plan: +SCAN groups + Query: UPDATE groups SET member_priv_key = NULL Plan: SCAN groups @@ -8272,6 +8371,10 @@ Query: UPDATE usage_conditions SET notified_at = ? WHERE usage_conditions_id = ? Plan: SEARCH usage_conditions USING INTEGER PRIMARY KEY (rowid=?) +Query: UPDATE user_contact_links SET short_link_contact = NULL +Plan: +SCAN user_contact_links + Query: UPDATE users SET active_user = 0 Plan: SCAN users diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 995497d5ee..95a837f5e1 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -211,7 +211,8 @@ CREATE TABLE groups( roster_blob BLOB, group_domain_verified INTEGER, stored_roster_version INTEGER, - applied_complete_roster_version INTEGER, -- received + applied_complete_roster_version INTEGER, + relay_request_public_group_id BLOB, -- received FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE @@ -390,6 +391,7 @@ CREATE TABLE connections( via_short_link_contact BLOB, via_contact_uri BLOB, relay_test INTEGER NOT NULL DEFAULT 0, + pres_header BLOB, FOREIGN KEY(snd_file_id, connection_id) REFERENCES snd_files(file_id, connection_id) ON DELETE CASCADE @@ -981,6 +983,17 @@ CREATE TABLE badge_code_redemptions( created_at TEXT NOT NULL, UNIQUE(user_id, code) ) STRICT; +CREATE TABLE group_member_badge_proofs( + group_member_id INTEGER PRIMARY KEY REFERENCES group_members ON DELETE CASCADE, + badge_proof BLOB NOT NULL, + badge_pres_header BLOB NOT NULL, + badge_key_idx INTEGER NOT NULL, + badge_type TEXT NOT NULL, + badge_expiry TEXT NOT NULL, + badge_extra TEXT NOT NULL, + created_at TEXT NOT NULL, + updated_at TEXT NOT NULL +) STRICT; CREATE INDEX contact_profiles_index ON contact_profiles( display_name, full_name diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 908d5a823b..605d441eb4 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/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, MaybeBadgeProofRow, ProofPresHeader, badgeToRow, maybeRowToBadgeProof, rowToBadge) import Simplex.Chat.Names (SimplexDomainProof, SimplexDomainClaim (..), claimDomain) import Simplex.Chat.Messages import Simplex.Chat.Remote.Types @@ -414,12 +414,12 @@ setCommandConnId db User {userId} cmdId connId = do createContact :: DB.Connection -> StoreCxt -> User -> Profile -> ExceptT StoreError IO () createContact db cxt user profile = do currentTs <- liftIO getCurrentTime - void $ createContact_ db cxt user profile emptyChatPrefs Nothing "" currentTs + void $ createContact_ db cxt user Nothing profile emptyChatPrefs Nothing "" currentTs -createContact_ :: DB.Connection -> StoreCxt -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId -createContact_ db cxt User {userId} Profile {displayName, fullName, shortDescr, description, image, contactLink, contactDomain, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs = +createContact_ :: DB.Connection -> StoreCxt -> User -> Maybe ProofPresHeader -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId +createContact_ db cxt User {userId} presHeader_ p@Profile {displayName, fullName, shortDescr, description, image, contactLink, contactDomain, peerType, preferences} ctUserPreferences prepared localAlias currentTs = ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do - badgeVerified <- verifyBadge_ (badgeKeys cxt) badge + (Profile {badge}, badgeVerified) <- profileBadgeVerified presHeader_ (badgeKeys cxt) Nothing p DB.execute db "INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, chat_peer_type, user_id, local_alias, 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, preferences, preferences_json) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" @@ -589,12 +589,12 @@ getConnReqInv db connId = "SELECT conn_req_inv FROM connections WHERE connection_id = ?" (Only connId) -getConnReqContact :: DB.Connection -> Int64 -> ExceptT StoreError IO ConnReqContact +getConnReqContact :: DB.Connection -> Int64 -> ExceptT StoreError IO (ConnReqContact, Maybe ProofPresHeader) getConnReqContact db connId = - ExceptT . firstRow fromOnly (SEConnectionNotFoundById connId) $ + ExceptT . firstRow id (SEConnectionNotFoundById connId) $ DB.query db - "SELECT via_contact_uri FROM connections WHERE connection_id = ?" + "SELECT via_contact_uri, pres_header FROM connections WHERE connection_id = ?" (Only connId) -- | Saves unique local display name based on passed displayName, suffixed with _N if required. @@ -747,14 +747,15 @@ toPublicGroupAccess (groupWebPage, groupDomain_, domainWebPage_, allowEmbedding_ domainWebPage = maybe False unBI domainWebPage_ allowEmbedding = maybe False unBI allowEmbedding_ -mkGroupKeys :: DB.Connection -> StoreCxt -> GroupInfo -> GroupKeysRow -> ExceptT StoreError IO GroupKeys -mkGroupKeys db cxt g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}, membership} (rootPrivKey, rootPubKey, memberPrivKey_) = do +mkGroupInfoKeys :: DB.Connection -> StoreCxt -> GroupInfo -> GroupKeysRow -> ExceptT StoreError IO GroupInfoKeys +mkGroupInfoKeys db cxt g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}, membership} (rootPrivKey, rootPubKey, memberPrivKey_) = do memberPrivKey <- case memberPrivKey_ of Just k -> pure k Nothing -> do (_, k) <- atomically $ C.generateKeyPair (drg cxt) setUserMemberKey db groupId (groupMemberId' membership) k - pure $ case (useRelays' g, isJust publicGroup, GRKPrivate <$> rootPrivKey <|> GRKPublic <$> rootPubKey) of + let membership' = membership {memberPubKey = Just $ C.publicKey memberPrivKey} :: GroupMember + pure $ GIK g {membership = membership'} $ case (useRelays' g, isJust publicGroup, GRKPrivate <$> rootPrivKey <|> GRKPublic <$> rootPubKey) of (False, _, _) -> GKGroup {memberPrivKey} (True, True, Just groupRootKey) -> GKPublicGroup {groupRootKey, memberPrivKey} (True, True, Nothing) -> GKPreparedPublicGroup {memberPrivKey} @@ -785,6 +786,7 @@ toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId invitedBy = toInvitedBy userContactId invitedById activeConn = Nothing memberVerifiedCode = SecurityCode <$> memberCode_ <*> memberCodeVerifiedAt_ + memberBadgeProof = NoJSON Nothing memberChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer supportChat = case supportChatTs_ of Just chatTs -> @@ -811,15 +813,17 @@ groupMemberQuery = c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter, - c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, + bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.group_member_id = m.group_member_id + LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id |] -toContactMember :: UTCTime -> StoreCxt -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember -toContactMember now cxt User {userContactId} (memberRow :. connRow) = - (toGroupMember now userContactId memberRow) {activeConn = toMaybeConnection cxt connRow} +toContactMember :: UTCTime -> StoreCxt -> User -> (GroupMemberRow :. MaybeConnectionRow :. MaybeBadgeProofRow) -> GroupMember +toContactMember now cxt User {userContactId} (memberRow :. connRow :. proofRow) = + (toGroupMember now userContactId memberRow) {activeConn = toMaybeConnection cxt connRow, memberBadgeProof = NoJSON $ maybeRowToBadgeProof proofRow} rowToLocalProfile :: UTCTime -> ProfileRow -> LocalProfile rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, description, image, contactLink, peerType, localAlias, encodedPrefs, receivedPrefs) :. badgeRow :. domainRow) = @@ -938,11 +942,7 @@ addGroupChatTags db g@GroupInfo {groupId} = do pure (g :: GroupInfo) {chatTags} getGroupInfoKeys :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO GroupInfoKeys -getGroupInfoKeys db cxt user groupId = do - (g@GroupInfo {membership}, keysData) <- getGroupInfoRow db cxt user groupId - gks <- mkGroupKeys db cxt g keysData - let membership' = membership {memberPubKey = Just $ C.publicKey $ memberPrivKey gks} :: GroupMember - pure $ GIK (g :: GroupInfo) {membership = membership'} gks +getGroupInfoKeys db cxt user groupId = uncurry (mkGroupInfoKeys db cxt) =<< getGroupInfoRow db cxt user groupId getGroupInfo :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO GroupInfo getGroupInfo db cxt user groupId = fst <$> getGroupInfoRow db cxt user groupId diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index cea169a4a4..81ed6ac5a8 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -54,7 +54,7 @@ import Data.Time.Clock (UTCTime) import Data.Type.Equality (testEquality, (:~:) (Refl)) import Data.Typeable (Typeable) import Data.Word (Word16) -import Simplex.Chat.Badges (BadgeInfo (..), BadgeProof (..), BadgeStatus (..), LocalBadge (..), localBadgeInfo, localBadgeStatus, mkBadgeStatus, verifyBadge) +import Simplex.Chat.Badges (BadgeInfo (..), BadgeProof (..), BadgeStatus (..), LocalBadge (..), ProofPresHeader, acceptedBadge, localBadgeInfo, localBadgeStatus, mkBadgeStatus, verifyBadge) import Simplex.Chat.Names (SimplexDomainClaim (..)) import Simplex.Messaging.Crypto.BBS (BBSPublicKey) import Simplex.Chat.Types.Preferences @@ -855,15 +855,18 @@ 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} = - case (localBadge, newBadge) of +profileBadgeVerified :: Maybe ProofPresHeader -> Map Int BBSPublicKey -> Maybe LocalProfile -> Profile -> IO (Profile, Maybe Bool) +profileBadgeVerified expected keys lp_ p@Profile {badge = rcvBadge} = + (,) p {badge = newBadge} <$> case (storedBadge, newBadge) of (_, Nothing) -> pure (Just False) -- an unchanged badge that verified before stays verified; failed or unknown-key badges -- are re-verified, so an unknown key heals once an app update adds it (Just lb, Just (BadgeProof _ _ _ newInfo)) | localBadgeInfo lb == newInfo && localBadgeStatus lb `notElem` [BSFailed, BSUnknownKey] -> pure (Just True) (_, Just newB) -> verifyBadge keys newB + where + storedBadge = (\LocalProfile {localBadge} -> localBadge) =<< lp_ + newBadge = acceptedBadge expected ((\Profile {badge} -> badge) . fromLocalProfile =<< lp_) rcvBadge -- a failed or unknown-key badge is re-verified on the next profile update even when its disclosed content -- is unchanged, so it heals once an app update adds the issuer key @@ -1007,7 +1010,9 @@ data GroupRelayInvitation = GroupRelayInvitation { fromMember :: MemberIdRole, fromMemberProfile :: Profile, relayMemberId :: MemberId, - groupLink :: ShortLinkContact + groupLink :: ShortLinkContact, + publicGroupId :: Maybe B64UrlByteString, + fromMemberKey :: Maybe MemberKey } deriving (Eq, Show) @@ -1210,13 +1215,15 @@ data GroupMember = GroupMember relayLink :: Maybe ShortLinkContact, -- out-of-band verified security code for connectionless (channel) members; -- regular members carry it in activeConn instead (see memberSecurityCode) - memberVerifiedCode :: Maybe SecurityCode + memberVerifiedCode :: Maybe SecurityCode, + memberBadgeProof :: NoJSON BadgeProof } deriving (Eq, Show) data RelayRequestData = RelayRequestData { relayInvId :: InvitationId, reqGroupLink :: ShortLinkContact, + reqPublicGroupId :: Maybe B64UrlByteString, reqChatVRange :: VersionRangeChat, reqDelay :: Int64, reqRetries :: Int, diff --git a/src/Simplex/Chat/Types/Preferences.hs b/src/Simplex/Chat/Types/Preferences.hs index 7445a9c2d5..ae257b5025 100644 --- a/src/Simplex/Chat/Types/Preferences.hs +++ b/src/Simplex/Chat/Types/Preferences.hs @@ -151,20 +151,22 @@ setPreference_ f pref_ prefs = SCFCalls -> prefs {calls = pref_} SCFSessions -> prefs {sessions = pref_} -newtype PrefsJSON = PrefsJSON {unPrefsJSON :: Maybe Object} +newtype NoJSON a = NoJSON {unNoJSON :: Maybe a} deriving (Eq, Show) -instance ToJSON PrefsJSON where +instance ToJSON (NoJSON a) where toJSON _ = Null toEncoding _ = JE.null_ omitField _ = True -instance FromJSON PrefsJSON where - parseJSON _ = pure $ PrefsJSON Nothing - omittedField = Just $ PrefsJSON Nothing +instance FromJSON (NoJSON a) where + parseJSON _ = pure $ NoJSON Nothing + omittedField = Just $ NoJSON Nothing + +type PrefsJSON = NoJSON Object keepPrefsJSON :: (ToJSON p, HasField "_json" p PrefsJSON) => Value -> p -> p -keepPrefsJSON v ps = setField @"_json" ps . PrefsJSON $ case v of +keepPrefsJSON v ps = setField @"_json" ps . NoJSON $ case v of Object o | v /= toJSON ps -> Just o _ -> Nothing @@ -177,7 +179,7 @@ prefsFromRow_ prefsP encodedPrefs receivedPrefs = (decode =<< receivedPrefs) <|> decode = decodePrefs prefsP prefsToRow :: HasField "_json" p PrefsJSON => Maybe p -> (Maybe p, Maybe Text) -prefsToRow ps = (ps, encodeJSON . Object <$> (unPrefsJSON . getField @"_json" =<< ps)) +prefsToRow ps = (ps, encodeJSON . Object <$> (unNoJSON . getField @"_json" =<< ps)) -- collection of optional chat preferences for the user and the contact data Preferences = Preferences @@ -545,7 +547,7 @@ toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, files, calls = Just calls, sessions = Just sessions, commands = Just cmds, - _json = PrefsJSON Nothing + _json = NoJSON Nothing } defaultChatPrefs :: FullPreferences @@ -562,7 +564,7 @@ defaultChatPrefs = } emptyChatPrefs :: Preferences -emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (PrefsJSON Nothing) +emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (NoJSON Nothing) defaultGroupPrefs :: FullGroupPreferences defaultGroupPrefs = @@ -584,7 +586,7 @@ defaultGroupPrefs = } emptyGroupPrefs :: GroupPreferences -emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (PrefsJSON Nothing) +emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (NoJSON Nothing) businessGroupPrefs :: Preferences -> GroupPreferences businessGroupPrefs Preferences {timedMessages, fullDelete, reactions, voice, files, sessions, commands} = @@ -620,7 +622,7 @@ defaultBusinessGroupPrefs = comments = Just $ CommentsGroupPreference FEOff Nothing, signMessages = Just $ SignMessagesGroupPreference FEOff, commands = Nothing, - _json = PrefsJSON Nothing + _json = NoJSON Nothing } data TimedMessagesPreference = TimedMessagesPreference @@ -1133,7 +1135,7 @@ toGroupPreferences groupPreferences@FullGroupPreferences {commands = ListDef cmd comments = pref SGFComments, signMessages = pref SGFSignMessages, commands = Just cmds, - _json = PrefsJSON Nothing + _json = NoJSON Nothing } where pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f) diff --git a/tests/BadgeTests.hs b/tests/BadgeTests.hs index ced51a5bbf..360c97edf0 100644 --- a/tests/BadgeTests.hs +++ b/tests/BadgeTests.hs @@ -53,6 +53,7 @@ badgeTests = do it "presentation headers encode and decode" testPresHeaderEncoding it "presentation headers with binary bytes round-trip through JSON" testPresHeaderJSON 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 @@ -207,6 +208,8 @@ testPresHeaderEncoding = PHFileInv {chatBinding = aliceBinding, fileSize = 139737}, PHFileDescr {chatBinding = aliceBinding, fileSize = 139737, descrHash = "descr-hash", fileExpires = Nothing}, PHFileDescr {chatBinding = aliceBinding, fileSize = 139737, descrHash = "descr-hash", fileExpires = Just futureTime}, + PHRequest requestCode, + PHLink "link-key", PHUnknown 'Z' "payload" ] @@ -220,6 +223,8 @@ testPresHeaderJSON = [ PHChat binaryBytes, PHFileInv {chatBinding = binaryBytes, fileSize = 139737}, PHFileDescr {chatBinding = binaryBytes, fileSize = 139737, descrHash = binaryBytes, fileExpires = Just futureTime}, + PHRequest binaryBytes, + PHLink binaryBytes, PHUnknown 'Z' binaryBytes ] where @@ -233,12 +238,33 @@ 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) + (pk'', requested) <- issueBadgeProofHeader BTSupporter futureTime (PHRequest requestCode) + acceptedProof Nothing unbound `shouldBe` True + acceptedProof (Just $ PHChat aliceBinding) unbound `shouldBe` True + acceptedProof (Just $ PHChat aliceBinding) bound `shouldBe` True + acceptedProof (Just $ PHChat bobBinding) bound `shouldBe` False + acceptedProof (Just $ PHRequest aliceBinding) bound `shouldBe` False + acceptedProof Nothing bound `shouldBe` False + acceptedProof (Just $ PHRequest requestCode) requested `shouldBe` True + acceptedProof (Just $ PHRequest "other-request-code") requested `shouldBe` False + acceptedProof (Just $ PHChat requestCode) requested `shouldBe` False + verifyBadge (keysFor pk) unbound >>= (`shouldBe` Just True) + verifyBadge (keysFor pk') bound >>= (`shouldBe` Just True) + verifyBadge (keysFor pk'') requested >>= (`shouldBe` Just True) + aliceBinding :: ByteString aliceBinding = "Galice-member-id" bobBinding :: ByteString bobBinding = "Gbob-member-id" +requestCode :: ByteString +requestCode = "request-code" + issueBadgeProof :: BadgeType -> UTCTime -> IO (BBSPublicKey, BadgeProof) issueBadgeProof bt expiry = issueBadgeProofHeader bt expiry (PHTest "test-nonce") diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index e349a71f0a..bf53060a67 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -21,6 +21,7 @@ import Control.Concurrent.Async (concurrently_) import Control.Concurrent.STM (atomically) import Control.Monad (forM_, void, when) import Control.Monad.Except (runExceptT) +import Control.Monad.Reader (runReaderT) import Data.Bifunctor (second) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B @@ -31,26 +32,28 @@ import Data.List (intercalate, isInfixOf, isSuffixOf) import qualified Data.Map.Strict as M import qualified Data.Text as T import Simplex.Chat.Badges (FileSizeLimits (..)) -import Simplex.Chat.Controller (ChatController (ChatController, smpAgent), ChatConfig (..), ChatHooks (..), ChatLogLevel (..), defaultChatHooks) -import Simplex.Chat.Library.Internal (uniqueMsgMentions, updatedMentionNames) +import Simplex.Chat.Controller (ChatController (ChatController, smpAgent), ChatConfig (..), ChatHooks (..), ChatLogLevel (..), defaultChatHooks, withAgent) +import Simplex.Chat.Library.Internal (encodeConnInfo, getShortLinkConnReq, uniqueMsgMentions, updatedMentionNames) import Simplex.Chat.Markdown (parseMaybeMarkdownList) import Simplex.Chat.Messages (CIMention (..), CIMentionMember (..), ChatItemId) import Simplex.Chat.Messages.Batch (encodeBinaryBatch, encodeFwdElement) import Simplex.Chat.Messages.CIContent (publicGroupNoE2EText) import Simplex.Chat.Options -import Simplex.Chat.Protocol (ChatMessage (ChatMessage), ChatMsgEvent (XGrpMemNew, XInfo, XMsgUpdate, XMsgNew, XMsgDel), FwdSender (FwdMember, FwdChannel), GrpMsgForward (GrpMsgForward), MsgContainer (..), MsgMention (..), MsgContent (..), VerifiedMsg (VMUnsigned), mcSimple, msgContentText) +import Simplex.Chat.Protocol (ChatMessage (ChatMessage), ChatMsgEvent (XGrpMemNew, XGrpRelayInv, XInfo, XMsgUpdate, XMsgNew, XMsgDel), FwdSender (FwdMember, FwdChannel), GrpMsgForward (GrpMsgForward), MsgContainer (..), MsgMention (..), MsgContent (..), VerifiedMsg (VMUnsigned), mcSimple, msgContentText) import Simplex.Chat.Types import Simplex.Chat.Types.MemberRelations (MemberRelation (..), getRelation, setRelation) import Simplex.Chat.Types.Shared (GroupMemberRole (..), GroupAcceptance (..)) -import Simplex.Messaging.Agent (sendMessages, vrValue) +import Simplex.Messaging.Agent (joinConnection, prepareConnectionToJoin, sendMessages, vrValue) import Simplex.Messaging.Agent.Env.SQLite import Simplex.Messaging.Agent.RetryInterval import qualified Simplex.Messaging.Agent.Store.DB as DB import Simplex.Messaging.Agent.Store.DB (Binary (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.BBS (bbsKeyGen) -import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff) -import Simplex.Messaging.Protocol (MsgFlags (..)) +import Simplex.Messaging.Client (pattern NRMInteractive) +import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff) +import Simplex.Messaging.Encoding.String (strDecode) +import Simplex.Messaging.Protocol (MsgFlags (..), SubscriptionMode (..)) import Simplex.Messaging.Server.Env.STM hiding (subscriptions) import Simplex.Messaging.Transport import Simplex.Messaging.Version @@ -306,6 +309,9 @@ chatGroupTests = do it "should report relay results when one relay deleted its address" testChannelCreateDeletedRelay it "should deliver support scope messages via relay" testChannelSupportScope it "should add relay to existing channel" testChannelAddRelay + it "should not add relay when the invitation owner key differs from link data" testChannelAddRelayOwnerKeyMismatch + it "should not add relay when the invitation group id differs from link data" testChannelAddRelayGroupIdMismatch + it "should ignore relay invitation without the owner's signature" testChannelRelayInvUnsigned it "should remove relay from channel" testChannelRemoveRelay it "should remove left relay from channel" testChannelRemoveLeftRelay describe "relay rejection" $ do @@ -11299,6 +11305,76 @@ testChannelAddRelay ps = [bob, cath] *<# "#team> hello" [dan, eve] *<# "#team> hello [>>]" +testChannelAddRelayOwnerKeyMismatch :: HasCallStack => TestParams -> IO () +testChannelAddRelayOwnerKeyMismatch ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> do + _ <- prepareChannel1Relay "team" alice bob + cath ##> "/ad" + (cathSLink, _cLink) <- getContactLinks cath True + alice ##> ("/relays name=cath " <> cathSLink) + alice <## "ok" + (otherKey :: C.PublicKeyEd25519, otherPrivKey :: C.PrivateKeyEd25519) <- atomically . C.generateKeyPair =<< C.newRandom + withCCTransaction alice $ \db -> do + DB.execute db "UPDATE groups SET member_priv_key = ?" (Only otherPrivKey) + DB.execute db "UPDATE group_members SET member_pub_key = ? WHERE member_category = 'user'" (Only otherKey) + alice ##> "/_add relays #1 2" + alice <## "#team: group relays:" + alice <## " - relay id 1: active" + alice <## " - relay id 2: invited" + cath <## "exception: getLinkDataCreateRelayLink: owner key of invitation does not match link data" + queryRelayOwnStatus cath 1 `shouldReturn` Just "invited" + +testChannelAddRelayGroupIdMismatch :: HasCallStack => TestParams -> IO () +testChannelAddRelayGroupIdMismatch ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> do + _ <- prepareChannel1Relay "team" alice bob + cath ##> "/ad" + (cathSLink, _cLink) <- getContactLinks cath True + alice ##> ("/relays name=cath " <> cathSLink) + alice <## "ok" + withCCTransaction alice $ \db -> + DB.execute db "UPDATE group_profiles SET public_group_id = ?" (Only (B64UrlByteString "other group id")) + alice ##> "/_add relays #1 2" + alice <## "#team: group relays:" + alice <## " - relay id 1: active" + alice <## " - relay id 2: invited" + cath <## "exception: getLinkDataCreateRelayLink: linkEntityId does not match publicGroupId of profile or invitation" + queryRelayOwnStatus cath 1 `shouldReturn` Just "invited" + +testChannelRelayInvUnsigned :: HasCallStack => TestParams -> IO () +testChannelRelayInvUnsigned ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> do + cath ##> "/ad" + (cathSLink, _cLink) <- getContactLinks cath True + sendUnsignedRelayInv alice cathSLink + cath <##. "error: x.grp.relay.inv: invitation is not signed by the owner" + +sendUnsignedRelayInv :: TestCC -> String -> IO () +sendUnsignedRelayInv cc relayAddress = + withCCUser cc $ \user -> do + relayLink :: ShortLinkContact <- either fail pure $ strDecode (B.pack relayAddress) + (memberKey, _) <- atomically . C.generateKeyPair =<< C.newRandom + let inv = + GroupRelayInvitation + { fromMember = MemberIdRole (MemberId "owner") GROwner, + fromMemberProfile = aliceProfile, + relayMemberId = MemberId "relay", + groupLink = relayLink, + publicGroupId = Just $ B64UrlByteString "group id", + fromMemberKey = Just $ MemberKey memberKey + } + joinRelay = do + (_, _, cReq) <- getShortLinkConnReq NRMInteractive user relayLink + (connId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq PQSupportOff + dm <- encodeConnInfo $ XGrpRelayInv inv + withAgent $ \a -> joinConnection a NRMInteractive (aUserId user) connId True cReq dm PQSupportOff SMSubscribe + runExceptT joinRelay `runReaderT` chatController cc >>= either (fail . show) (\_ -> pure ()) + testChannelAddRelayWithRoster :: HasCallStack => TestParams -> IO () testChannelAddRelayWithRoster ps = withNewTestChat ps "alice" aliceProfile $ \alice -> diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 06b85fdb72..3779006d8d 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PostfixOperators #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} @@ -16,6 +17,7 @@ import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_) import Control.Monad import Control.Monad.Except +import Control.Monad.Reader (runReaderT) import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.ByteString.Char8 as B import qualified Data.Text as T @@ -23,24 +25,36 @@ import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime, nominalDay) import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Data.Time.Format (defaultTimeLocale, formatTime) import qualified Data.Map.Strict as M -import Simplex.Chat.Badges (BadgeCredential, BadgeInfo (..), BadgePurchase (..), BadgeRequest (..), BadgeType (..), generateMasterKey, issueBadge, verifyPayment) -import Simplex.Chat.Controller (ChatConfig (..), ChatHooks (..), defaultChatHooks, storeCxt) +import Simplex.Chat.Badges (BadgeCredential, BadgeInfo (..), BadgeProof, BadgePurchase (..), BadgeRequest (..), BadgeStatus (..), BadgeType (..), LocalBadge (..), ProofPresHeader (..), badgeProof, generateMasterKey, issueBadge, verifyPayment) +import Simplex.Chat.Controller (ChatConfig (..), ChatController (ChatController, smpAgent), ChatHooks (..), defaultChatHooks, storeCxt) +import Simplex.Chat.Library.Internal (encodeShortLinkData, groupMemberKey, redactedMemberProfile, sendDirectContactMessage, sendGroupMessage') import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..)) -import Simplex.Chat.Protocol (LinkOwnerSig, MsgChatLink (..), MsgContent (..)) -import Simplex.Chat.Store.Shared (createContact) -import Simplex.Chat.Types (ConnStatus (..), Profile (..), GroupRejectionReason (..), profileFromName) +import Simplex.Chat.Protocol (ChatBinding (..), ChatMsgEvent (XInfo), ContactShortLinkData (ContactShortLinkData), LinkOwnerSig, MsgChatLink (..), MsgContent (..), encodeChatBinding) +import Simplex.Chat.Store.Groups (getGroupMembers) +import Simplex.Chat.Store.Shared (createContact, getGroupInfoKeys) +import Simplex.Chat.Types (AgentConnId (..), ConnStatus (..), GroupId, GroupInfo (..), GroupInfoKeys (..), GroupMember (..), Profile (..), GroupRejectionReason (..), fromLocalProfile, profileFromName, userProfileDirect, pattern VersionChat) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.BBS (BBSPublicKey, BBSSecretKey, bbsKeyGen) import Simplex.Chat.Types.Shared (GroupMemberRole (..)) import Simplex.Chat.Types.UITheme +import Simplex.Messaging.Agent (setConnShortLink) import Simplex.Messaging.Agent.Env.SQLite +import Simplex.Messaging.Agent.Protocol (SConnectionMode (..), UserConnLinkData (..)) import Simplex.Messaging.Agent.RetryInterval +import qualified Simplex.Messaging.Agent.Store.DB as DB +import Simplex.Messaging.Client (pattern NRMInteractive) import Simplex.Messaging.Encoding.String (StrEncoding (..)) import Simplex.Messaging.Server.Env.STM hiding (subscriptions) import Simplex.Messaging.Transport import Simplex.Messaging.Util (decodeJSON, encodeJSON) +import Simplex.Messaging.Version (mkVersionRange) import System.Directory (copyFile, createDirectoryIfMissing) import Test.Hspec hiding (it) +#if defined(dbPostgres) +import Database.PostgreSQL.Simple (Only (..)) +#else +import Database.SQLite.Simple (Only (..)) +#endif chatProfileTests :: SpecWith TestParams chatProfileTests = do @@ -62,10 +76,30 @@ 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 unsigned to member with version below 18 connecting in group" testUserBadgeGroupHandshakeOldMember + 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 it "supporter badge sent to contact connecting via address" testUserBadgeContactAddress + it "supporter badge in a request to an address" testUserBadgeAddressRequest + it "supporter badge in a request to an address with ratchet keys" testUserBadgeAddressRequestRatchet + it "supporter badge sent joining a one-time link" testUserBadgeInvitationJoin + it "supporter badge sent in a retried request to an address" testUserBadgeAddressConnectRetry + it "supporter badge sent in a retried join of a one-time link" testUserBadgeInvitationConnectRetry + it "supporter badge bound to another chat is ignored, stored badge is kept" testUserBadgeOtherBinding + it "supporter badge of member bound to another member is ignored, stored badge is kept" testUserBadgeMemberOtherBinding + it "supporter badge of member joining via group link, at request and after handshake" testUserBadgeGroupLinkJoiner + it "supporter badge of introduced member is taken from the introduction" testUserBadgeIntroduced + it "supporter badge of member invited via contact is forwarded in the introduction" testUserBadgeInvitedIntroduced + it "supporter badge of inviting host in the reply to the invited contact" testUserBadgeInvitingHost + it "supporter badge proof of member is deleted with a profile without badge" testUserBadgeMemberRemoved + it "supporter badge proof of member with contact is deleted with a profile without badge" testUserBadgeContactMemberRemoved + it "supporter badge in one-time link data" testUserBadgeInvitationLinkData + it "supporter badge in data of address getting its first short link" testUserBadgeAddressFirstShortLink + it "supporter badge in link data bound to another link is not shown" testUserBadgeLinkDataOtherLink + it "supporter badge in link data without a proof is not shown" testUserBadgeLinkDataNoProof describe "user contact link" $ do it "create and connect via contact link" testUserContactLink it "rotate address ratchet keys" testRotateAddressRatchetKeys @@ -395,6 +429,9 @@ testBadgeKeys = M.singleton 1 futureDate :: UTCTime futureDate = posixSecondsToUTCTime 4102444800 -- 2100-01-01 +pastDate :: UTCTime +pastDate = posixSecondsToUTCTime 1577836800 -- 2020-01-01 + -- issue a supporter badge credential with the given expiry (test issuer) issueTestBadge :: BBSSecretKey -> UTCTime -> IO BadgeCredential issueTestBadge sk = issueTestBadgeType sk BTSupporter @@ -494,6 +531,83 @@ 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" + ] + 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 + +testUserBadgeGroupHandshakeOldMember :: HasCallStack => TestParams -> IO () +testUserBadgeGroupHandshakeOldMember ps = do + Right (pk, sk) <- bbsKeyGen + let cfg = testCfg {badgePublicKeys = testBadgeKeys pk} + oldCfg = cfg {chatVRange = mkVersionRange (VersionChat 9) (VersionChat 17)} + withNewTestChatCfg ps oldCfg "alice" aliceProfile $ \alice -> + withNewTestChatCfg ps cfg "bob" bobProfile $ \bob -> + withNewTestChatCfg ps oldCfg "cath" cathProfile $ \cath -> do + connectUsers alice bob + addTestBadge bob =<< issueTestBadge sk futureDate + createGroup2' "team" alice (bob, GRAdmin) False + memberProofHeader alice "team" "bob" `shouldReturn` Nothing + 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" + ] + memberBadgeHeader cath "team" "bob" `shouldReturn` Nothing + +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 + 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 @@ -570,7 +684,6 @@ testUserBadgeExpiredOld ps = do bob <## "connection not verified, use /code command to see security code" bob <## "quantum resistant end-to-end encryption" bob <## currentChatVRangeInfo - pastDate = posixSecondsToUTCTime 1577836800 -- 2020-01-01 testUserBadgeIncognito :: HasCallStack => TestParams -> IO () testUserBadgeIncognito ps = do @@ -600,6 +713,455 @@ testUserBadgeIncognito ps = do bob <## "quantum resistant end-to-end encryption" bob <## currentChatVRangeInfo +testUserBadgeAddressRequest :: HasCallStack => TestParams -> IO () +testUserBadgeAddressRequest ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps + where + test sk alice bob = do + addTestBadge bob =<< issueTestBadge sk futureDate + alice ##> "/ad" + cLink <- getContactLink alice True + bob ##> ("/c " <> cLink) + alice <#? bob + requestBadgeHeader alice "bob" `shouldReturn` Just ("R", BSActive) + alice ##> "/ac bob" + alice <## "bob (Bob, * supporter): accepting contact request, you can send messages to contact" + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob, * supporter): contact is connected") + fmap snd <$> contactBadgeHeader alice "bob" `shouldReturn` Just BSActive + +testUserBadgeAddressRequestRatchet :: HasCallStack => TestParams -> IO () +testUserBadgeAddressRequestRatchet ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps + where + test sk alice bob = do + addTestBadge bob =<< issueTestBadge sk futureDate + alice ##> "/ad pq_ratchet=on" + (sLink, _) <- getContactLinks alice True + bob ##> ("/c " <> sLink) + alice <#? bob + requestBadgeHeader alice "bob" `shouldReturn` Just ("CD", BSActive) + alice ##> "/ac bob" + alice <## "bob (Bob, * supporter): accepting contact request, you can send messages to contact" + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob, * supporter): contact is connected") + fmap snd <$> contactBadgeHeader alice "bob" `shouldReturn` Just BSActive + +testUserBadgeInvitationJoin :: HasCallStack => TestParams -> IO () +testUserBadgeInvitationJoin ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps + where + test sk alice bob = do + addTestBadge bob =<< issueTestBadge sk futureDate + alice ##> "/c" + inv <- getInvitation alice + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob, * supporter): contact is connected") + contactBadgeHeader alice "bob" `shouldReturn` Just ("CD", BSActive) + +testUserBadgeAddressConnectRetry :: HasCallStack => TestParams -> IO () +testUserBadgeAddressConnectRetry ps = do + Right (pk, sk) <- bbsKeyGen + let cfg' = testCfg {badgePublicKeys = testBadgeKeys pk, agentConfig = testAgentCfg {persistErrorInterval = 0}} + withNewTestChatCfgOpts ps cfg' opts' "alice" aliceProfile $ \alice -> + withNewTestChatCfgOpts ps cfg' opts' "bob" bobProfile $ \bob -> do + addTestBadge bob =<< issueTestBadge sk futureDate + withSmpServer' serverCfg' $ do + alice ##> "/ad" + (shortLink, fullLink) <- getContactLinks alice True + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "contact address: ok to connect" + contactSLinkData <- getTermLine bob + bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> contactSLinkData) + bob <## "alice: contact is prepared" + alice <## "disconnected 1 connections on server localhost" + bob ##> "/_connect contact @2" + bob <##. "smp agent error: BROKER" + withSmpServer' serverCfg' $ do + alice <## "subscribed 1 connections on server localhost" + threadDelay 250000 + bob ##> "/_connect contact @2" + bob <## "alice: connection started" + alice <## "bob (Bob) wants to connect to you!" + alice <## "to accept: /ac bob" + alice <## "to reject: /rc bob (the sender will NOT be notified)" + requestBadgeHeader alice "bob" `shouldReturn` Just ("R", BSActive) + alice ##> "/ac bob" + alice <## "bob (Bob, * supporter): accepting contact request, you can send messages to contact" + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob, * supporter): contact is connected") + alice <## "disconnected 2 connections on server localhost" + bob <## "disconnected 1 connections on server localhost" + where + serverCfg' = + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], + serverStoreCfg = persistentServerStoreCfg (tmpPath ps) + } + opts' = + testOpts + { coreOptions = + testCoreOpts + { smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7003"] + } + } + +testUserBadgeInvitationConnectRetry :: HasCallStack => TestParams -> IO () +testUserBadgeInvitationConnectRetry ps = do + Right (pk, sk) <- bbsKeyGen + let cfg' = testCfg {badgePublicKeys = testBadgeKeys pk, agentConfig = testAgentCfg {persistErrorInterval = 0}} + withNewTestChatCfgOpts ps cfg' opts' "alice" aliceProfile $ \alice -> + withNewTestChatCfgOpts ps cfg' opts' "bob" bobProfile $ \bob -> do + addTestBadge bob =<< issueTestBadge sk futureDate + withSmpServer' serverCfg' $ do + alice ##> "/_connect 1" + (shortLink, fullLink) <- getInvitations alice + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "invitation link: ok to connect" + contactSLinkData <- getTermLine bob + bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> contactSLinkData) + bob <## "alice: contact is prepared" + alice <## "disconnected 1 connections on server localhost" + bob ##> "/_connect contact @2" + bob <##. "smp agent error: BROKER" + withSmpServer' serverCfg' $ do + alice <## "subscribed 1 connections on server localhost" + threadDelay 250000 + bob ##> "/_connect contact @2" + bob <## "alice: connection started" + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob, * supporter): contact is connected") + contactBadgeHeader alice "bob" `shouldReturn` Just ("CD", BSActive) + alice <## "disconnected 1 connections on server localhost" + bob <## "disconnected 1 connections on server localhost" + where + serverCfg' = + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], + serverStoreCfg = persistentServerStoreCfg (tmpPath ps) + } + opts' = + testOpts + { coreOptions = + testCoreOpts + { smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7003"] + } + } + +testUserBadgeOtherBinding :: HasCallStack => TestParams -> IO () +testUserBadgeOtherBinding ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test pk sk) ps + where + test pk sk alice bob = do + addTestBadge alice =<< issueTestBadge sk futureDate + alice ##> "/c" + inv <- getInvitation alice + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + concurrently_ + (bob <## "alice (Alice, * supporter): contact is connected") + (alice <## "bob (Bob): contact is connected") + contactBadgeHeader bob "alice" `shouldReturn` Just ("CD", BSActive) + legend <- issueTestBadgeType sk BTLegend futureDate + Right otherProof <- badgeProof pk legend (PHChat $ encodeChatBinding CBGroup "other chat") + withCCUser alice $ \user -> do + ct <- getTestCCContact alice 2 + let p = (userProfileDirect user Nothing (Just ct) True) {badge = Just otherProof} + runExceptT (sendDirectContactMessage user ct (XInfo p Nothing)) `runReaderT` chatController alice + >>= either (fail . show) (\_ -> pure ()) + alice #> "@bob hi" + bob <# "alice *> hi" + contactBadgeHeader bob "alice" `shouldReturn` Just ("CD", BSActive) + bob ##> "/i alice" + bob <## "contact ID: 2" + bob <## "supporter badge - active" + bob <## "expires 2100-01-01" + bob <## "receiving messages via: localhost" + bob <## "sending messages via: localhost" + bob <## "you've shared main profile with this contact" + bob <## "connection not verified, use /code command to see security code" + bob <## "quantum resistant end-to-end encryption" + bob <## currentChatVRangeInfo + +testUserBadgeGroupLinkJoiner :: HasCallStack => TestParams -> IO () +testUserBadgeGroupLinkJoiner ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps + where + test sk alice bob = do + addTestBadge bob =<< issueTestBadge sk futureDate + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + bob ##> "/_stop" + bob <## "chat stopped" + alice <## "bob (Bob): accepting request to join group #team..." + memberBadgeHeader alice "team" "bob" `shouldReturn` Just ("R", BSActive) + bob ##> "/_start" + bob <## "chat started" + bob <## "subscribed 1 connections on server localhost" + concurrentlyN_ + [ alice <## "#team: bob joined the group", + do + bob <## "#team: joining the group..." + bob <## "#team: you joined the group" + ] + memberBadgeHeader alice "team" "bob" `shouldReturn` Just ("CG", BSActive) + +testUserBadgeIntroduced :: HasCallStack => TestParams -> IO () +testUserBadgeIntroduced ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg3 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile cathProfile (test sk) ps + where + test sk alice bob cath = do + addTestBadge bob =<< issueTestBadge sk futureDate + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob (Bob): accepting request to join group #team..." + concurrentlyN_ + [ alice <## "#team: bob joined the group", + do + bob <## "#team: joining the group..." + bob <## "#team: you joined the group" + ] + memberBadgeHeader alice "team" "bob" `shouldReturn` Just ("CG", BSActive) + bob ##> "/_stop" + bob <## "chat stopped" + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + alice <## "cath (Catherine): accepting request to join group #team..." + concurrentlyN_ + [ alice <## "#team: cath joined the group", + do + cath <## "#team: joining the group..." + cath <## "#team: you joined the group" + ] + alice #> "#team hello" + cath <# "#team alice> hello" + memberBadgeHeader cath "team" "bob" `shouldReturn` Just ("CG", BSActive) + +testUserBadgeInvitedIntroduced :: HasCallStack => TestParams -> IO () +testUserBadgeInvitedIntroduced 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 cath + connectUsers alice bob + addTestBadge bob =<< issueTestBadge sk futureDate + bob #> "@alice hi" + alice <# "bob *> hi" + cath ##> "/_stop" + cath <## "chat stopped" + addMember "team" alice bob GRAdmin + bob ##> "/j team" + concurrently_ + (alice <## "#team: bob joined the group") + (bob <## "#team: you joined the group") + memberBadgeHeader alice "team" "bob" `shouldReturn` Just ("CD", BSActive) + memberProofHeader alice "team" "bob" `shouldReturn` Just "CG" + bob ##> "/_stop" + bob <## "chat stopped" + cath ##> "/_start" + cath <## "chat started" + cath <## "subscribed 2 connections on server localhost" + cath <## "#team: alice added bob (Bob) to the group (connecting...)" + memberBadgeHeader cath "team" "bob" `shouldReturn` Just ("CG", BSActive) + +testUserBadgeInvitingHost :: HasCallStack => TestParams -> IO () +testUserBadgeInvitingHost ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps + where + test sk alice bob = do + connectUsers alice bob + addTestBadge alice =<< issueTestBadge sk futureDate + alice #> "@bob hi" + bob <# "alice *> hi" + createGroup2' "team" alice (bob, GRAdmin) False + memberBadgeHeader bob "team" "alice" `shouldReturn` Just ("CD", BSActive) + memberProofHeader bob "team" "alice" `shouldReturn` Just "CG" + +testUserBadgeMemberRemoved :: HasCallStack => TestParams -> IO () +testUserBadgeMemberRemoved ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps + where + test sk alice bob = do + addTestBadge bob =<< issueTestBadge sk futureDate + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob (Bob): accepting request to join group #team..." + concurrentlyN_ + [ alice <## "#team: bob joined the group", + do + bob <## "#team: joining the group..." + bob <## "#team: you joined the group" + ] + memberProofHeader alice "team" "bob" `shouldReturn` Just "CG" + addTestBadge bob =<< issueTestBadge sk pastDate + bob #> "#team hi" + alice <# "#team bob> hi" + memberProofHeader alice "team" "bob" `shouldReturn` Nothing + memberBadgeHeader alice "team" "bob" `shouldReturn` Nothing + +testUserBadgeContactMemberRemoved :: HasCallStack => TestParams -> IO () +testUserBadgeContactMemberRemoved ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps + where + test sk alice bob = do + createGroup2 "team" alice bob + addTestBadge bob =<< issueTestBadge sk futureDate + bob #> "#team hello" + alice <# "#team bob> hello" + memberProofHeader alice "team" "bob" `shouldReturn` Just "CG" + addTestBadge bob =<< issueTestBadge sk pastDate + bob #> "#team hi" + alice <# "#team bob> hi" + memberProofHeader alice "team" "bob" `shouldReturn` Nothing + +testUserBadgeInvitationLinkData :: HasCallStack => TestParams -> IO () +testUserBadgeInvitationLinkData ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps + where + test sk alice bob = do + addTestBadge alice =<< issueTestBadge sk futureDate + alice ##> "/_connect 1" + (shortLink, fullLink) <- getInvitations alice + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "invitation link: ok to connect" + sLinkData <- getTermLine bob + sLinkData `shouldContain` "\"localBadge\":{\"badge\":{\"badgeType\":\"supporter\"" + sLinkData `shouldContain` "\"status\":\"active\"" + bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> sLinkData) + bob <## "alice: contact is prepared" + contactBadgeHeader bob "alice" `shouldReturn` Just ("L", BSActive) + +testUserBadgeAddressFirstShortLink :: HasCallStack => TestParams -> IO () +testUserBadgeAddressFirstShortLink ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps + where + test sk alice bob = do + addTestBadge alice =<< issueTestBadge sk futureDate + alice ##> "/ad" + _ <- getContactLinks alice True + withCCTransaction alice $ \db -> DB.execute_ db "UPDATE user_contact_links SET short_link_contact = NULL" + alice ##> "/_short_link_address 1" + (shortLink, _) <- getContactLinks alice False + alice <## "auto_accept off" + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "contact address: ok to connect" + sLinkData <- getTermLine bob + sLinkData `shouldContain` "\"localBadge\":{\"badge\":{\"badgeType\":\"supporter\"" + sLinkData `shouldContain` "\"status\":\"active\"" + +testUserBadgeMemberOtherBinding :: HasCallStack => TestParams -> IO () +testUserBadgeMemberOtherBinding ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg3 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile cathProfile (test pk sk) ps + where + test pk sk alice bob cath = do + createGroup3 "team" alice bob cath + addTestBadge bob =<< issueTestBadge sk futureDate + bob #> "#team hello" + alice <# "#team bob> hello" + cath <# "#team bob> hello" + memberBadgeHeader cath "team" "bob" `shouldReturn` Just ("CG", BSActive) + legend <- issueTestBadgeType sk BTLegend futureDate + Right otherProof <- badgeProof pk legend (PHChat $ encodeChatBinding CBGroup "other member") + sendTestMemberProof bob 1 otherProof + bob #> "#team hi" + alice <# "#team bob> hi" + cath <# "#team bob> hi" + memberProofHeader cath "team" "bob" `shouldReturn` Just "CG" + 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 + +testUserBadgeLinkDataOtherLink :: HasCallStack => TestParams -> IO () +testUserBadgeLinkDataOtherLink ps = do + Right (pk, sk) <- bbsKeyGen + testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test pk sk) ps + where + test pk sk alice bob = do + cred <- issueTestBadge sk futureDate + addTestBadge alice cred + alice ##> "/_connect 1" + (shortLink, _) <- getInvitations alice + Right otherProof <- badgeProof pk cred (PHLink "other link key") + setTestInvLinkData alice $ ContactShortLinkData aliceProfile {badge = Just otherProof} Nothing False Nothing + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "invitation link: ok to connect" + sLinkData <- getTermLine bob + sLinkData `shouldContain` "\"proof\":" + sLinkData `shouldNotContain` "localBadge" + +testUserBadgeLinkDataNoProof :: HasCallStack => TestParams -> IO () +testUserBadgeLinkDataNoProof = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/_connect 1" + (shortLink, _) <- getInvitations alice + let shownBadge = ShownBadge BadgeInfo {badgeType = BTSupporter, badgeExpiry = futureDate, badgeExtra = ""} BSActive + setTestInvLinkData alice $ ContactShortLinkData aliceProfile Nothing False (Just shownBadge) + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "invitation link: ok to connect" + sLinkData <- getTermLine bob + sLinkData `shouldNotContain` "localBadge" + +sendTestMemberProof :: TestCC -> GroupId -> BadgeProof -> IO () +sendTestMemberProof cc groupId proof = + withCCUser cc $ \user -> do + let cxt = storeCxt $ chatController cc + (g@(GIK gInfo@GroupInfo {membership = m@GroupMember {memberProfile}} gks), members) <- withCCTransaction cc $ \db -> do + g@(GIK gInfo _) <- runExceptT (getGroupInfoKeys db cxt user groupId) >>= either (fail . show) pure + members <- getGroupMembers db cxt user gInfo + pure (g, members) + let p = (redactedMemberProfile gInfo m $ fromLocalProfile memberProfile) {badge = Just proof} + runExceptT (sendGroupMessage' user g members (XInfo p (Just $ groupMemberKey gks))) `runReaderT` chatController cc + >>= either (fail . show) (\_ -> pure ()) + +setTestInvLinkData :: TestCC -> ContactShortLinkData -> IO () +setTestInvLinkData cc linkData = do + [Only (AgentConnId connId)] <- withCCTransaction cc $ \db -> DB.query_ db "SELECT agent_conn_id FROM connections" + let ChatController {smpAgent} = chatController cc + runExceptT (setConnShortLink smpAgent NRMInteractive connId SCMInvitation (UserInvLinkData $ encodeShortLinkData linkData) Nothing False Nothing) + >>= either (fail . show) (\_ -> pure ()) + testUpdateProfileImage :: HasCallStack => TestParams -> IO () testUpdateProfileImage = testChat2 aliceProfile bobProfile $ @@ -3743,8 +4305,8 @@ testShortLinkDeletedAddress = testChat2 aliceProfile bobProfile test testShortLinkAddressConnectRetry :: HasCallStack => TestParams -> IO () testShortLinkAddressConnectRetry ps = - withNewTestChatOpts ps opts' "alice" aliceProfile $ \alice -> - withNewTestChatOpts ps opts' "bob" bobProfile $ \bob -> do + withNewTestChatCfgOpts ps cfg' opts' "alice" aliceProfile $ \alice -> + withNewTestChatCfgOpts ps cfg' opts' "bob" bobProfile $ \bob -> do shortLink <- withSmpServer' serverCfg' $ do alice ##> "/ad" (shortLink, fullLink) <- getContactLinks alice True @@ -3788,6 +4350,7 @@ testShortLinkAddressConnectRetry ps = { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } + cfg' = testCfg {agentConfig = testAgentCfg {persistErrorInterval = 0}} opts' = testOpts { coreOptions = @@ -3798,8 +4361,8 @@ testShortLinkAddressConnectRetry ps = testShortLinkAddressConnectRetryIncognito :: HasCallStack => TestParams -> IO () testShortLinkAddressConnectRetryIncognito ps = - withNewTestChatOpts ps opts' "alice" aliceProfile $ \alice -> - withNewTestChatOpts ps opts' "bob" bobProfile $ \bob -> do + withNewTestChatCfgOpts ps cfg' opts' "alice" aliceProfile $ \alice -> + withNewTestChatCfgOpts ps cfg' opts' "bob" bobProfile $ \bob -> do shortLink <- withSmpServer' serverCfg' $ do alice ##> "/ad" (shortLink, fullLink) <- getContactLinks alice True @@ -3851,6 +4414,7 @@ testShortLinkAddressConnectRetryIncognito ps = { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } + cfg' = testCfg {agentConfig = testAgentCfg {persistErrorInterval = 0}} opts' = testOpts { coreOptions = diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index cd975a32c3..c1f58aa525 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -23,12 +23,14 @@ import Data.List (isPrefixOf, isSuffixOf) import Data.Maybe (fromMaybe) import Data.String import qualified Data.Text as T +import Simplex.Chat.Badges (BadgeProof (..), BadgeStatus, LocalBadge (..), ProofPresHeader (..)) import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), storeCxt) import Simplex.Chat.Library.Commands (maxProfileImageSize) import Simplex.Chat.Markdown (viewName) import Simplex.Chat.Messages.CIContent (e2eInfoNoPQText, e2eInfoPQText) import Simplex.Chat.Protocol -import Simplex.Chat.Store.Direct (getContact) +import Simplex.Chat.Store.Direct (getContact, getContactIdByName, getContactRequest, getContactRequestIdByName) +import Simplex.Chat.Store.Groups (getGroupIdByName, getGroupMember, getGroupMemberIdByName) import Simplex.Chat.Store.NoteFolders (createNoteFolder) import Simplex.Chat.Store.Profiles (getUserContactProfiles) import Simplex.Chat.Types @@ -39,6 +41,7 @@ import Simplex.Messaging.Agent.Client (agentClientStore) import Simplex.Messaging.Agent.Store.AgentStore (maybeFirstRow, withTransaction) import qualified Simplex.Messaging.Agent.Store.DB as DB import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.BBS (BBSPresHeader (..)) import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Version @@ -726,6 +729,50 @@ getTestCCContact cc contactId = do withCCUser cc $ \user -> runExceptT (getContact db (storeCxt chatController) user contactId) >>= either (fail . show) pure +contactBadgeHeader :: TestCC -> ContactName -> IO (Maybe (String, BadgeStatus)) +contactBadgeHeader cc cName = + withCCTransaction cc $ \db -> + withCCUser cc $ \user -> + runExceptT (getContact db (storeCxt $ chatController cc) user =<< getContactIdByName db user cName) + >>= either (fail . show) (pure . storedBadgeHeader . profile') + +requestBadgeHeader :: TestCC -> ContactName -> IO (Maybe (String, BadgeStatus)) +requestBadgeHeader cc cName = + withCCTransaction cc $ \db -> + withCCUser cc $ \user@User {userId} -> + runExceptT (getContactRequest db user =<< getContactRequestIdByName db userId cName) + >>= either (fail . show) (\UserContactRequest {profile} -> pure $ storedBadgeHeader profile) + +memberBadgeHeader :: TestCC -> GroupName -> ContactName -> IO (Maybe (String, BadgeStatus)) +memberBadgeHeader cc gName mName = (\GroupMember {memberProfile} -> storedBadgeHeader memberProfile) <$> getTestMember cc gName mName + +memberProofHeader :: TestCC -> GroupName -> ContactName -> IO (Maybe String) +memberProofHeader cc gName mName = (\GroupMember {memberBadgeProof} -> proofHeaderTag <$> unNoJSON memberBadgeProof) <$> getTestMember cc gName mName + +getTestMember :: TestCC -> GroupName -> ContactName -> IO GroupMember +getTestMember cc gName mName = + withCCTransaction cc $ \db -> + withCCUser cc $ \user -> + runExceptT + ( do + gId <- getGroupIdByName db user gName + getGroupMember db (storeCxt $ chatController cc) user gId =<< getGroupMemberIdByName db user gId mName + ) + >>= either (fail . show) pure + +storedBadgeHeader :: LocalProfile -> Maybe (String, BadgeStatus) +storedBadgeHeader LocalProfile {localBadge} = case localBadge of + Just (PeerBadge b st) -> Just (proofHeaderTag b, st) + _ -> Nothing + +proofHeaderTag :: BadgeProof -> String +proofHeaderTag (BadgeProof _ (BBSPresHeader ph) _ _) = case strDecode ph of + Right (PHChat b) -> 'C' : take 1 (B.unpack b) + Right (PHRequest _) -> "R" + Right (PHLink _) -> "L" + Right (PHTest _) -> "T" + _ -> "?" + lastItemId :: HasCallStack => TestCC -> IO String lastItemId cc = do cc ##> "/last_item_id" diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 2d9842e9ee..35f1ea5885 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -185,10 +185,10 @@ s #==# msg = do s ==# msg testChatPreferences :: Maybe Preferences -testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, files = Nothing, fullDelete = Nothing, timedMessages = Nothing, calls = Nothing, reactions = Just ReactionsPreference {allow = FAYes}, sessions = Nothing, commands = Nothing, _json = PrefsJSON Nothing} +testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, files = Nothing, fullDelete = Nothing, timedMessages = Nothing, calls = Nothing, reactions = Just ReactionsPreference {allow = FAYes}, sessions = Nothing, commands = Nothing, _json = NoJSON Nothing} testGroupPreferences :: Maybe GroupPreferences -testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn, role = Nothing}, files = Nothing, fullDelete = Nothing, simplexLinks = Nothing, history = Nothing, reports = Nothing, support = Nothing, sessions = Nothing, comments = Nothing, signMessages = Nothing, commands = Nothing, _json = PrefsJSON Nothing} +testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn, role = Nothing}, files = Nothing, fullDelete = Nothing, simplexLinks = Nothing, history = Nothing, reports = Nothing, support = Nothing, sessions = Nothing, comments = Nothing, signMessages = Nothing, commands = Nothing, _json = NoJSON Nothing} testProfile :: Profile testProfile = Profile {displayName = "alice", fullName = "Alice", shortDescr = Nothing, description = Nothing, image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), peerType = Nothing, contactLink = Nothing, preferences = testChatPreferences, badge = Nothing, contactDomain = Nothing} @@ -240,7 +240,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"v\":\"9\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (mcSimple (MCText "hello"))) it "x.msg.new chat message with chat version range" $ - "{\"v\":\"9-21\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" + "{\"v\":\"9-22\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" ##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (mcSimple (MCText "hello"))) it "x.msg.new quote" $ "{\"v\":\"9\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" @@ -352,18 +352,21 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, fromMemberKey = Nothing, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, business = Nothing, groupLinkId = Just $ GroupLinkId "\1\2\3\4", groupSize = Nothing} it "x.grp.acpt without incognito profile" $ "{\"v\":\"9\",\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" - #==# XGrpAcpt (MemberId "\1\2\3\4") Nothing + #==# XGrpAcpt (MemberId "\1\2\3\4") Nothing Nothing + it "x.grp.acpt with profile" $ + "{\"v\":\"9\",\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" + #==# XGrpAcpt (MemberId "\1\2\3\4") Nothing (Just testProfile) it "x.grp.mem.new" $ "{\"v\":\"9\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile, memberKey = Nothing} Nothing it "x.grp.mem.new with member chat version range" $ - "{\"v\":\"9\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-21\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"v\":\"9\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-22\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile, memberKey = Nothing} Nothing it "x.grp.mem.intro" $ "{\"v\":\"9\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile, memberKey = Nothing} Nothing it "x.grp.mem.intro with member chat version range" $ - "{\"v\":\"9\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-21\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"v\":\"9\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-22\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile, memberKey = Nothing} Nothing it "x.grp.mem.intro with member restrictions" $ "{\"v\":\"9\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberRestrictions\":{\"restriction\":\"blocked\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" @@ -372,7 +375,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"v\":\"9\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}" #==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq} it "x.grp.mem.fwd with member chat version range" $ - "{\"v\":\"9\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-21\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"v\":\"9\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-22\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile, memberKey = Nothing} IntroInvitation {groupConnReq = testConnReq} it "x.grp.mem.info" $ "{\"v\":\"9\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"