1.0.1

* use forked terminal with CapiFFI (fails to compile)

* update terminal package git tag

* add terminal fork to stack.yaml

.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'
 

.github/workflows/cla.yml

@@ -0,0 +1,36 @@
+name: "CLA Assistant"
+on:
+  issue_comment:
+    types: [created]
+  pull_request_target:
+    types: [opened, closed, synchronize]
+
+jobs:
+  CLAssistant:
+    runs-on: ubuntu-latest
+    steps:
+      - name: "CLA Assistant"
+        if: (github.event.comment.body == 'recheck' || github.event.comment.body == 'I have read the CLA Document and I hereby sign the CLA') || github.event_name == 'pull_request'
+        # Beta Release
+        uses: cla-assistant/github-action@v2.1.3-beta
+        env:
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+          # the below token should have repo scope and must be manually added by you in the repository's secret
+          PERSONAL_ACCESS_TOKEN : ${{ secrets.PERSONAL_ACCESS_TOKEN }}
+        with:
+          path-to-signatures: 'signatures/v1.1/cla.json'
+          path-to-document: 'https://github.com/simplex-chat/cla/blob/master/CLA.md'
+          # branch should not be protected
+          remote-organization-name: simplex-chat
+          remote-repository-name: cla
+          branch: 'master'
+          # allowlist: user1,bot*
+
+         #below are the optional inputs - If the optional inputs are not given, then default values will be taken
+          #create-file-commit-message: 'For example: Creating file for storing CLA Signatures'
+          #signed-commit-message: 'For example: $contributorName has signed the CLA in #$pullRequestNo'
+          #custom-notsigned-prcomment: 'pull request comment with Introductory message to ask new contributors to sign'
+          #custom-pr-sign-comment: 'The signature to be committed in order to sign the CLA'
+          #custom-allsigned-prcomment: 'pull request comment when all contributors has signed, defaults to **CLA Assistant Lite bot** All Contributors have signed the CLA.'
+          #lock-pullrequest-aftermerge: false - if you don't want this bot to automatically lock the pull request after merging (default - true)
+          #use-dco-flag: true - If you are using DCO instead of CLA

.gitignore

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

README.md

@@ -1,19 +1,28 @@
-<img align="right" src="images/logo.svg" alt="SimpleX logo" height="90">
+<img src="images/simplex-chat-logo.svg" alt="SimpleX logo" width="100%">
 
-# SimpleX chat
+# SimpleX Chat
 
