From 9b6b8089c292402c45df88045db8555dadf0b7f3 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 13:50:30 +0000 Subject: [PATCH] core: add optional profile description --- .../src/Directory/Service.hs | 4 +- ...-12-directory-business-bot-registration.md | 509 ++++++++++++++++++ simplex-chat.cabal | 2 + src/Simplex/Chat/Core.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 4 +- src/Simplex/Chat/Library/Internal.hs | 25 +- src/Simplex/Chat/Library/Subscriber.hs | 3 +- src/Simplex/Chat/ProfileGenerator.hs | 2 +- src/Simplex/Chat/Store/Connections.hs | 10 +- src/Simplex/Chat/Store/ContactRequest.hs | 13 +- src/Simplex/Chat/Store/Direct.hs | 24 +- src/Simplex/Chat/Store/Groups.hs | 18 +- src/Simplex/Chat/Store/Messages.hs | 10 +- src/Simplex/Chat/Store/Postgres/Migrations.hs | 4 +- .../M20260714_contact_description.hs | 21 + src/Simplex/Chat/Store/Profiles.hs | 20 +- src/Simplex/Chat/Store/SQLite/Migrations.hs | 4 +- .../M20260714_contact_description.hs | 18 + .../Store/SQLite/Migrations/chat_schema.sql | 3 +- src/Simplex/Chat/Store/Shared.hs | 46 +- src/Simplex/Chat/Types.hs | 18 +- src/Simplex/Chat/View.hs | 6 +- tests/Bots/BroadcastTests.hs | 2 +- tests/Bots/DirectoryTests.hs | 2 +- tests/ChatTests/Profiles.hs | 67 ++- tests/ChatTests/Utils.hs | 2 +- tests/ProtocolTests.hs | 4 +- 27 files changed, 745 insertions(+), 98 deletions(-) create mode 100644 plans/2026-07-12-directory-business-bot-registration.md create mode 100644 src/Simplex/Chat/Store/Postgres/Migrations/M20260714_contact_description.hs create mode 100644 src/Simplex/Chat/Store/SQLite/Migrations/M20260714_contact_description.hs diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 5c5718df4a..a3af872ac3 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -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 diff --git a/plans/2026-07-12-directory-business-bot-registration.md b/plans/2026-07-12-directory-business-bot-registration.md new file mode 100644 index 0000000000..6c57885ac8 --- /dev/null +++ b/plans/2026-07-12-directory-business-bot-registration.md @@ -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 @: `, + `/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 @: `. 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). diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 54462f941a..5c804fbe42 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -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: diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index cc3e49beb6..c68a8eed36 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -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 diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 3e1bf4d47a..d20be74d28 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -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 diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 9c9e794ff8..3ecd50c65b 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -1264,8 +1264,8 @@ memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, a } redactedMemberProfile :: GroupInfo -> GroupMember -> Profile -> Profile -redactedMemberProfile g m Profile {displayName, fullName, shortDescr, image, contactLink = lnk, peerType, badge, contactDomain} = - Profile {displayName, fullName, shortDescr = removeSimplexLink =<< shortDescr, image, contactLink, preferences = Nothing, peerType, badge, contactDomain = redactedDomain} +redactedMemberProfile g m Profile {displayName, fullName, shortDescr, description, image, contactLink = lnk, peerType, badge, contactDomain} = + Profile {displayName, fullName, shortDescr = removeSimplexLink =<< shortDescr, description = redactGroupDescription g m =<< description, image, contactLink, preferences = Nothing, peerType, badge, contactDomain = redactedDomain} where contactLink = if allowSimplexLinks then lnk else Nothing redactedDomain = if allowDirect then (\d -> d {proof = Nothing} :: SimplexDomainClaim) <$> contactDomain else Nothing @@ -1276,6 +1276,25 @@ redactedMemberProfile g m Profile {displayName, fullName, shortDescr, image, con | hasObfuscatedSimplexLink s = Nothing | otherwise = maybe (Just s) (\fts -> if any ftIsSimplexLink fts then Nothing else Just s) $ parseMaybeMarkdownList s +-- redact only the description of an incoming member profile (receive side), per the group's link/name policy +redactMemberProfileDescription :: GroupInfo -> GroupMember -> Profile -> Profile +redactMemberProfileDescription g m p@Profile {description} = p {description = redactGroupDescription g m =<< description} + +-- strip link/name spans inline from a group member's description (keeping the prose), dropping the whole field only on an obfuscated link +redactGroupDescription :: GroupInfo -> GroupMember -> Text -> Maybe Text +redactGroupDescription g m s + | allowSimplexLinks = Just s + | hasObfuscatedSimplexLink s = Nothing + | otherwise = case parseMaybeMarkdownList s of + Nothing -> Just s + Just fts -> + let kept = T.concat [t | FormattedText f t <- fts, not (maybe False isLinkOrName f)] + in if T.null (T.strip kept) then Nothing else Just kept + where + allowDirect = groupFeatureMemberAllowed SGFDirectMessages m g + allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m g && allowDirect + isLinkOrName f = isLink f || case f of Mention {} -> True; _ -> False + -- Roles carried by the roster; owners are on the link, not the roster. isRosterRole :: GroupMemberRole -> Bool isRosterRole r = r == GRMember || r == GRModerator || r == GRAdmin @@ -3176,6 +3195,7 @@ simplexTeamContactProfile = { displayName = "Ask SimpleX Team", fullName = "", shortDescr = Just "Send questions about SimpleX Chat app and your suggestions", + description = Nothing, image = Just simplexChatImage, contactLink = Just $ CLFull adminContactReq, peerType = Nothing, @@ -3190,6 +3210,7 @@ simplexStatusContactProfile = { displayName = "SimpleX Status", fullName = "", shortDescr = Just "Automatic server status and app release updates", + description = Nothing, image = Just (ImageData "data:image/jpg;base64,/9j/4AAQSkZJRgABAQAASABIAAD/4QBYRXhpZgAATU0AKgAAAAgAAgESAAMAAAABAAEAAIdpAAQAAAABAAAAJgAAAAAAA6ABAAMAAAABAAEAAKACAAQAAAABAAAAr6ADAAQAAAABAAAArwAAAAD/7QA4UGhvdG9zaG9wIDMuMAA4QklNBAQAAAAAAAA4QklNBCUAAAAAABDUHYzZjwCyBOmACZjs+EJ+/8AAEQgArwCvAwEiAAIRAQMRAf/EAB8AAAEFAQEBAQEBAAAAAAAAAAABAgMEBQYHCAkKC//EALUQAAIBAwMCBAMFBQQEAAABfQECAwAEEQUSITFBBhNRYQcicRQygZGhCCNCscEVUtHwJDNicoIJChYXGBkaJSYnKCkqNDU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6g4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2drh4uPk5ebn6Onq8fLz9PX29/j5+v/EAB8BAAMBAQEBAQEBAQEAAAAAAAABAgMEBQYHCAkKC//EALURAAIBAgQEAwQHBQQEAAECdwABAgMRBAUhMQYSQVEHYXETIjKBCBRCkaGxwQkjM1LwFWJy0QoWJDThJfEXGBkaJicoKSo1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoKDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uLj5OXm5+jp6vLz9PX29/j5+v/bAEMAAQEBAQEBAgEBAgMCAgIDBAMDAwMEBgQEBAQEBgcGBgYGBgYHBwcHBwcHBwgICAgICAkJCQkJCwsLCwsLCwsLC//bAEMBAgICAwMDBQMDBQsIBggLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLC//dAAQAC//aAAwDAQACEQMRAD8A/v4ooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAP/Q/v4ooooAKKKKACiiigAoorE8R+ItF8J6Jc+IvEVwlrZ2iGSWWQ4CgVUISlJRirtmdatTo05VaslGMU223ZJLVtvokbdFfl3of/BRbS734rtpup2Ig8LSsIYrjnzkOcea3bafTqBX6cafqFjq1jFqemSrPbzqHjkQ5VlPIINetm2Q43LXD65T5eZXX+XquqPiuC/Efh/itYh5HiVUdGTjJWaflJJ6uEvsy2fqXKKKK8c+5Ciq17e2mnWkl/fyLDDCpd3c4VVHJJJr8c/2kf8Ago34q8M3mpTfByG3fT7CGSJZrlC3nStwJF5GFU8gd69LA5VicXTrVaMfdpxcpPokk397toj4LjvxKyLhGjRqZxValVkowhFc05O9m0tPdjfV7dN2kfq346+J3w9+GWlPrXxA1m00i1QZL3Uqxj8Mnn8K/Mj4tf8ABYD4DeEJ5dM+Gmn3niq4TIE0YEFtn/ffBI+imv51vHfxA8b/ABR1+bxT8RNUuNXvp3LtJcOWCk84VeigdgBXI18LXzupLSkrL72fzrxH9IXNsTKVPKKMaMOkpe/P8fdXpaXqfqvrf/BYH9p6+1w3+iafo1jZA8WrRPKSPeTcpz9BX1l8J/8Ags34PvxDp/xn8M3OmSnAe709hcQfUoSHA/A1/PtSE4/GuKGZ4mLvz39T4TL/ABe4swlZ1ljpTvvGaUo/dbT/ALdsf2rfCX9pT4HfHGzF18M/EdnqTYBaFXCzJn+9G2GH5V7nX8IOm6hqGkX8eraLcy2d3EcpPbuY5FPsykGv6gf+CWf7QPxB+OPwX1Ky+JF22pX3h69+yJdyf62WJlDrvPdlzjPevdwGae3l7OcbP8D+i/DTxm/1ixkcqx2H5K7TalF3jLlV2rPWLtqtWvM/T2iiivYP3c//0f7+KKKKACiiigAooooAK/Fv/goX8Qvi2fFcXgfWrRtP8NDEls0bZS7YfxORxlT0Xt1r9pK8u+L/AMI/Cfxp8F3HgvxbFujlGYpgB5kMg6Op9R+tfR8K5vQy3MYYnE01KK0843+0vNf8NZn5f4wcFZhxTwziMpy3FOjVeqSdo1Lf8u5u11GXk97Xuro/mBFyDX3t+yL+2Be/CW+h8B+OHafw7cyALIxJa0Ldx6p6jt1FfMvx/wDgR4w/Z+8YN4d8RoZrSbLWd4owk6D+TDuK8KF0K/pLFYHA51geWVp0pq6a/Brs1/wH2P8ALvJsz4h4D4h9tR5qGLoS5ZRls11jJbSjJferSi9mf1uafqFlqtlFqWmyrPBOoeORDlWU8gg069vrPTbSS/v5FhghUu7ucKqjqSa/CH9j79sm++EuoQ/D/wAeSNceHbmRVjlZstZk9x6p6jt2q3+15+2fffFS8n8AfD2V7bw9CxWWZThrwj+Se3evxB+G2Zf2n9TX8Lf2nTl/+S/u/PbU/v2P0nuGv9Vf7cf+9/D9Xv73tLd/+ffXn7afF7pqftbfth3nxUu5vAXgGR7fw/A5WWUHDXZX19E9B361+Z/xKm3eCL9R3UfzFbQul6Cn+I/A3ivxR8LPEXivSbVn07RoVkurg8Iu5gAue7HPSv1HOsrwmVcN4uhRSjBUp6vq3Fq7fVt/5I/gTNeI884x4kjmeYOVWtKSdop2hCPvWjFbQjFNv5ybbuz4Toqa0ge9uoLOIhWnkSNSxwAXIUEnsBnmv0+/aK/4Jg+O/gj8Hoviz4b1n/hJFt40l1G2ig2NDG4yZEIJ3KvfgHHNfxVTw9SpGUoK6W5+xZVw1mWZYfEYrA0XOFBKU2raJ31te72b0T0R+XRIAyegr+gr/glx+yZoHhjwBc/tKfFywiafUY2OmpeIGS3sVGWmIbgF+TkjhR71+YP7DX7Lt9+1H8ZLfR75WTw5pBS61ScDKsoIKwg+snf0Ffqd/wAFSv2o4Phf4Ltv2WvhmVtrjUbRBfvA2Ps1kOFhAHQyAc9ML9a9HL6UacHi6q0W3mz9Q8M8owuV4KvxpnEL0aN40Yv/AJeVXpp5LZPo7v7J+M/7U/jX4e/EL4/+JfFXwrsI9P0Ke5K26RKESTZw0oUcAOeQBX7J/wDBFU5+HPjYf9RWH/0SK/nqACgKOgr+hT/giouPh143b11SH/0SKWVzc8YpPrf8jHwexk8XxzSxVRJSn7WTSVknKMnoui7H7a0UUV9cf3Mf/9L+/iiiigAoorzX4wfGD4afAP4bav8AF74v6xbaD4d0K3e6vb26cJHHGgyevUnoAOSeBTjFyajFXYHpVFf55Xxt/wCDu34nj9vzS/G3wX0Qz/ArQ2ksLnSp1CXurQyMA15uPMTqBmJD2+914/uU/Y//AGxfgH+3P8ENL+P37OutxazoWpoNwHyzW02PmhmjPKSKeCD9RxXqY/JcXg4QqV4WUvw8n2ZnCrGTaTPqGiiivKNDy/4u/CLwd8afBtx4N8ZW4kilBMUoH7yGTs6HsR+tfzjftA/AXxl+z54yfw34jQzWkuXs7xF/dzR/0YdxX9OPiDxBofhPQ7vxN4mu4rDT7CF57m4ncJHFFGMszMcAAAZJNf53n/Bav/g5W1H4ufGjTvg5+xB5F14E8JX4l1HVriIE6xNE2GjhLDKQdRuGC55HHX9L8Os+x2ExP1eKcsO/iX8vmvPy6/ifg3jZ4NYDjDBPFUEqeYU17k/50vsT8n0lvF+V0fq0LhTUgnA4r4y/ZG/bJ+FX7YXw9HjDwBP5N/ahV1LTZeJrSUjoR3U/wsOK+sRdL/n/APXX9G0nCrBTpu6Z/mVmuSYvLcXUwOPpOnWg7SjJWaf9ap7NarQ+pf2dP2evGH7Q3i4aLogNvp1uQ15esMpEnoPVj2Ffrd+1V8GvDnw5/YU8X+APh/Z7IrewEjYGXlZGUs7nqSQM18C/sO/ti6b8F7o/Dnx6qpoN9LvS6RRvglbjL45ZT69vpX7wX1poHjjwxNYzbL3TdUt2jbaQySRSrg4PoQa/nnxXxGaTxLwmIjy4e3uW2lpu33Xbp87v+7Po58I8L4nhfFVMuqKeY1oTp1nJe9S5k0oxWtoPfmXxve1uVfwqKA0YHYiv6Ev+CZ37bVv490eP9mb4zXAn1GKJo9Murg5F3bgYMLk9XUcD+8tflR+1/wDsn+Nv2XfiNdadqFs8vh28md9Mv1GY3iJyEY9nXoQa+UrC/v8ASr+DVdJnktbq2dZYZomKvG6nIZSOhFfztQrVMJW1Xqu5+Z8PZ5mvBWeSc4NSg+WrTeinHqv1jL56ptP+s7xHZ/A//gnR8EfE/jTwra+RHqF5JdxWpbLTXcwwkSnrsGPwXNfyrfEDx54l+J/jXU/iB4wna51LVZ3nmdj3Y8KPQKOAPQV2vxX/AGhvjT8corC3+K2vz6vFpq7beNgERT3YqvBY92NeNVeOxirNRpq0Fsju8RePKWfTo4TLqPscFRXuU9F7z+KTSuvJK7srvqwr+ir/AIIuaVd2/wAH/FesSIRDd6uFjb+8Y41Dfka/BX4YfCzx78ZfGVr4C+G+nyajqV22Aqj5I17u7dFUdya/r+/ZV+Aenfs2fBLSPhbZyC4ntVaW7nAx5tzKd0jfTJwPYV1ZLQk63tbaI+w8AOHcXiM8ebcjVClGS5ujlJWUV3sm27baX3R9FUUUV9Uf2gf/0/7+KKKKACv4If8Ag8QT9vN9W8IsVk/4Z+WJedOL7f7Xyd32/HGNu3yc/LnPev73q84+Lnwj+G/x3+HGr/CT4uaRba74d123e1vbK6QPHJG4weD0I6gjkHkV6WUY9YLFQxDgpJdP8vMipDmi0f4W1frt/wAEhP8Agrt8af8AglD8b38V+Fo21zwPr7xp4i0B3KpcRoeJoTyEnjBO04+boeK+m/8AguZ/wQz+I3/BMD4kyfEn4Ww3fiD4Oa5KzWWolC76XKx4tbphwOuI3PDAc81/PdX7LCeFzHC3VpU5f18mjympU5eZ/t9fsk/tb/Av9tv4G6N+0F+z3rUWs6BrEQYFCPNt5cfPDMnVJEPDKf5V794h8Q6F4T0O78TeJ7uGw06wiae4uZ3EcUUaDLMzHAAA6k1/j9f8EiP+Cunxv/4JTfHAeKPCZfWfAuuyRx+IvD8jkRTxg486Lsk8YJ2n+Loa/V7/AILy/wDBxZd/t2eHl/Zc/Y6mu9I+Gl1DDNrWoSBoLvUpGAY2+OqQoeH/AL5GOlfneI4OxCxio0taT+12Xn59u53xxMeW73ND/g4M/wCDgzVP2yNV1H9jz9j3UZrD4ZWE7waxrEDlH110ONiEYItgQe/7z6V/I6AAMDgCgAKNo6Cv0j/4Jkf8Ex/j/wD8FOvj/Y/Cj4UWE9voFvNGdf18xk2um2pPzEt0MhGdiZyTX6FhsNhctwvLH3YR1bfXzfn/AEjhlKVSR77/AMEMf2Rf2v8A9qr9tPRrb9mNpdL0fSp438UaxKjNYW+nk/PHKOA7uoIjTrnniv7Lfj98CvG37PPjiXwj4uiLxNl7S7UYjuIuzD39R1Ffvt+wn+wd+z5/wTy+A+n/AAF/Z70pbKyt1V728cA3V/c4w0079WYnoOijgV7V8cPgb4G+Pngqfwb41twwYEwXCgebBJ2ZT/MdDXi5N4mTwmYWqRvhXpb7S/vL9V28z8c8YfBXC8XYL61hbQx9Ne7LpNfyT8v5ZfZfkfyXi5r9Lf2Jv24bn4S3UHwz+JkzT+HZ5AsNy5LNZlu3vHn8q+KPj38CPHf7PPjabwn4yt2ELMxtLsD91cRg8Mp6Z9R2rxAXAPANfuePyzL89y/2c7TpTV1JdOzT6Nf8Bn8C5FnGfcEZ79Yw96OJpPlnCS0a6xkusX/k4u9mf2IeK/B/w++Mngt9C8U2ltrWi6lEGCuA6OrDhlPY+hHNfztftw/8E4tN+AGlTfE34ba3HJo0koVdMvGC3CFv4Ym/5aAenBArvf2PP2+9R+CGmv4B+JSy6joEUbtaOp3TQOBkRj1Rjx7V8uftEftH+Nf2i/G7+KPEzmG0hyllZqT5cEef1Y9zX4LT8GMTisynhsY7UI6qot5J7Jefe+i87o/prxI8YuEM/wCF6WM+rc2ZSXKo6qVJrdykvih/Ktebsmnb4DkilicxyqVYdQRzXUaN4R1HVMSzjyIf7zDk/QV6dIlpJIJ5Y1Z16MRk1+qf7DX7Ed58ULmH4p/Fe2kt/D8Dq9paSDabwjncf+mf/oX0rKXg3lOR+0zDPMW6lCL92EVyufZN3vfyjbvdI/AeFsJnHFOPp5TktD97L4pP4YLrJu2iXnq3ok20es/8Erv2f/G/gf8AtD4ozj7Bo2pwiFIpY/3t2VOQ4J5VFzx659q/aKq9paWthax2VlGsUMShERBtVVHAAA6AVYr4LNcdTxWIdSjRjSpqyjGKslFber7t6tn+k3APB1LhjJaOUUqsqjjdylJ/FKTvJpfZV9orbzd2yiiivNPsj//U/v4ooooAKKKKAPO/iz8Jvh18c/h1q/wm+LGk2+ueHtdt3tb2yukDxyxuMEEHoR1B6g81/lm/8Fy/+CFfxG/4Jh/ENvid8J4bzxF8Htdmke1vliaRtHctxbXTAEBecRyHAbGDzX+q54j8R6B4Q0C88U+KbyHT9N0+F7i5ubhxHFFFGMszMcAADqa/zM/+Dhb/AIL06p+3f4rvP2Tf2Xr6S0+Eui3DR397GcHXriM8N7W6EfIP4jz6V9fwfPGLFctD+H9q+3/D9jmxKjy+9ufyq0UAY4or9ZPMP0v/AOCX3/BLf9oT/gqP8d4Phf8ACa0lsvDtjLG3iDxDJGTa6bbse56NKwB8uPOSfav9ZX9hD9hT4Df8E8v2fdK/Z7+AenLbWNkoe8vHUfab+6I+eeZhyWY9B0UcCv8AKC/4JUf8FV/j1/wSu+PCfEf4aSHUvC+rPHH4i0CViIL63U43D+7MgJKN+B4r/Wd/Yy/bM+BH7eHwH0j9oL9n7Vo9S0fU4182LI8+0nx88MydVdTxz16ivzbjZ43nipfwOlu/n59uh6GE5Labn1ZRRRXwB2Hi3x3+BPgj9oHwJceCPGcIIYFre4UfvYJezKf5jvX8vH7QvwB8d/s4eOZfB/jKEtDIS9neKP3VxFngqfX1Hav6gvj58e/An7PHgK48ceN7gLtBW2twf3txL2RR/M9hX8rX7Qn7Rnjz9o3x5L418ZyhUXKWlqh/dW8WeFUevqe5r988G4Zu3Ut/ueu/839z/wBu6fM/jj6UdPhlwo8y/wCFTS3Lb+H/ANPf/bPtf9unlQuAec077SPWueFznrTxc1+/eyP4udE/XX9g79h24+K8tv8AF74qQvD4fgkDWdo64N4V53H/AKZg/wDfX0r+ge0tLWwtY7KyjWKGJQiIgwqqOAAOwFfzc/sIft2XnwO1KH4ZfEeVp/Ct5L8k7Es9k7YHH/TMnkjt1r+kDTNT07WtOg1fSJ0ubW5QSRSxncjowyCCOoNfyr4q0s3jmreYfwtfZW+Hl/8Akv5r6/Kx/or9HSXDX+rqhkqtidPb81vac/d/3P5Lab/auXqKKK/Lz+gwooooA//V/v4ooooAKxfEniTQPB2gXnirxVew6dpunQvcXV1cOI4oYoxlndjgAADJJrar/PV/4Ozf+CiX7Xlr8Yrf9hCx0u98GfDaS0iv5L1GZT4iZs5HmKceTERgx9d3LcYr08py2eOxMaEXbu/L9SKk1CN2fIX/AAcD/wDBfrXv27vFF1+yx+ylqFzpnwl0id476+icxSa/MhwGOMEWykHYv8fU9hX8qoAAwOAKUAAYFfqj/wAEnf8AglH8cv8Agqp8ek+Hvw/R9M8I6NJFJ4k19lzHZW7k/ImeGmcAhF/E8V+xUKGFyzC2Xuwju/1fds8tuVSXmM/4JQ/8Epfjr/wVU+Pcfw5+HiPpXhPSXjl8ReIZEJhsoGP3E7PO4B2J+J4r7o/4Li/8EC/H3/BL/UYPjH8Hp7vxV8JNQMcL3sy7rnTLkgDbcFRjZI3KPwATg9q/0rP2MP2MPgL+wZ8BdI/Z5/Z60hNM0bS4x5kpANxeTn7887gAvI55JPToOK9y+J/ww8AfGfwBqvwu+KOlW+t6Brdu9re2V0gkilicYIIP6HqDXwVbjSu8YqlNfulpy9139e3Y7VhY8tnuf4VdfqD/AMErP+Cpvx1/4Jb/ALQNn8S/h7cS6j4VvpUj8QeH2kIt723zgsB0WVRyjetffn/BeH/ghJ4x/wCCZvjlvjP8EYbvXPg5rk7GKcqZJdGmc5FvOwH+rOcRyH0wea/nCr9ApVcNmOGuvehL+vk0cLUqcvM/24v2Mf20PgH+3l8CdK/aA/Z61iPVNI1FF86LI+0Wc+PnhnTqjqeOevUcV3nx/wD2gfh/+zp4CuPHHjq5CBQVtrZT+9uJeyIP5noBX+Ud/wAEL/25f2t/2NP2u7A/s7xPrPhzW5Yk8T6LOzCyls1PzTE9I5UXJRupPHIr+p39o79pXx/+0v8AEGbxv42l2RrlLO0QnyreLPCqPX1PUmvM4b8KauYZg5VJWwkdW/tP+6vPu+i8z8r8VvF3D8L4P6vhbTx017sekF/PL/21fafkjV/aF/aN8e/tHePZ/GvjOc+XuK2lopPlW8WeFUevqe9eFfasDmsL7UB1r9kv+Cen/BPuX4mPa/Gv41Wrw6HE4k0/T5FwbsjkO4PPl56D+L6V/QWbZjlnDmW+1q2hSgrRit2+kYrq/wDh2fw9kXDmdcZ526NK9SvUfNOctorrKT6JdF6JIh/Yq/4JyXXxq8MSfEn4wtPpukXkLLp1vH8s0hYcTHPRR1Ud6+KP2nP2bvHX7MXj+Twl4pUz2U+Xsb5QRHcRZ/Rh/Etf2D2trbWNtHZ2caxRRKEREGFVRwAAOgFeSfHL4G+Af2gvAVz4A8f2wmt5huimUDzYJB0dD2I/Wv5/yrxgx0c3niMcr4abtyL7C6OPdrr/ADeWlv604g+jdlFTh6ngsrfLjaauqj/5eS6xn2i/s2+Hz1v/ABi+d3r9O/2DP28r/wCBGpRfDT4lSvdeFL2UBJmYs9izcZX1j7kduor48/ah/Zr8bfsu/EWTwZ4pHn2c4MtheqMJcQ5IB9mHRhXzd9oAFf0Djsuy3iHLeSdqlGorpr8Gn0a/4DW6P5DyrMc74Mzz2tG9LE0XaUXs11jJdYv/ACaezP7pdK1bTNd02DWdGnS6tLlBJFLEwZHRuQQR1FaFfix/wSG1n47X3hPVLHXUL+BoT/oEtxneLjPzLD6pjr2B6d6/aev424nyP+yMyrZf7RT5Huvv17NdV0Z/pTwPxP8A6w5Lh82dGVJ1FrGXdaNp9YveL6oKKKK8A+sP/9b+/iiiigAr4E/4KI/8E4f2b/8AgpZ8DLr4M/H7SklljV5NJ1aJQLzTblhxLC/Uc43L0YcGvvuitKNadKaqU3aS2Ymk1Zn+Vt8Nf+DZH9vDxJ/wUEn/AGQfGti+m+DdMkF5eeNlTNjLpRb5Xgz964cfL5XVWyTx1/0lv2L/ANif9nv9gn4H6b8Bv2dNDh0jSrFF8+YKDcXs4GGmuJOskjHPJ6dBxX1lgZz3pa9bNc+xWPjGFV2iui6vu/60M6dKMNgooorxTU4T4m/DHwB8ZfAeqfDH4paRba7oGtQPbXtjeRiWGaJxghlII/wr/M//AOCw/wDwbq/En9kb9o7Ttc/ZhQ6h8KvGl4VgknkUyaJIxy0UmTueMDmNgCexr/SN/aA/aA+Hf7N3w6u/iL8RbtYYIFIggBHm3Ev8Mca9yfyA5NfyB/tTftZfEX9qv4gSeL/GEv2exgLJYWEZPlW8WeOO7H+Ju9fsXhRwnmOZYl4hNwwi+Jv7T/lj5930Xnofj3iv4nYThrCPD0bTxs17kekV/PPy7L7T8rn58fs1fs1/Df8AZg8Dp4U8CwB7qYK19fuAZrmQDkseyjsvQV9GfaWrAWcjvUnnt6mv62w+Cp0KapUo2itkfwFmOLxWPxNTGYyo51Zu8pN6t/1stktEftx/wTa/YHsfi6sHx2+L8aT6BFJnT7DcGFy6dWlAzhQf4T171/SBaWltY20dlZRrFDEoREQYVVHAAA6AV/Hv+xJ+3N4y/ZO8Wi0ui+oeE9QkX7dYk5KdjLFzw49Ohr+tj4c/Efwb8WPB1l498A30eoaZqEYkiljOevVWHZh0IPIr+TPGXLs6p5p9Zxz5sO9KbXwxX8rXSXd/a3Wmi/t76P8AmHD08l+qZZDkxUdaydueT/mT0vDsl8Oz1d33FFFFfjR/QB4x8dPgN8O/2hvA1x4F+Idms8MgJhmAxLbydnjbqCP1r8RPg3/wSV8Z/wDC9r7T/izMreDNIlEkM8TYfUVPKpgcoAPv+/Ar+iKivrsh43zbKMLWweCq2hUXXXlf80eza0/HdJnwPFHhpkHEGOw+YZlQ5qlJ7rTnXSM/5op6/hs2jD8NeGdA8HaHbeGvC9nFYWFmgjhghUIiKOwArcoor5Oc5Tk5Sd292fd06cacVCCtFaJLZLsgoooqSz//1/7+KKKKACiiigAooooAK8J/aK/aG+H37M/wzvPiX8QrgRwwDbb26kebczH7saDuSep7DmvdW3bTt69s1/Hj/wAFS9c/acu/2hbiw+Psf2fTYWf+w47bd9ha2zw0ZPWQj7+eQfav0Dw44PpcRZssLXqqFOK5pK9pSS6RXfu+i1PzvxN4zrcN5PLF4ei51JPli7XjFv7U327Lq9Dwr9qv9rn4lftZ+Pv+Ev8AG8i29na7ksNPiJ8m2iJ7Ak5Y/wATHrXy/wDacDJNYfn45PFftR/wTX/4Ju6j8aryz+OXxttpLXwtbSrJY2Mi7W1Bl53MD0hB/wC+vpX9jZpmGU8LZT7WolTo01aMVu30jFdW/wDNvqz+HcryTOeLs4dODdSvUd5Tlsl1lJ9Eui9Elsix/wAE8/8Agmpc/Hq3HxZ+OcFxY+F8f6Daj93Jen++eMiMdum76V88ft4fsM+LP2RvGH9p6MJtS8G6gxNnfMMmFj/yxmIAAYfwnuPev7DbGxs9Ms4tP0+JYIIFCRxoNqqq8AADoBXL+P8AwB4R+KHhG+8C+OrGPUNM1CMxTQyjIIPcehHUEdDX8x4PxqzWOdvH11fDS0dJbKPRp/zrdvrtta39V47wCyWeQRy7D6YqOqrPeUuqkv5Hsl9ndXd7/wACwuGHevvT9iL9u7x1+yP4n+wMDqXhPUJVN/YMTlOxlh/uuB+BqH9vD9hXxl+yD4v/ALS03zNT8HajIfsV8VyYSf8AljNjgMOx/iHvX59C6bHav6fjDKeJsqurVcPVX9ecZRfzTP5LdLOeE850vRxNJ/15SjJfJo/v3+GnxJ8HfF3wRp/xC8BXiX2l6lEJYZEPr1Vh2YdCDyDXd1/PD/wRa8KftJW8moeKfPNp8N7kMBBdKT9ouR/Hbgn5QP4m6Gv6Hq/iHjXh6lkmb1svoVlUjF6Nbq/2ZdOZdbfhsf6AcC8SVs9yahmWIoOlOS1T2dvtR68r3V/x3ZRRRXyh9eFFFFABRRRQB//Q/v4ooooAKKKKACiiigAr5u/aj/Zg+HX7VvwyuPh14+i2N/rLO8jA861mHR0Pp2YdCOK+kaK6sDjq+DxEMVhZuFSDumt00cmOwOHxuHnhcVBTpzVpJ7NM/nF/ZW/4I2eINL+MV9rH7Rk0Vz4d0G5H2GCA8anjlXfuiDjcvJJ46V/RfY2FlpdlFpumxJBbwII444wFVEUYAAHAAFW6K9/injHM+Ia8a+Y1L8qsorSK7tLu3q3+iSPn+E+C8q4dw86GW07czvJvWT7Jvstkv1bYUUUV8sfVnEfEb4c+Dvix4Mv/AAB49sY9Q0vUYjFNDIMjB7j0YdQRyDX4HeH/APgiNJB+0LKNe1vzvhzARcxBeLyUEn/R27ADu46jtmv6KKK+r4d42zjI6Vajl1ZxjUVmt7P+aN9pW0uv0R8lxJwNk2e1aFfMqCnKk7p7XX8srbxvrZ/qzn/CnhXw/wCCPDll4R8K2sdlp2nQrBbwRDCoiDAAFdBRRXy05ynJzm7t6tvqfVwhGEVCCsloktkgoooqSgooooAKKKKAP//R/v4ooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAP/Z"), contactLink = Just (either error CLFull $ strDecode "simplex:/contact/#/?v=1-2&smp=smp%3A%2F%2Fu2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU%3D%40smp4.simplex.im%2FShQuD-rPokbDvkyotKx5NwM8P3oUXHxA%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEA6fSx1k9zrOmF0BJpCaTarZvnZpMTAVQhd3RkDQ35KT0%253D%26srv%3Do5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"), peerType = Just CPTBot, diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 822253bd55..ecdd1b5998 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -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 diff --git a/src/Simplex/Chat/ProfileGenerator.hs b/src/Simplex/Chat/ProfileGenerator.hs index 4d10945ab6..b460a73d3d 100644 --- a/src/Simplex/Chat/ProfileGenerator.hs +++ b/src/Simplex/Chat/ProfileGenerator.hs @@ -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) diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 74d574b643..8c366254ae 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -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 diff --git a/src/Simplex/Chat/Store/ContactRequest.hs b/src/Simplex/Chat/Store/ContactRequest.hs index 3bd481d7db..75652349b5 100644 --- a/src/Simplex/Chat/Store/ContactRequest.hs +++ b/src/Simplex/Chat/Store/ContactRequest.hs @@ -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 diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 71e5c80a63..723b12d448 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -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, diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index fe16dd4731..68b8986a78 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -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) diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index d9405866bb..f1f3789209 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -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 diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index 2e62542c4e..e68a6ec72a 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -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 diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20260714_contact_description.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20260714_contact_description.hs new file mode 100644 index 0000000000..09f17c35f4 --- /dev/null +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20260714_contact_description.hs @@ -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; +|] diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 522f966214..139dbbe2b2 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -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 = diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index c6ae71a58d..68044846f0 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -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 diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20260714_contact_description.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20260714_contact_description.hs new file mode 100644 index 0000000000..704718e4e5 --- /dev/null +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20260714_contact_description.hs @@ -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; +|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 676dd7e312..f268d8648f 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -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, diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 36a3a0c545..bfc20635e4 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -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 diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 0dc27eb9e9..b5afc88b2a 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -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 diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 432642259d..5b90f492f6 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -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 /= ""] diff --git a/tests/Bots/BroadcastTests.hs b/tests/Bots/BroadcastTests.hs index bfe7b96c7d..9edbb3cb73 100644 --- a/tests/Bots/BroadcastTests.hs +++ b/tests/Bots/BroadcastTests.hs @@ -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 = diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 566036026e..0d49e075b9 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -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 = diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 581aaec879..e66fee0640 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -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 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 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 = diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index a38333c2a2..8fdef18b49 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -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 = diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 42ab8c2589..798ab3c4d7 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -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