add implementation plan

* switch to ghc-8.10.7 (lts-18.17 resolver) (#125)

* update simplex.md

Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>

.github/CODEOWNERS

@@ -0,0 +1 @@
+* @epoberezkin @efim-poberezkin

.github/FUNDING.yml

@@ -1 +1,2 @@
+github: simplex-chat
 open_collective: simplex-chat

.github/changelog_conf.json

@@ -1,4 +1,4 @@
 {
-  "template": "${{UNCATEGORIZED}}",
-  "pr_template": "- ${{TITLE}}\n"
+  "template": "Commits:\n${{UNCATEGORIZED}}",
+  "pr_template": "- ${{TITLE}}"
 }

.github/workflows/build.yml

@@ -75,7 +75,7 @@ jobs:
       - name: Setup Stack
         uses: haskell/actions/setup@v1
         with:
-          ghc-version: '8.8.4'
+          ghc-version: '8.10.7'
           enable-stack: true
           stack-version: 'latest'
 

.gitignore

@@ -40,7 +40,6 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
-*.cabal
 stack.yaml.lock
 
 # Idris

README.md

@@ -8,12 +8,15 @@
 [![GitHub downloads](https://img.shields.io/github/downloads/simplex-chat/simplex-chat/total)](https://github.com/simplex-chat/simplex-chat/releases)
 [![GitHub release](https://img.shields.io/github/v/release/simplex-chat/simplex-chat)](https://github.com/simplex-chat/simplex-chat/releases)
 [![Follow on Twitter](https://img.shields.io/twitter/follow/SimpleXChat?style=social)](https://twitter.com/simplexchat)
+[![Join on Reddit](https://img.shields.io/reddit/subreddit-subscribers/SimpleXChat?style=social)](https://www.reddit.com/r/SimpleXChat)
 
 SimpleX chat prototype is a thin terminal UI on top of [SimpleXMQ](https://github.com/simplex-chat/simplexmq) message broker that uses [SMP protocols](https://github.com/simplex-chat/simplexmq/blob/master/protocol). The motivation for SimpleX chat is [presented here](./simplex.md). See [simplex.chat](https://simplex.chat) website for chat demo and the explanations of the system and how SMP protocol works.
 
-**NEW in v0.5.0: [user contact addresses](#user-contact-addresses-alpha)!**
+**NEW in v0.5.4: [messages persistence](#access-chat-history)**
 
-**Please note**: v0.5.0 of SimpleX Chat works with the same database, but the connection links are not compatible with the previous version - please ask all your contacts to upgrade!
+**NEW in v0.5.0: [user contact addresses](#user-contact-addresses-alpha)**
+
+**Please note**: v0.5.0 of SimpleX Chat works with the same database, but the connection links are not compatible with the prior versions - please ask all your contacts to upgrade!
 
 ### :zap: Quick installation
 
@@ -88,6 +91,7 @@ The routing of messages relies on the knowledge of client devices how user conta
 - Group messaging.
 - Sending files to contacts and groups.
 - User contact addresses - establish connections via multiple-use contact links.
+- Messages persisted in a local SQLite database.
 - Auto-populated recipient name - just type your messages to reply to the sender once the connection is established.
 - Demo SMP servers available and pre-configured in the app - or you can [deploy your own server](https://github.com/simplex-chat/simplexmq#using-smp-server-and-smp-agent).
 - No global identity or any names visible to the server(s), ensuring full privacy of your contacts and conversations.
@@ -274,23 +278,53 @@ Use `/help address` for other commands.
 
 ### Access chat history
 
-> 🚧 **Section currently out of date** 🏗
+SimpleX chat stores all your contacts and conversations in a local SQLite database, making it private and portable by design, owned and controlled by user.
 
-SimpleX chat stores all your contacts and conversations in a local database file, making it private and portable by design, fully owned and controlled by you.
-
-You can search your chat history via SQLite database file:
+You can view and search your chat history by querying your database:
 
 ```
-sqlite3 ~/.simplex/smp-chat.db
+sqlite3 ~/.simplex/simplex.chat.db
 ```
 
-Now you can query `messages` table, for example:
+Now you can run queries against `direct_messages`, `group_messages` and `all_messages` (or their simpler alternatives `direct_messages_plain`, `group_messages_plain` and `all_messages_plain`), for example:
 
 ```sql
-select * from messages
-where conn_alias = cast('alice' as blob)
-  and body like '%cats%'
-order by internal_id desc;
+-- you can put these or your preferred settings into ~/.sqliterc to persist across sqlite3 client sessions
+.mode column
+.headers on
+
+-- simple views into direct, group and all_messages with user's messages deduplicated for group and all_messages
+-- only 'x.msg.new' ("new message") chat events - filters out service events
+-- msg_sent is 0 for received, 1 for sent
+select * from direct_messages_plain;
+select * from group_messages_plain;
+select * from all_messages_plain;
+
+-- query other details of your chat history with regular SQL
+select * from direct_messages where msg_sent = 1 and chat_msg_event = 'x.file'; -- files you offered for sending
+select * from direct_messages where msg_sent = 0 and contact = 'catherine' and msg_body like '%cats%'; -- everything catherine sent related to cats
+select * from group_messages where group_name = 'team' and contact = 'alice'; -- all correspondence with alice in #team
+
+-- aggregate your chat data
+select contact_or_group, num_messages from (
+  select contact as contact_or_group, count(1) as num_messages from direct_messages_plain group by contact
+  union
+  select group_name as contact_or_group, count(1) as num_messages from group_messages_plain group by group_name
+) order by num_messages desc;
+```
+
+**Convenience queries**
+
+Get all messages from today (`chat_dt` is in UTC):
+
+```sql
+select * from all_messages_plain where date(chat_dt) > date('now', '-1 day') order by chat_dt;
+```
+
+Get overnight messages in the morning:
+
+```sql
+select * from all_messages_plain where chat_dt > datetime('now', '-15 hours') order by chat_dt;
 ```
 
 > **Please note:** SQLite foreign key constraints are disabled by default, and must be **[enabled separately for each database connection](https://sqlite.org/foreignkeys.html#fk_enable)**. The latter can be achieved by running `PRAGMA foreign_keys = ON;` command on an open database connection. By running data altering queries without enabling foreign keys prior to that, you may risk putting your database in an inconsistent state.

migrations/20210612_initial.sql

@@ -194,6 +194,8 @@ CREATE TABLE connections ( -- all SMP agent connections
     DEFERRABLE INITIALLY DEFERRED
 );
 
+-- PLEASE NOTE: all tables below were unused and are removed in the migration 20211227_messages.sql
+
 CREATE TABLE events ( -- messages received by the agent, append only
   event_id INTEGER PRIMARY KEY,
   agent_msg_id INTEGER NOT NULL, -- internal message ID

migrations/20211229_messages.sql

@@ -0,0 +1,200 @@
+DROP TABLE event_body_parts;
+DROP TABLE contact_profile_events;
+DROP TABLE group_profile_events;
+DROP TABLE group_event_parents;
+DROP TABLE group_events;
+DROP TABLE message_events;
+DROP TABLE message_content;
+DROP TABLE events;
+DROP TABLE messages;
+
+-- all message events as received or sent, append only
+-- maps to message deliveries as one-to-many for group messages
+CREATE TABLE messages (
+  message_id INTEGER PRIMARY KEY,
+  msg_sent INTEGER NOT NULL, -- 0 for received, 1 for sent
+  chat_msg_event TEXT NOT NULL, -- message event type (the constructor of ChatMsgEvent)
+  msg_body BLOB, -- agent message body as received or sent
+  created_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+-- message deliveries communicated with the agent, append only
+CREATE TABLE msg_deliveries (
+  msg_delivery_id INTEGER PRIMARY KEY,
+  message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages
+  connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
+  agent_msg_id INTEGER, -- internal agent message ID (NULL while pending)
+  agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
+  chat_ts TEXT NOT NULL DEFAULT (datetime('now')), -- broker_ts for received, created_at for sent
+  UNIQUE (connection_id, agent_msg_id)
+);
+
+-- TODO recovery for received messages with "rcv_agent" status - acknowledge to agent
+-- changes of messagy delivery status, append only
+CREATE TABLE msg_delivery_events (
+  msg_delivery_event_id INTEGER PRIMARY KEY,
+  msg_delivery_id INTEGER NOT NULL REFERENCES msg_deliveries ON DELETE CASCADE, -- non UNIQUE for multiple events per msg delivery
+  delivery_status TEXT NOT NULL, -- see MsgDeliveryStatus for allowed values
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  UNIQUE (msg_delivery_id, delivery_status)
+);
+
+CREATE VIEW direct_messages AS
+SELECT
+  ct.local_display_name AS contact,
+  m.message_id AS message_id,
+  m.msg_sent AS msg_sent,
+  m.chat_msg_event AS chat_msg_event,
+  m.msg_body AS msg_body,
+  md.msg_delivery_id AS delivery_id,
+  datetime(md.chat_ts) AS chat_dt,
+  md.agent_msg_meta AS msg_meta,
+  mde.delivery_status AS delivery_status,
+  datetime(mde.created_at) AS delivery_status_dt
+FROM messages m
+JOIN msg_deliveries md ON md.message_id = m.message_id
+JOIN (
+  SELECT msg_delivery_id, MAX(created_at) MaxDate
+  FROM msg_delivery_events
+  GROUP BY msg_delivery_id
+) MaxDates ON MaxDates.msg_delivery_id = md.msg_delivery_id
+JOIN msg_delivery_events mde ON mde.msg_delivery_id = MaxDates.msg_delivery_id
+                            AND mde.created_at = MaxDates.MaxDate
+JOIN connections c ON c.connection_id = md.connection_id
+JOIN contacts ct ON ct.contact_id = c.contact_id
+ORDER BY chat_dt DESC;
+
+CREATE VIEW direct_messages_plain AS
+SELECT
+  dm.contact AS contact,
+  dm.msg_sent AS msg_sent,
+  dm.msg_body AS msg_body,
+  dm.chat_dt AS chat_dt
+FROM direct_messages dm
+WHERE dm.chat_msg_event = 'x.msg.new';
+
+CREATE VIEW group_messages AS
+SELECT
+  g.local_display_name AS group_name,
+  gm.local_display_name AS contact,
+  m.message_id AS message_id,
+  m.msg_sent AS msg_sent,
+  m.chat_msg_event AS chat_msg_event,
+  m.msg_body AS msg_body,
+  md.msg_delivery_id AS delivery_id,
+  datetime(md.chat_ts) AS chat_dt,
+  md.agent_msg_meta AS msg_meta,
+  mde.delivery_status AS delivery_status,
+  datetime(mde.created_at) AS delivery_status_dt
+FROM messages m
+JOIN msg_deliveries md ON md.message_id = m.message_id
+JOIN (
+  SELECT msg_delivery_id, MAX(created_at) MaxDate
+  FROM msg_delivery_events
+  GROUP BY msg_delivery_id
+) MaxDates ON MaxDates.msg_delivery_id = md.msg_delivery_id
+JOIN msg_delivery_events mde ON mde.msg_delivery_id = MaxDates.msg_delivery_id
+                            AND mde.created_at = MaxDates.MaxDate
+JOIN connections c ON c.connection_id = md.connection_id
+JOIN group_members gm ON gm.group_member_id = c.group_member_id
+JOIN groups g ON g.group_id = gm.group_id
+ORDER BY chat_dt DESC;
+
+CREATE VIEW group_messages_plain AS
+SELECT
+  gm.group_name AS group_name,
+  (CASE WHEN gm.msg_sent = 0 THEN gm.contact ELSE gm.group_name END) AS contact,
+  gm.msg_sent AS msg_sent,
+  gm.msg_body AS msg_body,
+  gm.chat_dt AS chat_dt
+FROM group_messages gm
+JOIN (
+  SELECT message_id, MIN(delivery_id) MinDeliveryId
+  FROM group_messages
+  GROUP BY message_id
+) Deduplicated ON Deduplicated.message_id = gm.message_id
+              AND Deduplicated.MinDeliveryId = gm.delivery_id
+WHERE gm.chat_msg_event = 'x.msg.new';
+
+CREATE VIEW all_messages (
+  group_name,
+  contact,
+  message_id,
+  msg_sent,
+  chat_msg_event,
+  msg_body,
+  delivery_id,
+  chat_dt,
+  msg_meta,
+  delivery_status,
+  delivery_status_dt
+) AS
+  SELECT * FROM (
+    SELECT NULL AS group_name, * FROM direct_messages
+    UNION
+    SELECT * FROM group_messages
+  )
+  ORDER BY chat_dt DESC;
+
+CREATE VIEW all_messages_plain (
+  group_name,
+  contact,
+  msg_sent,
+  msg_body,
+  chat_dt
+) AS
+  SELECT * FROM (
+    SELECT NULL AS group_name, * FROM direct_messages_plain
+    UNION
+    SELECT * FROM group_messages_plain
+  )
+  ORDER BY chat_dt DESC;
+
+-- TODO group message parents and chat items not to be implemented in current scope
+
+-- CREATE TABLE group_message_parents (
+--   group_message_parent_id INTEGER PRIMARY KEY,
+--   message_id INTEGER NOT NULL REFERENCES group_messages (event_id),
+--   parent_group_member_id INTEGER REFERENCES group_members (group_member_id), -- can be NULL if parent_member_id is incorrect
+--   parent_member_id BLOB, -- shared member ID, unique per group
+--   parent_message_id INTEGER REFERENCES messages (message_id) ON DELETE CASCADE, -- can be NULL if received message references another message that's not received yet
+--   parent_chat_msg_id INTEGER NOT NULL,
+--   parent_msg_body_hash BLOB NOT NULL
+-- );
+
+-- CREATE INDEX group_event_parents_parent_chat_event_id_index
+--   ON group_message_parents (parent_member_id, parent_chat_msg_id);
+
+-- CREATE TABLE chat_items ( -- mutable chat_items presented to user
+--   chat_item_id INTEGER PRIMARY KEY,
+--   chat_msg_id INTEGER NOT NULL, -- sent as part of the message that created the item
+--   item_deleted INTEGER NOT NULL, -- 1 for deleted
+--   item_type TEXT NOT NULL,
+--   item_text TEXT NOT NULL, -- textual representation
+--   item_props TEXT NOT NULL -- JSON
+-- );
+
+-- CREATE TABLE direct_chat_items (
+--   chat_item_id INTEGER NOT NULL UNIQUE REFERENCES chat_items ON DELETE CASCADE,
+--   contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT,
+--   item_sent INTEGER -- 1 for sent, 0 for received
+-- );
+
+-- CREATE TABLE group_chat_items (
+--   chat_item_id INTEGER NOT NULL UNIQUE REFERENCES chat_items ON DELETE CASCADE,
+--   group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT, -- NULL for sent
+--   group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT
+-- );
+
+-- CREATE TABLE chat_item_content (
+--   chat_item_content_id INTEGER PRIMARY KEY,
+--   chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
+--   content_type TEXT NOT NULL,
+--   content_size INTEGER NOT NULL,
+--   content BLOB NOT NULL
+-- );
+
+-- CREATE TABLE chat_item_messages (
+--   message_id INTEGER NOT NULL UNIQUE REFERENCES messages,
+--   chat_item_id INTEGER NOT NULL REFERENCES chat_items
+-- );

migrations/20220106_group_members_inv_queue_info.sql

@@ -0,0 +1,3 @@
+ALTER TABLE group_members ADD inv_queue_info BLOB;
+
+CREATE INDEX idx_groups_inv_queue_info ON groups (inv_queue_info);

package.yaml

@@ -1,5 +1,5 @@
 name: simplex-chat
-version: 0.5.0
+version: 0.5.5
 #synopsis:
 #description:
 homepage: https://github.com/simplex-chat/simplex-chat#readme
@@ -13,7 +13,7 @@ extra-source-files:
 
 dependencies:
   - aeson == 1.5.*
-  - ansi-terminal == 0.10.*
+  - ansi-terminal >= 0.10 && < 0.12
   - attoparsec == 0.13.*
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
@@ -23,13 +23,13 @@ dependencies:
   - cryptonite >= 0.27 && < 0.30
   - directory == 1.3.*
   - exceptions == 0.10.*
-  - file-embed == 0.0.14.*
+  - file-embed >= 0.0.14 && < 0.0.16
   - filepath == 1.4.*
   - mtl == 2.2.*
-  - optparse-applicative == 0.15.*
+  - optparse-applicative >= 0.15 && < 0.17
   - process == 1.6.*
   - simple-logger == 0.1.*
-  - simplexmq == 0.5.*
+  - simplexmq >= 0.5.2 && < 0.6
   - sqlite-simple == 0.4.*
   - stm == 2.5.*
   - terminal == 0.2.*

rfcs/2022-01-07-notification-server.md

@@ -0,0 +1,78 @@
+# SimpleX Notification Server for SimpleX Chat
+
+## Background and motivation
+
+SimpleX Chat clients should receive message notifications when not being online and/or subscribed to SMP servers.
+
+To avoid revealing identities of clients directly to SMP servers via any kind of push notification tokens, a new party called SimpleX Notification Server is introduced to act as a service for subscribing to SMP server queue notifications on behalf of clients and sending push notifications to them.
+
+## Proposal
+
+Communication between SimpleX Chat clients and SimpleX Notification Servers is carried out using SMP protocols (via SMP agents), which provides stronger security guarantees out of the box compared to HTTPS. Communication between SimpleX Notification Servers and SMP servers is also carried out using SMP protocol, with SimpleX Notification Server using an SMP client internally.
+
+Before establishing message notifications:
+
+1. SimpleX Notification Server creates a permanent address via SMP protocol.
+
+2. This address is supplied to SimpleX Chat client via configuration or options, or baked in.
+
+3. If SimpleX Chat client enables message notifications (for all or given chat connections) it establishes connection(s) to SimpleX Notification Server(s).
+
+   TBC:
+
+   - establish connection(s) to Notification Server(s) preemptively or on-demand;
+   - one connection per Notification Server or per chat connection (probably the latter doesn't make sense);
+   - to one or many Notification Servers.
+
+Order of communication to establish message notifications goes as follows:
+
+1. SimpleX Chat client requests SMP server to establish notifications for a queue using NKEY command containing a public key for authentication of NSUB command.
+2. SMP server replies to SimpleX Chat client with NID response containing the queue's ID to be used for NSUB command.
+3. SimpleX Chat client requests SimpleX Notification Server to subscribe to message notifications for the queue by sending `s.post` message (see `2022-01-07-simplex-services.md` rfc) to the [previously ?] established connection with Notification Server. The message contains SMP server address, notifier ID from SMP server's NID response, notifier private key (public key was provided to SMP server in NKEY command) and some kind of push notification token.
+4. SimpleX Notification Server sends NSUB command to the SMP server containing notifier ID and signed with notifier key.
+5. SMP server responds to SimpleX Notification Server with OK or NMSG if messages are available. After that SMP server sends NMSG notifications to SimpleX Notification Server for new available message. TBC - for all messages? some heuristics?
+6. SimpleX Notification Server sends `s.ok` (`s.resp.ok`?) message to SimpleX Chat client signaling it has subscribed to notifications.
+7. SimpleX Notification Server sends push notifications to SimpleX Chat client on new NMSG notifications from SMP server via provided push notification token.
+
+## Implementation plan
+
+https://github.com/simplex-chat/simplexmq/pull/314
+
+Make agent work with postgres:
+- fix issue with writing binary data
+- make all tests pass with postgres
+- revise instances, error handling, transaction settings
+- class abstracting `execute`, `query`, `Only`, error handling, probably more
+- separate migration logic
+  - Q duplicate? (as now)
+  - Q or reuse store methods + store method for `exec`
+- parameterize agent to run either on sqlite or postgres
+- \* move postgres instances to separate package to avoid compiling for mobile app
+- make tests run for both sqlite and postgres
+
+Protocol design:
+- service protocol
+- notifications sub-protocol
+
+Push notifications:
+- investigate sending push notifications to ios, (*) android
+- notification server code running with postgres agent
+  - communication with smp servers
+  - communication with clients
+  - notification specific store
+    - Q same database? same server different database?
+    - Q how to reuse database code? notification specific methods? -> should be unavailable to sqlite agent
+  - Q other areas?
+- notification server deployed
+  - Q deployed where and how (probably a script similar to linode using systemd)
+    - \* should be built on github to be downloaded as binary, can be shortcutted
+  - Q spinning up postgres - postgres server, db, settings (password?)
+  - Q transport - will self signed certificates work for push notifications? or will CA signed certificates be required?
+- notifications at client
+  - client to request notifications from notification server, (*) parameterized
+  - store
+  - client to wake up and selectively subscribe to smp server, then notify
+  - api for wake up, api for response
+    - Q will separarate c binding be needed?
+  - logic in swift, (*) kotlin
+- test & fix

rfcs/2022-01-07-simplex-services.md

@@ -0,0 +1,37 @@
+# SimpleX Services
+
+## Background and motivation
+
+SimpleX clients communicating with SimpleX services require message format separate from SimpleX Chat `x` namespace.
+
+## Proposal
+
+Use `s` (for "service") namespace with REST like messages for requests and responses, e.g.
+
+```
+s.post resource data
+s.get resource
+...
+```
+
+Requests only require resource locations at the service, location of the service itself is determined by the SMP connection.
+
+Responses can either have separate messages:
+
+```
+s.ok
+s.not_found
+...
+```
+
+Or be united under a single "response" envelope:
+
+```
+s.resp.ok
+s.resp.not_found
+...
+```
+
+## Schema migration
+
+## Implementation plan

simplex-chat.cabal

@@ -0,0 +1,147 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+
+name:           simplex-chat
+version:        0.5.5
+category:       Web, System, Services, Cryptography
+homepage:       https://github.com/simplex-chat/simplex-chat#readme
+author:         Evgeny Poberezkin
+maintainer:     evgeny@poberezkin.com
+copyright:      2020 Evgeny Poberezkin
+license:        AGPL-3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+
+library
+  exposed-modules:
+      Simplex.Chat
+      Simplex.Chat.Controller
+      Simplex.Chat.Help
+      Simplex.Chat.Input
+      Simplex.Chat.Markdown
+      Simplex.Chat.Notification
+      Simplex.Chat.Options
+      Simplex.Chat.Protocol
+      Simplex.Chat.Store
+      Simplex.Chat.Styled
+      Simplex.Chat.Terminal
+      Simplex.Chat.Types
+      Simplex.Chat.Util
+      Simplex.Chat.View
+  other-modules:
+      Paths_simplex_chat
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
+  build-depends:
+      aeson ==1.5.*
+    , ansi-terminal >=0.10 && <0.12
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , directory ==1.3.*
+    , exceptions ==0.10.*
+    , file-embed >=0.0.14 && <0.0.16
+    , filepath ==1.4.*
+    , mtl ==2.2.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , simple-logger ==0.1.*
+    , simplexmq >=0.5.2 && <0.6
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , terminal ==0.2.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+  default-language: Haskell2010
+
+executable simplex-chat
+  main-is: Main.hs
+  other-modules:
+      Paths_simplex_chat
+  hs-source-dirs:
+      apps/simplex-chat
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  build-depends:
+      aeson ==1.5.*
+    , ansi-terminal >=0.10 && <0.12
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , directory ==1.3.*
+    , exceptions ==0.10.*
+    , file-embed >=0.0.14 && <0.0.16
+    , filepath ==1.4.*
+    , mtl ==2.2.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , simple-logger ==0.1.*
+    , simplex-chat
+    , simplexmq >=0.5.2 && <0.6
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , terminal ==0.2.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+  default-language: Haskell2010
+
+test-suite simplex-chat-test
+  type: exitcode-stdio-1.0
+  main-is: Test.hs
+  other-modules:
+      ChatClient
+      ChatTests
+      MarkdownTests
+      ProtocolTests
+      Paths_simplex_chat
+  hs-source-dirs:
+      tests
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
+  build-depends:
+      aeson ==1.5.*
+    , ansi-terminal >=0.10 && <0.12
+    , async ==2.2.*
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , directory ==1.3.*
+    , exceptions ==0.10.*
+    , file-embed >=0.0.14 && <0.0.16
+    , filepath ==1.4.*
+    , hspec ==2.7.*
+    , mtl ==2.2.*
+    , network ==3.1.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , simple-logger ==0.1.*
+    , simplex-chat
+    , simplexmq >=0.5.2 && <0.6
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , terminal ==0.2.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+  default-language: Haskell2010

simplex.md

@@ -4,8 +4,8 @@
 
 Existing chat platforms and protocols have some or all of the following problems:
 
-- Lack of privacy of the conversation, partially caused by [E2EE][1] implementations.
-- Lack of privacy of the user profile and connections.
+- Lack of privacy of the user profile and connections (meta-data privacy).
+- No protection (or only optional protection) of [E2EE][1] implementations from MITM attacks.
 - Unsolicited messages (spam and abuse).
 - Lack of data ownership and protection.
 - Complexity of usage for all non-centralized protocols to non-technical users.

src/Simplex/Chat.hs

@@ -24,6 +24,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Char (isSpace)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (find)
@@ -43,13 +44,14 @@ import Simplex.Chat.Store
 import Simplex.Chat.Styled (plain)
 import Simplex.Chat.Terminal
 import Simplex.Chat.Types
-import Simplex.Chat.Util (ifM, unlessM)
+import Simplex.Chat.Util (ifM, unlessM, whenM)
 import Simplex.Chat.View
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), defaultAgentConfig)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Protocol (MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Util (bshow, raceAny_, tryError)
 import System.Exit (exitFailure, exitSuccess)
@@ -69,9 +71,13 @@ data ChatCommand
   | GroupsHelp
   | MyAddressHelp
   | MarkdownHelp
+  | Welcome
   | AddContact
-  | Connect AConnectionRequest
+  | Connect (Maybe AConnectionRequest)
+  | ConnectAdmin
+  | SendAdminWelcome ContactName
   | DeleteContact ContactName
+  | ListContacts
   | CreateMyAddress
   | DeleteMyAddress
   | ShowMyAddress
@@ -86,6 +92,7 @@ data ChatCommand
   | LeaveGroup GroupName
   | DeleteGroup GroupName
   | ListMembers GroupName
+  | ListGroups
   | SendGroupMessage GroupName ByteString
   | SendFile ContactName FilePath
   | SendGroupFile GroupName FilePath
@@ -126,7 +133,9 @@ simplexChat cfg opts t =
 
 newChatController :: WithTerminal t => ChatConfig -> ChatOpts -> t -> (Notification -> IO ()) -> IO ChatController
 newChatController config@ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} ChatOpts {dbFile, smpServers} t sendNotification = do
-  chatStore <- createStore (dbFile <> ".chat.db") dbPoolSize
+  let f = chatStoreFile dbFile
+  firstTime <- not <$> doesFileExist f
+  chatStore <- createStore f dbPoolSize
   currentUser <- newTVarIO =<< getCreateActiveUser chatStore
   chatTerminal <- newChatTerminal t
   smpAgent <- getSMPAgentClient cfg {dbFile = dbFile <> ".agent.db", smpServers}
@@ -139,7 +148,10 @@ newChatController config@ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} Cha
   pure ChatController {..}
 
 runSimplexChat :: ChatController -> IO ()
-runSimplexChat = runReaderT (race_ runTerminalInput runChatController)
+runSimplexChat = runReaderT $ do
+  user <- readTVarIO =<< asks currentUser
+  whenM (asks firstTime) . printToView . chatWelcome user $ Onboarding 0 0 0 0 0
+  race_ runTerminalInput runChatController
 
 runChatController :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
 runChatController =
@@ -164,7 +176,7 @@ inputSubscriber = do
     atomically (readTBQueue q) >>= \case
       InputControl _ -> pure ()
       InputCommand s ->
-        case parseAll chatCommandP . encodeUtf8 $ T.pack s of
+        case parseAll chatCommandP . B.dropWhileEnd isSpace . encodeUtf8 $ T.pack s of
           Left e -> printToView [plain s, "invalid input: " <> plain e]
           Right cmd -> do
             case cmd of
@@ -172,6 +184,7 @@ inputSubscriber = do
               SendGroupMessage g msg -> showSentGroupMessage g msg
               SendFile c f -> showSentFileInvitation c f
               SendGroupFile g f -> showSentGroupFileInvitation g f
+              SendAdminWelcome c -> forM_ adminWelcomeMessages $ showSentMessage c
               _ -> printToView [plain s]
             user <- readTVarIO =<< asks currentUser
             withAgentLock a . withLock l . void . runExceptT $
@@ -184,16 +197,18 @@ processChatCommand user@User {userId, profile} = \case
   GroupsHelp -> printToView groupsHelpInfo
   MyAddressHelp -> printToView myAddressHelpInfo
   MarkdownHelp -> printToView markdownInfo
+  Welcome -> do
+    ob <- withStore (`getOnboarding` userId)
+    printToView $ chatWelcome user ob
   AddContact -> do
     (connId, cReq) <- withAgent (`createConnection` SCMInvitation)
     withStore $ \st -> createDirectConnection st userId connId
     showInvitation cReq
-  Connect (ACR cMode cReq) -> do
-    let msg :: ChatMsgEvent = case cMode of
-          SCMInvitation -> XInfo profile
-          SCMContact -> XContact profile Nothing
-    connId <- withAgent $ \a -> joinConnection a cReq $ directMessage msg
-    withStore $ \st -> createDirectConnection st userId connId
+  Connect (Just (ACR SCMInvitation cReq)) -> connect cReq (XInfo profile) >> showSentConfirmation
+  Connect (Just (ACR SCMContact cReq)) -> connect cReq (XContact profile Nothing) >> showSentInvitation
+  Connect Nothing -> showInvalidConnReq
+  ConnectAdmin -> connect adminContactReq (XContact profile Nothing) >> showSentInvitation
+  SendAdminWelcome cName -> forM_ adminWelcomeMessages $ sendMessageCmd cName
   DeleteContact cName ->
     withStore (\st -> getContactGroupNames st userId cName) >>= \case
       [] -> do
@@ -204,6 +219,7 @@ processChatCommand user@User {userId, profile} = \case
         unsetActive $ ActiveC cName
         showContactDeleted cName
       gs -> showContactGroups cName gs
+  ListContacts -> withStore (`getUserContacts` user) >>= showContactsList
   CreateMyAddress -> do
     (connId, cReq) <- withAgent (`createConnection` SCMContact)
     withStore $ \st -> createUserContactLink st userId connId cReq
@@ -229,11 +245,7 @@ processChatCommand user@User {userId, profile} = \case
         `E.finally` deleteContactRequest st userId cName
     withAgent $ \a -> rejectContact a agentContactConnId agentInvitationId
     showContactRequestRejected cName
-  SendMessage cName msg -> do
-    contact <- withStore $ \st -> getContact st userId cName
-    let msgEvent = XMsgNew $ MsgContent MTText [] [MsgContentBody {contentType = SimplexContentType XCText, contentData = msg}]
-    sendDirectMessage (contactConnId contact) msgEvent
-    setActive $ ActiveC cName
+  SendMessage cName msg -> sendMessageCmd cName msg
   NewGroup gProfile -> do
     gVar <- asks idsDrg
     group <- withStore $ \st -> createNewGroup st gVar user gProfile
@@ -241,19 +253,27 @@ processChatCommand user@User {userId, profile} = \case
   AddMember gName cName memRole -> do
     (group, contact) <- withStore $ \st -> (,) <$> getGroup st user gName <*> getContact st userId cName
     let Group {groupId, groupProfile, membership, members} = group
-        userRole = memberRole membership
-        userMemberId = memberId membership
+        GroupMember {memberRole = userRole, memberId = userMemberId} = membership
     when (userRole < GRAdmin || userRole < memRole) $ chatError CEGroupUserRole
     when (memberStatus membership == GSMemInvited) $ chatError (CEGroupNotJoined gName)
     unless (memberActive membership) $ chatError CEGroupMemberNotActive
-    when (isJust $ contactMember contact members) $ chatError (CEGroupDuplicateMember cName)
-    gVar <- asks idsDrg
-    (agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation)
-    GroupMember {memberId} <- withStore $ \st -> createContactGroupMember st gVar user groupId contact memRole agentConnId
-    let msg = XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
-    sendDirectMessage (contactConnId contact) msg
-    showSentGroupInvitation gName cName
-    setActive $ ActiveG gName
+    let sendInvitation memberId cReq = do
+          sendDirectMessage (contactConn contact) $
+            XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
+          showSentGroupInvitation gName cName
+          setActive $ ActiveG gName
+    case contactMember contact members of
+      Nothing -> do
+        gVar <- asks idsDrg
+        (agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation)
+        GroupMember {memberId} <- withStore $ \st -> createContactMember st gVar user groupId contact memRole agentConnId cReq
+        sendInvitation memberId cReq
+      Just GroupMember {groupMemberId, memberId, memberStatus}
+        | memberStatus == GSMemInvited ->
+          withStore (\st -> getMemberInvitation st user groupMemberId) >>= \case
+            Just cReq -> sendInvitation memberId cReq
+            Nothing -> showCannotResendInvitation gName cName
+        | otherwise -> chatError (CEGroupDuplicateMember cName)
   JoinGroup gName -> do
     ReceivedGroupInvitation {fromMember, userMember, connRequest} <- withStore $ \st -> getGroupInvitation st user gName
     agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId userMember
@@ -269,7 +289,7 @@ processChatCommand user@User {userId, profile} = \case
       Just member -> do
         let userRole = memberRole membership
         when (userRole < GRAdmin || userRole < memberRole member) $ chatError CEGroupUserRole
-        sendGroupMessage members . XGrpMemDel $ memberId member
+        when (memberStatus member /= GSMemInvited) . sendGroupMessage members $ XGrpMemDel (memberId member)
         deleteMemberConnection member
         withStore $ \st -> updateGroupMemberStatus st userId member GSMemRemoved
         showDeletedMember gName Nothing (Just member)
@@ -284,7 +304,7 @@ processChatCommand user@User {userId, profile} = \case
     let s = memberStatus membership
         canDelete =
           memberRole membership == GROwner
-            || (s == GSMemRemoved || s == GSMemLeft || s == GSMemGroupDeleted)
+            || (s == GSMemRemoved || s == GSMemLeft || s == GSMemGroupDeleted || s == GSMemInvited)
     unless canDelete $ chatError CEGroupUserRole
     when (memberActive membership) $ sendGroupMessage members XGrpDel
     mapM_ deleteMemberConnection members
@@ -293,8 +313,8 @@ processChatCommand user@User {userId, profile} = \case
   ListMembers gName -> do
     group <- withStore $ \st -> getGroup st user gName
     showGroupMembers group
+  ListGroups -> withStore (`getUserGroupDetails` userId) >>= showGroupsList
   SendGroupMessage gName msg -> do
-    -- TODO save sent messages
     -- TODO save pending message delivery for members without connections
     Group {members, membership} <- withStore $ \st -> getGroup st user gName
     unless (memberActive membership) $ chatError CEGroupMemberUserRemoved
@@ -308,7 +328,7 @@ processChatCommand user@User {userId, profile} = \case
     let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq}
     SndFileTransfer {fileId} <- withStore $ \st ->
       createSndFileTransfer st userId contact f fileInv agentConnId chSize
-    sendDirectMessage (contactConnId contact) $ XFile fileInv
+    sendDirectMessage (contactConn contact) $ XFile fileInv
     showSentFileInfo fileId
     setActive $ ActiveC cName
   SendGroupFile gName f -> do
@@ -320,8 +340,9 @@ processChatCommand user@User {userId, profile} = \case
       (connId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
       pure (m, connId, FileInvitation {fileName, fileSize, fileConnReq})
     fileId <- withStore $ \st -> createSndGroupFileTransfer st userId group ms f fileSize chSize
+    -- TODO sendGroupMessage - same file invitation to all
     forM_ ms $ \(m, _, fileInv) ->
-      traverse (`sendDirectMessage` XFile fileInv) $ memberConnId m
+      traverse (`sendDirectMessage` XFile fileInv) $ memberConn m
     showSentFileInfo fileId
     setActive $ ActiveG gName
   ReceiveFile fileId filePath_ -> do
@@ -349,12 +370,22 @@ processChatCommand user@User {userId, profile} = \case
     user' <- withStore $ \st -> updateUserProfile st user p
     asks currentUser >>= atomically . (`writeTVar` user')
     contacts <- withStore (`getUserContacts` user)
-    forM_ contacts $ \ct -> sendDirectMessage (contactConnId ct) $ XInfo p
+    forM_ contacts $ \ct -> sendDirectMessage (contactConn ct) $ XInfo p
     showUserProfileUpdated user user'
   ShowProfile -> showUserProfile profile
   QuitChat -> liftIO exitSuccess
   ShowVersion -> printToView clientVersionInfo
   where
+    connect :: ConnectionRequest c -> ChatMsgEvent -> m ()
+    connect cReq msg = do
+      connId <- withAgent $ \a -> joinConnection a cReq $ directMessage msg
+      withStore $ \st -> createDirectConnection st userId connId
+    sendMessageCmd :: ContactName -> ByteString -> m ()
+    sendMessageCmd cName msg = do
+      contact <- withStore $ \st -> getContact st userId cName
+      let msgEvent = XMsgNew $ MsgContent MTText [] [MsgContentBody {contentType = SimplexContentType XCText, contentData = msg}]
+      sendDirectMessage (contactConn contact) msgEvent
+      setActive $ ActiveC cName
     contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
     contactMember Contact {contactId} =
       find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
@@ -421,17 +452,20 @@ subscribeUserConnections = void . runExceptT $ do
         (subscribe (contactConnId ct) >> showContactSubscribed c) `catchError` showContactSubError c
     subscribeGroups user = do
       groups <- withStore (`getUserGroups` user)
-      forM_ groups $ \Group {members, membership, localDisplayName = g} -> do
+      forM_ groups $ \g@Group {members, membership, localDisplayName = gn} -> do
         let connectedMembers = mapMaybe (\m -> (m,) <$> memberConnId m) members
-        if null connectedMembers
-          then
-            if memberActive membership
-              then showGroupEmpty g
-              else showGroupRemoved g
-          else do
-            forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) ->
-              subscribe cId `catchError` showMemberSubError g c
-            showGroupSubscribed g
+        if memberStatus membership == GSMemInvited
+          then showGroupInvitation g
+          else
+            if null connectedMembers
+              then
+                if memberActive membership
+                  then showGroupEmpty g
+                  else showGroupRemoved g
+              else do
+                forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) ->
+                  subscribe cId `catchError` showMemberSubError gn c
+                showGroupSubscribed g
     subscribeFiles user = do
       withStore (`getLiveSndFileTransfers` user) >>= mapM_ subscribeSndFile
       withStore (`getLiveRcvFileTransfers` user) >>= mapM_ subscribeRcvFile
@@ -508,21 +542,27 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
           allowAgentConnection conn confId $ XInfo profile
         INFO connInfo ->
           saveConnInfo conn connInfo
-        MSG meta _ ->
+        MSG meta msgBody -> do
+          _ <- saveRcvMSG conn meta msgBody
           withAckMessage agentConnId meta $ pure ()
+          ackMsgDeliveryEvent conn meta
+        SENT msgId ->
+          sentMsgDeliveryEvent conn msgId
         _ -> pure ()
       Just ct@Contact {localDisplayName = c} -> case agentMsg of
-        MSG meta msgBody -> withAckMessage agentConnId meta $ do
-          ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
-          case chatMsgEvent of
-            XMsgNew (MsgContent MTText [] body) -> newTextMessage c meta $ find (isSimplexContentType XCText) body
-            XFile fInv -> processFileInvitation ct meta fInv
-            XInfo p -> xInfo ct p
-            XGrpInv gInv -> processGroupInvitation ct gInv
-            XInfoProbe probe -> xInfoProbe ct probe
-            XInfoProbeCheck probeHash -> xInfoProbeCheck ct probeHash
-            XInfoProbeOk probe -> xInfoProbeOk ct probe
-            _ -> pure ()
+        MSG meta msgBody -> do
+          chatMsgEvent <- saveRcvMSG conn meta msgBody
+          withAckMessage agentConnId meta $
+            case chatMsgEvent of
+              XMsgNew (MsgContent MTText [] body) -> newTextMessage c meta $ find (isSimplexContentType XCText) body
+              XFile fInv -> processFileInvitation ct meta fInv
+              XInfo p -> xInfo ct p
+              XGrpInv gInv -> processGroupInvitation ct gInv
+              XInfoProbe probe -> xInfoProbe ct probe
+              XInfoProbeCheck probeHash -> xInfoProbeCheck ct probeHash
+              XInfoProbeOk probe -> xInfoProbeOk ct probe
+              _ -> pure ()
+          ackMsgDeliveryEvent conn meta
         CONF confId connInfo -> do
           -- confirming direct connection with a member
           ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
@@ -543,7 +583,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
               -- TODO update contact profile
               pure ()
             XOk -> pure ()
-            _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok"
+            _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok"
         CON ->
           withStore (\st -> getViaGroupMember st user ct) >>= \case
             Nothing -> do
@@ -554,6 +594,8 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
               when (memberIsReady m) $ do
                 notifyMemberConnected gName m
                 when (memberCategory m == GCPreMember) $ probeMatchingContacts ct
+        SENT msgId ->
+          sentMsgDeliveryEvent conn msgId
         END -> do
           showContactAnotherClient c
           showToast (c <> "> ") "connected to another client"
@@ -619,7 +661,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
             intros <- withStore $ \st -> createIntroductions st group m
             sendGroupMessage members . XGrpMemNew $ memberInfo m
             forM_ intros $ \intro -> do
-              sendDirectMessage agentConnId . XGrpMemIntro . memberInfo $ reMember intro
+              sendDirectMessage conn . XGrpMemIntro . memberInfo $ reMember intro
               withStore $ \st -> updateIntroStatus st intro GMIntroSent
           _ -> do
             -- TODO send probe and decide whether to use existing contact connection or the new contact connection
@@ -632,20 +674,24 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
                 when (contactIsReady ct) $ do
                   notifyMemberConnected gName m
                   when (memberCategory m == GCPreMember) $ probeMatchingContacts ct
-      MSG meta msgBody -> withAckMessage agentConnId meta $ do
-        ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
-        case chatMsgEvent of
-          XMsgNew (MsgContent MTText [] body) ->
-            newGroupTextMessage gName m meta $ find (isSimplexContentType XCText) body
-          XFile fInv -> processGroupFileInvitation gName m meta fInv
-          XGrpMemNew memInfo -> xGrpMemNew gName m memInfo
-          XGrpMemIntro memInfo -> xGrpMemIntro gName m memInfo
-          XGrpMemInv memId introInv -> xGrpMemInv gName m memId introInv
-          XGrpMemFwd memInfo introInv -> xGrpMemFwd gName m memInfo introInv
-          XGrpMemDel memId -> xGrpMemDel gName m memId
-          XGrpLeave -> xGrpLeave gName m
-          XGrpDel -> xGrpDel gName m
-          _ -> messageError $ "unsupported message: " <> T.pack (show chatMsgEvent)
+      MSG meta msgBody -> do
+        chatMsgEvent <- saveRcvMSG conn meta msgBody
+        withAckMessage agentConnId meta $
+          case chatMsgEvent of
+            XMsgNew (MsgContent MTText [] body) ->
+              newGroupTextMessage gName m meta $ find (isSimplexContentType XCText) body
+            XFile fInv -> processGroupFileInvitation gName m meta fInv
+            XGrpMemNew memInfo -> xGrpMemNew gName m memInfo
+            XGrpMemIntro memInfo -> xGrpMemIntro conn gName m memInfo
+            XGrpMemInv memId introInv -> xGrpMemInv gName m memId introInv
+            XGrpMemFwd memInfo introInv -> xGrpMemFwd gName m memInfo introInv
+            XGrpMemDel memId -> xGrpMemDel gName m memId
+            XGrpLeave -> xGrpLeave gName m
+            XGrpDel -> xGrpDel gName m
+            _ -> messageError $ "unsupported message: " <> T.pack (show chatMsgEvent)
+        ackMsgDeliveryEvent conn meta
+      SENT msgId ->
+        sentMsgDeliveryEvent conn msgId
       _ -> pure ()
 
     processSndFileConn :: ACommand 'Agent -> Connection -> SndFileTransfer -> m ()
@@ -654,6 +700,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
         CONF confId connInfo -> do
           ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
           case chatMsgEvent of
+            -- TODO save XFileAcpt message
             XFileAcpt name
               | name == fileName -> do
                 withStore $ \st -> updateSndFileStatus st ft FSAccepted
@@ -733,6 +780,14 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
     withAckMessage cId MsgMeta {recipient = (msgId, _)} action =
       action `E.finally` withAgent (\a -> ackMessage a cId msgId `catchError` \_ -> pure ())
 
+    ackMsgDeliveryEvent :: Connection -> MsgMeta -> m ()
+    ackMsgDeliveryEvent Connection {connId} MsgMeta {recipient = (msgId, _)} =
+      withStore $ \st -> createRcvMsgDeliveryEvent st connId msgId MDSRcvAcknowledged
+
+    sentMsgDeliveryEvent :: Connection -> AgentMsgId -> m ()
+    sentMsgDeliveryEvent Connection {connId} msgId =
+      withStore $ \st -> createSndMsgDeliveryEvent st connId msgId MDSSndSent
+
     badRcvFileChunk :: RcvFileTransfer -> String -> m ()
     badRcvFileChunk ft@RcvFileTransfer {fileStatus} err =
       case fileStatus of
@@ -751,13 +806,13 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
     probeMatchingContacts ct = do
       gVar <- asks idsDrg
       (probe, probeId) <- withStore $ \st -> createSentProbe st gVar userId ct
-      sendDirectMessage (contactConnId ct) $ XInfoProbe probe
+      sendDirectMessage (contactConn ct) $ XInfoProbe probe
       cs <- withStore (\st -> getMatchingContacts st userId ct)
       let probeHash = C.sha256Hash probe
       forM_ cs $ \c -> sendProbeHash c probeHash probeId `catchError` const (pure ())
       where
         sendProbeHash c probeHash probeId = do
-          sendDirectMessage (contactConnId c) $ XInfoProbeCheck probeHash
+          sendDirectMessage (contactConn c) $ XInfoProbeCheck probeHash
           withStore $ \st -> createSentProbeHash st userId probeId c
 
     messageWarning :: Text -> m ()
@@ -770,7 +825,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
     newTextMessage c meta = \case
       Just MsgContentBody {contentData = bs} -> do
         let text = safeDecodeUtf8 bs
-        showReceivedMessage c (snd $ broker meta) (msgPlain text) (integrity meta)
+        showReceivedMessage c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
         showToast (c <> "> ") text
         setActive $ ActiveC c
       _ -> messageError "x.msg.new: no expected message body"
@@ -779,7 +834,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
     newGroupTextMessage gName GroupMember {localDisplayName = c} meta = \case
       Just MsgContentBody {contentData = bs} -> do
         let text = safeDecodeUtf8 bs
-        showReceivedGroupMessage gName c (snd $ broker meta) (msgPlain text) (integrity meta)
+        showReceivedGroupMessage gName c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
         showToast ("#" <> gName <> " " <> c <> "> ") text
         setActive $ ActiveG gName
       _ -> messageError "x.msg.new: no expected message body"
@@ -789,14 +844,14 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
       -- TODO chunk size has to be sent as part of invitation
       chSize <- asks $ fileChunkSize . config
       ft <- withStore $ \st -> createRcvFileTransfer st userId contact fInv chSize
-      showReceivedMessage c (snd $ broker meta) (receivedFileInvitation ft) (integrity meta)
+      showReceivedMessage c (snd $ broker meta) (receivedFileInvitation ft) (integrity (meta :: MsgMeta))
       setActive $ ActiveC c
 
     processGroupFileInvitation :: GroupName -> GroupMember -> MsgMeta -> FileInvitation -> m ()
     processGroupFileInvitation gName m@GroupMember {localDisplayName = c} meta fInv = do
       chSize <- asks $ fileChunkSize . config
       ft <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize
-      showReceivedGroupMessage gName c (snd $ broker meta) (receivedFileInvitation ft) (integrity meta)
+      showReceivedGroupMessage gName c (snd $ broker meta) (receivedFileInvitation ft) (integrity (meta :: MsgMeta))
       setActive $ ActiveG gName
 
     processGroupInvitation :: Contact -> GroupInvitation -> m ()
@@ -824,7 +879,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
     probeMatch :: Contact -> Contact -> ByteString -> m ()
     probeMatch c1@Contact {profile = p1} c2@Contact {profile = p2} probe =
       when (p1 == p2) $ do
-        sendDirectMessage (contactConnId c1) $ XInfoProbeOk probe
+        sendDirectMessage (contactConn c1) $ XInfoProbeOk probe
         mergeContacts c1 c2
 
     xInfoProbeOk :: Contact -> ByteString -> m ()
@@ -837,9 +892,6 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
       withStore $ \st -> mergeContactRecords st userId to from
       showContactsMerged to from
 
-    parseChatMessage :: ByteString -> Either ChatError ChatMessage
-    parseChatMessage msgBody = first ChatErrorMessage (parseAll rawChatMessageP msgBody >>= toChatMessage)
-
     saveConnInfo :: Connection -> ConnInfo -> m ()
     saveConnInfo activeConn connInfo = do
       ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
@@ -859,8 +911,8 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
             newMember <- withStore $ \st -> createNewGroupMember st user group memInfo GCPostMember GSMemAnnounced
             showJoinedGroupMemberConnecting gName m newMember
 
-    xGrpMemIntro :: GroupName -> GroupMember -> MemberInfo -> m ()
-    xGrpMemIntro gName m memInfo@(MemberInfo memId _ _) =
+    xGrpMemIntro :: Connection -> GroupName -> GroupMember -> MemberInfo -> m ()
+    xGrpMemIntro conn gName m memInfo@(MemberInfo memId _ _) =
       case memberCategory m of
         GCHostMember -> do
           group <- withStore $ \st -> getGroup st user gName
@@ -871,7 +923,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
               (directConnId, directConnReq) <- withAgent (`createConnection` SCMInvitation)
               newMember <- withStore $ \st -> createIntroReMember st user group m memInfo groupConnId directConnId
               let msg = XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq}
-              sendDirectMessage agentConnId msg
+              sendDirectMessage conn msg
               withStore $ \st -> updateGroupMemberStatus st userId newMember GSMemIntroInvited
         _ -> messageError "x.grp.mem.intro can be only sent by host member"
 
@@ -886,8 +938,8 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
               intro <- withStore $ \st -> saveIntroInvitation st reMember m introInv
               case activeConn (reMember :: GroupMember) of
                 Nothing -> pure () -- this is not an error, introduction will be forwarded once the member is connected
-                Just Connection {agentConnId = reAgentConnId} -> do
-                  sendDirectMessage reAgentConnId $ XGrpMemFwd (memberInfo m) introInv
+                Just reConn -> do
+                  sendDirectMessage reConn $ XGrpMemFwd (memberInfo m) introInv
                   withStore $ \st -> updateIntroStatus st intro GMIntroInvForwarded
         _ -> messageError "x.grp.mem.inv can be only sent by invitee member"
 
@@ -942,6 +994,9 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
       mapM_ deleteMemberConnection ms
       showGroupDeleted gName m
 
+parseChatMessage :: ByteString -> Either ChatError ChatMessage
+parseChatMessage msgBody = first ChatErrorMessage (parseAll rawChatMessageP msgBody >>= toChatMessage)
+
 sendFileChunk :: ChatMonad m => SndFileTransfer -> m ()
 sendFileChunk ft@SndFileTransfer {fileId, fileStatus, agentConnId} =
   unless (fileStatus == FSComplete || fileStatus == FSCancelled) $
@@ -1047,22 +1102,42 @@ deleteMemberConnection m@GroupMember {activeConn} = do
   -- withStore $ \st -> deleteGroupMemberConnection st userId m
   forM_ activeConn $ \conn -> withStore $ \st -> updateConnectionStatus st conn ConnDeleted
 
-sendDirectMessage :: ChatMonad m => ConnId -> ChatMsgEvent -> m ()
-sendDirectMessage agentConnId chatMsgEvent =
-  void . withAgent $ \a -> sendMessage a agentConnId $ directMessage chatMsgEvent
+sendDirectMessage :: ChatMonad m => Connection -> ChatMsgEvent -> m ()
+sendDirectMessage conn chatMsgEvent = do
+  let msgBody = directMessage chatMsgEvent
+      newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventType chatMsgEvent, msgBody}
+  -- can be done in transaction after sendMessage, probably shouldn't
+  msgId <- withStore $ \st -> createNewMessage st newMsg
+  deliverMessage conn msgBody msgId
 
 directMessage :: ChatMsgEvent -> ByteString
 directMessage chatMsgEvent =
   serializeRawChatMessage $
     rawChatMessage ChatMessage {chatMsgId = Nothing, chatMsgEvent, chatDAG = Nothing}
 
+deliverMessage :: ChatMonad m => Connection -> MsgBody -> MessageId -> m ()
+deliverMessage Connection {connId, agentConnId} msgBody msgId = do
+  agentMsgId <- withAgent $ \a -> sendMessage a agentConnId msgBody
+  let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId}
+  withStore $ \st -> createSndMsgDelivery st sndMsgDelivery msgId
+
 sendGroupMessage :: ChatMonad m => [GroupMember] -> ChatMsgEvent -> m ()
 sendGroupMessage members chatMsgEvent = do
-  let msg = directMessage chatMsgEvent
+  let msgBody = directMessage chatMsgEvent
+      newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventType chatMsgEvent, msgBody}
+  msgId <- withStore $ \st -> createNewMessage st newMsg
   -- TODO once scheduled delivery is implemented memberActive should be changed to memberCurrent
-  withAgent $ \a ->
-    forM_ (filter memberActive members) $
-      traverse (\connId -> sendMessage a connId msg) . memberConnId
+  forM_ (map memberConn $ filter memberActive members) $
+    traverse (\conn -> deliverMessage conn msgBody msgId)
+
+saveRcvMSG :: ChatMonad m => Connection -> MsgMeta -> MsgBody -> m ChatMsgEvent
+saveRcvMSG Connection {connId} agentMsgMeta msgBody = do
+  ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
+  let newMsg = NewMessage {direction = MDRcv, chatMsgEventType = toChatEventType chatMsgEvent, msgBody}
+      agentMsgId = fst $ recipient agentMsgMeta
+      rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta}
+  withStore $ \st -> createNewMessageAndRcvMsgDelivery st newMsg rcvMsgDelivery
+  pure chatMsgEvent
 
 allowAgentConnection :: ChatMonad m => Connection -> ConfirmationId -> ChatMsgEvent -> m ()
 allowAgentConnection conn@Connection {agentConnId} confId msg = do
@@ -1163,8 +1238,10 @@ chatCommandP =
     <|> ("/leave #" <|> "/leave " <|> "/l #" <|> "/l ") *> (LeaveGroup <$> displayName)
     <|> ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName)
     <|> ("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName)
+    <|> ("/groups" <|> "/gs") $> ListGroups
     <|> A.char '#' *> (SendGroupMessage <$> displayName <* A.space <*> A.takeByteString)
-    <|> ("/connect " <|> "/c ") *> (Connect <$> connReqP)
+    <|> ("/contacts" <|> "/cs") $> ListContacts
+    <|> ("/connect " <|> "/c ") *> (Connect <$> ((Just <$> connReqP) <|> A.takeByteString $> Nothing))
     <|> ("/connect" <|> "/c") $> AddContact
     <|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName)
     <|> A.char '@' *> (SendMessage <$> displayName <*> (A.space *> A.takeByteString))
@@ -1173,12 +1250,15 @@ chatCommandP =
     <|> ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (A.space *> filePath))
     <|> ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal)
     <|> ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal)
+    <|> "/admin_welcome " *> (SendAdminWelcome <$> displayName)
+    <|> "/admin" $> ConnectAdmin
     <|> ("/address" <|> "/ad") $> CreateMyAddress
     <|> ("/delete_address" <|> "/da") $> DeleteMyAddress
     <|> ("/show_address" <|> "/sa") $> ShowMyAddress
     <|> ("/accept @" <|> "/accept " <|> "/ac @" <|> "/ac ") *> (AcceptContact <$> displayName)
     <|> ("/reject @" <|> "/reject " <|> "/rc @" <|> "/rc ") *> (RejectContact <$> displayName)
     <|> ("/markdown" <|> "/m") $> MarkdownHelp
+    <|> ("/welcome" <|> "/w") $> Welcome
     <|> ("/profile " <|> "/p ") *> (UpdateProfile <$> userProfile)
     <|> ("/profile" <|> "/p") $> ShowProfile
     <|> ("/quit" <|> "/q" <|> "/exit") $> QuitChat
@@ -1203,3 +1283,7 @@ chatCommandP =
         <|> (" admin" $> GRAdmin)
         <|> (" member" $> GRMember)
         <|> pure GRAdmin
+
+adminContactReq :: ConnectionRequest 'CMContact
+adminContactReq =
+  either error id $ parseAll connReqP' "https://simplex.chat/contact#/?smp=smp%3A%2F%2Fnxc7HnrnM8dOKgkMp008ub_9o9LXJlxlMrMpR-mfMQw%3D%40smp3.simplex.im%2F-TXnePw5eH5-4L7B%23&e2e=rsa%3AMIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEA6vpcsZggnYL38Qa2G5YU0W5uqnV8WAq_S3flIFU2kx4qW-aokVT8fo0CLJXv9aagdHObFfhc9SXcZPcm4T2NLnafKTgQa_HYFfj764l6cHkbSI-4JBE1gyhtaapsvrDGIdoiGDLgsF3AJVjqs8gavkuTsmw035aWMH-pkpc4qGlEWpNWp1Nn-7O4sdIIQ7yN48jsdCfeIY-BIk3kFR6s4oQOgiOcnir8e3x5tTuRMX1KWSiuzuqLHqgmcI1IqcPJPrBoTQLbXXEMGG1RsvIudxR03jejXXbQvlxXlNNrxwkniEe-P0rApGuCyv2NRMb4n0Wd3ZwewH7X-xtr16XNbQKBgDouGUHD1C55jB-w8W8VJRhFZS2xIYka9gJH1jjCFxHFzgjo69A_sObIamND1pF_JOzj_XCoA1fDICF95XbfS0rq9iS6xvX6M8Muq8QiJsfD5bRt5nh-Y3GK5rAFXS0ZtyOeh07iMLAMJ_EFxBQuKKDRu9_9KAvLL_plU0PuaMH3"

src/Simplex/Chat/Controller.hs

@@ -26,7 +26,7 @@ import System.IO (Handle)
 import UnliftIO.STM
 
 versionNumber :: String
-versionNumber = "0.5.0"
+versionNumber = "0.5.5"
 
 data ChatConfig = ChatConfig
   { agentConfig :: AgentConfig,
@@ -37,6 +37,7 @@ data ChatConfig = ChatConfig
 
 data ChatController = ChatController
   { currentUser :: TVar User,
+    firstTime :: Bool,
     smpAgent :: AgentClient,
     chatTerminal :: ChatTerminal,
     chatStore :: SQLiteStore,

src/Simplex/Chat/Help.hs

@@ -1,7 +1,10 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Chat.Help
-  ( chatHelpInfo,
+  ( chatWelcome,
+    adminWelcomeMessages,
+    chatHelpInfo,
     filesHelpInfo,
     groupsHelpInfo,
     myAddressHelpInfo,
@@ -9,10 +12,13 @@ module Simplex.Chat.Help
   )
 where
 
+import Data.ByteString (ByteString)
 import Data.List (intersperse)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Simplex.Chat.Markdown
 import Simplex.Chat.Styled
+import Simplex.Chat.Types (Onboarding (..), Profile (..), User (..))
 import System.Console.ANSI.Types
 
 highlight :: Text -> Markdown
@@ -27,6 +33,51 @@ indent = "        "
 listHighlight :: [Text] -> Markdown
 listHighlight = mconcat . intersperse ", " . map highlight
 
+chatWelcome :: User -> Onboarding -> [StyledString]
+chatWelcome user Onboarding {contactsCount, createdGroups, membersCount, filesSentCount, addressCount} =
+  map
+    styleMarkdown
+    [ "                             __   __",
+      "  ___ ___ __  __ ___ _    ___" <> "\\ \\ / /" <> " ___ _  _   _ _____",
+      " / __|_ _|  \\/  | _ \\ |  | __ " <> "\\ V /" <> " / __| || | /_\\_   _|",
+      " \\__ \\| || |\\/| |  _/ |__| _|" <> " / . \\" <> "| (__| __ |/ _ \\| |",
+      " |___/___|_|  |_|_| |____|___" <> "/_/ \\_\\" <> "\\___|_||_/_/ \\_\\_|",
+      "",
+      "Welcome " <> green userName <> "!",
+      "Thank you for installing SimpleX Chat!",
+      "",
+      "We have created several groups that you can join to play with SimpleX Chat:",
+      highlight "#simplex" <> " (SimpleX Engineers 💻) - technical questions about running or contributing to SimpleX Chat",
+      highlight "#hacks" <> " (Ethical Hacking 🔓) - chatting about privacy, security, announced vulnerabilities etc.",
+      highlight "#music" <> " (Music 🎸) - favorite music of our team and users",
+      highlight "#rand" <> " (Random 😇) - anything interesting, just keep it decent and friendly please :)",
+      "",
+      "Connect to our groups admin to be added to these groups - " <> highlight "/admin",
+      "",
+      "To continue:",
+      "[" <> check (contactsCount >= 2) <> "] " <> highlight "/connect" <> " with 2 friends - " <> highlight "/help" <> " for instructions",
+      "[" <> check (createdGroups >= 1 && membersCount >= 2) <> "] create a " <> highlight "/group" <> " with them - " <> highlight "/g #friends",
+      "[" <> check (filesSentCount >= 1) <> "] send " <> highlight "/file" <> ", e.g. your photo, to the group - " <> highlight "/f #friends ./photo.jpg",
+      "[" <> check (addressCount >= 1) <> "] create your optional chat " <> highlight "/address" <> " and share it with your friends - " <> highlight "/ad",
+      "",
+      "To help us build SimpleX Chat:",
+      "> star GitHub repo: https://github.com/simplex-chat/simplex-chat",
+      "> join Reddit group: https://www.reddit.com/r/SimpleXChat/",
+      "",
+      "To show this message again - " <> highlight "/welcome" <> " (or " <> highlight "/w" <> ")"
+    ]
+  where
+    User {profile = Profile {displayName, fullName}} = user
+    userName = if T.null fullName then displayName else fullName
+    check c = if c then green "*" else " "
+
+adminWelcomeMessages :: [ByteString]
+adminWelcomeMessages =
+  [ "Hello - and welcome to SimpleX Chat!",
+    "Which community groups you'd like to join:",
+    "!5 #simplex!, !5 #hacks!, !5 #music! or !5 #rand!"
+  ]
+
 chatHelpInfo :: [StyledString]
 chatHelpInfo =
   map
@@ -46,17 +97,19 @@ chatHelpInfo =
       indent <> highlight "@bob Hello, Bob!" <> " - Alice messages Bob (assuming Bob has display name 'bob').",
       indent <> highlight "@alice Hey, Alice!" <> " - Bob replies to Alice.",
       "",
-      green "Send file: " <> highlight "/file bob ./photo.jpg" <> " (see /help files)",
+      green "Send file: " <> highlight "/file bob ./photo.jpg",
       "",
-      green "Create group: " <> highlight "/group team" <> " (see /help groups)",
+      green "Create group: " <> highlight "/group team",
       "",
-      green "Create your address: " <> highlight "/address" <> " (see /help address)",
+      green "Create your address: " <> highlight "/address",
       "",
       green "Other commands:",
+      indent <> highlight "/help <topic>    " <> " - help on: files, groups, address",
       indent <> highlight "/profile         " <> " - show / update user profile",
       indent <> highlight "/delete <contact>" <> " - delete contact and all messages with them",
-      indent <> highlight "/markdown        " <> " - show supported markdown syntax",
-      indent <> highlight "/version         " <> " - show SimpleX Chat version",
+      indent <> highlight "/contacts        " <> " - list contacts",
+      indent <> highlight "/markdown        " <> " - supported markdown syntax",
+      indent <> highlight "/version         " <> " - SimpleX Chat version",
       indent <> highlight "/quit            " <> " - quit chat",
       "",
       "The commands may be abbreviated: " <> listHighlight ["/c", "/f", "/g", "/p", "/ad"] <> ", etc."
@@ -88,9 +141,10 @@ groupsHelpInfo =
       indent <> highlight "/leave <group>                 " <> " - leave group",
       indent <> highlight "/delete <group>                " <> " - delete group",
       indent <> highlight "/members <group>               " <> " - list group members",
+      indent <> highlight "/groups                        " <> " - list groups",
       indent <> highlight "#<group> <message>             " <> " - send message to group",
       "",
-      "The commands may be abbreviated: " <> listHighlight ["/g", "/a", "/j", "/rm", "/l", "/d", "/ms"]
+      "The commands may be abbreviated: " <> listHighlight ["/g", "/a", "/j", "/rm", "/l", "/d", "/ms", "/gs"]
     ]
 
 myAddressHelpInfo :: [StyledString]

src/Simplex/Chat/Notification.hs

@@ -10,10 +10,10 @@ import Control.Monad (void)
 import Data.List (isInfixOf)
 import Data.Map (Map, fromList)
 import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
-import System.Directory (createDirectoryIfMissing, doesFileExist, getAppUserDataDirectory)
+import System.Directory (createDirectoryIfMissing, doesFileExist, findExecutable, getAppUserDataDirectory)
 import System.FilePath (combine)
 import System.Info (os)
 import System.Process (readCreateProcess, shell)
@@ -27,17 +27,25 @@ initializeNotifications =
     "mingw32" -> initWinNotify
     "linux" ->
       doesFileExist "/proc/sys/kernel/osrelease" >>= \case
-        False -> pure $ notify linuxScript
+        False -> initLinuxNotify
         True -> do
           v <- readFile "/proc/sys/kernel/osrelease"
           if "Microsoft" `isInfixOf` v || "WSL" `isInfixOf` v
             then initWslNotify
-            else pure $ notify linuxScript
-    _ -> pure . const $ pure ()
+            else initLinuxNotify
+    _ -> pure noNotifications
+
+noNotifications :: Notification -> IO ()
+noNotifications _ = pure ()
 
 hideException :: (a -> IO ()) -> (a -> IO ())
 hideException f a = f a `catch` \(_ :: SomeException) -> pure ()
 
+initLinuxNotify :: IO (Notification -> IO ())
+initLinuxNotify = do
+  found <- isJust <$> findExecutable "notify-send"
+  pure $ if found then notify linuxScript else noNotifications
+
 notify :: (Notification -> Text) -> Notification -> IO ()
 notify script notification =
   void $ readCreateProcess (shell . T.unpack $ script notification) ""

src/Simplex/Chat/Protocol.hs

@@ -103,6 +103,30 @@ data ChatMessage = ChatMessage
   }
   deriving (Eq, Show)
 
+toChatEventType :: ChatMsgEvent -> Text
+toChatEventType = \case
+  XMsgNew _ -> "x.msg.new"
+  XFile _ -> "x.file"
+  XFileAcpt _ -> "x.file.acpt"
+  XInfo _ -> "x.info"
+  XContact _ _ -> "x.con"
+  XGrpInv _ -> "x.grp.inv"
+  XGrpAcpt _ -> "x.grp.acpt"
+  XGrpMemNew _ -> "x.grp.mem.new"
+  XGrpMemIntro _ -> "x.grp.mem.intro"
+  XGrpMemInv _ _ -> "x.grp.mem.inv"
+  XGrpMemFwd _ _ -> "x.grp.mem.fwd"
+  XGrpMemInfo _ _ -> "x.grp.mem.info"
+  XGrpMemCon _ -> "x.grp.mem.con"
+  XGrpMemConAll _ -> "x.grp.mem.con.all"
+  XGrpMemDel _ -> "x.grp.mem.del"
+  XGrpLeave -> "x.grp.leave"
+  XGrpDel -> "x.grp.del"
+  XInfoProbe _ -> "x.info.probe"
+  XInfoProbeCheck _ -> "x.info.probe.check"
+  XInfoProbeOk _ -> "x.info.probe.ok"
+  XOk -> "x.ok"
+
 toChatMessage :: RawChatMessage -> Either String ChatMessage
 toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody} = do
   (chatDAG, body) <- getDAG <$> mapM toMsgBodyContent chatMsgBody
@@ -161,9 +185,9 @@ toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBod
     ("x.info.probe", [probe]) -> do
       chatMsg . XInfoProbe =<< B64.decode probe
     ("x.info.probe.check", [probeHash]) -> do
-      chatMsg =<< (XInfoProbeCheck <$> B64.decode probeHash)
+      chatMsg . XInfoProbeCheck =<< B64.decode probeHash
     ("x.info.probe.ok", [probe]) -> do
-      chatMsg =<< (XInfoProbeOk <$> B64.decode probe)
+      chatMsg . XInfoProbeOk =<< B64.decode probe
     ("x.ok", []) ->
       chatMsg XOk
     _ -> Left $ "bad syntax or unsupported event " <> B.unpack chatMsgEvent
@@ -216,17 +240,17 @@ rawChatMessage :: ChatMessage -> RawChatMessage
 rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
   case chatMsgEvent of
     XMsgNew MsgContent {messageType = t, files, content} ->
-      rawMsg "x.msg.new" (rawMsgType t : toRawFiles files) content
+      rawMsg (rawMsgType t : toRawFiles files) content
     XFile FileInvitation {fileName, fileSize, fileConnReq} ->
-      rawMsg "x.file" [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeConnReq' fileConnReq] []
+      rawMsg [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeConnReq' fileConnReq] []
     XFileAcpt fileName ->
-      rawMsg "x.file.acpt" [encodeUtf8 $ T.pack fileName] []
+      rawMsg [encodeUtf8 $ T.pack fileName] []
     XInfo profile ->
-      rawMsg "x.info" [] [jsonBody profile]
+      rawMsg [] [jsonBody profile]
     XContact profile Nothing ->
-      rawMsg "x.con" [] [jsonBody profile]
+      rawMsg [] [jsonBody profile]
     XContact profile (Just MsgContent {messageType = t, files, content}) ->
-      rawMsg "x.con" (rawMsgType t : toRawFiles files) (jsonBody profile : content)
+      rawMsg (rawMsgType t : toRawFiles files) (jsonBody profile : content)
     XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) cReq groupProfile) ->
       let params =
             [ B64.encode fromMemId,
@@ -235,17 +259,17 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
               serializeMemberRole role,
               serializeConnReq' cReq
             ]
-       in rawMsg "x.grp.inv" params [jsonBody groupProfile]
+       in rawMsg params [jsonBody groupProfile]
     XGrpAcpt memId ->
-      rawMsg "x.grp.acpt" [B64.encode memId] []
+      rawMsg [B64.encode memId] []
     XGrpMemNew (MemberInfo memId role profile) ->
       let params = [B64.encode memId, serializeMemberRole role]
-       in rawMsg "x.grp.mem.new" params [jsonBody profile]
+       in rawMsg params [jsonBody profile]
     XGrpMemIntro (MemberInfo memId role profile) ->
-      rawMsg "x.grp.mem.intro" [B64.encode memId, serializeMemberRole role] [jsonBody profile]
+      rawMsg [B64.encode memId, serializeMemberRole role] [jsonBody profile]
     XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq} ->
       let params = [B64.encode memId, serializeConnReq' groupConnReq, serializeConnReq' directConnReq]
-       in rawMsg "x.grp.mem.inv" params []
+       in rawMsg params []
     XGrpMemFwd (MemberInfo memId role profile) IntroInvitation {groupConnReq, directConnReq} ->
       let params =
             [ B64.encode memId,
@@ -253,30 +277,31 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
               serializeConnReq' groupConnReq,
               serializeConnReq' directConnReq
             ]
-       in rawMsg "x.grp.mem.fwd" params [jsonBody profile]
+       in rawMsg params [jsonBody profile]
     XGrpMemInfo memId profile ->
-      rawMsg "x.grp.mem.info" [B64.encode memId] [jsonBody profile]
+      rawMsg [B64.encode memId] [jsonBody profile]
     XGrpMemCon memId ->
-      rawMsg "x.grp.mem.con" [B64.encode memId] []
+      rawMsg [B64.encode memId] []
     XGrpMemConAll memId ->
-      rawMsg "x.grp.mem.con.all" [B64.encode memId] []
+      rawMsg [B64.encode memId] []
     XGrpMemDel memId ->
-      rawMsg "x.grp.mem.del" [B64.encode memId] []
+      rawMsg [B64.encode memId] []
     XGrpLeave ->
-      rawMsg "x.grp.leave" [] []
+      rawMsg [] []
     XGrpDel ->
-      rawMsg "x.grp.del" [] []
+      rawMsg [] []
     XInfoProbe probe ->
-      rawMsg "x.info.probe" [B64.encode probe] []
+      rawMsg [B64.encode probe] []
     XInfoProbeCheck probeHash ->
-      rawMsg "x.info.probe.check" [B64.encode probeHash] []
+      rawMsg [B64.encode probeHash] []
     XInfoProbeOk probe ->
-      rawMsg "x.info.probe.ok" [B64.encode probe] []
+      rawMsg [B64.encode probe] []
     XOk ->
-      rawMsg "x.ok" [] []
+      rawMsg [] []
   where
-    rawMsg :: ByteString -> [ByteString] -> [MsgContentBody] -> RawChatMessage
-    rawMsg event chatMsgParams body =
+    rawMsg :: [ByteString] -> [MsgContentBody] -> RawChatMessage
+    rawMsg chatMsgParams body = do
+      let event = encodeUtf8 $ toChatEventType chatMsgEvent
       RawChatMessage {chatMsgId, chatMsgEvent = event, chatMsgParams, chatMsgBody = rawWithDAG body}
     rawContentInfo :: (ContentType, Int) -> (RawContentType, Int)
     rawContentInfo (t, size) = (rawContentType t, size)

src/Simplex/Chat/Store.hs

@@ -17,6 +17,7 @@ module Simplex.Chat.Store
   ( SQLiteStore,
     StoreError (..),
     createStore,
+    chatStoreFile,
     createUser,
     getUsers,
     setActiveUser,
@@ -48,8 +49,10 @@ module Simplex.Chat.Store
     getGroup,
     deleteGroup,
     getUserGroups,
+    getUserGroupDetails,
     getGroupInvitation,
-    createContactGroupMember,
+    createContactMember,
+    getMemberInvitation,
     createMemberConnection,
     updateGroupMemberStatus,
     createNewGroupMember,
@@ -87,6 +90,12 @@ module Simplex.Chat.Store
     deleteRcvFileChunks,
     getFileTransfer,
     getFileTransferProgress,
+    getOnboarding,
+    createNewMessage,
+    createSndMsgDelivery,
+    createNewMessageAndRcvMsgDelivery,
+    createSndMsgDeliveryEvent,
+    createRcvMsgDeliveryEvent,
   )
 where
 
@@ -115,7 +124,7 @@ import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
-import Simplex.Messaging.Agent.Protocol (AParty (..), AgentMsgId, ConnId, InvitationId)
+import Simplex.Messaging.Agent.Protocol (AParty (..), AgentMsgId, ConnId, InvitationId, MsgMeta (..))
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, withTransaction)
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 import qualified Simplex.Messaging.Crypto as C
@@ -135,6 +144,9 @@ migrations =
 createStore :: FilePath -> Int -> IO SQLiteStore
 createStore dbFilePath poolSize = createSQLiteStore dbFilePath poolSize migrations
 
+chatStoreFile :: FilePath -> FilePath
+chatStoreFile = (<> ".chat.db")
+
 checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
 checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)
 
@@ -736,7 +748,6 @@ mergeContactRecords st userId Contact {contactId = toContactId} Contact {contact
     DB.execute db "UPDATE connections SET contact_id = ? WHERE contact_id = ? AND user_id = ?" (toContactId, fromContactId, userId)
     DB.execute db "UPDATE connections SET via_contact = ? WHERE via_contact = ? AND user_id = ?" (toContactId, fromContactId, userId)
     DB.execute db "UPDATE group_members SET invited_by = ? WHERE invited_by = ? AND user_id = ?" (toContactId, fromContactId, userId)
-    DB.execute db "UPDATE messages SET contact_id = ? WHERE contact_id = ?" (toContactId, fromContactId)
     DB.executeNamed
       db
       [sql|
@@ -881,21 +892,31 @@ createNewGroup st gVar user groupProfile =
     membership <- createContactMember_ db user groupId user (memberId, GROwner) GCUserMember GSMemCreator IBUser
     pure $ Right Group {groupId, localDisplayName = displayName, groupProfile, members = [], membership}
 
--- | creates a new group record for the group the current user was invited to
+-- | creates a new group record for the group the current user was invited to, or returns an existing one
 createGroupInvitation ::
   StoreMonad m => SQLiteStore -> User -> Contact -> GroupInvitation -> m Group
-createGroupInvitation st user contact GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} =
+createGroupInvitation st user@User {userId} contact GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} =
   liftIOEither . withTransaction st $ \db -> do
-    let GroupProfile {displayName, fullName} = groupProfile
-        uId = userId user
-    withLocalDisplayName db uId displayName $ \localDisplayName -> do
-      DB.execute db "INSERT INTO group_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
-      profileId <- insertedRowId db
-      DB.execute db "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, connRequest, uId)
-      groupId <- insertedRowId db
-      member <- createContactMember_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown
-      membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact $ contactId contact)
-      pure Group {groupId, localDisplayName, groupProfile, members = [member], membership}
+    getGroupInvitationLdn_ db >>= \case
+      Nothing -> createGroupInvitation_ db
+      -- TODO treat the case that the invitation details could've changed
+      Just localDisplayName -> runExceptT $ fst <$> getGroup_ db user localDisplayName
+  where
+    getGroupInvitationLdn_ :: DB.Connection -> IO (Maybe GroupName)
+    getGroupInvitationLdn_ db =
+      listToMaybe . map fromOnly
+        <$> DB.query db "SELECT local_display_name FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1;" (connRequest, userId)
+    createGroupInvitation_ :: DB.Connection -> IO (Either StoreError Group)
+    createGroupInvitation_ db = do
+      let GroupProfile {displayName, fullName} = groupProfile
+      withLocalDisplayName db userId displayName $ \localDisplayName -> do
+        DB.execute db "INSERT INTO group_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
+        profileId <- insertedRowId db
+        DB.execute db "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, connRequest, userId)
+        groupId <- insertedRowId db
+        member <- createContactMember_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown
+        membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact $ contactId contact)
+        pure Group {groupId, localDisplayName, groupProfile, members = [member], membership}
 
 -- TODO return the last connection that is ready, not any last connection
 -- requires updating connection status