-## Private, secure, decentralized
+SimpleX - the most private and secure open-source chat and applications platform - now with double-ratchet E2E encryption.
 
 [![GitHub build](https://github.com/simplex-chat/simplex-chat/workflows/build/badge.svg)](https://github.com/simplex-chat/simplex-chat/actions?query=workflow%3Abuild)
+[![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)
 
-> **NEW in v0.4: [groups](#groups) and [sending files](#sending-files)!**
+SimpleX Chat is a terminal (command line) UI using [SimpleXMQ](https://github.com/simplex-chat/simplexmq) message broker.
 
-The motivation for SimpleX chat is [presented here](./simplex.md).
+See [SimpleX overview](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md) for more information on platform objectives and technical design.
 
-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).
+**v1.0.0 is released: [read announcement here](https://github.com/simplex-chat/simplex-chat/blob/master/blog/20220112-simplex-chat-v1-released.md)**
 
-See [simplex.chat](https://simplex.chat) website for chat demo and the explanations of the system and how SMP protocol works.
+### :zap: Quick installation
+
+```sh
+curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/install.sh | bash
+```
+
+Once the chat client is installed, simply run `simplex-chat` from your terminal.
 
 ![simplex-chat](./images/connection.gif)
 
@@ -22,8 +31,10 @@ See [simplex.chat](https://simplex.chat) website for chat demo and the explanati
 - [Disclaimer](#disclaimer)
 - [Network topology](#network-topology)
 - [Terminal chat features](#terminal-chat-features)
-- [Installation](#installation)
+- [Installation](#🚀-installation)
   - [Download chat client](#download-chat-client)
+    - [Linux and MacOS](#linux-and-macos)
+    - [Windows](#windows)
   - [Build from source](#build-from-source)
     - [Using Docker](#using-docker)
     - [Using Haskell stack](#using-haskell-stack)
@@ -32,25 +43,26 @@ See [simplex.chat](https://simplex.chat) website for chat demo and the explanati
   - [How to use SimpleX chat](#how-to-use-simplex-chat)
   - [Groups](#groups)
   - [Sending files](#sending-files)
+  - [User contact addresses](#user-contact-addresses)
   - [Access chat history](#access-chat-history)
-- [Future roadmap](#future-roadmap)
+- [Roadmap](#Roadmap)
 - [License](#license)
 
 ## Disclaimer
 
-This is WIP implementation of SimpleX chat that implements a new network topology for asynchronous communication combining the advantages and avoiding the disadvantages of federated and P2P networks.
+SimpleX Chat implements a new network topology for asynchronous communication combining the advantages and avoiding the disadvantages of federated and P2P networks.
 
-If you expect a software being reliable most of the time and doing something useful, then this is probably not ready for you yet. We do use it for terminal chat though, and it seems to work most of the time - we would really appreciate if you try it and give us your feedback.
+[SimpleXMQ security model](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md) had many improvements in v1.0.0; the implementation has not been audited yet.
 
-**Please note:** The main differentiation of SimpleX network is the approach to internet message routing rather than encryption; for that reason no sufficient attention was paid to either TCP transport level encryption or to E2E encryption protocols - they are implemented in an ad hoc way based on RSA and AES algorithms. See [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a) on TCP transport encryption protocol (AEAD-GCM scheme, with an AES key negotiation based on RSA key hash known to the client in advance) and [this section](https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-01-26-crypto.md#e2e-encryption) on E2E encryption protocol (an ad hoc hybrid scheme a la PGP). These protocols will change in a consumer ready version to something more robust.
+We use SimpleX Chat all the time, but you may find some bugs. We would really appreciate if you use it and let us know anything that needs to be fixed or improved.
 
 ## Network topology
 
-SimpleX is a decentralized client-server network that uses redundant, disposable nodes to asynchronously pass the messages via message queues, providing receiver and sender anonymity.
+SimpleX is a client-server network that uses redundant, disposable nodes to asynchronously pass messages via message queues, providing receiver and sender anonymity.
 
 Unlike P2P networks, all messages are passed through one or several (for redundancy) servers, that do not even need to have persistence (in fact, the current [SMP server implementation](https://github.com/simplex-chat/simplexmq#smp-server) uses in-memory message storage, persisting only the queue records) - it provides better metadata protection than P2P designs, as no global participant ID is required, and avoids many [problems of P2P networks](https://github.com/simplex-chat/simplex-chat/blob/master/simplex.md#comparison-with-p2p-messaging-protocols).
 
-Unlike federated networks, the participating server nodes do NOT have records of the users, do NOT communicate with each other, do NOT store messages after they are delivered to the recipients, and there is no way to discover the full list of participating servers - it avoids the problem of metadata visibility that federated networks suffer from and better protects the network, as servers do not communicate with each other. Each server node provides unidirectional "dumb pipes" to the users, that do authorization without authentication, having no knowledge of the the users or their contacts. Each queue is assigned two RSA keys - one for receiver and one for sender - and each queue access is authorized with a signature created using a respective key's private counterpart.
+Unlike federated networks, the participating server nodes **do not have records of the users**, **do not communicate with each other**, **do not store messages** after they are delivered to the recipients, and there is no way to discover the full list of participating servers. SimpleX network avoids the problem of metadata visibility that federated networks have and better protects the network, as servers do not communicate with each other. Each server node provides unidirectional "dumb pipes" to the users, that do authorization without authentication, having no knowledge of the the users or their contacts. Each queue is assigned two Ed448 keys - one for receiver and one for sender - and each queue access is authorized with a signature created using a respective key's private counterpart.
 
 The routing of messages relies on the knowledge of client devices how user contacts and groups map at any given moment of time to these disposable queues on server nodes.
 
@@ -59,31 +71,49 @@ The routing of messages relies on the knowledge of client devices how user conta
 - 1-to-1 chat with multiple people in the same terminal window.
 - 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.
-- E2E encryption, with RSA public key that has to be passed out-of-band (see [How to use SimpleX chat](#how-to-use-simplex-chat)).
-- Message signing and verification with automatically generated RSA keys.
+- Two layers of E2E encryption (double-ratchet for duplex connections, using X3DH key agreement with ephemeral Curve448 keys, and NaCl crypto_box for SMP queues, using Curve25519 keys) and out-of-band passing of recipient keys (see [How to use SimpleX chat](#how-to-use-simplex-chat)).
 - Message integrity validation (via including the digests of the previous messages).
-- Authentication of each command/message by SMP servers with automatically generated RSA key pairs.
-- TCP transport encryption using SMP transport protocol.
+- Authentication of each command/message by SMP servers with automatically generated Ed448 keys.
+- TLS 1.2 transport encryption.
+- Additional encryption of messages from SMP server to recipient to reduce traffic correlation.
 
-RSA keys are not used as identity, they are randomly generated for each contact.
+Public keys involved in key exchange are not used as identity, they are randomly generated for each contact.
 
-## Installation
+See [Encryption Primitives Used](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md#encryption-primitives-used) for technical details.
+
+<a name="🚀-installation"></a>
+
+## 🚀 Installation
 
 ### Download chat client
 
-Download the chat binary for your system from the [latest stable release](https://github.com/simplex-chat/simplex-chat/releases) and make it executable as shown below.
-
 #### Linux and MacOS
 
+To **install** or **update** `simplex-chat`, you should run the install script. To do that, use the following cURL or Wget command:
+
+```sh
+curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/install.sh | bash
+```
+
+```sh
+wget -qO- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/install.sh | bash
+```
+
+Once the chat client downloads, you can run it with `simplex-chat` command in your terminal.
+
+Alternatively, you can manually download the chat binary for your system from the [latest stable release](https://github.com/simplex-chat/simplex-chat/releases) and make it executable as shown below.
+
 ```sh
 chmod +x <binary>
 mv <binary> ~/.local/bin/simplex-chat
 ```
 
-(or any other preferred location on PATH).
+(or any other preferred location on `PATH`).
 
 On MacOS you also need to [allow Gatekeeper to run it](https://support.apple.com/en-us/HT202491).
 
@@ -105,7 +135,7 @@ $ cd simplex-chat
 $ DOCKER_BUILDKIT=1 docker build --output ~/.local/bin .
 ```
 
-> **Please note:** If you encounter ``version `GLIBC_2.28' not found`` error, rebuild it with `haskell:8.8.4-stretch` base image (change it in your local [Dockerfile](Dockerfile)).
+> **Please note:** If you encounter `` version `GLIBC_2.28' not found `` error, rebuild it with `haskell:8.10.4-stretch` base image (change it in your local [Dockerfile](Dockerfile)).
 
 #### Using Haskell stack
 
@@ -129,7 +159,7 @@ $ stack install
 
 To start the chat client, run `simplex-chat` from the terminal.
 
-By default, app data directory is created in the home directory (`~/.simplex`, or `%APPDATA%/simplex` on Windows), and two SQLite database files `simplex.chat.db` and `simplex.agent.db` are initialized in it.
+By default, app data directory is created in the home directory (`~/.simplex`, or `%APPDATA%/simplex` on Windows), and two SQLite database files `simplex_v1_chat.db` and `simplex_v1_agent.db` are initialized in it.
 
 To specify a different file path prefix for the database files use `-d` command line option:
 
@@ -137,17 +167,17 @@ To specify a different file path prefix for the database files use `-d` command
 $ simplex-chat -d alice
 ```
 
-Running above, for example, would create `alice.chat.db` and `alice.agent.db` database files in current directory.
+Running above, for example, would create `alice_v1_chat.db` and `alice_v1_agent.db` database files in current directory.
 
-Default SMP servers are hosted on Linode (London, UK and Fremont, CA) - they are [pre-configured in the app](https://github.com/simplex-chat/simplex-chat/blob/master/src/Simplex/Chat/Options.hs#L40). Base-64 encoded string after server host is the transport key digest.
+Three default SMP servers are hosted on Linode - they are [pre-configured in the app](https://github.com/simplex-chat/simplex-chat/blob/master/src/Simplex/Chat/Options.hs#L42).
 
 If you deployed your own SMP server(s) you can configure client via `-s` option:
 
 ```shell
-$ simplex-chat -s smp.example.com:5223#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8=
+$ simplex-chat -s smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@smp.example.com
 ```
 
-The base-64 encoded string in server address is the digest of RSA transport handshake key that the server will generate on the first run and output its digest.
+Base64url encoded string preceding the server address is the server's offline certificate fingerprint which is validated by client during TLS handshake.
 
 You can still talk to people using default or any other server - it only affects the location of the message queue when you initiate the connection (and the reply queue can be on another server, as set by the other party's client).
 
@@ -155,9 +185,9 @@ Run `simplex-chat -h` to see all available options.
 
 ### How to use SimpleX chat
 
-Once you have started the chat, you will be prompted to specify your "display name" and an optional "full name" to create a local chat profile. Your display name is an alias for your contacts to refer to you by - it is not unique and does not serve as a global identity. In case different contacts chose the same display name, the chat client adds a numeric suffix to their local display names.
+Once you have started the chat, you will be prompted to specify your "display name" and an optional "full name" to create a local chat profile. Your display name is an alias for your contacts to refer to you by - it is not unique and does not serve as a global identity. If some of your contacts chose the same display name, the chat client adds a numeric suffix to their local display name.
 
-This diagram shows how to connect and message a contact:
+The diagram below shows how to connect and message a contact:
 
 <div align="center">
   <img align="center" src="images/how-to-use-simplex.svg">
@@ -167,7 +197,7 @@ Once you've set up your local profile, enter `/c` (for `/connect`) to create a n
 
 You are able to create multiple invitations by entering `/connect` multiple times and sending these invitations to the corresponding contacts you'd like to connect with.
 
-The invitation has the format `smp::<server>::<queue_id>::<rsa_public_key_for_this_queue_only>`. The invitation can only be used once and even if this is intercepted, the attacker would not be able to use it to send you the messages via this queue once your contact confirms that the connection is established.
+The invitation can only be used once and even if this is intercepted, the attacker would not be able to use it to send you the messages via this queue once your contact confirms that the connection is established. See agent protocol for explanation of [invitation format](https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#connection-request).
 
 The contact who received the invitation should enter `/c <invitation>` to accept the connection. This establishes the connection, and both parties are notified.
 
@@ -177,7 +207,7 @@ Use `/help` in chat to see the list of available commands.
 
 ### Groups
 
-To create a group use `/g <group>`, then add contacts to it with `/a <group> <name>`and send messages with `#<group> <message>`. Use `/help groups` for other commands.
+To create a group use `/g <group>`, then add contacts to it with `/a <group> <name>`. You can then send messages to the group by entering  `#<group> <message>`. Use `/help groups` for other commands.
 
 ![simplex-chat](./images/groups.gif)
 
@@ -191,39 +221,62 @@ You can send a file to your contact with `/f @<contact> <file_path>` - the recip
 
 You can send files to a group with `/f #<group> <file_path>`.
 
+### User contact addresses
+
+As an alternative to one-time invitation links, you can create a long-term address with `/ad` (for `/address`). The created address can then be shared via any channel, and used by other users as a link to make a contact request with `/c <user_contact_address>`.
+
+You can accept or reject incoming requests with `/ac <name>` and `/rc <name>` commands.
+
+User address is "long-term" in a sense that it is a multiple-use connection link - it can be used until it is deleted by the user, in which case all established connections would still remain active (unlike how it works with email, when changing the address results in people not being able to message you).
+
+Use `/help address` for other commands.
+
+![simplex-chat](./images/user-addresses.gif)
+
 ### Access chat history
 
-> 🚧 **Section currently out of date - will be updated soon** 🏗
+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 view and search your chat history by querying your database. Run the below script to create message views in your database.
 
-You can search your chat history via SQLite database file:
-
-```
-sqlite3 ~/.simplex/smp-chat.db
+```sh
+curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/message_views.sql | sqlite3 ~/.simplex/simplex_v1_chat.db
 ```
 
-Now you can query `messages` table, for example:
+Open SQLite Command Line Shell:
 
-```sql
-select * from messages
-where conn_alias = cast('alice' as blob)
-  and body like '%cats%'
-order by internal_id desc;
+```sh
+sqlite3 ~/.simplex/simplex_v1_chat.db
 ```
 
+See [Message queries](./message_queries.md) for examples.
+
 > **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.
 
-## Future roadmap
+**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;
+```
+
+## Roadmap
 
 1. Mobile and desktop apps (in progress).
 2. SMP protocol improvements:
-    - SMP queue redundancy and rotation.
-    - Message delivery confirmation.
-    - Support multiple devices.
+   - SMP queue redundancy and rotation.
+   - Message delivery confirmation.
+   - Support multiple devices.
 3. Privacy-preserving identity server for optional DNS-based contact/group addresses to simplify connection and discovery, but not used to deliver messages:
-    - keep all your contacts and groups even if you lose the domain.
-    - the server doesn't have information about your contacts and groups.
+   - keep all your contacts and groups even if you lose the domain.
+   - the server doesn't have information about your contacts and groups.
 4. Media server to optimize sending large files to groups.
 5. Channels server for large groups and broadcast channels.
 

apps/simplex-chat/Demo.hs

@@ -1,119 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Demo where
-
-import Simplex.Chat.Styled
-import System.Console.ANSI.Types
-import System.Terminal
-
-someViewUpdate :: Monad m => m ()
-someViewUpdate = pure ()
-
-chatLayoutDemo :: MonadTerminal m => m ()
-chatLayoutDemo =
-  mapM_
-    putStyledLn
-    [ "  search " <> Styled gray "(ctrl-s)   " <> lineV <> Styled toContact " @bob " <> "Bob Roberts                                    " <> Styled greenColor "@john" <> "",
-      "                    " <> lineV <> Styled gray " 14:15 online                             profile (ctrl-p)",
-      lineH 20 <> crossover <> lineH 59,
-      "* " <> Styled [SetConsoleIntensity BoldIntensity] "all chats   " <> "      " <> lineV <> "",
-      Styled gray "  (ctrl-a)          " <> lineV <> "",
-      "*" <> Styled toContact " @alice      " <> Styled darkGray "14:37 " <> lineV <> "",
-      Styled gray "  Hello there!  ... " <> lineV <> "",
-      Styled selected " " <> Styled (toContact <> selected) " @bob        " <> Styled (selected <> gray) "12:35 " <> lineV <> "",
-      Styled selected "  All good, John... " <> lineV <> "",
-      "*" <> Styled group " #team       " <> Styled darkGray "10:55 " <> lineV <> "",
-      Styled gray "  What's up ther... " <> lineV <> "",
-      " " <> Styled toContact " @tom          " <> Styled darkGray "Wed " <> lineV <> "",
-      Styled gray "  Have you seen ... " <> lineV <> "",
-      "                    " <> lineV,
-      "                    " <> lineV,
-      "                    " <> lineV,
-      "                    " <> lineV,
-      "                    " <> lineV,
-      "                    " <> lineV <> Styled greenColor " ✔︎" <> Styled darkGray " 12:30" <> Styled toContact " @bob" <> " hey bob - how is it going?",
-      "                    " <> lineV <> Styled greenColor " ✔︎" <> Styled darkGray "      " <> Styled toContact "     " <> " let's meet soon!",
-      "                    " <> lineV <> " *" <> Styled darkGray " 12:35" <> Styled contact " bob>" <> " All good, John! How are you?",
-      "                    " <> teeL <> lineH 59,
-      "                    " <> lineV <> " > " <> Styled toContact "@bob" <> " 😀 This is the message that will be sent to @bob"
-    ]
-    >> putStyled (Styled ctrlKeys " help (ctrl-h)  new contact (ctrl-n)  choose chat (ctrl-↓↑)  new group (ctrl-g) ")
-
-contact :: [SGR]
-contact = [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Yellow]
-
-toContact :: [SGR]
-toContact = [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Cyan]
-
-group :: [SGR]
-group = [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Cyan]
-
-selected :: [SGR]
-selected = [SetColor Background Vivid Black]
-
-ctrlKeys :: [SGR]
-ctrlKeys = [SetColor Background Dull White, SetColor Foreground Dull Black]
-
-gray :: [SGR]
-gray = [SetColor Foreground Dull White]
-
-darkGray :: [SGR]
-darkGray = [SetColor Foreground Vivid Black]
-
-greenColor :: [SGR]
-greenColor = [SetColor Foreground Vivid Green]
-
-lineV :: StyledString
-lineV = Styled selected " " -- "\x2502"
-
-lineH :: Int -> StyledString
-lineH n = Styled darkGray $ replicate n '\x2500'
-
-teeL :: StyledString
-teeL = Styled selected " " -- "\x251C"
-
-crossover :: StyledString
-crossover = Styled selected " " -- "\x253C"
-
-putStyledLn :: MonadTerminal m => StyledString -> m ()
-putStyledLn s = putStyled s >> putLn
-
-putStyled :: MonadTerminal m => StyledString -> m ()
-putStyled (s1 :<>: s2) = putStyled s1 >> putStyled s2
-putStyled (Styled [] s) = putString s
-putStyled (Styled sgr s) = setSGR sgr >> putString s >> resetAttributes
-
-setSGR :: MonadTerminal m => [SGR] -> m ()
-setSGR = mapM_ $ \case
-  Reset -> resetAttributes
-  SetConsoleIntensity BoldIntensity -> setAttribute bold
-  SetConsoleIntensity _ -> resetAttribute bold
-  SetItalicized True -> setAttribute italic
-  SetItalicized _ -> resetAttribute italic
-  SetUnderlining NoUnderline -> resetAttribute underlined
-  SetUnderlining _ -> setAttribute underlined
-  SetSwapForegroundBackground True -> setAttribute inverted
-  SetSwapForegroundBackground _ -> resetAttribute inverted
-  SetColor l i c -> setAttribute . layer l . intensity i $ color c
-  SetBlinkSpeed _ -> pure ()
-  SetVisible _ -> pure ()
-  SetRGBColor _ _ -> pure ()
-  SetPaletteColor _ _ -> pure ()
-  SetDefaultColor _ -> pure ()
-  where
-    layer = \case
-      Foreground -> foreground
-      Background -> background
-    intensity = \case
-      Dull -> id
-      Vivid -> bright
-    color = \case
-      Black -> black
-      Red -> red
-      Green -> green
-      Yellow -> yellow
-      Blue -> blue
-      Magenta -> magenta
-      Cyan -> cyan
-      White -> white

apps/simplex-chat/Main.hs

@@ -6,6 +6,7 @@
 module Main where
 
 import Simplex.Chat
+import Simplex.Chat.Controller (versionNumber)
 import Simplex.Chat.Options
 import System.Directory (getAppUserDataDirectory)
 import System.Terminal (withTerminal)
@@ -20,39 +21,7 @@ welcomeGetOpts :: IO ChatOpts
 welcomeGetOpts = do
   appDir <- getAppUserDataDirectory "simplex"
   opts@ChatOpts {dbFile} <- getChatOpts appDir
-  putStrLn "SimpleX chat prototype v0.4.0"
-  putStrLn $ "db: " <> dbFile <> ".chat.db, " <> dbFile <> ".agent.db"
+  putStrLn $ "SimpleX Chat v" ++ versionNumber
+  putStrLn $ "db: " <> dbFile <> "_chat.db, " <> dbFile <> "_agent.db"
   putStrLn "type \"/help\" or \"/h\" for usage info"
   pure opts
-
--- defaultSettings :: C.Size -> C.VirtualTerminalSettings
--- defaultSettings size =
---   C.VirtualTerminalSettings
---     { C.virtualType = "xterm",
---       C.virtualWindowSize = pure size,
---       C.virtualEvent = retry,
---       C.virtualInterrupt = retry
---     }
-
--- main :: IO ()
--- main = do
---   void $ createStore "simplex-chat.db" 4
-
---   hFlush stdout
---   -- ChatTerminal {termSize} <- newChatTerminal
---   -- pos <- C.withVirtualTerminal (defaultSettings termSize) $
---   --   \t -> runTerminalT (C.setAlternateScreenBuffer True >> C.putString "a" >> C.flush >> C.getCursorPosition) t
---   -- print pos
---   -- race_ (printEvents t) (updateTerminal t)
---   void . withTerminal . runTerminalT $ chatLayoutDemo >> C.flush >> C.awaitEvent
-
--- printEvents :: C.VirtualTerminal -> IO ()
--- printEvents t = forever $ do
---   event <- withTerminal . runTerminalT $ C.flush >> C.awaitEvent
---   runTerminalT (putStringLn $ show event) t
-
--- updateTerminal :: C.VirtualTerminal -> IO ()
--- updateTerminal t = forever $ do
---   threadDelay 10000
---   win <- readTVarIO $ C.virtualWindow t
---   withTerminal . runTerminalT $ mapM_ C.putStringLn win >> C.flush

blog/20201022-simplex-chat.md

@@ -0,0 +1,19 @@
+# Simplex chat
+
+**Published:** Oct 22, 2020
+
+https://simplex.chat
+
+I'd really appreciate your feedback, criticism and suggestions on the open-source idea I was slowly working on since early 2020. I recently made the demo server for the low-level message queue protocol ("simplex messaging protocol") and the website to try to explain the chat idea that would use this protocol.
+
+Haskell protocol implementation: https://github.com/simplex-chat/simplexmq
+
+In short, the protocol defines a minimalist set of commands and server responses (just 7 commands and 5 responses sent over TCP) to operate encrypted message queues with in-memory persistence - the implementation uses STM.
+
+If anything, it was definitely helping to get to know Haskell types etc. much deeper than before :)
+
+Any criticism would be great - thank you in advance!
+
+---
+
+Originally published at https://www.reddit.com/r/haskell/comments/jg6uh4/simplex_chat/

blog/20210512-simplex-chat-terminal-ui.md

@@ -0,0 +1,25 @@
+## Announcing SimpleX Chat Prototype!
+
+**Published:** May 12, 2021
+
+For the last six months [me](https://github.com/epoberezkin) and my son [Efim](https://github.com/efim-poberezkin) have been working to bring you a working prototype of SimpleX Chat. We're excited to announce SimpleX Chat terminal client is now available [here](https://github.com/simplex-chat/simplex-chat) on Linux, Windows and Mac (you can either build from source or download the binary for Linux, Windows or Mac from the latest release).
+
+We’ve been using the terminal client between us and a few other people for a couple of months now, eating our own “dog food”, and have developed up to version 0.3.1, with most of the messaging protocol features we originally planned
+
+### Features
+
+- End-to-end encryption with protection from man in the middle attack. The connection invitation must be passed out-of-band (see [how to use SimpleX Chat](https://github.com/simplex-chat/simplex-chat#how-to-use-simplex-chat) in the repo).
+- No global identity or any usernames visible to the server(s), ensuring full privacy of your contacts and conversations.
+- Message signing and verification with automatically generated RSA keys, with keys being unique per each connection.
+- Authorization of each command/message by the servers with automatically generated RSA key pairs, also unique per connection.
+- Message integrity validation (via passing the digests of the previous messages).
+- Encrypted TCP transport, independent of certificates.
+- You can deploy your own server, but you don’t have to - the demo SMP server to relay your messages is available at smp1.simplex.im:5223 (pre-configured in the client).
+
+### We need your help!
+
+We're building a new kind of chat network - the only network that lets you control your chat. We'd really appreciate your feedback, criticism and support - a star on the github repo, signing up to the mailing list or any contribution to the project will help. There is so much more to do!
+
+---
+
+Originally published at https://www.reddit.com/r/haskell/comments/naw6lz/simplex_chat_prototype_terminal_ui_made_in_haskell/

blog/20210914-simplex-chat-v0.4-released.md

@@ -0,0 +1,44 @@
+# SimpleX announces SimpleX Chat v0.4
+
+## Open-source decentralized chat that uses privacy-preserving message routing protocol
+
+**Published:** Sep 14, 2021
+
+We are building a new platform for distributed Internet applications where privacy of the messages _and_ the network matter. [SimpleX Chat](https://github.com/simplex-chat/simplex-chat) is our first application, a chat application built on the SimpleX platform that  serves as an example of the power of the platform and as a reference application.
+
+## What is SimpleX?
+
+We recognised that there is currently no messaging application which respects user privacy and guarantees metadata privacy -- in other words, messages could be private, but a third party can always see who is communicating with whom by examining a central service and the connection graph.  SimpleX, at it's core, is designed to be truly distributed with no central server.  This allows for enormous scalability at low cost, and also makes it virtually impossible to snoop on the network graph.
+
+The first application built on the platform is Simplex Chat, which for now is terminal (command line) based with mobile apps in the pipeline.  The platform can easily support a private social network feed and a multitude of other services, which can be developed by the Simplex team or third party developers.
+
+
+## What's new in v0.5?
+
+We're exicted to announce that SimpleX Chat now supports group chat and file transfer!
+
+### Chat groups
+
+To create a group use the `/g <group>` command. You can then invite contacts to the group by entering the `/a <group> <name>` command. Your contact(s) will need to use the `/j accept` command to accept the invitation to the group. To send messages to the group, simply enter `#<group> <message>`.  
+
+**Please note:** Groups are not stored on any server; they are maintained as a list of members in the app database. Sending a message to the group sends a message to each member of the group.
+
+![simplex-chat](../images/groups.gif)
+
+### File transfer
+
+Sharing files is simple! To send a file to a contact, use the `/f @<contact> <file_path>` command. The recipient will have to accept before the file is sent.
+
+![simplex-chat](../images/files.gif)
+
+## We're always looking for help!
+
+We'd really appreciate your comments, criticism and support - a star on the GitHub repo, downloading and testing the chat or any contribution to the project will help a lot – thank you for all your support!
+
+**Please note:** SimpleX Chat is in early stage development: we are still iterating protocols, improving privacy and security, so if you have communication scenarios requiring high security, you should consider some other options for now.
+
+Our goal is to create a new kind of chat platform that lets you control your chat!
+
+---
+
+Originally published at https://www.reddit.com/r/selfhosted/comments/poal79/simplex_chat_an_opensource_decentralized_chat/

blog/20211208-simplex-chat-v0.5-released.md

@@ -0,0 +1,32 @@
+# SimpleX announces SimpleX Chat v0.5 
+
+## Simplex Chat is the first chat platform that is 100% private by design - SimpleX no access to your connections graph
+
+**Published:** Dec 08, 2021
+
+We are building a new platform for distributed Internet applications where privacy of the messages _and_ the network matter. [SimpleX Chat](https://github.com/simplex-chat/simplex-chat) is our first application, a chat application built on the SimpleX platform that  serves as an example of the power of the platform and as a reference application.
+
+## What is SimpleX?
+
+We recognised that there is currently no messaging application which respects user privacy and guarantees metadata privacy -- in other words, messages could be private, but a third party can always see who is communicating with whom by examining a central service and the connection graph.  SimpleX, at it's core, is designed to be truly distributed with no central server.  This allows for enormous scalability at low cost, and also makes it virtually impossible to snoop on the network graph.
+
+The first application built on the platform is Simplex Chat, which for now is terminal (command line) based with mobile apps in the pipeline.  The platform can easily support a private social network feed and a multitude of other services, which can be developed by the Simplex team or third party developers.
+
+## What's new in v0.5?
+
+### Long-term chat addresses
+Users can now create long-term chat addresses that they can share with many people (e.g. in email signature, or online), so that any chat user can send them a connection request.
+
+This is an ALPHA feature, and we have not yet added any protection against spam contact requests. However, if the address you created starts receiving spam connection requests, you can simply delete it without losing any of your accepted connections and create another address - as many times as you like!
+
+## We need your help!
+
+We'd really appreciate your comments, criticism and support - a star on the GitHub repo, downloading and testing the chat or any contribution to the project will help a lot – thank you for all your support!
+
+**Please note:** SimpleX Chat is in early stage development: we are still iterating protocols, improving privacy and security, so if you have communication scenarios requiring high security, you should consider some other options for now.
+
+Our goal is to create a new kind of chat platform that lets you control your chat!
+
+---
+
+Originally published at https://www.reddit.com/r/haskell/comments/rc0xkn/simplex_chat_the_first_chat_platform_that_is_100/

blog/20220112-simplex-chat-v1-released.md

@@ -0,0 +1,53 @@
+# SimpleX announces SimpleX Chat v1
+
+**Published:** Jan 12, 2022
+
+## The most private and secure chat and application platform
+
+We are building a new platform for distributed Internet applications where privacy of the messages _and_ the network matter. [SimpleX Chat](https://github.com/simplex-chat/simplex-chat) is our first application, a messaging application built on the SimpleX platform.
+
+## What is SimpleX?
+
+There is currently no messaging application which respects user privacy and guarantees metadata privacy - in other words, messages could be private, but a third party can always see who is communicating with whom by examining a central service and the connection graph. SimpleX, at it's core, is designed to be truly distributed with no central server. This allows for enormous scalability at low cost, and also makes it virtually impossible to snoop on the network graph.
+
+The first application built on the platform is Simplex Chat, which for now is terminal (command line) based with mobile apps in the pipeline. The platform can easily support a private social network feed and a multitude of other services, which can be developed by the Simplex team or third party developers.
+
+## What's new in v1?
+
+### Stable protocol implementation
+
+All releases from v1 onwards will be forwards and backwards compatible.
+
+### Message encryption has been completely re-engineered to provide forward secrecy and recovery from break-in.
+
+SimpleX Chat v1 now uses:
+
+- [double-ratchet](https://www.signal.org/docs/specifications/doubleratchet/) E2E encryption using AES-256-GCM cipher with [X3DH key agreement](https://www.signal.org/docs/specifications/x3dh/) using 2 ephemeral Curve448 keys to derive secrets for ratchet initialization. These keys and secrets are separate for each contact, group membership and file transfer.
+- in addition to double ratchet, there is a separate E2E encryption in each message queue with DH key exchange using Curve25519 and [NaCl crypto-box](https://nacl.cr.yp.to/index.html) - separate E2E encryption has been added to avoid having any cipher-text in common between message queues of a single contact (to prevent traffic correlation).
+- additional encryption of messages delivered from servers to recipients, also using Curve25519 DH exchange and NaCl crypto-box - to avoid shared cipher-text in sent and received traffic (also to prevent traffic correlation).
+
+### Improved user and server authentication and transport
+
+SimpleX now uses ephemeral Ed448 keys to sign and verify client commands to the servers. As before, these keys are different per message queue and do not represent a user's identity.
+
+Instead of ad-hoc encrypted transport we now use TLS 1.2+ limited to the most performant and secure cipher with forward secrecy (ECDHE-ECDSA-CHACHA20POLY1305-SHA256), Curve448 groups and Ed448 keys.
+
+Server identity is validated as part of TLS handshake - the fingerprint of offline server certificate is used as a permanent server identity which is included in server address, to protect against MITM attacks between clients and servers.
+
+SimpleX also uses [tls-unique channel binding](https://datatracker.ietf.org/doc/html/rfc5929#section-3) in each signed client command to the server to protect against replay attacks.
+
+### Changes in protocol encoding
+
+We switched from inefficient text-based low level protocol encodings, that simplified early development, to space and performance efficient binary encodings, reducing protocol overhead from circa 15% to 3.7% of transmitted application message size.
+
+## Learn more about Simplex
+
+Further details on platform objectives and technical design are available [here](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md).
+
+SimpleX Chat client can be used in the terminal on all major desktop platforms (Windows/Mac/Linux) and also on Android devices with [Termux](https://github.com/termux).
+
+SimpleX also allows people to host their own servers and own their own chat data. SimpleX servers are exceptionally lightweight and require a single process with the initial memory footprint of under 20 Mb, which grows as the server adds in-memory queues (even with 10,000 queues it uses less than 50Mb, not accounting for messages).
+
+## We look forward to you using it!
+
+We look forward to your feedback and suggestions - via GitHub issues or via SimpleX Chat - you can connect to the team with `/simplex` command once you run the chat.

blog/README.md

@@ -0,0 +1,11 @@
+# Blog
+
+Jan 12, 2022. [SimpleX Chat v1 released: the most private and secure chat and application platform](https://github.com/simplex-chat/simplex-chat/blob/master/blog/20220112-simplex-chat-v1-released.md)
+
+Dec 08, 2021. [SimpleX Chat v0.5 released: the first chat platform that is 100% private by design - no access to your connections graph](https://github.com/simplex-chat/simplex-chat/blob/master/blog/20211208-simplex-chat-v0.5-released.md)
+
+Sep 14, 2021. [SimpleX Chat v0.4 released: open-source chat that uses privacy-preserving message routing protocol](https://github.com/simplex-chat/simplex-chat/blob/master/blog/20210914-simplex-chat-v0.4-released.md)
+
+May 12, 2021. [SimpleX Chat Prototype!](https://github.com/simplex-chat/simplex-chat/blob/master/blog/20210512-simplex-chat-terminal-ui.md)
+
+Oct 22, 2020. [SimpleX Chat](https://github.com/simplex-chat/simplex-chat/blob/master/blog/20201022-simplex-chat)

cabal.project

@@ -0,0 +1,12 @@
+packages: .
+
+source-repository-package
+    type: git
+    location: git://github.com/simplex-chat/hs-tls.git
+    tag: cea6d52c512716ff09adcac86ebc95bb0b3bb797
+    subdir: core
+
+source-repository-package
+    type: git
+    location: git://github.com/simplex-chat/haskell-terminal.git
+    tag: 5e0759ce4f9655fd3f0d94c76225e6904630dfd3

install.sh

@@ -0,0 +1,98 @@
+set -eu
+
+APP_NAME="simplex-chat"
+BIN_DIR="$HOME/.local/bin"
+BIN_PATH="$BIN_DIR/$APP_NAME"
+PLATFORM="$(uname)"
+
+if [ $PLATFORM == "Darwin" ]; then
+  PLATFORM="macos-x86-64"
+elif [ $PLATFORM == "Linux" ]; then
+  PLATFORM="ubuntu-20_04-x86-64"
+else
+  echo "Scripted installation on your platform is not supported."
+  echo "See compiled binaries in the latest release: https://github.com/$APP_NAME/$APP_NAME/releases/latest"
+  exit 1
+fi
+
+# / Prepare to upgrade from v0 to v1
+
+# Determine path of chat binary
+if [[ -n "$(which $APP_NAME)" ]]; then
+  binary=$(which $APP_NAME)
+elif [[ -f "$BIN_PATH" ]]; then
+  binary=$BIN_PATH
+else
+  binary=""
+fi
+
+# If chat binary not found, check v0 initial migration and offer to abort or continue
+if [[ -z $binary ]]; then
+  agent_db="$HOME/.simplex/simplex.agent.db"
+  if [[ \
+    -f "$agent_db" && \
+    $(echo "select * from migrations;" | sqlite3 $agent_db | grep 20210101_initial) \
+  ]]; then
+    echo "Warning: found SimpleX Chat database, the current version is not backwards compatible."
+    echo "If you continue, the current version will be installed as $APP_NAME with a clean database, the old database will be preserved."
+    while true; do
+      read -p "Please choose to (a)bort or (c)ontinue: " yn < /dev/tty
+      case $yn in
+          [Aa]* ) exit 1 ;;
+          [Cc]* ) break ;;
+          * ) echo "Please answer 'a' or 'c'."
+      esac
+    done
+  fi
+# If chat binary found, check version and offer to abort or continue, on continue rename chat binary
+elif [[ ! $($binary -h | grep v1) ]]; then
+  echo "Warning: found a previous version of SimpleX Chat, the current version is not backwards compatible."
+  echo "If you continue, it will be renamed to $APP_NAME-v0, and the new version will be installed as $APP_NAME with a clean database."
+  while true; do
+    read -p "Please choose (a)bort or (c)ontinue: " yn < /dev/tty
+    case $yn in
+        [Aa]* ) exit 1 ;;
+        [Cc]* )
+          binary_v0="$binary-v0"
+          mv ${binary} ${binary_v0}
+          echo "Renamed $binary into $binary_v0"
+          break
+          ;;
+        * ) echo "Please answer 'a' or 'c'."
+    esac
+  done
+fi
+# Prepare to upgrade from v0 to v1 /
+
+[[ ! -d $BIN_DIR ]] && mkdir -p $BIN_DIR
+
+if [ -n "$(command -v curl)" ]; then
+  curl -L -o $BIN_PATH "https://github.com/$APP_NAME/$APP_NAME/releases/latest/download/$APP_NAME-$PLATFORM"
+elif [ -n "$(command -v wget)" ]; then
+  wget -O $BIN_PATH "https://github.com/$APP_NAME/$APP_NAME/releases/latest/download/$APP_NAME-$PLATFORM"
+else
+  echo "Cannot download $APP_NAME - please install curl or wget"
+  exit 1
+fi
+
+chmod +x $BIN_PATH
+
+echo "$APP_NAME installed sucesfully!"
+
+if [ -z "$(command -v $APP_NAME)" ]; then
+  if [ -n "$($SHELL -c 'echo $ZSH_VERSION')" ]; then
+    SHELL_FILE="$HOME/.zshrc"
+  elif [ -n "$($SHELL -c 'echo $BASH_VERSION')" ]; then
+    SHELL_FILE="$HOME/.bashrc"
+  else
+    echo "Unknown shell - cannot add $APP_NAME folder to PATH"
+    echo "Please add $BIN_DIR to PATH variable"
+    echo "Or you can run $APP_NAME via full path: $BIN_PATH"
+  fi
+  if [ -n "$SHELL_FILE" ]; then
+    echo "export PATH=\$PATH:$BIN_DIR" >> $SHELL_FILE
+    echo "Source your $SHELL_FILE or open a new shell and type $APP_NAME to run it"
+  fi
+else
+  echo "Type $APP_NAME in your terminal to run it"
+fi

message_queries.md

@@ -0,0 +1,39 @@
+# Message queries
+
+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
+-- you can put these or your preferred settings into ~/.sqliterc
+-- to persist across sqlite3 client sessions
+.mode column
+.headers on
+.nullvalue NULL
+
+-- 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, for example:
+-- files you offered for sending
+select * from direct_messages where msg_sent = 1 and chat_msg_event = 'x.file';
+-- everything catherine sent related to cats
+select * from direct_messages where msg_sent = 0 and contact = 'catherine' and msg_body like '%cats%'; 
+-- all correspondence with alice in #team
+select * from group_messages where group_name = 'team' and contact = 'alice';
+
+-- 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;
+```

message_views.sql

@@ -0,0 +1,110 @@
+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;

migrations/20220101_initial.sql

@@ -15,13 +15,13 @@ CREATE TABLE users (
   active_user INTEGER NOT NULL DEFAULT 0, -- 1 for active user
   FOREIGN KEY (user_id, local_display_name)
     REFERENCES display_names (user_id, local_display_name)
-    ON DELETE RESTRICT
+    ON DELETE CASCADE
     ON UPDATE CASCADE
     DEFERRABLE INITIALLY DEFERRED
 );
 
 CREATE TABLE display_names (
-  user_id INTEGER NOT NULL REFERENCES users,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
   local_display_name TEXT NOT NULL,
   ldn_base TEXT NOT NULL,
   ldn_suffix INTEGER NOT NULL DEFAULT 0,
@@ -31,15 +31,15 @@ CREATE TABLE display_names (
 
 CREATE TABLE contacts (
   contact_id INTEGER PRIMARY KEY,
-  contact_profile_id INTEGER REFERENCES contact_profiles, -- NULL if it's an incognito profile
-  user_id INTEGER NOT NULL REFERENCES users,
+  contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL, -- NULL if it's an incognito profile
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
   local_display_name TEXT NOT NULL,
   is_user INTEGER NOT NULL DEFAULT 0, -- 1 if this contact is a user
   via_group INTEGER REFERENCES groups (group_id) ON DELETE SET NULL,
   created_at TEXT NOT NULL DEFAULT (datetime('now')),
   FOREIGN KEY (user_id, local_display_name)
     REFERENCES display_names (user_id, local_display_name)
-    ON DELETE RESTRICT
+    ON DELETE CASCADE
     ON UPDATE CASCADE,
   UNIQUE (user_id, local_display_name),
   UNIQUE (user_id, contact_profile_id)
@@ -49,7 +49,7 @@ CREATE TABLE sent_probes (
   sent_probe_id INTEGER PRIMARY KEY,
   contact_id INTEGER NOT NULL UNIQUE REFERENCES contacts ON DELETE CASCADE,
   probe BLOB NOT NULL,
-  user_id INTEGER NOT NULL REFERENCES users,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
   UNIQUE (user_id, probe)
 );
 
@@ -57,7 +57,7 @@ CREATE TABLE sent_probe_hashes (
   sent_probe_hash_id INTEGER PRIMARY KEY,
   sent_probe_id INTEGER NOT NULL REFERENCES sent_probes ON DELETE CASCADE,
   contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE,
-  user_id INTEGER NOT NULL REFERENCES users,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
   UNIQUE (sent_probe_id, contact_id)
 );
 
@@ -66,7 +66,7 @@ CREATE TABLE received_probes (
   contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE,
   probe BLOB,
   probe_hash BLOB NOT NULL,
-  user_id INTEGER NOT NULL REFERENCES users
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE
 );
 
 CREATE TABLE known_servers(
@@ -74,7 +74,7 @@ CREATE TABLE known_servers(
   host TEXT NOT NULL,
   port TEXT NOT NULL,
   key_hash BLOB,
-  user_id INTEGER NOT NULL REFERENCES users,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
   UNIQUE (user_id, host, port)
 ) WITHOUT ROWID;
 
@@ -87,35 +87,38 @@ CREATE TABLE group_profiles ( -- shared group profiles
 
 CREATE TABLE groups (
   group_id INTEGER PRIMARY KEY, -- local group ID
-  user_id INTEGER NOT NULL REFERENCES users,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
   local_display_name TEXT NOT NULL, -- local group name without spaces
-  group_profile_id INTEGER REFERENCES group_profiles, -- shared group profile
-  inv_queue_info BLOB,
+  group_profile_id INTEGER REFERENCES group_profiles ON DELETE SET NULL, -- shared group profile
+  inv_queue_info BLOB, -- received
   FOREIGN KEY (user_id, local_display_name)
     REFERENCES display_names (user_id, local_display_name)
-    ON DELETE RESTRICT
+    ON DELETE CASCADE
     ON UPDATE CASCADE,
   UNIQUE (user_id, local_display_name),
   UNIQUE (user_id, group_profile_id)
 );
 
+CREATE INDEX idx_groups_inv_queue_info ON groups (inv_queue_info);
+
 CREATE TABLE group_members ( -- group members, excluding the local user
   group_member_id INTEGER PRIMARY KEY,
-  group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT,
+  group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
   member_id BLOB NOT NULL, -- shared member ID, unique per group
   member_role TEXT NOT NULL, -- owner, admin, member
   member_category TEXT NOT NULL, -- see GroupMemberCategory
   member_status TEXT NOT NULL, -- see GroupMemberStatus
-  invited_by INTEGER REFERENCES contacts (contact_id) ON DELETE RESTRICT, -- NULL for the members who joined before the current user and for the group creator
-  group_queue_info BLOB,
-  direct_queue_info BLOB,
-  user_id INTEGER NOT NULL REFERENCES users,
+  invited_by INTEGER REFERENCES contacts (contact_id) ON DELETE SET NULL, -- NULL for the members who joined before the current user and for the group creator
+  sent_inv_queue_info BLOB, -- sent
+  group_queue_info BLOB, -- received
+  direct_queue_info BLOB, -- received
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
   local_display_name TEXT NOT NULL, -- should be the same as contact
-  contact_profile_id INTEGER NOT NULL REFERENCES contact_profiles ON DELETE RESTRICT,
-  contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
+  contact_profile_id INTEGER NOT NULL REFERENCES contact_profiles ON DELETE CASCADE,
+  contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
   FOREIGN KEY (user_id, local_display_name)
     REFERENCES display_names (user_id, local_display_name)
-    ON DELETE RESTRICT
+    ON DELETE CASCADE
     ON UPDATE CASCADE,
   UNIQUE (group_id, member_id)
 );
@@ -132,28 +135,28 @@ CREATE TABLE group_member_intros (
 
 CREATE TABLE files (
   file_id INTEGER PRIMARY KEY,
-  contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
-  group_id INTEGER REFERENCES groups ON DELETE RESTRICT,
+  contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
+  group_id INTEGER REFERENCES groups ON DELETE CASCADE,
   file_name TEXT NOT NULL,
   file_path TEXT,
   file_size INTEGER NOT NULL,
   chunk_size INTEGER NOT NULL,
   created_at TEXT NOT NULL DEFAULT (datetime('now')),
-  user_id INTEGER NOT NULL REFERENCES users
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE
 );
 
 CREATE TABLE snd_files (
-  file_id INTEGER NOT NULL REFERENCES files ON DELETE RESTRICT,
-  connection_id INTEGER NOT NULL REFERENCES connections ON DELETE RESTRICT,
+  file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
+  connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
   file_status TEXT NOT NULL, -- new, accepted, connected, completed
-  group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
+  group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
   PRIMARY KEY (file_id, connection_id)
 ) WITHOUT ROWID;
 
 CREATE TABLE rcv_files (
-  file_id INTEGER PRIMARY KEY REFERENCES files ON DELETE RESTRICT,
+  file_id INTEGER PRIMARY KEY REFERENCES files ON DELETE CASCADE,
   file_status TEXT NOT NULL, -- new, accepted, connected, completed
-  group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
+  group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
   file_queue_info BLOB
 );
 
@@ -168,7 +171,7 @@ CREATE TABLE snd_file_chunks (
 ) WITHOUT ROWID;
 
 CREATE TABLE rcv_file_chunks (
-  file_id INTEGER NOT NULL REFERENCES rcv_files,
+  file_id INTEGER NOT NULL REFERENCES rcv_files ON DELETE CASCADE,
   chunk_number INTEGER NOT NULL,
   chunk_agent_msg_id INTEGER NOT NULL,
   chunk_stored INTEGER NOT NULL DEFAULT 0, -- 0 (received), 1 (appended to file)
@@ -179,100 +182,78 @@ CREATE TABLE connections ( -- all SMP agent connections
   connection_id INTEGER PRIMARY KEY,
   agent_conn_id BLOB NOT NULL UNIQUE,
   conn_level INTEGER NOT NULL DEFAULT 0,
-  via_contact INTEGER REFERENCES contacts (contact_id),
+  via_contact INTEGER REFERENCES contacts (contact_id) ON DELETE SET NULL,
   conn_status TEXT NOT NULL,
   conn_type TEXT NOT NULL, -- contact, member, rcv_file, snd_file
-  contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
-  group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
+  user_contact_link_id INTEGER REFERENCES user_contact_links ON DELETE CASCADE,
+  contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
+  group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
   snd_file_id INTEGER,
-  rcv_file_id INTEGER REFERENCES rcv_files (file_id) ON DELETE RESTRICT,
+  rcv_file_id INTEGER REFERENCES rcv_files (file_id) ON DELETE CASCADE,
   created_at TEXT NOT NULL DEFAULT (datetime('now')),
-  user_id INTEGER NOT NULL REFERENCES users,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
   FOREIGN KEY (snd_file_id, connection_id)
     REFERENCES snd_files (file_id, connection_id)
-    ON DELETE RESTRICT
+    ON DELETE CASCADE
     DEFERRABLE INITIALLY DEFERRED
 );
 
-CREATE TABLE events ( -- messages received by the agent, append only
-  event_id INTEGER PRIMARY KEY,
-  agent_msg_id INTEGER NOT NULL, -- internal message ID
-  external_msg_id INTEGER NOT NULL, -- external message ID (sent or received)
-  agent_meta TEXT NOT NULL, -- JSON with timestamps etc. sent in MSG
-  connection_id INTEGER NOT NULL REFERENCES connections,
-  received INTEGER NOT NULL, -- 0 for received, 1 for sent
-  chat_event_id INTEGER,
-  continuation_of INTEGER, -- references chat_event_id, but can be incorrect
-  event_type TEXT NOT NULL, -- event type - see protocol/types.ts
-  event_encoding INTEGER NOT NULL, -- format of event_body: 0 - binary, 1 - text utf8, 2 - JSON (utf8)
-  content_type TEXT NOT NULL, -- content type - see protocol/types.ts
-  event_body BLOB, -- agent message body as sent
-  event_hash BLOB NOT NULL,
-  integrity TEXT NOT NULL DEFAULT '',
+CREATE TABLE user_contact_links (
+  user_contact_link_id INTEGER PRIMARY KEY,
+  conn_req_contact BLOB NOT NULL,
+  local_display_name TEXT NOT NULL DEFAULT '',
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  UNIQUE (user_id, local_display_name)
+);
+
+CREATE TABLE contact_requests (
+  contact_request_id INTEGER PRIMARY KEY,
+  user_contact_link_id INTEGER NOT NULL REFERENCES user_contact_links
+    ON UPDATE CASCADE ON DELETE CASCADE,
+  agent_invitation_id  BLOB NOT NULL,
+  contact_profile_id INTEGER REFERENCES contact_profiles
+    ON DELETE SET NULL -- NULL if it's an incognito profile
+    DEFERRABLE INITIALLY DEFERRED,
+  local_display_name TEXT NOT NULL,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  FOREIGN KEY (user_id, local_display_name)
+    REFERENCES display_names (user_id, local_display_name)
+    ON UPDATE CASCADE
+    ON DELETE CASCADE
+    DEFERRABLE INITIALLY DEFERRED,
+  UNIQUE (user_id, local_display_name),
+  UNIQUE (user_id, contact_profile_id)
+);
+
+-- 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'))
 );
 
-CREATE INDEX events_external_msg_id_index ON events (connection_id, external_msg_id);
-
-CREATE TABLE event_body_parts (
-  event_body_part_id INTEGER PRIMARY KEY,
-  event_id REFERENCES events,
-  full_size INTEGER NOT NULL,
-  part_status TEXT, -- full, partial
-  content_type TEXT NOT NULL,
-  event_part BLOB
+-- 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)
 );
 
-CREATE TABLE contact_profile_events (
-  event_id INTEGER NOT NULL UNIQUE REFERENCES events,
-  contact_profile_id INTEGER NOT NULL REFERENCES contact_profiles
-);
-
-CREATE TABLE group_profile_events (
-  event_id INTEGER NOT NULL UNIQUE REFERENCES events,
-  group_profile_id INTEGER NOT NULL REFERENCES group_profiles
-);
-
-CREATE TABLE group_events (
-  event_id INTEGER NOT NULL UNIQUE REFERENCES events,
-  group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT,
-  group_member_id INTEGER REFERENCES group_members -- NULL for current user
-);
-
-CREATE TABLE group_event_parents (
-  group_event_parent_id INTEGER PRIMARY KEY,
-  event_id INTEGER NOT NULL REFERENCES group_events (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_event_id INTEGER REFERENCES events (event_id) ON DELETE CASCADE, -- this can be NULL if received event references another event that's not received yet
-  parent_chat_event_id INTEGER NOT NULL,
-  parent_event_hash BLOB NOT NULL
-);
-
-CREATE INDEX group_event_parents_parent_chat_event_id_index
-  ON group_event_parents (parent_member_id, parent_chat_event_id);
-
-CREATE TABLE messages ( -- mutable messages presented to user
-  message_id INTEGER PRIMARY KEY,
-  contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT, -- 1 for sent messages
-  group_id INTEGER REFERENCES groups ON DELETE RESTRICT, -- NULL for direct messages
-  deleted INTEGER NOT NULL, -- 1 for deleted
-  msg_type TEXT NOT NULL,
-  content_type TEXT NOT NULL,
-  msg_text TEXT NOT NULL, -- textual representation
-  msg_props TEXT NOT NULL -- JSON
-);
-
-CREATE TABLE message_content (
-  message_content_id INTEGER PRIMARY KEY,
-  message_id INTEGER REFERENCES messages ON DELETE CASCADE,
-  content_type TEXT NOT NULL,
-  content_size INTEGER, -- full expected content size
-  content_status TEXT, -- empty, part, full
-  content BLOB NOT NULL
-);
-
-CREATE TABLE message_events (
-  event_id INTEGER NOT NULL UNIQUE REFERENCES events,
-  message_id INTEGER NOT NULL REFERENCES messages
+-- 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)
 );

package.yaml

@@ -1,19 +1,20 @@
 name: simplex-chat
-version: 0.4.2
+version: 1.0.1
 #synopsis:
 #description:
 homepage: https://github.com/simplex-chat/simplex-chat#readme
 license: AGPL-3
-author: Evgeny Poberezkin
-maintainer: evgeny@poberezkin.com
-copyright: 2020 Evgeny Poberezkin
+author: simplex.chat
+maintainer: chat@simplex.chat
+copyright: 2020-22 simplex.chat
 category: Web, System, Services, Cryptography
 extra-source-files:
   - README.md
+  - migrations/*.*
 
 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 +24,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.4.*
+  - simplexmq >= 1.0 && < 1.1
   - sqlite-simple == 0.4.*
   - stm == 2.5.*
   - terminal == 0.2.*
@@ -37,6 +38,7 @@ dependencies:
   - time == 1.9.*
   - unliftio == 0.2.*
   - unliftio-core == 0.2.*
+  - unordered-containers == 0.2.*
 
 library:
   source-dirs: src

simplex-chat.cabal

@@ -0,0 +1,151 @@
+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:        1.0.1
+category:       Web, System, Services, Cryptography
+homepage:       https://github.com/simplex-chat/simplex-chat#readme
+author:         simplex.chat
+maintainer:     chat@simplex.chat
+copyright:      2020-22 simplex.chat
+license:        AGPL-3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    migrations/20220101_initial.sql
+
+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 ==1.0.*
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , terminal ==0.2.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , unordered-containers ==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 ==1.0.*
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , terminal ==0.2.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , unordered-containers ==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 ==1.0.*
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , terminal ==0.2.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , unordered-containers ==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/Controller.hs

@@ -25,6 +25,15 @@ import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
 import System.IO (Handle)
 import UnliftIO.STM
 
+versionNumber :: String
+versionNumber = "1.0.1"
+
+versionStr :: String
+versionStr = "SimpleX Chat v" <> versionNumber
+
+updateStr :: String
+updateStr = "To update run: curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/install.sh | bash"
+
 data ChatConfig = ChatConfig
   { agentConfig :: AgentConfig,
     dbPoolSize :: Int,
@@ -34,6 +43,7 @@ data ChatConfig = ChatConfig
 
 data ChatController = ChatController
   { currentUser :: TVar User,
+    firstTime :: Bool,
     smpAgent :: AgentClient,
     chatTerminal :: ChatTerminal,
     chatStore :: SQLiteStore,
@@ -74,9 +84,10 @@ data ChatErrorType
   | CEFileSend Int64 AgentErrorType
   | CEFileRcvChunk String
   | CEFileInternal String
+  | CEAgentVersion
   deriving (Show, Exception)
 
-type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
+type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m, MonadFail m)
 
 setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
 setActive to = asks (activeTo . chatTerminal) >>= atomically . (`writeTVar` to)

src/Simplex/Chat/Help.hs

@@ -1,17 +1,22 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Chat.Help
-  ( chatHelpInfo,
+  ( chatWelcome,
+    chatHelpInfo,
     filesHelpInfo,
     groupsHelpInfo,
+    myAddressHelpInfo,
     markdownInfo,
   )
 where
 
 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 (Profile (..), User (..))
 import System.Console.ANSI.Types
 
 highlight :: Text -> Markdown
@@ -26,15 +31,44 @@ indent = "        "
 listHighlight :: [Text] -> Markdown
 listHighlight = mconcat . intersperse ", " . map highlight
 
+chatWelcome :: User -> [StyledString]
+chatWelcome user =
+  map
+    styleMarkdown
+    [ "                             __   __",
+      "  ___ ___ __  __ ___ _    ___" <> "\\ \\ / /" <> " ___ _  _   _ _____",
+      " / __|_ _|  \\/  | _ \\ |  | __ " <> "\\ V /" <> " / __| || | /_\\_   _|",
+      " \\__ \\| || |\\/| |  _/ |__| _|" <> " / . \\" <> "| (__| __ |/ _ \\| |",
+      " |___/___|_|  |_|_| |____|___" <> "/_/ \\_\\" <> "\\___|_||_/_/ \\_\\_|",
+      "",
+      "Welcome " <> green userName <> "!",
+      "Thank you for installing SimpleX Chat!",
+      "",
+      "We have a couple of groups that you can join to play with SimpleX Chat:",
+      highlight "#termux" <> " (Android Termux 📱) - chatting about using SimpleX Chat on Android devices",
+      highlight "#music" <> " (Music 🎸) - favorite music of our team and users",
+      "",
+      "Connect to SimpleX Chat team to be added to these groups - type " <> highlight "/simplex",
+      "",
+      "Follow our updates:",
+      "> Reddit: https://www.reddit.com/r/SimpleXChat/",
+      "> Twitter: https://twitter.com/SimpleXChat",
+      "",
+      "Type " <> highlight "/help" <> " for usage info, " <> highlight "/welcome" <> " to show this message"
+    ]
+  where
+    User {profile = Profile {displayName, fullName}} = user
+    userName = if T.null fullName then displayName else fullName
+
 chatHelpInfo :: [StyledString]
 chatHelpInfo =
   map
     styleMarkdown
-    [ highlight "Using SimpleX chat prototype",
+    [ highlight "Using SimpleX Chat",
       "Follow these steps to set up a connection:",
       "",
       green "Step 1: " <> highlight "/connect" <> " - Alice adds a contact.",
-      indent <> "Alice should send the invitation printed by the /add command",
+      indent <> "Alice should send the one-time invitation printed by the /connect command",
       indent <> "to her contact, Bob, out-of-band, via any trusted channel.",
       "",
       green "Step 2: " <> highlight "/connect <invitation>" <> " - Bob accepts the invitation.",
@@ -45,22 +79,22 @@ 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 "To send file:",
-      indent <> highlight "/file bob ./photo.jpg" <> " - Alice sends file to Bob",
-      indent <> "File commands: " <> highlight "/help files",
+      green "Send file: " <> highlight "/file bob ./photo.jpg",
       "",
-      green "To create group:",
-      indent <> highlight "/group team" <> " - create group #team",
-      indent <> "Group commands: " <> highlight "/help groups",
+      green "Create group: " <> highlight "/group team",
+      "",
+      green "Create your address: " <> highlight "/address",
       "",
       green "Other commands:",
-      indent <> highlight "/profile         " <> " - show user profile",
-      indent <> highlight "/profile <name> [<full_name>]" <> " - update user profile",
+      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 "/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 to a single letter: " <> listHighlight ["/c", "/f", "/g", "/p", "/h"] <> ", etc."
+      "The commands may be abbreviated: " <> listHighlight ["/c", "/f", "/g", "/p", "/ad"] <> ", etc."
     ]
 
 filesHelpInfo :: [StyledString]
@@ -89,9 +123,26 @@ 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]
+myAddressHelpInfo =
+  map
+    styleMarkdown
+    [ green "Your contact address commands:",
+      indent <> highlight "/address       " <> " - create your address",
+      indent <> highlight "/delete_address" <> " - delete your address (accepted contacts will remain connected)",
+      indent <> highlight "/show_address  " <> " - show your address",
+      indent <> highlight "/accept <name> " <> " - accept contact request",
+      indent <> highlight "/reject <name> " <> " - reject contact request",
+      "",
+      "Please note: you can receive spam contact requests, but it's safe to delete the address!",
+      "",
+      "The commands may be abbreviated: " <> listHighlight ["/ad", "/da", "/sa", "/ac", "/rc"]
     ]
 
 markdownInfo :: [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/Options.hs

@@ -7,7 +7,9 @@ import qualified Data.ByteString.Char8 as B
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Options.Applicative
-import Simplex.Messaging.Agent.Protocol (SMPServer (..), smpServerP)
+import Simplex.Chat.Controller (updateStr, versionStr)
+import Simplex.Messaging.Agent.Protocol (SMPServer (..))
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import System.FilePath (combine)
 
@@ -23,8 +25,9 @@ chatOpts appDir =
       ( long "database"
           <> short 'd'
           <> metavar "DB_FILE"
-          <> help ("sqlite database file path (" <> defaultDbFilePath <> ")")
+          <> help "Path prefix to chat and agent database files"
           <> value defaultDbFilePath
+          <> showDefault
       )
     <*> option
       parseSMPServer
@@ -32,31 +35,30 @@ chatOpts appDir =
           <> short 's'
           <> metavar "SERVER"
           <> help
-            ( "SMP server(s) to use"
-                <> "\n(smp2.simplex.im,smp3.simplex.im)"
-            )
+            "Comma separated list of SMP server(s) to use \
+            \(default: smp4.simplex.im,smp5.simplex.im,smp6.simplex.im)"
           <> value
             ( L.fromList
-                [ "smp2.simplex.im#z5W2QLQ1Br3Yd6CoWg7bIq1bHdwK7Y8bEiEXBs/WfAg=", -- London, UK
-                  "smp3.simplex.im#nxc7HnrnM8dOKgkMp008ub/9o9LXJlxlMrMpR+mfMQw=" -- Fremont, CA
+                [ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im",
+                  "smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im",
+                  "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im"
                 ]
             )
       )
   where
-    defaultDbFilePath = combine appDir "simplex"
+    defaultDbFilePath = combine appDir "simplex_v1"
 
 parseSMPServer :: ReadM (NonEmpty SMPServer)
 parseSMPServer = eitherReader $ parseAll servers . B.pack
   where
-    servers = L.fromList <$> smpServerP `A.sepBy1` A.char ','
+    servers = L.fromList <$> strP `A.sepBy1` A.char ','
 
 getChatOpts :: FilePath -> IO ChatOpts
-getChatOpts appDir = execParser opts
+getChatOpts appDir =
+  execParser $
+    info
+      (helper <*> versionOption <*> chatOpts appDir)
+      (header versionStr <> fullDesc <> progDesc "Start chat with DB_FILE file and use SERVER as SMP server")
   where
-    opts =
-      info
-        (chatOpts appDir <**> helper)
-        ( fullDesc
-            <> header "Chat prototype using Simplex Messaging Protocol (SMP)"
-            <> progDesc "Start chat with DB_FILE file and use SERVER as SMP server"
-        )
+    versionOption = infoOption versionAndUpdate (long "version" <> short 'v' <> help "Show version")
+    versionAndUpdate = versionStr <> "\n" <> updateStr

src/Simplex/Chat/Protocol.hs

@@ -1,35 +1,32 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TupleSections #-}
 
 module Simplex.Chat.Protocol where
 
-import Control.Applicative (optional)
 import Control.Monad ((<=<))
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON, ToJSON, (.:), (.:?), (.=))
 import qualified Data.Aeson as J
-import Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
-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.List (find)
+import qualified Data.HashMap.Strict as H
 import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
+import GHC.Generics
 import Simplex.Chat.Types
-import Simplex.Chat.Util (safeDecodeUtf8)
 import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Util (bshow)
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Util ((<$?>))
 
 data ChatDirection (p :: AParty) where
   ReceivedDirectMessage :: Connection -> Maybe Contact -> ChatDirection 'Agent
@@ -38,6 +35,7 @@ data ChatDirection (p :: AParty) where
   SentGroupMessage :: GroupName -> ChatDirection 'Client
   SndFileConnection :: Connection -> SndFileTransfer -> ChatDirection 'Agent
   RcvFileConnection :: Connection -> RcvFileTransfer -> ChatDirection 'Agent
+  UserContactConnection :: Connection -> UserContact -> ChatDirection 'Agent
 
 deriving instance Eq (ChatDirection p)
 
@@ -49,12 +47,31 @@ fromConnection = \case
   ReceivedGroupMessage conn _ _ -> conn
   SndFileConnection conn _ -> conn
   RcvFileConnection conn _ -> conn
+  UserContactConnection conn _ -> conn
+
+-- chat message is sent as JSON with these properties
+data AppMessage = AppMessage
+  { event :: Text,
+    params :: J.Object
+  }
+  deriving (Generic, FromJSON)
+
+instance ToJSON AppMessage where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+newtype ChatMessage = ChatMessage {chatMsgEvent :: ChatMsgEvent}
+  deriving (Eq, Show)
+
+instance StrEncoding ChatMessage where
+  strEncode = LB.toStrict . J.encode . chatToAppMessage
+  strDecode = appToChatMessage <=< J.eitherDecodeStrict'
+  strP = strDecode <$?> A.takeByteString
 
 data ChatMsgEvent
   = XMsgNew MsgContent
   | XFile FileInvitation
   | XFileAcpt String
   | XInfo Profile
+  | XContact Profile (Maybe MsgContent)
   | XGrpInv GroupInvitation
   | XGrpAcpt MemberId
   | XGrpMemNew MemberInfo
@@ -67,317 +84,215 @@ data ChatMsgEvent
   | XGrpMemDel MemberId
   | XGrpLeave
   | XGrpDel
-  | XInfoProbe ByteString
-  | XInfoProbeCheck ByteString
-  | XInfoProbeOk ByteString
+  | XInfoProbe Probe
+  | XInfoProbeCheck ProbeHash
+  | XInfoProbeOk Probe
   | XOk
   deriving (Eq, Show)
 
-data MessageType = MTText | MTImage deriving (Eq, Show)
+data MsgContentType = MCText_ | MCUnknown_
 
-data MsgContent = MsgContent
-  { messageType :: MessageType,
-    files :: [(ContentType, Int)],
-    content :: [MsgContentBody]
-  }
+instance StrEncoding MsgContentType where
+  strEncode = \case
+    MCText_ -> "text"
+    MCUnknown_ -> "text"
+  strDecode = \case
+    "text" -> Right MCText_
+    _ -> Right MCUnknown_
+  strP = strDecode <$?> A.takeTill (== ' ')
+
+instance FromJSON MsgContentType where
+  parseJSON = strParseJSON "MsgContentType"
+
+instance ToJSON MsgContentType where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+data MsgContent = MCText Text | MCUnknown
   deriving (Eq, Show)
 
-toMsgType :: ByteString -> Either String MessageType
-toMsgType = \case
-  "c.text" -> Right MTText
-  "c.image" -> Right MTImage
-  t -> Left $ "invalid message type " <> B.unpack t
+toMsgContentType :: MsgContent -> MsgContentType
+toMsgContentType = \case
+  MCText _ -> MCText_
+  MCUnknown -> MCUnknown_
 
-rawMsgType :: MessageType -> ByteString
-rawMsgType = \case
-  MTText -> "c.text"
-  MTImage -> "c.image"
+instance FromJSON MsgContent where
+  parseJSON (J.Object v) = do
+    v .: "type" >>= \case
+      MCText_ -> MCText <$> v .: "text"
+      MCUnknown_ -> pure MCUnknown
+  parseJSON invalid =
+    JT.prependFailure "bad MsgContent, " (JT.typeMismatch "Object" invalid)
 
-data ChatMessage = ChatMessage
-  { chatMsgId :: Maybe Int64,
-    chatMsgEvent :: ChatMsgEvent,
-    chatDAG :: Maybe ByteString
-  }
-  deriving (Eq, Show)
+unknownMsgType :: Text
+unknownMsgType = "unknown message type"
 
-toChatMessage :: RawChatMessage -> Either String ChatMessage
-toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody} = do
-  (chatDAG, body) <- getDAG <$> mapM toMsgBodyContent chatMsgBody
-  let chatMsg msg = pure ChatMessage {chatMsgId, chatMsgEvent = msg, chatDAG}
-  case (chatMsgEvent, chatMsgParams) of
-    ("x.msg.new", mt : rawFiles) -> do
-      t <- toMsgType mt
-      files <- mapM (toContentInfo <=< parseAll contentInfoP) rawFiles
-      chatMsg . XMsgNew $ MsgContent {messageType = t, files, content = body}
-    ("x.file", [name, size, qInfo]) -> do
-      let fileName = T.unpack $ safeDecodeUtf8 name
-      fileSize <- parseAll A.decimal size
-      fileQInfo <- parseAll smpQueueInfoP qInfo
-      chatMsg . XFile $ FileInvitation {fileName, fileSize, fileQInfo}
-    ("x.file.acpt", [name]) ->
-      chatMsg . XFileAcpt . T.unpack $ safeDecodeUtf8 name
-    ("x.info", []) -> do
-      profile <- getJSON body
-      chatMsg $ XInfo profile
-    ("x.grp.inv", [fromMemId, fromRole, memId, role, qInfo]) -> do
-      fromMem <- (,) <$> B64.decode fromMemId <*> toMemberRole fromRole
-      invitedMem <- (,) <$> B64.decode memId <*> toMemberRole role
-      groupQInfo <- parseAll smpQueueInfoP qInfo
-      profile <- getJSON body
-      chatMsg . XGrpInv $ GroupInvitation fromMem invitedMem groupQInfo profile
-    ("x.grp.acpt", [memId]) ->
-      chatMsg . XGrpAcpt =<< B64.decode memId
-    ("x.grp.mem.new", [memId, role]) -> do
-      chatMsg . XGrpMemNew =<< toMemberInfo memId role body
-    ("x.grp.mem.intro", [memId, role]) ->
-      chatMsg . XGrpMemIntro =<< toMemberInfo memId role body
-    ("x.grp.mem.inv", [memId, groupQInfo, directQInfo]) ->
-      chatMsg =<< (XGrpMemInv <$> B64.decode memId <*> toIntroInv groupQInfo directQInfo)
-    ("x.grp.mem.fwd", [memId, role, groupQInfo, directQInfo]) -> do
-      chatMsg =<< (XGrpMemFwd <$> toMemberInfo memId role body <*> toIntroInv groupQInfo directQInfo)
-    ("x.grp.mem.info", [memId]) ->
-      chatMsg =<< (XGrpMemInfo <$> B64.decode memId <*> getJSON body)
-    ("x.grp.mem.con", [memId]) ->
-      chatMsg . XGrpMemCon =<< B64.decode memId
-    ("x.grp.mem.con.all", [memId]) ->
-      chatMsg . XGrpMemConAll =<< B64.decode memId
-    ("x.grp.mem.del", [memId]) ->
-      chatMsg . XGrpMemDel =<< B64.decode memId
-    ("x.grp.leave", []) ->
-      chatMsg XGrpLeave
-    ("x.grp.del", []) ->
-      chatMsg XGrpDel
-    ("x.info.probe", [probe]) -> do
-      chatMsg . XInfoProbe =<< B64.decode probe
-    ("x.info.probe.check", [probeHash]) -> do
-      chatMsg =<< (XInfoProbeCheck <$> B64.decode probeHash)
-    ("x.info.probe.ok", [probe]) -> do
-      chatMsg =<< (XInfoProbeOk <$> B64.decode probe)
-    ("x.ok", []) ->
-      chatMsg XOk
-    _ -> Left $ "bad syntax or unsupported event " <> B.unpack chatMsgEvent
+instance ToJSON MsgContent where
+  toJSON mc =
+    J.object $
+      ("type" .= toMsgContentType mc) : case mc of
+        MCText t -> ["text" .= t]
+        MCUnknown -> ["text" .= unknownMsgType]
+  toEncoding mc =
+    J.pairs $
+      ("type" .= toMsgContentType mc) <> case mc of
+        MCText t -> "text" .= t
+        MCUnknown -> "text" .= unknownMsgType
+
+data CMEventTag
+  = XMsgNew_
+  | XFile_
+  | XFileAcpt_
+  | XInfo_
+  | XContact_
+  | XGrpInv_
+  | XGrpAcpt_
+  | XGrpMemNew_
+  | XGrpMemIntro_
+  | XGrpMemInv_
+  | XGrpMemFwd_
+  | XGrpMemInfo_
+  | XGrpMemCon_
+  | XGrpMemConAll_
+  | XGrpMemDel_
+  | XGrpLeave_
+  | XGrpDel_
+  | XInfoProbe_
+  | XInfoProbeCheck_
+  | XInfoProbeOk_
+  | XOk_
+
+instance StrEncoding CMEventTag where
+  strEncode = \case
+    XMsgNew_ -> "x.msg.new"
+    XFile_ -> "x.file"
+    XFileAcpt_ -> "x.file.acpt"
+    XInfo_ -> "x.info"
+    XContact_ -> "x.contact"
+    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"
+  strDecode = \case
+    "x.msg.new" -> Right XMsgNew_
+    "x.file" -> Right XFile_
+    "x.file.acpt" -> Right XFileAcpt_
+    "x.info" -> Right XInfo_
+    "x.contact" -> Right XContact_
+    "x.grp.inv" -> Right XGrpInv_
+    "x.grp.acpt" -> Right XGrpAcpt_
+    "x.grp.mem.new" -> Right XGrpMemNew_
+    "x.grp.mem.intro" -> Right XGrpMemIntro_
+    "x.grp.mem.inv" -> Right XGrpMemInv_
+    "x.grp.mem.fwd" -> Right XGrpMemFwd_
+    "x.grp.mem.info" -> Right XGrpMemInfo_
+    "x.grp.mem.con" -> Right XGrpMemCon_
+    "x.grp.mem.con.all" -> Right XGrpMemConAll_
+    "x.grp.mem.del" -> Right XGrpMemDel_
+    "x.grp.leave" -> Right XGrpLeave_
+    "x.grp.del" -> Right XGrpDel_
+    "x.info.probe" -> Right XInfoProbe_
+    "x.info.probe.check" -> Right XInfoProbeCheck_
+    "x.info.probe.ok" -> Right XInfoProbeOk_
+    "x.ok" -> Right XOk_
+    _ -> Left "bad CMEventTag"
+  strP = strDecode <$?> A.takeTill (== ' ')
+
+toCMEventTag :: ChatMsgEvent -> CMEventTag
+toCMEventTag = \case
+  XMsgNew _ -> XMsgNew_
+  XFile _ -> XFile_
+  XFileAcpt _ -> XFileAcpt_
+  XInfo _ -> XInfo_
+  XContact _ _ -> XContact_
+  XGrpInv _ -> XGrpInv_
+  XGrpAcpt _ -> XGrpAcpt_
+  XGrpMemNew _ -> XGrpMemNew_
+  XGrpMemIntro _ -> XGrpMemIntro_
+  XGrpMemInv _ _ -> XGrpMemInv_
+  XGrpMemFwd _ _ -> XGrpMemFwd_
+  XGrpMemInfo _ _ -> XGrpMemInfo_
+  XGrpMemCon _ -> XGrpMemCon_
+  XGrpMemConAll _ -> XGrpMemConAll_
+  XGrpMemDel _ -> XGrpMemDel_
+  XGrpLeave -> XGrpLeave_
+  XGrpDel -> XGrpDel_
+  XInfoProbe _ -> XInfoProbe_
+  XInfoProbeCheck _ -> XInfoProbeCheck_
+  XInfoProbeOk _ -> XInfoProbeOk_
+  XOk -> XOk_
+
+toChatEventTag :: ChatMsgEvent -> Text
+toChatEventTag = decodeLatin1 . strEncode . toCMEventTag
+
+appToChatMessage :: AppMessage -> Either String ChatMessage
+appToChatMessage AppMessage {event, params} = do
+  eventTag <- strDecode $ encodeUtf8 event
+  chatMsgEvent <- msg eventTag
+  pure ChatMessage {chatMsgEvent}
   where
-    getDAG :: [MsgContentBody] -> (Maybe ByteString, [MsgContentBody])
-    getDAG body = case break (isContentType SimplexDAG) body of
-      (b, MsgContentBody SimplexDAG dag : a) -> (Just dag, b <> a)
-      _ -> (Nothing, body)
-    toMemberInfo :: ByteString -> ByteString -> [MsgContentBody] -> Either String MemberInfo
-    toMemberInfo memId role body = MemberInfo <$> B64.decode memId <*> toMemberRole role <*> getJSON body
-    toIntroInv :: ByteString -> ByteString -> Either String IntroInvitation
-    toIntroInv groupQInfo directQInfo = IntroInvitation <$> parseAll smpQueueInfoP groupQInfo <*> parseAll smpQueueInfoP directQInfo
-    toContentInfo :: (RawContentType, Int) -> Either String (ContentType, Int)
-    toContentInfo (rawType, size) = (,size) <$> toContentType rawType
-    getJSON :: FromJSON a => [MsgContentBody] -> Either String a
-    getJSON = J.eitherDecodeStrict' <=< getSimplexContentType XCJson
+    p :: FromJSON a => Text -> Either String a
+    p key = JT.parseEither (.: key) params
+    msg = \case
+      XMsgNew_ -> XMsgNew <$> p "content"
+      XFile_ -> XFile <$> p "file"
+      XFileAcpt_ -> XFileAcpt <$> p "fileName"
+      XInfo_ -> XInfo <$> p "profile"
+      XContact_ -> XContact <$> p "profile" <*> JT.parseEither (.:? "content") params
+      XGrpInv_ -> XGrpInv <$> p "groupInvitation"
+      XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
+      XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
+      XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo"
+      XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
+      XGrpMemFwd_ -> XGrpMemFwd <$> p "memberInfo" <*> p "memberIntro"
+      XGrpMemInfo_ -> XGrpMemInfo <$> p "memberId" <*> p "profile"
+      XGrpMemCon_ -> XGrpMemCon <$> p "memberId"
+      XGrpMemConAll_ -> XGrpMemConAll <$> p "memberId"
+      XGrpMemDel_ -> XGrpMemDel <$> p "memberId"
+      XGrpLeave_ -> pure XGrpLeave
+      XGrpDel_ -> pure XGrpDel
+      XInfoProbe_ -> XInfoProbe <$> p "probe"
+      XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash"
+      XInfoProbeOk_ -> XInfoProbeOk <$> p "probe"
+      XOk_ -> pure XOk
 
-isContentType :: ContentType -> MsgContentBody -> Bool
-isContentType t MsgContentBody {contentType = t'} = t == t'
-
-isSimplexContentType :: XContentType -> MsgContentBody -> Bool
-isSimplexContentType = isContentType . SimplexContentType
-
-getContentType :: ContentType -> [MsgContentBody] -> Either String ByteString
-getContentType t body = case find (isContentType t) body of
-  Just MsgContentBody {contentData} -> Right contentData
-  Nothing -> Left "no required content type"
-
-getSimplexContentType :: XContentType -> [MsgContentBody] -> Either String ByteString
-getSimplexContentType = getContentType . SimplexContentType
-
-rawChatMessage :: ChatMessage -> RawChatMessage
-rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
-  case chatMsgEvent of
-    XMsgNew MsgContent {messageType = t, files, content} ->
-      let rawFiles = map (serializeContentInfo . rawContentInfo) files
-       in rawMsg "x.msg.new" (rawMsgType t : rawFiles) content
-    XFile FileInvitation {fileName, fileSize, fileQInfo} ->
-      rawMsg "x.file" [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeSmpQueueInfo fileQInfo] []
-    XFileAcpt fileName ->
-      rawMsg "x.file.acpt" [encodeUtf8 $ T.pack fileName] []
-    XInfo profile ->
-      rawMsg "x.info" [] [jsonBody profile]
-    XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) qInfo groupProfile) ->
-      let params =
-            [ B64.encode fromMemId,
-              serializeMemberRole fromRole,
-              B64.encode memId,
-              serializeMemberRole role,
-              serializeSmpQueueInfo qInfo
-            ]
-       in rawMsg "x.grp.inv" params [jsonBody groupProfile]
-    XGrpAcpt memId ->
-      rawMsg "x.grp.acpt" [B64.encode memId] []
-    XGrpMemNew (MemberInfo memId role profile) ->
-      let params = [B64.encode memId, serializeMemberRole role]
-       in rawMsg "x.grp.mem.new" params [jsonBody profile]
-    XGrpMemIntro (MemberInfo memId role profile) ->
-      rawMsg "x.grp.mem.intro" [B64.encode memId, serializeMemberRole role] [jsonBody profile]
-    XGrpMemInv memId IntroInvitation {groupQInfo, directQInfo} ->
-      let params = [B64.encode memId, serializeSmpQueueInfo groupQInfo, serializeSmpQueueInfo directQInfo]
-       in rawMsg "x.grp.mem.inv" params []
-    XGrpMemFwd (MemberInfo memId role profile) IntroInvitation {groupQInfo, directQInfo} ->
-      let params =
-            [ B64.encode memId,
-              serializeMemberRole role,
-              serializeSmpQueueInfo groupQInfo,
-              serializeSmpQueueInfo directQInfo
-            ]
-       in rawMsg "x.grp.mem.fwd" params [jsonBody profile]
-    XGrpMemInfo memId profile ->
-      rawMsg "x.grp.mem.info" [B64.encode memId] [jsonBody profile]
-    XGrpMemCon memId ->
-      rawMsg "x.grp.mem.con" [B64.encode memId] []
-    XGrpMemConAll memId ->
-      rawMsg "x.grp.mem.con.all" [B64.encode memId] []
-    XGrpMemDel memId ->
-      rawMsg "x.grp.mem.del" [B64.encode memId] []
-    XGrpLeave ->
-      rawMsg "x.grp.leave" [] []
-    XGrpDel ->
-      rawMsg "x.grp.del" [] []
-    XInfoProbe probe ->
-      rawMsg "x.info.probe" [B64.encode probe] []
-    XInfoProbeCheck probeHash ->
-      rawMsg "x.info.probe.check" [B64.encode probeHash] []
-    XInfoProbeOk probe ->
-      rawMsg "x.info.probe.ok" [B64.encode probe] []
-    XOk ->
-      rawMsg "x.ok" [] []
+chatToAppMessage :: ChatMessage -> AppMessage
+chatToAppMessage ChatMessage {chatMsgEvent} = AppMessage {event, params}
   where
-    rawMsg :: ByteString -> [ByteString] -> [MsgContentBody] -> RawChatMessage
-    rawMsg event chatMsgParams body =
-      RawChatMessage {chatMsgId, chatMsgEvent = event, chatMsgParams, chatMsgBody = rawWithDAG body}
-    rawContentInfo :: (ContentType, Int) -> (RawContentType, Int)
-    rawContentInfo (t, size) = (rawContentType t, size)
-    jsonBody :: ToJSON a => a -> MsgContentBody
-    jsonBody x =
-      let json = LB.toStrict $ J.encode x
-       in MsgContentBody {contentType = SimplexContentType XCJson, contentData = json}
-    rawWithDAG :: [MsgContentBody] -> [RawMsgBodyContent]
-    rawWithDAG body = map rawMsgBodyContent $ case chatDAG of
-      Nothing -> body
-      Just dag -> MsgContentBody {contentType = SimplexDAG, contentData = dag} : body
-
-toMsgBodyContent :: RawMsgBodyContent -> Either String MsgContentBody
-toMsgBodyContent RawMsgBodyContent {contentType, contentData} = do
-  cType <- toContentType contentType
-  pure MsgContentBody {contentType = cType, contentData}
-
-rawMsgBodyContent :: MsgContentBody -> RawMsgBodyContent
-rawMsgBodyContent MsgContentBody {contentType = t, contentData} =
-  RawMsgBodyContent {contentType = rawContentType t, contentData}
-
-data MsgContentBody = MsgContentBody
-  { contentType :: ContentType,
-    contentData :: ByteString
-  }
-  deriving (Eq, Show)
-
-data ContentType
-  = SimplexContentType XContentType
-  | MimeContentType MContentType
-  | SimplexDAG
-  deriving (Eq, Show)
-
-data XContentType = XCText | XCImage | XCJson deriving (Eq, Show)
-
-data MContentType = MCImageJPG | MCImagePNG deriving (Eq, Show)
-
-toContentType :: RawContentType -> Either String ContentType
-toContentType (RawContentType ns cType) = case ns of
-  "x" -> case cType of
-    "text" -> Right $ SimplexContentType XCText
-    "image" -> Right $ SimplexContentType XCImage
-    "json" -> Right $ SimplexContentType XCJson
-    "dag" -> Right SimplexDAG
-    _ -> err
-  "m" -> case cType of
-    "image/jpg" -> Right $ MimeContentType MCImageJPG
-    "image/png" -> Right $ MimeContentType MCImagePNG
-    _ -> err
-  _ -> err
-  where
-    err = Left . B.unpack $ "invalid content type " <> ns <> "." <> cType
-
-rawContentType :: ContentType -> RawContentType
-rawContentType t = case t of
-  SimplexContentType t' -> RawContentType "x" $ case t' of
-    XCText -> "text"
-    XCImage -> "image"
-    XCJson -> "json"
-  MimeContentType t' -> RawContentType "m" $ case t' of
-    MCImageJPG -> "image/jpg"
-    MCImagePNG -> "image/png"
-  SimplexDAG -> RawContentType "x" "dag"
-
-newtype ContentMsg = NewContentMsg ContentData
-
-newtype ContentData = ContentText Text
-
-data RawChatMessage = RawChatMessage
-  { chatMsgId :: Maybe Int64,
-    chatMsgEvent :: ByteString,
-    chatMsgParams :: [ByteString],
-    chatMsgBody :: [RawMsgBodyContent]
-  }
-  deriving (Eq, Show)
-
-data RawMsgBodyContent = RawMsgBodyContent
-  { contentType :: RawContentType,
-    contentData :: ByteString
-  }
-  deriving (Eq, Show)
-
-data RawContentType = RawContentType NameSpace ByteString
-  deriving (Eq, Show)
-
-type NameSpace = ByteString
-
-newtype MsgData = MsgData ByteString
-  deriving (Eq, Show)
-
-class DataLength a where
-  dataLength :: a -> Int
-
-rawChatMessageP :: Parser RawChatMessage
-rawChatMessageP = do
-  chatMsgId <- optional A.decimal <* A.space
-  chatMsgEvent <- B.intercalate "." <$> identifierP `A.sepBy1'` A.char '.' <* A.space
-  chatMsgParams <- A.takeWhile1 (not . A.inClass ", ") `A.sepBy'` A.char ',' <* A.space
-  chatMsgBody <- msgBodyContent =<< contentInfoP `A.sepBy'` A.char ',' <* A.space
-  pure RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody}
-  where
-    msgBodyContent :: [(RawContentType, Int)] -> Parser [RawMsgBodyContent]
-    msgBodyContent [] = pure []
-    msgBodyContent ((contentType, size) : ps) = do
-      contentData <- A.take size <* A.space
-      ((RawMsgBodyContent {contentType, contentData}) :) <$> msgBodyContent ps
-
-contentInfoP :: Parser (RawContentType, Int)
-contentInfoP = do
-  contentType <- RawContentType <$> identifierP <* A.char '.' <*> A.takeTill (A.inClass ":, ")
-  size <- A.char ':' *> A.decimal
-  pure (contentType, size)
-
-identifierP :: Parser ByteString
-identifierP = B.cons <$> A.letter_ascii <*> A.takeWhile (\c -> A.isAlpha_ascii c || A.isDigit c)
-
-serializeRawChatMessage :: RawChatMessage -> ByteString
-serializeRawChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody} =
-  B.unwords
-    [ maybe "" bshow chatMsgId,
-      chatMsgEvent,
-      B.intercalate "," chatMsgParams,
-      B.unwords $ map serializeBodyContentInfo chatMsgBody,
-      B.unwords $ map msgContentData chatMsgBody
-    ]
-
-serializeBodyContentInfo :: RawMsgBodyContent -> ByteString
-serializeBodyContentInfo RawMsgBodyContent {contentType = t, contentData} =
-  serializeContentInfo (t, B.length contentData)
-
-serializeContentInfo :: (RawContentType, Int) -> ByteString
-serializeContentInfo (RawContentType ns cType, size) = ns <> "." <> cType <> ":" <> bshow size
-
-msgContentData :: RawMsgBodyContent -> ByteString
-msgContentData RawMsgBodyContent {contentData} = contentData <> " "
+    event = toChatEventTag chatMsgEvent
+    o :: [(Text, J.Value)] -> J.Object
+    o = H.fromList
+    params = case chatMsgEvent of
+      XMsgNew content -> o ["content" .= content]
+      XFile fileInv -> o ["file" .= fileInv]
+      XFileAcpt fileName -> o ["fileName" .= fileName]
+      XInfo profile -> o ["profile" .= profile]
+      XContact profile content -> o $ maybe id ((:) . ("content" .=)) content ["profile" .= profile]
+      XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
+      XGrpAcpt memId -> o ["memberId" .= memId]
+      XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
+      XGrpMemIntro memInfo -> o ["memberInfo" .= memInfo]
+      XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]
+      XGrpMemFwd memInfo memIntro -> o ["memberInfo" .= memInfo, "memberIntro" .= memIntro]
+      XGrpMemInfo memId profile -> o ["memberId" .= memId, "profile" .= profile]
+      XGrpMemCon memId -> o ["memberId" .= memId]
+      XGrpMemConAll memId -> o ["memberId" .= memId]
+      XGrpMemDel memId -> o ["memberId" .= memId]
+      XGrpLeave -> H.empty
+      XGrpDel -> H.empty
+      XInfoProbe probe -> o ["probe" .= probe]
+      XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash]
+      XInfoProbeOk probe -> o ["probe" .= probe]
+      XOk -> H.empty

src/Simplex/Chat/Store.hs

@@ -17,6 +17,7 @@ module Simplex.Chat.Store
   ( SQLiteStore,
     StoreError (..),
     createStore,
+    chatStoreFile,
     createUser,
     getUsers,
     setActiveUser,
@@ -28,6 +29,14 @@ module Simplex.Chat.Store
     updateUserProfile,
     updateContactProfile,
     getUserContacts,
+    createUserContactLink,
+    getUserContactLinkConnections,
+    deleteUserContactLink,
+    getUserContactLink,
+    createContactRequest,
+    getContactRequest,
+    deleteContactRequest,
+    createAcceptedContact,
     getLiveSndFileTransfers,
     getLiveRcvFileTransfers,
     getPendingSndChunks,
@@ -40,8 +49,10 @@ module Simplex.Chat.Store
     getGroup,
     deleteGroup,
     getUserGroups,
+    getUserGroupDetails,
     getGroupInvitation,
-    createContactGroupMember,
+    createContactMember,
+    getMemberInvitation,
     createMemberConnection,
     updateGroupMemberStatus,
     createNewGroupMember,
@@ -79,6 +90,11 @@ module Simplex.Chat.Store
     deleteRcvFileChunks,
     getFileTransfer,
     getFileTransferProgress,
+    createNewMessage,
+    createSndMsgDelivery,
+    createNewMessageAndRcvMsgDelivery,
+    createSndMsgDeliveryEvent,
+    createRcvMsgDeliveryEvent,
   )
 where
 
@@ -107,7 +123,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, SMPQueueInfo)
+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
@@ -127,6 +143,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)
 
@@ -180,20 +199,45 @@ setActiveUser st userId = do
 createDirectConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnId -> m ()
 createDirectConnection st userId agentConnId =
   liftIO . withTransaction st $ \db ->
-    void $ createConnection_ db userId agentConnId Nothing 0
+    void $ createContactConnection_ db userId agentConnId Nothing 0
 
-createConnection_ :: DB.Connection -> UserId -> ConnId -> Maybe Int64 -> Int -> IO Connection
-createConnection_ db userId agentConnId viaContact connLevel = do
+createContactConnection_ :: DB.Connection -> UserId -> ConnId -> Maybe Int64 -> Int -> IO Connection
+createContactConnection_ db userId = createConnection_ db userId ConnContact Nothing
+
+-- field types coincidentally match, but the first element here is user ID and not connection ID as in ConnectionRow
+type InsertedConnectionRow = ConnectionRow
+
+createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> Maybe Int64 -> Int -> IO Connection
+createConnection_ db userId connType entityId agentConnId viaContact connLevel = do
   createdAt <- getCurrentTime
   DB.execute
     db
     [sql|
-      INSERT INTO connections
-        (user_id, agent_conn_id, conn_status, conn_type, via_contact, conn_level, created_at) VALUES (?,?,?,?,?,?,?);
+      INSERT INTO connections (
+        user_id, agent_conn_id, conn_level, via_contact, conn_status, conn_type,
+        contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
+      ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?);
     |]
-    (userId, agentConnId, ConnNew, ConnContact, viaContact, connLevel, createdAt)
+    (insertConnParams createdAt)
   connId <- insertedRowId db
-  pure Connection {connId, agentConnId, connType = ConnContact, entityId = Nothing, viaContact, connLevel, connStatus = ConnNew, createdAt}
+  pure Connection {connId, agentConnId, connType, entityId, viaContact, connLevel, connStatus = ConnNew, createdAt}
+  where
+    insertConnParams :: UTCTime -> InsertedConnectionRow
+    insertConnParams createdAt =
+      ( userId,
+        agentConnId,
+        connLevel,
+        viaContact,
+        ConnNew,
+        connType,
+        ent ConnContact,
+        ent ConnMember,
+        ent ConnSndFile,
+        ent ConnRcvFile,
+        ent ConnUserContact,
+        createdAt
+      )
+    ent ct = if connType == ct then entityId else Nothing
 
 createDirectContact :: StoreMonad m => SQLiteStore -> UserId -> Connection -> Profile -> m ()
 createDirectContact st userId Connection {connId} profile =
@@ -337,7 +381,7 @@ getContact_ db userId localDisplayName = do
           db
           [sql|
             SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
             FROM connections c
             WHERE c.user_id = :user_id AND c.contact_id == :contact_id
             ORDER BY c.connection_id DESC
@@ -359,6 +403,142 @@ getUserContacts st User {userId} =
     contactNames <- map fromOnly <$> DB.query db "SELECT local_display_name FROM contacts WHERE user_id = ?" (Only userId)
     rights <$> mapM (runExceptT . getContact_ db userId) contactNames
 
+createUserContactLink :: StoreMonad m => SQLiteStore -> UserId -> ConnId -> ConnReqContact -> m ()
+createUserContactLink st userId agentConnId cReq =
+  liftIOEither . checkConstraint SEDuplicateContactLink . withTransaction st $ \db -> do
+    DB.execute db "INSERT INTO user_contact_links (user_id, conn_req_contact) VALUES (?, ?)" (userId, cReq)
+    userContactLinkId <- insertedRowId db
+    Right () <$ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId Nothing 0
+
+getUserContactLinkConnections :: StoreMonad m => SQLiteStore -> UserId -> m [Connection]
+getUserContactLinkConnections st userId =
+  liftIOEither . withTransaction st $ \db ->
+    connections
+      <$> DB.queryNamed
+        db
+        [sql|
+          SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
+          FROM connections c
+          JOIN user_contact_links uc ON c.user_contact_link_id == uc.user_contact_link_id
+          WHERE c.user_id = :user_id
+            AND uc.user_id = :user_id
+            AND uc.local_display_name = ''
+        |]
+        [":user_id" := userId]
+  where
+    connections [] = Left SEUserContactLinkNotFound
+    connections rows = Right $ map toConnection rows
+
+deleteUserContactLink :: MonadUnliftIO m => SQLiteStore -> UserId -> m ()
+deleteUserContactLink st userId =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute
+      db
+      [sql|
+        DELETE FROM connections WHERE connection_id IN (
+          SELECT connection_id
+          FROM connections c
+          JOIN user_contact_links uc USING (user_contact_link_id)
+          WHERE uc.user_id = ? AND uc.local_display_name = ''
+        )
+      |]
+      (Only userId)
+    DB.executeNamed
+      db
+      [sql|
+        DELETE FROM display_names
+        WHERE user_id = :user_id
+          AND local_display_name in (
+            SELECT cr.local_display_name
+            FROM contact_requests cr
+            JOIN user_contact_links uc USING (user_contact_link_id)
+            WHERE uc.user_id = :user_id
+              AND uc.local_display_name = ''
+          )
+      |]
+      [":user_id" := userId]
+    DB.executeNamed
+      db
+      [sql|
+        DELETE FROM contact_profiles
+        WHERE contact_profile_id in (
+          SELECT cr.contact_profile_id
+          FROM contact_requests cr
+          JOIN user_contact_links uc USING (user_contact_link_id)
+          WHERE uc.user_id = :user_id
+            AND uc.local_display_name = ''
+        )
+      |]
+      [":user_id" := userId]
+    DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND local_display_name = ''" (Only userId)
+
+getUserContactLink :: StoreMonad m => SQLiteStore -> UserId -> m ConnReqContact
+getUserContactLink st userId =
+  liftIOEither . withTransaction st $ \db ->
+    connReq
+      <$> DB.query
+        db
+        [sql|
+          SELECT conn_req_contact
+          FROM user_contact_links
+          WHERE user_id = ?
+            AND local_display_name = ''
+        |]
+        (Only userId)
+  where
+    connReq [Only cReq] = Right cReq
+    connReq _ = Left SEUserContactLinkNotFound
+
+createContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> InvitationId -> Profile -> m ContactName
+createContactRequest st userId userContactId invId Profile {displayName, fullName} =
+  liftIOEither . withTransaction st $ \db ->
+    withLocalDisplayName db userId displayName $ \ldn -> do
+      DB.execute db "INSERT INTO contact_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
+      profileId <- insertedRowId db
+      DB.execute
+        db
+        [sql|
+          INSERT INTO contact_requests
+          (user_contact_link_id, agent_invitation_id, contact_profile_id, local_display_name, user_id) VALUES (?,?,?,?,?)
+        |]
+        (userContactId, invId, profileId, ldn, userId)
+      pure ldn
+
+getContactRequest :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m UserContactRequest
+getContactRequest st userId localDisplayName =
+  liftIOEither . withTransaction st $ \db ->
+    contactReq
+      <$> DB.query
+        db
+        [sql|
+          SELECT cr.contact_request_id, cr.agent_invitation_id, cr.user_contact_link_id,
+            c.agent_conn_id, cr.contact_profile_id
+          FROM contact_requests cr
+          JOIN connections c USING (user_contact_link_id)
+          WHERE cr.user_id = ?
+            AND cr.local_display_name = ?
+        |]
+        (userId, localDisplayName)
+  where
+    contactReq [(contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, profileId)] =
+      Right UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, profileId, localDisplayName}
+    contactReq _ = Left $ SEContactRequestNotFound localDisplayName
+
+deleteContactRequest :: MonadUnliftIO m => SQLiteStore -> UserId -> ContactName -> m ()
+deleteContactRequest st userId localDisplayName =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+    DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+
+createAcceptedContact :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnId -> ContactName -> Int64 -> m ()
+createAcceptedContact st userId agentConnId localDisplayName profileId =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+    DB.execute db "INSERT INTO contacts (user_id, local_display_name, contact_profile_id) VALUES (?,?,?)" (userId, localDisplayName, profileId)
+    contactId <- insertedRowId db
+    void $ createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing 0
+
 getLiveSndFileTransfers :: MonadUnliftIO m => SQLiteStore -> User -> m [SndFileTransfer]
 getLiveSndFileTransfers st User {userId} =
   liftIO . withTransaction st $ \db -> do
@@ -416,7 +596,7 @@ getPendingConnections st User {userId} =
         db
         [sql|
           SELECT connection_id, agent_conn_id, conn_level, via_contact,
-            conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, created_at
+            conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
           FROM connections
           WHERE user_id = :user_id
             AND conn_type = :conn_type
@@ -432,7 +612,7 @@ getContactConnections st userId displayName =
         db
         [sql|
           SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
           FROM connections c
           JOIN contacts cs ON c.contact_id == cs.contact_id
           WHERE c.user_id = :user_id
@@ -444,12 +624,12 @@ getContactConnections st userId displayName =
     connections [] = Left $ SEContactNotFound displayName
     connections rows = Right $ map toConnection rows
 
-type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, UTCTime)
+type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, UTCTime)
 
-type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
+type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
 
 toConnection :: ConnectionRow -> Connection
-toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, createdAt) =
+toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId, createdAt) =
   let entityId = entityId_ connType
    in Connection {connId, agentConnId, connLevel, viaContact, connStatus, connType, entityId, createdAt}
   where
@@ -458,10 +638,11 @@ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType,
     entityId_ ConnMember = groupMemberId
     entityId_ ConnRcvFile = rcvFileId
     entityId_ ConnSndFile = sndFileId
+    entityId_ ConnUserContact = userContactLinkId
 
 toMaybeConnection :: MaybeConnectionRow -> Maybe Connection
-toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, sndFileId, rcvFileId, Just createdAt) =
-  Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, createdAt)
+toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId, Just createdAt) =
+  Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId, createdAt)
 toMaybeConnection _ = Nothing
 
 getMatchingContacts :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [Contact]
@@ -485,20 +666,20 @@ getMatchingContacts st userId Contact {contactId, profile = Profile {displayName
           ]
     rights <$> mapM (runExceptT . getContact_ db userId) contactNames
 
-createSentProbe :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> UserId -> Contact -> m (ByteString, Int64)
+createSentProbe :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> UserId -> Contact -> m (Probe, Int64)
 createSentProbe st gVar userId _to@Contact {contactId} =
   liftIOEither . withTransaction st $ \db ->
     createWithRandomBytes 32 gVar $ \probe -> do
       DB.execute db "INSERT INTO sent_probes (contact_id, probe, user_id) VALUES (?,?,?)" (contactId, probe, userId)
-      (probe,) <$> insertedRowId db
+      (Probe probe,) <$> insertedRowId db
 
 createSentProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> Contact -> m ()
 createSentProbeHash st userId probeId _to@Contact {contactId} =
   liftIO . withTransaction st $ \db ->
     DB.execute db "INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, user_id) VALUES (?,?,?)" (probeId, contactId, userId)
 
-matchReceivedProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe Contact)
-matchReceivedProbe st userId _from@Contact {contactId} probe =
+matchReceivedProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Probe -> m (Maybe Contact)
+matchReceivedProbe st userId _from@Contact {contactId} (Probe probe) =
   liftIO . withTransaction st $ \db -> do
     let probeHash = C.sha256Hash probe
     contactNames <-
@@ -519,8 +700,8 @@ matchReceivedProbe st userId _from@Contact {contactId} probe =
         either (const Nothing) Just
           <$> runExceptT (getContact_ db userId cName)
 
-matchReceivedProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe (Contact, ByteString))
-matchReceivedProbeHash st userId _from@Contact {contactId} probeHash =
+matchReceivedProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ProbeHash -> m (Maybe (Contact, Probe))
+matchReceivedProbeHash st userId _from@Contact {contactId} (ProbeHash probeHash) =
   liftIO . withTransaction st $ \db -> do
     namesAndProbes <-
       DB.query
@@ -536,11 +717,11 @@ matchReceivedProbeHash st userId _from@Contact {contactId} probeHash =
     case namesAndProbes of
       [] -> pure Nothing
       (cName, probe) : _ ->
-        either (const Nothing) (Just . (,probe))
+        either (const Nothing) (Just . (,Probe probe))
           <$> runExceptT (getContact_ db userId cName)
 
-matchSentProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe Contact)
-matchSentProbe st userId _from@Contact {contactId} probe =
+matchSentProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Probe -> m (Maybe Contact)
+matchSentProbe st userId _from@Contact {contactId} (Probe probe) =
   liftIO . withTransaction st $ \db -> do
     contactNames <-
       map fromOnly
@@ -566,7 +747,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|
@@ -599,6 +779,7 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
           ConnContact -> ReceivedDirectMessage c . Just <$> getContactRec_ db entId c
           ConnSndFile -> SndFileConnection c <$> getConnSndFileTransfer_ db entId c
           ConnRcvFile -> RcvFileConnection c <$> ExceptT (getRcvFileTransfer_ db userId entId)
+          ConnUserContact -> UserContactConnection c <$> getUserContact_ db entId
   where
     getConnection_ :: DB.Connection -> ExceptT StoreError IO Connection
     getConnection_ db = ExceptT $ do
@@ -607,7 +788,7 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
           db
           [sql|
             SELECT connection_id, agent_conn_id, conn_level, via_contact,
-              conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, created_at
+              conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
             FROM connections
             WHERE user_id = ? AND agent_conn_id = ?
           |]
@@ -674,6 +855,21 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
         Just recipientDisplayName -> Right SndFileTransfer {..}
         Nothing -> Left $ SESndFileInvalid fileId
     sndFileTransfer_ fileId _ _ = Left $ SESndFileNotFound fileId
+    getUserContact_ :: DB.Connection -> Int64 -> ExceptT StoreError IO UserContact
+    getUserContact_ db userContactLinkId = ExceptT $ do
+      userContact_
+        <$> DB.query
+          db
+          [sql|
+            SELECT conn_req_contact
+            FROM user_contact_links
+            WHERE user_id = ? AND user_contact_link_id = ?
+          |]
+          (userId, userContactLinkId)
+      where
+        userContact_ :: [Only ConnReqContact] -> Either StoreError UserContact
+        userContact_ [Only cReq] = Right UserContact {userContactLinkId, connReqContact = cReq}
+        userContact_ _ = Left SEUserContactLinkNotFound
 
 updateConnectionStatus :: MonadUnliftIO m => SQLiteStore -> Connection -> ConnStatus -> m ()
 updateConnectionStatus st Connection {connId} connStatus =
@@ -692,24 +888,34 @@ createNewGroup st gVar user groupProfile =
     DB.execute db "INSERT INTO groups (local_display_name, user_id, group_profile_id) VALUES (?, ?, ?)" (displayName, uId, profileId)
     groupId <- insertedRowId db
     memberId <- randomBytes gVar 12
-    membership <- createContactMember_ db user groupId user (memberId, GROwner) GCUserMember GSMemCreator IBUser
+    membership <- createContactMember_ db user groupId user (MemberIdRole (MemberId 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, queueInfo, 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, queueInfo, 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
@@ -717,14 +923,14 @@ getGroup :: StoreMonad m => SQLiteStore -> User -> GroupName -> m Group
 getGroup st user localDisplayName =
   liftIOEither . withTransaction st $ \db -> runExceptT $ fst <$> getGroup_ db user localDisplayName
 
-getGroup_ :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO (Group, Maybe SMPQueueInfo)
+getGroup_ :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO (Group, Maybe ConnReqInvitation)
 getGroup_ db User {userId, userContactId} localDisplayName = do
-  (g@Group {groupId}, qInfo) <- getGroupRec_
+  (g@Group {groupId}, cReq) <- getGroupRec_
   allMembers <- getMembers_ groupId
   (members, membership) <- liftEither $ splitUserMember_ allMembers
-  pure (g {members, membership}, qInfo)
+  pure (g {members, membership}, cReq)
   where
-    getGroupRec_ :: ExceptT StoreError IO (Group, Maybe SMPQueueInfo)
+    getGroupRec_ :: ExceptT StoreError IO (Group, Maybe ConnReqInvitation)
     getGroupRec_ = ExceptT $ do
       toGroup
         <$> DB.query
@@ -736,10 +942,10 @@ getGroup_ db User {userId, userContactId} localDisplayName = do
             WHERE g.local_display_name = ? AND g.user_id = ?
           |]
           (localDisplayName, userId)
-    toGroup :: [(Int64, GroupName, Text, Maybe SMPQueueInfo)] -> Either StoreError (Group, Maybe SMPQueueInfo)
-    toGroup [(groupId, displayName, fullName, qInfo)] =
+    toGroup :: [(Int64, GroupName, Text, Maybe ConnReqInvitation)] -> Either StoreError (Group, Maybe ConnReqInvitation)
+    toGroup [(groupId, displayName, fullName, cReq)] =
       let groupProfile = GroupProfile {displayName, fullName}
-       in Right (Group {groupId, localDisplayName, groupProfile, members = undefined, membership = undefined}, qInfo)
+       in Right (Group {groupId, localDisplayName, groupProfile, members = undefined, membership = undefined}, cReq)
     toGroup _ = Left $ SEGroupNotFound localDisplayName
     getMembers_ :: Int64 -> ExceptT StoreError IO [GroupMember]
     getMembers_ groupId = ExceptT $ do
@@ -751,7 +957,7 @@ getGroup_ db User {userId, userContactId} localDisplayName = do
               m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
               m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
               c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
             FROM group_members m
             JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
             LEFT JOIN connections c ON c.connection_id = (
@@ -778,29 +984,44 @@ 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
-    (Group {membership, members, groupProfile}, qInfo) <- getGroup_ db user localDisplayName
+    (Group {membership, members, groupProfile}, cReq) <- getGroup_ db user localDisplayName
     when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined
-    case (qInfo, findFromContact (invitedBy membership) members) of
-      (Just queueInfo, Just fromMember) ->
-        pure ReceivedGroupInvitation {fromMember, userMember = membership, queueInfo, groupProfile}
+    case (cReq, findFromContact (invitedBy membership) members) of
+      (Just connRequest, Just fromMember) ->
+        pure ReceivedGroupInvitation {fromMember, userMember = membership, connRequest, groupProfile}
       _ -> throwError SEGroupInvitationNotFound
   where
     findFromContact :: InvitedBy -> [GroupMember] -> Maybe GroupMember
     findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId)
     findFromContact _ = const Nothing
 
-type GroupMemberRow = (Int64, Int64, ByteString, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text)
+type GroupMemberRow = (Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text)
 
 toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
 toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, localDisplayName, memberContactId, displayName, fullName) =
@@ -809,15 +1030,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 (MemberIdRole (MemberId 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 sent_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 ->
@@ -939,14 +1165,14 @@ saveIntroInvitation st reMember toMember introInv = do
           WHERE group_member_intro_id = :intro_id
         |]
         [ ":intro_status" := GMIntroInvReceived,
-          ":group_queue_info" := groupQInfo introInv,
-          ":direct_queue_info" := directQInfo introInv,
+          ":group_queue_info" := groupConnReq introInv,
+          ":direct_queue_info" := directConnReq introInv,
           ":intro_id" := introId intro
         ]
     pure intro {introInvitation = Just introInv, introStatus = GMIntroInvReceived}
 
 saveMemberInvitation :: StoreMonad m => SQLiteStore -> GroupMember -> IntroInvitation -> m ()
-saveMemberInvitation st GroupMember {groupMemberId} IntroInvitation {groupQInfo, directQInfo} =
+saveMemberInvitation st GroupMember {groupMemberId} IntroInvitation {groupConnReq, directConnReq} =
   liftIO . withTransaction st $ \db ->
     DB.executeNamed
       db
@@ -958,8 +1184,8 @@ saveMemberInvitation st GroupMember {groupMemberId} IntroInvitation {groupQInfo,
         WHERE group_member_id = :group_member_id
       |]
       [ ":member_status" := GSMemIntroInvited,
-        ":group_queue_info" := groupQInfo,
-        ":direct_queue_info" := directQInfo,
+        ":group_queue_info" := groupConnReq,
+        ":direct_queue_info" := directConnReq,
         ":group_member_id" := groupMemberId
       ]
 
@@ -975,9 +1201,9 @@ getIntroduction_ db reMember toMember = ExceptT $ do
       |]
       (groupMemberId reMember, groupMemberId toMember)
   where
-    toIntro :: [(Int64, Maybe SMPQueueInfo, Maybe SMPQueueInfo, GroupMemberIntroStatus)] -> Either StoreError GroupMemberIntro
-    toIntro [(introId, groupQInfo, directQInfo, introStatus)] =
-      let introInvitation = IntroInvitation <$> groupQInfo <*> directQInfo
+    toIntro :: [(Int64, Maybe ConnReqInvitation, Maybe ConnReqInvitation, GroupMemberIntroStatus)] -> Either StoreError GroupMemberIntro
+    toIntro [(introId, groupConnReq, directConnReq, introStatus)] =
+      let introInvitation = IntroInvitation <$> groupConnReq <*> directConnReq
        in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation}
     toIntro _ = Left SEIntroNotFound
 
@@ -985,7 +1211,7 @@ createIntroReMember :: StoreMonad m => SQLiteStore -> User -> Group -> GroupMemb
 createIntroReMember st user@User {userId} group@Group {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberProfile) groupAgentConnId directAgentConnId =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
     let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
-    Connection {connId = directConnId} <- liftIO $ createConnection_ db userId directAgentConnId memberContactId cLevel
+    Connection {connId = directConnId} <- liftIO $ createContactConnection_ db userId directAgentConnId memberContactId cLevel
     (localDisplayName, contactId, memProfileId) <- ExceptT $ createContact_ db userId directConnId memberProfile (Just groupId)
     liftIO $ do
       let newMember =
@@ -1007,7 +1233,7 @@ createIntroToMemberContact st userId GroupMember {memberContactId = viaContactId
   liftIO . withTransaction st $ \db -> do
     let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
     void $ createMemberConnection_ db userId groupMemberId groupAgentConnId viaContactId cLevel
-    Connection {connId = directConnId} <- createConnection_ db userId directAgentConnId viaContactId cLevel
+    Connection {connId = directConnId} <- createContactConnection_ db userId directAgentConnId viaContactId cLevel
     contactId <- createMemberContact_ db directConnId
     updateMember_ db contactId
   where
@@ -1040,20 +1266,14 @@ createIntroToMemberContact st userId GroupMember {memberContactId = viaContactId
         [":contact_id" := contactId, ":group_member_id" := groupMemberId]
 
 createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Maybe Int64 -> Int -> IO Connection
-createMemberConnection_ db userId groupMemberId agentConnId viaContact connLevel = do
-  createdAt <- getCurrentTime
-  DB.execute
-    db
-    [sql|
-      INSERT INTO connections
-        (user_id, agent_conn_id, conn_status, conn_type, group_member_id, via_contact, conn_level, created_at) VALUES (?,?,?,?,?,?,?,?);
-    |]
-    (userId, agentConnId, ConnNew, ConnMember, groupMemberId, viaContact, connLevel, createdAt)
-  connId <- insertedRowId db
-  pure Connection {connId, agentConnId, connType = ConnMember, entityId = Just groupMemberId, viaContact, connLevel, connStatus = ConnNew, createdAt}
+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_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
+createContactMember_ db user groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy =
+  createContactMemberInv_ db user groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy Nothing
+
+createContactMemberInv_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember
+createContactMemberInv_ db User {userId, userContactId} groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy connRequest = do
   insertMember_
   groupMemberId <- insertedRowId db
   let memberProfile = profile' userOrContact
@@ -1068,12 +1288,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, sent_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, :sent_inv_queue_info)
         |]
         [ ":group_id" := groupId,
           ":member_id" := memberId,
@@ -1083,7 +1303,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,
+          ":sent_inv_queue_info" := connRequest
         ]
 
 getViaGroupMember :: MonadUnliftIO m => SQLiteStore -> User -> Contact -> m (Maybe (GroupName, GroupMember))
@@ -1098,7 +1319,7 @@ getViaGroupMember st User {userId, userContactId} Contact {contactId} =
             m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
             m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
             c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
           FROM group_members m
           JOIN contacts ct ON ct.contact_id = m.contact_id
           JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
@@ -1128,7 +1349,7 @@ getViaGroupContact st User {userId} GroupMember {groupMemberId} =
           SELECT
             ct.contact_id, ct.local_display_name, p.display_name, p.full_name, ct.via_group,
             c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
           FROM contacts ct
           JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
           JOIN connections c ON c.connection_id = (
@@ -1171,19 +1392,8 @@ createSndGroupFileTransfer st userId Group {groupId} ms filePath fileSize chunkS
     pure fileId
 
 createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> IO Connection
-createSndFileConnection_ db userId fileId agentConnId = do
-  createdAt <- getCurrentTime
-  let connType = ConnSndFile
-      connStatus = ConnNew
-  DB.execute
-    db
-    [sql|
-      INSERT INTO connections
-        (user_id, snd_file_id, agent_conn_id, conn_status, conn_type, created_at) VALUES (?,?,?,?,?,?)
-    |]
-    (userId, fileId, agentConnId, connStatus, connType, createdAt)
-  connId <- insertedRowId db
-  pure Connection {connId, agentConnId, connType, entityId = Just fileId, viaContact = Nothing, connLevel = 0, connStatus, createdAt}
+createSndFileConnection_ db userId fileId agentConnId =
+  createConnection_ db userId ConnSndFile (Just fileId) agentConnId Nothing 0
 
 updateSndFileStatus :: MonadUnliftIO m => SQLiteStore -> SndFileTransfer -> FileStatus -> m ()
 updateSndFileStatus st SndFileTransfer {fileId, connId} status =
@@ -1236,19 +1446,19 @@ deleteSndFileChunks st SndFileTransfer {fileId, connId} =
     DB.execute db "DELETE FROM snd_file_chunks WHERE file_id = ? AND connection_id = ?" (fileId, connId)
 
 createRcvFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FileInvitation -> Integer -> m RcvFileTransfer
-createRcvFileTransfer st userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileQInfo} chunkSize =
+createRcvFileTransfer st userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq} chunkSize =
   liftIO . withTransaction st $ \db -> do
     DB.execute db "INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size) VALUES (?, ?, ?, ?, ?)" (userId, contactId, fileName, fileSize, chunkSize)
     fileId <- insertedRowId db
-    DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info) VALUES (?, ?, ?)" (fileId, FSNew, fileQInfo)
+    DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info) VALUES (?, ?, ?)" (fileId, FSNew, fileConnReq)
     pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize}
 
 createRcvGroupFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> GroupMember -> FileInvitation -> Integer -> m RcvFileTransfer
-createRcvGroupFileTransfer st userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileQInfo} chunkSize =
+createRcvGroupFileTransfer st userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq} chunkSize =
   liftIO . withTransaction st $ \db -> do
     DB.execute db "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size) VALUES (?, ?, ?, ?, ?)" (userId, groupId, fileName, fileSize, chunkSize)
     fileId <- insertedRowId db
-    DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info, group_member_id) VALUES (?, ?, ?, ?)" (fileId, FSNew, fileQInfo, groupMemberId)
+    DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info, group_member_id) VALUES (?, ?, ?, ?)" (fileId, FSNew, fileConnReq, groupMemberId)
     pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize}
 
 getRcvFileTransfer :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m RcvFileTransfer
@@ -1275,10 +1485,10 @@ getRcvFileTransfer_ db userId fileId =
       (userId, fileId)
   where
     rcvFileTransfer ::
-      [(FileStatus, SMPQueueInfo, String, Integer, Integer, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
+      [(FileStatus, ConnReqInvitation, String, Integer, Integer, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
       Either StoreError RcvFileTransfer
-    rcvFileTransfer [(fileStatus', fileQInfo, fileName, fileSize, chunkSize, contactName_, memberName_, filePath_, connId_, agentConnId_)] =
-      let fileInv = FileInvitation {fileName, fileSize, fileQInfo}
+    rcvFileTransfer [(fileStatus', fileConnReq, fileName, fileSize, chunkSize, contactName_, memberName_, filePath_, connId_, agentConnId_)] =
+      let fileInv = FileInvitation {fileName, fileSize, fileConnReq}
           fileInfo = (filePath_, connId_, agentConnId_)
        in case contactName_ <|> memberName_ of
             Nothing -> Left $ SERcvFileInvalid fileId
@@ -1414,6 +1624,101 @@ getSndFileTransfers_ db userId fileId =
         Just recipientDisplayName -> Right SndFileTransfer {..}
         Nothing -> Left $ SESndFileInvalid fileId
 
+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)
@@ -1473,6 +1778,9 @@ data StoreError
   = SEDuplicateName
   | SEContactNotFound ContactName
   | SEContactNotReady ContactName
+  | SEDuplicateContactLink
+  | SEUserContactLinkNotFound
+  | SEContactRequestNotFound ContactName
   | SEGroupNotFound GroupName
   | SEGroupWithoutUser
   | SEDuplicateGroupMember
@@ -1487,4 +1795,5 @@ data StoreError
   | SEIntroNotFound
   | SEUniqueID
   | SEInternal ByteString
+  | SENoMsgDelivery Int64 AgentMsgId
   deriving (Show, Exception)

src/Simplex/Chat/Types.hs

@@ -1,18 +1,30 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# 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 Data.Aeson (FromJSON, ToJSON, (.:), (.=))
 import qualified Data.Aeson as J
+import qualified Data.Aeson.Types as JT
+import qualified Data.Attoparsec.ByteString.Char8 as A
+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)
@@ -20,8 +32,11 @@ 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, SMPQueueInfo)
+import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, MsgMeta (..), serializeMsgIntegrity)
 import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (MsgBody)
+import Simplex.Messaging.Util ((<$?>))
 
 class IsContact a where
   contactId' :: a -> Int64
@@ -57,9 +72,28 @@ data Contact = Contact
   }
   deriving (Eq, Show)
 
+contactConn :: Contact -> Connection
+contactConn = activeConn
+
 contactConnId :: Contact -> ConnId
 contactConnId Contact {activeConn = Connection {agentConnId}} = agentConnId
 
+data UserContact = UserContact
+  { userContactLinkId :: Int64,
+    connReqContact :: ConnReqContact
+  }
+  deriving (Eq, Show)
+
+data UserContactRequest = UserContactRequest
+  { contactRequestId :: Int64,
+    agentInvitationId :: InvitationId,
+    userContactLinkId :: Int64,
+    agentContactConnId :: ConnId,
+    localDisplayName :: ContactName,
+    profileId :: Int64
+  }
+  deriving (Eq, Show)
+
 type ContactName = Text
 
 type GroupName = Text
@@ -77,46 +111,61 @@ data Profile = Profile
   { displayName :: ContactName,
     fullName :: Text
   }
-  deriving (Generic, Eq, Show)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON Profile where toEncoding = J.genericToEncoding J.defaultOptions
 
-instance FromJSON Profile
-
 data GroupProfile = GroupProfile
   { displayName :: GroupName,
     fullName :: Text
   }
-  deriving (Generic, Eq, Show)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON GroupProfile where toEncoding = J.genericToEncoding J.defaultOptions
 
-instance FromJSON GroupProfile
-
 data GroupInvitation = GroupInvitation
-  { fromMember :: (MemberId, GroupMemberRole),
-    invitedMember :: (MemberId, GroupMemberRole),
-    queueInfo :: SMPQueueInfo,
+  { fromMember :: MemberIdRole,
+    invitedMember :: MemberIdRole,
+    connRequest :: ConnReqInvitation,
     groupProfile :: GroupProfile
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON GroupInvitation where toEncoding = J.genericToEncoding J.defaultOptions
+
+data MemberIdRole = MemberIdRole
+  { memberId :: MemberId,
+    memberRole :: GroupMemberRole
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON MemberIdRole where toEncoding = J.genericToEncoding J.defaultOptions
 
 data IntroInvitation = IntroInvitation
-  { groupQInfo :: SMPQueueInfo,
-    directQInfo :: SMPQueueInfo
+  { groupConnReq :: ConnReqInvitation,
+    directConnReq :: ConnReqInvitation
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic, FromJSON)
 
-data MemberInfo = MemberInfo MemberId GroupMemberRole Profile
-  deriving (Eq, Show)
+instance ToJSON IntroInvitation where toEncoding = J.genericToEncoding J.defaultOptions
+
+data MemberInfo = MemberInfo
+  { memberId :: MemberId,
+    memberRole :: GroupMemberRole,
+    profile :: Profile
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON MemberInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
 memberInfo :: GroupMember -> MemberInfo
-memberInfo m = MemberInfo (memberId m) (memberRole m) (memberProfile m)
+memberInfo GroupMember {memberId, memberRole, memberProfile} =
+  MemberInfo memberId memberRole memberProfile
 
 data ReceivedGroupInvitation = ReceivedGroupInvitation
   { fromMember :: GroupMember,
     userMember :: GroupMember,
-    queueInfo :: SMPQueueInfo,
+    connRequest :: ConnReqInvitation,
     groupProfile :: GroupProfile
   }
   deriving (Eq, Show)
@@ -136,6 +185,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
@@ -151,7 +203,24 @@ data NewGroupMember = NewGroupMember
     memContactId :: Maybe Int64
   }
 
-type MemberId = ByteString
+newtype MemberId = MemberId {unMemberId :: ByteString}
+  deriving (Eq, Show)
+
+instance FromField MemberId where fromField f = MemberId <$> fromField f
+
+instance ToField MemberId where toField (MemberId m) = toField m
+
+instance StrEncoding MemberId where
+  strEncode (MemberId m) = strEncode m
+  strDecode s = MemberId <$> strDecode s
+  strP = MemberId <$> strP
+
+instance FromJSON MemberId where
+  parseJSON = strParseJSON "MemberId"
+
+instance ToJSON MemberId where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
 
 data InvitedBy = IBContact Int64 | IBUser | IBUnknown
   deriving (Eq, Show)
@@ -171,22 +240,28 @@ fromInvitedBy userCtId = \case
 data GroupMemberRole = GRMember | GRAdmin | GROwner
   deriving (Eq, Show, Ord)
 
-instance FromField GroupMemberRole where fromField = fromBlobField_ toMemberRole
+instance FromField GroupMemberRole where fromField = fromBlobField_ strDecode
 
-instance ToField GroupMemberRole where toField = toField . serializeMemberRole
+instance ToField GroupMemberRole where toField = toField . strEncode
 
-toMemberRole :: ByteString -> Either String GroupMemberRole
-toMemberRole = \case
-  "owner" -> Right GROwner
-  "admin" -> Right GRAdmin
-  "member" -> Right GRMember
-  r -> Left $ "invalid group member role " <> B.unpack r
+instance StrEncoding GroupMemberRole where
+  strEncode = \case
+    GROwner -> "owner"
+    GRAdmin -> "admin"
+    GRMember -> "member"
+  strDecode = \case
+    "owner" -> Right GROwner
+    "admin" -> Right GRAdmin
+    "member" -> Right GRMember
+    r -> Left $ "bad GroupMemberRole " <> B.unpack r
+  strP = strDecode <$?> A.takeByteString
 
-serializeMemberRole :: GroupMemberRole -> ByteString
-serializeMemberRole = \case
-  GROwner -> "owner"
-  GRAdmin -> "admin"
-  GRMember -> "member"
+instance FromJSON GroupMemberRole where
+  parseJSON = strParseJSON "GroupMemberRole"
+
+instance ToJSON GroupMemberRole where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
 
 fromBlobField_ :: Typeable k => (ByteString -> Either String k) -> FieldParser k
 fromBlobField_ p = \case
@@ -196,6 +271,36 @@ fromBlobField_ p = \case
       Left e -> returnError ConversionFailed f ("could not parse field: " ++ e)
   f -> returnError ConversionFailed f "expecting SQLBlob column type"
 
+newtype Probe = Probe {unProbe :: ByteString}
+  deriving (Eq, Show)
+
+instance StrEncoding Probe where
+  strEncode (Probe p) = strEncode p
+  strDecode s = Probe <$> strDecode s
+  strP = Probe <$> strP
+
+instance FromJSON Probe where
+  parseJSON = strParseJSON "Probe"
+
+instance ToJSON Probe where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+newtype ProbeHash = ProbeHash {unProbeHash :: ByteString}
+  deriving (Eq, Show)
+
+instance StrEncoding ProbeHash where
+  strEncode (ProbeHash p) = strEncode p
+  strDecode s = ProbeHash <$> strDecode s
+  strP = ProbeHash <$> strP
+
+instance FromJSON ProbeHash where
+  parseJSON = strParseJSON "ProbeHash"
+
+instance ToJSON ProbeHash where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
 data GroupMemberCategory
   = GCUserMember
   | GCInviteeMember -- member invited by the user
@@ -316,9 +421,26 @@ data SndFileTransfer = SndFileTransfer
 data FileInvitation = FileInvitation
   { fileName :: String,
     fileSize :: Integer,
-    fileQInfo :: SMPQueueInfo
+    fileConnReq :: ConnReqInvitation
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+
+instance FromJSON FileInvitation where
+  parseJSON (J.Object v) = FileInvitation <$> v .: "fileName" <*> v .: "fileSize" <*> v .: "fileConnReq"
+  parseJSON invalid = JT.prependFailure "bad FileInvitation, " (JT.typeMismatch "Object" invalid)
+
+instance ToJSON FileInvitation where
+  toJSON (FileInvitation fileName fileSize fileConnReq) =
+    J.object
+      [ "fileName" .= fileName,
+        "fileSize" .= fileSize,
+        "fileConnReq" .= fileConnReq
+      ]
+  toEncoding (FileInvitation fileName fileSize fileConnReq) =
+    J.pairs $
+      "fileName" .= fileName
+        <> "fileSize" .= fileSize
+        <> "fileConnReq" .= fileConnReq
 
 data RcvFileTransfer = RcvFileTransfer
   { fileId :: Int64,
@@ -372,6 +494,10 @@ serializeFileStatus = \case
 data RcvChunkStatus = RcvChunkOk | RcvChunkFinal | RcvChunkDuplicate | RcvChunkError
   deriving (Eq, Show)
 
+type ConnReqInvitation = ConnectionRequestUri 'CMInvitation
+
+type ConnReqContact = ConnectionRequestUri 'CMContact
+
 data Connection = Connection
   { connId :: Int64,
     agentConnId :: ConnId,
@@ -379,7 +505,7 @@ data Connection = Connection
     viaContact :: Maybe Int64,
     connType :: ConnType,
     connStatus :: ConnStatus,
-    entityId :: Maybe Int64, -- contact, group member or file ID
+    entityId :: Maybe Int64, -- contact, group member, file ID or user contact ID
     createdAt :: UTCTime
   }
   deriving (Eq, Show)
@@ -426,7 +552,7 @@ serializeConnStatus = \case
   ConnReady -> "ready"
   ConnDeleted -> "deleted"
 
-data ConnType = ConnContact | ConnMember | ConnSndFile | ConnRcvFile
+data ConnType = ConnContact | ConnMember | ConnSndFile | ConnRcvFile | ConnUserContact
   deriving (Eq, Show)
 
 instance FromField ConnType where fromField = fromTextField_ connTypeT
@@ -439,6 +565,7 @@ connTypeT = \case
   "member" -> Just ConnMember
   "snd_file" -> Just ConnSndFile
   "rcv_file" -> Just ConnRcvFile
+  "user_contact" -> Just ConnUserContact
   _ -> Nothing
 
 serializeConnType :: ConnType -> Text
@@ -447,6 +574,7 @@ serializeConnType = \case
   ConnMember -> "member"
   ConnSndFile -> "snd_file"
   ConnRcvFile -> "rcv_file"
+  ConnUserContact -> "user_contact"
 
 data NewConnection = NewConnection
   { agentConnId :: ByteString,
@@ -495,3 +623,123 @@ serializeIntroStatus = \case
   GMIntroReConnected -> "re-con"
   GMIntroToConnected -> "to-con"
   GMIntroConnected -> "con"
+
+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 MsgMetaJSON = MsgMetaJSON
+  { integrity :: Text,
+    rcvId :: Int64,
+    rcvTs :: UTCTime,
+    serverId :: Text,
+    serverTs :: UTCTime,
+    sndId :: Int64
+  }
+  deriving (Eq, Show, FromJSON, Generic)
+
+instance ToJSON MsgMetaJSON where toEncoding = J.genericToEncoding J.defaultOptions
+
+msgMetaToJson :: MsgMeta -> MsgMetaJSON
+msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId, serverTs), sndMsgId = sndId} =
+  MsgMetaJSON
+    { 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

@@ -1,4 +1,5 @@
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
@@ -8,17 +9,30 @@
 module Simplex.Chat.View
   ( printToView,
     showInvitation,
+    showSentConfirmation,
+    showSentInvitation,
+    showInvalidConnReq,
     showChatError,
     showContactDeleted,
     showContactGroups,
+    showContactsList,
     showContactConnected,
     showContactDisconnected,
     showContactAnotherClient,
     showContactSubscribed,
     showContactSubError,
+    showUserContactLinkCreated,
+    showUserContactLinkDeleted,
+    showUserContactLink,
+    showReceivedContactRequest,
+    showAcceptingContactRequest,
+    showContactRequestRejected,
+    showUserContactLinkSubscribed,
+    showUserContactLinkSubError,
     showGroupSubscribed,
     showGroupEmpty,
     showGroupRemoved,
+    showGroupInvitation,
     showMemberSubError,
     showReceivedMessage,
     showReceivedGroupMessage,
@@ -45,6 +59,7 @@ module Simplex.Chat.View
     showGroupDeletedUser,
     showGroupDeleted,
     showSentGroupInvitation,
+    showCannotResendInvitation,
     showReceivedGroupInvitation,
     showJoinedGroupMember,
     showUserJoinedGroup,
@@ -55,6 +70,7 @@ module Simplex.Chat.View
     showLeftMemberUser,
     showLeftMember,
     showGroupMembers,
+    showGroupsList,
     showContactsMerged,
     showUserProfile,
     showUserProfileUpdated,
@@ -62,6 +78,7 @@ module Simplex.Chat.View
     showMessageError,
     safeDecodeUtf8,
     msgPlain,
+    clientVersionInfo,
   )
 where
 
@@ -71,7 +88,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)
@@ -86,12 +103,29 @@ import Simplex.Chat.Terminal (printToTerminal)
 import Simplex.Chat.Types
 import Simplex.Chat.Util (safeDecodeUtf8)
 import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Encoding.String
+import qualified Simplex.Messaging.Protocol as SMP
 import System.Console.ANSI.Types
 
 type ChatReader m = (MonadUnliftIO m, MonadReader ChatController m)
 
-showInvitation :: ChatReader m => SMPQueueInfo -> m ()
-showInvitation = printToView . invitation
+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 previous version.",
+      "Please ask your contact to check " <> highlight' "/version" <> " and update if needed.",
+      plain updateStr
+    ]
 
 showChatError :: ChatReader m => ChatError -> m ()
 showChatError = printToView . chatError
@@ -102,6 +136,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
 
@@ -117,15 +154,43 @@ showContactSubscribed = printToView . contactSubscribed
 showContactSubError :: ChatReader m => ContactName -> ChatError -> m ()
 showContactSubError = printToView .: contactSubError
 
-showGroupSubscribed :: ChatReader m => GroupName -> m ()
+showUserContactLinkCreated :: ChatReader m => ConnReqContact -> m ()
+showUserContactLinkCreated = printToView . userContactLinkCreated
+
+showUserContactLinkDeleted :: ChatReader m => m ()
+showUserContactLinkDeleted = printToView userContactLinkDeleted
+
+showUserContactLink :: ChatReader m => ConnReqContact -> m ()
+showUserContactLink = printToView . userContactLink
+
+showReceivedContactRequest :: ChatReader m => ContactName -> Profile -> m ()
+showReceivedContactRequest = printToView .: receivedContactRequest
+
+showAcceptingContactRequest :: ChatReader m => ContactName -> m ()
+showAcceptingContactRequest = printToView . acceptingContactRequest
+
+showContactRequestRejected :: ChatReader m => ContactName -> m ()
+showContactRequestRejected = printToView . contactRequestRejected
+
+showUserContactLinkSubscribed :: ChatReader m => m ()
+showUserContactLinkSubscribed = printToView ["Your address is active! To show: " <> highlight' "/sa"]
+
+showUserContactLinkSubError :: ChatReader m => ChatError -> m ()
+showUserContactLinkSubError = printToView . userContactLinkSubError
+
+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
 
@@ -210,6 +275,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
 
@@ -240,6 +308,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
 
@@ -255,13 +326,13 @@ showContactUpdated = printToView .: contactUpdated
 showMessageError :: ChatReader m => Text -> Text -> m ()
 showMessageError = printToView .: messageError
 
-invitation :: SMPQueueInfo -> [StyledString]
-invitation qInfo =
-  [ "pass this invitation to your contact (via another channel): ",
+connReqInvitation_ :: ConnReqInvitation -> [StyledString]
+connReqInvitation_ cReq =
+  [ "pass this invitation link to your contact (via another channel): ",
     "",
-    (plain . serializeSmpQueueInfo) qInfo,
+    (plain . strEncode) cReq,
     "",
-    "and ask them to connect: " <> highlight' "/c <invitation_above>"
+    "and ask them to connect: " <> highlight' "/c <invitation_link_above>"
   ]
 
 contactDeleted :: ContactName -> [StyledString]
@@ -275,6 +346,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"]
 
@@ -290,14 +366,56 @@ contactSubscribed c = [ttyContact c <> ": connected to server"]
 contactSubError :: ContactName -> ChatError -> [StyledString]
 contactSubError c e = [ttyContact c <> ": contact error " <> sShow e]
 
-groupSubscribed :: GroupName -> [StyledString]
-groupSubscribed g = [ttyGroup g <> ": connected to server(s)"]
+userContactLinkCreated :: ConnReqContact -> [StyledString]
+userContactLinkCreated = connReqContact_ "Your new chat address is created!"
 
-groupEmpty :: GroupName -> [StyledString]
-groupEmpty g = [ttyGroup g <> ": group is empty"]
+userContactLinkDeleted :: [StyledString]
+userContactLinkDeleted =
+  [ "Your chat address is deleted - accepted contacts will remain connected.",
+    "To create a new chat address use " <> highlight' "/ad"
+  ]
 
-groupRemoved :: GroupName -> [StyledString]
-groupRemoved g = [ttyGroup g <> ": you are no longer a member or group deleted"]
+userContactLink :: ConnReqContact -> [StyledString]
+userContactLink = connReqContact_ "Your chat address:"
+
+connReqContact_ :: StyledString -> ConnReqContact -> [StyledString]
+connReqContact_ intro cReq =
+  [ intro,
+    "",
+    (plain . strEncode) cReq,
+    "",
+    "Anybody can send you contact requests with: " <> highlight' "/c <contact_link_above>",
+    "to show it again: " <> highlight' "/sa",
+    "to delete it: " <> highlight' "/da" <> " (accepted contacts will remain connected)"
+  ]
+
+receivedContactRequest :: ContactName -> Profile -> [StyledString]
+receivedContactRequest c Profile {fullName} =
+  [ ttyFullName c fullName <> " wants to connect to you!",
+    "to accept: " <> highlight ("/ac " <> c),
+    "to reject: " <> highlight ("/rc " <> c) <> " (the sender will NOT be notified)"
+  ]
+
+acceptingContactRequest :: ContactName -> [StyledString]
+acceptingContactRequest c = [ttyContact c <> ": accepting contact request..."]
+
+contactRequestRejected :: ContactName -> [StyledString]
+contactRequestRejected c = [ttyContact c <> ": contact request rejected"]
+
+userContactLinkSubError :: ChatError -> [StyledString]
+userContactLinkSubError e =
+  [ "user address error: " <> sShow e,
+    "to delete your address: " <> highlight' "/da"
+  ]
+
+groupSubscribed :: Group -> [StyledString]
+groupSubscribed g = [ttyFullGroup g <> ": connected to server(s)"]
+
+groupEmpty :: Group -> [StyledString]
+groupEmpty g = [ttyFullGroup g <> ": group is empty"]
+
+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]
@@ -320,9 +438,15 @@ 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),
+  [ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (strEncode role),
     "use " <> highlight ("/j " <> localDisplayName) <> " to accept"
   ]
 
@@ -370,7 +494,7 @@ groupMembers Group {membership, members} = map groupMember . filter (not . remov
   where
     removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
     groupMember m = ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
-    role = plain . serializeMemberRole . memberRole
+    role m = plain . strEncode $ memberRole (m :: GroupMember)
     category m = case memberCategory m of
       GCUserMember -> "you, "
       GCInviteeMember -> "invited, "
@@ -385,6 +509,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,
@@ -603,7 +744,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]
@@ -614,6 +755,7 @@ chatError = \case
     CEFileSend fileId e -> ["error sending file " <> sShow fileId <> ": " <> sShow e]
     CEFileRcvChunk e -> ["error receiving file: " <> plain e]
     CEFileInternal e -> ["file error: " <> plain e]
+    CEAgentVersion -> ["unsupported agent version"]
   -- e -> ["chat error: " <> sShow e]
   ChatErrorStore err -> case err of
     SEDuplicateName -> ["this display name is already used by user, contact or group"]
@@ -624,8 +766,13 @@ chatError = \case
     SEFileNotFound fileId -> fileNotFound fileId
     SESndFileNotFound fileId -> fileNotFound fileId
     SERcvFileNotFound fileId -> fileNotFound fileId
+    SEDuplicateContactLink -> ["you already have chat address, to show: " <> highlight' "/sa"]
+    SEUserContactLinkNotFound -> ["no chat address, to create: " <> highlight' "/ad"]
+    SEContactRequestNotFound c -> ["no contact request from " <> ttyContact c]
     e -> ["chat db error: " <> sShow e]
-  ChatErrorAgent e -> ["smp agent error: " <> sShow e]
+  ChatErrorAgent err -> case err of
+    SMP SMP.AUTH -> ["error: this connection is deleted"]
+    e -> ["smp agent error: " <> sShow e]
   ChatErrorMessage e -> ["chat message error: " <> sShow e]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
@@ -685,3 +832,6 @@ highlight' = highlight
 
 styleTime :: String -> StyledString
 styleTime = Styled [SetColor Foreground Vivid Black]
+
+clientVersionInfo :: [StyledString]
+clientVersionInfo = [plain versionStr, plain updateStr]

src/Simplex/Chat/protocol.md

@@ -22,9 +22,6 @@ The syntax of the message inside agent MSG:
 ```abnf
 agentMessageBody = [chatMsgId] SP msgEvent SP [parameters] SP [contentParts [SP msgBodyParts]]
 chatMsgId = 1*DIGIT ; used to refer to previous message;
-                    ; in the group should only be used in messages sent to all members,
-                    ; which is the main reason not to use external agent ID -
-                    ; some messages are sent only to one member
 msgEvent = protocolNamespace 1*("." msgTypeName)
 protocolNamespace = 1*ALPHA ; "x" for all events defined in the protocol
 msgTypeName = 1*ALPHA
@@ -68,6 +65,219 @@ refMsgHash = 16*16(OCTET) ; SHA256 of agent message body
 ' x.file name,size x.text:NNN <invitation> '
 ```
 
+Chat message JTD:
+
+```jsonc
+{
+  "properties": {
+    "msgId": {"type": "string"},
+    "minVersion": {"type": "uint16"}, // Word16
+    "maxVersion": {"type": "uint16"}, // Word16
+    "event": {"type": "string"}, // Text e.g. s.ok
+    "params": {"values": {}}, // Map Text Value
+  },
+  "optionalProperties": {
+    "dag": {"type": "string"}
+  }
+}
+```
+
+Events:
+
+```jsonc
+"event": "x.msg.new" // XMsgNew
+"params":            // MsgContent
+{
+  "content": {
+    "msgType": "text",
+    // field "files" can be represented in content as contentType "file" with length prepended or as complex contentData
+    "text": "<msg text>"
+  }
+  // "content": [
+    // free form contentType for extensibility and/or complex content types? e.g. MIME
+    // could it be useful if contentData was free form as well? currently it is ByteString
+  //  {"contentType": <content type>, "contentData": "<content data>"},
+  //  ...
+  //  {"contentType": <content type N>, "contentData": "<content data N>"}
+  // ]
+}
+
+"event": "x.file" // XFile; TODO rename into x.file.inv?
+"params":         // FileInvitation
+{
+  "file": {
+    "fileName": "<file name>",
+    "fileSize": <file size>, // integer
+    "fileConnReq": "<file conn req>"
+  }
+}
+
+"event": "x.file.acpt" // XFileAcpt
+"params":              // String
+{
+  "fileName": "<file name>"
+}
+
+"event": "x.info" // XInfo
+"params":         // Profile
+{
+  "profile": {
+    "displayName": "<display name>",
+    "fullName": "<full name>"
+  }
+}
+
+"event": "x.contact" // XContact
+"params":        // Profile (Maybe MsgContent)
+{
+  "profile": {
+    "displayName": "<display name>",
+    "fullName": "<full name>"
+  },
+  "content": {
+    "msgType": "text",
+    "text": "<msg text>"
+  } // optional
+}
+
+"event": "x.grp.inv" // XGrpInv
+"params":            // GroupInvitation
+{
+  "groupInvitation": {
+    "fromMember": {
+      "memberId": "<from_member ID>",
+      "memberRole": "<from_member role>"
+    },
+    "invitedMember": {
+      "memberId": "<invited_member ID>",
+      "memberRole": "<invited_member role>"
+    },
+    "connRequest": "<conn request>",
+    "groupProfile": {
+      "displayName": "<display name>",
+      "fullName": "<full name>"
+    }
+  }
+}
+
+"event": "x.grp.acpt" // XGrpAcpt
+"params":             // MemberId
+{
+  "memberId": "<member ID>"
+}
+
+"event": "x.grp.mem.new" // XGrpMemNew
+"params":                // MemberInfo
+{
+  "memberInfo": {
+    "memberId": "<member ID>",
+    "memberRole": "<member role>",
+    "profile": {
+      "displayName": "<display name>",
+      "fullName": "<full name>"
+    }
+  }
+}
+
+"event": "x.grp.mem.intro" // XGrpMemIntro
+"params":                  // MemberInfo
+{
+  "memberInfo": {
+    "memberId": "<member ID>",
+    "memberRole": "<member role>",
+    "profile": {
+      "displayName": "<display name>",
+      "fullName": "<full name>"
+    }
+  }
+}
+
+"event": "x.grp.mem.inv" // XGrpMemInv
+"params":                // MemberId IntroInvitation
+{
+  "memberId": "<member ID>",
+  "memberIntro": {
+    "groupConnReq": "<group conn req>",
+    "directConnReq": "<direct conn req>"
+  }
+}
+
+"event": "x.grp.mem.fwd" // XGrpMemFwd
+"params":                // MemberInfo IntroInvitation
+{
+  "memberInfo": {
+    "memberId": "<member ID>",
+    "memberRole": "<member role>",
+    "profile": {
+      "displayName": "<display name>",
+      "fullName": "<full name>"
+    },
+  },
+  "memberIntro": {
+    "groupConnReq": "<group conn req>",
+    "directConnReq": "<direct conn req>"
+  }
+}
+
+"event": "x.grp.mem.info" // XGrpMemInfo
+"params":                 // MemberId Profile
+{
+  "memberId": "<member ID>",
+  "profile": {
+    "displayName": "<display name>",
+    "fullName": "<full name>"
+  }
+}
+
+"event": "x.grp.mem.con" // XGrpMemCon
+"params":                // MemberId
+{
+  "memberId": "<member ID>"
+}
+
+"event": "x.grp.mem.con.all" // XGrpMemConAll
+"params":                    // MemberId
+{
+  "memberId": "<member ID>"
+}
+
+"event": "x.grp.mem.del" // XGrpMemDel
+"params":                // MemberId
+{
+  "memberId": "<member ID>"
+}
+
+"event": "x.grp.leave" // XGrpLeave
+"params":
+{}
+
+"event": "x.grp.del" // XGrpDel
+"params":
+{}
+
+"event": "x.info.probe" // XInfoProbe
+"params":               // ByteString
+{
+  "probe": "<probe>"
+}
+
+"event": "x.info.probe.check" // XInfoProbeCheck
+"params":                     // ByteString
+{
+  "probeHash": "<probe hash>"
+}
+
+"event": "x.info.probe.ok" // XInfoProbeOk
+"params":                  // ByteString
+{
+  "probe": "<probe>"
+}
+
+"event": "x.ok" // XOk
+"params":
+{}
+```
+
 ### Group protocol
 
 #### Add group member

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,14 +36,19 @@ 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.4.1@sha256:3a1bc40d85e4e398458e5b9b79757e0af4fe27b8ef44eb3157f7f1e07412a8e8,7640
+  # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
+  - github: simplex-chat/haskell-terminal
+    commit: 5e0759ce4f9655fd3f0d94c76225e6904630dfd3
+  - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   # - github: simplex-chat/simplexmq
-  #   commit: 35e6593581e68f7b444e0f8f4fb6a2e2cc59a5ea
+  #   commit: bfa4911217b71527a6fbaf73b242b5684aaf9fce
+  - github: simplex-chat/hs-tls
+    commit: cea6d52c512716ff09adcac86ebc95bb0b3bb797
+    subdirs:
+      - core
+
 #
 # extra-deps: []
 

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 = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"]
     }
 
 termSettings :: VirtualTerminalSettings
@@ -66,12 +66,12 @@ cfg :: ChatConfig
 cfg =
   defaultChatConfig
     { agentConfig =
-        aCfg {retryInterval = (retryInterval aCfg) {initialInterval = 50000}}
+        aCfg {reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000}}
     }
 
 virtualSimplexChat :: FilePath -> Profile -> IO TestCC
 virtualSimplexChat dbFile profile = do
-  st <- createStore (dbFile <> ".chat.db") 1
+  st <- createStore (dbFile <> "_chat.db") 1
   void . runExceptT $ createUser st profile True
   t <- withVirtualTerminal termSettings pure
   cc <- newChatController cfg opts {dbFile} t . const $ pure () -- no notifications
@@ -143,43 +143,16 @@ concurrentlyN_ = mapConcurrently_ id
 serverCfg :: ServerConfig
 serverCfg =
   ServerConfig
-    { transports = [(serverPort, transport @TCP)],
+    { transports = [(serverPort, transport @TLS)],
       tbqSize = 1,
+      serverTbqSize = 1,
       msgQueueQuota = 4,
       queueIdBytes = 12,
       msgIdBytes = 6,
       storeLog = Nothing,
-      blockSize = 4096,
-      serverPrivateKey =
-        -- full RSA private key (only for tests)
-        "MIIFIwIBAAKCAQEArZyrri/NAwt5buvYjwu+B/MQeJUszDBpRgVqNddlI9kNwDXu\
-        \kaJ8chEhrtaUgXeSWGooWwqjXEUQE6RVbCC6QVo9VEBSP4xFwVVd9Fj7OsgfcXXh\
-        \AqWxfctDcBZQ5jTUiJpdBc+Vz2ZkumVNl0W+j9kWm9nfkMLQj8c0cVSDxz4OKpZb\
-        \qFuj0uzHkis7e7wsrKSKWLPg3M5ZXPZM1m9qn7SfJzDRDfJifamxWI7uz9XK2+Dp\
-        \NkUQlGQgFJEv1cKN88JAwIqZ1s+TAQMQiB+4QZ2aNfSqGEzRJN7FMCKRK7pM0A9A\
-        \PCnijyuImvKFxTdk8Bx1q+XNJzsY6fBrLWJZ+QKBgQCySG4tzlcEm+tOVWRcwrWh\
-        \6zsczGZp9mbf9c8itRx6dlldSYuDG1qnddL70wuAZF2AgS1JZgvcRZECoZRoWP5q\
-        \Kq2wvpTIYjFPpC39lxgUoA/DXKVKZZdan+gwaVPAPT54my1CS32VrOiAY4gVJ3LJ\
-        \Mn1/FqZXUFQA326pau3loQKCAQEAoljmJMp88EZoy3HlHUbOjl5UEhzzVsU1TnQi\
-        \QmPm+aWRe2qelhjW4aTvSVE5mAUJsN6UWTeMf4uvM69Z9I5pfw2pEm8x4+GxRibY\
-        \iiwF2QNaLxxmzEHm1zQQPTgb39o8mgklhzFPill0JsnL3f6IkVwjFJofWSmpqEGs\
-        \dFSMRSXUTVXh1p/o7QZrhpwO/475iWKVS7o48N/0Xp513re3aXw+DRNuVnFEaBIe\
-        \TLvWM9Czn16ndAu1HYiTBuMvtRbAWnGZxU8ewzF4wlWK5tdIL5PTJDd1VhZJAKtB\
-        \npDvJpwxzKmjAhcTmjx0ckMIWtdVaOVm/2gWCXDty2FEdg7koQKBgQDOUUguJ/i7\
-        \q0jldWYRnVkotKnpInPdcEaodrehfOqYEHnvro9xlS6OeAS4Vz5AdH45zQ/4J3bV\
-        \2cH66tNr18ebM9nL//t5G69i89R9W7szyUxCI3LmAIdi3oSEbmz5GQBaw4l6h9Wi\
-        \n4FmFQaAXZrjQfO2qJcAHvWRsMp2pmqAGwKBgQDXaza0DRsKWywWznsHcmHa0cx8\
-        \I4jxqGaQmLO7wBJRP1NSFrywy1QfYrVX9CTLBK4V3F0PCgZ01Qv94751CzN43TgF\
-        \ebd/O9r5NjNTnOXzdWqETbCffLGd6kLgCMwPQWpM9ySVjXHWCGZsRAnF2F6M1O32\
-        \43StIifvwJQFqSM3ewKBgCaW6y7sRY90Ua7283RErezd9EyT22BWlDlACrPu3FNC\
-        \LtBf1j43uxBWBQrMLsHe2GtTV0xt9m0MfwZsm2gSsXcm4Xi4DJgfN+Z7rIlyy9UY\
-        \PCDSdZiU1qSr+NrffDrXlfiAM1cUmCdUX7eKjp/ltkUHNaOGfSn5Pdr3MkAiD/Hf\
-        \AoGBAKIdKCuOwuYlwjS9J+IRGuSSM4o+OxQdwGmcJDTCpyWb5dEk68e7xKIna3zf\
-        \jc+H+QdMXv1nkRK9bZgYheXczsXaNZUSTwpxaEldzVD3hNvsXSgJRy9fqHwA4PBq\
-        \vqiBHoO3RNbqg+2rmTMfDuXreME3S955ZiPZm4Z+T8Hj52mPAoGAQm5QH/gLFtY5\
-        \+znqU/0G8V6BKISCQMxbbmTQVcTgGySrP2gVd+e4MWvUttaZykhWqs8rpr7mgpIY\
-        \hul7Swx0SHFN3WpXu8uj+B6MLpRcCbDHO65qU4kQLs+IaXXsuuTjMvJ5LwjkZVrQ\
-        \TmKzSAw7iVWwEUZR/PeiEKazqrpp9VU="
+      caCertificateFile = "tests/fixtures/tls/ca.crt",
+      privateKeyFile = "tests/fixtures/tls/server.key",
+      certificateFile = "tests/fixtures/tls/server.crt"
     }
 
 withSmpServer :: IO a -> IO a

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
@@ -46,6 +49,10 @@ chatTests = do
     it "sender cancelled file transfer" testFileSndCancel
     it "recipient cancelled file transfer" testFileRcvCancel
     it "send and receive file to group" testGroupFileTransfer
+  describe "user contact link" $ do
+    it "should create and connect via contact link" testUserContactLink
+    it "should reject contact and delete contact link" testRejectContactAndDeleteUserContact
+    it "should delete connection requests when contact link deleted" testDeleteConnectionRequests
 
 testAddContact :: IO ()
 testAddContact =
@@ -54,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")
@@ -65,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")
@@ -128,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_
@@ -146,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 ()
@@ -271,7 +294,9 @@ 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 ##> "/d #club"
+      dan <## "#club: you deleted the group"
       dan <##> cath
       dan <##> alice
       -- member leaves
@@ -292,7 +317,9 @@ 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 ##> "/d #club"
+      bob <## "#club: you deleted the group"
       bob <##> cath
       bob <##> alice
 
@@ -314,7 +341,71 @@ 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"
+      cath ##> "/d #team"
+      cath <## "#team: you deleted 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 =
@@ -361,6 +452,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 $
@@ -530,6 +651,73 @@ testGroupFileTransfer =
             cath <## "completed receiving file 1 (test.jpg) from alice"
         ]
 
+testUserContactLink :: IO ()
+testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $
+  \alice bob cath -> do
+    alice ##> "/ad"
+    cLink <- getContactLink alice True
+    bob ##> ("/c " <> cLink)
+    alice <#? bob
+    alice ##> "/ac bob"
+    alice <## "bob: accepting contact request..."
+    concurrently_
+      (bob <## "alice (Alice): contact is connected")
+      (alice <## "bob (Bob): contact is connected")
+    alice <##> bob
+
+    cath ##> ("/c " <> cLink)
+    alice <#? cath
+    alice ##> "/ac cath"
+    alice <## "cath: accepting contact request..."
+    concurrently_
+      (cath <## "alice (Alice): contact is connected")
+      (alice <## "cath (Catherine): contact is connected")
+    alice <##> cath
+
+testRejectContactAndDeleteUserContact :: IO ()
+testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathProfile $
+  \alice bob cath -> do
+    alice ##> "/ad"
+    cLink <- getContactLink alice True
+    bob ##> ("/c " <> cLink)
+    alice <#? bob
+    alice ##> "/rc bob"
+    alice <## "bob: contact request rejected"
+    (bob </)
+
+    alice ##> "/sa"
+    cLink' <- getContactLink alice False
+    cLink' `shouldBe` cLink
+
+    alice ##> "/da"
+    alice <## "Your chat address is deleted - accepted contacts will remain connected."
+    alice <## "To create a new chat address use /ad"
+
+    cath ##> ("/c " <> cLink)
+    cath <## "error: this connection is deleted"
+
+testDeleteConnectionRequests :: IO ()
+testDeleteConnectionRequests = testChat3 aliceProfile bobProfile cathProfile $
+  \alice bob cath -> do
+    alice ##> "/ad"
+    cLink <- getContactLink alice True
+    bob ##> ("/c " <> cLink)
+    alice <#? bob
+    cath ##> ("/c " <> cLink)
+    alice <#? cath
+
+    alice ##> "/da"
+    alice <## "Your chat address is deleted - accepted contacts will remain connected."
+    alice <## "To create a new chat address use /ad"
+
+    alice ##> "/ad"
+    cLink' <- getContactLink alice True
+    bob ##> ("/c " <> cLink')
+    -- same names are used here, as they were released at /da
+    alice <#? bob
+    cath ##> ("/c " <> cLink')
+    alice <#? cath
+
 startFileTransfer :: TestCC -> TestCC -> IO ()
 startFileTransfer alice bob = do
   alice #> "/f @bob ./tests/fixtures/test.jpg"
@@ -556,6 +744,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"))
@@ -565,23 +754,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"),
@@ -592,18 +785,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 ()
@@ -648,6 +841,15 @@ cc <# line = (dropTime <$> getTermLine cc) `shouldReturn` line
 (</) :: TestCC -> Expectation
 (</) cc = timeout 500000 (getTermLine cc) `shouldReturn` Nothing
 
+(<#?) :: TestCC -> TestCC -> Expectation
+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)")
+
 dropTime :: String -> String
 dropTime msg = case splitAt 6 msg of
   ([m, m', ':', s, s', ' '], text) ->
@@ -659,9 +861,20 @@ getTermLine = atomically . readTQueue . termQ
 
 getInvitation :: TestCC -> IO String
 getInvitation cc = do
-  cc <## "pass this invitation to your contact (via another channel):"
+  cc <## "pass this invitation link to your contact (via another channel):"
   cc <## ""
   inv <- getTermLine cc
   cc <## ""
-  cc <## "and ask them to connect: /c <invitation_above>"
+  cc <## "and ask them to connect: /c <invitation_link_above>"
   pure inv
+
+getContactLink :: TestCC -> Bool -> IO String
+getContactLink cc created = do
+  cc <## if created then "Your new chat address is created!" else "Your chat address:"
+  cc <## ""
+  link <- getTermLine cc
+  cc <## ""
+  cc <## "Anybody can send you contact requests with: /c <contact_link_above>"
+  cc <## "to show it again: /sa"
+  cc <## "to delete it: /da (accepted contacts will remain connected)"
+  pure link

tests/ProtocolTests.hs

@@ -1,47 +1,124 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module ProtocolTests where
 
+import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import Simplex.Chat.Protocol
+import Simplex.Chat.Types
+import Simplex.Messaging.Agent.Protocol
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Ratchet
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Protocol (smpClientVRange)
 import Test.Hspec
 
 protocolTests :: Spec
-protocolTests = do
-  parseChatMessageTest
+protocolTests = decodeChatMessageTest
 
-(#==) :: ByteString -> RawChatMessage -> Expectation
-s #== msg = parseAll rawChatMessageP s `shouldBe` Right msg
+srv :: SMPServer
+srv =
+  SMPServer
+    { host = "smp.simplex.im",
+      port = "5223",
+      keyHash = C.KeyHash "\215m\248\251"
+    }
 
-parseChatMessageTest :: Spec
-parseChatMessageTest = describe "Raw chat message format" $ do
-  it "no parameters and content" $
-    "5 x.grp.mem.leave   " #== RawChatMessage (Just 5) "x.grp.mem.leave" [] []
-  it "one parameter, no content" $
-    "6 x.msg.del 3  " #== RawChatMessage (Just 6) "x.msg.del" ["3"] []
-  it "with content that fits the message" $
-    "7 x.msg.new c.text x.text:11 hello there "
-      #== RawChatMessage
-        (Just 7)
-        "x.msg.new"
-        ["c.text"]
-        [RawMsgBodyContent (RawContentType "x" "text") "hello there"]
-  it "with DAG reference and partial content" $
-    "8 x.msg.new c.image x.dag:16,x.text:7,m.image/jpg:6 0123456789012345 picture abcdef "
-      #== RawChatMessage
-        (Just 8)
-        "x.msg.new"
-        ["c.image"]
-        [ RawMsgBodyContent (RawContentType "x" "dag") "0123456789012345",
-          RawMsgBodyContent (RawContentType "x" "text") "picture",
-          RawMsgBodyContent (RawContentType "m" "image/jpg") "abcdef"
-        ]
-  it "without message id" $
-    " x.grp.mem.inv 23456,123 x.json:46 {\"contactRef\":\"john\",\"displayName\":\"John Doe\"} "
-      #== RawChatMessage
-        Nothing
-        "x.grp.mem.inv"
-        ["23456", "123"]
-        [RawMsgBodyContent (RawContentType "x" "json") "{\"contactRef\":\"john\",\"displayName\":\"John Doe\"}"]
+queue :: SMPQueueUri
+queue =
+  SMPQueueUri
+    { smpServer = srv,
+      senderId = "\223\142z\251",
+      clientVRange = smpClientVRange,
+      dhPublicKey = "MCowBQYDK2VuAyEAjiswwI3O/NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
+    }
+
+connReqData :: ConnReqUriData
+connReqData =
+  ConnReqUriData
+    { crScheme = simplexChat,
+      crAgentVRange = smpAgentVRange,
+      crSmpQueues = [queue]
+    }
+
+testDhPubKey :: C.PublicKeyX448
+testDhPubKey = "MEIwBQYDK2VvAzkAmKuSYeQ/m0SixPDS8Wq8VBaTS1cW+Lp0n0h4Diu+kUpR+qXx4SDJ32YGEFoGFGSbGPry5Ychr6U="
+
+testE2ERatchetParams :: E2ERatchetParamsUri 'C.X448
+testE2ERatchetParams = E2ERatchetParamsUri e2eEncryptVRange testDhPubKey testDhPubKey
+
+testConnReq :: ConnectionRequestUri 'CMInvitation
+testConnReq = CRInvitationUri connReqData testE2ERatchetParams
+
+(==#) :: ByteString -> ChatMsgEvent -> Expectation
+s ==# msg = do
+  strDecode s `shouldBe` Right (ChatMessage msg)
+  parseAll strP s `shouldBe` Right (ChatMessage msg)
+
+(#==) :: ByteString -> ChatMsgEvent -> Expectation
+s #== msg =
+  J.eitherDecodeStrict' (strEncode $ ChatMessage msg)
+    `shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
+
+(#==#) :: ByteString -> ChatMsgEvent -> Expectation
+s #==# msg = do
+  s #== msg
+  s ==# msg
+
+testProfile :: Profile
+testProfile = Profile {displayName = "alice", fullName = "Alice"}
+
+testGroupProfile :: GroupProfile
+testGroupProfile = GroupProfile {displayName = "team", fullName = "Team"}
+
+decodeChatMessageTest :: Spec
+decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
+  it "x.msg.new" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" #==# XMsgNew (MCText "hello")
+  it "x.file" $
+    "{\"event\":\"x.file\",\"params\":{\"file\":{\"fileConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
+      #==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = testConnReq}
+  it "x.file.acpt" $ "{\"event\":\"x.file.acpt\",\"params\":{\"fileName\":\"photo.jpg\"}}" #==# XFileAcpt "photo.jpg"
+  it "x.info" $ "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}" #==# XInfo testProfile
+  it "x.info" $ "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\"}}}" #==# XInfo Profile {displayName = "alice", fullName = ""}
+  it "x.contact without content field" $
+    "{\"event\":\"x.contact\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}"
+      #==# XContact testProfile Nothing
+  it "x.contact with content null" $
+    "{\"event\":\"x.contact\",\"params\":{\"content\":null,\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}"
+      ==# XContact testProfile Nothing
+  it "x.contact with content" $
+    "{\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}"
+      #==# XContact testProfile (Just $ MCText "hello")
+  it "x.grp.inv" $
+    "{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\"},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}"
+      #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile}
+  it "x.grp.acpt" $ "{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpAcpt (MemberId "\1\2\3\4")
+  it "x.grp.acpt" $ "{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpAcpt (MemberId "\1\2\3\4")
+  it "x.grp.mem.new" $
+    "{\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}}"
+      #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile}
+  it "x.grp.mem.intro" $
+    "{\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}}"
+      #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile}
+  it "x.grp.mem.inv" $
+    "{\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}"
+      #==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq}
+  it "x.grp.mem.fwd" $
+    "{\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}}"
+      #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq}
+  it "x.grp.mem.info" $
+    "{\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}"
+      #==# XGrpMemInfo (MemberId "\1\2\3\4") testProfile
+  it "x.grp.mem.con" $ "{\"event\":\"x.grp.mem.con\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpMemCon (MemberId "\1\2\3\4")
+  it "x.grp.mem.con.all" $ "{\"event\":\"x.grp.mem.con.all\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpMemConAll (MemberId "\1\2\3\4")
+  it "x.grp.mem.del" $ "{\"event\":\"x.grp.mem.del\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpMemDel (MemberId "\1\2\3\4")
+  it "x.grp.leave" $ "{\"event\":\"x.grp.leave\",\"params\":{}}" ==# XGrpLeave
+  it "x.grp.del" $ "{\"event\":\"x.grp.del\",\"params\":{}}" ==# XGrpDel
+  it "x.info.probe" $ "{\"event\":\"x.info.probe\",\"params\":{\"probe\":\"AQIDBA==\"}}" #==# XInfoProbe (Probe "\1\2\3\4")
+  it "x.info.probe.check" $ "{\"event\":\"x.info.probe.check\",\"params\":{\"probeHash\":\"AQIDBA==\"}}" #==# XInfoProbeCheck (ProbeHash "\1\2\3\4")
+  it "x.info.probe.ok" $ "{\"event\":\"x.info.probe.ok\",\"params\":{\"probe\":\"AQIDBA==\"}}" #==# XInfoProbeOk (Probe "\1\2\3\4")
+  it "x.ok" $ "{\"event\":\"x.ok\",\"params\":{}}" ==# XOk

tests/fixtures/tls/ca.crt

@@ -0,0 +1,12 @@
+-----BEGIN CERTIFICATE-----
+MIIBtjCCATagAwIBAgIUe2PryrWo0xXX9vcA3WfbCzcdmgAwBQYDK2VxMCoxFjAU
+BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjIwMTEx
+MTExNjM5WhgPNDc1OTEyMDgxMTE2MzlaMCoxFjAUBgNVBAMMDVNNUCBzZXJ2ZXIg
+Q0ExEDAOBgNVBAoMB1NpbXBsZVgwQzAFBgMrZXEDOgCAcvFwVicR+RLZpiEWPFNR
+XYTbf+mFcX1NHIyPQDugFwOCgqJAW1fsjYgFhtQJSMH/lc1N7clfm4CjUzBRMB0G
+A1UdDgQWBBQcUJvR7mm26yxMQfCsWgbnwMmJVDAfBgNVHSMEGDAWgBQcUJvR7mm2
+6yxMQfCsWgbnwMmJVDAPBgNVHRMBAf8EBTADAQH/MAUGAytlcQNzAAAP/hMPNxyW
+fyJi+iJViodU+C/aklnvHtjh5P3AbiVCSUfY6+PEdvkC8Ov0pBAYpYi5ukSNNVXl
+ABVRlipB+vOcLQStNyaZ7kXzQ2IO/0btmIidh+G6SP8I4aytYIYYcV5pEUZpG1L1
+57g8P29SDv81AA==
+-----END CERTIFICATE-----

tests/fixtures/tls/server.crt

@@ -0,0 +1,12 @@
+-----BEGIN CERTIFICATE-----
+MIIBvDCCATygAwIBAgIUUgqht3ibEJ9jp5JuroML5Baxa/IwBQYDK2VxMCoxFjAU
+BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjIwMTEx
+MTYzOTQ2WhgPNDc1OTEyMDgxNjM5NDZaMBQxEjAQBgNVBAMMCWxvY2FsaG9zdDBD
+MAUGAytlcQM6AFj+fmjmgOMBFgQ7lXfICSlSaB5sYp1wzhM2IaqgmVhWbDs3Tw7W
+oUXFJsWpKku1kFjLH2yhqIInAKNvMG0wCQYDVR0TBAIwADALBgNVHQ8EBAMCA8gw
+EwYDVR0lBAwwCgYIKwYBBQUHAwEwHQYDVR0OBBYEFMjbHbxESDI8YDPjJ8kXWjkg
+jHxmMB8GA1UdIwQYMBaAFBxQm9HuabbrLExB8KxaBufAyYlUMAUGAytlcQNzAP98
+RpFacmjxsc07GwC07uAxUxNgxX4R2nA+0St866uFbdyxApiyn44giG+m+YXCXLjh
+1ffKEhhqAPdlpzByLarx8EWgmOsisBCRWrmraksOV15FKxjPqm7OYKp4f9GvieAQ
+o/SKOyZVVdcZX7NcuDUxAA==
+-----END CERTIFICATE-----

tests/fixtures/tls/server.key

@@ -0,0 +1,4 @@
+-----BEGIN PRIVATE KEY-----
+MEcCAQAwBQYDK2VxBDsEOZcXSjKQ3FQ9EBfqHmFIidOu4LecpUgi5NVPMhx7mS2d
+QNQ0lFasp+EfvLErbs1Sd9xLVxA1hnZJng==
+-----END PRIVATE KEY-----