mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-09-17 08:05:23 +00:00
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>
This commit is contained in:
Evgeny
co-authored by
Evgeny @ SimpleX Chat
Evgeny @ SimpleX Chat
parent
ecdc518d4c
commit
44773d0412
@@ -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"
|
||||
|
||||
+11
-2
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -246,6 +246,7 @@ export namespace CR {
|
||||
user: T.User
|
||||
groupInfo: T.GroupInfo
|
||||
msgSigned: boolean
|
||||
localDeletion: boolean
|
||||
}
|
||||
|
||||
export interface GroupLink extends Interface {
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -103,6 +103,7 @@ class GroupDeletedUser(TypedDict):
|
||||
user: "T.User"
|
||||
groupInfo: "T.GroupInfo"
|
||||
msgSigned: bool
|
||||
localDeletion: bool
|
||||
|
||||
class GroupLink(TypedDict):
|
||||
type: Literal["groupLink"]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 = <reason>` 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 = <reason>` (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).
|
||||
@@ -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}
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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:
|
||||
|
||||
|
||||
@@ -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_)) =
|
||||
|
||||
@@ -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 ""
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 </)
|
||||
cath `connectVia` dsLink
|
||||
cath #> "@'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 </)
|
||||
groupFound bob "privacy"
|
||||
@@ -757,8 +757,8 @@ testDelistedServiceRemoved ps =
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
bob ##> "/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' <message> 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' <message> 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' <message> 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 ()
|
||||
|
||||
@@ -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"
|
||||
]
|
||||
|
||||
@@ -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"
|
||||
|
||||
+529
-263
File diff suppressed because it is too large
Load Diff
+35
-35
@@ -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 <message> 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
|
||||
|
||||
|
||||
+13
-13
@@ -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\"}}}}}"
|
||||
|
||||
Reference in New Issue
Block a user