@@ -964,14 +985,29 @@ deleteGroup st User {userId} Group {groupId, members, localDisplayName} =
     forM_ members $ \m -> DB.execute db "DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId m)
     DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId)
     DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
+    -- TODO ? delete group profile
     DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
 
 getUserGroups :: MonadUnliftIO m => SQLiteStore -> User -> m [Group]
-getUserGroups st user =
+getUserGroups st user@User {userId} =
   liftIO . withTransaction st $ \db -> do
-    groupNames <- liftIO $ map fromOnly <$> DB.query db "SELECT local_display_name FROM groups WHERE user_id = ?" (Only $ userId user)
+    groupNames <- map fromOnly <$> DB.query db "SELECT local_display_name FROM groups WHERE user_id = ?" (Only userId)
     map fst . rights <$> mapM (runExceptT . getGroup_ db user) groupNames
 
+getUserGroupDetails :: MonadUnliftIO m => SQLiteStore -> UserId -> m [(GroupName, Text, GroupMemberStatus)]
+getUserGroupDetails st userId =
+  liftIO . withTransaction st $ \db ->
+    DB.query
+      db
+      [sql|
+        SELECT g.local_display_name, p.full_name, m.member_status
+        FROM groups g
+        JOIN group_profiles p USING (group_profile_id)
+        JOIN group_members m USING (group_id)
+        WHERE g.user_id = ? AND m.member_category = 'user'
+      |]
+      (Only userId)
+
 getGroupInvitation :: StoreMonad m => SQLiteStore -> User -> GroupName -> m ReceivedGroupInvitation
 getGroupInvitation st user localDisplayName =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
