From 867949d2aa5f072db537ab123977204b32045e48 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 27 Sep 2026 12:42:45 +0000 Subject: [PATCH] improvements --- .../Chat/ChatItem/CIChatLinkHeader.swift | 2 +- apps/ios/SimpleXChat/FileUtils.swift | 3 + .../views/chat/item/CIChatLinkHeader.kt | 7 +- .../simplex/common/views/helpers/Utils.kt | 3 + cabal.project | 10 +- ...026-09-04-badge-binding-and-file-limits.md | 108 +++++----- src/Simplex/Chat/Badges.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 117 +++++------ src/Simplex/Chat/Library/Internal.hs | 82 +++++--- src/Simplex/Chat/Library/Subscriber.hs | 196 ++++++++---------- src/Simplex/Chat/Store/Groups.hs | 18 +- src/Simplex/Chat/Types.hs | 21 +- tests/ChatTests/Profiles.hs | 35 +++- 13 files changed, 308 insertions(+), 296 deletions(-) diff --git a/apps/ios/Shared/Views/Chat/ChatItem/CIChatLinkHeader.swift b/apps/ios/Shared/Views/Chat/ChatItem/CIChatLinkHeader.swift index 34768f5d0f..2008210c99 100644 --- a/apps/ios/Shared/Views/Chat/ChatItem/CIChatLinkHeader.swift +++ b/apps/ios/Shared/Views/Chat/ChatItem/CIChatLinkHeader.swift @@ -69,7 +69,7 @@ struct CIChatLinkHeader: View { private var linkBadge: LocalBadge? { guard case let .contact(_, profile, _) = chatLink, let b = profile.badge else { return nil } let expired = Date.now.timeIntervalSince(b.badgeInfo.badgeExpiry) - let status: BadgeStatus = expired > 38 * 86400 ? .expiredOld : expired > 7 * 86400 ? .expired : .active + let status: BadgeStatus = expired > BADGE_OLD_INTERVAL ? .expiredOld : expired > BADGE_GRACE_INTERVAL ? .expired : .active return LocalBadge(badge: b.badgeInfo, status: status) } } diff --git a/apps/ios/SimpleXChat/FileUtils.swift b/apps/ios/SimpleXChat/FileUtils.swift index a4d4e4ae0c..6cfd2c262e 100644 --- a/apps/ios/SimpleXChat/FileUtils.swift +++ b/apps/ios/SimpleXChat/FileUtils.swift @@ -36,6 +36,9 @@ public let MAX_FILE_SIZE_XFTP_LEGEND: Int64 = 5_368_709_120 // 5GB // a badge raises the limit at send for this long after its expiry, shorter than the receiver's grace public let BADGE_SND_GRACE_INTERVAL = TimeInterval(86400) +public let BADGE_GRACE_INTERVAL = TimeInterval(7 * 86400) +public let BADGE_OLD_INTERVAL = TimeInterval(38 * 86400) + public let MAX_FILE_SIZE_LOCAL: Int64 = Int64.max public let MAX_FILE_SIZE_SMP: Int64 = 8000000 diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIChatLinkHeader.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIChatLinkHeader.kt index 77ede9e76e..a3d744672f 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIChatLinkHeader.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIChatLinkHeader.kt @@ -10,12 +10,13 @@ import androidx.compose.ui.unit.dp import androidx.compose.ui.unit.sp import chat.simplex.common.model.* import chat.simplex.common.ui.theme.* +import chat.simplex.common.views.helpers.BADGE_GRACE_INTERVAL +import chat.simplex.common.views.helpers.BADGE_OLD_INTERVAL import chat.simplex.common.views.helpers.NameWithBadge import chat.simplex.common.views.helpers.ProfileImage import chat.simplex.res.MR import dev.icerock.moko.resources.compose.stringResource import kotlinx.datetime.Clock -import kotlin.time.Duration.Companion.days @Composable fun CIChatLinkHeader( @@ -86,8 +87,8 @@ private fun linkBadge(chatLink: MsgChatLink): LocalBadge? { val b = (chatLink as? MsgChatLink.Contact)?.profile?.badge ?: return null val expired = Clock.System.now() - b.badgeInfo.badgeExpiry val status = when { - expired > 38.days -> BadgeStatus.ExpiredOld - expired > 7.days -> BadgeStatus.Expired + expired > BADGE_OLD_INTERVAL -> BadgeStatus.ExpiredOld + expired > BADGE_GRACE_INTERVAL -> BadgeStatus.Expired else -> BadgeStatus.Active } return LocalBadge(b.badgeInfo, status) diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt index 2d6e70eae9..25098190a5 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt @@ -133,6 +133,9 @@ const val MAX_FILE_SIZE_XFTP_LEGEND: Long = 5_368_709_120 // 5GB // a badge raises the limit at send for this long after its expiry, shorter than the receiver's grace val BADGE_SND_GRACE_INTERVAL: Duration = 1.days +val BADGE_GRACE_INTERVAL: Duration = 7.days +val BADGE_OLD_INTERVAL: Duration = 38.days + const val MAX_FILE_SIZE_LOCAL: Long = Long.MAX_VALUE expect fun getAppFileUri(fileName: String): URI diff --git a/cabal.project b/cabal.project index a35474ca56..310adca7e7 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,4 @@ -packages: . +packages: . ../simplexmq-4 -- packages: . ../simplexmq -- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple @@ -18,10 +18,10 @@ package cryptostore constraints: zip +disable-bzip2 +disable-zstd -source-repository-package - type: git - location: https://github.com/simplex-chat/simplexmq.git - tag: 965ac7b1e339d8c172e70685a845c62cb6b0ec87 +-- source-repository-package +-- type: git +-- location: https://github.com/simplex-chat/simplexmq.git +-- tag: 965ac7b1e339d8c172e70685a845c62cb6b0ec87 source-repository-package type: git 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 1224893ae2..54aa766e38 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. Four new presentation headers: a profile shown in a chat, a file invitation, a file description, and a contact request. The random header of released clients stays accepted. +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, except in a shared address card. 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 an introduction under the key it introduces, and from a join request under the request header. In channels it is accepted from any profile message. 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. The same table holds the proof of a group member, 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. 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 request code of an invitation. +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. The same table holds the proof of a group member, 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. 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 @@ -89,7 +89,7 @@ One constructor serves every chat type, because the chat binding already encodes 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. `PHTest`, presented by released clients, is accepted in every chat. 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 except in a shared address card. 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. The expected header is computed in the chat layer and passed to the store, so `groupBindingData` and `profileBadgeVerified` stay where they are. One predicate is defined in `Badges.hs`: `acceptedProof`, true for `PHTest` and for a header equal to the expected one (section 14.3). @@ -111,7 +111,7 @@ The expected header, `Maybe ProofPresHeader`, is a parameter of the store functi The chat layer computes the binding with `memberChatBinding gInfo memberId key_` (`Internal.hs`): for a channel `encodeChatBinding CBGroup (publicGroupId, memberId)`, whatever the key; for a p2p group `encodeChatBinding CBGroup (memberId, key)`, or `Nothing` without a key. `rcvGroupChatBinding` uses it for its member alternatives. The key passed at each site: -- `xInfoMember` (`Subscriber.hs:2801`) and `xGrpLinkMem` (`:2807`): the stored key when `RcvMessage.msgSigned` is `MSSVerified`; otherwise the key the message delivers, when `storeMemberKey` verified the signature with it and stored it — `storeMemberKey` returns that key; otherwise none. +- `xInfoMember` (`Subscriber.hs:2814`) and `xGrpLinkMem` (`:2820`): the stored key when it verifies the message signature, otherwise none. A key delivered by the message is stored first by `storeMemberKey` when it verifies the signature; `storeMemberKey` returns the member with the key. - The member connection handshake, section 4: the stored key when it verifies the signature. - Introductions — `createNewGroupMember`, `createIntroReMember`, `updateUnknownMemberAnnounced`: the key in the `MemberInfo`. - Channel sites — `updateRosterMemberAnnounced`, `updatePreparedChannelMember`, a join via a relay (`createJoiningMember`, `updateMemberProfile`): no key; the channel binding is complete without it. @@ -129,7 +129,7 @@ When two p2p members connect, each sends `XGrpMemInfo` with its group profile. I - **Sign the join side.** `xGrpMemFwd` sends `encodeConnInfo $ XGrpMemInfo ...` (`:3336`), plain JSON. It takes `GroupInfoKeys` from the dispatch and encodes with `encodeSignedConnInfo` when `groupMsgSigning` returns a signing. The agreed version is computed below the send, as `chatV`; that computation moves above it, and the badge is presented when `chatV` is at least `relayWebCapVersion`. - **The reply side** (`:843`) presents the badge when `peerChatVRange` of the connection allows, and `allowAgentConnectionAsync` signs by the same rule. - **Parse the signature on CONF.** The member CONF site parses with `parseChatMessage` (`:781`), which discards the signature. Change it to `parseChatMessage'`, as INFO already does (`:850`). -- **Verify and store.** At `:837` and `:850` the signature is verified with the member's stored key, as `storeMemberKey` does; `XGrpMemInfo` names no key, and the handshake follows the introduction, which stored the key. `processMemberProfileUpdate` stores the profile with the binding from the verified key, or with no binding. +- **Verify and store.** At `:853` and `:862` the signed message is passed to `processMemberProfileUpdate`, and the signature is verified with the member's stored key by `signedMemberPresHeader`; `XGrpMemInfo` names no key, and the handshake follows the introduction, which stored the key. The profile is stored with the binding from the verified key, or with no binding. - `:615` and `:647` stay as they are. The profile there is the same group profile, received over the direct connection to the member. The contact for a member shares the member's profile row (`createIntroToMemberContact`), so storing it once, on the member connection, updates both. A member whose key was never introduced shows no badge until a signed `XInfo` that delivers the key arrives. @@ -272,7 +272,7 @@ Every profile badge is bound to the chat it is shown in. The sender presents the 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 and the id of the queue the joining party sends to. +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. @@ -281,12 +281,12 @@ Rules: | Direct chat: `XInfo`, `CONF` and `INFO` replies, accept, one-time link join, member contacts | contact | `PHChat (encodeChatBinding CBDirect codeAD)` | | Request to an address with ratchet keys | address owner | `PHChat (encodeChatBinding CBDirect 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 | `PHRequest code` — the inviter's keys, the invitation queue | +| One-time invitation link data | joining party | `PHLink linkKey` | | Address link data, shared address card | anyone with the link | `PHLink linkKey` | | P2p group | members | `PHChat (encodeChatBinding CBGroup (smpEncode (memberId, memberKey)))` | | Channel | subscribers | `PHChat (encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId)))` | -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 root key, the entity id, and the connection request with its server and queue id (`ShortLink.hs:61-64`). +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 @@ -326,7 +326,7 @@ 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 PQ key is removed from this code in section 14.2. +- `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`. `prepareConnectionToAccept` returns the same pair: for `CRInvitation` it creates the ratchet from the invitation's keys, for `CRInvitationDR` it takes the ratchet stored in the invitation. `startJoinInvitation` reads the ratchet before creating one, as the contact path and its retry branch already do; `createConnReq` reads the x3dh keys before generating them, as `mkJoinInvitation` does. Async joins and accepts then find the ratchet in place. Nothing in the prepare step touches the network. @@ -336,9 +336,9 @@ data ContactRequestBinding = CRBRatchet ConnVerifyCodes | CRBRequest ByteString ### 14.2 Agent: links before link data -Files: `Agent.hs`, `Agent/Protocol.hs`, `tests/AgentTests/FunctionalAPITests.hs`. +Files: `Agent.hs`, `Agent/Client.hs`, `Agent/Protocol.hs`, `Crypto/ShortLink.hs`, `Protocol.hs`, `Transport.hs`, `tests/AgentTests/FunctionalAPITests.hs`. -Committed in simplexmq `25b27342`. The chat pins it in `cabal.project` and `scripts/nix/sha256map.nix`. +The chat pins the simplexmq commit in `cabal.project` and `scripts/nix/sha256map.nix`. Every link, and every invitation, is available to the chat before its link data is signed; each creation makes one network request. @@ -366,14 +366,14 @@ createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool - - the returned link is `CCLink connReq Nothing`; the key is `plpLinkKey` - `useDR` is ignored - Invitation mode, create: - - the `PRKInvitation` keys are stored with `createRatchetX3dhKeys` - link data: `SL.encodeSignUserData SCMInvitation`, encrypted by `encryptInvLinkData` with `SL.invShortLinkKdf plpLinkKey`; `newRcvConnSrv` uses the same function + - then the connection is created and the `PRKInvitation` keys are stored with `createRatchetX3dhKeys`; the connection is deleted when storing fails - queue request: `CQRMessaging (Just CQRData {linkKey, privSigKey, srvReq = (sndId, srvData)})` - Both modes create the queue with the local `createLinkQueue`: - `createRcvQueue` - the sender id check of `createConnectionForLink'` on master, error `sender ID mismatch` - - the returned link from `connReqWithShortLink`, moved from `newRcvConnSrv` to top level with its body unchanged — `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`. The six existing test calls are updated for the mode and the pair. + - the returned link from `connReqWithShortLink`, moved from `newRcvConnSrv` to top level — `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`; link data above the size limit fails with `CMD LARGE` and leaves no connection. 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: @@ -386,19 +386,17 @@ prepareConnShortLink :: AgentClient -> ConnId -> Maybe CRClientData -> AE (ConnS - `setConnShortLink` uses `newContactLinkCreds` for a connection without stored credentials, and then encrypts and uploads the user data with one `LSET`. - 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. -**Invitation code.** Exported: +**SMP versions below 15.** The minimum SMP version of clients and servers is 15, and the code for older versions is removed: -```haskell -invitationRequestCode :: ConnectionRequestUri 'CMInvitation -> ByteString -``` - -- `requestCode` (`Agent.hs:1423-1424`) of the invitation's X448 keys and the sender id of its first queue. -- The PQ key is removed from `requestCode`: `sha256 (smpEncode (k1, k2, sndId))`, for requests and invitations alike, so the full link of an invitation created with `IKPQOn`, which is stored without the PQ key, gives the same code as its link data. -- Tests: the code of a prepared invitation equals the code of the invitation read from its link data and the code of its full link. +- `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. +- `Transport.hs`: `shortLinksSMPVersion` is renamed `_shortLinksSMPVersion` and is not exported; `_proxyServerHandshakeSMPVersion` is removed. +- Tests: `testInvitationShortLinkPrev` and `testProxyMatrixWithPrev` are removed. ### 14.3 Chat -Todo, in implementation order. At every direct send, a `Nothing` from `connPresHeader` or `connsPresHeaders`, and a retry without a stored request header, get `unboundPresHeader`. At a send into a group, a `Nothing` from `groupPresHeader` presents no badge. +Todo, in implementation order. At every direct send, a `Nothing` from `connPresHeader` or `connsPresHeaders`, and a retry without a stored request header, are replaced with `PHTest` by `sndPresHeader`. At a send into a group, a `Nothing` from `groupPresHeader` presents no badge. **1. Headers** — `Badges.hs` @@ -430,10 +428,8 @@ The expected header, `Maybe ProofPresHeader`, is a parameter of: - `updateUnknownMemberAnnounced` - `updateRosterMemberAnnounced` - `updatePreparedChannelMember` -- `setRelayLinkAccepted` -- `updateRelayMemberData` -`Nothing` for `createContact`, the preset contact card. The same parameter in `processMemberProfileUpdate`. In group callers the bindings computed today are wrapped with `PHChat <$>`. +`Nothing` is passed by `createContact`, the preset contact card, and by `setRelayLinkAccepted` and `updateRelayMemberData`. `processMemberProfileUpdate` takes the signed message and computes the header with `signedMemberPresHeader`. Group callers compute the header with `memberPresHeader` or `memberInfoPresHeader`. **4. Presenting** — `Internal.hs` @@ -441,21 +437,24 @@ The expected header, `Maybe ProofPresHeader`, is a parameter of: presentUserBadge :: User -> Maybe i -> Maybe ProofPresHeader -> Profile -> CM Profile ``` -With `Nothing`, no badge is presented. Header helpers: +With `Nothing`, no badge is presented. A badge is presented only when `presentsUserBadge :: User -> Bool` holds: the user's own badge is active or expired. Header helpers: - `groupPresHeader :: GroupInfo -> Maybe ProofPresHeader` — `PHChat <$> sndGroupChatBinding gInfo False` - `directPresHeader :: ContactRequestBinding -> ProofPresHeader` — `PHChat (encodeChatBinding CBDirect codeAD)` for `CRBRatchet`, `PHRequest code` for `CRBRequest` -- `linkPresHeader :: LinkKey -> ProofPresHeader` — `PHLink key` -- `invitationPresHeader :: ConnReqInvitation -> ProofPresHeader` — `PHRequest (invitationRequestCode connReq)` -- `unboundPresHeader :: CM ProofPresHeader` — `PHTest` of 16 random bytes +- `linkPresHeader :: ConnShortLink c -> ProofPresHeader` — `PHLink` of the link key +- `memberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader` — `PHChat <$> memberChatBinding` +- `memberInfoPresHeader :: GroupInfo -> MemberInfo -> Maybe ProofPresHeader` — `memberPresHeader` of the id and key in the `MemberInfo` +- `sndPresHeader :: Maybe ProofPresHeader -> CM ProofPresHeader` — the header, or `PHTest` of 16 random bytes for `Nothing` - `connPresHeader :: Connection -> CM (Maybe ProofPresHeader)` — `directPresHeader . CRBRatchet` of `getConnectionVerifyCodes`; `Nothing` on error - `connsPresHeaders :: [Connection] -> CM (Map ConnId ProofPresHeader)` — the same from `getConnectionsVerifyCodes` **5. The binding from prepare steps** -- `prepareContact :: User -> ConnReqContact -> PQSupport -> CM (ConnId, VersionChat, ContactRequestBinding)` -- `prepareAgentJoin :: User -> Maybe Connection -> Bool -> ConnectionRequestUri c -> CM ((CommandId, ConnId), Maybe ContactRequestBinding)` — `Nothing` for an existing connection -- `prepareAgentAccept :: User -> Bool -> InvitationId -> PQSupport -> CM ((CommandId, ConnId), ContactRequestBinding)` +Each returns `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** @@ -472,52 +471,48 @@ ALTER TABLE connections ADD COLUMN pres_header BLOB; **7. Direct sends** -- `joinContact` (`Commands.hs:3973`): the header, `Maybe ProofPresHeader`, is a parameter, set in `connect'`, `joinPreparedConn'` and `connectContactViaAddress`: - - a relay group: `groupPresHeader` - - every other join: `directPresHeader` of the `prepareContact` binding for a new connection, the stored header for a retry -- The branch on `gInfo_` for the badge (`Commands.hs:3976-3982`) is removed; the profile is still chosen by `gInfo_`. +- `joinContact` (`Commands.hs:3979`): the request header, `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:3819-3832`) and `connectMemberContact` (`:3398-3413`): the prepare binding for a new connection; `connPresHeader` for a prepared one. -- `joinMemberContactAsync` (`Subscriber.hs:3931`): the header is a parameter, set in `xGrpDirectInv` to `directPresHeader` of the `prepareAgentJoin` binding. +- `joinMemberContactAsync` (`Subscriber.hs:3947`): the header is a parameter, set in `xGrpDirectInv` to the `prepareAgentJoin` header. - `acceptContactRequest` (`Internal.hs:970-1000`): the prepare binding for a new connection; `connPresHeader` for an existing one. -- `acceptContactRequestAsync` (`Internal.hs:1002-1021`): the profile is built after `prepareAgentAccept`, from its binding. -- `CONF` replies (`Subscriber.hs:505` direct case, `:624`) and `updateContactPrefs` (`Commands.hs:4099`): `connPresHeader`. -- `sendUpdateToContacts` (`Commands.hs:4033-4071`) and `presentUserBadgeToContacts` (`:5200-5216`): one `connsPresHeaders` call per command. +- `acceptContactRequestAsync` (`Internal.hs:1007-1026`): the profile is built after `prepareAgentAccept`, from its header. +- `CONF` replies (`Subscriber.hs:509` direct case, `:628`) and `updateContactPrefs` (`Commands.hs:4108`): `connPresHeader`. +- `sendUpdateToContacts` (`Commands.hs:4039-4077`) and `presentUserBadgeToContacts` (`:5212-5228`): one `connsPresHeaders` call per command, when `presentsUserBadge` holds. **8. Direct receipts** - `REQ` (`Subscriber.hs:1396`): `directPresHeader` of the `REQ` binding is a parameter of `profileContactRequest`, passed to `createOrUpdateContactRequest` and to `acceptGroupJoinRequestAsync`. -- `processContactProfileUpdate` (`Subscriber.hs:2758`): `connPresHeader` of the contact's connection, read in the update branch. -- `saveConnInfo` (`Subscriber.hs:3173`): `connPresHeader` of the connection, for `createDirectContact`. +- `processContactProfileUpdate` (`Subscriber.hs:2771`) and `saveConnInfo` (`:3180`, for `createDirectContact`): the header is a parameter, `connPresHeader` of the connection, read by the caller. A `CONF` reply is presented with the same header. **9. Groups** - `groupPresHeader` at every send into a group: `Commands.hs:4319`; `Subscriber.hs:505` group case, `:637`, `:826`, `:843`, `:970`, `:1252`, `:3356`; `Internal.hs:2656`. -- `acceptGroupJoinRequestAsync`: the expected header is a parameter, in place of `binding_` (`Internal.hs:1044`) — `PHChat <$> memberChatBinding gInfo joiningMemberId Nothing` in `memberJoinRequestViaRelay`. `Nothing` in `acceptGroupJoinSendRejectAsync`. -- Host `INFO` with `XInfo` (`Subscriber.hs:859-864`): after `storeMemberKey`, the profile is stored by `processMemberProfileUpdate` with `PHChat <$> signedMemberBinding`, under the member's key. -- The profile is also stored by `processMemberProfileUpdate` when the new proof is accepted and its header differs from the stored proof's header. +- `acceptGroupJoinRequestAsync`: the expected header is a parameter, in place of `binding_` (`Internal.hs:1028`) — `memberPresHeader gInfo joiningMemberId Nothing` in `memberJoinRequestViaRelay`. `Nothing` in `acceptGroupJoinSendRejectAsync`. +- Host `INFO` with `XInfo` (`Subscriber.hs:865-872`): 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 arrives for a member with a stored proof. - Introductions: - - In `memberInfo` (`Internal.hs:1331`) the stored proof (item 11) is included when `acceptedProof (PHChat <$> memberChatBinding g memberId memberPubKey)` holds, and omitted otherwise. - - In `xGrpMemNew`, `xGrpMemIntro` and `xGrpMemFwd` (`Subscriber.hs:3197, 3279, 3341`): `PHChat <$> memberChatBinding gInfo memId key`, with `key` from the `MemberInfo`. + - In `memberInfo` (`Internal.hs:1335`) the stored proof (item 11) is included when `acceptedProof (memberPresHeader g memberId memberPubKey)` holds, and omitted otherwise. + - In `xGrpMemNew`, `xGrpMemIntro` and `xGrpMemFwd` (`Subscriber.hs:3207, 3290, 3342`): `memberInfoPresHeader`, with the member id and key from the `MemberInfo`. - Invitation via contact: - `profile :: Maybe Profile` in `XGrpAcpt`, the optional JSON field `profile`. - The invitee (`Commands.hs:2845`, `Subscriber.hs:2697`) includes its group profile, with `groupPresHeader`, when the maximum of the contact connection's `peerChatVRange` is at least `relayWebCapVersion`; the message is encoded with `encodeSignedConnInfo` when a signing is returned by `groupMsgSigning`. - `XGrpAcpt` with a badge in its profile is signed by `groupMsgSigning` (`Internal.hs:2316-2319`). - - The host (`Subscriber.hs:786`) stores the key, then the profile with `PHChat <$> signedMemberBinding`. For an invitee whose contact is active, the profile row is kept by `canUpdateProfile` and the proof is stored on the membership (item 11). + - The host (`Subscriber.hs:792-798`) stores the key, then the profile, by `processMemberProfileUpdate` with the signed message. For an invitee whose contact is active, the profile row is kept by `canUpdateProfile` 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`); the badge is presented when the invitee's version is at least `relayWebCapVersion`, as at `:840-846`. **10. Link data** -- Invitation links (`APIAddContact`, `recreateConn`): the chat generates the root key pair and calls `prepareConnectionLink SCMInvitation`; the badge is presented with the header of the prepared invitation; then `createConnectionForLink` is called. -- Invitation updates (`updatePCCShortLinkData`, `APISetConnectionIncognito`): the header of the stored invitation. +- 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`, then `setConnShortLink` is called once. - Receipts: - - `linkDataBadge` (`Internal.hs:2251`): the expected header is a parameter — the header of the invitation read with the link data for an invitation (`Commands.hs:4403-4404`), `linkPresHeader` of the link key for an address (`:4457-4458`). - - `createPreparedContact` (`Commands.hs:2203`): the same headers, from `accLink`; `Nothing` for an address without a short link. - - `updateContactFromLinkData` (`Internal.hs:1637`): the header of the address link is a parameter. + - `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. - Shared address card: - `APIShareMyAddress` (`Commands.hs:1243-1255`): the badge is presented with `linkPresHeader` of `connLink`. - - Receipts (`Subscriber.hs:1910-1916`, `:2217-2221`): the proof in `MCLContact.profile` is kept when accepted under `linkPresHeader` of `connLink` and verified, and removed otherwise. + - Receipts, by `chatLinkBadge` (`Internal.hs:2294`): new messages and updates in direct chats and groups, the message of a contact request, a member contact invitation, and the welcome message of a prepared chat. The proof in `MCLContact.profile` is kept when its header equals `linkPresHeader` of `connLink` and it verifies, and removed otherwise; `PHTest` is not accepted. - The badge from `profile.badge` is shown in `CIChatLinkHeader`, on iOS and in the multiplatform app. Its status is computed by the app from the expiry: active until seven days past it, expired until 38 days past it, hidden after. **11. Member proofs** — `Badges.hs`, `Types.hs`, `Types/Preferences.hs`, `Store/Shared.hs`, `Store/Groups.hs`, `Store/Connections.hs`, `Internal.hs`, `Subscriber.hs` @@ -596,8 +591,9 @@ The down migration deletes member rows before `file_id` is `NOT NULL` again. Bot - Invitation via contact: the invitee's badge, stored on the membership at the host, is shown at a member introduced after the invitee joins. - Channel: the owner's badge is shown at a subscriber, forwarded by the relay (`testChannelMemberBadges`). - Link data: the badge is shown from an invitation link, an address, an address that gets its first short link, and a shared address card. +- A shared address card with a proof bound to another link, or with `PHTest`, is received without the badge, in a new message and in an update. -`PHTest` is still sent by released clients and, through `unboundPresHeader`, on a retry of a connection prepared before this change. +`PHTest` is still sent by released clients and, through `sndPresHeader`, on a retry of a connection prepared before this change. ## Out of scope diff --git a/src/Simplex/Chat/Badges.hs b/src/Simplex/Chat/Badges.hs index 8a1b077c2a..970bf6477b 100644 --- a/src/Simplex/Chat/Badges.hs +++ b/src/Simplex/Chat/Badges.hs @@ -271,7 +271,7 @@ 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 | PHRequestTag | PHLinkTag | PHUnknownTag Char diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index a880502900..56e32d393c 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 (..), ProofPresHeader, 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) @@ -1244,12 +1244,12 @@ processChatCommand cxt nm = \case UserContactLink {connLinkContact = CCLink _ sl_, addressSettings} <- withFastStore (`getUserAddress` user) case sl_ of Nothing -> throwCmdError "your address has no short link to share" - Just connLink@(CSLContact _ _ _ linkKey) -> do + Just connLink -> do conn <- withFastStore $ \db -> getUserAddressConnection db cxt user ownerSig <- withAgent (`getConnLinkPrivKey` aConnId conn) $>>= \privKey -> mkLinkOwnerSig privKey connLink Nothing <$$> shareChatBinding user toSendRef - profile <- presentUserBadge user Nothing (Just $ linkPresHeader linkKey) $ userProfileDirect user Nothing Nothing True + profile <- presentUserBadge user Nothing (Just $ linkPresHeader connLink) $ userProfileDirect user Nothing Nothing True let business = businessAddress addressSettings text = safeDecodeUtf8 $ strEncode connLink pure $ CRChatMsgContent user MCChat {text, chatLink = MCLContact {connLink, profile, business}, ownerSig} @@ -2119,8 +2119,8 @@ processChatCommand cxt nm = \case incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing subMode <- chatReadVar subscriptionMode rootKey <- atomically . C.generateKeyPair =<< asks random - (preparedLink@(CCLink preparedReq _), preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) SCMInvitation rootKey Nothing False Nothing IKUsePQ False Nothing - linkProfile <- presentUserBadge user incognitoProfile (Just $ invitationPresHeader preparedReq) $ userProfileDirect user incognitoProfile Nothing True + (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 -> createConnectionForLink a nm (aUserId user) True preparedLink preparedParams userLinkData subMode @@ -2142,7 +2142,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 (invitationPresHeader . connFullLink <$> connLinkInv) (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 @@ -2164,8 +2164,8 @@ processChatCommand cxt nm = \case if isJust $ connShortLink' =<< connLinkInv then do rootKey <- atomically . C.generateKeyPair =<< asks random - (preparedLink@(CCLink preparedReq _), preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId newUser) SCMInvitation rootKey Nothing False Nothing IKPQOn False Nothing - userLinkData <- UserInvLinkData . (`contactShortLinkData` Nothing) <$> presentUserBadge newUser Nothing (Just $ invitationPresHeader preparedReq) (userProfileDirect newUser Nothing Nothing True) + (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 @@ -2197,23 +2197,20 @@ processChatCommand cxt nm = \case createItem sharedMsgId content = createChatItem user cd True content sharedMsgId Nothing Nothing cInfo = GroupChat gInfo Nothing void $ createGroupFeatureItems_ user cd True CIRcvGroupFeature gInfo - aci <- mapM (createItem welcomeSharedMsgId . CIRcvMsgContent) message + aci <- mapM (createItem welcomeSharedMsgId . CIRcvMsgContent <=< chatLinkBadge) message let chat = case aci of 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 cMode (CCLink cReq sLnk) -> do - let presHeader_ = case cMode of - SCMInvitation -> Just $ invitationPresHeader cReq - SCMContact -> (\(CSLContact _ _ _ linkKey) -> linkPresHeader linkKey) <$> sLnk - ct <- withStore $ \db -> createPreparedContact db cxt user presHeader_ 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 cInfo = DirectChat ct void $ createItem Nothing $ CIRcvDirectE2EEInfo $ e2eInfoEncrypted $ connRequestPQEncryption cReq void $ createFeatureEnabledItems_ user ct - aci <- mapM (createItem welcomeSharedMsgId . CIRcvMsgContent) message + aci <- mapM (createItem welcomeSharedMsgId . CIRcvMsgContent <=< chatLinkBadge) message let chat = case aci of Just (AChatItem SCTDirect dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci} _ -> Chat cInfo [] emptyChatStats @@ -2468,13 +2465,13 @@ processChatCommand cxt nm = \case Just True -> (IKUsePQ, True) Just False -> (IKPQOn, True) Nothing -> (IKPQOn, False) - (ccLink, preparedParams@PreparedLinkParams {plpLinkKey}) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) SCMContact rootKey (Just 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 (Just $ linkPresHeader plpLinkKey) (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 let ccLink'' = if isTrue userChatRelay then setShortLinkType CCTRelay ccLink' else ccLink' @@ -2843,18 +2840,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 - let incognitoProfile = incognitoMembershipProfile g - profile_ <- - if maxVersion peerChatVRange >= relayWebCapVersion - then Just <$> presentUserBadge user incognitoProfile (groupPresHeader g) (userProfileInGroup user g $ fromLocalProfile <$> incognitoProfile) - else pure Nothing - let msg = XGrpAcpt membershipMemId (Just $ groupMemberKey gks) profile_ - dm <- maybe (encodeConnInfo msg) (`encodeSignedConnInfo` msg) (groupMsgSigning False (GIK g gks) msg) + dm <- encodeXGrpAcpt user (GIK g gks) peerChatVRange agentConnId <- case memberConn fromMember of Nothing -> do (agentConnId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff @@ -3404,7 +3394,7 @@ 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 =<< maybe unboundPresHeader pure =<< connPresHeader conn + ConnPrepared -> joinPreparedConn subMode conn =<< sndPresHeader =<< connPresHeader conn _ -> throwChatError $ CEException "connection already started (past prepared status)" where joinNewConn subMode = do @@ -3823,7 +3813,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 - presHeader <- maybe unboundPresHeader pure =<< connPresHeader conn + presHeader <- sndPresHeader =<< connPresHeader conn joinPreparedConn conn (fromLocalProfile <$> localIncognitoProfile) presHeader Just ent -> throwCmdError $ "connection is not RcvDirectMsgConnection: " <> show (connEntityInfo ent) where @@ -3887,33 +3877,29 @@ processChatCommand cxt nm = \case relayMemberId_ = case preparedEntity_ of Just (PCEGroup (GIK gInfo _) m) | useRelays' gInfo -> Just (memberId' m) _ -> Nothing - joinPresHeader gInfo_ reqHeader = case gInfo_ of - Just (Just (GIK gInfo _)) | useRelays' gInfo -> groupPresHeader gInfo - _ -> Just reqHeader joinPreparedConn' xContactId_ conn@Connection {connId, customUserProfileId} gInfo_ = do 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', reqHeader_), localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId) - reqHeader <- maybe unboundPresHeader pure reqHeader_ + reqHeader <- sndPresHeader reqHeader_ let incognitoProfile = fromLocalProfile <$> localIncognitoProfile - conn' <- joinContact user conn cReq' incognitoProfile (joinPresHeader gInfo_ reqHeader) 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, binding) <- 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 Just (Just (GIK gInfo _)) | useRelays' gInfo -> pure $ ExistingIncognito <$> incognitoMembershipProfile gInfo _ -> if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing let incognitoProfile = fromIncognitoProfile <$> incognitoProfile_ - reqHeader = directPresHeader binding subMode <- chatReadVar subscriptionMode let sLnk' = serverShortLink <$> sLnk conn <- withFastStore' $ \db -> createConnReqConnection db userId connId preparedEntity_ cReq reqHeader cReqHash1 sLnk' xContactId incognitoProfile_ groupLinkId subMode chatV pqSup - conn' <- joinContact user conn cReq incognitoProfile (joinPresHeader gInfo_ reqHeader) xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup + conn' <- joinContact user conn cReq incognitoProfile 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) = @@ -3921,15 +3907,14 @@ processChatCommand cxt nm = \case case activeConn of Nothing -> do let pqSup = PQSupportOn - (connId, chatV, binding) <- 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 - reqHeader = directPresHeader binding 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 + void $ joinContact user conn cReq incognitoProfile 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 @@ -3937,9 +3922,9 @@ processChatCommand cxt nm = \case when (incognito /= isJust customUserProfileId) $ throwCmdError "incognito mode is different from prepared connection" xContactId <- mkXContactId xContactId_ ((cReq', reqHeader_), localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId) - reqHeader <- maybe unboundPresHeader pure reqHeader_ + reqHeader <- sndPresHeader reqHeader_ let incognitoProfile = fromLocalProfile <$> localIncognitoProfile - void $ joinContact user conn cReq' incognitoProfile (Just reqHeader) 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" @@ -3953,7 +3938,7 @@ processChatCommand cxt nm = \case relayLinkData_ <- liftIO $ decodeLinkUserData cData relayMemberId <- case (relayLinkData_, linkEntityId) of (Just RelayShortLinkData {relayProfile = p}, Just entityId) -> do - withFastStore $ \db -> updateRelayMemberData db cxt user relayMember (MemberId entityId) (MemberKey relayKey) Nothing p + withFastStore $ \db -> updateRelayMemberData db cxt user relayMember (MemberId entityId) (MemberKey relayKey) p pure $ MemberId entityId _ -> throwChatError $ CEException "relay link: no relay link data or entity id" let relayLinkToConnect = CCLink cReq (Just relayLink) @@ -3980,22 +3965,23 @@ processChatCommand cxt nm = \case deleteMemberConnection m deleteOrUpdateMemberRecord user gInfo m _ -> pure () - prepareContact :: User -> ConnReqContact -> PQSupport -> CM (ConnId, VersionChat, ContactRequestBinding) + 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, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup - pure (connId, chatV, binding) + pure (connId, chatV, directPresHeader binding) mkXContactId :: Maybe XContactId -> CM XContactId mkXContactId = maybe (XContactId <$> drgRandomBytes 16) pure - 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 presHeader_ xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup = do + joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> 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 presHeader_ $ case gInfo_ of - Just gInfo_' -> userProfileInGroup' user ((\(GIK g _) -> g) <$> gInfo_') incognitoProfile - Nothing -> userProfileDirect user incognitoProfile Nothing True + profileToSend <- + 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 Just (Just gInfo@(GIK g gks)) | useRelays' g -> case relayMemberId_ of @@ -4007,6 +3993,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 + _ -> Just reqHeader contactMember :: Contact -> [GroupMember] -> Maybe GroupMember contactMember Contact {contactId} = find $ \GroupMember {memberContactId = cId, memberStatus = s} -> @@ -4052,7 +4042,7 @@ processChatCommand cxt nm = \case case changedCts_ of Nothing -> pure $ UserProfileUpdateSummary 0 0 [] Just changedCts -> do - presHeaders <- connsPresHeaders $ map (\ChangedProfileContact {conn} -> conn) $ L.toList 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_ @@ -4080,7 +4070,7 @@ processChatCommand cxt nm = \case -- non-incognito (filtered above), so the user's badge is presented; a profile update keeps the badge instead of clearing it ctSndEvent :: Map ConnId ProofPresHeader -> ChangedProfileContact -> CM (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent 'Json) ctSndEvent presHeaders ChangedProfileContact {mergedProfile', conn = conn@Connection {connId}} = do - presHeader <- maybe unboundPresHeader pure $ M.lookup (aConnId conn) presHeaders + presHeader <- sndPresHeader $ M.lookup (aConnId conn) presHeaders p'' <- presentUserBadge user' Nothing (Just presHeader) mergedProfile' pure (ConnectionId connId, Nothing, XInfo p'' Nothing) ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq @@ -4090,8 +4080,8 @@ processChatCommand cxt nm = \case setMyAddressData :: Bool -> Maybe InitialKeys -> User -> UserContactLink -> CM UserContactLink setMyAddressData rotateKeys pqInitKeys user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink sLnk_, addressSettings} = do conn <- withFastStore $ \db -> getUserAddressConnection db cxt user - linkKey <- (\(CSLContact _ _ _ k) -> k) <$> maybe (withAgent $ \a -> prepareConnShortLink a (aConnId conn) Nothing) pure sLnk_ - shortLinkProfile <- presentUserBadge user Nothing (Just $ linkPresHeader linkKey) (userProfileDirect user Nothing Nothing True) + presHeader <- linkPresHeader <$> maybe (withAgent $ \a -> prepareConnShortLink a (aConnId conn) Nothing) pure sLnk_ + shortLinkProfile <- presentUserBadge user Nothing (Just presHeader) (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 @@ -4115,7 +4105,7 @@ processChatCommand cxt nm = \case mergedProfile' = userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') False when (mergedProfile' /= mergedProfile) $ withContactLock "updateContactPrefs" (contactId' ct) $ do - presHeader <- maybe unboundPresHeader pure =<< connPresHeader conn + presHeader <- sndPresHeader =<< connPresHeader conn p <- presentUserBadge user incognitoProfile (Just presHeader) mergedProfile' void (sendDirectContactMessage user ct' $ XInfo p Nothing) `catchAllErrors` eToView lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct' @@ -4422,7 +4412,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 $ invitationPresHeader cReq) =<< liftIO (decodeLinkUserData cData) + contactSLinkData_ <- mapM (linkDataBadge $ linkPresHeader l') =<< liftIO (decodeLinkUserData cData) let ov = verifyLinkOwner rootKey [] l sig_ invitationReqAndPlan cReq (Just l') contactSLinkData_ ov where @@ -4476,7 +4466,7 @@ processChatCommand cxt nm = \case when (resolveMode == PRMNever) $ throwChatError CENotResolvedLocally l' <- resolveSLink (FixedLinkData {rootKey}, cData, cReq) <- getShortLinkConnReq nm user l' - let presHeader = linkPresHeader $ (\(CSLContact _ _ _ linkKey) -> linkKey) l' + let presHeader = linkPresHeader l' contactSLinkData_ <- mapM (linkDataBadge presHeader) =<< liftIO (decodeLinkUserData cData) let linkProfile_ = (\ContactShortLinkData {profile} -> profile) <$> contactSLinkData_ linkDomain_ = linkProfile_ >>= \Profile {contactDomain} -> claimDomain <$> contactDomain @@ -5229,16 +5219,13 @@ 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' - presHeaders <- connsPresHeaders [conn | Right conn <- map contactSendConn_ contacts, not (connIncognito conn)] - withChatLock "presentUserBadge" $ forM_ contacts $ \ct -> - case contactSendConn_ ct of - Right conn - | not (connIncognito conn) -> do - let ct' = updateMergedPreferences user' ct - presHeader <- maybe unboundPresHeader pure $ M.lookup (aConnId conn) presHeaders - p <- presentUserBadge user' Nothing (Just presHeader) $ 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 + presHeader <- sndPresHeader $ M.lookup (aConnId conn) presHeaders + p <- presentUserBadge user' Nothing (Just presHeader) $ 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 c25998b25a..573965561f 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -28,7 +28,7 @@ import Control.Monad.IO.Unlift import Control.Monad.Reader import Crypto.Random (ChaChaDRG) import qualified Data.Aeson as J -import Data.Bifunctor (first, second) +import Data.Bifunctor (first) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB @@ -265,7 +265,7 @@ rcvForwardedFrom db user chatDirection RcvMessage {chatMsgEvent} = case chatMsgE forwardLinkCIFF :: DB.Connection -> User -> ForwardLink -> IO CIForwardedFrom forwardLinkCIFF db user ForwardLink {displayName, groupLink, publicGroupId, memberId, msgId} = getGroupViaPublicGroupId db user publicGroupId >>= \case - Just (gId, Just storedLink) + Just (gId, storedLink) | sameShortLinkContact groupLink storedLink -> do ciId_ <- itemId_ gId pure $ CIFFGroup displayName MDRcv (Just gId) ciId_ memberId (Just msgId) linkGroupType @@ -998,7 +998,7 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId pure (ct {activeConn = Just conn} :: Contact, conn, incognitoProfile, directPresHeader binding) Just conn@Connection {customUserProfileId} -> do incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId - presHeader <- maybe unboundPresHeader pure =<< connPresHeader conn + presHeader <- sndPresHeader =<< connPresHeader conn pure (ct, conn, ExistingIncognito <$> incognitoProfile, presHeader) profileToSend <- presentUserBadge user incognitoProfile (Just presHeader) $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend Nothing @@ -1014,8 +1014,8 @@ acceptContactRequestAsync subMode <- chatReadVar subscriptionMode cxt <- chatStoreCxt let chatV = vr cxt `peerConnChatVersion` cReqChatVRange - ((cmdId, acId), binding) <- prepareAgentAccept user True cReqInvId cReqPQSup - profileToSend <- presentUserBadge user incognitoProfile (Just $ directPresHeader binding) $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True + ((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 @@ -1338,7 +1338,7 @@ memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, a { memberId, memberRole, v = ChatVersionRange . peerChatVRange <$> activeConn, - profile = (p :: Profile) {badge = mfilter (acceptedProof $ PHChat <$> memberChatBinding g memberId memberPubKey) (unNoJSON memberBadgeProof <|> badge)}, + profile = (p :: Profile) {badge = mfilter (acceptedProof $ memberPresHeader g memberId memberPubKey) (unNoJSON memberBadgeProof <|> badge)}, memberKey = MemberKey <$> memberPubKey } where @@ -2243,11 +2243,16 @@ sendDirectContactMessages user ct events = do -- 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 -> Maybe ProofPresHeader -> Profile -> CM Profile -presentUserBadge user@User {profile = LocalProfile {localBadge}} incognitoProfile presHeader_ p = case (incognitoProfile, localBadge) of - (Nothing, Just (OwnBadge _ st)) | st == BSActive || st == BSExpired -> do - badge <- join <$> mapM (sndBadgeProof user) presHeader_ - pure p {badge} - _ -> pure p +presentUserBadge user incognitoProfile presHeader_ p + | isNothing incognitoProfile && presentsUserBadge user = do + badge <- pure presHeader_ $>>= 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 = PHChat <$> sndGroupChatBinding gInfo False @@ -2257,18 +2262,17 @@ directPresHeader = \case CRBRatchet ConnVerifyCodes {codeAD} -> PHChat $ encodeChatBinding CBDirect codeAD CRBRequest code -> PHRequest code -linkPresHeader :: LinkKey -> ProofPresHeader -linkPresHeader (LinkKey key) = PHLink key - -invitationPresHeader :: ConnReqInvitation -> ProofPresHeader -invitationPresHeader = PHRequest . invitationRequestCode +linkPresHeader :: ConnShortLink c -> ProofPresHeader +linkPresHeader = \case + CSLInvitation _ _ _ (LinkKey key) -> PHLink key + CSLContact _ _ _ (LinkKey key) -> PHLink key relayInvPresHeader :: GroupRelayInvitation -> Maybe ProofPresHeader relayInvPresHeader GroupRelayInvitation {fromMember = MemberIdRole {memberId}, publicGroupId} = (\gId -> PHChat $ encodeChatBinding CBGroup $ smpEncode (gId, memberId)) <$> publicGroupId -unboundPresHeader :: CM ProofPresHeader -unboundPresHeader = PHTest <$> drgRandomBytes 16 +sndPresHeader :: Maybe ProofPresHeader -> CM ProofPresHeader +sndPresHeader = maybe (PHTest <$> drgRandomBytes 16) pure connPresHeader :: Connection -> CM (Maybe ProofPresHeader) connPresHeader conn = eitherToMaybe <$> tryAllErrors (directPresHeader . CRBRatchet <$> withAgent (`getConnectionVerifyCodes` aConnId conn)) @@ -2280,13 +2284,21 @@ connsPresHeaders conns = either (const M.empty) (M.map (directPresHeader . CRBRa -- and set the crypto-free display badge for the UI (the raw proof stays in profile for APIPrepareContact) linkDataBadge :: ProofPresHeader -> ContactShortLinkData -> CM ContactShortLinkData linkDataBadge presHeader cld@ContactShortLinkData {profile = Profile {badge}} = case mfilter (acceptedProof (Just presHeader)) badge of - Nothing -> pure cld + Nothing -> pure (cld :: ContactShortLinkData) {localBadge = Nothing} Just b@(BadgeProof _ _ _ info) -> do keys <- asks $ badgePublicKeys . config verified <- liftIO $ verifyBadge keys b now <- liftIO getCurrentTime pure (cld :: ContactShortLinkData) {localBadge = Just $ ShownBadge info (mkBadgeStatus now verified info)} +chatLinkBadge :: MsgContent -> CM MsgContent +chatLinkBadge = \case + MCChat {text, chatLink = chatLink@MCLContact {connLink, profile = p@Profile {badge = Just b@BadgeProof {presHeader = BBSPresHeader ph}}}, ownerSig} -> do + keys <- asks $ badgePublicKeys . config + verified <- if ph == strEncode (linkPresHeader connLink) then liftIO (verifyBadge keys b) else pure Nothing + pure MCChat {text, chatLink = if verified == Just True then chatLink else (chatLink :: MsgChatLink) {profile = (p :: Profile) {badge = Nothing}}, ownerSig} + c -> pure c + sendDirectContactMessage :: MsgEncodingI e => User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64) sendDirectContactMessage user ct chatMsgEvent = do conn@Connection {connId} <- liftEither $ contactSendConn_ ct @@ -2376,6 +2388,12 @@ memberChatBinding gInfo memberId key_ = case publicGroup' gInfo of Just PublicGroupProfile {publicGroupId} -> Just $ encodeChatBinding CBGroup $ smpEncode (publicGroupId, memberId) Nothing -> (\k -> encodeChatBinding CBGroup $ smpEncode (memberId, k)) <$> key_ +memberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader +memberPresHeader gInfo memberId = fmap PHChat . memberChatBinding gInfo memberId + +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_ @@ -2504,6 +2522,16 @@ encodeXMemberConnInfo (GIK gInfo@GroupInfo {membership = GroupMember {memberId}} signing = MsgSigning CBGroup bindingData KRMember memberPrivKey' in encodeSignedConnInfo 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_ <- + if maxVersion peerVRange >= relayWebCapVersion + then Just <$> presentUserBadge user incognitoProfile (groupPresHeader gInfo) (userProfileInGroup user gInfo $ fromLocalProfile <$> incognitoProfile) + else pure Nothing + let msg = XGrpAcpt memberId (Just $ groupMemberKey gks) profile_ + maybe (encodeConnInfo msg) (`encodeSignedConnInfo` msg) (groupMsgSigning False g msg) + deliverMessage :: Connection -> CMEventTag e -> MsgBody -> MessageId -> CM (Int64, PQEncryption) deliverMessage conn cmEventTag msgBody msgId = do let msgFlags = MsgFlags {notification = hasNotification cmEventTag} @@ -3058,13 +3086,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), Maybe ContactRequestBinding) -prepareAgentJoin user conn_ enableNtfs cReqUri = do - cmdId <- withStore' $ \db -> createCommand db user (dbConnId <$> conn_) CFJoinConn - (connId, binding_) <- case conn_ of - Just conn -> pure (aConnId conn, Nothing) - Nothing -> second Just <$> withAgent (\a -> prepareConnectionToJoin a (aUserId user) enableNtfs cReqUri PQSupportOff) - pure ((cmdId, connId), binding_) +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 = @@ -3086,11 +3112,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), ContactRequestBinding) +prepareAgentAccept :: User -> Bool -> InvitationId -> PQSupport -> CM ((CommandId, ConnId), ProofPresHeader) prepareAgentAccept user enableNtfs invId pqSup = do cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact (connId, binding) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) enableNtfs invId pqSup - pure ((cmdId, connId), binding) + 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 8080629172..14ea589976 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 (..), LocalBadge (..), ProofPresHeader (..), acceptedProof, verifyBadge) +import Simplex.Chat.Badges (BadgeProof (..), BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), ProofPresHeader (..), acceptedProof) import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Delivery @@ -498,19 +498,21 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag Right () -> pure () Nothing -> do conn' <- processCONFpqSupport conn pqSupport + presHeader_ <- connPresHeader conn' -- [incognito] send saved profile - (conn'', gInfo_) <- saveConnInfo conn' connInfo + (conn'', gInfo_) <- saveConnInfo conn' presHeader_ connInfo incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) profileToSend <- case gInfo_ of Just (GIK gInfo _) -> presentUserBadge user incognitoProfile (groupPresHeader gInfo) $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) Nothing -> do - presHeader <- maybe unboundPresHeader pure =<< connPresHeader conn'' + presHeader <- sndPresHeader presHeader_ presentUserBadge user incognitoProfile (Just presHeader) $ 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 processINFOpqSupport conn pqSupport - void $ saveConnInfo conn connInfo + presHeader_ <- connPresHeader conn + void $ saveConnInfo conn presHeader_ connInfo MSG meta _msgFlags _msgBody -> -- We are not saving message (saveDirectRcvMSG) as contact hasn't been created yet, -- chat item is also not created here @@ -577,7 +579,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag case event of XMsgNew mc -> newContentMessage ct'' mc msg msgMeta XMsgFileDescr sharedMsgId fileDescr fileExpires fileBadge -> messageFileDescription ct'' sharedMsgId fileDescr fileExpires fileBadge - XMsgUpdate sharedMsgId mContent _ ttl live _msgScope _ -> messageUpdate ct'' sharedMsgId mContent msg msgMeta ttl live + XMsgUpdate sharedMsgId mContent _ ttl live _msgScope _ -> chatLinkBadge mContent >>= \mc -> messageUpdate ct'' sharedMsgId mc msg msgMeta ttl live XMsgDel sharedMsgId _ _ _ -> messageDelete ct'' sharedMsgId msg msgMeta XMsgReact sharedMsgId _ _ reaction add -> directMsgReaction ct'' sharedMsgId reaction add msg msgMeta -- TODO discontinue XFile @@ -619,10 +621,11 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag -- [async agent commands] no continuation needed, but command should be asynchronous for stability allowAgentConnectionAsync user conn'' confId Nothing XOk XInfo profile _ -> do - ct' <- processContactProfileUpdate ct profile False `catchAllErrors` const (pure ct) + presHeader_ <- connPresHeader conn'' + ct' <- processContactProfileUpdate ct presHeader_ profile False `catchAllErrors` const (pure ct) -- [incognito] send incognito profile incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId - presHeader <- maybe unboundPresHeader pure =<< connPresHeader conn'' + presHeader <- sndPresHeader presHeader_ p <- presentUserBadge user incognitoProfile (Just presHeader) $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True allowAgentConnectionAsync user conn'' confId Nothing $ XInfo p Nothing void $ withStore' $ \db -> resetMemberContactFields db ct' @@ -652,7 +655,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag pure () XInfo profile _ -> do let prepared = isJust (preparedContact ct) || isJust (contactRequestId' ct) - void $ processContactProfileUpdate ct profile prepared + presHeader_ <- connPresHeader conn + void $ processContactProfileUpdate ct presHeader_ profile prepared XOk -> pure () _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok" CON pqEnc -> do @@ -788,17 +792,13 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag 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 - let m' = maybe m (\(MemberKey k) -> m {memberPubKey = Just k}) mKey - forM_ memProfile_ $ \memProfile -> processMemberProfileUpdate gInfo m' (PHChat <$> signedMemberBinding gInfo m' signedMsg_) memProfile Nothing - let GroupMember {memberId = membershipMemId} = membership - p = redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership - membershipProfile <- - if maxVersion (peerChatVRange conn') >= relayWebCapVersion - then presentUserBadge user (incognitoMembershipProfile gInfo) (groupPresHeader gInfo) p - else pure p + m' <- case mKey of + Just (MemberKey k) -> m {memberPubKey = Just k} <$ withStore' (\db -> setMemberPubKey db (groupMemberId' m) k) + Nothing -> pure m + forM_ memProfile_ $ \memProfile -> processMemberProfileUpdate gInfo m' signedMsg_ memProfile Nothing + membershipProfile <- membershipHandshakeProfile gInfo $ maxVersion (peerChatVRange conn') -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId (Just g) $ XGrpMemInfo membershipMemId membershipProfile + allowAgentConnectionAsync user conn' confId (Just g) $ XGrpMemInfo (memberId' membership) membershipProfile | otherwise -> messageError "x.grp.acpt: memberId is different from expected" XGrpRelayAcpt relayLink relayCap | memberRole' membership == GROwner && isRelay m -> do @@ -847,14 +847,10 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag XGrpMemInfo memId memProfile | sameMemberId memId m -> do let GroupMember {memberId = membershipMemId} = membership - p = redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership - membershipProfile <- - if maxVersion (peerChatVRange conn') >= relayWebCapVersion - then presentUserBadge user (incognitoMembershipProfile gInfo) (groupPresHeader gInfo) p - else pure p + membershipProfile <- membershipHandshakeProfile gInfo $ maxVersion (peerChatVRange conn') -- [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 (PHChat <$> signedMemberBinding gInfo m signedMsg_) memProfile Nothing + 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 @@ -863,7 +859,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag case chatMsgEvent of XGrpMemInfo memId memProfile | sameMemberId memId m -> - void $ processMemberProfileUpdate gInfo m (PHChat <$> signedMemberBinding gInfo m signedMsg_) memProfile Nothing + 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 memProfile mKey @@ -872,9 +868,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag deleteMemberConnection' m True withStore' $ \db -> deleteGroupMember db user m | otherwise -> do - storedKey_ <- join <$> mapM (storeMemberKey gInfo m signedMsg_) mKey - let m' = maybe m (\k -> m {memberPubKey = Just k}) storedKey_ - void $ processMemberProfileUpdate gInfo m' (PHChat <$> signedMemberBinding gInfo m' signedMsg_) memProfile Nothing + 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 @@ -1086,7 +1081,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag XMsgUpdate sharedMsgId mContent mentions ttl live msgScope asGroup_ -> checkSendAsGroup asGroup_ $ memberCanSend (Just m'') msgScope $ - groupMessageUpdate gInfo' (Just m'') sharedMsgId mContent mentions msgScope msg brokerTs ttl live asGroup_ + chatLinkBadge mContent >>= \mc -> groupMessageUpdate gInfo' (Just m'') sharedMsgId mc mentions msgScope msg brokerTs ttl live asGroup_ XMsgDel sharedMsgId memberId_ scope_ onlyHistory -> groupMessageDelete gInfo' (Just m'') sharedMsgId memberId_ scope_ onlyHistory msg brokerTs XMsgReact sharedMsgId memberId scope_ reaction add -> groupMsgReaction gInfo' m'' sharedMsgId memberId scope_ reaction add msg brokerTs @@ -1247,7 +1242,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag relayLinkData_ <- liftIO $ decodeLinkUserData cData relayMemberId <- case (relayLinkData_, linkEntityId) of (Just RelayShortLinkData {relayProfile = p}, Just entityId) -> do - withStore $ \db -> updateRelayMemberData db cxt user m (MemberId entityId) (MemberKey relayKey) Nothing p + withStore $ \db -> updateRelayMemberData db cxt user m (MemberId entityId) (MemberKey relayKey) p pure $ MemberId entityId _ -> throwChatError $ CEException "relay link: no relay link data or entity id" case cReq of @@ -1265,8 +1260,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag profileToSend <- presentUserBadge user incognitoProfile (groupPresHeader gInfo) $ userProfileInGroup user gInfo incognitoProfile dm <- encodeXMemberConnInfo 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 @@ -1277,7 +1272,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag (confId, m', relay) <- withStore $ \db -> do confId <- getRelayConfId db m liftIO $ updateGroupMemberStatus db userId m GSMemAccepted - (m', relay) <- setRelayLinkAccepted db cxt user m (MemberKey relayKey) Nothing relayProfile + (m', relay) <- setRelayLinkAccepted db cxt user m (MemberKey relayKey) relayProfile pure (confId, m', relay) allowAgentConnectionAsync user conn confId (Just g) XOk toView $ CEvtGroupRelayUpdated user gInfo m' relay @@ -1410,7 +1405,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag (signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo let reqHeader = directPresHeader binding case chatMsgEvent of - XContact p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange reqHeader p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ pqSupport rejectionSupported + XContact p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ -> mapM (traverse chatLinkBadge) requestMsg_ >>= \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 reqHeader p Nothing Nothing Nothing Nothing pqSupport rejectionSupported XGrpRelayInv groupRelayInv -> xGrpRelayInv invId chatVRange groupRelayInv @@ -1706,7 +1701,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag && viaRelay == Just (memberId' (membership gInfo)) _ -> False acceptJoin g@(GIK gInfo _) existingMem_ acceptRole = do - mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p (PHChat <$> memberChatBinding gInfo joiningMemberId Nothing) Nothing (Just joiningMemberId) Nothing GAAccepted acceptRole Nothing (Just joiningMemberKey) existingMem_ + mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p (memberPresHeader gInfo joiningMemberId Nothing) 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' @@ -1952,14 +1947,6 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_ toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv cInfo ci {reactions}] - chatLinkBadge :: MsgContent -> CM MsgContent - chatLinkBadge = \case - MCChat {text, chatLink = chatLink@MCLContact {connLink = CSLContact _ _ _ linkKey, profile = p@Profile {badge = Just b}}, ownerSig} -> do - keys <- asks $ badgePublicKeys . config - verified <- if acceptedProof (Just $ linkPresHeader linkKey) b then liftIO (verifyBadge keys b) else pure Nothing - pure MCChat {text, chatLink = if verified == Just True then chatLink else (chatLink :: MsgChatLink) {profile = (p :: Profile) {badge = Nothing}}, ownerSig} - c -> pure c - autoAcceptFile :: Maybe (RcvFileTransfer, CIFile 'MDRcv) -> CM () autoAcceptFile = mapM_ $ \(ft, CIFile {fileSize}) -> do -- ! autoAcceptFileSize is only used in tests @@ -2713,19 +2700,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 - let incognitoProfile = incognitoMembershipProfile gInfo - profile_ <- - if maxVersion peerChatVRange >= relayWebCapVersion - then Just <$> presentUserBadge user incognitoProfile (groupPresHeader gInfo) (userProfileInGroup user gInfo $ fromLocalProfile <$> incognitoProfile) - else pure Nothing - let acptMsg = XGrpAcpt membershipMemId (Just $ groupMemberKey gks) profile_ - dm <- maybe (encodeConnInfo acptMsg) (`encodeSignedConnInfo` acptMsg) (groupMsgSigning False (GIK gInfo gks) acptMsg) - (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 @@ -2762,7 +2743,9 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag MsgError e -> createInternalChatItem user cd (CIRcvIntegrityError e) (Just brokerTs) xInfo :: Contact -> Profile -> CM () - xInfo c p' = void $ processContactProfileUpdate c p' True + xInfo c p' = do + presHeader_ <- pure (contactConn c) $>>= connPresHeader + void $ processContactProfileUpdate c presHeader_ p' True xDirectDel :: Contact -> RcvMessage -> MsgMeta -> CM () xDirectDel c msg msgMeta = @@ -2785,11 +2768,10 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag where brokerTs = metaBrokerTs msgMeta - processContactProfileUpdate :: Contact -> Profile -> Bool -> CM Contact - processContactProfileUpdate c@Contact {profile = lp} p' createItems + processContactProfileUpdate :: Contact -> Maybe ProofPresHeader -> Profile -> Bool -> CM Contact + processContactProfileUpdate c@Contact {profile = lp} presHeader_ p' createItems -- 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 - presHeader_ <- maybe (pure Nothing) connPresHeader $ contactConn c c' <- withStore $ \db -> if userTTL == rcvTTL then updateContactProfile db cxt user c presHeader_ p' @@ -2830,44 +2812,38 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p' xInfoMember :: GroupInfo -> GroupMember -> Profile -> Maybe MemberKey -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) - xInfoMember gInfo m p' mKey msg brokerTs = do - binding_ <- verifiedMemberBinding gInfo m mKey msg - void $ processMemberProfileUpdate gInfo m (PHChat <$> binding_) p' (Just (msg, brokerTs)) + xInfoMember gInfo m p' mKey msg@RcvMessage {signedMsg_} brokerTs = do + 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 () - xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' mKey msg = do + xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' mKey RcvMessage {signedMsg_} = do xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived then do - binding_ <- verifiedMemberBinding gInfo m mKey msg - m' <- processMemberProfileUpdate gInfo m (PHChat <$> binding_) 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" - verifiedMemberBinding :: GroupInfo -> GroupMember -> Maybe MemberKey -> RcvMessage -> CM (Maybe ByteString) - verifiedMemberBinding gInfo m@GroupMember {memberId, memberPubKey} mKey RcvMessage {msgSigned, signedMsg_} = do - storedKey_ <- maybe (pure Nothing) (storeMemberKey gInfo m signedMsg_) mKey - let key_ = if msgSigned == Just MSSVerified then memberPubKey else storedKey_ - pure $ memberChatBinding gInfo memberId key_ - - signedMemberBinding :: GroupInfo -> GroupMember -> Maybe SignedMsg -> Maybe ByteString - signedMemberBinding gInfo GroupMember {memberId, memberPubKey} signedMsg_ = - memberChatBinding gInfo memberId $ mfilter (\k -> memberSigned gInfo memberId k signedMsg_) memberPubKey + signedMemberPresHeader :: GroupInfo -> GroupMember -> Maybe SignedMsg -> Maybe ProofPresHeader + signedMemberPresHeader gInfo GroupMember {memberId, memberPubKey} signedMsg_ = + memberPresHeader gInfo memberId $ mfilter (\k -> memberSigned gInfo memberId k signedMsg_) memberPubKey memberSigned :: GroupInfo -> MemberId -> C.PublicKeyEd25519 -> Maybe SignedMsg -> Bool memberSigned gInfo memberId k = \case Just SignedMsg {chatBinding = CBGroup, signatures, signedBody} -> verifyGroupSig k gInfo memberId signatures signedBody _ -> False - storeMemberKey :: GroupInfo -> GroupMember -> Maybe SignedMsg -> MemberKey -> CM (Maybe C.PublicKeyEd25519) - storeMemberKey gInfo GroupMember {groupMemberId, memberPubKey, memberId} signedMsg_ (MemberKey k) = case memberPubKey of - Just k0 -> Nothing <$ 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 - | memberSigned gInfo memberId k signedMsg_ -> Just k <$ withStore' (\db -> setMemberPubKey db groupMemberId k) - | otherwise -> Nothing <$ messageError "member key not signed by that key, ignored" + | memberSigned gInfo memberId k signedMsg_ -> m {memberPubKey = Just k} <$ withStore' (\db -> setMemberPubKey db groupMemberId k) + | otherwise -> m <$ messageError "member key not signed by that key, ignored" xGrpLinkAcpt :: GroupInfoKeys -> GroupMember -> GroupAcceptance -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM () xGrpLinkAcpt g@(GIK gInfo@GroupInfo {membership} _) m acceptance role memberId msg brokerTs @@ -2927,10 +2903,10 @@ 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 -> Maybe ProofPresHeader -> Profile -> Maybe (RcvMessage, UTCTime) -> CM GroupMember - processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} presHeader_ rcvProfile msgTs_ + processMemberProfileUpdate :: GroupInfo -> GroupMember -> Maybe SignedMsg -> Profile -> Maybe (RcvMessage, UTCTime) -> CM GroupMember + processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId, memberBadgeProof} signedMsg_ rcvProfile 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 || proofHeaderChanged = do + | contentChanged || badgeNeedsReverify p || memberProofChanged = do when contentChanged $ updateBusinessChatProfile gInfo case memberContactId of Nothing -> do @@ -2959,16 +2935,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag | otherwise = pure m where - p' = case rcvProfile of - Profile {badge = Just b} | not (acceptedProof presHeader_ b) -> rcvProfile {badge = storedProof} - _ -> rcvProfile + presHeader_ = signedMemberPresHeader gInfo m signedMsg_ + (p', memberProofChanged) = case rcvProfile of + Profile {badge = Just b} | not (acceptedProof presHeader_ b) -> (rcvProfile {badge = storedProof}, False) + Profile {badge} -> (rcvProfile, (proofContent <$> badge) /= (proofContent <$> unNoJSON memberBadgeProof)) + proofContent BadgeProof {presHeader, badgeInfo} = (presHeader, badgeInfo) Profile {badge = storedProof} = fromLocalProfile p p'' = redactedMemberProfile gInfo m p' contentChanged = not (sameProfileContent (redactedMemberProfile gInfo m (fromLocalProfile p)) p'') - proofHeaderChanged = case (p', p) of - (Profile {badge = Just BadgeProof {presHeader}}, LocalProfile {localBadge = Just (PeerBadge BadgeProof {presHeader = storedHeader} _)}) -> - presHeader /= storedHeader - _ -> False updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of Just bc | isMainBusinessMember bc m -> do g' <- withStore $ \db -> updateGroupProfileFromMember db user g p' @@ -3203,13 +3177,12 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag toView $ CEvtContactAndMemberAssociated user c2 g m1 c2' pure c2' - saveConnInfo :: Connection -> ConnInfo -> CM (Connection, Maybe GroupInfoKeys) - saveConnInfo activeConn connInfo = do + saveConnInfo :: Connection -> Maybe ProofPresHeader -> ConnInfo -> CM (Connection, Maybe GroupInfoKeys) + saveConnInfo activeConn presHeader_ connInfo = do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo conn' <- updatePeerChatVRange activeConn chatVRange case chatMsgEvent of XInfo p _ -> do - presHeader_ <- connPresHeader conn' ct <- withStore $ \db -> createDirectContact db cxt user conn' presHeader_ p toView $ CEvtContactConnecting user ct pure (conn', Nothing) @@ -3234,7 +3207,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_ = PHChat <$> memberChatBinding gInfo memId ((\(MemberKey k) -> k) <$> assertedKey_) + let presHeader_ = memberInfoPresHeader gInfo memInfo if sameMemberId memId (membership gInfo) then pure Nothing else @@ -3315,8 +3288,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag pure (announcedMember', Just scopeInfo) xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> CM () - xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _ introKey_) memRestrictions = do - let presHeader_ = PHChat <$> memberChatBinding gInfo memId ((\(MemberKey k) -> k) <$> introKey_) + xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _ _) memRestrictions = do + let presHeader_ = memberInfoPresHeader gInfo memInfo case memberCategory m of GCHostMember -> withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case @@ -3367,7 +3340,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag _ -> messageError "x.grp.mem.inv can be only sent by invitee member" xGrpMemFwd :: GroupInfoKeys -> GroupMember -> MemberInfo -> IntroInvitation -> CM () - xGrpMemFwd g@(GIK gInfo@GroupInfo {membership, chatSettings} _) m memInfo@(MemberInfo memId memRole memChatVRange _ introKey_) IntroInvitation {groupConnReq, directConnReq} = do + xGrpMemFwd g@(GIK gInfo@GroupInfo {membership, chatSettings} _) m memInfo@(MemberInfo memId memRole memChatVRange _ _) IntroInvitation {groupConnReq, directConnReq} = do let GroupMember {memberId = membershipMemId} = membership checkHostRole m memRole toMember <- withStore $ \db -> do @@ -3378,7 +3351,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 (PHChat <$> memberChatBinding gInfo memId ((\(MemberKey k) -> k) <$> introKey_)) 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.? @@ -3389,24 +3362,27 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag subMode <- chatReadVar subscriptionMode let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange chatV = vr cxt `peerConnChatVersion` mcvr - p = redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership -- [incognito] send membership incognito profile, create direct connection as incognito - membershipProfile <- - if chatV >= relayWebCapVersion - then presentUserBadge user (incognitoMembershipProfile gInfo) (groupPresHeader gInfo) p - else pure p + membershipProfile <- membershipHandshakeProfile gInfo chatV let msg = XGrpMemInfo membershipMemId membershipProfile dm <- maybe (encodeConnInfo msg) (`encodeSignedConnInfo` msg) (groupMsgSigning False g msg) -- [async agent commands] no continuation needed, but commands should be asynchronous for stability let enableNtfsGrp = chatHasNtfs chatSettings - (groupConnIds@(gCmdId, gAcId), _) <- prepareAgentJoin user Nothing enableNtfsGrp groupConnReq - directConnIds <- mapM (fmap fst . prepareAgentJoin user Nothing True) directConnReq + (groupConnIds@(gCmdId, gAcId), _) <- prepareAgentJoin user enableNtfsGrp groupConnReq + directConnIds <- mapM (fmap fst . prepareAgentJoin user True) directConnReq let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds directConnIds customUserProfileId subMode joinAgentConnectionAsync gCmdId False gAcId enableNtfsGrp groupConnReq dm subMode forM_ ((,) <$> directConnIds <*> directConnReq) $ \((dCmdId, dAcId), dcr) -> joinAgentConnectionAsync dCmdId False dAcId True dcr dm subMode + membershipHandshakeProfile :: GroupInfo -> VersionChat -> CM Profile + membershipHandshakeProfile gInfo@GroupInfo {membership} v + | v >= relayWebCapVersion = presentUserBadge user (incognitoMembershipProfile gInfo) (groupPresHeader gInfo) p + | otherwise = pure p + where + p = redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership + -- rollback defense (channels): apply an owner-signed role/removal only at a version >= the persisted -- roster_version (not the batch-constant gInfo, which a relay can stale by reordering events in one -- batch), then advance it in the same transaction; a strictly lower version is a replay and is ignored. @@ -3929,12 +3905,12 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag } joinExistingContact subMode mCt@Contact {contactId = mContactId} | autoAcceptMemberContacts user = do - ((cmdId, acId), binding_) <- 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 (directPresHeader <$> binding_) subMode + joinMemberContactAsync cmdId acId presHeader subMode securityCodeChanged mCt' createItems mCt' m | otherwise = do @@ -3948,14 +3924,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag createItems mCt' m createNewContact subMode | autoAcceptMemberContacts user = do - ((cmdId, acId), binding_) <- 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 (directPresHeader <$> binding_) subMode + joinMemberContactAsync cmdId acId presHeader subMode createInternalChatItem user (CDDirectSnd mCt) CIChatBanner (Just epochStart) createItems mCt m' | otherwise = do @@ -3968,9 +3944,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 presHeader_ subMode = do + joinMemberContactAsync cmdId acId presHeader subMode = do -- [incognito] send membership incognito profile - p <- presentUserBadge user (incognitoMembershipProfile g) presHeader_ $ 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 @@ -3978,7 +3954,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag (g', m'', scopeInfo) <- mkGroupChatScope g m' createInternalChatItem user (CDGroupRcv g' scopeInfo m'') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing toView $ CEvtNewMemberContactReceivedInv user mCt' g' m'' - forM_ mContent_ $ \mc -> do + forM_ mContent_ $ chatLinkBadge >=> \mc -> do (ci, cInfo) <- saveRcvChatItem user (CDDirectRcv mCt') msg brokerTs (CIRcvMsgContent mc, msgContentTexts mc) toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv cInfo ci] @@ -4026,7 +4002,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag -- file description is always allowed, to allow sending files to support scope XMsgFileDescr sharedMsgId fileDescr fileExpires fileBadge -> void $ groupMessageFileDescription gInfo author_ sharedMsgId fileDescr fileExpires fileBadge XMsgUpdate sharedMsgId mContent mentions ttl live msgScope asGroup_ -> - void $ memberCanSend author_ msgScope $ groupMessageUpdate gInfo author_ sharedMsgId mContent mentions msgScope rcvMsg msgTs ttl live asGroup_ + void $ memberCanSend author_ msgScope $ chatLinkBadge mContent >>= \mc -> groupMessageUpdate gInfo author_ sharedMsgId mc mentions msgScope rcvMsg msgTs ttl live asGroup_ XMsgDel sharedMsgId memId scope_ _ -> void $ groupMessageDelete gInfo author_ sharedMsgId memId scope_ False rcvMsg msgTs XMsgReact sharedMsgId memId scope_ reaction add -> withAuthor XMsgReact_ $ \author -> void $ groupMsgReaction gInfo author sharedMsgId memId scope_ reaction add rcvMsg msgTs XFileCancel sharedMsgId -> void $ xFileCancelGroup gInfo author_ sharedMsgId diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index ba4afe581a..3088361752 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -1808,8 +1808,8 @@ updateRelayStatus_ db relayId relayStatus = do currentTs <- getCurrentTime DB.execute db "UPDATE group_relays SET relay_status = ?, updated_at = ? WHERE group_relay_id = ?" (relayStatus, currentTs, relayId) -setRelayLinkAccepted :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberKey -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO (GroupMember, GroupRelay) -setRelayLinkAccepted db cxt user m (MemberKey relayKey) presHeader_ profile = do +setRelayLinkAccepted :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberKey -> Profile -> ExceptT StoreError IO (GroupMember, GroupRelay) +setRelayLinkAccepted db cxt user m (MemberKey relayKey) profile = do let gmId = groupMemberId' m currentTs <- liftIO getCurrentTime liftIO $ DB.execute @@ -1828,7 +1828,7 @@ setRelayLinkAccepted db cxt user m (MemberKey relayKey) presHeader_ profile = do WHERE group_member_id = ? |] (relayKey, currentTs, gmId) - void $ updateMemberProfile db cxt user m presHeader_ profile + void $ updateMemberProfile db cxt user m Nothing profile (,) <$> getGroupMemberById db cxt user gmId <*> getGroupRelayByGMId db gmId setRelayLinkConfId :: DB.Connection -> GroupMember -> ConfirmationId -> ShortLinkContact -> IO () @@ -1875,8 +1875,8 @@ getRelayConfId db m = |] (Only (groupMemberId' m)) -updateRelayMemberData :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberId -> MemberKey -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO () -updateRelayMemberData db cxt user m memberId (MemberKey relayKey) presHeader_ profile = do +updateRelayMemberData :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberId -> MemberKey -> Profile -> ExceptT StoreError IO () +updateRelayMemberData db cxt user m memberId (MemberKey relayKey) profile = do currentTs <- liftIO getCurrentTime liftIO $ DB.execute @@ -1887,7 +1887,7 @@ updateRelayMemberData db cxt user m memberId (MemberKey relayKey) presHeader_ pr WHERE group_member_id = ? |] (memberId, relayKey, currentTs, groupMemberId' m) - void $ updateMemberProfile db cxt user m presHeader_ profile + void $ updateMemberProfile db cxt user m Nothing profile setGroupInProgressDone :: DB.Connection -> GroupInfo -> IO () setGroupInProgressDone db GroupInfo {groupId} = do @@ -2050,7 +2050,7 @@ getRelayPublishableGroups db User {userId, userContactId} = where toRow ((gId, pgId) :. accessRow) = (gId, pgId, toPublicGroupAccess accessRow) -getGroupViaPublicGroupId :: DB.Connection -> User -> B64UrlByteString -> IO (Maybe (GroupId, Maybe ShortLinkContact)) +getGroupViaPublicGroupId :: DB.Connection -> User -> B64UrlByteString -> IO (Maybe (GroupId, ShortLinkContact)) getGroupViaPublicGroupId db User {userId} publicGroupId = maybeFirstRow id $ DB.query @@ -2635,13 +2635,13 @@ createIntroReMember cxt user gInfo - (MemberInfo memId memRole memChatVRange memberProfile memKey) + memInfo@(MemberInfo _ _ _ memberProfile _) presHeader_ memRestrictions_ = do currentTs <- liftIO getCurrentTime (localDisplayName, memProfileId, memberProfile', badgeVerified) <- createNewMemberProfile_ db cxt user memberProfile presHeader_ currentTs let memRestriction = restriction <$> memRestrictions_ - newMember = NewGroupMember {memInfo = MemberInfo memId memRole memChatVRange memberProfile' memKey, 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 diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 44f239f492..408f382fc9 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -850,22 +850,19 @@ fromLocalProfile LocalProfile {displayName, fullName, shortDescr, description, i ShownBadge _ _ -> Nothing -- a display-only badge is not sent profileBadgeVerified :: Maybe ProofPresHeader -> Map Int BBSPublicKey -> Maybe LocalProfile -> Profile -> IO (Profile, Maybe Bool) -profileBadgeVerified expected keys lp_ p@Profile {badge = newBadge} = case newBadge of - Nothing -> pure (p, Just False) - Just newB@(BadgeProof _ _ _ newInfo) - | not (acceptedProof expected newB) -> pure (p {badge = storedProof}, storedVerified) +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 <- storedBadge, localBadgeInfo lb == newInfo && localBadgeStatus lb `notElem` [BSFailed, BSUnknownKey] -> pure (p, Just True) - | otherwise -> (,) p <$> verifyBadge keys newB + (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_ - Profile {badge = storedProof} = maybe p {badge = Nothing} fromLocalProfile lp_ - storedVerified = case localBadgeStatus <$> storedBadge of - Nothing -> Just False - Just BSFailed -> Just False - Just BSUnknownKey -> Nothing - Just _ -> Just True + newBadge + | all (acceptedProof expected) rcvBadge = rcvBadge + | otherwise = (\Profile {badge} -> badge) . fromLocalProfile =<< lp_ -- 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 diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 139b9ba376..81b23abfbd 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -77,6 +77,7 @@ chatProfileTests = do it "supporter badge of member joining via group link, at request and after handshake" testUserBadgeGroupLinkJoiner it "supporter badge of introduced member" testUserBadgeIntroduced it "supporter badge of member invited via contact, forwarded to introduced member" testUserBadgeInvitedIntroduced + it "supporter badge of inviting host in the reply to the invited contact" testUserBadgeInvitingHost 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 shared address card" testUserBadgeAddressCard @@ -415,7 +416,6 @@ testUserBadgeGroupHandshake ps = do bob <## "#team: alice added cath (Catherine) to the group (connecting...)" bob <## "#team: new member cath is connected" ] - -- bob sent nothing to the group, so the badge reached cath in the member connection handshake cath ##> "/i #team bob" cath <## "group ID: 1" cath <##. "member ID: " @@ -434,7 +434,6 @@ testUserBadgeGroupUpdate ps = do test sk alice bob cath = do createGroup3 "team" alice bob cath addTestBadge bob =<< issueTestBadge sk futureDate - -- the profile with the badge is sent to the group with the next message bob #> "#team hello" alice <# "#team bob> hello" cath <# "#team bob> hello" @@ -715,7 +714,7 @@ testUserBadgeOtherBinding ps = do (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 CBDirect "other chat") + 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} @@ -829,6 +828,20 @@ testUserBadgeInvitedIntroduced ps = do 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" + testUserBadgeInvitationLinkData :: HasCallStack => TestParams -> IO () testUserBadgeInvitationLinkData ps = do Right (pk, sk) <- bbsKeyGen @@ -845,7 +858,7 @@ testUserBadgeInvitationLinkData ps = do sLinkData `shouldContain` "\"status\":\"active\"" bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> sLinkData) bob <## "alice: contact is prepared" - contactBadgeHeader bob "alice" `shouldReturn` Just ("R", BSActive) + contactBadgeHeader bob "alice" `shouldReturn` Just ("L", BSActive) testUserBadgeAddressFirstShortLink :: HasCallStack => TestParams -> IO () testUserBadgeAddressFirstShortLink ps = do @@ -887,14 +900,24 @@ testUserBadgeAddressCard ps = do lastItemContent bob >>= (`shouldContain` "\"badgeType\":\"supporter\"") cred <- issueTestBadge sk futureDate Right otherProof <- badgeProof pk cred (PHLink "other link") + Right testProof <- badgeProof pk cred (PHTest "nonce") let cLink = either error id $ strDecode (B.pack bLink) - mc = MCChat (T.pack bLink) (MCLContact cLink (profileFromName "alice") {badge = Just otherProof} False) Nothing - bob ##> ("/_send @3 json [{\"msgContent\":" <> T.unpack (encodeJSON mc) <> "}]") + card proof = MCChat (T.pack bLink) (MCLContact cLink (profileFromName "alice") {badge = Just proof} False) Nothing + bob ##> ("/_send @3 json [{\"msgContent\":" <> T.unpack (encodeJSON $ card otherProof) <> "}]") bob <# "@cath contact address of @alice:" _ <- getTermLine bob cath <# "bob> contact address of @alice:" _ <- getTermLine cath lastItemContent cath >>= (`shouldNotContain` "\"badge\"") + bob #> "@cath hi" + cath <# "bob> hi" + msgId <- lastItemId bob + bob ##> ("/_update item @3 " <> msgId <> " json {\"msgContent\":" <> T.unpack (encodeJSON $ card testProof) <> ",\"mentions\":{}}") + bob <# "@cath [edited] contact address of @alice:" + _ <- getTermLine bob + cath <# "bob> [edited] contact address of @alice:" + _ <- getTermLine cath + lastItemContent cath >>= (`shouldNotContain` "\"badge\"") testUpdateProfileImage :: HasCallStack => TestParams -> IO () testUpdateProfileImage =