mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-10-22 15:22:07 +00:00
fixes
This commit is contained in:
Evgeny @ SimpleX Chat committed
1 parent
388fe39180
commit
3a94d1b383
9 files changed
+154
-128
No files matched your search
@@ -74,7 +74,7 @@ import Simplex.Chat.Names (claimDomain)
|
||||
import Simplex.Chat.Options.DB (FromField (..), ToField (..))
|
||||
import Simplex.Chat.Store
|
||||
import Simplex.Chat.Store.Groups
|
||||
import Simplex.Chat.Store.Shared (GroupKeysRow, groupInfoQueryFields, groupInfoQueryFrom, mkGroupKeys, toGroupInfo_)
|
||||
import Simplex.Chat.Store.Shared (GroupKeysRow, groupInfoQueryFields, groupInfoQueryFrom, mkGroupInfoKeys, toGroupInfo_)
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Shared (GroupMemberRole (..))
|
||||
import Simplex.Messaging.Agent.Protocol (CreatedConnLink (..), SimplexDomain)
|
||||
@@ -316,8 +316,8 @@ getGroupAndRegLink cc user@User {userId, userContactId} gId =
|
||||
(g, gksData, gr, gLink_) <-
|
||||
ExceptT $ firstRow (toGroupInfoKeysRegLink currentTs cxt user) ("group " ++ show gId ++ " not found") $
|
||||
DB.query db (groupReqQuery <> " AND g.group_id = ?") (userId, userContactId, gId)
|
||||
gks <- withExceptT groupDBError $ mkGroupKeys db cxt g gksData
|
||||
pure (GIK g gks, gr, gLink_)
|
||||
gInfoKeys <- withExceptT groupDBError $ mkGroupInfoKeys db cxt g gksData
|
||||
pure (gInfoKeys, gr, gLink_)
|
||||
where
|
||||
cxt = storeCxt cc
|
||||
|
||||
|
||||
@@ -13,7 +13,7 @@ The changes:
|
||||
|
||||
1. Five new presentation headers: a profile shown in a chat, a file invitation, a file description, a contact request, and a link. The random header of released clients stays accepted.
|
||||
2. Every profile badge is bound to the chat it is shown in: a direct chat, a contact request, a link, or a group membership (section 14). A proof bound to another chat is ignored.
|
||||
3. In p2p groups a badge is accepted from a message signed by the member and from a join request under the request header; from an introduction only the random header is accepted. In channels it is accepted from a message signed by the member and from the relay's introduction under the member key in it.
|
||||
3. In p2p groups a badge is accepted from a message signed by the member and from a join request under the request header; from an introduction only the random header is accepted. In channels it is accepted from a message signed by the member and from the relay's introduction under the key stored for the member: the key from the owner-signed roster for roles from member up, the key in the introduction for lower roles.
|
||||
4. Files above the default limit include a proof in the invitation and a proof in the description, in every chat type. The core library verifies both. The decision is stored on the file and shown by the apps from one field.
|
||||
5. Forwarding a file above the forwarder's limit is refused with an alert before the forwarding sheet opens, and again, for the chosen destination, before anything is uploaded.
|
||||
6. A received file keeps its two proofs, so a file re-sent to a new member as part of history keeps them; the sender's own files get fresh proofs from the credential.
|
||||
@@ -100,7 +100,7 @@ The expected header is computed in the chat layer and passed to the store; `grou
|
||||
|
||||
File: `src/Simplex/Chat/Library/Internal.hs`, `presentUserBadge` (`:2238`).
|
||||
|
||||
The proof for an outgoing profile is generated with `sndBadgeProof`, as file proofs are. The header, `Maybe ProofPresHeader`, is a parameter; with `Nothing`, no badge is presented. For a send into a group the header is `groupPresHeader`, `memberPresHeader` of the user's own member id and key in that group. The membership key is stored by `mkGroupKeys` when the group is read with its keys; for a membership without a stored public key, no badge is presented. The header of every call site is listed in section 14.3.
|
||||
The proof for an outgoing profile is generated with `sndBadgeProof`, as file proofs are. The header, `Maybe ProofPresHeader`, is a parameter; with `Nothing`, no badge is presented. For a send into a group the header is `groupPresHeader`, `memberPresHeader` of the user's own member id and key in that group. The membership key is generated and stored by `mkGroupInfoKeys` when the group is read with its keys, and it is set on the membership of the returned group; for a membership without a public key, no badge is presented. The header of every call site is listed in section 14.3.
|
||||
|
||||
In the two handshake sends (section 4), the badge is presented only when the peer version is at least `relayWebCapVersion`.
|
||||
|
||||
@@ -114,14 +114,14 @@ The header is computed in the chat layer by `memberPresHeader gInfo memberId key
|
||||
|
||||
- `xInfoMember` (`Subscriber.hs:2798`) and `xGrpLinkMem` (`:2804`): the stored key when the message signature is verified with it, otherwise no key. A key delivered by the message is first stored by `storeMemberKey` when the signature is verified with it; the member with the stored key is returned by `storeMemberKey`.
|
||||
- The member connection handshake, section 4: the stored key when the signature is verified with it.
|
||||
- Introductions — `createNewGroupMember`, `createIntroReMember`, `updateUnknownMemberAnnounced`, `updateRosterMemberAnnounced`, `updatePreparedChannelMember`: in a channel the key in the `MemberInfo`; in a p2p group no header, and only `PHTest` is accepted.
|
||||
- Introductions — `createNewGroupMember`, `createIntroReMember`, `updateUnknownMemberAnnounced`, `updateRosterMemberAnnounced`, `updatePreparedChannelMember`: in a channel the key stored for the member after the introduction — the roster key for roles from member up, the key in the `MemberInfo` for lower roles; in a p2p group no header, and only `PHTest` is accepted.
|
||||
- A join via a relay (`createJoiningMember`, `updateMemberProfile`): the key in `XMember` when the message signature is verified with it.
|
||||
- The channel owner at a relay (`createRelayRequestGroup`, `relayInvPresHeader`): the owner's key claimed in the invitation.
|
||||
- `XGrpAcpt` at the inviting host: the key delivered by the message, stored before the profile; the binding includes it when the message signature is verified with it.
|
||||
- A join by `XContact` to a p2p group: the request header (section 14.3).
|
||||
- A relay's profile, from its link data: `Nothing`.
|
||||
|
||||
In a channel a badge is accepted from `XMember` and `XInfo` whose signature was verified under the member's key, and from the introduction by a relay under the key in it. In a p2p group a badge is accepted from a message whose signature was verified under the member's key and from a join request under the request header.
|
||||
In a channel a badge is accepted from `XMember` and `XInfo` whose signature was verified under the member's key, and from the introduction by a relay under the key stored for the member (section 14.3, item 9). In a p2p group a badge is accepted from a message whose signature was verified under the member's key and from a join request under the request header.
|
||||
|
||||
## 4. The member connection handshake
|
||||
|
||||
@@ -399,13 +399,14 @@ prepareConnShortLink :: AgentClient -> ConnId -> Maybe CRClientData -> AE (ConnS
|
||||
|
||||
### 14.3 Chat
|
||||
|
||||
In implementation order. A badge is presented only with a header: no badge is presented at a direct send for a connection without codes or for a retry without a stored request header, and at a send into a group for a `Nothing` from `groupPresHeader`. An agent error is returned as a chat error.
|
||||
In implementation order. A badge is presented only with a header: no badge is presented at a direct send for a connection without codes or for a retry without a stored request header, and at a send into a group for a `Nothing` from `groupPresHeader`. The agent is asked for codes or a link only when a badge is presented, or when a received proof has a header other than `PHTest`. An agent error is returned as a chat error.
|
||||
|
||||
**1. Headers** — `Badges.hs`
|
||||
|
||||
- `PHRequest ByteString` in `ProofPresHeader`, tag `'R'`.
|
||||
- `PHLink ByteString` in `ProofPresHeader`, tag `'L'`; payload: the link key bytes.
|
||||
- `acceptedProof :: Maybe ProofPresHeader -> BadgeProof -> Bool`: true for `PHTest`, and for a header equal to `strEncode` of the expected one. `proofPresHeaderAccepted` and `verifyBadge_` are removed.
|
||||
- `unboundProof :: BadgeProof -> Bool`: true for `PHTest`.
|
||||
- `ToField` and `FromField` for `ProofPresHeader`: the `strEncode` bytes as a blob.
|
||||
|
||||
**2. Ignored proofs** — `Types.hs`, store modules
|
||||
@@ -439,16 +440,20 @@ The expected header, `Maybe ProofPresHeader`, is a parameter of:
|
||||
|
||||
```haskell
|
||||
presentUserBadge :: User -> Maybe i -> Maybe ProofPresHeader -> Profile -> CM Profile
|
||||
|
||||
presentUserBadgeWith :: User -> Maybe i -> CM (Maybe ProofPresHeader) -> Profile -> CM Profile
|
||||
```
|
||||
|
||||
With `Nothing`, no badge is presented. A badge is presented only when `presentsUserBadge :: User -> Bool` holds: the user's own badge is active or expired. Header helpers:
|
||||
With `Nothing`, no badge is presented. A badge is presented only when `presentsUserBadge :: User -> Bool` holds, for a profile that is not incognito: the user's own badge is active or expired. `presentUserBadgeWith` runs the header action only in that case; `presentUserBadge` is `presentUserBadgeWith` of a known header. Header helpers:
|
||||
|
||||
- `groupPresHeader :: GroupInfo -> Maybe ProofPresHeader` — `memberPresHeader` of the membership's id and key
|
||||
- `directPresHeader :: ContactRequestBinding -> ProofPresHeader` — `PHChat (encodeChatBinding CBDirect codeAD)` for `CRBRatchet`, `PHRequest code` for `CRBRequest`
|
||||
- `linkPresHeader :: ConnShortLink c -> ProofPresHeader` — `PHLink` of the link key
|
||||
- `memberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader` — `PHChat (encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId, key)))` in a channel, `PHChat (encodeChatBinding CBGroup (smpEncode (memberId, key)))` in a p2p group, `Nothing` without a key
|
||||
- `memberInfoPresHeader :: GroupInfo -> MemberInfo -> Maybe ProofPresHeader` — in a channel `memberPresHeader` of the id and key in the `MemberInfo`; `Nothing` in a p2p group
|
||||
- `relayInvPresHeader :: GroupRelayInvitation -> Maybe ProofPresHeader` — the channel header of the owner's id and key in the invitation (item 12)
|
||||
- `memberKeyPresHeader :: Maybe B64UrlByteString -> MemberId -> C.PublicKeyEd25519 -> ProofPresHeader` — `PHChat (encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId, key)))` with a channel id, `PHChat (encodeChatBinding CBGroup (smpEncode (memberId, key)))` without one
|
||||
- `memberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader` — `memberKeyPresHeader` of the channel id in a channel and of no id in a p2p group; `Nothing` without a key
|
||||
- `channelMemberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader` — `memberPresHeader` in a channel; `Nothing` in a p2p group
|
||||
- `memberInfoPresHeader :: GroupInfo -> MemberInfo -> Maybe ProofPresHeader` — `channelMemberPresHeader` of the id and key in the `MemberInfo`
|
||||
- `relayInvPresHeader :: GroupRelayInvitation -> Maybe ProofPresHeader` — `memberKeyPresHeader` of the channel id, the owner's id and the key in the invitation (item 12)
|
||||
- `connPresHeader :: Connection -> CM (Maybe ProofPresHeader)` — `connsPresHeaders` of one connection
|
||||
- `connsPresHeaders :: [Connection] -> CM (Map ConnId ProofPresHeader)` — `directPresHeader . CRBRatchet` of `getConnectionsVerifyCodes`; the map includes the connections with codes
|
||||
|
||||
@@ -476,40 +481,46 @@ ALTER TABLE connections ADD COLUMN pres_header BLOB;
|
||||
**7. Direct sends**
|
||||
|
||||
- `joinContact` (`Commands.hs:3982`): the request header, `Maybe ProofPresHeader`, is a parameter, set in `connect'`, `joinPreparedConn'` and `connectContactViaAddress` — the `prepareContact` header for a new connection, the stored header for a retry. The badge is presented with `groupPresHeader` in a relay group, and with the request header otherwise.
|
||||
- `connectViaInvitation` (`Commands.hs:3808-3845`) and `connectMemberContact` (`:3395-3422`): the prepare binding for a new connection; `connPresHeader` for a prepared one.
|
||||
- `joinMemberContactAsync` (`Subscriber.hs:3956`): the header is a parameter, set in `xGrpDirectInv` to the `prepareAgentJoin` header.
|
||||
- `acceptContactRequest` (`Internal.hs:984-1014`): the prepare binding for a new connection; `connPresHeader` for an existing one.
|
||||
- `connectViaInvitation` (`Commands.hs:3808-3845`) and `connectMemberContact` (`:3395-3422`): the prepare binding for a new connection; `connPresHeader` for a prepared one, by `presentUserBadgeWith`.
|
||||
- `joinMemberContactAsync` (`Subscriber.hs:3952`): the header is a parameter, set in `xGrpDirectInv` to the `prepareAgentJoin` header.
|
||||
- `acceptContactRequest` (`Internal.hs:984-1014`): the prepare binding for a new connection; `connPresHeader` for an existing one, by `presentUserBadgeWith`.
|
||||
- `acceptContactRequestAsync` (`Internal.hs:1016-1035`): the profile is built after `prepareAgentAccept`, from its header.
|
||||
- `CONF` replies (`Subscriber.hs:507` direct case, `:626`) and `updateContactPrefs` (`Commands.hs:4099`): `connPresHeader`.
|
||||
- `sendUpdateToContacts` (`Commands.hs:4043-4082`) and `presentUserBadgeToContacts` (`:5216-5231`): one `connsPresHeaders` call per command, when `presentsUserBadge` holds.
|
||||
- `CONF` replies (`Subscriber.hs:506` direct case, `:623`) and `updateContactPrefs` (`Commands.hs:4099`): `connPresHeader`, by `presentUserBadgeWith`.
|
||||
- `sendUpdateToContacts` (`Commands.hs:4043-4082`) and `presentUserBadgeToContacts` (`:5215-5230`): one `connsPresHeaders` call per command, when `presentsUserBadge` holds.
|
||||
|
||||
**8. Direct receipts**
|
||||
|
||||
- `REQ` (`Subscriber.hs:1403`): `directPresHeader` of the `REQ` binding is a parameter of `profileContactRequest`, passed to `createOrUpdateContactRequest` and to `acceptGroupJoinRequestAsync`.
|
||||
- `processContactProfileUpdate` (`Subscriber.hs:2767`) and `saveConnInfo` (`:3189`, for `createDirectContact`): the header is a parameter, `connPresHeader` of the connection, read by the caller. In the direct case, the badge in the `CONF` reply is presented with the same header.
|
||||
- `REQ` (`Subscriber.hs:1399`): `directPresHeader` of the `REQ` binding is a parameter of `profileContactRequest`, passed to `createOrUpdateContactRequest` and to `acceptGroupJoinRequestAsync`.
|
||||
- `processContactProfileUpdate` (`Subscriber.hs:2761`) and `saveConnInfo` (`:3185`, for `createDirectContact`): `connPresHeader` of the connection the profile was received on, read only for a received proof with a header other than `PHTest`.
|
||||
- In `processContactProfileUpdate` the profile with the stored proof in place of a rejected one is used for the comparison and the chat item, as for members (item 11).
|
||||
|
||||
**9. Groups**
|
||||
|
||||
- `groupPresHeader` at every send into a group: `Commands.hs:4002` (`joinContact`, relay group), `:4332`; `Subscriber.hs:506` group case, `:639`, `:833`, `:975`, `:1257`, and `membershipHandshakeProfile` (`:3388-3393`) for `:796`, `:847` and `:3375`; `Internal.hs:2535` (`encodeXGrpAcpt`) and `:2719`.
|
||||
- `groupPresHeader` at every send into a group: `Commands.hs:4002` (`joinContact`, relay group), `:4331`; `Subscriber.hs:505` group case, `:636`, `:829`, `:971`, `:1253`, and `membershipHandshakeProfile` (`:3384-3389`) for `:791`, `:843` and `:3371`; `Internal.hs:2546` (`encodeXGrpAcpt`) and `:2730`.
|
||||
- `acceptGroupJoinRequestAsync` (`Internal.hs:1037`): the expected header is a new parameter, passed to `createJoiningMember` and `updateMemberProfile` — in `memberJoinRequestViaRelay`, `memberPresHeader` of the joining member's id and the key in `XMember` when the message signature is verified with it. `Nothing` is passed to `createJoiningMember` in `acceptGroupJoinSendRejectAsync`.
|
||||
- Host `INFO` with `XInfo` (`Subscriber.hs:862-869`): after `storeMemberKey`, the profile is stored by `processMemberProfileUpdate` with `signedMemberPresHeader`, under the member's key.
|
||||
- Host `INFO` with `XInfo` (`Subscriber.hs:858-865`): after `storeMemberKey`, the profile is stored by `processMemberProfileUpdate` with `signedMemberPresHeader`, under the member's key.
|
||||
- The profile is also stored by `processMemberProfileUpdate` when the received proof is accepted and differs from the stored member proof in its header or its disclosed information, and when a profile without a proof is received for a member with a stored proof.
|
||||
- Introductions:
|
||||
- In `memberInfo` (`Internal.hs:1335`) the stored proof (item 11) is included when `acceptedProof` holds under `memberPresHeader` of the member's id and stored key in a channel, and under `Nothing` in a p2p group: in a p2p group only a `PHTest` proof is included.
|
||||
- In `xGrpMemNew`, `xGrpMemIntro` and `xGrpMemFwd` (`Subscriber.hs:3207, 3290, 3342`): `memberInfoPresHeader`; in a p2p group only `PHTest` is accepted.
|
||||
- In `memberInfo` (`Internal.hs:1344`) the stored proof (item 11) is included when `acceptedProof` holds under `channelMemberPresHeader` of the member's id and stored key: in a p2p group only a `PHTest` proof is included.
|
||||
- In `xGrpMemNew`, `xGrpMemIntro` and `xGrpMemFwd` (`Subscriber.hs:3213, 3296, 3347`) the header is built from the key stored for the member after the introduction:
|
||||
- a roster member in `xGrpMemNew` and an existing member in `xGrpMemIntro`: `channelMemberPresHeader` of the stored key;
|
||||
- a new member in `xGrpMemIntro`: `memberInfoPresHeader` of the introduction with the key removed for roles from member up;
|
||||
- other introductions: `memberInfoPresHeader` of the introduction, whose key is stored.
|
||||
- In a p2p group only `PHTest` is accepted.
|
||||
- Invitation via contact:
|
||||
- `profile :: Maybe Profile` in `XGrpAcpt`, the optional JSON field `profile`.
|
||||
- The invitee (`Commands.hs:2847`, `Subscriber.hs:2708`, both by `encodeXGrpAcpt`, `Internal.hs:2525-2533`) includes its group profile, with `groupPresHeader`, when the maximum of the contact connection's `peerChatVRange` is at least `relayWebCapVersion`; the message is encoded with `encodeSignedConnInfo` when a signing is returned by `groupMsgSigning`.
|
||||
- `XGrpAcpt` with a badge in its profile is signed by `groupMsgSigning` (`Internal.hs:2358-2362`).
|
||||
- The host (`Subscriber.hs:792-798`) stores the key, then the profile, by `processMemberProfileUpdate` with the signed message. For an invitee whose contact is active, the profile row is kept by `canUpdateProfile` and the proof is stored on the membership (item 11).
|
||||
- The host replies with `XGrpMemInfo` and its group profile in place of `XOk` (`Subscriber.hs:799-801`); the badge is presented when the invitee's version is at least `relayWebCapVersion`, as at `:847-852`.
|
||||
- The invitee (`Commands.hs:2851`, `Subscriber.hs:2700`, both by `encodeXGrpAcpt`, `Internal.hs:2541-2549`) includes its group profile, with `groupPresHeader`, when the maximum of the contact connection's `peerChatVRange` is at least `relayWebCapVersion`; the message is encoded by `encodeConnInfoSigning`, signed when a signing is returned by `groupMsgSigning`.
|
||||
- `XGrpAcpt` with a badge in its profile is signed by `groupMsgSigning` (`Internal.hs:2360-2363`).
|
||||
- `encodeConnInfoSigning :: PQSupport -> Maybe MsgSigning -> ChatMsgEvent e -> CM ByteString` — `encodeSignedConnInfo` with a signing, `encodeConnInfoPQ` without one; used by `encodeXGrpAcpt`, `xGrpMemFwd` and `allowAgentConnectionAsync`.
|
||||
- The host (`Subscriber.hs:785-795`) stores the key, allows the connection, then stores the profile by `processMemberProfileUpdate` with the signed message. For an invitee whose contact is active, the profile row is kept by `canUpdateProfile` and the proof is stored on the membership (item 11).
|
||||
- The host replies with `XGrpMemInfo` and its group profile in place of `XOk` (`Subscriber.hs:791-793`); the badge is presented when the invitee's version is at least `relayWebCapVersion`, as at `:843-845`.
|
||||
|
||||
**10. Link data**
|
||||
|
||||
- Invitation links (`APIAddContact`, `recreateConn`): the chat generates the root key pair and calls `prepareConnectionLink SCMInvitation`; the badge is presented with `PHLink` of `plpLinkKey`; then `createConnectionForLink` is called.
|
||||
- Invitation updates (`updatePCCShortLinkData`, `APISetConnectionIncognito`): `linkPresHeader` of the stored invitation short link.
|
||||
- Address (`APICreateMyAddress`): `linkPresHeader` of the key in the prepared `CSLContact`.
|
||||
- Address updates (`setMyAddressData`): the key of the stored short link. For an address without a short link, the key is taken from `prepareConnShortLink`, then `setConnShortLink` is called once.
|
||||
- Address updates (`setMyAddressData`): the key of the stored short link. For an address without a short link, the key is taken from `prepareConnShortLink` when a badge is presented, then `setConnShortLink` is called once.
|
||||
- Receipts:
|
||||
- `linkDataBadge` (`Internal.hs:2285`): the expected header is a parameter — `linkPresHeader` of the short link, for an invitation (`Commands.hs:4415`) and for an address (`:4469-4470`). For a rejected proof the display badge, `localBadge`, is cleared.
|
||||
- `createPreparedContact` (`Commands.hs:2206`): `linkPresHeader` of the short link in `accLink`; `Nothing` without a short link.
|
||||
@@ -554,22 +565,22 @@ Postgres: `BIGINT`, `BYTEA` and `TIMESTAMPTZ`. Both schema dumps and `chat_query
|
||||
- They are selected the same way by the member read of `getConnectionEntity` (`Connections.hs:145-194`); the field is set by `toGroupAndMember`.
|
||||
- `NoJSON Nothing` is set by `toGroupMember`, for the membership, chat item members and quoted members.
|
||||
- Writes, for a received profile:
|
||||
- a badge accepted by `acceptedProof` under the expected header is upserted;
|
||||
- for a profile without a badge, the row is deleted;
|
||||
- for a badge not accepted, the row is kept.
|
||||
- a badge accepted by `acceptedProof` under the expected header and different from the stored proof is upserted by `createMemberBadgeProof` (`INSERT ... ON CONFLICT (group_member_id) DO UPDATE`);
|
||||
- for a profile without a badge and a member with a stored proof, the row is deleted;
|
||||
- for a badge not accepted, or equal to the stored proof, the row is kept.
|
||||
- These rules are applied by `setMemberBadgeProof :: DB.Connection -> GroupMember -> Maybe ProofPresHeader -> Profile -> IO GroupMember`, and the member with the field set is returned. Used by `updateMemberProfile` and `updateContactMemberProfile`, and by `processMemberProfileUpdate` when `canUpdateProfile` is false.
|
||||
- The received profile is passed to `updateMemberProfile` after `redactedMemberProfile`, and unredacted to `updateContactMemberProfile` and `setMemberBadgeProof`. The profile with the stored proof in place of a rejected one is used for the comparisons, the business chat profile and the chat item.
|
||||
- At creation the accepted proof is inserted: `createNewMember_` (for `createNewGroupMember` and `createIntroReMember`), `createJoiningMember`, and the owner in `createRelayRequestGroup`.
|
||||
- `memberBadgeProof`, or the profile's proof when it is absent, is included by `memberInfo`, filtered by `acceptedProof` under `publicGroup' g *> memberPresHeader g memberId memberPubKey`.
|
||||
- `memberBadgeProof`, or the profile's proof when it is absent, is included by `memberInfo`, filtered by `acceptedProof` under `channelMemberPresHeader g memberId memberPubKey`.
|
||||
|
||||
**12. The channel owner at the relay** — `Types.hs`, `Commands.hs`, `Subscriber.hs`, `Internal.hs`, `Store/Groups.hs`, `Store/Shared.hs`
|
||||
|
||||
- `GroupRelayInvitation` gains `publicGroupId :: Maybe B64UrlByteString` and `fromMemberKey :: Maybe MemberKey`, the optional JSON fields `publicGroupId` and `fromMemberKey`. The owner sets them in `addRelays` from `publicGroup' gInfo` and from the membership key.
|
||||
- `relayInvPresHeader :: GroupRelayInvitation -> Maybe ProofPresHeader` — `PHChat (encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId, memberKey)))` with the owner's member id and key; `Nothing` without both claims.
|
||||
- It is passed to `createRelayRequestGroup` as the expected header, at `xGrpRelayInv` and `rejectRelayInvitationAsync`. The owner's profile and membership proof are stored under it.
|
||||
- The group id claim is written to the placeholder's `group_profiles.public_group_id`. `group_type` and `group_link` are NULL, so `publicGroup` is `Nothing` and `GKRelayRequest` is returned by `mkGroupKeys`.
|
||||
- The group id claim is written to the placeholder's `group_profiles.public_group_id`. `group_type` and `group_link` are NULL, so `publicGroup` is `Nothing` and `GKRelayRequest` is returned by `mkGroupInfoKeys`.
|
||||
- The key claim is written to the owner's `group_members.member_pub_key`.
|
||||
- `GroupKeysRow` gains the profile's `public_group_id`, set by `toGroupInfo` from the same row. `GKRelayRequest` gains `publicGroupId :: Maybe B64UrlByteString`, set by `mkGroupKeys`.
|
||||
- `GroupKeysRow` gains the profile's `public_group_id`, set by `toGroupInfo` from the same row. `GKRelayRequest` gains `publicGroupId :: Maybe B64UrlByteString`, set by `mkGroupInfoKeys`.
|
||||
- The owner member is read by `processRelayRequest` in the transaction that reads the group, and passed to `getLinkDataCreateRelayLink` and `acceptOwnerConnection`.
|
||||
- The request is failed by `getLinkDataCreateRelayLink`:
|
||||
- when the group id claim differs from the link's entity id;
|
||||
|
||||
@@ -48,6 +48,7 @@ module Simplex.Chat.Badges
|
||||
badgeProof,
|
||||
verifyBadge,
|
||||
acceptedProof,
|
||||
unboundProof,
|
||||
mkBadgeStatus,
|
||||
BadgeRow,
|
||||
BadgeProofKind (..),
|
||||
@@ -338,9 +339,12 @@ instance StrEncoding ProofPresHeader where
|
||||
PHUnknownTag c -> PHUnknown c <$> A.takeByteString
|
||||
|
||||
acceptedProof :: Maybe ProofPresHeader -> BadgeProof -> Bool
|
||||
acceptedProof expected_ BadgeProof {presHeader = BBSPresHeader ph} = case strDecode ph of
|
||||
acceptedProof expected_ b@BadgeProof {presHeader = BBSPresHeader ph} = unboundProof b || maybe False ((ph ==) . strEncode) expected_
|
||||
|
||||
unboundProof :: BadgeProof -> Bool
|
||||
unboundProof BadgeProof {presHeader = BBSPresHeader ph} = case strDecode ph of
|
||||
Right (PHTest _) -> True
|
||||
_ -> maybe False ((ph ==) . strEncode) expected_
|
||||
_ -> False
|
||||
|
||||
-- Payment proof
|
||||
|
||||
|
||||
@@ -3401,7 +3401,7 @@ processChatCommand cxt nm = \case
|
||||
-- so incognito profile can be attached to it and be visible in UI before accepting
|
||||
Nothing -> joinNewConn subMode
|
||||
Just conn@Connection {connStatus} -> case connStatus of
|
||||
ConnPrepared -> joinPreparedConn subMode conn =<< connPresHeader conn
|
||||
ConnPrepared -> joinPreparedConn subMode conn $ connPresHeader conn
|
||||
_ -> throwChatError $ CEException "connection already started (past prepared status)"
|
||||
where
|
||||
joinNewConn subMode = do
|
||||
@@ -3412,10 +3412,10 @@ processChatCommand cxt nm = \case
|
||||
conn <- withStore $ \db -> do
|
||||
connId <- liftIO $ createMemberContactConn db user acId Nothing gInfo mConn ConnPrepared contactId subMode
|
||||
getConnectionById db cxt user connId
|
||||
joinPreparedConn subMode conn $ Just $ directPresHeader binding
|
||||
joinPreparedConn subMode conn presHeader_ = do
|
||||
joinPreparedConn subMode conn $ pure $ Just $ directPresHeader binding
|
||||
joinPreparedConn subMode conn getPresHeader = do
|
||||
-- [incognito] send membership incognito profile
|
||||
p <- presentUserBadge user (incognitoMembershipProfile gInfo) presHeader_ $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile gInfo) Nothing True
|
||||
p <- presentUserBadgeWith user (incognitoMembershipProfile gInfo) getPresHeader $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile gInfo) Nothing True
|
||||
dm <- encodeConnInfo $ XInfo p Nothing
|
||||
sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm PQSupportOff subMode
|
||||
let newStatus = if sqSecured then ConnSndReady else ConnJoined
|
||||
@@ -3820,7 +3820,7 @@ processChatCommand cxt nm = \case
|
||||
| connStatus == ConnNew && contactConnInitiated -> joinNewConn chatV -- own connection link
|
||||
| connStatus == ConnPrepared -> do -- retrying join after error
|
||||
localIncognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
|
||||
joinPreparedConn conn (fromLocalProfile <$> localIncognitoProfile) =<< connPresHeader conn
|
||||
joinPreparedConn conn (fromLocalProfile <$> localIncognitoProfile) $ connPresHeader conn
|
||||
Just ent -> throwCmdError $ "connection is not RcvDirectMsgConnection: " <> show (connEntityInfo ent)
|
||||
where
|
||||
-- all supported versions support PQ encryption
|
||||
@@ -3831,9 +3831,9 @@ processChatCommand cxt nm = \case
|
||||
(connId, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup'
|
||||
let ccLink = CCLink cReq $ serverShortLink <$> sLnk_
|
||||
conn <- withFastStore' $ \db -> createDirectConnection' db userId connId ccLink contactId_ ConnPrepared incognitoProfile subMode chatV pqSup'
|
||||
joinPreparedConn conn incognitoProfile $ Just $ directPresHeader binding
|
||||
joinPreparedConn conn incognitoProfile presHeader_ = do
|
||||
profileToSend <- presentUserBadge user incognitoProfile presHeader_ $ userProfileDirect user incognitoProfile Nothing True
|
||||
joinPreparedConn conn incognitoProfile $ pure $ Just $ directPresHeader binding
|
||||
joinPreparedConn conn incognitoProfile getPresHeader = do
|
||||
profileToSend <- presentUserBadgeWith user incognitoProfile getPresHeader $ userProfileDirect user incognitoProfile Nothing True
|
||||
dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend Nothing
|
||||
sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup' subMode
|
||||
let newStatus = if sqSecured then ConnSndReady else ConnJoined
|
||||
@@ -4083,8 +4083,8 @@ processChatCommand cxt nm = \case
|
||||
setMyAddressData :: Bool -> Maybe InitialKeys -> User -> UserContactLink -> CM UserContactLink
|
||||
setMyAddressData rotateKeys pqInitKeys user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink sLnk_, addressSettings} = do
|
||||
conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
|
||||
presHeader <- linkPresHeader <$> maybe (withAgent $ \a -> prepareConnShortLink a (aConnId conn) Nothing) pure sLnk_
|
||||
shortLinkProfile <- presentUserBadge user Nothing (Just presHeader) (userProfileDirect user Nothing Nothing True)
|
||||
let getPresHeader = Just . linkPresHeader <$> maybe (withAgent $ \a -> prepareConnShortLink a (aConnId conn) Nothing) pure sLnk_
|
||||
shortLinkProfile <- presentUserBadgeWith user Nothing getPresHeader (userProfileDirect user Nothing Nothing True)
|
||||
-- TODO [short links] do not save address to server if data did not change, spinners, error handling
|
||||
let userData
|
||||
| isTrue userChatRelay = relayShortLinkData shortLinkProfile
|
||||
@@ -4108,8 +4108,7 @@ processChatCommand cxt nm = \case
|
||||
mergedProfile' = userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') False
|
||||
when (mergedProfile' /= mergedProfile) $
|
||||
withContactLock "updateContactPrefs" (contactId' ct) $ do
|
||||
presHeader_ <- connPresHeader conn
|
||||
p <- presentUserBadge user incognitoProfile presHeader_ mergedProfile'
|
||||
p <- presentUserBadgeWith user incognitoProfile (connPresHeader conn) mergedProfile'
|
||||
void (sendDirectContactMessage user ct' $ XInfo p Nothing) `catchAllErrors` eToView
|
||||
lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct'
|
||||
pure $ CRContactPrefsUpdated user ct ct'
|
||||
|
||||
@@ -988,13 +988,13 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId
|
||||
pqSup' = pqSup `CR.pqSupportAnd` pqSupport
|
||||
cxt <- chatStoreCxt
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
(ct, conn, incognitoProfile, presHeader_) <- case contactId_ of
|
||||
(ct, conn, incognitoProfile, getPresHeader) <- case contactId_ of
|
||||
Nothing -> do
|
||||
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
|
||||
(connId, binding) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup'
|
||||
(ct, conn) <- withStore' $ \db ->
|
||||
createContactFromRequest db user userContactLinkId_ connId chatV cReqChatVRange cName profileId cp xContactId incognitoProfile subMode pqSup' False
|
||||
pure (ct, conn, incognitoProfile, Just $ directPresHeader binding)
|
||||
pure (ct, conn, incognitoProfile, pure $ Just $ directPresHeader binding)
|
||||
Just contactId -> do
|
||||
ct <- withFastStore $ \db -> getContact db cxt user contactId
|
||||
case contactConn ct of
|
||||
@@ -1005,11 +1005,11 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId
|
||||
conn <- withStore' $ \db -> do
|
||||
forM_ xContactId $ \xcId -> setContactAcceptedXContactId db ct xcId
|
||||
createAcceptedContactConn db user userContactLinkId_ contactId connId chatV cReqChatVRange pqSup' incognitoProfile subMode currentTs
|
||||
pure (ct {activeConn = Just conn} :: Contact, conn, incognitoProfile, Just $ directPresHeader binding)
|
||||
pure (ct {activeConn = Just conn} :: Contact, conn, incognitoProfile, pure $ Just $ directPresHeader binding)
|
||||
Just conn@Connection {customUserProfileId} -> do
|
||||
incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
|
||||
(ct, conn, ExistingIncognito <$> incognitoProfile,) <$> connPresHeader conn
|
||||
profileToSend <- presentUserBadge user incognitoProfile presHeader_ $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
|
||||
pure (ct, conn, ExistingIncognito <$> incognitoProfile, connPresHeader conn)
|
||||
profileToSend <- presentUserBadgeWith user incognitoProfile getPresHeader $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
|
||||
dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend Nothing
|
||||
(ct,conn,) <$> withAgent (\a -> acceptContact a nm (aUserId user) (aConnId conn) True invId dm pqSup' subMode)
|
||||
|
||||
@@ -1347,7 +1347,7 @@ memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, a
|
||||
{ memberId,
|
||||
memberRole,
|
||||
v = ChatVersionRange . peerChatVRange <$> activeConn,
|
||||
profile = (p :: Profile) {badge = mfilter (acceptedProof $ publicGroup' g *> memberPresHeader g memberId memberPubKey) (unNoJSON memberBadgeProof <|> badge)},
|
||||
profile = (p :: Profile) {badge = mfilter (acceptedProof $ channelMemberPresHeader g memberId memberPubKey) (unNoJSON memberBadgeProof <|> badge)},
|
||||
memberKey = MemberKey <$> memberPubKey
|
||||
}
|
||||
where
|
||||
@@ -2252,9 +2252,12 @@ sendDirectContactMessages user ct events = do
|
||||
-- the send's incognito profile (when set) suppresses it - an incognito identity must never carry the badge.
|
||||
-- a long-expired badge is not presented at all (receivers would hide it anyway).
|
||||
presentUserBadge :: User -> Maybe i -> Maybe ProofPresHeader -> Profile -> CM Profile
|
||||
presentUserBadge user incognitoProfile presHeader_ p
|
||||
presentUserBadge user incognitoProfile = presentUserBadgeWith user incognitoProfile . pure
|
||||
|
||||
presentUserBadgeWith :: User -> Maybe i -> CM (Maybe ProofPresHeader) -> Profile -> CM Profile
|
||||
presentUserBadgeWith user incognitoProfile getPresHeader p
|
||||
| isNothing incognitoProfile && presentsUserBadge user = do
|
||||
badge <- pure presHeader_ $>>= sndBadgeProof user
|
||||
badge <- getPresHeader $>>= sndBadgeProof user
|
||||
pure p {badge}
|
||||
| otherwise = pure p
|
||||
|
||||
@@ -2278,7 +2281,7 @@ linkPresHeader = \case
|
||||
|
||||
relayInvPresHeader :: GroupRelayInvitation -> Maybe ProofPresHeader
|
||||
relayInvPresHeader GroupRelayInvitation {fromMember = MemberIdRole {memberId}, publicGroupId, fromMemberKey} =
|
||||
(\gId (MemberKey k) -> PHChat $ encodeChatBinding CBGroup $ smpEncode (gId, memberId, k)) <$> publicGroupId <*> fromMemberKey
|
||||
(\gId (MemberKey k) -> memberKeyPresHeader (Just gId) memberId k) <$> publicGroupId <*> fromMemberKey
|
||||
|
||||
connPresHeader :: Connection -> CM (Maybe ProofPresHeader)
|
||||
connPresHeader conn = M.lookup (aConnId conn) <$> connsPresHeaders [conn]
|
||||
@@ -2384,12 +2387,17 @@ rcvGroupChatBinding gInfo m_ asGroup badge_ =
|
||||
_ -> Nothing
|
||||
|
||||
memberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader
|
||||
memberPresHeader gInfo memberId = fmap $ \k -> PHChat $ encodeChatBinding CBGroup $ case publicGroup' gInfo of
|
||||
Just PublicGroupProfile {publicGroupId} -> smpEncode (publicGroupId, memberId, k)
|
||||
Nothing -> smpEncode (memberId, k)
|
||||
memberPresHeader gInfo memberId = fmap $ memberKeyPresHeader ((\PublicGroupProfile {publicGroupId} -> publicGroupId) <$> publicGroup' gInfo) memberId
|
||||
|
||||
memberKeyPresHeader :: Maybe B64UrlByteString -> MemberId -> C.PublicKeyEd25519 -> ProofPresHeader
|
||||
memberKeyPresHeader publicGroupId_ memberId k =
|
||||
PHChat $ encodeChatBinding CBGroup $ maybe (smpEncode (memberId, k)) (\publicGroupId -> smpEncode (publicGroupId, memberId, k)) publicGroupId_
|
||||
|
||||
channelMemberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader
|
||||
channelMemberPresHeader gInfo memberId memberKey_ = publicGroup' gInfo *> memberPresHeader gInfo memberId memberKey_
|
||||
|
||||
memberInfoPresHeader :: GroupInfo -> MemberInfo -> Maybe ProofPresHeader
|
||||
memberInfoPresHeader gInfo MemberInfo {memberId, memberKey} = publicGroup' gInfo *> memberPresHeader gInfo memberId ((\(MemberKey k) -> k) <$> memberKey)
|
||||
memberInfoPresHeader gInfo MemberInfo {memberId, memberKey} = channelMemberPresHeader gInfo memberId ((\(MemberKey k) -> k) <$> memberKey)
|
||||
|
||||
proofMemberKey :: MemberId -> Maybe BadgeProof -> Maybe C.PublicKeyEd25519
|
||||
proofMemberKey memberId badge_ = do
|
||||
@@ -2517,6 +2525,9 @@ encodeSignedConnInfo pqSup signing chatMsgEvent = do
|
||||
ECMEncoded body -> compressConnInfo pqSup $ encodeBatchElement (Just $ signChatMsgBody signing body) body
|
||||
ECMLarge -> throwChatError $ CEException "large signed info"
|
||||
|
||||
encodeConnInfoSigning :: MsgEncodingI e => PQSupport -> Maybe MsgSigning -> ChatMsgEvent e -> CM ByteString
|
||||
encodeConnInfoSigning pqSup = maybe (encodeConnInfoPQ pqSup) (encodeSignedConnInfo pqSup)
|
||||
|
||||
-- signed XMember for a relay-group join: proves the joiner holds the member key it asserts, and carries
|
||||
-- viaRelay = the target relay's memberId inside the signed body so a sibling relay can't accept a replay
|
||||
encodeXMemberConnInfo :: PQSupport -> GroupInfoKeys -> MemberId -> Profile -> CM ByteString
|
||||
@@ -2535,7 +2546,7 @@ encodeXGrpAcpt user g@(GIK gInfo@GroupInfo {membership = GroupMember {memberId}}
|
||||
then Just <$> presentUserBadge user incognitoProfile (groupPresHeader gInfo) (userProfileInGroup user gInfo $ fromLocalProfile <$> incognitoProfile)
|
||||
else pure Nothing
|
||||
let msg = XGrpAcpt memberId (Just $ groupMemberKey gks) profile_
|
||||
maybe (encodeConnInfo msg) (\signing -> encodeSignedConnInfo PQSupportOff signing msg) (groupMsgSigning False g msg)
|
||||
encodeConnInfoSigning PQSupportOff (groupMsgSigning False g msg) msg
|
||||
|
||||
deliverMessage :: Connection -> CMEventTag e -> MsgBody -> MessageId -> CM (Int64, PQEncryption)
|
||||
deliverMessage conn cmEventTag msgBody msgId = do
|
||||
@@ -3105,9 +3116,7 @@ allowAgentConnectionAsync user conn@Connection {pqSupport} confId gInfo_ msg = d
|
||||
let signing_ = case gInfo_ of
|
||||
Just gInfo@(GIK g _) | useRelays' g || maxVersion (peerChatVRange conn) >= relayWebCapVersion -> groupMsgSigning False gInfo msg
|
||||
_ -> Nothing
|
||||
dm <- case signing_ of
|
||||
Just signing -> encodeSignedConnInfo pqSupport signing msg
|
||||
Nothing -> encodeConnInfoPQ pqSupport msg
|
||||
dm <- encodeConnInfoSigning pqSupport signing_ msg
|
||||
allowAgentConnectionInfo user conn confId dm
|
||||
|
||||
allowAgentConnectionInfo :: User -> Connection -> ConfirmationId -> ByteString -> CM ()
|
||||
|
||||
@@ -46,7 +46,7 @@ import Data.Time.Format (defaultTimeLocale, formatTime)
|
||||
import qualified Data.UUID as UUID
|
||||
import qualified Data.UUID.V4 as V4
|
||||
import Data.Word (Word32)
|
||||
import Simplex.Chat.Badges (BadgeProof (..), BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), ProofPresHeader (..), acceptedProof)
|
||||
import Simplex.Chat.Badges (BadgeProof (..), BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), ProofPresHeader (..), acceptedProof, unboundProof)
|
||||
import Simplex.Chat.Call
|
||||
import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Delivery
|
||||
@@ -138,18 +138,18 @@ processAgentMessage corrId connId msg = do
|
||||
-- Missing connection/entity errors here will be sent to the view but not shown as CRITICAL alert,
|
||||
-- as in this case no need to ACK message - we can't process messages for this connection anyway.
|
||||
critical connId (withStore $ getUserEntity cxt) >>= \case
|
||||
Just (user, entity, gks_) -> processAgentMessageConn cxt user entity gks_ corrId connId msg `catchAllErrors` eToView
|
||||
Just (user, entity, gInfoKeys_) -> processAgentMessageConn cxt user entity gInfoKeys_ corrId connId msg `catchAllErrors` eToView
|
||||
_ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
|
||||
where
|
||||
getUserEntity :: StoreCxt -> DB.Connection -> ExceptT StoreError IO (Maybe (User, ConnectionEntity, Maybe GroupKeys))
|
||||
getUserEntity :: StoreCxt -> DB.Connection -> ExceptT StoreError IO (Maybe (User, ConnectionEntity, Maybe GroupInfoKeys))
|
||||
getUserEntity cxt db =
|
||||
liftIO (getUserByAConnId db $ AgentConnId connId)
|
||||
>>= mapM (\user -> do
|
||||
(entity, groupKeysData_) <- getConnectionEntityKeys db cxt user (AgentConnId connId)
|
||||
gks_ <- case entity of
|
||||
RcvGroupMsgConnection _ gInfo _ -> mapM (mkGroupKeys db cxt gInfo) groupKeysData_
|
||||
gInfoKeys_ <- case entity of
|
||||
RcvGroupMsgConnection _ gInfo _ -> mapM (mkGroupInfoKeys db cxt gInfo) groupKeysData_
|
||||
_ -> pure Nothing
|
||||
(user,,gks_) <$> liftIO (updateConnStatus db entity))
|
||||
(user,,gInfoKeys_) <$> liftIO (updateConnStatus db entity))
|
||||
|
||||
updateConnStatus :: DB.Connection -> ConnectionEntity -> IO ConnectionEntity
|
||||
updateConnStatus db acEntity = case agentMsgConnStatus (entityConnection acEntity) msg of
|
||||
@@ -436,8 +436,8 @@ processAgentMsgRcvFile _corrId aFileId msg = do
|
||||
|
||||
type ShouldDeleteGroupConns = Bool
|
||||
|
||||
processAgentMessageConn :: StoreCxt -> User -> ConnectionEntity -> Maybe GroupKeys -> ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
|
||||
processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId agentMessage =
|
||||
processAgentMessageConn :: StoreCxt -> User -> ConnectionEntity -> Maybe GroupInfoKeys -> ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
|
||||
processAgentMessageConn cxt user@User {userId} entity gInfoKeys_ corrId agentConnId agentMessage =
|
||||
case agentMessage of
|
||||
END -> case entity of
|
||||
RcvDirectMsgConnection _ (Just ct) -> toView $ CEvtContactAnotherClient user ct
|
||||
@@ -446,8 +446,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
_ -> case entity of
|
||||
RcvDirectMsgConnection conn contact_ ->
|
||||
processDirectMessage agentMessage entity conn contact_
|
||||
RcvGroupMsgConnection conn gInfo m -> case gks_ of
|
||||
Just gks -> processGroupMessage agentMessage entity conn (GIK gInfo gks) m
|
||||
RcvGroupMsgConnection conn _ m -> case gInfoKeys_ of
|
||||
Just gInfoKeys -> processGroupMessage agentMessage entity conn gInfoKeys m
|
||||
Nothing -> throwChatError $ CEInternalError "group connection entity without group keys"
|
||||
UserContactConnection conn uc ->
|
||||
processContactConnMessage agentMessage entity conn uc
|
||||
@@ -498,19 +498,17 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
Right () -> pure ()
|
||||
Nothing -> do
|
||||
conn' <- processCONFpqSupport conn pqSupport
|
||||
presHeader_ <- connPresHeader conn'
|
||||
-- [incognito] send saved profile
|
||||
(conn'', gInfo_) <- saveConnInfo conn' presHeader_ connInfo
|
||||
(conn'', gInfo_) <- saveConnInfo conn' connInfo
|
||||
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
|
||||
profileToSend <- case gInfo_ of
|
||||
Just (GIK gInfo _) -> presentUserBadge user incognitoProfile (groupPresHeader gInfo) $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
|
||||
Nothing -> presentUserBadge user incognitoProfile presHeader_ $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True
|
||||
Nothing -> presentUserBadgeWith user incognitoProfile (connPresHeader conn'') $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn'' confId gInfo_ $ XInfo profileToSend ((\(GIK _ gks) -> groupMemberKey gks) <$> gInfo_)
|
||||
INFO pqSupport connInfo -> do
|
||||
processINFOpqSupport conn pqSupport
|
||||
presHeader_ <- connPresHeader conn
|
||||
void $ saveConnInfo conn presHeader_ connInfo
|
||||
void $ saveConnInfo conn connInfo
|
||||
MSG meta _msgFlags _msgBody ->
|
||||
-- We are not saving message (saveDirectRcvMSG) as contact hasn't been created yet,
|
||||
-- chat item is also not created here
|
||||
@@ -619,11 +617,10 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn'' confId Nothing XOk
|
||||
XInfo profile _ -> do
|
||||
presHeader_ <- connPresHeader conn''
|
||||
ct' <- processContactProfileUpdate ct presHeader_ profile False `catchAllErrors` const (pure ct)
|
||||
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 presHeader_ $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True
|
||||
p <- presentUserBadgeWith user incognitoProfile (connPresHeader conn'') $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True
|
||||
allowAgentConnectionAsync user conn'' confId Nothing $ XInfo p Nothing
|
||||
void $ withStore' $ \db -> resetMemberContactFields db ct'
|
||||
XGrpLinkInv glInv -> do
|
||||
@@ -652,8 +649,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
pure ()
|
||||
XInfo profile _ -> do
|
||||
let prepared = isJust (preparedContact ct) || isJust (contactRequestId' ct)
|
||||
presHeader_ <- connPresHeader conn
|
||||
void $ processContactProfileUpdate ct presHeader_ profile prepared
|
||||
void $ processContactProfileUpdate ct profile prepared
|
||||
XOk -> pure ()
|
||||
_ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok"
|
||||
CON pqEnc -> do
|
||||
@@ -792,10 +788,10 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
m' <- case mKey of
|
||||
Just (MemberKey k) -> m {memberPubKey = Just k} <$ withStore' (\db -> setMemberPubKey db (groupMemberId' m) k)
|
||||
Nothing -> pure m
|
||||
forM_ memProfile_ $ \memProfile -> processMemberProfileUpdate gInfo m' signedMsg_ memProfile Nothing
|
||||
membershipProfile <- membershipHandshakeProfile gInfo $ maxVersion (peerChatVRange conn')
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn' confId (Just g) $ XGrpMemInfo (memberId' membership) membershipProfile
|
||||
forM_ memProfile_ $ \memProfile -> processMemberProfileUpdate gInfo m' signedMsg_ memProfile Nothing
|
||||
| otherwise -> messageError "x.grp.acpt: memberId is different from expected"
|
||||
XGrpRelayAcpt relayLink relayCap
|
||||
| memberRole' membership == GROwner && isRelay m -> do
|
||||
@@ -2739,9 +2735,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
MsgError e -> createInternalChatItem user cd (CIRcvIntegrityError e) (Just brokerTs)
|
||||
|
||||
xInfo :: Contact -> Profile -> CM ()
|
||||
xInfo c p' = do
|
||||
presHeader_ <- pure (contactConn c) $>>= connPresHeader
|
||||
void $ processContactProfileUpdate c presHeader_ p' True
|
||||
xInfo c p' = void $ processContactProfileUpdate c p' True
|
||||
|
||||
xDirectDel :: Contact -> RcvMessage -> MsgMeta -> CM ()
|
||||
xDirectDel c msg msgMeta =
|
||||
@@ -2764,10 +2758,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
where
|
||||
brokerTs = metaBrokerTs msgMeta
|
||||
|
||||
processContactProfileUpdate :: Contact -> Maybe ProofPresHeader -> Profile -> Bool -> CM Contact
|
||||
processContactProfileUpdate c@Contact {profile = lp} presHeader_ p' createItems
|
||||
processContactProfileUpdate :: Contact -> Profile -> Bool -> CM Contact
|
||||
processContactProfileUpdate c@Contact {profile = lp} p'@Profile {badge = rcvBadge} createItems = do
|
||||
presHeader_ <- if any (not . unboundProof) rcvBadge then pure (contactConn c) $>>= connPresHeader else pure Nothing
|
||||
let p'' = if all (acceptedProof presHeader_) rcvBadge then p' else p' {badge = storedBadge}
|
||||
contentChanged = not (sameProfileContent p p'')
|
||||
-- a failed/unknown-key badge is re-verified even when content is unchanged, so it heals after an app update adds the key
|
||||
| contentChanged || badgeNeedsReverify lp = do
|
||||
if contentChanged || badgeNeedsReverify lp
|
||||
then do
|
||||
c' <- withStore $ \db ->
|
||||
if userTTL == rcvTTL
|
||||
then updateContactProfile db cxt user c presHeader_ p'
|
||||
@@ -2775,15 +2773,13 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
|
||||
updateContactProfile db cxt user c' presHeader_ p'
|
||||
when (contentChanged && directOrUsed c' && createItems) $ do
|
||||
createProfileUpdatedItem c'
|
||||
createProfileUpdatedItem c' p''
|
||||
lift $ createRcvFeatureItems user c c'
|
||||
toView $ CEvtContactUpdated user c c'
|
||||
pure c'
|
||||
| otherwise =
|
||||
pure c
|
||||
else pure c
|
||||
where
|
||||
contentChanged = not (sameProfileContent p p')
|
||||
p = fromLocalProfile lp
|
||||
p@Profile {badge = storedBadge} = fromLocalProfile lp
|
||||
Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c
|
||||
userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs
|
||||
Profile {preferences = rcvPrefs_} = p'
|
||||
@@ -2797,15 +2793,15 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
| rcvTTL /= userDefaultTTL -> Just (userDefault :: TimedMessagesPreference) {ttl = rcvTTL}
|
||||
| otherwise -> Nothing
|
||||
in setPreference_ SCFTimedMessages ctUserTMPref' ctUserPrefs
|
||||
createProfileUpdatedItem c' =
|
||||
createProfileUpdatedItem c' p'' =
|
||||
when visibleProfileUpdated $ do
|
||||
let ciContent = CIRcvDirectEvent $ RDEProfileUpdated p p'
|
||||
let ciContent = CIRcvDirectEvent $ RDEProfileUpdated p p''
|
||||
createInternalChatItem user (CDDirectRcv c') ciContent Nothing
|
||||
where
|
||||
visibleProfileUpdated =
|
||||
n' /= n || fn' /= fn || sd /= sd' || i' /= i || cl' /= cl
|
||||
Profile {displayName = n, fullName = fn, shortDescr = sd, image = i, contactLink = cl} = p
|
||||
Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p'
|
||||
Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p''
|
||||
|
||||
xInfoMember :: GroupInfo -> GroupMember -> Profile -> Maybe MemberKey -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
|
||||
xInfoMember gInfo m p' mKey msg@RcvMessage {signedMsg_} brokerTs = do
|
||||
@@ -3186,12 +3182,13 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
toView $ CEvtContactAndMemberAssociated user c2 g m1 c2'
|
||||
pure c2'
|
||||
|
||||
saveConnInfo :: Connection -> Maybe ProofPresHeader -> ConnInfo -> CM (Connection, Maybe GroupInfoKeys)
|
||||
saveConnInfo activeConn presHeader_ connInfo = do
|
||||
saveConnInfo :: Connection -> ConnInfo -> CM (Connection, Maybe GroupInfoKeys)
|
||||
saveConnInfo activeConn connInfo = do
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo
|
||||
conn' <- updatePeerChatVRange activeConn chatVRange
|
||||
case chatMsgEvent of
|
||||
XInfo p _ -> do
|
||||
XInfo p@Profile {badge} _ -> do
|
||||
presHeader_ <- if any (not . unboundProof) badge then connPresHeader conn' else pure Nothing
|
||||
ct <- withStore $ \db -> createDirectContact db cxt user conn' presHeader_ p
|
||||
toView $ CEvtContactConnecting user ct
|
||||
pure (conn', Nothing)
|
||||
@@ -3233,7 +3230,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
-- TODO [relays] member: surface relay-key-mismatch as a dedicated event / chat item / relay state
|
||||
when (assertedKey /= memberPubKey unknownMember) $
|
||||
messageWarning $ "x.grp.mem.new: relay asserted key differs from roster-established key, keeping roster key, memberId=" <> safeDecodeUtf8 (strEncode memId)
|
||||
updatedMember <- withStore $ \db -> updateRosterMemberAnnounced db cxt user m unknownMember memInfo presHeader_ initialStatus
|
||||
updatedMember <- withStore $ \db -> updateRosterMemberAnnounced db cxt user m unknownMember memInfo (channelMemberPresHeader gInfo memId (memberPubKey unknownMember)) initialStatus
|
||||
-- roster members can't be pending, so no members-require-attention update
|
||||
gInfo' <- updatePublicGroupData user gInfo gks
|
||||
toView $ CEvtUnknownMemberAnnounced user gInfo' m unknownMember updatedMember
|
||||
@@ -3298,13 +3295,12 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
|
||||
xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> CM ()
|
||||
xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _ _) memRestrictions = do
|
||||
let presHeader_ = memberInfoPresHeader gInfo memInfo
|
||||
case memberCategory m of
|
||||
GCHostMember ->
|
||||
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
|
||||
Right existingMember
|
||||
| useRelays' gInfo -> do
|
||||
updatedMember <- withStore $ \db -> updatePreparedChannelMember db cxt user existingMember memInfo presHeader_
|
||||
updatedMember <- withStore $ \db -> updatePreparedChannelMember db cxt user existingMember memInfo (channelMemberPresHeader gInfo memId (memberPubKey existingMember))
|
||||
toView $ CEvtGroupMemberUpdated user gInfo existingMember updatedMember
|
||||
| otherwise ->
|
||||
messageError "x.grp.mem.intro ignored: member already exists"
|
||||
@@ -3317,7 +3313,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
MemberInfo mId mRole v p _
|
||||
| mRole >= GRMember -> MemberInfo mId defaultRole v p Nothing
|
||||
_ -> memInfo
|
||||
void $ withStore $ \db -> createIntroReMember db cxt user gInfo memInfo' presHeader_ memRestrictions
|
||||
void $ withStore $ \db -> createIntroReMember db cxt user gInfo memInfo' (memberInfoPresHeader gInfo memInfo') memRestrictions
|
||||
| otherwise -> do
|
||||
when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c)
|
||||
case memChatVRange of
|
||||
@@ -3327,7 +3323,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
groupConnIds@(cmdId, connId) <- prepareAgentCreation user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation
|
||||
let chatV = maybe (minVersion (vr cxt)) (\peerVR -> vr cxt `peerConnChatVersion` fromChatVRange peerVR) memChatVRange
|
||||
void $ withStore $ \db -> do
|
||||
reMember <- createIntroReMember db cxt user gInfo memInfo presHeader_ memRestrictions
|
||||
reMember <- createIntroReMember db cxt user gInfo memInfo (memberInfoPresHeader gInfo memInfo) memRestrictions
|
||||
createIntroReMemberConn db user m reMember chatV memInfo groupConnIds subMode
|
||||
withAgent $ \a -> createConnectionAsync a (aCorrId cmdId) connId (chatHasNtfs chatSettings) SCMInvitation CR.IKPQOff True subMode
|
||||
_ -> messageError "x.grp.mem.intro can be only sent by host member"
|
||||
@@ -3374,7 +3370,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
-- [incognito] send membership incognito profile, create direct connection as incognito
|
||||
membershipProfile <- membershipHandshakeProfile gInfo chatV
|
||||
let msg = XGrpMemInfo membershipMemId membershipProfile
|
||||
dm <- maybe (encodeConnInfo msg) (\signing -> encodeSignedConnInfo PQSupportOff signing msg) (groupMsgSigning False g msg)
|
||||
dm <- encodeConnInfoSigning PQSupportOff (groupMsgSigning False g msg) msg
|
||||
-- [async agent commands] no continuation needed, but commands should be asynchronous for stability
|
||||
let enableNtfsGrp = chatHasNtfs chatSettings
|
||||
(groupConnIds@(gCmdId, gAcId), _) <- prepareAgentJoin user enableNtfsGrp groupConnReq
|
||||
|
||||
@@ -96,8 +96,8 @@ createOrUpdateContactRequest
|
||||
Just (gInfo@GroupInfo {businessChat = Just BusinessChatInfo {customerId}}, keysData) -> do
|
||||
clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId
|
||||
cr <- liftIO $ getContactRequestByXContactId xContactId
|
||||
gks <- mkGroupKeys db cxt gInfo keysData
|
||||
pure $ RSAcceptedRequest cr (REBusinessChat (GIK gInfo gks) clientMember)
|
||||
gInfoKeys <- mkGroupInfoKeys db cxt gInfo keysData
|
||||
pure $ RSAcceptedRequest cr (REBusinessChat gInfoKeys clientMember)
|
||||
Just (GroupInfo {businessChat = Nothing}, _) -> throwError SEInvalidBusinessChatContactRequest
|
||||
-- 2) if no legacy accepted contact or business chat was found, next we try to find an existing request
|
||||
Nothing ->
|
||||
@@ -309,8 +309,8 @@ createOrUpdateContactRequest
|
||||
case gInfo of
|
||||
GroupInfo {businessChat = Just BusinessChatInfo {customerId}} -> do
|
||||
clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId
|
||||
gks <- mkGroupKeys db cxt gInfo keysData
|
||||
pure $ Just (REBusinessChat (GIK gInfo gks) clientMember)
|
||||
gInfoKeys <- mkGroupInfoKeys db cxt gInfo keysData
|
||||
pure $ Just (REBusinessChat gInfoKeys clientMember)
|
||||
_ -> throwError SEInvalidBusinessChatContactRequest
|
||||
(Nothing, Nothing) -> pure Nothing
|
||||
_ -> throwError $ SEInvalidContactRequestEntity contactRequestId
|
||||
|
||||
@@ -2030,7 +2030,7 @@ getRelayServedGroups db cxt User {userId, userContactId} = do
|
||||
<> " WHERE g.user_id = ? AND mu.contact_id = ? AND g.relay_own_status IN (?, ?, ?)"
|
||||
)
|
||||
(userId, userContactId, RSAccepted, RSAcknowledgedRoster, RSActive)
|
||||
forM rows $ \(g, keysData) -> GIK g <$> mkGroupKeys db cxt g keysData
|
||||
forM rows $ uncurry (mkGroupInfoKeys db cxt)
|
||||
|
||||
getRelayPublishableGroups :: DB.Connection -> User -> IO [(Int64, B64UrlByteString, Maybe PublicGroupAccess)]
|
||||
getRelayPublishableGroups db User {userId, userContactId} =
|
||||
@@ -3472,19 +3472,29 @@ updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} pr
|
||||
pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile} :: Contact)
|
||||
|
||||
setMemberBadgeProof :: DB.Connection -> GroupMember -> Maybe ProofPresHeader -> Profile -> IO GroupMember
|
||||
setMemberBadgeProof db m@GroupMember {groupMemberId} presHeader_ Profile {badge} = case badge of
|
||||
setMemberBadgeProof db m@GroupMember {groupMemberId, memberBadgeProof = NoJSON storedProof} presHeader_ Profile {badge} = case badge of
|
||||
Just b | not (acceptedProof presHeader_ b) -> pure m
|
||||
_ -> do
|
||||
DB.execute db "DELETE FROM group_member_badge_proofs WHERE group_member_id = ?" (Only groupMemberId)
|
||||
forM_ badge $ createMemberBadgeProof db groupMemberId
|
||||
pure m {memberBadgeProof = NoJSON badge}
|
||||
_ | badge == storedProof -> pure m
|
||||
Nothing -> m {memberBadgeProof = NoJSON Nothing} <$ DB.execute db "DELETE FROM group_member_badge_proofs WHERE group_member_id = ?" (Only groupMemberId)
|
||||
Just b -> m {memberBadgeProof = NoJSON badge} <$ createMemberBadgeProof db groupMemberId b
|
||||
|
||||
createMemberBadgeProof :: DB.Connection -> GroupMemberId -> BadgeProof -> IO ()
|
||||
createMemberBadgeProof db groupMemberId badge = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO group_member_badge_proofs (group_member_id, badge_proof, badge_pres_header, badge_key_idx, badge_type, badge_expiry, badge_extra, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
[sql|
|
||||
INSERT INTO group_member_badge_proofs (group_member_id, badge_proof, badge_pres_header, badge_key_idx, badge_type, badge_expiry, badge_extra, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?)
|
||||
ON CONFLICT (group_member_id) DO UPDATE SET
|
||||
badge_proof = excluded.badge_proof,
|
||||
badge_pres_header = excluded.badge_pres_header,
|
||||
badge_key_idx = excluded.badge_key_idx,
|
||||
badge_type = excluded.badge_type,
|
||||
badge_expiry = excluded.badge_expiry,
|
||||
badge_extra = excluded.badge_extra,
|
||||
updated_at = excluded.updated_at
|
||||
|]
|
||||
(Only groupMemberId :. badgeProofToRow badge :. (currentTs, currentTs))
|
||||
|
||||
getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool
|
||||
|
||||
@@ -746,14 +746,15 @@ toPublicGroupAccess (groupWebPage, groupDomain_, domainWebPage_, allowEmbedding_
|
||||
domainWebPage = maybe False unBI domainWebPage_
|
||||
allowEmbedding = maybe False unBI allowEmbedding_
|
||||
|
||||
mkGroupKeys :: DB.Connection -> StoreCxt -> GroupInfo -> GroupKeysRow -> ExceptT StoreError IO GroupKeys
|
||||
mkGroupKeys db cxt g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}, membership} (rootPrivKey, rootPubKey, memberPrivKey_, publicGroupId) = do
|
||||
mkGroupInfoKeys :: DB.Connection -> StoreCxt -> GroupInfo -> GroupKeysRow -> ExceptT StoreError IO GroupInfoKeys
|
||||
mkGroupInfoKeys db cxt g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}, membership} (rootPrivKey, rootPubKey, memberPrivKey_, publicGroupId) = do
|
||||
memberPrivKey <- case memberPrivKey_ of
|
||||
Just k -> pure k
|
||||
Nothing -> do
|
||||
(_, k) <- atomically $ C.generateKeyPair (drg cxt)
|
||||
setUserMemberKey db groupId (groupMemberId' membership) k
|
||||
pure $ case (useRelays' g, isJust publicGroup, GRKPrivate <$> rootPrivKey <|> GRKPublic <$> rootPubKey) of
|
||||
let membership' = membership {memberPubKey = Just $ C.publicKey memberPrivKey} :: GroupMember
|
||||
pure $ GIK g {membership = membership'} $ case (useRelays' g, isJust publicGroup, GRKPrivate <$> rootPrivKey <|> GRKPublic <$> rootPubKey) of
|
||||
(False, _, _) -> GKGroup {memberPrivKey}
|
||||
(True, True, Just groupRootKey) -> GKPublicGroup {groupRootKey, memberPrivKey}
|
||||
(True, True, Nothing) -> GKPreparedPublicGroup {memberPrivKey}
|
||||
@@ -940,11 +941,7 @@ addGroupChatTags db g@GroupInfo {groupId} = do
|
||||
pure (g :: GroupInfo) {chatTags}
|
||||
|
||||
getGroupInfoKeys :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO GroupInfoKeys
|
||||
getGroupInfoKeys db cxt user groupId = do
|
||||
(g@GroupInfo {membership}, keysData) <- getGroupInfoRow db cxt user groupId
|
||||
gks <- mkGroupKeys db cxt g keysData
|
||||
let membership' = membership {memberPubKey = Just $ C.publicKey $ memberPrivKey gks} :: GroupMember
|
||||
pure $ GIK (g :: GroupInfo) {membership = membership'} gks
|
||||
getGroupInfoKeys db cxt user groupId = uncurry (mkGroupInfoKeys db cxt) =<< getGroupInfoRow db cxt user groupId
|
||||
|
||||
getGroupInfo :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO GroupInfo
|
||||
getGroupInfo db cxt user groupId = fst <$> getGroupInfoRow db cxt user groupId
|
||||
|
||||
Reference in new issue
Block a user