@@ -995,15 +1031,20 @@ toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, membe
       activeConn = Nothing
    in GroupMember {..}
 
-createContactGroupMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> m GroupMember
-createContactGroupMember st gVar user groupId contact memberRole agentConnId =
+createContactMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> m GroupMember
+createContactMember st gVar user groupId contact memberRole agentConnId connRequest =
   liftIOEither . withTransaction st $ \db ->
     createWithRandomId gVar $ \memId -> do
-      member <- createContactMember_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser
-      groupMemberId <- insertedRowId db
+      member@GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser (Just connRequest)
       void $ createMemberConnection_ db (userId user) groupMemberId agentConnId Nothing 0
       pure member
 
+getMemberInvitation :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Maybe ConnReqInvitation)
+getMemberInvitation st User {userId} groupMemberId =
+  liftIO . withTransaction st $ \db ->
+    join . listToMaybe . map fromOnly
+      <$> DB.query db "SELECT inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?;" (groupMemberId, userId)
+
 createMemberConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> GroupMember -> ConnId -> m ()
 createMemberConnection st userId GroupMember {groupMemberId} agentConnId =
   liftIO . withTransaction st $ \db ->
@@ -1229,7 +1270,11 @@ createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Maybe I
 createMemberConnection_ db userId groupMemberId = createConnection_ db userId ConnMember (Just groupMemberId)
 
 createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
