Files
simplex-chat/tests/ChatTests/Direct.hs
T
sh 10a814694c core, ui: support SimpleX names (#7045)
* deps: bump simplexmq for ConnectTarget

* chat: migration adds simplex_name to contacts, groups, connections

Nullable TEXT column on all three tables, with partial indexes on
contacts(user_id, simplex_name) and groups(user_id, simplex_name)
for the upcoming connectPlanName lookup. connections.simplex_name
is the transient carrier from APIConnect -> XInfo handler, where
the value is copied to contacts.simplex_name at delayed create.
No reads or writes yet - column threading lands in subsequent commits.

* tests: provide namesConfig = Nothing in smpServerCfg

Follow-up to the simplexmq pin bump (ee0a45e9). The new
namesConfig :: Maybe NamesConfig field on ServerConfig (introduced
in simplexmq's namespace branch) needs to appear in the test
fixture's record literal, otherwise the test suite fails to compile
under -Werror. Disabled by default (Nothing).

* chat: thread simplexName through Contact/GroupInfo/Connection records

Adds `simplexName :: Maybe SimplexNameInfo` to the three records and
extends every SELECT path that reconstructs them to read the new
column. Decoded via eitherToMaybe . strDecode . encodeUtf8 (the
codebase's established pattern for Maybe Text -> typed-decode fields),
extracted as decodeSimplexName helper since the chain appears in
toContact / toContact' / toGroupInfo / toConnection. INSERT paths
still write Nothing - the write-side wiring lands in the next commit
(Task 7).

* deps: bump simplexmq for SimplexNameInfo FromField/ToField

* chat: cross-reference groupInfoQueryFields and getGroupAndMember_

Two helpers redundantly maintain the same g.* column list. A future
g.* addition must be applied to both sites; the cross-reference
comments flag this for maintainers. A proper refactor (reusing
groupInfoQueryFields from Connections.hs's inline SELECT) is out of
scope for this branch.

* chat: persist simplexName on prepare and connect-via-plan write paths

createPreparedContact/createPreparedGroup gain a Maybe SimplexNameInfo
parameter that they write to contacts.simplex_name / groups.simplex_name
directly. createConnection_ writes to connections.simplex_name as a
transient carrier for the connect-via-plan path. The XInfo handler
in Library/Subscriber.hs reads the connection's simplexName and passes
it to createDirectContact so the final contact row captures the name.

All current callers pass Nothing; the actual flow lights up when
APIConnectPlan accepts ConnectTarget and connectPlanName threads the
name through (later commits in this branch).

Uses the upstream ToField SimplexNameInfo (simplexmq 0b334b66) for
writes; reads continue to go via the soft-degradation helper.

* chat: APIConnectPlan accepts ConnectTarget; connectPlanName looks up by name

APIConnectPlan/Connect flip from Maybe AConnectionLink to Maybe ConnectTarget.
connectPlan dispatches CTLink -> connectPlanLink (the prior body, renamed)
and CTName -> connectPlanName (new) which looks the name up against
contacts.simplex_name and groups.simplex_name via the new
getContactBySimplexName / getGroupInfoBySimplexName store helpers.

The hit path returns the contact's / group's stored conn link from
preparedContact / preparedGroup; missing prepared state or unknown
names return CEInvalidConnReq. RSLV on-chain resolution is out of
scope for this branch -- known-name lookup is enough for conversation
display, search, and external-link share.

connLinkP_ parser is unchanged: APIConnect's preparedLink_ stays
ACreatedConnLink-shaped, and the Connect / APIConnectPlan parsers
already use inline strP for ConnectTarget without going through the
helper.

Directory.Service call sites updated to wrap their AConnectionLink in
CTLink when invoking APIConnectPlan.

* chat: surface simplexName in conversation view + JSON output

viewConnectionPlan now shows the simplex name beneath known
contacts/groups (ILPKnown, CAPKnown, CAPContactViaAddress, GLPKnown
active/prepared/deleted). The TH-derived Contact / GroupInfo JSON
instances automatically expose `simplexName` (omitted when Nothing
per defaultJSON's omitNothingFields), which unblocks client-side
display and search.

No JSON test added: there is no Contact-level JSON test module in
this codebase; coverage is already provided by defaultJSON's
omitNothingFields = True behaviour.

Server-side substring search has no existing pattern in this
codebase; client renderers index simplexName themselves once it
appears in the JSON shape.

External-link share (preferring simplex:/name… form over the raw
link when the contact has a simplexName) lands in the next commit.

* chat: share/copy output prefers simplexName when present

When a contact or group has a simplex_name stored, the share-link
render path emits the canonical simplex:/name... URI (via strEncode)
instead of the underlying connection link. Falls back to the existing
link rendering when simplexName is Nothing.

Final commit of the ConnectTarget plumbing chain: end-to-end users
can now (a) connect via @alice.simplex / #group.simplex with the
agent layer carrying the name, (b) see the simplex name on the
contact/group records and in viewConnectionPlan, (c) share the
contact using the namespace-canonical form rather than the raw URI.

* deps: bump simplexmq for boundedNonSpace + drop unused FromField

* chat: simplex_name partial indexes are UNIQUE

A simplex name is a stable, per-user identity (one name → one contact
or group). Without a unique constraint, a later writer that populates
the column twice for the same name would silently produce two matching
rows, and getContactBySimplexName/getGroupInfoBySimplexName would
return whichever the planner picks first.

Promote the partial indexes added in M20260603 to UNIQUE before any
caller wires the writes. Predicate (WHERE simplex_name IS NOT NULL)
already scopes the constraint to rows that opted in.

* chat: regen Postgres schema dump for UNIQUE simplex_name indexes

Follow-up to f71c579c. The SchemaDump test runs against SQLite only;
the parallel PostgresSchemaDump suite gates on -fclient_postgres and
a running localhost PG instance, which this environment doesn't have.
Updated the Postgres schema dump by hand to mirror the migration
change (two lines: CREATE INDEX → CREATE UNIQUE INDEX).

* chat: CESimplexNameNotFound for name lookup misses

connectPlanName now distinguishes "name not found" from "connection
link is invalid". CEInvalidConnReq's message ("Connection link is
invalid, possibly it was created in a previous version") was
misleading when a user typed @alice.simplex against a database that
simply has no contact by that name.

The two "missing prepared link" cases stay on CEInvalidConnReq —
the lookup found a row but the stored link is unusable, which is
closer to the existing semantics. The two truly-missing cases
(no contact found / no group found) move to CESimplexNameNotFound,
which also surfaces the name back to the client for a precise UX.

* chat: exclude soft-deleted contacts from idx_contacts_simplex_name

The lookup `getContactBySimplexName` (Store/Direct.hs:781) filters
`AND deleted = 0`, but the index predicate `WHERE simplex_name IS NOT
NULL` covered tombstoned rows too. Forward-compat trap: once writers
land a non-Nothing simplex_name, soft-deleting a contact would block
re-claiming its name (UNIQUE conflict) even though the lookup reports
the slot as free.

Tighten the partial-index predicate to also require deleted = 0 so the
constraint scope matches the live-lookup scope. Groups have no soft-
delete column, so their index stays as-is.

* chat: connectPlanName dispatches on nameType first

Previously the function always probed contacts.simplex_name first and
fell through to groups for NTPublicGroup misses. But the discriminator
(`@`/`#`) is embedded in the stored bytes via strEncode, so an
`#group.simplex` lookup can never match a contact row. Reorder to
case on nameType up front, saving one DB query and one withFastStore
transaction acquire on the group path.

* chat: CESimplexNameUnprepared for found-but-no-link cases + member-removed filter

connectPlanName previously threw CEInvalidConnReq when a name lookup
hit a contact / group row whose preparedContact / preparedGroup was
NULL. The error message ("Connection link is invalid, possibly it was
created in a previous version") was wrong: the name resolved fine,
the device just has no link material to reconnect via (typical for a
contact created via the XInfo handler rather than the prepare path).
Introduce CESimplexNameUnprepared SimplexNameInfo for this case.

Also mirror the link-based path's gPlan (Commands.hs:4133) for groups
whose membership state is GSMemRemoved — return CESimplexNameNotFound
rather than GLPKnown for a removed-member group, since GLPKnown for
removed members would be inconsistent with how /_connect plan over a
short link handles the same situation.

* chat: fix stale CRITICAL comment in saveConnInfo

Comment claimed SEDBException is re-thrown as CRITICAL but only
SEDBBusyError is (via the `critical` helper at Subscriber.hs:136
and the showCritical branch at :1695). Updated to describe the actual
behaviour.

* chat: fix misleading decodeSimplexName docstring

The comment described "@alice.simplex" as the column's surface form,
but ToField SimplexNameInfo writes the canonical strEncode output
("simplex:/name@alice.simplex"). Aligns the docstring with what the
column actually holds.

* chat: drop redundant T.unpack in CESimplexName* error rendering

plain has a Text instance (verified by sibling simplexNameLine at
View.hs:2176 which uses it directly). The T.unpack in the new error
renderings was inconsistent with the same-feature helper. Cosmetic
cleanup.

* deps: bump simplexmq for resolveSimplexName

* chat: simplexName field on Profile, GroupProfile, LocalProfile

Adds a Maybe SimplexNameInfo field to the wire-level Profile and
GroupProfile (and their DB sibling LocalProfile). JSON instances are
TH-derived with omitNothingFields = True, so the new optional field is
auto-handled and old peers / old JSON without the key decode as Nothing.

Existing record-construction sites are set to simplexName = Nothing as
a placeholder. Outgoing dissemination (userProfileDirect /
userProfileInGroup) and incoming persistence wire-up land in follow-up
commits. redactedMemberProfile passes the field through, matching how
peerType is preserved.

* chat: load LocalProfile.simplexName from simplex_name column

Populate the embedded LocalProfile.simplexName field for the user's own
profile and for peer Contact / GroupInfo from the existing simplex_name
columns on contacts and groups. Previously every DB read set this field
to Nothing (Task 1 placeholder), so downstream consumers that work off
LocalProfile / GroupProfile (e.g., userProfileDirect / userProfileInGroup
that build outgoing XInfo / XGrpInfo via fromLocalProfile) saw Nothing
unconditionally.

Scope is limited to the rows where the simplex_name column actually
exists: contacts (per-user) and groups (per-user). Sites that only read
contact_profiles / group_profiles (toContactRequest, toContactProfile,
toGroupProfile, rowToLocalProfile) remain Nothing; Task 3 adds the
profile-table columns and wires them up.

* chat: test outgoing Profile carries simplexName from User profile

userProfileDirect, userProfileInGroup' and redactedMemberProfile already
pass simplexName through via fromLocalProfile (Task 1) once the embedded
LocalProfile field is populated (previous commit). Lock that behavior in
with focused unit tests:

- userProfileDirect with Just simplexName -> wire Profile.simplexName Just
- userProfileDirect with Nothing -> wire Nothing
- userProfileDirect with an incognito Profile overlay -> wire Nothing
  (incognito identity must not leak the user's registered name)
- userProfileInGroup' pass-through
- redactedMemberProfile pass-through (forwarded member profiles)

* chat: clarify groups.simplex_name stopgap comment

Drop the asymmetric toContact comment (the mirror is now obvious post-Task-1)
and rewrite the toGroupInfo stopgap comment to reflect the actual semantics:
groups.simplex_name is per-user locally-known, mirrored into groupProfile as a
stopgap until group_profiles.simplex_name lands.

* chat: add simplex_name to contact_profiles and group_profiles

Adds nullable simplex_name TEXT column and partial UNIQUE
(user_id, simplex_name) index to both contact_profiles and group_profiles
tables. Distinct from contacts.simplex_name / groups.simplex_name
(M20260603), which carry the user's locally-known label set by the
prepare-via-name path; the new columns will carry the peer's broadcast
claim received via XInfo / XGrpInfo (wired up in following commits).

* chat: persist peer-claimed simplexName from incoming profiles

Write paths:
- updateContactProfile_' / updateGroupProfile_ now set the new
  contact_profiles.simplex_name / group_profiles.simplex_name columns
  from Profile.simplexName / GroupProfile.simplexName respectively.
- createContact_ INSERT writes Profile.simplexName to the new
  contact_profiles column (separate from the existing simplexName arg,
  which still writes contacts.simplex_name — the user's locally-known
  label).

Read paths (closing Task 2's deferred sites):
- toContact splits simplex_name reads: Contact.simplexName from
  contacts.simplex_name (existing); LocalProfile.simplexName from
  contact_profiles.simplex_name (new column).
- toGroupInfo similarly splits: GroupInfo.simplexName from
  groups.simplex_name; groupProfile.simplexName from
  group_profiles.simplex_name.
- ProfileRow / rowToLocalProfile, toContactRequest, getUserContactProfiles,
  toGroupProfile, getProfileById, groupMemberQuery, getGroupAndMember_,
  saveRcvChatItem-related quotes — all extended to read p.simplex_name
  and decode it into LocalProfile.simplexName / GroupProfile.simplexName.

Conflict handling (Decision B):
- clearConflictingContactProfileSimplexName_ / *Group* helpers do an
  atomic UPDATE-with-RETURNING that NULLs simplex_name on any other
  row in the same user that would collide on the partial UNIQUE index,
  returning the displaced row's display_name.
- updateContactProfileWithConflict / updateGroupProfileWithConflict
  bundle clear+update in one transaction.
- processContactProfileUpdate / xGrpInfo invoke the *WithConflict
  variants and emit CEvtSimplexNameConflict when a displacement
  happened (with the claiming and displaced display names).

Adds ChatEvent CEvtSimplexNameConflict and SimplexNameConflictEntity
(SNCEContact / SNCEGroup) with JSON instances and View.hs rendering.

* chat: fix review findings on simplex_name persistence

- updateUserProfile no longer writes contact_profiles.simplex_name on
  the user's own row (the column is reserved for peer claims; the user's
  broadcastable name lives on contacts.simplex_name via uct.simplex_name).
- updateMemberContactProfile_'/Reset_' now write simplex_name; new
  updateMemberProfileWithConflict / updateContactMemberProfileWithConflict
  variants run conflict-clear and return the displaced name, with
  processMemberProfileUpdate emitting CEvtSimplexNameConflict.
- createContact_ runs conflict-clear before INSERT to avoid UNIQUE
  constraint violations on first-write peer collisions, returning the
  displaced name; createPreparedContact / createDirectContact thread it
  through to APIPrepareContact and saveConnInfo XInfo for event emission.
- groups conflict-clear takes ProfileId directly (avoids the NOT IN (NULL)
  silent-noop edge case when groups.group_profile_id is ON DELETE SET NULL).
- Moves clearConflictingContactProfileSimplexName_ to Shared.hs so
  createContact_ can call it without inducing a circular import.

* chat: resolveOnUserServers iterates user SMP servers for RSLV

* chat: connectPlanName falls back to RSLV when local lookup misses

* chat: RSLV-resolved NameRecord dispatched through prepared row

dispatchResolvedRecord now picks the first nrContactLinks (NTContact) or
nrChannelLinks (NTPublicGroup) entry from the resolved record, decodes it
as AConnShortLink, fetches the short-link data, and eagerly calls
createPreparedContact / createPreparedGroup with the simplex_name set.

Returning CPContactAddress (CAPKnown ct) / CPGroupLink (GLPKnown g ...)
mirrors the local-store-hit branch of connectPlanName: hit and miss
converge on the same plan shape, so the connectWithPlan caller cannot
distinguish where the prepared row came from. Threading uses the
existing Maybe SimplexNameInfo parameter added in c6f26150 for the
local-prepare path -- no new write path or transient carrier.

Pure helper firstNameLink is extracted and exported so the link-picker
contract is testable without a DB / agent. ResolveNameTests gains five
cases covering the per-type selection, the first-link policy, and the
empty-list to CESimplexNameNotFound collapse.

* chat: regen query plans after simplex_name plumbing

* chat: register ConnectTarget + CEvtSimplexNameConflict in bot docs

Bot API docs generator failed with "Undefined type: ConnectTarget"
since f2394d121 (prior plan) flipped APIConnectPlan/Connect from
Maybe AConnectionLink to Maybe ConnectTarget without updating
bots/src/API/Docs/*. Also adds SimplexNameConflictEntity (new in
cd0de9659) and documents the CEvtSimplexNameConflict event for
peer-name displacement notifications. Regenerates the affected
markdown / TypeScript / Python artefacts.

* deps: bump simplexmq for NameRecord reshape; update consumers

simplexmq 5ee014dd reshaped NameRecord to align with the Python resolver
JSON: nrChannelLinks/nrContactLinks (lists of NameLink) became
nrSimplexChannel/nrSimplexContact (Maybe Text); nrDisplayName became
nrName; nrResolver was added; the NameLink wrapper type and nrIsTest/
nrExpiry/nrAdminAddress/nrAdminEmail fields were dropped.

Update dispatchResolvedRecord destructure and firstNameLink signature
to the new Maybe Text shape, and refresh the ResolveNameTests fixtures
and assertions accordingly.

* chat: resolveOnUserServers iterates only on transport errors

Privacy: every miss previously broadcast the candidate name to every
enabled SMP server. Now only NETWORK / TIMEOUT failures fall through
to the next server; definite resolver answers (NAME / AUTH / CMD
PROHIBITED / other ERR) stop iteration.

* chat: document why groups simplex_name index has no soft-delete filter

The contacts simplex_name index filters on (deleted = 0); the groups
index has no analogous filter because the groups table has no `deleted`
column. Groups are hard-deleted by deleteGroup, so the asymmetry is
intentional. The remaining "removed member, row retained" edge case is
flagged in the lookup comment for follow-up.

* chat: document connections.simplex_name as transient carrier

Audit flagged the column as "INSERTed but never UPDATEd". This is by
design per the prior plan's connect-via-plan flow: the column is a
transient carrier between connection-creation and contact-creation.
After the Contact row is created via XInfo handling, contacts.simplex_name
is the source of truth and the connections value is a historical snapshot.
Documents the intent so future readers don't reflag it.

* chat: extract surfaceSimplexNameConflict helper

Six call sites duplicated the same forM_ ((,) <$> claim <*> displaced)
shape emitting CEvtSimplexNameConflict. Extract to a single helper so
future call sites don't drift on whether to emit, and so the conflict
event shape change (post-Task-3 SimplexNameConflictEntity split into
SNCEContact / SNCEGroup) propagates through one site.

* chat: APIVerifySimplexName command + CEvtSimplexNameUnverified warning

Addresses the TOFU vulnerability where peer-claimed simplex_name was
accepted unverified. Adds:

- contacts.simplex_name_verified_at + groups.simplex_name_verified_at
  (M20260606_simplex_name_verified)
- APIVerifySimplexName ChatRef command: RSLV-resolves the claimed name
  and compares the resolved link to the peer's stored connection link;
  on match writes verified_at and emits CEvtSimplexNameVerified;
  on mismatch emits CEvtSimplexNameVerifyFailed
- CEvtSimplexNameUnverified passive warning emitted on incoming XInfo /
  XGrpInfo when a name claim arrives without a current verification
- updateContactProfileWithConflict / updateGroupProfileWithConflict
  clear simplex_name_verified_at whenever the peer's claim transitions
  (any value change including Nothing<->Just): the prior verification
  was bound to the prior claim.

UI can surface the unverified indicator next to a contact / group's
name, and prompt the user to invoke the verify command. This shifts
the security model from "TOFU + last-writer-wins" to "TOFU + on-demand
RSLV verification".

* chat: register APIVerifySimplexName + verify events in bot docs

ebe90f716 added the verify command + events + SimplexNameVerifyFailReason
type without touching bots/src/API/Docs/. Mirrors commit 0d7ea8061 which
addressed the same gap for ConnectTarget. Regenerates the affected
markdown / TypeScript / Python artefacts.

* chat: bump simplexmq pin + document cross-table simplex_name discriminator

Pin bump 5ee014dd -> c9c2d19 picks up the 8 simplexmq commits since the
last bump (parseBare lowercase fix, forwarded-param cleanup, ServerTests
+ agent end-to-end tests, TldRegistries removal, SNRC ABI decoder,
NameRecord/NameOwner module extraction).

Adds a brief comment on clearConflictingContactProfileSimplexName_
explaining why the audit's flagged cross-table collision (between
contact_profiles.simplex_name and group_profiles.simplex_name) is
structurally impossible: SimplexNameInfo's strEncode prefixes contact
names with '@' and group names with '#', so the stored bytes never
overlap between the two tables.

Query-plan regen deferred (the test is non-deterministic in CI / dev
sandbox — see prior 6c990696c).

* deps: bump simplexmq for HTTP resolver; adapt NameRecord consumers

simplexmq 92b3d049 reshaped NameRecord text fields from Maybe Text to
Text (empty string sentinel). Adapt firstNameLink to take Text directly
and treat T.null as "absent". dispatchResolvedRecord destructure
unchanged; passes the text values straight through. apiVerifySimplexName
switches from Just/Nothing pattern to a T.null guard with the same UX.
Test fixtures updated.

* deps: bump simplexmq for multi-link NameRecord; adapt consumers

* core: treat RSLV CMD UNKNOWN as no name-resolution support

* core: fix contact-by-connection query missing simplex_name_verified_at

* deps: update sha256map for simplexmq f555e9af pin

* core: iterate past RSLV-unsupported name servers

* core: filter RSLV servers by operator enablement

* core: align resolver docs/tests with RSLV errors

* deps: bump simplexmq to df1aa24c

* refactor(names): agent resolution + one error type

Adopt the simplexmq names rework (PR #7045): name resolution is now
owned by the agent (resolveSimplexName picks a names-role server), so
the chat-side iteration is removed - delete ResolveError,
iterateResolvers, resolveOnUserServers, enabledSMPServersForUser and
resolveErrorToChatError.

One error type: resolver/agent failures flow through ChatErrorAgent;
remove the CEvtSimplexName* events, SimplexNameVerifyFailReason,
SimplexNameConflictEntity and CESimplexNameResolverUnavailable.
APIVerifySimplexName returns CRSimplexNameVerified (verified::Bool),
mirroring CRConnectionVerified. connectPlan handles the name target
directly; updateProfile WithConflict aliases collapsed into the plain
functions.

Add the per-operator "names" SMP server role (migration
20260612_smp_role_names, official operator on by default) feeding
ServerRoles.names -> UserServers.nameSrvs.

Bump simplexmq pin to ce69adfd and regenerate sha256map.nix.

* fix(store): match chat_schema.sql to sqlite 3.46+ indent

The schema-dump test renders the partial-index WHERE via the sqlite3
CLI; sqlite >=3.46 wraps a multi-condition WHERE onto two lines
("IS NOT NULL" + indented "AND ...") where 3.45 kept it on one. The
committed schema was generated with 3.45, so CI (newer sqlite) failed
the comparison on idx_contacts_simplex_name. Regenerated with the
newer formatter; only that one WHERE clause changes.

* feat(operators): warn when no server resolves names

Mirror USWNoChatRelays: validateUserServers emits USWNoNamesServers
when no enabled server of an enabled operator carries the SMP names
role. noNamesServersWarns is self-contained with local predicates,
matching the sibling noChatRelaysWarns; noServersErrs is untouched.

* test(operators): expect USWNoNamesServers warning in no-servers cases

* fix(store): single-line simplex_name WHERE to match CI sqlite (<=3.45)

* chore: bump simplexmq pin to 6843b14c

* refactor(store): consolidate names migrations into one

Unshipped feature - merge the four incremental simplex_name migrations
(0603/0604/0606/0612) into a single M20260603_simplex_name. The combined
UP applies the ALTERs/indexes in the same order, so the resulting schema
is byte-identical (verified by SchemaDump on SQLite and pg_dump on Postgres).

* update simplexmq

* plan for name resolution

* update types and schema

* simpler resolution, name proofs

* simplexmq

* generate bot types, schema, unStrJSON, fix tests

* ad hoc link comparison, create short link

* update simplexmq

* remove same link, use simplexmq instead

* split verify API for contacts and public groups

* remove comment

* simplify warnings

* test: remove unused

* remove cute language

* type name

* remove spurious comments

* refactor setting user name

* refactor setting user name

* remove trivial tests

* refactor

* remove tests using pre-short-link addresses

* rename

* move names

* bots api

* refactor more

* refactor

* refactor to another type

* load own names

* read short links when looking up by name

* renames

* refactor verification

* mapM_

* update api types

* change field for name

* rename columns

* api types, schema

* renames

* fix links

* simplify

* remove comments

* rename fields

* simplify

* remove proof from channel addres

* refactor

* name resolution test

* change tests

* fix tests

* fix tests

* fix plan for names

* test

* test verification status

* bot api

* fix tests

* update bot api types

* query plan

* add api for setting public group access

* android, desktop, ios: connect via SimpleX name (#7068)

* android, desktop, ios: connect via SimpleX name

* android, desktop, ios: open known contact on name lookup; surface prepared contact

Name search opens the contact (not list-filter); resolved/prepared contacts and groups are added to the chat list so they're visible and openable. Kotlin compile-verified; iOS edits pattern-matched, pending Xcode build.

* feat(names): UI names role + agent NAME error

Parity with the core names rework (#7045):

- Add `names` to ServerRoles (Android + iOS) and a per-operator
  "To resolve names" toggle under the SMP section (xftp has no names
  role; the shared ServerRoles field stays false there).
- Mirror the new agent error: NameErrorType + a NAME case on both
  AgentErrorType and ProtocolErrorType (the SMP ErrorType mirror), so
  the new SMP/agent NAME errors decode instead of crashing the decoder.
- Remove ChatErrorType.SimplexNameResolverUnavailable (deleted in core)
  and repoint its "name resolution unavailable" alert to the agent
  NAME NO_SERVERS error, reusing the existing strings.

Android (multiplatform) compiles clean; iOS mirrors the same changes
(builds in Xcode).

* feat(names): UI warning when no server resolves names

Mirror core USWNoNamesServers: add the NoNamesServers variant to
UserServersWarning (Kotlin sealed class + Swift enum) and its
globalWarning / globalServersWarning branch, rendered by the existing
ServersWarningFooter / ServersWarningView. Matches the noChatRelays
warning exactly.

* fix(servers): show all validation errors and warnings, not just the first

globalServersError/Warning returned only the first entry, so a second
warning (e.g. no names servers behind no chat relays) or a second error
(e.g. no XFTP servers behind no SMP servers) was never displayed. Make
them return all entries (globalServersErrors/Warnings) and render one
footer row each, across the three combined-footer views. Per-protocol
SMP/XFTP footers are unchanged.

* docs(names): add SimpleX name UI plan

* feat(names): add name model fields + SimplexName helpers

* feat(names): verify + set-name API & responses

* docs(names): bump core sync to 5008b4e62

* feat(names): show name + verification on chat info

* feat(names): add Verify SimpleX names privacy toggle

* feat(names): add set-name screens (user + channel)

* update ui

* fix kotlin

* fix codable

* fix ios

* fix errors

* api in UI

* send name as string in protocol

* update simplexmq, capitalize

* verify that name is in profile for own and known contacts and channels as condition of name resolution

* update simplexmq

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>

* add log

* bot types

* finalize renames, ui alerts

* more renames

* kotlin alerts

* show set name

* alerts

* texts, icons, footers

* move JSON parsing to a persistent thread with large stack

* simplexmq

* use uikit alerts

* remove comment

* move name verification to more privacy

* change icon on verify names setting

* verify name proof

* nix shas

* show verified names

* better alert when saving names

* revert breaking field name change

* simplexmq

* clean up

* remove unused

* remove empty line

* fix error

* simplify

* use domain without prefix in profiles and in database, rename fields and types

* rename types

* fix JSON name

* pass verified domain to prepare API

* fix prepare api

* fix ios encoding

* enable name resolution via Flux servers

* fix test

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
2026-07-03 12:51:52 +01:00

3376 lines
131 KiB
Haskell

{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PostfixOperators #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
module ChatTests.Direct where
import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
import Control.Monad (forM_, void)
import Data.Aeson (ToJSON)
import qualified Data.Aeson as J
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.List (intercalate)
import qualified Data.Text as T
import Simplex.Chat.AppSettings (defaultAppSettings)
import qualified Simplex.Chat.AppSettings as AS
import Simplex.Chat.Call
import Simplex.Chat.Controller (ChatConfig (..), PresetServers (..))
import Simplex.Chat.Messages (ChatItemId)
import Simplex.Chat.Options
import Simplex.Chat.Protocol (supportedChatVRange)
import Simplex.Chat.Types (VersionRangeChat, authErrDisableCount, sameVerificationCode, verificationCode, pattern VersionChat)
import Simplex.Messaging.Agent.Env.SQLite
import Simplex.Messaging.Agent.RetryInterval
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Client (NetworkTimeout (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Server.Env.STM hiding (subscriptions)
import Simplex.Messaging.Transport
import Simplex.Messaging.Util (safeDecodeUtf8)
import Simplex.Messaging.Version
import System.Directory (copyFile, doesDirectoryExist, doesFileExist)
import Test.Hspec hiding (it)
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..))
#else
import Database.SQLite.Simple (Only (..))
import Simplex.Chat.Options.DB
import System.FilePath ((</>))
#endif
chatDirectTests :: SpecWith TestParams
chatDirectTests = do
describe "direct messages" $ do
describe "add contact and send/receive messages" testAddContact
it "retry connecting via the same link" testRetryConnecting
it "retry connecting via the same link with client timeout" testRetryConnectingClientTimeout
it "mark multiple messages as read" testMarkReadDirect
it "clear chat with contact" testContactClear
it "deleting contact deletes profile" testDeleteContactDeletesProfile
it "delete contact keeping conversation" testDeleteContactKeepConversation
it "delete conversation keeping contact" testDeleteConversationKeepContact
it "direct message quoted replies" testDirectMessageQuotedReply
it "direct message update" testDirectMessageUpdate
it "direct message edit history" testDirectMessageEditHistory
it "direct message delete" testDirectMessageDelete
it "direct message delete multiple" testDirectMessageDeleteMultiple
it "direct message delete multiple (many chat batches)" testDirectMessageDeleteMultipleManyBatches
it "direct live message" testDirectLiveMessage
it "direct timed message" testDirectTimedMessage
it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact
it "should send multiline message" testMultilineMessage
it "send large message" testLargeMessage
it "initial chat pagination" testChatPaginationInitial
describe "batch send messages" $ do
it "send multiple messages api" testSendMulti
it "send multiple timed messages" testSendMultiTimed
it "send multiple messages, including quote" testSendMultiWithQuote
it "send multiple messages (many chat batches)" testSendMultiManyBatches
describe "duplicate contacts" $ do
it "duplicate contacts are separate (contacts don't merge)" testDuplicateContactsSeparate
it "new contact is separate with multiple duplicate contacts (contacts don't merge)" testDuplicateContactsMultipleSeparate
describe "invitation link connection plan" $ do
it "invitation link ok to connect" testPlanInvitationLinkOk
it "own invitation link" testPlanInvitationLinkOwn
it "connecting via invitation link" testPlanInvitationLinkConnecting
describe "SMP servers" $ do
it "get and set SMP servers" testGetSetSMPServers
it "test SMP server connection" testTestSMPServerConnection
describe "XFTP servers" $ do
it "get and set XFTP servers" testGetSetXFTPServers
it "test XFTP server connection" testTestXFTPServer
describe "operators and usage conditions" $ do
it "get and enable operators, accept conditions" testOperators
describe "async connection handshake" $ do
it "connect when initiating client goes offline" $ testAsyncInitiatingOffline True
it "connect when accepting client goes offline" $ testAsyncAcceptingOffline True
it "connect, fully asynchronous (when clients are never simultaneously online)" $ testFullAsyncFast
describe "webrtc calls api" $ do
it "negotiate call" testNegotiateCall
#if !defined(dbPostgres)
describe "maintenance mode" $ do
it "start/stop/export/import chat" testMaintenanceMode
it "export/import chat with files" testMaintenanceModeWithFiles
it "encrypt/decrypt database" testDatabaseEncryption
#endif
describe "connections synchronization" $ do
it "should report users missing in agent" testConnSyncMissingAgentUsers
it "should remove and report extra users in agent" testConnSyncExtraAgentUsers
it "should report connections missing in agent" testConnSyncMissingAgentConns
it "should remove and report extra connections in agent" testConnSyncExtraAgentConns
describe "coordination between app and NSE" $ do
it "should not subscribe in NSE and subscribe in the app" testSubscribeAppNSE
describe "mute/unmute messages" $ do
it "mute/unmute contact" testMuteContact
it "mute/unmute group and member" testMuteGroup
describe "multiple users" $ do
it "create second user" testCreateSecondUser
it "multiple users subscribe and receive messages after restart" testUsersSubscribeAfterRestart
it "both users have contact link" testMultipleUserAddresses
it "create user with same servers" testCreateUserSameServers
it "delete user" testDeleteUser
it "delete user with chat tags" testDeleteUserChatTags
it "rejects raw chat TTL updates for another user's chat" testRejectCrossUserChatTTL
it "users have different chat item TTL configuration, chat items expire" testUsersDifferentCIExpirationTTL
it "chat items expire after restart for all users according to per user configuration" testUsersRestartCIExpiration
it "chat items only expire for users who configured expiration" testEnableCIExpirationOnlyForOneUser
it "disabling chat item expiration doesn't disable it for other users" testDisableCIExpirationOnlyForOneUser
it "both users have configured timed messages with contacts, messages expire, restart" testUsersTimedMessages
it "user profile privacy: hide profiles and notifications" testUserPrivacy
it "set direct chat expiration TTL" testSetDirectChatTTL
describe "settings" $ do
it "set chat item expiration TTL" testSetChatItemTTL
it "save/get app settings" testAppSettings
describe "connection switch" $ do
it "switch contact to a different queue" testSwitchContact
it "stop switching contact to a different queue" testAbortSwitchContact
it "switch group member to a different queue" testSwitchGroupMember
it "stop switching group member to a different queue" testAbortSwitchGroupMember
describe "connection verification code" $ do
it "verificationCode function converts ByteString to series of digits" $ \_ ->
verificationCode (C.sha256Hash "abcd") `shouldBe` "61889 38426 63934 09576 96390 79389 84124 85253 63658 69469 70853 37788 95900 68296 20156 25"
it "sameVerificationCode function should ignore spaces" $ \_ ->
sameVerificationCode "123 456 789" "12345 6789" `shouldBe` True
it "mark contact verified" testMarkContactVerified
it "mark group member verified" testMarkGroupMemberVerified
#if !defined(dbPostgres)
-- TODO [postgres] restore from outdated db backup (same as in agent)
describe "message errors" $ do
it "show message decryption error" testMsgDecryptError
it "should report ratchet de-synchronization, synchronize ratchets" testSyncRatchet
it "synchronize ratchets, reset connection code" testSyncRatchetCodeReset
#endif
describe "message reactions" $ do
it "set message reactions" testSetMessageReactions
describe "delivery receipts" $ do
it "should send delivery receipts" testSendDeliveryReceipts
it "should send delivery receipts depending on configuration" testConfigureDeliveryReceipts
describe "link content filter" $ do
it "filter chat by link content" testLinkContentFilter
describe "negotiate connection peer chat protocol version range" $ do
describe "peer version range correctly set for new connection via invitation" $ do
testInvVRange supportedChatVRange supportedChatVRange
testInvVRange supportedChatVRange vr11
testInvVRange vr11 supportedChatVRange
testInvVRange vr11 vr11
describe "peer version range correctly set for new connection via contact request" $ do
testReqVRange supportedChatVRange supportedChatVRange
testReqVRange supportedChatVRange vr11
testReqVRange vr11 supportedChatVRange
testReqVRange vr11 vr11
it "update peer version range on received messages" testUpdatePeerChatVRange
where
testInvVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnInvChatVRange vr1 vr2
testReqVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnReqChatVRange vr1 vr2
testAddContact :: HasCallStack => SpecWith TestParams
testAddContact = versionTestMatrix2 runTestAddContact
where
runTestAddContact pqExpected withShortLink alice bob = do
alice ##> "/_connect 1"
inv <- (if withShortLink then getInvitation else getInvitationNoShortLink) alice
bob ##> ("/_connect 1 " <> inv)
bob <## "confirmation sent!"
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
threadDelay 100000
chatsEmpty
alice #> "@bob hello there 🙂"
bob <# "alice> hello there 🙂"
alice ##> "/_unread chat @2 on"
alice <## "ok"
alice ##> "/_unread chat @2 off"
alice <## "ok"
chatsOneMessage
bob #> "@alice hello there"
alice <# "bob> hello there"
bob #> "@alice how are you?"
alice <# "bob> how are you?"
chatsManyMessages
where
chatsEmpty = do
alice @@@ [("@bob", lastChatFeature)]
alice #$> ("/_get chat @2 count=100", chat, features)
bob @@@ [("@alice", lastChatFeature)]
bob #$> ("/_get chat @2 count=100", chat, features)
chatsOneMessage = do
alice @@@ [("@bob", "hello there 🙂")]
alice #$> ("/_get chat @2 count=100", chat, features <> [(1, "hello there 🙂")])
bob @@@ [("@alice", "hello there 🙂")]
bob #$> ("/_get chat @2 count=100", chat, features <> [(0, "hello there 🙂")])
chatsManyMessages = do
alice @@@ [("@bob", "how are you?")]
alice #$> ("/_get chat @2 count=100", chat, features <> [(1, "hello there 🙂"), (0, "hello there"), (0, "how are you?")])
bob @@@ [("@alice", "how are you?")]
bob #$> ("/_get chat @2 count=100", chat, features <> [(0, "hello there 🙂"), (1, "hello there"), (1, "how are you?")])
-- pagination
alice #$> ("/_get chat @2 after=" <> itemId 1 <> " count=100", chat, [(0, "hello there"), (0, "how are you?")])
alice #$> ("/_get chat @2 before=" <> itemId 2 <> " count=100", chat, features <> [(1, "hello there 🙂")])
alice #$> ("/_get chat @2 around=" <> itemId 2 <> " count=2", chat, [(0, "Audio/video calls: enabled"), (1, "hello there 🙂"), (0, "hello there"), (0, "how are you?")])
-- search
alice #$> ("/_get chat @2 count=100 search=ello ther", chat, [(1, "hello there 🙂"), (0, "hello there")])
-- read messages
alice #$> ("/_read chat @2", id, "ok")
bob #$> ("/_read chat @2", id, "ok")
alice #$> ("/read user", id, "ok")
alice #$> ("/_read user 1", id, "ok")
features = if pqExpected then chatFeatures else chatFeaturesNoPQ
testRetryConnecting :: HasCallStack => TestParams -> IO ()
testRetryConnecting ps = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile test ps
where
tmp = tmpPath ps
test alice bob = do
inv <- withSmpServer' serverCfg' $ do
alice ##> "/_connect 1"
getInvitation alice
alice <## "disconnected 1 connections on server localhost"
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: ok to connect"
_sLinkData <- getTermLine bob
bob ##> ("/_connect 1 " <> inv)
bob <##. "smp agent error: BROKER"
withSmpServer' serverCfg' $ do
alice <## "subscribed 1 connections on server localhost"
threadDelay 250000
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: ok to connect"
_sLinkData <- getTermLine bob
bob ##> ("/_connect 1 " <> inv)
bob <## "confirmation sent!"
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
alice #> "@bob message 1"
bob <# "alice> message 1"
bob #> "@alice message 2"
alice <# "bob> message 2"
bob <## "disconnected 1 connections on server localhost"
alice <## "disconnected 1 connections on server localhost"
serverCfg' =
smpServerCfg
{ transports = [("7003", transport @TLS, False)],
msgQueueQuota = 2,
serverStoreCfg = persistentServerStoreCfg tmp
}
fastRetryInterval = defaultReconnectInterval {initialInterval = 50000} -- same as in agent tests
cfg' =
testCfg
{ agentConfig =
testAgentCfg
{ quotaExceededTimeout = 1,
messageRetryInterval = RetryInterval2 {riFast = fastRetryInterval, riSlow = fastRetryInterval}
}
}
opts' =
testOpts
{ coreOptions =
testCoreOpts
{ smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7003"]
}
}
testRetryConnectingClientTimeout :: HasCallStack => TestParams -> IO ()
testRetryConnectingClientTimeout ps = do
inv <- withSmpServer' serverCfg' $ do
withNewTestChatCfgOpts ps cfg' opts' "alice" aliceProfile $ \alice -> do
alice ##> "/_connect 1"
inv <- getInvitation alice
withNewTestChatCfgOpts ps cfgZeroTimeout opts' "bob" bobProfile $ \bob -> do
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: ok to connect"
_sLinkData <- getTermLine bob
bob ##> ("/_connect 1 " <> inv)
bob <## "smp agent error: BROKER {brokerAddress = \"smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7003\", brokerErr = TIMEOUT}"
pure inv
logFile <- readFile $ tmp <> "/smp-server-store.log"
logFile `shouldContain` "SECURE"
withSmpServer' serverCfg' $ do
withTestChatCfgOpts ps cfg' opts' "alice" $ \alice -> do
withTestChatCfgOpts ps cfg' opts' "bob" $ \bob -> do
threadDelay 250000
alice <## "subscribed 1 connections on server localhost"
-- bob <## "1 subscription errors (run with -c option to show each error)"
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: ok to connect"
_sLinkData <- getTermLine bob
bob ##> ("/_connect 1 " <> inv)
bob <## "confirmation sent!"
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
alice #> "@bob message 1"
bob <# "alice> message 1"
bob #> "@alice message 2"
alice <# "bob> message 2"
where
tmp = tmpPath ps
serverCfg' =
smpServerCfg
{ transports = [("7003", transport @TLS, False)],
msgQueueQuota = 2,
serverStoreCfg = persistentServerStoreCfg tmp
}
fastRetryInterval = defaultReconnectInterval {initialInterval = 50000} -- same as in agent tests
cfg' =
testCfg
{ agentConfig =
testAgentCfg
{ quotaExceededTimeout = 1,
messageRetryInterval = RetryInterval2 {riFast = fastRetryInterval, riSlow = fastRetryInterval}
}
}
ChatConfig {presetServers = presetSrvs@PresetServers {netCfg}} = testCfg
cfgZeroTimeout =
(testCfg :: ChatConfig)
{ agentConfig =
testAgentCfg
{ quotaExceededTimeout = 1,
messageRetryInterval = RetryInterval2 {riFast = fastRetryInterval, riSlow = fastRetryInterval}
},
presetServers = presetSrvs {netCfg = (netCfg :: NetworkConfig) {tcpTimeout = NetworkTimeout 10 10}}
}
opts' =
testOpts
{ coreOptions =
testCoreOpts
{ smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7003"]
}
}
testMarkReadDirect :: HasCallStack => TestParams -> IO ()
testMarkReadDirect = testChat2 aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob
alice #> "@bob 1"
alice #> "@bob 2"
alice #> "@bob 3"
alice #> "@bob 4"
bob <# "alice> 1"
bob <# "alice> 2"
bob <# "alice> 3"
bob <# "alice> 4"
bob ##> "/last_item_id"
i :: ChatItemId <- read <$> getTermLine bob
let itemIds = intercalate "," $ map show [i - 3 .. i]
bob #$> ("/_read chat items @2 " <> itemIds, id, "items read for chat")
testChatPaginationInitial :: HasCallStack => TestParams -> IO ()
testChatPaginationInitial = testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob
-- Wait, otherwise ids are going to be wrong.
threadDelay 1000000
-- Send messages from alice to bob
forM_ ([1 .. 10] :: [Int]) $ \n -> alice #> ("@bob " <> show n)
-- Bob receives the messages.
forM_ ([1 .. 10] :: [Int]) $ \n -> bob <# ("alice> " <> show n)
-- All messages are unread for bob, should return area around unread
bob #$> ("/_get chat @2 initial=2", chat, [(0, "Voice messages: enabled"), (0, "Audio/video calls: enabled"), (0, "1"), (0, "2"), (0, "3")])
-- Read next 2 items
let itemIds = intercalate "," $ map itemId [1 .. 2]
bob #$> ("/_read chat items @2 " <> itemIds, id, "items read for chat")
bob #$> ("/_get chat @2 initial=2", chat, [(0, "Audio/video calls: enabled"), (0, "1"), (0, "2"), (0, "3"), (0, "4")])
-- Read all items
bob #$> ("/_read chat @2", id, "ok")
bob #$> ("/_get chat @2 initial=3", chat, [(0, "8"), (0, "9"), (0, "10")])
bob #$> ("/_get chat @2 initial=5", chat, [(0, "6"), (0, "7"), (0, "8"), (0, "9"), (0, "10")])
where
opts =
testOpts
{ markRead = False
}
testDuplicateContactsSeparate :: HasCallStack => TestParams -> IO ()
testDuplicateContactsSeparate =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
alice ##> "/c"
inv' <- getInvitation alice
bob ##> ("/c " <> inv')
bob <## "confirmation sent!"
concurrently_
(alice <## "bob_1 (Bob): contact is connected")
(bob <## "alice_1 (Alice): contact is connected")
alice <##> bob
alice #> "@bob_1 1"
bob <# "alice_1> 1"
bob #> "@alice_1 2"
alice <# "bob_1> 2"
alice @@@ [("@bob", "hey"), ("@bob_1", "2")]
alice `hasContactProfiles` ["alice", "bob", "bob"]
bob @@@ [("@alice", "hey"), ("@alice_1", "2")]
bob `hasContactProfiles` ["bob", "alice", "alice"]
testDuplicateContactsMultipleSeparate :: HasCallStack => TestParams -> IO ()
testDuplicateContactsMultipleSeparate =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
alice ##> "/c"
inv' <- getInvitation alice
bob ##> ("/c " <> inv')
bob <## "confirmation sent!"
concurrently_
(alice <## "bob_1 (Bob): contact is connected")
(bob <## "alice_1 (Alice): contact is connected")
alice ##> "/c"
inv'' <- getInvitation alice
bob ##> ("/c " <> inv'')
bob <## "confirmation sent!"
concurrently_
(alice <## "bob_2 (Bob): contact is connected")
(bob <## "alice_2 (Alice): contact is connected")
alice <##> bob
alice #> "@bob_1 1"
bob <# "alice_1> 1"
bob #> "@alice_1 2"
alice <# "bob_1> 2"
alice #> "@bob_2 3"
bob <# "alice_2> 3"
bob #> "@alice_2 4"
alice <# "bob_2> 4"
alice ##> "/contacts"
alice <### ["bob (Bob)", "bob_1 (Bob)", "bob_2 (Bob)"]
bob ##> "/contacts"
bob <### ["alice (Alice)", "alice_1 (Alice)", "alice_2 (Alice)"]
alice `hasContactProfiles` ["alice", "bob", "bob", "bob"]
bob `hasContactProfiles` ["bob", "alice", "alice", "alice"]
testPlanInvitationLinkOk :: HasCallStack => TestParams -> IO ()
testPlanInvitationLinkOk =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/c"
inv <- getInvitation alice
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: ok to connect"
_sLinkData <- getTermLine bob
bob ##> ("/c " <> inv)
bob <## "confirmation sent!"
concurrently_
(alice <## "bob (Bob): contact is connected")
(bob <## "alice (Alice): contact is connected")
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: ok to connect" -- conn_req_inv is forgotten after connection
_sLinkData <- getTermLine bob
alice <##> bob
testPlanInvitationLinkOwn :: HasCallStack => TestParams -> IO ()
testPlanInvitationLinkOwn ps =
withNewTestChat ps "alice" aliceProfile $ \alice -> do
alice ##> "/c"
inv <- getInvitation alice
alice ##> ("/_connect plan 1 " <> inv)
alice <## "invitation link: own link"
let invSchema2 = linkAnotherSchema inv
alice ##> ("/_connect plan 1 " <> invSchema2)
alice <## "invitation link: own link"
alice ##> ("/c " <> inv)
alice <## "confirmation sent!"
alice
<### [ "alice_1 (Alice): contact is connected",
"alice_2 (Alice): contact is connected"
]
alice ##> ("/_connect plan 1 " <> inv)
alice <## "invitation link: ok to connect" -- conn_req_inv is forgotten after connection
_sLinkData <- getTermLine alice
threadDelay 100000
alice @@@ [("@alice_1", lastChatFeature), ("@alice_2", lastChatFeature)]
alice `send` "@alice_2 hi"
alice
<### [ WithTime "@alice_2 hi",
WithTime "alice_1> hi"
]
alice `send` "@alice_1 hey"
alice
<### [ WithTime "@alice_1 hey",
WithTime "alice_2> hey"
]
alice @@@ [("@alice_1", "hey"), ("@alice_2", "hey")]
testPlanInvitationLinkConnecting :: HasCallStack => TestParams -> IO ()
testPlanInvitationLinkConnecting ps = do
inv <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
alice ##> "/c"
getInvitation alice
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob ##> ("/c " <> inv)
bob <## "confirmation sent!"
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: connecting"
let invSchema2 = linkAnotherSchema inv
bob ##> ("/_connect plan 1 " <> invSchema2)
bob <## "invitation link: connecting"
testContactClear :: HasCallStack => TestParams -> IO ()
testContactClear =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
threadDelay 500000
alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY")
alice #$> ("/_get chat @2 count=100", chat, [(1,"chat banner")])
bob #$> ("/clear alice", id, "alice: all messages are removed locally ONLY")
bob #$> ("/_get chat @2 count=100", chat, [(1,"chat banner")])
testDeleteContactDeletesProfile :: HasCallStack => TestParams -> IO ()
testDeleteContactDeletesProfile =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
-- alice deletes contact, profile is deleted
alice ##> "/_delete @2 full notify=on"
alice <## "bob: contact is deleted"
bob <## "alice (Alice) deleted contact with you"
alice ##> "/_contacts 1"
(alice </)
alice `hasContactProfiles` ["alice"]
-- bob deletes contact, profile is deleted
bob ##> "/d alice"
bob <## "alice: contact is deleted"
bob ##> "/contacts"
(bob </)
bob `hasContactProfiles` ["bob"]
testDeleteContactKeepConversation :: HasCallStack => TestParams -> IO ()
testDeleteContactKeepConversation =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
alice ##> "/_delete @2 entity notify=on"
alice <## "bob: contact is deleted"
bob <## "alice (Alice) deleted contact with you"
alice @@@ [("@bob", "hey")]
alice ##> "@bob hi"
alice <## "bob: not ready"
bob @@@ [("@alice", "contact deleted")]
bob ##> "@alice hey"
bob <## "alice: not ready"
testDeleteConversationKeepContact :: HasCallStack => TestParams -> IO ()
testDeleteConversationKeepContact =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
alice @@@ [("@bob", "hey")]
alice ##> "/_delete @2 messages"
alice <## "bob: contact is deleted"
alice @@@ [("@bob", "chat banner")] -- UI would filter
bob @@@ [("@alice", "hey")]
bob #> "@alice hi"
alice <# "bob> hi"
alice @@@ [("@bob", "hi")]
alice <##> bob
testDirectMessageQuotedReply :: HasCallStack => TestParams -> IO ()
testDirectMessageQuotedReply =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/_send @2 text hello! how are you?"
alice <# "@bob hello! how are you?"
bob <# "alice> hello! how are you?"
bob #> "@alice hi!"
alice <# "bob> hi!"
bob `send` "> @alice (hello) all good - you?"
bob <# "@alice > hello! how are you?"
bob <## " all good - you?"
alice <# "bob> > hello! how are you?"
alice <## " all good - you?"
bob #$> ("/_get chat @2 count=1", chat', [((1, "all good - you?"), Just (0, "hello! how are you?"))])
alice #$> ("/_get chat @2 count=1", chat', [((0, "all good - you?"), Just (1, "hello! how are you?"))])
bob `send` ">> @alice (all good) will tell more"
bob <# "@alice >> all good - you?"
bob <## " will tell more"
alice <# "bob> >> all good - you?"
alice <## " will tell more"
bob #$> ("/_get chat @2 count=1", chat', [((1, "will tell more"), Just (1, "all good - you?"))])
alice #$> ("/_get chat @2 count=1", chat', [((0, "will tell more"), Just (0, "all good - you?"))])
testDirectMessageUpdate :: HasCallStack => TestParams -> IO ()
testDirectMessageUpdate =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
-- msg id 1
alice #> "@bob hello 🙂"
bob <# "alice> hello 🙂"
-- msg id 2
bob `send` "> @alice (hello) hi alice"
bob <# "@alice > hello 🙂"
bob <## " hi alice"
alice <# "bob> > hello 🙂"
alice <## " hi alice"
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((1, "hello 🙂"), Nothing), ((0, "hi alice"), Just (1, "hello 🙂"))])
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "hello 🙂"), Nothing), ((1, "hi alice"), Just (0, "hello 🙂"))])
alice ##> ("/_update item @2 " <> itemId 1 <> " text hello 🙂")
alice <## "message didn't change"
alice ##> ("/_update item @2 " <> itemId 1 <> " text hey 👋")
alice <# "@bob [edited] hey 👋"
bob <# "alice> [edited] hey 👋"
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((1, "hey 👋"), Nothing), ((0, "hi alice"), Just (1, "hello 🙂"))])
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "hey 👋"), Nothing), ((1, "hi alice"), Just (0, "hello 🙂"))])
-- msg id 3
bob `send` "> @alice (hey) hey alice"
bob <# "@alice > hey 👋"
bob <## " hey alice"
alice <# "bob> > hey 👋"
alice <## " hey alice"
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((1, "hey 👋"), Nothing), ((0, "hi alice"), Just (1, "hello 🙂")), ((0, "hey alice"), Just (1, "hey 👋"))])
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "hey 👋"), Nothing), ((1, "hi alice"), Just (0, "hello 🙂")), ((1, "hey alice"), Just (0, "hey 👋"))])
alice ##> ("/_update item @2 " <> itemId 1 <> " text greetings 🤝")
alice <# "@bob [edited] greetings 🤝"
bob <# "alice> [edited] greetings 🤝"
alice #$> ("/_update item @2 " <> itemId 2 <> " text updating bob's message", id, "cannot update this item")
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((1, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (1, "hello 🙂")), ((0, "hey alice"), Just (1, "hey 👋"))])
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "greetings 🤝"), Nothing), ((1, "hi alice"), Just (0, "hello 🙂")), ((1, "hey alice"), Just (0, "hey 👋"))])
bob ##> ("/_update item @2 " <> itemId 2 <> " text hey Alice")
bob <# "@alice [edited] > hello 🙂"
bob <## " hey Alice"
alice <# "bob> [edited] > hello 🙂"
alice <## " hey Alice"
bob ##> ("/_update item @2 " <> itemId 3 <> " text greetings Alice")
bob <# "@alice [edited] > hey 👋"
bob <## " greetings Alice"
alice <# "bob> [edited] > hey 👋"
alice <## " greetings Alice"
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((1, "greetings 🤝"), Nothing), ((0, "hey Alice"), Just (1, "hello 🙂")), ((0, "greetings Alice"), Just (1, "hey 👋"))])
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "greetings 🤝"), Nothing), ((1, "hey Alice"), Just (0, "hello 🙂")), ((1, "greetings Alice"), Just (0, "hey 👋"))])
testDirectMessageEditHistory :: HasCallStack => TestParams -> IO ()
testDirectMessageEditHistory =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #> "@bob hello!"
bob <# "alice> hello!"
alice ##> ("/_get item info @2 " <> itemId 1)
alice <##. "sent at: "
alice <## "message history:"
alice .<## ": hello!"
bob ##> ("/_get item info @2 " <> itemId 1)
bob <##. "sent at: "
bob <##. "received at: "
bob <## "message history:"
bob .<## ": hello!"
alice ##> ("/_update item @2 " <> itemId 1 <> " text hey 👋")
alice <# "@bob [edited] hey 👋"
bob <# "alice> [edited] hey 👋"
alice ##> ("/_get item info @2 " <> itemId 1)
alice <##. "sent at: "
alice <## "message history:"
alice .<## ": hey 👋"
alice .<## ": hello!"
bob ##> ("/_get item info @2 " <> itemId 1)
bob <##. "sent at: "
bob <##. "received at: "
bob <## "message history:"
bob .<## ": hey 👋"
bob .<## ": hello!"
alice ##> ("/_update item @2 " <> itemId 1 <> " text hello there")
alice <# "@bob [edited] hello there"
bob <# "alice> [edited] hello there"
alice ##> "/item info @bob hello"
alice <##. "sent at: "
alice <## "message history:"
alice .<## ": hello there"
alice .<## ": hey 👋"
alice .<## ": hello!"
bob ##> "/item info @alice hello"
bob <##. "sent at: "
bob <##. "received at: "
bob <## "message history:"
bob .<## ": hello there"
bob .<## ": hey 👋"
bob .<## ": hello!"
bob #$> ("/_delete item @2 " <> itemId 1 <> " internal", id, "message deleted")
alice ##> ("/_update item @2 " <> itemId 1 <> " text hey there")
alice <# "@bob [edited] hey there"
bob <# "alice> [edited] hey there"
alice ##> "/item info @bob hey"
alice <##. "sent at: "
alice <## "message history:"
alice .<## ": hey there"
alice .<## ": hello there"
alice .<## ": hey 👋"
alice .<## ": hello!"
bob ##> "/item info @alice hey"
bob <##. "sent at: "
bob <##. "received at: "
bob <## "message history:"
bob .<## ": hey there"
testDirectMessageDelete :: HasCallStack => TestParams -> IO ()
testDirectMessageDelete =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
-- Test for exception not interrupting the delivery - uncomment lines in newContentMessage
-- alice #> "@bob hello 111"
-- bob <## "exception: user error (#####################)"
-- -- bob <## "bad chat command: #####################"
-- -- bob <# "alice> hello 111"
-- alice, bob: msg id 1
alice #> "@bob hello 🙂"
bob <# "alice> hello 🙂"
-- alice, bob: msg id 2
bob `send` "> @alice (hello 🙂) hey alic"
bob <# "@alice > hello 🙂"
bob <## " hey alic"
alice <# "bob> > hello 🙂"
alice <## " hey alic"
-- alice: deletes msg ids 1,2
alice #$> ("/_delete item @2 " <> itemId 1 <> " internal", id, "message deleted")
alice #$> ("/_delete item @2 " <> itemId 2 <> " internal", id, "message deleted")
alice @@@ [("@bob", lastChatFeature)]
alice #$> ("/_get chat @2 count=100", chat, chatFeatures)
-- alice: msg id 3
bob ##> ("/_update item @2 " <> itemId 2 <> " text hey alice")
bob <# "@alice [edited] > hello 🙂"
bob <## " hey alice"
alice <# "bob> [edited] hey alice"
alice @@@ [("@bob", "hey alice")]
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "hey alice")])
-- bob: marks deleted msg id 2
bob #$> ("/_delete item @2 " <> itemId 2 <> " broadcast", id, "message marked deleted")
bob @@@ [("@alice", "hey alice [marked deleted]")]
alice <# "bob> [marked deleted] hey alice"
alice @@@ [("@bob", "hey alice [marked deleted]")]
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "hey alice [marked deleted]")])
-- alice: deletes msg id 3 that was broadcast deleted by bob
alice #$> ("/_delete item @2 " <> itemId 3 <> " internal", id, "message deleted")
alice @@@ [("@bob", lastChatFeature)]
alice #$> ("/_get chat @2 count=100", chat, chatFeatures)
-- alice: msg id 4, bob: msg id 3 (quoting message alice deleted locally)
bob `send` "> @alice (hello 🙂) do you receive my messages?"
bob <# "@alice > hello 🙂"
bob <## " do you receive my messages?"
alice <# "bob> > hello 🙂"
alice <## " do you receive my messages?"
alice @@@ [("@bob", "do you receive my messages?")]
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "do you receive my messages?"), Just (1, "hello 🙂"))])
alice #$> ("/_delete item @2 " <> itemId 4 <> " broadcast", id, "cannot delete this item")
-- alice: msg id 5, bob: msg id 4
bob #> "@alice how are you?"
alice <# "bob> how are you?"
-- alice: deletes msg id 5
alice #$> ("/_delete item @2 " <> itemId 5 <> " internal", id, "message deleted")
-- bob: marks deleted msg id 4 (that alice deleted locally)
bob #$> ("/_delete item @2 " <> itemId 4 <> " broadcast", id, "message marked deleted")
alice <## "bob> [deleted - original message not found]"
alice @@@ [("@bob", "do you receive my messages?")]
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "do you receive my messages?"), Just (1, "hello 🙂"))])
bob @@@ [("@alice", "how are you? [marked deleted]")]
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "hello 🙂"), Nothing), ((1, "hey alice [marked deleted]"), Just (0, "hello 🙂")), ((1, "do you receive my messages?"), Just (0, "hello 🙂")), ((1, "how are you? [marked deleted]"), Nothing)])
-- bob: deletes msg ids 2,4 (that he has marked deleted)
bob #$> ("/_delete item @2 " <> itemId 2 <> " internal", id, "message deleted")
bob #$> ("/_delete item @2 " <> itemId 4 <> " internal", id, "message deleted")
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "hello 🙂"), Nothing), ((1, "do you receive my messages?"), Just (0, "hello 🙂"))])
testDirectMessageDeleteMultiple :: HasCallStack => TestParams -> IO ()
testDirectMessageDeleteMultiple =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #> "@bob hello"
bob <# "alice> hello"
msgId1 <- lastItemId alice
alice #> "@bob hey"
bob <# "alice> hey"
msgId2 <- lastItemId alice
alice ##> ("/_delete item @2 " <> msgId1 <> "," <> msgId2 <> " broadcast")
alice <## "2 messages deleted"
bob <# "alice> [marked deleted] hello"
bob <# "alice> [marked deleted] hey"
alice #$> ("/_get chat @2 count=2", chat, [(1, "hello [marked deleted]"), (1, "hey [marked deleted]")])
bob #$> ("/_get chat @2 count=2", chat, [(0, "hello [marked deleted]"), (0, "hey [marked deleted]")])
testDirectMessageDeleteMultipleManyBatches :: HasCallStack => TestParams -> IO ()
testDirectMessageDeleteMultipleManyBatches =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
msgIdZero <- lastItemId alice
let cm i = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message " <> show i <> "\"}}"
cms = intercalate ", " (map cm [1 .. 300 :: Int])
alice `send` ("/_send @2 json [" <> cms <> "]")
_ <- getTermLine alice
alice <## "300 messages sent"
msgIdLast <- lastItemId alice
forM_ [(1 :: Int) .. 300] $ \i -> do
bob <# ("alice> message " <> show i)
let mIdFirst = (read msgIdZero :: Int) + 1
mIdLast = read msgIdLast :: Int
deleteIds = intercalate "," (map show [mIdFirst .. mIdLast])
alice `send` ("/_delete item @2 " <> deleteIds <> " broadcast")
_ <- getTermLine alice
alice <## "300 messages deleted"
forM_ [(1 :: Int) .. 300] $ \i -> do
bob <# ("alice> [marked deleted] message " <> show i)
testDirectLiveMessage :: HasCallStack => TestParams -> IO ()
testDirectLiveMessage =
testChat2 aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob
-- non-empty live message is sent instantly
alice `send` "/live @bob hello"
bob <# "alice> [LIVE started] use /show [on/off/8] hello"
alice ##> ("/_update item @2 " <> itemId 1 <> " text hello there")
alice <# "@bob [LIVE] hello there"
bob <# "alice> [LIVE ended] hello there"
-- empty live message is also sent instantly
alice `send` "/live @bob"
bob <# "alice> [LIVE started] use /show [on/off/9]"
alice ##> ("/_update item @2 " <> itemId 2 <> " text hello 2")
alice <# "@bob [LIVE] hello 2"
bob <# "alice> [LIVE ended] hello 2"
-- live message has edit history
alice ##> ("/_get item info @2 " <> itemId 2)
alice <##. "sent at: "
alice <## "message history:"
alice .<## ": hello 2"
alice .<## ":"
bob ##> ("/_get item info @2 " <> itemId 2)
bob <##. "sent at: "
bob <##. "received at: "
bob <## "message history:"
bob .<## ": hello 2"
bob .<## ":"
testDirectTimedMessage :: HasCallStack => TestParams -> IO ()
testDirectTimedMessage =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/_send @2 ttl=1 text hello!"
alice <# "@bob hello!"
bob <# "alice> hello!"
alice <## "timed message deleted: hello!"
bob <## "timed message deleted: hello!"
alice ##> "/_send @2 live=off ttl=1 text hey"
alice <# "@bob hey"
bob <# "alice> hey"
alice <## "timed message deleted: hey"
bob <## "timed message deleted: hey"
alice ##> "/_send @2 ttl=default text hello"
alice <# "@bob hello"
bob <# "alice> hello"
alice ##> "/_send @2 live=off text hi"
alice <# "@bob hi"
bob <# "alice> hi"
testRepeatAuthErrorsDisableContact :: HasCallStack => TestParams -> IO ()
testRepeatAuthErrorsDisableContact =
testChat2 aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob
alice <##> bob
threadDelay 500000
bob ##> "/_delete @2 notify=off"
bob <## "alice: contact is deleted"
forM_ [1 .. authErrDisableCount] $ \_ -> sendAuth alice
alice <## "[bob] connection is disabled, to enable: /enable bob, to delete: /d bob"
alice ##> "@bob hey"
alice <## "bob: disabled, to enable: /enable bob, to delete: /d bob"
alice ##> "/enable bob"
alice <## "ok"
sendAuth alice
where
sendAuth alice = do
alice #> "@bob hey"
alice <## "[bob, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection"
testMultilineMessage :: HasCallStack => TestParams -> IO ()
testMultilineMessage = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
connectUsers alice bob
connectUsers alice cath
alice `send` "@bob \"hello\\nthere\"" -- @bob "hello\nthere"
alice <# "@bob hello"
alice <## "there"
bob <# "alice> hello"
bob <## "there"
alice `send` "/feed \"hello\\nthere\"" -- /feed "hello\nthere"
alice <##. "/feed (2)"
alice <## "there"
bob <# "alice> hello"
bob <## "there"
cath <# "alice> hello"
cath <## "there"
testLargeMessage :: HasCallStack => TestParams -> IO ()
testLargeMessage =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
img <- genProfileImg
let profileImage = "data:image/png;base64," <> B.unpack img
alice `send` ("/_profile 1 {\"displayName\": \"alice2\", \"fullName\": \"\", \"image\": \"" <> profileImage <> "\"}")
_trimmedCmd1 <- getTermLine alice
alice <## "user profile is changed to alice2 (your 1 contacts are notified)"
bob <## "contact alice changed to alice2"
bob <## "use @alice2 <message> to send messages"
testSendMulti :: HasCallStack => TestParams -> IO ()
testSendMulti =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/_send @2 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]"
alice <# "@bob test 1"
alice <# "@bob test 2"
bob <# "alice> test 1"
bob <# "alice> test 2"
testSendMultiTimed :: HasCallStack => TestParams -> IO ()
testSendMultiTimed =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/_send @2 ttl=1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]"
alice <# "@bob test 1"
alice <# "@bob test 2"
bob <# "alice> test 1"
bob <# "alice> test 2"
alice
<### [ "timed message deleted: test 1",
"timed message deleted: test 2"
]
bob
<### [ "timed message deleted: test 1",
"timed message deleted: test 2"
]
testSendMultiWithQuote :: HasCallStack => TestParams -> IO ()
testSendMultiWithQuote =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #> "@bob hello"
bob <# "alice> hello"
msgId1 <- lastItemId alice
threadDelay 1000000
bob #> "@alice hi"
alice <# "bob> hi"
msgId2 <- lastItemId alice
let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message 1\"}}"
cm2 = "{\"quotedItemId\": " <> msgId1 <> ", \"msgContent\": {\"type\": \"text\", \"text\": \"message 2\"}}"
cm3 = "{\"quotedItemId\": " <> msgId2 <> ", \"msgContent\": {\"type\": \"text\", \"text\": \"message 3\"}}"
alice ##> ("/_send @2 json [" <> cm1 <> ", " <> cm2 <> ", " <> cm3 <> "]")
alice <## "bad chat command: invalid multi send: live and more than one quote not supported"
alice ##> ("/_send @2 json [" <> cm1 <> ", " <> cm2 <> "]")
alice <# "@bob message 1"
alice <# "@bob >> hello"
alice <## " message 2"
bob <# "alice> message 1"
bob <# "alice> >> hello"
bob <## " message 2"
alice ##> ("/_send @2 json [" <> cm3 <> ", " <> cm1 <> "]")
alice <# "@bob > hi"
alice <## " message 3"
alice <# "@bob message 1"
bob <# "alice> > hi"
bob <## " message 3"
bob <# "alice> message 1"
testSendMultiManyBatches :: HasCallStack => TestParams -> IO ()
testSendMultiManyBatches =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
threadDelay 1000000
msgIdAlice <- lastItemId alice
msgIdBob <- lastItemId bob
let cm i = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message " <> show i <> "\"}}"
cms = intercalate ", " (map cm [1 .. 300 :: Int])
alice `send` ("/_send @2 json [" <> cms <> "]")
_ <- getTermLine alice
alice <## "300 messages sent"
forM_ [(1 :: Int) .. 300] $ \i ->
bob <# ("alice> message " <> show i)
aliceItemsCount <- withCCTransaction alice $ \db ->
DB.query db "SELECT count(1) FROM chat_items WHERE chat_item_id > ?" (Only msgIdAlice) :: IO [[Int]]
aliceItemsCount `shouldBe` [[300]]
bobItemsCount <- withCCTransaction bob $ \db ->
DB.query db "SELECT count(1) FROM chat_items WHERE chat_item_id > ?" (Only msgIdBob) :: IO [[Int]]
bobItemsCount `shouldBe` [[300]]
threadDelay 1000000
testGetSetSMPServers :: HasCallStack => TestParams -> IO ()
testGetSetSMPServers =
testChat aliceProfile $
\alice -> do
alice ##> "/_servers 1"
alice <## "Your servers"
alice <## " SMP servers"
alice <## " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"
alice <## " XFTP servers"
alice <## " xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002"
alice #$> ("/smp smp://1234-w==@smp1.example.im", id, "ok")
alice ##> "/smp"
alice <## "Your servers"
alice <## " SMP servers"
alice <## " smp://1234-w==@smp1.example.im"
alice #$> ("/smp smp://1234-w==:password@smp1.example.im", id, "ok")
-- alice #$> ("/smp", id, "smp://1234-w==:password@smp1.example.im")
alice ##> "/smp"
alice <## "Your servers"
alice <## " SMP servers"
alice <## " smp://1234-w==:password@smp1.example.im"
alice #$> ("/smp smp://2345-w==@smp2.example.im smp://3456-w==@smp3.example.im:5224", id, "ok")
alice ##> "/smp"
alice <## "Your servers"
alice <## " SMP servers"
alice <## " smp://2345-w==@smp2.example.im"
alice <## " smp://3456-w==@smp3.example.im:5224"
testTestSMPServerConnection :: HasCallStack => TestParams -> IO ()
testTestSMPServerConnection =
testChat aliceProfile $
\alice -> do
alice ##> "/smp test smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7001"
alice <## "SMP server test passed"
-- to test with password:
-- alice <## "SMP server test failed at CreateQueue, error: SMP AUTH"
-- alice <## "Server requires authorization to create queues, check password"
alice ##> "/smp test smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"
alice <## "SMP server test passed"
alice ##> "/smp test smp://LcJU@localhost:7001"
alice <## "SMP server test failed at Connect, error: BROKER {brokerAddress = \"smp://LcJU@localhost:7001\", brokerErr = NETWORK {networkError = NEUnknownCAError}}"
alice <## "Certificate fingerprint in SMP server address does not match server certificate"
testGetSetXFTPServers :: HasCallStack => TestParams -> IO ()
testGetSetXFTPServers =
testChat aliceProfile $
\alice -> withXFTPServer $ do
alice ##> "/_servers 1"
alice <## "Your servers"
alice <## " SMP servers"
alice <## " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"
alice <## " XFTP servers"
alice <## " xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002"
alice #$> ("/xftp xftp://1234-w==@xftp1.example.im", id, "ok")
alice ##> "/xftp"
alice <## "Your servers"
alice <## " XFTP servers"
alice <## " xftp://1234-w==@xftp1.example.im"
alice #$> ("/xftp xftp://1234-w==:password@xftp1.example.im", id, "ok")
alice ##> "/xftp"
alice <## "Your servers"
alice <## " XFTP servers"
alice <## " xftp://1234-w==:password@xftp1.example.im"
alice #$> ("/xftp xftp://2345-w==@xftp2.example.im xftp://3456-w==@xftp3.example.im:5224", id, "ok")
alice ##> "/xftp"
alice <## "Your servers"
alice <## " XFTP servers"
alice <## " xftp://2345-w==@xftp2.example.im"
alice <## " xftp://3456-w==@xftp3.example.im:5224"
testTestXFTPServer :: HasCallStack => TestParams -> IO ()
testTestXFTPServer =
testChat aliceProfile $
\alice -> withXFTPServer $ do
alice ##> "/xftp test xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7002"
alice <## "XFTP server test passed"
-- to test with password:
-- alice <## "XFTP server test failed at CreateFile, error: XFTP AUTH"
-- alice <## "Server requires authorization to upload files, check password"
alice ##> "/xftp test xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002"
alice <## "XFTP server test passed"
alice ##> "/xftp test xftp://LcJU@localhost:7002"
alice <## "XFTP server test failed at Connect, error: BROKER {brokerAddress = \"xftp://LcJU@localhost:7002\", brokerErr = NETWORK {networkError = NEUnknownCAError}}"
alice <## "Certificate fingerprint in XFTP server address does not match server certificate"
testOperators :: HasCallStack => TestParams -> IO ()
testOperators =
testChatCfgOpts testCfg opts' aliceProfile $
\alice -> do
-- initial load
alice ##> "/_conditions"
alice <##. "Current conditions: 2."
alice ##> "/_operators"
alice <##. "1 (simplex). SimpleX Chat (SimpleX Chat Ltd), domains: simplex.im, servers: enabled, conditions: required"
alice <## "2 (flux). Flux (InFlux Technologies Limited), domains: simplexonflux.com, servers: SMP enabled proxy, XFTP enabled, conditions: required"
alice <##. "The new conditions will be accepted for SimpleX Chat Ltd, InFlux Technologies Limited at "
-- set conditions notified
alice ##> "/_conditions_notified 2"
alice <## "ok"
alice ##> "/_operators"
alice <##. "1 (simplex). SimpleX Chat (SimpleX Chat Ltd), domains: simplex.im, servers: enabled, conditions: required"
alice <## "2 (flux). Flux (InFlux Technologies Limited), domains: simplexonflux.com, servers: SMP enabled proxy, XFTP enabled, conditions: required"
alice ##> "/_conditions"
alice <##. "Current conditions: 2 (notified)."
-- accept conditions
alice ##> "/_accept_conditions 2 1,2"
alice <##. "1 (simplex). SimpleX Chat (SimpleX Chat Ltd), domains: simplex.im, servers: enabled, conditions: accepted ("
alice <##. "2 (flux). Flux (InFlux Technologies Limited), domains: simplexonflux.com, servers: SMP enabled proxy, XFTP enabled, conditions: accepted ("
-- update operators
alice ##> "/operators 2:on:smp=proxy:xftp=off"
alice <##. "1 (simplex). SimpleX Chat (SimpleX Chat Ltd), domains: simplex.im, servers: enabled, conditions: accepted ("
alice <##. "2 (flux). Flux (InFlux Technologies Limited), domains: simplexonflux.com, servers: SMP enabled proxy, XFTP disabled (servers known), conditions: accepted ("
where
opts' = testOpts {coreOptions = testCoreOpts {smpServers = [], xftpServers = []}}
testAsyncInitiatingOffline :: HasCallStack => Bool -> TestParams -> IO ()
testAsyncInitiatingOffline withShortLink ps = do
inv <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
threadDelay 250000
alice ##> "/c"
(if withShortLink then getInvitation else getInvitationNoShortLink) alice
withNewTestChat ps "bob" bobProfile $ \bob -> do
threadDelay 250000
bob ##> ("/c " <> inv)
bob <## "confirmation sent!"
withTestChat ps "alice" $ \alice -> do
alice <## "subscribed 1 connections on server localhost"
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
testAsyncAcceptingOffline :: HasCallStack => Bool -> TestParams -> IO ()
testAsyncAcceptingOffline withShortLink ps = do
inv <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
alice ##> "/c"
(if withShortLink then getInvitation else getInvitationNoShortLink) alice
withNewTestChat ps "bob" bobProfile $ \bob -> do
threadDelay 250000
bob ##> ("/c " <> inv)
bob <## "confirmation sent!"
withTestChat ps "alice" $ \alice -> do
withTestChat ps "bob" $ \bob -> do
alice <## "subscribed 1 connections on server localhost"
bob <## "subscribed 1 connections on server localhost"
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
testFullAsyncFast :: HasCallStack => TestParams -> IO ()
testFullAsyncFast ps = do
inv <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
threadDelay 250000
alice ##> "/c"
getInvitation alice
withNewTestChat ps "bob" bobProfile $ \bob -> do
threadDelay 250000
bob ##> ("/c " <> inv)
bob <## "confirmation sent!"
threadDelay 250000
withTestChat ps "alice" $ \alice -> do
alice <## "subscribed 1 connections on server localhost"
alice <## "bob (Bob): contact is connected"
withTestChat ps "bob" $ \bob -> do
bob <## "subscribed 1 connections on server localhost"
bob <## "alice (Alice): contact is connected"
testCallType :: CallType
testCallType = CallType {media = CMVideo, capabilities = CallCapabilities {encryption = True}}
testWebRTCSession :: WebRTCSession
testWebRTCSession =
WebRTCSession
{ rtcSession = "{}",
rtcIceCandidates = "[]"
}
testWebRTCCallOffer :: WebRTCCallOffer
testWebRTCCallOffer =
WebRTCCallOffer
{ callType = testCallType,
rtcSession = testWebRTCSession
}
serialize :: ToJSON a => a -> String
serialize = B.unpack . LB.toStrict . J.encode
repeatM_ :: Int -> IO a -> IO ()
repeatM_ n a = forM_ [1 .. n] $ const a
testNegotiateCall :: HasCallStack => TestParams -> IO ()
testNegotiateCall =
withTestOutput $ testChat2 aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob
-- just for testing db query
alice ##> "/_call get"
-- alice invite bob to call
alice ##> ("/_call invite @2 " <> serialize testCallType)
alice <## "ok"
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "outgoing call: calling...")])
bob <## "alice wants to connect with you via WebRTC video call (e2e encrypted)"
repeatM_ 3 $ getTermLine bob
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "incoming call: calling...")])
-- bob accepts call by sending WebRTC offer
bob ##> ("/_call offer @2 " <> serialize testWebRTCCallOffer)
bob <## "ok"
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "incoming call: accepted")])
alice <## "bob accepted your WebRTC video call (e2e encrypted)"
repeatM_ 3 $ getTermLine alice
threadDelay 100000
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "outgoing call: accepted")])
-- alice confirms call by sending WebRTC answer
alice ##> ("/_call answer @2 " <> serialize testWebRTCSession)
alice <## "ok"
threadDelay 100000
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "outgoing call: connecting...")])
bob <## "alice continued the WebRTC call"
repeatM_ 3 $ getTermLine bob
threadDelay 100000
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "incoming call: connecting...")])
-- participants can update calls as connected
alice ##> "/_call status @2 connected"
alice <## "ok"
threadDelay 100000
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "outgoing call: in progress (00:00)")])
bob ##> "/_call status @2 connected"
bob <## "ok"
threadDelay 100000
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "incoming call: in progress (00:00)")])
-- either party can end the call
bob ##> "/_call end @2"
bob <## "ok"
threadDelay 100000
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "incoming call: ended (00:00)")])
alice <## "call with bob ended"
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "outgoing call: ended (00:00)")])
testMaintenanceMode :: HasCallStack => TestParams -> IO ()
testMaintenanceMode ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChatOpts ps testOpts {coreOptions = testCoreOpts {maintenance = True}} "alice" aliceProfile $ \alice -> do
alice ##> "/c"
alice <## "error: chat not started"
alice ##> "/_start"
alice <## "chat started"
connectUsers alice bob
alice #> "@bob hi"
bob <# "alice> hi"
alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
alice <## "error: chat not stopped"
alice ##> "/_stop"
alice <## "chat stopped"
alice ##> "/_start"
alice <## "chat started"
-- chat works after start
alice <## "subscribed 1 connections on server localhost"
alice #> "@bob hi again"
bob <# "alice> hi again"
bob #> "@alice hello"
alice <# "bob> hello"
-- export / delete / import
alice ##> "/_stop"
alice <## "chat stopped"
alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
alice <## "ok"
doesFileExist "./tests/tmp/alice-chat.zip" `shouldReturn` True
alice ##> "/_db import {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
alice <## "ok"
-- cannot start chat after import
alice ##> "/_start"
alice <## "error: chat store changed, please restart chat"
-- works after full restart
withTestChat ps "alice" $ \alice -> testChatWorking alice bob
testChatWorking :: HasCallStack => TestCC -> TestCC -> IO ()
testChatWorking alice bob = do
alice <## "subscribed 1 connections on server localhost"
alice #> "@bob hello again"
bob <# "alice> hello again"
bob #> "@alice hello too"
alice <# "bob> hello too"
testMaintenanceModeWithFiles :: HasCallStack => TestParams -> IO ()
testMaintenanceModeWithFiles ps = withXFTPServer $ do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChatOpts ps testOpts {coreOptions = testCoreOpts {maintenance = True}} "alice" aliceProfile $ \alice -> do
alice ##> "/_start"
alice <## "chat started"
alice ##> "/_files_folder ./tests/tmp/alice_files"
alice <## "ok"
connectUsers alice bob
bob #> "/f @alice ./tests/fixtures/test.jpg"
bob <## "use /fc 1 to cancel sending"
alice <# "bob> sends file test.jpg (136.5 KiB / 139737 bytes)"
alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob <## "completed uploading file 1 (test.jpg) for alice"
alice ##> "/fr 1"
alice
<### [ "saving file 1 from bob to test.jpg",
"started receiving file 1 (test.jpg) from bob"
]
alice <## "completed receiving file 1 (test.jpg) from bob"
src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/alice_files/test.jpg"
dest `shouldBe` src
threadDelay 500000
alice ##> "/_stop"
alice <## "chat stopped"
alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
alice <## "ok"
alice ##> "/_db delete"
alice <## "ok"
-- cannot start chat after delete
alice ##> "/_start"
alice <## "error: chat store changed, please restart chat"
doesDirectoryExist "./tests/tmp/alice_files" `shouldReturn` False
alice ##> "/_db import {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
alice <## "ok"
B.readFile "./tests/tmp/alice_files/test.jpg" `shouldReturn` src
-- works after full restart
withTestChat ps "alice" $ \alice -> testChatWorking alice bob
#if !defined(dbPostgres)
testDatabaseEncryption :: HasCallStack => TestParams -> IO ()
testDatabaseEncryption ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChatOpts ps testOpts {coreOptions = testCoreOpts {maintenance = True}} "alice" aliceProfile $ \alice -> do
alice ##> "/_start"
alice <## "chat started"
connectUsers alice bob
alice #> "@bob hi"
bob <# "alice> hi"
alice ##> "/db encrypt mykey"
alice <## "error: chat not stopped"
alice ##> "/db decrypt mykey"
alice <## "error: chat not stopped"
alice ##> "/_stop"
alice <## "chat stopped"
alice ##> "/db decrypt mykey"
alice <## "error: chat database is not encrypted"
alice ##> "/db encrypt mykey"
alice <## "ok"
alice ##> "/_start"
alice <## "error: chat store changed, please restart chat"
withTestChatOpts ps (getTestOpts True "mykey") "alice" $ \alice -> do
alice ##> "/_start"
alice <## "chat started"
testChatWorking alice bob
alice ##> "/_stop"
alice <## "chat stopped"
alice ##> "/db test key wrongkey"
alice <## "error opening database after encryption: wrong passphrase or invalid database file"
alice ##> "/db test key mykey"
alice <## "ok"
alice ##> "/db key wrongkey nextkey"
alice <## "error encrypting database: wrong passphrase or invalid database file"
alice ##> "/db key mykey nextkey"
alice <## "ok"
alice ##> "/_db encryption {\"currentKey\":\"nextkey\",\"newKey\":\"anotherkey\"}"
alice <## "ok"
withTestChatOpts ps (getTestOpts True "anotherkey") "alice" $ \alice -> do
alice ##> "/_start"
alice <## "chat started"
testChatWorking alice bob
alice ##> "/_stop"
alice <## "chat stopped"
alice ##> "/db decrypt anotherkey"
alice <## "ok"
withTestChat ps "alice" $ \alice -> do
testChatWorking alice bob
#endif
testConnSyncMissingAgentUsers :: HasCallStack => TestParams -> IO ()
testConnSyncMissingAgentUsers ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
connectUsers alice bob
alice ##> "/create user alisa"
showActiveUser alice "alisa"
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice ##> "/_connections diff"
alice <## "no difference between agent and chat connections"
void $ withCCAgentTransaction alice $ \db ->
DB.execute_ db "DELETE FROM users WHERE user_id = 2"
alice ##> "/_connections diff"
alice <## "connections difference summary:"
alice <## "number of missing users in agent: 1"
alice ##> "/_connections diff show_ids=on"
alice <## "connections difference:"
alice <## "missing users in agent (agent IDs): 2"
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE connections_sync SET should_sync = 1 WHERE connections_sync_id = 1"
withTestChat ps "alice" $ \alice -> do
alice <## "connections difference summary:"
alice <## "number of missing users in agent: 1"
alice <## "subscribed 1 connections on server localhost"
alice <##> bob
testConnSyncExtraAgentUsers :: HasCallStack => TestParams -> IO ()
testConnSyncExtraAgentUsers ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
connectUsers alice bob
alice ##> "/_connections diff"
alice <## "no difference between agent and chat connections"
void $ withCCAgentTransaction alice $ \db ->
DB.execute_ db "INSERT INTO users DEFAULT VALUES"
agentUserCount <- withCCAgentTransaction alice $ \db ->
DB.query_ db "SELECT count(1) FROM users" :: IO [[Int]]
agentUserCount `shouldBe` [[2]]
alice ##> "/_connections diff"
alice <## "connections difference summary:"
alice <## "number of extra users in agent: 1"
alice ##> "/_connections diff show_ids=on"
alice <## "connections difference:"
alice <## "extra users in agent (agent IDs): 2"
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE connections_sync SET should_sync = 1 WHERE connections_sync_id = 1"
withTestChat ps "alice" $ \alice -> do
alice <## "connections difference summary:"
alice <## "number of extra users in agent: 1"
alice <## "removed extra users in agent"
alice <## "subscribed 1 connections on server localhost"
threadDelay 100000
agentUserCount <- withCCAgentTransaction alice $ \db ->
DB.query_ db "SELECT count(1) FROM users" :: IO [[Int]]
agentUserCount `shouldBe` [[1]]
alice <##> bob
testConnSyncMissingAgentConns :: HasCallStack => TestParams -> IO ()
testConnSyncMissingAgentConns ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "cath" cathProfile $ \cath -> do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
connectUsers alice bob
alice ##> "/create user alisa"
showActiveUser alice "alisa"
-- connection with cath is in user 2, below we delete connection by user_id
-- because it's one of the simplest ways to differentiate them in agent db
connectUsers alice cath
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice ##> "/_connections diff"
alice <## "no difference between agent and chat connections"
void $ withCCAgentTransaction alice $ \db ->
DB.execute_ db "DELETE FROM connections WHERE user_id = 2"
alice ##> "/_connections diff"
alice <## "connections difference summary:"
alice <## "number of missing connections in agent: 1"
alice ##> "/_connections diff show_ids=on"
alice <## "connections difference:"
alice <##. "missing connections in agent (agent IDs):"
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE connections_sync SET should_sync = 1 WHERE connections_sync_id = 1"
withTestChat ps "alice" $ \alice -> do
alice <## "connections difference summary:"
alice <## "number of missing connections in agent: 1"
alice <## "subscribed 1 connections on server localhost"
-- alice <## "[user: alisa] 1 subscription errors (run with -c option to show each error)"
alice <##> bob
testConnSyncExtraAgentConns :: HasCallStack => TestParams -> IO ()
testConnSyncExtraAgentConns ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "cath" cathProfile $ \cath -> do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
connectUsers alice bob
connectUsers alice cath
alice ##> "/_connections diff"
alice <## "no difference between agent and chat connections"
-- deleting connection record in chat db
void $ withCCTransaction alice $ \db ->
DB.execute_ db "DELETE FROM connections WHERE contact_id = (SELECT contact_id FROM contacts WHERE local_display_name = 'cath')"
agentConnCount <- withCCAgentTransaction alice $ \db ->
DB.query_ db "SELECT count(1) FROM connections" :: IO [[Int]]
agentConnCount `shouldBe` [[2]]
alice ##> "/_connections diff"
alice <## "connections difference summary:"
alice <## "number of extra connections in agent: 1"
alice ##> "/_connections diff show_ids=on"
alice <## "connections difference:"
alice <##. "extra connections in agent (agent IDs):"
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE connections_sync SET should_sync = 1 WHERE connections_sync_id = 1"
withTestChat ps "alice" $ \alice -> do
alice <## "connections difference summary:"
alice <## "number of extra connections in agent: 1"
alice <## "removed extra connections in agent"
alice <## "subscribed 1 connections on server localhost"
threadDelay 100000
agentConnCount <- withCCAgentTransaction alice $ \db ->
DB.query_ db "SELECT count(1) FROM connections" :: IO [[Int]]
agentConnCount `shouldBe` [[1]]
alice <##> bob
testSubscribeAppNSE :: HasCallStack => TestParams -> IO ()
testSubscribeAppNSE ps =
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
withTestChatOpts ps testOpts {coreOptions = testCoreOpts {maintenance = True}} "alice" $ \nseAlice -> do
alice ##> "/_app suspend 1"
alice <## "ok"
alice <## "chat suspended"
nseAlice ##> "/_start main=off"
nseAlice <## "chat started"
threadDelay 100000
nseAlice ##> "/ad"
cLink <- getContactLink nseAlice True
bob ##> ("/c " <> cLink)
bob <## "connection request sent!"
(nseAlice </)
alice ##> "/_app activate"
alice <## "ok"
alice <## "subscribed 1 connections on server localhost"
alice <## "bob (Bob) wants to connect to you!"
alice <## "to accept: /ac bob"
alice <## "to reject: /rc bob (the sender will NOT be notified)"
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request, you can send messages to contact"
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
threadDelay 100000
alice <##> bob
testMuteContact :: HasCallStack => TestParams -> IO ()
testMuteContact =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #> "@bob hello"
bob <# "alice> hello"
bob ##> "/mute @alice"
bob <## "ok"
alice #> "@bob hi"
bob <# "alice> hi <muted>"
bob ##> "/contacts"
bob <## "alice (Alice) (muted, you can /unmute @alice)"
bob ##> "/unmute @alice"
bob <## "ok"
bob ##> "/contacts"
bob <## "alice (Alice)"
alice #> "@bob hi again"
bob <# "alice> hi again"
testMuteGroup :: HasCallStack => TestParams -> IO ()
testMuteGroup =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
threadDelay 1000000
alice #> "#team hello!"
concurrently_
(bob <# "#team alice> hello!")
(cath <# "#team alice> hello!")
bob ##> "/mute #team"
bob <## "ok"
alice #> "#team hi"
concurrently_
(bob <# "#team alice> hi <muted>")
(cath <# "#team alice> hi")
bob #> "#team hello"
concurrently_
(alice <# "#team bob> hello")
(cath <# "#team bob> hello")
cath `send` "> #team (hello) hello too!"
cath <# "#team > bob hello"
cath <## " hello too!"
concurrentlyN_
[ do
bob <# "#team cath!> > bob hello <muted>"
bob <## " hello too! <muted>",
do
alice <# "#team cath> > bob hello"
alice <## " hello too!"
]
bob ##> "/unmute mentions #team"
bob <## "ok"
alice `send` "> #team @bob (hello) hey bob!"
alice <# "#team > bob hello"
alice <## " hey bob!"
concurrentlyN_
[ do
bob <# "#team alice!> > bob hello"
bob <## " hey bob!",
do
cath <# "#team alice> > bob hello"
cath <## " hey bob!"
]
alice `send` "> #team @cath (hello) hey cath!"
alice <# "#team > cath hello too!"
alice <## " hey cath!"
concurrentlyN_
[ do
bob <# "#team alice> > cath hello too! <muted>"
bob <## " hey cath! <muted>",
do
cath <# "#team alice!> > cath hello too!"
cath <## " hey cath!"
]
bob ##> "/gs"
bob <## "#team (3 members, mentions only, you can /unmute #team)"
bob ##> "/unmute #team"
bob <## "ok"
threadDelay 1000000
alice #> "#team hi again"
concurrently_
(bob <# "#team alice> hi again")
(cath <# "#team alice> hi again")
bob ##> "/block #team alice"
bob <## "admins or above can't block member for self, use /block for all #team alice"
-- can bypass with api
bob ##> "/_member settings #1 1 {\"showMessages\": false}"
bob <## "ok"
bob ##> "/ms team"
bob <## "bob (Bob): admin, you, connected"
bob <## "alice (Alice): owner, host, connected, blocked"
bob <## "cath (Catherine): admin, connected"
threadDelay 1000000
alice #> "#team test 1"
concurrently_
(bob <# "#team alice> test 1 [blocked] <muted>")
(cath <# "#team alice> test 1")
threadDelay 1000000
cath #> "#team test 2"
concurrently_
(bob <# "#team cath> test 2")
(alice <# "#team cath> test 2")
bob ##> "/tail #team 3"
bob <# "#team alice> hi again"
bob <# "#team alice> test 1 [blocked]"
bob <# "#team cath> test 2"
threadDelay 1000000
bob ##> "/unblock #team alice"
bob <## "admins or above can't block member for self, use /unblock for all #team alice"
-- can bypass with api
bob ##> "/_member settings #1 1 {\"showMessages\": true}"
bob <## "ok"
bob ##> "/ms team"
bob <## "bob (Bob): admin, you, connected"
bob <## "alice (Alice): owner, host, connected"
bob <## "cath (Catherine): admin, connected"
alice #> "#team test 3"
concurrently_
(bob <# "#team alice> test 3")
(cath <# "#team alice> test 3")
cath #> "#team test 4"
concurrently_
(bob <# "#team cath> test 4")
(alice <# "#team cath> test 4")
bob ##> "/gs"
bob <## "#team (3 members)"
testCreateSecondUser :: HasCallStack => TestParams -> IO ()
testCreateSecondUser =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
connectUsers alice bob
alice ##> "/create user alisa"
showActiveUser alice "alisa"
-- connect using second user
connectUsers alice bob
alice #> "@bob hello"
bob <# "alisa> hello"
bob #> "@alisa hey"
alice <# "bob> hey"
alice ##> "/user"
showActiveUser alice "alisa"
alice ##> "/users"
alice <## "alice (Alice)"
alice <## "alisa (active)"
-- receive message to first user
bob #> "@alice hey alice"
(alice, "alice") $<# "bob> hey alice"
connectUsers alice cath
-- set active user to first user
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice ##> "/user"
showActiveUser alice "alice (Alice)"
alice ##> "/users"
alice <## "alice (Alice) (active)"
alice <## "alisa"
alice <##> bob
cath #> "@alisa hey alisa"
(alice, "alisa") $<# "cath> hey alisa"
alice ##> "@cath hi cath"
alice <## "no contact cath"
-- set active user to second user
alice ##> "/_user 2"
showActiveUser alice "alisa"
testUsersSubscribeAfterRestart :: HasCallStack => TestParams -> IO ()
testUsersSubscribeAfterRestart ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
connectUsers alice bob
alice <##> bob
alice ##> "/create user alisa"
showActiveUser alice "alisa"
connectUsers alice bob
alice <##> bob
withTestChat ps "alice" $ \alice -> do
-- second user is active
alice <## "subscribed 1 connections on server localhost"
alice <## "subscribed 1 connections on server localhost"
-- second user receives message
alice <##> bob
-- first user receives message
bob #> "@alice hey alice"
(alice, "alice") $<# "bob> hey alice"
testMultipleUserAddresses :: HasCallStack => TestParams -> IO ()
testMultipleUserAddresses =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/ad"
cLinkAlice <- getContactLink alice True
bob ##> ("/c " <> cLinkAlice)
alice <#? bob
alice @@@ [("@bob", "Audio/video calls: enabled")]
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request, you can send messages to contact"
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
threadDelay 100000
alice @@@ [("@bob", lastChatFeature)]
alice <##> bob
alice ##> "/create user alisa"
showActiveUser alice "alisa"
-- connect using second user address
alice ##> "/ad"
cLinkAlisa <- getContactLink alice True
bob ##> ("/c " <> cLinkAlisa)
alice <#? bob
alice #$> ("/_get chats 2 pcc=on", chats, [("@bob", "Audio/video calls: enabled"), ("@Ask SimpleX Team", ""), ("@SimpleX Status", ""), ("*", "")])
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request, you can send messages to contact"
concurrently_
(bob <## "alisa: contact is connected")
(alice <## "bob (Bob): contact is connected")
threadDelay 100000
alice #$> ("/_get chats 2 pcc=on", chats, [("@bob", lastChatFeature), ("@Ask SimpleX Team", ""), ("@SimpleX Status", ""), ("*", "")])
alice <##> bob
bob #> "@alice hey alice"
(alice, "alice") $<# "bob> hey alice"
-- delete first user address
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice ##> "/da"
alice <## "Your chat address is deleted - accepted contacts will remain connected."
alice <## "To create a new chat address use /ad"
-- second user receives request when not active
cath ##> ("/c " <> cLinkAlisa)
cath <## "connection request sent!"
alice <## "[user: alisa] cath (Catherine) wants to connect to you!"
alice <## "to accept: /ac cath"
alice <## "to reject: /rc cath (the sender will NOT be notified)"
-- accept request
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice ##> "/ac cath"
alice <## "cath (Catherine): accepting contact request, you can send messages to contact"
concurrently_
(cath <## "alisa: contact is connected")
(alice <## "cath (Catherine): contact is connected")
threadDelay 100000
alice #$> ("/_get chats 2 pcc=on", chats, [("@cath", lastChatFeature), ("@bob", "hey"), ("@Ask SimpleX Team", ""), ("@SimpleX Status", ""), ("*", "")])
alice <##> cath
-- first user doesn't have cath as contact
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice @@@ [("@bob", "hey alice")]
testCreateUserSameServers :: HasCallStack => TestParams -> IO ()
testCreateUserSameServers =
testChat2 aliceProfile bobProfile $
\alice _ -> do
alice #$> ("/smp smp://2345-w==@smp2.example.im smp://3456-w==@smp3.example.im:5224", id, "ok")
alice #$> ("/xftp xftp://2345-w==@xftp2.example.im xftp://3456-w==@xftp3.example.im:5224", id, "ok")
checkCustomServers alice
alice ##> "/create user alisa"
showActiveUser alice "alisa"
checkCustomServers alice
where
checkCustomServers alice = do
alice ##> "/smp"
alice <## "Your servers"
alice <## " SMP servers"
alice <## " smp://2345-w==@smp2.example.im"
alice <## " smp://3456-w==@smp3.example.im:5224"
alice ##> "/xftp"
alice <## "Your servers"
alice <## " XFTP servers"
alice <## " xftp://2345-w==@xftp2.example.im"
alice <## " xftp://3456-w==@xftp3.example.im:5224"
testDeleteUser :: HasCallStack => TestParams -> IO ()
testDeleteUser =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
connectUsers alice bob
alice ##> "/create user alisa"
showActiveUser alice "alisa"
-- cannot delete active user when there is another user
alice ##> "/_delete user 2 del_smp=off"
alice <## "cannot delete active user"
-- delete user without deleting SMP queues
connectUsers alice cath
alice <##> cath
alice ##> "/users"
alice <## "alice (Alice)"
alice <## "alisa (active)"
alice ##> "/_delete user 1 del_smp=off"
alice <## "ok"
alice ##> "/users"
alice <## "alisa (active)"
bob #> "@alice hey"
-- no connection authorization error - connection wasn't deleted
(alice </)
-- cannot delete active user when there is another user
alice ##> "/create user alisa2"
showActiveUser alice "alisa2"
connectUsers alice dan
alice <##> dan
alice ##> "/delete user alisa2"
alice <## "cannot delete active user"
alice ##> "/users"
alice <## "alisa"
alice <## "alisa2 (active)"
alice <##> dan
-- delete user deleting SMP queues
alice ##> "/delete user alisa"
alice <### ["ok", "completed deleting user"]
alice ##> "/users"
alice <## "alisa2 (active)"
cath #> "@alisa hey"
cath <## "[alisa, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection"
(alice </)
alice <##> dan
-- delete last active user
alice ##> "/delete user alisa2 del_smp=off"
alice <### ["ok", "completed deleting user"]
alice ##> "/users"
alice <## "no users"
alice ##> "/create user alisa3"
showActiveUser alice "alisa3"
alice ##> "/delete user alisa3 del_smp=on"
alice <### ["ok", "completed deleting user"]
alice ##> "/users"
alice <## "no users"
alice ##> "/create user alisa4"
showActiveUser alice "alisa4"
connectUsers alice bob
alice <##> bob
alice ##> "/delete user alisa4 del_smp=on"
alice <### ["ok", "completed deleting user"]
alice ##> "/users"
alice <## "no users"
testDeleteUserChatTags :: HasCallStack => TestParams -> IO ()
testDeleteUserChatTags =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/_create tag {\"text\":\"my tag\"}"
alice <## "[{\"chatTagId\":1,\"chatTagText\":\"my tag\"}]"
alice ##> "/_tags @2 1"
alice <## "chat tags updated"
alice ##> "/create user alisa"
showActiveUser alice "alisa"
alice ##> "/_delete user 1 del_smp=off"
alice <## "ok"
alice ##> "/users"
alice <## "alisa (active)"
testRejectCrossUserChatTTL :: HasCallStack => TestParams -> IO ()
testRejectCrossUserChatTTL =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #$> ("/_ttl 1 @2 2", id, "ok")
alice #$> ("/ttl @bob", id, "old messages are set to be deleted after: 2 second(s)")
alice ##> "/create user alisa"
showActiveUser alice "alisa"
alice ##> "/_ttl 2 @2 9"
alice <##. "chat db error:"
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/ttl @bob", id, "old messages are set to be deleted after: 2 second(s)")
testUsersDifferentCIExpirationTTL :: HasCallStack => TestParams -> IO ()
testUsersDifferentCIExpirationTTL ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do
-- first user messages
connectUsers alice bob
alice #> "@bob alice 1"
bob <# "alice> alice 1"
bob #> "@alice alice 2"
alice <# "bob> alice 2"
-- second user messages
alice ##> "/create user alisa"
showActiveUser alice "alisa"
connectUsers alice bob
alice #> "@bob alisa 1"
bob <# "alisa> alisa 1"
bob #> "@alisa alisa 2"
alice <# "bob> alisa 2"
-- set ttl for first user
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/_ttl 1 2", id, "ok")
-- set ttl for second user
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/_ttl 2 4", id, "ok")
-- first user messages
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/ttl", id, "old messages are set to be deleted after: 2 second(s)")
alice #> "@bob alice 3"
bob <# "alice> alice 3"
bob #> "@alice alice 4"
alice <# "bob> alice 4"
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "alice 1"), (0, "alice 2"), (1, "alice 3"), (0, "alice 4")])
-- second user messages
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/ttl", id, "old messages are set to be deleted after: 4 second(s)")
alice #> "@bob alisa 3"
bob <# "alisa> alisa 3"
bob #> "@alisa alisa 4"
alice <# "bob> alisa 4"
alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
threadDelay 3000000
-- messages both before and after setting chat item ttl are deleted
-- first user messages
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/_get chat @2 count=100", chat, [(1,"chat banner")])
-- second user messages
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
threadDelay 2100000
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner")])
where
cfg = testCfg {initialCleanupManagerDelay = 0, cleanupManagerStepDelay = 0, ciExpirationInterval = 500000}
testUsersRestartCIExpiration :: HasCallStack => TestParams -> IO ()
testUsersRestartCIExpiration ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do
-- set ttl for first user
alice #$> ("/_ttl 1 2", id, "ok")
connectUsers alice bob
-- create second user and set ttl
alice ##> "/create user alisa"
showActiveUser alice "alisa"
alice #$> ("/_ttl 2 5", id, "ok")
connectUsers alice bob
-- first user messages
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #> "@bob alice 1"
bob <# "alice> alice 1"
bob #> "@alice alice 2"
alice <# "bob> alice 2"
-- second user messages
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #> "@bob alisa 1"
bob <# "alisa> alisa 1"
bob #> "@alisa alisa 2"
alice <# "bob> alisa 2"
-- first user will be active on restart
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
withTestChatCfg ps cfg "alice" $ \alice -> do
alice <## "subscribed 1 connections on server localhost"
alice <## "subscribed 1 connections on server localhost"
-- first user messages
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/ttl", id, "old messages are set to be deleted after: 2 second(s)")
alice #> "@bob alice 3"
bob <# "alice> alice 3"
bob #> "@alice alice 4"
alice <# "bob> alice 4"
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "alice 1"), (0, "alice 2"), (1, "alice 3"), (0, "alice 4")])
-- second user messages
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/ttl", id, "old messages are set to be deleted after: 5 second(s)")
alice #> "@bob alisa 3"
bob <# "alisa> alisa 3"
bob #> "@alisa alisa 4"
alice <# "bob> alisa 4"
alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
threadDelay 3000000
-- messages both before and after restart are deleted
-- first user messages
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/_get chat @2 count=100", chat, [(1,"chat banner")])
-- second user messages
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
threadDelay 4000000
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner")])
where
cfg = testCfg {initialCleanupManagerDelay = 0, cleanupManagerStepDelay = 0, ciExpirationInterval = 500000}
testEnableCIExpirationOnlyForOneUser :: HasCallStack => TestParams -> IO ()
testEnableCIExpirationOnlyForOneUser ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do
-- first user messages
connectUsers alice bob
alice #> "@bob alice 1"
bob <# "alice> alice 1"
bob #> "@alice alice 2"
alice <# "bob> alice 2"
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "alice 1"), (0, "alice 2")])
-- second user messages before first user sets ttl
alice ##> "/create user alisa"
showActiveUser alice "alisa"
connectUsers alice bob
alice #> "@bob alisa 1"
bob <# "alisa> alisa 1"
bob #> "@alisa alisa 2"
alice <# "bob> alisa 2"
-- set ttl for first user
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/_ttl 1 1", id, "ok")
-- second user messages after first user sets ttl
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #> "@bob alisa 3"
bob <# "alisa> alisa 3"
bob #> "@alisa alisa 4"
alice <# "bob> alisa 4"
alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
threadDelay 2000000
-- messages are deleted for first user
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/_get chat @2 count=100", chat, [(1,"chat banner")])
-- messages are not deleted for second user
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
withTestChatCfg ps cfg "alice" $ \alice -> do
alice <## "subscribed 1 connections on server localhost"
alice <## "subscribed 1 connections on server localhost"
-- messages are not deleted for second user after restart
alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
alice #> "@bob alisa 5"
bob <# "alisa> alisa 5"
bob #> "@alisa alisa 6"
alice <# "bob> alisa 6"
threadDelay 2000000
-- new messages are not deleted for second user
alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4"), (1, "alisa 5"), (0, "alisa 6")])
where
cfg = testCfg {initialCleanupManagerDelay = 0, cleanupManagerStepDelay = 0, ciExpirationInterval = 500000}
testDisableCIExpirationOnlyForOneUser :: HasCallStack => TestParams -> IO ()
testDisableCIExpirationOnlyForOneUser ps = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do
-- set ttl for first user
alice #$> ("/_ttl 1 1", id, "ok")
connectUsers alice bob
-- create second user and set ttl
alice ##> "/create user alisa"
showActiveUser alice "alisa"
alice #$> ("/_ttl 2 1", id, "ok")
connectUsers alice bob
-- first user disables expiration
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/ttl none", id, "ok")
alice #$> ("/ttl", id, "old messages are not being deleted")
-- second user still has ttl configured
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/ttl", id, "old messages are set to be deleted after: 1 second(s)")
alice #> "@bob alisa 1"
bob <# "alisa> alisa 1"
bob #> "@alisa alisa 2"
alice <# "bob> alisa 2"
alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2")])
threadDelay 2000000
-- second user messages are deleted
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner")])
withTestChatCfg ps cfg "alice" $ \alice -> do
alice <## "subscribed 1 connections on server localhost"
alice <## "subscribed 1 connections on server localhost"
-- second user still has ttl configured after restart
alice #$> ("/ttl", id, "old messages are set to be deleted after: 1 second(s)")
alice #> "@bob alisa 3"
bob <# "alisa> alisa 3"
bob #> "@alisa alisa 4"
alice <# "bob> alisa 4"
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")])
threadDelay 2500000
-- second user messages are deleted
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner")])
where
cfg = testCfg {initialCleanupManagerDelay = 0, cleanupManagerStepDelay = 0, ciExpirationInterval = 500000}
testUsersTimedMessages :: HasCallStack => TestParams -> IO ()
testUsersTimedMessages ps' = do
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
connectUsers alice bob
configureTimedMessages alice bob "2" "2"
-- create second user and configure timed messages for contact
alice ##> "/create user alisa"
showActiveUser alice "alisa"
connectUsers alice bob
configureTimedMessages alice bob "6" "3"
-- first user messages
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #> "@bob alice 1"
bob <# "alice> alice 1"
bob #> "@alice alice 2"
alice <# "bob> alice 2"
-- second user messages
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #> "@bob alisa 1"
bob <# "alisa> alisa 1"
bob #> "@alisa alisa 2"
alice <# "bob> alisa 2"
-- messages are deleted after ttl
threadDelay 1500000
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/_get chat @2 count=100", chat, [(1,"chat banner"), (1, "alice 1"), (0, "alice 2")])
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner"), (1, "alisa 1"), (0, "alisa 2")])
threadDelay 1000000
alice <### ["[user: alice] timed message deleted: alice 1", "[user: alice] timed message deleted: alice 2"]
bob <### ["timed message deleted: alice 1", "timed message deleted: alice 2"]
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/_get chat @2 count=100", chat, [(1,"chat banner")])
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner"), (1, "alisa 1"), (0, "alisa 2")])
threadDelay 1000000
alice <### ["timed message deleted: alisa 1", "timed message deleted: alisa 2"]
bob <### ["timed message deleted: alisa 1", "timed message deleted: alisa 2"]
alice ##> "/user"
showActiveUser alice "alisa"
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner")])
-- first user messages
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #> "@bob alice 3"
bob <# "alice> alice 3"
bob #> "@alice alice 4"
alice <# "bob> alice 4"
-- second user messages
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #> "@bob alisa 3"
bob <# "alisa> alisa 3"
bob #> "@alisa alisa 4"
alice <# "bob> alisa 4"
withTestChat ps "alice" $ \alice -> do
alice <## "subscribed 1 connections on server localhost"
alice <## "subscribed 1 connections on server localhost"
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/_get chat @2 count=100", chat, [(1,"chat banner"), (1, "alice 3"), (0, "alice 4")])
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")])
-- messages are deleted after restart
threadDelay 1000000
alice <### ["[user: alice] timed message deleted: alice 3", "[user: alice] timed message deleted: alice 4"]
bob <### ["timed message deleted: alice 3", "timed message deleted: alice 4"]
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
alice #$> ("/_get chat @2 count=100", chat, [(1,"chat banner")])
alice ##> "/user alisa"
showActiveUser alice "alisa"
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")])
threadDelay 1000000
alice <### ["timed message deleted: alisa 3", "timed message deleted: alisa 4"]
bob <### ["timed message deleted: alisa 3", "timed message deleted: alisa 4"]
alice ##> "/user"
showActiveUser alice "alisa"
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner")])
where
ps = ps' {printOutput = True} :: TestParams
configureTimedMessages :: HasCallStack => TestCC -> TestCC -> String -> String -> IO ()
configureTimedMessages alice bob bobId ttl = do
aliceName <- userName alice
alice ##> ("/_set prefs @" <> bobId <> " {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": " <> ttl <> "}}")
alice <## "you updated preferences for bob:"
alice <## ("Disappearing messages: enabled (you allow: yes (" <> ttl <> " sec), contact allows: yes)")
bob <## (aliceName <> " updated preferences for you:")
bob <## ("Disappearing messages: enabled (you allow: yes (" <> ttl <> " sec), contact allows: yes (" <> ttl <> " sec))")
alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY") -- to remove feature items
testUserPrivacy :: HasCallStack => TestParams -> IO ()
testUserPrivacy =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/create user alisa"
showActiveUser alice "alisa"
-- connect using second user
connectUsers alice bob
threadDelay 1000000
alice #> "@bob hello"
threadDelay 1000000
bob <# "alisa> hello"
bob #> "@alisa hey"
alice <# "bob> hey"
bob #> "@alice hey"
(alice, "[user: alice] ") ^<# "bob> hey"
-- hide user profile
alice ##> "/hide user my_password"
userHidden alice "current "
-- shows messages when active
bob #> "@alisa hello again"
alice <# "bob> hello again"
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
-- does not show messages to user
bob #> "@alisa this won't show"
(alice </)
-- does not show hidden user
alice ##> "/users"
alice <## "alice (Alice) (active)"
(alice </)
-- requires password to switch to the user
alice ##> "/user alisa"
alice <## "user does not exist or incorrect password"
alice ##> "/user alisa wrong_password"
alice <## "user does not exist or incorrect password"
alice ##> "/user alisa my_password"
showActiveUser alice "alisa"
-- shows hidden user when active
alice ##> "/users"
alice <## "alice (Alice)"
alice <## "alisa (active, hidden, muted, unread: 1)"
-- hidden message is saved
alice ##> "/tail 11"
alice <##? chatHistory
alice ##> "/_get items count=11"
alice <##? chatHistory
alice ##> "/_get items before=15 count=10"
alice
<##? [ "@bob chat banner",
ConsoleString ("bob> " <> e2eeInfoPQStr),
"bob> Disappearing messages: allowed",
"bob> Full deletion: off",
"bob> Message reactions: enabled",
"bob> Voice messages: enabled",
"bob> Audio/video calls: enabled"
]
alice ##> "/_get items around=13 count=2"
alice
<##? [ "bob> Full deletion: off",
"bob> Message reactions: enabled",
"bob> Voice messages: enabled",
"bob> Audio/video calls: enabled",
"@bob hello"
]
alice ##> "/_get items after=14 count=10"
alice
<##? [ "@bob hello",
"bob> hey",
"bob> hello again",
"bob> this won't show"
]
-- change profile password
alice ##> "/unmute user"
alice <## "hidden user always muted when inactive"
alice ##> "/hide user password"
alice <## "user is already hidden"
alice ##> "/unhide user wrong_password"
alice <## "user does not exist or incorrect password"
alice ##> "/unhide user my_password"
userVisible alice "current "
alice ##> "/hide user new_password"
userHidden alice "current "
alice ##> "/user alice"
showActiveUser alice "alice (Alice)"
-- delete last visible active user
alice ##> "/_delete user 1 del_smp=on"
alice <### ["ok", "completed deleting user"]
-- hidden user is not shown
alice ##> "/users"
alice <## "no users"
-- but it is still possible to switch to it
alice ##> "/user alisa wrong_password"
alice <## "user does not exist or incorrect password"
alice ##> "/user alisa new_password"
showActiveUser alice "alisa"
alice ##> "/create user alisa2"
showActiveUser alice "alisa2"
alice ##> "/_hide user 3 \"password2\""
alice <## "cannot hide the only not hidden user"
-- change profile privacy for inactive user via API requires correct password
alice ##> "/_unmute user 2"
alice <## "hidden user always muted when inactive"
alice ##> "/_hide user 2 \"password\""
alice <## "user is already hidden"
alice ##> "/_unhide user 2 \"wrong_password\""
alice <## "user does not exist or incorrect password"
alice ##> "/_unhide user 2 \"new_password\""
userVisible alice ""
alice ##> "/_hide user 2 \"another_password\""
userHidden alice ""
alice ##> "/_delete user 2 del_smp=on"
alice <## "user does not exist or incorrect password"
alice ##> "/_delete user 2 del_smp=on \"wrong_password\""
alice <## "user does not exist or incorrect password"
alice ##> "/_delete user 2 del_smp=on \"another_password\""
alice <### ["ok", "completed deleting user"]
alice ##> "/_delete user 3 del_smp=on"
alice <### ["ok", "completed deleting user"]
where
userHidden alice current = do
alice <## (current <> "user alisa:")
alice <## "messages are hidden (use /tail to view)"
alice <## "profile is hidden"
userVisible alice current = do
alice <## (current <> "user alisa:")
alice <## "messages are shown"
alice <## "profile is visible"
chatHistory =
[ "@bob chat banner",
ConsoleString ("bob> " <> e2eeInfoPQStr),
"bob> Disappearing messages: allowed",
"bob> Full deletion: off",
"bob> Message reactions: enabled",
"bob> Voice messages: enabled",
"bob> Audio/video calls: enabled",
"@bob hello",
"bob> hey",
"bob> hello again",
"bob> this won't show"
]
testSetChatItemTTL :: HasCallStack => TestParams -> IO ()
testSetChatItemTTL =
testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do
connectUsers alice bob
alice #> "@bob 1"
bob <# "alice> 1"
bob #> "@alice 2"
alice <# "bob> 2"
-- chat item with file
alice #$> ("/_files_folder ./tests/tmp/app_files", id, "ok")
copyFile "./tests/fixtures/test.jpg" "./tests/tmp/app_files/test.jpg"
alice ##> "/_send @2 json [{\"filePath\": \"test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]"
alice <# "/f @bob test.jpg"
alice <## "use /fc 1 to cancel sending"
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
alice <## "completed uploading file 1 (test.jpg) for bob"
-- above items should be deleted after we set ttl
threadDelay 3000000
alice #> "@bob 3"
bob <# "alice> 3"
bob #> "@alice 4"
alice <# "bob> 4"
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "1"), Nothing), ((0, "2"), Nothing), ((1, ""), Just "test.jpg"), ((1, "3"), Nothing), ((0, "4"), Nothing)])
checkActionDeletesFile "./tests/tmp/app_files/test.jpg" $
alice #$> ("/_ttl 1 2", id, "ok")
alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner"), (1, "3"), (0, "4")]) -- when expiration is turned on, first cycle is synchronous
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "1"), (1, "2"), (0, ""), (0, "3"), (1, "4")])
alice #$> ("/_ttl 1", id, "old messages are set to be deleted after: 2 second(s)")
alice #$> ("/ttl week", id, "ok")
alice #$> ("/ttl", id, "old messages are set to be deleted after: one week")
alice #$> ("/ttl none", id, "ok")
alice #$> ("/ttl", id, "old messages are not being deleted")
testSetDirectChatTTL :: HasCallStack => TestParams -> IO ()
testSetDirectChatTTL =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
connectUsers alice bob
connectUsers alice cath
alice #> "@bob 1"
bob <# "alice> 1"
bob #> "@alice 2"
alice <# "bob> 2"
-- above items should be deleted after we set ttl
alice #> "@cath 10"
cath <# "alice> 10"
cath #> "@alice 11"
alice <# "cath> 11"
alice #$> ("/ttl @cath none", id, "ok")
alice #$> ("/ttl @cath", id, "old messages are not being deleted")
threadDelay 3000000
alice #> "@bob 3"
bob <# "alice> 3"
bob #> "@alice 4"
alice <# "bob> 4"
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "1"), Nothing), ((0, "2"), Nothing), ((1, "3"), Nothing), ((0, "4"), Nothing)])
alice #$> ("/_ttl 1 2", id, "ok")
-- when expiration is turned on, first cycle is synchronous
alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner"), (1, "3"), (0, "4")])
-- chat @3 doesn't expire since it was set to not expire
alice #$> ("/_get chat @3 count=100", chat, chatFeatures <> [(1, "10"), (0, "11")])
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "1"), (1, "2"), (0, "3"), (1, "4")])
-- remove global ttl
alice #$> ("/ttl none", id, "ok")
alice #> "@bob 5"
bob <# "alice> 5"
bob #> "@alice 6"
alice <# "bob> 6"
alice #$> ("/_get chat @3 count=100", chat, chatFeatures <> [(1, "10"), (0, "11")])
alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner"), (1, "3"), (0, "4"), (1, "5"), (0, "6")])
-- set ttl for chat @3, only chat @3 is affected since global ttl is disabled
alice #$> ("/_ttl 1 @3 1", id, "ok")
alice #$> ("/ttl @cath", id, "old messages are set to be deleted after: 1 second(s)")
threadDelay 3000000
alice #$> ("/_get chat @3 count=100", chat, [(1, "chat banner")])
alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner"), (1, "3"), (0, "4"), (1, "5"), (0, "6")])
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "1"), (1, "2"), (0, "3"), (1, "4"), (0, "5"), (1, "6")])
-- set ttl to never expire again
alice #$> ("/ttl @cath none", id, "ok")
alice #> "@cath 12"
cath <# "alice> 12"
cath #> "@alice 13"
alice <# "cath> 13"
threadDelay 3000000
alice #$> ("/_get chat @3 count=100", chat, [(1, "chat banner"), (1, "12"), (0, "13")])
alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner"), (1, "3"), (0, "4"), (1, "5"), (0, "6")])
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "1"), (1, "2"), (0, "3"), (1, "4"), (0, "5"), (1, "6")])
-- set ttl back to default
alice #$> ("/ttl @cath default", id, "ok")
alice #$> ("/ttl @cath", id, "old messages are set to delete according to default user config")
alice #$> ("/_ttl 1 2", id, "ok")
alice #$> ("/_get chat @3 count=100", chat, [(1, "chat banner")])
alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner")])
alice #$> ("/ttl @cath day", id, "ok")
alice #$> ("/ttl @cath", id, "old messages are set to be deleted after: one day")
alice #$> ("/ttl @cath week", id, "ok")
alice #$> ("/ttl @cath", id, "old messages are set to be deleted after: one week")
alice #$> ("/ttl @cath month", id, "ok")
alice #$> ("/ttl @cath", id, "old messages are set to be deleted after: one month")
alice #$> ("/ttl @cath year", id, "ok")
alice #$> ("/ttl @cath", id, "old messages are set to be deleted after: one year")
testAppSettings :: HasCallStack => TestParams -> IO ()
testAppSettings ps =
withNewTestChat ps "alice" aliceProfile $ \alice -> do
let settings = T.unpack . safeDecodeUtf8 . LB.toStrict $ J.encode defaultAppSettings
settingsApp = T.unpack . safeDecodeUtf8 . LB.toStrict $ J.encode defaultAppSettings {AS.webrtcICEServers = Just ["non-default.value.com"]}
-- app-provided defaults
alice ##> ("/_get app settings " <> settingsApp)
alice <## ("app settings: " <> settingsApp)
-- parser defaults fallback
alice ##> "/_get app settings"
alice <## ("app settings: " <> settings)
-- store
alice ##> ("/_save app settings " <> settingsApp)
alice <## "ok"
-- read back
alice ##> "/_get app settings"
alice <## ("app settings: " <> settingsApp)
testSwitchContact :: HasCallStack => TestParams -> IO ()
testSwitchContact =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #$> ("/switch bob", id, "switch started")
bob <## "alice started changing address for you"
alice <## "bob: you started changing address"
bob <## "alice changed address for you"
alice <## "bob: you changed address"
threadDelay 100000
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "started changing address..."), (1, "you changed address")])
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "started changing address for you..."), (0, "changed address for you")])
alice <##> bob
testAbortSwitchContact :: HasCallStack => TestParams -> IO ()
testAbortSwitchContact ps = do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChat ps "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice #$> ("/switch bob", id, "switch started")
alice <## "bob: you started changing address"
-- repeat switch is prohibited
alice ##> "/switch bob"
alice <## "error: command is prohibited, switchConnectionAsync: already switching"
-- stop switch
alice #$> ("/abort switch bob", id, "switch aborted")
-- repeat switch stop is prohibited
alice ##> "/abort switch bob"
alice <## "error: command is prohibited, abortConnectionSwitch: not allowed"
withTestChat ps "bob" $ \bob -> do
bob <## "subscribed 1 connections on server localhost"
bob <## "alice started changing address for you"
-- alice changes address again
alice #$> ("/switch bob", id, "switch started")
alice <## "bob: you started changing address"
bob <## "alice started changing address for you"
bob <## "alice changed address for you"
alice <## "bob: you changed address"
threadDelay 100000
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "started changing address..."), (1, "started changing address..."), (1, "you changed address")])
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "started changing address for you..."), (0, "started changing address for you..."), (0, "changed address for you")])
alice <##> bob
testSwitchGroupMember :: HasCallStack => TestParams -> IO ()
testSwitchGroupMember =
testChat2 aliceProfile bobProfile $
\alice bob -> do
createGroup2 "team" alice bob
alice #$> ("/switch #team bob", id, "switch started")
bob <## "#team: alice started changing address for you"
alice <## "#team: you started changing address for bob"
bob <## "#team: alice changed address for you"
alice <## "#team: you changed address for bob"
threadDelay 100000
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "started changing address for bob..."), (1, "you changed address for bob")])
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "started changing address for you..."), (0, "changed address for you")])
alice #> "#team hey"
bob <# "#team alice> hey"
bob #> "#team hi"
alice <# "#team bob> hi"
testAbortSwitchGroupMember :: HasCallStack => TestParams -> IO ()
testAbortSwitchGroupMember ps = do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChat ps "bob" bobProfile $ \bob -> do
createGroup2 "team" alice bob
alice #$> ("/switch #team bob", id, "switch started")
alice <## "#team: you started changing address for bob"
-- repeat switch is prohibited
alice ##> "/switch #team bob"
alice <## "error: command is prohibited, switchConnectionAsync: already switching"
-- stop switch
alice #$> ("/abort switch #team bob", id, "switch aborted")
-- repeat switch stop is prohibited
alice ##> "/abort switch #team bob"
alice <## "error: command is prohibited, abortConnectionSwitch: not allowed"
withTestChat ps "bob" $ \bob -> do
bob <## "subscribed 2 connections on server localhost"
bob <## "#team: alice started changing address for you"
-- alice changes address again
alice #$> ("/switch #team bob", id, "switch started")
alice <## "#team: you started changing address for bob"
bob <## "#team: alice started changing address for you"
bob <## "#team: alice changed address for you"
alice <## "#team: you changed address for bob"
threadDelay 100000
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "started changing address for bob..."), (1, "started changing address for bob..."), (1, "you changed address for bob")])
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "started changing address for you..."), (0, "started changing address for you..."), (0, "changed address for you")])
alice #> "#team hey"
bob <# "#team alice> hey"
bob #> "#team hi"
alice <# "#team bob> hi"
testMarkContactVerified :: HasCallStack => TestParams -> IO ()
testMarkContactVerified =
testChat2 aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob
alice ##> "/i bob"
bobInfo alice False
alice ##> "/code bob"
bCode <- getTermLine alice
bob ##> "/code alice"
aCode <- getTermLine bob
bCode `shouldBe` aCode
alice ##> "/verify bob 123"
alice <##. "connection not verified, current code is "
alice ##> ("/verify bob " <> aCode)
alice <## "connection verified"
alice ##> "/i bob"
bobInfo alice True
alice ##> "/verify bob"
alice <##. "connection not verified, current code is "
alice ##> "/i bob"
bobInfo alice False
where
bobInfo :: HasCallStack => TestCC -> Bool -> IO ()
bobInfo alice verified = do
alice <## "contact ID: 2"
alice <## "receiving messages via: localhost"
alice <## "sending messages via: localhost"
alice <## "you've shared main profile with this contact"
alice <## connVerified
alice <## "quantum resistant end-to-end encryption"
alice <## currentChatVRangeInfo
where
connVerified
| verified = "connection verified"
| otherwise = "connection not verified, use /code command to see security code"
testMarkGroupMemberVerified :: HasCallStack => TestParams -> IO ()
testMarkGroupMemberVerified =
testChat2 aliceProfile bobProfile $ \alice bob -> do
createGroup2 "team" alice bob
alice ##> "/i #team bob"
bobInfo alice False
alice ##> "/code #team bob"
bCode <- getTermLine alice
bob ##> "/code #team alice"
aCode <- getTermLine bob
bCode `shouldBe` aCode
alice ##> "/verify #team bob 123"
alice <##. "connection not verified, current code is "
alice ##> ("/verify #team bob " <> aCode)
alice <## "connection verified"
alice ##> "/i #team bob"
bobInfo alice True
alice ##> "/verify #team bob"
alice <##. "connection not verified, current code is "
alice ##> "/i #team bob"
bobInfo alice False
where
bobInfo :: HasCallStack => TestCC -> Bool -> IO ()
bobInfo alice verified = do
alice <## "group ID: 1"
alice <## "member ID: 2"
alice <## "receiving messages via: localhost"
alice <## "sending messages via: localhost"
alice <## connVerified
alice <## currentChatVRangeInfo
where
connVerified
| verified = "connection verified"
| otherwise = "connection not verified, use /code command to see security code"
#if !defined(dbPostgres)
testMsgDecryptError :: HasCallStack => TestParams -> IO ()
testMsgDecryptError ps =
withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChat ps "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice #> "@bob hi"
bob <# "alice> hi"
bob #> "@alice hey"
alice <# "bob> hey"
setupDesynchronizedRatchet ps alice
withTestChat ps "bob" $ \bob -> do
bob <## "subscribed 1 connections on server localhost"
alice #> "@bob hello again"
bob <# "alice> skipped message ID 9..11"
bob <# "alice> hello again"
bob #> "@alice received!"
alice <# "bob> received!"
setupDesynchronizedRatchet :: HasCallStack => TestParams -> TestCC -> IO ()
setupDesynchronizedRatchet ps alice = do
copyDb "bob" "bob_old"
withTestChat ps "bob" $ \bob -> do
bob <## "subscribed 1 connections on server localhost"
alice #> "@bob 1"
bob <# "alice> 1"
bob #> "@alice 2"
alice <# "bob> 2"
alice #> "@bob 3"
bob <# "alice> 3"
bob #> "@alice 4"
alice <# "bob> 4"
threadDelay 500000
withTestChat ps "bob_old" $ \bob -> do
bob <## "subscribed 1 connections on server localhost"
bob ##> "/sync alice"
bob <## "error: command is prohibited, synchronizeRatchet: not allowed"
alice #> "@bob 1"
bob <## "alice: decryption error (connection out of sync), synchronization required"
bob <## "use /sync alice to synchronize"
alice #> "@bob 2"
alice #> "@bob 3"
(bob </)
bob ##> "/tail @alice 1"
bob <# "alice> decryption error, possibly due to the device change (header, 3 messages)"
bob ##> "@alice 1"
bob <## "error: command is prohibited, sendMessagesB: send prohibited"
(alice </)
where
tmp = tmpPath ps
copyDb from to = do
copyFile (tmp </> (from <> chatSuffix)) (tmp </> (to <> chatSuffix))
copyFile (tmp </> (from <> agentSuffix)) (tmp </> (to <> agentSuffix))
testSyncRatchet :: HasCallStack => TestParams -> IO ()
testSyncRatchet ps =
withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChat ps "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice #> "@bob hi"
bob <# "alice> hi"
bob #> "@alice hey"
alice <# "bob> hey"
setupDesynchronizedRatchet ps alice
withTestChat ps "bob_old" $ \bob -> do
bob <## "subscribed 1 connections on server localhost"
bob ##> "/sync alice"
bob <## "connection synchronization started"
alice <## "bob: connection synchronization agreed"
bob <## "alice: connection synchronization agreed"
alice <## "bob: connection synchronized"
bob <## "alice: connection synchronized"
threadDelay 100000
bob #$> ("/_get chat @2 count=3", chat, [(1, "connection synchronization started"), (0, "connection synchronization agreed"), (0, "connection synchronized")])
alice #$> ("/_get chat @2 count=2", chat, [(0, "connection synchronization agreed"), (0, "connection synchronized")])
alice #> "@bob hello again"
bob <# "alice> hello again"
bob #> "@alice received!"
alice <# "bob> received!"
testSyncRatchetCodeReset :: HasCallStack => TestParams -> IO ()
testSyncRatchetCodeReset ps =
withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChat ps "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice #> "@bob hi"
bob <# "alice> hi"
bob #> "@alice hey"
alice <# "bob> hey"
-- connection not verified
bob ##> "/i alice"
aliceInfo bob False
-- verify connection
alice ##> "/code bob"
bCode <- getTermLine alice
bob ##> ("/verify alice " <> bCode)
bob <## "connection verified"
-- connection verified
bob ##> "/i alice"
aliceInfo bob True
setupDesynchronizedRatchet ps alice
withTestChat ps "bob_old" $ \bob -> do
bob <## "subscribed 1 connections on server localhost"
bob ##> "/sync alice"
bob <## "connection synchronization started"
alice <## "bob: connection synchronization agreed"
bob <## "alice: connection synchronization agreed"
bob <## "alice: security code changed"
alice <## "bob: connection synchronized"
bob <## "alice: connection synchronized"
threadDelay 100000
bob #$> ("/_get chat @2 count=4", chat, [(1, "connection synchronization started"), (0, "connection synchronization agreed"), (0, "security code changed"), (0, "connection synchronized")])
alice #$> ("/_get chat @2 count=2", chat, [(0, "connection synchronization agreed"), (0, "connection synchronized")])
-- connection not verified
bob ##> "/i alice"
aliceInfo bob False
alice #> "@bob hello again"
bob <# "alice> hello again"
bob #> "@alice received!"
alice <# "bob> received!"
where
aliceInfo :: HasCallStack => TestCC -> Bool -> IO ()
aliceInfo bob verified = do
bob <## "contact ID: 2"
bob <## "receiving messages via: localhost"
bob <## "sending messages via: localhost"
bob <## "you've shared main profile with this contact"
bob <## connVerified
bob <## "quantum resistant end-to-end encryption"
bob <## currentChatVRangeInfo
where
connVerified
| verified = "connection verified"
| otherwise = "connection not verified, use /code command to see security code"
#endif
testSetMessageReactions :: HasCallStack => TestParams -> IO ()
testSetMessageReactions =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #> "@bob hi"
bob <# "alice> hi"
bob ##> "+1 alice hi"
bob <## "added 👍"
alice <# "bob> >> hi"
alice <## " + 👍"
bob ##> "+1 alice hi"
bob <## "bad chat command: reaction already added"
bob ##> "+^ alice hi"
bob <## "added 🚀"
alice <# "bob> >> hi"
alice <## " + 🚀"
alice ##> "/tail @bob 1"
alice <# "@bob hi"
alice <## " 👍 1 🚀 1"
bob ##> "/tail @alice 1"
bob <# "alice> hi"
bob <## " 👍 1 🚀 1"
alice ##> "+1 bob hi"
alice <## "added 👍"
bob <# "alice> > hi"
bob <## " + 👍"
alice ##> "/tail @bob 1"
alice <# "@bob hi"
alice <## " 👍 2 🚀 1"
bob ##> "/tail @alice 1"
bob <# "alice> hi"
bob <## " 👍 2 🚀 1"
bob ##> "-1 alice hi"
bob <## "removed 👍"
alice <# "bob> >> hi"
alice <## " - 👍"
bob ##> "-^ alice hi"
bob <## "removed 🚀"
alice <# "bob> >> hi"
alice <## " - 🚀"
alice ##> "/tail @bob 1"
alice <# "@bob hi"
alice <## " 👍 1"
bob ##> "/tail @alice 1"
bob <# "alice> hi"
bob <## " 👍 1"
testSendDeliveryReceipts :: HasCallStack => TestParams -> IO ()
testSendDeliveryReceipts ps =
withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do
withNewTestChatCfg ps cfg "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice #> "@bob hi"
bob <# "alice> hi"
alice "@bob hi"
bob #> "@alice hey"
alice <# "bob> hey"
bob "@alice hey"
where
cfg = testCfg {showReceipts = True}
testConfigureDeliveryReceipts :: HasCallStack => TestParams -> IO ()
testConfigureDeliveryReceipts ps =
withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do
withNewTestChatCfg ps cfg "bob" bobProfile $ \bob -> do
withNewTestChatCfg ps cfg "cath" cathProfile $ \cath -> do
connectUsers alice bob
connectUsers alice cath
-- for new users receipts are enabled by default
receipt bob alice "1"
receipt cath alice "2"
-- configure receipts in all chats
alice ##> "/set receipts all off"
alice <## "ok"
noReceipt bob alice "3"
noReceipt cath alice "4"
-- configure receipts for user contacts
alice ##> "/_set receipts contacts 1 on"
alice <## "ok"
receipt bob alice "5"
receipt cath alice "6"
-- configure receipts for user contacts (terminal api)
alice ##> "/set receipts contacts off"
alice <## "ok"
noReceipt bob alice "7"
noReceipt cath alice "8"
-- configure receipts for contact
alice ##> "/receipts @bob on"
alice <## "ok"
receipt bob alice "9"
noReceipt cath alice "10"
-- configure receipts for user contacts (don't clear overrides)
alice ##> "/_set receipts contacts 1 off"
alice <## "ok"
receipt bob alice "11"
noReceipt cath alice "12"
alice ##> "/_set receipts contacts 1 off clear_overrides=off"
alice <## "ok"
receipt bob alice "13"
noReceipt cath alice "14"
-- configure receipts for user contacts (clear overrides)
alice ##> "/set receipts contacts off clear_overrides=on"
alice <## "ok"
noReceipt bob alice "15"
noReceipt cath alice "16"
-- configure receipts for contact, reset to default
alice ##> "/receipts @bob on"
alice <## "ok"
receipt bob alice "17"
noReceipt cath alice "18"
alice ##> "/receipts @bob default"
alice <## "ok"
noReceipt bob alice "19"
noReceipt cath alice "20"
where
cfg = testCfg {showReceipts = True}
receipt cc1 cc2 msg = do
name1 <- userName cc1
name2 <- userName cc2
cc1 #> ("@" <> name2 <> " " <> msg)
cc2 <# (name1 <> "> " <> msg)
cc1 ("@" <> name2 <> " " <> msg)
noReceipt cc1 cc2 msg = do
name1 <- userName cc1
name2 <- userName cc2
cc1 #> ("@" <> name2 <> " " <> msg)
cc2 <# (name1 <> "> " <> msg)
cc1 <// 50000
testConnInvChatVRange :: HasCallStack => VersionRangeChat -> VersionRangeChat -> TestParams -> IO ()
testConnInvChatVRange ct1VRange ct2VRange ps =
withNewTestChatCfg ps testCfg {chatVRange = ct1VRange} "alice" aliceProfile $ \alice -> do
withNewTestChatCfg ps testCfg {chatVRange = ct2VRange} "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice ##> "/i bob"
contactInfoChatVRange alice ct2VRange
bob ##> "/i alice"
contactInfoChatVRange bob ct1VRange
testConnReqChatVRange :: HasCallStack => VersionRangeChat -> VersionRangeChat -> TestParams -> IO ()
testConnReqChatVRange ct1VRange ct2VRange ps =
withNewTestChatCfg ps testCfg {chatVRange = ct1VRange} "alice" aliceProfile $ \alice -> do
withNewTestChatCfg ps testCfg {chatVRange = ct2VRange} "bob" bobProfile $ \bob -> do
alice ##> "/ad"
cLink <- getContactLink alice True
bob ##> ("/c " <> cLink)
alice <#? bob
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request, you can send messages to contact"
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
alice ##> "/i bob"
contactInfoChatVRange alice ct2VRange
bob ##> "/i alice"
contactInfoChatVRange bob ct1VRange
testUpdatePeerChatVRange :: HasCallStack => TestParams -> IO ()
testUpdatePeerChatVRange ps =
withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChatCfg ps cfg11 "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice ##> "/i bob"
contactInfoChatVRange alice vr11
bob ##> "/i alice"
contactInfoChatVRange bob supportedChatVRange
withTestChat ps "bob" $ \bob -> do
bob <## "subscribed 1 connections on server localhost"
bob #> "@alice hello 1"
alice <# "bob> hello 1"
alice ##> "/i bob"
contactInfoChatVRange alice supportedChatVRange
bob ##> "/i alice"
contactInfoChatVRange bob supportedChatVRange
withTestChatCfg ps cfg11 "bob" $ \bob -> do
bob <## "subscribed 1 connections on server localhost"
bob #> "@alice hello 2"
alice <# "bob> hello 2"
alice ##> "/i bob"
contactInfoChatVRange alice vr11
bob ##> "/i alice"
contactInfoChatVRange bob supportedChatVRange
where
cfg11 = testCfg {chatVRange = vr11} :: ChatConfig
vr11 :: VersionRangeChat
vr11 = mkVersionRange (VersionChat 1) (VersionChat 1)
contactInfoChatVRange :: TestCC -> VersionRangeChat -> IO ()
contactInfoChatVRange cc (VersionRange minVer maxVer) = do
cc <## "contact ID: 2"
cc <## "receiving messages via: localhost"
cc <## "sending messages via: localhost"
cc <## "you've shared main profile with this contact"
cc <## "connection not verified, use /code command to see security code"
cc <## "quantum resistant end-to-end encryption"
cc <## ("peer chat protocol version range: (" <> show minVer <> ", " <> show maxVer <> ")")
testLinkContentFilter :: HasCallStack => TestParams -> IO ()
testLinkContentFilter =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/c"
simplexLink <- getInvitation alice
let linkPreview = "{\"msgContent\": {\"type\": \"link\", \"text\": \"https://simplex.chat\", \"preview\": {\"uri\": \"https://simplex.chat\", \"title\": \"SimpleX Chat\", \"description\": \"SimpleX Chat\", \"image\": \"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}"
alice ##> ("/_send @2 json [" <> linkPreview <> "]")
alice <# "@bob https://simplex.chat"
bob <# "alice> https://simplex.chat"
alice #> "@bob check out https://example.com"
bob <# "alice> check out https://example.com"
bob #> "@alice visit http://test.org"
alice <# "bob> visit http://test.org"
alice #> ("@bob " <> simplexLink)
bob <#. "alice> https://simplex.chat/invitation#"
bob #> "@alice [click here](https://link.example.com)"
alice <# "bob> [click here](https://link.example.com)"
alice #> "@bob visit example.com for info"
bob <# "alice> visit example.com for info"
alice #> "@bob hello, no links here"
bob <# "alice> hello, no links here"
alice ##> "/_get content types @2"
alice <## "Chat content types: link, text"
alice #$> ("/_get chat @2 content=link count=100", chat, [(1, "https://simplex.chat"), (1, "check out https://example.com"), (0, "visit http://test.org"), (1, simplexLink), (0, "[click here](https://link.example.com)"), (1, "visit example.com for info")])
bob ##> "/_get content types @2"
bob <## "Chat content types: link, text"
bob #$> ("/_get chat @2 content=link count=100", chat, [(0, "https://simplex.chat"), (0, "check out https://example.com"), (1, "visit http://test.org"), (0, simplexLink), (1, "[click here](https://link.example.com)"), (0, "visit example.com for info")])