mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-08-22 03:40:17 +00:00
core: share links to channels and verify shared links when connecting (#6810)
* core: share links to channels and verify shared links when connecting * refactor * improve * refactor case * simplify * exctract encodeChatBinding * share api * corrections Co-authored-by: Evgeny <evgeny@poberezkin.com> * tests * verify signature in the tests * drop signature if context does not match on reception * try to test "fake" forward * fix * fix direct chat sharing test * channel test * sign link * rename api * refactor view * chal link item CLI view, tests * clean up * share channel in channel as channel * query plan * fix test * refactor * whitespace * simpler * refactor * dont use partial field update --------- 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 <259188159+evgeny-simplex@users.noreply.github.com>
Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
parent
e2a55291fc
commit
30ae0d864c
@@ -1280,6 +1280,7 @@ Determine SimpleX link type and if the bot is already connected via this link.
|
||||
**Parameters**:
|
||||
- userId: int64
|
||||
- connectionLink: string?
|
||||
- linkOwnerSig: [LinkOwnerSig](./TYPES.md#linkownersig)?
|
||||
|
||||
**Syntax**:
|
||||
|
||||
|
||||
@@ -117,6 +117,7 @@ This file is generated automatically.
|
||||
- [InvitationLinkPlan](#invitationlinkplan)
|
||||
- [InvitedBy](#invitedby)
|
||||
- [LinkContent](#linkcontent)
|
||||
- [LinkOwnerSig](#linkownersig)
|
||||
- [LinkPreview](#linkpreview)
|
||||
- [LocalProfile](#localprofile)
|
||||
- [MemberCriteria](#membercriteria)
|
||||
@@ -132,6 +133,7 @@ This file is generated automatically.
|
||||
- [NetworkError](#networkerror)
|
||||
- [NewUser](#newuser)
|
||||
- [NoteFolder](#notefolder)
|
||||
- [OwnerVerification](#ownerverification)
|
||||
- [PendingContactConnection](#pendingcontactconnection)
|
||||
- [PrefEnabled](#prefenabled)
|
||||
- [Preferences](#preferences)
|
||||
@@ -1698,6 +1700,7 @@ Error:
|
||||
Ok:
|
||||
- type: "ok"
|
||||
- contactSLinkData_: [ContactShortLinkData](#contactshortlinkdata)?
|
||||
- ownerVerification: [OwnerVerification](#ownerverification)?
|
||||
|
||||
OwnLink:
|
||||
- type: "ownLink"
|
||||
@@ -2261,6 +2264,7 @@ Ok:
|
||||
- type: "ok"
|
||||
- groupSLinkInfo_: [GroupShortLinkInfo](#groupshortlinkinfo)?
|
||||
- groupSLinkData_: [GroupShortLinkData](#groupshortlinkdata)?
|
||||
- ownerVerification: [OwnerVerification](#ownerverification)?
|
||||
|
||||
OwnLink:
|
||||
- type: "ownLink"
|
||||
@@ -2526,6 +2530,7 @@ Public:
|
||||
Ok:
|
||||
- type: "ok"
|
||||
- contactSLinkData_: [ContactShortLinkData](#contactshortlinkdata)?
|
||||
- ownerVerification: [OwnerVerification](#ownerverification)?
|
||||
|
||||
OwnLink:
|
||||
- type: "ownLink"
|
||||
@@ -2578,6 +2583,16 @@ Unknown:
|
||||
- json: JSONObject
|
||||
|
||||
|
||||
---
|
||||
|
||||
## LinkOwnerSig
|
||||
|
||||
**Record type**:
|
||||
- ownerId: string?
|
||||
- chatBinding: string
|
||||
- ownerSig: string
|
||||
|
||||
|
||||
---
|
||||
|
||||
## LinkPreview
|
||||
@@ -2683,6 +2698,7 @@ Chat:
|
||||
- type: "chat"
|
||||
- text: string
|
||||
- chatLink: [MsgChatLink](#msgchatlink)
|
||||
- ownerSig: [LinkOwnerSig](#linkownersig)?
|
||||
|
||||
Unknown:
|
||||
- type: "unknown"
|
||||
@@ -2830,6 +2846,20 @@ SubscribeError:
|
||||
- unread: bool
|
||||
|
||||
|
||||
---
|
||||
|
||||
## OwnerVerification
|
||||
|
||||
**Discriminated union type**:
|
||||
|
||||
Verified:
|
||||
- type: "verified"
|
||||
|
||||
Failed:
|
||||
- type: "failed"
|
||||
- reason: string
|
||||
|
||||
|
||||
---
|
||||
|
||||
## PendingContactConnection
|
||||
|
||||
@@ -282,6 +282,7 @@ cliCommands =
|
||||
"SetUserGroupReceipts",
|
||||
"SetUserAutoAcceptMemberContacts",
|
||||
"SetUserTimedMessages",
|
||||
"SharePublicGroup",
|
||||
"ShowChatItem",
|
||||
"ShowChatItemInfo",
|
||||
"ShowGroupDescription",
|
||||
@@ -407,6 +408,7 @@ undocumentedCommands =
|
||||
"APISetUserGroupReceipts",
|
||||
"APISetUserServers",
|
||||
"APISetUserUIThemes",
|
||||
"APIShareChatMsgContent",
|
||||
"APIStandaloneFileInfo",
|
||||
"APIStorageEncryption",
|
||||
"APISuspendChat",
|
||||
|
||||
@@ -132,6 +132,7 @@ undocumentedResponses =
|
||||
"CRChatItemInfo",
|
||||
"CRChatItems",
|
||||
"CRChatItemTTL",
|
||||
"CRChatMsgContent",
|
||||
"CRChatRelayTestResult",
|
||||
"CRChats",
|
||||
"CRConnectionsDiff",
|
||||
|
||||
@@ -299,6 +299,7 @@ chatTypesDocsData =
|
||||
(sti @InvitationLinkPlan, STUnion, "ILP", [], "", ""),
|
||||
(sti @InvitedBy, STUnion, "IB", [], "", ""),
|
||||
(sti @LinkContent, STUnion, "LC", [], "", ""),
|
||||
(sti @LinkOwnerSig, STRecord, "", [], "", ""),
|
||||
(sti @LinkPreview, STRecord, "", [], "", ""),
|
||||
(sti @LocalProfile, STRecord, "", [], "", ""),
|
||||
(sti @MemberCriteria, STEnum1, "MC", [], "", ""),
|
||||
@@ -314,6 +315,7 @@ chatTypesDocsData =
|
||||
(sti @NetworkError, STUnion, "NE", [], "", ""),
|
||||
(sti @NewUser, STRecord, "", [], "", ""),
|
||||
(sti @NoteFolder, STRecord, "", [], "", ""),
|
||||
(sti @OwnerVerification, STUnion, "OV", [], "", ""),
|
||||
(sti @PendingContactConnection, STRecord, "", [], "", ""),
|
||||
(sti @PrefEnabled, STRecord, "", [], "", ""),
|
||||
(sti @Preferences, STRecord, "", [], "", ""),
|
||||
@@ -506,6 +508,7 @@ deriving instance Generic JSONCIDirection
|
||||
deriving instance Generic JSONCIFileStatus
|
||||
deriving instance Generic JSONCIStatus
|
||||
deriving instance Generic LinkContent
|
||||
deriving instance Generic LinkOwnerSig
|
||||
deriving instance Generic LinkPreview
|
||||
deriving instance Generic LocalProfile
|
||||
deriving instance Generic MemberCriteria
|
||||
@@ -521,6 +524,7 @@ deriving instance Generic MsgSigStatus
|
||||
deriving instance Generic NetworkError
|
||||
deriving instance Generic NewUser
|
||||
deriving instance Generic NoteFolder
|
||||
deriving instance Generic OwnerVerification
|
||||
deriving instance Generic PendingContactConnection
|
||||
deriving instance Generic PrefEnabled
|
||||
deriving instance Generic Preferences
|
||||
|
||||
@@ -214,6 +214,7 @@ toTypeInfo tr =
|
||||
"ProtocolServer",
|
||||
"SbKey",
|
||||
"SharedMsgId",
|
||||
"Signature",
|
||||
"TransportHost",
|
||||
"UIColor",
|
||||
"UserPwd",
|
||||
|
||||
+1
-1
@@ -21,7 +21,7 @@ constraints: zip +disable-bzip2 +disable-zstd
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: bc5ea42bec3a63e46b191e4150dd79957f114e01
|
||||
tag: 95b17ada2795e1c5c84bbe2a50a0752ee66d0aad
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
||||
@@ -471,6 +471,7 @@ export namespace APIAddContact {
|
||||
export interface APIConnectPlan {
|
||||
userId: number // int64
|
||||
connectionLink?: string
|
||||
linkOwnerSig?: T.LinkOwnerSig
|
||||
}
|
||||
|
||||
export namespace APIConnectPlan {
|
||||
|
||||
@@ -1986,6 +1986,7 @@ export namespace ContactAddressPlan {
|
||||
export interface Ok extends Interface {
|
||||
type: "ok"
|
||||
contactSLinkData_?: ContactShortLinkData
|
||||
ownerVerification?: OwnerVerification
|
||||
}
|
||||
|
||||
export interface OwnLink extends Interface {
|
||||
@@ -2577,6 +2578,7 @@ export namespace GroupLinkPlan {
|
||||
type: "ok"
|
||||
groupSLinkInfo_?: GroupShortLinkInfo
|
||||
groupSLinkData_?: GroupShortLinkData
|
||||
ownerVerification?: OwnerVerification
|
||||
}
|
||||
|
||||
export interface OwnLink extends Interface {
|
||||
@@ -2787,6 +2789,7 @@ export namespace InvitationLinkPlan {
|
||||
export interface Ok extends Interface {
|
||||
type: "ok"
|
||||
contactSLinkData_?: ContactShortLinkData
|
||||
ownerVerification?: OwnerVerification
|
||||
}
|
||||
|
||||
export interface OwnLink extends Interface {
|
||||
@@ -2856,6 +2859,12 @@ export namespace LinkContent {
|
||||
}
|
||||
}
|
||||
|
||||
export interface LinkOwnerSig {
|
||||
ownerId?: string
|
||||
chatBinding: string
|
||||
ownerSig: string
|
||||
}
|
||||
|
||||
export interface LinkPreview {
|
||||
uri: string
|
||||
title: string
|
||||
@@ -2973,6 +2982,7 @@ export namespace MsgContent {
|
||||
type: "chat"
|
||||
text: string
|
||||
chatLink: MsgChatLink
|
||||
ownerSig?: LinkOwnerSig
|
||||
}
|
||||
|
||||
export interface Unknown extends Interface {
|
||||
@@ -3131,6 +3141,25 @@ export interface NoteFolder {
|
||||
unread: boolean
|
||||
}
|
||||
|
||||
export type OwnerVerification = OwnerVerification.Verified | OwnerVerification.Failed
|
||||
|
||||
export namespace OwnerVerification {
|
||||
export type Tag = "verified" | "failed"
|
||||
|
||||
interface Interface {
|
||||
type: Tag
|
||||
}
|
||||
|
||||
export interface Verified extends Interface {
|
||||
type: "verified"
|
||||
}
|
||||
|
||||
export interface Failed extends Interface {
|
||||
type: "failed"
|
||||
reason: string
|
||||
}
|
||||
}
|
||||
|
||||
export interface PendingContactConnection {
|
||||
pccConnId: number // int64
|
||||
pccAgentConnId: string
|
||||
|
||||
@@ -0,0 +1,255 @@
|
||||
# Public Group Invitations & Directory Listing
|
||||
|
||||
## Goal
|
||||
|
||||
Enable public group (channel) subscribers to invite new subscribers by sharing a channel card in any chat where they can send messages. Channel owners can prove ownership via a signed card. This unblocks directory service support for public groups alongside regular groups.
|
||||
|
||||
Sharing channels should be as simple as forwarding — share button on channel opens chat picker, sends a channel card as a regular message. Old clients show the text; new clients show a rich card with profile and join button.
|
||||
|
||||
## Context
|
||||
|
||||
### Current state
|
||||
- Public groups have `PublicGroupProfile {groupType = GTChannel, groupLink, publicGroupId}` and `useRelays = True`
|
||||
- Users join public groups via link → `APIPrepareGroup` → `APIConnectPreparedGroup`
|
||||
- `MCChat` message content exists with `MsgChatLink` variants for contacts, invitations, and groups (`MCLGroup`)
|
||||
- Group invitations (`XGrpInv`) carry `connRequest :: ConnReqInvitation` — public groups don't use this mechanism
|
||||
- Directory bot registers groups via group invitation (owner invites bot as admin) — public groups need a different flow
|
||||
|
||||
### Owner keys in public group links
|
||||
- `FixedLinkData.rootKey :: PublicKeyEd25519` — genesis root key
|
||||
- `UserContactData.owners :: [OwnerAuth]` — chain of authorized owner keys, each signed by root or previous owner
|
||||
- Public group creator stores `GroupKeys {groupRootKey = GRKPrivate rootPrivKey, memberPrivKey}`
|
||||
- `memberPrivKey`'s public key = `ownerKey` in the `OwnerAuth` entry (created via `newOwnerAuth`)
|
||||
- `publicGroupId = sha256(rootPubKey)` — immutable group identity
|
||||
|
||||
### DR connection shared secret
|
||||
- Each direct connection has `rcAD` (Associated Data) from X3DH key exchange
|
||||
- `getConnectionRatchetAdHash` returns `sha256(rcAD)` — binding for replay protection
|
||||
|
||||
## Design
|
||||
|
||||
### Channel cards as MCChat messages
|
||||
|
||||
Channel invitations are sent as regular `XMsgNew` with `MCChat` content. No new protocol messages.
|
||||
|
||||
```haskell
|
||||
data MsgContent
|
||||
= ...
|
||||
| MCChat {text :: Text, chatLink :: MsgChatLink, ownerSig :: Maybe LinkOwnerSig}
|
||||
| ...
|
||||
```
|
||||
|
||||
`ownerSig` is optional. Old clients ignore it (missing field) and show `text` as a regular message.
|
||||
|
||||
```haskell
|
||||
data LinkOwnerSig = LinkOwnerSig
|
||||
{ ownerId :: Maybe OwnerId, -- Nothing = root key, Just = owner key from OwnerAuth chain
|
||||
binding :: B64UrlByteString,
|
||||
ownerSig :: B64UrlByteString
|
||||
}
|
||||
```
|
||||
|
||||
Sending is supported for channel cards only (for now). Verification is generic for all `MsgChatLink` types:
|
||||
- `ownerId = Just id`: verified against matching `OwnerAuth.ownerKey` in the link's owner chain (channels)
|
||||
- `ownerId = Nothing`: verified against `rootKey` from `FixedLinkData` (contacts, invitations)
|
||||
|
||||
The sender proves control over the link regardless of type.
|
||||
|
||||
### What is signed
|
||||
|
||||
`smpEncode chatBinding <> bindingData <> smpEncode chatLink` signed with `memberPrivKey`.
|
||||
|
||||
Binding depends on where the card is sent:
|
||||
- **Direct chat**: `CBDirect` with `ratchetAdHash`
|
||||
- **Public group**: `CBGroup` with `smpEncode (publicGroupId, memberId)`
|
||||
- **Group without public identity**: signature treated as failed at verification time
|
||||
|
||||
Binding is to chat, not to message (`sharedMsgId` is not included). This allows the sender to forward their own signed card within the same chat (e.g., re-sharing a channel link as a reminder) without invalidating the signature. Message-level binding would prevent this since forwarded messages get new `sharedMsgId`s.
|
||||
|
||||
### Sending flow
|
||||
|
||||
1. User presses "Share" on channel → API call `APIPrepareLinkOwnerSig GroupId` returns `Maybe LinkOwnerSig`
|
||||
2. Opens chat picker (same as forwarding) — chats with disabled simplex links greyed out
|
||||
3. Sends `XMsgNew` with `MCChat {text = displayName, chatLink = MCLGroup {connLink, groupProfile}, ownerSig}`
|
||||
4. Creates regular `CISndMsgContent` chat item — no new item types, no new response types
|
||||
|
||||
### Receiving flow
|
||||
|
||||
Regular `XMsgNew` processing. Creates `CIRcvMsgContent (MCChat ...)`. No hidden groups, no async verification, no special events.
|
||||
|
||||
UI renders channel card with profile, member count, join button. If `ownerSig` present, shows "signed by owner" indicator (unverified until join).
|
||||
|
||||
### Verification at join time
|
||||
|
||||
When user taps "Join" on a channel card:
|
||||
|
||||
1. UI extracts `connLink` and `ownerSig` from `MCChat` message content
|
||||
2. UI calls `APIConnectPlan` with the link and signature. `APIConnectPlan` extended:
|
||||
```haskell
|
||||
APIConnectPlan {userId :: UserId, connectionLink :: Maybe AConnectionLink, linkOwnerSig :: Maybe LinkOwnerSig}
|
||||
```
|
||||
Parser: `/_connect plan <userId> <link> [sig=<json>]`
|
||||
3. Inside `connectPlan`, if `linkOwnerSig` is present:
|
||||
- Gets `FixedLinkData {rootKey}` and `UserContactData {owners}` from resolved link
|
||||
- Finds verification key: `ownerId = Nothing` → `rootKey`, `ownerId = Just id` → matching `OwnerAuth.ownerKey`
|
||||
- Verifies binding data against expected value from context
|
||||
- Verifies signature
|
||||
4. Each "OK" plan variant extended with verification result:
|
||||
```haskell
|
||||
data LinkSigVerification = LSVVerified | LSVFailed {reason :: Text}
|
||||
|
||||
ILPOk {contactSLinkData_, linkSigVerification :: Maybe LinkSigVerification}
|
||||
CAPOk {contactSLinkData_, linkSigVerification :: Maybe LinkSigVerification}
|
||||
GLPOk {groupSLinkInfo_, groupSLinkData_, linkSigVerification :: Maybe LinkSigVerification}
|
||||
-- Nothing = not signed, Just LSVVerified = verified, Just LSVFailed = failed with reason
|
||||
```
|
||||
Reasons: "unknown owner ID", "binding data mismatch", "signature verification failed", "no group identity for verification"
|
||||
5. UI shows verification result in join/connect alert for the OK plan variants
|
||||
6. User confirms → `APIPrepareGroup` → `APIConnectPreparedGroup` — existing join flow, no changes
|
||||
|
||||
Pasted links (no message context) pass `linkOwnerSig = Nothing` — plan shows "not signed."
|
||||
|
||||
### Forwarding
|
||||
|
||||
When `MCChat` is forwarded, `ownerSig` is dropped — UNLESS forwarded by sender in the same chat (re-sharing own card as reminder). Signature is bound to chat context, so forwarding in the same chat preserves validity.
|
||||
|
||||
Implementation: in forwarding code, drop `ownerSig` unless `fromChatRef == toChatRef` and sender is the same user.
|
||||
|
||||
### Simplex link permission
|
||||
|
||||
`MCChat` IS a simplex link — if `SGFSimplexLinks` is prohibited for the sender's role, `MCChat` should be prohibited regardless of content.
|
||||
|
||||
Currently `prohibitedSimplexLinks` (Internal.hs:363) only checks formatted text. Fix: also check `MsgContent` type — if it's `MCChat` and simplex links are not allowed, prohibit it. This covers both send and receive via existing `prohibitedGroupContent` calls.
|
||||
|
||||
For backward compatibility, the current text-level check is sufficient since the link is included in `text`. But the `MCChat` type check is the correct long-term fix.
|
||||
|
||||
### CLI view
|
||||
|
||||
`MCChat` with `MCLGroup` renders as channel card with display name. If `ownerSig` present, shows "(signed)" indicator.
|
||||
|
||||
## Directory bot changes
|
||||
|
||||
### Registration flow
|
||||
|
||||
Bot receives regular `CIRcvMsgContent (MCChat ...)` messages in direct chat from channel owners. Bot checks `ownerSig` is present. Verifies at join time via `connectPlan`. No special events needed.
|
||||
|
||||
- Owner sends channel card to bot in DM (signed)
|
||||
- Bot resolves link, verifies owner signature
|
||||
- Bot joins channel as subscriber
|
||||
- Simplified approval flow: `GRSProposed` → `GRSPendingApproval` → `GRSActive`
|
||||
|
||||
### Profile monitoring
|
||||
|
||||
Bot as subscriber receives `XGrpInfo` when owner updates profile. On profile change: re-resolve link, compare. Periodic re-verification.
|
||||
|
||||
### Search and listing
|
||||
|
||||
Search includes both groups and public groups. No separate listing category — `groupProfile.publicGroup` is the source of truth. `DETGroup` works for both in JSON listing.
|
||||
|
||||
## Implementation plan (diff from master)
|
||||
|
||||
### Step 1: LinkOwnerSig type
|
||||
|
||||
- `LinkOwnerSig` type in Types.hs (or Protocol.hs alongside `MCChat`)
|
||||
- `ownerSig :: Maybe LinkOwnerSig` field on `MCChat`
|
||||
- JSON derivation with backward compat (optional field)
|
||||
|
||||
### Step 2: CBDirect
|
||||
|
||||
- Add `CBDirect` to `ChatBinding` in Protocol.hs (already done on master via refactoring PR)
|
||||
|
||||
### Step 3: Share chat message content API
|
||||
|
||||
New command that constructs the complete `MCChat` content for sharing:
|
||||
```haskell
|
||||
-- Controller.hs
|
||||
APIShareChatMsgContent {shareChatRef :: ChatRef, toChatRef :: ChatRef}
|
||||
-- returns CRChatMsgContent {user :: User, msgContent :: MsgContent}
|
||||
```
|
||||
|
||||
Implementation in Commands.hs:
|
||||
1. Load shared chat info from `shareChatRef` — initially only `CTGroup` with public groups supported
|
||||
2. Get `PublicGroupProfile {groupLink}` and `groupProfile` from group
|
||||
3. Determine if user is owner (has `GroupKeys {memberPrivKey}`)
|
||||
4. If owner, compute binding based on `toChatRef`:
|
||||
- `ChatRef CTDirect contactId` → `getConnectionRatchetAdHash` on contact's connection → `CBDirect`
|
||||
- `ChatRef CTGroup groupId` → `smpEncode (publicGroupId, memberId)` if group has identity → `CBGroup`
|
||||
- Group without identity → `Nothing` (can't sign)
|
||||
5. If owner and binding available, sign `smpEncode chatBinding <> bindingData <> smpEncode chatLink` with `memberPrivKey`
|
||||
6. Return `MCChat {text = displayName, chatLink = MCLGroup {connLink = groupLink, groupProfile}, ownerSig}`
|
||||
|
||||
Parser: `/_share_chat <chatRef> <chatRef>`
|
||||
|
||||
UI flow: press Share on channel → chat picker → select destination → call `APIShareChatMsgContent` → get `MsgContent` → send via existing `APISendMessages`
|
||||
|
||||
All business logic (ownership check, signing decision, link extraction, profile inclusion) stays in core. UI only passes two chat refs and sends the returned content.
|
||||
|
||||
### Step 4: connectPlan verification
|
||||
|
||||
Extend `APIConnectPlan` (Controller.hs:472):
|
||||
```haskell
|
||||
APIConnectPlan {userId :: UserId, connectionLink :: Maybe AConnectionLink, linkOwnerSig :: Maybe LinkOwnerSig}
|
||||
```
|
||||
|
||||
Parser (Commands.hs:4945): extend to accept optional JSON `LinkOwnerSig` parameter.
|
||||
|
||||
In `connectPlan` (Commands.hs), pass `linkOwnerSig` to `groupShortLinkPlan` / `groupJoinRequestPlan`.
|
||||
|
||||
In `groupShortLinkPlan` (Commands.hs ~line 3944): after resolving the link via `getShortLinkConnReq`, if `linkOwnerSig` is present:
|
||||
1. Extract `FixedLinkData {rootKey}` and `UserContactData {owners}`
|
||||
2. If `ownerId = Nothing`: verify against `rootKey`
|
||||
3. If `ownerId = Just id`: find `OwnerAuth` where `ownerId == id`, verify against `ownerKey`
|
||||
4. Check binding data matches expected
|
||||
5. Verify signature
|
||||
|
||||
Extend `GroupLinkPlan` (Controller.hs:1025):
|
||||
```haskell
|
||||
GLPOk {groupSLinkInfo_, groupSLinkData_, ownerVerified :: Maybe Bool}
|
||||
```
|
||||
`Nothing` = not signed, `Just True` = verified, `Just False` = failed.
|
||||
|
||||
`CRConnectionPlan` response carries this through to UI — shown in plan alert.
|
||||
|
||||
### Step 5: Forwarding — drop ownerSig
|
||||
|
||||
In message forwarding code (Commands.hs, `APIForwardChatItems`), when forwarding `MCChat` content, set `ownerSig = Nothing`.
|
||||
|
||||
Location: Commands.hs where forwarded message content is constructed — find where `MCChat` is handled in forwarding and strip the signature.
|
||||
|
||||
### Step 6: Permission check
|
||||
|
||||
Fix `prohibitedSimplexLinks` (Internal.hs:363) to also check `MsgContent` type — if `MCChat`, treat as simplex link. Covers both send and receive paths via existing `prohibitedGroupContent` calls.
|
||||
|
||||
For backward compatibility, the link is also in `text` field, so existing text-level check catches it. The type check is the correct fix.
|
||||
|
||||
### Step 7: CLI view
|
||||
|
||||
In `viewChatItem` (View.hs), `MCChat` content already renders via `ttyMsgContent`. Extend to show channel card format and "(signed)" indicator when `ownerSig` is present.
|
||||
|
||||
### Step 8: groupLinkData owners preservation
|
||||
|
||||
Fix `groupLinkData` (Internal.hs:1330) to reconstruct `OwnerAuth` from `GroupKeys` instead of hardcoding `owners = []`. This ensures the resolved link data has the owner keys needed for verification.
|
||||
|
||||
Implementation: when `GroupKeys` has `GRKPrivate rootPrivKey` and `memberPrivKey`, reconstruct `OwnerAuth` with `ownerId = unMemberId memberId`, `ownerKey = publicKey memberPrivKey`, `authOwnerSig = sign rootPrivKey (ownerId <> encodePubKey ownerKey)`.
|
||||
|
||||
### Step 9: Tests
|
||||
|
||||
- Share channel card in direct chat (owner signed)
|
||||
- Share channel card in group (unsigned — no binding for groups without identity)
|
||||
- Share channel card in channel
|
||||
- Join via channel card — verify `connectPlan` shows verification result
|
||||
- Non-public group share rejected
|
||||
- Forwarded card has no signature
|
||||
- Old client compatibility (text field shown)
|
||||
|
||||
### Step 10: Directory bot
|
||||
|
||||
- Handle `MCChat` with `MCLGroup` in `crDirectoryEvent_`
|
||||
- Channel registration flow
|
||||
- Profile monitoring
|
||||
|
||||
## What stays from refactoring PR (already on master)
|
||||
|
||||
- `CBDirect` in `ChatBinding`
|
||||
- `HasShortLink` typeclass with `connShortLink'`
|
||||
- `setShortLinkType` / `setShortLinkType_`
|
||||
@@ -341,6 +341,7 @@ data ChatCommand
|
||||
| APIGetReactionMembers {userId :: UserId, groupId :: GroupId, chatItemId :: ChatItemId, reaction :: MsgReaction}
|
||||
| APIPlanForwardChatItems {fromChatRef :: ChatRef, chatItemIds :: NonEmpty ChatItemId}
|
||||
| APIForwardChatItems {toChatRef :: ChatRef, sendAsGroup :: ShowGroupAsSender, fromChatRef :: ChatRef, chatItemIds :: NonEmpty ChatItemId, ttl :: Maybe Int}
|
||||
| APIShareChatMsgContent {shareChatRef :: ChatRef, toSendRef :: SendRef}
|
||||
| APIUserRead UserId
|
||||
| UserRead
|
||||
| APIChatRead {chatRef :: ChatRef}
|
||||
@@ -469,7 +470,7 @@ data ChatCommand
|
||||
| AddContact IncognitoEnabled
|
||||
| APISetConnectionIncognito Int64 IncognitoEnabled
|
||||
| APIChangeConnectionUser Int64 UserId -- new user id to switch connection to
|
||||
| APIConnectPlan {userId :: UserId, connectionLink :: Maybe AConnectionLink} -- Maybe is used to report link parsing failure as special error
|
||||
| APIConnectPlan {userId :: UserId, connectionLink :: Maybe AConnectionLink, linkOwnerSig :: Maybe LinkOwnerSig} -- Maybe AConnectionLink is used to report link parsing failure as special error
|
||||
| APIPrepareContact UserId ACreatedConnLink ContactShortLinkData
|
||||
| APIPrepareGroup UserId CreatedLinkContact DirectLink GroupShortLinkData
|
||||
| APIChangePreparedContactUser ContactId UserId
|
||||
@@ -500,6 +501,7 @@ data ChatCommand
|
||||
| ForwardMessage {toChatName :: ChatName, fromContactName :: ContactName, forwardedMsg :: Text}
|
||||
| ForwardGroupMessage {toChatName :: ChatName, fromGroupName :: GroupName, fromMemberName_ :: Maybe ContactName, forwardedMsg :: Text}
|
||||
| ForwardLocalMessage {toChatName :: ChatName, forwardedMsg :: Text}
|
||||
| SharePublicGroup {shareGroupName :: GroupName, toChatName :: ChatName}
|
||||
| SendMessage SendName Text
|
||||
| SendMemberContactMessage GroupName ContactName Text
|
||||
| AcceptMemberContact ContactName
|
||||
@@ -760,6 +762,7 @@ data ChatResponse
|
||||
| CRLeftMemberUser {user :: User, groupInfo :: GroupInfo}
|
||||
| CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo, msgSigned :: Bool}
|
||||
| CRForwardPlan {user :: User, itemsCount :: Int, chatItemIds :: [ChatItemId], forwardConfirmation :: Maybe ForwardConfirmation}
|
||||
| CRChatMsgContent {user :: User, msgContent :: MsgContent}
|
||||
| CRRcvFileAccepted {user :: User, chatItem :: AChatItem}
|
||||
-- TODO add chatItem :: AChatItem
|
||||
| CRRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
|
||||
@@ -1007,14 +1010,14 @@ data ConnectionPlan
|
||||
deriving (Show)
|
||||
|
||||
data InvitationLinkPlan
|
||||
= ILPOk {contactSLinkData_ :: Maybe ContactShortLinkData}
|
||||
= ILPOk {contactSLinkData_ :: Maybe ContactShortLinkData, ownerVerification :: Maybe OwnerVerification}
|
||||
| ILPOwnLink
|
||||
| ILPConnecting {contact_ :: Maybe Contact}
|
||||
| ILPKnown {contact :: Contact}
|
||||
deriving (Show)
|
||||
|
||||
data ContactAddressPlan
|
||||
= CAPOk {contactSLinkData_ :: Maybe ContactShortLinkData}
|
||||
= CAPOk {contactSLinkData_ :: Maybe ContactShortLinkData, ownerVerification :: Maybe OwnerVerification}
|
||||
| CAPOwnLink
|
||||
| CAPConnectingConfirmReconnect
|
||||
| CAPConnectingProhibit {contact :: Contact}
|
||||
@@ -1023,13 +1026,18 @@ data ContactAddressPlan
|
||||
deriving (Show)
|
||||
|
||||
data GroupLinkPlan
|
||||
= GLPOk {groupSLinkInfo_ :: Maybe GroupShortLinkInfo, groupSLinkData_ :: Maybe GroupShortLinkData}
|
||||
= GLPOk {groupSLinkInfo_ :: Maybe GroupShortLinkInfo, groupSLinkData_ :: Maybe GroupShortLinkData, ownerVerification :: Maybe OwnerVerification}
|
||||
| GLPOwnLink {groupInfo :: GroupInfo}
|
||||
| GLPConnectingConfirmReconnect
|
||||
| GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
|
||||
| GLPKnown {groupInfo :: GroupInfo}
|
||||
deriving (Show)
|
||||
|
||||
data OwnerVerification
|
||||
= OVVerified
|
||||
| OVFailed {reason :: Text}
|
||||
deriving (Show)
|
||||
|
||||
type DirectLink = Bool
|
||||
|
||||
data GroupShortLinkInfo = GroupShortLinkInfo
|
||||
@@ -1042,11 +1050,11 @@ data GroupShortLinkInfo = GroupShortLinkInfo
|
||||
connectionPlanProceed :: ConnectionPlan -> Bool
|
||||
connectionPlanProceed = \case
|
||||
CPInvitationLink ilp -> case ilp of
|
||||
ILPOk _ -> True
|
||||
ILPOk {} -> True
|
||||
ILPOwnLink -> True
|
||||
_ -> False
|
||||
CPContactAddress cap -> case cap of
|
||||
CAPOk _ -> True
|
||||
CAPOk {} -> True
|
||||
CAPOwnLink -> True
|
||||
CAPConnectingConfirmReconnect -> True
|
||||
CAPContactViaAddress _ -> True
|
||||
@@ -1631,6 +1639,8 @@ $(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CLQ") ''ChatListQuery)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "OV") ''OwnerVerification)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "ILP") ''InvitationLinkPlan)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CAP") ''ContactAddressPlan)
|
||||
|
||||
@@ -101,6 +101,7 @@ import qualified Simplex.Messaging.Crypto.ShortLink as SL
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQSupportOff, pattern PQSupportOn)
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (base64P)
|
||||
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
|
||||
@@ -690,7 +691,7 @@ processChatCommand vr nm = \case
|
||||
gInfo@GroupInfo {groupId, membership} <- withFastStore $ \db -> getGroupInfo db vr user chatId
|
||||
when (isNothing scope) $ assertUserGroupRole gInfo GRAuthor
|
||||
let (_, ft_) = msgContentTexts mc
|
||||
if prohibitedSimplexLinks gInfo membership ft_
|
||||
if prohibitedSimplexLinks gInfo membership mc ft_
|
||||
then throwCmdError ("feature not allowed " <> T.unpack (groupFeatureNameText GFSimplexLinks))
|
||||
else do
|
||||
-- TODO [knocking] check chat item scope?
|
||||
@@ -999,7 +1000,13 @@ processChatCommand vr nm = \case
|
||||
CTContactConnection -> throwCmdError "not supported"
|
||||
where
|
||||
prepareMsgReq :: CChatItem c -> CM (Maybe (MsgContent, Maybe CryptoFile))
|
||||
prepareMsgReq (CChatItem _ ci) = forwardMsgContent ci $>>= forwardContent ci
|
||||
prepareMsgReq (CChatItem md ci) = forwardMsgContent ci $>>= forwardContent ci . dropOwnerSig
|
||||
where
|
||||
dropOwnerSig = \case
|
||||
mc@MCChat {text, chatLink}
|
||||
| SMDSnd <- md, fromChat == toChat -> mc
|
||||
| otherwise -> MCChat {text, chatLink, ownerSig = Nothing}
|
||||
mc -> mc
|
||||
forwardCIFF :: ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
|
||||
forwardCIFF ChatItem {meta = CIMeta {itemForwarded}} ciff = case itemForwarded of
|
||||
Nothing -> ciff
|
||||
@@ -1067,6 +1074,41 @@ processChatCommand vr nm = \case
|
||||
let formattedDate = formatTime defaultTimeLocale "%Y%m%d_%H%M%S" currentDate
|
||||
let ext = takeExtension fileName
|
||||
pure $ prefix <> formattedDate <> ext
|
||||
APIShareChatMsgContent (ChatRef CTGroup groupId _) toSendRef -> withUser $ \user -> do
|
||||
GroupInfo {groupProfile = gp@GroupProfile {publicGroup}, membership = GroupMember {memberId, memberRole}, groupKeys} <-
|
||||
withFastStore $ \db -> getGroupInfo db vr user groupId
|
||||
case publicGroup of
|
||||
Nothing -> throwCmdError "not a public group"
|
||||
Just PublicGroupProfile {groupLink} -> do
|
||||
let signingKeys = case (memberRole, groupKeys) of
|
||||
(GROwner, Just gk@GroupKeys {groupRootKey = GRKPrivate _}) -> Just gk
|
||||
_ -> Nothing
|
||||
ownerSig <-
|
||||
pure signingKeys $>>= \GroupKeys {memberPrivKey} ->
|
||||
mkLinkOwnerSig memberPrivKey groupLink memberId <$$> shareChatBinding user toSendRef
|
||||
let text = safeDecodeUtf8 $ strEncode groupLink
|
||||
pure $ CRChatMsgContent user MCChat {text, chatLink = MCLGroup groupLink gp, ownerSig}
|
||||
where
|
||||
mkLinkOwnerSig :: ConnectionModeI m => C.PrivateKeyEd25519 -> ConnShortLink m -> MemberId -> (ChatBinding, ByteString) -> LinkOwnerSig
|
||||
mkLinkOwnerSig privKey connLink MemberId {unMemberId} (cbTag, bindingData) =
|
||||
let ownerId = Just $ B64UrlByteString unMemberId
|
||||
cb = encodeChatBinding cbTag bindingData
|
||||
ownerSig = C.sign' privKey $ cb <> smpEncode connLink
|
||||
in LinkOwnerSig {ownerId, chatBinding = B64UrlByteString cb, ownerSig}
|
||||
shareChatBinding :: User -> SendRef -> CM (Maybe (ChatBinding, ByteString))
|
||||
shareChatBinding u = \case
|
||||
SRDirect contactId -> do
|
||||
ct <- withFastStore $ \db -> getContact db vr u contactId
|
||||
forM (contactConn ct) $ \conn ->
|
||||
(CBDirect,) <$> withAgent (`getConnectionRatchetAdHash` aConnId conn)
|
||||
SRGroup toGroupId _ asGroup -> do
|
||||
GroupInfo {groupProfile = GroupProfile {publicGroup}, membership = m} <- withFastStore $ \db -> getGroupInfo db vr u toGroupId
|
||||
pure $ mkBinding m <$> publicGroup
|
||||
where
|
||||
mkBinding GroupMember {memberId} PublicGroupProfile {publicGroupId = pgId}
|
||||
| asGroup = (CBChannel, smpEncode pgId)
|
||||
| otherwise = (CBGroup, smpEncode (pgId, memberId))
|
||||
APIShareChatMsgContent _ _ -> throwCmdError "sharing is only supported for public groups"
|
||||
APIUserRead userId -> withUserId userId $ \user -> withFastStore' (`setUserChatsRead` user) >> ok user
|
||||
UserRead -> withUser $ \User {userId} -> processChatCommand vr nm $ APIUserRead userId
|
||||
APIChatRead chatRef@(ChatRef cType chatId scope_) -> withUser $ \_ -> case cType of
|
||||
@@ -1933,9 +1975,9 @@ processChatCommand vr nm = \case
|
||||
createDirectConnection db newUser agConnId ccLink' Nothing ConnNew Nothing subMode initialChatVersion PQSupportOn
|
||||
deleteAgentConnectionAsync (aConnId' conn)
|
||||
pure conn'
|
||||
APIConnectPlan userId (Just cLink) -> withUserId userId $ \user ->
|
||||
uncurry (CRConnectionPlan user) <$> connectPlan user cLink
|
||||
APIConnectPlan _ Nothing -> throwChatError CEInvalidConnReq
|
||||
APIConnectPlan userId (Just cLink) linkOwnerSig_ -> withUserId userId $ \user ->
|
||||
uncurry (CRConnectionPlan user) <$> connectPlan user cLink linkOwnerSig_
|
||||
APIConnectPlan _ Nothing _ -> throwChatError CEInvalidConnReq
|
||||
APIPrepareContact userId accLink contactSLinkData -> withUserId userId $ \user -> do
|
||||
let ContactShortLinkData {profile, message, business} = contactSLinkData
|
||||
welcomeSharedMsgId <- forM message $ \_ -> getSharedMsgId
|
||||
@@ -2176,7 +2218,7 @@ processChatCommand vr nm = \case
|
||||
Connect incognito (Just cLink@(ACL m cLink')) -> withUser $ \user -> do
|
||||
-- TODO [relays] member: /c api to support groups with relays
|
||||
-- TODO - possibly by going through APIPrepareGroup -> APIConnectPreparedGroup
|
||||
(ccLink, plan) <- connectPlan user cLink `catchAllErrors` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing)); _ -> throwError e
|
||||
(ccLink, plan) <- connectPlan user cLink Nothing `catchAllErrors` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing Nothing)); _ -> throwError e
|
||||
connectWithPlan user incognito ccLink plan
|
||||
Connect _ Nothing -> throwChatError CEInvalidConnReq
|
||||
APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do
|
||||
@@ -2194,7 +2236,7 @@ processChatCommand vr nm = \case
|
||||
toView $ CEvtChatInfoUpdated user (AChatInfo SCTDirect $ DirectChat ct')
|
||||
throwError e
|
||||
ConnectSimplex incognito -> withUser $ \user -> do
|
||||
plan <- contactRequestPlan user adminContactReq Nothing `catchAllErrors` const (pure $ CPContactAddress (CAPOk Nothing))
|
||||
plan <- contactRequestPlan user adminContactReq Nothing Nothing `catchAllErrors` const (pure $ CPContactAddress (CAPOk Nothing Nothing))
|
||||
connectWithPlan user incognito (ACCL SCMContact (CCLink adminContactReq Nothing)) plan
|
||||
DeleteContact cName cdm -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId Nothing) cdm
|
||||
ClearContact cName -> withContactName cName $ \chatId -> APIClearChat $ ChatRef CTDirect chatId Nothing
|
||||
@@ -2288,6 +2330,19 @@ processChatCommand vr nm = \case
|
||||
toChatRef <- getChatRef user toChatName
|
||||
asGroup <- getSendAsGroup user toChatRef
|
||||
processChatCommand vr nm $ APIForwardChatItems toChatRef asGroup (ChatRef CTLocal folderId Nothing) (forwardedItemId :| []) Nothing
|
||||
SharePublicGroup shareGroupName toChatName -> withUser $ \user -> do
|
||||
groupId <- withFastStore $ \db -> getGroupIdByName db user shareGroupName
|
||||
toChatRef <- getChatRef user toChatName
|
||||
sendRef <- case toChatRef of
|
||||
ChatRef CTDirect ctId _ -> pure $ SRDirect ctId
|
||||
ChatRef CTGroup gId scope_ -> do
|
||||
gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId
|
||||
pure $ SRGroup gId scope_ (useRelays' gInfo)
|
||||
_ -> throwCmdError "unsupported share target"
|
||||
processChatCommand vr nm (APIShareChatMsgContent (ChatRef CTGroup groupId Nothing) sendRef) >>= \case
|
||||
CRChatMsgContent _ mc ->
|
||||
processChatCommand vr nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc]
|
||||
r -> pure r
|
||||
SendMessage sendName msg -> withUser $ \user -> do
|
||||
let mc = MCText msg
|
||||
case sendName of
|
||||
@@ -3888,28 +3943,29 @@ processChatCommand vr nm = \case
|
||||
pure (gId, chatSettings)
|
||||
_ -> throwCmdError "not supported"
|
||||
processChatCommand vr nm $ APISetChatSettings (ChatRef cType chatId Nothing) $ updateSettings chatSettings
|
||||
connectPlan :: User -> AConnectionLink -> CM (ACreatedConnLink, ConnectionPlan)
|
||||
connectPlan user (ACL SCMInvitation cLink) = case cLink of
|
||||
CLFull cReq -> invitationReqAndPlan cReq Nothing Nothing
|
||||
connectPlan :: User -> AConnectionLink -> Maybe LinkOwnerSig -> CM (ACreatedConnLink, ConnectionPlan)
|
||||
connectPlan user (ACL SCMInvitation cLink) sig_ = case cLink of
|
||||
CLFull cReq -> invitationReqAndPlan cReq Nothing Nothing Nothing
|
||||
CLShort l -> do
|
||||
let l' = serverShortLink l
|
||||
knownLinkPlans l' >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
(FixedLinkData {linkConnReq = cReq}, cData) <- getShortLinkConnReq nm user l'
|
||||
(FixedLinkData {linkConnReq = cReq, rootKey}, cData) <- getShortLinkConnReq nm user l'
|
||||
contactSLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
invitationReqAndPlan cReq (Just l') contactSLinkData_
|
||||
let ov = verifyLinkOwner rootKey [] l sig_
|
||||
invitationReqAndPlan cReq (Just l') contactSLinkData_ ov
|
||||
where
|
||||
knownLinkPlans l' = withFastStore $ \db -> do
|
||||
let inv cReq = ACCL SCMInvitation $ CCLink cReq (Just l')
|
||||
liftIO (getConnectionEntityViaShortLink db vr user l') >>= \case
|
||||
Just (cReq, ent) -> pure $ Just (inv cReq, invitationEntityPlan Nothing ent)
|
||||
Just (cReq, ent) -> pure $ Just (inv cReq, invitationEntityPlan Nothing Nothing ent)
|
||||
-- deleted contact is returned as known, as invitation link cannot be re-used too connect anyway
|
||||
Nothing -> bimap inv (CPInvitationLink . ILPKnown) <$$> getContactViaShortLinkToConnect db vr user l'
|
||||
invitationReqAndPlan cReq sLnk_ contactSLinkData_ = do
|
||||
plan <- invitationRequestPlan user cReq contactSLinkData_ `catchAllErrors` (pure . CPError)
|
||||
invitationReqAndPlan cReq sLnk_ cld ov = do
|
||||
plan <- invitationRequestPlan user cReq cld ov `catchAllErrors` (pure . CPError)
|
||||
pure (ACCL SCMInvitation (CCLink cReq sLnk_), plan)
|
||||
connectPlan user (ACL SCMContact cLink) = case cLink of
|
||||
connectPlan user (ACL SCMContact cLink) sig_ = case cLink of
|
||||
CLFull cReq -> do
|
||||
plan <- contactOrGroupRequestPlan user cReq `catchAllErrors` (pure . CPError)
|
||||
pure (ACCL SCMContact $ CCLink cReq Nothing, plan)
|
||||
@@ -3919,12 +3975,14 @@ processChatCommand vr nm = \case
|
||||
knownLinkPlans >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
(FixedLinkData {linkConnReq = cReq}, cData) <- getShortLinkConnReq nm user l'
|
||||
(FixedLinkData {linkConnReq = cReq, rootKey}, cData) <- getShortLinkConnReq nm user l'
|
||||
withFastStore' (\db -> getContactWithoutConnViaShortAddress db vr user l') >>= \case
|
||||
Just ct' | not (contactDeleted ct') -> pure (con cReq, CPContactAddress (CAPContactViaAddress ct'))
|
||||
_ -> do
|
||||
contactSLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
plan <- contactRequestPlan user cReq contactSLinkData_
|
||||
let ContactLinkData _ UserContactData {owners} = cData
|
||||
ov = verifyLinkOwner rootKey owners l' sig_
|
||||
plan <- contactRequestPlan user cReq contactSLinkData_ ov
|
||||
pure (con cReq, plan)
|
||||
where
|
||||
knownLinkPlans = withFastStore $ \db ->
|
||||
@@ -3945,8 +4003,8 @@ processChatCommand vr nm = \case
|
||||
knownLinkPlans >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
(fd, cData@(ContactLinkData _ UserContactData {direct, relays})) <- getShortLinkConnReq nm user l'
|
||||
let FixedLinkData {linkConnReq = cReq, linkEntityId} = fd
|
||||
(fd, cData@(ContactLinkData _ UserContactData {direct, owners, relays})) <- getShortLinkConnReq nm user l'
|
||||
let FixedLinkData {linkConnReq = cReq, linkEntityId, rootKey} = fd
|
||||
linkInfo = GroupShortLinkInfo {direct, groupRelays = relays, publicGroupId = B64UrlByteString <$> linkEntityId}
|
||||
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
-- Cross-validate linkEntityId and publicGroupId from profile:
|
||||
@@ -3957,7 +4015,8 @@ processChatCommand vr nm = \case
|
||||
(Just entityId, Just publicGroupId) | entityId == publicGroupId -> pure ()
|
||||
(Nothing, Nothing) -> pure ()
|
||||
_ -> throwChatError CEInvalidConnReq
|
||||
plan <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_
|
||||
let ov = verifyLinkOwner rootKey owners l' sig_
|
||||
plan <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_ ov
|
||||
pure (con cReq, plan)
|
||||
where
|
||||
knownLinkPlans = withFastStore $ \db ->
|
||||
@@ -3973,9 +4032,9 @@ processChatCommand vr nm = \case
|
||||
processChatCommand vr nm $ APIConnectContactViaAddress userId incognito contactId
|
||||
_ -> processChatCommand vr nm $ APIConnect userId incognito $ Just ccLink
|
||||
| otherwise = pure $ CRConnectionPlan user ccLink plan
|
||||
invitationRequestPlan :: User -> ConnReqInvitation -> Maybe ContactShortLinkData -> CM ConnectionPlan
|
||||
invitationRequestPlan user cReq contactSLinkData_ = do
|
||||
maybe (CPInvitationLink (ILPOk contactSLinkData_)) (invitationEntityPlan contactSLinkData_)
|
||||
invitationRequestPlan :: User -> ConnReqInvitation -> Maybe ContactShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan
|
||||
invitationRequestPlan user cReq cld ov = do
|
||||
maybe (CPInvitationLink (ILPOk cld ov)) (invitationEntityPlan cld ov)
|
||||
<$> withFastStore' (\db -> getConnectionEntityByConnReq db vr user $ invCReqSchemas cReq)
|
||||
where
|
||||
invCReqSchemas :: ConnReqInvitation -> (ConnReqInvitation, ConnReqInvitation)
|
||||
@@ -3983,15 +4042,15 @@ processChatCommand vr nm = \case
|
||||
( CRInvitationUri crData {crScheme = SSSimplex} e2e,
|
||||
CRInvitationUri crData {crScheme = simplexChat} e2e
|
||||
)
|
||||
invitationEntityPlan :: Maybe ContactShortLinkData -> ConnectionEntity -> ConnectionPlan
|
||||
invitationEntityPlan contactSLinkData_ = \case
|
||||
invitationEntityPlan :: Maybe ContactShortLinkData -> Maybe OwnerVerification -> ConnectionEntity -> ConnectionPlan
|
||||
invitationEntityPlan cld ov = \case
|
||||
RcvDirectMsgConnection Connection {connStatus, contactConnInitiated} ct_ -> case ct_ of
|
||||
Just ct
|
||||
| contactActive ct -> CPInvitationLink (ILPKnown ct)
|
||||
| otherwise -> CPInvitationLink (ILPOk contactSLinkData_)
|
||||
| otherwise -> CPInvitationLink (ILPOk cld ov)
|
||||
Nothing
|
||||
| connStatus == ConnNew && contactConnInitiated -> CPInvitationLink ILPOwnLink
|
||||
| connStatus == ConnPrepared -> CPInvitationLink (ILPOk contactSLinkData_)
|
||||
| connStatus == ConnPrepared -> CPInvitationLink (ILPOk cld ov)
|
||||
| otherwise -> CPInvitationLink (ILPConnecting Nothing)
|
||||
_ -> CPError $ ChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection"
|
||||
contactOrGroupRequestPlan :: User -> ConnReqContact -> CM ConnectionPlan
|
||||
@@ -3999,10 +4058,10 @@ processChatCommand vr nm = \case
|
||||
let ConnReqUriData {crClientData} = crData
|
||||
groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
|
||||
case groupLinkId of
|
||||
Nothing -> contactRequestPlan user cReq Nothing
|
||||
Just _ -> groupJoinRequestPlan user cReq Nothing Nothing
|
||||
contactRequestPlan :: User -> ConnReqContact -> Maybe ContactShortLinkData -> CM ConnectionPlan
|
||||
contactRequestPlan user (CRContactUri crData) contactSLinkData_ = do
|
||||
Nothing -> contactRequestPlan user cReq Nothing Nothing
|
||||
Just _ -> groupJoinRequestPlan user cReq Nothing Nothing Nothing
|
||||
contactRequestPlan :: User -> ConnReqContact -> Maybe ContactShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan
|
||||
contactRequestPlan user (CRContactUri crData) cld ov = do
|
||||
let cReqSchemas = contactCReqSchemas crData
|
||||
cReqHashes = bimap contactCReqHash contactCReqHash cReqSchemas
|
||||
withFastStore' (\db -> getUserContactLinkByConnReq db user cReqSchemas) >>= \case
|
||||
@@ -4012,19 +4071,19 @@ processChatCommand vr nm = \case
|
||||
Nothing ->
|
||||
withFastStore' (\db -> getContactWithoutConnViaAddress db vr user cReqSchemas) >>= \case
|
||||
Just ct | not (contactDeleted ct) -> pure $ CPContactAddress (CAPContactViaAddress ct)
|
||||
_ -> pure $ CPContactAddress (CAPOk contactSLinkData_)
|
||||
_ -> pure $ CPContactAddress (CAPOk cld ov)
|
||||
Just (RcvDirectMsgConnection Connection {connStatus} Nothing)
|
||||
| connStatus == ConnPrepared -> pure $ CPContactAddress (CAPOk contactSLinkData_)
|
||||
| connStatus == ConnPrepared -> pure $ CPContactAddress (CAPOk cld ov)
|
||||
| otherwise -> pure $ CPContactAddress CAPConnectingConfirmReconnect
|
||||
Just (RcvDirectMsgConnection _ (Just ct))
|
||||
| not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnectingProhibit ct)
|
||||
| contactDeleted ct -> pure $ CPContactAddress (CAPOk contactSLinkData_)
|
||||
| contactDeleted ct -> pure $ CPContactAddress (CAPOk cld ov)
|
||||
| otherwise -> pure $ CPContactAddress (CAPKnown ct)
|
||||
-- TODO [short links] RcvGroupMsgConnection branch is deprecated? (old group link protocol?)
|
||||
Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo Nothing Nothing
|
||||
Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo Nothing Nothing Nothing
|
||||
Just _ -> throwCmdError "found connection entity is not RcvDirectMsgConnection or RcvGroupMsgConnection"
|
||||
groupJoinRequestPlan :: User -> ConnReqContact -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> CM ConnectionPlan
|
||||
groupJoinRequestPlan user (CRContactUri crData) groupSLinkInfo_ groupSLinkData_ = do
|
||||
groupJoinRequestPlan :: User -> ConnReqContact -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan
|
||||
groupJoinRequestPlan user (CRContactUri crData) linkInfo gld ov = do
|
||||
let cReqSchemas = contactCReqSchemas crData
|
||||
cReqHashes = bimap contactCReqHash contactCReqHash cReqSchemas
|
||||
withFastStore' (\db -> getGroupInfoByUserContactLinkConnReq db vr user cReqSchemas) >>= \case
|
||||
@@ -4033,21 +4092,21 @@ processChatCommand vr nm = \case
|
||||
connEnt_ <- withFastStore' $ \db -> getContactConnEntityByConnReqHash db vr user cReqHashes
|
||||
gInfo_ <- withFastStore' $ \db -> getGroupInfoByGroupLinkHash db vr user cReqHashes
|
||||
case (gInfo_, connEnt_) of
|
||||
(Nothing, Nothing) -> pure $ CPGroupLink (GLPOk groupSLinkInfo_ groupSLinkData_)
|
||||
(Nothing, Nothing) -> pure $ CPGroupLink (GLPOk linkInfo gld ov)
|
||||
-- TODO [short links] RcvDirectMsgConnection branches are deprecated? (old group link protocol?)
|
||||
(Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> pure $ CPGroupLink GLPConnectingConfirmReconnect
|
||||
(Nothing, Just (RcvDirectMsgConnection _ (Just ct)))
|
||||
| not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnectingProhibit gInfo_)
|
||||
| otherwise -> pure $ CPGroupLink (GLPOk groupSLinkInfo_ groupSLinkData_)
|
||||
| otherwise -> pure $ CPGroupLink (GLPOk linkInfo gld ov)
|
||||
(Nothing, Just _) -> throwCmdError "found connection entity is not RcvDirectMsgConnection"
|
||||
(Just gInfo, _) -> groupPlan gInfo groupSLinkInfo_ groupSLinkData_
|
||||
groupPlan :: GroupInfo -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> CM ConnectionPlan
|
||||
groupPlan gInfo@GroupInfo {membership} groupSLinkInfo_ groupSLinkData_
|
||||
(Just gInfo, _) -> groupPlan gInfo linkInfo gld ov
|
||||
groupPlan :: GroupInfo -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan
|
||||
groupPlan gInfo@GroupInfo {membership} linkInfo gld ov
|
||||
| memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo)
|
||||
| not (memberActive membership) && not (memberRemoved membership) =
|
||||
pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo)
|
||||
| memberActive membership = pure $ CPGroupLink (GLPKnown gInfo)
|
||||
| otherwise = pure $ CPGroupLink (GLPOk groupSLinkInfo_ groupSLinkData_)
|
||||
| otherwise = pure $ CPGroupLink (GLPOk linkInfo gld ov)
|
||||
contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact)
|
||||
contactCReqSchemas crData =
|
||||
( CRContactUri crData {crScheme = SSSimplex},
|
||||
@@ -4059,6 +4118,16 @@ processChatCommand vr nm = \case
|
||||
serverShortLink = \case
|
||||
CSLInvitation _ srv lnkId linkKey -> CSLInvitation SLSServer srv lnkId linkKey
|
||||
CSLContact _ ct srv linkKey -> CSLContact SLSServer ct srv linkKey
|
||||
verifyLinkOwner :: ConnectionModeI m => C.PublicKeyEd25519 -> [OwnerAuth] -> ConnShortLink m -> Maybe LinkOwnerSig -> Maybe OwnerVerification
|
||||
verifyLinkOwner rootKey owners connLink =
|
||||
fmap $ \LinkOwnerSig {ownerId, chatBinding = B64UrlByteString bindingBytes, ownerSig} ->
|
||||
let signedData = bindingBytes <> smpEncode connLink
|
||||
findOwner (B64UrlByteString oId) = find (\OwnerAuth {ownerId = oId'} -> oId' == oId) owners
|
||||
in case maybe (Just rootKey) (fmap ownerKey . findOwner) ownerId of
|
||||
Nothing -> OVFailed "unknown owner"
|
||||
Just key
|
||||
| C.verify' key ownerSig signedData -> OVVerified
|
||||
| otherwise -> OVFailed "signature verification failed"
|
||||
contactShortLinkData :: Profile -> Maybe AddressSettings -> UserLinkData
|
||||
contactShortLinkData p settings =
|
||||
let msg = autoReply =<< settings
|
||||
@@ -4772,6 +4841,7 @@ chatCommandP =
|
||||
"/_reaction members " *> (APIGetReactionMembers <$> A.decimal <* " #" <*> A.decimal <* A.space <*> A.decimal <* A.space <*> (knownReaction <$?> jsonP)),
|
||||
"/_forward plan " *> (APIPlanForwardChatItems <$> chatRefP <*> _strP),
|
||||
"/_forward " *> (APIForwardChatItems <$> chatRefP <*> (" as_group=" *> onOffP <|> pure False) <* A.space <*> chatRefP <*> _strP <*> sendMessageTTLP),
|
||||
"/_share chat content " *> (APIShareChatMsgContent <$> chatRefP <* A.space <*> sendRefP),
|
||||
"/_read user " *> (APIUserRead <$> A.decimal),
|
||||
"/read user" $> UserRead,
|
||||
"/_read chat " *> (APIChatRead <$> chatRefP),
|
||||
@@ -4943,7 +5013,7 @@ chatCommandP =
|
||||
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayNameP <* A.space <* char_ '@' <*> (Just <$> displayNameP) <* A.space <*> quotedMsg <*> msgTextP),
|
||||
"/_contacts " *> (APIListContacts <$> A.decimal),
|
||||
"/contacts" $> ListContacts,
|
||||
"/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeTill (== ' ') $> Nothing)),
|
||||
"/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeTill (== ' ') $> Nothing) <*> optional (" sig=" *> jsonP)),
|
||||
"/_prepare contact " *> (APIPrepareContact <$> A.decimal <* A.space <*> connLinkP <* A.space <*> jsonP),
|
||||
"/_prepare group " *> (APIPrepareGroup <$> A.decimal <* A.space <*> connLinkP' <*> (" direct=" *> onOffP <|> pure True) <* A.space <*> jsonP),
|
||||
"/_set contact user @" *> (APIChangePreparedContactUser <$> A.decimal <* A.space <*> A.decimal),
|
||||
@@ -4960,6 +5030,7 @@ chatCommandP =
|
||||
ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayNameP <* A.space <* A.char '@' <*> (Just <$> displayNameP) <* A.space <*> msgTextP,
|
||||
ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayNameP <*> pure Nothing <* A.space <*> msgTextP,
|
||||
ForwardLocalMessage <$> chatNameP <* " <- * " <*> msgTextP,
|
||||
"/share chat #" *> (SharePublicGroup <$> displayNameP <* A.space <*> chatNameP),
|
||||
SendMessage <$> sendNameP <* A.space <*> msgTextP,
|
||||
"@#" *> (SendMemberContactMessage <$> displayNameP <* A.space <* char_ '@' <*> displayNameP <* A.space <*> msgTextP),
|
||||
"/accept_member_contact @" *> (AcceptMemberContact <$> displayNameP),
|
||||
|
||||
@@ -341,7 +341,7 @@ prohibitedGroupContent gInfo@GroupInfo {membership = mem@GroupMember {memberRole
|
||||
| isVoice mc && not (groupFeatureMemberAllowed SGFVoice m gInfo) && not hostApprovalVoice = Just GFVoice
|
||||
| isNothing scopeInfo && not (isVoice mc) && isJust file_ && not (groupFeatureMemberAllowed SGFFiles m gInfo) = Just GFFiles
|
||||
| isNothing scopeInfo && isReport mc && (badReportUser || not (groupFeatureAllowed SGFReports gInfo)) = Just GFReports
|
||||
| isNothing scopeInfo && prohibitedSimplexLinks gInfo m ft = Just GFSimplexLinks
|
||||
| isNothing scopeInfo && prohibitedSimplexLinks gInfo m mc ft = Just GFSimplexLinks
|
||||
| otherwise = Nothing
|
||||
where
|
||||
hostApprovalVoice
|
||||
@@ -358,10 +358,14 @@ prohibitedGroupContent gInfo@GroupInfo {membership = mem@GroupMember {memberRole
|
||||
| sent = userRole >= GRModerator
|
||||
| otherwise = userRole < GRModerator
|
||||
|
||||
prohibitedSimplexLinks :: GroupInfo -> GroupMember -> Maybe MarkdownList -> Bool
|
||||
prohibitedSimplexLinks gInfo m ft =
|
||||
prohibitedSimplexLinks :: GroupInfo -> GroupMember -> MsgContent -> Maybe MarkdownList -> Bool
|
||||
prohibitedSimplexLinks gInfo m mc ft =
|
||||
not (groupFeatureMemberAllowed SGFSimplexLinks m gInfo)
|
||||
&& maybe False (any ftIsSimplexLink) ft
|
||||
&& (isChatLink mc || maybe False (any ftIsSimplexLink) ft)
|
||||
where
|
||||
isChatLink = \case
|
||||
MCChat {} -> True
|
||||
_ -> False
|
||||
|
||||
ftIsSimplexLink :: FormattedText -> Bool
|
||||
ftIsSimplexLink FormattedText {format} = maybe False isSimplexLink format
|
||||
|
||||
@@ -1726,7 +1726,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
|
||||
newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> CM ()
|
||||
newContentMessage ct mc msg@RcvMessage {sharedMsgId_} msgMeta = do
|
||||
let MsgContainer {content, file = fInv_} = mc
|
||||
let MsgContainer {content = c, file = fInv_} = mc
|
||||
content <- case c of
|
||||
MCChat {text, chatLink, ownerSig = Just LinkOwnerSig {chatBinding = B64UrlByteString binding}} -> do
|
||||
keepSig <- case contactConn ct of
|
||||
Nothing -> pure False
|
||||
Just conn -> do
|
||||
adHash <- withAgent (`getConnectionRatchetAdHash` aConnId conn)
|
||||
pure $ encodeChatBinding CBDirect adHash == binding
|
||||
pure $ if keepSig then c else MCChat {text, chatLink, ownerSig = Nothing}
|
||||
_ -> pure c
|
||||
-- Uncomment to test stuck delivery on errors - see test testDirectMessageDelete
|
||||
-- case content of
|
||||
-- MCText "hello 111" ->
|
||||
@@ -1979,7 +1988,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
rejected gInfo' m' scopeInfo f = newChatItem gInfo' m' scopeInfo (ciContentNoParse $ CIRcvGroupFeatureRejected f) Nothing Nothing False
|
||||
timed_ gInfo' = if forwarded then rcvCITimed_ (Just Nothing) itemTTL else rcvGroupCITimed gInfo' itemTTL
|
||||
live' = fromMaybe False live_
|
||||
MsgContainer {content, mentions = MsgMentions mentions, file = fInv_, ttl = itemTTL, live = live_, scope = msgScope_, asGroup = asGroup_} = mc
|
||||
MsgContainer {content = c, mentions = MsgMentions mentions, file = fInv_, ttl = itemTTL, live = live_, scope = msgScope_, asGroup = asGroup_} = mc
|
||||
content = case c of
|
||||
MCChat {text, chatLink, ownerSig = Just LinkOwnerSig {chatBinding = B64UrlByteString binding}} -> case publicGroup of
|
||||
Just pgp | maybe False (binding ==) (expectedBinding pgp) -> c
|
||||
_ -> MCChat {text, chatLink, ownerSig = Nothing}
|
||||
_ -> c
|
||||
expectedBinding PublicGroupProfile {publicGroupId}
|
||||
| sentAsGroup = Just $ encodeChatBinding CBChannel (smpEncode publicGroupId)
|
||||
| otherwise = (\GroupMember {memberId} -> encodeChatBinding CBGroup (smpEncode (publicGroupId, memberId))) <$> m_
|
||||
GroupInfo {groupProfile = GroupProfile {publicGroup}} = gInfo
|
||||
sentAsGroup = asGroup_ == Just True
|
||||
ts@(_, ft_) = msgContentTexts content
|
||||
-- m' is Maybe GroupMember
|
||||
@@ -2030,7 +2048,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
|
||||
groupMessageUpdate :: GroupInfo -> Maybe GroupMember -> SharedMsgId -> MsgContent -> Map MemberName MsgMention -> Maybe MsgScope -> RcvMessage -> UTCTime -> Maybe Int -> Maybe Bool -> Maybe Bool -> CM (Maybe DeliveryTaskContext)
|
||||
groupMessageUpdate gInfo@GroupInfo {groupId} m_ sharedMsgId mc mentions msgScope_ msg@RcvMessage {msgId} brokerTs ttl_ live_ asGroup_
|
||||
| Just m <- m_, prohibitedSimplexLinks gInfo m ft_ =
|
||||
| Just m <- m_, prohibitedSimplexLinks gInfo m mc ft_ =
|
||||
messageWarning ("x.msg.update ignored: feature not allowed " <> groupFeatureNameText GFSimplexLinks) $> Nothing
|
||||
| otherwise = do
|
||||
updateRcvChatItem `catchCINotFound` \_ -> do
|
||||
|
||||
@@ -318,7 +318,7 @@ data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMess
|
||||
data KeyRef = KRMember
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ChatBinding = CBGroup
|
||||
data ChatBinding = CBGroup | CBDirect | CBChannel
|
||||
deriving (Eq, Show)
|
||||
|
||||
data MsgSignature = MsgSignature KeyRef C.ASignature
|
||||
@@ -381,10 +381,15 @@ instance Encoding KeyRef where
|
||||
c -> fail $ "invalid KeyRef tag: " <> show c
|
||||
|
||||
instance Encoding ChatBinding where
|
||||
smpEncode CBGroup = "G"
|
||||
smpEncode = \case
|
||||
CBGroup -> "G"
|
||||
CBDirect -> "D"
|
||||
CBChannel -> "C"
|
||||
smpP =
|
||||
A.anyChar >>= \case
|
||||
'G' -> pure CBGroup
|
||||
'D' -> pure CBDirect
|
||||
'C' -> pure CBChannel
|
||||
c -> fail $ "invalid ChatBinding: " <> show c
|
||||
|
||||
instance ToField ChatBinding where toField = toField . decodeLatin1 . smpEncode
|
||||
@@ -411,7 +416,8 @@ data MsgSigning = MsgSigning
|
||||
privKey :: C.PrivateKeyEd25519
|
||||
}
|
||||
|
||||
|
||||
encodeChatBinding :: ChatBinding -> ByteString -> ByteString
|
||||
encodeChatBinding cb bindingData = smpEncode cb <> bindingData
|
||||
|
||||
data ChatMsgEvent (e :: MsgEncoding) where
|
||||
XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
|
||||
@@ -685,7 +691,7 @@ data MsgContent
|
||||
| MCVoice {text :: Text, duration :: Int}
|
||||
| MCFile {text :: Text}
|
||||
| MCReport {text :: Text, reason :: ReportReason}
|
||||
| MCChat {text :: Text, chatLink :: MsgChatLink}
|
||||
| MCChat {text :: Text, chatLink :: MsgChatLink, ownerSig :: Maybe LinkOwnerSig}
|
||||
| MCUnknown {tag :: Text, text :: Text, json :: J.Object}
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -695,6 +701,13 @@ data MsgChatLink
|
||||
| MCLGroup {connLink :: ShortLinkContact, groupProfile :: GroupProfile}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data LinkOwnerSig = LinkOwnerSig
|
||||
{ ownerId :: Maybe B64UrlByteString,
|
||||
chatBinding :: B64UrlByteString,
|
||||
ownerSig :: C.Signature 'C.Ed25519
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
msgContentText :: MsgContent -> Text
|
||||
msgContentText = \case
|
||||
MCText t -> t
|
||||
@@ -757,6 +770,8 @@ newtype MsgMentions = MsgMentions (Map MemberName MsgMention)
|
||||
|
||||
$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MCL") ''MsgChatLink)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''LinkOwnerSig)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MsgMention)
|
||||
|
||||
instance FromJSON MsgMentions where
|
||||
@@ -803,7 +818,8 @@ instance FromJSON MsgContent where
|
||||
MCChat_ -> do
|
||||
text <- v .: "text"
|
||||
chatLink <- v .: "chatLink"
|
||||
pure MCChat {text, chatLink}
|
||||
ownerSig <- v .:? "ownerSig"
|
||||
pure MCChat {text, chatLink, ownerSig}
|
||||
MCUnknown_ tag -> do
|
||||
text <- fromMaybe unknownMsgType <$> v .:? "text"
|
||||
pure MCUnknown {tag, text, json = v}
|
||||
@@ -813,6 +829,9 @@ instance FromJSON MsgContent where
|
||||
unknownMsgType :: Text
|
||||
unknownMsgType = "unknown message type"
|
||||
|
||||
(.=?) :: ToJSON v => JT.Key -> Maybe v -> [(J.Key, J.Value)] -> [(J.Key, J.Value)]
|
||||
key .=? value = maybe id ((:) . (key .=)) value
|
||||
|
||||
instance ToJSON MsgContent where
|
||||
toJSON = \case
|
||||
MCUnknown {json} -> J.Object json
|
||||
@@ -823,7 +842,7 @@ instance ToJSON MsgContent where
|
||||
MCVoice {text, duration} -> J.object ["type" .= MCVoice_, "text" .= text, "duration" .= duration]
|
||||
MCFile t -> J.object ["type" .= MCFile_, "text" .= t]
|
||||
MCReport {text, reason} -> J.object ["type" .= MCReport_, "text" .= text, "reason" .= reason]
|
||||
MCChat {text, chatLink} -> J.object ["type" .= MCChat_, "text" .= text, "chatLink" .= chatLink]
|
||||
MCChat {text, chatLink, ownerSig} -> J.object $ ("ownerSig" .=? ownerSig) ["type" .= MCChat_, "text" .= text, "chatLink" .= chatLink]
|
||||
toEncoding = \case
|
||||
MCUnknown {json} -> JE.value $ J.Object json
|
||||
MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t
|
||||
@@ -833,7 +852,7 @@ instance ToJSON MsgContent where
|
||||
MCVoice {text, duration} -> J.pairs $ "type" .= MCVoice_ <> "text" .= text <> "duration" .= duration
|
||||
MCFile t -> J.pairs $ "type" .= MCFile_ <> "text" .= t
|
||||
MCReport {text, reason} -> J.pairs $ "type" .= MCReport_ <> "text" .= text <> "reason" .= reason
|
||||
MCChat {text, chatLink} -> J.pairs $ "type" .= MCChat_ <> "text" .= text <> "chatLink" .= chatLink
|
||||
MCChat {text, chatLink, ownerSig} -> J.pairs $ "type" .= MCChat_ <> "text" .= text <> "chatLink" .= chatLink <> maybe mempty ("ownerSig" .=) ownerSig
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MsgContainer)
|
||||
|
||||
@@ -1324,9 +1343,6 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
|
||||
XOk_ -> pure XOk
|
||||
XUnknown_ t -> pure $ XUnknown t params
|
||||
|
||||
(.=?) :: ToJSON v => JT.Key -> Maybe v -> [(J.Key, J.Value)] -> [(J.Key, J.Value)]
|
||||
key .=? value = maybe id ((:) . (key .=)) value
|
||||
|
||||
chatToAppMessage :: forall e. MsgEncodingI e => ChatMessage e -> AppMessage e
|
||||
chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @e of
|
||||
SBinary -> AMBinary AppMessageBinary {msgId = Nothing, tag = B.head $ strEncode tag, body = chatMsgBinaryToBody chatMsg}
|
||||
|
||||
@@ -229,7 +229,7 @@ createNewSndMessage db gVar connOrGroupId chatMsgEvent msgSigning_ encodeMessage
|
||||
ECMEncoded msgBody -> do
|
||||
let signedMsg_ = signBody <$> msgSigning_
|
||||
signBody MsgSigning {bindingTag, bindingData, keyRef, privKey} =
|
||||
let sig = C.ASignature C.SEd25519 $ C.sign' privKey (smpEncode bindingTag <> bindingData <> msgBody)
|
||||
let sig = C.ASignature C.SEd25519 $ C.sign' privKey (encodeChatBinding bindingTag bindingData <> msgBody)
|
||||
in SignedMsg {chatBinding = bindingTag, signatures = MsgSignature keyRef sig :| [], signedBody = msgBody}
|
||||
createdAt <- getCurrentTime
|
||||
DB.execute
|
||||
@@ -240,7 +240,7 @@ createNewSndMessage db gVar connOrGroupId chatMsgEvent msgSigning_ encodeMessage
|
||||
shared_msg_id, shared_msg_id_user, created_at, updated_at
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((MDSnd, toCMEventTag chatMsgEvent, DB.Binary msgBody, chatBinding <$> signedMsg_, DB.Binary . smpEncode . signatures <$> signedMsg_, connId_, groupId_)
|
||||
((MDSnd, toCMEventTag chatMsgEvent, DB.Binary msgBody, (\SignedMsg {chatBinding} -> chatBinding) <$> signedMsg_, DB.Binary . smpEncode . signatures <$> signedMsg_, connId_, groupId_)
|
||||
:. (DB.Binary sharedMsgId, Just (BI True), createdAt, createdAt))
|
||||
msgId <- insertedRowId db
|
||||
pure $ Right SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody, signedMsg_}
|
||||
@@ -327,7 +327,7 @@ createNewRcvMessage db connOrGroupId NewRcvMessage {chatMsgEvent, verifiedMsg, b
|
||||
shared_msg_id, author_group_member_id, forwarded_by_group_member_id)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((MDRcv, toCMEventTag chatMsgEvent, DB.Binary msgBody, chatBinding <$> signedMsg_, DB.Binary . smpEncode . signatures <$> signedMsg_, brokerTs, currentTs, currentTs, connId_, groupId_)
|
||||
((MDRcv, toCMEventTag chatMsgEvent, DB.Binary msgBody, (\SignedMsg {chatBinding} -> chatBinding) <$> signedMsg_, DB.Binary . smpEncode . signatures <$> signedMsg_, brokerTs, currentTs, currentTs, connId_, groupId_)
|
||||
:. (sharedMsgId_, authorMember, forwardedByMember))
|
||||
msgId <- insertedRowId db
|
||||
pure RcvMessage {msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgSigned, forwardedByMember}
|
||||
|
||||
@@ -1842,6 +1842,41 @@ SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_mem
|
||||
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
|
||||
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
|
||||
|
||||
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, member_pub_key, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
|
||||
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
SEARCH received_probes USING COVERING INDEX idx_received_probes_group_member_id (group_member_id=?)
|
||||
SEARCH sent_probe_hashes USING COVERING INDEX idx_sent_probe_hashes_group_member_id (group_member_id=?)
|
||||
SEARCH sent_probes USING COVERING INDEX idx_sent_probes_group_member_id (group_member_id=?)
|
||||
SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_group_member_id (group_member_id=?)
|
||||
SEARCH chat_item_moderations USING COVERING INDEX idx_chat_item_moderations_moderator_member_id (moderator_member_id=?)
|
||||
SEARCH chat_item_reactions USING COVERING INDEX idx_chat_item_reactions_group_member_id (group_member_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_scope_group_member_id (group_scope_group_member_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_forwarded_by_group_member_id (forwarded_by_group_member_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_item_deleted_by_group_member_id (item_deleted_by_group_member_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_member_id (group_member_id=?)
|
||||
SEARCH pending_group_messages USING COVERING INDEX idx_pending_group_messages_group_member_id (group_member_id=?)
|
||||
SEARCH messages USING COVERING INDEX idx_messages_forwarded_by_group_member_id (forwarded_by_group_member_id=?)
|
||||
SEARCH messages USING COVERING INDEX idx_messages_author_group_member_id (author_group_member_id=?)
|
||||
SEARCH connections USING COVERING INDEX idx_connections_group_member_id (group_member_id=?)
|
||||
SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_member_id=?)
|
||||
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
|
||||
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
|
||||
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
|
||||
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
|
||||
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
|
||||
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
|
||||
|
||||
Query:
|
||||
INSERT INTO group_relays
|
||||
(group_id, group_member_id, chat_relay_id, relay_status, created_at, updated_at)
|
||||
@@ -6530,6 +6565,10 @@ Query: SELECT COUNT(1) FROM contacts WHERE user_id = ? AND chat_item_ttl > 0
|
||||
Plan:
|
||||
SEARCH contacts USING INDEX idx_contacts_chat_ts (user_id=?)
|
||||
|
||||
Query: SELECT COUNT(1) FROM group_members WHERE member_role = 'owner' AND member_pub_key IS NOT NULL
|
||||
Plan:
|
||||
SCAN group_members
|
||||
|
||||
Query: SELECT COUNT(1) FROM groups WHERE user_id = ? AND chat_item_ttl > 0
|
||||
Plan:
|
||||
SEARCH groups USING INDEX sqlite_autoindex_groups_2 (user_id=?)
|
||||
|
||||
+44
-10
@@ -22,7 +22,7 @@ import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Char (isSpace, toUpper)
|
||||
import Data.Function (on)
|
||||
import Data.Int (Int64)
|
||||
import Data.List (groupBy, intercalate, intersperse, sortOn)
|
||||
import Data.List (groupBy, intercalate, intersperse, nub, sortOn)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
@@ -148,8 +148,8 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
|
||||
CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
|
||||
CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView
|
||||
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
|
||||
CRNewChatItems u chatItems -> viewChatItems ttyUser unmuted u chatItems ts tz
|
||||
CRChatItems u _ chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems
|
||||
CRNewChatItems u chatItems -> viewChatItems ttyUser unmuted u chatItems ts tz testView
|
||||
CRChatItems u _ chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item <> viewTestInfo testView item) chatItems
|
||||
CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz
|
||||
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
|
||||
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewItemUpdate chat item liveItems ts tz
|
||||
@@ -222,6 +222,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
|
||||
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRGroupDeletedUser u g signed -> ttyUser u [ttyGroup' g <> ": 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
|
||||
CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
|
||||
CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts
|
||||
@@ -407,7 +408,7 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView}
|
||||
CEvtContactRatchetSync u ct progress -> ttyUser u $ viewContactRatchetSync ct progress
|
||||
CEvtGroupMemberRatchetSync u g m progress -> ttyUser u $ viewGroupMemberRatchetSync g m progress
|
||||
CEvtChatInfoUpdated _ _ -> []
|
||||
CEvtNewChatItems u chatItems -> viewChatItems ttyUser unmuted u chatItems ts tz
|
||||
CEvtNewChatItems u chatItems -> viewChatItems ttyUser unmuted u chatItems ts tz testView
|
||||
CEvtChatItemsStatusesUpdated u chatItems
|
||||
| length chatItems <= 20 ->
|
||||
concatMap
|
||||
@@ -646,11 +647,12 @@ viewChatItems ::
|
||||
[AChatItem] ->
|
||||
UTCTime ->
|
||||
TimeZone ->
|
||||
Bool ->
|
||||
[StyledString]
|
||||
viewChatItems ttyUser unmuted u chatItems ts tz
|
||||
viewChatItems ttyUser unmuted u chatItems ts tz testView
|
||||
| length chatItems <= 20 =
|
||||
concatMap
|
||||
(\(AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewChatItem chat item False ts tz <> viewItemReactions item)
|
||||
(\(AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewChatItem chat item False ts tz <> viewItemReactions item <> viewTestInfo testView item)
|
||||
chatItems
|
||||
| all (\aci -> aChatItemDir aci == MDRcv) chatItems = ttyUser u [sShow (length chatItems) <> " new messages"]
|
||||
| all (\aci -> aChatItemDir aci == MDSnd) chatItems = ttyUser u [sShow (length chatItems) <> " messages sent"]
|
||||
@@ -949,6 +951,14 @@ viewItemReactions ChatItem {reactions} = [" " <> viewReactions reactions |
|
||||
viewReaction CIReactionCount {reaction = MREmoji (MREmojiChar emoji), userReacted, totalReacted} =
|
||||
plain [emoji, ' '] <> (if userReacted then styled Italic else plain) (show totalReacted)
|
||||
|
||||
viewTestInfo :: Bool -> ChatItem c d -> [StyledString]
|
||||
viewTestInfo testView ChatItem {content} = maybe [] (viewMsgTestInfo testView) $ ciMsgContent content
|
||||
|
||||
viewMsgTestInfo :: Bool -> MsgContent -> [StyledString]
|
||||
viewMsgTestInfo testView = \case
|
||||
MCChat {ownerSig = Just sig} | testView -> [viewJSON sig]
|
||||
_ -> []
|
||||
|
||||
viewReactionMembers :: [MemberReaction] -> [StyledString]
|
||||
viewReactionMembers memberReactions = [sShow (length memberReactions) <> " member(s) reacted"]
|
||||
|
||||
@@ -2039,7 +2049,7 @@ viewGroupUserChanged
|
||||
viewConnectionPlan :: ChatConfig -> ACreatedConnLink -> ConnectionPlan -> [StyledString]
|
||||
viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
|
||||
CPInvitationLink ilp -> case ilp of
|
||||
ILPOk contactSLinkData -> [invOrBiz contactSLinkData "ok to connect"] <> [viewJSON contactSLinkData | testView]
|
||||
ILPOk contactSLinkData ov -> [invOrBiz contactSLinkData "ok to connect"] <> viewSigVerification ov <> [viewJSON contactSLinkData | testView]
|
||||
ILPOwnLink -> [invLink "own link"]
|
||||
ILPConnecting Nothing -> [invLink "connecting"]
|
||||
ILPConnecting (Just ct) -> [invLink ("connecting to contact " <> ttyContact' ct)]
|
||||
@@ -2057,7 +2067,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
|
||||
| business -> ("business address: " <>)
|
||||
_ -> ("invitation link: " <>)
|
||||
CPContactAddress cap -> case cap of
|
||||
CAPOk contactSLinkData -> [addrOrBiz contactSLinkData "ok to connect"] <> [viewJSON contactSLinkData | testView]
|
||||
CAPOk contactSLinkData ov -> [addrOrBiz contactSLinkData "ok to connect"] <> viewSigVerification ov <> [viewJSON contactSLinkData | testView]
|
||||
CAPOwnLink -> [ctAddr "own address"]
|
||||
CAPConnectingConfirmReconnect -> [ctAddr "connecting, allowed to reconnect"]
|
||||
CAPConnectingProhibit ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)]
|
||||
@@ -2075,9 +2085,10 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
|
||||
| business -> ("business address: " <>)
|
||||
_ -> ("contact address: " <>)
|
||||
CPGroupLink glp -> case glp of
|
||||
GLPOk groupSLinkInfo_ groupSLinkData ->
|
||||
GLPOk groupSLinkInfo_ groupSLinkData ov ->
|
||||
let direct = maybe True (\(GroupShortLinkInfo {direct = d}) -> d) groupSLinkInfo_
|
||||
in [grpLink $ if direct then "ok to connect directly" else "ok to connect via relays"]
|
||||
<> viewSigVerification ov
|
||||
<> [viewJSON groupSLinkData | testView]
|
||||
GLPOwnLink g -> [grpLink "own link for group " <> ttyGroup' g]
|
||||
GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"]
|
||||
@@ -2113,6 +2124,10 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
|
||||
nextConnectPrepared Contact {preparedContact, activeConn} = case preparedContact of
|
||||
Just _ -> maybe True (\c -> connStatus c == ConnPrepared) activeConn
|
||||
_ -> False
|
||||
viewSigVerification = \case
|
||||
Just OVVerified -> ["owner signature: verified"]
|
||||
Just (OVFailed r) -> ["owner signature: FAILED (" <> plain r <> ")"]
|
||||
Nothing -> []
|
||||
|
||||
viewContactUpdated :: Contact -> Contact -> [StyledString]
|
||||
viewContactUpdated
|
||||
@@ -2212,7 +2227,26 @@ sentWithTime_ ts tz styledMsg CIMeta {itemTs} =
|
||||
prependFirst (ttyMsgTime ts tz itemTs <> " ") styledMsg
|
||||
|
||||
ttyMsgContent :: MsgContent -> [StyledString]
|
||||
ttyMsgContent = msgPlain . msgContentText
|
||||
ttyMsgContent = \case
|
||||
MCChat {text, chatLink, ownerSig} ->
|
||||
let (linkInfo, name, links) = viewChatLink chatLink
|
||||
signed = if isJust ownerSig then " (signed)" else ""
|
||||
body = if T.null text || text `elem` links then [] else msgPlain text
|
||||
in [plain $ linkInfo <> viewName name <> signed <> ":"] <> map plain links <> body
|
||||
mc -> msgPlain $ msgContentText mc
|
||||
where
|
||||
viewChatLink = \case
|
||||
MCLGroup {connLink, groupProfile = GroupProfile {displayName, publicGroup}} ->
|
||||
let (ref, links) = case publicGroup of
|
||||
Just PublicGroupProfile {groupType, groupLink} -> (textEncode groupType, nub [enc connLink, enc groupLink])
|
||||
Nothing -> ("group", [enc connLink])
|
||||
in ("link to join " <> ref <> " #", displayName, links)
|
||||
MCLContact {connLink, profile = Profile {displayName}} ->
|
||||
("contact address of @", displayName, [enc connLink])
|
||||
MCLInvitation {invLink, profile = Profile {displayName}} ->
|
||||
("one-time link of @", displayName, [enc invLink])
|
||||
enc :: StrEncoding a => a -> Text
|
||||
enc = safeDecodeUtf8 . strEncode
|
||||
|
||||
prependFirst :: StyledString -> [StyledString] -> [StyledString]
|
||||
prependFirst s [] = [s]
|
||||
|
||||
@@ -1,9 +1,23 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ChatTests.ChatRelays where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Groups (memberJoinChannel, memberJoinChannel', prepareChannel, prepareChannel', prepareChannel1Relay, setupRelay)
|
||||
import ChatTests.Utils
|
||||
import Control.Concurrent (threadDelay)
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import ProtocolTests (testGroupProfile)
|
||||
import Simplex.Chat.Protocol (LinkOwnerSig, MsgChatLink (..), MsgContent (..))
|
||||
import Simplex.Chat.Types (GroupProfile (..))
|
||||
import Simplex.Messaging.Encoding.String (StrEncoding (..))
|
||||
import Simplex.Messaging.Util (decodeJSON)
|
||||
import Test.Hspec hiding (it)
|
||||
|
||||
chatRelayTests :: SpecWith TestParams
|
||||
@@ -14,6 +28,10 @@ chatRelayTests = do
|
||||
it "re-add soft-deleted relay by same name" testReAddRelaySameName
|
||||
it "test chat relay" testChatRelayTest
|
||||
it "relay profile updated in address" testRelayProfileUpdateInAddress
|
||||
describe "share channel card" $ do
|
||||
it "share channel card in direct chat" testShareChannelDirect
|
||||
it "share channel card in group" testShareChannelGroup
|
||||
it "share channel card in channel" testShareChannelChannel
|
||||
|
||||
testGetSetChatRelays :: HasCallStack => TestParams -> IO ()
|
||||
testGetSetChatRelays ps =
|
||||
@@ -165,6 +183,151 @@ testRelayProfileUpdateInAddress ps =
|
||||
alice ##> ("/relay test " <> bobSLink)
|
||||
alice <## "relay test passed, profile: bob2 (Bob relay)"
|
||||
|
||||
testShareChannelDirect :: HasCallStack => TestParams -> IO ()
|
||||
testShareChannelDirect ps =
|
||||
testChat3 aliceProfile bobProfile cathProfile test ps
|
||||
where
|
||||
test alice bob cath = withRelay ps $ \relay -> do
|
||||
(shortLink, fullLink) <- prepareChannel1Relay "news" alice relay
|
||||
connectUsers alice bob
|
||||
-- alice gets ownerSig from share content API (for validation later)
|
||||
alice ##> "/_share chat content #1 @2"
|
||||
alice <## "link to join channel #news (signed):"
|
||||
(_, apiOwnerSig) <- getTermLine2 alice
|
||||
-- alice sends the card to bob
|
||||
alice ##> "/share chat #news @bob"
|
||||
alice <# "@bob link to join channel #news (signed):"
|
||||
_ <- getTermLine2 alice -- alice's testView ownerSig
|
||||
bob <# "alice> link to join channel #news (signed):"
|
||||
-- bob captures the received ownerSig from message view (testView)
|
||||
(sLink, cSig) <- getTermLine2 bob
|
||||
sLink `shouldBe` shortLink
|
||||
cSig `shouldBe` apiOwnerSig
|
||||
-- bob verifies owner signature via connect plan
|
||||
bob ##> ("/_connect plan 1 " <> shortLink <> " sig=" <> cSig)
|
||||
bob <## "group link: ok to connect via relays"
|
||||
bob <## "owner signature: verified"
|
||||
_ <- getTermLine bob -- group link data
|
||||
-- bob joins
|
||||
memberJoinChannel' "news" 1 0 1 0 [relay] [alice] shortLink fullLink bob
|
||||
connectUsers bob cath
|
||||
-- bob (subscriber) shares unsigned - not owner
|
||||
bob ##> "/share chat #news @cath"
|
||||
bob <# "@cath link to join channel #news:"
|
||||
_ <- getTermLine bob
|
||||
cath <# "bob> link to join channel #news:"
|
||||
_ <- getTermLine cath
|
||||
-- bob tries to replay alice's signed card to cath - binding mismatch, sig stripped at receive
|
||||
let sig = fromMaybe (error "bad sig") (decodeJSON (T.pack cSig) :: Maybe LinkOwnerSig)
|
||||
cLink = either error id $ strDecode (B.pack sLink)
|
||||
mc = MCChat (T.pack sLink) (MCLGroup cLink (testGroupProfile {displayName = "news"} :: GroupProfile)) (Just sig)
|
||||
cm = "{\"msgContent\":" <> LB.unpack (J.encode mc) <> "}"
|
||||
bob ##> ("/_send @3 json [" <> cm <> "]")
|
||||
bob <# "@cath link to join group #news (signed):"
|
||||
_ <- getTermLine2 bob -- bob's testView ownerSig (his sent has the sig data)
|
||||
-- cath sees it without signature - binding was for alice->bob, not bob->cath, sig stripped
|
||||
cath <# "bob> link to join group #news:"
|
||||
_ <- getTermLine cath
|
||||
-- cath joins anyway
|
||||
memberJoinChannel "news" [relay] [alice] shortLink fullLink cath
|
||||
alice #> "#news hello"
|
||||
relay <# "#news> hello"
|
||||
[bob, cath] *<# "#news> hello [>>]"
|
||||
|
||||
testShareChannelGroup :: HasCallStack => TestParams -> IO ()
|
||||
testShareChannelGroup ps =
|
||||
testChat3 aliceProfile bobProfile cathProfile test ps
|
||||
where
|
||||
test alice bob cath = withRelay ps $ \relay -> do
|
||||
(shortLink, fullLink) <- prepareChannel1Relay "news" alice relay
|
||||
createGroup2 "team" alice bob
|
||||
alice ##> "/share chat #news #team"
|
||||
alice <# "#team link to join channel #news:"
|
||||
_ <- getTermLine alice
|
||||
bob <# "#team alice> link to join channel #news:"
|
||||
sLink <- getTermLine bob
|
||||
sLink `shouldBe` shortLink
|
||||
memberJoinChannel' "news" 2 0 1 0 [relay] [alice] sLink fullLink bob
|
||||
createGroup2 "work" bob cath
|
||||
bob ##> "/share chat #news #work"
|
||||
bob <# "#work link to join channel #news:"
|
||||
_ <- getTermLine bob
|
||||
cath <# "#work bob> link to join channel #news:"
|
||||
_ <- getTermLine cath
|
||||
memberJoinChannel' "news" 2 0 0 0 [relay] [alice] shortLink fullLink cath
|
||||
alice #> "#news hello"
|
||||
relay <# "#news> hello"
|
||||
[bob, cath] *<# "#news> hello [>>]"
|
||||
|
||||
testShareChannelChannel :: HasCallStack => TestParams -> IO ()
|
||||
testShareChannelChannel ps =
|
||||
testChat3 aliceProfile bobProfile cathProfile test ps
|
||||
where
|
||||
test alice bob cath = withRelay ps $ \relay -> do
|
||||
relaySLink <- setupRelay alice relay
|
||||
(sLink1, fLink1) <- prepareChannel "news" alice relay
|
||||
(sLink2, fLink2) <- prepareChannel' 2 "updates" alice relay
|
||||
-- bob joins "updates" first (relay doesn't know bob yet, no suffix)
|
||||
memberJoinChannel "updates" [relay] [alice] sLink2 fLink2 bob
|
||||
-- alice (owner) shares "news" to "updates" - signed
|
||||
alice ##> "/_share chat content #1 #2(as_group=on)"
|
||||
alice <## "link to join channel #news (signed):"
|
||||
(apiLink, apiOwnerSig) <- getTermLine2 alice
|
||||
apiLink `shouldBe` sLink1
|
||||
alice ##> "/share chat #news #updates"
|
||||
alice <# "#updates link to join channel #news (signed):"
|
||||
_ <- getTermLine2 alice -- link, ownerSig
|
||||
relay <# "#updates> link to join channel #news (signed):"
|
||||
_ <- getTermLine2 relay -- link, ownerSig
|
||||
bob <# "#updates> link to join channel #news (signed): [>>]"
|
||||
(cLink, cSig) <- getTermLine2 bob
|
||||
cLink `shouldBe` (sLink1 <> " [>>]")
|
||||
cSig `shouldBe` apiOwnerSig
|
||||
-- bob verifies alice's signature via connect plan
|
||||
bob ##> ("/_connect plan 1 " <> sLink1 <> " sig=" <> cSig)
|
||||
bob <## "group link: ok to connect via relays"
|
||||
bob <## "owner signature: verified"
|
||||
_ <- getTermLine bob -- group link data
|
||||
-- bob joins "news" (group #2 for bob, relay knows bob from "updates" so sfx=1)
|
||||
memberJoinChannel' "news" 2 1 1 1 [relay] [alice] sLink1 fLink1 bob
|
||||
-- bob creates channel "bob_ch" for delivery to cath
|
||||
bob ##> ("/relays name=relay " <> relaySLink)
|
||||
bob <## "ok"
|
||||
(sLink3, fLink3) <- prepareChannel "bob_ch" bob relay
|
||||
memberJoinChannel "bob_ch" [relay] [bob] sLink3 fLink3 cath
|
||||
-- bob (subscriber) shares "news" to "bob_ch" - unsigned (not owner)
|
||||
bob ##> "/share chat #news #bob_ch"
|
||||
bob <# "#bob_ch link to join channel #news:"
|
||||
_ <- getTermLine bob
|
||||
relay <# "#bob_ch> link to join channel #news:"
|
||||
_ <- getTermLine relay
|
||||
cath <# "#bob_ch> link to join channel #news: [>>]"
|
||||
_ <- getTermLine cath
|
||||
-- bob tries to replay alice's signed card to bob_ch - binding mismatch, sig stripped at receive
|
||||
let sig = fromMaybe (error "bad sig") (decodeJSON (T.pack cSig) :: Maybe LinkOwnerSig)
|
||||
cLink' = either error id $ strDecode (B.pack sLink1)
|
||||
mc = MCChat (T.pack sLink1) (MCLGroup cLink' (testGroupProfile {displayName = "news"} :: GroupProfile)) (Just sig)
|
||||
cm = "{\"msgContent\":" <> LB.unpack (J.encode mc) <> "}"
|
||||
bob ##> ("/_send #3 json [" <> cm <> "]")
|
||||
bob <# "#bob_ch link to join group #news (signed):"
|
||||
_ <- getTermLine2 bob -- bob's testView ownerSig (his sent has the sig data)
|
||||
relay <# "#bob_ch bob_2> link to join group #news:"
|
||||
_ <- getTermLine relay
|
||||
cath <# "#bob_ch bob> link to join group #news: [>>]"
|
||||
_ <- getTermLine cath
|
||||
-- cath joins "news" (group #2 for cath since "bob_ch" is #1)
|
||||
memberJoinChannel' "news" 2 1 0 1 [relay] [alice] sLink1 fLink1 cath
|
||||
-- alice sends message, both receive
|
||||
alice #> "#news hello"
|
||||
relay <# "#news> hello"
|
||||
[bob, cath] *<# "#news> hello [>>]"
|
||||
|
||||
getTermLine2 :: TestCC -> IO (String, String)
|
||||
getTermLine2 c = (,) <$> getTermLine c <*> getTermLine c
|
||||
|
||||
withRelay :: HasCallStack => TestParams -> (TestCC -> IO ()) -> IO ()
|
||||
withRelay ps = withNewTestChatOpts ps relayTestOpts "relay" relayProfile
|
||||
|
||||
-- Create a public group with relay=1, wait for relay to join
|
||||
createChannelWithRelay :: HasCallStack => String -> TestCC -> TestCC -> IO ()
|
||||
createChannelWithRelay gName owner relay = do
|
||||
|
||||
+27
-11
@@ -8440,16 +8440,25 @@ createChannel1Relay gName owner relay cath dan eve = do
|
||||
forM_ [cath, dan, eve] $ \member ->
|
||||
memberJoinChannel gName [relay] [owner] shortLink fullLink member
|
||||
|
||||
prepareChannel1Relay :: String -> TestCC -> TestCC -> IO (String, String)
|
||||
prepareChannel1Relay gName owner relay = do
|
||||
setupRelay :: TestCC -> TestCC -> IO String
|
||||
setupRelay owner relay = do
|
||||
rName <- userName relay
|
||||
|
||||
relay ##> "/ad"
|
||||
(relaySLink, _cLink) <- getContactLinks relay True
|
||||
|
||||
owner ##> ("/relays name=" <> rName <> " " <> relaySLink)
|
||||
owner <## "ok"
|
||||
pure relaySLink
|
||||
|
||||
prepareChannel1Relay :: String -> TestCC -> TestCC -> IO (String, String)
|
||||
prepareChannel1Relay gName owner relay = do
|
||||
_ <- setupRelay owner relay
|
||||
prepareChannel gName owner relay
|
||||
|
||||
prepareChannel :: String -> TestCC -> TestCC -> IO (String, String)
|
||||
prepareChannel = prepareChannel' 1
|
||||
|
||||
prepareChannel' :: Int -> String -> TestCC -> TestCC -> IO (String, String)
|
||||
prepareChannel' relayId gName owner relay = do
|
||||
owner ##> ("/public group relays=1 #" <> gName)
|
||||
owner <## ("group #" <> gName <> " is created")
|
||||
owner <## "wait for selected relay(s) to join, then you can invite members via group link"
|
||||
@@ -8457,7 +8466,7 @@ prepareChannel1Relay gName owner relay = do
|
||||
concurrentlyN_
|
||||
[ do
|
||||
owner <## ("#" <> gName <> ": group link relays updated, current relays:")
|
||||
owner <## " - relay id 1: active"
|
||||
owner <## (" - relay id " <> show relayId <> ": active")
|
||||
owner <## "group link:"
|
||||
_ <- getTermLine owner
|
||||
pure (),
|
||||
@@ -8516,10 +8525,17 @@ prepareChannel2Relays gName owner relay1 relay2 = do
|
||||
getGroupLinks owner gName GRMember False
|
||||
|
||||
memberJoinChannel :: String -> [TestCC] -> [TestCC] -> String -> String -> TestCC -> IO ()
|
||||
memberJoinChannel gName relays owners shortLink fullLink member = do
|
||||
memberJoinChannel gName = memberJoinChannel' gName 1 0 0 0
|
||||
|
||||
-- | sfx params: relaySfx - how relay/owner see the member, memberRelaySfx - how member sees relay
|
||||
memberJoinChannel' :: String -> Int -> Int -> Int -> Int -> [TestCC] -> [TestCC] -> String -> String -> TestCC -> IO ()
|
||||
memberJoinChannel' gName gId relaySfx ownerSfx memberRelaySfx relays owners shortLink fullLink member = do
|
||||
mName <- userName member
|
||||
mFullName <- showName member
|
||||
relayNames <- mapM userName relays
|
||||
let sfxMName s = if s == 0 then mName else mName <> "_" <> show s
|
||||
sfxName s = if s == 0 then mFullName else sfxMName s <> drop (length mName) mFullName
|
||||
sfxRelayName rn = if memberRelaySfx == 0 then rn else rn <> "_" <> show memberRelaySfx
|
||||
relayNames <- mapM (\r -> sfxRelayName <$> userName r) relays
|
||||
|
||||
member ##> ("/_connect plan 1 " <> shortLink)
|
||||
member <## "group link: ok to connect via relays"
|
||||
@@ -8528,7 +8544,7 @@ memberJoinChannel gName relays owners shortLink fullLink member = do
|
||||
member ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " direct=off " <> groupSLinkData)
|
||||
member <## ("#" <> gName <> ": group is prepared")
|
||||
|
||||
member ##> "/_connect group #1"
|
||||
member ##> ("/_connect group #" <> show gId)
|
||||
member <## ("#" <> gName <> ": connection started")
|
||||
concurrentlyN_ $
|
||||
[ member
|
||||
@@ -8540,11 +8556,11 @@ memberJoinChannel gName relays owners shortLink fullLink member = do
|
||||
]
|
||||
]
|
||||
<> [ do
|
||||
relay <## (mFullName <> ": accepting request to join group #" <> gName <> "...")
|
||||
relay <## ("#" <> gName <> ": " <> mName <> " joined the group")
|
||||
relay <## (sfxName relaySfx <> ": accepting request to join group #" <> gName <> "...")
|
||||
relay <## ("#" <> gName <> ": " <> sfxMName relaySfx <> " joined the group")
|
||||
| relay <- relays
|
||||
]
|
||||
<> [ owner <### [EndsWith ("added " <> mFullName <> " to the group")]
|
||||
<> [ owner <### [EndsWith ("added " <> sfxName ownerSfx <> " to the group")]
|
||||
| owner <- owners
|
||||
]
|
||||
|
||||
|
||||
@@ -81,6 +81,9 @@ frankProfile = mkProfile "frank" "Frank" Nothing
|
||||
businessProfile :: Profile
|
||||
businessProfile = mkProfile "biz" "Biz Inc" Nothing
|
||||
|
||||
relayProfile :: Profile
|
||||
relayProfile = mkProfile "relay" "Relay" Nothing
|
||||
|
||||
mkProfile :: T.Text -> T.Text -> Maybe ImageData -> Profile
|
||||
mkProfile displayName descr image = Profile {displayName, fullName = "", shortDescr = Just descr, image, contactLink = Nothing, peerType = Nothing, preferences = defaultPrefs}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user