-createContactMember_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy = do
+createContactMember_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy =
+  createContactMemberInv_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy Nothing
+
+createContactMemberInv_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember
+createContactMemberInv_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy connRequest = do
   insertMember_
   groupMemberId <- insertedRowId db
   let memberProfile = profile' userOrContact
@@ -1244,12 +1289,12 @@ createContactMember_ db User {userId, userContactId} groupId userOrContact (memb
         [sql|
           INSERT INTO group_members
             ( group_id, member_id, member_role, member_category, member_status, invited_by,
-              user_id, local_display_name, contact_profile_id, contact_id)
+              user_id, local_display_name, contact_profile_id, contact_id, inv_queue_info)
           VALUES
             (:group_id,:member_id,:member_role,:member_category,:member_status,:invited_by,
              :user_id,:local_display_name,
               (SELECT contact_profile_id FROM contacts WHERE contact_id = :contact_id),
-              :contact_id)
+              :contact_id, :inv_queue_info)
         |]
         [ ":group_id" := groupId,
           ":member_id" := memberId,
@@ -1259,7 +1304,8 @@ createContactMember_ db User {userId, userContactId} groupId userOrContact (memb
           ":invited_by" := fromInvitedBy userContactId invitedBy,
           ":user_id" := userId,
           ":local_display_name" := localDisplayName' userOrContact,
-          ":contact_id" := contactId' userOrContact
+          ":contact_id" := contactId' userOrContact,
+          ":inv_queue_info" := connRequest
         ]
 
 getViaGroupMember :: MonadUnliftIO m => SQLiteStore -> User -> Contact -> m (Maybe (GroupName, GroupMember))
@@ -1579,6 +1625,116 @@ getSndFileTransfers_ db userId fileId =
         Just recipientDisplayName -> Right SndFileTransfer {..}
         Nothing -> Left $ SESndFileInvalid fileId
 
+getOnboarding :: MonadUnliftIO m => SQLiteStore -> UserId -> m Onboarding
+getOnboarding st userId =
+  liftIO . withTransaction st $ \db -> do
+    contactsCount <- intQuery db "SELECT COUNT(contact_id) FROM contacts WHERE user_id = ? AND is_user = 0"
+    createdGroups <- headOrZero <$> DB.query db "SELECT COUNT(g.group_id) FROM groups g JOIN group_members m WHERE g.user_id = ? AND m.member_status = ?" (userId, GSMemCreator)
+    membersCount <- headOrZero <$> DB.query db "SELECT COUNT(group_member_id) FROM group_members WHERE user_id = ? AND (member_status = ? OR member_status = ?)" (userId, GSMemConnected, GSMemComplete)
+    filesSentCount <- intQuery db "SELECT COUNT(s.file_id) FROM snd_files s JOIN files f USING (file_id) WHERE f.user_id = ?"
+    addressCount <- intQuery db "SELECT COUNT(user_contact_link_id) FROM user_contact_links WHERE user_id = ?"
+    pure $ Onboarding {..}
+  where
+    intQuery :: DB.Connection -> DB.Query -> IO Int
+    intQuery db q = headOrZero <$> DB.query db q (Only userId)
+    headOrZero [] = 0
+    headOrZero (n : _) = fromOnly n
+
+createNewMessage :: MonadUnliftIO m => SQLiteStore -> NewMessage -> m MessageId
+createNewMessage st newMsg =
+  liftIO . withTransaction st $ \db ->
+    createNewMessage_ db newMsg
+
+createSndMsgDelivery :: MonadUnliftIO m => SQLiteStore -> SndMsgDelivery -> MessageId -> m ()
+createSndMsgDelivery st sndMsgDelivery messageId =
+  liftIO . withTransaction st $ \db -> do
+    msgDeliveryId <- createSndMsgDelivery_ db sndMsgDelivery messageId
+    createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent
+
+createNewMessageAndRcvMsgDelivery :: MonadUnliftIO m => SQLiteStore -> NewMessage -> RcvMsgDelivery -> m ()
+createNewMessageAndRcvMsgDelivery st newMsg rcvMsgDelivery =
+  liftIO . withTransaction st $ \db -> do
+    messageId <- createNewMessage_ db newMsg
+    msgDeliveryId <- createRcvMsgDelivery_ db rcvMsgDelivery messageId
+    createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent
+
+createSndMsgDeliveryEvent :: StoreMonad m => SQLiteStore -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> m ()
+createSndMsgDeliveryEvent st connId agentMsgId sndMsgDeliveryStatus =
+  liftIOEither . withTransaction st $ \db -> runExceptT $ do
+    msgDeliveryId <- ExceptT $ getMsgDeliveryId_ db connId agentMsgId
+    liftIO $ createMsgDeliveryEvent_ db msgDeliveryId sndMsgDeliveryStatus
+
+createRcvMsgDeliveryEvent :: StoreMonad m => SQLiteStore -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDRcv -> m ()
+createRcvMsgDeliveryEvent st connId agentMsgId rcvMsgDeliveryStatus =
+  liftIOEither . withTransaction st $ \db -> runExceptT $ do
+    msgDeliveryId <- ExceptT $ getMsgDeliveryId_ db connId agentMsgId
+    liftIO $ createMsgDeliveryEvent_ db msgDeliveryId rcvMsgDeliveryStatus
+
+createNewMessage_ :: DB.Connection -> NewMessage -> IO MessageId
+createNewMessage_ db NewMessage {direction, chatMsgEventType, msgBody} = do
+  createdAt <- getCurrentTime
+  DB.execute
+    db
+    [sql|
+      INSERT INTO messages
+        (msg_sent, chat_msg_event, msg_body, created_at) VALUES (?,?,?,?);
+    |]
+    (direction, chatMsgEventType, msgBody, createdAt)
+  insertedRowId db
+
+createSndMsgDelivery_ :: DB.Connection -> SndMsgDelivery -> MessageId -> IO Int64
+createSndMsgDelivery_ db SndMsgDelivery {connId, agentMsgId} messageId = do
+  chatTs <- getCurrentTime
+  DB.execute
+    db
+    [sql|
+      INSERT INTO msg_deliveries
+        (message_id, connection_id, agent_msg_id, agent_msg_meta, chat_ts)
+      VALUES (?,?,?,NULL,?);
+    |]
+    (messageId, connId, agentMsgId, chatTs)
+  insertedRowId db
+
+createRcvMsgDelivery_ :: DB.Connection -> RcvMsgDelivery -> MessageId -> IO Int64
+createRcvMsgDelivery_ db RcvMsgDelivery {connId, agentMsgId, agentMsgMeta} messageId = do
+  DB.execute
+    db
+    [sql|
+      INSERT INTO msg_deliveries
+        (message_id, connection_id, agent_msg_id, agent_msg_meta, chat_ts)
+      VALUES (?,?,?,?,?);
+    |]
+    (messageId, connId, agentMsgId, msgMetaJson agentMsgMeta, snd $ broker agentMsgMeta)
+  insertedRowId db
+
+createMsgDeliveryEvent_ :: DB.Connection -> Int64 -> MsgDeliveryStatus d -> IO ()
+createMsgDeliveryEvent_ db msgDeliveryId msgDeliveryStatus = do
+  createdAt <- getCurrentTime
+  DB.execute
+    db
+    [sql|
+      INSERT INTO msg_delivery_events
+        (msg_delivery_id, delivery_status, created_at) VALUES (?,?,?);
+    |]
+    (msgDeliveryId, msgDeliveryStatus, createdAt)
+
+getMsgDeliveryId_ :: DB.Connection -> Int64 -> AgentMsgId -> IO (Either StoreError Int64)
+getMsgDeliveryId_ db connId agentMsgId =
+  toMsgDeliveryId
+    <$> DB.query
+      db
+      [sql|
+        SELECT msg_delivery_id
+        FROM msg_deliveries m
+        WHERE m.connection_id = ? AND m.agent_msg_id == ?
+        LIMIT 1;
+      |]
+      (connId, agentMsgId)
+  where
+    toMsgDeliveryId :: [Only Int64] -> Either StoreError Int64
+    toMsgDeliveryId [Only msgDeliveryId] = Right msgDeliveryId
+    toMsgDeliveryId _ = Left $ SENoMsgDelivery connId agentMsgId
+
 -- | Saves unique local display name based on passed displayName, suffixed with _N if required.
 -- This function should be called inside transaction.
 withLocalDisplayName :: forall a. DB.Connection -> UserId -> Text -> (Text -> IO a) -> IO (Either StoreError a)
@@ -1655,4 +1811,5 @@ data StoreError
   | SEIntroNotFound
   | SEUniqueID
   | SEInternal ByteString
+  | SENoMsgDelivery Int64 AgentMsgId
   deriving (Show, Exception)

src/Simplex/Chat/Types.hs

@@ -1,19 +1,27 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Chat.Types where
 
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
 import Data.Text (Text)
+import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime)
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 import Database.SQLite.Simple (ResultError (..), SQLData (..))
 import Database.SQLite.Simple.FromField (FieldParser, FromField (..), returnError)
