From 44773d0412ea44637a873fa90f1b0b24f234f52d Mon Sep 17 00:00:00 2001 From: Evgeny Date: Fri, 11 Sep 2026 12:33:07 +0100 Subject: [PATCH] core: support message signing in p2p groups (#7312) * core: support message signing in p2p groups * improve * add member key * distribute keys and sign * refactor * better query * map * sign in relay groups too * clean up * list * fix test * update bot types * some refactor * remove unnecessary condition * simplify * refactor * simplify * move * clean up * diff * diff * limit attempts for key sending * optimize * fix test * split * fuse * null * only mark as "key sent" when forwarder supports binary encoding * fix bot apis * fix some tests * add key distribution steps, and fix some tests * fix test * increase timeout * fix tests * fix more tests * simplify * disable test output * mark keys sent with invitations * fix test * fix test, query plans * unify signing of connection info packets * revert change to createNewGroup * create key at group/member creation * rename, remove liftIO * clean up * fix type * remove ad hoc key sending * update bot api * diff * reduce diff * failing test * fix sending messages in groups with members before version 18 * remove test delays * update query plans * update test * add tests * fix tests --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com> --- bots/api/COMMANDS.md | 1 + bots/api/TYPES.md | 13 +- bots/src/API/Docs/Types.hs | 2 + .../types/typescript/src/responses.ts | 1 + .../types/typescript/src/types.ts | 8 +- .../src/simplex_chat/types/_responses.py | 1 + .../src/simplex_chat/types/_types.py | 7 +- plans/2026-07-26-p2p-member-keys.md | 189 +++++ src/Simplex/Chat/Controller.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 50 +- src/Simplex/Chat/Library/Internal.hs | 111 ++- src/Simplex/Chat/Library/Subscriber.hs | 145 ++-- src/Simplex/Chat/Messages/Batch.hs | 2 +- src/Simplex/Chat/Protocol.hs | 41 +- src/Simplex/Chat/Store/Groups.hs | 102 ++- .../SQLite/Migrations/chat_query_plans.txt | 16 +- src/Simplex/Chat/Store/Shared.hs | 10 +- src/Simplex/Chat/Terminal/Input.hs | 2 +- src/Simplex/Chat/Types.hs | 13 +- src/Simplex/Chat/View.hs | 2 +- tests/Bots/DirectoryTests.hs | 66 +- tests/ChatTests/Files.hs | 4 +- tests/ChatTests/Forward.hs | 2 +- tests/ChatTests/Groups.hs | 792 ++++++++++++------ tests/ChatTests/Profiles.hs | 70 +- tests/ProtocolTests.hs | 26 +- 26 files changed, 1126 insertions(+), 552 deletions(-) create mode 100644 plans/2026-07-26-p2p-member-keys.md diff --git a/bots/api/COMMANDS.md b/bots/api/COMMANDS.md index d88181b778..dd62b87585 100644 --- a/bots/api/COMMANDS.md +++ b/bots/api/COMMANDS.md @@ -1854,6 +1854,7 @@ GroupDeletedUser: User deleted group. - user: [User](./TYPES.md#user) - groupInfo: [GroupInfo](./TYPES.md#groupinfo) - msgSigned: bool +- localDeletion: bool ChatCmdError: Command error (only used in WebSockets API). - type: "chatCmdError" diff --git a/bots/api/TYPES.md b/bots/api/TYPES.md index 203e790f1e..1ba260b3d3 100644 --- a/bots/api/TYPES.md +++ b/bots/api/TYPES.md @@ -158,6 +158,7 @@ This file is generated automatically. - [ProxyError](#proxyerror) - [PublicGroupAccess](#publicgroupaccess) - [PublicGroupData](#publicgroupdata) +- [PublicGroupKeys](#publicgroupkeys) - [PublicGroupProfile](#publicgroupprofile) - [RCErrorType](#rcerrortype) - [RatchetSyncState](#ratchetsyncstate) @@ -2404,8 +2405,7 @@ MemberSupport: ## GroupKeys **Record type**: -- publicGroupId: string -- groupRootKey: [GroupRootKey](#grouprootkey) +- publicGroupKeys: [PublicGroupKeys](#publicgroupkeys)? - memberPrivKey: string @@ -3274,6 +3274,15 @@ NO_SESSION: - publicMemberCount: int64 +--- + +## PublicGroupKeys + +**Record type**: +- publicGroupId: string +- groupRootKey: [GroupRootKey](#grouprootkey) + + --- ## PublicGroupProfile diff --git a/bots/src/API/Docs/Types.hs b/bots/src/API/Docs/Types.hs index e0af1f3ff5..4567512b75 100644 --- a/bots/src/API/Docs/Types.hs +++ b/bots/src/API/Docs/Types.hs @@ -342,6 +342,7 @@ chatTypesDocsData = (sti @ProxyError, STUnion, "", [], "", ""), (sti @PublicGroupAccess, STRecord, "", [], "", ""), (sti @PublicGroupData, STRecord, "", [], "", ""), + (sti @PublicGroupKeys, STRecord, "", [], "", ""), (sti @PublicGroupProfile, STRecord, "", [], "", ""), (sti @RatchetSyncState, STEnum, "RS", [], "", ""), (sti @RCErrorType, STUnion, "RCE", [], "", ""), @@ -576,6 +577,7 @@ deriving instance Generic ProxyClientError deriving instance Generic ProxyError deriving instance Generic PublicGroupAccess deriving instance Generic PublicGroupData +deriving instance Generic PublicGroupKeys deriving instance Generic PublicGroupProfile deriving instance Generic RatchetSyncState deriving instance Generic RCErrorType diff --git a/packages/simplex-chat-client/types/typescript/src/responses.ts b/packages/simplex-chat-client/types/typescript/src/responses.ts index b2d29490c8..fd6050ef49 100644 --- a/packages/simplex-chat-client/types/typescript/src/responses.ts +++ b/packages/simplex-chat-client/types/typescript/src/responses.ts @@ -246,6 +246,7 @@ export namespace CR { user: T.User groupInfo: T.GroupInfo msgSigned: boolean + localDeletion: boolean } export interface GroupLink extends Interface { diff --git a/packages/simplex-chat-client/types/typescript/src/types.ts b/packages/simplex-chat-client/types/typescript/src/types.ts index 09c88069e2..eadfda7ba9 100644 --- a/packages/simplex-chat-client/types/typescript/src/types.ts +++ b/packages/simplex-chat-client/types/typescript/src/types.ts @@ -2700,8 +2700,7 @@ export interface GroupInfo { } export interface GroupKeys { - publicGroupId: string - groupRootKey: GroupRootKey + publicGroupKeys?: PublicGroupKeys memberPrivKey: string } @@ -3548,6 +3547,11 @@ export interface PublicGroupData { publicMemberCount: number // int64 } +export interface PublicGroupKeys { + publicGroupId: string + groupRootKey: GroupRootKey +} + export interface PublicGroupProfile { groupType: GroupType groupLink: string diff --git a/packages/simplex-chat-python/src/simplex_chat/types/_responses.py b/packages/simplex-chat-python/src/simplex_chat/types/_responses.py index 393c20f311..217fb3019d 100644 --- a/packages/simplex-chat-python/src/simplex_chat/types/_responses.py +++ b/packages/simplex-chat-python/src/simplex_chat/types/_responses.py @@ -103,6 +103,7 @@ class GroupDeletedUser(TypedDict): user: "T.User" groupInfo: "T.GroupInfo" msgSigned: bool + localDeletion: bool class GroupLink(TypedDict): type: Literal["groupLink"] diff --git a/packages/simplex-chat-python/src/simplex_chat/types/_types.py b/packages/simplex-chat-python/src/simplex_chat/types/_types.py index 25206c8654..74ffd4536b 100644 --- a/packages/simplex-chat-python/src/simplex_chat/types/_types.py +++ b/packages/simplex-chat-python/src/simplex_chat/types/_types.py @@ -1898,8 +1898,7 @@ class GroupInfo(TypedDict): groupDomainVerified: NotRequired[bool] class GroupKeys(TypedDict): - publicGroupId: str - groupRootKey: "GroupRootKey" + publicGroupKeys: NotRequired["PublicGroupKeys"] memberPrivKey: str class GroupLink(TypedDict): @@ -2490,6 +2489,10 @@ class PublicGroupAccess(TypedDict): class PublicGroupData(TypedDict): publicMemberCount: int # int64 +class PublicGroupKeys(TypedDict): + publicGroupId: str + groupRootKey: "GroupRootKey" + class PublicGroupProfile(TypedDict): groupType: "GroupType" groupLink: str diff --git a/plans/2026-07-26-p2p-member-keys.md b/plans/2026-07-26-p2p-member-keys.md new file mode 100644 index 0000000000..6bad3829e4 --- /dev/null +++ b/plans/2026-07-26-p2p-member-keys.md @@ -0,0 +1,189 @@ +# p2p group member keys - generation and distribution + +## Goal + +Give every member of a p2p (non-relay) group an Ed25519 signing key, and distribute each member's public key to the other members, so p2p group messages can be signed and verified. New members are keyed at join; existing members are keyed on upgrade and their keys are distributed through the existing profile-update path. + +## Design (agreed) + +- Own key: private in `groups.member_priv_key` (via `GroupKeys.memberPrivKey`), public in the membership's `group_members.member_pub_key`. `groupKeys = Just (GroupKeys {publicGroupKeys = Nothing, memberPrivKey})` marks a p2p member key. +- Distribution: the public key is included in `XInfo` (and in `XContact` at join). `XInfo` is sent by the existing profile-update send (`sendGroupProfileUpdate`); the key is included whenever `XInfo` is sent, and a per-member flag records delivery to version-compatible members. One `XInfo` per send - if the profile is sent because it changed, the key is included in that message rather than a second one. +- Version: a new chat version decides who is marked and who can read the key. A member between version 7 and the new version receives `XInfo` for the profile and ignores the unknown key field. +- No acknowledgement in groups: the flag is set on send. A lost message means the member cannot verify until the next send re-delivers the key; whether an unverifiable claim is hidden or shown is a per-claim decision. + +## Current state (last commit `261d09ba4`) + +Field plumbing is done: `memberKey :: Maybe MemberKey` added to `XInfo` and `XContact`, full encode/decode, all call sites pass `Nothing`/`_`. Four `TODO [member keys]` markers remain at the fill-in points: `Commands.hs:3911` (XContact join), `Internal.hs:2489` (profile-update send `sendGroupProfileUpdate`), `Subscriber.hs:836` (join-confirmation allow), `xInfoMember` (receive/store). + +## Changes + +### 1. Version - `Protocol.hs` + +- Add `groupMemberKeyVersion :: VersionChat = VersionChat 20` with a comment. +- `currentChatVersion = VersionChat 20` (from 19). +- Add changelog line `-- 20 - p2p group member keys for signing (2026-07-26)`. +- No new binary-floor constant: reuse `relayWebCapVersion` (18) as the reliable binary-batch floor for partitioning signed sends (item 7). Binary parsing was added in #6597 at version 17 with no constant; 18 is the first guaranteed. + +### 2. Schema + type + row parsing + +- New migration `M20260726_member_key_sent.hs` (mirror `M20260720_server_roles.hs`): `ALTER TABLE group_members ADD COLUMN user_member_key_sent INTEGER NOT NULL DEFAULT 0`. Update `chat_schema.sql`. +- `GroupMember` (`Types.hs:1119`): add `userMemberKeySent :: Bool` after `memberPubKey`. +- `GroupMemberRow` / `MaybeGroupMemberRow` (`Groups.hs:263`): add `BoolInt` / `Maybe BoolInt` to the last tuple group, next to `member_pub_key`. +- `toGroupMember` / `toMaybeGroupMember`: parse the column. +- Every `SELECT` that builds a `GroupMemberRow` adds `user_member_key_sent` (shared column list - several sites; grep the existing `member_pub_key, relay_link` list). + +### 3. Own key generation + storage (key exists before signing) + +- New store fn `setUserMemberKey :: DB.Connection -> GroupId -> GroupMemberId -> C.PrivateKeyEd25519 -> IO ()`: two writes, both required - the private key to `groups.member_priv_key` (the user's own signing key for this group) and its derived public key to the user's own membership row (`group_members.member_pub_key`), as `createNewGroup:429` does. +- New helper `ensureUserMemberKey :: User -> GroupInfo -> CM GroupInfo`: if `groupKeys` already has a key, return `gInfo` unchanged; for a p2p group with `groupKeys = Nothing`, generate an Ed25519 key, store it via `setUserMemberKey`, and return `gInfo` with `groupKeys = Just (GroupKeys {publicGroupKeys = Nothing, memberPrivKey})`. Idempotent (check-and-set in one transaction so concurrent sends cannot create two keys). +- Generation points: + - Create group - `APINewGroup` (`Commands.hs:2642`): generate the key and pass `Just GroupKeys {publicGroupKeys = Nothing, memberPrivKey}` to `newGroup` (was `Nothing`). `createNewGroup` (`Groups.hs:393-430`) already stores both columns. + - Join - in `joinContact`'s p2p-group branch (item 5): `gInfo' <- ensureUserMemberKey user gInfo`, take the public key from `gInfo'` `groupKeys` for `XContact`. + - Send - call `ensureUserMemberKey` at the top of the send entry (`sendGroupMessages` `:2458`, `sendGroupSignedMessages` `:2464`) and thread the returned `gInfo'` to BOTH `sendGroupProfileUpdate` and `sendGroupMessages_`, so `groupMsgSigning` signs the very first message after generation - the key must not lag one message behind. This is also the lazy path for groups created before this change. + +### 4. `sendGroupProfileUpdate` - one `XInfo` with profile and/or key (`Internal.hs:2468`) + +Key and signing are independent of incognito status: the member key is per group and needed in every p2p group. Only the badge may depend on incognito, and that is handled by the existing profile/badge logic, not the key path. `shouldSendProfileUpdate` gates only the profile part; the key part runs regardless. Restructure `sendGroupProfileUpdate` so a single `XInfo` serves both purposes (never two messages), for non-relay groups, using `gInfo'` from `ensureUserMemberKey`: + +- `profileMembers = if shouldSendProfileUpdate then filter (\`supportsVersion\` memberProfileUpdateVersion) members else []` (unchanged trigger; still skips incognito, scope, asGroup). +- `keyMembers` = members with `supportsVersion groupMemberKeyVersion` and `not (userMemberKeySent m)` - runs regardless of incognito. +- recipients = union of the two. +- Send one `XInfo profile (Just ownKey)` to recipients via `sendGroupMessages_` (`:2500`), which returns the `GroupSndResult` needed for marking - `sendGroupMessage'` (`:2374`) discards it (the `_` at `:2377`), so the current `sendGroupProfileUpdate` send call must change. `profile` and its badge are the existing profile logic (unchanged); `ownKey = MemberKey (C.publicKey memberPrivKey)` from `gInfo'` `groupKeys`. +- After send, from that `GroupSndResult`: set `userMemberKeySent = True` for a key recipient whose `sentTo` delivery result (the third tuple element, `:2495`) is `Right`, or that is in `pending` or `forwarded` (enqueued, stored for delivery on connect, or forwarded). A `sentTo` `Left` (enqueue failure) stays `False`. `updateUserMemberProfileSentAt` only when `shouldSendProfileUpdate`. +- Retry stays but is uncapped: any `False` member is re-included on the next send. No cap is needed because `memberSendAction` (`Internal.hs:2608`) returns `Nothing` for a disabled/deleted/failed/rejected connection, so `addMember` (`:2542`) skips it - re-inclusion re-filters it in memory, it is never actually re-sent. The only un-marked-but-attempted case is a `sentTo` failure on a *ready* connection (a rare enqueue error), which retries next send and fails identically for the content message; a truly broken connection transitions to disabled/failed and is then skipped. So retry is cheap and self-limiting. `user_member_key_sent` is a plain boolean. +- New store fn `setMembersMemberKeySent :: DB.Connection -> [GroupMemberId] -> IO ()`. +- Relay groups keep current behaviour (no key here; key comes from the roster). + +The member list is already in memory and `userMemberKeySent` is a field on the record, so both filters are in-memory with no extra query. + +### 5. Fill the TODO send points + +- `joinContact` (`Commands.hs:3900`): the key belongs only in the `Just (Just gInfo) | not (useRelays' gInfo)` case (p2p group join). Split that out of the current `_` branch: `gInfo' <- ensureUserMemberKey user gInfo`, then `XContact profileToSend (Just ownKey) (Just xContactId) welcomeSharedMsgId msg_`. The `Just Nothing` (unknown group) and `Nothing` (direct contact) cases keep `XContact ... Nothing ...`. `XContact` is `encodeConnInfoPQ` (JSON), so this delivery is **unsigned** - the initial trust-on-first-use key. The membership row exists in `gInfo` here, so `setUserMemberKey` writes `member_pub_key` (#5 confirmed). +- `Subscriber.hs:836` (joiner's allow-reply to the host): `XInfo profileToSend (Just ownKey)`, **signed** with the joiner's key when the host version allows (item 6). `XInfo` is `requiresSignature`, so it is signed like any other `XInfo`; this gives the host a signed confirmation of the joiner's key at join. +- `Subscriber.hs:1626` (host accepting the join): pass the parsed `XContact.memberKey` to `acceptGroupJoinRequestAsync` instead of `Nothing`; it flows to `createJoiningMember` (`Groups.hs:2070`, `:2112`), which stores `member_pub_key` (unsigned TOFU). +- Host key to the joiner: `XGrpLinkMem` (`Protocol.hs:503`, currently `Profile` only) needs a `Maybe MemberKey` field added, like the commit added to `XInfo`/`XContact`. The host already sends it during the join in `sendXGrpLinkMem` (`Subscriber.hs:974`), fired on the joiner's `CON` (`:958`); include the host's key, and store it in `xGrpLinkMem` (`:2760`). This is the host->joiner counterpart of the joiner's `XContact`. Add `XGrpLinkMem` to `requiresSignature` (safe - p2p-only, relay groups never send/receive it). But `sendXGrpLinkMem` currently uses `sendDirectMemberMessage` -> `sendDirectMessage_` -> `createSndMessage` (`:2197`), which hardcodes `Nothing` signing and sends via `deliverMessage` (no `groupMsgSigning`, no mode partition) - so `requiresSignature` alone would not sign it. Switch `sendXGrpLinkMem` to `sendGroupMemberMessages` (`:2228`), which computes `groupMsgSigning` (`:2231`) and uses the mode at `:2232` (item-7 partition site: binary-signed to a v20+ joiner, unsigned JSON to a pre-20 joiner), and run `ensureUserMemberKey` first so the host has a key to sign with. `xGrpLinkMem` (`:2760`) must `verifyGroupSig` against the key delivered in the message (self-certifying, like `:868`), since `withVerifiedMsg` has no stored host key yet. + +### 6. Receive + confirm the key + +The key is confirmed cryptographically wherever the `XInfo` is signed. Two receive points: + +- Handshake allow-reply - `Subscriber.hs:868` (`XInfo _ _`). The joiner's reply can be signed: `encodeSignedConnInfo` already produces a signed connInfo (used by `encodeXMemberConnInfo`), and the peer version is known by `INFO` (`updatePeerChatVRange`), so sign the allow-reply (item 5) with the joiner's key when the host version supports it. `parseChatMessage` here is `parseChatMessage'` with the signature discarded (`Internal.hs:1793`); switch to `parseChatMessage'`, verify the signature against the key in the `XInfo`, then read and confirm the key. This confirms the joiner's key at join. +- Group-message `XInfo` - `xInfoMember` (`Subscriber.hs:2755`), signed via item 7, for ongoing profile/key updates. + +Store/confirm rule at both points, new store fn `setMemberPubKey :: DB.Connection -> GroupMemberId -> C.PublicKeyEd25519 -> IO ()` (the key-only, no-role counterpart of the existing `setGroupMemberKeyRole`): +- `memberPubKey m = Nothing`, `mKey = Just k` -> store `k`. +- `memberPubKey m = Just k0` -> accept only `Nothing` or `Just k0`; a different key is rejected (immutable). + +This is the same pin-or-reject rule as the existing `applyMemberKeyRole` (`Subscriber.hs`, used by the roster): `Nothing` -> pin, `Just k` with `k /= pubKey` -> `Left` reject. Reuse or mirror it. + +Signing is uniform: `XInfo` is `requiresSignature`, so every group `XInfo` (the 836 allow-reply, group profile updates) and `XGrpLinkMem` is signed with the member's key when the recipient version allows (binary). The one unconditionally-unsigned delivery is `XContact` - a JSON connInfo that cannot be signed; the host holds that key as trust-on-first-use, confirmed by the joiner's signed `XInfo` (the 836 reply, then later updates). + +### 7. Signed send - partition recipients by binary capability + +Once `groupKeys = Just`, `groupMsgSigning` (`Internal.hs:2214`) produces a `MsgSigning` for p2p messages, and `createNewSndMessage` (`Store/Messages.hs:236`) stores each `SndMessage` with both `msgBody` (plain encoded message) and `signedMsg_ :: Maybe SignedMsg` (signature over that body). A signed element cannot sit in a JSON batch: `encodeBatchElement (Just sm) body = "/" <> smpEncode (chatBinding, signatures) <> body` (binary), `encodeBatchElement Nothing body = body` (plain JSON), and `encodeBatch` wraps them as `=...` (binary) or `[...]` (JSON) (`Batch.hs:70`, `:130-134`). So the same `SndMessage` yields either form with no re-encoding: keep `signedMsg_` for the signed element, set it to `Nothing` for the unsigned one. + +The send path currently picks one mode for the whole group: `mode = if useRelays' gInfo then BMBinary else BMJson` (`Internal.hs:2232`, `:2549`, `:2676`), so p2p is always `BMJson`. Change, for a p2p group when any message is signed (`any (isJust . signedMsg_) msgs`): + +- Partition the recipients (`toSendSeparate` and `toSendBatched`) by `\`supportsVersion\` relayWebCapVersion` (18, the binary-batch floor). +- Binary-capable members -> `batchSndMessagesJSON BMBinary msgs` (signed `/` elements). +- Binary-incapable members -> `batchSndMessagesJSON BMJson (map (fmap dropSig) msgs)`, `dropSig m = m {signedMsg_ = Nothing}` (unsigned JSON). +- Fold each partition over its own batch (`foldMembers` already runs per list) and concatenate; body references (`VRRef`) are naturally per-partition. + +Relay groups (`BMBinary` for all) and unsigned p2p sends (`BMJson` for all) are unchanged. + +A binary-capable member below `groupMemberKeyVersion` (18-19) receives the signed form, stores it unverified (no key), and can forward it intact via `encodeFwdElement` (`Batch.hs:125`), which preserves `signedMsg_` - which is why the partition is by binary capability, not key possession. A member below 18 receives the unsigned JSON form; in a p2p group `signatureOptional` is true, so it accepts the unsigned message rather than rejecting it. + +Three mode sites to update: `prepareMsgReqs` (`:2549`, main group send), `sendGroupMemberMessages` (`:2232`, member-to-member / introductions), and `:2676`. + +## Revision (2026-07-30): consolidate the send decision, classify delivery + +Items 2, 4, 7 above are the first-cut design - a boolean `user_member_key_sent`, set true on delivery, with the binary/JSON split re-derived in `prepareMsgReqs`. That shipped (commit `261d09ba4` onward) and is the current code. This revision replaces it. Two problems drove it: + +1. **`prepareMsgReqs` re-derives the send mode.** `memberSendAction` (`Internal.hs:2606`) already walks every member - with `useRelays'` and version in hand - to choose `MSASend`; `prepareMsgReqs` then walks the resulting `toSend` again - `partition useBinary` where `useBinary (m,_) = useRelays' gInfo || m supportsVersion relayWebCapVersion` (`:2564`) - recomputing the same decision. One decision, two owners. +2. **The boolean models only the happy path.** A `sentTo` `Left` is never marked, so an errored member is re-selected every send forever, uncounted; a disabled member (a `memberSendAction` skip) likewise. No permanent/transient split, no give-up. + +### A. `MemberSendAction` - total, records mode and skip reason + +```haskell +data SkipReason = SRUnsendable | SRNotApplicable + -- SRUnsendable: disabled / ConnDeleted / failed / GSMemRejected (memberSendAction :2619) + -- SRNotApplicable: relay non-target (:2615), self GCUserMember (:2625), forward with no path (:2633) +data MemberSendAction = MSASend BatchMode Connection | MSAPending | MSAForwarded | MSASkip SkipReason +memberSendAction :: ... -> MemberSendAction -- total, no Maybe +``` + +- Every current `Nothing` becomes `MSASkip r` with the reason from the branch it came from. For a key recipient (a real, non-self member receiving `XInfo`, not `XGrpMsgForward`), only `:2619` → `SRUnsendable` is reachable. +- `MSASend` records the `BatchMode` (`BMBinary` for `useRelays' gInfo || m supportsVersion relayWebCapVersion`, else `BMJson`) - computed where `memberSendAction` already branches on exactly that predicate. +- `addMember` (`:2550`) sorts `MSASend BMBinary` / `MSASend BMJson` into pre-partitioned `toSendBin` / `toSendJson`; `prepareMsgReqs` consumes those and drops its own `partition useBinary`. Problem 1 gone. +- `GroupSndResult` gains `skipped :: [(GroupMember, SkipReason)]` so the key-marking sees skips. The other consumer, `createMemberSndStatuses` (`Commands.hs:4822`), ignores `skipped` and the mode - unchanged. + +### B. Two columns + `KeySendStatus` sum type + +Replace the boolean with two columns (edit the unreleased `M20260727` migration + both `chat_schema.sql`; no new migration): +- `user_member_key_status TEXT` - `NULL` = attempting; `"sent"` = delivered; any other text = terminal error reason. +- `user_member_key_attempts INTEGER NOT NULL DEFAULT 0` - retriable-failure count. + +`GroupMember` field `userMemberKeyStatus :: KeySendStatus` (was `userMemberKeySent :: Bool`), a sum type constructed from the two columns: + +```haskell +data KeySendStatus = KSSent | KSError Text | KSAttempts Int +-- from (status :: Maybe Text, attempts :: Int): +-- (Just "sent", _) -> KSSent +-- (Just reason, _) -> KSError reason -- any non-null, non-"sent" text ("sent" reserved) +-- (Nothing, n) -> KSAttempts n -- still attempting, n prior retriable failures +``` + +Two columns, not one text field, so each marking outcome is one uniform bulk write (C): success touches only `status`, a retry touches only `attempts` (`attempts = attempts + 1`, no per-row value), an error groups by reason. Member creation default `KSAttempts 0` = (`NULL`, `0`). + +Selection: `memberNeedsKey m = m supportsVersion groupMemberKeyVersion && case userMemberKeyStatus m of { KSAttempts n -> n < maxKeySendAttempts; _ -> False }`. Comparing the count to config (E) means no separate "abandoned" state; raising the cap re-includes maxed-out members. + +### C. Marking - classify once, from `GroupSndResult` + +Per key-recipient, one outcome, written as partitioned bulk updates: +- **Delivered** (`sentTo` enqueue `Right`, or `pending`, or `forwarded`) → `status = "sent"`. +- **Skipped** (`skipped`): `SRUnsendable` → `status = ` terminal (a disabled connection is terminal in practice - `APIEnableGroupMember` is effectively never called - so stop re-selecting it); `SRNotApplicable` → untouched. +- **Errored** (`sentTo` `Left`): `terminalKeySend e` → `status = ` (grouped by reason); else → `attempts = attempts + 1`. + +The send is async: this classifies only the synchronous **enqueue** result. `submitPendingMsg` (`Agent.hs:2068`) hands the message to the SND worker, which does the network send and emits `SENT` / `MERR` (`Agent.hs:2196,2274`) - so AUTH / QUOTA / NETWORK / BROKER never reach this point; the agent retries them itself. `temporaryOrHostError` is therefore the wrong classifier here - it triages the async errors that cannot occur, and misjudges the few that can. + +### D. `terminalKeySend` - closed terminal set, default retriable + +```haskell +terminalKeySend :: ChatError -> Bool +terminalKeySend = \case + ChatErrorAgent {agentError} -> case agentError of + CONN SIMPLEX _ -> True -- connection has no send queue (prepareConn :1821) + CONN NOT_FOUND _ -> True -- connection / ratchet gone (getConn :1812) + NO_USER -> True -- user deleted + _ -> False + _ -> False +``` + +Everything else is retriable, bounded by the cap: `CMD PROHIBITED` (ratchet resync, `Agent.hs:1826`), `CRITICAL True` (agent DB lock, `SEDatabaseBusy`), `INACTIVE` (agent suspended), `ChatErrorStore` (chat DB contention), `INTERNAL` (catch-all - ambiguous, so retriable), and oversize (`CMD LARGE` / batch `CEInternalError "large message"` / `CEException "large compressed message"` - rare, a global profile-size problem, self-limiting under the cap; a dedicated `ChatErrorType` constructor for the batch case is a separate cleanup, out of this branch). Inverting to a terminal whitelist is deliberate: at the enqueue phase, mislabeling a transient error permanent abandons a member whose next send would succeed, while mislabeling a permanent error retriable costs only a few capped sends. + +Exhaustive reachability (why the terminal set is these three): the only synchronous producers are `getConn_` (`Agent.hs:1806`), `prepareConn` (`:1814`), and `enqueueMessageB`/`storeSentMsg` (`:2062`). All network/server errors (`SMP`/`BROKER`/`PROXY`/`NTF`/`XFTP`, and `AUTH`/`QUOTA`) are async (MERR) and unreachable here; `AGENT (A_*)` are receive/queue-op side; `CONN DUPLICATE`/`NOT_ACCEPTED`/`NOT_AVAILABLE`, `CMD SYNTAX`/`NO_CONN`/`SIZE`, `NTF`/`XFTP`/`FILE`/`RCP`/`NOTICE`/`CRITICAL False` are other paths. + +### E. Config + +`maxKeySendAttempts :: Int` in the chat config (value immaterial - a small cap like 5; over-retrying a rare ambiguous error is cheap). + +## Implementation status (2026-07-30) + +- Items 1, 3, 5, 6 - implemented as described: versions, key generation, distribution (`XContact` / `XGrpLinkMem` / `XInfo`), receive pin-or-reject. +- Items 2, 4, 7 - the boolean baseline is **replaced by the Revision (A-E)**, which is now implemented and compiles (`cabal build lib:simplex-chat`, both backends' schema + migration updated): + - A - `MemberSendAction` total, records `BatchMode` and `SkipReason`; `sendBatchMode` is the single owner of the binary/JSON decision; `sendGroupSignedMessages_` dedups then classifies with list comprehensions into pre-partitioned `toSendBin`/`toSendJson`; `prepareMsgReqs` reads them (no re-derivation); `GroupSndResult` gains `skipped`. + - B - two columns `user_member_key_status TEXT` / `user_member_key_attempts` (migration `M20260727` + both `chat_schema.sql`), field `userMemberKeyStatus :: KeySendStatus` built by `toKeySendStatus`, store fns `setMembersKeyStatus` / `incMembersKeyAttempts`. + - C - `markKeySends` classifies each key-recipient once from `GroupSndResult` and writes partitioned bulk updates; `memberNeedsKey` selects `KSAttempts n < maxKeySendAttempts`. + - D - `terminalKeySend` = {`CONN SIMPLEX`, `CONN NOT_FOUND`, `NO_USER`}; everything else retriable. + - E - `maxKeySendAttempts = 5`. + +Remaining work: +- Regenerate the client-type mirrors: `userMemberKeyStatus` still shows as `userMemberKeySent: boolean` in the generated `types.ts`, `_types.py`, and `bots/api/TYPES.md` (generated by `bots/src/API/Docs/Generate*.hs`). +- Tests: the branch adds none beyond `ProtocolTests` field plumbing - no coverage of distribution, pin-or-reject, signed send/verify, or the classification. + +## Open decisions + +- Names, to confirm or adjust: columns `user_member_key_status` / `user_member_key_attempts`, field `userMemberKeyStatus :: KeySendStatus`, constructors `KeySendStatus`/`KS*` and `SkipReason`/`SR*`, config `maxKeySendAttempts`. +- Whether a `SRUnsendable` skip is recorded as a terminal `error` (proposed: yes - a disabled connection is terminal in practice). + +Resolved: both key writes required (`groups.member_priv_key` and own-row `member_pub_key`). `XContact` includes the unsigned key at member creation and the signed allow-reply confirms it. Reuse `relayWebCapVersion` (18) as the binary floor. Key change on receipt - reject any change, immutable. Signed send (item 7) - partition by binary capability, and (Revision A) the mode is decided once in `memberSendAction`, not re-derived. Key distribution runs in all p2p groups including incognito. First send after generation is signed. Sign criteria unchanged. Handshake allow-reply signed, confirms the key at join. Status is a two-column `KeySendStatus` sum type (not a boolean); delivery is classified terminal-vs-retriable with a capped attempt counter, terminal set closed (D). diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 54dfb58fc3..f670af261c 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -872,7 +872,7 @@ data ChatResponse | CRAcceptingContactRequest {user :: User, contact :: Contact} | CRContactAlreadyExists {user :: User, contact :: Contact} | CRLeftMemberUser {user :: User, groupInfo :: GroupInfo} - | CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo, msgSigned :: Bool} + | CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo, msgSigned :: Bool, localDeletion :: Bool} | CRForwardPlan {user :: User, itemsCount :: Int, chatItemIds :: [ChatItemId], forwardConfirmation :: Maybe ForwardConfirmation} | CRChatMsgContent {user :: User, msgContent :: MsgContent} | CRRcvFileAccepted {user :: User, chatItem :: AChatItem} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 2f2a25d8fd..7e3371f13e 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -64,7 +64,7 @@ import Simplex.Chat.Delivery (DeliveryJobScope (..), DeliveryJobSpec (..), Deliv import Simplex.Chat.Files import Simplex.Chat.Markdown import Simplex.Chat.Messages -import Simplex.Chat.Messages.Batch (encodeBatchElement) +import Simplex.Chat.Messages.Batch (BatchMode, encodeBatchElement) import Simplex.Chat.Messages.CIContent import Simplex.Chat.Messages.CIContent.Events import Simplex.Chat.Operators @@ -164,7 +164,7 @@ checkProfileImageSize = mapM_ $ \(ImageData t) -> in when (size > maxProfileImageSize) $ throwCmdError $ "Profile image is too large " <> show size checkProfileSize :: Profile -> CM () -checkProfileSize p = checkInfoSize "Profile" (XInfo p) +checkProfileSize p = checkInfoSize "Profile" (XInfo p Nothing) checkGroupProfileSize :: GroupProfile -> CM () checkGroupProfileSize p = checkInfoSize "Group profile" (XGrpInfo p) @@ -1205,7 +1205,7 @@ processChatCommand cxt nm = \case Nothing -> throwCmdError "not a public group" Just PublicGroupProfile {groupLink} -> do let signingKeys = case (memberRole, groupKeys) of - (GROwner, Just gk@GroupKeys {groupRootKey = GRKPrivate _}) -> Just gk + (GROwner, Just gk@GroupKeys {publicGroupKeys = Just PublicGroupKeys {groupRootKey = GRKPrivate _}}) -> Just gk _ -> Nothing ownerSig <- pure signingKeys $>>= \GroupKeys {memberPrivKey} -> @@ -1373,7 +1373,7 @@ processChatCommand cxt nm = \case withFastStore' $ \db -> cleanupHostGroupLinkConn db user gInfo withFastStore' $ \db -> deleteGroupMembers db user gInfo withFastStore' $ \db -> deleteGroup db user gInfo - pure $ CRGroupDeletedUser user gInfo msgSigned + pure $ CRGroupDeletedUser user gInfo msgSigned (not doSendDel) where getRecipients gInfo | useRelays' gInfo = do @@ -2304,8 +2304,7 @@ processChatCommand cxt nm = \case -- set group link info and incognito profile, generate and store membership keys incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing let cReqHash = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex} e2e - gVar <- asks random - (_, memberPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar + (_, memberPrivKey) <- atomically . C.generateKeyPair =<< asks random gInfo' <- withFastStore $ \db -> do gInfo' <- updatePreparedRelayedGroup db cxt user gInfo mainCReq cReqHash incognitoProfile rootKey memberPrivKey publicMemberCount_ -- Pre-emptively create owner members with trusted keys from link data @@ -2447,8 +2446,7 @@ processChatCommand cxt nm = \case Left e -> throwError $ ChatErrorStore e Right _ -> throwError $ ChatErrorStore SEDuplicateContactLink subMode <- chatReadVar subscriptionMode - gVar <- asks random - rootKey@(rootPubKey, rootPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar + rootKey@(rootPubKey, rootPrivKey) <- atomically . C.generateKeyPair =<< asks random let entityId = C.sha256Hash $ C.pubKeyBytes rootPubKey -- TODO [address DR] remove this option and switch to IKUsePQ True let (pqInitKeys, useDR) = case pqRatchet_ of @@ -2691,7 +2689,8 @@ processChatCommand cxt nm = \case APINewGroup userId incognito gProfile -> withUserId userId $ \user -> do g <- asks random memberId <- liftIO $ MemberId <$> encodedRandomBytes g 12 - gInfo <- newGroup user incognito gProfile False memberId Nothing Nothing + (_, memberPrivKey) <- atomically $ C.generateKeyPair g + gInfo <- newGroup user incognito gProfile False memberId (Just GroupKeys {publicGroupKeys = Nothing, memberPrivKey}) Nothing createNewGroupItems user gInfo pure $ CRGroupCreated user gInfo NewGroup incognito gProfile -> withUser $ \User {userId} -> @@ -2727,7 +2726,7 @@ processChatCommand cxt nm = \case groupLinkId <- GroupLinkId <$> drgRandomBytes 16 subMode <- chatReadVar subscriptionMode -- generate root key pair; entity ID = sha256(rootPubKey) — see docs/rfcs/2026-03-28-group-identity-binding.md - rootKey@(rootPubKey, rootPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar + rootKey@(rootPubKey, rootPrivKey) <- atomically $ C.generateKeyPair gVar let entityId = C.sha256Hash $ C.pubKeyBytes rootPubKey crClientData = encodeJSON $ CRDataGroup groupLinkId -- prepare link with entityId as linkEntityId (no server request) @@ -2745,7 +2744,8 @@ processChatCommand cxt nm = \case userLinkData = UserContactLinkData UserContactData {direct = False, owners = [ownerAuth], relays = [], userData, ratchetKeys = Nothing} -- create connection with prepared link (single network call) connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode - let groupKeys = GroupKeys {publicGroupId = B64UrlByteString entityId, groupRootKey = GRKPrivate rootPrivKey, memberPrivKey} + let groupKeys = GroupKeys {publicGroupKeys, memberPrivKey} + publicGroupKeys = Just PublicGroupKeys {publicGroupId = B64UrlByteString entityId, groupRootKey = GRKPrivate rootPrivKey} setupLink gInfo = do -- TODO [relays] starting role should be communicated in protocol from owner to relays subRole <- asks $ channelSubscriberRole . config @@ -2834,7 +2834,7 @@ processChatCommand cxt nm = \case case activeConn of Just Connection {peerChatVRange} -> do subMode <- chatReadVar subscriptionMode - dm <- encodeConnInfo $ XGrpAcpt membershipMemId + dm <- encodeConnInfo $ XGrpAcpt membershipMemId (groupMemberKey g) agentConnId <- case memberConn fromMember of Nothing -> do agentConnId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff @@ -3399,7 +3399,7 @@ processChatCommand cxt nm = \case joinPreparedConn subMode conn = do -- [incognito] send membership incognito profile p <- presentUserBadge user (incognitoMembershipProfile gInfo) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile gInfo) Nothing True - dm <- encodeConnInfo $ XInfo p + dm <- encodeConnInfo $ XInfo p Nothing sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm PQSupportOff subMode let newStatus = if sqSecured then ConnSndReady else ConnJoined void $ withFastStore' $ \db -> updateConnectionStatusFromTo db conn ConnPrepared newStatus @@ -3801,7 +3801,7 @@ processChatCommand cxt nm = \case joinPreparedConn conn incognitoProfile joinPreparedConn conn incognitoProfile = do profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user incognitoProfile Nothing True - dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend + dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend Nothing sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup' subMode let newStatus = if sqSecured then ConnSndReady else ConnJoined conn' <- withFastStore' $ \db -> updateConnectionStatusFromTo db conn ConnPrepared newStatus @@ -3954,10 +3954,15 @@ processChatCommand cxt nm = \case Just gInfo_' -> userProfileInGroup' user gInfo_' incognitoProfile Nothing -> userProfileDirect user incognitoProfile Nothing True dm <- case gInfo_ of - Just (Just gInfo) | useRelays' gInfo -> case relayMemberId_ of - Just relayMemberId -> encodeXMemberConnInfo gInfo relayMemberId profileToSend - Nothing -> throwChatError $ CEInternalError "relay group join without target relay memberId" - _ -> encodeConnInfoPQ pqSup $ XContact profileToSend (Just xContactId) welcomeSharedMsgId msg_ + Just (Just gInfo) + | useRelays' gInfo -> case relayMemberId_ of + Just relayMemberId -> encodeXMemberConnInfo gInfo relayMemberId profileToSend + Nothing -> throwChatError $ CEInternalError "relay group join without target relay memberId" + | otherwise -> do + gInfo' <- createUserMemberKey gInfo + encodeConnInfoPQ pqSup $ XContact profileToSend (groupMemberKey gInfo') (Just xContactId) welcomeSharedMsgId msg_ + _ -> + encodeConnInfoPQ pqSup $ XContact profileToSend Nothing (Just xContactId) welcomeSharedMsgId msg_ 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 @@ -4032,7 +4037,7 @@ processChatCommand cxt nm = \case ctSndEvent :: ChangedProfileContact -> CM (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent 'Json) ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = do p'' <- presentUserBadge user' Nothing mergedProfile' - pure (ConnectionId connId, Nothing, XInfo p'') + pure (ConnectionId connId, Nothing, XInfo p'' Nothing) ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq ctMsgReq ChangedProfileContact {conn} = fmap $ \SndMessage {msgId, msgBody} -> @@ -4065,7 +4070,7 @@ processChatCommand cxt nm = \case when (mergedProfile' /= mergedProfile) $ withContactLock "updateContactPrefs" (contactId' ct) $ do p <- presentUserBadge user incognitoProfile mergedProfile' - void (sendDirectContactMessage user ct' $ XInfo p) `catchAllErrors` eToView + void (sendDirectContactMessage user ct' $ XInfo p Nothing) `catchAllErrors` eToView lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct' pure $ CRContactPrefsUpdated user ct ct' runUpdateGroupProfile :: User -> GroupInfo -> GroupProfile -> Bool -> CM ChatResponse @@ -4241,12 +4246,13 @@ processChatCommand cxt nm = \case createInternalChatItem user cd (CISndGroupE2EEInfo $ e2eInfoGroup gInfo) Nothing createGroupFeatureItems user cd CISndGroupFeature gInfo sendGrpInvitation :: User -> Contact -> GroupInfo -> GroupMember -> ConnReqInvitation -> CM () - sendGrpInvitation user ct@Contact {contactId, localDisplayName} gInfo@GroupInfo {groupId, groupProfile, membership, businessChat} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do + sendGrpInvitation user ct@Contact {contactId, localDisplayName} gInfo@GroupInfo {groupId, groupProfile, membership, businessChat} m@GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do let currentMemCount = fromIntegral $ currentMembers $ groupSummary gInfo GroupMember {memberRole = userRole, memberId = userMemberId} = membership groupInv = GroupInvitation { fromMember = MemberIdRole userMemberId userRole, + fromMemberKey = groupMemberKey gInfo, invitedMember = MemberIdRole memberId memRole, connRequest = cReq, groupProfile, @@ -5154,7 +5160,7 @@ addUserBadge user cred@(BadgeCredential keyIdx _ _ info) = do | not (connIncognito conn) -> do let ct' = updateMergedPreferences user' ct p <- presentUserBadge user' Nothing $ userProfileDirect user' Nothing (Just ct') False - void (sendDirectContactMessage user' ct' (XInfo p)) `catchAllErrors` eToView + void (sendDirectContactMessage user' ct' (XInfo p Nothing)) `catchAllErrors` eToView _ -> pure () assertDirectAllowed :: User -> MsgDirection -> Contact -> CMEventTag e -> CM () diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 79b4578d8f..d1b50f7f77 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -40,7 +40,7 @@ import Data.Foldable (foldr') import Data.Functor (($>)) import Data.Functor.Identity import Data.Int (Int64) -import Data.List (foldl', mapAccumL, partition) +import Data.List (find, foldl', mapAccumL, partition) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) @@ -970,7 +970,7 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId pure (ct, conn, ExistingIncognito <$> incognitoProfile) profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True - dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend + dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend Nothing (ct,conn,) <$> withAgent (\a -> acceptContact a nm (aUserId user) (aConnId conn) True invId dm pqSup' subMode) acceptContactRequestAsync :: User -> Int64 -> Contact -> UserContactRequest -> Maybe IncognitoProfile -> CM Contact @@ -991,7 +991,7 @@ acceptContactRequestAsync Connection {connId} <- liftIO $ createAcceptedContactConn db user (Just uclId) contactId acId chatV cReqChatVRange cReqPQSup incognitoProfile subMode currentTs liftIO $ setCommandConnId db user cmdId connId getContact db cxt user contactId - agentAcceptContactAsync cmdId acId True cReqInvId (XInfo profileToSend) cReqPQSup subMode + agentAcceptContactAsync cmdId acId True cReqInvId (XInfo profileToSend Nothing) cReqPQSup subMode pure ct' acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> Maybe GroupMember -> CM GroupMember @@ -1032,6 +1032,7 @@ acceptGroupJoinRequestAsync GroupLinkInvitation { fromMember = MemberIdRole userMemberId userRole, fromMemberName = displayName, + fromMemberKey = groupMemberKey gInfo, invitedMember = MemberIdRole memberId gLinkMemRole, groupProfile, accepted = Just gAccepted, @@ -1095,6 +1096,7 @@ acceptBusinessJoinRequestAsync GroupLinkInvitation { fromMember = MemberIdRole userMemberId userRole, fromMemberName = displayName, + fromMemberKey = groupMemberKey gInfo, invitedMember = MemberIdRole memberId GRMember, groupProfile = businessGroupProfile userProfile groupPreferences, accepted = Just GAAccepted, @@ -1593,7 +1595,7 @@ groupLinkData gInfo@GroupInfo {groupProfile, groupSummary = GroupSummary {public publicGroupData_ = PublicGroupData <$> publicMemberCount userData = encodeShortLinkData $ GroupShortLinkData {groupProfile, publicGroupData = publicGroupData_} owners = case groupKeys of - Just GroupKeys {groupRootKey = GRKPrivate rootPrivKey, memberPrivKey} -> + Just GroupKeys {publicGroupKeys = Just PublicGroupKeys {groupRootKey = GRKPrivate rootPrivKey}, memberPrivKey} -> let ownerId = unMemberId memberId ownerKey = C.publicKey memberPrivKey authOwnerSig = C.sign' rootPrivKey (ownerId <> C.encodePubKey ownerKey) @@ -2248,27 +2250,46 @@ createSndMessages idsEvents = do encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr, msgId = Just sharedMsgId, chatMsgEvent = evnt} groupMsgSigning :: Bool -> GroupInfo -> ChatMsgEvent e -> Maybe MsgSigning -groupMsgSigning sign gInfo@GroupInfo {membership = GroupMember {memberId}, groupKeys = Just GroupKeys {publicGroupId, memberPrivKey}} evt - | useRelays' gInfo && shouldSign = - Just $ MsgSigning CBGroup (smpEncode (publicGroupId, memberId)) KRMember memberPrivKey - where - tag = toCMEventTag evt - shouldSign = requiresSignature tag || (sign && signableContent tag) -groupMsgSigning _ _ _ = Nothing +groupMsgSigning sign GroupInfo {membership = GroupMember {memberId}, groupKeys} evt = case groupKeys of + Just gks@GroupKeys {memberPrivKey} | shouldSign -> Just $ MsgSigning CBGroup bindingData KRMember memberPrivKey + where + tag = toCMEventTag evt + shouldSign = requiresSignature tag || (sign && signableContent tag) + bindingData = groupBindingData (Just gks) memberId (C.publicKey memberPrivKey) + _ -> Nothing + +groupBindingData :: Maybe GroupKeys -> MemberId -> C.PublicKeyEd25519 -> ByteString +groupBindingData gks memberId memberKey = case gks >>= publicGroupKeys of + Just PublicGroupKeys {publicGroupId} -> smpEncode (publicGroupId, memberId) + Nothing -> smpEncode (memberId, memberKey) + +createUserMemberKey :: GroupInfo -> CM GroupInfo +createUserMemberKey gInfo@GroupInfo {groupId, membership, groupKeys} + | useRelays' gInfo || isJust groupKeys = pure gInfo + | otherwise = do + (_, memberPrivKey) <- atomically . C.generateKeyPair =<< asks random + withStore' $ \db -> setUserMemberKey db groupId (groupMemberId' membership) memberPrivKey + pure gInfo {groupKeys = Just GroupKeys {publicGroupKeys = Nothing, memberPrivKey}} + +groupMemberKey :: GroupInfo -> Maybe MemberKey +groupMemberKey GroupInfo {groupKeys} = MemberKey . C.publicKey . memberPrivKey <$> groupKeys sendGroupMemberMessages :: forall e. MsgEncodingI e => User -> GroupInfo -> Connection -> NonEmpty (ChatMsgEvent e) -> CM () sendGroupMemberMessages user gInfo@GroupInfo {groupId} conn events = do when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) let idsEvts = L.map (\evt -> (GroupId groupId, groupMsgSigning False gInfo evt, evt)) events - mode = if useRelays' gInfo then BMBinary else BMJson (errs, msgs) <- lift $ partitionEithers . L.toList <$> createSndMessages idsEvts unless (null errs) $ toView $ CEvtChatErrors errs forM_ (L.nonEmpty msgs) $ \msgs' -> - batchSendConnMessages mode user conn MsgFlags {notification = True} msgs' + batchSendConnMessages gInfo user conn MsgFlags {notification = True} msgs' -batchSendConnMessages :: BatchMode -> User -> Connection -> MsgFlags -> NonEmpty SndMessage -> CM ([Either ChatError SndMessage], Maybe PQEncryption) -batchSendConnMessages mode user conn msgFlags msgs = +batchSendConnMessages :: GroupInfo -> User -> Connection -> MsgFlags -> NonEmpty SndMessage -> CM ([Either ChatError SndMessage], Maybe PQEncryption) +batchSendConnMessages gInfo user conn msgFlags msgs = batchSendConnMessagesB mode user conn msgFlags $ L.map Right msgs + where + mode + | useRelays' gInfo || maxVersion (peerChatVRange conn) >= relayWebCapVersion = BMBinary + | otherwise = BMJson batchSendConnMessagesB :: BatchMode -> User -> Connection -> MsgFlags -> NonEmpty (Either ChatError SndMessage) -> CM ([Either ChatError SndMessage], Maybe PQEncryption) batchSendConnMessagesB mode _user conn msgFlags msgs_ = do @@ -2326,9 +2347,10 @@ encodeSignedConnInfo signing chatMsgEvent = do encodeXMemberConnInfo :: GroupInfo -> MemberId -> Profile -> CM ByteString encodeXMemberConnInfo GroupInfo {membership = GroupMember {memberId}, groupKeys} relayMemberId profileToSend = case groupKeys of - Just GroupKeys {publicGroupId, memberPrivKey} -> + Just gks@GroupKeys {memberPrivKey} -> let xMemberEvt = XMember profileToSend memberId (MemberKey $ C.publicKey memberPrivKey) (Just relayMemberId) - signing = MsgSigning CBGroup (smpEncode (publicGroupId, memberId)) KRMember memberPrivKey + bindingData = groupBindingData (Just gks) memberId (C.publicKey memberPrivKey) + signing = MsgSigning CBGroup bindingData KRMember memberPrivKey in encodeSignedConnInfo signing xMemberEvt Nothing -> throwChatError $ CEInternalError "no group keys for channel membership" @@ -2483,13 +2505,15 @@ sendRelayCapIfNeeded user gInfo = do withStore' $ \db -> updateRelaySentWebDomain db gInfo currentWebDomain sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> [GroupMember] -> Bool -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) -sendGroupMessages user gInfo scope asGroup members sign events = do +sendGroupMessages user gInfo' scope asGroup members sign events = do + gInfo <- createUserMemberKey gInfo' sendGroupProfileUpdate user gInfo scope asGroup members sendGroupMessages_ user gInfo members sign events -- per-item signer variant of sendGroupMessages (used for per-item delete signing); preserves the profile-update prelude sendGroupSignedMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> [GroupMember] -> NonEmpty (Maybe MsgSigning, ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) -sendGroupSignedMessages user gInfo scope asGroup members signedEvents = do +sendGroupSignedMessages user gInfo' scope asGroup members signedEvents = do + gInfo <- createUserMemberKey gInfo' sendGroupProfileUpdate user gInfo scope asGroup members sendGroupSignedMessages_ gInfo members signedEvents @@ -2513,7 +2537,7 @@ sendGroupProfileUpdate user gInfo scope asGroup members = sendProfileUpdate = do -- shouldSendProfileUpdate excludes incognito membership, so the badge is presented profileUpdate <- presentUserBadge user Nothing $ redactedMemberProfile gInfo (membership gInfo) $ fromLocalProfile p - void $ sendGroupMessage' user gInfo members $ XInfo profileUpdate + void $ sendGroupMessage' user gInfo members $ XInfo profileUpdate (groupMemberKey gInfo) currentTs <- liftIO getCurrentTime withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs @@ -2533,7 +2557,7 @@ sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents recipientMembers' <- liftIO $ shuffleMembers recipientMembers let msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events} (toSend, toPending, forwarded, _, dups) = - foldr' (addMember recipientMembers') ([], [], [], S.empty, 0 :: Int) recipientMembers' + foldr' (addMember recipientMembers') (([], []), [], [], S.empty, 0 :: Int) recipientMembers' when (dups /= 0) $ logError $ "sendGroupMessages_: " <> tshow dups <> " duplicate members" -- TODO PQ either somehow ensure that group members connections cannot have pqSupport/pqEncryption or pass Off's here -- Deliver to toSend members @@ -2557,26 +2581,30 @@ sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents liftM2 (<>) (shuffle adminMs) (shuffle otherMs) where isAdmin GroupMember {memberRole} = memberRole >= GRAdmin - addMember members m acc@(toSend, pending, forwarded, !mIds, !dups) = + addMember members m acc@(toSend@(toSendBin, toSendJson), pending, forwarded, !mIds, !dups) = case memberSendAction gInfo events members m of Just a | mId `S.member` mIds -> (toSend, pending, forwarded, mIds, dups + 1) | otherwise -> case a of - MSASend conn -> ((m, conn) : toSend, pending, forwarded, mIds', dups) + MSASend conn -> + let toSend' = case batchMode gInfo m of + BMBinary -> ((m, conn) : toSendBin, toSendJson) + BMJson -> (toSendBin, (m, conn) : toSendJson) + in (toSend', pending, forwarded, mIds', dups) MSAPending -> (toSend, m : pending, forwarded, mIds', dups) MSAForwarded -> (toSend, pending, m : forwarded, mIds', dups) Nothing -> acc where mId = groupMemberId' m mIds' = S.insert mId mIds - prepareMsgReqs :: MsgFlags -> NonEmpty (Either ChatError SndMessage) -> [(GroupMember, Connection)] -> ([GroupMemberId], [Either ChatError ChatMsgReq]) - prepareMsgReqs msgFlags msgs toSend = do - let mode = if useRelays' gInfo then BMBinary else BMJson - batched_ = batchSndMessagesJSON mode msgs - case L.nonEmpty batched_ of - Just batched' -> foldMembers (length batched' + length msgs) msgBatchMBR batched' toSend - Nothing -> ([], []) + prepareMsgReqs :: MsgFlags -> NonEmpty (Either ChatError SndMessage) -> ([(GroupMember, Connection)], [(GroupMember, Connection)]) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) + prepareMsgReqs msgFlags msgs (toSendBin, toSendJson) = + batchReqs 1 BMBinary toSendBin <> batchReqs 2 BMJson toSendJson where + batchReqs _ _ [] = ([], []) + batchReqs n mode toSend' = case L.nonEmpty (batchSndMessagesJSON mode msgs) of + Just batched -> foldMembers (n * (length batched + length msgs)) msgBatchMBR batched toSend' + Nothing -> ([], []) foldMembers :: forall a. Int -> (Maybe Int -> Int -> a -> (ValueOrRef MsgBody, [MessageId])) -> NonEmpty (Either ChatError a) -> [(GroupMember, Connection)] -> ([GroupMemberId], [Either ChatError ChatMsgReq]) foldMembers lastRef mkMb mbs mems = snd $ foldr' foldMsgBodies (lastMemIdx_, ([], [])) mems where @@ -2609,6 +2637,11 @@ sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents createPendingMsg db (groupMemberId, msgId) = createPendingGroupMessage db groupMemberId msgId $> Right () +batchMode :: GroupInfo -> GroupMember -> BatchMode +batchMode gInfo m + | useRelays' gInfo || m `supportsVersion` relayWebCapVersion = BMBinary + | otherwise = BMJson + data MemberSendAction = MSASend Connection | MSAPending | MSAForwarded memberSendAction :: GroupInfo -> NonEmpty (ChatMsgEvent e) -> [GroupMember] -> GroupMember -> Maybe MemberSendAction @@ -2682,10 +2715,9 @@ sendFwdMemberMessage member fwd verifiedMsg = -- TODO ensure order - pending messages interleave with user input messages sendPendingGroupMessages :: User -> GroupInfo -> GroupMember -> Connection -> CM () sendPendingGroupMessages user gInfo GroupMember {groupMemberId} conn = do - let mode = if useRelays' gInfo then BMBinary else BMJson msgs <- withStore' $ \db -> getPendingGroupMessages db groupMemberId forM_ (L.nonEmpty msgs) $ \msgs' -> do - void $ batchSendConnMessages mode user conn MsgFlags {notification = True} msgs' + void $ batchSendConnMessages gInfo user conn MsgFlags {notification = True} msgs' lift . void . withStoreBatch' $ \db -> L.map (\SndMessage {msgId} -> deletePendingGroupMessage db groupMemberId msgId) msgs' saveDirectRcvMSG :: forall e. MsgEncodingI e => Connection -> MsgMeta -> ChatMessage e -> CM (Connection, RcvMessage) @@ -2890,10 +2922,19 @@ joinAgentConnectionAsync :: CommandId -> Bool -> ConnId -> Bool -> ConnectionReq joinAgentConnectionAsync cmdId updateConn connId enableNtfs cReqUri cInfo subMode = withAgent $ \a -> joinConnectionAsync a (aCorrId cmdId) updateConn connId enableNtfs cReqUri cInfo PQSupportOff subMode -allowAgentConnectionAsync :: MsgEncodingI e => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> CM () -allowAgentConnectionAsync user conn@Connection {connId, pqSupport} confId msg = do +allowAgentConnectionAsync :: MsgEncodingI e => User -> Connection -> ConfirmationId -> Maybe GroupInfo -> ChatMsgEvent e -> CM () +allowAgentConnectionAsync user conn@Connection {pqSupport} confId gInfo_ msg = do + let signing_ = case gInfo_ of + Just gInfo | useRelays' gInfo || maxVersion (peerChatVRange conn) >= relayWebCapVersion -> groupMsgSigning False gInfo msg + _ -> Nothing + dm <- case signing_ of + Just signing -> encodeSignedConnInfo signing msg + Nothing -> encodeConnInfoPQ pqSupport msg + allowAgentConnectionInfo user conn confId dm + +allowAgentConnectionInfo :: User -> Connection -> ConfirmationId -> ByteString -> CM () +allowAgentConnectionInfo user conn@Connection {connId} confId dm = do cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFAllowConn - dm <- encodeConnInfoPQ pqSupport msg withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm withStore' $ \db -> updateConnectionStatus db conn ConnAccepted diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 47625a9fd2..ac587b9ec5 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -112,11 +112,11 @@ import qualified Data.Aeson as J smallGroupsRcptsMemLimit :: Int smallGroupsRcptsMemLimit = 20 --- Verifies member signatures over CBGroup <> (publicGroupId, memberId) <> signedBody under the given key. +-- Verifies member signatures over CBGroup <> (publicGroupId, memberId) or (memberId, pubKey) <> signedBody under the given key. -- signatures is NonEmpty so the verification can't be vacuously true. -verifyGroupSig :: C.PublicKeyEd25519 -> B64UrlByteString -> MemberId -> NonEmpty MsgSignature -> ByteString -> Bool -verifyGroupSig key publicGroupId memberId signatures signedBody = - let prefix = smpEncode CBGroup <> smpEncode (publicGroupId, memberId) +verifyGroupSig :: C.PublicKeyEd25519 -> Maybe GroupKeys -> MemberId -> NonEmpty MsgSignature -> ByteString -> Bool +verifyGroupSig key gks memberId signatures signedBody = + let prefix = encodeChatBinding CBGroup $ groupBindingData gks memberId key in all (\case (MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 key) sig (prefix <> signedBody)) signatures processAgentMessage :: ACorrId -> ConnId -> AEvent 'AEConn -> CM () @@ -481,7 +481,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = Just gInfo -> userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) Nothing -> userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend + allowAgentConnectionAsync user conn'' confId gInfo_ $ XInfo profileToSend (groupMemberKey =<< gInfo_) INFO pqSupport connInfo -> do processINFOpqSupport conn pqSupport void $ saveConnInfo conn connInfo @@ -558,7 +558,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = XFile fInv -> processFileInvitation' ct'' fInv msg msgMeta XFileCancel sharedMsgId -> xFileCancel ct'' sharedMsgId XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct'' sharedMsgId fileConnReq_ fName - XInfo p -> xInfo ct'' p + XInfo p _ -> xInfo ct'' p XDirectDel -> xDirectDel ct'' msg msgMeta XGrpInv gInv -> processGroupInvitation ct'' gInv msg msgMeta XInfoProbe probe -> xInfoProbe (COMContact ct'') probe @@ -591,24 +591,25 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- TODO check member ID -- TODO update member profile -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn'' confId XOk - XInfo profile -> do + allowAgentConnectionAsync user conn'' confId Nothing XOk + XInfo profile _ -> do ct' <- processContactProfileUpdate ct profile False `catchAllErrors` const (pure ct) -- [incognito] send incognito profile incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId p <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True - allowAgentConnectionAsync user conn'' confId $ XInfo p + allowAgentConnectionAsync user conn'' confId Nothing $ XInfo p Nothing void $ withStore' $ \db -> resetMemberContactFields db ct' XGrpLinkInv glInv -> do -- XGrpLinkInv here means we are connecting via business contact card, so we replace contact with group + memberKeys <- atomically . C.generateKeyPair =<< asks random (gInfo, host) <- withStore $ \db -> do liftIO $ deleteContactCardKeepConn db connId ct - createGroupInvitedViaLink db cxt user conn'' glInv + createGroupInvitedViaLink db cxt user conn'' memberKeys glInv void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart) -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) - allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend + allowAgentConnectionAsync user conn'' confId (Just gInfo) $ XInfo profileToSend (groupMemberKey gInfo) toView $ CEvtBusinessLinkConnecting user gInfo host ct _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info" INFO pqSupport connInfo -> do @@ -620,7 +621,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- TODO check member ID -- TODO update member profile pure () - XInfo profile -> do + XInfo profile _ -> do let prepared = isJust (preparedContact ct) || isJust (contactRequestId' ct) void $ processContactProfileUpdate ct profile prepared XOk -> pure () @@ -754,11 +755,12 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = case memberCategory m of GCInviteeMember -> case chatMsgEvent of - XGrpAcpt memId + XGrpAcpt memId mKey | sameMemberId memId m -> do withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted + forM_ mKey $ \(MemberKey k) -> withStore' $ \db -> setMemberPubKey db (groupMemberId' m) k -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId XOk + allowAgentConnectionAsync user conn' confId (Just gInfo) XOk | otherwise -> messageError "x.grp.acpt: memberId is different from expected" XGrpRelayAcpt relayLink relayCap | memberRole' membership == GROwner && isRelay m -> do @@ -778,7 +780,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = liftIO $ updateGroupMemberStatus db userId m GSMemLeft pure (relay', m {memberStatus = GSMemLeft}) -- complete the contact handshake so the relay receives INFO and cleans up its transient bookkeeping - allowAgentConnectionAsync user conn' confId XOk + allowAgentConnectionAsync user conn' confId (Just gInfo) XOk toView $ CEvtGroupRelayUpdated user gInfo m' relay' toViewTE $ TERelayRejected user gInfo reason | otherwise -> messageError "x.grp.relay.reject: only owner should receive relay rejection" @@ -790,11 +792,12 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = pgId = fmap (\PublicGroupProfile {publicGroupId} -> publicGroupId), useRelays' gInfo == isJust rcvPG && pgId rcvPG == pgId curPG -> do -- XGrpLinkInv here means we are connecting via prepared group, and we have to update user and host member records - (gInfo', m') <- withStore $ \db -> updatePreparedUserAndHostMembersInvited db cxt user gInfo m glInv + (gInfo'', m') <- withStore $ \db -> updatePreparedUserAndHostMembersInvited db cxt user gInfo m glInv + gInfo' <- createUserMemberKey gInfo'' -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) - profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) - allowAgentConnectionAsync user conn' confId $ XInfo profileToSend + profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo' (fromLocalProfile <$> incognitoProfile) + allowAgentConnectionAsync user conn' confId (Just gInfo') $ XInfo profileToSend (groupMemberKey gInfo') toView $ CEvtGroupLinkConnecting user gInfo' m' | otherwise -> messageError "x.grp.link.inv: publicGroupId mismatch" XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do @@ -810,11 +813,11 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership -- TODO update member profile -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId $ XGrpMemInfo membershipMemId membershipProfile + allowAgentConnectionAsync user conn' confId (Just gInfo) $ XGrpMemInfo membershipMemId membershipProfile | 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 - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + (signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo _conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of XGrpMemInfo memId _memProfile @@ -823,11 +826,12 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = pure () | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" -- sent when connecting via group link - XInfo _ -> + XInfo _ mKey -- TODO Keep rejected member to allow them to appeal against rejection. - when (memberStatus m == GSMemRejected) $ do - deleteMemberConnection' m True - withStore' $ \db -> deleteGroupMember db user m + | memberStatus m == GSMemRejected -> do + deleteMemberConnection' m True + withStore' $ \db -> deleteGroupMember db user m + | otherwise -> mapM_ (storeMemberKey gInfo m signedMsg_) mKey XOk -> -- transient relay-reject row cleanup after the rejection handshake completes when (memberCategory m == GCHostMember && not (relayServesGroup gInfo)) $ do @@ -913,7 +917,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = _ -> pure () toView $ CEvtJoinedGroupMember user gInfo'' m' {memberStatus = mStatus} let Connection {viaUserContactLink} = conn - when (isJust viaUserContactLink && isNothing (memberContactId m')) $ sendXGrpLinkMem gInfo'' + when (isJust viaUserContactLink && isNothing (memberContactId m')) $ sendXGrpLinkMem gInfo'' m' if useRelays' gInfo'' then do introduceInChannel cxt user gInfo'' m' @@ -931,10 +935,11 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = _ -> False when (groupFeatureAllowed SGFHistory gInfo'' && not memberIsCustomer) $ sendHistory user gInfo'' m' where - sendXGrpLinkMem gInfo'' = do + sendXGrpLinkMem gInfo''' m' = do + gInfo'' <- createUserMemberKey gInfo''' let incognitoProfile = ExistingIncognito <$> incognitoMembershipProfile gInfo'' - profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile) - void $ sendDirectMemberMessage conn (XGrpLinkMem profileToSend) groupId + profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo'' (fromIncognitoProfile <$> incognitoProfile) + sendGroupMemberMessages user gInfo'' conn [XGrpLinkMem profileToSend (groupMemberKey gInfo'')] _ -> do unless (memberPending m) $ withStore' $ \db -> updateGroupMemberStatus db userId m GSMemConnected notifyMemberConnected gInfo m Nothing @@ -1047,8 +1052,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = XFile fInv -> Nothing <$ processGroupFileInvitation' gInfo' m'' fInv msg brokerTs XFileCancel sharedMsgId -> xFileCancelGroup gInfo' (Just m'') sharedMsgId XFileAcptInv sharedMsgId fileConnReq_ fName -> Nothing <$ xFileAcptInvGroup gInfo' m'' sharedMsgId fileConnReq_ fName - XInfo p -> fmap ctx <$> xInfoMember gInfo' m'' p msg brokerTs - XGrpLinkMem p -> Nothing <$ xGrpLinkMem gInfo' m'' conn' p + XInfo p mKey -> fmap ctx <$> xInfoMember gInfo' m'' p mKey msg brokerTs + XGrpLinkMem p mKey -> Nothing <$ xGrpLinkMem gInfo' m'' conn' p mKey msg XGrpLinkAcpt acceptance role memberId -> Nothing <$ xGrpLinkAcpt gInfo' m'' acceptance role memberId msg brokerTs XGrpRelayNew rl -> fmap ctx <$> xGrpRelayNew gInfo' m'' rl XGrpRelayCap relayCap @@ -1229,7 +1234,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = liftIO $ updateGroupMemberStatus db userId m GSMemAccepted (m', relay) <- setRelayLinkAccepted db cxt user m (MemberKey relayKey) relayProfile pure (confId, m', relay) - allowAgentConnectionAsync user conn confId XOk + allowAgentConnectionAsync user conn confId (Just gInfo) XOk toView $ CEvtGroupRelayUpdated user gInfo m' relay else -- TODO [relays] owner: TBC failed RelayStatus? @@ -1359,9 +1364,9 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = REQ invId pqSupport _ connInfo rejectionSupported -> do (signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo case chatMsgEvent of - XContact p xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ pqSupport rejectionSupported + XContact p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ pqSupport rejectionSupported XMember p joiningMemberId joiningMemberKey viaRelay -> memberJoinRequestViaRelay invId chatVRange signedMsg_ p joiningMemberId joiningMemberKey viaRelay - XInfo p -> profileContactRequest invId chatVRange p Nothing Nothing Nothing pqSupport rejectionSupported + XInfo p _ -> profileContactRequest invId chatVRange p Nothing Nothing Nothing Nothing pqSupport rejectionSupported XGrpRelayInv groupRelayInv -> xGrpRelayInv invId chatVRange groupRelayInv XGrpRelayTest challenge _ -> xGrpRelayTest invId chatVRange challenge -- TODO show/log error, other events in contact request @@ -1435,8 +1440,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- TODO add debugging output _ -> pure () where - profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> Bool -> CM () - profileContactRequest invId chatVRange p@Profile {displayName} xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported = do + profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe MemberKey -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> Bool -> CM () + profileContactRequest invId chatVRange p@Profile {displayName} memberKey_ xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported = do (ucl, gLinkInfo_) <- withStore $ \db -> getUserContactLinkById db userId uclId let v = maxVersion chatVRange case gLinkInfo_ of @@ -1589,7 +1594,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = maybe (pure $ Right (GAAccepted, gLinkMemRole)) (\am -> liftIO $ am gInfo gli p) acceptMember_ >>= \case Right (acceptance, useRole) -> do let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo - mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode Nothing Nothing + mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode memberKey_ Nothing (gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem' @@ -1649,9 +1654,9 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = where -- replay defense: the viaRelay == own memberId check (viaRelay is in the signed body); without it a sibling relay could replay a privileged member's signed join verifyKey gInfo rosterMem = case (signedMsg_, groupKeys gInfo) of - (Just SignedMsg {chatBinding = CBGroup, signatures, signedBody}, Just GroupKeys {publicGroupId}) -> + (Just SignedMsg {chatBinding = CBGroup, signatures, signedBody}, Just gks) -> memberPubKey rosterMem == Just joiningKey - && verifyGroupSig joiningKey publicGroupId joiningMemberId signatures signedBody + && verifyGroupSig joiningKey (Just gks) joiningMemberId signatures signedBody && viaRelay == Just (memberId' (membership gInfo)) _ -> False acceptJoin gInfo existingMem_ acceptRole = do @@ -2618,14 +2623,15 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile - (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership}, hostId) <- withStore $ \db -> createGroupInvitation db cxt user ct inv customUserProfileId + memberKeys <- atomically . C.generateKeyPair =<< asks random + (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership}, 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 -- hostContact is only reported for group links, where the client replaces -- the transient host connection view with the group and removes its chat joinGroupAsync hostContact_ sameLink = do subMode <- chatReadVar subscriptionMode - dm <- encodeConnInfo $ XGrpAcpt membershipMemId + dm <- encodeConnInfo $ XGrpAcpt membershipMemId (groupMemberKey gInfo) connIds@(cmdId, acId) <- prepareAgentJoin user Nothing True connRequest withStore' $ \db -> do when sameLink $ setViaGroupLinkUri db groupId connId @@ -2729,22 +2735,35 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = Profile {displayName = n, fullName = fn, shortDescr = sd, image = i, contactLink = cl} = p Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p' - xInfoMember :: GroupInfo -> GroupMember -> Profile -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) - xInfoMember gInfo m p' msg brokerTs = do + xInfoMember :: GroupInfo -> GroupMember -> Profile -> Maybe MemberKey -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) + xInfoMember gInfo m p' mKey msg@RcvMessage {signedMsg_} brokerTs = do + mapM_ (storeMemberKey gInfo m signedMsg_) mKey void $ processMemberProfileUpdate gInfo m p' (Just (msg, brokerTs)) pure $ memberEventDeliveryScope m - xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> CM () - xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do + xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> Maybe MemberKey -> RcvMessage -> CM () + xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' mKey RcvMessage {signedMsg_} = do xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived then do + mapM_ (storeMemberKey gInfo m signedMsg_) mKey m' <- processMemberProfileUpdate gInfo m p' Nothing withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True let connectedIncognito = memberIncognito membership probeMatchingMemberContact m' connectedIncognito else messageError "x.grp.link.mem error: invalid group link host profile update" + storeMemberKey :: GroupInfo -> GroupMember -> Maybe SignedMsg -> MemberKey -> CM () + storeMemberKey gInfo GroupMember {groupMemberId, memberPubKey, memberId} signedMsg_ (MemberKey k) = case memberPubKey of + Just k0 -> when (k /= k0) $ messageError "member key change rejected, keeping current key" + Nothing + | signed -> withStore' $ \db -> setMemberPubKey db groupMemberId k + | otherwise -> messageError "member key not signed by that key, ignored" + where + signed = case signedMsg_ of + Just SignedMsg {chatBinding = CBGroup, signatures, signedBody} -> verifyGroupSig k (groupKeys gInfo) memberId signatures signedBody + _ -> False + xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupAcceptance -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM () xGrpLinkAcpt gInfo@GroupInfo {membership} m acceptance role memberId msg brokerTs | memberRole' m < GRModerator || memberRole' m < role = @@ -2840,7 +2859,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of Just bc | isMainBusinessMember bc m -> do g' <- withStore $ \db -> updateGroupProfileFromMember db user g p' - toView $ CEvtGroupUpdated user g g' (Just m) Nothing + toView $ CEvtGroupUpdated user g g' (Just m) ((\(RcvMessage {msgSigned}, _) -> msgSigned) =<< msgTs_) _ -> pure () isMainBusinessMember BusinessChatInfo {chatType, businessId, customerId} GroupMember {memberId} = case chatType of BCBusiness -> businessId == memberId @@ -3076,16 +3095,18 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo conn' <- updatePeerChatVRange activeConn chatVRange case chatMsgEvent of - XInfo p -> do + XInfo p _ -> do ct <- withStore $ \db -> createDirectContact db cxt user conn' p toView $ CEvtContactConnecting user ct pure (conn', Nothing) XGrpLinkInv glInv -> do - (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db cxt user conn' glInv + memberKeys <- atomically . C.generateKeyPair =<< asks random + (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db cxt user conn' memberKeys glInv toView $ CEvtGroupLinkConnecting user gInfo host pure (conn', Just gInfo) XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do - (gInfo, host) <- withStore $ \db -> createGroupRejectedViaLink db cxt user conn' glRjct + memberKeys <- atomically . C.generateKeyPair =<< asks random + (gInfo, host) <- withStore $ \db -> createGroupRejectedViaLink db cxt user conn' memberKeys glRjct toView $ CEvtGroupLinkConnecting user gInfo host toViewTE $ TEGroupLinkRejected user gInfo rejectionReason pure (conn', Just gInfo) @@ -3826,7 +3847,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- [incognito] send membership incognito profile p <- presentUserBadge user (incognitoMembershipProfile g) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing True -- TODO PQ should negotitate contact connection with PQSupportOn? (use encodeConnInfoPQ) - dm <- encodeConnInfo $ XInfo p + dm <- encodeConnInfo $ XInfo p Nothing joinAgentConnectionAsync cmdId False acId True connReq dm subMode createItems mCt' m' = do (g', m'', scopeInfo) <- mkGroupChatScope g m' @@ -3884,7 +3905,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = 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 - XInfo p -> withAuthor XInfo_ $ \author -> void $ xInfoMember gInfo author p rcvMsg msgTs + XInfo p mKey -> withAuthor XInfo_ $ \author -> void $ xInfoMember gInfo author p mKey rcvMsg msgTs XGrpRelayNew rl -> withAuthor XGrpRelayNew_ $ \author -> void $ xGrpRelayNew gInfo author rl XGrpMemNew memInfo msgScope -> withAuthor XGrpMemNew_ $ \author -> void $ xGrpMemNew gInfo author memInfo msgScope rcvMsg msgTs XGrpMemRole memId memRole memberKey rosterVer -> withAuthor XGrpMemRole_ $ \author -> void $ xGrpMemRole gInfo (Just m) author memId memRole memberKey rosterVer rcvMsg msgTs @@ -3903,7 +3924,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = Nothing -> messageError $ "x.grp.msg.forward: event " <> tshow tag <> " requires author" withVerifiedMsg :: GroupInfo -> Maybe GroupChatScopeInfo -> GroupMember -> ParsedMsg e -> UTCTime -> (VerifiedMsg e -> CM a) -> CM (Maybe a) - withVerifiedMsg gInfo@GroupInfo {membership} scopeInfo member (ParsedMsg _ signedMsg_ chatMsg@ChatMessage {chatMsgEvent}) ts action = + withVerifiedMsg gInfo@GroupInfo {membership, groupKeys} scopeInfo member@GroupMember {memberPubKey, memberId} (ParsedMsg _ signedMsg_ chatMsg@ChatMessage {chatMsgEvent}) ts action = case verified of Just verifiedMsg -> Just <$> action verifiedMsg Nothing -> do @@ -3911,17 +3932,11 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = pure Nothing where verified = case signedMsg_ of - Just sm@SignedMsg {chatBinding, signatures, signedBody} - | GroupMember {memberPubKey = Just pubKey, memberId} <- member -> - case chatBinding of - CBGroup - | Just GroupKeys {publicGroupId} <- groupKeys gInfo -> - signed MSSVerified <$ guard (verifyGroupSig pubKey publicGroupId memberId signatures signedBody) - | otherwise -> - let prefix = smpEncode chatBinding <> smpEncode (memberId, pubKey) -- forward compatibility for verifying signed messages in p2p groups - in signed MSSVerified <$ guard (all (\case (MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 pubKey) sig (prefix <> signedBody)) signatures) - _ -> signed MSSSignedNoKey <$ guard signatureOptional - | otherwise -> signed MSSSignedNoKey <$ guard (signatureOptional || unverifiedAllowed membership member tag) + Just sm@SignedMsg {chatBinding, signatures, signedBody} -> case memberPubKey of + Just pubKey -> case chatBinding of + CBGroup -> signed MSSVerified <$ guard (verifyGroupSig pubKey groupKeys memberId signatures signedBody) + _ -> signed MSSSignedNoKey <$ guard signatureOptional + Nothing -> signed MSSSignedNoKey <$ guard (signatureOptional || unverifiedAllowed membership member tag) where signed status = VMSigned status sm chatMsg Nothing -> VMUnsigned chatMsg <$ guard signatureOptional @@ -4379,7 +4394,7 @@ runRelayRequestWorker a Worker {doWork} = do r -> pure r scheduleRequest :: GroupId -> NominalDiffTime -> CM () scheduleRequest groupId delay = do - v_ <- liftIO $ atomically $ + v_ <- atomically $ ifM (isNothing <$> TM.lookup groupId delayThreads) (newEmptyTMVar >>= \v -> TM.insert groupId v delayThreads $> Just v) @@ -4390,7 +4405,7 @@ runRelayRequestWorker a Worker {doWork} = do atomically $ TM.delete groupId delayThreads void $ atomically $ tryPutTMVar doWork () weakTId <- liftIO $ mkWeakThreadId tId - liftIO $ atomically $ putTMVar v weakTId + atomically $ putTMVar v weakTId retryTmpError :: (Int, NominalDiffTime) -> GroupId -> RelayRequestData -> ChatError -> CM () retryTmpError (retriesThreshold, ttl) groupId RelayRequestData {reqDelay, reqRetries, reqCreatedAt} = \case ChatErrorAgent {agentError} | temporaryOrHostError agentError -> do @@ -4450,7 +4465,7 @@ runRelayRequestWorker a Worker {doWork} = do gVar <- asks random groupLinkId <- GroupLinkId <$> drgRandomBytes 16 subMode <- chatReadVar subscriptionMode - sigKeys <- liftIO $ atomically $ C.generateKeyPair gVar + sigKeys <- atomically $ C.generateKeyPair gVar let crClientData = encodeJSON $ CRDataGroup groupLinkId -- prepare link with relayMemId as linkEntityId (no server request) (ccLink, preparedParams) <- withAgent $ \a' -> prepareConnectionLink a' (aUserId user) sigKeys relayMemId True (Just crClientData) CR.IKPQOff False Nothing diff --git a/src/Simplex/Chat/Messages/Batch.hs b/src/Simplex/Chat/Messages/Batch.hs index 1f9ae0b9ea..0aa177cf27 100644 --- a/src/Simplex/Chat/Messages/Batch.hs +++ b/src/Simplex/Chat/Messages/Batch.hs @@ -67,7 +67,7 @@ batchMessages mode maxLen = addBatch . foldr addToBatch ([], [], [], 0, 0) | msgLen <= maxLen = (addBatch acc, [body], [msg], msgLen, 1) | otherwise = (errLarge msg : addBatch acc, [], [], 0, 0) where - body = encodeBatchElement signedMsg_ msgBody + body = encodeBatchElement (if mode == BMBinary then signedMsg_ else Nothing) msgBody msgLen = B.length body len' = len + msgLen n' = n + 1 diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 7c932d89ad..4660fb24a3 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -86,12 +86,13 @@ import Simplex.Messaging.Version hiding (version) -- 17 - allow host voice messages during member approval regardless of group voice setting (2026-02-10) -- 18 - relay web capabilities (2026-05-31) -- 19 - group roster (2026-06-18) +-- 20 - p2p group member keys for signing (2026-07-26) -- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig. -- This indirection is needed for backward/forward compatibility testing. -- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code. currentChatVersion :: VersionChat -currentChatVersion = VersionChat 19 +currentChatVersion = VersionChat 20 -- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above) supportedChatVRange :: VersionRangeChat @@ -135,6 +136,10 @@ relayWebCapVersion = VersionChat 18 groupRosterVersion :: VersionChat groupRosterVersion = VersionChat 19 +-- members sign messages in p2p groups; member keys are distributed for verification +groupMemberKeyVersion :: VersionChat +groupMemberKeyVersion = VersionChat 20 + data ConnectionEntity = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact} | RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember} @@ -455,15 +460,15 @@ data ChatMsgEvent (e :: MsgEncoding) where XFileAcpt :: String -> ChatMsgEvent 'Json -- direct file protocol XFileAcptInv :: SharedMsgId -> Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json XFileCancel :: SharedMsgId -> ChatMsgEvent 'Json - XInfo :: Profile -> ChatMsgEvent 'Json - XContact :: {profile :: Profile, contactReqId :: Maybe XContactId, welcomeMsgId :: Maybe SharedMsgId, requestMsg :: Maybe (SharedMsgId, MsgContent)} -> ChatMsgEvent 'Json + XInfo :: {profile :: Profile, memberKey :: Maybe MemberKey} -> ChatMsgEvent 'Json + XContact :: {profile :: Profile, memberKey :: Maybe MemberKey, contactReqId :: Maybe XContactId, welcomeMsgId :: Maybe SharedMsgId, requestMsg :: Maybe (SharedMsgId, MsgContent)} -> ChatMsgEvent 'Json XMember :: {profile :: Profile, newMemberId :: MemberId, newMemberKey :: MemberKey, viaRelay :: Maybe MemberId} -> ChatMsgEvent 'Json XDirectDel :: ChatMsgEvent 'Json XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json - XGrpAcpt :: MemberId -> ChatMsgEvent 'Json + XGrpAcpt :: MemberId -> Maybe MemberKey -> ChatMsgEvent 'Json XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json - XGrpLinkMem :: Profile -> ChatMsgEvent 'Json + XGrpLinkMem :: Profile -> Maybe MemberKey -> ChatMsgEvent 'Json XGrpLinkAcpt :: GroupAcceptance -> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json XGrpRelayInv :: GroupRelayInvitation -> ChatMsgEvent 'Json XGrpRelayAcpt :: ShortLinkContact -> RelayCapabilities -> ChatMsgEvent 'Json @@ -522,7 +527,7 @@ isForwardedGroupMsg ev = case ev of XMsgDel {} -> True XMsgReact {} -> True XFileCancel _ -> True - XInfo _ -> True + XInfo {} -> True XGrpRelayNew _ -> True XGrpMemNew {} -> True XGrpMemRole {} -> True @@ -1248,15 +1253,15 @@ toCMEventTag msg = case msg of XFileAcpt _ -> XFileAcpt_ XFileAcptInv {} -> XFileAcptInv_ XFileCancel _ -> XFileCancel_ - XInfo _ -> XInfo_ + XInfo {} -> XInfo_ XContact {} -> XContact_ XMember {} -> XMember_ XDirectDel -> XDirectDel_ XGrpInv _ -> XGrpInv_ - XGrpAcpt _ -> XGrpAcpt_ + XGrpAcpt {} -> XGrpAcpt_ XGrpLinkInv _ -> XGrpLinkInv_ XGrpLinkReject _ -> XGrpLinkReject_ - XGrpLinkMem _ -> XGrpLinkMem_ + XGrpLinkMem {} -> XGrpLinkMem_ XGrpLinkAcpt {} -> XGrpLinkAcpt_ XGrpRelayInv _ -> XGrpRelayInv_ XGrpRelayAcpt {} -> XGrpRelayAcpt_ @@ -1342,6 +1347,7 @@ requiresSignature = \case XGrpRelayNew_ -> True XGrpRoster_ -> True XInfo_ -> True + XGrpLinkMem_ -> True _ -> False -- | Content events a member may sign (XMsgNew opt-in; XMsgUpdate/XMsgDel when the target was signed). @@ -1408,22 +1414,23 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do XFileAcpt_ -> XFileAcpt <$> p "fileName" XFileAcptInv_ -> XFileAcptInv <$> p "msgId" <*> opt "fileConnReq" <*> p "fileName" XFileCancel_ -> XFileCancel <$> p "msgId" - XInfo_ -> XInfo <$> p "profile" + XInfo_ -> XInfo <$> p "profile" <*> opt "memberKey" XContact_ -> do profile <- p "profile" + memberKey <- opt "memberKey" contactReqId <- opt "contactReqId" welcomeMsgId <- opt "welcomeMsgId" reqMsgId <- opt "msgId" reqContent <- opt "content" let requestMsg = (,) <$> reqMsgId <*> reqContent - pure XContact {profile, contactReqId, welcomeMsgId, requestMsg} + pure XContact {profile, memberKey, contactReqId, welcomeMsgId, requestMsg} XMember_ -> XMember <$> p "profile" <*> p "newMemberId" <*> p "newMemberKey" <*> opt "viaRelay" XDirectDel_ -> pure XDirectDel XGrpInv_ -> XGrpInv <$> p "groupInvitation" - XGrpAcpt_ -> XGrpAcpt <$> p "memberId" + XGrpAcpt_ -> XGrpAcpt <$> p "memberId" <*> opt "memberKey" XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation" XGrpLinkReject_ -> XGrpLinkReject <$> p "groupLinkRejection" - XGrpLinkMem_ -> XGrpLinkMem <$> p "profile" + XGrpLinkMem_ -> XGrpLinkMem <$> p "profile" <*> opt "memberKey" XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "acceptance" <*> p "role" <*> p "memberId" XGrpRelayInv_ -> XGrpRelayInv <$> p "groupRelayInvitation" XGrpRelayAcpt_ -> XGrpRelayAcpt <$> p "relayLink" <*> (fromMaybe defaultRelayCapabilities <$> opt "relayCap") @@ -1491,15 +1498,15 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en XFileAcpt fileName -> o ["fileName" .= fileName] XFileAcptInv sharedMsgId fileConnReq fileName -> o $ ("fileConnReq" .=? fileConnReq) ["msgId" .= sharedMsgId, "fileName" .= fileName] XFileCancel sharedMsgId -> o ["msgId" .= sharedMsgId] - XInfo profile -> o ["profile" .= profile] - XContact {profile, contactReqId, welcomeMsgId, requestMsg} -> o $ ("contactReqId" .=? contactReqId) $ ("welcomeMsgId" .=? welcomeMsgId) $ ("msgId" .=? (fst <$> requestMsg)) $ ("content" .=? (snd <$> requestMsg)) $ ["profile" .= profile] + XInfo {profile, memberKey} -> o $ ("memberKey" .=? memberKey) ["profile" .= profile] + XContact {profile, memberKey, contactReqId, welcomeMsgId, requestMsg} -> o $ ("contactReqId" .=? contactReqId) $ ("welcomeMsgId" .=? welcomeMsgId) $ ("msgId" .=? (fst <$> requestMsg)) $ ("content" .=? (snd <$> requestMsg)) $ ("memberKey" .=? memberKey) $ ["profile" .= profile] XMember {profile, newMemberId, newMemberKey, viaRelay} -> o $ ("viaRelay" .=? viaRelay) ["profile" .= profile, "newMemberId" .= newMemberId, "newMemberKey" .= newMemberKey] XDirectDel -> JM.empty XGrpInv groupInv -> o ["groupInvitation" .= groupInv] - XGrpAcpt memId -> o ["memberId" .= memId] + XGrpAcpt memId memberKey -> o $ ("memberKey" .=? memberKey) ["memberId" .= memId] XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv] XGrpLinkReject groupLinkRjct -> o ["groupLinkRejection" .= groupLinkRjct] - XGrpLinkMem profile -> o ["profile" .= profile] + XGrpLinkMem profile memberKey -> o $ ("memberKey" .=? memberKey) ["profile" .= profile] XGrpLinkAcpt acceptance role memberId -> o ["acceptance" .= acceptance, "role" .= role, "memberId" .= memberId] XGrpRelayInv groupRelayInv -> o ["groupRelayInvitation" .= groupRelayInv] XGrpRelayAcpt relayLink relayCap -> o ["relayLink" .= relayLink, "relayCap" .= relayCap] diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index bac41a0dff..84a58fb222 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -107,6 +107,8 @@ module Simplex.Chat.Store.Groups deleteRosterTransfer, deleteGroupRosterTransfers, setGroupMemberKeyRole, + setUserMemberKey, + setMemberPubKey, setGroupMemberVerified, createRelayForOwner, getCreateRelayForMember, @@ -387,10 +389,12 @@ createNewGroup db cxt user@User {userId} groupProfile incognitoProfile useRelays withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do let (rootPrivKey_, rootPubKey_, memberPrivKey_) = case groupKeys of Nothing -> (Nothing, Nothing, Nothing) - Just GroupKeys {groupRootKey, memberPrivKey} -> - let (rpk, rpub) = case groupRootKey of - GRKPrivate pk -> (Just pk, Nothing) - GRKPublic k -> (Nothing, Just k) + Just GroupKeys {publicGroupKeys, memberPrivKey} -> + let (rpk, rpub) = case publicGroupKeys of + Just PublicGroupKeys {groupRootKey} -> case groupRootKey of + GRKPrivate pk -> (Just pk, Nothing) + GRKPublic k -> (Nothing, Just k) + Nothing -> (Nothing, Nothing) in (rpk, rpub, Just memberPrivKey) groupId <- liftIO $ do DB.execute @@ -452,9 +456,9 @@ createNewGroup db cxt user@User {userId} groupProfile incognitoProfile useRelays } -- | creates a new group record for the group the current user was invited to, or returns an existing one -createGroupInvitation :: DB.Connection -> StoreCxt -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId) -createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName -createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, activeConn = Just Connection {peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile, business} incognitoProfileId = do +createGroupInvitation :: DB.Connection -> StoreCxt -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> C.KeyPairEd25519 -> ExceptT StoreError IO (GroupInfo, GroupMemberId) +createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ = throwError $ SEContactNotReady localDisplayName +createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, activeConn = Just Connection {peerChatVRange}} GroupInvitation {fromMember, fromMemberKey, invitedMember, connRequest, groupProfile, business} incognitoProfileId memberKeys = do liftIO getInvitationGroupId_ >>= \case Nothing -> createGroupInvitation_ Just gId -> do @@ -492,14 +496,14 @@ createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, acti [sql| INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id, enable_ntfs, - created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_member_id, customer_member_id) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?) + created_at, updated_at, chat_ts, user_member_profile_sent_at, member_priv_key, business_chat, business_member_id, customer_member_id) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?) |] - ((profileId, localDisplayName, connRequest, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business) + ((profileId, localDisplayName, connRequest, userId, BI True, currentTs, currentTs, currentTs, currentTs, snd memberKeys) :. businessChatInfoRow business) insertedRowId db let hostVRange = adjustedMemberVRange (vr cxt) peerChatVRange - GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing Nothing currentTs hostVRange - membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId Nothing currentTs (vr cxt) + GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing ((\(MemberKey k) -> k) <$> fromMemberKey) currentTs hostVRange + membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId (Just $ fst memberKeys) currentTs (vr cxt) let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} pure ( GroupInfo @@ -526,7 +530,7 @@ createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, acti customData = Nothing, membersRequireAttention = 0, viaGroupLinkUri = Nothing, - groupKeys = Nothing, + groupKeys = Just GroupKeys {publicGroupKeys = Nothing, memberPrivKey = snd memberKeys}, groupDomainVerified = Nothing }, groupMemberId @@ -647,8 +651,9 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile { createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> StoreCxt -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> Maybe SimplexDomain -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember) createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ verifiedDomain = do currentTs <- liftIO getCurrentTime + (memberPubKey, memberPrivKey) <- atomically $ C.generateKeyPair gVar let prepared = Just (connLinkToConnect, welcomeSharedMsgId) - (groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ currentTs + (groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ (Just memberPrivKey) currentTs hostMemberId_ <- if useRelays then pure Nothing @@ -658,8 +663,7 @@ createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile b then liftIO $ MemberId <$> encodedRandomBytes gVar 12 else pure $ MemberId $ encodeUtf8 groupLDN <> "_user_unknown_id" let userMember = MemberIdRole userMemberId userMemberRole - -- TODO [member keys] user key must be included here. Should key be added when group is prepared? - membership <- createContactMemberInv_ db user groupId hostMemberId_ user userMember GCUserMember GSMemUnknown IBUnknown Nothing Nothing currentTs (vr cxt) + membership <- createContactMemberInv_ db user groupId hostMemberId_ user userMember GCUserMember GSMemUnknown IBUnknown Nothing (Just memberPubKey) currentTs (vr cxt) hostMember_ <- forM hostMemberId_ $ getGroupMember db cxt user groupId forM_ hostMember_ $ \hostMember -> when business $ liftIO $ setGroupBusinessChatInfo groupId membership hostMember @@ -781,10 +785,12 @@ updatePreparedGroupUser db cxt user gInfo@GroupInfo {groupId, membership} hostMe safeDeleteLDN db user oldHostLDN updatePreparedUserAndHostMembersInvited :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember) -updatePreparedUserAndHostMembersInvited db cxt user gInfo hostMember GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do +updatePreparedUserAndHostMembersInvited db cxt user gInfo hostMember GroupLinkInvitation {fromMember, fromMemberKey, fromMemberName, invitedMember, groupProfile, accepted, business} = do let fromMemberProfile = profileFromName fromMemberName initialStatus = maybe GSMemAccepted (acceptanceToStatus $ memberAdmission groupProfile) accepted - updatePreparedUserAndHostMembers' db cxt user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile business initialStatus + r@(_, hostMember') <- updatePreparedUserAndHostMembers' db cxt user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile business initialStatus + forM_ fromMemberKey $ \(MemberKey k) -> liftIO $ setMemberPubKey db (groupMemberId' hostMember') k + pure r updatePreparedUserAndHostMembersRejected :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember) updatePreparedUserAndHostMembersRejected db cxt user gInfo hostMember GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do @@ -846,36 +852,37 @@ updatePreparedUserAndHostMembers' (memberId, memberRole, currentTs, gmId) getGroupMemberById db cxt user gmId -createGroupInvitedViaLink :: DB.Connection -> StoreCxt -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember) -createGroupInvitedViaLink db cxt user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do +createGroupInvitedViaLink :: DB.Connection -> StoreCxt -> User -> Connection -> C.KeyPairEd25519 -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember) +createGroupInvitedViaLink db cxt user conn memberKeys GroupLinkInvitation {fromMember, fromMemberKey, fromMemberName, invitedMember, groupProfile, accepted, business} = do let fromMemberProfile = profileFromName fromMemberName initialStatus = maybe GSMemAccepted (acceptanceToStatus $ memberAdmission groupProfile) accepted - createGroupViaLink' db cxt user conn fromMember fromMemberProfile invitedMember groupProfile business initialStatus + createGroupViaLink' db cxt user conn memberKeys fromMember fromMemberProfile ((\(MemberKey k) -> k) <$> fromMemberKey) invitedMember groupProfile business initialStatus -createGroupRejectedViaLink :: DB.Connection -> StoreCxt -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember) -createGroupRejectedViaLink db cxt user conn GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do +createGroupRejectedViaLink :: DB.Connection -> StoreCxt -> User -> Connection -> C.KeyPairEd25519 -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember) +createGroupRejectedViaLink db cxt user conn memberKeys GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do let fromMemberProfile = profileFromName $ nameFromMemberId memberId - createGroupViaLink' db cxt user conn fromMember fromMemberProfile invitedMember groupProfile Nothing GSMemRejected + createGroupViaLink' db cxt user conn memberKeys fromMember fromMemberProfile Nothing invitedMember groupProfile Nothing GSMemRejected -createGroupViaLink' :: DB.Connection -> StoreCxt -> User -> Connection -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember) +createGroupViaLink' :: DB.Connection -> StoreCxt -> User -> Connection -> C.KeyPairEd25519 -> MemberIdRole -> Profile -> Maybe C.PublicKeyEd25519 -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember) createGroupViaLink' db cxt user@User {userId, userContactId} Connection {connId, customUserProfileId} + memberKeys fromMember fromMemberProfile + fromMemberPubKey_ invitedMember groupProfile business membershipStatus = do currentTs <- liftIO getCurrentTime - (groupId, _groupLDN) <- createGroup_ db userId groupProfile Nothing business False Nothing Nothing currentTs + (groupId, _groupLDN) <- createGroup_ db userId groupProfile Nothing business False Nothing Nothing (Just (snd memberKeys)) currentTs hostMemberId <- insertHost_ currentTs groupId liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId) -- using IBUnknown since host is created without contact - -- TODO [member keys] this is currently not used with public groups. If it needs to be used, member keys need to be added - void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember membershipStatus IBUnknown customUserProfileId Nothing currentTs (vr cxt) + _membership <- createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember membershipStatus IBUnknown customUserProfileId (Just (fst memberKeys)) currentTs (vr cxt) liftIO $ setViaGroupLinkUri db groupId connId (,) <$> getGroupInfo db cxt user groupId <*> getGroupMemberById db cxt user hostMemberId where @@ -889,16 +896,16 @@ createGroupViaLink' [sql| INSERT INTO group_members ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, - user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) + user_id, local_display_name, contact_id, contact_profile_id, member_pub_key, created_at, updated_at) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ( (groupId, indexInGroup, memberId, memberRole, GCHostMember, GSMemAccepted, Binary B.empty, fromInvitedBy userContactId IBUnknown) - :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs) + :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, fromMemberPubKey_, currentTs, currentTs) ) insertedRowId db -createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe (CreatedLinkContact, Maybe SharedMsgId) -> Maybe BusinessChatInfo -> Bool -> Maybe RelayStatus -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (GroupId, Text) -createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus publicMemberCount_ currentTs = ExceptT $ do +createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe (CreatedLinkContact, Maybe SharedMsgId) -> Maybe BusinessChatInfo -> Bool -> Maybe RelayStatus -> Maybe Int64 -> Maybe C.PrivateKeyEd25519 -> UTCTime -> ExceptT StoreError IO (GroupId, Text) +createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus publicMemberCount_ memberPrivKey_ currentTs = ExceptT $ do let GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission} = groupProfile (groupType_, groupLink_, publicGroupId_) = case publicGroup of Just PublicGroupProfile {groupType, groupLink, publicGroupId} -> (Just groupType, Just groupLink, Just publicGroupId) @@ -924,10 +931,10 @@ createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus p INSERT INTO groups (group_profile_id, local_display_name, user_id, enable_ntfs, created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id, - business_chat, business_member_id, customer_member_id, use_relays, relay_own_status, public_member_count) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + business_chat, business_member_id, customer_member_id, use_relays, relay_own_status, public_member_count, member_priv_key) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] - ((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. toPreparedGroupRow prepared :. businessChatInfoRow business :. (BI useRelays, relayOwnStatus, publicMemberCount_)) + ((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. toPreparedGroupRow prepared :. businessChatInfoRow business :. (BI useRelays, relayOwnStatus, publicMemberCount_, memberPrivKey_)) groupId <- insertedRowId db pure (groupId, localDisplayName) @@ -1688,6 +1695,17 @@ setGroupMemberKeyRole db GroupMember {groupMemberId} pubKey role = do currentTs <- getCurrentTime DB.execute db "UPDATE group_members SET member_pub_key = ?, member_role = ?, updated_at = ? WHERE group_member_id = ?" (pubKey, role, currentTs, groupMemberId) +setUserMemberKey :: DB.Connection -> GroupId -> GroupMemberId -> C.PrivateKeyEd25519 -> IO () +setUserMemberKey db groupId membershipId memberPrivKey = do + currentTs <- getCurrentTime + DB.execute db "UPDATE groups SET member_priv_key = ?, updated_at = ? WHERE group_id = ?" (memberPrivKey, currentTs, groupId) + DB.execute db "UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?" (C.publicKey memberPrivKey, currentTs, membershipId) + +setMemberPubKey :: DB.Connection -> GroupMemberId -> C.PublicKeyEd25519 -> IO () +setMemberPubKey db groupMemberId pubKey = do + currentTs <- getCurrentTime + DB.execute db "UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?" (pubKey, currentTs, groupMemberId) + setGroupMemberVerified :: DB.Connection -> User -> GroupMemberId -> Maybe Text -> IO () setGroupMemberVerified db User {userId} groupMemberId code = do updatedAt <- getCurrentTime @@ -1896,7 +1914,7 @@ createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMemb groupPreferences = Nothing, memberAdmission = Nothing } - (groupId, _groupLDN) <- createGroup_ db userId placeholderProfile Nothing Nothing True (Just relayStatus) Nothing currentTs + (groupId, _groupLDN) <- createGroup_ db userId placeholderProfile Nothing Nothing True (Just relayStatus) Nothing Nothing currentTs -- Store relay request data for recovery liftIO $ setRelayRequestData_ groupId currentTs ownerMemberId <- insertOwner_ currentTs groupId @@ -2151,6 +2169,7 @@ createBusinessRequestGroup pure (groupInfo, clientMember) where insertGroup_ currentTs = do + (memberPubKey, memberPrivKey) <- atomically $ C.generateKeyPair gVar liftIO $ DB.execute db @@ -2163,14 +2182,13 @@ createBusinessRequestGroup [sql| INSERT INTO groups (group_profile_id, local_display_name, user_id, enable_ntfs, - created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat) - VALUES (?,?,?,?,?,?,?,?,?) + created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, member_priv_key) + VALUES (?,?,?,?,?,?,?,?,?,?) |] - (groupProfileId, ldn, userId, BI True, currentTs, currentTs, currentTs, currentTs, BCCustomer) + (groupProfileId, ldn, userId, BI True, currentTs, currentTs, currentTs, currentTs, BCCustomer, memberPrivKey) groupId <- liftIO $ insertedRowId db memberId <- liftIO $ encodedRandomBytes gVar 12 - -- TODO [member keys] we could support member keys in business groups to allow binding agreements (though identity keys would be better for it. - membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing Nothing currentTs (vr cxt) + membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing (Just memberPubKey) currentTs (vr cxt) pure (groupId, membership) VersionRange minV maxV = cReqChatVRange insertClientMember_ currentTs groupId membership = diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index 7372e51b6b..47a6d2745d 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -115,8 +115,8 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta Query: INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id, enable_ntfs, - created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_member_id, customer_member_id) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?) + created_at, updated_at, chat_ts, user_member_profile_sent_at, member_priv_key, business_chat, business_member_id, customer_member_id) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: @@ -288,8 +288,8 @@ SEARCH users USING INTEGER PRIMARY KEY (rowid=?) Query: INSERT INTO group_members ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, - user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) + user_id, local_display_name, contact_id, contact_profile_id, member_pub_key, created_at, updated_at) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?) @@ -395,8 +395,8 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta Query: INSERT INTO groups (group_profile_id, local_display_name, user_id, enable_ntfs, - created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat) - VALUES (?,?,?,?,?,?,?,?,?) + created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, member_priv_key) + VALUES (?,?,?,?,?,?,?,?,?,?) Plan: @@ -1312,8 +1312,8 @@ Query: INSERT INTO groups (group_profile_id, local_display_name, user_id, enable_ntfs, created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id, - business_chat, business_member_id, customer_member_id, use_relays, relay_own_status, public_member_count) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + business_chat, business_member_id, customer_member_id, use_relays, relay_own_status, public_member_count, member_priv_key) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index ceaf905df0..375d557c28 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -733,10 +733,12 @@ toPublicGroupAccess (groupWebPage, groupDomain_, domainWebPage_, allowEmbedding_ allowEmbedding = maybe False unBI allowEmbedding_ toGroupKeys :: Maybe B64UrlByteString -> GroupKeysRow -> Maybe GroupKeys -toGroupKeys (Just publicGroupId) (rootPrivKey_, rootPubKey_, Just memberPrivKey) = - (\grk -> GroupKeys {publicGroupId, groupRootKey = grk, memberPrivKey}) - <$> (GRKPrivate <$> rootPrivKey_ <|> GRKPublic <$> rootPubKey_) -toGroupKeys _ _ = Nothing +toGroupKeys publicGroupId_ (rootPrivKey, rootPubKey, memberPrivKey) = + let publicGroupKeys = case (publicGroupId_, GRKPrivate <$> rootPrivKey <|> GRKPublic <$> rootPubKey) of + (Just publicGroupId, Just groupRootKey) -> Just $ Just PublicGroupKeys {publicGroupId, groupRootKey} + (Nothing, Nothing) -> Just Nothing + _ -> Nothing -- invalid state, in which case messages won't be signed even if memberPrivKey is present + in GroupKeys <$> publicGroupKeys <*> memberPrivKey toGroupMember :: UTCTime -> Int64 -> GroupMemberRow -> GroupMember toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. profileRow :. (createdAt, updatedAt) :. (supportChatTs_, supportChatUnread, supportChatMemberAttention, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink, memberCode_, memberCodeVerifiedAt_)) = diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index 746b1e137f..fa5efd0354 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -80,7 +80,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do CRChatItemUpdated u (AChatItem _ SMDSnd cInfo _) -> whenCurrUser cc u $ setActiveChat ct cInfo CRChatItemsDeleted u ((ChatItemDeletion (AChatItem _ _ cInfo _) _) : _) _ _ -> whenCurrUser cc u $ setActiveChat ct cInfo CRContactDeleted u c -> whenCurrUser cc u $ unsetActiveContact ct c - CRGroupDeletedUser u g _ -> whenCurrUser cc u $ unsetActiveGroup ct g + CRGroupDeletedUser u g _ _ -> whenCurrUser cc u $ unsetActiveGroup ct g CRSentGroupInvitation u g _ _ -> whenCurrUser cc u $ setActiveGroup ct g CRCmdOk _ -> case cmd of Right APIDeleteUser {} -> setActive ct "" diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index c0e44277a4..9c7ae95749 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -480,12 +480,17 @@ groupRootPubKey (GRKPrivate pk) = C.publicKey pk groupRootPubKey (GRKPublic pk) = pk data GroupKeys = GroupKeys - { publicGroupId :: B64UrlByteString, - groupRootKey :: GroupRootKey, + { publicGroupKeys :: Maybe PublicGroupKeys, memberPrivKey :: C.PrivateKeyEd25519 } deriving (Eq, Show) +data PublicGroupKeys = PublicGroupKeys + { publicGroupId :: B64UrlByteString, + groupRootKey :: GroupRootKey + } + deriving (Eq, Show) + data GroupInfo = GroupInfo { groupId :: GroupId, useRelays :: BoolDef, @@ -943,6 +948,7 @@ instance ToJSON GroupLinkId where data GroupInvitation = GroupInvitation { fromMember :: MemberIdRole, + fromMemberKey :: Maybe MemberKey, invitedMember :: MemberIdRole, connRequest :: ConnReqInvitation, groupProfile :: GroupProfile, @@ -955,6 +961,7 @@ data GroupInvitation = GroupInvitation data GroupLinkInvitation = GroupLinkInvitation { fromMember :: MemberIdRole, fromMemberName :: ContactName, + fromMemberKey :: Maybe MemberKey, invitedMember :: MemberIdRole, groupProfile :: GroupProfile, accepted :: Maybe GroupAcceptance, @@ -2336,6 +2343,8 @@ instance FromJSON GroupSummary where $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GRK") ''GroupRootKey) +$(JQ.deriveJSON defaultJSON ''PublicGroupKeys) + $(JQ.deriveJSON defaultJSON ''GroupKeys) $(JQ.deriveJSON defaultJSON ''GroupInfo) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 650157145b..49823ae7cf 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -241,7 +241,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, showFullLinks, te "use " <> highlight ("/d #" <> viewGroupName g) <> " to delete the group (also clears the rejection)" ] | otherwise -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g - CRGroupDeletedUser u g signed -> ttyUser u [ttyGroup' g <> ": you deleted the group" <> signedStr signed] + CRGroupDeletedUser u g signed local -> ttyUser u [ttyGroup' g <> (if local then ": you deleted your local copy of the group" else ": you deleted the group" <> signedStr signed)] CRForwardPlan u count itemIds fc -> ttyUser u $ viewForwardPlan count itemIds fc CRChatMsgContent u mc -> ttyUser u $ ttyMsgContent mc <> viewMsgTestInfo testView mc CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 9c627df90d..af92195f79 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -343,7 +343,7 @@ testDeleteGroupAdmin ps = submitGroup bob "security" "Security" bob <# "'SimpleX Directory'> The group security (Security) is already listed in the directory, please choose another name." bob ##> "/d #security" - bob <## "#security: you deleted the group" + bob <## "#security: you deleted the group (signed)" -- admin can delete the group superUser #> "@'SimpleX Directory' /delete 2:security" superUser <# "'SimpleX Directory'> > /delete 2:security" @@ -622,7 +622,7 @@ testInviteOwnerAfterLeavingOwnersGroup ps = superUser <## "#owners: new member bob is connected" -- owner leaves owners' group; GroupMember row keeps status GSMemLeft leaveGroup "owners" bob - superUser <## "#owners: bob left the group" + superUser <## "#owners: bob left the group (signed)" -- owners' group has no GroupReg, so directory service notifies admins on contact left superUser <# "'SimpleX Directory'> Error: contact left, group: 1 owners, group registration not found" -- super-user re-invites via /invite — must send a fresh invitation, not "already a member" @@ -641,7 +641,7 @@ testDelistedOwnerLeaves ps = registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath leaveGroup "privacy" bob - cath <## "#privacy: bob left the group" + cath <## "#privacy: bob left the group (signed)" bob <# "'SimpleX Directory'> You left the group ID 1 (privacy)." bob <## "" bob <## "The group is no longer listed in the directory." @@ -678,7 +678,7 @@ testNotDelistedMemberLeaves ps = registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath leaveGroup "privacy" cath - bob <## "#privacy: cath left the group" + bob <## "#privacy: cath left the group (signed)" (superUser "@'SimpleX Directory_1' privacy" @@ -743,7 +743,7 @@ testNotDelistedOwnerRejoinsViaLink ps = bob ##> "/l privacy_1" bob <## "#privacy_1: you left the group" bob <## "use /d #privacy_1 to delete the group" - bob <## "#privacy: bob_1 left the group" + bob <## "#privacy: bob_1 left the group (signed)" -- the group must remain listed: the leaving member is not the owner member (superUser "/rm #privacy 'SimpleX Directory'" - bob <## "#privacy: you removed 'SimpleX Directory' from the group" - cath <## "#privacy: bob removed 'SimpleX Directory' from the group" + bob <## "#privacy: you removed 'SimpleX Directory' from the group (signed)" + cath <## "#privacy: bob removed 'SimpleX Directory' from the group (signed)" bob <# "'SimpleX Directory'> SimpleX Directory is removed from the group ID 1 (privacy)." bob <## "" bob <## "The group is no longer listed in the directory." @@ -781,11 +781,11 @@ testDelistedGroupDeleted ps = cath <## "contact and member are merged: 'SimpleX Directory', #privacy 'SimpleX Directory_1'" cath <## "use @'SimpleX Directory' to send messages" bob ##> "/d #privacy" - bob <## "#privacy: you deleted the group" + bob <## "#privacy: you deleted the group (signed)" bob <# "'SimpleX Directory'> The group ID 1 (privacy) is deleted." bob <## "" bob <## "The group is no longer listed in the directory." - cath <## "#privacy: bob deleted the group" + cath <## "#privacy: bob deleted the group (signed)" cath <## "use /d #privacy to delete the local copy of the group" superUser <# "'SimpleX Directory'> The group ID 1 (privacy) is de-listed (group is deleted)." groupNotFound cath "privacy" @@ -804,8 +804,8 @@ testDelistedRoleChanges ps = groupFoundN 3 cath "privacy" -- de-listed if service role changed bob ##> "/mr privacy 'SimpleX Directory' member" - bob <## "#privacy: you changed the role of 'SimpleX Directory' to member" - cath <## "#privacy: bob changed the role of 'SimpleX Directory' from admin to member" + bob <## "#privacy: you changed the role of 'SimpleX Directory' to member (signed)" + cath <## "#privacy: bob changed the role of 'SimpleX Directory' from admin to member (signed)" bob <# "'SimpleX Directory'> SimpleX Directory role in the group ID 1 (privacy) is changed to member." bob <## "" bob <## "The group is no longer listed in the directory." @@ -813,8 +813,8 @@ testDelistedRoleChanges ps = groupNotFound cath "privacy" -- re-listed if service role changed back without profile changes cath ##> "/mr privacy 'SimpleX Directory' admin" - cath <## "#privacy: you changed the role of 'SimpleX Directory' to admin" - bob <## "#privacy: cath changed the role of 'SimpleX Directory' from member to admin" + cath <## "#privacy: you changed the role of 'SimpleX Directory' to admin (signed)" + bob <## "#privacy: cath changed the role of 'SimpleX Directory' from member to admin (signed)" bob <# "'SimpleX Directory'> SimpleX Directory role in the group ID 1 (privacy) is changed to admin." bob <## "" bob <## "The group is listed in the directory again." @@ -822,8 +822,8 @@ testDelistedRoleChanges ps = groupFoundN 3 cath "privacy" -- de-listed if owner role changed cath ##> "/mr privacy bob admin" - cath <## "#privacy: you changed the role of bob to admin" - bob <## "#privacy: cath changed your role from owner to admin" + cath <## "#privacy: you changed the role of bob to admin (signed)" + bob <## "#privacy: cath changed your role from owner to admin (signed)" bob <# "'SimpleX Directory'> Your role in the group ID 1 (privacy) is changed to admin." bob <## "" bob <## "The group is no longer listed in the directory." @@ -831,8 +831,8 @@ testDelistedRoleChanges ps = groupNotFound cath "privacy" -- re-listed if owner role changed back without profile changes cath ##> "/mr privacy bob owner" - cath <## "#privacy: you changed the role of bob to owner" - bob <## "#privacy: cath changed your role from admin to owner" + cath <## "#privacy: you changed the role of bob to owner (signed)" + bob <## "#privacy: cath changed your role from admin to owner (signed)" bob <# "'SimpleX Directory'> Your role in the group ID 1 (privacy) is changed to owner." bob <## "" bob <## "The group is listed in the directory again." @@ -852,8 +852,8 @@ testNotDelistedMemberRoleChanged ps = cath <## "use @'SimpleX Directory' to send messages" groupFoundN 3 cath "privacy" bob ##> "/mr privacy cath member" - bob <## "#privacy: you changed the role of cath to member" - cath <## "#privacy: bob changed your role from owner to member" + bob <## "#privacy: you changed the role of cath to member (signed)" + cath <## "#privacy: bob changed your role from owner to member (signed)" groupFoundN 3 cath "privacy" testNotSentApprovalBadRoles :: HasCallStack => TestParams -> IO () @@ -867,13 +867,13 @@ testNotSentApprovalBadRoles ps = groupAccepted bob "privacy" 1 notifySuperUser superUser bob "privacy" "Privacy" 1 bob ##> "/mr privacy 'SimpleX Directory' member" - bob <## "#privacy: you changed the role of 'SimpleX Directory' to member" + bob <## "#privacy: you changed the role of 'SimpleX Directory' to member (signed)" bob ##> "/gp privacy privacy Privacy!" bob <## "description changed to: Privacy!" groupUpdatedHidden superUser bob "privacy" "" bob <# "'SimpleX Directory'> You must grant directory service admin role to register the group" bob ##> "/mr privacy 'SimpleX Directory' admin" - bob <## "#privacy: you changed the role of 'SimpleX Directory' to admin" + bob <## "#privacy: you changed the role of 'SimpleX Directory' to admin (signed)" bob <# "'SimpleX Directory'> SimpleX Directory role in the group ID 1 (privacy) is changed to admin." bob <## "" bob <## "The group is submitted for approval." @@ -893,14 +893,14 @@ testNotApprovedBadRoles ps = groupAccepted bob "privacy" 1 notifySuperUser superUser bob "privacy" "Privacy" 1 bob ##> "/mr privacy 'SimpleX Directory' member" - bob <## "#privacy: you changed the role of 'SimpleX Directory' to member" + bob <## "#privacy: you changed the role of 'SimpleX Directory' to member (signed)" let approve = "/approve 1:privacy 1" superUser #> ("@'SimpleX Directory' " <> approve) superUser <# ("'SimpleX Directory'> > " <> approve) superUser <## " Group is not approved: SimpleX Directory is not an admin." groupNotFound cath "privacy" bob ##> "/mr privacy 'SimpleX Directory' admin" - bob <## "#privacy: you changed the role of 'SimpleX Directory' to admin" + bob <## "#privacy: you changed the role of 'SimpleX Directory' to admin (signed)" bob <# "'SimpleX Directory'> SimpleX Directory role in the group ID 1 (privacy) is changed to admin." bob <## "" bob <## "The group is submitted for approval." @@ -920,7 +920,7 @@ testRegOwnerChangedProfile ps = bob <## "description changed to: Privacy and Security" bob <# "'SimpleX Directory'> The group ID 1 (privacy) is updated!" bob <## "It is hidden from the directory until approved." - cath <## "bob updated group #privacy:" + cath <## "bob updated group #privacy: (signed)" cath <## "description changed to: Privacy and Security" cath `connectVia` dsLink cath <## "contact and member are merged: 'SimpleX Directory_1', #privacy 'SimpleX Directory'" @@ -943,7 +943,7 @@ testAnotherOwnerChangedProfile ps = cath <## "use @'SimpleX Directory' to send messages" cath ##> "/gp privacy privacy Privacy and Security" cath <## "description changed to: Privacy and Security" - bob <## "cath updated group #privacy:" + bob <## "cath updated group #privacy: (signed)" bob <## "description changed to: Privacy and Security" bob <# "'SimpleX Directory'> The group ID 1 (privacy) is updated by cath!" bob <## "It is hidden from the directory until approved." @@ -964,7 +964,7 @@ testNotConnectedOwnerChangedProfile ps = addCathAsOwner bob cath cath ##> "/gp privacy privacy Privacy and Security" cath <## "description changed to: Privacy and Security" - bob <## "cath updated group #privacy:" + bob <## "cath updated group #privacy: (signed)" bob <## "description changed to: Privacy and Security" bob <# "'SimpleX Directory'> The group ID 1 (privacy) is updated by cath!" bob <## "It is hidden from the directory until approved." @@ -1176,7 +1176,7 @@ testListUserGroups promote ps = -- with de-listed group groupFound cath "anonymity" cath ##> "/mr anonymity 'SimpleX Directory' member" - cath <## "#anonymity: you changed the role of 'SimpleX Directory' to member" + cath <## "#anonymity: you changed the role of 'SimpleX Directory' to member (signed)" cath <# "'SimpleX Directory'> SimpleX Directory role in the group ID 1 (anonymity) is changed to member." cath <## "" cath <## "The group is no longer listed in the directory." @@ -1191,7 +1191,7 @@ testListUserGroups promote ps = checkListings ["privacy", "security"] ["privacy"] bob ##> "/gp privacy privacy" bob <## "description removed" - cath <## "bob updated group #privacy:" + cath <## "bob updated group #privacy: (signed)" cath <## "description removed" groupUpdatedHidden superUser bob "privacy" "" superUser <# "'SimpleX Directory'> bob submitted the group ID 1:" @@ -1342,9 +1342,9 @@ testCapthaScreening ps = cath ##> "/l privacy" cath <## "#privacy: you left the group" cath <## "use /d #privacy to delete the group" - bob <## "#privacy: cath left the group" + bob <## "#privacy: cath left the group (signed)" cath ##> "/d #privacy" - cath <## "#privacy: you deleted the group" + cath <## "#privacy: you deleted your local copy of the group" -- change default role to observer bob #> "@'SimpleX Directory' /role 1 observer" bob <# "'SimpleX Directory'> > /role 1 observer" @@ -1888,7 +1888,7 @@ setWelcomeMessage u others welcome = do u <## "welcome message changed to:" u <## welcome forM_ others $ \m -> do - m <## (uName <> " updated group #privacy:") + m <## (uName <> " updated group #privacy: (signed)") m <## "welcome message changed to:" m <## welcome @@ -1926,8 +1926,8 @@ removeMember gName admin removed = do adminName <- userName admin removedName <- userName removed admin ##> ("/rm " <> gName <> " " <> removedName) - admin <## (gn <> ": you removed " <> removedName <> " from the group") - removed <## (gn <> ": " <> adminName <> " removed you from the group") + admin <## (gn <> ": you removed " <> removedName <> " from the group (signed)") + removed <## (gn <> ": " <> adminName <> " removed you from the group (signed)") removed <## ("use /d " <> gn <> " to delete the group") groupFound :: TestCC -> String -> IO () diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index fb94194561..089efc914d 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -1037,11 +1037,11 @@ testProhibitFiles = alice <## "Files and media: off" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Files and media: off", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "updated group preferences:" cath <## "Files and media: off" ] diff --git a/tests/ChatTests/Forward.hs b/tests/ChatTests/Forward.hs index 91ad46ba43..1654ce5335 100644 --- a/tests/ChatTests/Forward.hs +++ b/tests/ChatTests/Forward.hs @@ -128,7 +128,7 @@ testForwardChannelLinkRemoved ps = cath ##> "/set links #club off" cath <## "updated group preferences:" cath <## "SimpleX links: off" - dan <## "cath updated group #club:" + dan <## "cath updated group #club: (signed)" dan <## "updated group preferences:" dan <## "SimpleX links: off" alice #> "#team hi" diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 2c01f379ad..187dd1b078 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -108,6 +108,9 @@ chatGroupTests = do it "send multiple messages (many chat batches)" testSendMultiManyBatches it "shared message body is reused" testSharedMessageBody it "shared batch body is reused" testSharedBatchBody + it "shared batch body reference across binary and json members" testGroupSharedBatchBodyMixedModes + it "shared batch body reused across binary and json members" testSharedBatchBodyMixed + it "all old members group upgrades to current version" testGroupAllOldThenUpgrade describe "async group connections" $ do xit "create and join group when clients go offline" testGroupAsync describe "group links" $ do @@ -429,9 +432,9 @@ testGroupShared alice bob cath checkMessages = do -- test observer role alice ##> "/mr team bob observer" concurrentlyN_ - [ alice <## "#team: you changed the role of bob to observer", - bob <## "#team: alice changed your role from admin to observer", - cath <## "#team: alice changed the role of bob from admin to observer" + [ alice <## "#team: you changed the role of bob to observer (signed)", + bob <## "#team: alice changed your role from admin to observer (signed)", + cath <## "#team: alice changed the role of bob from admin to observer (signed)" ] bob ##> "#team hello" bob <## "#team: you don't have permission to send messages" @@ -439,9 +442,9 @@ testGroupShared alice bob cath checkMessages = do bob <## "#team: you have insufficient permissions for this action, the required role is admin" alice ##> "/mr team bob admin" concurrentlyN_ - [ alice <## "#team: you changed the role of bob to admin", - bob <## "#team: alice changed your role from observer to admin", - cath <## "#team: alice changed the role of bob from observer to admin" + [ alice <## "#team: you changed the role of bob to admin (signed)", + bob <## "#team: alice changed your role from observer to admin (signed)", + cath <## "#team: alice changed the role of bob from observer to admin (signed)" ] -- delete contact alice ##> "/d bob" @@ -548,7 +551,7 @@ testGroupLargeMessage = alice `send` ("/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"image\": \"" <> profileImage <> "\", \"groupPreferences\": {\"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}") _trimmedCmd1 <- getTermLine alice alice <## "profile image updated" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "profile image updated" testNewGroupIncognito :: HasCallStack => TestParams -> IO () @@ -760,11 +763,11 @@ testGroup2 = -- remove member cath ##> "/rm club dan" concurrentlyN_ - [ cath <## "#club: you removed dan from the group", - alice <## "#club: cath removed dan from the group", - bob <## "#club: cath removed dan from the group", + [ cath <## "#club: you removed dan from the group (signed)", + alice <## "#club: cath removed dan from the group (signed)", + bob <## "#club: cath removed dan from the group (signed)", do - dan <## "#club: cath removed you from the group" + dan <## "#club: cath removed you from the group (signed)" dan <## "use /d #club to delete the group" ] alice #> "#club hello" @@ -788,7 +791,7 @@ testGroup2 = dan ##> "#club how is it going?" dan <## "bad chat command: not current member" dan ##> "/d #club" - dan <## "#club: you deleted the group" + dan <## "#club: you deleted your local copy of the group" dan <##> alice -- member leaves bob ##> "/l club" @@ -796,8 +799,8 @@ testGroup2 = [ do bob <## "#club: you left the group" bob <## "use /d #club to delete the group", - alice <## "#club: bob left the group", - cath <## "#club: bob left the group" + alice <## "#club: bob left the group (signed)", + cath <## "#club: bob left the group (signed)" ] alice #> "#club hello" concurrently_ @@ -810,7 +813,7 @@ testGroup2 = bob ##> "#club how is it going?" bob <## "bad chat command: not current member" bob ##> "/d #club" - bob <## "#club: you deleted the group" + bob <## "#club: you deleted your local copy of the group" bob <##> alice testGroupDelete :: HasCallStack => TestParams -> IO () @@ -820,22 +823,22 @@ testGroupDelete = createGroup3' "team" alice (bob, GRMember) (cath, GRMember) alice ##> "/d #team" concurrentlyN_ - [ alice <## "#team: you deleted the group", + [ alice <## "#team: you deleted the group (signed)", do - bob <## "#team: alice deleted the group" + bob <## "#team: alice deleted the group (signed)" bob <## "use /d #team to delete the local copy of the group", do - cath <## "#team: alice deleted the group" + cath <## "#team: alice deleted the group (signed)" cath <## "use /d #team to delete the local copy of the group" ] alice ##> "#team hi" alice <## "no group #team" bob ##> "/d #team" - bob <## "#team: you deleted the group" + bob <## "#team: you deleted your local copy of the group" cath ##> "#team hi" cath <## "bad chat command: not current member" cath ##> "/d #team" - cath <## "#team: you deleted the group" + cath <## "#team: you deleted your local copy of the group" alice <##> bob alice <##> cath -- unused group contacts are deleted @@ -877,7 +880,7 @@ testGroupDeleteWhenInvited = bob <## "use /j team to accept" ] bob ##> "/d #team" - bob <## "#team: you deleted the group" + bob <## "#team: you deleted your local copy of the group" -- alice doesn't receive notification that bob deleted group, -- but she can re-add bob alice ##> "/a team bob" @@ -953,15 +956,15 @@ testGroupReAddInvitedChangeRole = (bob <## "#team: you joined the group") bob ##> "/d #team" concurrentlyN_ - [ bob <## "#team: you deleted the group", + [ bob <## "#team: you deleted the group (signed)", do - alice <## "#team: bob deleted the group" + alice <## "#team: bob deleted the group (signed)" alice <## "use /d #team to delete the local copy of the group" ] bob ##> "#team hi" bob <## "no group #team" alice ##> "/d #team" - alice <## "#team: you deleted the group" + alice <## "#team: you deleted your local copy of the group" testGroupDeleteInvitedContact :: HasCallStack => TestParams -> IO () testGroupDeleteInvitedContact = @@ -1066,15 +1069,15 @@ testDeleteGroupMemberProfileKept = -- delete group 1 alice ##> "/d #team" concurrentlyN_ - [ alice <## "#team: you deleted the group", + [ alice <## "#team: you deleted the group (signed)", do - bob <## "#team: alice deleted the group" + bob <## "#team: alice deleted the group (signed)" bob <## "use /d #team to delete the local copy of the group" ] alice ##> "#team hi" alice <## "no group #team" bob ##> "/d #team" - bob <## "#team: you deleted the group" + bob <## "#team: you deleted your local copy of the group" -- group 2 still works alice #> "#club checking connection" bob <# "#club alice> checking connection" @@ -1092,11 +1095,11 @@ testGroupRemoveAdd = -- remove member alice ##> "/rm team bob" concurrentlyN_ - [ alice <## "#team: you removed bob from the group", + [ alice <## "#team: you removed bob from the group (signed)", do - bob <## "#team: alice removed you from the group" + bob <## "#team: alice removed you from the group (signed)" bob <## "use /d #team to delete the group", - cath <## "#team: alice removed bob from the group" + cath <## "#team: alice removed bob from the group (signed)" ] threadDelay 100000 @@ -1154,7 +1157,7 @@ testGroupList = ] -- after deleting invitation bob sees only one group bob ##> "/d #tennis" - bob <## "#tennis: you deleted the group" + bob <## "#tennis: you deleted your local copy of the group" bob ##> "/gs" bob <## "#team (2 members)" @@ -1589,10 +1592,10 @@ testUpdateGroupProfile = alice <## "changed to #my_team" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "changed to #my_team", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "changed to #my_team" ] bob #> "#my_team hi" @@ -1603,20 +1606,20 @@ testUpdateGroupProfile = alice <## "description changed to: My team" concurrentlyN_ [ do - bob <## "alice updated group #my_team:" + bob <## "alice updated group #my_team: (signed)" bob <## "description changed to: My team", do - cath <## "alice updated group #my_team:" + cath <## "alice updated group #my_team: (signed)" cath <## "description changed to: My team" ] alice ##> "/gp my_team my_team My team updated" alice <## "description changed to: My team updated" concurrentlyN_ [ do - bob <## "alice updated group #my_team:" + bob <## "alice updated group #my_team: (signed)" bob <## "description changed to: My team updated", do - cath <## "alice updated group #my_team:" + cath <## "alice updated group #my_team: (signed)" cath <## "description changed to: My team updated" ] @@ -1642,8 +1645,8 @@ testUpdateMemberRole = bob <## "#team: you have insufficient permissions for this action, the required role is admin" alice ##> "/mr team bob admin" concurrently_ - (alice <## "#team: you changed the role of bob to admin") - (bob <## "#team: alice changed your role from member to admin") + (alice <## "#team: you changed the role of bob to admin (signed)") + (bob <## "#team: alice changed your role from member to admin (signed)") bob ##> "/a team cath owner" bob <## "#team: you have insufficient permissions for this action, the required role is owner" addMember "team" bob cath GRMember @@ -1678,7 +1681,7 @@ testOwnerRoleChange = |] cath ##> "/mr #team bob owner" - cath <## "#team: you changed the role of bob to owner" + cath <## "#team: you changed the role of bob to owner (signed)" concurrentlyN_ [ alice <## "error: x.grp.mem.role with insufficient member permissions", bob <## "error: x.grp.mem.role with insufficient member permissions" @@ -1712,7 +1715,7 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile alice ##> "/set welcome team Welcome to the team!" alice <## "welcome message changed to:" alice <## "Welcome to the team!" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "welcome message changed to:" bob <## "Welcome to the team!" alice ##> "/group_profile team" @@ -1775,9 +1778,9 @@ testGroupModerate = -- disableFullDeletion3 "team" alice bob cath alice ##> "/mr team cath member" concurrentlyN_ - [ alice <## "#team: you changed the role of cath to member", - bob <## "#team: alice changed the role of cath from admin to member", - cath <## "#team: alice changed your role from admin to member" + [ alice <## "#team: you changed the role of cath to member (signed)", + bob <## "#team: alice changed the role of cath from admin to member (signed)", + cath <## "#team: alice changed your role from admin to member (signed)" ] alice #> "#team hello" concurrently_ @@ -1858,20 +1861,20 @@ testGroupModerateFullDelete = -- disableFullDeletion3 "team" alice bob cath alice ##> "/mr team cath member" concurrentlyN_ - [ alice <## "#team: you changed the role of cath to member", - bob <## "#team: alice changed the role of cath from admin to member", - cath <## "#team: alice changed your role from admin to member" + [ alice <## "#team: you changed the role of cath to member (signed)", + bob <## "#team: alice changed the role of cath from admin to member (signed)", + cath <## "#team: alice changed your role from admin to member (signed)" ] alice ##> "/set delete #team on" alice <## "updated group preferences:" alice <## "Full deletion: on" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Full deletion: on", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "updated group preferences:" cath <## "Full deletion: on" ] @@ -1965,13 +1968,13 @@ testGroupDelayedModerationFullDelete ps = do alice ##> "/set delete #team on" alice <## "updated group preferences:" alice <## "Full deletion: on" - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "updated group preferences:" cath <## "Full deletion: on" withTestChatCfg ps cfg "bob" $ \bob -> do bob <## "subscribed 2 connections on server localhost" bob <## "#team: alice added cath (Catherine) to the group (connecting...)" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Full deletion: on" withTestChatCfg ps cfg "cath" $ \cath -> do @@ -2002,11 +2005,11 @@ testDeleteMemberWithMessages = threadDelay 750000 concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Full deletion: on", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "updated group preferences:" cath <## "Full deletion: on" ] @@ -2053,19 +2056,19 @@ testDeleteMemberWithMessages = threadDelay 1000000 alice ##> "/rm #team bob messages=on" - alice <## "#team: you removed bob from the group with all messages" - bob <## "#team: alice removed you from the group with all messages" + alice <## "#team: you removed bob from the group with all messages (signed)" + bob <## "#team: alice removed you from the group with all messages (signed)" bob <## "use /d #team to delete the group" - cath <## "#team: alice removed bob from the group with all messages" + cath <## "#team: alice removed bob from the group with all messages (signed)" doesFileExist "./tests/tmp/alice_app_files/test.jpg" `shouldReturn` False doesFileExist "./tests/tmp/bob_app_files/test.jpg" `shouldReturn` False doesFileExist "./tests/tmp/cath_app_files/test.jpg" `shouldReturn` False -- Under fullDelete, bob's items are physically deleted on all sides; only the system event remains. - alice #$> ("/_get chat #1 count=1", chat, [(1, "removed bob")]) - bob #$> ("/_get chat #1 count=1", chat, [(0, "removed you")]) - cath #$> ("/_get chat #1 count=1", chat, [(0, "removed bob")]) + alice #$> ("/_get chat #1 count=1", chat, [(1, "removed bob (signed)")]) + bob #$> ("/_get chat #1 count=1", chat, [(0, "removed you (signed)")]) + cath #$> ("/_get chat #1 count=1", chat, [(0, "removed bob (signed)")]) testDeleteMemberMarkMessagesDeleted :: HasCallStack => TestParams -> IO () testDeleteMemberMarkMessagesDeleted = @@ -2082,13 +2085,13 @@ testDeleteMemberMarkMessagesDeleted = cath #$> ("/_get chat #1 count=1", chat, [(0, "hello")]) threadDelay 1000000 alice ##> "/rm #team bob messages=on" - alice <## "#team: you removed bob from the group with all messages" - bob <## "#team: alice removed you from the group with all messages" + alice <## "#team: you removed bob from the group with all messages (signed)" + bob <## "#team: alice removed you from the group with all messages (signed)" bob <## "use /d #team to delete the group" - cath <## "#team: alice removed bob from the group with all messages" - alice #$> ("/_get chat #1 count=2", chat, [(0, "hello [marked deleted by you]"), (1, "removed bob")]) - bob #$> ("/_get chat #1 count=2", chat, [(1, "hello [marked deleted by alice]"), (0, "removed you")]) - cath #$> ("/_get chat #1 count=2", chat, [(0, "hello [marked deleted by alice]"), (0, "removed bob")]) + cath <## "#team: alice removed bob from the group with all messages (signed)" + alice #$> ("/_get chat #1 count=2", chat, [(0, "hello [marked deleted by you]"), (1, "removed bob (signed)")]) + bob #$> ("/_get chat #1 count=2", chat, [(1, "hello [marked deleted by alice]"), (0, "removed you (signed)")]) + cath #$> ("/_get chat #1 count=2", chat, [(0, "hello [marked deleted by alice]"), (0, "removed bob (signed)")]) testDeleteMemberMessagesLeftRemoved :: HasCallStack => TestParams -> IO () testDeleteMemberMessagesLeftRemoved = @@ -2115,33 +2118,33 @@ testDeleteMemberMessagesLeftRemoved = [ do cath <## "#team: you left the group" cath <## "use /d #team to delete the group", - alice <## "#team: cath left the group", - bob <## "#team: cath left the group", - dan <## "#team: cath left the group" + alice <## "#team: cath left the group (signed)", + bob <## "#team: cath left the group (signed)", + dan <## "#team: cath left the group (signed)" ] threadDelay 1000000 alice ##> "/rm team dan" concurrentlyN_ - [ alice <## "#team: you removed dan from the group", + [ alice <## "#team: you removed dan from the group (signed)", do - dan <## "#team: alice removed you from the group" + dan <## "#team: alice removed you from the group (signed)" dan <## "use /d #team to delete the group", - bob <## "#team: alice removed dan from the group" + bob <## "#team: alice removed dan from the group (signed)" ] alice ##> "/rm #team cath messages=on" - alice <## "#team: you removed cath from the group with all messages" - bob <## "#team: alice removed cath from the group with all messages" + alice <## "#team: you removed cath from the group with all messages (signed)" + bob <## "#team: alice removed cath from the group with all messages (signed)" alice ##> "/rm #team dan messages=on" - alice <## "#team: you removed dan from the group with all messages" - bob <## "#team: alice removed dan from the group with all messages" + alice <## "#team: you removed dan from the group with all messages (signed)" + bob <## "#team: alice removed dan from the group with all messages (signed)" - alice #$> ("/_get chat #1 count=4", chat, [(0, "1 [marked deleted by you]"), (0, "2 [marked deleted by you]"), (0, "left [marked deleted by you]"), (1, "removed dan")]) - bob #$> ("/_get chat #1 count=4", chat, [(0, "1 [marked deleted by alice]"), (0, "2 [marked deleted by alice]"), (0, "left [marked deleted by alice]"), (0, "removed dan")]) - cath #$> ("/_get chat #1 count=3", chat, [(1, "1"), (0, "2"), (1, "left")]) - dan #$> ("/_get chat #1 count=4", chat, [(0, "1"), (1, "2"), (0, "left"), (0, "removed you")]) + alice #$> ("/_get chat #1 count=4", chat, [(0, "1 [marked deleted by you]"), (0, "2 [marked deleted by you]"), (0, "left (signed) [marked deleted by you]"), (1, "removed dan (signed)")]) + bob #$> ("/_get chat #1 count=4", chat, [(0, "1 [marked deleted by alice]"), (0, "2 [marked deleted by alice]"), (0, "left (signed) [marked deleted by alice]"), (0, "removed dan (signed)")]) + cath #$> ("/_get chat #1 count=3", chat, [(1, "1"), (0, "2"), (1, "left (signed)")]) + dan #$> ("/_get chat #1 count=4", chat, [(0, "1"), (1, "2"), (0, "left (signed)"), (0, "removed you (signed)")]) testSendMulti :: HasCallStack => TestParams -> IO () testSendMulti = @@ -2166,10 +2169,10 @@ testSendMultiTimed = alice ##> "/set disappear #team on 1" alice <## "updated group preferences:" alice <## "Disappearing messages: on (1 sec)" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Disappearing messages: on (1 sec)" - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "updated group preferences:" cath <## "Disappearing messages: on (1 sec)" @@ -2322,6 +2325,269 @@ testSharedBatchBody ps = } } +testGroupSharedBatchBodyMixedModes :: HasCallStack => TestParams -> IO () +testGroupSharedBatchBodyMixedModes ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do + withNewTestChatCfg ps oldCfg "dan" danProfile $ \dan -> + withNewTestChatCfg ps oldCfg "eve" eveProfile $ \eve -> do + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob (Bob): accepting request to join group #team..." + concurrentlyN_ + [ alice <## "#team: bob joined the group", + do + bob <## "#team: joining the group..." + bob <## "#team: you joined the group" + ] + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + concurrentlyN_ + [ do + alice <## "cath (Catherine): accepting request to join group #team..." + alice <## "#team: cath joined the group", + cath + <### [ "#team: joining the group...", + "#team: you joined the group", + "#team: member bob (Bob) is connected" + ], + bob + <### [ "#team: alice added cath (Catherine) to the group (connecting...)", + "#team: new member cath is connected" + ] + ] + dan ##> ("/c " <> gLink) + dan <## "connection request sent!" + concurrentlyN_ + [ do + alice <## "dan (Daniel): accepting request to join group #team..." + alice <## "#team: dan joined the group", + dan + <### [ "#team: joining the group...", + "#team: you joined the group", + "#team: member bob (Bob) is connected", + "#team: member cath (Catherine) is connected" + ], + bob + <### [ "#team: alice added dan (Daniel) to the group (connecting...)", + "#team: new member dan is connected" + ], + cath + <### [ "#team: alice added dan (Daniel) to the group (connecting...)", + "#team: new member dan is connected" + ] + ] + eve ##> ("/c " <> gLink) + eve <## "connection request sent!" + concurrentlyN_ + [ do + alice <## "eve (Eve): accepting request to join group #team..." + alice <## "#team: eve joined the group", + eve + <### [ "#team: joining the group...", + "#team: you joined the group", + "#team: member bob (Bob) is connected", + "#team: member cath (Catherine) is connected", + "#team: member dan (Daniel) is connected" + ], + bob + <### [ "#team: alice added eve (Eve) to the group (connecting...)", + "#team: new member eve is connected" + ], + cath + <### [ "#team: alice added eve (Eve) to the group (connecting...)", + "#team: new member eve is connected" + ], + dan + <### [ "#team: alice added eve (Eve) to the group (connecting...)", + "#team: new member eve is connected" + ] + ] + cath ##> "/p kate" + cath <## "user profile is changed to kate (your 0 contacts are notified)" + cath #> "#team hi" + alice <# "#team kate> hi" + bob <# "#team kate> hi" + dan <# "#team kate> hi" + eve <# "#team kate> hi" + alice ##> "/_get chat #1 count=100" + ra <- chat <$> getTermLine alice + ra `shouldContain` [(0, "updated profile (signed)")] + bob ##> "/_get chat #1 count=100" + rb <- chat <$> getTermLine bob + rb `shouldContain` [(0, "updated profile (signed)")] + dan ##> "/_get chat #1 count=100" + rd <- chat <$> getTermLine dan + rd `shouldContain` [(0, "updated profile")] + eve ##> "/_get chat #1 count=100" + re <- chat <$> getTermLine eve + re `shouldContain` [(0, "updated profile")] + dan #> "#team hello from dan" + [alice, bob, cath, eve] *<# "#team dan> hello from dan" + alice ##> "/mr team dan admin" + concurrentlyN_ + [ alice <## "#team: you changed the role of dan to admin (signed)", + dan <## "#team: alice changed your role from member to admin", + bob <## "#team: alice changed the role of dan from member to admin (signed)", + cath <## "#team: alice changed the role of dan from member to admin (signed)", + eve <## "#team: alice changed the role of dan from member to admin" + ] + withTestChat ps "dan" $ \dan -> + withTestChat ps "eve" $ \eve -> do + dan <## "subscribed 4 connections on server localhost" + eve <## "subscribed 4 connections on server localhost" + dan #> "#team d1" + [alice, bob, cath, eve] *<# "#team dan> d1" + dan #> "#team d2" + [alice, bob, cath, eve] *<# "#team dan> d2" + eve #> "#team e1" + [alice, bob, cath, dan] *<# "#team eve> e1" + eve #> "#team e2" + [alice, bob, cath, dan] *<# "#team eve> e2" + dan ##> "/p dan2" + dan <## "user profile is changed to dan2 (your 0 contacts are notified)" + dan #> "#team d3" + [alice, bob, cath, eve] *<# "#team dan2> d3" + eve ##> "/_get chat #1 count=100" + re2 <- chat <$> getTermLine eve + re2 `shouldContain` [(0, "updated profile (signed)")] + where + oldCfg = testCfg {chatVRange = mkVersionRange (VersionChat 9) (VersionChat 17)} + +testSharedBatchBodyMixed :: HasCallStack => TestParams -> IO () +testSharedBatchBodyMixed ps = + withNewTestChatOpts ps opts' "alice" aliceProfile $ \alice -> do + withSmpServer' serverCfg' $ + withNewTestChatOpts ps opts' "bob" bobProfile $ \bob -> + withNewTestChatOpts ps opts' "cath" cathProfile $ \cath -> + withNewTestChatCfgOpts ps oldCfg opts' "dan" danProfile $ \dan -> + withNewTestChatCfgOpts ps oldCfg opts' "eve" eveProfile $ \eve -> do + createGroup4 "team" alice (bob, GRMember) (cath, GRMember) (dan, GRMember) + connectUsers alice eve + addMember "team" alice eve GRMember + eve ##> "/j team" + concurrentlyN_ + [ alice <## "#team: eve joined the group", + do + eve <## "#team: you joined the group" + eve + <### [ "#team: member bob (Bob) is connected", + "#team: member cath (Catherine) is connected", + "#team: member dan (Daniel) is connected" + ], + do + bob <## "#team: alice added eve (Eve) to the group (connecting...)" + bob <## "#team: new member eve is connected", + do + cath <## "#team: alice added eve (Eve) to the group (connecting...)" + cath <## "#team: new member eve is connected", + do + dan <## "#team: alice added eve (Eve) to the group (connecting...)" + dan <## "#team: new member eve is connected" + ] + alice <##. "disconnected " + let cm i = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message " <> show i <> "\"}}" + cms = intercalate ", " (map cm [1 .. 300 :: Int]) + alice `send` ("/_send #1 json [" <> cms <> "]") + _ <- getTermLine alice + alice <## "300 messages sent" + checkMsgBodyCount alice 6 + withSmpServer' serverCfg' $ + withTestChatOpts ps opts' "bob" $ \bob -> + withTestChatOpts ps opts' "cath" $ \cath -> + withTestChatCfgOpts ps oldCfg opts' "dan" $ \dan -> + withTestChatCfgOpts ps oldCfg opts' "eve" $ \eve -> do + concurrentlyN_ + [ alice <##. "subscribed ", + bob <##. "subscribed ", + cath <##. "subscribed ", + dan <##. "subscribed ", + eve <##. "subscribed " + ] + forM_ [(1 :: Int) .. 300] $ \i -> + [bob, cath, dan, eve] *<# ("#team alice> message " <> show i) + checkMsgBodyCount alice 0 + alice <##. "disconnected " + where + oldCfg = testCfg {chatVRange = mkVersionRange (VersionChat 9) (VersionChat 17)} + tmp = tmpPath ps + serverCfg' = + smpServerCfg + { transports = [("7003", transport @TLS, False)], + serverStoreCfg = persistentServerStoreCfg tmp + } + opts' = + testOpts + { coreOptions = + testCoreOpts + { smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7003"] + } + } + +testGroupAllOldThenUpgrade :: HasCallStack => TestParams -> IO () +testGroupAllOldThenUpgrade ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> do + withNewTestChatCfg ps oldCfg "bob" bobProfile $ \bob -> + withNewTestChatCfg ps oldCfg "cath" cathProfile $ \cath -> do + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob (Bob): accepting request to join group #team..." + concurrentlyN_ + [ alice <## "#team: bob joined the group", + do + bob <## "#team: joining the group..." + bob <## "#team: you joined the group" + ] + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + concurrentlyN_ + [ do + alice <## "cath (Catherine): accepting request to join group #team..." + alice <## "#team: cath joined the group", + cath + <### [ "#team: joining the group...", + "#team: you joined the group", + "#team: member bob (Bob) is connected" + ], + bob + <### [ "#team: alice added cath (Catherine) to the group (connecting...)", + "#team: new member cath is connected" + ] + ] + alice #> "#team hi1" + [bob, cath] *<# "#team alice> hi1" + withTestChat ps "bob" $ \bob -> + withTestChat ps "cath" $ \cath -> do + bob <##. "subscribed " + cath <##. "subscribed " + bob #> "#team b1" + [alice, cath] *<# "#team bob> b1" + cath #> "#team c1" + [alice, bob] *<# "#team cath> c1" + alice ##> "/p alisa" + alice <## "user profile is changed to alisa (your 0 contacts are notified)" + alice #> "#team hi2" + [bob, cath] *<# "#team alisa> hi2" + bob ##> "/_get chat #1 count=100" + rb <- chat <$> getTermLine bob + rb `shouldContain` [(0, "updated profile (signed)")] + cath ##> "/_get chat #1 count=100" + rc <- chat <$> getTermLine cath + rc `shouldContain` [(0, "updated profile (signed)")] + where + oldCfg = testCfg {chatVRange = mkVersionRange (VersionChat 9) (VersionChat 17)} + testGroupAsync :: HasCallStack => TestParams -> IO () testGroupAsync ps = do withNewTestChat ps "alice" aliceProfile $ \alice -> do @@ -2472,10 +2738,10 @@ testGroupLinkDeleteGroupRejoin = [ do bob <## "#team: you left the group" bob <## "use /d #team to delete the group", - alice <## "#team: bob left the group" + alice <## "#team: bob left the group (signed)" ] bob ##> "/d #team" - bob <## "#team: you deleted the group" + bob <## "#team: you deleted your local copy of the group" -- re-join via same link bob ##> ("/c " <> gLink) bob <## "connection request sent!" @@ -2666,7 +2932,7 @@ testPlanGroupLinkLeaveRejoin = [ do bob <## "#team: you left the group" bob <## "use /d #team to delete the group", - alice <## "#team: bob left the group" + alice <## "#team: bob left the group (signed)" ] threadDelay 100000 @@ -2795,8 +3061,8 @@ testGroupLink = [ do alice <## "#team: you left the group" alice <## "use /d #team to delete the group", - bob <## "#team: alice left the group", - cath <## "#team: alice left the group" + bob <## "#team: alice left the group (signed)", + cath <## "#team: alice left the group (signed)" ] alice ##> "/show link #team" alice <## "no group link, to create: /create link #team" @@ -2805,7 +3071,7 @@ testGroupLink = alice ##> "/contacts" alice <## "cath (Catherine)" alice ##> "/d #team" - alice <## "#team: you deleted the group" + alice <## "#team: you deleted your local copy of the group" alice ##> "/contacts" alice <## "cath (Catherine)" @@ -3010,8 +3276,8 @@ testGroupLinkMemberRole = bob <## "#team: you don't have permission to send messages" alice ##> "/mr #team bob member" - alice <## "#team: you changed the role of bob to member" - bob <## "#team: alice changed your role from observer to member" + alice <## "#team: you changed the role of bob to member (signed)" + bob <## "#team: alice changed your role from observer to member (signed)" bob #> "#team hey now" alice <# "#team bob> hey now" @@ -3040,18 +3306,18 @@ testGroupLinkMemberRole = cath <## "#team: you don't have permission to send messages" alice ##> "/mr #team cath admin" - alice <## "#team: you changed the role of cath to admin" - cath <## "#team: alice changed your role from observer to admin" - bob <## "#team: alice changed the role of cath from observer to admin" + alice <## "#team: you changed the role of cath to admin (signed)" + cath <## "#team: alice changed your role from observer to admin (signed)" + bob <## "#team: alice changed the role of cath from observer to admin (signed)" cath #> "#team hey" alice <# "#team cath> hey" bob <# "#team cath> hey" cath ##> "/mr #team bob admin" - cath <## "#team: you changed the role of bob to admin" - bob <## "#team: cath changed your role from member to admin" - alice <## "#team: cath changed the role of bob from member to admin" + cath <## "#team: you changed the role of bob to admin (signed)" + bob <## "#team: cath changed your role from member to admin (signed)" + alice <## "#team: cath changed the role of bob from member to admin (signed)" testGroupLinkDemotedAdmin :: HasCallStack => TestParams -> IO () testGroupLinkDemotedAdmin = @@ -3064,8 +3330,8 @@ testGroupLinkDemotedAdmin = alice ##> "/mr #team bob member" concurrentlyN_ - [ alice <## "#team: you changed the role of bob to member", - bob <## "#team: alice changed your role from admin to member" + [ alice <## "#team: you changed the role of bob to member (signed)", + bob <## "#team: alice changed your role from admin to member (signed)" ] -- demotion does not remove bob's group link (it is preserved, usable again on re-promotion) @@ -3162,7 +3428,7 @@ testGroupLinkHostProfileReceived = bob <## "#team: you joined the group" ] - threadDelay 100000 + threadDelay 250000 aliceImage <- getProfilePictureByName bob "alice" aliceImage `shouldBe` Just profileImage @@ -3317,13 +3583,13 @@ testGLinkReviewMember = alice <## "changed member admission rules" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "changed member admission rules", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "changed member admission rules", do - dan <## "alice updated group #team:" + dan <## "alice updated group #team: (signed)" dan <## "changed member admission rules" ] @@ -3444,13 +3710,13 @@ testGLinkApproveThenReviewMember = alice <## "changed member admission rules" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "changed member admission rules", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "changed member admission rules", do - dan <## "alice updated group #team:" + dan <## "alice updated group #team: (signed)" dan <## "changed member admission rules" ] @@ -3615,8 +3881,8 @@ testGLinkDeletePendingApprovalMember = ] alice ##> "/rm team cath" - alice <## "#team: you removed cath from the group" - cath <## "#team: alice removed you from the group" + alice <## "#team: you removed cath from the group (signed)" + cath <## "#team: alice removed you from the group (signed)" cath <## "use /d #team to delete the group" where cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPendingApproval, GRObserver))}} @@ -3651,23 +3917,23 @@ testGLinkReviewIntroduce = alice ##> "/mr team dan admin" concurrentlyN_ - [ alice <## "#team: you changed the role of dan to admin", - bob <## "#team: alice changed the role of dan from member to admin", - cath <## "#team: alice changed the role of dan from member to admin", - dan <## "#team: alice changed your role from member to admin" + [ alice <## "#team: you changed the role of dan to admin (signed)", + bob <## "#team: alice changed the role of dan from member to admin (signed)", + cath <## "#team: alice changed the role of dan from member to admin (signed)", + dan <## "#team: alice changed your role from member to admin (signed)" ] alice ##> "/set admission review #team all" alice <## "changed member admission rules" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "changed member admission rules", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "changed member admission rules", do - dan <## "alice updated group #team:" + dan <## "alice updated group #team: (signed)" dan <## "changed member admission rules" ] @@ -4918,12 +5184,12 @@ testMemberContactAccept = -- if group is deleted, bob and cath keep contact with each other alice ##> "/d #team" concurrentlyN_ - [ alice <## "#team: you deleted the group", + [ alice <## "#team: you deleted the group (signed)", do - bob <## "#team: alice deleted the group" + bob <## "#team: alice deleted the group (signed)" bob <## "use /d #team to delete the local copy of the group", do - cath <## "#team: alice deleted the group" + cath <## "#team: alice deleted the group (signed)" cath <## "use /d #team to delete the local copy of the group" ] @@ -5018,12 +5284,12 @@ testMemberContactAcceptIncognito = -- if group is deleted, bob and cath keep contact with each other alice ##> "/d #team" concurrentlyN_ - [ alice <## "#team: you deleted the group", + [ alice <## "#team: you deleted the group (signed)", do - bob <## "#team: alice deleted the group" + bob <## "#team: alice deleted the group (signed)" bob <## "use /d #team to delete the local copy of the group", do - cath <## "#team: alice deleted the group" + cath <## "#team: alice deleted the group (signed)" cath <## "use /d #team to delete the local copy of the group" ] @@ -5129,16 +5395,16 @@ testGroupMsgForwardReport = alice ##> "/mr team bob moderator" concurrentlyN_ - [ alice <## "#team: you changed the role of bob to moderator", - bob <## "#team: alice changed your role from admin to moderator", - cath <## "#team: alice changed the role of bob from admin to moderator" + [ alice <## "#team: you changed the role of bob to moderator (signed)", + bob <## "#team: alice changed your role from admin to moderator (signed)", + cath <## "#team: alice changed the role of bob from admin to moderator (signed)" ] alice ##> "/mr team cath member" concurrentlyN_ - [ alice <## "#team: you changed the role of cath to member", - bob <## "#team: alice changed the role of cath from admin to member", - cath <## "#team: alice changed your role from admin to member" + [ alice <## "#team: you changed the role of cath to member (signed)", + bob <## "#team: alice changed the role of cath from admin to member (signed)", + cath <## "#team: alice changed your role from admin to member (signed)" ] cath ##> "/report #team content hi there" cath <# "#team (support) > bob hi there" @@ -5154,9 +5420,9 @@ testGroupMsgForwardReport = alice ##> "/mr team bob member" concurrentlyN_ - [ alice <## "#team: you changed the role of bob to member", - bob <## "#team: alice changed your role from moderator to member", - cath <## "#team: alice changed the role of bob from moderator to member" + [ alice <## "#team: you changed the role of bob to member (signed)", + bob <## "#team: alice changed your role from moderator to member (signed)", + cath <## "#team: alice changed the role of bob from moderator to member (signed)" ] cath ##> "/report #team content hi there" @@ -5373,9 +5639,9 @@ testGroupMsgForwardChangeRole = setupGroupForwarding alice bob cath cath ##> "/mr #team bob member" - cath <## "#team: you changed the role of bob to member" - alice <## "#team: cath changed the role of bob from admin to member" - bob <## "#team: cath changed your role from admin to member" -- TODO show as forwarded + cath <## "#team: you changed the role of bob to member (signed)" + alice <## "#team: cath changed the role of bob from admin to member (signed)" + bob <## "#team: cath changed your role from admin to member (signed)" -- TODO show as forwarded testGroupMsgForwardNewMember :: HasCallStack => TestParams -> IO () testGroupMsgForwardNewMember = @@ -5429,8 +5695,8 @@ testGroupMsgForwardLeave = bob ##> "/leave #team" bob <## "#team: you left the group" bob <## "use /d #team to delete the group" - alice <## "#team: bob left the group" - cath <## "#team: bob left the group" + alice <## "#team: bob left the group (signed)" + cath <## "#team: bob left the group (signed)" testGroupMsgForwardMemberRemoval :: HasCallStack => TestParams -> IO () testGroupMsgForwardMemberRemoval = @@ -5442,10 +5708,10 @@ testGroupMsgForwardMemberRemoval = -- remove member bob ##> "/rm team cath" concurrentlyN_ - [ bob <## "#team: you removed cath from the group", - alice <## "#team: bob removed cath from the group", + [ bob <## "#team: you removed cath from the group (signed)", + alice <## "#team: bob removed cath from the group (signed)", do - cath <## "#team: bob removed you from the group" + cath <## "#team: bob removed you from the group (signed)" cath <## "use /d #team to delete the group" ] bob #> "#team hi" @@ -5478,11 +5744,11 @@ testGroupMsgForwardAdminRemoval = -- if alice is removed, she forwards message of her own removal bob ##> "/rm team alice" concurrentlyN_ - [ bob <## "#team: you removed alice from the group", + [ bob <## "#team: you removed alice from the group (signed)", do - alice <## "#team: bob removed you from the group" + alice <## "#team: bob removed you from the group (signed)" alice <## "use /d #team to delete the group", - cath <## "#team: bob removed alice from the group" + cath <## "#team: bob removed alice from the group (signed)" ] -- there is no forwarding admin anymore between bob and cath, so messages don't get delivered @@ -5517,12 +5783,12 @@ testGroupMsgForwardGroupDeletion = -- if bob deletes the group, alice forwards it to cath bob ##> "/d #team" concurrentlyN_ - [ bob <## "#team: you deleted the group", + [ bob <## "#team: you deleted the group (signed)", do - alice <## "#team: bob deleted the group" + alice <## "#team: bob deleted the group (signed)" alice <## "use /d #team to delete the local copy of the group", do - cath <## "#team: bob deleted the group" + cath <## "#team: bob deleted the group (signed)" cath <## "use /d #team to delete the local copy of the group" ] @@ -5667,11 +5933,11 @@ testGroupHistoryPreferenceOff = alice <## "Recent history: off" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Recent history: off", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "updated group preferences:" cath <## "Recent history: off" ] @@ -6203,7 +6469,7 @@ testGroupHistoryDisappearingMessage = alice ##> "/set disappear #team on 4" alice <## "updated group preferences:" alice <## "Disappearing messages: on (4 sec)" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Disappearing messages: on (4 sec)" @@ -6220,7 +6486,7 @@ testGroupHistoryDisappearingMessage = alice ##> "/set disappear #team off" alice <## "updated group preferences:" alice <## "Disappearing messages: off" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Disappearing messages: off" @@ -6280,7 +6546,7 @@ testGroupHistoryWelcomeMessage = alice <## "welcome message changed to:" alice <## "welcome to team" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "welcome message changed to:" bob <## "welcome to team" @@ -6353,8 +6619,8 @@ testGroupHistoryUnknownMember = [ do bob <## "#team: you left the group" bob <## "use /d #team to delete the group", - alice <## "#team: bob left the group", - cath <## "#team: bob left the group" + alice <## "#team: bob left the group (signed)", + cath <## "#team: bob left the group (signed)" ] connectUsers alice dan @@ -6467,7 +6733,7 @@ testMembershipProfileUpdateNextGroupMessage = bob ##> "/_get chat #1 count=100" rb <- chat <$> getTermLine bob - rb `shouldContain` [(0, "updated profile")] + rb `shouldContain` [(0, "updated profile (signed)")] -- update profile in group 2 @@ -6491,7 +6757,7 @@ testMembershipProfileUpdateNextGroupMessage = cath ##> "/_get chat #1 count=100" rc <- chat <$> getTermLine cath - rc `shouldContain` [(0, "updated profile")] + rc `shouldContain` [(0, "updated profile (signed)")] testMembershipProfileUpdateSameMember :: HasCallStack => TestParams -> IO () testMembershipProfileUpdateSameMember = @@ -6545,7 +6811,7 @@ testMembershipProfileUpdateSameMember = bob ##> "/_get chat #1 count=100" rTeam <- chat <$> getTermLine bob - rTeam `shouldContain` [(0, "updated profile")] + rTeam `shouldContain` [(0, "updated profile (signed)")] bob ##> "/_get chat #2 count=100" rClub <- chat <$> getTermLine bob @@ -6691,7 +6957,7 @@ testMembershipProfileUpdateContactDeleted = bob ##> "/_get chat #1 count=100" rGrp <- chat <$> getTermLine bob - rGrp `shouldContain` [(0, "updated profile")] + rGrp `shouldContain` [(0, "updated profile (signed)")] checkAliceNoProfileLink bob name = do bob ##> ("/info #team " <> name) bob <## "group ID: 1" @@ -6754,7 +7020,7 @@ testMembershipProfileUpdateContactDisabled = bob ##> "/_get chat #1 count=100" rGrp <- chat <$> getTermLine bob - rGrp `shouldContain` [(0, "updated profile")] + rGrp `shouldContain` [(0, "updated profile (signed)")] testMembershipProfileUpdateNoChangeIgnored :: HasCallStack => TestParams -> IO () testMembershipProfileUpdateNoChangeIgnored = @@ -6852,8 +7118,8 @@ testBlockForAllMarkedBlocked = threadDelay 1000000 alice ##> "/block for all #team bob" - alice <## "#team: you blocked bob" - cath <## "#team: alice blocked bob" + alice <## "#team: you blocked bob (signed)" + cath <## "#team: alice blocked bob (signed)" bob "/ms team" @@ -6892,8 +7158,8 @@ testBlockForAllMarkedBlocked = threadDelay 1000000 alice ##> "/unblock for all #team bob" - alice <## "#team: you unblocked bob" - cath <## "#team: alice unblocked bob" + alice <## "#team: you unblocked bob (signed)" + cath <## "#team: alice unblocked bob (signed)" bob ( "/_get chat #1 count=6", chat, [ (0, "1"), - (1, "blocked bob"), + (1, "blocked bob (signed)"), (0, "2 [blocked by admin]"), (0, "3 [blocked by admin]"), - (1, "unblocked bob"), + (1, "unblocked bob (signed)"), (0, "4") ] ) @@ -6916,10 +7182,10 @@ testBlockForAllMarkedBlocked = #$> ( "/_get chat #1 count=6", chat, [ (0, "1"), - (0, "blocked bob"), + (0, "blocked bob (signed)"), (0, "2 [blocked by admin]"), (0, "3 [blocked by admin]"), - (0, "unblocked bob"), + (0, "unblocked bob (signed)"), (0, "4") ] ) @@ -6941,8 +7207,8 @@ testBlockForAllMentionsIgnored = threadDelay 1000000 alice ##> "/block for all #team bob" - alice <## "#team: you blocked bob" - cath <## "#team: alice blocked bob" + alice <## "#team: you blocked bob (signed)" + cath <## "#team: alice blocked bob (signed)" bob "/block for all #team bob" - alice <## "#team: you blocked bob" - cath <## "#team: alice blocked bob" + alice <## "#team: you blocked bob (signed)" + cath <## "#team: alice blocked bob (signed)" bob "/unblock for all #team bob" - alice <## "#team: you unblocked bob" - cath <## "#team: alice unblocked bob" + alice <## "#team: you unblocked bob (signed)" + cath <## "#team: alice unblocked bob (signed)" bob ( "/_get chat #1 count=6", chat, [ (0, "1"), - (1, "blocked bob"), + (1, "blocked bob (signed)"), (0, "blocked [blocked by admin]"), (0, "blocked [blocked by admin]"), - (1, "unblocked bob"), + (1, "unblocked bob (signed)"), (0, "4") ] ) @@ -7064,10 +7330,10 @@ testBlockForAllFullDelete = #$> ( "/_get chat #1 count=6", chat, [ (0, "1"), - (0, "blocked bob"), + (0, "blocked bob (signed)"), (0, "blocked [blocked by admin]"), (0, "blocked [blocked by admin]"), - (0, "unblocked bob"), + (0, "unblocked bob (signed)"), (0, "4") ] ) @@ -7084,8 +7350,8 @@ testBlockForAllAnotherAdminUnblocks = [alice, cath] *<# "#team bob> 1" alice ##> "/block for all #team bob" - alice <## "#team: you blocked bob" - cath <## "#team: alice blocked bob" + alice <## "#team: you blocked bob (signed)" + cath <## "#team: alice blocked bob (signed)" bob "#team 2" @@ -7093,8 +7359,8 @@ testBlockForAllAnotherAdminUnblocks = cath <# "#team bob> 2 [blocked by admin] " cath ##> "/unblock for all #team bob" - cath <## "#team: you unblocked bob" - alice <## "#team: cath unblocked bob" + cath <## "#team: you unblocked bob (signed)" + alice <## "#team: cath unblocked bob (signed)" bob "#team 3" @@ -7113,8 +7379,8 @@ testBlockForAllBeforeJoining = [alice, cath] *<# "#team bob> 1" alice ##> "/block for all #team bob" - alice <## "#team: you blocked bob" - cath <## "#team: alice blocked bob" + alice <## "#team: you blocked bob (signed)" + cath <## "#team: alice blocked bob (signed)" bob "#team 2" @@ -7148,9 +7414,9 @@ testBlockForAllBeforeJoining = threadDelay 1000000 alice ##> "/unblock for all #team bob" - alice <## "#team: you unblocked bob" - cath <## "#team: alice unblocked bob" - dan <## "#team: alice unblocked bob" + alice <## "#team: you unblocked bob (signed)" + cath <## "#team: alice unblocked bob (signed)" + dan <## "#team: alice unblocked bob (signed)" bob "/_get chat #1 count=100" r <- chat <$> getTermLine dan - r `shouldContain` [(0, "3 [blocked by admin]"), (0, "4 [blocked by admin]"), (0, "unblocked bob"), (0, "5")] + r `shouldContain` [(0, "3 [blocked by admin]"), (0, "4 [blocked by admin]"), (0, "unblocked bob (signed)"), (0, "5")] r `shouldNotContain` [(0, "1")] r `shouldNotContain` [(0, "1 [blocked by admin]")] r `shouldNotContain` [(0, "2")] @@ -7182,30 +7448,30 @@ testBlockForAllRepeat = [alice, cath] *<# "#team bob> 1" alice ##> "/block for all #team bob" - alice <## "#team: you blocked bob" - cath <## "#team: alice blocked bob" + alice <## "#team: you blocked bob (signed)" + cath <## "#team: alice blocked bob (signed)" bob "/block for all #team bob" - alice <## "#team: you blocked bob" + alice <## "#team: you blocked bob (signed)" cath ##> "/block for all #team bob" - cath <## "#team: you blocked bob" + cath <## "#team: you blocked bob (signed)" bob #> "#team 2" alice <# "#team bob> 2 [blocked by admin] " cath <# "#team bob> 2 [blocked by admin] " cath ##> "/unblock for all #team bob" - cath <## "#team: you unblocked bob" - alice <## "#team: cath unblocked bob" + cath <## "#team: you unblocked bob (signed)" + alice <## "#team: cath unblocked bob (signed)" bob "/unblock for all #team bob" - alice <## "#team: you unblocked bob" + alice <## "#team: you unblocked bob (signed)" cath ##> "/unblock for all #team bob" - cath <## "#team: you unblocked bob" + cath <## "#team: you unblocked bob (signed)" bob #> "#team 3" [alice, cath] *<# "#team bob> 3" @@ -7240,17 +7506,17 @@ testBlockForAllMultipleMembers = -- lower roles to for batch block to be allowed (can't batch block if admins are selected) alice ##> "/mr team bob member" concurrentlyN_ - [ alice <## "#team: you changed the role of bob to member", - bob <## "#team: alice changed your role from admin to member", - cath <## "#team: alice changed the role of bob from admin to member", - dan <## "#team: alice changed the role of bob from admin to member" + [ alice <## "#team: you changed the role of bob to member (signed)", + bob <## "#team: alice changed your role from admin to member (signed)", + cath <## "#team: alice changed the role of bob from admin to member (signed)", + dan <## "#team: alice changed the role of bob from admin to member (signed)" ] alice ##> "/mr team cath member" concurrentlyN_ - [ alice <## "#team: you changed the role of cath to member", - bob <## "#team: alice changed the role of cath from admin to member", - cath <## "#team: alice changed your role from admin to member", - dan <## "#team: alice changed the role of cath from admin to member" + [ alice <## "#team: you changed the role of cath to member (signed)", + bob <## "#team: alice changed the role of cath from admin to member (signed)", + cath <## "#team: alice changed your role from admin to member (signed)", + dan <## "#team: alice changed the role of cath from admin to member (signed)" ] bob #> "#team 1" @@ -7260,9 +7526,9 @@ testBlockForAllMultipleMembers = [alice, bob, dan] *<# "#team cath> 2" alice ##> "/_block #1 2,3 blocked=on" - alice <## "#team: you blocked 2 members" - dan <## "#team: alice blocked bob" - dan <## "#team: alice blocked cath" + alice <## "#team: you blocked 2 members (signed)" + dan <## "#team: alice blocked bob (signed)" + dan <## "#team: alice blocked cath (signed)" bob 4" alice ##> "/_block #1 2,3 blocked=off" - alice <## "#team: you unblocked 2 members" - dan <## "#team: alice unblocked bob" - dan <## "#team: alice unblocked cath" + alice <## "#team: you unblocked 2 members (signed)" + dan <## "#team: alice unblocked bob (signed)" + dan <## "#team: alice unblocked cath (signed)" bob "/rm team dan" concurrentlyN_ - [ alice <## "#team: you removed dan from the group", + [ alice <## "#team: you removed dan from the group (signed)", do - dan <## "#team: alice removed you from the group" + dan <## "#team: alice removed you from the group (signed)" dan <## "use /d #team to delete the group", - bob <## "#team: alice removed dan from the group" + bob <## "#team: alice removed dan from the group (signed)" ] alice ##> "/block for all #team cath" - alice <## "#team: you blocked cath" - bob <## "#team: alice blocked cath" + alice <## "#team: you blocked cath (signed)" + bob <## "#team: alice blocked cath (signed)" alice ##> "/block for all #team dan" - alice <## "#team: you blocked dan" - bob <## "#team: alice blocked dan" + alice <## "#team: you blocked dan (signed)" + bob <## "#team: alice blocked dan (signed)" testGroupMemberInactive :: HasCallStack => TestParams -> IO () testGroupMemberInactive ps = do @@ -7398,15 +7664,15 @@ testGroupMemberReports = -- disableFullDeletion3 "jokes" alice bob cath alice ##> "/mr jokes bob moderator" concurrentlyN_ - [ alice <## "#jokes: you changed the role of bob to moderator", - bob <## "#jokes: alice changed your role from admin to moderator", - cath <## "#jokes: alice changed the role of bob from admin to moderator" + [ alice <## "#jokes: you changed the role of bob to moderator (signed)", + bob <## "#jokes: alice changed your role from admin to moderator (signed)", + cath <## "#jokes: alice changed the role of bob from admin to moderator (signed)" ] alice ##> "/mr jokes cath member" concurrentlyN_ - [ alice <## "#jokes: you changed the role of cath to member", - bob <## "#jokes: alice changed the role of cath from admin to member", - cath <## "#jokes: alice changed your role from admin to member" + [ alice <## "#jokes: you changed the role of cath to member (signed)", + bob <## "#jokes: alice changed the role of cath from admin to member (signed)", + cath <## "#jokes: alice changed your role from admin to member (signed)" ] alice ##> "/create link #jokes" gLink <- getGroupLink alice "jokes" GRMember True @@ -7843,13 +8109,13 @@ testScopedSupportForwardWhileReview = alice <## "changed member admission rules" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "changed member admission rules", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "changed member admission rules", do - dan <## "alice updated group #team:" + dan <## "alice updated group #team: (signed)" dan <## "changed member admission rules" ] @@ -7926,13 +8192,13 @@ testScopedSupportForwardAll = alice <## "changed member admission rules" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "changed member admission rules", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "changed member admission rules", do - dan <## "alice updated group #team:" + dan <## "alice updated group #team: (signed)" dan <## "changed member admission rules" ] @@ -7980,16 +8246,16 @@ testScopedSupportForwardAll = dan <## "changed to #my_team" concurrentlyN_ [ do - alice <## "dan updated group #team:" + alice <## "dan updated group #team: (signed)" alice <## "changed to #my_team", do - bob <## "dan updated group #team:" + bob <## "dan updated group #team: (signed)" bob <## "changed to #my_team", do - cath <## "dan updated group #team:" + cath <## "dan updated group #team: (signed)" cath <## "changed to #my_team", do - eve <## "dan updated group #team:" + eve <## "dan updated group #team: (signed)" eve <## "changed to #my_team" ] @@ -8063,11 +8329,11 @@ testScopedSupportForwardMemberRemoval = -- bob removes eve, eve and dan receive member removal message bob ##> "/_remove #1 5" concurrentlyN_ - [ bob <## "#team: you removed eve from the group", - alice <## "#team: bob removed eve from the group", - dan <## "#team: bob removed eve from the group", + [ bob <## "#team: you removed eve from the group (signed)", + alice <## "#team: bob removed eve from the group (signed)", + dan <## "#team: bob removed eve from the group (signed)", do - eve <## "#team: bob removed you from the group" + eve <## "#team: bob removed you from the group (signed)" eve <## "use /d #team to delete the group" ] @@ -8086,13 +8352,13 @@ setupReviewForward alice bob cath dan eve = do alice <## "changed member admission rules" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "changed member admission rules", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "changed member admission rules", do - dan <## "alice updated group #team:" + dan <## "alice updated group #team: (signed)" dan <## "changed member admission rules" ] @@ -8146,13 +8412,13 @@ testScopedSupportForwardAdminRemoval = -- bob removes eve, eve and dan receive member removal message bob ##> "/rm team alice" concurrentlyN_ - [ bob <## "#team: you removed alice from the group", + [ bob <## "#team: you removed alice from the group (signed)", do - alice <## "#team: bob removed you from the group" + alice <## "#team: bob removed you from the group (signed)" alice <## "use /d #team to delete the group", - cath <## "#team: bob removed alice from the group", - dan <## "#team: bob removed alice from the group", - eve <## "#team: bob removed alice from the group" + cath <## "#team: bob removed alice from the group (signed)", + dan <## "#team: bob removed alice from the group (signed)", + eve <## "#team: bob removed alice from the group (signed)" ] -- there is no forwarding admin anymore between bob and cath, @@ -8193,9 +8459,9 @@ testScopedSupportForwardLeave = eve ##> "/leave #team" eve <## "#team: you left the group" eve <## "use /d #team to delete the group" - alice <## "#team: eve left the group" - bob <## "#team: eve left the group" - dan <## "#team: eve left the group" + alice <## "#team: eve left the group (signed)" + bob <## "#team: eve left the group (signed)" + dan <## "#team: eve left the group (signed)" alice ##> "#team (support: eve) hi" alice <## "bad chat command: support member not current or pending" @@ -8216,18 +8482,18 @@ testScopedSupportForwardGroupDeletion = -- if bob deletes the group, alice forwards it to eve and dan bob ##> "/d #team" concurrentlyN_ - [ bob <## "#team: you deleted the group", + [ bob <## "#team: you deleted the group (signed)", do - alice <## "#team: bob deleted the group" + alice <## "#team: bob deleted the group (signed)" alice <## "use /d #team to delete the local copy of the group", do - cath <## "#team: bob deleted the group" + cath <## "#team: bob deleted the group (signed)" cath <## "use /d #team to delete the local copy of the group", do - dan <## "#team: bob deleted the group" + dan <## "#team: bob deleted the group (signed)" dan <## "use /d #team to delete the local copy of the group", do - eve <## "#team: bob deleted the group" + eve <## "#team: bob deleted the group (signed)" eve <## "use /d #team to delete the local copy of the group" ] @@ -8433,7 +8699,7 @@ testScopedSupportUnreadStatsOnDelete = alice ##> "/set delete #team on" alice <## "updated group preferences:" alice <## "Full deletion: on" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Full deletion: on" @@ -8588,11 +8854,11 @@ testScopedSupportMemberRemoved = cath ##> "/rm team bob" concurrentlyN_ - [ cath <## "#team: you removed bob from the group", + [ cath <## "#team: you removed bob from the group (signed)", do - bob <## "#team: cath removed you from the group" + bob <## "#team: cath removed you from the group (signed)" bob <## "use /d #team to delete the group", - alice <## "#team: cath removed bob from the group" + alice <## "#team: cath removed bob from the group (signed)" ] alice ##> "/member support chats #team" @@ -8620,9 +8886,9 @@ testScopedSupportUserRemovesMember = alice ##> "/rm team bob" concurrentlyN_ - [ alice <## "#team: you removed bob from the group", + [ alice <## "#team: you removed bob from the group (signed)", do - bob <## "#team: alice removed you from the group" + bob <## "#team: alice removed you from the group (signed)" bob <## "use /d #team to delete the group" ] @@ -8655,7 +8921,7 @@ testScopedSupportMemberLeaves = [ do bob <## "#team: you left the group" bob <## "use /d #team to delete the group", - alice <## "#team: bob left the group" + alice <## "#team: bob left the group (signed)" ] alice ##> "/member support chats #team" @@ -8687,11 +8953,11 @@ testSupportPreferenceGroup = alice <## "Chat with admins: off" concurrentlyN_ [ do - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Chat with admins: off", do - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "updated group preferences:" cath <## "Chat with admins: off" ] @@ -11502,7 +11768,7 @@ testRelayRejectRaceConcurrentInvitations ps = -- first rejection alice ##> "/rm #team bob" - alice .<##. ("#team: you removed bob from the group", "") + alice .<##. ("#team: you removed bob from the group (signed)", "") threadDelay 100000 alice ##> "/_add relays #1 1" alice <## "#team: group relays:" @@ -11517,7 +11783,7 @@ testRelayRejectRaceConcurrentInvitations ps = -- second rejection alice ##> "/rm #team bob" - alice .<##. ("#team: you removed bob from the group", "") + alice .<##. ("#team: you removed bob from the group (signed)", "") threadDelay 100000 alice ##> "/_add relays #1 1" alice <## "#team: group relays:" diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index efe2097504..adcfc6d994 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -1299,13 +1299,13 @@ testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile c alice ##> "/p alisa" alice <## "user profile is changed to alisa (your 0 contacts are notified)" alice #> "#biz hello again" -- profile update is sent with message - biz <## "alice_1 updated group #alice:" + biz <## "alice_1 updated group #alice: (signed)" biz <## "changed to #alisa" biz <# "#alisa alisa_1> hello again" -- customer can invite members too, if business allows biz ##> "/mr alisa alisa_1 admin" - biz <## "#alisa: you changed the role of alisa_1 to admin" - alice <## "#biz: biz_1 changed your role from member to admin" + biz <## "#alisa: you changed the role of alisa_1 to admin (signed)" + alice <## "#biz: biz_1 changed your role from member to admin (signed)" connectUsers alice bob alice ##> "/a #biz bob" alice <## "invitation to join the group #biz sent to bob" @@ -1370,11 +1370,11 @@ testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile c biz #> "#alisa hey" concurrentlyN_ [ do - alice <## "biz_1 updated group #biz:" + alice <## "biz_1 updated group #biz: (signed)" alice <## "changed to #business" alice <# "#business business_1> hey", do - bob <## "biz_1 updated group #biz:" + bob <## "biz_1 updated group #biz: (signed)" bob <## "changed to #business" bob <# "#business business_1> hey", do @@ -1387,15 +1387,15 @@ testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile c biz <## "Full deletion: on" concurrentlyN_ [ do - alice <## "business_1 updated group #business:" + alice <## "business_1 updated group #business: (signed)" alice <## "updated group preferences:" alice <## "Full deletion: on", do - bob <## "business_1 updated group #business:" + bob <## "business_1 updated group #business: (signed)" bob <## "updated group preferences:" bob <## "Full deletion: on", do - cath <## "business updated group #alisa:" + cath <## "business updated group #alisa: (signed)" cath <## "updated group preferences:" cath <## "Full deletion: on" ] @@ -2093,11 +2093,11 @@ testJoinGroupIncognito = -- remove member alice ##> ("/rm secret_club " <> cathIncognito) concurrentlyN_ - [ alice <## ("#secret_club: you removed " <> cathIncognito <> " from the group"), - bob <## ("#secret_club: alice removed " <> cathIncognito <> " from the group"), - dan <## ("#secret_club: alice removed " <> cathIncognito <> " from the group"), + [ alice <## ("#secret_club: you removed " <> cathIncognito <> " from the group (signed)"), + bob <## ("#secret_club: alice removed " <> cathIncognito <> " from the group (signed)"), + dan <## ("#secret_club: alice removed " <> cathIncognito <> " from the group (signed)"), do - cath <## "#secret_club: alice removed you from the group" + cath <## "#secret_club: alice removed you from the group (signed)" cath <## "use /d #secret_club to delete the group" ] bob #> "#secret_club hi" @@ -2236,10 +2236,10 @@ testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobPr [ do bob <## "#team: you left the group" bob <## "use /d #team to delete the group", - alice <## ("#team: " <> bobIncognito <> " left the group") + alice <## ("#team: " <> bobIncognito <> " left the group (signed)") ] bob ##> "/d #team" - bob <## "#team: you deleted the group" + bob <## "#team: you deleted your local copy of the group" bob `hasContactProfiles` ["bob"] testDeleteGroupThenContactDeletesIncognitoProfile :: HasCallStack => TestParams -> IO () @@ -2281,10 +2281,10 @@ testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobPr [ do bob <## "#team: you left the group" bob <## "use /d #team to delete the group", - alice <## ("#team: " <> bobIncognito <> " left the group") + alice <## ("#team: " <> bobIncognito <> " left the group (signed)") ] bob ##> "/d #team" - bob <## "#team: you deleted the group" + bob <## "#team: you deleted your local copy of the group" bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito] -- delete contact bob ##> "/d alice" @@ -2653,7 +2653,7 @@ testUpdateGroupPrefs = alice <## "updated group preferences:" alice <## "Full deletion: on" alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Full deletion: on")]) - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Full deletion: on" threadDelay 500000 @@ -2663,7 +2663,7 @@ testUpdateGroupPrefs = alice <## "Full deletion: off" alice <## "Voice messages: off" alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off")]) - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Full deletion: off" bob <## "Voice messages: off" @@ -2673,7 +2673,7 @@ testUpdateGroupPrefs = alice <## "updated group preferences:" alice <## "Voice messages: on" alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")]) - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Voice messages: on" threadDelay 500000 @@ -2726,7 +2726,7 @@ testAllowFullDeletionGroup = alice ##> "/set delete #team on" alice <## "updated group preferences:" alice <## "Full deletion: on" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Full deletion: on" alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "hi"), (0, "hey"), (1, "Full deletion: on")]) @@ -2790,7 +2790,7 @@ testProhibitDirectMessages = where directProhibited :: HasCallStack => TestCC -> IO () directProhibited cc = do - cc <## "alice updated group #team:" + cc <## "alice updated group #team: (signed)" cc <## "updated group preferences:" cc <## "Direct messages: off" @@ -2846,7 +2846,7 @@ testEnableTimedMessagesGroup = alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 1}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}" alice <## "updated group preferences:" alice <## "Disappearing messages: on (1 sec)" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Disappearing messages: on (1 sec)" threadDelay 1000000 @@ -2864,7 +2864,7 @@ testEnableTimedMessagesGroup = alice ##> "/set disappear #team off" alice <## "updated group preferences:" alice <## "Disappearing messages: off" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Disappearing messages: off" threadDelay 1000000 @@ -2877,13 +2877,13 @@ testEnableTimedMessagesGroup = alice ##> "/set disappear #team on 30s" alice <## "updated group preferences:" alice <## "Disappearing messages: on (30 sec)" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Disappearing messages: on (30 sec)" alice ##> "/set disappear #team week" -- "on" is optional alice <## "updated group preferences:" alice <## "Disappearing messages: on (1 week)" - bob <## "alice updated group #team:" + bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" bob <## "Disappearing messages: on (1 week)" @@ -3001,7 +3001,7 @@ testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danP where directForOwners :: HasCallStack => TestCC -> IO () directForOwners cc = do - cc <## "alice updated group #team:" + cc <## "alice updated group #team: (signed)" cc <## "updated group preferences:" cc <## "Direct messages: on for owners" @@ -3036,7 +3036,7 @@ testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $ where filesForOwners :: HasCallStack => TestCC -> IO () filesForOwners cc = do - cc <## "alice updated group #team:" + cc <## "alice updated group #team: (signed)" cc <## "updated group preferences:" cc <## "Files and media: on for owners" @@ -3078,7 +3078,7 @@ testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfil where linksForOwners :: HasCallStack => TestCC -> IO () linksForOwners cc = do - cc <## "alice updated group #team:" + cc <## "alice updated group #team: (signed)" cc <## "updated group preferences:" cc <## "SimpleX links: on for owners" @@ -3724,10 +3724,10 @@ testShortLinkAddressPrepareBusiness = testChat3 businessProfile aliceProfile {fu bob <## "business address: known business #biz" bob <## "use #biz to send messages" biz ##> "/d #bob" - biz <## "#bob: you deleted the group" - alice <## "#bob: biz deleted the group" + biz <## "#bob: you deleted the group (signed)" + alice <## "#bob: biz deleted the group (signed)" alice <## "use /d #bob to delete the local copy of the group" - bob <## "#biz: biz_1 deleted the group" + bob <## "#biz: biz_1 deleted the group (signed)" bob <## "use /d #biz to delete the local copy of the group" bob ##> ("/_connect plan 1 " <> shortLink) bob <## "business address: ok to connect" @@ -3820,8 +3820,8 @@ testShortLinkPrepareGroup = testChat3 aliceProfile bobProfile cathProfile test bob ##> "/l #team" bob <## "#team: you left the group" bob <## "use /d #team to delete the group" - alice <## "#team: bob left the group" - cath <## "#team: bob left the group" + alice <## "#team: bob left the group (signed)" + cath <## "#team: bob left the group (signed)" bob ##> ("/_connect plan 1 " <> shortLink) bob <## "group link: ok to connect directly" void $ getTermLine bob @@ -4483,7 +4483,7 @@ testShortLinkGroupChangeProfile = testChat3 aliceProfile bobProfile cathProfile alice ##> "/gp team club" alice <## "changed to #club" - cath <## "alice updated group #team:" + cath <## "alice updated group #team: (signed)" cath <## "changed to #club" bob ##> ("/_connect plan 1 " <> shortLink) @@ -4521,7 +4521,7 @@ testShortLinkGroupChangeProfileReceived = testChat3 aliceProfile bobProfile cath cath ##> "/gp team club" cath <## "changed to #club" - alice <## "cath updated group #team:" + alice <## "cath updated group #team: (signed)" alice <## "changed to #club" threadDelay 250000 diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index cf613a1b26..127b1c7a08 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -188,7 +188,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"v\":\"9\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (mcSimple (MCText "hello"))) it "x.msg.new chat message with chat version range" $ - "{\"v\":\"9-19\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" + "{\"v\":\"9-20\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" ##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (mcSimple (MCText "hello"))) it "x.msg.new quote" $ "{\"v\":\"9\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" @@ -276,42 +276,42 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do #==# XFileCancel (SharedMsgId "\1\2\3\4") it "x.info" $ "{\"v\":\"9\",\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" - #==# XInfo testProfile + #==# XInfo testProfile Nothing it "x.info with empty full name" $ "{\"v\":\"9\",\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" - #==# XInfo Profile {displayName = "alice", fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = testChatPreferences, badge = Nothing, contactDomain = Nothing} + #==# XInfo Profile {displayName = "alice", fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = testChatPreferences, badge = Nothing, contactDomain = Nothing} Nothing it "x.contact with xContactId" $ "{\"v\":\"9\",\"event\":\"x.contact\",\"params\":{\"contactReqId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" - #==# XContact testProfile (Just $ XContactId "\1\2\3\4") Nothing Nothing + #==# XContact testProfile Nothing (Just $ XContactId "\1\2\3\4") Nothing Nothing it "x.contact without XContactId" $ "{\"v\":\"9\",\"event\":\"x.contact\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" - #==# XContact testProfile Nothing Nothing Nothing + #==# XContact testProfile Nothing Nothing Nothing Nothing it "x.contact with content null" $ "{\"v\":\"9\",\"event\":\"x.contact\",\"params\":{\"content\":null,\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" - ==# XContact testProfile Nothing Nothing Nothing + ==# XContact testProfile Nothing Nothing Nothing Nothing it "x.contact with content" $ "{\"v\":\"9\",\"event\":\"x.contact\",\"params\":{\"msgId\":\"AQIDBA==\",\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" - ==# XContact testProfile Nothing Nothing (Just (SharedMsgId "\1\2\3\4", MCText {text = "hello"})) + ==# XContact testProfile Nothing Nothing Nothing (Just (SharedMsgId "\1\2\3\4", MCText {text = "hello"})) it "x.grp.inv" $ "{\"v\":\"9\",\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}" - #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, business = Nothing, groupLinkId = Nothing, groupSize = Nothing} + #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, fromMemberKey = Nothing, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, business = Nothing, groupLinkId = Nothing, groupSize = Nothing} it "x.grp.inv with group link id" $ "{\"v\":\"9\",\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}, \"groupLinkId\":\"AQIDBA==\"}}}" - #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, business = Nothing, groupLinkId = Just $ GroupLinkId "\1\2\3\4", groupSize = Nothing} + #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, fromMemberKey = Nothing, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, business = Nothing, groupLinkId = Just $ GroupLinkId "\1\2\3\4", groupSize = Nothing} it "x.grp.acpt without incognito profile" $ "{\"v\":\"9\",\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" - #==# XGrpAcpt (MemberId "\1\2\3\4") + #==# XGrpAcpt (MemberId "\1\2\3\4") Nothing it "x.grp.mem.new" $ "{\"v\":\"9\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile, memberKey = Nothing} Nothing it "x.grp.mem.new with member chat version range" $ - "{\"v\":\"9\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-19\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"v\":\"9\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-20\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile, memberKey = Nothing} Nothing it "x.grp.mem.intro" $ "{\"v\":\"9\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile, memberKey = Nothing} Nothing it "x.grp.mem.intro with member chat version range" $ - "{\"v\":\"9\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-19\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"v\":\"9\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-20\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile, memberKey = Nothing} Nothing it "x.grp.mem.intro with member restrictions" $ "{\"v\":\"9\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberRestrictions\":{\"restriction\":\"blocked\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" @@ -326,7 +326,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"v\":\"9\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile, memberKey = Nothing} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq} it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $ - "{\"v\":\"9\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-19\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"v\":\"9\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"9-20\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile, memberKey = Nothing} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing} it "x.grp.mem.info" $ "{\"v\":\"9\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"