mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-08-27 22:34:51 +00:00
core: add optional profile description
This commit is contained in:
Evgeny @ SimpleX Chat
@@ -638,8 +638,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
|
||||
Right CRGroupLink {groupLink = GroupLink {connLinkContact = CCLink cr sl_}} ->
|
||||
let linkBefore_ = profileGroupLinkText fromGroup
|
||||
linkNow_ = profileGroupLinkText toGroup
|
||||
profileGroupLinkText GroupInfo {groupProfile = gp} =
|
||||
maybe Nothing (fmap (\(FormattedText _ t) -> t) . find ftHasLink) $ parseMaybeMarkdownList =<< description gp
|
||||
profileGroupLinkText GroupInfo {groupProfile = GroupProfile {description = descr_}} =
|
||||
maybe Nothing (fmap (\(FormattedText _ t) -> t) . find ftHasLink) $ parseMaybeMarkdownList =<< descr_
|
||||
ftHasLink = \case
|
||||
FormattedText (Just SimplexLink {simplexUri = ACL SCMContact cLink}) _ -> case cLink of
|
||||
CLFull cr' -> sameConnReqContact cr' cr
|
||||
|
||||
@@ -0,0 +1,509 @@
|
||||
# Directory registration of businesses and service bots (via signed contact card)
|
||||
|
||||
Status: draft plan for review. Grounded against the current tree (branch `ep/improve-names-2`).
|
||||
|
||||
## 1. Goal
|
||||
|
||||
Let a business or a service (chat bot) operator register their **contact `/a` address** in
|
||||
the directory by **forwarding a signed contact card** to the directory bot — exactly the
|
||||
UX we already have for channels (`/share chat #ch @'SimpleX Directory'`), but for a contact
|
||||
address instead of a channel link.
|
||||
|
||||
**Guiding principle: the flow is the channel registration flow verbatim — owner-signed card, admin
|
||||
approval, re-approval on any profile change, the same periodic link-check loop — differing only in
|
||||
the listing type (a contact `peerType`, not a group). Where a detail is unspecified here, the answer
|
||||
is "whatever channels do."**
|
||||
|
||||
Product decisions from the discussion, baked into this plan:
|
||||
|
||||
- **The owner sends the card, and the signature is the authorization.** The `ownerSig` (signed
|
||||
with the address key) is what proves the address owner authorized the listing — only the key
|
||||
holder can produce it. We deliberately do NOT use a "directory connects and asks the owner to
|
||||
confirm" double opt-in (it is a spam vector, like any mailing-list signup). "Submitter ≠ owner"
|
||||
is handled not by letting non-owners submit, but by giving the owner's tooling a way to send (the
|
||||
support-bot entry point that would cover the headless case is deferred — §B.4).
|
||||
- **The directory does NOT connect to / join these addresses.** They are not groups. It verifies
|
||||
the signature via a link-data *fetch* (not a connection) and records the address in a new table.
|
||||
- **One table for both businesses and bots** — they are all contact `/a` addresses. The MVP types
|
||||
each accepted registration by `peerType`: a **bot** requires `peerType == CPTBot`; a **business**
|
||||
requires `peerType ∈ {CPTHuman, CPTBusiness}` (an unset `peerType` counts as `CPTHuman`); an
|
||||
unrecognized `CPTUnknown` is rejected. The admin then manually verifies a business before
|
||||
approving — as for channels.
|
||||
- **Listing type = `ChatPeerType`.** Extend `ChatPeerType` (today `CPTHuman | CPTBot`, `Types.hs:710`)
|
||||
with **`CPTBusiness`** and **`CPTUnknown Text`** (forward-compat, like `GTUnknown`), and make the
|
||||
decoder **lenient** (unknown tag → `CPTUnknown`) so this version won't choke on future tags.
|
||||
**Wire-compat caveat (verified):** `ChatPeerType` decodes strictly today
|
||||
(`textDecode … _ -> Nothing`, `Profile` via `deriveJSON`), so a present-but-unknown `peerType`
|
||||
makes an *already-deployed* app fail to parse the whole profile — it does **not** downgrade to
|
||||
human. So a business must **not** publish `CPTBusiness` yet (old apps couldn't reach it); a
|
||||
business's profile stays `CPTHuman` in practice, with `CPTBusiness` reserved for later. The MVP
|
||||
types a **bot** from `peerType == CPTBot` and a **business** from `peerType ∈ {CPTHuman,
|
||||
CPTBusiness}` (unset ≙ `CPTHuman`), rejecting `CPTUnknown`; it stores the resolved type
|
||||
(`CPTBot`/`CPTBusiness`) on the listing. When the lenient version is broadly adopted, businesses
|
||||
can publish `CPTBusiness` directly.
|
||||
- **`peerType` and `businessAddress` are orthogonal, and the directory ignores `businessAddress`.**
|
||||
`businessAddress` chooses the *conversation type* a connector gets (a business chat / group vs a
|
||||
direct 1:1); it can be set by non-businesses, and a real business may run a plain direct-chat
|
||||
address. The directory does **not** use it to classify — the type comes from the profile's
|
||||
`peerType` (bot vs human/business, above), not from `businessAddress`. (App-side only, unchanged:
|
||||
the connect-preview briefcase shows when **either** `businessAddress` or `peerType == CPTBusiness`;
|
||||
bot cube from `peerType`, else person — in the MVP that briefcase comes from `businessAddress`.
|
||||
Separate from directory classification.)
|
||||
- **Description lives on the contact `Profile`** (new `description` field, parallel to
|
||||
`GroupProfile.description`). In group-member profiles it is **redacted per the group's policy —
|
||||
the same treatment `shortDescr` gets** (links/names stripped when the group prohibits them), not
|
||||
removed wholesale. It is carried **full** in the direct contact view, the address link preview,
|
||||
and the directory. See §G.
|
||||
- **`peerType` + `description` are visible in the app independent of the directory** (that is why
|
||||
owners will set them). `peerType` drives the type icon in the pre-connect alert
|
||||
(`ConnectPlan.kt:698-713`) and a marker in the chat list / chat banner. The compact surfaces (the
|
||||
alert, the shared-link card) are too small for the large `description`, so it appears via a
|
||||
**"Read more"** affordance in the **chat banner** (`ChatView.kt` `ChatBannerView`) and the
|
||||
**contact info page** (`ChatInfoView.kt:778`) that opens the full text in a sheet (iOS) / alert
|
||||
(Kotlin). These are NOT the welcome/auto-reply message (`AddressSettings.autoReply`, transient
|
||||
on-connect). Full details in §H.
|
||||
|
||||
Deliverables: (a) an API + CLI to prepare and share the signed contact card; (b) the
|
||||
`Profile.description` field; (c) directory handling that verifies and stores the address; (d) admin
|
||||
approval, web listing, and search. (A support-bot entry point for headless businesses is out of
|
||||
scope for now — §B.4.)
|
||||
|
||||
## 2. End-to-end flow
|
||||
|
||||
```
|
||||
Operator's client Directory bot
|
||||
----------------- -------------
|
||||
/share address @'SimpleX Directory'
|
||||
-> get own /a address (short link,
|
||||
businessAddress flag, root key)
|
||||
-> build MCChat { chatLink =
|
||||
MCLContact {connLink, profile, business},
|
||||
ownerSig = sign(rootPrivKey,
|
||||
chatBinding <> connLink) } ── card ──▶ DEChatLinkReceived (MCLContact, ownerSig)
|
||||
-> APIConnectPlan (PLAN only, no connect)
|
||||
fetches link data (opaque) + verifies sig
|
||||
=> CPContactAddress (CAPOk {ownerVerification})
|
||||
-> if OVVerified:
|
||||
addContactReg (bot if CPTBot,
|
||||
else business), status pending
|
||||
notify admins with profile (admin verifies)
|
||||
admins: /approve ... -> status active -> listingsUpdated
|
||||
-> web listing.json + bot search include it
|
||||
```
|
||||
|
||||
Nothing is connected or joined. The only network action on the directory side is a one-time,
|
||||
opaque link-data fetch for signature verification (consistent with the established rule that
|
||||
the directory may fetch link data, only name *resolution* leaks membership).
|
||||
|
||||
## 3. What already exists (reuse map)
|
||||
|
||||
All grounded in the current tree:
|
||||
|
||||
- **Chat-link card type** — `MCLContact {connLink :: ShortLinkContact, profile :: Profile, business :: Bool}`
|
||||
already exists (`src/Simplex/Chat/Protocol.hs:769`). `MCChat {text, chatLink, ownerSig}` and
|
||||
`LinkOwnerSig {ownerId, chatBinding, ownerSig}` at `Protocol.hs:764,774`.
|
||||
- **Owner-signature verification for contact addresses is already wired.** `connectPlan`'s
|
||||
`CTShortContact CCTContact` path fetches `FixedLinkData {rootKey}` + `UserContactData {owners}`
|
||||
and computes `ov = verifyLinkOwner rootKey owners l' sig_`, surfaced as
|
||||
`CPContactAddress (CAPOk {contactSLinkData_, ownerVerification})`
|
||||
(`src/Simplex/Chat/Library/Commands.hs:4287-4289,4518-4527`; `Controller.hs:1114-1121,1139-1142`).
|
||||
For plain/business addresses `owners == []`, so `ownerId = Nothing` and verification uses the
|
||||
link **root key** (`verifyLinkOwner` fallback).
|
||||
- **The directory already receives any `MCChat` card as `DEChatLinkReceived`** — `Directory/Events.hs:108`
|
||||
turns `(MCChat {chatLink, ownerSig}, Nothing)` into `DEChatLinkReceived`. Today `deChatLinkReceived`
|
||||
only matches `MCLGroup` and otherwise replies "Only channels can be added to directory via link."
|
||||
(`Directory/Service.hs:964-979`). We add an `MCLContact` case.
|
||||
- **Card-sharing UI + API + signing** — `/share chat #g @to` → `SharePublicGroup`
|
||||
(`Commands.hs:2437-2449`, parser `Commands.hs:5551`) → `APIShareChatMsgContent`
|
||||
(`Commands.hs:1136-1170`) which builds the `MCChat` and signs with `mkLinkOwnerSig` +
|
||||
`shareChatBinding` (binds the card to the recipient connection, anti-replay).
|
||||
- **Address key + business flag storage** — `link_priv_sig_key` (the address root private key,
|
||||
Ed25519) is stored in `user_contact_links` by `createUserContactLink`
|
||||
(`src/Simplex/Chat/Store/Profiles.hs:429-439`); `businessAddress` lives in `AddressSettings`
|
||||
(`Profiles.hs:497-502`) and is published as `ContactShortLinkData.business`
|
||||
(`Commands.hs:4528-4533`, `Protocol.hs:1584-1592`). Note: `getUserAddress`/`UserContactLink`
|
||||
do **not** currently read `link_priv_sig_key` back (`Profiles.hs:479-524`).
|
||||
- **Directory store / listing / web infra** — `sx_directory_group_regs` table
|
||||
(`Directory/Store/{SQLite,Postgres}/Migrations.hs`), `GroupReg`/`GroupRegStatus`
|
||||
(`Directory/Store.hs:116-226`), `getAllListedGroups_` (`Store.hs:354-363`), `generateListing`
|
||||
(`Directory/Listing.hs:148-170`), `DirectoryEntry`/`DirectoryEntryType = DETGroup`
|
||||
(`Listing.hs:55-86`), website renderer `website/src/js/directory.jsc`.
|
||||
|
||||
## 4. Work items
|
||||
|
||||
### A. Protocol / types
|
||||
|
||||
- `MCLContact` exists; no new protocol message for the card itself.
|
||||
- **Extend `ChatPeerType`** (`Types.hs:710`, today `CPTHuman | CPTBot`) with `CPTBusiness` and
|
||||
`CPTUnknown Text` (forward-compat, like `GTUnknown`). Update the `TextEncoding`/JSON instances
|
||||
(`Types.hs:724-731`): encode `CPTBusiness` as `"business"` and `CPTUnknown t` back to `t`
|
||||
(round-trips the original tag); make `textDecode` **lenient** — an unrecognized tag becomes
|
||||
`CPTUnknown t` instead of `Nothing`, so this version never fails to parse a profile with a future
|
||||
tag. **Verified constraint:** the *current* decoder is strict (`_ -> Nothing`) and `Profile`
|
||||
is `deriveJSON`-parsed, so an already-deployed app fails the whole profile on an unknown `peerType`;
|
||||
therefore `CPTBusiness` must not be published on profiles until the lenient version is broadly
|
||||
adopted. **MVP:** the directory types a **bot** from `peerType == CPTBot` and a **business** from
|
||||
`peerType ∈ {CPTHuman, CPTBusiness}` (unset ≙ `CPTHuman`; stored as `CPTBusiness`), and **rejects
|
||||
`CPTUnknown`**. Businesses are then admin-verified — the admin is the gate, as for channels.
|
||||
- **New optional `description :: Maybe Text` on `Profile`** (`Types.hs:693`), parallel to
|
||||
`GroupProfile.description` (`Types.hs:867`). Additive/nullable — only businesses/bots set it.
|
||||
It rides into the address link data automatically (`ContactShortLinkData` embeds the whole
|
||||
`Profile`, `Protocol.hs:1584`), so the directory reads it from the fetched link data. It is
|
||||
redacted per group policy in group-member profiles, on **both send and receive** (see §G). No
|
||||
version bump is needed — `Profile` is `deriveJSON`-parsed and aeson ignores unknown keys, so old
|
||||
apps just drop `description` (same as when `peerType`/`badge`/`contactDomain` were added).
|
||||
- **Setting `peerType`/`description` (for tests + eventual UI).** Both are plain `Profile` fields, so
|
||||
they ride through the existing profile-update path (`APIUpdateProfile` / the `/p` command); tests
|
||||
drive them via `/_profile`. A small dedicated setter for the multi-line `description` is worth
|
||||
adding for CLI ergonomics. The app-UI toggle to set `peerType = CPTBusiness` is deferred (per the
|
||||
wire-compat caveat above).
|
||||
|
||||
### B. Client: prepare + share the contact-address card
|
||||
|
||||
1. **Signing key — from the agent, not the chat DB.** Sign the card with the address short-link key
|
||||
via `getConnLinkPrivKey (aConnId addressConn)` (already in the agent, used at `Subscriber.hs:1649`;
|
||||
`getUserAddressConnection` gives the connection). This is the authoritative key — the private half
|
||||
of the short link's root key the directory verifies against — and it exists whenever the short link
|
||||
does, **including right after an upgrade** (`setConnShortLink` provisions it). Do **not** read the
|
||||
chat-DB `link_priv_sig_key` for signing: it is written only at `createUserContactLink` and never on
|
||||
upgrade. *(Separate cleanup, off the signing path: persist `link_priv_sig_key` on upgrade too —
|
||||
`setMyAddressData`/`setUserContactLinkShortLink` — reading it back via `getConnLinkPrivKey` so the
|
||||
column stops being stale.)*
|
||||
2. **Card-builder API — `APIShareMyAddress {toSendRef :: SendRef}`** (Controller) + handler in
|
||||
`Commands.hs`, mirroring the group-share case (`APIShareChatMsgContent`, `Commands.hs:1136`):
|
||||
- `getUserAddress` → `connLinkContact` (short link) + profile + `businessAddress`.
|
||||
- `getUserAddressConnection` → conn; `getConnLinkPrivKey (aConnId conn)` → `rootPrivKey`
|
||||
(`Nothing` ⇒ not upgraded → error; the UI pre-empts this via §B.5).
|
||||
- hoist `shareChatBinding` to top-level; `binding <- shareChatBinding user toSendRef`.
|
||||
- `ownerSig = LinkOwnerSig {ownerId = Nothing, chatBinding = B64UrlByteString cb,
|
||||
ownerSig = C.sign' rootPrivKey (cb <> smpEncode connShortLink)}` (contact variant of
|
||||
`mkLinkOwnerSig`, `ownerId = Nothing` so the directory verifies against the link root key).
|
||||
- return `CRChatMsgContent user (MCChat {text, chatLink = MCLContact {connLink, profile, business}, ownerSig})`.
|
||||
`SendRef` covers direct **and** group/channel targets.
|
||||
3. **CLI command — `ShareMyAddress {toChatName}`**, parser `/share address @to` / `/share address #to`
|
||||
(`Commands.hs:5551` neighborhood), handler mirroring `SharePublicGroup` (`Commands.hs:2437-2449`):
|
||||
resolve `toChatName` → `SendRef` → `APIShareMyAddress` → `APISendMessages`. Shares to contacts and
|
||||
groups/channels alike.
|
||||
4. **Support-bot entry point — OUT OF SCOPE (deferred).** A headless business running
|
||||
`apps/simplex-support-bot` (TypeScript, no app UI) will eventually need a way to trigger the
|
||||
share — a bot admin/config command that calls `APIShareMyAddress` against the directory contact
|
||||
once connected. Deferred; the core `APIShareMyAddress`/`/share address` path built here is exactly
|
||||
what it will call.
|
||||
5. **App UI — "Share via chat" (Phase 1; mirrors the channel share).** The receiving/rendering half
|
||||
already exists from the channel work (`MsgChatLink.Contact`, `CIChatLinkHeader`, the compose
|
||||
preview, and the `SharedContent → ShareListView → ComposeView` picker). New pieces: the entry
|
||||
point, a `SharedContent.AddressLink` case, the `apiShareMyAddress` call, and the upgrade branch.
|
||||
- **Entry point:** a **"Share via chat"** button (reuse the channel string) in the user's own
|
||||
address screen (`UserAddressView.kt`), beside the existing OS-share "Share" button. Address
|
||||
creation lands on this same screen (`createAddress` sets `userAddress`, `UserAddressView.kt:73-84`
|
||||
— verified), so the button is visible immediately after creating an address.
|
||||
- **Flow:** tap → if `userAddress.shouldBeUpgraded` (old full address) show an **upgrade alert**
|
||||
("To share your address in a chat it will be upgraded to a short link. All your contacts stay
|
||||
connected."), buttons **[Upgrade & share]** / **[Cancel]** — on confirm: spinner →
|
||||
`apiAddMyAddressShortLink`, **then** continue (two separate API calls, cleaner errors); no
|
||||
"share old" option. Then set `SharedContent.AddressLink` → `ShareListView` (contacts +
|
||||
groups/channels, with the simplex-link prohibition filtering) → pick destination → `ComposeView`
|
||||
`LaunchedEffect` calls `apiShareMyAddress` → sets the existing `ChatLinkPreview` → optional
|
||||
message text (same UX as the channel share) → **Send** → the recipient sees the existing
|
||||
`CIChatLinkHeader` card and taps to connect.
|
||||
- iOS mirrors this via the existing channel-share flow (`f49d98511`); Kotlin per
|
||||
`plans/2026-04-17-kotlin-share-channel-link.md`.
|
||||
|
||||
### C. Directory: verify + store (no connect)
|
||||
|
||||
1. **`deChatLinkReceived` — add the `MCLContact` case** (`Directory/Service.hs:964`).
|
||||
**No new verification code** — reuse the exact plan path channels use (resolved, Q1):
|
||||
- `deChatLinkReceived ct (MCLContact {connLink, profile, business}) (Just ownerSig)`:
|
||||
- `APIConnectPlan userId (contact link) PRMAll (Just ownerSig)` — **plan only**, no connect
|
||||
(rename `PRMAllGroups` → `PRMAll` and make it work for contact links too, not just groups).
|
||||
`connectPlan`'s contact-address path already computes `ov = verifyLinkOwner rootKey owners l' sig_`
|
||||
(`Commands.hs:4288`), identical to the channel path at `Commands.hs:4346`; for a plain/business
|
||||
address `owners == []`, so the card's `ownerId = Nothing` makes `verifyLinkOwner` verify against
|
||||
the link **root key**. Expect `CPContactAddress (CAPOk {contactSLinkData_ = Just csld, ownerVerification})`.
|
||||
Use the **fetched** `csld.profile` (`peerType`, `description`, name claim, …) as authoritative
|
||||
— the card's copies are display-only / potentially stale; `csld.business` is not used for
|
||||
typing.
|
||||
- `OVVerified` → type from the fetched profile's `peerType`: **bot** if `CPTBot`, **business**
|
||||
if `CPTHuman`/`CPTBusiness` (unset ≙ `CPTHuman`; stored as `CPTBusiness`) → `addContactReg`
|
||||
status pending; **reject `CPTUnknown`** ("unsupported account type"). A business is then
|
||||
admin-verified before approving (as for channels). `OVFailed reason` → "ownership verification
|
||||
failed". `CAPKnown`/other → appropriate message.
|
||||
- The fetch is intrinsic (the root public key isn't in the card, same as channels) and is an
|
||||
opaque link-data read, not a connection — consistent with the established directory rule.
|
||||
- Keep the existing `MCLGroup` and fall-through cases unchanged.
|
||||
2. **New store: `sx_directory_contact_regs`.** Add a migration to
|
||||
`Directory/Store/SQLite/Migrations.hs` and `Directory/Store/Postgres/Migrations.hs` (new named
|
||||
migration appended to `schemaMigrations`). Proposed columns:
|
||||
```
|
||||
contact_reg_id PK autoincrement
|
||||
user_contact_reg_id INTEGER -- per-submitter sequence (cf. user_group_reg_id)
|
||||
submitter_contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE
|
||||
conn_short_link TEXT NOT NULL -- the contact link; the LISTING IDENTITY (stable for
|
||||
-- contacts). A link change ⇒ unlist + re-register.
|
||||
-- Must be present in the fetched profile (contactLink).
|
||||
display_name TEXT NOT NULL
|
||||
full_name TEXT
|
||||
short_descr TEXT
|
||||
description TEXT -- long description (Profile.description)
|
||||
image TEXT -- base64, optional
|
||||
peer_type TEXT NOT NULL -- resolved listing type: "bot" or "business" (ChatPeerType)
|
||||
simplex_name TEXT -- verified SimpleX name, optional (see Q5)
|
||||
reg_status TEXT NOT NULL
|
||||
promoted INTEGER NOT NULL DEFAULT 0
|
||||
created_at, updated_at TEXT
|
||||
UNIQUE(conn_short_link); UNIQUE(submitter_contact_id, user_contact_reg_id)
|
||||
```
|
||||
Records store the profile inline (`display_name`, `description`, `image`, `peerType`, …) —
|
||||
self-contained, no FK to a joined contact, since we never connect. Reuse **`GroupRegStatus`**
|
||||
(resolved, Q3) for `reg_status` — same states as channels. New `Directory/Store.hs` data +
|
||||
functions mirroring the `GroupReg` ones: `ContactReg`, `addContactReg`, `setContactRegStatus`,
|
||||
`deleteContactReg`, `getContactRegBy{Id,Link}`, `getAllListedContacts`, and a search query.
|
||||
3. **Registration lifecycle mirrors channels.** `proposed → pending approval → active`, plus
|
||||
`suspended/removed`. On submission, notify admins with the profile + an approve command. The
|
||||
directory **re-reads the address links in the same periodic loop as channels** (resolved, Q6 —
|
||||
`deGroupLinkCheck`, `Service.hs:832`): re-fetch the link data, refresh the stored profile, and
|
||||
a profile change triggers **re-approval** (hidden until re-approved), exactly like a channel
|
||||
profile change (`reapprove`, `Service.hs:858`). The loop is the same as channels; a contact
|
||||
address has a single key and no group membership, so the channel `checkValidOwner` owner-list
|
||||
re-check has no analog and doesn't run — which also means the empty-`linkOwners` false-delist bug
|
||||
can't arise, and `UNIQUE(conn_short_link)` (below) prevents the duplicate-row class that triggered
|
||||
it. **Re-submission of an already-registered link (to research + propose):** mirror the channel
|
||||
re-registration path (`deReregistration`) — upsert the existing reg and send it back to admin
|
||||
review on any change, rather than erroring.
|
||||
4. **Admin & user commands — same commands, extended with a chat type** (resolved, Q4). Reuse the
|
||||
existing command constructors and syntax; carry a chat-type discriminator on the id token — `#`
|
||||
for a group (existing), `@` for a contact address — e.g. `/approve @<id>:<name> <version>`,
|
||||
`/list @...`, `/suspend @...`, mirroring the group forms. The `@`/`#` prefix disambiguates the
|
||||
overlapping id spaces (a `group_id` and a `contact_reg_id` both start at 1), so no parallel
|
||||
command names are needed. Extend the command constructors with the chat type, extend
|
||||
`Directory/Events.hs` `directoryCmdP` to parse the prefix, and branch on it in `Service.hs`
|
||||
`deSuperUserCommand`/`deUserCommand`.
|
||||
5. **Link identity + verified SimpleX names (resolved).** The contact **link is the listing
|
||||
identity** (for contacts the link is expected to be stable). Two conditions:
|
||||
- **Link present in the profile.** For listing, the fetched profile must declare this link —
|
||||
`Profile.contactLink` present and equal to the registered link. If the link **changes** (or the
|
||||
profile stops declaring it), the address is **unlisted** and must be re-registered — the link is
|
||||
the anchor, not a mutable attribute.
|
||||
- **Name↔link consistency, verified inline.** If the profile claims a SimpleX name
|
||||
(`Profile.contactDomain`), resolve that name and confirm it points to **this** link, comparing
|
||||
inline — the reverse direction of the existing by-name plan path (`Commands.hs:4272-4281`,
|
||||
`contactDomain`/`nameResolvesTo`). A **name change** re-runs this check. On success, populate
|
||||
`sx_directory_contact_regs.simplex_name` → flows to `DirectoryEntry.simplexName` and bot/web
|
||||
search. Reuse `plans/2026-06-25-name-resolution.md` and the group-names work.
|
||||
*(To research + propose: how the directory detects a link change on re-read, whether an address's
|
||||
published profile actually carries `contactLink == its own link`, and the exact resolve-and-compare
|
||||
call for the link → name-claim → link round-trip.)*
|
||||
|
||||
### D. Listing + web
|
||||
|
||||
1. **`DirectoryEntryType`** (`Listing.hs:55`): add `DETContact {peerType :: ChatPeerType}`. The
|
||||
`taggedObjectJSON`/`dropPrefix "DET"` derivation already emits `{"type":"contact", ...}` for a new
|
||||
constructor for free (single→multi constructor is transparent); `peerType` serializes as
|
||||
`"business"`/`"bot"`/etc.
|
||||
2. **`contactDirectoryEntry`** builder (analogue of `groupDirectoryEntry`, `Listing.hs:100`), from a
|
||||
`ContactReg` row: `DirectoryEntry {entryType = DETContact peerType, displayName, simplexName,
|
||||
groupLink = PublicLink Nothing (Just connShortLink), shortDescr` (from `Profile.shortDescr`)`,
|
||||
welcomeMessage` (from the new `Profile.description`)`, imageFile, activeAt, createdAt}`.
|
||||
`PublicLink` already models contact links (`Listing.hs:63-68`). Store the profile fields (incl.
|
||||
`description`, `peerType`) on the reg row at registration so the entry is self-contained.
|
||||
3. **`generateListing`** (`Listing.hs:148`): merge group entries + contact entries into the single
|
||||
`DirectoryListing`. Feed the contact rows from `getAllListedContacts` (status active); build
|
||||
`DirectoryEntry`s from both sources and serialize together. `listingsUpdated` triggers stay as-is,
|
||||
plus fire on contact-reg status changes.
|
||||
4. **Website `directory.jsc`**: branch `displayEntries` on `entryType.type` and, for contacts, on
|
||||
`entryType.peerType`:
|
||||
- business vs bot label/avatar from `peerType` (`business`/`bot`); non-group avatar fallback
|
||||
instead of `/img/group.svg`;
|
||||
- "Connect"/"Chat" affordance instead of the "N members/subscribers" line (`entryMemberCount`
|
||||
already returns 0 for non-group — `directory.jsc:183-193`);
|
||||
- join URI already works via `connShortLink` (`directory.jsc:331-348`).
|
||||
Search/filter already reads generic fields (`displayName`, `shortDescr`, `welcomeMessage`,
|
||||
`simplexName`), so text search works unchanged.
|
||||
|
||||
### E. Bot search
|
||||
|
||||
Include active contact regs in the bot's search results (`DCSearchGroup` path,
|
||||
`Service.hs:1115`, backed by `searchListedGroups` in `Store.hs`) as **one unified result set** (not a
|
||||
separate contact search); match on display name and SimpleX name.
|
||||
|
||||
### F. Tests
|
||||
|
||||
- **Client** (`tests/ChatTests/`): `/share address` produces an `MCChat`/`MCLContact` card with a
|
||||
valid `ownerSig` (`ownerId = Nothing`); parser test for `/share address`.
|
||||
- **Directory** (`tests/Bots/DirectoryTests.hs`, mirroring `testRegisterChannelViaCard`
|
||||
`:2050` and `testDirectoryChannelName` `:2129`): register a business and a bot via card
|
||||
(verified → pending → admin approve → listed), reject on bad/absent signature, search finds it,
|
||||
and the generated `listing.json` contains a `"type":"contact"` entry with the right `peerType`
|
||||
(`business`/`bot`). Wire under the names/SMP test harness as needed.
|
||||
- **Profile description** (§G): a member's `description` is **redacted per the group's policy** in
|
||||
the profile others receive in a group (send side) and when stored from an incoming member profile
|
||||
(receive side) — links/names stripped when the group prohibits them, clean prose passing through;
|
||||
a direct contact / address preview keeps it full.
|
||||
|
||||
### G. `Profile.description` field + member-profile redaction (resolved)
|
||||
|
||||
`description :: Maybe Text` is added to `Profile` (§A). In group-member profiles it is **redacted
|
||||
per the group's policy — the same treatment `shortDescr` gets today** (not removed wholesale):
|
||||
links and SimpleX names are stripped when the group prohibits them.
|
||||
|
||||
1. **Send side** — in `redactedMemberProfile` (`Internal.hs:1266-1277`, which already redacts
|
||||
`shortDescr`/`contactLink`/name-proof under the group's `SGFSimplexLinks`/`SGFDirectMessages`),
|
||||
also redact `description` — with a **new inline-strip helper** (per G.3), not `shortDescr`'s
|
||||
drop-whole `removeSimplexLink`. Adding `description` to `Profile` forces this output record to be
|
||||
rebuilt here anyway. (Used on every member-profile-out path — `Internal.hs:1254,1262`,
|
||||
`Subscriber.hs:851,3273`, `Commands.hs:4134`.)
|
||||
2. **Receive side** — apply the same redaction when ingesting a member profile from the network, so
|
||||
a peer can't inject a link/name-laden description. Chokepoints: `updateMemberProfile`
|
||||
(`Store/Groups.hs:3407`) and member creation (`Store/Groups.hs:2510`, `1395`); prefer a single
|
||||
helper mirroring the send-side redaction.
|
||||
3. **Redaction granularity (RESOLVED).** **Inline-strip links and names** — drop the
|
||||
`Uri`/`HyperLink`/`SimplexLink`/`SimplexName` (the `isLink` set, `Markdown.hs:184`) and `Mention`
|
||||
spans via `parseMaybeMarkdownList`, re-concat the remaining `FormattedText`, keep the prose (empty
|
||||
result ⇒ `Nothing`). **Exception:** if `hasObfuscatedSimplexLink` matches (a link that can't be
|
||||
cleanly isolated as a token), drop the **whole** description.
|
||||
4. **Kept full where wanted** — the address link data (`ContactShortLinkData` embeds the full,
|
||||
unredacted profile), the direct contact profile view, and the directory listing all carry the
|
||||
full `description`. Group redaction applies only to member-profile *delivery into a group*, a
|
||||
separate code path. For the **directory** page, abuse is gated by **admin review** (Q7), not an
|
||||
automatic filter.
|
||||
5. **UI/UX** — add a multi-line "Description" field to the profile/address editor (app UI, follow-on
|
||||
with §B.5). Because the field can carry into groups (redacted), an edit-time hint that links and
|
||||
names won't show where a group prohibits them is worthwhile, mirroring `shortDescr`.
|
||||
|
||||
### H. App visibility of `peerType` + `description` (why owners will set them)
|
||||
|
||||
These are persistent profile identity shown to everyone who reaches the address — independent of the
|
||||
directory. That is the reason to fill them in; the directory is a bonus channel. Existing surfaces
|
||||
(multiplatform paths; iOS/Android mirror them):
|
||||
|
||||
**`peerType` — type icon / badge** (small, already-present surfaces):
|
||||
- Pre-connect "Open chat?" alert (`newchat/ConnectPlan.kt:698-713`) — type icon + verification;
|
||||
briefcase when **either** the address `business` flag or `peerType == CPTBusiness`, bot cube from
|
||||
`peerType`, else person (see §1). The alert holds no description (too small — `AlertManager.kt:289`).
|
||||
- Chat list (`chatlist/ChatPreviewView.kt:188`, `isBot`) and the chat banner
|
||||
(`chat/ChatView.kt:2227` `ChatBannerView`, which already has per-type captions — bot / business /
|
||||
contact) — extend to a business marker from `peerType`.
|
||||
|
||||
**`description` — shown via a "Read more" affordance, NOT inline** (the alert and the in-chat link
|
||||
card `CIChatLinkHeader.kt` are too small — they carry only the short teaser). Rendered in **two
|
||||
surfaces: the chat banner (`ChatBannerView`) and the contact info page (`ChatInfoView`, `:778`)**:
|
||||
- Teaser text: if `shortDescr` is present → show `shortDescr`, then a clickable **"Read more"**; if
|
||||
`shortDescr` is absent → show the first line of `description` truncated to 100 chars with ellipsis
|
||||
(up to the first line break), then **"Read more"**. "Read more" appears only when a `description`
|
||||
exists to reveal.
|
||||
- **"Read more" is a general, extensible `Modal` markdown element.** Add an inline `Format` variant
|
||||
`Modal {modalName :: Text}` to `Markdown.hs:51` (sibling to `Command`/`Mention`/`SimplexLink`) —
|
||||
**no `showText`**: the app resolves both the tappable label and the modal content from the current
|
||||
chat by `modalName` (e.g. `modalName = "description"` → renders "Read more", opens the contact's
|
||||
`description`). `Format`'s existing `Unknown` fallback (`parseJSON … <|> pure (Unknown v)`,
|
||||
`Markdown.hs:533`) makes it forward-compat — old apps decode it as `Unknown`. The **teaser is built
|
||||
app-side** from the profile fields (d3), so the Haskell core just adds the variant + JSON so the
|
||||
app's mirrored enum matches; each client renders the tap (iOS sheet / Android modal), reusing the
|
||||
existing tappable-markdown mechanism (no iOS multiline-hit-test hack).
|
||||
- This is NOT the welcome/auto-reply message (`AddressSettings.autoReply`, a transient on-connect
|
||||
message), and NOT shown in the pre-connect alert or the shared-link card.
|
||||
|
||||
**Profile editor** (`usersettings/UserProfileView.kt`) — add the multi-line description field and a
|
||||
way to set the account type (`peerType`). Note: the editor exposes two separate "business" concepts
|
||||
— `peerType` (identity) and the `businessAddress` conversation-type setting — which must use distinct
|
||||
labels, since both otherwise read as "business."
|
||||
|
||||
Note: before connecting, the only surface with room to read the full description is the directory web
|
||||
page; in-app it is the banner/info "Read more" once the (prepared) chat is open.
|
||||
|
||||
## 5. Files to touch (summary)
|
||||
|
||||
- `src/Simplex/Chat/Types.hs` — extend `ChatPeerType` (`CPTBusiness`, `CPTUnknown`, lenient decode);
|
||||
add `Profile.description`; JSON/TextEncoding derivations.
|
||||
- `src/Simplex/Chat/Markdown.hs` — add the `Modal {modalName}` `Format` variant + JSON (§H).
|
||||
- App views (Phase 1, §B.5/§H) — `UserAddressView.kt` ("Share via chat" button + upgrade branch),
|
||||
`ChatInfoView.kt` + `ChatView.kt` `ChatBannerView` (description teaser + `Modal` "Read more"), the
|
||||
Kotlin/Swift `Format` mirror (`Modal` case + tap → sheet/alert) (+ iOS equivalents). The `peerType`
|
||||
badge/editor UI is deferred.
|
||||
- `src/Simplex/Chat/Controller.hs` — `APIShareMyAddress`, `ShareMyAddress` command constructors.
|
||||
- `src/Simplex/Chat/Library/Commands.hs` — handlers + parsers for the two new commands; reuse
|
||||
`shareChatBinding`.
|
||||
- `src/Simplex/Chat/Library/Internal.hs` — redact `description` per group policy in `redactedMemberProfile` (send side, §G).
|
||||
- `src/Simplex/Chat/Store/Groups.hs` — redact `description` when ingesting a member profile (receive side, §G).
|
||||
- `src/Simplex/Chat/Store/Profiles.hs` — persist `link_priv_sig_key` on short-link upgrade
|
||||
(`setUserContactLinkShortLink`/`setMyAddressData`); card signing uses the agent's
|
||||
`getConnLinkPrivKey`, not this column.
|
||||
- `apps/simplex-directory-service/src/Directory/Service.hs` — `MCLContact` case in
|
||||
`deChatLinkReceived`; contact-reg lifecycle + admin/user commands; listing trigger.
|
||||
- `apps/simplex-directory-service/src/Directory/Store.hs` — `ContactReg` model + queries.
|
||||
- `apps/simplex-directory-service/src/Directory/Store/{SQLite,Postgres}/Migrations.hs` — new table.
|
||||
- `apps/simplex-directory-service/src/Directory/Events.hs` — extend `directoryCmdP` to parse the
|
||||
`@`/`#` chat-type prefix and thread the chat type into the (shared) command constructors.
|
||||
- `apps/simplex-directory-service/src/Directory/Listing.hs` — `DETContact`, `contactDirectoryEntry`,
|
||||
merge in `generateListing`.
|
||||
- `website/src/js/directory.jsc` (+ a contact/bot avatar asset) — non-group card rendering.
|
||||
- `tests/Bots/DirectoryTests.hs`, `tests/ChatTests/*` — tests.
|
||||
|
||||
## 6. Design decisions
|
||||
|
||||
Resolved:
|
||||
|
||||
- **Submission model (RESOLVED: identical to channels).** Submission is by the **link owner**,
|
||||
**signed with the address key** — exactly the channel card flow, no extra requirement. The
|
||||
`ownerSig` (only the key-holder can produce it) is the authorization. Admins then decide to list;
|
||||
any profile change sends it back to admin review; the address is re-read on the same periodic loop
|
||||
— all as for channels. The only "submitter ≠ owner" accommodation is giving the headless support
|
||||
bot a way to send (§B.4). *(Earlier we explored open submission with the verified SimpleX name as
|
||||
the authenticity signal, and an opt-in flag in the address link data; both dropped — the channel
|
||||
model already answers authorization, and name-verification proves identity, not consent to list.)*
|
||||
- **Description home (RESOLVED: `Profile.description`, redacted per group policy).** New profile
|
||||
field. In group-member profiles it is redacted the same way `shortDescr` is (links/names stripped
|
||||
under the group's policy, §G), not removed wholesale; carried full in the address link data /
|
||||
direct view / directory. Directory abuse is gated by admin review (Q7).
|
||||
- **Q1 — Verification (RESOLVED: reuse the plan).** Already verifiable via `APIConnectPlan` — the
|
||||
same `verifyLinkOwner` path channels use, no new code. The intrinsic link-data fetch (to get the
|
||||
root public key) is opaque and not a connection. No card/protocol extension.
|
||||
- **Q4 — Command surface (RESOLVED: same commands, extended with chat type).** Reuse the existing
|
||||
command constructors and syntax with a chat-type discriminator on the id token — `#` group
|
||||
(existing), `@` contact (new) — e.g. `/approve @<id>:<name> <version>`. The prefix disambiguates
|
||||
the overlapping `group_id`/`contact_reg_id` spaces, so no parallel command names are needed.
|
||||
- **Q5 — SimpleX names (RESOLVED: support now).** Verify name↔link consistency for addresses and
|
||||
populate `simplex_name`; flows through to listing + search (see §C.5).
|
||||
|
||||
- **Q2 — Entry type (RESOLVED: `ChatPeerType`, typed + admin-verified).** The listing type is a
|
||||
`ChatPeerType`: **bot** from `peerType == CPTBot`; **business** from `peerType ∈ {CPTHuman,
|
||||
CPTBusiness}` (unset ≙ `CPTHuman`; stored as `CPTBusiness`); `CPTUnknown` is rejected. Because
|
||||
`CPTBusiness` can't be published on profiles yet (wire-compat, §A), a business's profile is
|
||||
`CPTHuman` in practice; the admin verifies it. When profiles can carry `CPTBusiness`, it's read
|
||||
directly.
|
||||
- **Q3 — Reg status type (RESOLVED: reuse the group/channel type).** Use the same `GroupRegStatus`
|
||||
the channel registrations use — no separate `ContactRegStatus`. The lifecycle mirrors channels.
|
||||
- **Q6 — Updates (RESOLVED: re-read in the same loop as channels).** The directory re-reads the
|
||||
registered address links in the same periodic link-check loop it runs for channels
|
||||
(`deGroupLinkCheck`, `Service.hs:832`), re-fetching the address link data to pick up profile/link
|
||||
changes and re-verify the name. Opaque fetch, no connection.
|
||||
- **Q7 — Description screening (RESOLVED: two surfaces, two mechanisms).** *Directory page:* admin
|
||||
approval is the gate — a profile change (incl. description) triggers re-approval, hiding the
|
||||
address until re-approved, exactly like a channel profile change; no separate automatic content
|
||||
filter on the directory description. *Group member profiles:* the group's own policy redacts the
|
||||
description on delivery (links/names stripped like `shortDescr`, §G). The two are independent.
|
||||
|
||||
## 7. Suggested sequencing
|
||||
|
||||
**Phase 1 — UX prerequisites (self-contained; do these first — no registration work until they
|
||||
land).**
|
||||
|
||||
1. **`Profile.description` field** (§A) + member-profile redaction on send and receive (§G) + a test
|
||||
that a member's description is redacted per group policy.
|
||||
2. **Show the description in the app** — banner + contact-info "Read more" via the `Modal` markdown
|
||||
element (§H). This is the "see how it looks" step; iterate on the UX here.
|
||||
3. **`ChatPeerType` extension** (`CPTBusiness`, `CPTUnknown`, lenient decoder) (§A) — the type only,
|
||||
**no UI** to set or display it yet.
|
||||
4. **Share a contact link via chat** — core (`getUserAddressSignKey`, `APIShareAddress`,
|
||||
`/share address`, §B.1–3) + the app share UI mirroring the channel share (§B.5) + a client test on
|
||||
the signed `MCLContact` card.
|
||||
|
||||
**Phase 2 — directory (only after Phase 1).**
|
||||
|
||||
5. Directory store: migration + `ContactReg` model/queries (link-keyed).
|
||||
6. `deChatLinkReceived` `MCLContact` case (verify + derive type + link-in-profile check +
|
||||
`addContactReg`) + name↔link verification + admin approval + directory test through to "listed".
|
||||
7. Listing merge (`DETContact` + `contactDirectoryEntry` + `generateListing`) + one unified
|
||||
group+contact search + website rendering.
|
||||
|
||||
**Deferred:** peerType setting/badge UI; the support-bot entry point (§B.4).
|
||||
@@ -148,6 +148,7 @@ library
|
||||
Simplex.Chat.Store.Postgres.Migrations.M20260603_simplex_name
|
||||
Simplex.Chat.Store.Postgres.Migrations.M20260629_roster_catchup
|
||||
Simplex.Chat.Store.Postgres.Migrations.M20260707_file_digest
|
||||
Simplex.Chat.Store.Postgres.Migrations.M20260714_contact_description
|
||||
else
|
||||
exposed-modules:
|
||||
Simplex.Chat.Archive
|
||||
@@ -313,6 +314,7 @@ library
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20260603_simplex_name
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20260629_roster_catchup
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20260707_file_digest
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20260714_contact_description
|
||||
other-modules:
|
||||
Paths_simplex_chat
|
||||
hs-source-dirs:
|
||||
|
||||
@@ -140,7 +140,7 @@ createActiveUser cc CoreChatOpts {chatRelay} = \case
|
||||
displayName <- T.pack <$> withPrompt "display name" getLine
|
||||
createUser loop False $ mkProfile displayName
|
||||
where
|
||||
mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
createUser onError clientService p =
|
||||
execChatCommand' (CreateActiveUser NewUser {profile = Just p, pastTimestamp = False, userChatRelay = BoolDef chatRelay, clientService = BoolDef clientService}) 0 `runReaderT` cc >>= \case
|
||||
Right (CRActiveUser user) -> pure user
|
||||
|
||||
@@ -5746,7 +5746,7 @@ chatCommandP =
|
||||
newUserP relay = do
|
||||
(cName, shortDescr) <- profileNameDescr
|
||||
service <- (" service=" *> onOffP) <|> pure False
|
||||
let profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
let profile = Just Profile {displayName = cName, fullName = "", shortDescr, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
pure NewUser {profile, pastTimestamp = False, userChatRelay = BoolDef relay, clientService = BoolDef service}
|
||||
newBotUserP = do
|
||||
files_ <- optional $ "files=" *> onOffP <* A.space
|
||||
@@ -5755,7 +5755,7 @@ chatCommandP =
|
||||
let preferences = case files_ of
|
||||
Just True -> Nothing
|
||||
_ -> Just (emptyChatPrefs :: Preferences) {files = Just FilesPreference {allow = FANo}}
|
||||
profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences, badge = Nothing, contactDomain = Nothing}
|
||||
profile = Just Profile {displayName = cName, fullName = "", shortDescr, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences, badge = Nothing, contactDomain = Nothing}
|
||||
pure NewUser {profile, pastTimestamp = False, userChatRelay = BoolDef False, clientService = BoolDef service}
|
||||
jsonP :: J.FromJSON a => Parser a
|
||||
jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -2832,7 +2832,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
when contentChanged $ updateBusinessChatProfile gInfo
|
||||
case memberContactId of
|
||||
Nothing -> do
|
||||
m' <- withStore $ \db -> updateMemberProfile db cxt user m p'
|
||||
m' <- withStore $ \db -> updateMemberProfile db cxt user m pr'
|
||||
unless (muteEventInChannel gInfo m') $ do
|
||||
when contentChanged $ forM_ msgTs_ $ createProfileUpdatedItem m'
|
||||
toView $ CEvtGroupMemberUpdated user gInfo m m'
|
||||
@@ -2857,6 +2857,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
| otherwise =
|
||||
pure m
|
||||
where
|
||||
pr' = redactMemberProfileDescription gInfo m p'
|
||||
contentChanged = not (sameProfileContent (redactedMemberProfile gInfo m (fromLocalProfile p)) (redactedMemberProfile gInfo m p'))
|
||||
updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of
|
||||
Just bc | isMainBusinessMember bc m -> do
|
||||
|
||||
@@ -10,7 +10,7 @@ generateRandomProfile :: IO Profile
|
||||
generateRandomProfile = do
|
||||
adjective <- pick adjectives
|
||||
noun <- pickNoun adjective 2
|
||||
pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
where
|
||||
pick :: [a] -> IO a
|
||||
pick xs = (xs !!) <$> randomRIO (0, length xs - 1)
|
||||
|
||||
@@ -112,7 +112,7 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
|
||||
c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
|
||||
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect, c.welcome_shared_msg_id, c.request_shared_msg_id, c.contact_request_id,
|
||||
c.contact_group_member_id, c.contact_grp_inv_sent, c.grp_direct_inv_link, c.grp_direct_inv_from_group_id, c.grp_direct_inv_from_group_member_id, c.grp_direct_inv_from_member_conn_id, c.grp_direct_inv_started_connection,
|
||||
c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl,
|
||||
@@ -124,8 +124,8 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
|
||||
|]
|
||||
(userId, contactId, CSActive)
|
||||
toContact' :: UTCTime -> Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
|
||||
toContact' currentTs contactId conn chatTags ((profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow :. domainRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge currentTs badgeRow, preferences, localAlias}
|
||||
toContact' currentTs contactId conn chatTags ((profileId, localDisplayName, displayName, fullName, shortDescr, description, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow :. domainRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge currentTs badgeRow, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
activeConn = Just conn
|
||||
@@ -156,13 +156,13 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
|
||||
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
-- GroupInfo {membership = GroupMember {memberProfile}}
|
||||
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
|
||||
pu.display_name, pu.full_name, pu.short_descr, pu.description, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
|
||||
pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature, pu.badge_key_idx, pu.contact_domain, pu.contact_domain_proof, pu.contact_domain_verified,
|
||||
mu.created_at, mu.updated_at,
|
||||
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.relay_link,
|
||||
-- from GroupMember
|
||||
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
|
||||
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified,
|
||||
m.created_at, m.updated_at,
|
||||
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link
|
||||
|
||||
@@ -73,7 +73,7 @@ createOrUpdateContactRequest
|
||||
isSimplexTeam
|
||||
invId
|
||||
cReqChatVRange@(VersionRange minV maxV)
|
||||
profile@Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences}
|
||||
profile@Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences}
|
||||
xContactId_
|
||||
welcomeMsgId_
|
||||
requestMsg_
|
||||
@@ -112,7 +112,7 @@ createOrUpdateContactRequest
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.description, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
|
||||
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
|
||||
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
|
||||
@@ -148,7 +148,7 @@ createOrUpdateContactRequest
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
|
||||
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
|
||||
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, cr.xcontact_id,
|
||||
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, cr.xcontact_id,
|
||||
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
|
||||
cr.created_at, cr.updated_at,
|
||||
cr.peer_chat_min_version, cr.peer_chat_max_version,
|
||||
@@ -168,8 +168,8 @@ createOrUpdateContactRequest
|
||||
liftIO $
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, image, contactLink, userId) :. ("" :: LocalAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, description, image, contactLink, userId) :. ("" :: LocalAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
|
||||
profileId <- liftIO $ insertedRowId db
|
||||
liftIO $
|
||||
DB.execute
|
||||
@@ -238,6 +238,7 @@ createOrUpdateContactRequest
|
||||
SET display_name = ?,
|
||||
full_name = ?,
|
||||
short_descr = ?,
|
||||
description = ?,
|
||||
image = ?,
|
||||
contact_link = ?,
|
||||
updated_at = ?,
|
||||
@@ -257,7 +258,7 @@ createOrUpdateContactRequest
|
||||
AND contact_request_id = ?
|
||||
)
|
||||
|]
|
||||
((displayName, fullName, shortDescr, image, contactLink, currentTs) :. badgeToRow badge badgeVerified :. (userId, contactRequestId))
|
||||
((displayName, fullName, shortDescr, description, image, contactLink, currentTs) :. badgeToRow badge badgeVerified :. (userId, contactRequestId))
|
||||
updateRequest currentTs =
|
||||
if displayName == oldDisplayName
|
||||
then
|
||||
|
||||
@@ -321,7 +321,7 @@ getContactByConnReqHash db cxt user@User {userId} cReqHash1 cReqHash2 = do
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.description, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
|
||||
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
|
||||
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
|
||||
@@ -731,17 +731,17 @@ updateContactProfile_ db userId profileId profile badgeVerified = do
|
||||
updateContactProfile_' db userId profileId profile badgeVerified currentTs
|
||||
|
||||
updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
|
||||
updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain, preferences, peerType, badge} badgeVerified updatedAt =
|
||||
updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, description, image, contactLink, contactDomain, preferences, peerType, badge} badgeVerified updatedAt =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contact_profiles
|
||||
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?,
|
||||
SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?,
|
||||
badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?,
|
||||
contact_domain = ?, contact_domain_proof = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. contactDomainToRow contactDomain :. (userId, profileId))
|
||||
((displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. contactDomainToRow contactDomain :. (userId, profileId))
|
||||
|
||||
-- update only member profile fields (when member doesn't have associated contact - we can reset contactLink and prefs)
|
||||
updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
|
||||
@@ -750,17 +750,17 @@ updateMemberContactProfileReset_ db userId profileId profile badgeVerified = do
|
||||
updateMemberContactProfileReset_' db userId profileId profile badgeVerified currentTs
|
||||
|
||||
updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
|
||||
updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactDomain, badge} badgeVerified updatedAt =
|
||||
updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, description, image, contactDomain, badge} badgeVerified updatedAt =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contact_profiles
|
||||
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = NULL, preferences = NULL, updated_at = ?,
|
||||
SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?, contact_link = NULL, preferences = NULL, updated_at = ?,
|
||||
badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?,
|
||||
contact_domain = ?, contact_domain_proof = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. contactDomainToRow contactDomain :. (userId, profileId))
|
||||
((displayName, fullName, shortDescr, description, image, updatedAt) :. badgeToRow badge badgeVerified :. contactDomainToRow contactDomain :. (userId, profileId))
|
||||
|
||||
-- update only member profile fields (when member has associated contact - we keep contactLink and prefs)
|
||||
updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
|
||||
@@ -769,17 +769,17 @@ updateMemberContactProfile_ db userId profileId profile badgeVerified = do
|
||||
updateMemberContactProfile_' db userId profileId profile badgeVerified currentTs
|
||||
|
||||
updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
|
||||
updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactDomain, badge} badgeVerified updatedAt =
|
||||
updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, description, image, contactDomain, badge} badgeVerified updatedAt =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contact_profiles
|
||||
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, updated_at = ?,
|
||||
SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?, updated_at = ?,
|
||||
badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?,
|
||||
contact_domain = ?, contact_domain_proof = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. contactDomainToRow contactDomain :. (userId, profileId))
|
||||
((displayName, fullName, shortDescr, description, image, updatedAt) :. badgeToRow badge badgeVerified :. contactDomainToRow contactDomain :. (userId, profileId))
|
||||
|
||||
updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
|
||||
updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt = do
|
||||
@@ -849,7 +849,7 @@ contactRequestQuery =
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
|
||||
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
|
||||
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, cr.xcontact_id,
|
||||
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, cr.xcontact_id,
|
||||
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
|
||||
cr.created_at, cr.updated_at,
|
||||
cr.peer_chat_min_version, cr.peer_chat_max_version,
|
||||
@@ -970,7 +970,7 @@ getContact_ db cxt user@User {userId} contactId deleted = do
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.description, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
|
||||
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
|
||||
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
|
||||
|
||||
@@ -259,11 +259,11 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
#endif
|
||||
|
||||
type MaybeGroupMemberRow = (Maybe GroupMemberId, Maybe GroupId, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. ((Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. BadgeRow :. ContactDomainRow) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)
|
||||
type MaybeGroupMemberRow = (Maybe GroupMemberId, Maybe GroupId, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. ((Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. BadgeRow :. ContactDomainRow) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)
|
||||
|
||||
toMaybeGroupMember :: UTCTime -> Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
|
||||
toMaybeGroupMember now userContactId ((Just groupMemberId, Just groupId, Just indexInGroup, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. ((Just profileId, Just displayName, Just fullName, shortDescr, image, contactLink, peerType, Just localAlias, contactPreferences) :. badgeRow :. domainRow) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink)) =
|
||||
Just $ toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, contactPreferences) :. badgeRow :. domainRow) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink))
|
||||
toMaybeGroupMember now userContactId ((Just groupMemberId, Just groupId, Just indexInGroup, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. ((Just profileId, Just displayName, Just fullName, shortDescr, description, image, contactLink, peerType, Just localAlias, contactPreferences) :. badgeRow :. domainRow) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink)) =
|
||||
Just $ toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. ((profileId, displayName, fullName, shortDescr, description, image, contactLink, peerType, localAlias, contactPreferences) :. badgeRow :. domainRow) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink))
|
||||
toMaybeGroupMember _ _ _ = Nothing
|
||||
|
||||
createGroupLink :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> ConnId -> CreatedLinkContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO GroupLink
|
||||
@@ -2062,7 +2062,7 @@ createJoiningMember
|
||||
User {userId, userContactId}
|
||||
GroupInfo {groupId, membership}
|
||||
cReqChatVRange
|
||||
Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences}
|
||||
Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences}
|
||||
cReqXContactId_
|
||||
cReqMemberId_
|
||||
welcomeMsgId_
|
||||
@@ -2075,8 +2075,8 @@ createJoiningMember
|
||||
liftIO $
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, image, contactLink, userId, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, description, image, contactLink, userId, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
|
||||
profileId <- liftIO $ insertedRowId db
|
||||
case cReqMemberId_ of
|
||||
Just memberId -> do
|
||||
@@ -2443,13 +2443,13 @@ createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profil
|
||||
createNewMember_ db user gInfo newMember badgeVerified currentTs
|
||||
|
||||
createNewMemberProfile_ :: DB.Connection -> StoreCxt -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId, Maybe Bool)
|
||||
createNewMemberProfile_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences} createdAt =
|
||||
createNewMemberProfile_ db cxt User {userId} Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences} createdAt =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
|
||||
badgeVerified <- verifyBadge_ (badgeKeys cxt) badge
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, image, contactLink, userId, preferences, createdAt, createdAt) :. badgeToRow badge badgeVerified)
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, description, image, contactLink, userId, preferences, createdAt, createdAt) :. badgeToRow badge badgeVerified)
|
||||
profileId <- insertedRowId db
|
||||
pure $ Right (ldn, profileId, badgeVerified)
|
||||
|
||||
|
||||
@@ -714,7 +714,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
||||
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
|
||||
p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
|
||||
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified,
|
||||
m.created_at, m.updated_at,
|
||||
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link
|
||||
@@ -1135,7 +1135,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = do
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
|
||||
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
|
||||
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, cr.xcontact_id,
|
||||
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, cr.xcontact_id,
|
||||
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
|
||||
cr.created_at, cr.updated_at,
|
||||
cr.peer_chat_min_version, cr.peer_chat_max_version,
|
||||
@@ -3069,7 +3069,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
||||
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
|
||||
p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
|
||||
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified,
|
||||
m.created_at, m.updated_at,
|
||||
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link,
|
||||
@@ -3078,14 +3078,14 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
-- quoted GroupMember
|
||||
rm.group_member_id, rm.group_id, rm.index_in_group, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
rp.display_name, rp.full_name, rp.short_descr, rp.image, rp.contact_link, rp.chat_peer_type, rp.local_alias, rp.preferences,
|
||||
rp.display_name, rp.full_name, rp.short_descr, rp.description, rp.image, rp.contact_link, rp.chat_peer_type, rp.local_alias, rp.preferences,
|
||||
rp.badge_proof, rp.badge_pres_header, rp.badge_expiry, rp.badge_type, rp.badge_verified, rp.badge_extra, rp.badge_master_key, rp.badge_signature, rp.badge_key_idx, rp.contact_domain, rp.contact_domain_proof, rp.contact_domain_verified,
|
||||
rm.created_at, rm.updated_at,
|
||||
rm.support_chat_ts, rm.support_chat_items_unread, rm.support_chat_items_member_attention, rm.support_chat_items_mentions, rm.support_chat_last_msg_from_member_ts, rm.member_pub_key, rm.relay_link,
|
||||
-- deleted by GroupMember
|
||||
dbm.group_member_id, dbm.group_id, dbm.index_in_group, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
|
||||
dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
|
||||
dbp.display_name, dbp.full_name, dbp.short_descr, dbp.image, dbp.contact_link, dbp.chat_peer_type, dbp.local_alias, dbp.preferences,
|
||||
dbp.display_name, dbp.full_name, dbp.short_descr, dbp.description, dbp.image, dbp.contact_link, dbp.chat_peer_type, dbp.local_alias, dbp.preferences,
|
||||
dbp.badge_proof, dbp.badge_pres_header, dbp.badge_expiry, dbp.badge_type, dbp.badge_verified, dbp.badge_extra, dbp.badge_master_key, dbp.badge_signature, dbp.badge_key_idx, dbp.contact_domain, dbp.contact_domain_proof, dbp.contact_domain_verified,
|
||||
dbm.created_at, dbm.updated_at,
|
||||
dbm.support_chat_ts, dbm.support_chat_items_unread, dbm.support_chat_items_member_attention, dbm.support_chat_items_mentions, dbm.support_chat_last_msg_from_member_ts, dbm.member_pub_key, dbm.relay_link
|
||||
|
||||
@@ -41,6 +41,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260602_group_roster
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260603_simplex_name
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260629_roster_catchup
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260707_file_digest
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260714_contact_description
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Text, Maybe Text)]
|
||||
@@ -81,7 +82,8 @@ schemaMigrations =
|
||||
("20260602_group_roster", m20260602_group_roster, Just down_m20260602_group_roster),
|
||||
("20260603_simplex_name", m20260603_simplex_name, Just down_m20260603_simplex_name),
|
||||
("20260629_roster_catchup", m20260629_roster_catchup, Just down_m20260629_roster_catchup),
|
||||
("20260707_file_digest", m20260707_file_digest, Just down_m20260707_file_digest)
|
||||
("20260707_file_digest", m20260707_file_digest, Just down_m20260707_file_digest),
|
||||
("20260714_contact_description", m20260714_contact_description, Just down_m20260714_contact_description)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -0,0 +1,21 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Store.Postgres.Migrations.M20260714_contact_description where
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
m20260714_contact_description :: Text
|
||||
m20260714_contact_description =
|
||||
T.pack
|
||||
[r|
|
||||
ALTER TABLE contact_profiles ADD COLUMN description TEXT;
|
||||
|]
|
||||
|
||||
down_m20260714_contact_description :: Text
|
||||
down_m20260714_contact_description =
|
||||
T.pack
|
||||
[r|
|
||||
ALTER TABLE contact_profiles DROP COLUMN description;
|
||||
|]
|
||||
@@ -133,7 +133,7 @@ import Database.SQLite.Simple.QQ (sql)
|
||||
#endif
|
||||
|
||||
createUserRecordAt :: DB.Connection -> AgentUserId -> Bool -> Bool -> Profile -> Bool -> UTCTime -> ExceptT StoreError IO User
|
||||
createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {displayName, fullName, shortDescr, image, peerType, preferences = userPreferences} activeUser currentTs =
|
||||
createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {displayName, fullName, shortDescr, description, image, peerType, preferences = userPreferences} activeUser currentTs =
|
||||
checkConstraint SEDuplicateName . liftIO $ do
|
||||
when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
|
||||
let showNtfs = True
|
||||
@@ -154,8 +154,8 @@ createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {di
|
||||
(displayName, displayName, userId, currentTs, currentTs)
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, chat_peer_type, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, shortDescr, image, peerType, userId, userPreferences, currentTs, currentTs)
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, chat_peer_type, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, shortDescr, description, image, peerType, userId, userPreferences, currentTs, currentTs)
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -163,7 +163,7 @@ createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {di
|
||||
(profileId, displayName, userId, BI True, currentTs, currentTs, currentTs)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
|
||||
pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. (Nothing, Nothing, Nothing)
|
||||
pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, description, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. (Nothing, Nothing, Nothing)
|
||||
|
||||
-- TODO [mentions]
|
||||
getUsersInfo :: DB.Connection -> IO [UserInfo]
|
||||
@@ -360,15 +360,15 @@ updateUserProfile db user p'
|
||||
|
||||
-- own profile field update; leaves the badge columns alone (the credential is owned by setUserBadge/addUserBadge)
|
||||
updateUserProfileFields_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
|
||||
updateUserProfileFields_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType} updatedAt =
|
||||
updateUserProfileFields_' db userId profileId Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType} updatedAt =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contact_profiles
|
||||
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?
|
||||
SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. (userId, profileId))
|
||||
((displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType, updatedAt) :. (userId, profileId))
|
||||
|
||||
-- store the user's own badge credential; touches only the badge columns.
|
||||
-- bumps user_member_profile_updated_at so groups receive the updated profile (with the badge) on the next message.
|
||||
@@ -417,14 +417,14 @@ getUserContactProfiles db User {userId} =
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT display_name, full_name, short_descr, image, contact_link, chat_peer_type, contact_domain, preferences
|
||||
SELECT display_name, full_name, short_descr, description, image, contact_link, chat_peer_type, contact_domain, preferences
|
||||
FROM contact_profiles
|
||||
WHERE user_id = ?
|
||||
|]
|
||||
(Only userId)
|
||||
where
|
||||
toContactProfile :: (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe SimplexDomain, Maybe Preferences) -> Profile
|
||||
toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, domain_, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain = mkDomainClaim <$> domain_, peerType, preferences, badge = Nothing}
|
||||
toContactProfile :: (ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe SimplexDomain, Maybe Preferences) -> Profile
|
||||
toContactProfile (displayName, fullName, shortDescr, description, image, contactLink, peerType, domain_, preferences) = Profile {displayName, fullName, shortDescr, description, image, contactLink, contactDomain = mkDomainClaim <$> domain_, peerType, preferences, badge = Nothing}
|
||||
|
||||
createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> SubscriptionMode -> C.PrivateKeyEd25519 -> ExceptT StoreError IO ()
|
||||
createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMode linkPrivSigKey =
|
||||
|
||||
@@ -164,6 +164,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260602_group_roster
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260603_simplex_name
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260629_roster_catchup
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260707_file_digest
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260714_contact_description
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -327,7 +328,8 @@ schemaMigrations =
|
||||
("20260602_group_roster", m20260602_group_roster, Just down_m20260602_group_roster),
|
||||
("20260603_simplex_name", m20260603_simplex_name, Just down_m20260603_simplex_name),
|
||||
("20260629_roster_catchup", m20260629_roster_catchup, Just down_m20260629_roster_catchup),
|
||||
("20260707_file_digest", m20260707_file_digest, Just down_m20260707_file_digest)
|
||||
("20260707_file_digest", m20260707_file_digest, Just down_m20260707_file_digest),
|
||||
("20260714_contact_description", m20260714_contact_description, Just down_m20260714_contact_description)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -0,0 +1,18 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Store.SQLite.Migrations.M20260714_contact_description where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20260714_contact_description :: Query
|
||||
m20260714_contact_description =
|
||||
[sql|
|
||||
ALTER TABLE contact_profiles ADD COLUMN description TEXT;
|
||||
|]
|
||||
|
||||
down_m20260714_contact_description :: Query
|
||||
down_m20260714_contact_description =
|
||||
[sql|
|
||||
ALTER TABLE contact_profiles DROP COLUMN description;
|
||||
|]
|
||||
@@ -31,7 +31,8 @@ CREATE TABLE contact_profiles(
|
||||
badge_key_idx INTEGER,
|
||||
contact_domain TEXT,
|
||||
contact_domain_proof TEXT,
|
||||
contact_domain_verified INTEGER
|
||||
contact_domain_verified INTEGER,
|
||||
description TEXT
|
||||
) STRICT;
|
||||
CREATE TABLE users(
|
||||
user_id INTEGER PRIMARY KEY,
|
||||
|
||||
@@ -321,14 +321,14 @@ createConnection_ db userId connType entityId acId connStatus connChatVersion pe
|
||||
ent ct = if connType == ct then entityId else Nothing
|
||||
|
||||
createIncognitoProfile_ :: DB.Connection -> UserId -> UTCTime -> Profile -> IO Int64
|
||||
createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, shortDescr, image} = do
|
||||
createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, shortDescr, description, image} = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO contact_profiles (display_name, full_name, short_descr, image, user_id, incognito, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?)
|
||||
INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, user_id, incognito, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(displayName, fullName, shortDescr, image, userId, Just (BI True), createdAt, createdAt)
|
||||
(displayName, fullName, shortDescr, description, image, userId, Just (BI True), createdAt, createdAt)
|
||||
insertedRowId db
|
||||
|
||||
updateConnSupportPQ :: DB.Connection -> Int64 -> PQSupport -> PQEncryption -> IO ()
|
||||
@@ -415,13 +415,13 @@ createContact db cxt user profile = do
|
||||
void $ createContact_ db cxt user profile emptyChatPrefs Nothing "" currentTs
|
||||
|
||||
createContact_ :: DB.Connection -> StoreCxt -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId
|
||||
createContact_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
|
||||
createContact_ db cxt User {userId} Profile {displayName, fullName, shortDescr, description, image, contactLink, contactDomain, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
|
||||
badgeVerified <- verifyBadge_ (badgeKeys cxt) badge
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx, contact_domain, contact_domain_proof) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified :. contactDomainToRow contactDomain)
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx, contact_domain, contact_domain_proof) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, description, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified :. contactDomainToRow contactDomain)
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -488,15 +488,15 @@ type PreparedContactRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink, Ma
|
||||
|
||||
type GroupDirectInvitationRow = (Maybe ConnReqInvitation, Maybe GroupId, Maybe GroupMemberId, Maybe Int64, BoolInt)
|
||||
|
||||
type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64) :. BadgeRow :. ContactDomainRow
|
||||
type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64) :. BadgeRow :. ContactDomainRow
|
||||
|
||||
type ContactRow = Only ContactId :. ContactRow'
|
||||
|
||||
type ContactDomainRow = (Maybe SimplexDomain, Maybe SimplexDomainProof, Maybe BoolInt)
|
||||
|
||||
toContact :: UTCTime -> StoreCxt -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
|
||||
toContact now cxt user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow :. domainRow) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge now badgeRow, preferences, localAlias}
|
||||
toContact now cxt user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, description, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow :. domainRow) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge now badgeRow, preferences, localAlias}
|
||||
activeConn = toMaybeConnection cxt connRow
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
|
||||
incognito = maybe False connIncognito activeConn
|
||||
@@ -537,25 +537,25 @@ getProfileById db userId profileId = do
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT cp.contact_profile_id, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, cp.preferences, -- , ct.user_preferences
|
||||
SELECT cp.contact_profile_id, cp.display_name, cp.full_name, cp.short_descr, cp.description, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, cp.preferences, -- , ct.user_preferences
|
||||
cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature, cp.badge_key_idx, cp.contact_domain, cp.contact_domain_proof, cp.contact_domain_verified
|
||||
FROM contact_profiles cp
|
||||
WHERE cp.user_id = ? AND cp.contact_profile_id = ?
|
||||
|]
|
||||
(userId, profileId)
|
||||
|
||||
type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupId, Maybe Int64) :. (Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias) :. (Maybe XContactId, PQSupport, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat) :. BadgeRow :. ContactDomainRow
|
||||
type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupId, Maybe Int64) :. (Int64, ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias) :. (Maybe XContactId, PQSupport, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat) :. BadgeRow :. ContactDomainRow
|
||||
|
||||
toContactRequest :: UTCTime -> ContactRequestRow -> UserContactRequest
|
||||
toContactRequest now ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias) :. (xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer) :. badgeRow :. domainRow) = do
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, preferences, localBadge = rowToBadge now badgeRow, localAlias}
|
||||
toContactRequest now ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_) :. (profileId, displayName, fullName, shortDescr, description, image, contactLink, peerType, localAlias) :. (xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer) :. badgeRow :. domainRow) = do
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, preferences, localBadge = rowToBadge now badgeRow, localAlias}
|
||||
cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
|
||||
in UserContactRequest {contactRequestId, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, createdAt, updatedAt}
|
||||
|
||||
userQuery :: Query
|
||||
userQuery =
|
||||
[sql|
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -563,11 +563,11 @@ userQuery =
|
||||
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
|
||||
|]
|
||||
|
||||
toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) :. BadgeRow :. ContactDomainRow -> User
|
||||
toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow :. domainRow) =
|
||||
toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) :. BadgeRow :. ContactDomainRow -> User
|
||||
toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, description, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow :. domainRow) =
|
||||
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts, viewPwdHash, userMemberProfileUpdatedAt, userChatRelay = BoolDef userChatRelay, clientService = BoolDef clientService, uiThemes}
|
||||
where
|
||||
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""}
|
||||
profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""}
|
||||
fullPreferences = fullPreferences' userPreferences
|
||||
viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_
|
||||
|
||||
@@ -689,7 +689,7 @@ type PublicGroupAccessRow = (Maybe Text, Maybe SimplexDomain, Maybe BoolInt, May
|
||||
|
||||
type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)
|
||||
|
||||
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) :. BadgeRow :. ContactDomainRow
|
||||
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) :. BadgeRow :. ContactDomainRow
|
||||
|
||||
toGroupInfo :: UTCTime -> StoreCxt -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo now cxt userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri, groupDomainVerified) :. groupKeysRow :. userMemberRow) =
|
||||
@@ -762,7 +762,7 @@ groupMemberQuery =
|
||||
[sql|
|
||||
SELECT
|
||||
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
|
||||
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified,
|
||||
m.created_at, m.updated_at,
|
||||
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link,
|
||||
@@ -780,8 +780,8 @@ toContactMember now cxt User {userContactId} (memberRow :. connRow) =
|
||||
(toGroupMember now userContactId memberRow) {activeConn = toMaybeConnection cxt connRow}
|
||||
|
||||
rowToLocalProfile :: UTCTime -> ProfileRow -> LocalProfile
|
||||
rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) :. badgeRow :. domainRow) =
|
||||
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences}
|
||||
rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, description, image, contactLink, peerType, localAlias, preferences) :. badgeRow :. domainRow) =
|
||||
LocalProfile {profileId, displayName, fullName, shortDescr, description, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences}
|
||||
|
||||
toBusinessChatInfo :: Maybe SimplexDomainClaim -> BusinessChatInfoRow -> Maybe BusinessChatInfo
|
||||
toBusinessChatInfo businessDomain (Just chatType, Just businessId, Just customerId) = Just BusinessChatInfo {chatType, businessId, customerId, businessDomain}
|
||||
@@ -807,7 +807,7 @@ groupInfoQueryFields =
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
|
||||
pu.display_name, pu.full_name, pu.short_descr, pu.description, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
|
||||
pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature, pu.badge_key_idx, pu.contact_domain, pu.contact_domain_proof, pu.contact_domain_verified,
|
||||
mu.created_at, mu.updated_at,
|
||||
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.relay_link
|
||||
|
||||
@@ -694,6 +694,7 @@ data Profile = Profile
|
||||
{ displayName :: ContactName,
|
||||
fullName :: Text,
|
||||
shortDescr :: Maybe Text, -- short description limited to 160 characters
|
||||
description :: Maybe Text, -- long description (businesses/bots); redacted per group policy in member profiles
|
||||
image :: Maybe ImageData,
|
||||
contactLink :: Maybe ConnLinkContact,
|
||||
preferences :: Maybe Preferences,
|
||||
@@ -732,14 +733,14 @@ instance TextEncoding ChatPeerType where
|
||||
|
||||
profileFromName :: ContactName -> Profile
|
||||
profileFromName displayName =
|
||||
Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
Profile {displayName, fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
|
||||
-- check if profiles match ignoring preferences
|
||||
profilesMatch :: LocalProfile -> LocalProfile -> Bool
|
||||
profilesMatch
|
||||
LocalProfile {displayName = n1, fullName = fn1, image = i1, shortDescr = d1}
|
||||
LocalProfile {displayName = n2, fullName = fn2, image = i2, shortDescr = d2} =
|
||||
n1 == n2 && fn1 == fn2 && i1 == i2 && d1 == d2
|
||||
LocalProfile {displayName = n1, fullName = fn1, image = i1, shortDescr = d1, description = desc1}
|
||||
LocalProfile {displayName = n2, fullName = fn2, image = i2, shortDescr = d2, description = desc2} =
|
||||
n1 == n2 && fn1 == fn2 && i1 == i2 && d1 == d2 && desc1 == desc2
|
||||
|
||||
-- equal for profile-update detection: badge proofs are re-generated for every presentation,
|
||||
-- so compare badges by disclosed info (not proof bytes) - a re-presentation of the same badge is a no-op
|
||||
@@ -778,6 +779,7 @@ data LocalProfile = LocalProfile
|
||||
displayName :: ContactName,
|
||||
fullName :: Text,
|
||||
shortDescr :: Maybe Text,
|
||||
description :: Maybe Text,
|
||||
image :: Maybe ImageData,
|
||||
contactLink :: Maybe ConnLinkContact,
|
||||
preferences :: Maybe Preferences,
|
||||
@@ -793,15 +795,15 @@ localProfileId :: LocalProfile -> ProfileId
|
||||
localProfileId LocalProfile {profileId} = profileId
|
||||
|
||||
toLocalProfile :: ProfileId -> Profile -> LocalAlias -> UTCTime -> Maybe Bool -> Maybe Bool -> LocalProfile
|
||||
toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge, contactDomain} localAlias now badgeVerified contactDomainVerified =
|
||||
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, localAlias, contactDomain, contactDomainVerified}
|
||||
toLocalProfile profileId Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType, badge, contactDomain} localAlias now badgeVerified contactDomainVerified =
|
||||
LocalProfile {profileId, displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType, localBadge, localAlias, contactDomain, contactDomainVerified}
|
||||
where
|
||||
localBadge = (\b@(BadgeProof _ _ _ info) -> PeerBadge b (mkBadgeStatus now badgeVerified info)) <$> badge
|
||||
|
||||
fromLocalProfile :: LocalProfile -> Profile
|
||||
fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, contactDomain} =
|
||||
fromLocalProfile LocalProfile {displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType, localBadge, contactDomain} =
|
||||
-- the name proof is re-signed on each send
|
||||
Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge, contactDomain = (\d -> d {proof = Nothing} :: SimplexDomainClaim) <$> contactDomain}
|
||||
Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge, contactDomain = (\d -> d {proof = Nothing} :: SimplexDomainClaim) <$> contactDomain}
|
||||
where
|
||||
wireBadge :: LocalBadge -> Maybe BadgeProof
|
||||
wireBadge = \case
|
||||
|
||||
@@ -1815,9 +1815,10 @@ viewContactBadge = maybe [] $ \lb ->
|
||||
in [plain (textEncode badgeType <> " badge - " <> st), plain expiry]
|
||||
|
||||
viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString]
|
||||
viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge, contactDomain, contactDomainVerified}, activeConn, uiThemes, customData} stats incognitoProfile =
|
||||
viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge, contactDomain, contactDomainVerified, description}, activeConn, uiThemes, customData} stats incognitoProfile =
|
||||
["contact ID: " <> sShow contactId]
|
||||
<> viewContactBadge localBadge
|
||||
<> maybe [] ((bold' "description:" :) . map plain . T.lines) description
|
||||
<> maybe [] viewConnectionStats stats
|
||||
<> maybe [] (\l -> ["contact address: " <> plain (strEncode (simplexChatContact' l))]) contactLink
|
||||
<> simplexDomainLine NTContact contactDomain contactDomainVerified
|
||||
@@ -1856,11 +1857,12 @@ viewCustomData :: Maybe CustomData -> [StyledString]
|
||||
viewCustomData = maybe [] (\(CustomData v) -> ["custom data: " <> viewJSON (J.Object v)])
|
||||
|
||||
viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [StyledString]
|
||||
viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias, contactLink, localBadge}, activeConn} stats =
|
||||
viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias, contactLink, localBadge, description}, activeConn} stats =
|
||||
[ "group ID: " <> sShow groupId,
|
||||
"member ID: " <> sShow groupMemberId
|
||||
]
|
||||
<> viewContactBadge localBadge
|
||||
<> maybe [] ((bold' "description:" :) . map plain . T.lines) description
|
||||
<> maybe ["member not connected"] viewConnectionStats stats
|
||||
<> maybe [] (\l -> ["contact address: " <> (plain . strEncode) (simplexChatContact' l)]) contactLink
|
||||
<> ["alias: " <> plain localAlias | localAlias /= ""]
|
||||
|
||||
@@ -33,7 +33,7 @@ withBroadcastBot opts test =
|
||||
bot = simplexChatCore testCfg (mkChatOpts opts) $ broadcastBot opts
|
||||
|
||||
broadcastBotProfile :: Profile
|
||||
broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadcast Bot", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadcast Bot", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
|
||||
mkBotOpts :: TestParams -> [KnownContact] -> BroadcastBotOpts
|
||||
mkBotOpts ps publishers =
|
||||
|
||||
@@ -109,7 +109,7 @@ directoryNameTests = do
|
||||
it "should mark an inconsistent SimpleX name as not verified" testDirectoryChannelNameNotVerified
|
||||
|
||||
directoryProfile :: Profile
|
||||
directoryProfile = Profile {displayName = "SimpleX Directory", fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
directoryProfile = Profile {displayName = "SimpleX Directory", fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
|
||||
|
||||
mkDirectoryOpts :: TestParams -> [KnownContact] -> Maybe KnownGroup -> Maybe FilePath -> DirectoryOpts
|
||||
mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup webFolder =
|
||||
|
||||
@@ -46,6 +46,8 @@ chatProfileTests :: SpecWith TestParams
|
||||
chatProfileTests = do
|
||||
describe "user profiles" $ do
|
||||
it "update user profile and notify contacts" testUpdateProfile
|
||||
it "profile description round-trips and shows in contact info" testProfileDescriptionShown
|
||||
it "member profile description is redacted for members without a direct contact" testMemberDescriptionRedacted
|
||||
it "update user profile with image" testUpdateProfileImage
|
||||
it "use multiword profile names" testMultiWordProfileNames
|
||||
it "present supporter badge to contacts" testUserBadgeBroadcast
|
||||
@@ -199,6 +201,69 @@ testUpdateProfile =
|
||||
bob <## "use @cat <message> to send messages"
|
||||
]
|
||||
|
||||
-- Profile.description survives the connect-time round-trip and is shown in the contact /i view.
|
||||
testProfileDescriptionShown :: HasCallStack => TestParams -> IO ()
|
||||
testProfileDescriptionShown =
|
||||
testChat2 aliceProfile bobWithDescr $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice ##> "/i @bob"
|
||||
alice <## "contact ID: 2"
|
||||
alice <## "description:"
|
||||
alice <## "check https://simplex.chat out"
|
||||
alice <##. "receiving messages via"
|
||||
alice <##. "sending messages via"
|
||||
alice <## "you've shared main profile with this contact"
|
||||
alice <## "connection not verified, use /code command to see security code"
|
||||
alice <## "quantum resistant end-to-end encryption"
|
||||
alice <##. "peer chat protocol version range"
|
||||
where
|
||||
bobWithDescr = bobProfile {description = Just "check https://simplex.chat out"}
|
||||
|
||||
-- for a member without a direct contact, the description is redacted per the group's link/name policy
|
||||
testMemberDescriptionRedacted :: HasCallStack => TestParams -> IO ()
|
||||
testMemberDescriptionRedacted =
|
||||
testChat3 aliceProfile bobProfile cathWithDescr $
|
||||
\alice bob cath -> do
|
||||
connectUsers alice bob
|
||||
connectUsers alice cath
|
||||
alice ##> "/g team"
|
||||
alice <## "group #team is created"
|
||||
alice <## "to add members use /a team <name> or /create link #team"
|
||||
-- prohibit direct messages (and thus simplex links) before members join
|
||||
alice ##> "/set direct #team off"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Direct messages: off"
|
||||
addMember "team" alice bob GRAdmin
|
||||
bob ##> "/j team"
|
||||
concurrently_
|
||||
(alice <## "#team: bob joined the group")
|
||||
(bob <## "#team: you joined the group")
|
||||
-- cath joins and is introduced to bob with a redacted profile (link stripped)
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
do
|
||||
cath <## "#team: you joined the group"
|
||||
cath <## "#team: member bob (Bob) is connected",
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
-- bob has no direct contact to cath, so his stored member profile has the link stripped
|
||||
bob ##> "/i #team cath"
|
||||
bob <## "group ID: 1"
|
||||
bob <##. "member ID:"
|
||||
bob <## "description:"
|
||||
bob <## "check out"
|
||||
bob <##. "receiving messages via"
|
||||
bob <##. "sending messages via"
|
||||
bob <## "connection not verified, use /code command to see security code"
|
||||
bob <##. "peer chat protocol version range"
|
||||
where
|
||||
cathWithDescr = cathProfile {description = Just "check https://simplex.chat out"}
|
||||
|
||||
-- the test issuer key under index 1 in the test config
|
||||
testBadgeKeys :: BBSPublicKey -> M.Map Int BBSPublicKey
|
||||
testBadgeKeys = M.singleton 1
|
||||
@@ -497,7 +562,7 @@ testMultiWordProfileNames =
|
||||
aliceProfile' = baseProfile {displayName = "Alice Jones"}
|
||||
bobProfile' = baseProfile {displayName = "Bob James"}
|
||||
cathProfile' = baseProfile {displayName = "Cath Johnson"}
|
||||
baseProfile = Profile {displayName = "", fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = defaultPrefs, badge = Nothing, contactDomain = Nothing}
|
||||
baseProfile = Profile {displayName = "", fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = defaultPrefs, badge = Nothing, contactDomain = Nothing}
|
||||
|
||||
testUserContactLink :: HasCallStack => TestParams -> IO ()
|
||||
testUserContactLink =
|
||||
|
||||
@@ -88,7 +88,7 @@ serviceProfile :: Profile
|
||||
serviceProfile = mkProfile "service_user" "Service user" 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, badge = Nothing, contactDomain = Nothing}
|
||||
mkProfile displayName descr image = Profile {displayName, fullName = "", shortDescr = Just descr, description = Nothing, image, contactLink = Nothing, peerType = Nothing, preferences = defaultPrefs, badge = Nothing, contactDomain = Nothing}
|
||||
|
||||
it :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expectation))
|
||||
it name test =
|
||||
|
||||
@@ -108,7 +108,7 @@ testGroupPreferences :: Maybe GroupPreferences
|
||||
testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn, role = Nothing}, files = Nothing, fullDelete = Nothing, simplexLinks = Nothing, history = Nothing, reports = Nothing, support = Nothing, sessions = Nothing, comments = Nothing, signMessages = Nothing, commands = Nothing}
|
||||
|
||||
testProfile :: Profile
|
||||
testProfile = Profile {displayName = "alice", fullName = "Alice", shortDescr = Nothing, image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), peerType = Nothing, contactLink = Nothing, preferences = testChatPreferences, badge = Nothing, contactDomain = Nothing}
|
||||
testProfile = Profile {displayName = "alice", fullName = "Alice", shortDescr = Nothing, description = Nothing, image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), peerType = Nothing, contactLink = Nothing, preferences = testChatPreferences, badge = Nothing, contactDomain = Nothing}
|
||||
|
||||
testGroupProfile :: GroupProfile
|
||||
testGroupProfile = GroupProfile {displayName = "team", fullName = "Team", description = Nothing, shortDescr = Nothing, image = Nothing, publicGroup = Nothing, groupPreferences = testGroupPreferences, memberAdmission = Nothing}
|
||||
@@ -241,7 +241,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
#==# XInfo testProfile
|
||||
it "x.info with empty full name" $
|
||||
"{\"v\":\"1\",\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"
|
||||
#==# XInfo Profile {displayName = "alice", fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = testChatPreferences, badge = Nothing, contactDomain = Nothing}
|
||||
#==# XInfo Profile {displayName = "alice", fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = testChatPreferences, badge = Nothing, contactDomain = Nothing}
|
||||
it "x.contact with xContactId" $
|
||||
"{\"v\":\"1\",\"event\":\"x.contact\",\"params\":{\"contactReqId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"
|
||||
#==# XContact testProfile (Just $ XContactId "\1\2\3\4") Nothing Nothing
|
||||
|
||||
Reference in New Issue
Block a user