@@ -21,8 +29,9 @@ import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics
-import Simplex.Messaging.Agent.Protocol (ConnId, ConnectionMode (..), ConnectionRequest, InvitationId)
+import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, ConnectionMode (..), ConnectionRequest, InvitationId, MsgMeta (..), serializeMsgIntegrity)
 import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
+import Simplex.Messaging.Protocol (MsgBody)
 
 class IsContact a where
   contactId' :: a -> Int64
@@ -58,6 +67,9 @@ data Contact = Contact
   }
   deriving (Eq, Show)
 
+contactConn :: Contact -> Connection
+contactConn = activeConn
+
 contactConnId :: Contact -> ConnId
 contactConnId Contact {activeConn = Connection {agentConnId}} = agentConnId
 
@@ -153,6 +165,9 @@ data GroupMember = GroupMember
   }
   deriving (Eq, Show)
 
+memberConn :: GroupMember -> Maybe Connection
+memberConn = activeConn
+
 memberConnId :: GroupMember -> Maybe ConnId
 memberConnId GroupMember {activeConn} = case activeConn of
   Just Connection {agentConnId} -> Just agentConnId
@@ -518,3 +533,133 @@ serializeIntroStatus = \case
   GMIntroReConnected -> "re-con"
   GMIntroToConnected -> "to-con"
   GMIntroConnected -> "con"
+
+data Onboarding = Onboarding
+  { contactsCount :: Int,
+    createdGroups :: Int,
+    membersCount :: Int,
+    filesSentCount :: Int,
+    addressCount :: Int
+  }
+
+data NewMessage = NewMessage
+  { direction :: MsgDirection,
+    chatMsgEventType :: Text,
+    msgBody :: MsgBody
+  }
+
+type MessageId = Int64
+
+data MsgDirection = MDRcv | MDSnd
+
+data SMsgDirection (d :: MsgDirection) where
+  SMDRcv :: SMsgDirection 'MDRcv
+  SMDSnd :: SMsgDirection 'MDSnd
+
+instance TestEquality SMsgDirection where
+  testEquality SMDRcv SMDRcv = Just Refl
+  testEquality SMDSnd SMDSnd = Just Refl
+  testEquality _ _ = Nothing
+
+class MsgDirectionI (d :: MsgDirection) where
+  msgDirection :: SMsgDirection d
+
+instance MsgDirectionI 'MDRcv where msgDirection = SMDRcv
+
+instance MsgDirectionI 'MDSnd where msgDirection = SMDSnd
+
+instance ToField MsgDirection where toField = toField . msgDirectionInt
+
+msgDirectionInt :: MsgDirection -> Int
+msgDirectionInt = \case
+  MDRcv -> 0
+  MDSnd -> 1
+
+msgDirectionIntP :: Int -> Maybe MsgDirection
+msgDirectionIntP = \case
+  0 -> Just MDRcv
+  1 -> Just MDSnd
+  _ -> Nothing
+
+data SndMsgDelivery = SndMsgDelivery
+  { connId :: Int64,
+    agentMsgId :: AgentMsgId
+  }
+
+data RcvMsgDelivery = RcvMsgDelivery
+  { connId :: Int64,
+    agentMsgId :: AgentMsgId,
+    agentMsgMeta :: MsgMeta
+  }
+
+data MsgMetaJ = MsgMetaJ
+  { integrity :: Text,
+    rcvId :: Int64,
+    rcvTs :: UTCTime,
+    serverId :: Text,
+    serverTs :: UTCTime,
+    sndId :: Int64
+  }
+  deriving (Generic, Eq, Show)
+
+instance ToJSON MsgMetaJ where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance FromJSON MsgMetaJ
+
+msgMetaToJson :: MsgMeta -> MsgMetaJ
+msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId, serverTs), sender = (sndId, _)} =
+  MsgMetaJ
+    { integrity = (decodeLatin1 . serializeMsgIntegrity) integrity,
+      rcvId,
+      rcvTs,
+      serverId = (decodeLatin1 . B64.encode) serverId,
+      serverTs,
+      sndId
+    }
+
+msgMetaJson :: MsgMeta -> Text
+msgMetaJson = decodeLatin1 . LB.toStrict . J.encode . msgMetaToJson
+
+data MsgDeliveryStatus (d :: MsgDirection) where
+  MDSRcvAgent :: MsgDeliveryStatus 'MDRcv
+  MDSRcvAcknowledged :: MsgDeliveryStatus 'MDRcv
+  MDSSndPending :: MsgDeliveryStatus 'MDSnd
+  MDSSndAgent :: MsgDeliveryStatus 'MDSnd
+  MDSSndSent :: MsgDeliveryStatus 'MDSnd
+  MDSSndReceived :: MsgDeliveryStatus 'MDSnd
+  MDSSndRead :: MsgDeliveryStatus 'MDSnd
+
+data AMsgDeliveryStatus = forall d. AMDS (SMsgDirection d) (MsgDeliveryStatus d)
+
+instance (Typeable d, MsgDirectionI d) => FromField (MsgDeliveryStatus d) where
+  fromField = fromTextField_ msgDeliveryStatusT'
+
+instance ToField (MsgDeliveryStatus d) where toField = toField . serializeMsgDeliveryStatus
+
+serializeMsgDeliveryStatus :: MsgDeliveryStatus d -> Text
+serializeMsgDeliveryStatus = \case
+  MDSRcvAgent -> "rcv_agent"
+  MDSRcvAcknowledged -> "rcv_acknowledged"
+  MDSSndPending -> "snd_pending"
+  MDSSndAgent -> "snd_agent"
+  MDSSndSent -> "snd_sent"
+  MDSSndReceived -> "snd_received"
+  MDSSndRead -> "snd_read"
+
+msgDeliveryStatusT :: Text -> Maybe AMsgDeliveryStatus
+msgDeliveryStatusT = \case
+  "rcv_agent" -> Just $ AMDS SMDRcv MDSRcvAgent
+  "rcv_acknowledged" -> Just $ AMDS SMDRcv MDSRcvAcknowledged
+  "snd_pending" -> Just $ AMDS SMDSnd MDSSndPending
+  "snd_agent" -> Just $ AMDS SMDSnd MDSSndAgent
+  "snd_sent" -> Just $ AMDS SMDSnd MDSSndSent
+  "snd_received" -> Just $ AMDS SMDSnd MDSSndReceived
+  "snd_read" -> Just $ AMDS SMDSnd MDSSndRead
+  _ -> Nothing
+
+msgDeliveryStatusT' :: forall d. MsgDirectionI d => Text -> Maybe (MsgDeliveryStatus d)
+msgDeliveryStatusT' s =
+  msgDeliveryStatusT s >>= \(AMDS d st) ->
+    case testEquality d (msgDirection @d) of
+      Just Refl -> Just st
+      _ -> Nothing

src/Simplex/Chat/Util.hs

@@ -1,5 +1,6 @@
 module Simplex.Chat.Util where
 
+import Control.Monad (when)
 import Data.ByteString.Char8 (ByteString)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8With)
@@ -12,5 +13,8 @@ safeDecodeUtf8 = decodeUtf8With onError
 ifM :: Monad m => m Bool -> m a -> m a -> m a
 ifM ba t f = ba >>= \b -> if b then t else f
 
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM ba a = ba >>= (`when` a)
+
 unlessM :: Monad m => m Bool -> m () -> m ()
 unlessM b = ifM b $ pure ()

src/Simplex/Chat/View.hs

@@ -8,9 +8,13 @@
 module Simplex.Chat.View
   ( printToView,
     showInvitation,
+    showSentConfirmation,
+    showSentInvitation,
+    showInvalidConnReq,
     showChatError,
     showContactDeleted,
     showContactGroups,
+    showContactsList,
     showContactConnected,
     showContactDisconnected,
     showContactAnotherClient,
@@ -27,6 +31,7 @@ module Simplex.Chat.View
     showGroupSubscribed,
     showGroupEmpty,
     showGroupRemoved,
+    showGroupInvitation,
     showMemberSubError,
     showReceivedMessage,
     showReceivedGroupMessage,
@@ -53,6 +58,7 @@ module Simplex.Chat.View
     showGroupDeletedUser,
     showGroupDeleted,
     showSentGroupInvitation,
+    showCannotResendInvitation,
     showReceivedGroupInvitation,
     showJoinedGroupMember,
     showUserJoinedGroup,
@@ -63,6 +69,7 @@ module Simplex.Chat.View
     showLeftMemberUser,
     showLeftMember,
     showGroupMembers,
+    showGroupsList,
     showContactsMerged,
     showUserProfile,
     showUserProfileUpdated,
@@ -80,7 +87,7 @@ import Data.ByteString.Char8 (ByteString)
 import Data.Composition ((.:), (.:.))
 import Data.Function (on)
 import Data.Int (Int64)
-import Data.List (groupBy, intersperse, sortOn)
+import Data.List (groupBy, intersperse, sort, sortOn)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (DiffTime, UTCTime)
@@ -103,6 +110,21 @@ type ChatReader m = (MonadUnliftIO m, MonadReader ChatController m)
 showInvitation :: ChatReader m => ConnReqInvitation -> m ()
 showInvitation = printToView . connReqInvitation_
 
+showSentConfirmation :: ChatReader m => m ()
+showSentConfirmation = printToView ["confirmation sent!"]
+
+showSentInvitation :: ChatReader m => m ()
+showSentInvitation = printToView ["connection request sent!"]
+
+showInvalidConnReq :: ChatReader m => m ()
+showInvalidConnReq =
+  printToView
+    [ "Connection link is invalid!",
+      "Possibly, it was created in a newer version (to check version: " <> highlight' "/v" <> ")",
+      "To upgrade (Linux/Mac):",
+      "curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/install.sh | bash"
+    ]
+
 showChatError :: ChatReader m => ChatError -> m ()
 showChatError = printToView . chatError
 
@@ -112,6 +134,9 @@ showContactDeleted = printToView . contactDeleted
 showContactGroups :: ChatReader m => ContactName -> [GroupName] -> m ()
 showContactGroups = printToView .: contactGroups
 
+showContactsList :: ChatReader m => [Contact] -> m ()
+showContactsList = printToView . contactsList
+
 showContactConnected :: ChatReader m => Contact -> m ()
 showContactConnected = printToView . contactConnected
 
@@ -151,15 +176,19 @@ showUserContactLinkSubscribed = printToView ["Your address is active! To show: "
 showUserContactLinkSubError :: ChatReader m => ChatError -> m ()
 showUserContactLinkSubError = printToView . userContactLinkSubError
 
-showGroupSubscribed :: ChatReader m => GroupName -> m ()
+showGroupSubscribed :: ChatReader m => Group -> m ()
 showGroupSubscribed = printToView . groupSubscribed
 
-showGroupEmpty :: ChatReader m => GroupName -> m ()
+showGroupEmpty :: ChatReader m => Group -> m ()
 showGroupEmpty = printToView . groupEmpty
 
-showGroupRemoved :: ChatReader m => GroupName -> m ()
+showGroupRemoved :: ChatReader m => Group -> m ()
 showGroupRemoved = printToView . groupRemoved
 
+showGroupInvitation :: ChatReader m => Group -> m ()
+showGroupInvitation Group {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} =
+  printToView [groupInvitation ldn fullName]
+
 showMemberSubError :: ChatReader m => GroupName -> ContactName -> ChatError -> m ()
 showMemberSubError = printToView .:. memberSubError
 
@@ -244,6 +273,9 @@ showGroupDeleted = printToView .: groupDeleted
 showSentGroupInvitation :: ChatReader m => GroupName -> ContactName -> m ()
 showSentGroupInvitation = printToView .: sentGroupInvitation
 
+showCannotResendInvitation :: ChatReader m => GroupName -> ContactName -> m ()
+showCannotResendInvitation = printToView .: cannotResendInvitation
+
 showReceivedGroupInvitation :: ChatReader m => Group -> ContactName -> GroupMemberRole -> m ()
 showReceivedGroupInvitation = printToView .:. receivedGroupInvitation
 
@@ -274,6 +306,9 @@ showLeftMember = printToView .: leftMember
 showGroupMembers :: ChatReader m => Group -> m ()
 showGroupMembers = printToView . groupMembers
 
+showGroupsList :: ChatReader m => [(GroupName, Text, GroupMemberStatus)] -> m ()
+showGroupsList = printToView . groupsList
+
 showContactsMerged :: ChatReader m => Contact -> Contact -> m ()
 showContactsMerged = printToView .: contactsMerged
 
@@ -309,6 +344,11 @@ contactGroups c gNames = [ttyContact c <> ": contact cannot be deleted, it is a
     ttyGroups [g] = ttyGroup g
     ttyGroups (g : gs) = ttyGroup g <> ", " <> ttyGroups gs
 
+contactsList :: [Contact] -> [StyledString]
+contactsList =
+  let ldn = T.toLower . (localDisplayName :: Contact -> ContactName)
+   in map ttyFullContact . sortOn ldn
+
 contactConnected :: Contact -> [StyledString]
 contactConnected ct = [ttyFullContact ct <> ": contact is connected"]
 
@@ -366,14 +406,14 @@ userContactLinkSubError e =
     "to delete your address: " <> highlight' "/da"
   ]
 
-groupSubscribed :: GroupName -> [StyledString]
-groupSubscribed g = [ttyGroup g <> ": connected to server(s)"]
+groupSubscribed :: Group -> [StyledString]
+groupSubscribed g = [ttyFullGroup g <> ": connected to server(s)"]
 
-groupEmpty :: GroupName -> [StyledString]
-groupEmpty g = [ttyGroup g <> ": group is empty"]
+groupEmpty :: Group -> [StyledString]
+groupEmpty g = [ttyFullGroup g <> ": group is empty"]
 
-groupRemoved :: GroupName -> [StyledString]
-groupRemoved g = [ttyGroup g <> ": you are no longer a member or group deleted"]
+groupRemoved :: Group -> [StyledString]
+groupRemoved g = [ttyFullGroup g <> ": you are no longer a member or group deleted"]
 
 memberSubError :: GroupName -> ContactName -> ChatError -> [StyledString]
 memberSubError g c e = [ttyGroup g <> " member " <> ttyContact c <> " error: " <> sShow e]
@@ -396,6 +436,12 @@ groupDeleted_ g m = [ttyGroup g <> ": " <> memberOrUser m <> " deleted the group
 sentGroupInvitation :: GroupName -> ContactName -> [StyledString]
 sentGroupInvitation g c = ["invitation to join the group " <> ttyGroup g <> " sent to " <> ttyContact c]
 
+cannotResendInvitation :: GroupName -> ContactName -> [StyledString]
+cannotResendInvitation g c =
+  [ ttyContact c <> " is already invited to group " <> ttyGroup g,
+    "to re-send invitation: " <> highlight ("/rm " <> g <> " " <> c) <> ", " <> highlight ("/a " <> g <> " " <> c)
+  ]
+
 receivedGroupInvitation :: Group -> ContactName -> GroupMemberRole -> [StyledString]
 receivedGroupInvitation g@Group {localDisplayName} c role =
   [ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (serializeMemberRole role),
@@ -461,6 +507,23 @@ groupMembers Group {membership, members} = map groupMember . filter (not . remov
       GSMemCreator -> "created group"
       _ -> ""
 
+groupsList :: [(GroupName, Text, GroupMemberStatus)] -> [StyledString]
+groupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
+groupsList gs = map groupSS $ sort gs
+  where
+    groupSS (displayName, fullName, GSMemInvited) = groupInvitation displayName fullName
+    groupSS (displayName, fullName, _) = ttyGroup displayName <> optFullName displayName fullName
+
+groupInvitation :: GroupName -> Text -> StyledString
+groupInvitation displayName fullName =
+  highlight ("#" <> displayName)
+    <> optFullName displayName fullName
+    <> " - you are invited ("
+    <> highlight ("/j " <> displayName)
+    <> " to join, "
+    <> highlight ("/d #" <> displayName)
+    <> " to delete invitation)"
+
 contactsMerged :: Contact -> Contact -> [StyledString]
 contactsMerged _to@Contact {localDisplayName = c1} _from@Contact {localDisplayName = c2} =
   [ "contact " <> ttyContact c2 <> " is merged into " <> ttyContact c1,
@@ -679,7 +742,7 @@ chatError = \case
     CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"]
     CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> g)]
     CEGroupMemberNotActive -> ["you cannot invite other members yet, try later"]
-    CEGroupMemberUserRemoved -> ["you are no longer the member of the group"]
+    CEGroupMemberUserRemoved -> ["you are no longer a member of the group"]
     CEGroupMemberNotFound c -> ["contact " <> ttyContact c <> " is not a group member"]
     CEGroupInternal s -> ["chat group bug: " <> plain s]
     CEFileNotFound f -> ["file not found: " <> plain f]

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-17.12
+resolver: lts-18.21
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -36,11 +36,9 @@ packages:
 #
 extra-deps:
   - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
-  - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718
   - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
-  - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
   - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
-  - simplexmq-0.5.0@sha256:3d9b84d986df7409839c19455a376722837d52a646cb5d136037cadd0b5a4b76,7828
+  - simplexmq-0.5.2@sha256:3544e479f353c1bbc6aa9405ef6976b78364f437d8af9cc45b9e0b228429e240,7884
   # - ../simplexmq
   # - github: simplex-chat/simplexmq
   #   commit: f15067cf6891bda3216c6cf6d2e3ecdba9b7269e

tests/ChatClient.hs

@@ -33,13 +33,13 @@ testDBPrefix :: FilePath
 testDBPrefix = "tests/tmp/test"
 
 serverPort :: ServiceName
-serverPort = "5000"
+serverPort = "5001"
 
 opts :: ChatOpts
 opts =
   ChatOpts
     { dbFile = undefined,
-      smpServers = ["localhost:5000"]
+      smpServers = ["localhost:5001"]
     }
 
 termSettings :: VirtualTerminalSettings
@@ -145,6 +145,7 @@ serverCfg =
   ServerConfig
     { transports = [(serverPort, transport @TCP)],
       tbqSize = 1,
+      serverTbqSize = 1,
       msgQueueQuota = 4,
       queueIdBytes = 12,
       msgIdBytes = 6,

tests/ChatTests.hs

@@ -37,7 +37,10 @@ chatTests = do
     it "add contacts, create group and send/receive messages" testGroup
     it "create and join group with 4 members" testGroup2
     it "create and delete group" testGroupDelete
+    it "invitee delete group when in status invited" testGroupDeleteWhenInvited
+    it "re-add member in status invited" testGroupReAddInvited
     it "remove contact from group and add again" testGroupRemoveAdd
+    it "list groups containing group invitations" testGroupList
   describe "user profiles" $
     it "update user profiles and notify contacts" testUpdateProfile
   describe "sending and receiving files" $ do
@@ -58,6 +61,7 @@ testAddContact =
       alice ##> "/c"
       inv <- getInvitation alice
       bob ##> ("/c " <> inv)
+      bob <## "confirmation sent!"
       concurrently_
         (bob <## "alice (Alice): contact is connected")
         (alice <## "bob (Bob): contact is connected")
@@ -69,6 +73,7 @@ testAddContact =
       alice ##> "/c"
       inv' <- getInvitation alice
       bob ##> ("/c " <> inv')
+      bob <## "confirmation sent!"
       concurrently_
         (bob <## "alice_1 (Alice): contact is connected")
         (alice <## "bob_1 (Bob): contact is connected")
@@ -132,6 +137,20 @@ testGroup =
         (alice <# "#team cath> hey")
         (bob <# "#team cath> hey")
       bob <##> cath
+      -- list groups
+      alice ##> "/gs"
+      alice <## "#team"
+      -- list group members
+      alice ##> "/ms team"
+      alice
+        <### [ "alice (Alice): owner, you, created group",
+               "bob (Bob): admin, invited, connected",
+               "cath (Catherine): admin, invited, connected"
+             ]
+      -- list contacts
+      alice ##> "/cs"
+      alice <## "bob (Bob)"
+      alice <## "cath (Catherine)"
       -- remove member
       bob ##> "/rm team cath"
       concurrentlyN_
@@ -150,7 +169,7 @@ testGroup =
         (bob <# "#team alice> hello")
         (cath </)
       cath #> "#team hello"
-      cath <## "you are no longer the member of the group"
+      cath <## "you are no longer a member of the group"
       bob <##> cath
 
 testGroup2 :: IO ()
@@ -275,7 +294,7 @@ testGroup2 =
           (dan </)
         ]
       dan #> "#club how is it going?"
-      dan <## "you are no longer the member of the group"
+      dan <## "you are no longer a member of the group"
       dan <##> cath
       dan <##> alice
       -- member leaves
@@ -296,7 +315,7 @@ testGroup2 =
         (alice <# "#club cath> hey")
         (bob </)
       bob #> "#club how is it going?"
-      bob <## "you are no longer the member of the group"
+      bob <## "you are no longer a member of the group"
       bob <##> cath
       bob <##> alice
 
@@ -318,7 +337,69 @@ testGroupDelete =
       bob ##> "/d #team"
       bob <## "#team: you deleted the group"
       cath #> "#team hi"
-      cath <## "you are no longer the member of the group"
+      cath <## "you are no longer a member of the group"
+
+testGroupDeleteWhenInvited :: IO ()
+testGroupDeleteWhenInvited =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      connectUsers alice bob
+      alice ##> "/g team"
+      alice <## "group #team is created"
+      alice <## "use /a team <name> to add members"
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team: alice invites you to join the group as admin"
+            bob <## "use /j team to accept"
+        ]
+      bob ##> "/d #team"
+      bob <## "#team: you deleted the group"
+      -- alice doesn't receive notification that bob deleted group,
+      -- but she can re-add bob
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team: alice invites you to join the group as admin"
+            bob <## "use /j team to accept"
+        ]
+
+testGroupReAddInvited :: IO ()
+testGroupReAddInvited =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      connectUsers alice bob
+      alice ##> "/g team"
+      alice <## "group #team is created"
+      alice <## "use /a team <name> to add members"
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team: alice invites you to join the group as admin"
+            bob <## "use /j team to accept"
+        ]
+      -- alice re-adds bob, he sees it as the same group
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team: alice invites you to join the group as admin"
+            bob <## "use /j team to accept"
+        ]
+      -- if alice removes bob and then re-adds him, she uses a new connection request
+      -- and he sees it as a new group with a different local display name
+      alice ##> "/rm team bob"
+      alice <## "#team: you removed bob from the group"
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team_1 (team): alice invites you to join the group as admin"
+            bob <## "use /j team_1 to accept"
+        ]
 
 testGroupRemoveAdd :: IO ()
 testGroupRemoveAdd =
@@ -365,6 +446,36 @@ testGroupRemoveAdd =
         (alice <# "#team cath> hello")
         (bob <# "#team_1 cath> hello")
 
+testGroupList :: IO ()
+testGroupList =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      createGroup2 "team" alice bob
+      alice ##> "/g tennis"
+      alice <## "group #tennis is created"
+      alice <## "use /a tennis <name> to add members"
+      alice ##> "/a tennis bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #tennis sent to bob",
+          do
+            bob <## "#tennis: alice invites you to join the group as admin"
+            bob <## "use /j tennis to accept"
+        ]
+      -- alice sees both groups
+      alice ##> "/gs"
+      alice <### ["#team", "#tennis"]
+      -- bob sees #tennis as invitation
+      bob ##> "/gs"
+      bob
+        <### [ "#team",
+               "#tennis - you are invited (/j tennis to join, /d #tennis to delete invitation)"
+             ]
+      -- after deleting invitation bob sees only one group
+      bob ##> "/d #tennis"
+      bob <## "#tennis: you deleted the group"
+      bob ##> "/gs"
+      bob <## "#team"
+
 testUpdateProfile :: IO ()
 testUpdateProfile =
   testChat3 aliceProfile bobProfile cathProfile $
@@ -627,6 +738,7 @@ connectUsers cc1 cc2 = do
   cc1 ##> "/c"
   inv <- getInvitation cc1
   cc2 ##> ("/c " <> inv)
+  cc2 <## "confirmation sent!"
   concurrently_
     (cc2 <## (name1 <> ": contact is connected"))
     (cc1 <## (name2 <> ": contact is connected"))
@@ -636,23 +748,27 @@ showName (TestCC ChatController {currentUser} _ _ _ _) = do
   User {localDisplayName, profile = Profile {fullName}} <- readTVarIO currentUser
   pure . T.unpack $ localDisplayName <> " (" <> fullName <> ")"
 
-createGroup3 :: String -> TestCC -> TestCC -> TestCC -> IO ()
-createGroup3 gName cc1 cc2 cc3 = do
+createGroup2 :: String -> TestCC -> TestCC -> IO ()
+createGroup2 gName cc1 cc2 = do
   connectUsers cc1 cc2
-  connectUsers cc1 cc3
   name2 <- userName cc2
-  name3 <- userName cc3
-  sName2 <- showName cc2
-  sName3 <- showName cc3
   cc1 ##> ("/g " <> gName)
   cc1 <## ("group #" <> gName <> " is created")
   cc1 <## ("use /a " <> gName <> " <name> to add members")
-  addMember cc2
+  addMember gName cc1 cc2
   cc2 ##> ("/j " <> gName)
   concurrently_
     (cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group"))
     (cc2 <## ("#" <> gName <> ": you joined the group"))
-  addMember cc3
+
+createGroup3 :: String -> TestCC -> TestCC -> TestCC -> IO ()
+createGroup3 gName cc1 cc2 cc3 = do
+  createGroup2 gName cc1 cc2
+  connectUsers cc1 cc3
+  name3 <- userName cc3
+  sName2 <- showName cc2
+  sName3 <- showName cc3
+  addMember gName cc1 cc3
   cc3 ##> ("/j " <> gName)
   concurrentlyN_
     [ cc1 <## ("#" <> gName <> ": " <> name3 <> " joined the group"),
@@ -663,18 +779,18 @@ createGroup3 gName cc1 cc2 cc3 = do
         cc2 <## ("#" <> gName <> ": alice added " <> sName3 <> " to the group (connecting...)")
         cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected")
     ]
-  where
-    addMember :: TestCC -> IO ()
-    addMember mem = do
-      name1 <- userName cc1
-      memName <- userName mem
-      cc1 ##> ("/a " <> gName <> " " <> memName)
-      concurrentlyN_
-        [ cc1 <## ("invitation to join the group #" <> gName <> " sent to " <> memName),
-          do
-            mem <## ("#" <> gName <> ": " <> name1 <> " invites you to join the group as admin")
-            mem <## ("use /j " <> gName <> " to accept")
-        ]
+
+addMember :: String -> TestCC -> TestCC -> IO ()
+addMember gName inviting invitee = do
+  name1 <- userName inviting
+  memName <- userName invitee
+  inviting ##> ("/a " <> gName <> " " <> memName)
+  concurrentlyN_
+    [ inviting <## ("invitation to join the group #" <> gName <> " sent to " <> memName),
+      do
+        invitee <## ("#" <> gName <> ": " <> name1 <> " invites you to join the group as admin")
+        invitee <## ("use /j " <> gName <> " to accept")
+    ]
 
 -- | test sending direct messages
 (<##>) :: TestCC -> TestCC -> IO ()
@@ -723,6 +839,7 @@ cc <# line = (dropTime <$> getTermLine cc) `shouldReturn` line
 cc1 <#? cc2 = do
   name <- userName cc2
   sName <- showName cc2
+  cc2 <## "connection request sent!"
   cc1 <## (sName <> " wants to connect to you!")
   cc1 <## ("to accept: /ac " <> name)
   cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)")