wip

* use aeson fork with the option to encode/decode nullary constructors as empty objects

* update dependencies

.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"
+  "pr_template": "- ${{TITLE}}"
 }

.github/workflows/build.yml

@@ -19,7 +19,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'
 
@@ -31,11 +31,12 @@ jobs:
 
       - name: Build & test
         id: build_test
+        shell: bash
         run: |
           stack build --test --force-dirty
           install_root=$(stack path --local-install-root)
           mv ${install_root}/bin/smp-server smp-server-ubuntu-20_04-x86-64
-      
+
       - name: Build changelog
         if: startsWith(github.ref, 'refs/tags/v')
         id: build_changelog
@@ -47,15 +48,28 @@ jobs:
           commitMode: true
         env:
           GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-      
+
+      - name: Extract release candidate
+        if: startsWith(github.ref, 'refs/tags/v')
+        id: extract_release_candidate
+        shell: bash
+        run: |
+          if [[ ${GITHUB_REF} == *rc* ]]; then
+            echo "::set-output name=release_candidate::true"
+          else
+            echo "::set-output name=release_candidate::false"
+          fi
+
       - name: Create release
         if: startsWith(github.ref, 'refs/tags/v')
         uses: softprops/action-gh-release@v1
         with:
           body: |
             See full changelog [here](https://github.com/simplex-chat/simplexmq/blob/master/CHANGELOG.md).
-            Commits, chronological:
+
+            Commits:
             ${{ steps.build_changelog.outputs.changelog }}
+          prerelease: ${{ steps.extract_release_candidate.outputs.release_candidate }}
           files: |
             LICENSE
             smp-server-ubuntu-20_04-x86-64

.gitignore

@@ -2,3 +2,5 @@
 *.db
 *.db.bak
 *.session.sql
+tests/tmp
+dist-newstyle/

CHANGELOG.md

@@ -1,3 +1,50 @@
+# 1.0.2
+
+General:
+- Enable TLS 1.3 parameters for TLS handshake (server and client).
+- Switch from hs-tls fork to original repo now that it supports getFinished and getPeerFinished APIs for both TLS 1.2 and TLS 1.3.
+
+SMP server:
+- Perform TLS handshake in a separate thread per-connection.
+
+SMP agent:
+- Cease attempts to send HELLO after one week timeout.
+- Coalesce requests to connect to SMP servers, to have 1 connection per server.
+
+# 1.0.1
+
+SMP server:
+- Explicitly set line buffering in stdout/stderr to log each line when output is redirected to files.
+
+# 1.0.0
+
+Security and privacy improvements:
+- Faster and more secure 2-layer E2E encryption with additional encryption layer between servers and recipients:
+  - application messages in each duplex connection (managed by SMP agents - see [overview](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md)) are encrypted using [double-ratchet algorithm](https://www.signal.org/docs/specifications/doubleratchet/), providing forward secrecy and break-in recovery. This layer uses two Curve448 keys per client for [X3DH key agreement](https://www.signal.org/docs/specifications/x3dh/), SHA512 based HKDFs and AES-GCM AEAD encryption.
+  - SMP client messages are additionally E2E encrypted in each SMP queue to avoid cipher-text correlation of messages sent via multiple redundant queues (that will be supported soon). This and the next layer use [NaCl crypto_box algorithm](https://nacl.cr.yp.to/index.html) with XSalsa20Poly1305 cipher and Curve25519 keys for DH key agreement.
+  - Messages delivered from the servers to the recipients are additionally encrypted to avoid cipher-text correlation between sent and received messages.
+- To prevent any traffic correlation by content size, SimpleX uses fixed transport block size of 16kb (16384 bytes) with padding on all encryption layers:
+  - application messages are padded to 15788 bytes before E2E double-ratchet encryption.
+  - messages between SMP clients are padded to 16032 bytes before E2E encryption in each SMP queue.
+  - messages from the server to the recipient are padded to padded to 16088 bytes before the additional encryption layer (see above).
+- TLS 1.2+ with tls-unique channel binding in each command to prevent replay attacks.
+- Server identity verification via server offline certificate fingerprints included in SMP server addresses.
+
+New functionality:
+- Support for notification servers with new SMP commands: `NKEY`/`NID`, `NSUB`/`NMSG`.
+
+Efficiency improvements:
+- Binary protocol encodings to reduce overhead from circa 15% to approximately 3.7% of transmitted application message size, with only 2.2% overhead for SMP protocol messages.
+- More performant cryptographic algorithms.
+
+For more information about SimpleX:
+- [SimpleX overview](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md).
+- [SimpleX chat v1 announcement](https://github.com/simplex-chat/simplex-chat/blob/master/blog/20220112-simplex-chat-v1-released.md).
+
+# 0.5.2
+
+- Fix message delivery logic that blocked delivery of all server messages when server per-queue quota exceeded, making it concurrent per SMP queue, not per server.
+
 # 0.5.1
 
 - Fix server subscription logic bug that was leading to memory leak / resource exhaustion in some edge cases.

README.md

@@ -3,38 +3,61 @@
 [![GitHub build](https://github.com/simplex-chat/simplexmq/workflows/build/badge.svg)](https://github.com/simplex-chat/simplexmq/actions?query=workflow%3Abuild)
 [![GitHub release](https://img.shields.io/github/v/release/simplex-chat/simplexmq)](https://github.com/simplex-chat/simplexmq/releases)
 
-📢 **v0.5.1 brings a hotfix to the server's subscription management logic, to apply it log in to your server via SSH and run the following command. If you have store log enabled for your server, information about already established queues will be preserved.** If you're doing a custom installation instead of Linode or DigitalOcean you may have to change the path for binary download.
+📢 SimpleXMQ v1 is released - with many security, privacy and efficiency improvements, new functionality - see [release notes](https://github.com/simplex-chat/simplexmq/releases/tag/v1.0.0).
 
-```sh
-systemctl stop smp-server && curl -L -o /opt/simplex/bin/smp-server https://github.com/simplex-chat/simplexmq/releases/download/v0.5.1/smp-server-ubuntu-20_04-x86-64 && chmod +x /opt/simplex/bin/smp-server && systemctl start smp-server
-```
+**Please note**: v1 is not backwards compatible, but it has the version negotiation built into all protocol layers for forwards compatibility of this version and backwards compatibility of the future versions, that will be backwards compatible for at least two versions back.
+
+If you have a server deployed please deploy a new server to a new host and retire the previous version once it is no longer used.
 
 ## Message broker for unidirectional (simplex) queues
 
 SimpleXMQ is a message broker for managing message queues and sending messages over public network. It consists of SMP server, SMP client library and SMP agent that implement [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md) for client-server communication and [SMP agent protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md) to manage duplex connections via simplex queues on multiple SMP servers.
 
-SMP protocol is inspired by [Redis serialization protocol](https://redis.io/topics/protocol), but it is much simpler - it currently has only 8 client commands and 6 server responses.
+SMP protocol is inspired by [Redis serialization protocol](https://redis.io/topics/protocol), but it is much simpler - it currently has only 10 client commands and 8 server responses.
 
 SimpleXMQ is implemented in Haskell - it benefits from robust software transactional memory (STM) and concurrency primitives that Haskell provides.
 
 ## SimpleXMQ roadmap
 
-- SMP queue redundancy and rotation in SMP agent duplex connections.
+- SimpleX service protocol and application template - to enable users building services and chat bots that work over SimpleX protocol stack. The first such service will be a notification service for a mobile app.
+- SMP queue redundancy and rotation in SMP agent connections.
 - SMP agents synchronization to share connections and messages between multiple agents (it would allow using multiple devices for [simplex-chat](https://github.com/simplex-chat/simplex-chat)).
-- Streams - high performance message queues. See [Streams RFC](https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-02-28-streams.md) for details.
 
 ## Components
 
 ### SMP server
 
-[SMP server](https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-server/Main.hs) can be run on any Linux distribution without any dependencies. It uses in-memory persistence with an optional append-only log of created queues that allows to re-start the server without losing the connections. This log is compacted on every server restart, permanently removing suspended and removed queues.
+[SMP server](https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-server/Main.hs) can be run on any Linux distribution without any dependencies, including low power/low memory devices.
 
-To enable the queue logging, uncomment `enable: on` option in `smp-server.ini` configuration file that is created the first time the server is started.
+To initialize the server use `smp-server init` command - it will generate keys and certificates for TLS transport. The fingerprint of offline certificate is used as part of the server address to protect client/server connection against man-in-the-middle attacks: `smp://<fingerprint>@<hostname>[:5223]`.
 
-On the first start the server generates an RSA key pair for encrypted transport handshake and outputs hash of the public key every time it runs - this hash should be used as part of the server address: `<hostname>:5223#<key hash>`.
+SMP server uses in-memory persistence with an optional append-only log of created queues that allows to re-start the server without losing the connections. This log is compacted on every server restart, permanently removing suspended and removed queues.
+
+To enable store log, initialize server using `smp-server -l` command, or modify `smp-server.ini` created during initialization (uncomment `enable: on` option in the store log section). Use `smp-server --help` for other usage tips.
+
+> **Please note:** On initialization SMP server creates a chain of two certificates: a self-signed CA certificate ("offline") and a server certificate used for TLS handshake ("online"). **You should store CA certificate private key securely and delete it from the server. If server TLS credential is compromised this key can be used to sign a new one, keeping the same server identity and established connections.** CA private key location by default is `/etc/opt/simplex/ca.key`.
 
 SMP server implements [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md).
 
+#### Running SMP server on MacOS
+
+SMP server requires OpenSSL library for initialization. On MacOS OpenSSL library may be replaced with LibreSSL, which doesn't support required algorithms. Before initializing SMP server verify you have OpenSSL installed:
+
+```sh
+openssl version
+```
+
+If it says "LibreSSL", please install original OpenSSL:
+
+```sh
+brew update
+brew install openssl
+echo 'PATH="/opt/homebrew/opt/openssl@3/bin:$PATH"' >> ~/.zprofile # or follow whatever instructions brew suggests
+. ~/.zprofile # or restart your terminal to start a new session
+```
+
+Now `openssl version` should be saying "OpenSSL". You can now run `smp-server init` to initialize your SMP server.
+
 ### SMP client library
 
 [SMP client](https://github.com/simplex-chat/simplexmq/blob/master/src/Simplex/Messaging/Client.hs) is a Haskell library to connect to SMP servers that allows to:
@@ -54,10 +77,13 @@ See [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI for
 
 ## Using SMP server and SMP agent
 
-You can either run your own SMP server locally or deploy using [Linode StackScript](#deploy-smp-server-on-linode), or try local SMP agent with the deployed servers:
+You can either run your own SMP server locally or deploy using [Linode StackScript](https://cloud.linode.com/stackscripts/748014), or try local SMP agent with the deployed servers:
 
-`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`
 
 It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI.
 
@@ -65,21 +91,23 @@ It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.
 
 ## Deploy SMP server on Linode
 
-You can get Linode [free credits](https://www.linode.com/lp/affiliate-referral/?irclickid=02-QkdTEpxyLW0W0EOSREQreUkB2DtzGE2lGTE0&irgwc=1&utm_source=impact) to deploy SMP server.
+\* You can use free credit Linode offers when [creating a new account](https://www.linode.com/) to deploy an SMP server.
 
-Deployment on [Linode](https://www.linode.com/) is performed via StackScripts, which serve as recipes for Linode instances, also called Linodes. To deploy SMP server on Linode:
+Deployment on Linode is performed via StackScripts, which serve as recipes for Linode instances, also called Linodes. To deploy SMP server on Linode:
 
 - Create a Linode account or login with an already existing one.
 - Open [SMP server StackScript](https://cloud.linode.com/stackscripts/748014) and click "Deploy New Linode".
 - You can optionally configure the following parameters:
-    - [SMP Server store log](#SMP-server) flag for queue persistence on server restart (recommended).
-    - [Linode API token](https://www.linode.com/docs/guides/getting-started-with-the-linode-api#get-an-access-token) for attaching server info as tags to Linode (server address, public key hash, version) and adding A record to your 2nd level domain (Note: 2nd level e.g. `example.com` domain should be [created](https://cloud.linode.com/domains/create) in your account prior to deployment). The API token access scope should be read/write access to "linodes" (to update linode tags - you need them), and "domains" (to add A record for the 3rd level domain, e.g. `smp`).
-    - Domain name to use instead of Linode ip address, e.g. `smp.example.com`.
-- Choose the region and plan according to your requirements (for regular use Shared CPU Nanode should be sufficient).
-- Provide ssh key to be able to connect to your Linode via ssh. This step is required if you haven't provided a Linode API token, because you will need to login to your Linode and get a public key hash either from the welcome message or from the file `/etc/opt/simplex/pub_key_hash` on your Linode after SMP server starts.
+    - SMP Server store log flag for queue persistence on server restart, recommended.
+    - [Linode API token](https://www.linode.com/docs/guides/getting-started-with-the-linode-api#get-an-access-token) to attach server address etc. as tags to Linode and to add A record to your 2nd level domain (e.g. `example.com` [domain should be created](https://cloud.linode.com/domains/create) in your account prior to deployment). The API token access scopes:
+      - read/write for "linodes"
+      - read/write for "domains"
+    - Domain name to use instead of Linode IP address, e.g. `smp1.example.com`.
+- Choose the region and plan, Shared CPU Nanode with 1Gb is sufficient.
+- Provide ssh key to be able to connect to your Linode via ssh. If you haven't provided a Linode API token this step is required to login to your Linode and get the server's fingerprint either from the welcome message or from the file `/etc/opt/simplex/fingerprint` after server starts. See [Linode's guide on ssh](https://www.linode.com/docs/guides/use-public-key-authentication-with-ssh/) .
 - Deploy your Linode. After it starts wait for SMP server to start and for tags to appear (if a Linode API token was provided). It may take up to 5 minutes depending on the connection speed on the Linode. Connecting Linode IP address to provided domain name may take some additional time.
-- Get `hostname` and `hash` either from Linode tags (click on a tag and copy it's value from the browser search panel) or via ssh. Linode has a good [guide](https://www.linode.com/docs/guides/use-public-key-authentication-with-ssh/) about ssh.
-- Great, your own SMP server is ready! Use `address#hash` as SMP server address in the client.
+- Get `address` and `fingerprint` either from Linode tags (click on a tag and copy it's value from the browser search panel) or via ssh.
+- Great, your own SMP server is ready! If you provided FQDN use `smp://<fingerprint>@<fqdn>` as SMP server address in the client, otherwise use `smp://<fingerprint>@<ip_address>`.
 
 Please submit an [issue](https://github.com/simplex-chat/simplexmq/issues) if any problems occur.
 
@@ -87,17 +115,28 @@ Please submit an [issue](https://github.com/simplex-chat/simplexmq/issues) if an
 
 ## Deploy SMP server on DigitalOcean
 
-You can deploy SMP server using [SimpleX Server 1-click app](https://marketplace.digitalocean.com/apps/simplex-server) from DigitalOcean marketplace:
+> 🚧 DigitalOcean snapshot is currently not up to date, it will soon be updated 🏗️
+
+\* When creating a DigitalOcean account you can use [this link](https://try.digitalocean.com/freetrialoffer/) to get free credit. (You would still be required either to provide your credit card details or make a confirmation pre-payment with PayPal)
+
+To deploy SMP server use [SimpleX Server 1-click app](https://marketplace.digitalocean.com/apps/simplex-server) from DigitalOcean marketplace:
 
 - Create a DigitalOcean account or login with an already existing one.
 - Click 'Create SimpleX server Droplet' button.
-- Choose the region and plan according to your requirements (cheapest Regular plan should be sufficient).
-- Provide ssh key and confirm Droplet creation. 
-- SSH to created Droplet (`ssh root@<droplet_ip_address>`) to get SMP server public key hash - either from the welcome message or from `/etc/opt/simplex/pub_key_hash`. DigitalOcean has a good guide on [how to login to Droplet via ssh](https://docs.digitalocean.com/products/droplets/how-to/connect-with-ssh/).
-- Great, your own SMP server is ready! Use `ip_address#hash` as SMP server address in the client.
+- Choose the region and plan according to your requirements (Basic plan should be sufficient).
+- Finalize Droplet creation.
+- Open "Console" on your Droplet management page to get SMP server fingerprint - either from the welcome message or from `/etc/opt/simplex/fingerprint`. Alternatively you can manually SSH to created Droplet, see [DigitalOcean instruction](https://docs.digitalocean.com/products/droplets/how-to/connect-with-ssh/).
+- Great, your own SMP server is ready! Use `smp://<fingerprint>@<ip_address>` as SMP server address in the client.
 
 Please submit an [issue](https://github.com/simplex-chat/simplexmq/issues) if any problems occur.
 
+> **Please note:** SMP server uses server address as a Common Name for server certificate generated during initialization. If you would like your server address to be FQDN instead of IP address, you can log in to your Droplet and run the commands below to re-initialize the server. Alternatively you can use [Linode StackScript](https://cloud.linode.com/stackscripts/748014) which allows this parameterization.
+
+```sh
+smp-server delete
+smp-server init [-l] -n <fqdn>
+```
+
 ## SMP server design
 
 ![SMP server design](https://raw.githubusercontent.com/simplex-chat/simplexmq/master/design/server.svg)

apps/smp-agent/Main.hs

@@ -6,12 +6,12 @@ module Main where
 
 import Control.Logger.Simple
 import qualified Data.List.NonEmpty as L
-import Simplex.Messaging.Agent (runSMPAgent)
-import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Transport (TCP, Transport (..))
+import Simplex.Messaging.Agent.Env.Postgres
+import Simplex.Messaging.Agent.Server (runSMPAgent)
+import Simplex.Messaging.Transport (TLS, Transport (..))
 
 cfg :: AgentConfig
-cfg = defaultAgentConfig {smpServers = L.fromList ["localhost:5223#bU0K+bRg24xWW//lS0umO1Zdw/SXqpJNtm1/RrPLViE="]}
+cfg = defaultAgentConfig {smpServers = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"]}
 
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
@@ -20,4 +20,4 @@ main :: IO ()
 main = do
   putStrLn $ "SMP agent listening on port " ++ tcpPort (cfg :: AgentConfig)
   setLogLevel LogInfo -- LogError
-  withGlobalLogging logCfg $ runSMPAgent (transport @TCP) cfg
+  withGlobalLogging logCfg $ runSMPAgent (transport @TLS) cfg

apps/smp-server/Main.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -8,52 +9,28 @@
 module Main where
 
 import Control.Monad.Except
-import Control.Monad.Trans.Except
-import qualified Crypto.Store.PKCS8 as S
-import Data.ByteString.Base64 (encode)
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Char (toLower)
+import Data.Either (fromRight)
 import Data.Ini (Ini, lookupValue, readIniFile)
-import Data.Text (Text)
+import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
-import Data.X509 (PrivKey (PrivKeyRSA))
-import Network.Socket (ServiceName)
+import Data.X509.Validation (Fingerprint (..))
+import Network.Socket (HostName, ServiceName)
 import Options.Applicative
-import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath)
-import Simplex.Messaging.Transport (ATransport (..), TCP, Transport (..))
+import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..), simplexMQVersion)
+import Simplex.Messaging.Transport.Server (loadFingerprint)
 import Simplex.Messaging.Transport.WebSockets (WS)
-import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeDirectoryRecursive)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
-import System.IO (IOMode (..), hFlush, stdout)
-import Text.Read (readEither)
-
-defaultServerPort :: ServiceName
-defaultServerPort = "5223"
-
-defaultBlockSize :: Int
-defaultBlockSize = 4096
-
-serverConfig :: ServerConfig
-serverConfig =
-  ServerConfig
-    { tbqSize = 16,
-      serverTbqSize = 128,
-      msgQueueQuota = 256,
-      queueIdBytes = 12,
-      msgIdBytes = 6,
-      -- below parameters are set based on ini file /etc/opt/simplex/smp-server.ini
-      transports = undefined,
-      storeLog = undefined,
-      blockSize = undefined,
-      serverPrivateKey = undefined
-    }
-
-newKeySize :: Int
-newKeySize = 2048 `div` 8
+import System.IO (BufferMode (..), IOMode (..), hGetLine, hSetBuffering, stderr, stdout, withFile)
+import System.Process (readCreateProcess, shell)
+import Text.Read (readMaybe)
 
 cfgDir :: FilePath
 cfgDir = "/etc/opt/simplex"
@@ -61,217 +38,282 @@ cfgDir = "/etc/opt/simplex"
 logDir :: FilePath
 logDir = "/var/opt/simplex"
 
-defaultStoreLogFile :: FilePath
-defaultStoreLogFile = combine logDir "smp-server-store.log"
-
 iniFile :: FilePath
 iniFile = combine cfgDir "smp-server.ini"
 
-defaultKeyFile :: FilePath
-defaultKeyFile = combine cfgDir "server_key"
+storeLogFile :: FilePath
+storeLogFile = combine logDir "smp-server-store.log"
+
+caKeyFile :: FilePath
+caKeyFile = combine cfgDir "ca.key"
+
+caCrtFile :: FilePath
+caCrtFile = combine cfgDir "ca.crt"
+
+serverKeyFile :: FilePath
+serverKeyFile = combine cfgDir "server.key"
+
+serverCrtFile :: FilePath
+serverCrtFile = combine cfgDir "server.crt"
+
+fingerprintFile :: FilePath
+fingerprintFile = combine cfgDir "fingerprint"
 
 main :: IO ()
 main = do
-  opts <- getServerOpts
-  case serverCommand opts of
-    ServerInit ->
-      runExceptT (getConfig opts) >>= \case
-        Right cfg -> do
-          putStrLn "Error: server is already initialized. Start it with `smp-server start` command"
-          printConfig cfg
-          exitFailure
-        Left _ -> do
-          cfg <- initializeServer opts
-          putStrLn "Server was initialized. Start it with `smp-server start` command"
-          printConfig cfg
-    ServerStart ->
-      runExceptT (getConfig opts) >>= \case
-        Right cfg -> runServer cfg
-        Left e -> do
-          putStrLn $ "Server is not initialized: " <> e
-          putStrLn "Initialize server with `smp-server init` command"
-          exitFailure
-    ServerDelete -> do
-      deleteServer
-      putStrLn "Server key, config file and store log deleted"
+  getCliCommand >>= \case
+    Init opts ->
+      doesFileExist iniFile >>= \case
+        True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `smp-server start`."
+        _ -> initializeServer opts
+    Start ->
+      doesFileExist iniFile >>= \case
+        True -> readIniFile iniFile >>= either exitError (runServer . mkIniOptions)
+        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `smp-server init`."
+    Delete -> cleanup >> putStrLn "Deleted configuration and log files"
 
-getConfig :: ServerOpts -> ExceptT String IO ServerConfig
-getConfig opts = do
-  ini <- readIni
-  pk <- readKey ini
-  storeLog <- liftIO $ openStoreLog opts ini
-  pure $ makeConfig ini pk storeLog
+exitError :: String -> IO ()
+exitError msg = putStrLn msg >> exitFailure
 
-makeConfig :: IniOpts -> C.FullPrivateKey -> Maybe (StoreLog 'ReadMode) -> ServerConfig
-makeConfig IniOpts {serverPort, blockSize, enableWebsockets} pk storeLog =
-  let transports = (serverPort, transport @TCP) : [("80", transport @WS) | enableWebsockets]
-   in serverConfig {serverPrivateKey = pk, storeLog, blockSize, transports}
+data CliCommand
+  = Init InitOptions
+  | Start
+  | Delete
 
-printConfig :: ServerConfig -> IO ()
-printConfig ServerConfig {serverPrivateKey, storeLog} = do
-  B.putStrLn $ "transport key hash: " <> serverKeyHash serverPrivateKey
-  putStrLn $ case storeLog of
-    Just s -> "store log: " <> storeLogFilePath s
-    Nothing -> "store log disabled"
-
-initializeServer :: ServerOpts -> IO ServerConfig
-initializeServer opts = do
-  createDirectoryIfMissing False cfgDir
-  ini <- createIni opts
-  pk <- createKey ini
-  storeLog <- openStoreLog opts ini
-  pure $ makeConfig ini pk storeLog
-
-runServer :: ServerConfig -> IO ()
-runServer cfg = do
-  printConfig cfg
-  forM_ (transports cfg) $ \(port, ATransport t) ->
-    putStrLn $ "listening on port " <> port <> " (" <> transportName t <> ")"
-  runSMPServer cfg
-
-deleteServer :: IO ()
-deleteServer = do
-  ini <- runExceptT readIni
-  deleteIfExists iniFile
-  case ini of
-    Right IniOpts {storeLogFile, serverKeyFile} -> do
-      deleteIfExists storeLogFile
-      deleteIfExists serverKeyFile
-    Left _ -> do
-      deleteIfExists defaultKeyFile
-      deleteIfExists defaultStoreLogFile
-
-data IniOpts = IniOpts
+data InitOptions = InitOptions
   { enableStoreLog :: Bool,
-    storeLogFile :: FilePath,
-    serverKeyFile :: FilePath,
-    serverPort :: ServiceName,
-    blockSize :: Int,
+    signAlgorithm :: SignAlgorithm,
+    ip :: HostName,
+    fqdn :: Maybe HostName
+  }
+  deriving (Show)
+
+data SignAlgorithm = ED448 | ED25519
+  deriving (Read, Show)
+
+getCliCommand :: IO CliCommand
+getCliCommand =
+  customExecParser
+    (prefs showHelpOnEmpty)
+    ( info
+        (helper <*> versionOption <*> cliCommandP)
+        (header version <> fullDesc)
+    )
+  where
+    versionOption = infoOption version (long "version" <> short 'v' <> help "Show version")
+
+cliCommandP :: Parser CliCommand
+cliCommandP =
+  hsubparser
+    ( command "init" (info initP (progDesc $ "Initialize server - creates " <> cfgDir <> " and " <> logDir <> " directories and configuration files"))
+        <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
+        <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
+    )
+  where
+    initP :: Parser CliCommand
+    initP =
+      Init
+        <$> ( InitOptions
+                <$> switch
+                  ( long "store-log"
+                      <> short 'l'
+                      <> help "Enable store log for SMP queues persistence"
+                  )
+                <*> option
+                  (maybeReader readMaybe)
+                  ( long "sign-algorithm"
+                      <> short 'a'
+                      <> help "Signature algorithm used for TLS certificates: ED25519, ED448"
+                      <> value ED448
+                      <> showDefault
+                      <> metavar "ALG"
+                  )
+                <*> strOption
+                  ( long "ip"
+                      <> help
+                        "Server IP address used as Subject Alternative Name for TLS online certificate, \
+                        \also used as Common Name if FQDN is not supplied"
+                      <> value "127.0.0.1"
+                      <> showDefault
+                      <> metavar "IP"
+                  )
+                <*> (optional . strOption)
+                  ( long "fqdn"
+                      <> short 'n'
+                      <> help "Server FQDN used as Common Name and Subject Alternative Name for TLS online certificate"
+                      <> showDefault
+                      <> metavar "FQDN"
+                  )
+            )
+
+initializeServer :: InitOptions -> IO ()
+initializeServer InitOptions {enableStoreLog, signAlgorithm, ip, fqdn} = do
+  cleanup
+  createDirectoryIfMissing True cfgDir
+  createDirectoryIfMissing True logDir
+  createX509
+  fp <- saveFingerprint
+  createIni
+  putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `smp-server start` to start server."
+  printServiceInfo fp
+  warnCAPrivateKeyFile
+  where
+    createX509 = do
+      createOpensslCaConf
+      createOpensslServerConf
+      -- CA certificate (identity/offline)
+      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> caKeyFile
+      run $ "openssl req -new -x509 -days 999999 -config " <> opensslCaConfFile <> " -extensions v3 -key " <> caKeyFile <> " -out " <> caCrtFile
+      -- server certificate (online)
+      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> serverKeyFile
+      run $ "openssl req -new -config " <> opensslServerConfFile <> " -reqexts v3 -key " <> serverKeyFile <> " -out " <> serverCsrFile
+      run $ "openssl x509 -req -days 999999 -extfile " <> opensslServerConfFile <> " -extensions v3 -in " <> serverCsrFile <> " -CA " <> caCrtFile <> " -CAkey " <> caKeyFile <> " -CAcreateserial -out " <> serverCrtFile
+      where
+        run cmd = void $ readCreateProcess (shell cmd) ""
+        opensslCaConfFile = combine cfgDir "openssl_ca.conf"
+        opensslServerConfFile = combine cfgDir "openssl_server.conf"
+        serverCsrFile = combine cfgDir "server.csr"
+        createOpensslCaConf =
+          writeFile
+            opensslCaConfFile
+            "[req]\n\
+            \distinguished_name = req_distinguished_name\n\
+            \prompt = no\n\n\
+            \[req_distinguished_name]\n\
+            \CN = SMP server CA\n\
+            \O = SimpleX\n\n\
+            \[v3]\n\
+            \subjectKeyIdentifier = hash\n\
+            \authorityKeyIdentifier = keyid:always\n\
+            \basicConstraints = critical,CA:true\n"
+        -- TODO revise https://www.rfc-editor.org/rfc/rfc5280#section-4.2.1.3, https://www.rfc-editor.org/rfc/rfc3279#section-2.3.5
+        -- IP and FQDN can't both be used as server address interchangeably even if IP is added
+        -- as Subject Alternative Name, unless the following validation hook is disabled:
+        -- https://hackage.haskell.org/package/x509-validation-1.6.10/docs/src/Data-X509-Validation.html#validateCertificateName
+        createOpensslServerConf =
+          writeFile
+            opensslServerConfFile
+            ( "[req]\n\
+              \distinguished_name = req_distinguished_name\n\
+              \prompt = no\n\n\
+              \[req_distinguished_name]\n"
+                <> ("CN = " <> cn <> "\n\n")
+                <> "[v3]\n\
+                   \basicConstraints = CA:FALSE\n\
+                   \keyUsage = digitalSignature, nonRepudiation, keyAgreement\n\
+                   \extendedKeyUsage = serverAuth\n"
+            )
+          where
+            cn = fromMaybe ip fqdn
+
+    saveFingerprint = do
+      Fingerprint fp <- loadFingerprint caCrtFile
+      withFile fingerprintFile WriteMode (`B.hPutStrLn` strEncode fp)
+      pure fp
+
+    createIni = do
+      writeFile iniFile $
+        "[STORE_LOG]\n\
+        \# The server uses STM memory to store SMP queues and messages,\n\
+        \# that will be lost on restart (e.g., as with redis).\n\
+        \# This option enables saving SMP queues to append only log,\n\
+        \# and restoring them when the server is started.\n\
+        \# Log is compacted on start (deleted queues are removed).\n\
+        \# The messages in the queues are not logged.\n"
+          <> ("enable: " <> (if enableStoreLog then "on" else "off  # on") <> "\n\n")
+          <> "[TRANSPORT]\n\
+             \port: 5223\n\
+             \websockets: off\n"
+
+    warnCAPrivateKeyFile =
+      putStrLn $
+        "----------\n\
+        \You should store CA private key securely and delete it from the server.\n\
+        \If server TLS credential is compromised this key can be used to sign a new one, \
+        \keeping the same server identity and established connections.\n\
+        \CA private key location:\n"
+          <> caKeyFile
+          <> "\n----------"
+
+data IniOptions = IniOptions
+  { enableStoreLog :: Bool,
+    port :: ServiceName,
     enableWebsockets :: Bool
   }
 
-readIni :: ExceptT String IO IniOpts
-readIni = do
-  fileExists iniFile
-  ini <- ExceptT $ readIniFile iniFile
-  let enableStoreLog = (== Right "on") $ lookupValue "STORE_LOG" "enable" ini
-      storeLogFile = opt defaultStoreLogFile "STORE_LOG" "file" ini
-      serverKeyFile = opt defaultKeyFile "TRANSPORT" "key_file" ini
-      serverPort = opt defaultServerPort "TRANSPORT" "port" ini
-      enableWebsockets = (== Right "on") $ lookupValue "TRANSPORT" "websockets" ini
-  blockSize <- liftEither . readEither $ opt (show defaultBlockSize) "TRANSPORT" "block_size" ini
-  pure IniOpts {enableStoreLog, storeLogFile, serverKeyFile, serverPort, blockSize, enableWebsockets}
+-- TODO ? properly parse ini as a whole
+mkIniOptions :: Ini -> IniOptions
+mkIniOptions ini =
+  IniOptions
+    { enableStoreLog = (== "on") $ strict "STORE_LOG" "enable",
+      port = T.unpack $ strict "TRANSPORT" "port",
+      enableWebsockets = (== "on") $ strict "TRANSPORT" "websockets"
+    }
   where
-    opt :: String -> Text -> Text -> Ini -> String
-    opt def section key ini = either (const def) T.unpack $ lookupValue section key ini
+    strict :: String -> String -> T.Text
+    strict section key =
+      fromRight (error ("no key " <> key <> " in section " <> section)) $
+        lookupValue (T.pack section) (T.pack key) ini
 
-createIni :: ServerOpts -> IO IniOpts
-createIni ServerOpts {enableStoreLog} = do
-  writeFile iniFile $
-    "[STORE_LOG]\n\
-    \# The server uses STM memory to store SMP queues and messages,\n\
-    \# that will be lost on restart (e.g., as with redis).\n\
-    \# This option enables saving SMP queues to append only log,\n\
-    \# and restoring them when the server is started.\n\
-    \# Log is compacted on start (deleted queues are removed).\n\
-    \# The messages in the queues are not logged.\n\n"
-      <> (if enableStoreLog then "" else "# ")
-      <> "enable: on\n\
-         \# file: "
-      <> defaultStoreLogFile
-      <> "\n\n\
-         \[TRANSPORT]\n\n\
-         \# key_file: "
-      <> defaultKeyFile
-      <> "\n\
-         \# port: "
-      <> defaultServerPort
-      <> "\n\
-         \# block_size: "
-      <> show defaultBlockSize
-      <> "\n\
-         \websockets: on\n"
-  pure
-    IniOpts
-      { enableStoreLog,
-        storeLogFile = defaultStoreLogFile,
-        serverKeyFile = defaultKeyFile,
-        serverPort = defaultServerPort,
-        blockSize = defaultBlockSize,
-        enableWebsockets = True
-      }
-
-readKey :: IniOpts -> ExceptT String IO C.FullPrivateKey
-readKey IniOpts {serverKeyFile} = do
-  fileExists serverKeyFile
-  liftIO (S.readKeyFile serverKeyFile) >>= \case
-    [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.FullPrivateKey pk
-    [_] -> err "not RSA key"
-    [] -> err "invalid key file format"
-    _ -> err "more than one key"
+runServer :: IniOptions -> IO ()
+runServer IniOptions {enableStoreLog, port, enableWebsockets} = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stderr LineBuffering
+  fp <- checkSavedFingerprint
+  printServiceInfo fp
+  storeLog <- openStoreLog
+  let cfg = mkServerConfig storeLog
+  printServerConfig cfg
+  runSMPServer cfg
   where
-    err :: String -> ExceptT String IO b
-    err e = throwE $ e <> ": " <> serverKeyFile
+    checkSavedFingerprint = do
+      savedFingerprint <- loadSavedFingerprint
+      Fingerprint fp <- loadFingerprint caCrtFile
+      when (B.pack savedFingerprint /= strEncode fp) $
+        exitError "Stored fingerprint is invalid."
+      pure fp
 
-createKey :: IniOpts -> IO C.FullPrivateKey
-createKey IniOpts {serverKeyFile} = do
-  (_, pk) <- C.generateKeyPair newKeySize
-  S.writeKeyFile S.TraditionalFormat serverKeyFile [PrivKeyRSA $ C.rsaPrivateKey pk]
-  pure pk
+    mkServerConfig storeLog =
+      ServerConfig
+        { transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets],
+          tbqSize = 16,
+          serverTbqSize = 128,
+          msgQueueQuota = 256,
+          queueIdBytes = 24,
+          msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
+          caCertificateFile = caCrtFile,
+          privateKeyFile = serverKeyFile,
+          certificateFile = serverCrtFile,
+          storeLog
+        }
 
-fileExists :: FilePath -> ExceptT String IO ()
-fileExists path = do
-  exists <- liftIO $ doesFileExist path
-  unless exists . throwE $ "file " <> path <> " not found"
+    openStoreLog :: IO (Maybe (StoreLog 'ReadMode))
+    openStoreLog =
+      if enableStoreLog
+        then Just <$> openReadStoreLog storeLogFile
+        else pure Nothing
 
-deleteIfExists :: FilePath -> IO ()
-deleteIfExists path = doesFileExist path >>= (`when` removeFile path)
+    printServerConfig ServerConfig {storeLog, transports} = do
+      putStrLn $ case storeLog of
+        Just s -> "Store log: " <> storeLogFilePath s
+        Nothing -> "Store log disabled."
+      forM_ transports $ \(p, ATransport t) ->
+        putStrLn $ "Listening on port " <> p <> " (" <> transportName t <> ")..."
 
-confirm :: String -> IO ()
-confirm msg = do
-  putStr $ msg <> " (y/N): "
-  hFlush stdout
-  ok <- getLine
-  when (map toLower ok /= "y") exitFailure
-
-serverKeyHash :: C.FullPrivateKey -> B.ByteString
-serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey'
-
-openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode))
-openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f}
-  | l || l' = do
-    createDirectoryIfMissing True logDir
-    Just <$> openReadStoreLog f
-  | otherwise = pure Nothing
-
-data ServerOpts = ServerOpts
-  { serverCommand :: ServerCommand,
-    enableStoreLog :: Bool
-  }
-
-data ServerCommand = ServerInit | ServerStart | ServerDelete
-
-serverOpts :: Parser ServerOpts
-serverOpts =
-  ServerOpts
-    <$> subparser
-      ( command "init" (info (pure ServerInit) (progDesc "Initialize server: generate server key and ini file"))
-          <> command "start" (info (pure ServerStart) (progDesc "Start server (ini: /etc/opt/simplex/smp-server.ini)"))
-          <> command "delete" (info (pure ServerDelete) (progDesc "Delete server key, ini file and store log"))
-      )
-    <*> switch
-      ( long "store-log"
-          <> short 'l'
-          <> help "enable store log for SMP queues persistence"
-      )
-
-getServerOpts :: IO ServerOpts
-getServerOpts = customExecParser p opts
+cleanup :: IO ()
+cleanup = do
+  deleteDirIfExists cfgDir
+  deleteDirIfExists logDir
   where
-    p = prefs showHelpOnEmpty
-    opts =
-      info
-        (serverOpts <**> helper)
-        ( fullDesc
-            <> header "Simplex Messaging Protocol (SMP) Server"
-        )
+    deleteDirIfExists path = doesDirectoryExist path >>= (`when` removeDirectoryRecursive path)
+
+printServiceInfo :: ByteString -> IO ()
+printServiceInfo fpStr = do
+  putStrLn version
+  B.putStrLn $ "Fingerprint: " <> strEncode fpStr
+
+version :: String
+version = "SMP server v" <> simplexMQVersion
+
+loadSavedFingerprint :: IO String
+loadSavedFingerprint = withFile fingerprintFile ReadMode hGetLine

cabal.project

@@ -0,0 +1,6 @@
+packages: .
+
+source-repository-package
+    type: git
+    location: git://github.com/simplex-chat/aeson.git
+    tag: 3eb66f9a68f103b5f1489382aad89f5712a64db7

migrations/20210101_initial.sql

@@ -1,117 +0,0 @@
-CREATE TABLE IF NOT EXISTS servers(
-  host TEXT NOT NULL,
-  port TEXT NOT NULL,
-  key_hash BLOB,
-  PRIMARY KEY (host, port)
-) WITHOUT ROWID;
-
-CREATE TABLE IF NOT EXISTS rcv_queues(
-  host TEXT NOT NULL,
-  port TEXT NOT NULL,
-  rcv_id BLOB NOT NULL,
-  conn_alias BLOB NOT NULL,
-  rcv_private_key BLOB NOT NULL,
-  snd_id BLOB,
-  snd_key BLOB,
-  decrypt_key BLOB NOT NULL,
-  verify_key BLOB,
-  status TEXT NOT NULL,
-  PRIMARY KEY (host, port, rcv_id),
-  FOREIGN KEY (host, port) REFERENCES servers (host, port),
-  FOREIGN KEY (conn_alias)
-    REFERENCES connections (conn_alias)
-    ON DELETE CASCADE
-    DEFERRABLE INITIALLY DEFERRED,
-  UNIQUE (host, port, snd_id)
-) WITHOUT ROWID;
-
-CREATE TABLE IF NOT EXISTS snd_queues(
-  host TEXT NOT NULL,
-  port TEXT NOT NULL,
-  snd_id BLOB NOT NULL,
-  conn_alias BLOB NOT NULL,
-  snd_private_key BLOB NOT NULL,
-  encrypt_key BLOB NOT NULL,
-  sign_key BLOB NOT NULL,
-  status TEXT NOT NULL,
-  PRIMARY KEY (host, port, snd_id),
-  FOREIGN KEY (host, port) REFERENCES servers (host, port),
-  FOREIGN KEY (conn_alias)
-    REFERENCES connections (conn_alias)
-    ON DELETE CASCADE
-    DEFERRABLE INITIALLY DEFERRED
-) WITHOUT ROWID;
-
-CREATE TABLE IF NOT EXISTS connections(
-  conn_alias BLOB NOT NULL,
-  rcv_host TEXT,
-  rcv_port TEXT,
-  rcv_id BLOB,
-  snd_host TEXT,
-  snd_port TEXT,
-  snd_id BLOB,
-  last_internal_msg_id INTEGER NOT NULL, -- TODO add defauls here and below in the new schema
-  last_internal_rcv_msg_id INTEGER NOT NULL,
-  last_internal_snd_msg_id INTEGER NOT NULL,
-  last_external_snd_msg_id INTEGER NOT NULL,
-  last_rcv_msg_hash BLOB NOT NULL,
-  last_snd_msg_hash BLOB NOT NULL,
-  PRIMARY KEY (conn_alias),
-  FOREIGN KEY (rcv_host, rcv_port, rcv_id) REFERENCES rcv_queues (host, port, rcv_id),
-  FOREIGN KEY (snd_host, snd_port, snd_id) REFERENCES snd_queues (host, port, snd_id)
-) WITHOUT ROWID;
-
-CREATE TABLE IF NOT EXISTS messages(
-  conn_alias BLOB NOT NULL,
-  internal_id INTEGER NOT NULL,
-  internal_ts TEXT NOT NULL,
-  internal_rcv_id INTEGER,
-  internal_snd_id INTEGER,
-  body TEXT NOT NULL,  -- deprecated
-  PRIMARY KEY (conn_alias, internal_id),
-  FOREIGN KEY (conn_alias)
-    REFERENCES connections (conn_alias)
-    ON DELETE CASCADE,
-  FOREIGN KEY (conn_alias, internal_rcv_id)
-    REFERENCES rcv_messages (conn_alias, internal_rcv_id)
-    ON DELETE CASCADE
-    DEFERRABLE INITIALLY DEFERRED,
-  FOREIGN KEY (conn_alias, internal_snd_id)
-    REFERENCES snd_messages (conn_alias, internal_snd_id)
-    ON DELETE CASCADE
-    DEFERRABLE INITIALLY DEFERRED
-) WITHOUT ROWID;
-
-CREATE TABLE IF NOT EXISTS rcv_messages(
-  conn_alias BLOB NOT NULL,
-  internal_rcv_id INTEGER NOT NULL,
-  internal_id INTEGER NOT NULL,
-  external_snd_id INTEGER NOT NULL,
-  external_snd_ts TEXT NOT NULL,
-  broker_id BLOB NOT NULL,
-  broker_ts TEXT NOT NULL,
-  rcv_status TEXT NOT NULL,
-  ack_brocker_ts TEXT,
-  ack_sender_ts TEXT,
-  internal_hash BLOB NOT NULL,
-  external_prev_snd_hash BLOB NOT NULL,
-  integrity BLOB NOT NULL,
-  PRIMARY KEY (conn_alias, internal_rcv_id),
-  FOREIGN KEY (conn_alias, internal_id)
-    REFERENCES messages (conn_alias, internal_id)
-    ON DELETE CASCADE
-) WITHOUT ROWID;
-
-CREATE TABLE IF NOT EXISTS snd_messages(
-  conn_alias BLOB NOT NULL,
-  internal_snd_id INTEGER NOT NULL,
-  internal_id INTEGER NOT NULL,
-  snd_status TEXT NOT NULL,
-  sent_ts TEXT,
-  delivered_ts TEXT,
-  internal_hash BLOB NOT NULL,
-  PRIMARY KEY (conn_alias, internal_snd_id),
-  FOREIGN KEY (conn_alias, internal_id)
-    REFERENCES messages (conn_alias, internal_id)
-    ON DELETE CASCADE
-) WITHOUT ROWID;

migrations/20210624_confirmations.sql

@@ -1,9 +0,0 @@
-CREATE TABLE conn_confirmations (
-  confirmation_id BLOB NOT NULL PRIMARY KEY,
-  conn_alias BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
-  sender_key BLOB NOT NULL,
-  sender_conn_info BLOB NOT NULL,
-  accepted INTEGER NOT NULL,
-  own_conn_info BLOB,
-  created_at TEXT NOT NULL DEFAULT (datetime('now'))
-) WITHOUT ROWID;

migrations/20210809_snd_messages.sql

@@ -1,3 +0,0 @@
-ALTER TABLE messages ADD msg_body BLOB NOT NULL DEFAULT x'';  -- this field replaces body TEXT
--- TODO possibly migrate the data from body if it is possible in migration
-ALTER TABLE snd_messages ADD previous_msg_hash BLOB NOT NULL DEFAULT x'';

migrations/20211202_connection_mode.sql

@@ -1,11 +0,0 @@
-ALTER TABLE connections ADD conn_mode TEXT NOT NULL DEFAULT 'INV';
-
-CREATE TABLE conn_invitations (
-  invitation_id BLOB NOT NULL PRIMARY KEY,
-  contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
-  cr_invitation BLOB NOT NULL,
-  recipient_conn_info BLOB NOT NULL,
-  accepted INTEGER NOT NULL DEFAULT 0,
-  own_conn_info BLOB,
-  created_at TEXT NOT NULL DEFAULT (datetime('now'))
-) WITHOUT ROWID;

migrations/README.md

@@ -1,9 +0,0 @@
-# SQLite database migrations
-
-These migrations are [embedded](../src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs) into the executable and run when SMP agent starts (as a separate executable or as a part of [simplex-chat](https://github.com/simplex-chat/simplex-chat) app).
-
-Migration file names must have a format `YYYYMMDD-name.sql` - they will be executed in the order or lexicographic sorting of the names, the files with any other extension than `.sql` are ignored.
-
-The proposed approach is to minimize the number of migrations and merge them together when possible, to align with the agent releases.
-
-**Please note**: Adding or editing migrations will NOT update the migrations embedded into the executable, unless the [Migrations](../src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs) module is rebuilt - use `stack build --force-dirty` (in addition to edited files it seems to rebuild the files with TH splices and their dependencies, not all files as with `stack clean`).

package.yaml

@@ -1,5 +1,5 @@
 name: simplexmq
-version: 0.5.1
+version: 1.0.2
 synopsis: SimpleXMQ message broker
 description:  |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -15,19 +15,19 @@ homepage: https://github.com/simplex-chat/simplexmq#readme
 license: AGPL-3
 author: simplex.chat
 maintainer: chat@simplex.chat
-copyright: 2020 simplex.chat
+copyright: 2020-2022 simplex.chat
 category: Chat, Network, Web, System, Cryptography
 extra-source-files:
   - README.md
   - CHANGELOG.md
-  - migrations/*.*
 
 dependencies:
+  - aeson == 2.0.*
   - ansi-terminal >= 0.10 && < 0.12
   - asn1-encoding == 0.9.*
   - asn1-types == 0.3.*
   - async == 2.2.*
-  - attoparsec == 0.13.*
+  - attoparsec == 0.14.*
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
   - bytestring == 0.10.*
@@ -35,9 +35,10 @@ dependencies:
   - constraints >= 0.12 && < 0.14
   - containers == 0.6.*
   - cryptonite >= 0.27 && < 0.30
+  - cryptostore == 0.2.*
+  - data-default == 0.7.*
   - direct-sqlite == 2.3.*
   - directory == 1.3.*
-  - file-embed == 0.0.14.*
   - filepath == 1.4.*
   - http-types == 0.12.*
   - generic-random >= 1.3 && < 1.5
@@ -46,6 +47,7 @@ dependencies:
   - mtl == 2.2.*
   - network == 3.1.*
   - network-transport == 0.5.*
+  - postgresql-simple == 0.6.*
   - QuickCheck == 2.14.*
   - random >= 1.1 && < 1.3
   - simple-logger == 0.1.*
@@ -54,11 +56,14 @@ dependencies:
   - template-haskell == 2.16.*
   - text == 1.2.*
   - time == 1.9.*
+  - tls >= 1.5.7 && < 1.6
   - transformers == 0.5.*
   - unliftio == 0.2.*
   - unliftio-core == 0.2.*
   - websockets == 0.12.*
   - x509 == 1.7.*
+  - x509-store == 1.6.*
+  - x509-validation == 1.6.*
 
 library:
   source-dirs: src
@@ -68,9 +73,9 @@ executables:
     source-dirs: apps/smp-server
     main: Main.hs
     dependencies:
-      - cryptostore == 0.2.*
       - ini == 0.4.*
       - optparse-applicative >= 0.15 && < 0.17
+      - process == 1.6.*
       - simplexmq
     ghc-options:
       - -threaded

protocol/agent-protocol.md

@@ -123,7 +123,7 @@ Each SMP message client body, once decrypted, contains 3 parts (one of them may
   - to send and to acknowledge user messages (`clientMsg`, `acknowledgeMsg`)
   - to manage SMP queue rotation (`newQueueMessage`, `deleteQueueMsg`)
   - to manage encryption key rotation (TODO)
-- `msgPadding` - an optional message padding to make all SMP messages have constant size, to prevent servers from observing the actual message size.
+- `msgPadding` - an optional message padding to make all SMP messages have constant size, to prevent servers from observing the actual message size. The only case the message padding can be absent is when the message has exactly the maximum size, in all other cases the message MUST be padded to a fixed size.
 
 ### Messages between SMP agents
 
@@ -131,56 +131,34 @@ Message syntax below uses [ABNF][3] with [case-sensitive strings extension][4].
 
 ```abnf
 decryptedSmpMessageBody = agentMsgHeader CRLF agentMessage CRLF msgPadding
-agentMsgHeader = agentMsgId SP agentTimestamp SP previousMsgHash ; here `agentMsgId` is sequential ID set by the sending agent
+agentMsgHeader = agentMsgId SP previousMsgHash ; here `agentMsgId` is sequential ID set by the sending agent
 agentMsgId = 1*DIGIT
-agentTimestamp = <date-time> ; RFC3339
 previousMsgHash = encoded
 encoded = <base64 encoded>
 
 agentMessage = helloMsg / replyQueueMsg /
-               clientMsg / invitationMsg/ acknowledgeMsg /
+               clientMsg / invitationMsg /
                newQueueMessage / deleteQueueMsg 
 
 msgPadding = *OCTET ; optional random bytes to get messages to the same size (as defined in SMP message size)
 
-helloMsg = %s"HELLO" SP signatureVerificationKey [SP %s"NO_ACK"]
-; NO_ACK means that acknowledgements to client messages will NOT be sent in this connection by the agent that sent `HELLO` message.
-signatureVerificationKey = encoded
+helloMsg = %s"H"
 
-replyQueueMsg = %s"REPLY" SP connectionRequest ; `connectionRequest` is defined below
+replyQueueMsg = %s"R" connectionRequest ; `connectionRequest` is defined below
 ; this message can only be sent by the second connection party
 
-clientMsg = %s"MSG" SP size CRLF clientMsgBody CRLF ; CRLF is in addition to CRLF in decryptedSmpMessageBody
-size = 1*DIGIT
+clientMsg = %s"M" clientMsgBody
 clientMsgBody = *OCTET
 
+; TODO remove and move to "public" header
 invitationMsg = %s"INV" SP connReqInvitation SP connInfo
 ; `connReqInvitation` and `connInfo` are defined below
 
-acknowledgeMsg = %s"ACK" SP agentMsgId SP msgHash SP ackStatus
-; NOT SUPPORTED in the current implementation
-
-msgHash = encoded
-; base64 encoded hash of the received message
-
-ackStatus = %s"OK" / ackError
-
-ackError = %s"ERR" SP ackErrorType
-
-ackErrorType = ackUnknownMsg / ackProhibitedMsg / ackSyntaxErr
-
-ackUnknownMsg = %s"UNKNOWN"
-
-ackProhibitedMsg = %s"PROHIBITED" ; unexpected message e.g. "HELLO" or "REPLY"
-
-ackSyntaxErr = %s"SYNTAX" SP syntaxErrCode
-syntaxErrCode = 1*DIGIT ; TODO
-
-newQueueMsg = %s"NEW" SP queueURI
+newQueueMsg = %s"N" queueURI
 ; this message can be sent by any party to add SMP queue to the connection.
 ; NOT SUPPORTED in the current implementation
 
-deleteQueueMsg = %s"DEL" SP queueURI
+deleteQueueMsg = %s"D" queueURI
 ; notification that the queue with passed URI will be deleted
 ; no need to notify the other party about suspending queue separately, as suspended and deleted queues are indistinguishable to the sender
 ; NOT SUPPORTED in the current implementation
@@ -214,7 +192,7 @@ This message is sent to add an additional SMP queue to the connection. Unlike RE
 
 #### DEL message 
 
-This message is sent to notify that the queue with passed URI will be deleted - having received this message, the receiving agent should no longer send messages to this queue. In case it was the only queue in the connection to which the agent could send the messages, it MAY also delete the reply queue(s) in the connection.
+This message is sent to notify that the queue with passed URI will be deleted - having received this message, the receiving agent should no longer send messages to this queue. In case it was the last remaining send queue in the duplex connection, the agent MAY also delete the reply queue(s) in the connection.
 
 ## SMP agent commands
 
@@ -225,13 +203,11 @@ Commands syntax below is provided using [ABNF][3] with [case-sensitive strings e
 Each transmission between the user and SMP agent must have this format/syntax:
 
 ```abnf
-agentTransmission = [corrId] CRLF [cAlias] CRLF agentCommand
+agentTransmission = [corrId] CRLF [connId] CRLF agentCommand
 
 corrId = 1*(%x21-7F) ; any characters other than control/whitespace
 
-cAlias = cId / cName
-cId = encoded
-cName = 1*(ALPHA / DIGIT / "_" / "-")
+connId = encoded
 
 agentCommand = (userCmd / agentMsg) CRLF
 userCmd = newCmd / joinCmd / letCmd / acceptCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd
@@ -304,7 +280,7 @@ messageError = %s"MERR" SP agentMsgId SP <errorType>
 message = %s"MSG" SP msgIntegrity SP recipientMeta SP brokerMeta SP senderMeta SP binaryMsg
 recipientMeta = %s"R=" agentMsgId "," agentTimestamp ; receiving agent message metadata 
 brokerMeta = %s"B=" brokerMsgId "," brokerTimestamp ; broker (server) message metadata
-senderMeta = %s"S=" agentMsgId "," agentTimestamp ; sending agent message metadata 
+senderMeta = %s"S=" agentMsgId ; sending agent message ID 
 brokerMsgId = encoded
 brokerTimestamp = <date-time>
 msgIntegrity = ok / msgIntegrityError

protocol/overview-tjr.md

@@ -0,0 +1,313 @@
+Revision 1, 2022-01-01
+
+Evgeny Poberezkin
+
+# SimpleX: messaging and application platform
+
+## Table of contents
+
+- [Introduction](#introduction)
+  - [What is SimpleX](#what-is-simplex)
+  - [SimpleX objectives](#simplex-objectives)
+  - [In Comparison](#in-comparison)
+- [Technical Details](#technical-details)
+  - [Trust in Servers](#trust-in-servers)
+  - [Client -> Server Communication](#client---server-communication)
+  - [SimpleX Messaging Protocol](#simplex-messaging-protocol)
+  - [SimpleX Agents](#simplex-agents)
+  - [Encryption Primitives Used](#encryption-primitives-used)
+- [Threat model](#threat-model)
+- [Acknowledgements](#acknowledgements)
+
+## Introduction
+
+#### What is SimpleX
+
+SimpleX as a whole is a platform upon which applications can be built. [SimpleX Chat](https://github.com/simplex-chat/simplex-chat) is one such application that also serves as an example and reference application.
+
+ - [SimpleX Messaging Protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md) (SMP) is a protocol to send messages in one direction to a recipient, relying on a server in-between. The messages are delivered via uni-directional queues created by recipients.
+
+ - SMP runs over a transport protocol (shown below as TLS) that provides integrity, server authentication, confidentiality, and transport channel binding.
+
+ - A SimpleX Server is one of those servers.
+
+ - The SimpleX Network is the term used for the collective of SimpleX Servers that facilitate SMP.
+
+ - SimpleX Client libraries speak SMP to SimpleX Servers and provide a low-level API not generally intended to be used by applications.
+
+ - SimpleX Agents interface with SimpleX Clients to provide a more high-level API intended to be used by applications. Typically they are embedded as libraries, but are designed so they can also be abstracted into local services.
+
+
+*Diagram showing the SimpleX Chat app, with logical layers of the chat application interfacing with a SimpleX Agent library, which in turn interfaces with a SimpleX Client library. The Client library in turn speaks the Messaging Protocol to a SimpleX Server.*
+
+```
+  User's Computer                 Internet                    Third-Party Server
+------------------     |   ----------------------     |   -------------------------
+                       |                              |
+   SimpleX Chat        |                              |
+                       |                              |
++----------------+     |                              |
+|    Chat App    |     |                              |
++----------------+     |                              |
+|  SimpleX Agent |     |                              |
++----------------+    -------------- TLS ----------------    +----------------+
+| SimpleX Client | ------ SimpleX Messaging Protocol ------> | SimpleX Server |
++----------------+    -----------------------------------    +----------------+
+                       |                              |
+```
+
+#### SimpleX objectives
+
+1. Provide messaging infrastructure for distributed applications. This infrastructure needs to have the following qualities:
+
+   - Security against passive and active (man-in-the-middle) attacks: the parties should have reliable end-to-end encryption and be able to detect the presence of an active attacker who modified, deleted or added messages.
+
+   - Privacy: protect against traffic correlation attacks to determine the contacts that the users communicate with.
+
+   - Reliability: the messages should be delivered even if some participating network servers or receiving clients fail, with “at least once” delivery guarantee.
+
+   - Integrity: the messages sent in one direction are ordered in a way that sender and recipient agree on; the recipient can detect when a message was removed or changed.
+
+   - Asynchronous delivery: it should not be required that both communicating parties (client devices, services or applications) are online for reliable message delivery.
+
+   - Low latency: the delay introduced by the network should not be higher than 100ms-1s in addition to the underlying TCP network latency.
+
+2. Provide better communication security and privacy than the alternative instant messaging solutions.  In particular SimpleX provides better privacy of metadata (who talks to whom and when) and better security against active network attackers and malicious servers.
+
+3. Balance user experience with privacy requirements, prioritizing experience of mobile device users.
+
+#### In Comparison
+
+SimpleX network has a design similar to P2P networks, but unlike most P2P networks it consists of clients and servers without depending on any centralized component.
+In comparison to more traditional messaging applications (e.g. WhatsApp, Signal, Telegram) the key differences of SimpleX network are:
+
+- participants do not need to have globally unique addresses to communicate, instead they use redundant unidirectional (simplex) messaging queues, with a separate set of queues for each contact.
+
+- connection requests are passed out-of-band, non-optionally protecting key exchange against man-in-the-middle attack.
+
+- simple message queues provided by network servers are used by the clients to create more complex communication scenarios, such as duplex one-to-one communication, transmitting files, group communication without central servers, and content/communication channels.
+
+- servers do not store any user information (no user profiles or contacts, or messages once they are delivered), and primarily use in-memory persistence.
+
+- users can change servers with minimal disruption - even after an in-use server disappears, simply by changing the configuration on which servers the new queues are created.
+
+## Technical Details
+
+#### Trust in Servers
+
+Clients communicate directly with servers (but not with other clients) using SimpleX Messaging Protocol (SMP) running over some transport protocol that provides integrity, server authentication, confidentiality, and transport channel binding. By default, we assume this transport protocol is TLS.
+
+Users use multiple servers, and choose where to receive their messages. Accordingly, they send messages to their communication partners' chosen servers.
+
+Although end-to-end encryption is always present, users place a degree of trust in servers. This trust decision is very similar to a user's choice of email provider; however the trust placed in a SimpleX server is significantly less. Notably, there is no re-used identifier or credential between queues on the same (or different) servers. While a user *may* re-use a connection to fetch from multiple queues, or connect to a server from the same IP address, both are choices a user may opt into to break the promise of un-correlatable queues.
+
+Users may trust a server because:
+
+- They deploy and control the servers themselves from the available open-source code. This has the trade-offs of strong trust in the server but limited metadata obfuscation to a passive network observer. Techniques such as noise traffic, traffic mixing (incurring latency), and using an onion routing transport protocol can mitigate that latter.
+
+- They use servers from a trusted commercial provider. The more clients the provider has, the less metadata about the communication times is leaked to the network observers.
+
+- Users trust their contacts and the servers they chose.
+
+By default, servers do not retain access logs, and permanently delete messages and queues when requested.  Messages persist only in memory until they cross a threshold of time, typically on the order of days.[0] There is still a risk that a server maliciously records all queues and messages (even though encrypted) sent via the same transport connection to gain a partial knowledge of the user’s communications graph and other meta-data.
+
+SimpleX supports measures (managed transparently to the user at the agent level) to mitigate the trust placed in servers.  These include rotating the queues in use between users, noise traffic, and supporting overlay networks such as Tor.
+
+[0] While configurable by servers, a minimum value is enforced by the default software. SimpleX Agents provide redundant routing over queues to mitigate against message loss.
+
+
+#### Client -> Server Communication
+
+Utilizing TLS grants the SimpleX Messaging Protocol (SMP) server authentication and metadata protection to a passive network observer. But SMP does not rely on the transport protocol for message confidentiality or client authentication. The SMP protocol itself provides end-to-end confidentiality, authentication, and integrity of messages between communicating parties.
+
+Servers have long-lived, self-signed, offline certificates whose hash is pre-shared with clients over secure channels - either provided with the client library or provided in the secure introduction between clients.  The offline certificate signs an online certificate used in the transport protocol handshake. [0]
+
+If the transport protocol's confidentiality is broken, incoming and outgoing messages to the server cannot be correlated by message contents. Additionally, because of encryption at the SMP layer, impersonating the server is not sufficient to pass (and therefore correlate) a message from a sender to recipient - the only attack possible is to drop the messages. Only by additionally *compromising* the server can one pass and correlate messages.
+
+It's important to note that the SMP protocol does not do server authentication. Instead we rely upon the fact that an attacker who tricks the transport protocol into authenticating the server incorrectly cannot do anything with the SMP messages except drop them.
+
+After the connection is established, the client sends blocks of a fixed size 16Kb, and the server replies with the blocks of the same size to reduce metadata observable to a network adversary. The protocol has been designed to make traffic correlation attacks difficult, adapting ideas from Tor, remailers, and more general onion and mix networks. It does not try to replace Tor though - SimpleX servers can be deployed as onion services and SimpleX clients can communicate with servers over Tor to further improve participants privacy.
+
+By using fixed-size blocks, oversized for the expected content, the vast majority of traffic is uniform in nature. When enough traffic is transiting a server simultaneously, the server acts as a (very) low-latency mix node.  We can't rely on this behavior to make a security claim, but we have engineered to take advantage of it when we can. As mentioned, this holds true even if the transport connection is compromised.
+
+The protocol does not protect against attacks targeted at particular users with known identities - e.g., if the attacker wants to prove that two known users are communicating, they can achieve it. At the same time, it substantially complicates large-scale traffic correlation, making determining the real user identities much less effective.
+
+[0] Future versions of SMP may add support for revocation lists of certificates, presently this risk is mitigated by the SMP protocol itself.
+
+
+#### SimpleX Messaging Protocol
+
+SMP is initialized with an in-person or out-of-band introduction message, where Alice provides Bob with details of a server (including IP, port, and hash of the long-lived offline certificate), a queue ID, and Alice's public key for her receiving queue. These introductions are similar to the PANDA key-exchange, in that if observed, the adversary can race to establish the communication channel instead of the intended participant. [0]
+
+Because queues are uni-directional, Bob provides an identically-formatted introduction message to Alice over Alice's now-established receiving queue.
+
+When setting up a queue, the server will create separate sender and recipient queue IDs (provided to Alice during set-up and Bob during initial connection). Additionally, during set-up Alice will perform a DH exchange with the server to agree upon a shared secret. This secret will be used to re-encrypt Bob's incoming message before Alice receives it, creating the anti-correlation property earlier-described should the transport encryption be compromised.
+
+[0] Users can additionally create public 'contact queues' that are only used to receive connection requests.  
+
+#### SimpleX Agents
+
+SimpleX agents provide higher-level operations compared to SimpleX Clients, who are primarily concerned with creating queues and communicating with servers using SMP.  Agent operations include:
+
+- Managing sets of bi-directional, redundant queues for communication partners
+
+- Providing end-to-end encryption of messages
+
+- Rotating queues periodically with communication partners
+
+- Noise traffic
+
+#### Encryption Primitives Used
+
+- Ed448 to sign/verify commands to SMP servers (Ed25519 is also supported via client/server configuration).
+- Curve25519 for DH exchange to agree:
+  - the shared secret between server and recipient (to encrypt message bodies - it avoids shared cipher-text in sender and recipient traffic)
+  - the shared secret between sender and recipient (to encrypt messages end-to-end in each queue - it avoids shared cipher-text in redundant queues).
+- [NaCl crypto_box](https://nacl.cr.yp.to/box.html) encryption scheme (curve25519xsalsa20poly1305) for message body encryption between server and recipient and for E2E per-queue encryption.
+- SHA256 to validate server offline certificates.
+- [double ratchet](https://signal.org/docs/specifications/doubleratchet/) protocol for end-to-end message encryption between the agents:
+  - Curve448 keys to agree shared secrets required for double ratchet initialization (using [X3DH](https://signal.org/docs/specifications/x3dh/) key agreement with 2 ephemeral keys for each side),
+  - AES-GCM AEAD cipher,
+  - SHA512-based HKDF for key derivation.
+
+## Threat Model
+
+#### Global Assumptions
+
+ - A user protects their local database and key material
+ - The user's application is authentic, and no local malware is running
+ - The cryptographic primitives in use are not broken
+ - A user's choice of servers is not directly tied to their identity or otherwise represents distinguishing information about the user.
+
+#### A passive adversary able to monitor the traffic of one user
+
+*can:*
+
+ - identify that and when a user is using SimpleX
+
+ - block SimpleX traffic
+
+ - determine which servers the user communicates with
+
+ - observe how much traffic is being sent, and make guesses as to its purpose.
+
+*cannot:*
+
+ - see who sends messages to the user and who the user sends the messages to
+
+#### A passive adversary able to monitor a set of senders and recipients
+
+ *can:*
+
+ - identify who and when is using SimpleX
+
+ - learn which SimpleX Messaging Protocol servers are used as receive queues for which users
+
+ - learn when messages are sent and received
+
+ - perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers
+
+ - observe how much traffic is being sent, and make guesses as to its purpose
+
+*cannot, even in case of a compromised transport protocol:*
+
+ - perform traffic correlation attacks with any increase in efficiency over a non-compromised transport protocol
+
+#### SimpleX Messaging Protocol server
+
+*can:*
+
+- learn when a queue recipient or sender is online
+
+- know how many messages are sent via the queue (although some may be noise)
+
+- perform queue correlation (matching multiple queues to a single user) via either a re-used transport connection, user's IP Address, or connection timing regularities
+
+- learn a user's IP address, track them through other IP addresses they use to access the same queue, and infer information (e.g. employer) based on the IP addresses, as long as Tor is not used.
+
+- drop all future messages inserted into a queue, detectable only over other, redundant queues
+
+- lie about the state of a queue to the recipient and/or to the sender  (e.g. suspended or deleted when it is not).
+
+- spam a user with invalid messages
+
+*cannot:*
+
+- undetectably add, duplicate, or corrupt individual messages
+
+- undetectably drop individual messages, so long as a subsequent message is delivered
+
+- learn the contents of messages
+
+- distinguish noise messages from regular messages except via timing regularities
+
+- compromise the user's end-to-end encryption with an active attack
+
+#### An attacker who obtained Alice's (decrypted) chat database
+
+*can:*
+
+- see the history of all messages exchanged by Alice with her communication partners
+
+- see shared profiles of contacts and groups
+
+- surreptitiously receive new messages sent to Alice via existing queues; until communication queues are rotated or the Double-Ratchet advances forward
+
+- prevent Alice from receiving all new messages sent to her - either surreptitiously by emptying the queues regularly or overtly by deleting them
+
+- send messages from the user to their contacts; recipients will detect it as soon as the user sends the next message, because the previous message hash won’t match (and potentially won’t be able to decrypt them in case they don’t keep the previous ratchet keys).
+
+*cannot:*
+
+- impersonate a sender and send messages to the user whose database was stolen. Doing so requires also compromising the server (to place the message in the queue, that is possible until the Double-Ratchet advances forward) or the user's device at a subsequent time (to place the message in the database).
+
+- undetectably communicate at the same time as Alice with her contacts. Doing so would result in the contact getting different messages with repeated IDs.
+
+- undetectably monitor message queues in realtime without alerting the user they are doing so, as a second subscription request unsubscribes the first and notifies the second.
+
+#### A user’s contact
+
+*can:*
+
+- spam the user with messages
+
+- forever retain messages from the user
+
+*cannot:*
+
+- cryptographically prove to a third-party that a message came from a user (assuming the user’s device is not seized)
+
+- prove that two contacts they have is the same user
+
+- cannot collaborate with another of the user's contacts to confirm they are communicating with the same user
+
+#### An attacker who observes Alice showing an introduction message to Bob
+
+*can:*
+
+ - Impersonate Bob to Alice
+
+*cannot:*
+
+ - Impersonate Alice to Bob
+
+#### An attacker with Internet access
+
+*can:*
+
+- Denial of Service SimpleX messaging servers
+
+- spam a user's public “contact queue” with connection requests
+
+*cannot:*
+
+- send messages to a user who they are not connected with
+
+- enumerate queues on a SimpleX server
+
+
+## Acknowledgements
+
+Efim Poberezkin contributed to the design and implementation of [SimpleX Messaging Protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md) and [SimpleX Agent Protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md) since 2019.
+
+Adam Langley's [Pond](https://github.com/agl/pond) inspired some of the recent improvements and the structure of this document.

protocol/overview.md

@@ -1,259 +0,0 @@
-# SimpleX: messaging and application network
-
-## Table of contents
-
-- [SimpleX objectives](#simplex-objectives)
-- [SimpleX network](#simplex-network)
-- [Threat model](#threat-model)
-
-## SimpleX objectives
-
-1. Provide messaging infrastructure for distributed applications. This infrastructure needs to have the following qualities:
-
-   - Security against passive and active (man-in-the-middle) attacks: the parties should have reliable end-to-end encryption and be able to identify and to some extent compensate for the presence of the active attacker who may modify, delete or add messages.
-  
-   - Privacy: network server operators should have no ability to read or modify messages without detection, and it should be impossible or hard to infer the contacts the users communicate with. Non-malicious network operators should retain no record of participants communications.
-  
-   - Reliability: the messages should be delivered even if some participating network servers or receiving clients fail, with “at least once” delivery guarantee.
-  
-   - Integrity: the messages should be delivered without alteration, in the same order, and any unauthorized message change should be detected by the recipient.
-  
-   - Asynchronous delivery: it should not be required that both communicating parties (client devices, services or applications) are online for reliable message delivery.
-  
-   - Low latency: the delay introduced by the network should not be higher than 100ms-1s in addition to the underlying TCP network latency.
-  
-2. Provide better communication privacy, in particular meta-data privacy (who talks to whom and when), and security, in particular security against active attacks, than the alternative instant messaging solutions.
-
-3. Balance user experience with privacy requirements, prioritizing experience of mobile device users.
-
-## SimpleX network
-
-### Overview
-
-SimpleX network provides asynchronous messaging infrastructure that aims to deliver on the above objectives and to avoid the disadvantages of the alternative solutions.
-
-The key differences of SimpleX network are:
-
-- participants do not need to have globally unique addresses to communicate, instead they use redundant unidirectional (simplex) messaging queues, with a separate set of queues for each contact.
-
-- connection requests are passed out-of-band, non-optionally protecting key exchange against man-in-the-middle attack.
-
-- message queues provided by network servers are used by the clients to create more complex communication scenarios, such as duplex one-to-one communication, transmitting files, group communication without central servers and content/communication channels (requiring a separate type of server to host them, which is out of scope of this document).
-
-- servers do not store any user information (no user profiles, contacts or messages, once they are delivered), and can use in-memory persistence only.
-
-- users can change server provider(s) without losing their communication contacts, simply by changing the configuration on which servers the new queues are created.
-
-SimpleX network has design similar to P2P networks, but unlike most P2P networks it consists of clients and servers, without dependency on any centralized component. Servers provide anonymous unidirectional message queues in order to:
-
-- continuously accept messages for the recipients, even when they are offline.
-
-- provide recipient anonymity, as the messaging queues do not identify the users, and different addresses of the same queue are used for senders and recipients to provide additional protection against server traffic correlation, in case transport connections are compromised.
-
-Coincidentally, SimpleX network reminds [Pond messenger](https://github.com/agl/pond) design, the main differences are:
-
-- Clients can receive messages via multiple servers (in Pond users use one home server and it serves as a user permanent address),
-
-- Clients do not need to poll servers to receive messages, the messages from subscribed queues are delivered via an open transport connection as they are received by the servers, resulting in low latency of message delivery.
-
-### SimpleX servers
-
-Clients communicate with servers (but not with other clients) using SimpleX Messaging Protocol (SMP) running over some transport protocol that provides server authentication, confidentiality with forward secrecy, integrity and transport channel binding (to prevent SMP commands replay).
-
-Users can use multiple servers. They choose the servers they use to receive the messages through, and they communicate with the servers chosen by the recipients to send messages.
-
-It is assumed that users have some degree of trust to the servers, for one of the following reasons:
-
-- They deploy and control the servers themselves from the available open-source code. The advantage of self-deployed servers is that users have full control of server information and activity, but the downside is that it is easier to correlate incoming and outgoing messages by observing server traffic, assuming small number of messages sent via user-hosted servers and irregular communication time. It can be mitigated by:
-
-  - sending noise traffic.
-
-  - future protocol versions can add configurable per queue message delivery delays (compromising on one of the design objectives of low latency).
-
-  - using SMP servers via an onion routing or mix network.
-
-- They use servers from the trusted commercial providers. The more clients the provider has, the less meta-data about the communication times is leaked to the network observers, and even if transport confidentiality is compromised it is not possible to correlate sent and received traffic without compromising the server, because the clients use different queue IDs to send and receive messages, and the message delivered to the recipient is additionally encrypted by the server.
-
-- To some extent, users trust their contacts and the servers they chose that the users send messages to. The client applications could further improve user trust to the servers chosen by their contacts by supporting either the list of servers that are “allowed to send to” or “prohibited to send to” (e.g., known trusted or compromised servers, certain IP ranges, server geographical locations etc.).
-
-If users use the free servers deployed by the volunteers, there is a risk that the server code can maliciously record all queues and messages (even though encrypted) sent via the same transport connection and to gain a partial knowledge of the user’s communications graph and other meta-data. User clients can mitigate it by using some overlay network that protects the privacy of TCP connections, e.g., Tor, and by sending noise traffic between the end users.
-
-The servers authorize users to access (send/receive/etc.) their message queues via a digital signature of transmissions using a unique key pair different for each queue sender and recipient, so no information that is required for the server to authorize users allows to aggregate user communications across multiple queues.
-
-### Transport
-
-SimpleX network does not rely on transport or overlay network for server or client authentication. SMP protocol itself must provide integrity, forward secure confidentiality of communicating parties and mutual authentication even if transport protocol (but not the server) is compromised by the active attacker.
-
-To protect against MITM attack on the transport, the clients should verify server self-signed certificate during TLS handshake by validating its pre-shared hash of the certificate in the server address (either as part of client configuration or passed in SMP connection request).
-
-Clients use TLS1.3 protocol to connect to the server, restricting supported cryptographic protocols as defined in SimpleX Messaging Protocol.
-
-After TCP transport connection is established, and the server is authenticated, the client sends blocks of a fixed size 16Kb, and the server replies with the blocks of the same size. When the actual message is smaller, it should be padded before encryption, and if it is larger, it can be split to chunks by the client application. The first blocks from the client and the server should include protocol version so that the party with the higher version can confirm compatibility and the transport channel identifier as described in SMP protocol.
-
-Client can terminate the server transport connection without losing any messages – removal of the message from the server and the delivery of the next message happens when the client acknowledges the message reception (normally, after it is persisted in the client’s database).
-
-Depending on the privacy requirements of the clients, the client can use a separate transport connection per queue, or receive messages from multiple queues via a single transport connection, for efficiency. In our implementations this configuration will be available to the end users.
-
-### Server implementation
-
-- does not store user access logs.
-
-- does not store messages after the client has received them.
-
-- permanently removes queues after they are deleted by the users
-
-- only stores messages in transit in server operating memory; as clients are expected to use multiple servers to deliver each message, the message loss in one of the servers is acceptable.
-
-### SimpleX clients and agents
-
-Clients are assumed to be running on the trusted devices and can use the locally encrypted storage for messages, contacts, groups and other resources.
-
-SimpleX clients implementing application-level protocols communicate with SimpleX servers via agents. SimpleX agents can be accessed in one of the following ways:
-
-- via TCP network using trusted network connection or an overlay transport network.
-
-- via local port (when the agent runs on the same device as a separate process).
-
-- via agent library, when the agent logic is included directly into the client application.
-
-The last option is the most secure, as it reduces the number of attack vectors in comparison with other options. The current implementation of SimpleX Chat uses this approach.
-
-SimpleX agents provide the following operations:
-
-- Creating and managing bi-directional (duplex) client connections and delivering messages via redundant groups of SimpleX queues.
-
-- Exchanging keys and providing end-to-end encryption. The current prototype uses RSA cryptography with ad-hoc hybrid encryption scheme, we are currently switching it to X3DH for key exchange and double ratchet protocol for E2E encryption.
-
-Communication between the client and the agent and the communication between the agents (via end-to-end encrypted messages delivered via SMP protocol) is described by SimpleX Agent Protocol.
-
-Bi-directional client connections consist of multiple “send” and multiple “receive” queues (for redundancy) that agents use to send and receive messages; each queue should be used for limited amount of time, the rotation of queues is negotiated using SimpleX Agent Protocol.
-
-There are two ways that SimpleX network users can establish the connection:
-
-- Users communicate the initial connection invitation out-of-band, via link or via QR code. This out-of-band communication is assumed secure against active attacks and insecure against passive attacks. Once the connection is established that users are assumed to have confirmed out-of-band, the connection can no longer be compromised even if out-of-band invitation was obtained by the attacker. This out-of-band invitation does not contain any personal information, only the address of the queue and public key for the key exchange for end-to-end encryption.
-
-- Users can create a “contact queue(s)” on SMP servers that would be used to receive connection requests. The important distinction with commonly used addressing systems is that this queue is only used to pass the connection request and not for subsequent messages. So, while it is possible to spam users who created such contact queues with connection requests, they can be removed without disrupting the communication with the existing contacts.
-
-The reply queue addresses and the key exchange for the reply queues is negotiated via the direct queue.
-
-### Message encryption
-
-Messages are encrypted end-to-end using double ratchet protocol. Once the sending client deletes messages it won’t be able to decrypt them again. While messages are numbered within the queue, this only reveals to the servers how messages have been exchanged in a given queue that has a limited lifetime, so the total number of messages exchanged between contacts is not revealed.
-
-The next queue to use is negotiated between agents in encrypted messages, and in most cases, it will be on another server (unless the client is configured to use one server, which is not recommended).
-
-### Client storage
-
-It is assumed that the client device and the storage is trusted, but clients can implement storage encryption using a user-provided passphrase.
-
-## Threat model
-
-### Assumptions
-
-User protects their information and keys.
-
-SimpleX Chat software is authentic.
-
-User device is not compromised, excluding the scenarios below where it is explicitly stated it is compromised.
-
-Used cryptographic primitives are not compromised.
-
-### SimpleX Messaging Protocol server
-
-**can:**
-
-- learn when a queue recipient or sender is online via transmission times.
-
-- correlate multiple queues to a single user in case they are accessed via the same transport connection or from the same IP address.
-
-- correlate multiple queues to a single user based on the time they are accessed. Clients that use message notification servers can mitigate it by only subscribing to the queues after they receive the notifications and disconnecting after some time of inactivity.
-
-- know how many messages is sent via the queue, clients can mitigate it with noise traffic.
-
-- add, drop, duplicate or corrupt messages, but it will be detected by the client on SimpleX Agent Protocol level. Using multiple servers to deliver each message mitigates the loss of messages.
-
-**cannot:**
-
-- decrypt messages
-
-- compromise e2e encryption with MITM attack (as server is only used to pass one of two keys in DH exchange, the first key is passed out-of-band)
-
-### A global passive adversary monitoring all Internet traffic
-
-**can:**
-
-- learn who is using SimpleX Chat.
-
-- learn when messages are sent and received.
-
-- learn which SimpleX Messaging Protocol servers are used.
-
-- in case of low traffic on the servers, correlate senders and recipients by the time messages sent and received.
-
-- observe the approximate size of the files transmitted – to O(log log M) of file size precision.
-
-**cannot, even in case of compromised transport protocol:**
-
-- correlate senders and recipients by the content of messages (as different queue IDs are used for senders and recipients, with additional encryption layer in the delivered messages).
-
-### A local network attacker
-
-**can:**
-
-- observe when a user is using SimpleX Chat.
-
-- block SimpleX Chat traffic.
-
-- determine which servers the user communicates with.
-
-- observe the approximate size of files transmissions and receptions.
-
-**cannot:**
-
-- see who sends messages to the user and who the user sends the messages to
-
-### An attacker who obtained user’s decrypted chat database
-
-**can:**
-
-- see the history of all messages
-
-- see shared profiles of contacts and groups
-
-- receive new user messages, but the user will detect it as the number and the hash of the previous message won’t match. Also, they will be instantly alerted that an unknown device is connected to their message queues, as long as they are online at the same time, as message queues only allow one active subscription.
-
-- delete user’s message queues, so the contacts won’t be able to send messages.
-
-- send messages from the user to their contacts, but the recipients will detect it as soon as the user sends the next message, because the previous message hash won’t match (and potentially won’t be able to decrypt them in case they don’t keep the previous ratchet keys).
-
-**cannot:**
-
-- impersonate a sender and send messages to the user whose database was stolen without also compromising the server (to place the message in the queue) or the user's device at a subsequent time (to place the message in the database).
-
-### A user’s contact
-
-**can:**
-
-- spam the user with messages.
-
-- forever retain messages from the user.
-
-**cannot:**
-
-- prove to a third-party that a message came from a user (assuming a user’s device is not seized)
-
-- prove that two contacts they have is the same user.
-
-- two contacts cannot confirm if they are communicating with the same user.
-
-### An attacker with Internet access
-
-**can:**
-
-- DoS SimpleX messaging servers.
-
-- spam the user who created a “contact queue” (queue for accepting connection requests) by sending multiple connection requests.
-
-**cannot:**
-
-- send messages to the user who they are not connected with.

protocol/simplex-messaging.md

@@ -14,6 +14,7 @@
 - [Simplex queue IDs](#simplex-queue-ids)
 - [Server security requirements](#server-security-requirements)
 - [Message delivery notifications](#message-delivery-notifications)
+- [SMP Transmission structure](#smp-transmission-structure)
 - [SMP commands](#smp-commands)
   - [Correlating responses with commands](#correlating-responses-with-commands)
   - [Command authentication](#command-authentication)
@@ -89,7 +90,7 @@ The simplex queue is the main unit of SMP protocol. It is used by:
 
 - Sender of the queue (who received out-of-band message) to send messages to the server using sender's queue ID, signed by sender's key.
 
-- Recipient of the queue (who created the queue and sent out-of-band message) will use it to retrieve messages from the server, signing the commands by the recipient key.
+- Recipient of the queue (who created the queue and sent out-of-band message) will use it to retrieve messages from the server, signing the commands by the recipient key. Recipient decrypts the messages with the key negotiated during the creation of the queue.
 
 - Participant identities are not shared with the server - new unique keys and queue IDs are used for each queue.
 
@@ -99,7 +100,7 @@ This approach is based on the concept of [unidirectional networks][4] that are u
 
 Access to each queue is controlled with unique (not shared with other queues) asymmetric key pairs, separate for the sender and the recipient. The sender and the receiver have private keys, and the server has associated public keys to authenticate participants' commands by verifying cryptographic signatures.
 
-The messages sent over the queue are encrypted and decrypted using another key pair that was shared via out-of-band message - the recipient has the private key and the sender has the associated public key.
+The messages sent over the queue are end-to-end encrypted using the DH secret agreed via out-of-band message and SMP confirmation.
 
 **Simplex queue diagram:**
 
@@ -116,14 +117,19 @@ The SMP queue URIs MUST include server identity, queue hostname, an optional por
 The [ABNF][8] syntax of the queue URI is:
 
 ```abnf
-queueURI = %s"smp://" smpServer "/" queueId "#" serverSignaturePublicKey
-; serverSignaturePublicKey syntax is defined below
-smpServer = serverIdentity "@" srvHost [":" port] 
+queueURI = %s"smp://" smpServer "/" queueId "#" recipientDhPublicKey
+smpServer = serverIdentity "@" srvHost [":" port]
 srvHost = <hostname> ; RFC1123, RFC5891
 port = 1*DIGIT
 serverIdentity = base64url
 queueId = base64url
 base64url = <base64url encoded binary> ; RFC4648, section 5
+recipientDhPublicKey = x509UrlEncoded
+; the recipient's Curve25519 key for DH exchange to derive the secret
+; that the sender will use to encrypt delivered messages
+; using [NaCl crypto_box][16] encryption scheme (curve25519xsalsa20poly1305).
+
+x509UrlEncoded = <base64url X509 key encoding>
 ```
 
 `hostname` can be IP address or domain name, as defined in RFC 1123, section 2.1.
@@ -146,17 +152,21 @@ To create and start using a simplex queue Alice and Bob follow these steps:
 
     3. Generates another new random public/private key pair (recipient key - `RK`) that she did not use before for her to sign commands and to decrypt the transmissions received from the server.
 
-    4. Sends `"NEW"` command to the server to create a simplex queue (see `create` in [Create queue command](#create-queue-command)). This command contains previously generated unique "public" key `RK` that will be used to verify the following commands related to the same queue signed by its private counterpart, for example to subscribe to the messages received to this queue or to update the queue, e.g. by setting the key required to send the messages (initially Alice creates the queue that accepts unsigned messages, so anybody could send the message via this queue if they knew the queue sender's ID and server address).
+    4. Generates one more random key pair (recipient DH key - `RDHK`) to negotiate symmetric key that will be used by the server to encrypt message bodies delivered to Alice (to avoid shared cipher-text inside transport connection).
 
-    5. The server sends `"IDS"` response with queue IDs (`queueIds`):
+    5. Sends `"NEW"` command to the server to create a simplex queue (see `create` in [Create queue command](#create-queue-command)). This command contains previously generated unique "public" keys `RK` and `RDHK`. `RK` will be used to verify the following commands related to the same queue signed by its private counterpart, for example to subscribe to the messages received to this queue or to update the queue, e.g. by setting the key required to send the messages (initially Alice creates the queue that accepts unsigned messages, so anybody could send the message via this queue if they knew the queue sender's ID and server address).
+
+    6. The server sends `"IDS"` response with queue IDs (`queueIds`):
 
         - Recipient ID `RID` for Alice to manage the queue and to receive the messages.
 
         - Sender ID `SID` for Bob to send messages to the queue.
 
+        - Server public DH key (`SDHK`) to negotiate a shared secret for message body encryption, that Alice uses to derive a shared secret with the server `SS`.
+
 2. Alice sends an out-of-band message to Bob via the alternative channel that both Alice and Bob trust (see [protocol abstract](#simplex-messaging-protocol-abstract)). The message must include:
 
-    - Unique "public" key (`EK`) that Bob must use to encrypt messages.
+    - Unique "public" key (`EK`) that Bob must use for E2E key agreement.
 
     - SMP server hostname and information to open secure encrypted transport connection (see [Appendix A](#appendix-a)).
 
@@ -178,9 +188,11 @@ To create and start using a simplex queue Alice and Bob follow these steps:
 
 4. Alice receives Bob's message from the server using recipient queue ID `RID` (possibly, via the same transport connection she already has opened - see `message` in [Deliver queue message](#deliver-queue-message)):
 
-    1. She decrypts received message with "private" key `EK`.
+    1. She decrypts received message body using the secret `SS`.
 
-    2. Even though anybody could have sent the message to the queue with ID `SID` before it is secured (e.g. if communication is compromised), Alice would ignore all messages until the decryption succeeds (i.e. the result contains the expected message format). Optionally, in the client application, she also may identify Bob using the information provided, but it is out of scope of SMP protocol.
+    2. She decrypts received message with [key agreed with sender using] "private" key `EK`.
+
+    3. Even though anybody could have sent the message to the queue with ID `SID` before it is secured (e.g. if communication is compromised), Alice would ignore all messages until the decryption succeeds (i.e. the result contains the expected message format). Optionally, in the client application, she also may identify Bob using the information provided, but it is out of scope of SMP protocol.
 
 5. Alice secures the queue `RID` with `"KEY"` command so only Bob can send messages to it (see [Secure queue command](#secure-queue-command)):
 
@@ -206,7 +218,7 @@ Bob now can securely send messages to Alice:
 
     2. He signs `"SEND"` command to the server queue `SID` using the "private" key `SK` (that only he knows, used only for this queue).
 
-    3. He sends the command to the server (see `send` in [Send message](#send-message)), that the server will authenticate using the "public" key `SK` (that Alice earlier provided to the server).
+    3. He sends the command to the server (see `send` in [Send message](#send-message)), that the server will authenticate using the "public" key `SK` (that Alice earlier received from Bob and provided to the server via `"KEY"` command).
 
 2. Alice receives the message(s):
 
@@ -346,23 +358,35 @@ The clients can optionally instruct a dedicated push notification server to subs
 - `subscribeNotifications` (`"NSUB"`) - see [Subscribe to queue notifications](#subscribe-to-queue-notifications).
 - `messageNotification` (`"NMSG"`) - see [Deliver message notification](#deliver-message-notification).
 
-## SMP commands
+## SMP Transmission structure
 
-Commands syntax below is provided using [ABNF][8] with [case-sensitive strings extension][8a].
+Each transport block (SMP transmission) has a fixed size of 16384 bytes for traffic uniformity.
 
-Each transmission between the client and the server must have this format/syntax (after the decryption):
+Some parts of SMP transmission are padded to a fixed size; this padding is uniformly added as a word16 encoded in network byte order - see `paddedString` syntax.
 
-```abnf
-transmission = [signature] SP signed SP pad ; pad to the fixed block size
-signed = sessionIdentifier SP [corrId] SP [queueId] SP cmd ; corrId is required in client commands and server responses,
-                                                           ; corrId is empty in server notifications.
-cmd = ping / recipientCmd / send / subscribeNotifications / serverMsg
-recipientCmd = create / subscribe / secure / enableNotifications /
-               acknowledge / suspend / delete
-serverMsg = queueIds / message / notifierId / messageNotification /
-            unsubscribed / ok / error
-corrId = 1*(%x21-7F) ; any characters other than control/whitespace
-queueId = encoded ; empty queue ID is used with "create" command
+In places where some part of the transmission should be padded, the syntax for `paddedNotation` is used:
+
+```
+paddedString = originalLength string pad
+originalLength = 2*2 OCTET
+pad = N*N"#" ; where N = paddedLength - originalLength - 2
+
+paddedNotation = <padded(string, paddedLength)>
+; string - un-padded string
+; paddedLength - required length after padding, including 2 bytes for originalLength
+```
+
+Each transmission between the client and the server must have this format/syntax:
+
+```
+paddedTransmission = <padded(transmission), 16384>
+transmission = [signature] SP signed
+signed = sessionIdentifier SP [corrId] SP [queueId] SP smpCommand
+; corrId is required in client commands and server responses,
+; it is empty in server notifications.
+corrId = 1*32(%x21-7F) ; any characters other than control/whitespace
+queueId = encoded ; max 32 bytes when decoded (24 bytes is used),
+; empty queue ID is used with "create" command and in some server responses
 signature = encoded
 ; empty signature can be used with "send" before the queue is secured with secure command
 ; signature is always empty with "ping" and "serverMsg"
@@ -371,6 +395,18 @@ encoded = <base64 encoded binary>
 
 `base64` encoding should be used with padding, as defined in section 4 of [RFC 4648][9]
 
+## SMP commands
+
+Commands syntax below is provided using [ABNF][8] with [case-sensitive strings extension][8a].
+
+```abnf
+smpCommand = ping / recipientCmd / send / subscribeNotifications / serverMsg
+recipientCmd = create / subscribe / secure / enableNotifications /
+               acknowledge / suspend / delete
+serverMsg = queueIds / message / notifierId / messageNotification /
+            unsubscribed / ok / error
+```
+
 The syntax of specific commands and responses is defined below.
 
 ### Correlating responses with commands
@@ -402,45 +438,36 @@ Sending any of the commands in this section (other than `create`, that is sent w
 This command is sent by the recipient to the SMP server to create a new queue. The syntax is:
 
 ```abnf
-create = %s"NEW" SP recipientSignaturePublicKey SP recipientDhPublicKey
-recipientSignaturePublicKey = signaturePublicKey
-; the recipient's public key to verify commands for this queue
+create = %s"NEW " recipientSignaturePublicKey recipientDhPublicKey
+recipientSignaturePublicKey = length x509encoded
+; the recipient's Ed25519 or Ed448 public key to verify commands for this queue
 
-signaturePublicKey = signatureScheme ":" x509encoded
-signatureScheme = %s"rsa" | %s"ed25519" | %s"ed448"
-; "rsa" means deprecated RSA-PSS signature scheme,
-; it must not be used for the new queues.
-
-recipientDhPublicKey = dhPublicKey
-dhPublicKey = encryptionScheme ":" x509encoded
-; the recipient's key for DH exchange to derive the secret
+recipientDhPublicKey = length x509encoded
+; the recipient's Curve25519 key for DH exchange to derive the secret
 ; that the server will use to encrypt delivered message bodies
+; using [NaCl crypto_box][16] encryption scheme (curve25519xsalsa20poly1305).
 
-encryptionScheme = %s"x25519" | %s"x448"
-; TODO change to define the encryption scheme, e.g. "crypto_box"
+x509encoded = <binary X509 key encoding>
 
-x509encoded = <base64 X509 key encoding>
+length = 1*1 OCTET
 ```
 
 If the queue is created successfully, the server must send `queueIds` response with the recipient's and sender's queue IDs and public keys to sign all responses and messages and to encrypt delivered message bodies:
 
 ```abnf
-queueIds = %s"IDS" SP recipientId SP senderId
-           SP serverSignaturePublicKey SP serverDhPublicKey
-serverSignaturePublicKey = signatureKey
-; the server's public key to verify responses and messages for this queue
-serverDhPublicKey = dhPublicKey
-; the server's key for DH exchange to derive the secret
+queueIds = %s"IDS " recipientId senderId srvDhPublicKey
+serverDhPublicKey = length x509encoded
+; the server's Curve25519 key for DH exchange to derive the secret
 ; that the server will use to encrypt delivered message bodies to the recipient
-recipientId = encoded
-senderId = encoded
+recipientId = length *OCTET ; 16-24 bytes
+senderId = length *OCTET ; 16-24 bytes
 ```
 
 Once the queue is created, the recipient gets automatically subscribed to receive the messages from that queue, until the transport connection is closed. The `subscribe` command is needed only to start receiving the messages from the existing queue when the new transport connection is opened.
 
 `NEW` transmission MUST be signed using the private part of the `recipientSignaturePublicKey` – this verifies that the client has the private key that will be used to sign subsequent commands for this queue.
 
-`IDS` response transmission MUST be sent signed with `serverSignaturePublicKey` – this verifies that the server has the private key that will be used to sign subsequent responses and messages for this queue.  This response should be sent with empty queue ID (the third part of the transmission).
+`IDS` response transmission MUST be sent with empty queue ID (the third part of the transmission).
 
 #### Subscribe to queue
 
@@ -461,9 +488,9 @@ This transmission and its response MUST be signed.
 This command is sent by the recipient to the server to add sender's key to the queue:
 
 ```abnf
-secure = %s"KEY" SP senderSignaturePublicKey
-senderSignaturePublicKey = signaturePublicKey
-; the sender's key to verify SEND commands for this queue
+secure = %s"KEY " senderSignaturePublicKey
+senderSignaturePublicKey = length x509encoded
+; the sender's Ed25519 or Ed448 key to verify SEND commands for this queue
 ```
 
 `senderKey` is received from the sender as part of the first message - see [Send Message](#send-message) command.
@@ -475,15 +502,16 @@ Once the queue is secured only signed messages can be sent to it.
 This command is sent by the recipient to the server to add notifier's key to the queue, to allow push notifications server to receive notifications when the message arrives, via a separate queue ID, without receiving message content.
 
 ```abnf
-enableNotifications = %s"NKEY" SP notifierKey
-notifierKey = signatureScheme ":" x509encoded ; the notifier's public key public key to verify NSUB command for this queue
+enableNotifications = %s"NKEY " notifierKey
+notifierKey = length x509encoded
+; the notifier's Ed25519 or Ed448 public key public key to verify NSUB command for this queue
 ```
 
 The server will respond with `notifierId` response if notifications were enabled and the notifier's key was successfully added to the queue:
 
 ```abnf
-notifierId = %s"NID" SP notifierId
-recipientId = encoded
+notifierId = %s"NID " notifierId
+notifierId = length *OCTET ; 16-24 bytes
 ```
 
 This response is sent with the recipient's queue ID (the third part of the transmission).
@@ -537,10 +565,17 @@ Currently SMP defines only one command that can be used by senders - `send` mess
 This command is sent to the server by the sender both to confirm the queue after the sender received out-of-band message from the recipient and to send messages after the queue is secured:
 
 ```abnf
-send = %s"SEND" SP size SP msgBody SP
-; the last SP is in addition to SP in the transmission
-size = 1*DIGIT ; size in bytes
-msgBody = *OCTET ; any binary content of specified size
+send = %s"SEND " smpEncMessage
+smpEncMessage = smpPubHeader sentMsgBody ; message up to 16088 bytes
+smpPubHeader = smpClientVersion ("1" senderPublicDhKey / "0")
+smpClientVersion = word16
+senderPublicDhKey = length x509encoded
+; sender's Curve25519 public key to agree DH secret for E2E encryption in this queue
+; it is only sent in confirmation message
+x509encoded = <binary X509 key encoding>
+sentMsgBody = 16032*16032 OCTET
+; E2E-encrypted smpClientMessage padded to 16032 bytes before encryption
+word16 = 2*2 OCTET
 ```
 
 The first message is sent to confirm the queue - it should contain sender's server key (see decrypted message syntax below) - this first message must be sent without signature.
@@ -558,15 +593,93 @@ Until the queue is secured, the server should accept any number of unsigned mess
 The body should be encrypted with the recipient's "public" key (`EK`); once decrypted it must have this format:
 
 ```abnf
-decryptedBody = [clientHeader] CRLF clientBody CRLF
-clientHeader = senderKeyMsg
-senderKeyMsg = %s"KEY" SP senderKey
-senderKey = signatureScheme ":" x509encoded ; the sender's public key to sign SEND commands for this queue
-clientBody = *OCTET
+sentMsgBody = <encrypted padded(smpClientMessage, 16032)>
+smpClientMessage = smpPrivHeader clientMsgBody
+smpPrivHeader = emptyHeader / smpConfirmationHeader
+emptyHeader = " "
+smpConfirmationHeader = %s"K" senderKey
+senderKey = length x509encoded
+; the sender's Ed25519 or Ed448 public key to sign SEND commands for this queue
+clientMsgBody = *OCTET ; up to 16016 in case of emptyHeader
 ```
 
 `clientHeader` in the initial unsigned message is used to transmit sender's server key and can be used in the future revisions of SMP protocol for other purposes.
 
+SMP transmission structure for sent messages:
+
+```
+------- transmission (= 16384 bytes)
+    2 | originalLength
+ 276- | signature sessionId corrId queueId %s"SEND" SP (1+114 + 1+32? + 1+32 + 1+24 + 4+1 = 210)
+      ....... smpEncMessage (= 16088 bytes = 16384 - 296 bytes)
+         8- | smpPubHeader (for messages it is only version and '0' to mean "no DH key" = 3 bytes)
+         24 | nonce for smpClientMessage
+         16 | auth tag for smpClientMessage
+            ------- smpClientMessage (E2E encrypted, = 16032 bytes = 16088 - 48)
+                2 | originalLength
+               12- | smpPrivHeader
+                  .......
+                        | clientMsgBody (<= 16016 bytes = 16032 - 14)
+                  .......
+               0+ | smpClientMessage pad
+            ------- smpClientMessage end
+            |
+      ....... smpEncMessage end
+  18+ | transmission pad
+------- transmission end
+```
+
+SMP transmission structure for received messages:
+
+```
+------- transmission (= 16384 bytes)
+    2 | originalLength
+ 276- | signature sessionId corrId queueId %s"MSG" SP msgId timestamp (1+114 + 1+32? + 1+32 + 1+24 + 3+1 + 24+1 + 8 = 243)
+   16 | auth tag (msgId is used as nonce)
+      ------- serverEncryptedMsg (= 16090 bytes = 16384 - 294 bytes)
+          2 | originalLength
+            ....... smpEncMessage (= 16088 bytes = 16090 - 2 bytes)
+               16- | smpPubHeader (empty header for the message)
+               24 | nonce for smpClientMessage
+               16 | auth tag for smpClientMessage
+                  ------- smpClientMessage (E2E encrypted, = 16032 bytes = 16088 - 56 bytes)
+                      2 | originalLength
+                     16- | smpPrivHeader (empty header for the message)
+                        ....... clientMsgBody (<= 16016 bytes = 16032 - 16)
+                              -- TODO move internal structure (below) to agent protocol
+                          20- | agentPublicHeader (the size is for user messages post handshake, without E2E X3DH keys - it is version and 'M' for the messages - 3 bytes in total)
+                              ....... E2E double-ratchet encrypted (<= 15996 bytes = 16016 - 20)
+                                  1 | encoded double ratchet header length (it is 123 now)
+                                123 | encoded double ratchet header, including:
+                                         2 | version
+                                        16 | double-ratchet header iv
+                                        16 | double-ratchet header auth tag
+                                      1+88 | double-ratchet header (actual size is 69 bytes, the rest is reserved)
+                                 16 | message auth tag (IV generated from chain ratchet)
+                                    ------- encrypted agent message (= 15856 bytes = 15996 - 140)
+                                        2 | originalLength
+                                      64- | agentHeader (the actual size is 41 = 8 + 1+32)
+                                        2 | %s"MM"
+                                          .......
+                                                | application message (<= 15788 bytes = 15856 - 68)
+                                          .......
+                                       0+ | encrypted agent message pad
+                                    ------- encrypted agent message end
+                                    |
+                              ....... E2E double-ratchet encrypted end
+                              |
+                              -- TODO move internal structure (above) to agent protocol
+                        ....... clientMsgBody end
+                     0+ | smpClientMessage pad
+                  ------- smpClientMessage end
+                  |
+            ....... smpEncMessage end
+         0+ | serverEncryptedMsg pad
+      ------- serverEncryptedMsg end
+   0+ | transmission pad
+------- transmission end
+```
+
 ### Notifier commands
 
 #### Subscribe to queue notifications
@@ -594,18 +707,18 @@ See its syntax in [Create queue command](#create-queue-command)
 The server must deliver messages to all subscribed simplex queues on the currently open transport connection. The syntax for the message delivery is:
 
 ```abnf
-message = %s"MSG" SP encryptedMessage
-encryptedMessage = <encrypt sentMessage>
-sentMessage = msgId SP timestamp SP size SP msgBody SP
-msgId = encoded
-timestamp = <date-time defined in RFC3339>
+message = %s"MSG " msgId SP timestamp SP encryptedMsgBody
+encryptedMsgBody = <encrypt paddedSentMsgBody> ; server-encrypted padded sent msgBody
+paddedSentMsgBody = <padded(sentMsgBody, maxMessageLength + 2)> ; maxMessageLength = 16088
+msgId = length 24*24OCTET
+timestamp = 8*8OCTET
 ```
 
-`msgId` - unique message ID generated by the server based on cryptographically strong random bytes. It should be used by the clients to detect messages that were delivered more than once (in case the transport connection was interrupted and the server did not receive the message delivery acknowledgement).
+`msgId` - unique message ID generated by the server based on cryptographically strong random bytes. It should be used by the clients to detect messages that were delivered more than once (in case the transport connection was interrupted and the server did not receive the message delivery acknowledgement). Message ID is used as a nonce for server/recipient encryption of message bodies.
 
-`timestamp` - the UTC time when the server received the message from the sender, must be in date-time format defined by [RFC 3339][10]
+`timestamp` - system time when the server received the message from the sender as **a number of seconds** since Unix epoch (1970-01-01) encoded as 64-bit integer in network byte order. If a client system/language does not support 64-bit integers, until 2106 it is safe to simply skip the first 4 zero bytes and decode 32-bit unsigned integer (or as signed integer until 2038).
 
-`msgBody` - see syntax in [Send message](#send-message)
+`paddedSentMsgBody` - see syntax in [Send message](#send-message)
 
 When server delivers the messages to the recipient, message body should be encrypted with the secret derived from DH exchange using the keys passed during the queue creation and returned with `queueIds` response.
 
@@ -640,24 +753,24 @@ No further messages should be delivered to unsubscribed transport connection.
 #### Error responses
 
 - incorrect block format, encoding or signature size (`BLOCK`).
+- missing or different session ID - tls-unique binding of TLS transport (`SESSION`)
 - command errors (`CMD`):
   - error parsing command (`SYNTAX`)
   - prohibited command (`PROHIBITED`) - any server response sent from client or `ACK` sent without active subscription or without message delivery.
-  - incorrect RSA key size in `NEW` or `KEY` commands - only 1024, 2048 and 4096-bit keys are allowed (`KEY_SIZE`).
   - transmission has no required signature or queue ID (`NO_AUTH`)
   - transmission has unexpected credentials (`HAS_AUTH`)
   - transmission has no required queue ID (`NO_QUEUE`)
 - authentication error (`AUTH`) - incorrect signature, unknown (or suspended) queue, sender's ID is used in place of recipient's and vice versa, and some other cases (see [Send message](#send-message) command).
 - message queue quota exceeded error (`QUOTA`) - too many messages were sent to the message queue. Further messages can only be sent after the recipient retrieves the messages.
-- incorrect message body size (`SIZE`).
+- sent message is too large (> 16088) to be delivered (`LARGE_MSG`).
 - internal server error (`INTERNAL`).
 
 The syntax for error responses:
 
 ```abnf
-error = %s"ERR" SP errorType
-errorType = %s"BLOCK" / %s"CMD" SP cmdError / %s"AUTH" / %s"SIZE" /%s"INTERNAL"
-cmdError = %s"SYNTAX" / %s"PROHIBITED" / %s"KEY_SIZE" / %s"NO_AUTH" / %s"HAS_AUTH" / %s"NO_QUEUE"
+error = %s"ERR " errorType
+errorType = %s"BLOCK" / %s"SESSION" / %s"CMD " cmdError / %s"AUTH" / %s"LARGE_MSG" /%s"INTERNAL"
+cmdError = %s"SYNTAX" / %s"PROHIBITED" / %s"NO_AUTH" / %s"HAS_AUTH" / %s"NO_QUEUE"
 ```
 
 Server implementations must aim to respond within the same time for each command in all cases when `"ERR AUTH"` response is required to prevent timing attacks (e.g., the server should perform signature verification even when the queue does not exist on the server or the signature of different size is sent, using any RSA key with the same size as the signature size).
@@ -692,32 +805,37 @@ The transport protocol should provide the following:
 - unique channel binding (`sessionIdentifier`) to include in the signed part of SMP transmissions.
 
 By default, the client and server communicate using [TLS 1.3 protocol][13] restricted to:
-- TLS_AES_256_GCM_SHA384 cypher suite,
+- TLS_CHACHA20_POLY1305_SHA256 cipher suite (for better performance on mobile devices),
 - ed25519 and ed448 EdDSA algorithms for signatures,
 - x25519 and x448 ECDHE groups for key exchange.
-- servers must send only one self-signed certificate in the handshake, clients must abort the connection in case more than one certificate is sent.
+- servers must send the chain of exactly 2 self-signed certificates in the handshake, with the first (offline) certificate one signing the second (online) certificate. Offline certificate fingerprint is used as a server identity - it is a part of SMP server address.
+- The clients must abort the connection in case a different number of certificates is sent.
 - server and client TLS configuration should not allow resuming the sessions.
 
-During TLS handshake the client must validate that the hash of the server certificate SPKI block is equal to the `serverIdentity` the client received as part of SMP server address; if the server identity does not match the client must abort the connection.
+During TLS handshake the client must validate that the fingerprint of the online server certificate is equal to the `serverIdentity` the client received as part of SMP server address; if the server identity does not match the client must abort the connection.
 
 Once TLS handshake is complete, client and server will exchange blocks of fixed size (16384 bytes).
 
-The first block sent by the client should be `clientHello` and the server should respond with `serverHello`:
+The first block sent by the server should be `serverHello` and the client should respond with `clientHello` - these blocks are used to agree SMP protocol version:
 
 ```abnf
-clientHello = SP smpVersion SP reserved pad
-serverHello = sessionIdentifier SP smpVersion SP reserved pad
-sessionIdentifier = <base64 encoded> ; unique session identifier derived from transport connection handshake
-  ; it should be included in all SMP transmissions sent in this transport connection.
+serverHello = minSmpVersion maxSmpVersion sessionIdentifier pad
+minSmpVersion = smpVersion
+maxSmpVersion = smpVersion
+sessionIdentifier = length *OCTET
+; unique session identifier derived from transport connection handshake
+; it should be included in all SMP transmissions sent in this transport connection.
 
-smpVersion = %s"SMP v" 1*DIGIT "." 1*DIGIT "." 1*DIGIT ; semver format, the version in this document is v0.5.0
-reserved = <reserved for additional information>
-pad = 1*OCTET
+clientHello = smpVersion pad
+; chosen SMP protocol version - it must be the maximum supported version
+; within the range offered by the server
+
+smpVersion = 2*2OCTET ; Word16 version number
+
+pad = *OCTET
 ```
 
-For TLS 1.3 transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `serverHello` block to allow communication over some other transport protocol.
-
-The communication party (client or server) that has the lower protocol version should assume that this version will be supported by another party, the party with the higher protocol version should abort the connection in case they cannot support the lower version.
+For TLS transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `serverHello` block to allow communication over some other transport protocol (possibly, with another channel binding).
 
 [1]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack
 [2]: https://en.wikipedia.org/wiki/End-to-end_encryption
@@ -734,3 +852,4 @@ The communication party (client or server) that has the lower protocol version s
 [13]: https://datatracker.ietf.org/doc/html/rfc8446
 [14]: https://datatracker.ietf.org/doc/html/rfc5929#section-3
 [15]: https://www.rfc-editor.org/rfc/rfc8709.html
+[16]: https://nacl.cr.yp.to/box.html

protocol/simplex-uri-request.txt

@@ -0,0 +1,18 @@
+Scheme name: simplex
+
+Status: Provisional
+
+Applications/protocols that use this scheme name:
+This scheme is used for connection requests in SimpleX Agent Protocol,
+a middle layer protocol for managing bi-directional communication via
+redundant unidirectional SimpleX Messaging Protocol queues.
+
+Contact: Evgeny Poberezkin <ep@simplex.chat>
+
+Change controller: Evgeny Poberezkin <ep@simplex.chat>
+
+References:
+The syntax for connection requests in the latest version of SimpleX Agent Protocol:
+https://github.com/simplex-chat/simplexmq/blob/v5/protocol/agent-protocol.md#connection-request
+SimpleX Messaging Protocol:
+https://github.com/simplex-chat/simplexmq/blob/v5/protocol/simplex-messaging.md

protocol/smp-uri-request.txt

@@ -0,0 +1,16 @@
+Scheme name: smp
+
+Status: Provisional
+
+Applications/protocols that use this scheme name:
+This scheme is used for URIs of message queues in SimpleX Messaging Protocol,
+a client-server protocol for asynchronous distributed unidirectional
+message transmission via persistent message queues.
+
+Contact: Evgeny Poberezkin <ep@simplex.chat>
+
+Change controller: Evgeny Poberezkin <ep@simplex.chat>
+
+References:
+The syntax for message queue URIs in the latest version of SimpleX Messaging Protocol:
+https://github.com/simplex-chat/simplexmq/blob/v5/protocol/simplex-messaging.md#smp-queue-uri

rfcs/2021-02-28-streams.md

@@ -26,20 +26,20 @@ Such connections that can be unidirectional or duplex can be managed by agents v
 
 The protocol to create and manage such stream could be the following:
 
-1. The sender client notifies the agent about the stream it has to create for a specific duplex connection (the connection must be duplex for it to be possible): `<conn_alias> SNEW <size>` (where `conn_alias` is the existing duplex connection, `size` is the size for the data to be transferred; 0 for unbounded streams), the response is `<conn_alias> STREAM <stream_id> <size>`.
+1. The sender client notifies the agent about the stream it has to create for a specific duplex connection (the connection must be duplex for it to be possible): `<conn_id> SNEW <size>` (where `conn_id` is the existing duplex connection, `size` is the size for the data to be transferred; 0 for unbounded streams), the response is `<conn_id> STREAM <stream_id> <size>`.
 2. The sender agent sends to the recipient agent the "envelope" `STREAM <stream_id> <size>`
-3. The receiving agent would notify the client about availability of the stream by sending `<conn_alias> STREAM <stream_id> <size>` notification.
-4. Receiving client would send `<conn_alias> SJOIN <stream_id>` command to the receiving agent.
+3. The receiving agent would notify the client about availability of the stream by sending `<conn_id> STREAM <stream_id> <size>` notification.
+4. Receiving client would send `<conn_id> SJOIN <stream_id>` command to the receiving agent.
 5. Receiving agent provisions the SMP queue on the random SMP server (we planned to remove SMP server from NEW command anyway). Possibly, there will be a limited list of servers that support streams (that is un-throttled number of messages), and stream support can be communicated via welcome header and change with AUTH SMP command.
 6. Receiving agent sends the envelop to sending agent `SJOIN <stream_id> <invitation>` (where invitation has the same format as in out-of-band message, but it has symmetric AES key and IV instead of asymmetric RSA key - the encryption scheme should codified in the invitation to make it generic).
 7. Sending agent and receiving agent confirm and secure SMP queue as usual. This is still not solving the problem that the sending agent should sign each command. We might extend SMP protocol to create a new queue type that allows authenticating the sender only once per TCP session so that messages can be sent without signing - the server can see that these queues are special anyway, as there will be much faster traffic there.
-8. Sending agent, once the queue is confirmed notifies the sending client that the stream is ready to accept data by sending notification `<conn_alias> SREADY <stream_id> <max_chunk_size>`.
-9. Sending agent client can now send packets into the stream up to total `<size>` limit if it was specified by using command `<conn_alias> SPUT <stream_id> <chunk_no> <chunk_size> <binary> ` (the chunk size should not be bigger than `max_chunk_size`, the agent would pad it to this size before sending to the receiving agent)
+8. Sending agent, once the queue is confirmed notifies the sending client that the stream is ready to accept data by sending notification `<conn_id> SREADY <stream_id> <max_chunk_size>`.
+9. Sending agent client can now send packets into the stream up to total `<size>` limit if it was specified by using command `<conn_id> SPUT <stream_id> <chunk_no> <chunk_size> <binary> ` (the chunk size should not be bigger than `max_chunk_size`, the agent would pad it to this size before sending to the receiving agent)
 10. Sending agent would send the chunk to the receiving agent in `CHUNK <chunk_no> <ts> <chunk_size> <binary>` envelope, where the first 4 bytes in decrypted binary is chunk size.
-11. Receiving agent would send the chunk to the client as `<conn_alias> SDATA <stream_id> <chunk_no> <ts> <status> <chunk_size> <binary>` (possibly, with three IDs and timestamps as with messages).
-12. Both the receiving and sending clients can terminate the stream with `<conn_alias> SCLOSE <stream_id>` command. The agent would send `SCLOSED <stream_id>` envelope and the opposite client would receive `<conn_alias> SCLOSED <stream_id>` notification - no more data will be accepted into this stream.
+11. Receiving agent would send the chunk to the client as `<conn_id> SDATA <stream_id> <chunk_no> <ts> <status> <chunk_size> <binary>` (possibly, with three IDs and timestamps as with messages).
+12. Both the receiving and sending clients can terminate the stream with `<conn_id> SCLOSE <stream_id>` command. The agent would send `SCLOSED <stream_id>` envelope and the opposite client would receive `<conn_id> SCLOSED <stream_id>` notification - no more data will be accepted into this stream.
 13. If the stream was bounded with some `size` then both the sending and receiving client would receive `SCLOSED` notification after the last chunk of correct size was sent (and the incorrect chunk would be rejected).
-14. If the stream was interrupted then the recipient client can request resuming this stream using `<conn_alias> SRESUME <stream_id> <from_chunk_no>`, the recipient agent would send "envelope" `SRESUME <stream_id> <from_chunk_no> <invitation>`.
+14. If the stream was interrupted then the recipient client can request resuming this stream using `<conn_id> SRESUME <stream_id> <from_chunk_no>`, the recipient agent would send "envelope" `SRESUME <stream_id> <from_chunk_no> <invitation>`.
 
 To be clarified:
 1. Possibly the internal stream ID used by clients should be different from stream ID communicated between agents, and in any case it should be connection scoped (same as with messages).

rfcs/2021-05-17-open-connection.md

@@ -17,7 +17,7 @@ Additional parameters in commands in SMP agent protocol:
 
 - `NEW` command will have a parameter `INV` or `CON` to create an invitation or a permanent contact connection.
 
-`conn_alias? OPEN` (or `PUB`, `NEWPUB`, tbc) - to create an "open"/"public" queue, the response is an invitation in a different format (TBC):
+`conn_id? OPEN` (or `PUB`, `NEWPUB`, tbc) - to create an "open"/"public" queue, the response is an invitation in a different format (TBC):
   - should allow multiple servers (probably the original invitation should be extended to support it)
   - should have a marker to indicate it's an open/public queue (probably the original invitation should be extended to include an invitation type).
 

rfcs/done/2021-01-20-logging.md

@@ -31,7 +31,7 @@ Agent disconnected from host:port
 ### Received command from the client
 
 ```
-n --> A : corrId connAlias parsed_command // raw_command
+n --> A : corrId connId parsed_command // raw_command
 ```
 
 `raw_command` is added only in case of parsing failure.
@@ -53,13 +53,13 @@ In case the response is a message or notification, corrId should be replaced wit
 ### Interpreted ("unwrapped") SMP message as agent message
 
 ```
-Agent msg : connAlias parsed_message // raw_message 
+Agent msg : connId parsed_message // raw_message 
 ```
 
 ### Sent response / message to the client
 
 ```
-n <-- A : corrId connAlias parsed_command // raw_command
+n <-- A : corrId connId parsed_command // raw_command
 ```
 
 ### Database changes

scripts/smp-server-digitalocean-droplet/README.md

@@ -1,10 +1,4 @@
-# Server image for DigitalOcean
-
-The current image used for 1-click deployment on DigitalOcean does not contain the source or binary of SMP Server - it downloads the compiled binary of the latest release (rather than a particular release) from GitHub.
-
-The upside is that the new image does not have to be created and approved by DigitalOcean every time when the new release is created.
-
-The downside is that while the release is being prepared in CI, when the release object is already created in GitHub but the server binary is not attached yet, the attempt to install the server would fail - it can last anything from several to 20 minutes, depending on whether the cached dependencies were used or everything was recompiled. Currently, when there is a small number of users, it is not a big problem, but we should consider some possible solutions in the future. Linode StackScript has the same issue.
+# SMP server image for DigitalOcean
 
 ## How to build an image
 

scripts/smp-server-digitalocean-droplet/files/opt/simplex/initialize_server.sh

@@ -0,0 +1,51 @@
+#!/bin/bash
+
+# Download latest release
+bin_dir="/opt/simplex/bin"
+binary="$bin_dir/smp-server"
+mkdir -p $bin_dir
+curl -L -o $binary https://github.com/simplex-chat/simplexmq/releases/latest/download/smp-server-ubuntu-20_04-x86-64
+chmod +x $binary
+
+# / Add to PATH
+cat > /etc/profile.d/simplex.sh << EOF
+#!/bin/bash
+
+export PATH="$PATH:$bin_dir"
+
+EOF
+# Add to PATH /
+
+# Source and test PATH
+source /etc/profile.d/simplex.sh
+smp-server --version
+
+# Initialize server
+ip_address=$(curl ifconfig.me)
+smp-server init -l --ip $ip_address
+
+# Server fingerprint
+fingerprint=$(cat /etc/opt/simplex/fingerprint)
+
+# Set up welcome script
+echo "bash /opt/simplex/on_login.sh $fingerprint $ip_address" >> /root/.bashrc
+
+# / Create systemd service for SMP server
+cat > /etc/systemd/system/smp-server.service << EOF
+[Unit]
+Description=SMP server
+
+[Service]
+Type=simple
+ExecStart=/bin/sh -c "exec $binary start >> /var/opt/simplex/smp-server.log 2>&1"
+
+[Install]
+WantedBy=multi-user.target
+
+EOF
+# Create systemd service for SMP server /
+
+# Start systemd service for SMP server
+chmod 644 /etc/systemd/system/smp-server.service
+sudo systemctl enable smp-server
+sudo systemctl start smp-server

scripts/smp-server-digitalocean-droplet/files/opt/simplex/on_login.sh

@@ -1,17 +1,16 @@
 #!/bin/bash
-# receives pubkey_hash file location as the first parameter
 
-ip_address=$(hostname -I | awk '{print$1}')
-hash=$(cat $1)
+fingerprint=$1
+server_address=$2
 
 cat <<EOF
 ********************************************************************************
 
-SMP server address: $ip_address#$hash
+SMP server address: smp://$fingerprint@$server_address
 Check SMP server status with: systemctl status smp-server
 
 To keep this server secure, the UFW firewall is enabled.
-All ports are BLOCKED except 22 (SSH), 80 (HTTP), 5223 (SMP server).
+All ports are BLOCKED except 22 (SSH), 443 (HTTPS), 5223 (SMP server).
 
 ********************************************************************************
 To stop seeing this message delete line - bash /opt/simplex/on_login.sh - from /root/.bashrc

scripts/smp-server-digitalocean-droplet/files/opt/simplex/server_bootstrap.sh

@@ -0,0 +1,12 @@
+#!/bin/bash
+
+set -eu
+
+if [[ ! -f /opt/simplex/do_initialize_server ]]; then
+  touch /opt/simplex/do_initialize_server
+elif [[ ! -f /etc/opt/simplex/smp-server.ini ]]; then
+  chmod +x /opt/simplex/initialize_server.sh
+  /opt/simplex/initialize_server.sh
+else
+  echo "SMP server already initialized"
+fi

scripts/smp-server-digitalocean-droplet/scripts/01-packages.sh

@@ -1,8 +1,25 @@
 #!/bin/sh
 
-# update apt
-apt-get -y update
-apt-get -y upgrade
+# https://superuser.com/questions/1638779/automatic-yess-to-linux-update-upgrade
+# https://superuser.com/questions/1412054/non-interactive-apt-upgrade
+sudo DEBIAN_FRONTEND=noninteractive \
+  apt-get \
+  -o Dpkg::Options::=--force-confold \
+  -o Dpkg::Options::=--force-confdef \
+  -y --allow-downgrades --allow-remove-essential --allow-change-held-packages \
+  update
 
-# packages needed for smp-server init-start.sh
-apt-get install -y jq
+sudo DEBIAN_FRONTEND=noninteractive \
+  apt-get \
+  -o Dpkg::Options::=--force-confold \
+  -o Dpkg::Options::=--force-confdef \
+  -y --allow-downgrades --allow-remove-essential --allow-change-held-packages \
+  dist-upgrade
+
+# TODO install unattended-upgrades; jq is not needed on DigitalOcean
+# sudo DEBIAN_FRONTEND=noninteractive \
+#   apt-get \
+#   -o Dpkg::Options::=--force-confold \
+#   -o Dpkg::Options::=--force-confdef \
+#   -y --allow-downgrades --allow-remove-essential --allow-change-held-packages \
+#   install jq

scripts/smp-server-digitalocean-droplet/scripts/02-firewall.sh

@@ -1,9 +1,9 @@
 #!/bin/sh
 
-# add firewall
+# Add firewall
 echo "y" | ufw enable
 
-# open ports
+# Open ports
 ufw allow ssh
-ufw allow http
+ufw allow https
 ufw allow 5223

scripts/smp-server-digitalocean-droplet/scripts/03-init-start.sh

@@ -1,57 +1,23 @@
 #!/bin/bash
 
-bin_dir="/opt/simplex/bin"
-conf_dir="/etc/opt/simplex"
-var_dir="/var/opt/simplex"
-mkdir -p $bin_dir
-mkdir -p $conf_dir
-mkdir -p $var_dir
+chmod +x /opt/simplex/server_bootstrap.sh
 
-echo "downloading the latest SMP server release"
-curl -s https://api.github.com/repos/simplex-chat/simplexmq/releases/latest > release.json
-jq '.assets[].browser_download_url | select(test("smp-server-ubuntu-20_04-x86-64"))' release.json \
-| tr -d \" \
-| wget -qi -
-
-release_version=$(jq '.tag_name' release.json | tr -d \")
-echo "downloaded SMP server $release_version"
-rm release.json
-
-echo "preparing for SMP server initiaization"
-mv smp-server-ubuntu-20_04-x86-64 $bin_dir/smp-server
-chmod +x $bin_dir/smp-server
-
-cat <<EOT >> /etc/profile.d/simplex.sh
-#!/bin/bash
-
-export PATH="$PATH:$bin_dir"
-
-EOT
-source /etc/profile.d/simplex.sh
-
-# prepare SMP server systemd service
-cat <<EOT >> /etc/systemd/system/smp-server.service
+# / Create systemd service for server bootstrap script
+cat > /etc/systemd/system/server-bootstrap.service << EOF
 [Unit]
-Description=SMP server systemd service
+Description=Server bootstrap script that downloads and initializes SMP server from the latest release
 
 [Service]
-Type=simple
-ExecStart=/bin/sh -c "$bin_dir/smp-server start"
+Type=oneshot
+ExecStart=/opt/simplex/server_bootstrap.sh
 
 [Install]
 WantedBy=multi-user.target
 
-EOT
-chmod 644 /etc/systemd/system/smp-server.service
+EOF
+# Create systemd service for server bootstrap script /
 
-echo "initializing SMP server"
-hash_file="$conf_dir/pubkey_hash"
-smp-server init -l | grep "transport key hash:" | cut -f2 -d":" | xargs > $hash_file
-# turn off websockets support
-sed -e '/websockets/s/^/# /g' -i $conf_dir/smp-server.ini
-# add welcome script to .bashrc
-echo "bash /opt/simplex/on_login.sh $hash_file" >> /root/.bashrc
-
-echo "starting SMP server"
-sudo systemctl enable smp-server
-sudo systemctl start smp-server
+# Start systemd service for server bootstrap script
+chmod 644 /etc/systemd/system/server-bootstrap.service
+sudo systemctl enable server-bootstrap
+sudo systemctl start server-bootstrap

scripts/smp-server-linode.sh

@@ -1,125 +1,167 @@
 #!/bin/bash
-# <UDF name="enable_store_log" label="Store log - persists SMP queues to append only log and restores them upon server restart." default="on" oneof="on, off" />
-# <UDF name="api_token" label="Linode API token - enables StackScript to create tags containing SMP server domain/ip address, transport key hash and server version. Use `domain#hash` or `ip#hash` as SMP server address in the client. Note: minimal permissions token should have are - read/write access to `linodes` (to update linode tags - you need them) and `domains` (to add A record for the chosen 3rd level domain)" default="" />
-# <UDF name="fqdn" label="FQDN (Fully qualified domain name) - provide third level domain name (ex: smp.example.com). If provided can be used instead of ip address." default="" />
 
-# log all stdout output to stackscript.log
+# <UDF name="enable_store_log" label="Store log - persist SMP queues to append only log and restore them upon server restart." default="on" oneof="on, off" />
+# <UDF name="api_token" label="Linode API token - enable Linode to create tags with server address, fingerprint and version. Note: minimal permissions token should have are read/write access to `linodes` (to create tags) and `domains` (to add A record for the third level domain if FQDN is provided)." default="" />
+# <UDF name="fqdn" label="FQDN (Fully Qualified Domain Name) - provide third level domain name (e.g. smp.example.com). If provided use `smp://fingerprint@FQDN` as server address in the client. If FQDN is not provided use `smp://fingerprint@IP` instead." default="" />
+
+# Log all stdout output to stackscript.log
 exec &> >(tee -i /var/log/stackscript.log)
-# uncomment next line to enable debugging features
+
+# Uncomment next line to enable debugging features
 # set -xeo pipefail
 
 cd $HOME
 
-sudo apt-get -y update 
-sudo apt-get -y upgrade
-sudo apt-get install -y jq
+# https://superuser.com/questions/1638779/automatic-yess-to-linux-update-upgrade
+# https://superuser.com/questions/1412054/non-interactive-apt-upgrade
+sudo DEBIAN_FRONTEND=noninteractive \
+  apt-get \
+  -o Dpkg::Options::=--force-confold \
+  -o Dpkg::Options::=--force-confdef \
+  -y --allow-downgrades --allow-remove-essential --allow-change-held-packages \
+  update
 
-# add firewall
+sudo DEBIAN_FRONTEND=noninteractive \
+  apt-get \
+  -o Dpkg::Options::=--force-confold \
+  -o Dpkg::Options::=--force-confdef \
+  -y --allow-downgrades --allow-remove-essential --allow-change-held-packages \
+  dist-upgrade
+
+# TODO install unattended-upgrades
+sudo DEBIAN_FRONTEND=noninteractive \
+  apt-get \
+  -o Dpkg::Options::=--force-confold \
+  -o Dpkg::Options::=--force-confdef \
+  -y --allow-downgrades --allow-remove-essential --allow-change-held-packages \
+  install jq
+
+# Add firewall
 echo "y" | ufw enable
-# open ports
+
+# Open ports
 ufw allow ssh
-ufw allow http
+ufw allow https
 ufw allow 5223
 
+# Download latest release
 bin_dir="/opt/simplex/bin"
-conf_dir="/etc/opt/simplex"
-var_dir="/var/opt/simplex"
+binary="$bin_dir/smp-server"
 mkdir -p $bin_dir
-mkdir -p $conf_dir
-mkdir -p $var_dir
+curl -L -o $binary https://github.com/simplex-chat/simplexmq/releases/latest/download/smp-server-ubuntu-20_04-x86-64
+chmod +x $binary
 
-# retrieve latest release info and download smp-server executable
-curl -s https://api.github.com/repos/simplex-chat/simplexmq/releases/latest > release.json
-jq '.assets[].browser_download_url | select(test("smp-server-ubuntu-20_04-x86-64"))' release.json \
-| tr -d \" \
-| wget -qi -
-
-mv smp-server-ubuntu-20_04-x86-64 $bin_dir/smp-server
-chmod +x $bin_dir/smp-server
-
-cat <<EOT >> /etc/profile.d/simplex.sh
+# / Add to PATH
+cat > /etc/profile.d/simplex.sh << EOF
 #!/bin/bash
 
 export PATH="$PATH:$bin_dir"
 
-EOT
+EOF
+# Add to PATH /
+
+# Source and test PATH
 source /etc/profile.d/simplex.sh
+smp-server --version
 
-# initialize SMP server
+# Initialize server
 init_opts=()
+
 [[ $ENABLE_STORE_LOG == "on" ]] && init_opts+=(-l)
-hash_file="$conf_dir/pubkey_hash"
-smp-server init "${init_opts[@]}" | grep "transport key hash:" | cut -f2 -d":" | xargs > $hash_file
-# turn off websockets support
-sed -e '/websockets/s/^/# /g' -i $conf_dir/smp-server.ini
-# create script that will run on login
+
+ip_address=$(curl ifconfig.me)
+init_opts+=(--ip $ip_address)
+
+[[ -n "$FQDN" ]] && init_opts+=(-n $FQDN)
+
+smp-server init "${init_opts[@]}"
+
+# Server fingerprint
+fingerprint=$(cat /etc/opt/simplex/fingerprint)
+
+# Determine server address to specify in welcome script and Linode tag
+# ! If FQDN was provided and used as part of server initialization, server's certificate will not pass validation at client
+# ! if client tries to connect by server's IP address, so we have to specify FQDN as server address in Linode tag and
+# ! in welcome script regardless of creation of A record in Linode
+# ! https://hackage.haskell.org/package/x509-validation-1.6.10/docs/src/Data-X509-Validation.html#validateCertificateName
+if [[ -n "$FQDN" ]]; then
+  server_address=$FQDN
+else
+  server_address=$ip_address
+fi
+
+# Set up welcome script
 on_login_script="/opt/simplex/on_login.sh"
-cat <<EOT >> $on_login_script
+
+# / Welcome script
+cat > $on_login_script << EOF
 #!/bin/bash
-# receives pubkey_hash file location as the first parameter
 
-ip_address=\$(hostname -I | awk '{print\$1}')
-hash=\$(cat \$1)
+fingerprint=\$1
+server_address=\$2
 
-cat <<EOF
+cat << EOF2
 ********************************************************************************
 
-SMP server address: \$ip_address#\$hash
+SMP server address: smp://\$fingerprint@\$server_address
 Check SMP server status with: systemctl status smp-server
 
 To keep this server secure, the UFW firewall is enabled.
-All ports are BLOCKED except 22 (SSH), 80 (HTTP), 5223 (SMP server).
+All ports are BLOCKED except 22 (SSH), 443 (HTTPS), 5223 (SMP server).
 
 ********************************************************************************
 To stop seeing this message delete line - bash /opt/simplex/on_login.sh - from /root/.bashrc
+EOF2
+
 EOF
+# Welcome script /
 
-EOT
 chmod +x $on_login_script
-echo "bash $on_login_script $hash_file" >> /root/.bashrc
+echo "bash $on_login_script $fingerprint $server_address" >> /root/.bashrc
 
-# create A record and update linode's tags
-if [ ! -z "$API_TOKEN" ]; then
-     ip_address=$(curl ifconfig.me)
-     address=$ip_address
-     if [ ! -z "$FQDN" ]; then
-          domain_address=$(echo $FQDN | rev | cut -d "." -f 1,2 | rev)
-          domain_id=$(curl -H "Authorization: Bearer $API_TOKEN" https://api.linode.com/v4/domains \
-          | jq --arg da "$domain_address" '.data[] | select( .domain == $da ) | .id')
-          if [[ ! -z $domain_id ]]; then
-               curl -s -H "Content-Type: application/json" \
-                    -H "Authorization: Bearer $API_TOKEN" \
-                    -X POST -d "{\"type\":\"A\",\"name\":\"$FQDN\",\"target\":\"$ip_address\"}" \
-                    https://api.linode.com/v4/domains/${domain_id}/records
-               address=$FQDN
-          fi
-     fi
+# Create A record and update Linode's tags
+if [[ -n "$API_TOKEN" ]]; then
+  if [[ -n "$FQDN" ]]; then
+    domain_address=$(echo $FQDN | rev | cut -d "." -f 1,2 | rev)
+    domain_id=$(curl -H "Authorization: Bearer $API_TOKEN" https://api.linode.com/v4/domains \
+    | jq --arg da "$domain_address" '.data[] | select( .domain == $da ) | .id')
+    if [[ -n $domain_id ]]; then
+      curl \
+        -s -H "Content-Type: application/json" \
+        -H "Authorization: Bearer $API_TOKEN" \
+        -X POST -d "{\"type\":\"A\",\"name\":\"$FQDN\",\"target\":\"$ip_address\"}" \
+        https://api.linode.com/v4/domains/${domain_id}/records
+    fi
+  fi
 
-     hash=$(cat $hash_file)
-     release_version=$(jq '.tag_name' release.json | tr -d \")
+  version=$(smp-server --version | cut -d ' ' -f 3-)
 
-     curl -s -H "Content-Type: application/json" \
-          -H "Authorization: Bearer $API_TOKEN" \
-          -X PUT -d "{\"tags\":[\"$address\",\"#$hash\",\"$release_version\"]}" \
-          https://api.linode.com/v4/linode/instances/$LINODE_ID
+  curl \
+    -s -H "Content-Type: application/json" \
+    -H "Authorization: Bearer $API_TOKEN" \
+    -X PUT -d "{\"tags\":[\"$server_address\",\"$fingerprint\",\"$version\"]}" \
+    https://api.linode.com/v4/linode/instances/$LINODE_ID
 fi
 
-# create, enable and start SMP server systemd service
-cat <<EOT >> /etc/systemd/system/smp-server.service
+# / Create systemd service
+cat > /etc/systemd/system/smp-server.service << EOF
 [Unit]
-Description=SMP server systemd service
+Description=SMP server
 
 [Service]
 Type=simple
-ExecStart=/bin/sh -c "$bin_dir/smp-server start"
+ExecStart=/bin/sh -c "exec $binary start >> /var/opt/simplex/smp-server.log 2>&1"
 
 [Install]
 WantedBy=multi-user.target
 
-EOT
+EOF
+# Create systemd service /
+
+# Start systemd service
 chmod 644 /etc/systemd/system/smp-server.service
 sudo systemctl enable smp-server
 sudo systemctl start smp-server
 
-# cleanup
-rm release.json
+# Reboot Linode to apply upgrades
+sudo reboot

simplexmq.cabal

@@ -3,11 +3,9 @@ cabal-version: 1.12
 -- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
---
--- hash: ff75c96b1b4f19821ceda01f32e8759e89ad661380f324f1ab9eec3d5c223425
 
 name:           simplexmq
-version:        0.5.1
+version:        1.0.2
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -21,31 +19,36 @@ category:       Chat, Network, Web, System, Cryptography
 homepage:       https://github.com/simplex-chat/simplexmq#readme
 author:         simplex.chat
 maintainer:     chat@simplex.chat
-copyright:      2020 simplex.chat
+copyright:      2020-2022 simplex.chat
 license:        AGPL-3
 license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
     README.md
     CHANGELOG.md
-    migrations/20210101_initial.sql
-    migrations/20210624_confirmations.sql
-    migrations/20210809_snd_messages.sql
-    migrations/20211202_connection_mode.sql
-    migrations/README.md
 
 library
   exposed-modules:
       Simplex.Messaging.Agent
       Simplex.Messaging.Agent.Client
+      Simplex.Messaging.Agent.Env.Postgres
       Simplex.Messaging.Agent.Env.SQLite
       Simplex.Messaging.Agent.Protocol
+      Simplex.Messaging.Agent.QueryString
       Simplex.Messaging.Agent.RetryInterval
+      Simplex.Messaging.Agent.Server
       Simplex.Messaging.Agent.Store
+      Simplex.Messaging.Agent.Store.Postgres
+      Simplex.Messaging.Agent.Store.Postgres.Migrations
+      Simplex.Messaging.Agent.Store.Postgres.Migrations.M20220202_initial
       Simplex.Messaging.Agent.Store.SQLite
       Simplex.Messaging.Agent.Store.SQLite.Migrations
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
       Simplex.Messaging.Client
       Simplex.Messaging.Crypto
+      Simplex.Messaging.Crypto.Ratchet
+      Simplex.Messaging.Encoding
+      Simplex.Messaging.Encoding.String
       Simplex.Messaging.Parsers
       Simplex.Messaging.Protocol
       Simplex.Messaging.Server
@@ -56,8 +59,11 @@ library
       Simplex.Messaging.Server.QueueStore.STM
       Simplex.Messaging.Server.StoreLog
       Simplex.Messaging.Transport
+      Simplex.Messaging.Transport.Client
+      Simplex.Messaging.Transport.Server
       Simplex.Messaging.Transport.WebSockets
       Simplex.Messaging.Util
+      Simplex.Messaging.Version
   other-modules:
       Paths_simplexmq
   hs-source-dirs:
@@ -65,11 +71,12 @@ library
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
   build-depends:
       QuickCheck ==2.14.*
+    , aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
@@ -77,9 +84,10 @@ library
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
+    , data-default ==0.7.*
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
-    , file-embed ==0.0.14.*
     , filepath ==1.4.*
     , generic-random >=1.3 && <1.5
     , http-types ==0.12.*
@@ -88,6 +96,7 @@ library
     , mtl ==2.2.*
     , network ==3.1.*
     , network-transport ==0.5.*
+    , postgresql-simple ==0.6.*
     , random >=1.1 && <1.3
     , simple-logger ==0.1.*
     , sqlite-simple ==0.4.*
@@ -95,11 +104,14 @@ library
     , template-haskell ==2.16.*
     , text ==1.2.*
     , time ==1.9.*
+    , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
     , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
   default-language: Haskell2010
 
 executable smp-agent
@@ -111,11 +123,12 @@ executable smp-agent
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       QuickCheck ==2.14.*
+    , aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
@@ -123,9 +136,10 @@ executable smp-agent
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
+    , data-default ==0.7.*
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
-    , file-embed ==0.0.14.*
     , filepath ==1.4.*
     , generic-random >=1.3 && <1.5
     , http-types ==0.12.*
@@ -134,6 +148,7 @@ executable smp-agent
     , mtl ==2.2.*
     , network ==3.1.*
     , network-transport ==0.5.*
+    , postgresql-simple ==0.6.*
     , random >=1.1 && <1.3
     , simple-logger ==0.1.*
     , simplexmq
@@ -142,11 +157,14 @@ executable smp-agent
     , template-haskell ==2.16.*
     , text ==1.2.*
     , time ==1.9.*
+    , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
     , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
   default-language: Haskell2010
 
 executable smp-server
@@ -158,11 +176,12 @@ executable smp-server
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       QuickCheck ==2.14.*
+    , aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
@@ -171,9 +190,9 @@ executable smp-server
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
     , cryptostore ==0.2.*
+    , data-default ==0.7.*
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
-    , file-embed ==0.0.14.*
     , filepath ==1.4.*
     , generic-random >=1.3 && <1.5
     , http-types ==0.12.*
@@ -184,6 +203,8 @@ executable smp-server
     , network ==3.1.*
     , network-transport ==0.5.*
     , optparse-applicative >=0.15 && <0.17
+    , postgresql-simple ==0.6.*
+    , process ==1.6.*
     , random >=1.1 && <1.3
     , simple-logger ==0.1.*
     , simplexmq
@@ -192,11 +213,14 @@ executable smp-server
     , template-haskell ==2.16.*
     , text ==1.2.*
     , time ==1.9.*
+    , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
     , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
   default-language: Haskell2010
 
 test-suite smp-server-test
@@ -205,9 +229,12 @@ test-suite smp-server-test
   other-modules:
       AgentTests
       AgentTests.ConnectionRequestTests
+      AgentTests.DoubleRatchetTests
       AgentTests.FunctionalAPITests
       AgentTests.SQLiteTests
-      ProtocolErrorTests
+      CoreTests.EncodingTests
+      CoreTests.ProtocolErrorTests
+      CoreTests.VersionRangeTests
       ServerTests
       SMPAgentClient
       SMPClient
@@ -218,11 +245,12 @@ test-suite smp-server-test
   build-depends:
       HUnit ==1.6.*
     , QuickCheck ==2.14.*
+    , aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
@@ -230,9 +258,10 @@ test-suite smp-server-test
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
+    , data-default ==0.7.*
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
-    , file-embed ==0.0.14.*
     , filepath ==1.4.*
     , generic-random >=1.3 && <1.5
     , hspec ==2.7.*
@@ -243,6 +272,7 @@ test-suite smp-server-test
     , mtl ==2.2.*
     , network ==3.1.*
     , network-transport ==0.5.*
+    , postgresql-simple ==0.6.*
     , random >=1.1 && <1.3
     , simple-logger ==0.1.*
     , simplexmq
@@ -252,9 +282,12 @@ test-suite smp-server-test
     , text ==1.2.*
     , time ==1.9.*
     , timeit ==2.0.*
+    , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
     , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
   default-language: Haskell2010

src/Simplex/Messaging/Agent.hs

@@ -7,11 +7,9 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -28,11 +26,7 @@
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md
 module Simplex.Messaging.Agent
-  ( -- * SMP agent over TCP
-    runSMPAgent,
-    runSMPAgentBlocking,
-
-    -- * queue-based SMP agent
+  ( -- * queue-based SMP agent
     getAgentClient,
     runAgentClient,
 
@@ -53,6 +47,7 @@ module Simplex.Messaging.Agent
     ackMessage,
     suspendConnection,
     deleteConnection,
+    logConnection,
   )
 where
 
@@ -62,60 +57,38 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
-import Data.Bifunctor (second)
+import Data.Bifunctor (first, second)
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.))
 import Data.Functor (($>))
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
-import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (isJust)
 import qualified Data.Text as T
-import Data.Text.Encoding (decodeUtf8)
 import Data.Time.Clock
+import Data.Time.Clock.System (systemToUTCTime)
 import Database.SQLite.Simple (SQLError)
 import Simplex.Messaging.Agent.Client
-import Simplex.Messaging.Agent.Env.SQLite
+import Simplex.Messaging.Agent.Env.Postgres
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
-import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
+import Simplex.Messaging.Agent.Store.Postgres (PostgresStore)
 import Simplex.Messaging.Client (SMPServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (MsgBody, SenderPublicKey)
+import qualified Simplex.Messaging.Crypto.Ratchet as CR
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Parsers (parse)
+import Simplex.Messaging.Protocol (MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), currentSMPVersionStr, runTransportServer)
-import Simplex.Messaging.Util (bshow, tryError)
+import Simplex.Messaging.Util (bshow, liftError, tryError, unlessM)
+import Simplex.Messaging.Version
 import System.Random (randomR)
-import UnliftIO.Async (Async, async, race_)
+import UnliftIO.Async (async, race_)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
--- | Runs an SMP agent as a TCP service using passed configuration.
---
--- See a full agent executable here: https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-agent/Main.hs
-runSMPAgent :: (MonadRandom m, MonadUnliftIO m) => ATransport -> AgentConfig -> m ()
-runSMPAgent t cfg = do
-  started <- newEmptyTMVarIO
-  runSMPAgentBlocking t started cfg
-
--- | Runs an SMP agent as a TCP service using passed configuration with signalling.
---
--- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
--- and when it is disconnected from the TCP socket once the server thread is killed (False).
-runSMPAgentBlocking :: (MonadRandom m, MonadUnliftIO m) => ATransport -> TMVar Bool -> AgentConfig -> m ()
-runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort} = runReaderT (smpAgent t) =<< newSMPAgentEnv cfg
-  where
-    smpAgent :: forall c m'. (Transport c, MonadUnliftIO m', MonadReader Env m') => TProxy c -> m' ()
-    smpAgent _ = runTransportServer started tcpPort $ \(h :: c) -> do
-      liftIO . putLn h $ "Welcome to SMP agent v" <> currentSMPVersionStr
-      c <- getAgentClient
-      logConnection c True
-      race_ (connectClient h c) (runAgentClient c)
-        `E.finally` disconnectAgentClient c
-
 -- | Creates an SMP agent client instance
 getSMPAgentClient :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> m AgentClient
 getSMPAgentClient cfg = newSMPAgentEnv cfg >>= runReaderT runAgent
@@ -132,11 +105,11 @@ disconnectAgentClient c = closeAgentClient c >> logConnection c False
 type AgentErrorMonad m = (MonadUnliftIO m, MonadError AgentErrorType m)
 
 -- | Create SMP agent connection (NEW command)
-createConnection :: AgentErrorMonad m => AgentClient -> SConnectionMode c -> m (ConnId, ConnectionRequest c)
+createConnection :: AgentErrorMonad m => AgentClient -> SConnectionMode c -> m (ConnId, ConnectionRequestUri c)
 createConnection c cMode = withAgentEnv c $ newConn c "" cMode
 
 -- | Join SMP agent connection (JOIN command)
-joinConnection :: AgentErrorMonad m => AgentClient -> ConnectionRequest c -> ConnInfo -> m ConnId
+joinConnection :: AgentErrorMonad m => AgentClient -> ConnectionRequestUri c -> ConnInfo -> m ConnId
 joinConnection c = withAgentEnv c .: joinConn c ""
 
 -- | Allow connection to continue after CONF notification (LET command)
@@ -180,9 +153,6 @@ withAgentEnv c = (`runReaderT` agentEnv c)
 getAgentClient :: (MonadUnliftIO m, MonadReader Env m) => m AgentClient
 getAgentClient = ask >>= atomically . newAgentClient
 
-connectClient :: Transport c => MonadUnliftIO m => c -> AgentClient -> m ()
-connectClient h c = race_ (send h c) (receive h c)
-
 logConnection :: MonadUnliftIO m => AgentClient -> Bool -> m ()
 logConnection c connected =
   let event = if connected then "connected to" else "disconnected from"
@@ -192,28 +162,6 @@ logConnection c connected =
 runAgentClient :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
 runAgentClient c = race_ (subscriber c) (client c)
 
-receive :: forall c m. (Transport c, MonadUnliftIO m) => c -> AgentClient -> m ()
-receive h c@AgentClient {rcvQ, subQ} = forever $ do
-  (corrId, connId, cmdOrErr) <- tGet SClient h
-  case cmdOrErr of
-    Right cmd -> write rcvQ (corrId, connId, cmd)
-    Left e -> write subQ (corrId, connId, ERR e)
-  where
-    write :: TBQueue (ATransmission p) -> ATransmission p -> m ()
-    write q t = do
-      logClient c "-->" t
-      atomically $ writeTBQueue q t
-
-send :: (Transport c, MonadUnliftIO m) => c -> AgentClient -> m ()
-send h c@AgentClient {subQ} = forever $ do
-  t <- atomically $ readTBQueue subQ
-  tPut h t
-  logClient c "<--" t
-
-logClient :: MonadUnliftIO m => AgentClient -> ByteString -> ATransmission a -> m ()
-logClient AgentClient {clientId} dir (corrId, connId, cmd) = do
-  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, connId, B.takeWhile (/= ' ') $ serializeCommand cmd]
-
 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
 client c@AgentClient {rcvQ, subQ} = forever $ do
   (corrId, connId, cmd) <- atomically $ readTBQueue rcvQ
@@ -224,18 +172,22 @@ client c@AgentClient {rcvQ, subQ} = forever $ do
 
 withStore ::
   AgentMonad m =>
-  (forall m'. (MonadUnliftIO m', MonadError StoreError m') => SQLiteStore -> m' a) ->
+  (forall m'. (MonadUnliftIO m', MonadError StoreError m') => PostgresStore -> m' a) ->
   m a
 withStore action = do
   st <- asks store
   runExceptT (action st `E.catch` handleInternal) >>= \case
     Right c -> return c
-    Left e -> throwError $ storeError e
+    Left e -> do
+      liftIO $ print e
+      throwError $ storeError e
   where
     -- TODO when parsing exception happens in store, the agent hangs;
     -- changing SQLError to SomeException does not help
-    handleInternal :: (MonadError StoreError m') => SQLError -> m' a
-    handleInternal e = throwError . SEInternal $ bshow e
+    handleInternal :: (MonadUnliftIO m', MonadError StoreError m') => SQLError -> m' a
+    handleInternal e = do
+      liftIO $ print e
+      throwError . SEInternal $ bshow e
     storeError :: StoreError -> AgentErrorType
     storeError = \case
       SEConnNotFound -> CONN NOT_FOUND
@@ -259,53 +211,76 @@ processCommand c (connId, cmd) = case cmd of
   OFF -> suspendConnection' c connId $> (connId, OK)
   DEL -> deleteConnection' c connId $> (connId, OK)
 
-newConn :: AgentMonad m => AgentClient -> ConnId -> SConnectionMode c -> m (ConnId, ConnectionRequest c)
+newConn :: AgentMonad m => AgentClient -> ConnId -> SConnectionMode c -> m (ConnId, ConnectionRequestUri c)
 newConn c connId cMode = do
   srv <- getSMPServer
-  (rq, qUri, encryptKey) <- newRcvQueue c srv
+  (rq, qUri) <- newRcvQueue c srv
   g <- asks idsDrg
   let cData = ConnData {connId}
   connId' <- withStore $ \st -> createRcvConn st g cData rq cMode
   addSubscription c rq connId'
-  let crData = ConnReqData simplexChat [qUri] encryptKey
-  pure . (connId',) $ case cMode of
-    SCMInvitation -> CRInvitation crData
-    SCMContact -> CRContact crData
+  let crData = ConnReqUriData simplexChat smpAgentVRange [qUri]
+  case cMode of
+    SCMContact -> pure (connId', CRContactUri crData)
+    SCMInvitation -> do
+      (pk1, pk2, e2eRcvParams) <- liftIO $ CR.generateE2EParams CR.e2eEncryptVersion
+      withStore $ \st -> createRatchetX3dhKeys st connId' pk1 pk2
+      pure (connId', CRInvitationUri crData $ toVersionRangeT e2eRcvParams CR.e2eEncryptVRange)
 
-joinConn :: AgentMonad m => AgentClient -> ConnId -> ConnectionRequest c -> ConnInfo -> m ConnId
-joinConn c connId (CRInvitation (ConnReqData _ (qUri :| _) encryptKey)) cInfo = do
-  (sq, senderKey, verifyKey) <- newSndQueue qUri encryptKey
-  g <- asks idsDrg
-  cfg <- asks config
-  let cData = ConnData {connId}
-  connId' <- withStore $ \st -> createSndConn st g cData sq
-  confirmQueue c sq senderKey cInfo
-  activateQueueJoining c connId' sq verifyKey $ retryInterval cfg
-  pure connId'
-joinConn c connId (CRContact (ConnReqData _ (qUri :| _) encryptKey)) cInfo = do
-  (connId', cReq) <- newConn c connId SCMInvitation
-  sendInvitation c qUri encryptKey cReq cInfo
-  pure connId'
+joinConn :: AgentMonad m => AgentClient -> ConnId -> ConnectionRequestUri c -> ConnInfo -> m ConnId
+joinConn c connId (CRInvitationUri (ConnReqUriData _ agentVRange (qUri :| _)) e2eRcvParamsUri) cInfo =
+  case ( qUri `compatibleVersion` SMP.smpClientVRange,
+         e2eRcvParamsUri `compatibleVersion` CR.e2eEncryptVRange,
+         agentVRange `compatibleVersion` smpAgentVRange
+       ) of
+    (Just qInfo, Just (Compatible e2eRcvParams@(CR.E2ERatchetParams _ _ rcDHRr)), Just _) -> do
+      -- TODO in agent v2 - use found compatible version rather than current
+      (pk1, pk2, e2eSndParams) <- liftIO . CR.generateE2EParams $ version e2eRcvParams
+      (_, rcDHRs) <- liftIO C.generateKeyPair'
+      let rc = CR.initSndRatchet rcDHRr rcDHRs $ CR.x3dhSnd pk1 pk2 e2eRcvParams
+      (sq, smpConf) <- newSndQueue qInfo cInfo
+      g <- asks idsDrg
+      let cData = ConnData {connId}
+      connId' <- withStore $ \st -> do
+        liftIO $ print "before: createSndConn st g cData sq"
+        connId' <- createSndConn st g cData sq
+        liftIO $ print "before: createRatchet st connId' rc"
+        createRatchet st connId' rc
+        liftIO $ print "after: createRatchet st connId' rc"
+        pure connId'
+      confirmQueue c connId' sq smpConf $ Just e2eSndParams
+      void $ enqueueMessage c connId' sq HELLO
+      pure connId'
+    _ -> throwError $ AGENT A_VERSION
+joinConn c connId (CRContactUri (ConnReqUriData _ agentVRange (qUri :| _))) cInfo =
+  case ( qUri `compatibleVersion` SMP.smpClientVRange,
+         agentVRange `compatibleVersion` smpAgentVRange
+       ) of
+    (Just qInfo, Just _) -> do
+      -- TODO in agent v2 - use found compatible version rather than current
+      (connId', cReq) <- newConn c connId SCMInvitation
+      sendInvitation c qInfo cReq cInfo
+      pure connId'
+    _ -> throwError $ AGENT A_VERSION
 
-activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
-activateQueueJoining c connId sq verifyKey retryInterval =
-  activateQueue c connId sq verifyKey retryInterval createReplyQueue
-  where
-    createReplyQueue :: m ()
-    createReplyQueue = do
-      srv <- getSMPServer
-      (rq, qUri', encryptKey) <- newRcvQueue c srv
-      addSubscription c rq connId
-      withStore $ \st -> upgradeSndConnToDuplex st connId rq
-      sendControlMessage c sq . REPLY $ CRInvitation $ ConnReqData CRSSimplex [qUri'] encryptKey
+createReplyQueue :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> m ()
+createReplyQueue c connId sq = do
+  srv <- getSMPServer
+  (rq, qUri) <- newRcvQueue c srv
+  -- TODO reply queue version should be the same as send queue, ignoring it in v1
+  let qInfo = toVersionT qUri SMP.smpClientVersion
+  addSubscription c rq connId
+  withStore $ \st -> upgradeSndConnToDuplex st connId rq
+  void . enqueueMessage c connId sq $ REPLY [qInfo]
 
 -- | Approve confirmation (LET command) in Reader monad
 allowConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
 allowConnection' c connId confId ownConnInfo = do
   withStore (`getConn` connId) >>= \case
     SomeConn _ (RcvConnection _ rq) -> do
-      AcceptedConfirmation {senderKey} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo
-      processConfirmation c rq senderKey
+      AcceptedConfirmation {senderConf, ratchetState} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo
+      withStore $ \st -> createRatchet st connId ratchetState
+      processConfirmation c rq senderConf
     _ -> throwError $ CMD PROHIBITED
 
 -- | Accept contact (ACPT command) in Reader monad
@@ -323,10 +298,11 @@ rejectContact' :: AgentMonad m => AgentClient -> ConnId -> InvitationId -> m ()
 rejectContact' _ contactConnId invId =
   withStore $ \st -> deleteInvitation st contactConnId invId
 
-processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
-processConfirmation c rq sndKey = do
-  withStore $ \st -> setRcvQueueStatus st rq Confirmed
-  secureQueue c rq sndKey
+processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SMPConfirmation -> m ()
+processConfirmation c rq@RcvQueue {e2ePrivKey} SMPConfirmation {senderKey, e2ePubKey} = do
+  let dhSecret = C.dh' e2ePubKey e2ePrivKey
+  withStore $ \st -> setRcvQueueConfirmedE2E st rq dhSecret
+  secureQueue c rq senderKey
   withStore $ \st -> setRcvQueueStatus st rq Secured
 
 -- | Subscribe to receive connection messages (SUB command) in Reader monad
@@ -334,139 +310,147 @@ subscribeConnection' :: forall m. AgentMonad m => AgentClient -> ConnId -> m ()
 subscribeConnection' c connId =
   withStore (`getConn` connId) >>= \case
     SomeConn _ (DuplexConnection _ rq sq) -> do
-      resumeDelivery sq
+      resumeMsgDelivery c connId sq
+      subscribeQueue c rq connId
       case status (sq :: SndQueue) of
-        Confirmed -> withVerifyKey sq $ \verifyKey -> do
-          conf <- withStore (`getAcceptedConfirmation` connId)
-          secureQueue c rq $ senderKey (conf :: AcceptedConfirmation)
+        Confirmed -> do
+          -- TODO if there is no confirmation saved, just update the status without securing the queue
+          AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <-
+            withStore (`getAcceptedConfirmation` connId)
+          secureQueue c rq senderKey
           withStore $ \st -> setRcvQueueStatus st rq Secured
-          activateSecuredQueue rq sq verifyKey
-        Secured -> withVerifyKey sq $ activateSecuredQueue rq sq
-        Active -> subscribeQueue c rq connId
+        Secured -> pure ()
+        Active -> pure ()
         _ -> throwError $ INTERNAL "unexpected queue status"
     SomeConn _ (SndConnection _ sq) -> do
-      resumeDelivery sq
+      resumeMsgDelivery c connId sq
       case status (sq :: SndQueue) of
-        Confirmed -> withVerifyKey sq $ \verifyKey ->
-          activateQueueJoining c connId sq verifyKey =<< resumeInterval
+        Confirmed -> pure ()
         Active -> throwError $ CONN SIMPLEX
         _ -> throwError $ INTERNAL "unexpected queue status"
     SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId
     SomeConn _ (ContactConnection _ rq) -> subscribeQueue c rq connId
-  where
-    resumeDelivery :: SndQueue -> m ()
-    resumeDelivery SndQueue {server} = do
-      wasDelivering <- resumeMsgDelivery c connId server
-      unless wasDelivering $ do
-        pending <- withStore (`getPendingMsgs` connId)
-        queuePendingMsgs c connId pending
-    withVerifyKey :: SndQueue -> (C.PublicKey -> m ()) -> m ()
-    withVerifyKey sq action =
-      let err = throwError $ INTERNAL "missing signing key public counterpart"
-       in maybe err action . C.publicKey $ signKey sq
-    activateSecuredQueue :: RcvQueue -> SndQueue -> C.PublicKey -> m ()
-    activateSecuredQueue rq sq verifyKey = do
-      activateQueueInitiating c connId sq verifyKey =<< resumeInterval
-      subscribeQueue c rq connId
-    resumeInterval :: m RetryInterval
-    resumeInterval = do
-      r <- asks $ retryInterval . config
-      pure r {initialInterval = 5_000_000}
 
 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> MsgBody -> m AgentMsgId
 sendMessage' c connId msg =
   withStore (`getConn` connId) >>= \case
-    SomeConn _ (DuplexConnection _ _ sq) -> enqueueMessage sq
-    SomeConn _ (SndConnection _ sq) -> enqueueMessage sq
+    SomeConn _ (DuplexConnection _ _ sq) -> enqueueMsg sq
+    SomeConn _ (SndConnection _ sq) -> enqueueMsg sq
     _ -> throwError $ CONN SIMPLEX
   where
-    enqueueMessage :: SndQueue -> m AgentMsgId
-    enqueueMessage SndQueue {server} = do
-      msgId <- storeSentMsg
-      wasDelivering <- resumeMsgDelivery c connId server
-      pending <-
-        if wasDelivering
-          then pure [PendingMsg {connId, msgId}]
-          else withStore (`getPendingMsgs` connId)
-      queuePendingMsgs c connId pending
-      pure $ unId msgId
-      where
-        storeSentMsg :: m InternalId
-        storeSentMsg = do
-          internalTs <- liftIO getCurrentTime
-          withStore $ \st -> do
-            (internalId, internalSndId, previousMsgHash) <- updateSndIds st connId
-            let msgBody =
-                  serializeSMPMessage
-                    SMPMessage
-                      { senderMsgId = unSndId internalSndId,
-                        senderTimestamp = internalTs,
-                        previousMsgHash,
-                        agentMessage = A_MSG msg
-                      }
-                internalHash = C.sha256Hash msgBody
-                msgData = SndMsgData {..}
-            createSndMsg st connId msgData
-            pure internalId
+    enqueueMsg :: SndQueue -> m AgentMsgId
+    enqueueMsg sq = enqueueMessage c connId sq $ A_MSG msg
 
-resumeMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SMPServer -> m Bool
-resumeMsgDelivery c connId srv = do
-  void $ resume srv (srvMsgDeliveries c) $ runSrvMsgDelivery c srv
-  resume connId (connMsgDeliveries c) $ runMsgDelivery c connId srv
+enqueueMessage :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> AMessage -> m AgentMsgId
+enqueueMessage c connId sq aMessage = do
+  resumeMsgDelivery c connId sq
+  msgId <- storeSentMsg
+  queuePendingMsgs c connId sq [msgId]
+  pure $ unId msgId
   where
-    resume :: Ord a => a -> TVar (Map a (Async ())) -> m () -> m Bool
-    resume key actionMap actionProcess = do
-      isDelivering <- isJust . M.lookup key <$> readTVarIO actionMap
-      unless isDelivering $
-        async actionProcess
-          >>= atomically . modifyTVar actionMap . M.insert key
-      pure isDelivering
+    storeSentMsg :: m InternalId
+    storeSentMsg = do
+      internalTs <- liftIO getCurrentTime
+      (internalId, internalSndId, prevMsgHash) <- withStore (`updateSndIds` connId)
+      let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
+          agentMessage = smpEncode $ AgentMessage privHeader aMessage
+          internalHash = C.sha256Hash agentMessage
 
-queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> [PendingMsg] -> m ()
-queuePendingMsgs c connId pending =
-  atomically $ getPendingMsgQ connId (connMsgQueues c) >>= forM_ pending . writeTQueue
+      encAgentMessage <- agentRatchetEncrypt connId agentMessage e2eEncUserMsgLength
+      let msgBody = smpEncode $ AgentMsgEnvelope {agentVersion = smpAgentVersion, encAgentMessage}
+          msgType = aMessageType aMessage
+          msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, internalHash, prevMsgHash}
+      withStore $ \st -> createSndMsg st connId msgData
+      pure internalId
 
-getPendingMsgQ :: Ord a => a -> TVar (Map a (TQueue PendingMsg)) -> STM (TQueue PendingMsg)
-getPendingMsgQ key queueMap = do
-  maybe newMsgQueue pure . M.lookup key =<< readTVar queueMap
+resumeMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> m ()
+resumeMsgDelivery c connId sq@SndQueue {server, sndId} = do
+  let qKey = (connId, server, sndId)
+  unlessM (queueDelivering qKey) $
+    async (runSmpQueueMsgDelivery c connId sq)
+      >>= atomically . modifyTVar (smpQueueMsgDeliveries c) . M.insert qKey
+  unlessM connQueued $
+    withStore (`getPendingMsgs` connId)
+      >>= queuePendingMsgs c connId sq
   where
-    newMsgQueue :: STM (TQueue PendingMsg)
-    newMsgQueue = do
+    queueDelivering qKey = isJust . M.lookup qKey <$> readTVarIO (smpQueueMsgDeliveries c)
+    connQueued =
+      atomically $
+        isJust
+          <$> stateTVar
+            (connMsgsQueued c)
+            (\m -> (M.lookup connId m, M.insert connId True m))
+
+queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> [InternalId] -> m ()
+queuePendingMsgs c connId sq msgIds = atomically $ do
+  q <- getPendingMsgQ c connId sq
+  mapM_ (writeTQueue q) msgIds
+
+getPendingMsgQ :: AgentClient -> ConnId -> SndQueue -> STM (TQueue InternalId)
+getPendingMsgQ c connId SndQueue {server, sndId} = do
+  let qKey = (connId, server, sndId)
+  maybe (newMsgQueue qKey) pure . M.lookup qKey =<< readTVar (smpQueueMsgQueues c)
+  where
+    newMsgQueue qKey = do
       mq <- newTQueue
-      modifyTVar queueMap $ M.insert key mq
+      modifyTVar (smpQueueMsgQueues c) $ M.insert qKey mq
       pure mq
 
-runMsgDelivery :: AgentMonad m => AgentClient -> ConnId -> SMPServer -> m ()
-runMsgDelivery c connId srv = do
-  mq <- atomically . getPendingMsgQ connId $ connMsgQueues c
-  smq <- atomically . getPendingMsgQ srv $ srvMsgQueues c
-  forever . atomically $ readTQueue mq >>= writeTQueue smq
-
-runSrvMsgDelivery :: forall m. AgentMonad m => AgentClient -> SMPServer -> m ()
-runSrvMsgDelivery c@AgentClient {subQ} srv = do
-  mq <- atomically . getPendingMsgQ srv $ srvMsgQueues c
+runSmpQueueMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> m ()
+runSmpQueueMsgDelivery c@AgentClient {subQ} connId sq = do
+  mq <- atomically $ getPendingMsgQ c connId sq
   ri <- asks $ reconnectInterval . config
   forever $ do
-    PendingMsg {connId, msgId} <- atomically $ readTQueue mq
+    msgId <- atomically $ readTQueue mq
     let mId = unId msgId
     withStore (\st -> E.try $ getPendingMsgData st connId msgId) >>= \case
       Left (e :: E.SomeException) ->
-        notify connId $ MERR mId (INTERNAL $ show e)
-      Right (sq, msgBody) -> do
-        withRetryInterval ri $ \loop -> do
+        notify $ MERR mId (INTERNAL $ show e)
+      Right (rq_, (msgType, msgBody, internalTs)) ->
+        withRetryInterval ri $ \loop ->
           tryError (sendAgentMessage c sq msgBody) >>= \case
-            Left e -> case e of
-              SMP SMP.QUOTA -> loop
-              SMP {} -> notify connId $ MERR mId e
-              CMD {} -> notify connId $ MERR mId e
-              _ -> loop
+            Left e -> do
+              case e of
+                SMP SMP.QUOTA -> loop
+                SMP SMP.AUTH -> case msgType of
+                  HELLO_ -> do
+                    helloTimeout <- asks $ helloTimeout . config
+                    currentTime <- liftIO getCurrentTime
+                    if diffUTCTime currentTime internalTs > helloTimeout
+                      then case rq_ of
+                        -- party initiating connection
+                        Just _ -> notifyDel msgId . ERR $ CONN NOT_AVAILABLE
+                        -- party joining connection
+                        _ -> notifyDel msgId . ERR $ CONN NOT_ACCEPTED
+                      else loop
+                  REPLY_ -> notifyDel msgId $ ERR e
+                  A_MSG_ -> notifyDel msgId $ MERR mId e
+                SMP (SMP.CMD _) -> notifyDel msgId $ MERR mId e
+                SMP SMP.LARGE_MSG -> notifyDel msgId $ MERR mId e
+                SMP {} -> notify (MERR mId e) >> loop
+                _ -> loop
             Right () -> do
-              notify connId $ SENT mId
-              withStore $ \st -> updateSndMsgStatus st connId msgId SndMsgSent
+              case msgType of
+                HELLO_ -> do
+                  withStore $ \st -> setSndQueueStatus st sq Active
+                  case rq_ of
+                    -- party initiating connection
+                    Just rq -> do
+                      subscribeQueue c rq connId
+                      notify CON
+                    -- party joining connection
+                    _ -> createReplyQueue c connId sq
+                A_MSG_ -> notify $ SENT mId
+                _ -> pure ()
+              delMsg msgId
   where
-    notify :: ConnId -> ACommand 'Agent -> m ()
-    notify connId cmd = atomically $ writeTBQueue subQ ("", connId, cmd)
+    delMsg :: InternalId -> m ()
+    delMsg msgId = withStore $ \st -> deleteMsg st connId msgId
+    notify :: ACommand 'Agent -> m ()
+    notify cmd = atomically $ writeTBQueue subQ ("", connId, cmd)
+    notifyDel :: InternalId -> ACommand 'Agent -> m ()
+    notifyDel msgId cmd = notify cmd >> delMsg msgId
 
 ackMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> AgentMsgId -> m ()
 ackMessage' c connId msgId = do
@@ -480,7 +464,7 @@ ackMessage' c connId msgId = do
       let mId = InternalId msgId
       withStore $ \st -> checkRcvMsg st connId mId
       sendAck c rq
-      withStore $ \st -> updateRcvMsgAck st connId mId
+      withStore $ \st -> deleteMsg st connId mId
 
 -- | Suspend SMP agent connection (OFF command) in Reader monad
 suspendConnection' :: AgentMonad m => AgentClient -> ConnId -> m ()
@@ -514,17 +498,6 @@ getSMPServer =
       i <- atomically . stateTVar gen $ randomR (0, L.length servers - 1)
       pure $ servers L.!! i
 
-sendControlMessage :: AgentMonad m => AgentClient -> SndQueue -> AMessage -> m ()
-sendControlMessage c sq agentMessage = do
-  senderTimestamp <- liftIO getCurrentTime
-  sendAgentMessage c sq . serializeSMPMessage $
-    SMPMessage
-      { senderMsgId = 0,
-        senderTimestamp,
-        previousMsgHash = "",
-        agentMessage
-      }
-
 subscriber :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
 subscriber c@AgentClient {msgQ} = forever $ do
   t <- atomically $ readTBQueue msgQ
@@ -541,21 +514,38 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
     _ -> atomically $ writeTBQueue subQ ("", "", ERR $ CONN NOT_FOUND)
   where
     processSMP :: SConnType c -> ConnData -> RcvQueue -> m ()
-    processSMP cType ConnData {connId} rq@RcvQueue {status} =
+    processSMP cType ConnData {connId} rq@RcvQueue {rcvDhSecret, e2ePrivKey, e2eDhSecret, status} =
       case cmd of
-        SMP.MSG srvMsgId srvTs msgBody -> do
+        SMP.MSG srvMsgId srvTs msgBody' -> handleNotifyAck $ do
           -- TODO deduplicate with previously received
-          msg <- decryptAndVerify rq msgBody
-          let msgHash = C.sha256Hash msg
-          case parseSMPMessage msg of
-            Left e -> notify (ERR e) >> sendAck c rq
-            Right (SMPConfirmation senderKey cInfo) -> smpConfirmation senderKey cInfo >> sendAck c rq
-            Right SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
-              case agentMessage of
-                HELLO verifyKey _ -> helloMsg verifyKey msgBody >> sendAck c rq
-                REPLY cReq -> replyMsg cReq >> sendAck c rq
-                A_MSG body -> agentClientMsg previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash
-                A_INV cReq cInfo -> smpInvitation cReq cInfo >> sendAck c rq
+          msgBody <- agentCbDecrypt rcvDhSecret (C.cbNonce srvMsgId) msgBody'
+          clientMsg@SMP.ClientMsgEnvelope {cmHeader = SMP.PubHeader phVer e2ePubKey_} <-
+            parseMessage msgBody
+          unless (phVer `isCompatible` SMP.smpClientVRange) . throwError $ AGENT A_VERSION
+          case (e2eDhSecret, e2ePubKey_) of
+            (Nothing, Just e2ePubKey) -> do
+              let e2eDh = C.dh' e2ePubKey e2ePrivKey
+              decryptClientMessage e2eDh clientMsg >>= \case
+                (SMP.PHConfirmation senderKey, AgentConfirmation {e2eEncryption, encConnInfo}) ->
+                  smpConfirmation senderKey e2ePubKey e2eEncryption encConnInfo >> ack
+                (SMP.PHEmpty, AgentInvitation {connReq, connInfo}) ->
+                  smpInvitation connReq connInfo >> ack
+                _ -> prohibited >> ack
+            (Just e2eDh, Nothing) -> do
+              decryptClientMessage e2eDh clientMsg >>= \case
+                (SMP.PHEmpty, AgentMsgEnvelope _ encAgentMsg) -> do
+                  agentMsgBody <- agentRatchetDecrypt connId encAgentMsg
+                  parseMessage agentMsgBody >>= \case
+                    AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage -> do
+                      (msgId, msgMeta) <- agentClientMsg prevMsgHash sndMsgId (srvMsgId, systemToUTCTime srvTs) agentMsgBody aMessage
+                      case aMessage of
+                        HELLO -> helloMsg >> ack >> withStore (\st -> deleteMsg st connId msgId)
+                        REPLY cReq -> replyMsg cReq >> ack >> withStore (\st -> deleteMsg st connId msgId)
+                        -- note that there is no ACK sent here, it is sent with agent's user ACK command
+                        A_MSG body -> notify $ MSG msgMeta body
+                    _ -> prohibited >> ack
+                _ -> prohibited >> ack
+            _ -> prohibited >> ack
         SMP.END -> do
           removeSubscription c connId
           logServer "<--" c srv rId "END"
@@ -567,64 +557,101 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
         notify :: ACommand 'Agent -> m ()
         notify msg = atomically $ writeTBQueue subQ ("", connId, msg)
 
+        handleNotifyAck :: m () -> m ()
+        handleNotifyAck m = m `catchError` \e -> notify (ERR e) >> ack
+
         prohibited :: m ()
         prohibited = notify . ERR $ AGENT A_PROHIBITED
 
-        smpConfirmation :: SenderPublicKey -> ConnInfo -> m ()
-        smpConfirmation senderKey cInfo = do
-          logServer "<--" c srv rId "MSG <KEY>"
+        ack :: m ()
+        ack = sendAck c rq
+
+        decryptClientMessage :: C.DhSecretX25519 -> SMP.ClientMsgEnvelope -> m (SMP.PrivHeader, AgentMsgEnvelope)
+        decryptClientMessage e2eDh SMP.ClientMsgEnvelope {cmNonce, cmEncBody} = do
+          clientMsg <- agentCbDecrypt e2eDh cmNonce cmEncBody
+          SMP.ClientMessage privHeader clientBody <- parseMessage clientMsg
+          agentEnvelope <- parseMessage clientBody
+          if agentVersion agentEnvelope `isCompatible` smpAgentVRange
+            then pure (privHeader, agentEnvelope)
+            else throwError $ AGENT A_VERSION
+
+        parseMessage :: Encoding a => ByteString -> m a
+        parseMessage = liftEither . parse smpP (AGENT A_MESSAGE)
+
+        smpConfirmation :: C.APublicVerifyKey -> C.PublicKeyX25519 -> Maybe (CR.E2ERatchetParams 'C.X448) -> ByteString -> m ()
+        smpConfirmation senderKey e2ePubKey e2eEncryption encConnInfo = do
+          logServer "<--" c srv rId "MSG <CONF>"
           case status of
-            New -> case cType of
-              SCRcv -> do
-                g <- asks idsDrg
-                let newConfirmation = NewConfirmation {connId, senderKey, senderConnInfo = cInfo}
-                confId <- withStore $ \st -> createConfirmation st g newConfirmation
-                notify $ CONF confId cInfo
-              SCDuplex -> do
-                notify $ INFO cInfo
-                processConfirmation c rq senderKey
+            New -> case (cType, e2eEncryption) of
+              (SCRcv, Just e2eSndParams) -> do
+                (pk1, rcDHRs) <- withStore $ \st -> getRatchetX3dhKeys st connId
+                let rc = CR.initRcvRatchet rcDHRs $ CR.x3dhRcv pk1 rcDHRs e2eSndParams
+                (agentMsgBody_, rc', skipped) <- liftError cryptoError $ CR.rcDecrypt rc M.empty encConnInfo
+                case (agentMsgBody_, skipped) of
+                  (Right agentMsgBody, CR.SMDNoChange) ->
+                    parseMessage agentMsgBody >>= \case
+                      AgentConnInfo connInfo -> do
+                        g <- asks idsDrg
+                        let senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo}
+                            newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'}
+                        confId <- withStore $ \st -> createConfirmation st g newConfirmation
+                        notify $ CONF confId connInfo
+                      _ -> prohibited
+                  _ -> prohibited
+              (SCDuplex, Nothing) -> do
+                agentRatchetDecrypt connId encConnInfo >>= parseMessage >>= \case
+                  AgentConnInfo connInfo -> do
+                    notify $ INFO connInfo
+                    processConfirmation c rq $ SMPConfirmation {senderKey, e2ePubKey, connInfo}
+                  _ -> prohibited
               _ -> prohibited
             _ -> prohibited
 
-        helloMsg :: SenderPublicKey -> ByteString -> m ()
-        helloMsg verifyKey msgBody = do
+        helloMsg :: m ()
+        helloMsg = do
           logServer "<--" c srv rId "MSG <HELLO>"
           case status of
             Active -> prohibited
             _ -> do
-              void $ verifyMessage (Just verifyKey) msgBody
-              withStore $ \st -> setRcvQueueActive st rq verifyKey
+              withStore $ \st -> setRcvQueueStatus st rq Active
               case cType of
                 SCDuplex -> notifyConnected c connId
                 _ -> pure ()
 
-        replyMsg :: ConnectionRequest 'CMInvitation -> m ()
-        replyMsg (CRInvitation (ConnReqData _ (qUri :| _) encryptKey)) = do
+        replyMsg :: L.NonEmpty SMPQueueInfo -> m ()
+        replyMsg (qInfo :| _) = do
           logServer "<--" c srv rId "MSG <REPLY>"
           case cType of
             SCRcv -> do
               AcceptedConfirmation {ownConnInfo} <- withStore (`getAcceptedConfirmation` connId)
-              (sq, senderKey, verifyKey) <- newSndQueue qUri encryptKey
-              withStore $ \st -> upgradeRcvConnToDuplex st connId sq
-              confirmQueue c sq senderKey ownConnInfo
-              withStore (`removeConfirmations` connId)
-              cfg <- asks config
-              activateQueueInitiating c connId sq verifyKey $ retryInterval cfg
+              case qInfo `proveCompatible` SMP.smpClientVRange of
+                Nothing -> notify . ERR $ AGENT A_VERSION
+                Just qInfo' -> do
+                  (sq, smpConf) <- newSndQueue qInfo' ownConnInfo
+                  liftIO $ print "before: upgradeRcvConnToDuplex st connId sq"
+                  withStore $ \st -> upgradeRcvConnToDuplex st connId sq
+                  confirmQueue c connId sq smpConf Nothing
+                  liftIO $ print "before: `removeConfirmations` connId"
+                  withStore (`removeConfirmations` connId)
+                  liftIO $ print "after: `removeConfirmations` connId"
+                  void $ enqueueMessage c connId sq HELLO
             _ -> prohibited
 
-        agentClientMsg :: PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m ()
-        agentClientMsg externalPrevSndHash sender broker msgBody internalHash = do
+        agentClientMsg :: PrevRcvMsgHash -> ExternalSndId -> (BrokerId, BrokerTs) -> MsgBody -> AMessage -> m (InternalId, MsgMeta)
+        agentClientMsg externalPrevSndHash sndMsgId broker msgBody aMessage = do
           logServer "<--" c srv rId "MSG <MSG>"
+          let internalHash = C.sha256Hash msgBody
           internalTs <- liftIO getCurrentTime
           (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore (`updateRcvIds` connId)
-          let integrity = checkMsgIntegrity prevExtSndId (fst sender) prevRcvMsgHash externalPrevSndHash
+          let integrity = checkMsgIntegrity prevExtSndId sndMsgId prevRcvMsgHash externalPrevSndHash
               recipient = (unId internalId, internalTs)
-              msgMeta = MsgMeta {integrity, recipient, sender, broker}
-              rcvMsg = RcvMsgData {..}
+              msgMeta = MsgMeta {integrity, recipient, broker, sndMsgId}
+              msgType = aMessageType aMessage
+              rcvMsg = RcvMsgData {msgMeta, msgType, msgBody, internalRcvId, internalHash, externalPrevSndHash}
           withStore $ \st -> createRcvMsg st connId rcvMsg
-          notify $ MSG msgMeta msgBody
+          pure (internalId, msgMeta)
 
-        smpInvitation :: ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
+        smpInvitation :: ConnectionRequestUri 'CMInvitation -> ConnInfo -> m ()
         smpInvitation connReq cInfo = do
           logServer "<--" c srv rId "MSG <KEY>"
           case cType of
@@ -644,49 +671,60 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
           | internalPrevMsgHash /= receivedPrevMsgHash = MsgError MsgBadHash
           | otherwise = MsgError MsgDuplicate -- this case is not possible
 
-confirmQueue :: AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> ConnInfo -> m ()
-confirmQueue c sq senderKey cInfo = do
-  sendConfirmation c sq senderKey cInfo
+confirmQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> SMPConfirmation -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
+confirmQueue c connId sq SMPConfirmation {senderKey, e2ePubKey, connInfo} e2eEncryption = do
+  msg <- mkConfirmation
+  sendConfirmation c sq msg
   withStore $ \st -> setSndQueueStatus st sq Confirmed
-
-activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
-activateQueueInitiating c connId sq verifyKey retryInterval =
-  activateQueue c connId sq verifyKey retryInterval $ notifyConnected c connId
-
-activateQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m () -> m ()
-activateQueue c connId sq verifyKey retryInterval afterActivation =
-  getActivation c connId >>= \case
-    Nothing -> async runActivation >>= addActivation c connId
-    Just _ -> pure ()
   where
-    runActivation :: m ()
-    runActivation = do
-      sendHello c sq verifyKey retryInterval
-      withStore $ \st -> setSndQueueStatus st sq Active
-      removeActivation c connId
-      removeVerificationKey
-      afterActivation
-    removeVerificationKey :: m ()
-    removeVerificationKey =
-      let safeSignKey = C.removePublicKey $ signKey sq
-       in withStore $ \st -> updateSignKey st sq safeSignKey
+    mkConfirmation :: m MsgBody
+    mkConfirmation = do
+      encConnInfo <- agentRatchetEncrypt connId (smpEncode $ AgentConnInfo connInfo) e2eEncConnInfoLength
+      let agentEnvelope = AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo}
+      agentCbEncrypt sq (Just e2ePubKey) . smpEncode $
+        SMP.ClientMessage (SMP.PHConfirmation senderKey) $ smpEncode agentEnvelope
+
+-- encoded AgentMessage -> encoded EncAgentMessage
+agentRatchetEncrypt :: AgentMonad m => ConnId -> ByteString -> Int -> m ByteString
+agentRatchetEncrypt connId msg paddedLen = do
+  rc <- withStore $ \st -> getRatchet st connId
+  (encMsg, rc') <- liftError cryptoError $ CR.rcEncrypt rc paddedLen msg
+  withStore $ \st -> updateRatchet st connId rc' CR.SMDNoChange
+  pure encMsg
+
+-- encoded EncAgentMessage -> encoded AgentMessage
+agentRatchetDecrypt :: AgentMonad m => ConnId -> ByteString -> m ByteString
+agentRatchetDecrypt connId encAgentMsg = do
+  (rc, skipped) <- withStore $ \st ->
+    (,) <$> getRatchet st connId <*> getSkippedMsgKeys st connId
+  (agentMsgBody_, rc', skippedDiff) <- liftError cryptoError $ CR.rcDecrypt rc skipped encAgentMsg
+  withStore $ \st -> updateRatchet st connId rc' skippedDiff
+  liftEither $ first cryptoError agentMsgBody_
 
 notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m ()
 notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON)
 
-newSndQueue ::
-  (MonadUnliftIO m, MonadReader Env m) => SMPQueueUri -> EncryptionKey -> m (SndQueue, SenderPublicKey, VerificationKey)
-newSndQueue (SMPQueueUri smpServer senderId _) encryptKey = do
-  size <- asks $ rsaKeySize . config
-  (senderKey, sndPrivateKey) <- liftIO $ C.generateKeyPair size
-  (verifyKey, signKey) <- liftIO $ C.generateKeyPair size
+newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => Compatible SMPQueueInfo -> ConnInfo -> m (SndQueue, SMPConfirmation)
+newSndQueue qInfo cInfo =
+  asks (cmdSignAlg . config) >>= \case
+    C.SignAlg a -> newSndQueue_ a qInfo cInfo
+
+newSndQueue_ ::
+  (C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m) =>
+  C.SAlgorithm a ->
+  Compatible SMPQueueInfo ->
+  ConnInfo ->
+  m (SndQueue, SMPConfirmation)
+newSndQueue_ a (Compatible (SMPQueueInfo _clientVersion smpServer senderId rcvE2ePubDhKey)) cInfo = do
+  -- this function assumes clientVersion is compatible - it was tested before
+  (senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
+  (e2ePubKey, e2ePrivKey) <- liftIO C.generateKeyPair'
   let sndQueue =
         SndQueue
           { server = smpServer,
             sndId = senderId,
             sndPrivateKey,
-            encryptKey,
-            signKey,
+            e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
             status = New
           }
-  return (sndQueue, senderKey, verifyKey)
+  pure (sndQueue, SMPConfirmation senderKey e2ePubKey cInfo)

src/Simplex/Messaging/Agent/Client.hs

@@ -2,10 +2,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Simplex.Messaging.Agent.Client
   ( AgentClient (..),
@@ -19,30 +23,27 @@ module Simplex.Messaging.Agent.Client
     sendConfirmation,
     sendInvitation,
     RetryInterval (..),
-    sendHello,
     secureQueue,
     sendAgentMessage,
-    decryptAndVerify,
-    verifyMessage,
+    agentCbEncrypt,
+    agentCbDecrypt,
+    cryptoError,
     sendAck,
     suspendQueue,
     deleteQueue,
     logServer,
     removeSubscription,
-    cryptoError,
-    addActivation,
-    getActivation,
-    removeActivation,
   )
 where
 
+import Control.Concurrent (forkIO)
 import Control.Concurrent.Async (Async, async, uninterruptibleCancel)
 import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
-import Control.Monad.Trans.Except
+import Data.Bifunctor (first)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -52,31 +53,33 @@ import Data.Maybe (isNothing)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text.Encoding
-import Data.Time.Clock
-import Simplex.Messaging.Agent.Env.SQLite
+import Simplex.Messaging.Agent.Env.Postgres
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgBody, QueueId, SenderPublicKey)
-import Simplex.Messaging.Util (bshow, liftEitherError, liftError)
-import UnliftIO.Exception (IOException)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Protocol (QueueId, QueueIdsKeys (..), SndPublicVerifyKey)
+import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Util (bshow, liftEitherError, liftError, liftIOEither, tryError)
+import Simplex.Messaging.Version
+import UnliftIO.Exception (Exception, IOException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
+type SMPClientVar = TMVar (Either AgentErrorType SMPClient)
+
 data AgentClient = AgentClient
   { rcvQ :: TBQueue (ATransmission 'Client),
     subQ :: TBQueue (ATransmission 'Agent),
     msgQ :: TBQueue SMPServerTransmission,
-    smpClients :: TVar (Map SMPServer SMPClient),
+    smpClients :: TVar (Map SMPServer SMPClientVar),
     subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
     subscrConns :: TVar (Map ConnId SMPServer),
-    activations :: TVar (Map ConnId (Async ())), -- activations of send queues in progress
-    connMsgQueues :: TVar (Map ConnId (TQueue PendingMsg)),
-    connMsgDeliveries :: TVar (Map ConnId (Async ())),
-    srvMsgQueues :: TVar (Map SMPServer (TQueue PendingMsg)),
-    srvMsgDeliveries :: TVar (Map SMPServer (Async ())),
+    connMsgsQueued :: TVar (Map ConnId Bool),
+    smpQueueMsgQueues :: TVar (Map (ConnId, SMPServer, SMP.SenderId) (TQueue InternalId)),
+    smpQueueMsgDeliveries :: TVar (Map (ConnId, SMPServer, SMP.SenderId) (Async ())),
     reconnections :: TVar [Async ()],
     clientId :: Int,
     agentEnv :: Env,
@@ -93,30 +96,57 @@ newAgentClient agentEnv = do
   smpClients <- newTVar M.empty
   subscrSrvrs <- newTVar M.empty
   subscrConns <- newTVar M.empty
-  activations <- newTVar M.empty
-  connMsgQueues <- newTVar M.empty
-  connMsgDeliveries <- newTVar M.empty
-  srvMsgQueues <- newTVar M.empty
-  srvMsgDeliveries <- newTVar M.empty
+  connMsgsQueued <- newTVar M.empty
+  smpQueueMsgQueues <- newTVar M.empty
+  smpQueueMsgDeliveries <- newTVar M.empty
   reconnections <- newTVar []
   clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1)
   lock <- newTMVar ()
-  return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, activations, connMsgQueues, connMsgDeliveries, srvMsgQueues, srvMsgDeliveries, reconnections, clientId, agentEnv, smpSubscriber = undefined, lock}
+  return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, clientId, agentEnv, smpSubscriber = undefined, lock}
 
 -- | Agent monad with MonadReader Env and MonadError AgentErrorType
 type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)
 
+newtype InternalException e = InternalException {unInternalException :: e}
+  deriving (Eq, Show)
+
+instance Exception e => Exception (InternalException e)
+
+instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where
+  withRunInIO :: ((forall a. ExceptT e m a -> IO a) -> IO b) -> ExceptT e m b
+  withRunInIO exceptToIO =
+    withExceptT unInternalException . ExceptT . E.try $
+      withRunInIO $ \run ->
+        exceptToIO $ run . (either (E.throwIO . InternalException) return <=< runExceptT)
+
 getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPServer -> m SMPClient
 getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
-  readTVarIO smpClients
-    >>= maybe newSMPClient return . M.lookup srv
+  atomically getClientVar >>= either newSMPClient waitForSMPClient
   where
-    newSMPClient :: m SMPClient
-    newSMPClient = do
-      smp <- connectClient
-      logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
-      atomically . modifyTVar smpClients $ M.insert srv smp
-      return smp
+    getClientVar :: STM (Either SMPClientVar SMPClientVar)
+    getClientVar = maybe (Left <$> newClientVar) (pure . Right) . M.lookup srv =<< readTVar smpClients
+
+    newClientVar :: STM SMPClientVar
+    newClientVar = do
+      smpVar <- newEmptyTMVar
+      modifyTVar smpClients $ M.insert srv smpVar
+      pure smpVar
+
+    waitForSMPClient :: TMVar (Either AgentErrorType SMPClient) -> m SMPClient
+    waitForSMPClient = liftIOEither . atomically . readTMVar
+
+    newSMPClient :: TMVar (Either AgentErrorType SMPClient) -> m SMPClient
+    newSMPClient smpVar =
+      tryError connectClient >>= \r -> case r of
+        Right smp -> do
+          logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
+          atomically $ putTMVar smpVar r
+          pure smp
+        Left e -> do
+          atomically $ do
+            putTMVar smpVar r
+            modifyTVar smpClients $ M.delete srv
+          throwError e
 
     connectClient :: m SMPClient
     connectClient = do
@@ -175,13 +205,16 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
 closeAgentClient :: MonadUnliftIO m => AgentClient -> m ()
 closeAgentClient c = liftIO $ do
   closeSMPServerClients c
-  cancelActions $ activations c
   cancelActions $ reconnections c
-  cancelActions $ connMsgDeliveries c
-  cancelActions $ srvMsgDeliveries c
+  cancelActions $ smpQueueMsgDeliveries c
 
 closeSMPServerClients :: AgentClient -> IO ()
-closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ closeSMPClient
+closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ (forkIO . closeClient)
+  where
+    closeClient smpVar =
+      atomically (readTMVar smpVar) >>= \case
+        Right smp -> closeSMPClient smp `E.catch` \(_ :: E.SomeException) -> pure ()
+        _ -> pure ()
 
 cancelActions :: Foldable f => TVar (f (Async ())) -> IO ()
 cancelActions as = readTVarIO as >>= mapM_ uninterruptibleCancel
@@ -227,25 +260,37 @@ smpClientError = \case
   SMPTransportError e -> BROKER $ TRANSPORT e
   e -> INTERNAL $ show e
 
-newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri, EncryptionKey)
-newRcvQueue c srv = do
-  size <- asks $ rsaKeySize . config
-  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateKeyPair size
+newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri)
+newRcvQueue c srv =
+  asks (cmdSignAlg . config) >>= \case
+    C.SignAlg a -> newRcvQueue_ a c srv
+
+newRcvQueue_ ::
+  (C.SignatureAlgorithm a, C.AlgorithmI a, AgentMonad m) =>
+  C.SAlgorithm a ->
+  AgentClient ->
+  SMPServer ->
+  m (RcvQueue, SMPQueueUri)
+newRcvQueue_ a c srv = do
+  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
+  (dhKey, privDhKey) <- liftIO C.generateKeyPair'
+  (e2eDhKey, e2ePrivKey) <- liftIO C.generateKeyPair'
   logServer "-->" c srv "" "NEW"
-  (rcvId, sId) <- withSMP c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey
-  logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sId]
-  (encryptKey, decryptKey) <- liftIO $ C.generateKeyPair size
+  QIK {rcvId, sndId, rcvPublicDhKey} <-
+    withSMP c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey dhKey
+  logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
   let rq =
         RcvQueue
           { server = srv,
             rcvId,
             rcvPrivateKey,
-            sndId = Just sId,
-            decryptKey,
-            verifyKey = Nothing,
+            rcvDhSecret = C.dh' rcvPublicDhKey privDhKey,
+            e2ePrivKey,
+            e2eDhSecret = Nothing,
+            sndId = Just sndId,
             status = New
           }
-  pure (rq, SMPQueueUri srv sId reservedServerKey, encryptKey)
+  pure (rq, SMPQueueUri srv sndId SMP.smpClientVRange e2eDhKey)
 
 subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
 subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
@@ -275,72 +320,37 @@ removeSubscription AgentClient {subscrConns, subscrSrvrs} connId = atomically $
       let cs' = M.delete connId cs
        in if M.null cs' then Nothing else Just cs'
 
-addActivation :: MonadUnliftIO m => AgentClient -> ConnId -> Async () -> m ()
-addActivation c connId a = atomically . modifyTVar (activations c) $ M.insert connId a
-
-getActivation :: MonadUnliftIO m => AgentClient -> ConnId -> m (Maybe (Async ()))
-getActivation c connId = M.lookup connId <$> readTVarIO (activations c)
-
-removeActivation :: MonadUnliftIO m => AgentClient -> ConnId -> m ()
-removeActivation c connId = atomically . modifyTVar (activations c) $ M.delete connId
-
 logServer :: AgentMonad m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m ()
 logServer dir AgentClient {clientId} srv qId cmdStr =
   logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret qId, cmdStr]
 
 showServer :: SMPServer -> ByteString
-showServer srv = B.pack $ host srv <> maybe "" (":" <>) (port srv)
+showServer SMPServer {host, port} =
+  B.pack $ host <> if null port then "" else ':' : port
 
 logSecret :: ByteString -> ByteString
 logSecret bs = encode $ B.take 3 bs
 
-sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> ConnInfo -> m ()
-sendConfirmation c sq@SndQueue {server, sndId} senderKey cInfo =
-  withLogSMP_ c server sndId "SEND <KEY>" $ \smp -> do
-    msg <- mkConfirmation smp
-    liftSMP $ sendSMPMessage smp Nothing sndId msg
-  where
-    mkConfirmation :: SMPClient -> m MsgBody
-    mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey cInfo
+-- TODO maybe package E2ERatchetParams into SMPConfirmation
+sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
+sendConfirmation c SndQueue {server, sndId} encConfirmation =
+  withLogSMP_ c server sndId "SEND <CONF>" $ \smp ->
+    liftSMP $ sendSMPMessage smp Nothing sndId encConfirmation
 
-sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> RetryInterval -> m ()
-sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey ri =
-  withLogSMP_ c server sndId "SEND <HELLO> (retrying)" $ \smp -> do
-    msg <- mkHello smp $ AckMode On
-    liftSMP . withRetryInterval ri $ \loop ->
-      sendSMPMessage smp (Just sndPrivateKey) sndId msg `catchE` \case
-        SMPServerError AUTH -> loop
-        e -> throwE e
-  where
-    mkHello :: SMPClient -> AckMode -> m ByteString
-    mkHello smp ackMode = do
-      senderTimestamp <- liftIO getCurrentTime
-      encryptAndSign smp sq . serializeSMPMessage $
-        SMPMessage
-          { senderMsgId = 0,
-            senderTimestamp,
-            previousMsgHash = "",
-            agentMessage = HELLO verifyKey ackMode
-          }
-
-sendInvitation :: forall m. AgentMonad m => AgentClient -> SMPQueueUri -> EncryptionKey -> ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
-sendInvitation c SMPQueueUri {smpServer, senderId} encryptKey cReq connInfo = do
+sendInvitation :: forall m. AgentMonad m => AgentClient -> Compatible SMPQueueInfo -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> m ()
+sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) connReq connInfo =
   withLogSMP_ c smpServer senderId "SEND <INV>" $ \smp -> do
-    msg <- mkInvitation smp
+    msg <- mkInvitation
     liftSMP $ sendSMPMessage smp Nothing senderId msg
   where
-    mkInvitation :: SMPClient -> m ByteString
-    mkInvitation smp = do
-      senderTimestamp <- liftIO getCurrentTime
-      encryptUnsigned smp encryptKey . serializeSMPMessage $
-        SMPMessage
-          { senderMsgId = 0,
-            senderTimestamp,
-            previousMsgHash = "",
-            agentMessage = A_INV cReq connInfo
-          }
+    mkInvitation :: m ByteString
+    -- this is only encrypted with per-queue E2E, not with double ratchet
+    mkInvitation = do
+      let agentEnvelope = AgentInvitation {agentVersion = smpAgentVersion, connReq, connInfo}
+      agentCbEncryptOnce dhPublicKey . smpEncode $
+        SMP.ClientMessage SMP.PHEmpty $ smpEncode agentEnvelope
 
-secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
+secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SndPublicVerifyKey -> m ()
 secureQueue c RcvQueue {server, rcvId, rcvPrivateKey} senderKey =
   withLogSMP c server rcvId "KEY <key>" $ \smp ->
     secureSMPQueue smp rcvPrivateKey rcvId senderKey
@@ -360,48 +370,49 @@ deleteQueue c RcvQueue {server, rcvId, rcvPrivateKey} =
   withLogSMP c server rcvId "DEL" $ \smp ->
     deleteSMPQueue smp rcvPrivateKey rcvId
 
-sendAgentMessage :: AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
-sendAgentMessage c sq@SndQueue {server, sndId, sndPrivateKey} msg =
-  withLogSMP_ c server sndId "SEND <message>" $ \smp -> do
-    msg' <- encryptAndSign smp sq msg
-    liftSMP $ sendSMPMessage smp (Just sndPrivateKey) sndId msg'
+-- TODO this is just wrong
+sendAgentMessage :: forall m. AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
+sendAgentMessage c sq@SndQueue {server, sndId, sndPrivateKey} agentMsg =
+  withLogSMP_ c server sndId "SEND <MSG>" $ \smp -> do
+    let clientMsg = SMP.ClientMessage SMP.PHEmpty agentMsg
+    msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
+    liftSMP $ sendSMPMessage smp (Just sndPrivateKey) sndId msg
 
-encryptAndSign :: AgentMonad m => SMPClient -> SndQueue -> ByteString -> m ByteString
-encryptAndSign smp SndQueue {encryptKey, signKey} msg = do
-  paddedSize <- asks $ (blockSize smp -) . reservedMsgSize
-  liftError cryptoError $ do
-    enc <- C.encrypt encryptKey paddedSize msg
-    C.Signature sig <- C.sign signKey enc
-    pure $ sig <> enc
+agentCbEncrypt :: AgentMonad m => SndQueue -> Maybe C.PublicKeyX25519 -> ByteString -> m ByteString
+agentCbEncrypt SndQueue {e2eDhSecret} e2ePubKey msg = do
+  cmNonce <- liftIO C.randomCbNonce
+  let paddedLen = maybe SMP.e2eEncMessageLength (const SMP.e2eEncConfirmationLength) e2ePubKey
+  cmEncBody <-
+    liftEither . first cryptoError $
+      C.cbEncrypt e2eDhSecret cmNonce msg paddedLen
+  -- TODO per-queue client version
+  let cmHeader = SMP.PubHeader (maxVersion SMP.smpClientVRange) e2ePubKey
+  pure $ smpEncode SMP.ClientMsgEnvelope {cmHeader, cmNonce, cmEncBody}
 
-decryptAndVerify :: AgentMonad m => RcvQueue -> ByteString -> m ByteString
-decryptAndVerify RcvQueue {decryptKey, verifyKey} msg =
-  verifyMessage verifyKey msg
-    >>= liftError cryptoError . C.decrypt decryptKey
+-- add encoding as AgentInvitation'?
+agentCbEncryptOnce :: AgentMonad m => C.PublicKeyX25519 -> ByteString -> m ByteString
+agentCbEncryptOnce dhRcvPubKey msg = do
+  (dhSndPubKey, dhSndPrivKey) <- liftIO C.generateKeyPair'
+  let e2eDhSecret = C.dh' dhRcvPubKey dhSndPrivKey
+  cmNonce <- liftIO C.randomCbNonce
+  cmEncBody <-
+    liftEither . first cryptoError $
+      C.cbEncrypt e2eDhSecret cmNonce msg SMP.e2eEncConfirmationLength
+  -- TODO per-queue client version
+  let cmHeader = SMP.PubHeader (maxVersion SMP.smpClientVRange) (Just dhSndPubKey)
+  pure $ smpEncode SMP.ClientMsgEnvelope {cmHeader, cmNonce, cmEncBody}
 
-encryptUnsigned :: AgentMonad m => SMPClient -> EncryptionKey -> ByteString -> m ByteString
-encryptUnsigned smp encryptKey msg = do
-  paddedSize <- asks $ (blockSize smp -) . reservedMsgSize
-  size <- asks $ rsaKeySize . config
-  liftError cryptoError $ do
-    enc <- C.encrypt encryptKey paddedSize msg
-    let sig = B.replicate size ' '
-    pure $ sig <> enc
-
-verifyMessage :: AgentMonad m => Maybe VerificationKey -> ByteString -> m ByteString
-verifyMessage verifyKey msg = do
-  size <- asks $ rsaKeySize . config
-  let (sig, enc) = B.splitAt size msg
-  case verifyKey of
-    Nothing -> pure enc
-    Just k
-      | C.verify k (C.Signature sig) enc -> pure enc
-      | otherwise -> throwError $ AGENT A_SIGNATURE
+-- | NaCl crypto-box decrypt - both for messages received from the server
+-- and per-queue E2E encrypted messages from the sender that were inside.
+agentCbDecrypt :: AgentMonad m => C.DhSecretX25519 -> C.CbNonce -> ByteString -> m ByteString
+agentCbDecrypt dhSecret nonce msg =
+  liftEither . first cryptoError $
+    C.cbDecrypt dhSecret nonce msg
 
 cryptoError :: C.CryptoError -> AgentErrorType
 cryptoError = \case
   C.CryptoLargeMsgError -> CMD LARGE
-  C.RSADecryptError _ -> AGENT A_ENCRYPTION
   C.CryptoHeaderError _ -> AGENT A_ENCRYPTION
   C.AESDecryptError -> AGENT A_ENCRYPTION
+  C.CBDecryptError -> AGENT A_ENCRYPTION
   e -> INTERNAL $ show e

src/Simplex/Messaging/Agent/Env/Postgres.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
+
+module Simplex.Messaging.Agent.Env.Postgres
+  ( AgentConfig (..),
+    defaultAgentConfig,
+    Env (..),
+    newSMPAgentEnv,
+  )
+where
+
+import Control.Monad.IO.Unlift
+import Crypto.Random
+import Data.List.NonEmpty (NonEmpty)
+import Data.Time.Clock (NominalDiffTime, nominalDay)
+import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
+import Network.Socket
+import Numeric.Natural
+import Simplex.Messaging.Agent.Protocol (SMPServer)
+import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Agent.Store.Postgres
+import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
+import Simplex.Messaging.Client
+import qualified Simplex.Messaging.Crypto as C
+import System.Random (StdGen, newStdGen)
+import UnliftIO.STM
+
+data AgentConfig = AgentConfig
+  { tcpPort :: ServiceName,
+    smpServers :: NonEmpty SMPServer,
+    cmdSignAlg :: C.SignAlg,
+    connIdBytes :: Int,
+    tbqSize :: Natural,
+    dbConnInfo :: ConnectInfo,
+    dbPoolSize :: Int,
+    smpCfg :: SMPClientConfig,
+    reconnectInterval :: RetryInterval,
+    helloTimeout :: NominalDiffTime,
+    caCertificateFile :: FilePath,
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath
+  }
+
+defaultAgentConfig :: AgentConfig
+defaultAgentConfig =
+  AgentConfig
+    { tcpPort = "5224",
+      smpServers = undefined, -- TODO move it elsewhere?
+      cmdSignAlg = C.SignAlg C.SEd448,
+      connIdBytes = 12,
+      tbqSize = 16,
+      dbConnInfo = defaultConnectInfo {connectDatabase = "agent_poc_1"},
+      dbPoolSize = 4,
+      smpCfg = smpDefaultConfig,
+      reconnectInterval =
+        RetryInterval
+          { initialInterval = second,
+            increaseAfter = 10 * second,
+            maxInterval = 10 * second
+          },
+      helloTimeout = 7 * nominalDay,
+      -- CA certificate private key is not needed for initialization
+      -- ! we do not generate these
+      caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
+      privateKeyFile = "/etc/opt/simplex-agent/agent.key",
+      certificateFile = "/etc/opt/simplex-agent/agent.crt"
+    }
+  where
+    second = 1_000_000
+
+data Env = Env
+  { config :: AgentConfig,
+    store :: PostgresStore,
+    idsDrg :: TVar ChaChaDRG,
+    clientCounter :: TVar Int,
+    randomServer :: TVar StdGen
+  }
+
+newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env
+newSMPAgentEnv cfg@AgentConfig {dbConnInfo, dbPoolSize} = do
+  idsDrg <- newTVarIO =<< drgNew
+  store <- liftIO $ createPostgresStore dbConnInfo dbPoolSize Migrations.app
+  clientCounter <- newTVarIO 0
+  randomServer <- newTVarIO =<< liftIO newStdGen
+  return Env {config = cfg, store, idsDrg, clientCounter, randomServer}

src/Simplex/Messaging/Agent/Env/SQLite.hs

@@ -4,11 +4,18 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
-module Simplex.Messaging.Agent.Env.SQLite where
+module Simplex.Messaging.Agent.Env.SQLite
+  ( AgentConfig (..),
+    defaultAgentConfig,
+    Env (..),
+    newSMPAgentEnv,
+  )
+where
 
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.List.NonEmpty (NonEmpty)
+import Data.Time.Clock (NominalDiffTime, nominalDay)
 import Network.Socket
 import Numeric.Natural
 import Simplex.Messaging.Agent.Protocol (SMPServer)
@@ -16,56 +23,58 @@ import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Client
+import qualified Simplex.Messaging.Crypto as C
 import System.Random (StdGen, newStdGen)
 import UnliftIO.STM
 
 data AgentConfig = AgentConfig
   { tcpPort :: ServiceName,
     smpServers :: NonEmpty SMPServer,
-    rsaKeySize :: Int,
+    cmdSignAlg :: C.SignAlg,
     connIdBytes :: Int,
     tbqSize :: Natural,
     dbFile :: FilePath,
     dbPoolSize :: Int,
     smpCfg :: SMPClientConfig,
-    retryInterval :: RetryInterval,
-    reconnectInterval :: RetryInterval
+    reconnectInterval :: RetryInterval,
+    helloTimeout :: NominalDiffTime,
+    caCertificateFile :: FilePath,
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath
   }
 
-minute :: Int
-minute = 60_000_000
-
 defaultAgentConfig :: AgentConfig
 defaultAgentConfig =
   AgentConfig
     { tcpPort = "5224",
-      smpServers = undefined,
-      rsaKeySize = 2048 `div` 8,
+      smpServers = undefined, -- TODO move it elsewhere?
+      cmdSignAlg = C.SignAlg C.SEd448,
       connIdBytes = 12,
       tbqSize = 16,
       dbFile = "smp-agent.db",
       dbPoolSize = 4,
       smpCfg = smpDefaultConfig,
-      retryInterval =
-        RetryInterval
-          { initialInterval = 1_000_000,
-            increaseAfter = minute,
-            maxInterval = 10 * minute
-          },
       reconnectInterval =
         RetryInterval
-          { initialInterval = 1_000_000,
-            increaseAfter = 10_000_000,
-            maxInterval = 10_000_000
-          }
+          { initialInterval = second,
+            increaseAfter = 10 * second,
+            maxInterval = 10 * second
+          },
+      helloTimeout = 7 * nominalDay,
+      -- CA certificate private key is not needed for initialization
+      -- ! we do not generate these
+      caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
+      privateKeyFile = "/etc/opt/simplex-agent/agent.key",
+      certificateFile = "/etc/opt/simplex-agent/agent.crt"
     }
+  where
+    second = 1_000_000
 
 data Env = Env
   { config :: AgentConfig,
     store :: SQLiteStore,
     idsDrg :: TVar ChaChaDRG,
     clientCounter :: TVar Int,
-    reservedMsgSize :: Int,
     randomServer :: TVar StdGen
   }
 
@@ -75,10 +84,4 @@ newSMPAgentEnv cfg = do
   store <- liftIO $ createSQLiteStore (dbFile cfg) (dbPoolSize cfg) Migrations.app
   clientCounter <- newTVarIO 0
   randomServer <- newTVarIO =<< liftIO newStdGen
-  return Env {config = cfg, store, idsDrg, clientCounter, reservedMsgSize, randomServer}
-  where
-    -- 1st rsaKeySize is used by the RSA signature in each command,
-    -- 2nd - by encrypted message body header
-    -- 3rd - by message signature
-    -- smpCommandSize - is the estimated max size for SMP command, queueId, corrId
-    reservedMsgSize = 3 * rsaKeySize cfg + smpCommandSize (smpCfg cfg)
+  return Env {config = cfg, store, idsDrg, clientCounter, randomServer}

src/Simplex/Messaging/Agent/QueryString.hs

@@ -0,0 +1,30 @@
+module Simplex.Messaging.Agent.QueryString where
+
+import Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.List (find)
+import qualified Network.HTTP.Types as Q
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (parseAll)
+
+data QueryStringParams = QSP QSPEscaping Q.SimpleQuery
+  deriving (Show)
+
+data QSPEscaping = QEscape | QNoEscaping
+  deriving (Show)
+
+instance StrEncoding QueryStringParams where
+  strEncode (QSP esc q) = case esc of
+    QEscape -> Q.renderSimpleQuery False q
+    QNoEscaping ->
+      Q.renderQueryPartialEscape False $
+        map (\(n, v) -> (n, [Q.QN v])) q
+  strP = QSP QEscape . Q.parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
+
+queryParam :: StrEncoding a => ByteString -> QueryStringParams -> Parser a
+queryParam name (QSP _ q) =
+  case find ((== name) . fst) q of
+    Just (_, p) -> either fail pure $ parseAll strP p
+    _ -> fail $ "no qs param " <> B.unpack name

src/Simplex/Messaging/Agent/Server.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Agent.Server
+  ( -- * SMP agent over TCP
+    runSMPAgent,
+    runSMPAgentBlocking,
+  )
+where
+
+import Control.Logger.Simple (logInfo)
+import Control.Monad.Except
+import Control.Monad.IO.Unlift (MonadUnliftIO)
+import Control.Monad.Reader
+import Crypto.Random (MonadRandom)
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Text.Encoding (decodeUtf8)
+import Simplex.Messaging.Agent
+import Simplex.Messaging.Agent.Env.Postgres
+import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), simplexMQVersion)
+import Simplex.Messaging.Transport.Server (loadTLSServerParams, runTransportServer)
+import Simplex.Messaging.Util (bshow)
+import UnliftIO.Async (race_)
+import qualified UnliftIO.Exception as E
+import UnliftIO.STM
+
+-- | Runs an SMP agent as a TCP service using passed configuration.
+--
+-- See a full agent executable here: https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-agent/Main.hs
+runSMPAgent :: (MonadRandom m, MonadUnliftIO m) => ATransport -> AgentConfig -> m ()
+runSMPAgent t cfg = do
+  started <- newEmptyTMVarIO
+  runSMPAgentBlocking t started cfg
+
+-- | Runs an SMP agent as a TCP service using passed configuration with signalling.
+--
+-- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
+-- and when it is disconnected from the TCP socket once the server thread is killed (False).
+runSMPAgentBlocking :: (MonadRandom m, MonadUnliftIO m) => ATransport -> TMVar Bool -> AgentConfig -> m ()
+runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, caCertificateFile, certificateFile, privateKeyFile} = do
+  runReaderT (smpAgent t) =<< newSMPAgentEnv cfg
+  where
+    smpAgent :: forall c m'. (Transport c, MonadUnliftIO m', MonadReader Env m') => TProxy c -> m' ()
+    smpAgent _ = do
+      -- tlsServerParams is not in Env to avoid breaking functional API w/t key and certificate generation
+      tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
+      runTransportServer started tcpPort tlsServerParams $ \(h :: c) -> do
+        liftIO . putLn h $ "Welcome to SMP agent v" <> B.pack simplexMQVersion
+        c <- getAgentClient
+        logConnection c True
+        race_ (connectClient h c) (runAgentClient c)
+          `E.finally` disconnectAgentClient c
+
+connectClient :: Transport c => MonadUnliftIO m => c -> AgentClient -> m ()
+connectClient h c = race_ (send h c) (receive h c)
+
+receive :: forall c m. (Transport c, MonadUnliftIO m) => c -> AgentClient -> m ()
+receive h c@AgentClient {rcvQ, subQ} = forever $ do
+  (corrId, connId, cmdOrErr) <- tGet SClient h
+  case cmdOrErr of
+    Right cmd -> write rcvQ (corrId, connId, cmd)
+    Left e -> write subQ (corrId, connId, ERR e)
+  where
+    write :: TBQueue (ATransmission p) -> ATransmission p -> m ()
+    write q t = do
+      logClient c "-->" t
+      atomically $ writeTBQueue q t
+
+send :: (Transport c, MonadUnliftIO m) => c -> AgentClient -> m ()
+send h c@AgentClient {subQ} = forever $ do
+  t <- atomically $ readTBQueue subQ
+  tPut h t
+  logClient c "<--" t
+
+logClient :: MonadUnliftIO m => AgentClient -> ByteString -> ATransmission a -> m ()
+logClient AgentClient {clientId} dir (corrId, connId, cmd) = do
+  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, connId, B.takeWhile (/= ' ') $ serializeCommand cmd]

src/Simplex/Messaging/Agent/Store.hs

@@ -18,12 +18,14 @@ import Data.Kind (Type)
 import Data.Time (UTCTime)
 import Data.Type.Equality
 import Simplex.Messaging.Agent.Protocol
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff, SkippedMsgKeys)
 import Simplex.Messaging.Protocol
   ( MsgBody,
     MsgId,
-    RecipientPrivateKey,
-    SenderPrivateKey,
-    SenderPublicKey,
+    RcvDhSecret,
+    RcvPrivateSignKey,
+    SndPrivateSignKey,
   )
 import qualified Simplex.Messaging.Protocol as SMP
 
@@ -35,15 +37,13 @@ class Monad m => MonadAgentStore s m where
   createRcvConn :: s -> TVar ChaChaDRG -> ConnData -> RcvQueue -> SConnectionMode c -> m ConnId
   createSndConn :: s -> TVar ChaChaDRG -> ConnData -> SndQueue -> m ConnId
   getConn :: s -> ConnId -> m SomeConn
-  getAllConnIds :: s -> m [ConnId] -- TODO remove - hack for subscribing to all
   getRcvConn :: s -> SMPServer -> SMP.RecipientId -> m SomeConn
   deleteConn :: s -> ConnId -> m ()
   upgradeRcvConnToDuplex :: s -> ConnId -> SndQueue -> m ()
   upgradeSndConnToDuplex :: s -> ConnId -> RcvQueue -> m ()
   setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m ()
-  setRcvQueueActive :: s -> RcvQueue -> VerificationKey -> m ()
+  setRcvQueueConfirmedE2E :: s -> RcvQueue -> C.DhSecretX25519 -> m ()
   setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m ()
-  updateSignKey :: s -> SndQueue -> SignatureKey -> m ()
 
   -- Confirmations
   createConfirmation :: s -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
@@ -62,23 +62,37 @@ class Monad m => MonadAgentStore s m where
   createRcvMsg :: s -> ConnId -> RcvMsgData -> m ()
   updateSndIds :: s -> ConnId -> m (InternalId, InternalSndId, PrevSndMsgHash)
   createSndMsg :: s -> ConnId -> SndMsgData -> m ()
-  updateSndMsgStatus :: s -> ConnId -> InternalId -> SndMsgStatus -> m ()
-  getPendingMsgData :: s -> ConnId -> InternalId -> m (SndQueue, MsgBody)
-  getPendingMsgs :: s -> ConnId -> m [PendingMsg]
-  getMsg :: s -> ConnId -> InternalId -> m Msg
+  getPendingMsgData :: s -> ConnId -> InternalId -> m (Maybe RcvQueue, (AMsgType, MsgBody, InternalTs))
+  getPendingMsgs :: s -> ConnId -> m [InternalId]
   checkRcvMsg :: s -> ConnId -> InternalId -> m ()
-  updateRcvMsgAck :: s -> ConnId -> InternalId -> m ()
+  deleteMsg :: s -> ConnId -> InternalId -> m ()
+
+  -- Double ratchet persistence
+  createRatchetX3dhKeys :: s -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> m ()
+  getRatchetX3dhKeys :: s -> ConnId -> m (C.PrivateKeyX448, C.PrivateKeyX448)
+  createRatchet :: s -> ConnId -> RatchetX448 -> m ()
+  getRatchet :: s -> ConnId -> m RatchetX448
+  getSkippedMsgKeys :: s -> ConnId -> m SkippedMsgKeys
+  updateRatchet :: s -> ConnId -> RatchetX448 -> SkippedMsgDiff -> m ()
 
 -- * Queue types
 
 -- | A receive queue. SMP queue through which the agent receives messages from a sender.
 data RcvQueue = RcvQueue
   { server :: SMPServer,
+    -- | recipient queue ID
     rcvId :: SMP.RecipientId,
-    rcvPrivateKey :: RecipientPrivateKey,
+    -- | key used by the recipient to sign transmissions
+    rcvPrivateKey :: RcvPrivateSignKey,
+    -- | shared DH secret used to encrypt/decrypt message bodies from server to recipient
+    rcvDhSecret :: RcvDhSecret,
+    -- | private DH key related to public sent to sender out-of-band (to agree simple per-queue e2e)
+    e2ePrivKey :: C.PrivateKeyX25519,
+    -- | public sender's DH key and agreed shared DH secret for simple per-queue e2e
+    e2eDhSecret :: Maybe C.DhSecretX25519,
+    -- | sender queue ID
     sndId :: Maybe SMP.SenderId,
-    decryptKey :: DecryptionKey,
-    verifyKey :: Maybe VerificationKey,
+    -- | queue status
     status :: QueueStatus
   }
   deriving (Eq, Show)
@@ -86,10 +100,13 @@ data RcvQueue = RcvQueue
 -- | A send queue. SMP queue through which the agent sends messages to a recipient.
 data SndQueue = SndQueue
   { server :: SMPServer,
+    -- | sender queue ID
     sndId :: SMP.SenderId,
-    sndPrivateKey :: SenderPrivateKey,
-    encryptKey :: EncryptionKey,
-    signKey :: SignatureKey,
+    -- | key used by the sender to sign transmissions
+    sndPrivateKey :: SndPrivateSignKey,
+    -- | shared DH secret agreed for simple per-queue e2e encryption
+    e2eDhSecret :: C.DhSecretX25519,
+    -- | queue status
     status :: QueueStatus
   }
   deriving (Eq, Show)
@@ -160,15 +177,15 @@ newtype ConnData = ConnData {connId :: ConnId}
 
 data NewConfirmation = NewConfirmation
   { connId :: ConnId,
-    senderKey :: SenderPublicKey,
-    senderConnInfo :: ConnInfo
+    senderConf :: SMPConfirmation,
+    ratchetState :: RatchetX448
   }
 
 data AcceptedConfirmation = AcceptedConfirmation
   { confirmationId :: ConfirmationId,
     connId :: ConnId,
-    senderKey :: SenderPublicKey,
-    senderConnInfo :: ConnInfo,
+    senderConf :: SMPConfirmation,
+    ratchetState :: RatchetX448,
     ownConnInfo :: ConnInfo
   }
 
@@ -176,14 +193,14 @@ data AcceptedConfirmation = AcceptedConfirmation
 
 data NewInvitation = NewInvitation
   { contactConnId :: ConnId,
-    connReq :: ConnectionRequest 'CMInvitation,
+    connReq :: ConnectionRequestUri 'CMInvitation,
     recipientConnInfo :: ConnInfo
   }
 
 data Invitation = Invitation
   { invitationId :: InvitationId,
     contactConnId :: ConnId,
-    connReq :: ConnectionRequest 'CMInvitation,
+    connReq :: ConnectionRequestUri 'CMInvitation,
     recipientConnInfo :: ConnInfo,
     ownConnInfo :: Maybe ConnInfo,
     accepted :: Bool
@@ -200,12 +217,11 @@ type PrevRcvMsgHash = MsgHash
 -- | Corresponds to `last_snd_msg_hash` in `connections` table
 type PrevSndMsgHash = MsgHash
 
--- ? merge/replace these with RcvMsg and SndMsg
-
 -- * Message data containers - used on Msg creation to reduce number of parameters
 
 data RcvMsgData = RcvMsgData
   { msgMeta :: MsgMeta,
+    msgType :: AMsgType,
     msgBody :: MsgBody,
     internalRcvId :: InternalRcvId,
     internalHash :: MsgHash,
@@ -216,9 +232,10 @@ data SndMsgData = SndMsgData
   { internalId :: InternalId,
     internalSndId :: InternalSndId,
     internalTs :: InternalTs,
+    msgType :: AMsgType,
     msgBody :: MsgBody,
     internalHash :: MsgHash,
-    previousMsgHash :: MsgHash
+    prevMsgHash :: MsgHash
   }
 
 data PendingMsg = PendingMsg
@@ -227,43 +244,6 @@ data PendingMsg = PendingMsg
   }
   deriving (Show)
 
--- * Broadcast types
-
-type BroadcastId = ByteString
-
--- * Message types
-
--- | A message in either direction that is stored by the agent.
-data Msg = MRcv RcvMsg | MSnd SndMsg
-  deriving (Eq, Show)
-
--- | A message received by the agent from a sender.
-data RcvMsg = RcvMsg
-  { msgBase :: MsgBase,
-    internalRcvId :: InternalRcvId,
-    -- | Id of the message at sender, corresponds to `internalSndId` from the sender's side.
-    -- Sender Id is made sequential for detection of missing messages. For redundant / parallel queues,
-    -- it also allows to keep track of duplicates and restore the original order before delivery to the client.
-    externalSndId :: ExternalSndId,
-    externalSndTs :: ExternalSndTs,
-    -- | Id of the message at broker, although it is not sequential (to avoid metadata leakage for potential observer),
-    -- it is needed to track repeated deliveries in case of connection loss - this logic is not implemented yet.
-    brokerId :: BrokerId,
-    brokerTs :: BrokerTs,
-    rcvMsgStatus :: RcvMsgStatus,
-    -- | Timestamp of acknowledgement to broker, corresponds to `AcknowledgedToBroker` status.
-    -- Do not mix up with `brokerTs` - timestamp created at broker after it receives the message from sender.
-    ackBrokerTs :: AckBrokerTs,
-    -- | Timestamp of acknowledgement to sender, corresponds to `AcknowledgedToSender` status.
-    -- Do not mix up with `externalSndTs` - timestamp created at sender before sending,
-    -- which in its turn corresponds to `internalTs` in sending agent.
-    ackSenderTs :: AckSenderTs,
-    -- | Hash of previous message as received from sender - stored for integrity forensics.
-    externalPrevSndHash :: MsgHash,
-    msgIntegrity :: MsgIntegrity
-  }
-  deriving (Eq, Show)
-
 -- internal Ids are newtypes to prevent mixing them up
 newtype InternalRcvId = InternalRcvId {unRcvId :: Int64} deriving (Eq, Show)
 
@@ -275,44 +255,11 @@ type BrokerId = MsgId
 
 type BrokerTs = UTCTime
 
-data RcvMsgStatus
-  = Received
-  | AcknowledgedToBroker
-  | AcknowledgedToSender
-  deriving (Eq, Show)
-
-type AckBrokerTs = UTCTime
-
-type AckSenderTs = UTCTime
-
--- | A message sent by the agent to a recipient.
-data SndMsg = SndMsg
-  { msgBase :: MsgBase,
-    -- | Id of the message sent / to be sent, as in its number in order of sending.
-    internalSndId :: InternalSndId,
-    sndMsgStatus :: SndMsgStatus,
-    -- | Timestamp of the message received by broker, corresponds to `Sent` status.
-    sentTs :: SentTs,
-    -- | Timestamp of the message received by recipient, corresponds to `Delivered` status.
-    deliveredTs :: DeliveredTs
-  }
-  deriving (Eq, Show)
-
 newtype InternalSndId = InternalSndId {unSndId :: Int64} deriving (Eq, Show)
 
-data SndMsgStatus
-  = SndMsgCreated
-  | SndMsgSent
-  | SndMsgDelivered
-  deriving (Eq, Show)
-
-type SentTs = UTCTime
-
-type DeliveredTs = UTCTime
-
 -- | Base message data independent of direction.
 data MsgBase = MsgBase
-  { connAlias :: ConnId,
+  { connId :: ConnId,
     -- | Monotonically increasing id of a message per connection, internal to the agent.
     -- Internal Id preserves ordering between both received and sent messages, and is needed
     -- to track the order of the conversation (which can be different for the sender / receiver)
@@ -336,11 +283,11 @@ type InternalTs = UTCTime
 data StoreError
   = -- | IO exceptions in store actions.
     SEInternal ByteString
-  | -- | failed to generate unique random ID
+  | -- | Failed to generate unique random ID
     SEUniqueID
-  | -- | Connection alias not found (or both queues absent).
+  | -- | Connection not found (or both queues absent).
     SEConnNotFound
-  | -- | Connection alias already used.
+  | -- | Connection already used.
     SEConnDuplicate
   | -- | Wrong connection type, e.g. "send" connection when "receive" or "duplex" is expected, or vice versa.
     -- 'upgradeRcvConnToDuplex' and 'upgradeSndConnToDuplex' do not allow duplex connections - they would also return this error.
@@ -355,6 +302,10 @@ data StoreError
     -- as we always know what it should be at any stage of the protocol,
     -- and in case it does not match use this error.
     SEBadQueueStatus
+  | -- | connection does not have associated double-ratchet state
+    SERatchetNotFound
+  | -- | connection does not have associated x3dh keys
+    SEX3dhKeysNotFound
   | -- | Used in `getMsg` that is not implemented/used. TODO remove.
     SENotImplemented
   deriving (Eq, Show, Exception)

src/Simplex/Messaging/Agent/Store/Postgres.hs

@@ -0,0 +1,957 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Simplex.Messaging.Agent.Store.Postgres
+  ( PostgresStore (..),
+    createPostgresStore,
+    connectPostgresStore,
+    withConnection,
+    withTransaction,
+    fromTextField_,
+    firstRow,
+  )
+where
+
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.STM
+import Control.Exception (bracket)
+import Control.Monad (void)
+import Control.Monad.Except
+import Control.Monad.IO.Unlift (MonadUnliftIO)
+import Crypto.Random (ChaChaDRG, randomBytesGenerate)
+import Data.Bifunctor (second)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Base64.URL as U
+import qualified Data.ByteString.Char8 as B
+import Data.Char (toLower)
+import Data.Functor (($>))
+import Data.List (find, foldl')
+import qualified Data.Map.Strict as M
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1)
+import Database.PostgreSQL.Simple (FromRow, Only (..), Query, SqlError, ToRow, withSavepoint)
+import qualified Database.PostgreSQL.Simple as DB
+import Database.PostgreSQL.Simple.Errors (constraintViolation)
+import Database.PostgreSQL.Simple.FromField
+import Database.PostgreSQL.Simple.Internal (Conversion (..), Field (..))
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.ToField (ToField (..))
+import qualified Database.PostgreSQL.Simple.TypeInfo
+import Database.PostgreSQL.Simple.TypeInfo.Static (bytea, text)
+import qualified Database.PostgreSQL.Simple.TypeInfo.Static
+import GHC.Word (Word32)
+import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.Store
+import Simplex.Messaging.Agent.Store.Postgres.Migrations (Migration)
+import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (blobFieldParser, parseAll)
+import Simplex.Messaging.Protocol (MsgBody)
+import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Util (bshow, liftIOEither)
+import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
+import System.Exit (exitFailure)
+import System.FilePath (takeDirectory)
+import System.IO (hFlush, stdout)
+import qualified UnliftIO.Exception as E
+import Network.Socket (HostName, ServiceName)
+import Simplex.Messaging.Crypto (KeyHash)
+
+-- * Postgres Store implementation
+
+data PostgresStore = PostgresStore
+  { dbConnInfo :: DB.ConnectInfo,
+    dbConnPool :: TBQueue DB.Connection,
+    dbNew :: Bool
+  }
+
+createPostgresStore :: DB.ConnectInfo -> Int -> [Migration] -> IO PostgresStore
+createPostgresStore dbConnInfo poolSize migrations = do
+  st <- connectPostgresStore dbConnInfo poolSize
+  migrateSchema st migrations
+  pure st
+
+migrateSchema :: PostgresStore -> [Migration] -> IO ()
+migrateSchema st migrations = withConnection st $ \db -> do
+  Migrations.initialize db
+  Migrations.get db migrations >>= \case
+    Left e -> confirmOrExit $ "Database error: " <> e
+    Right [] -> pure ()
+    Right ms -> do
+      unless (dbNew st) $ do
+        confirmOrExit "The app has a newer version than the database - it will be backed up and upgraded."
+      -- TODO backup
+      -- let f = dbFilePath st
+      -- copyFile f (f <> ".bak")
+      Migrations.run db ms
+
+confirmOrExit :: String -> IO ()
+confirmOrExit s = do
+  putStrLn s
+  putStr "Continue (y/N): "
+  hFlush stdout
+  ok <- getLine
+  when (map toLower ok /= "y") exitFailure
+
+connectPostgresStore :: DB.ConnectInfo -> Int -> IO PostgresStore
+connectPostgresStore dbConnInfo poolSize = do
+  let dbNew = True -- TODO scan migrations
+  dbConnPool <- newTBQueueIO $ toEnum poolSize
+  replicateM_ poolSize $
+    connectDB dbConnInfo >>= atomically . writeTBQueue dbConnPool
+  pure PostgresStore {dbConnInfo, dbConnPool, dbNew}
+
+connectDB :: DB.ConnectInfo -> IO DB.Connection
+connectDB = DB.connect
+
+checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
+checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)
+
+handleSQLError :: StoreError -> SqlError -> StoreError
+handleSQLError err e = case constraintViolation e of
+  Just _ -> err
+  Nothing -> SEInternal $ bshow e
+
+withConnection :: PostgresStore -> (DB.Connection -> IO a) -> IO a
+withConnection PostgresStore {dbConnPool} =
+  bracket
+    (atomically $ readTBQueue dbConnPool)
+    (atomically . writeTBQueue dbConnPool)
+
+execute :: ToRow q => DB.Connection -> Query -> q -> IO ()
+execute db query q = void $ DB.execute db query q
+
+-- TODO not sure this logic is needed with Postgres, also no such error
+-- withTransaction :: forall a. PostgresStore -> (DB.Connection -> IO a) -> IO a
+-- withTransaction st action = withConnection st $ loop 100 100_000
+--   where
+--     loop :: Int -> Int -> DB.Connection -> IO a
+--     loop t tLim db =
+--       DB.withTransaction db (action db) `E.catch` \(e :: SQLError) ->
+--         if tLim > t && DB.sqlError e == DB.ErrorBusy
+--           then do
+--             threadDelay t
+--             loop (t * 9 `div` 8) (tLim - t) db
+--           else E.throwIO e
+
+withTransaction :: forall a. PostgresStore -> (DB.Connection -> IO a) -> IO a
+withTransaction st action = withConnection st inTransaction
+  where
+    inTransaction :: DB.Connection -> IO a
+    inTransaction db = DB.withTransaction db (action db)
+
+createConn_ ::
+  (MonadUnliftIO m, MonadError StoreError m) =>
+  PostgresStore ->
+  TVar ChaChaDRG ->
+  ConnData ->
+  (DB.Connection -> ByteString -> IO ()) ->
+  m ByteString
+createConn_ st gVar cData create = do
+  connId <- liftIOEither . checkConstraint SEConnDuplicate . withTransaction st $ \db ->
+    case cData of
+      ConnData {connId = ""} -> createWithRandomId gVar $ create db
+      ConnData {connId} -> create db connId $> Right connId
+  liftIO $ print "before: getConn_ db connId"
+  conn <- liftIO $ withTransaction st $ \db -> getConn_ db connId
+  liftIO $ print conn
+  pure connId
+
+instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore PostgresStore m where
+  createRcvConn :: PostgresStore -> TVar ChaChaDRG -> ConnData -> RcvQueue -> SConnectionMode c -> m ConnId
+  createRcvConn st gVar cData q@RcvQueue {server} cMode =
+    createConn_ st gVar cData $ \db connId -> do
+      upsertServer_ db server
+      execute db "INSERT INTO connections (conn_id, conn_mode) VALUES (?, ?)" (connId, cMode)
+      insertRcvQueue_ db connId q
+
+  createSndConn :: PostgresStore -> TVar ChaChaDRG -> ConnData -> SndQueue -> m ConnId
+  createSndConn st gVar cData q@SndQueue {server} =
+    createConn_ st gVar cData $ \db connId -> do
+      upsertServer_ db server
+      execute db "INSERT INTO connections (conn_id, conn_mode) VALUES (?, ?)" (connId, SCMInvitation)
+      insertSndQueue_ db connId q
+
+  getConn :: PostgresStore -> ConnId -> m SomeConn
+  getConn st connId =
+    liftIOEither . withTransaction st $ \db ->
+      getConn_ db connId
+
+  getRcvConn :: PostgresStore -> SMPServer -> SMP.RecipientId -> m SomeConn
+  getRcvConn st SMPServer {host, port} rcvId =
+    liftIOEither . withTransaction st $ \db ->
+      DB.query
+        db
+        [sql|
+          SELECT q.conn_id
+          FROM rcv_queues q
+          WHERE q.host = ? AND q.port = ? AND q.rcv_id = ?;
+        |]
+        (host, port, rcvId)
+        >>= \case
+          [Only connId] -> getConn_ db connId
+          _ -> pure $ Left SEConnNotFound
+
+  deleteConn :: PostgresStore -> ConnId -> m ()
+  deleteConn st connId =
+    liftIO . withTransaction st $ \db ->
+      execute
+        db
+        "DELETE FROM connections WHERE conn_id = ?;"
+        (Only connId)
+
+  upgradeRcvConnToDuplex :: PostgresStore -> ConnId -> SndQueue -> m ()
+  upgradeRcvConnToDuplex st connId sq@SndQueue {server} =
+    liftIOEither . withTransaction st $ \db ->
+      getConn_ db connId >>= \case
+        Right (SomeConn _ RcvConnection {}) -> do
+          upsertServer_ db server
+          insertSndQueue_ db connId sq
+          pure $ Right ()
+        Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+        _ -> pure $ Left SEConnNotFound
+
+  upgradeSndConnToDuplex :: PostgresStore -> ConnId -> RcvQueue -> m ()
+  upgradeSndConnToDuplex st connId rq@RcvQueue {server} =
+    liftIOEither . withTransaction st $ \db ->
+      getConn_ db connId >>= \case
+        Right (SomeConn _ SndConnection {}) -> do
+          upsertServer_ db server
+          insertRcvQueue_ db connId rq
+          pure $ Right ()
+        Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+        _ -> pure $ Left SEConnNotFound
+
+  setRcvQueueStatus :: PostgresStore -> RcvQueue -> QueueStatus -> m ()
+  setRcvQueueStatus st RcvQueue {rcvId, server = SMPServer {host, port}} status =
+    -- ? throw error if queue does not exist?
+    liftIO . withTransaction st $ \db ->
+      execute
+        db
+        [sql|
+          UPDATE rcv_queues
+          SET status = ?
+          WHERE host = ? AND port = ? AND rcv_id = ?;
+        |]
+        (status, host, port, rcvId)
+
+  setRcvQueueConfirmedE2E :: PostgresStore -> RcvQueue -> C.DhSecretX25519 -> m ()
+  setRcvQueueConfirmedE2E st RcvQueue {rcvId, server = SMPServer {host, port}} e2eDhSecret =
+    liftIO . withTransaction st $ \db ->
+      execute
+        db
+        [sql|
+          UPDATE rcv_queues
+          SET e2e_dh_secret = ?,
+              status = ?
+          WHERE host = ? AND port = ? AND rcv_id = ?
+        |]
+        (Confirmed, e2eDhSecret, host, port, rcvId)
+
+  setSndQueueStatus :: PostgresStore -> SndQueue -> QueueStatus -> m ()
+  setSndQueueStatus st SndQueue {sndId, server = SMPServer {host, port}} status =
+    -- ? throw error if queue does not exist?
+    liftIO . withTransaction st $ \db ->
+      execute
+        db
+        [sql|
+          UPDATE snd_queues
+          SET status = ?
+          WHERE host = ? AND port = ? AND snd_id = ?;
+        |]
+        (status, host, port, sndId)
+
+  createConfirmation :: PostgresStore -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
+  createConfirmation st gVar NewConfirmation {connId, senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo}, ratchetState} =
+    liftIOEither . withTransaction st $ \db ->
+      createWithRandomId gVar $ \confirmationId ->
+        execute
+          db
+          [sql|
+            INSERT INTO conn_confirmations
+            (confirmation_id, conn_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, accepted) VALUES (?, ?, ?, ?, ?, ?, 0);
+          |]
+          (confirmationId, connId, senderKey, e2ePubKey, ratchetState, connInfo)
+
+  acceptConfirmation :: PostgresStore -> ConfirmationId -> ConnInfo -> m AcceptedConfirmation
+  acceptConfirmation st confirmationId ownConnInfo =
+    liftIOEither . withTransaction st $ \db -> do
+      execute
+        db
+        [sql|
+          UPDATE conn_confirmations
+          SET accepted = 1,
+              own_conn_info = ?
+          WHERE confirmation_id = ?;
+        |]
+        (ownConnInfo, confirmationId)
+      firstRow confirmation SEConfirmationNotFound $
+        DB.query
+          db
+          [sql|
+            SELECT conn_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info
+            FROM conn_confirmations
+            WHERE confirmation_id = ?;
+          |]
+          (Only confirmationId)
+    where
+      confirmation (connId, senderKey, e2ePubKey, ratchetState, connInfo) =
+        AcceptedConfirmation
+          { confirmationId,
+            connId,
+            senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo},
+            ratchetState,
+            ownConnInfo
+          }
+
+  getAcceptedConfirmation :: PostgresStore -> ConnId -> m AcceptedConfirmation
+  getAcceptedConfirmation st connId =
+    liftIOEither . withTransaction st $ \db ->
+      firstRow confirmation SEConfirmationNotFound $
+        DB.query
+          db
+          [sql|
+            SELECT confirmation_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, own_conn_info
+            FROM conn_confirmations
+            WHERE conn_id = ? AND accepted = 1;
+          |]
+          (Only connId)
+    where
+      confirmation (confirmationId, senderKey, e2ePubKey, ratchetState, connInfo, ownConnInfo) =
+        AcceptedConfirmation
+          { confirmationId,
+            connId,
+            senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo},
+            ratchetState,
+            ownConnInfo
+          }
+
+  removeConfirmations :: PostgresStore -> ConnId -> m ()
+  removeConfirmations st connId =
+    liftIO . withTransaction st $ \db ->
+      execute
+        db
+        [sql|
+          DELETE FROM conn_confirmations
+          WHERE conn_id = ?;
+        |]
+        (Only connId)
+
+  createInvitation :: PostgresStore -> TVar ChaChaDRG -> NewInvitation -> m InvitationId
+  createInvitation st gVar NewInvitation {contactConnId, connReq, recipientConnInfo} =
+    liftIOEither . withTransaction st $ \db ->
+      createWithRandomId gVar $ \invitationId ->
+        execute
+          db
+          [sql|
+            INSERT INTO conn_invitations
+            (invitation_id,  contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
+          |]
+          (invitationId, contactConnId, connReq, recipientConnInfo)
+
+  getInvitation :: PostgresStore -> InvitationId -> m Invitation
+  getInvitation st invitationId =
+    liftIOEither . withTransaction st $ \db ->
+      firstRow invitation SEInvitationNotFound $
+        DB.query
+          db
+          [sql|
+            SELECT contact_conn_id, cr_invitation, recipient_conn_info, own_conn_info, accepted
+            FROM conn_invitations
+            WHERE invitation_id = ?
+              AND accepted = 0
+          |]
+          (Only invitationId)
+    where
+      invitation (contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted) =
+        Invitation {invitationId, contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted}
+
+  acceptInvitation :: PostgresStore -> InvitationId -> ConnInfo -> m ()
+  acceptInvitation st invitationId ownConnInfo =
+    liftIO . withTransaction st $ \db -> do
+      execute
+        db
+        [sql|
+          UPDATE conn_invitations
+          SET accepted = 1,
+              own_conn_info = ?
+          WHERE invitation_id = ?
+        |]
+        (ownConnInfo, invitationId)
+
+  deleteInvitation :: PostgresStore -> ConnId -> InvitationId -> m ()
+  deleteInvitation st contactConnId invId =
+    liftIOEither . withTransaction st $ \db ->
+      runExceptT $
+        ExceptT (getConn_ db contactConnId) >>= \case
+          SomeConn SCContact _ ->
+            liftIO $ execute db "DELETE FROM conn_invitations WHERE contact_conn_id = ? AND invitation_id = ?" (contactConnId, invId)
+          _ -> throwError SEConnNotFound
+
+  updateRcvIds :: PostgresStore -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
+  updateRcvIds st connId =
+    liftIO . withTransaction st $ \db -> do
+      (lastInternalId, lastInternalRcvId, lastExternalSndId, lastRcvHash) <- retrieveLastIdsAndHashRcv_ db connId
+      let internalId = InternalId $ unId lastInternalId + 1
+          internalRcvId = InternalRcvId $ unRcvId lastInternalRcvId + 1
+      updateLastIdsRcv_ db connId internalId internalRcvId
+      pure (internalId, internalRcvId, lastExternalSndId, lastRcvHash)
+
+  createRcvMsg :: PostgresStore -> ConnId -> RcvMsgData -> m ()
+  createRcvMsg st connId rcvMsgData =
+    liftIO . withTransaction st $ \db -> do
+      insertRcvMsgBase_ db connId rcvMsgData
+      insertRcvMsgDetails_ db connId rcvMsgData
+      updateHashRcv_ db connId rcvMsgData
+
+  updateSndIds :: PostgresStore -> ConnId -> m (InternalId, InternalSndId, PrevSndMsgHash)
+  updateSndIds st connId =
+    liftIO . withTransaction st $ \db -> do
+      (lastInternalId, lastInternalSndId, prevSndHash) <- retrieveLastIdsAndHashSnd_ db connId
+      let internalId = InternalId $ unId lastInternalId + 1
+          internalSndId = InternalSndId $ unSndId lastInternalSndId + 1
+      updateLastIdsSnd_ db connId internalId internalSndId
+      pure (internalId, internalSndId, prevSndHash)
+
+  createSndMsg :: PostgresStore -> ConnId -> SndMsgData -> m ()
+  createSndMsg st connId sndMsgData =
+    liftIO . withTransaction st $ \db -> do
+      insertSndMsgBase_ db connId sndMsgData
+      insertSndMsgDetails_ db connId sndMsgData
+      updateHashSnd_ db connId sndMsgData
+
+  getPendingMsgData :: PostgresStore -> ConnId -> InternalId -> m (Maybe RcvQueue, (AMsgType, MsgBody, InternalTs))
+  getPendingMsgData st connId msgId =
+    liftIOEither . withTransaction st $ \db -> runExceptT $ do
+      rq_ <- liftIO $ getRcvQueueByConnId_ db connId
+      msgData <-
+        ExceptT . firstRow id SEMsgNotFound $
+          DB.query
+            db
+            [sql|
+                SELECT m.msg_type, m.msg_body, m.internal_ts
+                FROM messages m
+                JOIN snd_messages s ON s.conn_id = m.conn_id AND s.internal_id = m.internal_id
+                WHERE m.conn_id = ? AND m.internal_id = ?
+              |]
+            (connId, msgId)
+      pure (rq_, msgData)
+
+  getPendingMsgs :: PostgresStore -> ConnId -> m [InternalId]
+  getPendingMsgs st connId =
+    liftIO . withTransaction st $ \db ->
+      map fromOnly
+        <$> DB.query db "SELECT internal_id FROM snd_messages WHERE conn_id = ?" (Only connId)
+
+  checkRcvMsg :: PostgresStore -> ConnId -> InternalId -> m ()
+  checkRcvMsg st connId msgId =
+    liftIOEither . withTransaction st $ \db ->
+      hasMsg
+        <$> DB.query
+          db
+          [sql|
+            SELECT conn_id, internal_id
+            FROM rcv_messages
+            WHERE conn_id = ? AND internal_id = ?
+          |]
+          (connId, msgId)
+    where
+      hasMsg :: [(ConnId, InternalId)] -> Either StoreError ()
+      hasMsg r = if null r then Left SEMsgNotFound else Right ()
+
+  deleteMsg :: PostgresStore -> ConnId -> InternalId -> m ()
+  deleteMsg st connId msgId =
+    liftIO . withTransaction st $ \db ->
+      execute db "DELETE FROM messages WHERE conn_id = ? AND internal_id = ?;" (connId, msgId)
+
+  createRatchetX3dhKeys :: PostgresStore -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> m ()
+  createRatchetX3dhKeys st connId x3dhPrivKey1 x3dhPrivKey2 =
+    liftIO . withTransaction st $ \db ->
+      execute db "INSERT INTO ratchets (conn_id, x3dh_priv_key_1, x3dh_priv_key_2) VALUES (?, ?, ?)" (connId, x3dhPrivKey1, x3dhPrivKey2)
+
+  getRatchetX3dhKeys :: PostgresStore -> ConnId -> m (C.PrivateKeyX448, C.PrivateKeyX448)
+  getRatchetX3dhKeys st connId =
+    liftIOEither . withTransaction st $ \db ->
+      fmap hasKeys $
+        firstRow id SEX3dhKeysNotFound $
+          DB.query db "SELECT x3dh_priv_key_1, x3dh_priv_key_2 FROM ratchets WHERE conn_id = ?" (Only connId)
+    where
+      hasKeys = \case
+        Right (Just k1, Just k2) -> Right (k1, k2)
+        _ -> Left SEX3dhKeysNotFound
+
+  createRatchet :: PostgresStore -> ConnId -> RatchetX448 -> m ()
+  createRatchet st connId rc =
+    liftIO . withTransaction st $ \db -> do
+      execute
+        db
+        [sql|
+          INSERT INTO ratchets (conn_id, ratchet_state)
+          VALUES (?, ?)
+          ON CONFLICT (conn_id) DO UPDATE SET
+            ratchet_state = ?,
+            x3dh_priv_key_1 = NULL,
+            x3dh_priv_key_2 = NULL
+        |]
+        (connId, rc, rc)
+
+  getRatchet :: PostgresStore -> ConnId -> m RatchetX448
+  getRatchet st connId =
+    liftIOEither . withTransaction st $ \db ->
+      ratchet
+        <$> DB.query db "SELECT ratchet_state FROM ratchets WHERE conn_id = ?" (Only connId)
+    where
+      ratchet (Only (Just rc) : _) = Right rc
+      ratchet _ = Left SERatchetNotFound
+
+  getSkippedMsgKeys :: PostgresStore -> ConnId -> m SkippedMsgKeys
+  getSkippedMsgKeys st connId =
+    liftIO . withTransaction st $ \db ->
+      skipped <$> DB.query db "SELECT header_key, msg_n, msg_key FROM skipped_messages WHERE conn_id = ?" (Only connId)
+    where
+      skipped ms = foldl' addSkippedKey M.empty ms
+      addSkippedKey smks (hk, msgN, mk) = M.alter (Just . addMsgKey) hk smks
+        where
+          addMsgKey = maybe (M.singleton msgN mk) (M.insert msgN mk)
+
+  updateRatchet :: PostgresStore -> ConnId -> RatchetX448 -> SkippedMsgDiff -> m ()
+  updateRatchet st connId rc skipped =
+    liftIO . withTransaction st $ \db -> do
+      execute db "UPDATE ratchets SET ratchet_state = ? WHERE conn_id = ?" (rc, connId)
+      case skipped of
+        SMDNoChange -> pure ()
+        SMDRemove hk msgN ->
+          execute db "DELETE FROM skipped_messages WHERE conn_id = ? AND header_key = ? AND msg_n = ?" (connId, hk, msgN)
+        SMDAdd smks ->
+          forM_ (M.assocs smks) $ \(hk, mks) ->
+            forM_ (M.assocs mks) $ \(msgN, mk) ->
+              execute db "INSERT INTO skipped_messages (conn_id, header_key, msg_n, msg_key) VALUES (?, ?, ?, ?)" (connId, hk, msgN, mk)
+
+-- -- * Auxiliary helpers
+
+instance ToField QueueStatus where toField = toField . serializeQueueStatus
+
+instance FromField QueueStatus where fromField = fromTextField_ queueStatusT
+
+instance ToField InternalRcvId where toField (InternalRcvId x) = toField x
+
+instance FromField InternalRcvId where fromField x = fromField x
+
+instance ToField InternalSndId where toField (InternalSndId x) = toField x
+
+instance FromField InternalSndId where fromField x = fromField x
+
+instance ToField InternalId where toField (InternalId x) = toField x
+
+instance FromField InternalId where fromField x = fromField x
+
+instance ToField AMsgType where toField = toField . smpEncode
+
+instance FromField AMsgType where fromField = fromByteStringField $ parseAll smpP
+
+instance ToField MsgIntegrity where toField = toField . strEncode
+
+instance FromField MsgIntegrity where fromField = fromByteStringField $ parseAll strP
+
+instance ToField SMPQueueUri where toField = toField . strEncode
+
+instance FromField SMPQueueUri where fromField = fromByteStringField $ parseAll strP
+
+instance ToField AConnectionRequestUri where toField = toField . strEncode
+
+instance FromField AConnectionRequestUri where fromField = fromByteStringField $ parseAll strP
+
+instance ConnectionModeI c => ToField (ConnectionRequestUri c) where toField = toField . strEncode
+
+instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequestUri c) where fromField = fromByteStringField $ parseAll strP
+
+instance ToField ConnectionMode where toField = toField . decodeLatin1 . strEncode
+
+instance FromField ConnectionMode where fromField = fromTextField_ connModeT
+
+instance ToField (SConnectionMode c) where toField = toField . connMode
+
+instance FromField AConnectionMode where fromField = fromTextField_ $ fmap connMode' . connModeT
+
+instance FromField Word32 where fromField x = fromField x
+
+fromTextField_ :: E.Typeable a => (Text -> Maybe a) -> Field -> Maybe ByteString -> Conversion a
+fromTextField_ fromText f mdata =
+  if typeOid f /= typoid text
+    then returnError Incompatible f ""
+    else case mdata of
+      Nothing -> returnError UnexpectedNull f ""
+      Just dat ->
+        case fromText ((T.pack . B.unpack) dat) of
+          Just x -> return x
+          _ -> returnError ConversionFailed f (B.unpack dat)
+
+-- TODO same as in Crypto
+fromByteStringField :: E.Typeable a => (ByteString -> Either String a) -> Field -> Maybe ByteString -> Conversion a
+fromByteStringField dec f mdata =
+  if typeOid f /= typoid bytea
+    then returnError Incompatible f ""
+    else case mdata of
+      Nothing -> returnError UnexpectedNull f ""
+      Just dat ->
+        case dec dat of
+          Right x -> return x
+          _ -> returnError ConversionFailed f (B.unpack dat)
+
+listToEither :: e -> [a] -> Either e a
+listToEither _ (x : _) = Right x
+listToEither e _ = Left e
+
+firstRow :: (a -> b) -> e -> IO [a] -> IO (Either e b)
+firstRow f e a = second f . listToEither e <$> a
+
+-- {- ORMOLU_DISABLE -}
+-- -- SQLite.Simple only has these up to 10 fields, which is insufficient for some of our queries
+-- instance (FromField a, FromField b, FromField c, FromField d, FromField e,
+--           FromField f, FromField g, FromField h, FromField i, FromField j,
+--           FromField k) =>
+--   FromRow (a,b,c,d,e,f,g,h,i,j,k) where
+--   fromRow = (,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
+--                          <*> field <*> field <*> field <*> field <*> field
+--                          <*> field
+
+-- instance (FromField a, FromField b, FromField c, FromField d, FromField e,
+--           FromField f, FromField g, FromField h, FromField i, FromField j,
+--           FromField k, FromField l) =>
+--   FromRow (a,b,c,d,e,f,g,h,i,j,k,l) where
+--   fromRow = (,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
+--                           <*> field <*> field <*> field <*> field <*> field
+--                           <*> field <*> field
+
+-- instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
+--           ToField g, ToField h, ToField i, ToField j, ToField k, ToField l) =>
+--   ToRow (a,b,c,d,e,f,g,h,i,j,k,l) where
+--   toRow (a,b,c,d,e,f,g,h,i,j,k,l) =
+--     [ toField a, toField b, toField c, toField d, toField e, toField f,
+--       toField g, toField h, toField i, toField j, toField k, toField l
+--     ]
+
+-- {- ORMOLU_ENABLE -}
+
+-- * Server upsert helper
+
+upsertServer_ :: DB.Connection -> SMPServer -> IO ()
+upsertServer_ dbConn SMPServer {host, port, keyHash} = do
+  execute
+    dbConn
+    [sql|
+      INSERT INTO servers (host, port, key_hash) VALUES (?,?,?)
+      ON CONFLICT (host, port) DO UPDATE SET
+        host=excluded.host,
+        port=excluded.port,
+        key_hash=excluded.key_hash;
+    |]
+    (host, port, keyHash)
+
+-- * createRcvConn helpers
+
+insertRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()
+insertRcvQueue_ dbConn connId RcvQueue {..} = do
+  execute
+    dbConn
+    [sql|
+      INSERT INTO rcv_queues
+        ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status)
+      VALUES
+        (?,?,?,?,?,?,?,?,?,?);
+    |]
+    (host server, port server, rcvId, connId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status)
+
+-- * createSndConn helpers
+
+insertSndQueue_ :: DB.Connection -> ConnId -> SndQueue -> IO ()
+insertSndQueue_ dbConn connId SndQueue {..} = do
+  execute
+    dbConn
+    [sql|
+      INSERT INTO snd_queues
+        ( host, port, snd_id, conn_id, snd_private_key, e2e_dh_secret, status)
+      VALUES
+        (?,?,?,?,?,?,?);
+    |]
+    (host server, port server, DB.Binary sndId, connId, sndPrivateKey, e2eDhSecret, status)
+
+-- * getConn helpers
+
+getConn_ :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
+getConn_ dbConn connId =
+  getConnData_ dbConn connId >>= \case
+    Nothing -> pure $ Left SEConnNotFound
+    Just (connData, cMode) -> do
+      liftIO $ print "before: getRcvQueueByConnId_ dbConn connId"
+      rQ <- getRcvQueueByConnId_ dbConn connId
+      liftIO $ print $ "rQ: " <> show rQ
+      liftIO $ print "before: getSndQueueByConnId_ dbConn connId"
+      sQ <- getSndQueueByConnId_ dbConn connId
+      liftIO $ print $ "sQ: " <> show sQ
+      liftIO $ print "after: getSndQueueByConnId_ dbConn connId"
+      pure $ case (rQ, sQ, cMode) of
+        (Just rcvQ, Just sndQ, CMInvitation) -> Right $ SomeConn SCDuplex (DuplexConnection connData rcvQ sndQ)
+        (Just rcvQ, Nothing, CMInvitation) -> Right $ SomeConn SCRcv (RcvConnection connData rcvQ)
+        (Nothing, Just sndQ, CMInvitation) -> Right $ SomeConn SCSnd (SndConnection connData sndQ)
+        (Just rcvQ, Nothing, CMContact) -> Right $ SomeConn SCContact (ContactConnection connData rcvQ)
+        _ -> Left SEConnNotFound
+
+getConnData_ :: DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode))
+getConnData_ dbConn connId' =
+  connData
+    <$> DB.query dbConn "SELECT conn_id, conn_mode FROM connections WHERE conn_id = ?;" (Only connId')
+  where
+    connData [(connId, cMode)] = Just (ConnData {connId}, cMode)
+    connData _ = Nothing
+
+getRcvQueueByConnId_ :: DB.Connection -> ConnId -> IO (Maybe RcvQueue)
+getRcvQueueByConnId_ dbConn connId =
+  rcvQueue
+    <$> DB.query
+      dbConn
+      [sql|
+        SELECT s.key_hash, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret,
+          q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.status
+        FROM rcv_queues q
+        INNER JOIN servers s ON q.host = s.host AND q.port = s.port
+        WHERE q.conn_id = ?;
+      |]
+      (Only connId)
+  where
+    rcvQueue [(keyHash, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status)] =
+      let server = SMPServer host port keyHash
+       in Just RcvQueue {server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status}
+    rcvQueue _ = Nothing
+
+getSndQueueByConnId_ :: DB.Connection -> ConnId -> IO (Maybe SndQueue)
+getSndQueueByConnId_ dbConn connId = do
+  -- sndQueue
+  --   <$> DB.query
+  --     dbConn
+  --     -- [sql|
+  --     --   SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key, q.e2e_dh_secret, q.status
+  --     --   FROM snd_queues q
+  --     --   INNER JOIN servers s ON q.host = s.host AND q.port = s.port
+  --     --   WHERE q.conn_id = ?;
+  --     -- |]
+  --     [sql|
+  --       SELECT s.key_hash, q.host, q.port, q.snd_private_key, q.status
+  --       FROM snd_queues q
+  --       INNER JOIN servers s ON q.host = s.host AND q.port = s.port
+  --       WHERE q.conn_id = ?;
+  --     |]
+  --     (Only connId)
+  print "inside: getSndQueueByConnId_"
+  -- r1 <- (DB.query
+  --     dbConn
+  --     [sql|
+  --       SELECT host, port, key_hash
+  --       FROM servers
+  --       WHERE host = ?
+  --     |]
+  --     (DB.Only ("localhost" :: HostName))) :: (IO [(HostName, ServiceName, KeyHash)])
+  -- putStrLn $ show r1
+  r <- DB.query
+      dbConn
+      [sql|
+        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key, q.e2e_dh_secret, q.status
+        FROM snd_queues q
+        INNER JOIN servers s ON q.host = s.host AND q.port = s.port
+        WHERE q.conn_id = ?;
+      |]
+      -- [sql|
+      --   SELECT q.host, q.port, q.status
+      --   FROM snd_queues q
+      --   INNER JOIN servers s ON q.host = s.host AND q.port = s.port
+      --   WHERE q.conn_id = ?;
+      -- |]
+      (DB.Only connId)
+  print $ "r: " <> show r
+  let q = sndQueue r
+  print $ "q: " <> show q
+  pure q
+  where
+    sndQueue [(keyHash, host, port, DB.Binary sndId, sndPrivateKey, e2eDhSecret, status)] =
+      let server = SMPServer host port keyHash
+       in Just SndQueue {server, sndId, sndPrivateKey, e2eDhSecret, status}
+    sndQueue _ = Nothing
+    -- sndQueue [(host, port, status)] = do
+    --   let server = SMPServer host port "abcd"
+    --    in Just SndQueue {server, sndId="3456", sndPrivateKey=(C.APrivateSignKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"), e2eDhSecret="MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o=", status}
+    -- sndQueue _ = Nothing
+
+-- * updateRcvIds helpers
+
+retrieveLastIdsAndHashRcv_ :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
+retrieveLastIdsAndHashRcv_ dbConn connId = do
+  [(lastInternalId, lastInternalRcvId, lastExternalSndId, lastRcvHash)] <-
+    DB.query
+      dbConn
+      [sql|
+        SELECT last_internal_msg_id, last_internal_rcv_msg_id, last_external_snd_msg_id, last_rcv_msg_hash
+        FROM connections
+        WHERE conn_id = ?;
+      |]
+      (Only connId)
+  return (lastInternalId, lastInternalRcvId, lastExternalSndId, lastRcvHash)
+
+updateLastIdsRcv_ :: DB.Connection -> ConnId -> InternalId -> InternalRcvId -> IO ()
+updateLastIdsRcv_ dbConn connId newInternalId newInternalRcvId =
+  execute
+    dbConn
+    [sql|
+      UPDATE connections
+      SET last_internal_msg_id = :last_internal_msg_id,
+          last_internal_rcv_msg_id = :last_internal_rcv_msg_id
+      WHERE conn_id = :conn_id;
+    |]
+    (newInternalId, newInternalRcvId, connId)
+
+-- * createRcvMsg helpers
+
+insertRcvMsgBase_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
+insertRcvMsgBase_ dbConn connId RcvMsgData {msgMeta, msgType, msgBody, internalRcvId} = do
+  let MsgMeta {recipient = (internalId, internalTs)} = msgMeta
+  execute
+    dbConn
+    [sql|
+      INSERT INTO messages
+        ( conn_id, internal_id, internal_ts, internal_rcv_id, internal_snd_id, msg_type, msg_body)
+      VALUES
+        (?,?,?,?,NULL,?,?);
+    |]
+    (connId, internalId, internalTs, internalRcvId, msgType, msgBody)
+
+insertRcvMsgDetails_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
+insertRcvMsgDetails_ dbConn connId RcvMsgData {msgMeta, internalRcvId, internalHash, externalPrevSndHash} = do
+  let MsgMeta {integrity, recipient, broker, sndMsgId} = msgMeta
+  execute
+    dbConn
+    [sql|
+      INSERT INTO rcv_messages
+        ( conn_id, internal_rcv_id, internal_id, external_snd_id,
+          broker_id, broker_ts,
+          internal_hash, external_prev_snd_hash, integrity)
+      VALUES
+        (?,?,?,?,
+         ?,?,
+         ?,?,?);
+    |]
+    (connId, internalRcvId, fst recipient, sndMsgId, fst broker, snd broker, internalHash, externalPrevSndHash, integrity)
+
+updateHashRcv_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
+updateHashRcv_ dbConn connId RcvMsgData {msgMeta, internalHash, internalRcvId} =
+  execute
+    dbConn
+    -- last_internal_rcv_msg_id equality check prevents race condition in case next id was reserved
+    [sql|
+      UPDATE connections
+      SET last_external_snd_msg_id = ?,
+          last_rcv_msg_hash = ?
+      WHERE conn_id = ?
+        AND last_internal_rcv_msg_id = ?;
+    |]
+    (sndMsgId (msgMeta :: MsgMeta), internalHash, connId, internalRcvId)
+
+-- * updateSndIds helpers
+
+retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
+retrieveLastIdsAndHashSnd_ dbConn connId = do
+  [(lastInternalId, lastInternalSndId, lastSndHash)] <-
+    DB.query
+      dbConn
+      [sql|
+        SELECT last_internal_msg_id, last_internal_snd_msg_id, last_snd_msg_hash
+        FROM connections
+        WHERE conn_id = ?;
+      |]
+      (Only connId)
+  return (lastInternalId, lastInternalSndId, lastSndHash)
+
+updateLastIdsSnd_ :: DB.Connection -> ConnId -> InternalId -> InternalSndId -> IO ()
+updateLastIdsSnd_ dbConn connId newInternalId newInternalSndId =
+  execute
+    dbConn
+    [sql|
+      UPDATE connections
+      SET last_internal_msg_id = ?,
+          last_internal_snd_msg_id = ?
+      WHERE conn_id = ?;
+    |]
+    (newInternalId, newInternalSndId, connId)
+
+-- * createSndMsg helpers
+
+insertSndMsgBase_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
+insertSndMsgBase_ dbConn connId SndMsgData {..} = do
+  execute
+    dbConn
+    [sql|
+      INSERT INTO messages
+        ( conn_id, internal_id, internal_ts, internal_rcv_id, internal_snd_id, msg_type, msg_body)
+      VALUES
+        (?,?,?,NULL,?,?, ?);
+    |]
+    (connId, internalId, internalTs, internalSndId, msgType, msgBody)
+
+insertSndMsgDetails_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
+insertSndMsgDetails_ dbConn connId SndMsgData {..} =
+  execute
+    dbConn
+    [sql|
+      INSERT INTO snd_messages
+        ( conn_id, internal_snd_id, internal_id, internal_hash, previous_msg_hash)
+      VALUES
+        (?,?,?,?,?);
+    |]
+    (connId, internalSndId, internalId, internalHash, prevMsgHash)
+
+updateHashSnd_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
+updateHashSnd_ dbConn connId SndMsgData {..} =
+  execute
+    dbConn
+    -- last_internal_snd_msg_id equality check prevents race condition in case next id was reserved
+    [sql|
+      UPDATE connections
+      SET last_snd_msg_hash = ?
+      WHERE conn_id = ?
+        AND last_internal_snd_msg_id = ?;
+    |]
+    (internalHash, connId, internalSndId)
+
+-- create record with a random ID
+createWithRandomId :: TVar ChaChaDRG -> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
+createWithRandomId gVar create = tryCreate 3
+  where
+    tryCreate :: Int -> IO (Either StoreError ByteString)
+    tryCreate 0 = pure $ Left SEUniqueID
+    tryCreate n = do
+      id' <- randomId gVar 12
+      E.try (create id') >>= \case
+        Right _ -> pure $ Right id'
+        Left e -> case constraintViolation e of
+          Just _ -> tryCreate (n - 1)
+          Nothing -> pure . Left . SEInternal $ bshow e
+
+randomId :: TVar ChaChaDRG -> Int -> IO ByteString
+randomId gVar n = U.encode <$> (atomically . stateTVar gVar $ randomBytesGenerate n)

src/Simplex/Messaging/Agent/Store/Postgres/Migrations.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations
+  ( Migration (..),
+    app,
+    initialize,
+    get,
+    run,
+  )
+where
+
+import Control.Monad (forM_, void)
+import Data.Function (on)
+import Data.List (intercalate, sortBy)
+import Data.Time.Clock (getCurrentTime)
+import Database.PostgreSQL.Simple (Connection, Only (..))
+import qualified Database.PostgreSQL.Simple as DB
+import Database.PostgreSQL.Simple.Internal (exec)
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.Transaction (withTransaction)
+import Database.PostgreSQL.Simple.Types (Query (..))
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20220202_initial (m20220202_initial)
+
+data Migration = Migration {name :: String, up :: Query}
+  deriving (Show)
+
+schemaMigrations :: [(String, Query)]
+schemaMigrations =
+  [ ("20220101_initial", m20220202_initial)
+  ]
+
+-- | The list of migrations in ascending order by date
+app :: [Migration]
+app = sortBy (compare `on` name) $ map migration schemaMigrations
+  where
+    migration (name, query) = Migration {name, up = query}
+
+get :: Connection -> [Migration] -> IO (Either String [Migration])
+get conn migrations =
+  migrationsToRun migrations . map fromOnly
+    <$> DB.query_ conn "SELECT name FROM migrations ORDER BY name ASC;"
+
+run :: Connection -> [Migration] -> IO ()
+run conn ms = withTransaction conn . forM_ ms $
+  \Migration {name, up} -> insert name >> exec conn (fromQuery up)
+  where
+    insert name = DB.execute conn "INSERT INTO migrations (name, ts) VALUES (?, ?);" . (name,) =<< getCurrentTime
+
+initialize :: Connection -> IO ()
+initialize conn =
+  void $
+    DB.execute_
+      conn
+      [sql|
+    CREATE TABLE IF NOT EXISTS migrations (
+      name TEXT NOT NULL,
+      ts TEXT NOT NULL,
+      PRIMARY KEY (name)
+    );
+  |]
+
+migrationsToRun :: [Migration] -> [String] -> Either String [Migration]
+migrationsToRun appMs [] = Right appMs
+migrationsToRun [] dbMs = Left $ "database version is newer than the app: " <> intercalate ", " dbMs
+migrationsToRun (a : as) (d : ds)
+  | name a == d = migrationsToRun as ds
+  | otherwise = Left $ "different migration in the app/database: " <> name a <> " / " <> d

src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20220202_initial.hs

@@ -0,0 +1,158 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20220202_initial where
+
+import Database.PostgreSQL.Simple (Query)
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+
+m20220202_initial :: Query
+m20220202_initial =
+  [sql|
+-- for easy testing
+DROP SCHEMA public CASCADE;
+CREATE SCHEMA public;
+
+CREATE TABLE servers (
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  key_hash BYTEA NOT NULL,
+  PRIMARY KEY (host, port)
+);
+
+CREATE TABLE connections (
+  conn_id BYTEA NOT NULL PRIMARY KEY,
+  conn_mode TEXT NOT NULL,
+  last_internal_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_internal_rcv_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_internal_snd_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_external_snd_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_rcv_msg_hash BYTEA NOT NULL DEFAULT '',
+  last_snd_msg_hash BYTEA NOT NULL DEFAULT '',
+  smp_agent_version INTEGER NOT NULL DEFAULT 1
+);
+
+CREATE TABLE rcv_queues (
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  rcv_id BYTEA NOT NULL,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  rcv_private_key BYTEA NOT NULL,
+  rcv_dh_secret BYTEA NOT NULL,
+  e2e_priv_key BYTEA NOT NULL,
+  e2e_dh_secret BYTEA,
+  snd_id BYTEA NOT NULL,
+  snd_key BYTEA,
+  status TEXT NOT NULL,
+  smp_server_version INTEGER NOT NULL DEFAULT 1,
+  smp_client_version INTEGER,
+  PRIMARY KEY (host, port, rcv_id),
+  FOREIGN KEY (host, port) REFERENCES servers
+    ON DELETE RESTRICT ON UPDATE CASCADE,
+  UNIQUE (host, port, snd_id)
+);
+
+CREATE TABLE snd_queues (
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  snd_id BYTEA NOT NULL,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  snd_private_key BYTEA NOT NULL,
+  e2e_dh_secret BYTEA NOT NULL,
+  status TEXT NOT NULL,
+  smp_server_version INTEGER NOT NULL DEFAULT 1,
+  smp_client_version INTEGER NOT NULL DEFAULT 1,
+  PRIMARY KEY (host, port, snd_id),
+  FOREIGN KEY (host, port) REFERENCES servers
+    ON DELETE RESTRICT ON UPDATE CASCADE
+);
+
+CREATE TABLE messages (
+  conn_id BYTEA NOT NULL REFERENCES connections (conn_id)
+    ON DELETE CASCADE,
+  internal_id INTEGER NOT NULL,
+  internal_ts TIMESTAMP NOT NULL,
+  internal_rcv_id INTEGER,
+  internal_snd_id INTEGER,
+  msg_type BYTEA NOT NULL, -- (H)ELLO, (R)EPLY, (D)ELETE. Should SMP confirmation be saved too?
+  msg_body BYTEA NOT NULL DEFAULT '',
+  PRIMARY KEY (conn_id, internal_id)
+);
+
+CREATE TABLE rcv_messages (
+  conn_id BYTEA NOT NULL,
+  internal_rcv_id INTEGER NOT NULL,
+  internal_id INTEGER NOT NULL,
+  external_snd_id INTEGER NOT NULL,
+  broker_id BYTEA NOT NULL,
+  broker_ts TIMESTAMP NOT NULL,
+  internal_hash BYTEA NOT NULL,
+  external_prev_snd_hash BYTEA NOT NULL,
+  integrity BYTEA NOT NULL, -- in the list of keywords
+  PRIMARY KEY (conn_id, internal_rcv_id),
+  FOREIGN KEY (conn_id, internal_id) REFERENCES messages
+    ON DELETE CASCADE
+);
+
+ALTER TABLE messages
+ADD CONSTRAINT fk_messages_rcv_messages
+  FOREIGN KEY (conn_id, internal_rcv_id) REFERENCES rcv_messages
+  ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED;
+
+CREATE TABLE snd_messages (
+  conn_id BYTEA NOT NULL,
+  internal_snd_id INTEGER NOT NULL,
+  internal_id INTEGER NOT NULL,
+  internal_hash BYTEA NOT NULL,
+  previous_msg_hash BYTEA NOT NULL DEFAULT '',
+  PRIMARY KEY (conn_id, internal_snd_id),
+  FOREIGN KEY (conn_id, internal_id) REFERENCES messages
+    ON DELETE CASCADE
+);
+
+ALTER TABLE messages
+ADD CONSTRAINT fk_messages_snd_messages
+  FOREIGN KEY (conn_id, internal_snd_id) REFERENCES snd_messages
+  ON DELETE CASCADE DEFERRABLE INITIALLY deferred;
+
+CREATE TABLE conn_confirmations (
+  confirmation_id BYTEA NOT NULL PRIMARY KEY,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  e2e_snd_pub_key BYTEA NOT NULL, -- TODO per-queue key. Split?
+  sender_key BYTEA NOT NULL, -- TODO per-queue key. Split?
+  ratchet_state BYTEA NOT NULL,
+  sender_conn_info BYTEA NOT NULL,
+  accepted INTEGER NOT NULL,
+  own_conn_info BYTEA,
+  created_at TIMESTAMP NOT NULL DEFAULT (now())
+);
+
+CREATE TABLE conn_invitations (
+  invitation_id BYTEA NOT NULL PRIMARY KEY,
+  contact_conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  cr_invitation BYTEA NOT NULL,
+  recipient_conn_info BYTEA NOT NULL,
+  accepted INTEGER NOT NULL DEFAULT 0,
+  own_conn_info BYTEA,
+  created_at TIMESTAMP NOT NULL DEFAULT (now())
+);
+
+CREATE TABLE ratchets (
+  conn_id BYTEA NOT NULL PRIMARY KEY REFERENCES connections
+    ON DELETE CASCADE,
+  -- x3dh keys are not saved on the sending side (the side accepting the connection)
+  x3dh_priv_key_1 BYTEA,
+  x3dh_priv_key_2 BYTEA,
+  -- ratchet is initially empty on the receiving side (the side offering the connection)
+  ratchet_state BYTEA,
+  e2e_version INTEGER NOT NULL DEFAULT 1
+);
+
+CREATE TABLE skipped_messages (
+  skipped_message_id INTEGER PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  conn_id BYTEA NOT NULL REFERENCES ratchets
+    ON DELETE CASCADE,
+  header_key BYTEA NOT NULL,
+  msg_n INTEGER NOT NULL,
+  msg_key BYTEA NOT NULL
+);
+|]

src/Simplex/Messaging/Agent/Store/Postgres/README.md

@@ -0,0 +1,9 @@
+# Postgres setup
+
+Create three databases - `agent_poc_1`, `agent_poc_2`, `agent_poc_3` - and have Postgres server running.
+
+~~`brew install postgresql` - required by postgresql-simple.~~
+
+~~You may run into compilation errors, then you might also need to `brew install libpq --build-from-source`, see [this Stack Overflow answer](https://stackoverflow.com/a/70012033).~~
+
+In the end I managed to build using cabal.

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -23,6 +23,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     withConnection,
     withTransaction,
     fromTextField_,
+    firstRow,
   )
 where
 
@@ -32,11 +33,13 @@ import Control.Exception (bracket)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Crypto.Random (ChaChaDRG, randomBytesGenerate)
+import Data.Bifunctor (second)
 import Data.ByteString (ByteString)
-import Data.ByteString.Base64 (encode)
+import qualified Data.ByteString.Base64.URL as U
 import Data.Char (toLower)
-import Data.List (find)
-import Data.Maybe (fromMaybe)
+import Data.Functor (($>))
+import Data.List (find, foldl')
+import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
@@ -47,11 +50,14 @@ import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.QQ (sql)
 import Database.SQLite.Simple.ToField (ToField (..))
-import Network.Socket (ServiceName)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration)
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldParser)
 import Simplex.Messaging.Protocol (MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
@@ -60,7 +66,6 @@ import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (takeDirectory)
 import System.IO (hFlush, stdout)
-import Text.Read (readMaybe)
 import qualified UnliftIO.Exception as E
 
 -- * SQLite Store implementation
@@ -150,56 +155,50 @@ withTransaction st action = withConnection st $ loop 100 100_000
             loop (t * 9 `div` 8) (tLim - t) db
           else E.throwIO e
 
+createConn_ ::
+  (MonadUnliftIO m, MonadError StoreError m) =>
+  SQLiteStore ->
+  TVar ChaChaDRG ->
+  ConnData ->
+  (DB.Connection -> ByteString -> IO ()) ->
+  m ByteString
+createConn_ st gVar cData create =
+  liftIOEither . checkConstraint SEConnDuplicate . withTransaction st $ \db ->
+    case cData of
+      ConnData {connId = ""} -> createWithRandomId gVar $ create db
+      ConnData {connId} -> create db connId $> Right connId
+
 instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteStore m where
   createRcvConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> RcvQueue -> SConnectionMode c -> m ConnId
   createRcvConn st gVar cData q@RcvQueue {server} cMode =
-    -- TODO if schema has to be restarted, this function can be refactored
-    -- to create connection first using createWithRandomId
-    liftIOEither . checkConstraint SEConnDuplicate . withTransaction st $ \db ->
-      getConnId_ db gVar cData >>= traverse (create db)
-    where
-      create :: DB.Connection -> ConnId -> IO ConnId
-      create db connId = do
-        upsertServer_ db server
-        insertRcvQueue_ db connId q
-        insertRcvConnection_ db cData {connId} q cMode
-        pure connId
+    createConn_ st gVar cData $ \db connId -> do
+      upsertServer_ db server
+      DB.execute db "INSERT INTO connections (conn_id, conn_mode) VALUES (?, ?)" (connId, cMode)
+      insertRcvQueue_ db connId q
 
   createSndConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> SndQueue -> m ConnId
   createSndConn st gVar cData q@SndQueue {server} =
-    -- TODO if schema has to be restarted, this function can be refactored
-    -- to create connection first using createWithRandomId
-    liftIOEither . checkConstraint SEConnDuplicate . withTransaction st $ \db ->
-      getConnId_ db gVar cData >>= traverse (create db)
-    where
-      create :: DB.Connection -> ConnId -> IO ConnId
-      create db connId = do
-        upsertServer_ db server
-        insertSndQueue_ db connId q
-        insertSndConnection_ db cData {connId} q
-        pure connId
+    createConn_ st gVar cData $ \db connId -> do
+      upsertServer_ db server
+      DB.execute db "INSERT INTO connections (conn_id, conn_mode) VALUES (?, ?)" (connId, SCMInvitation)
+      insertSndQueue_ db connId q
 
   getConn :: SQLiteStore -> ConnId -> m SomeConn
   getConn st connId =
     liftIOEither . withTransaction st $ \db ->
       getConn_ db connId
 
-  getAllConnIds :: SQLiteStore -> m [ConnId]
-  getAllConnIds st =
-    liftIO . withTransaction st $ \db ->
-      concat <$> (DB.query_ db "SELECT conn_alias FROM connections;" :: IO [[ConnId]])
-
   getRcvConn :: SQLiteStore -> SMPServer -> SMP.RecipientId -> m SomeConn
   getRcvConn st SMPServer {host, port} rcvId =
     liftIOEither . withTransaction st $ \db ->
       DB.queryNamed
         db
         [sql|
-          SELECT q.conn_alias
+          SELECT q.conn_id
           FROM rcv_queues q
           WHERE q.host = :host AND q.port = :port AND q.rcv_id = :rcv_id;
         |]
-        [":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId]
+        [":host" := host, ":port" := port, ":rcv_id" := rcvId]
         >>= \case
           [Only connId] -> getConn_ db connId
           _ -> pure $ Left SEConnNotFound
@@ -209,8 +208,8 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
     liftIO . withTransaction st $ \db ->
       DB.executeNamed
         db
-        "DELETE FROM connections WHERE conn_alias = :conn_alias;"
-        [":conn_alias" := connId]
+        "DELETE FROM connections WHERE conn_id = :conn_id;"
+        [":conn_id" := connId]
 
   upgradeRcvConnToDuplex :: SQLiteStore -> ConnId -> SndQueue -> m ()
   upgradeRcvConnToDuplex st connId sq@SndQueue {server} =
@@ -219,7 +218,6 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         Right (SomeConn _ RcvConnection {}) -> do
           upsertServer_ db server
           insertSndQueue_ db connId sq
-          updateConnWithSndQueue_ db connId sq
           pure $ Right ()
         Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
         _ -> pure $ Left SEConnNotFound
@@ -231,7 +229,6 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         Right (SomeConn _ SndConnection {}) -> do
           upsertServer_ db server
           insertRcvQueue_ db connId rq
-          updateConnWithRcvQueue_ db connId rq
           pure $ Right ()
         Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
         _ -> pure $ Left SEConnNotFound
@@ -247,23 +244,23 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
           SET status = :status
           WHERE host = :host AND port = :port AND rcv_id = :rcv_id;
         |]
-        [":status" := status, ":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId]
+        [":status" := status, ":host" := host, ":port" := port, ":rcv_id" := rcvId]
 
-  setRcvQueueActive :: SQLiteStore -> RcvQueue -> VerificationKey -> m ()
-  setRcvQueueActive st RcvQueue {rcvId, server = SMPServer {host, port}} verifyKey =
-    -- ? throw error if queue does not exist?
+  setRcvQueueConfirmedE2E :: SQLiteStore -> RcvQueue -> C.DhSecretX25519 -> m ()
+  setRcvQueueConfirmedE2E st RcvQueue {rcvId, server = SMPServer {host, port}} e2eDhSecret =
     liftIO . withTransaction st $ \db ->
       DB.executeNamed
         db
         [sql|
           UPDATE rcv_queues
-          SET verify_key = :verify_key, status = :status
-          WHERE host = :host AND port = :port AND rcv_id = :rcv_id;
+          SET e2e_dh_secret = :e2e_dh_secret,
+              status = :status
+          WHERE host = :host AND port = :port AND rcv_id = :rcv_id
         |]
-        [ ":verify_key" := Just verifyKey,
-          ":status" := Active,
+        [ ":status" := Confirmed,
+          ":e2e_dh_secret" := e2eDhSecret,
           ":host" := host,
-          ":port" := serializePort_ port,
+          ":port" := port,
           ":rcv_id" := rcvId
         ]
 
@@ -278,31 +275,19 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
           SET status = :status
           WHERE host = :host AND port = :port AND snd_id = :snd_id;
         |]
-        [":status" := status, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId]
-
-  updateSignKey :: SQLiteStore -> SndQueue -> SignatureKey -> m ()
-  updateSignKey st SndQueue {sndId, server = SMPServer {host, port}} signatureKey =
-    liftIO . withTransaction st $ \db ->
-      DB.executeNamed
-        db
-        [sql|
-          UPDATE snd_queues
-          SET sign_key = :sign_key
-          WHERE host = :host AND port = :port AND snd_id = :snd_id;
-        |]
-        [":sign_key" := signatureKey, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId]
+        [":status" := status, ":host" := host, ":port" := port, ":snd_id" := sndId]
 
   createConfirmation :: SQLiteStore -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
-  createConfirmation st gVar NewConfirmation {connId, senderKey, senderConnInfo} =
+  createConfirmation st gVar NewConfirmation {connId, senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo}, ratchetState} =
     liftIOEither . withTransaction st $ \db ->
       createWithRandomId gVar $ \confirmationId ->
         DB.execute
           db
           [sql|
             INSERT INTO conn_confirmations
-            (confirmation_id, conn_alias, sender_key, sender_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
+            (confirmation_id, conn_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, accepted) VALUES (?, ?, ?, ?, ?, ?, 0);
           |]
-          (confirmationId, connId, senderKey, senderConnInfo)
+          (confirmationId, connId, senderKey, e2ePubKey, ratchetState, connInfo)
 
   acceptConfirmation :: SQLiteStore -> ConfirmationId -> ConnInfo -> m AcceptedConfirmation
   acceptConfirmation st confirmationId ownConnInfo =
@@ -318,36 +303,46 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         [ ":own_conn_info" := ownConnInfo,
           ":confirmation_id" := confirmationId
         ]
-      confirmation
-        <$> DB.query
+      firstRow confirmation SEConfirmationNotFound $
+        DB.query
           db
           [sql|
-            SELECT conn_alias, sender_key, sender_conn_info
+            SELECT conn_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info
             FROM conn_confirmations
             WHERE confirmation_id = ?;
           |]
           (Only confirmationId)
     where
-      confirmation [(connId, senderKey, senderConnInfo)] =
-        Right $ AcceptedConfirmation {confirmationId, connId, senderKey, senderConnInfo, ownConnInfo}
-      confirmation _ = Left SEConfirmationNotFound
+      confirmation (connId, senderKey, e2ePubKey, ratchetState, connInfo) =
+        AcceptedConfirmation
+          { confirmationId,
+            connId,
+            senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo},
+            ratchetState,
+            ownConnInfo
+          }
 
   getAcceptedConfirmation :: SQLiteStore -> ConnId -> m AcceptedConfirmation
   getAcceptedConfirmation st connId =
     liftIOEither . withTransaction st $ \db ->
-      confirmation
-        <$> DB.query
+      firstRow confirmation SEConfirmationNotFound $
+        DB.query
           db
           [sql|
-            SELECT confirmation_id, sender_key, sender_conn_info, own_conn_info
+            SELECT confirmation_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, own_conn_info
             FROM conn_confirmations
-            WHERE conn_alias = ? AND accepted = 1;
+            WHERE conn_id = ? AND accepted = 1;
           |]
           (Only connId)
     where
-      confirmation [(confirmationId, senderKey, senderConnInfo, ownConnInfo)] =
-        Right $ AcceptedConfirmation {confirmationId, connId, senderKey, senderConnInfo, ownConnInfo}
-      confirmation _ = Left SEConfirmationNotFound
+      confirmation (confirmationId, senderKey, e2ePubKey, ratchetState, connInfo, ownConnInfo) =
+        AcceptedConfirmation
+          { confirmationId,
+            connId,
+            senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo},
+            ratchetState,
+            ownConnInfo
+          }
 
   removeConfirmations :: SQLiteStore -> ConnId -> m ()
   removeConfirmations st connId =
@@ -356,9 +351,9 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         db
         [sql|
           DELETE FROM conn_confirmations
-          WHERE conn_alias = :conn_alias;
+          WHERE conn_id = :conn_id;
         |]
-        [":conn_alias" := connId]
+        [":conn_id" := connId]
 
   createInvitation :: SQLiteStore -> TVar ChaChaDRG -> NewInvitation -> m InvitationId
   createInvitation st gVar NewInvitation {contactConnId, connReq, recipientConnInfo} =
@@ -375,8 +370,8 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
   getInvitation :: SQLiteStore -> InvitationId -> m Invitation
   getInvitation st invitationId =
     liftIOEither . withTransaction st $ \db ->
-      invitation
-        <$> DB.query
+      firstRow invitation SEInvitationNotFound $
+        DB.query
           db
           [sql|
             SELECT contact_conn_id, cr_invitation, recipient_conn_info, own_conn_info, accepted
@@ -386,9 +381,8 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
           |]
           (Only invitationId)
     where
-      invitation [(contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted)] =
-        Right Invitation {invitationId, contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted}
-      invitation _ = Left SEInvitationNotFound
+      invitation (contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted) =
+        Invitation {invitationId, contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted}
 
   acceptInvitation :: SQLiteStore -> InvitationId -> ConnInfo -> m ()
   acceptInvitation st invitationId ownConnInfo =
@@ -446,53 +440,28 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
       insertSndMsgDetails_ db connId sndMsgData
       updateHashSnd_ db connId sndMsgData
 
-  updateSndMsgStatus :: SQLiteStore -> ConnId -> InternalId -> SndMsgStatus -> m ()
-  updateSndMsgStatus st connId msgId msgStatus =
-    liftIO . withTransaction st $ \db ->
-      DB.executeNamed
-        db
-        [sql|
-          UPDATE snd_messages
-          SET snd_status = :snd_status
-          WHERE conn_alias = :conn_alias AND internal_id = :internal_id
-        |]
-        [ ":conn_alias" := connId,
-          ":internal_id" := msgId,
-          ":snd_status" := msgStatus
-        ]
-
-  getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m (SndQueue, MsgBody)
+  getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m (Maybe RcvQueue, (AMsgType, MsgBody, InternalTs))
   getPendingMsgData st connId msgId =
     liftIOEither . withTransaction st $ \db -> runExceptT $ do
-      sq <- ExceptT $ sndQueue <$> getSndQueueByConnAlias_ db connId
-      msgBody <-
-        ExceptT $
-          sndMsgData
-            <$> DB.query
-              db
-              [sql|
-                SELECT m.msg_body
+      rq_ <- liftIO $ getRcvQueueByConnId_ db connId
+      msgData <-
+        ExceptT . firstRow id SEMsgNotFound $
+          DB.query
+            db
+            [sql|
+                SELECT m.msg_type, m.msg_body, m.internal_ts
                 FROM messages m
-                JOIN snd_messages s ON s.conn_alias = m.conn_alias AND s.internal_id = m.internal_id
-                WHERE m.conn_alias = ? AND m.internal_id = ?
+                JOIN snd_messages s ON s.conn_id = m.conn_id AND s.internal_id = m.internal_id
+                WHERE m.conn_id = ? AND m.internal_id = ?
               |]
-              (connId, msgId)
-      pure (sq, msgBody)
-    where
-      sndMsgData :: [Only MsgBody] -> Either StoreError MsgBody
-      sndMsgData [Only msgBody] = Right msgBody
-      sndMsgData _ = Left SEMsgNotFound
-      sndQueue :: Maybe SndQueue -> Either StoreError SndQueue
-      sndQueue = maybe (Left SEConnNotFound) Right
+            (connId, msgId)
+      pure (rq_, msgData)
 
-  getPendingMsgs :: SQLiteStore -> ConnId -> m [PendingMsg]
+  getPendingMsgs :: SQLiteStore -> ConnId -> m [InternalId]
   getPendingMsgs st connId =
     liftIO . withTransaction st $ \db ->
-      map (PendingMsg connId . fromOnly)
-        <$> DB.query db "SELECT internal_id FROM snd_messages WHERE conn_alias = ? AND snd_status = ?" (connId, SndMsgCreated)
-
-  getMsg :: SQLiteStore -> ConnId -> InternalId -> m Msg
-  getMsg _st _connId _id = throwError SENotImplemented
+      map fromOnly
+        <$> DB.query db "SELECT internal_id FROM snd_messages WHERE conn_id = ?" (Only connId)
 
   checkRcvMsg :: SQLiteStore -> ConnId -> InternalId -> m ()
   checkRcvMsg st connId msgId =
@@ -501,40 +470,88 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         <$> DB.query
           db
           [sql|
-            SELECT conn_alias, internal_id
+            SELECT conn_id, internal_id
             FROM rcv_messages
-            WHERE conn_alias = ? AND internal_id = ?
+            WHERE conn_id = ? AND internal_id = ?
           |]
           (connId, msgId)
     where
       hasMsg :: [(ConnId, InternalId)] -> Either StoreError ()
       hasMsg r = if null r then Left SEMsgNotFound else Right ()
 
-  updateRcvMsgAck :: SQLiteStore -> ConnId -> InternalId -> m ()
-  updateRcvMsgAck st connId msgId =
+  deleteMsg :: SQLiteStore -> ConnId -> InternalId -> m ()
+  deleteMsg st connId msgId =
+    liftIO . withTransaction st $ \db ->
+      DB.execute db "DELETE FROM messages WHERE conn_id = ? AND internal_id = ?;" (connId, msgId)
+
+  createRatchetX3dhKeys :: SQLiteStore -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> m ()
+  createRatchetX3dhKeys st connId x3dhPrivKey1 x3dhPrivKey2 =
+    liftIO . withTransaction st $ \db ->
+      DB.execute db "INSERT INTO ratchets (conn_id, x3dh_priv_key_1, x3dh_priv_key_2) VALUES (?, ?, ?)" (connId, x3dhPrivKey1, x3dhPrivKey2)
+
+  getRatchetX3dhKeys :: SQLiteStore -> ConnId -> m (C.PrivateKeyX448, C.PrivateKeyX448)
+  getRatchetX3dhKeys st connId =
+    liftIOEither . withTransaction st $ \db ->
+      fmap hasKeys $
+        firstRow id SEX3dhKeysNotFound $
+          DB.query db "SELECT x3dh_priv_key_1, x3dh_priv_key_2 FROM ratchets WHERE conn_id = ?" (Only connId)
+    where
+      hasKeys = \case
+        Right (Just k1, Just k2) -> Right (k1, k2)
+        _ -> Left SEX3dhKeysNotFound
+
+  createRatchet :: SQLiteStore -> ConnId -> RatchetX448 -> m ()
+  createRatchet st connId rc =
     liftIO . withTransaction st $ \db -> do
-      DB.execute
+      DB.executeNamed
         db
         [sql|
-          UPDATE rcv_messages
-          SET rcv_status = ?, ack_brocker_ts = datetime('now')
-          WHERE conn_alias = ? AND internal_id = ?
+          INSERT INTO ratchets (conn_id, ratchet_state)
+          VALUES (:conn_id, :ratchet_state)
+          ON CONFLICT (conn_id) DO UPDATE SET
+            ratchet_state = :ratchet_state,
+            x3dh_priv_key_1 = NULL,
+            x3dh_priv_key_2 = NULL
         |]
-        (AcknowledgedToBroker, connId, msgId)
+        [":conn_id" := connId, ":ratchet_state" := rc]
+
+  getRatchet :: SQLiteStore -> ConnId -> m RatchetX448
+  getRatchet st connId =
+    liftIOEither . withTransaction st $ \db ->
+      ratchet
+        <$> DB.query db "SELECT ratchet_state FROM ratchets WHERE conn_id = ?" (Only connId)
+    where
+      ratchet (Only (Just rc) : _) = Right rc
+      ratchet _ = Left SERatchetNotFound
+
+  getSkippedMsgKeys :: SQLiteStore -> ConnId -> m SkippedMsgKeys
+  getSkippedMsgKeys st connId =
+    liftIO . withTransaction st $ \db ->
+      skipped <$> DB.query db "SELECT header_key, msg_n, msg_key FROM skipped_messages WHERE conn_id = ?" (Only connId)
+    where
+      skipped ms = foldl' addSkippedKey M.empty ms
+      addSkippedKey smks (hk, msgN, mk) = M.alter (Just . addMsgKey) hk smks
+        where
+          addMsgKey = maybe (M.singleton msgN mk) (M.insert msgN mk)
+
+  updateRatchet :: SQLiteStore -> ConnId -> RatchetX448 -> SkippedMsgDiff -> m ()
+  updateRatchet st connId rc skipped =
+    liftIO . withTransaction st $ \db -> do
+      DB.execute db "UPDATE ratchets SET ratchet_state = ? WHERE conn_id = ?" (rc, connId)
+      case skipped of
+        SMDNoChange -> pure ()
+        SMDRemove hk msgN ->
+          DB.execute db "DELETE FROM skipped_messages WHERE conn_id = ? AND header_key = ? AND msg_n = ?" (connId, hk, msgN)
+        SMDAdd smks ->
+          forM_ (M.assocs smks) $ \(hk, mks) ->
+            forM_ (M.assocs mks) $ \(msgN, mk) ->
+              DB.execute db "INSERT INTO skipped_messages (conn_id, header_key, msg_n, msg_key) VALUES (?, ?, ?, ?)" (connId, hk, msgN, mk)
 
 -- * Auxiliary helpers
 
--- ? replace with ToField? - it's easy to forget to use this
-serializePort_ :: Maybe ServiceName -> ServiceName
-serializePort_ = fromMaybe "_"
+instance ToField QueueStatus where toField = toField . serializeQueueStatus
 
-deserializePort_ :: ServiceName -> Maybe ServiceName
-deserializePort_ "_" = Nothing
-deserializePort_ port = Just port
-
-instance ToField QueueStatus where toField = toField . show
-
-instance FromField QueueStatus where fromField = fromTextField_ $ readMaybe . T.unpack
+instance FromField QueueStatus where fromField = fromTextField_ queueStatusT
 
 instance ToField InternalRcvId where toField (InternalRcvId x) = toField x
 
@@ -548,27 +565,27 @@ instance ToField InternalId where toField (InternalId x) = toField x
 
 instance FromField InternalId where fromField x = InternalId <$> fromField x
 
-instance ToField RcvMsgStatus where toField = toField . show
+instance ToField AMsgType where toField = toField . smpEncode
 
-instance ToField SndMsgStatus where toField = toField . show
+instance FromField AMsgType where fromField = blobFieldParser smpP
 
-instance ToField MsgIntegrity where toField = toField . serializeMsgIntegrity
+instance ToField MsgIntegrity where toField = toField . strEncode
 
-instance FromField MsgIntegrity where fromField = blobFieldParser msgIntegrityP
+instance FromField MsgIntegrity where fromField = blobFieldParser strP
 
-instance ToField SMPQueueUri where toField = toField . serializeSMPQueueUri
+instance ToField SMPQueueUri where toField = toField . strEncode
 
-instance FromField SMPQueueUri where fromField = blobFieldParser smpQueueUriP
+instance FromField SMPQueueUri where fromField = blobFieldParser strP
 
-instance ToField AConnectionRequest where toField = toField . serializeConnReq
+instance ToField AConnectionRequestUri where toField = toField . strEncode
 
-instance FromField AConnectionRequest where fromField = blobFieldParser connReqP
+instance FromField AConnectionRequestUri where fromField = blobFieldParser strP
 
-instance ToField (ConnectionRequest c) where toField = toField . serializeConnReq'
+instance ConnectionModeI c => ToField (ConnectionRequestUri c) where toField = toField . strEncode
 
-instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequest c) where fromField = blobFieldParser connReqP'
+instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequestUri c) where fromField = blobFieldParser strP
 
-instance ToField ConnectionMode where toField = toField . decodeLatin1 . serializeConnMode'
+instance ToField ConnectionMode where toField = toField . decodeLatin1 . strEncode
 
 instance FromField ConnectionMode where fromField = fromTextField_ connModeT
 
@@ -584,6 +601,13 @@ fromTextField_ fromText = \case
       _ -> returnError ConversionFailed f ("invalid text: " <> T.unpack t)
   f -> returnError ConversionFailed f "expecting SQLText column type"
 
+listToEither :: e -> [a] -> Either e a
+listToEither _ (x : _) = Right x
+listToEither e _ = Left e
+
+firstRow :: (a -> b) -> e -> IO [a] -> IO (Either e b)
+firstRow f e a = second f . listToEither e <$> a
+
 {- ORMOLU_DISABLE -}
 -- SQLite.Simple only has these up to 10 fields, which is insufficient for some of our queries
 instance (FromField a, FromField b, FromField c, FromField d, FromField e,
@@ -609,13 +633,13 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
     [ toField a, toField b, toField c, toField d, toField e, toField f,
       toField g, toField h, toField i, toField j, toField k, toField l
     ]
+
 {- ORMOLU_ENABLE -}
 
 -- * Server upsert helper
 
 upsertServer_ :: DB.Connection -> SMPServer -> IO ()
 upsertServer_ dbConn SMPServer {host, port, keyHash} = do
-  let port_ = serializePort_ port
   DB.executeNamed
     dbConn
     [sql|
@@ -625,92 +649,53 @@ upsertServer_ dbConn SMPServer {host, port, keyHash} = do
         port=excluded.port,
         key_hash=excluded.key_hash;
     |]
-    [":host" := host, ":port" := port_, ":key_hash" := keyHash]
+    [":host" := host, ":port" := port, ":key_hash" := keyHash]
 
 -- * createRcvConn helpers
 
 insertRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()
 insertRcvQueue_ dbConn connId RcvQueue {..} = do
-  let port_ = serializePort_ $ port server
   DB.executeNamed
     dbConn
     [sql|
       INSERT INTO rcv_queues
-        ( host, port, rcv_id, conn_alias, rcv_private_key, snd_id, decrypt_key, verify_key, status)
+        ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status)
       VALUES
-        (:host,:port,:rcv_id,:conn_alias,:rcv_private_key,:snd_id,:decrypt_key,:verify_key,:status);
+        (:host,:port,:rcv_id,:conn_id,:rcv_private_key,:rcv_dh_secret,:e2e_priv_key,:e2e_dh_secret,:snd_id,:status);
     |]
     [ ":host" := host server,
-      ":port" := port_,
+      ":port" := port server,
       ":rcv_id" := rcvId,
-      ":conn_alias" := connId,
+      ":conn_id" := connId,
       ":rcv_private_key" := rcvPrivateKey,
+      ":rcv_dh_secret" := rcvDhSecret,
+      ":e2e_priv_key" := e2ePrivKey,
+      ":e2e_dh_secret" := e2eDhSecret,
       ":snd_id" := sndId,
-      ":decrypt_key" := decryptKey,
-      ":verify_key" := verifyKey,
       ":status" := status
     ]
 
-insertRcvConnection_ :: DB.Connection -> ConnData -> RcvQueue -> SConnectionMode c -> IO ()
-insertRcvConnection_ dbConn ConnData {connId} RcvQueue {server, rcvId} cMode = do
-  let port_ = serializePort_ $ port server
-  DB.executeNamed
-    dbConn
-    [sql|
-      INSERT INTO connections
-        ( conn_alias, rcv_host, rcv_port, rcv_id, snd_host, snd_port, snd_id, last_internal_msg_id, last_internal_rcv_msg_id, last_internal_snd_msg_id, last_external_snd_msg_id, last_rcv_msg_hash, last_snd_msg_hash,
-          conn_mode )
-      VALUES
-        (:conn_alias,:rcv_host,:rcv_port,:rcv_id, NULL,     NULL,     NULL, 0, 0, 0, 0, x'', x'',
-         :conn_mode );
-    |]
-    [ ":conn_alias" := connId,
-      ":rcv_host" := host server,
-      ":rcv_port" := port_,
-      ":rcv_id" := rcvId,
-      ":conn_mode" := cMode
-    ]
-
 -- * createSndConn helpers
 
 insertSndQueue_ :: DB.Connection -> ConnId -> SndQueue -> IO ()
 insertSndQueue_ dbConn connId SndQueue {..} = do
-  let port_ = serializePort_ $ port server
   DB.executeNamed
     dbConn
     [sql|
       INSERT INTO snd_queues
-        ( host, port, snd_id, conn_alias, snd_private_key, encrypt_key, sign_key, status)
+        ( host, port, snd_id, conn_id, snd_private_key, e2e_dh_secret, status)
       VALUES
-        (:host,:port,:snd_id,:conn_alias,:snd_private_key,:encrypt_key,:sign_key,:status);
+        (:host,:port,:snd_id,:conn_id,:snd_private_key,:e2e_dh_secret,:status);
     |]
     [ ":host" := host server,
-      ":port" := port_,
+      ":port" := port server,
       ":snd_id" := sndId,
-      ":conn_alias" := connId,
+      ":conn_id" := connId,
       ":snd_private_key" := sndPrivateKey,
-      ":encrypt_key" := encryptKey,
-      ":sign_key" := signKey,
+      ":e2e_dh_secret" := e2eDhSecret,
       ":status" := status
     ]
 
-insertSndConnection_ :: DB.Connection -> ConnData -> SndQueue -> IO ()
-insertSndConnection_ dbConn ConnData {connId} SndQueue {server, sndId} = do
-  let port_ = serializePort_ $ port server
-  DB.executeNamed
-    dbConn
-    [sql|
-      INSERT INTO connections
-        ( conn_alias, rcv_host, rcv_port, rcv_id, snd_host, snd_port, snd_id, last_internal_msg_id, last_internal_rcv_msg_id, last_internal_snd_msg_id, last_external_snd_msg_id, last_rcv_msg_hash, last_snd_msg_hash)
-      VALUES
-        (:conn_alias, NULL,     NULL,     NULL,  :snd_host,:snd_port,:snd_id, 0, 0, 0, 0, x'', x'');
-    |]
-    [ ":conn_alias" := connId,
-      ":snd_host" := host server,
-      ":snd_port" := port_,
-      ":snd_id" := sndId
-    ]
-
 -- * getConn helpers
 
 getConn_ :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
@@ -718,8 +703,8 @@ getConn_ dbConn connId =
   getConnData_ dbConn connId >>= \case
     Nothing -> pure $ Left SEConnNotFound
     Just (connData, cMode) -> do
-      rQ <- getRcvQueueByConnAlias_ dbConn connId
-      sQ <- getSndQueueByConnAlias_ dbConn connId
+      rQ <- getRcvQueueByConnId_ dbConn connId
+      sQ <- getSndQueueByConnId_ dbConn connId
       pure $ case (rQ, sQ, cMode) of
         (Just rcvQ, Just sndQ, CMInvitation) -> Right $ SomeConn SCDuplex (DuplexConnection connData rcvQ sndQ)
         (Just rcvQ, Nothing, CMInvitation) -> Right $ SomeConn SCRcv (RcvConnection connData rcvQ)
@@ -730,76 +715,48 @@ getConn_ dbConn connId =
 getConnData_ :: DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode))
 getConnData_ dbConn connId' =
   connData
-    <$> DB.query dbConn "SELECT conn_alias, conn_mode FROM connections WHERE conn_alias = ?;" (Only connId')
+    <$> DB.query dbConn "SELECT conn_id, conn_mode FROM connections WHERE conn_id = ?;" (Only connId')
   where
     connData [(connId, cMode)] = Just (ConnData {connId}, cMode)
     connData _ = Nothing
 
-getRcvQueueByConnAlias_ :: DB.Connection -> ConnId -> IO (Maybe RcvQueue)
-getRcvQueueByConnAlias_ dbConn connId =
+getRcvQueueByConnId_ :: DB.Connection -> ConnId -> IO (Maybe RcvQueue)
+getRcvQueueByConnId_ dbConn connId =
   rcvQueue
     <$> DB.query
       dbConn
       [sql|
-        SELECT s.key_hash, q.host, q.port, q.rcv_id, q.rcv_private_key,
-          q.snd_id, q.decrypt_key, q.verify_key, q.status
+        SELECT s.key_hash, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret,
+          q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.status
         FROM rcv_queues q
         INNER JOIN servers s ON q.host = s.host AND q.port = s.port
-        WHERE q.conn_alias = ?;
+        WHERE q.conn_id = ?;
       |]
       (Only connId)
   where
-    rcvQueue [(keyHash, host, port, rcvId, rcvPrivateKey, sndId, decryptKey, verifyKey, status)] =
-      let srv = SMPServer host (deserializePort_ port) keyHash
-       in Just $ RcvQueue srv rcvId rcvPrivateKey sndId decryptKey verifyKey status
+    rcvQueue [(keyHash, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status)] =
+      let server = SMPServer host port keyHash
+       in Just RcvQueue {server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status}
     rcvQueue _ = Nothing
 
-getSndQueueByConnAlias_ :: DB.Connection -> ConnId -> IO (Maybe SndQueue)
-getSndQueueByConnAlias_ dbConn connId =
+getSndQueueByConnId_ :: DB.Connection -> ConnId -> IO (Maybe SndQueue)
+getSndQueueByConnId_ dbConn connId =
   sndQueue
     <$> DB.query
       dbConn
       [sql|
-        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key, q.encrypt_key, q.sign_key, q.status
+        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key, q.e2e_dh_secret, q.status
         FROM snd_queues q
         INNER JOIN servers s ON q.host = s.host AND q.port = s.port
-        WHERE q.conn_alias = ?;
+        WHERE q.conn_id = ?;
       |]
       (Only connId)
   where
-    sndQueue [(keyHash, host, port, sndId, sndPrivateKey, encryptKey, signKey, status)] =
-      let srv = SMPServer host (deserializePort_ port) keyHash
-       in Just $ SndQueue srv sndId sndPrivateKey encryptKey signKey status
+    sndQueue [(keyHash, host, port, sndId, sndPrivateKey, e2eDhSecret, status)] =
+      let server = SMPServer host port keyHash
+       in Just SndQueue {server, sndId, sndPrivateKey, e2eDhSecret, status}
     sndQueue _ = Nothing
 
--- * upgradeRcvConnToDuplex helpers
-
-updateConnWithSndQueue_ :: DB.Connection -> ConnId -> SndQueue -> IO ()
-updateConnWithSndQueue_ dbConn connId SndQueue {server, sndId} = do
-  let port_ = serializePort_ $ port server
-  DB.executeNamed
-    dbConn
-    [sql|
-      UPDATE connections
-      SET snd_host = :snd_host, snd_port = :snd_port, snd_id = :snd_id
-      WHERE conn_alias = :conn_alias;
-    |]
-    [":snd_host" := host server, ":snd_port" := port_, ":snd_id" := sndId, ":conn_alias" := connId]
-
--- * upgradeSndConnToDuplex helpers
-
-updateConnWithRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()
-updateConnWithRcvQueue_ dbConn connId RcvQueue {server, rcvId} = do
-  let port_ = serializePort_ $ port server
-  DB.executeNamed
-    dbConn
-    [sql|
-      UPDATE connections
-      SET rcv_host = :rcv_host, rcv_port = :rcv_port, rcv_id = :rcv_id
-      WHERE conn_alias = :conn_alias;
-    |]
-    [":rcv_host" := host server, ":rcv_port" := port_, ":rcv_id" := rcvId, ":conn_alias" := connId]
-
 -- * updateRcvIds helpers
 
 retrieveLastIdsAndHashRcv_ :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
@@ -810,9 +767,9 @@ retrieveLastIdsAndHashRcv_ dbConn connId = do
       [sql|
         SELECT last_internal_msg_id, last_internal_rcv_msg_id, last_external_snd_msg_id, last_rcv_msg_hash
         FROM connections
-        WHERE conn_alias = :conn_alias;
+        WHERE conn_id = :conn_id;
       |]
-      [":conn_alias" := connId]
+      [":conn_id" := connId]
   return (lastInternalId, lastInternalRcvId, lastExternalSndId, lastRcvHash)
 
 updateLastIdsRcv_ :: DB.Connection -> ConnId -> InternalId -> InternalRcvId -> IO ()
@@ -823,56 +780,55 @@ updateLastIdsRcv_ dbConn connId newInternalId newInternalRcvId =
       UPDATE connections
       SET last_internal_msg_id = :last_internal_msg_id,
           last_internal_rcv_msg_id = :last_internal_rcv_msg_id
-      WHERE conn_alias = :conn_alias;
+      WHERE conn_id = :conn_id;
     |]
     [ ":last_internal_msg_id" := newInternalId,
       ":last_internal_rcv_msg_id" := newInternalRcvId,
-      ":conn_alias" := connId
+      ":conn_id" := connId
     ]
 
 -- * createRcvMsg helpers
 
 insertRcvMsgBase_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
-insertRcvMsgBase_ dbConn connId RcvMsgData {msgMeta, msgBody, internalRcvId} = do
+insertRcvMsgBase_ dbConn connId RcvMsgData {msgMeta, msgType, msgBody, internalRcvId} = do
   let MsgMeta {recipient = (internalId, internalTs)} = msgMeta
   DB.executeNamed
     dbConn
     [sql|
       INSERT INTO messages
-        ( conn_alias, internal_id, internal_ts, internal_rcv_id, internal_snd_id, body, msg_body)
+        ( conn_id, internal_id, internal_ts, internal_rcv_id, internal_snd_id, msg_type, msg_body)
       VALUES
-        (:conn_alias,:internal_id,:internal_ts,:internal_rcv_id,            NULL,   '',:msg_body);
+        (:conn_id,:internal_id,:internal_ts,:internal_rcv_id,            NULL,:msg_type, :msg_body);
     |]
-    [ ":conn_alias" := connId,
+    [ ":conn_id" := connId,
       ":internal_id" := internalId,
       ":internal_ts" := internalTs,
       ":internal_rcv_id" := internalRcvId,
+      ":msg_type" := msgType,
       ":msg_body" := msgBody
     ]
 
 insertRcvMsgDetails_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
 insertRcvMsgDetails_ dbConn connId RcvMsgData {msgMeta, internalRcvId, internalHash, externalPrevSndHash} = do
-  let MsgMeta {integrity, recipient, sender, broker} = msgMeta
+  let MsgMeta {integrity, recipient, broker, sndMsgId} = msgMeta
   DB.executeNamed
     dbConn
     [sql|
       INSERT INTO rcv_messages
-        ( conn_alias, internal_rcv_id, internal_id, external_snd_id, external_snd_ts,
-          broker_id, broker_ts, rcv_status, ack_brocker_ts, ack_sender_ts,
+        ( conn_id, internal_rcv_id, internal_id, external_snd_id,
+          broker_id, broker_ts,
           internal_hash, external_prev_snd_hash, integrity)
       VALUES
-        (:conn_alias,:internal_rcv_id,:internal_id,:external_snd_id,:external_snd_ts,
-         :broker_id,:broker_ts,:rcv_status,           NULL,          NULL,
+        (:conn_id,:internal_rcv_id,:internal_id,:external_snd_id,
+         :broker_id,:broker_ts,
          :internal_hash,:external_prev_snd_hash,:integrity);
     |]
-    [ ":conn_alias" := connId,
+    [ ":conn_id" := connId,
       ":internal_rcv_id" := internalRcvId,
       ":internal_id" := fst recipient,
-      ":external_snd_id" := fst sender,
-      ":external_snd_ts" := snd sender,
+      ":external_snd_id" := sndMsgId,
       ":broker_id" := fst broker,
       ":broker_ts" := snd broker,
-      ":rcv_status" := Received,
       ":internal_hash" := internalHash,
       ":external_prev_snd_hash" := externalPrevSndHash,
       ":integrity" := integrity
@@ -887,12 +843,12 @@ updateHashRcv_ dbConn connId RcvMsgData {msgMeta, internalHash, internalRcvId} =
       UPDATE connections
       SET last_external_snd_msg_id = :last_external_snd_msg_id,
           last_rcv_msg_hash = :last_rcv_msg_hash
-      WHERE conn_alias = :conn_alias
+      WHERE conn_id = :conn_id
         AND last_internal_rcv_msg_id = :last_internal_rcv_msg_id;
     |]
-    [ ":last_external_snd_msg_id" := fst (sender msgMeta),
+    [ ":last_external_snd_msg_id" := sndMsgId (msgMeta :: MsgMeta),
       ":last_rcv_msg_hash" := internalHash,
-      ":conn_alias" := connId,
+      ":conn_id" := connId,
       ":last_internal_rcv_msg_id" := internalRcvId
     ]
 
@@ -906,9 +862,9 @@ retrieveLastIdsAndHashSnd_ dbConn connId = do
       [sql|
         SELECT last_internal_msg_id, last_internal_snd_msg_id, last_snd_msg_hash
         FROM connections
-        WHERE conn_alias = :conn_alias;
+        WHERE conn_id = :conn_id;
       |]
-      [":conn_alias" := connId]
+      [":conn_id" := connId]
   return (lastInternalId, lastInternalSndId, lastSndHash)
 
 updateLastIdsSnd_ :: DB.Connection -> ConnId -> InternalId -> InternalSndId -> IO ()
@@ -919,11 +875,11 @@ updateLastIdsSnd_ dbConn connId newInternalId newInternalSndId =
       UPDATE connections
       SET last_internal_msg_id = :last_internal_msg_id,
           last_internal_snd_msg_id = :last_internal_snd_msg_id
-      WHERE conn_alias = :conn_alias;
+      WHERE conn_id = :conn_id;
     |]
     [ ":last_internal_msg_id" := newInternalId,
       ":last_internal_snd_msg_id" := newInternalSndId,
-      ":conn_alias" := connId
+      ":conn_id" := connId
     ]
 
 -- * createSndMsg helpers
@@ -934,14 +890,15 @@ insertSndMsgBase_ dbConn connId SndMsgData {..} = do
     dbConn
     [sql|
       INSERT INTO messages
-        ( conn_alias, internal_id, internal_ts, internal_rcv_id, internal_snd_id, body, msg_body)
+        ( conn_id, internal_id, internal_ts, internal_rcv_id, internal_snd_id, msg_type, msg_body)
       VALUES
-        (:conn_alias,:internal_id,:internal_ts,            NULL,:internal_snd_id,   '',:msg_body);
+        (:conn_id,:internal_id,:internal_ts,            NULL,:internal_snd_id,:msg_type, :msg_body);
     |]
-    [ ":conn_alias" := connId,
+    [ ":conn_id" := connId,
       ":internal_id" := internalId,
       ":internal_ts" := internalTs,
       ":internal_snd_id" := internalSndId,
+      ":msg_type" := msgType,
       ":msg_body" := msgBody
     ]
 
@@ -951,16 +908,15 @@ insertSndMsgDetails_ dbConn connId SndMsgData {..} =
     dbConn
     [sql|
       INSERT INTO snd_messages
-        ( conn_alias, internal_snd_id, internal_id, snd_status, sent_ts, delivered_ts, internal_hash, previous_msg_hash)
+        ( conn_id, internal_snd_id, internal_id, internal_hash, previous_msg_hash)
       VALUES
-        (:conn_alias,:internal_snd_id,:internal_id,:snd_status,    NULL,         NULL,:internal_hash,:previous_msg_hash);
+        (:conn_id,:internal_snd_id,:internal_id,:internal_hash,:previous_msg_hash);
     |]
-    [ ":conn_alias" := connId,
+    [ ":conn_id" := connId,
       ":internal_snd_id" := internalSndId,
       ":internal_id" := internalId,
-      ":snd_status" := SndMsgCreated,
       ":internal_hash" := internalHash,
-      ":previous_msg_hash" := previousMsgHash
+      ":previous_msg_hash" := prevMsgHash
     ]
 
 updateHashSnd_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
@@ -971,31 +927,15 @@ updateHashSnd_ dbConn connId SndMsgData {..} =
     [sql|
       UPDATE connections
       SET last_snd_msg_hash = :last_snd_msg_hash
-      WHERE conn_alias = :conn_alias
+      WHERE conn_id = :conn_id
         AND last_internal_snd_msg_id = :last_internal_snd_msg_id;
     |]
     [ ":last_snd_msg_hash" := internalHash,
-      ":conn_alias" := connId,
+      ":conn_id" := connId,
       ":last_internal_snd_msg_id" := internalSndId
     ]
 
 -- create record with a random ID
-
-getConnId_ :: DB.Connection -> TVar ChaChaDRG -> ConnData -> IO (Either StoreError ConnId)
-getConnId_ dbConn gVar ConnData {connId = ""} = getUniqueRandomId gVar $ getConnData_ dbConn
-getConnId_ _ _ ConnData {connId} = pure $ Right connId
-
-getUniqueRandomId :: TVar ChaChaDRG -> (ByteString -> IO (Maybe a)) -> IO (Either StoreError ByteString)
-getUniqueRandomId gVar get = tryGet 3
-  where
-    tryGet :: Int -> IO (Either StoreError ByteString)
-    tryGet 0 = pure $ Left SEUniqueID
-    tryGet n = do
-      id' <- randomId gVar 12
-      get id' >>= \case
-        Nothing -> pure $ Right id'
-        Just _ -> tryGet (n - 1)
-
 createWithRandomId :: TVar ChaChaDRG -> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
 createWithRandomId gVar create = tryCreate 3
   where
@@ -1010,4 +950,4 @@ createWithRandomId gVar create = tryCreate 3
           | otherwise -> pure . Left . SEInternal $ bshow e
 
 randomId :: TVar ChaChaDRG -> Int -> IO ByteString
-randomId gVar n = encode <$> (atomically . stateTVar gVar $ randomBytesGenerate n)
+randomId gVar n = U.encode <$> (atomically . stateTVar gVar $ randomBytesGenerate n)

src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs

@@ -16,29 +16,29 @@ module Simplex.Messaging.Agent.Store.SQLite.Migrations
 where
 
 import Control.Monad (forM_)
-import Data.FileEmbed (embedDir, makeRelativeToProject)
 import Data.Function (on)
 import Data.List (intercalate, sortBy)
 import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8)
 import Data.Time.Clock (getCurrentTime)
-import Database.SQLite.Simple (Connection, Only (..))
+import Database.SQLite.Simple (Connection, Only (..), Query (..))
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
-import System.FilePath (takeBaseName, takeExtension)
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
 
 data Migration = Migration {name :: String, up :: Text}
   deriving (Show)
 
+schemaMigrations :: [(String, Query)]
+schemaMigrations =
+  [ ("20220101_initial", m20220101_initial)
+  ]
+
 -- | The list of migrations in ascending order by date
 app :: [Migration]
-app =
-  sortBy (compare `on` name) . map migration . filter sqlFile $
-    $(makeRelativeToProject "migrations" >>= embedDir)
+app = sortBy (compare `on` name) $ map migration schemaMigrations
   where
-    sqlFile (file, _) = takeExtension file == ".sql"
-    migration (file, qStr) = Migration {name = takeBaseName file, up = decodeUtf8 qStr}
+    migration (name, query) = Migration {name = name, up = fromQuery query}
 
 get :: Connection -> [Migration] -> IO (Either String [Migration])
 get conn migrations =

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220101_initial.hs

@@ -0,0 +1,148 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220101_initial :: Query
+m20220101_initial =
+  [sql|
+CREATE TABLE servers (
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  key_hash BLOB NOT NULL,
+  PRIMARY KEY (host, port)
+) WITHOUT ROWID;
+
+CREATE TABLE connections (
+  conn_id BLOB NOT NULL PRIMARY KEY,
+  conn_mode TEXT NOT NULL,
+  last_internal_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_internal_rcv_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_internal_snd_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_external_snd_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_rcv_msg_hash BLOB NOT NULL DEFAULT x'',
+  last_snd_msg_hash BLOB NOT NULL DEFAULT x'',
+  smp_agent_version INTEGER NOT NULL DEFAULT 1
+) WITHOUT ROWID;
+
+CREATE TABLE rcv_queues (
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  rcv_id BLOB NOT NULL,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  rcv_private_key BLOB NOT NULL,
+  rcv_dh_secret BLOB NOT NULL,
+  e2e_priv_key BLOB NOT NULL,
+  e2e_dh_secret BLOB,
+  snd_id BLOB NOT NULL,
+  snd_key BLOB,
+  status TEXT NOT NULL,
+  smp_server_version INTEGER NOT NULL DEFAULT 1,
+  smp_client_version INTEGER,
+  PRIMARY KEY (host, port, rcv_id),
+  FOREIGN KEY (host, port) REFERENCES servers
+    ON DELETE RESTRICT ON UPDATE CASCADE,
+  UNIQUE (host, port, snd_id)
+) WITHOUT ROWID;
+
+CREATE TABLE snd_queues (
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  snd_id BLOB NOT NULL,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  snd_private_key BLOB NOT NULL,
+  e2e_dh_secret BLOB NOT NULL,
+  status TEXT NOT NULL,
+  smp_server_version INTEGER NOT NULL DEFAULT 1,
+  smp_client_version INTEGER NOT NULL DEFAULT 1,
+  PRIMARY KEY (host, port, snd_id),
+  FOREIGN KEY (host, port) REFERENCES servers
+    ON DELETE RESTRICT ON UPDATE CASCADE
+) WITHOUT ROWID;
+
+CREATE TABLE messages (
+  conn_id BLOB NOT NULL REFERENCES connections (conn_id)
+    ON DELETE CASCADE,
+  internal_id INTEGER NOT NULL,
+  internal_ts TEXT NOT NULL,
+  internal_rcv_id INTEGER,
+  internal_snd_id INTEGER,
+  msg_type BLOB NOT NULL, -- (H)ELLO, (R)EPLY, (D)ELETE. Should SMP confirmation be saved too?
+  msg_body BLOB NOT NULL DEFAULT x'',
+  PRIMARY KEY (conn_id, internal_id),
+  FOREIGN KEY (conn_id, internal_rcv_id) REFERENCES rcv_messages
+    ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED,
+  FOREIGN KEY (conn_id, internal_snd_id) REFERENCES snd_messages
+    ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
+) WITHOUT ROWID;
+
+CREATE TABLE rcv_messages (
+  conn_id BLOB NOT NULL,
+  internal_rcv_id INTEGER NOT NULL,
+  internal_id INTEGER NOT NULL,
+  external_snd_id INTEGER NOT NULL,
+  broker_id BLOB NOT NULL,
+  broker_ts TEXT NOT NULL,
+  internal_hash BLOB NOT NULL,
+  external_prev_snd_hash BLOB NOT NULL,
+  integrity BLOB NOT NULL,
+  PRIMARY KEY (conn_id, internal_rcv_id),
+  FOREIGN KEY (conn_id, internal_id) REFERENCES messages
+    ON DELETE CASCADE
+) WITHOUT ROWID;
+
+CREATE TABLE snd_messages (
+  conn_id BLOB NOT NULL,
+  internal_snd_id INTEGER NOT NULL,
+  internal_id INTEGER NOT NULL,
+  internal_hash BLOB NOT NULL,
+  previous_msg_hash BLOB NOT NULL DEFAULT x'',
+  PRIMARY KEY (conn_id, internal_snd_id),
+  FOREIGN KEY (conn_id, internal_id) REFERENCES messages
+    ON DELETE CASCADE
+) WITHOUT ROWID;
+
+CREATE TABLE conn_confirmations (
+  confirmation_id BLOB NOT NULL PRIMARY KEY,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  e2e_snd_pub_key BLOB NOT NULL, -- TODO per-queue key. Split?
+  sender_key BLOB NOT NULL, -- TODO per-queue key. Split?
+  ratchet_state BLOB NOT NULL,
+  sender_conn_info BLOB NOT NULL,
+  accepted INTEGER NOT NULL,
+  own_conn_info BLOB,
+  created_at TEXT NOT NULL DEFAULT (datetime('now'))
+) WITHOUT ROWID;
+
+CREATE TABLE conn_invitations (
+  invitation_id BLOB NOT NULL PRIMARY KEY,
+  contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  cr_invitation BLOB NOT NULL,
+  recipient_conn_info BLOB NOT NULL,
+  accepted INTEGER NOT NULL DEFAULT 0,
+  own_conn_info BLOB,
+  created_at TEXT NOT NULL DEFAULT (datetime('now'))
+) WITHOUT ROWID;
+
+CREATE TABLE ratchets (
+  conn_id BLOB NOT NULL PRIMARY KEY REFERENCES connections
+    ON DELETE CASCADE,
+  -- x3dh keys are not saved on the sending side (the side accepting the connection)
+  x3dh_priv_key_1 BLOB,
+  x3dh_priv_key_2 BLOB,
+  -- ratchet is initially empty on the receiving side (the side offering the connection)
+  ratchet_state BLOB,
+  e2e_version INTEGER NOT NULL DEFAULT 1
+) WITHOUT ROWID;
+
+CREATE TABLE skipped_messages (
+  skipped_message_id INTEGER PRIMARY KEY,
+  conn_id BLOB NOT NULL REFERENCES ratchets
+    ON DELETE CASCADE,
+  header_key BLOB NOT NULL,
+  msg_n INTEGER NOT NULL,
+  msg_key BLOB NOT NULL
+);
+|]

src/Simplex/Messaging/Client.hs

@@ -23,14 +23,16 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Client
   ( -- * Connect (disconnect) client to (from) SMP server
-    SMPClient (blockSize),
+    SMPClient,
     getSMPClient,
     closeSMPClient,
 
     -- * SMP protocol command functions
     createSMPQueue,
     subscribeSMPQueue,
+    subscribeSMPQueueNotifications,
     secureSMPQueue,
+    enableSMPQueueNotifications,
     sendSMPMessage,
     ackSMPMessage,
     suspendSMPQueue,
@@ -59,10 +61,10 @@ import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe)
 import Network.Socket (ServiceName)
 import Numeric.Natural
-import Simplex.Messaging.Agent.Protocol (SMPServer (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Transport (ATransport (..), TCP, THandle (..), TProxy, Transport (..), TransportError, clientHandshake, runTransportClient)
+import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake)
+import Simplex.Messaging.Transport.Client (runTransportClient)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
 import System.Timeout (timeout)
@@ -76,18 +78,18 @@ import System.Timeout (timeout)
 data SMPClient = SMPClient
   { action :: Async (),
     connected :: TVar Bool,
+    sessionId :: ByteString,
     smpServer :: SMPServer,
     tcpTimeout :: Int,
     clientCorrId :: TVar Natural,
     sentCommands :: TVar (Map CorrId Request),
-    sndQ :: TBQueue SignedRawTransmission,
-    rcvQ :: TBQueue SignedTransmissionOrError,
-    msgQ :: TBQueue SMPServerTransmission,
-    blockSize :: Int
+    sndQ :: TBQueue SentRawTransmission,
+    rcvQ :: TBQueue (SignedTransmission BrokerMsg),
+    msgQ :: TBQueue SMPServerTransmission
   }
 
 -- | Type synonym for transmission from some SPM server queue.
-type SMPServerTransmission = (SMPServer, RecipientId, Command 'Broker)
+type SMPServerTransmission = (SMPServer, RecipientId, BrokerMsg)
 
 -- | SMP client configuration.
 data SMPClientConfig = SMPClientConfig
@@ -98,13 +100,7 @@ data SMPClientConfig = SMPClientConfig
     -- | timeout of TCP commands (microseconds)
     tcpTimeout :: Int,
     -- | period for SMP ping commands (microseconds)
-    smpPing :: Int,
-    -- | SMP transport block size, Nothing - the block size will be set by the server.
-    -- Allowed sizes are 4, 8, 16, 32, 64 KiB (* 1024 bytes).
-    smpBlockSize :: Maybe Int,
-    -- | estimated maximum size of SMP command excluding message body,
-    -- determines the maximum allowed message size
-    smpCommandSize :: Int
+    smpPing :: Int
   }
 
 -- | Default SMP client configuration.
@@ -112,11 +108,9 @@ smpDefaultConfig :: SMPClientConfig
 smpDefaultConfig =
   SMPClientConfig
     { qSize = 16,
-      defaultTransport = ("5223", transport @TCP),
+      defaultTransport = ("5223", transport @TLS),
       tcpTimeout = 4_000_000,
-      smpPing = 30_000_000,
-      smpBlockSize = Just 8192,
-      smpCommandSize = 256
+      smpPing = 30_000_000
     }
 
 data Request = Request
@@ -124,7 +118,7 @@ data Request = Request
     responseVar :: TMVar Response
   }
 
-type Response = Either SMPClientError Cmd
+type Response = Either SMPClientError BrokerMsg
 
 -- | Connects to 'SMPServer' using passed client configuration
 -- and queue for messages and notifications.
@@ -132,7 +126,7 @@ type Response = Either SMPClientError Cmd
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
 getSMPClient :: SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO () -> IO (Either SMPClientError SMPClient)
-getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlockSize} msgQ disconnected =
+getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ disconnected =
   atomically mkSMPClient >>= runClient useTransport
   where
     mkSMPClient :: STM SMPClient
@@ -145,7 +139,7 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
       return
         SMPClient
           { action = undefined,
-            blockSize = undefined,
+            sessionId = undefined,
             connected,
             smpServer,
             tcpTimeout,
@@ -161,45 +155,46 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
       thVar <- newEmptyTMVarIO
       action <-
         async $
-          runTransportClient (host smpServer) port' (client t c thVar)
+          runTransportClient (host smpServer) port' (keyHash smpServer) (client t c thVar)
             `finally` atomically (putTMVar thVar $ Left SMPNetworkError)
-      bSize <- tcpTimeout `timeout` atomically (takeTMVar thVar)
-      pure $ case bSize of
-        Just (Right blockSize) -> Right c {action, blockSize}
+      th_ <- tcpTimeout `timeout` atomically (takeTMVar thVar)
+      pure $ case th_ of
+        Just (Right THandle {sessionId}) -> Right c {action, sessionId}
         Just (Left e) -> Left e
         Nothing -> Left SMPNetworkError
 
     useTransport :: (ServiceName, ATransport)
     useTransport = case port smpServer of
-      Nothing -> defaultTransport cfg
-      Just "80" -> ("80", transport @WS)
-      Just p -> (p, transport @TCP)
+      "" -> defaultTransport cfg
+      "80" -> ("80", transport @WS)
+      p -> (p, transport @TLS)
 
-    client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError Int) -> c -> IO ()
+    client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError (THandle c)) -> c -> IO ()
     client _ c thVar h =
-      runExceptT (clientHandshake h smpBlockSize $ keyHash smpServer) >>= \case
+      runExceptT (clientHandshake h $ keyHash smpServer) >>= \case
         Left e -> atomically . putTMVar thVar . Left $ SMPTransportError e
-        Right th -> do
+        Right th@THandle {sessionId} -> do
           atomically $ do
             writeTVar (connected c) True
-            putTMVar thVar . Right $ blockSize (th :: THandle c)
-          raceAny_ [send c th, process c, receive c th, ping c]
+            putTMVar thVar $ Right th
+          let c' = c {sessionId} :: SMPClient
+          raceAny_ [send c' th, process c', receive c' th, ping c']
             `finally` disconnected
 
     send :: Transport c => SMPClient -> THandle c -> IO ()
     send SMPClient {sndQ} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
 
     receive :: Transport c => SMPClient -> THandle c -> IO ()
-    receive SMPClient {rcvQ} h = forever $ tGet fromServer h >>= atomically . writeTBQueue rcvQ
+    receive SMPClient {rcvQ} h = forever $ tGet h >>= atomically . writeTBQueue rcvQ
 
     ping :: SMPClient -> IO ()
     ping c = forever $ do
       threadDelay smpPing
-      runExceptT $ sendSMPCommand c Nothing "" (Cmd SSender PING)
+      runExceptT $ sendSMPCommand c Nothing "" PING
 
     process :: SMPClient -> IO ()
     process SMPClient {rcvQ, sentCommands} = forever $ do
-      (_, (corrId, qId, respOrErr)) <- atomically $ readTBQueue rcvQ
+      (_, _, (corrId, qId, respOrErr)) <- atomically $ readTBQueue rcvQ
       if B.null $ bs corrId
         then sendMsg qId respOrErr
         else do
@@ -212,13 +207,13 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
                 if queueId == qId
                   then case respOrErr of
                     Left e -> Left $ SMPResponseError e
-                    Right (Cmd _ (ERR e)) -> Left $ SMPServerError e
+                    Right (ERR e) -> Left $ SMPServerError e
                     Right r -> Right r
                   else Left SMPUnexpectedResponse
 
-    sendMsg :: QueueId -> Either ErrorType Cmd -> IO ()
+    sendMsg :: QueueId -> Either ErrorType BrokerMsg -> IO ()
     sendMsg qId = \case
-      Right (Cmd SBroker cmd) -> atomically $ writeTBQueue msgQ (smpServer, qId, cmd)
+      Right cmd -> atomically $ writeTBQueue msgQ (smpServer, qId, cmd)
       -- TODO send everything else to errQ and log in agent
       _ -> return ()
 
@@ -257,49 +252,64 @@ data SMPClientError
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#create-queue-command
 createSMPQueue ::
   SMPClient ->
-  RecipientPrivateKey ->
-  RecipientPublicKey ->
-  ExceptT SMPClientError IO (RecipientId, SenderId)
-createSMPQueue c rpKey rKey =
-  -- TODO add signing this request too - requires changes in the server
-  sendSMPCommand c (Just rpKey) "" (Cmd SRecipient $ NEW rKey) >>= \case
-    Cmd _ (IDS rId sId) -> return (rId, sId)
+  RcvPrivateSignKey ->
+  RcvPublicVerifyKey ->
+  RcvPublicDhKey ->
+  ExceptT SMPClientError IO QueueIdsKeys
+createSMPQueue c rpKey rKey dhKey =
+  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey) >>= \case
+    IDS qik -> pure qik
     _ -> throwE SMPUnexpectedResponse
 
 -- | Subscribe to the SMP queue.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue
-subscribeSMPQueue :: SMPClient -> RecipientPrivateKey -> RecipientId -> ExceptT SMPClientError IO ()
+subscribeSMPQueue :: SMPClient -> RcvPrivateSignKey -> RecipientId -> ExceptT SMPClientError IO ()
 subscribeSMPQueue c@SMPClient {smpServer, msgQ} rpKey rId =
-  sendSMPCommand c (Just rpKey) rId (Cmd SRecipient SUB) >>= \case
-    Cmd _ OK -> return ()
-    Cmd _ cmd@MSG {} ->
+  sendSMPCommand c (Just rpKey) rId SUB >>= \case
+    OK -> return ()
+    cmd@MSG {} ->
       lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd)
     _ -> throwE SMPUnexpectedResponse
 
+-- | Subscribe to the SMP queue notifications.
+--
+-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue-notifications
+subscribeSMPQueueNotifications :: SMPClient -> NtfPrivateSignKey -> NotifierId -> ExceptT SMPClientError IO ()
+subscribeSMPQueueNotifications = okSMPCommand NSUB
+
 -- | Secure the SMP queue by adding a sender public key.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#secure-queue-command
-secureSMPQueue :: SMPClient -> RecipientPrivateKey -> RecipientId -> SenderPublicKey -> ExceptT SMPClientError IO ()
-secureSMPQueue c rpKey rId senderKey = okSMPCommand (Cmd SRecipient $ KEY senderKey) c rpKey rId
+secureSMPQueue :: SMPClient -> RcvPrivateSignKey -> RecipientId -> SndPublicVerifyKey -> ExceptT SMPClientError IO ()
+secureSMPQueue c rpKey rId senderKey = okSMPCommand (KEY senderKey) c rpKey rId
+
+-- | Enable notifications for the queue for push notifications server.
+--
+-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
+enableSMPQueueNotifications :: SMPClient -> RcvPrivateSignKey -> RecipientId -> NtfPublicVerifyKey -> ExceptT SMPClientError IO NotifierId
+enableSMPQueueNotifications c rpKey rId notifierKey =
+  sendSMPCommand c (Just rpKey) rId (NKEY notifierKey) >>= \case
+    NID nId -> pure nId
+    _ -> throwE SMPUnexpectedResponse
 
 -- | Send SMP message.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message
-sendSMPMessage :: SMPClient -> Maybe SenderPrivateKey -> SenderId -> MsgBody -> ExceptT SMPClientError IO ()
+sendSMPMessage :: SMPClient -> Maybe SndPrivateSignKey -> SenderId -> MsgBody -> ExceptT SMPClientError IO ()
 sendSMPMessage c spKey sId msg =
-  sendSMPCommand c spKey sId (Cmd SSender $ SEND msg) >>= \case
-    Cmd _ OK -> return ()
+  sendSMPCommand c spKey sId (SEND msg) >>= \case
+    OK -> pure ()
     _ -> throwE SMPUnexpectedResponse
 
 -- | Acknowledge message delivery (server deletes the message).
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
-ackSMPMessage :: SMPClient -> RecipientPrivateKey -> QueueId -> ExceptT SMPClientError IO ()
+ackSMPMessage :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
 ackSMPMessage c@SMPClient {smpServer, msgQ} rpKey rId =
-  sendSMPCommand c (Just rpKey) rId (Cmd SRecipient ACK) >>= \case
-    Cmd _ OK -> return ()
-    Cmd _ cmd@MSG {} ->
+  sendSMPCommand c (Just rpKey) rId ACK >>= \case
+    OK -> return ()
+    cmd@MSG {} ->
       lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd)
     _ -> throwE SMPUnexpectedResponse
 
@@ -307,26 +317,27 @@ ackSMPMessage c@SMPClient {smpServer, msgQ} rpKey rId =
 -- The existing messages from the queue will still be delivered.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#suspend-queue
-suspendSMPQueue :: SMPClient -> RecipientPrivateKey -> QueueId -> ExceptT SMPClientError IO ()
-suspendSMPQueue = okSMPCommand $ Cmd SRecipient OFF
+suspendSMPQueue :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
+suspendSMPQueue = okSMPCommand OFF
 
 -- | Irreversibly delete SMP queue and all messages in it.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#delete-queue
-deleteSMPQueue :: SMPClient -> RecipientPrivateKey -> QueueId -> ExceptT SMPClientError IO ()
-deleteSMPQueue = okSMPCommand $ Cmd SRecipient DEL
+deleteSMPQueue :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
+deleteSMPQueue = okSMPCommand DEL
 
-okSMPCommand :: Cmd -> SMPClient -> C.SafePrivateKey -> QueueId -> ExceptT SMPClientError IO ()
+okSMPCommand :: PartyI p => Command p -> SMPClient -> C.APrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
 okSMPCommand cmd c pKey qId =
   sendSMPCommand c (Just pKey) qId cmd >>= \case
-    Cmd _ OK -> return ()
+    OK -> return ()
     _ -> throwE SMPUnexpectedResponse
 
--- | Send any SMP command ('Cmd' type).
-sendSMPCommand :: SMPClient -> Maybe C.SafePrivateKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd
-sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId cmd = do
+-- | Send SMP command
+-- TODO sign all requests (SEND of SMP confirmation would be signed with the same key that is passed to the recipient)
+sendSMPCommand :: PartyI p => SMPClient -> Maybe C.APrivateSignKey -> QueueId -> Command p -> ExceptT SMPClientError IO BrokerMsg
+sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, sessionId, tcpTimeout} pKey qId cmd = do
   corrId <- lift_ getNextCorrId
-  t <- signTransmission $ serializeTransmission (corrId, qId, cmd)
+  t <- signTransmission $ encodeTransmission sessionId (corrId, qId, cmd)
   ExceptT $ sendRecv corrId t
   where
     lift_ :: STM a -> ExceptT SMPClientError IO a
@@ -337,20 +348,20 @@ sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId
       i <- stateTVar clientCorrId $ \i -> (i, i + 1)
       pure . CorrId $ bshow i
 
-    signTransmission :: ByteString -> ExceptT SMPClientError IO SignedRawTransmission
+    signTransmission :: ByteString -> ExceptT SMPClientError IO SentRawTransmission
     signTransmission t = case pKey of
-      Nothing -> return ("", t)
+      Nothing -> return (Nothing, t)
       Just pk -> do
         sig <- liftError SMPSignatureError $ C.sign pk t
-        return (sig, t)
+        return (Just sig, t)
 
     -- two separate "atomically" needed to avoid blocking
-    sendRecv :: CorrId -> SignedRawTransmission -> IO Response
+    sendRecv :: CorrId -> SentRawTransmission -> IO Response
     sendRecv corrId t = atomically (send corrId t) >>= withTimeout . atomically . takeTMVar
       where
         withTimeout a = fromMaybe (Left SMPResponseTimeout) <$> timeout tcpTimeout a
 
-    send :: CorrId -> SignedRawTransmission -> STM (TMVar Response)
+    send :: CorrId -> SentRawTransmission -> STM (TMVar Response)
     send corrId t = do
       r <- newEmptyTMVar
       modifyTVar sentCommands . M.insert corrId $ Request qId r

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -0,0 +1,511 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
+module Simplex.Messaging.Crypto.Ratchet where
+
+import Control.Monad.Except
+import Control.Monad.Trans.Except
+import Crypto.Cipher.AES (AES256)
+import Crypto.Hash (SHA512)
+import qualified Crypto.KDF.HKDF as H
+import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson as J
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.List.NonEmpty as L
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Maybe (fromMaybe)
+import Data.Typeable (Typeable)
+import Data.Word (Word32)
+import qualified Database.PostgreSQL.Simple.FromField as PF
+import qualified Database.PostgreSQL.Simple.ToField as PT
+import qualified Database.PostgreSQL.Simple.TypeInfo as PTI
+import qualified Database.PostgreSQL.Simple.TypeInfo.Static as PTIS
+import qualified Database.SQLite.Simple.FromField as SF
+import qualified Database.SQLite.Simple.ToField as ST
+import GHC.Generics
+import Simplex.Messaging.Agent.QueryString
+import Simplex.Messaging.Crypto
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (blobFieldDecoder, parseE, parseE')
+import Simplex.Messaging.Util (tryE)
+import Simplex.Messaging.Version
+
+e2eEncryptVersion :: Version
+e2eEncryptVersion = 1
+
+e2eEncryptVRange :: VersionRange
+e2eEncryptVRange = mkVersionRange 1 e2eEncryptVersion
+
+data E2ERatchetParams (a :: Algorithm)
+  = E2ERatchetParams Version (PublicKey a) (PublicKey a)
+  deriving (Eq, Show)
+
+instance AlgorithmI a => Encoding (E2ERatchetParams a) where
+  smpEncode (E2ERatchetParams v k1 k2) = smpEncode (v, k1, k2)
+  smpP = E2ERatchetParams <$> smpP <*> smpP <*> smpP
+
+instance VersionI (E2ERatchetParams a) where
+  type VersionRangeT (E2ERatchetParams a) = E2ERatchetParamsUri a
+  version (E2ERatchetParams v _ _) = v
+  toVersionRangeT (E2ERatchetParams _ k1 k2) vr = E2ERatchetParamsUri vr k1 k2
+
+instance VersionRangeI (E2ERatchetParamsUri a) where
+  type VersionT (E2ERatchetParamsUri a) = (E2ERatchetParams a)
+  versionRange (E2ERatchetParamsUri vr _ _) = vr
+  toVersionT (E2ERatchetParamsUri _ k1 k2) v = E2ERatchetParams v k1 k2
+
+data E2ERatchetParamsUri (a :: Algorithm)
+  = E2ERatchetParamsUri VersionRange (PublicKey a) (PublicKey a)
+  deriving (Eq, Show)
+
+instance AlgorithmI a => StrEncoding (E2ERatchetParamsUri a) where
+  strEncode (E2ERatchetParamsUri vs key1 key2) =
+    strEncode $
+      QSP QNoEscaping [("v", strEncode vs), ("x3dh", strEncodeList [key1, key2])]
+  strP = do
+    query <- strP
+    vs <- queryParam "v" query
+    keys <- L.toList <$> queryParam "x3dh" query
+    case keys of
+      [key1, key2] -> pure $ E2ERatchetParamsUri vs key1 key2
+      _ -> fail "bad e2e params"
+
+generateE2EParams :: (AlgorithmI a, DhAlgorithm a) => Version -> IO (PrivateKey a, PrivateKey a, E2ERatchetParams a)
+generateE2EParams v = do
+  (k1, pk1) <- generateKeyPair'
+  (k2, pk2) <- generateKeyPair'
+  pure (pk1, pk2, E2ERatchetParams v k1 k2)
+
+data RatchetInitParams = RatchetInitParams
+  { assocData :: Str,
+    ratchetKey :: RatchetKey,
+    sndHK :: HeaderKey,
+    rcvNextHK :: HeaderKey
+  }
+  deriving (Eq, Show)
+
+x3dhSnd :: DhAlgorithm a => PrivateKey a -> PrivateKey a -> E2ERatchetParams a -> RatchetInitParams
+x3dhSnd spk1 spk2 (E2ERatchetParams _ rk1 rk2) =
+  x3dh (publicKey spk1, rk1) (dh' rk1 spk2) (dh' rk2 spk1) (dh' rk2 spk2)
+
+x3dhRcv :: DhAlgorithm a => PrivateKey a -> PrivateKey a -> E2ERatchetParams a -> RatchetInitParams
+x3dhRcv rpk1 rpk2 (E2ERatchetParams _ sk1 sk2) =
+  x3dh (sk1, publicKey rpk1) (dh' sk2 rpk1) (dh' sk1 rpk2) (dh' sk2 rpk2)
+
+x3dh :: DhAlgorithm a => (PublicKey a, PublicKey a) -> DhSecret a -> DhSecret a -> DhSecret a -> RatchetInitParams
+x3dh (sk1, rk1) dh1 dh2 dh3 =
+  RatchetInitParams {assocData, ratchetKey = RatchetKey sk, sndHK = Key hk, rcvNextHK = Key nhk}
+  where
+    assocData = Str $ pubKeyBytes sk1 <> pubKeyBytes rk1
+    (hk, rest) = B.splitAt 32 $ dhBytes' dh1 <> dhBytes' dh2 <> dhBytes' dh3
+    (nhk, sk) = B.splitAt 32 rest
+
+type RatchetX448 = Ratchet 'X448
+
+data Ratchet a = Ratchet
+  { -- ratchet version range sent in messages (current .. max supported ratchet version)
+    rcVersion :: VersionRange,
+    -- associated data - must be the same in both parties ratchets
+    rcAD :: Str,
+    rcDHRs :: PrivateKey a,
+    rcRK :: RatchetKey,
+    rcSnd :: Maybe (SndRatchet a),
+    rcRcv :: Maybe RcvRatchet,
+    rcNs :: Word32,
+    rcNr :: Word32,
+    rcPN :: Word32,
+    rcNHKs :: HeaderKey,
+    rcNHKr :: HeaderKey
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance AlgorithmI a => ToJSON (Ratchet a) where
+  toEncoding = J.genericToEncoding J.defaultOptions
+
+data SndRatchet a = SndRatchet
+  { rcDHRr :: PublicKey a,
+    rcCKs :: RatchetKey,
+    rcHKs :: HeaderKey
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance AlgorithmI a => ToJSON (SndRatchet a) where
+  toEncoding = J.genericToEncoding J.defaultOptions
+
+data RcvRatchet = RcvRatchet
+  { rcCKr :: RatchetKey,
+    rcHKr :: HeaderKey
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON RcvRatchet where
+  toEncoding = J.genericToEncoding J.defaultOptions
+
+type SkippedMsgKeys = Map HeaderKey SkippedHdrMsgKeys
+
+type SkippedHdrMsgKeys = Map Word32 MessageKey
+
+data SkippedMsgDiff
+  = SMDNoChange
+  | SMDRemove HeaderKey Word32
+  | SMDAdd SkippedMsgKeys
+
+-- | this function is only used in tests to apply changes in skipped messages,
+-- in the agent the diff is persisted, and the whole state is loaded for the next message.
+applySMDiff :: SkippedMsgKeys -> SkippedMsgDiff -> SkippedMsgKeys
+applySMDiff smks = \case
+  SMDNoChange -> smks
+  SMDRemove hk msgN -> fromMaybe smks $ do
+    mks <- M.lookup hk smks
+    _ <- M.lookup msgN mks
+    let mks' = M.delete msgN mks
+    pure $
+      if M.null mks'
+        then M.delete hk smks
+        else M.insert hk mks' smks
+  SMDAdd smks' ->
+    let merge hk mks = M.alter (Just . maybe mks (M.union mks)) hk
+     in M.foldrWithKey merge smks smks'
+
+type HeaderKey = Key
+
+data MessageKey = MessageKey Key IV
+
+instance Encoding MessageKey where
+  smpEncode (MessageKey (Key key) (IV iv)) = smpEncode (key, iv)
+  smpP = MessageKey <$> (Key <$> smpP) <*> (IV <$> smpP)
+
+-- | Input key material for double ratchet HKDF functions
+newtype RatchetKey = RatchetKey ByteString
+  deriving (Eq, Show)
+
+instance ToJSON RatchetKey where
+  toJSON (RatchetKey k) = strToJSON k
+  toEncoding (RatchetKey k) = strToJEncoding k
+
+instance FromJSON RatchetKey where
+  parseJSON = fmap RatchetKey . strParseJSON "Key"
+
+instance AlgorithmI a => ST.ToField (Ratchet a) where toField = ST.toField . LB.toStrict . J.encode
+
+instance AlgorithmI a => PT.ToField (Ratchet a) where toField = PT.toField . LB.toStrict . J.encode
+
+instance (AlgorithmI a, Typeable a) => PF.FromField (Ratchet a) where fromField = fromByteStringField J.eitherDecodeStrict'
+
+instance (AlgorithmI a, Typeable a) => SF.FromField (Ratchet a) where fromField = blobFieldDecoder J.eitherDecodeStrict'
+
+instance ST.ToField MessageKey where toField = ST.toField . smpEncode
+
+instance PT.ToField MessageKey where toField = PT.toField . smpEncode
+
+instance SF.FromField MessageKey where fromField = blobFieldDecoder smpDecode
+
+instance PF.FromField MessageKey where fromField = fromByteStringField smpDecode
+
+fromByteStringField :: Typeable a => (ByteString -> Either String a) -> PF.Field -> Maybe ByteString -> PF.Conversion a
+fromByteStringField dec f mdata =
+  if PF.typeOid f /= PTI.typoid PTIS.bytea
+    then PF.returnError PF.Incompatible f ""
+    else case mdata of
+      Nothing -> PF.returnError PF.UnexpectedNull f ""
+      Just dat ->
+        case dec dat of
+          Right x -> return x
+          _ -> PF.returnError PF.ConversionFailed f (B.unpack dat)
+
+-- | Sending ratchet initialization, equivalent to RatchetInitAliceHE in double ratchet spec
+--
+-- Please note that sPKey is not stored, and its public part together with random salt
+-- is sent to the recipient.
+initSndRatchet ::
+  forall a. (AlgorithmI a, DhAlgorithm a) => PublicKey a -> PrivateKey a -> RatchetInitParams -> Ratchet a
+initSndRatchet rcDHRr rcDHRs RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK} = do
+  -- state.RK, state.CKs, state.NHKs = KDF_RK_HE(SK, DH(state.DHRs, state.DHRr))
+  let (rcRK, rcCKs, rcNHKs) = rootKdf ratchetKey rcDHRr rcDHRs
+   in Ratchet
+        { rcVersion = e2eEncryptVRange,
+          rcAD = assocData,
+          rcDHRs,
+          rcRK,
+          rcSnd = Just SndRatchet {rcDHRr, rcCKs, rcHKs = sndHK},
+          rcRcv = Nothing,
+          rcPN = 0,
+          rcNs = 0,
+          rcNr = 0,
+          rcNHKs,
+          rcNHKr = rcvNextHK
+        }
+
+-- | Receiving ratchet initialization, equivalent to RatchetInitBobHE in double ratchet spec
+--
+-- Please note that the public part of rcDHRs was sent to the sender
+-- as part of the connection request and random salt was received from the sender.
+initRcvRatchet ::
+  forall a. (AlgorithmI a, DhAlgorithm a) => PrivateKey a -> RatchetInitParams -> Ratchet a
+initRcvRatchet rcDHRs RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK} =
+  Ratchet
+    { rcVersion = e2eEncryptVRange,
+      rcAD = assocData,
+      rcDHRs,
+      rcRK = ratchetKey,
+      rcSnd = Nothing,
+      rcRcv = Nothing,
+      rcPN = 0,
+      rcNs = 0,
+      rcNr = 0,
+      rcNHKs = rcvNextHK,
+      rcNHKr = sndHK
+    }
+
+data MsgHeader a = MsgHeader
+  { -- | max supported ratchet version
+    msgMaxVersion :: Version,
+    msgDHRs :: PublicKey a,
+    msgPN :: Word32,
+    msgNs :: Word32
+  }
+  deriving (Eq, Show)
+
+data AMsgHeader
+  = forall a.
+    (AlgorithmI a, DhAlgorithm a) =>
+    AMsgHeader (SAlgorithm a) (MsgHeader a)
+
+-- to allow extension without increasing the size, the actual header length is:
+-- 69 = 2 (original size) + 2 + 1+56 (Curve448) + 4 + 4
+paddedHeaderLen :: Int
+paddedHeaderLen = 88
+
+-- only used in tests to validate correct padding
+-- (2 bytes - version size, 1 byte - header size, not to have it fixed or version-dependent)
+fullHeaderLen :: Int
+fullHeaderLen = 2 + 1 + paddedHeaderLen + authTagSize + ivSize @AES256
+
+instance AlgorithmI a => Encoding (MsgHeader a) where
+  smpEncode MsgHeader {msgMaxVersion, msgDHRs, msgPN, msgNs} =
+    smpEncode (msgMaxVersion, msgDHRs, msgPN, msgNs)
+  smpP = do
+    msgMaxVersion <- smpP
+    msgDHRs <- smpP
+    msgPN <- smpP
+    msgNs <- smpP
+    pure MsgHeader {msgMaxVersion, msgDHRs, msgPN, msgNs}
+
+data EncMessageHeader = EncMessageHeader
+  { ehVersion :: Version,
+    ehIV :: IV,
+    ehAuthTag :: AuthTag,
+    ehBody :: ByteString
+  }
+
+instance Encoding EncMessageHeader where
+  smpEncode EncMessageHeader {ehVersion, ehIV, ehAuthTag, ehBody} =
+    smpEncode (ehVersion, ehIV, ehAuthTag, ehBody)
+  smpP = do
+    (ehVersion, ehIV, ehAuthTag, ehBody) <- smpP
+    pure EncMessageHeader {ehVersion, ehIV, ehAuthTag, ehBody}
+
+data EncRatchetMessage = EncRatchetMessage
+  { emHeader :: ByteString,
+    emAuthTag :: AuthTag,
+    emBody :: ByteString
+  }
+
+instance Encoding EncRatchetMessage where
+  smpEncode EncRatchetMessage {emHeader, emBody, emAuthTag} =
+    smpEncode (emHeader, emAuthTag, Tail emBody)
+  smpP = do
+    (emHeader, emAuthTag, Tail emBody) <- smpP
+    pure EncRatchetMessage {emHeader, emBody, emAuthTag}
+
+rcEncrypt :: AlgorithmI a => Ratchet a -> Int -> ByteString -> ExceptT CryptoError IO (ByteString, Ratchet a)
+rcEncrypt Ratchet {rcSnd = Nothing} _ _ = throwE CERatchetState
+rcEncrypt rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, rcNs, rcPN, rcAD = Str rcAD, rcVersion} paddedMsgLen msg = do
+  -- state.CKs, mk = KDF_CK(state.CKs)
+  let (ck', mk, iv, ehIV) = chainKdf rcCKs
+  -- enc_header = HENCRYPT(state.HKs, header)
+  (ehAuthTag, ehBody) <- encryptAEAD rcHKs ehIV paddedHeaderLen rcAD msgHeader
+  -- return enc_header, ENCRYPT(mk, plaintext, CONCAT(AD, enc_header))
+  let emHeader = smpEncode EncMessageHeader {ehVersion = minVersion rcVersion, ehBody, ehAuthTag, ehIV}
+  (emAuthTag, emBody) <- encryptAEAD mk iv paddedMsgLen (rcAD <> emHeader) msg
+  let msg' = smpEncode EncRatchetMessage {emHeader, emBody, emAuthTag}
+      -- state.Ns += 1
+      rc' = rc {rcSnd = Just sr {rcCKs = ck'}, rcNs = rcNs + 1}
+  pure (msg', rc')
+  where
+    -- header = HEADER(state.DHRs, state.PN, state.Ns)
+    msgHeader =
+      smpEncode
+        MsgHeader
+          { msgMaxVersion = maxVersion rcVersion,
+            msgDHRs = publicKey rcDHRs,
+            msgPN = rcPN,
+            msgNs = rcNs
+          }
+
+data SkippedMessage a
+  = SMMessage (DecryptResult a)
+  | SMHeader (Maybe RatchetStep) (MsgHeader a)
+  | SMNone
+
+data RatchetStep = AdvanceRatchet | SameRatchet
+  deriving (Eq)
+
+type DecryptResult a = (Either CryptoError ByteString, Ratchet a, SkippedMsgDiff)
+
+maxSkip :: Word32
+maxSkip = 512
+
+rcDecrypt ::
+  forall a.
+  (AlgorithmI a, DhAlgorithm a) =>
+  Ratchet a ->
+  SkippedMsgKeys ->
+  ByteString ->
+  ExceptT CryptoError IO (DecryptResult a)
+rcDecrypt rc@Ratchet {rcRcv, rcAD = Str rcAD} rcMKSkipped msg' = do
+  encMsg@EncRatchetMessage {emHeader} <- parseE CryptoHeaderError smpP msg'
+  encHdr <- parseE CryptoHeaderError smpP emHeader
+  -- plaintext = TrySkippedMessageKeysHE(state, enc_header, cipher-text, AD)
+  decryptSkipped encHdr encMsg >>= \case
+    SMNone -> do
+      (rcStep, hdr) <- decryptRcHeader rcRcv encHdr
+      decryptRcMessage rcStep hdr encMsg
+    SMHeader rcStep_ hdr ->
+      case rcStep_ of
+        Just rcStep -> decryptRcMessage rcStep hdr encMsg
+        Nothing -> throwE CERatchetHeader
+    SMMessage r -> pure r
+  where
+    decryptRcMessage :: RatchetStep -> MsgHeader a -> EncRatchetMessage -> ExceptT CryptoError IO (DecryptResult a)
+    decryptRcMessage rcStep MsgHeader {msgDHRs, msgPN, msgNs} encMsg = do
+      -- if dh_ratchet:
+      (rc', smks1) <- ratchetStep rcStep
+      case skipMessageKeys msgNs rc' of
+        Left e -> pure (Left e, rc', smkDiff smks1)
+        Right (rc''@Ratchet {rcRcv = Just rr@RcvRatchet {rcCKr}, rcNr}, smks2) -> do
+          -- state.CKr, mk = KDF_CK(state.CKr)
+          let (rcCKr', mk, iv, _) = chainKdf rcCKr
+          -- return DECRYPT (mk, cipher-text, CONCAT (AD, enc_header))
+          msg <- decryptMessage (MessageKey mk iv) encMsg
+          -- state . Nr += 1
+          pure (msg, rc'' {rcRcv = Just rr {rcCKr = rcCKr'}, rcNr = rcNr + 1}, smkDiff $ smks1 <> smks2)
+        Right (rc'', smks2) -> do
+          pure (Left CERatchetState, rc'', smkDiff $ smks1 <> smks2)
+      where
+        smkDiff :: SkippedMsgKeys -> SkippedMsgDiff
+        smkDiff smks = if M.null smks then SMDNoChange else SMDAdd smks
+        ratchetStep :: RatchetStep -> ExceptT CryptoError IO (Ratchet a, SkippedMsgKeys)
+        ratchetStep SameRatchet = pure (rc, M.empty)
+        ratchetStep AdvanceRatchet =
+          -- SkipMessageKeysHE(state, header.pn)
+          case skipMessageKeys msgPN rc of
+            Left e -> throwE e
+            Right (rc'@Ratchet {rcDHRs, rcRK, rcNHKs, rcNHKr}, hmks) -> do
+              -- DHRatchetHE(state, header)
+              (_, rcDHRs') <- liftIO $ generateKeyPair' @a
+              -- state.RK, state.CKr, state.NHKr = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr))
+              let (rcRK', rcCKr', rcNHKr') = rootKdf rcRK msgDHRs rcDHRs
+                  -- state.RK, state.CKs, state.NHKs = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr))
+                  (rcRK'', rcCKs', rcNHKs') = rootKdf rcRK' msgDHRs rcDHRs'
+                  rc'' =
+                    rc'
+                      { rcDHRs = rcDHRs',
+                        rcRK = rcRK'',
+                        rcSnd = Just SndRatchet {rcDHRr = msgDHRs, rcCKs = rcCKs', rcHKs = rcNHKs},
+                        rcRcv = Just RcvRatchet {rcCKr = rcCKr', rcHKr = rcNHKr},
+                        rcPN = rcNs rc,
+                        rcNs = 0,
+                        rcNr = 0,
+                        rcNHKs = rcNHKs',
+                        rcNHKr = rcNHKr'
+                      }
+              pure (rc'', hmks)
+    skipMessageKeys :: Word32 -> Ratchet a -> Either CryptoError (Ratchet a, SkippedMsgKeys)
+    skipMessageKeys _ r@Ratchet {rcRcv = Nothing} = Right (r, M.empty)
+    skipMessageKeys untilN r@Ratchet {rcRcv = Just rr@RcvRatchet {rcCKr, rcHKr}, rcNr}
+      | rcNr > untilN = Left CERatchetDuplicateMessage
+      | rcNr + maxSkip < untilN = Left CERatchetTooManySkipped
+      | rcNr == untilN = Right (r, M.empty)
+      | otherwise =
+        let (rcCKr', rcNr', mks) = advanceRcvRatchet (untilN - rcNr) rcCKr rcNr M.empty
+            r' = r {rcRcv = Just rr {rcCKr = rcCKr'}, rcNr = rcNr'}
+         in Right (r', M.singleton rcHKr mks)
+    advanceRcvRatchet :: Word32 -> RatchetKey -> Word32 -> SkippedHdrMsgKeys -> (RatchetKey, Word32, SkippedHdrMsgKeys)
+    advanceRcvRatchet 0 ck msgNs mks = (ck, msgNs, mks)
+    advanceRcvRatchet n ck msgNs mks =
+      let (ck', mk, iv, _) = chainKdf ck
+          mks' = M.insert msgNs (MessageKey mk iv) mks
+       in advanceRcvRatchet (n - 1) ck' (msgNs + 1) mks'
+    decryptSkipped :: EncMessageHeader -> EncRatchetMessage -> ExceptT CryptoError IO (SkippedMessage a)
+    decryptSkipped encHdr encMsg = tryDecryptSkipped SMNone $ M.assocs rcMKSkipped
+      where
+        tryDecryptSkipped :: SkippedMessage a -> [(HeaderKey, SkippedHdrMsgKeys)] -> ExceptT CryptoError IO (SkippedMessage a)
+        tryDecryptSkipped SMNone ((hk, mks) : hks) = do
+          tryE (decryptHeader hk encHdr) >>= \case
+            Left CERatchetHeader -> tryDecryptSkipped SMNone hks
+            Left e -> throwE e
+            Right hdr@MsgHeader {msgNs} ->
+              case M.lookup msgNs mks of
+                Nothing ->
+                  let nextRc
+                        | maybe False ((== hk) . rcHKr) rcRcv = Just SameRatchet
+                        | hk == rcNHKr rc = Just AdvanceRatchet
+                        | otherwise = Nothing
+                   in pure $ SMHeader nextRc hdr
+                Just mk -> do
+                  msg <- decryptMessage mk encMsg
+                  pure $ SMMessage (msg, rc, SMDRemove hk msgNs)
+        tryDecryptSkipped r _ = pure r
+    decryptRcHeader :: Maybe RcvRatchet -> EncMessageHeader -> ExceptT CryptoError IO (RatchetStep, MsgHeader a)
+    decryptRcHeader Nothing hdr = decryptNextHeader hdr
+    decryptRcHeader (Just RcvRatchet {rcHKr}) hdr =
+      -- header = HDECRYPT(state.HKr, enc_header)
+      ((SameRatchet,) <$> decryptHeader rcHKr hdr) `catchE` \case
+        CERatchetHeader -> decryptNextHeader hdr
+        e -> throwE e
+    -- header = HDECRYPT(state.NHKr, enc_header)
+    decryptNextHeader hdr = (AdvanceRatchet,) <$> decryptHeader (rcNHKr rc) hdr
+    decryptHeader k EncMessageHeader {ehBody, ehAuthTag, ehIV} = do
+      header <- decryptAEAD k ehIV rcAD ehBody ehAuthTag `catchE` \_ -> throwE CERatchetHeader
+      parseE' CryptoHeaderError smpP header
+    decryptMessage :: MessageKey -> EncRatchetMessage -> ExceptT CryptoError IO (Either CryptoError ByteString)
+    decryptMessage (MessageKey mk iv) EncRatchetMessage {emHeader, emBody, emAuthTag} =
+      -- DECRYPT(mk, cipher-text, CONCAT(AD, enc_header))
+      -- TODO add associated data
+      tryE $ decryptAEAD mk iv (rcAD <> emHeader) emBody emAuthTag
+
+rootKdf :: (AlgorithmI a, DhAlgorithm a) => RatchetKey -> PublicKey a -> PrivateKey a -> (RatchetKey, RatchetKey, Key)
+rootKdf (RatchetKey rk) k pk =
+  let dhOut = dhBytes' $ dh' k pk
+      (rk', ck, nhk) = hkdf3 rk dhOut "SimpleXRootRatchet"
+   in (RatchetKey rk', RatchetKey ck, Key nhk)
+
+chainKdf :: RatchetKey -> (RatchetKey, Key, IV, IV)
+chainKdf (RatchetKey ck) =
+  let (ck', mk, ivs) = hkdf3 "" ck "SimpleXChainRatchet"
+      (iv1, iv2) = B.splitAt 16 ivs
+   in (RatchetKey ck', Key mk, IV iv1, IV iv2)
+
+hkdf3 :: ByteString -> ByteString -> ByteString -> (ByteString, ByteString, ByteString)
+hkdf3 salt ikm info = (s1, s2, s3)
+  where
+    prk = H.extract salt ikm :: H.PRK SHA512
+    out = H.expand prk info 96
+    (s1, rest) = B.splitAt 32 out
+    (s2, s3) = B.splitAt 32 rest

src/Simplex/Messaging/Encoding.hs

@@ -0,0 +1,143 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Simplex.Messaging.Encoding
+  ( Encoding (..),
+    Tail (..),
+    Large (..),
+    smpEncodeList,
+    smpListP,
+  )
+where
+
+import Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Bits (shiftL, shiftR, (.|.))
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.ByteString.Internal (c2w, w2c)
+import Data.Int (Int64)
+import qualified Data.List.NonEmpty as L
+import Data.Time.Clock.System (SystemTime (..))
+import Data.Word (Word16, Word32)
+import Network.Transport.Internal (decodeWord16, decodeWord32, encodeWord16, encodeWord32)
+import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Util ((<$?>))
+
+-- | SMP protocol encoding
+class Encoding a where
+  {-# MINIMAL smpEncode, (smpDecode | smpP) #-}
+
+  -- | protocol encoding of type (default implementation uses protocol ByteString encoding)
+  smpEncode :: a -> ByteString
+
+  -- | decoding of type (default implementation uses parser)
+  smpDecode :: ByteString -> Either String a
+  smpDecode = parseAll smpP
+
+  -- | protocol parser of type (default implementation parses protocol ByteString encoding)
+  smpP :: Parser a
+  smpP = smpDecode <$?> smpP
+
+instance Encoding Char where
+  smpEncode = B.singleton
+  smpP = A.anyChar
+
+instance Encoding Word16 where
+  smpEncode = encodeWord16
+  smpP = decodeWord16 <$> A.take 2
+
+instance Encoding Word32 where
+  smpEncode = encodeWord32
+  smpP = decodeWord32 <$> A.take 4
+
+instance Encoding Int64 where
+  smpEncode i = w32 (i `shiftR` 32) <> w32 i
+  smpP = do
+    l <- w32P
+    r <- w32P
+    pure $ (l `shiftL` 32) .|. r
+
+w32 :: Int64 -> ByteString
+w32 = smpEncode @Word32 . fromIntegral
+
+w32P :: Parser Int64
+w32P = fromIntegral <$> smpP @Word32
+
+-- ByteStrings are assumed no longer than 255 bytes
+instance Encoding ByteString where
+  smpEncode s = B.cons (lenEncode $ B.length s) s
+  smpP = A.take =<< lenP
+
+lenEncode :: Int -> Char
+lenEncode = w2c . fromIntegral
+
+lenP :: Parser Int
+lenP = fromIntegral . c2w <$> A.anyChar
+
+instance Encoding a => Encoding (Maybe a) where
+  smpEncode s = maybe "0" (("1" <>) . smpEncode) s
+  smpP =
+    smpP >>= \case
+      '0' -> pure Nothing
+      '1' -> Just <$> smpP
+      _ -> fail "invalid Maybe tag"
+
+newtype Tail = Tail {unTail :: ByteString}
+
+instance Encoding Tail where
+  smpEncode = unTail
+  smpP = Tail <$> A.takeByteString
+
+-- newtype for encoding/decoding ByteStrings over 255 bytes with 2-bytes length prefix
+newtype Large = Large {unLarge :: ByteString}
+
+instance Encoding Large where
+  smpEncode (Large s) = smpEncode @Word16 (fromIntegral $ B.length s) <> s
+  smpP = do
+    len <- fromIntegral <$> smpP @Word16
+    Large <$> A.take len
+
+instance Encoding SystemTime where
+  smpEncode = smpEncode . systemSeconds
+  smpP = MkSystemTime <$> smpP <*> pure 0
+
+-- lists encode/parse as a sequence of items prefixed with list length (as 1 byte)
+smpEncodeList :: Encoding a => [a] -> ByteString
+smpEncodeList xs = B.cons (lenEncode $ length xs) . B.concat $ map smpEncode xs
+
+smpListP :: Encoding a => Parser [a]
+smpListP = (`A.count` smpP) =<< lenP
+
+instance Encoding String where
+  smpEncode = smpEncode . B.pack
+  smpP = B.unpack <$> smpP
+
+instance Encoding a => Encoding (L.NonEmpty a) where
+  smpEncode = smpEncodeList . L.toList
+  smpP =
+    lenP >>= \case
+      0 -> fail "empty list"
+      n -> L.fromList <$> A.count n smpP
+
+instance (Encoding a, Encoding b) => Encoding (a, b) where
+  smpEncode (a, b) = smpEncode a <> smpEncode b
+  smpP = (,) <$> smpP <*> smpP
+
+instance (Encoding a, Encoding b, Encoding c) => Encoding (a, b, c) where
+  smpEncode (a, b, c) = smpEncode a <> smpEncode b <> smpEncode c
+  smpP = (,,) <$> smpP <*> smpP <*> smpP
+
+instance (Encoding a, Encoding b, Encoding c, Encoding d) => Encoding (a, b, c, d) where
+  smpEncode (a, b, c, d) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d
+  smpP = (,,,) <$> smpP <*> smpP <*> smpP <*> smpP
+
+instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e) => Encoding (a, b, c, d, e) where
+  smpEncode (a, b, c, d, e) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d <> smpEncode e
+  smpP = (,,,,) <$> smpP <*> smpP <*> smpP <*> smpP <*> smpP

src/Simplex/Messaging/Encoding/String.hs

@@ -0,0 +1,120 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Encoding.String
+  ( StrEncoding (..),
+    Str (..),
+    strP_,
+    strToJSON,
+    strToJEncoding,
+    strParseJSON,
+    base64urlP,
+    strEncodeList,
+    strListP,
+  )
+where
+
+import Control.Applicative (optional)
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Encoding as JE
+import qualified Data.Aeson.Types as JT
+import Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.ByteString.Base64.URL as U
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Char (isAlphaNum)
+import qualified Data.List.NonEmpty as L
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
+import Data.Word (Word16)
+import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Util ((<$?>))
+
+-- | Serializing human-readable and (where possible) URI-friendly strings for SMP and SMP agent protocols
+class StrEncoding a where
+  {-# MINIMAL strEncode, (strDecode | strP) #-}
+  strEncode :: a -> ByteString
+
+  -- Please note - if you only specify strDecode, it will use base64urlP as default parser before decoding the string
+  strDecode :: ByteString -> Either String a
+  strDecode = parseAll strP
+  strP :: Parser a
+  strP = strDecode <$?> base64urlP
+
+-- base64url encoding/decoding of ByteStrings - the parser only allows non-empty strings
+instance StrEncoding ByteString where
+  strEncode = U.encode
+  strDecode = U.decode
+  strP = base64urlP
+
+base64urlP :: Parser ByteString
+base64urlP = do
+  str <- A.takeWhile1 (\c -> isAlphaNum c || c == '-' || c == '_')
+  pad <- A.takeWhile (== '=')
+  either fail pure $ U.decode (str <> pad)
+
+newtype Str = Str {unStr :: ByteString}
+  deriving (Eq, Show)
+
+instance StrEncoding Str where
+  strEncode = unStr
+  strP = Str <$> A.takeTill (== ' ') <* optional A.space
+
+instance ToJSON Str where
+  toJSON (Str s) = strToJSON s
+  toEncoding (Str s) = strToJEncoding s
+
+instance FromJSON Str where
+  parseJSON = fmap Str . strParseJSON "Str"
+
+instance StrEncoding a => StrEncoding (Maybe a) where
+  strEncode = maybe "" strEncode
+  strP = optional strP
+
+instance StrEncoding Word16 where
+  strEncode = B.pack . show
+  strP = A.decimal
+
+-- lists encode/parse as comma-separated strings
+strEncodeList :: StrEncoding a => [a] -> ByteString
+strEncodeList = B.intercalate "," . map strEncode
+
+strListP :: StrEncoding a => Parser [a]
+strListP = listItem `A.sepBy'` A.char ','
+
+-- relies on sepBy1 never returning an empty list
+instance StrEncoding a => StrEncoding (L.NonEmpty a) where
+  strEncode = strEncodeList . L.toList
+  strP = L.fromList <$> listItem `A.sepBy1'` A.char ','
+
+listItem :: StrEncoding a => Parser a
+listItem = parseAll strP <$?> A.takeTill (== ',')
+
+instance (StrEncoding a, StrEncoding b) => StrEncoding (a, b) where
+  strEncode (a, b) = B.unwords [strEncode a, strEncode b]
+  strP = (,) <$> strP_ <*> strP
+
+instance (StrEncoding a, StrEncoding b, StrEncoding c) => StrEncoding (a, b, c) where
+  strEncode (a, b, c) = B.unwords [strEncode a, strEncode b, strEncode c]
+  strP = (,,) <$> strP_ <*> strP_ <*> strP
+
+instance (StrEncoding a, StrEncoding b, StrEncoding c, StrEncoding d) => StrEncoding (a, b, c, d) where
+  strEncode (a, b, c, d) = B.unwords [strEncode a, strEncode b, strEncode c, strEncode d]
+  strP = (,,,) <$> strP_ <*> strP_ <*> strP_ <*> strP
+
+instance (StrEncoding a, StrEncoding b, StrEncoding c, StrEncoding d, StrEncoding e) => StrEncoding (a, b, c, d, e) where
+  strEncode (a, b, c, d, e) = B.unwords [strEncode a, strEncode b, strEncode c, strEncode d, strEncode e]
+  strP = (,,,,) <$> strP_ <*> strP_ <*> strP_ <*> strP_ <*> strP
+
+strP_ :: StrEncoding a => Parser a
+strP_ = strP <* A.space
+
+strToJSON :: StrEncoding a => a -> J.Value
+strToJSON = J.String . decodeLatin1 . strEncode
+
+strToJEncoding :: StrEncoding a => a -> J.Encoding
+strToJEncoding = JE.text . decodeLatin1 . strEncode
+
+strParseJSON :: StrEncoding a => String -> J.Value -> JT.Parser a
+strParseJSON name = J.withText name $ either fail pure . parseAll strP . encodeUtf8

src/Simplex/Messaging/Parsers.hs

@@ -3,35 +3,30 @@
 
 module Simplex.Messaging.Parsers where
 
+import Control.Monad.Trans.Except
+import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import Data.ByteString.Base64
-import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Char (isAlphaNum)
+import Data.Char (isAlphaNum, toLower)
 import Data.Time.Clock (UTCTime)
 import Data.Time.ISO8601 (parseISO8601)
 import Data.Typeable (Typeable)
+import qualified Database.PostgreSQL.Simple.FromField as PF
+import qualified Database.PostgreSQL.Simple.Internal as PI
+import qualified Database.PostgreSQL.Simple.Ok as PO
 import Database.SQLite.Simple (ResultError (..), SQLData (..))
-import Database.SQLite.Simple.FromField (FieldParser, returnError)
-import Database.SQLite.Simple.Internal (Field (..))
-import Database.SQLite.Simple.Ok (Ok (Ok))
+import qualified Database.SQLite.Simple.FromField as SF
+import qualified Database.SQLite.Simple.Internal as SI
+import qualified Database.SQLite.Simple.Ok as SO
 import Simplex.Messaging.Util ((<$?>))
 import Text.Read (readMaybe)
 
 base64P :: Parser ByteString
-base64P = decode <$?> base64StringP
-
-base64StringP :: Parser ByteString
-base64StringP = paddedBase64 rawBase64P
-
-base64UriP :: Parser ByteString
-base64UriP = U.decode <$?> base64UriStringP
-
-base64UriStringP :: Parser ByteString
-base64UriStringP = paddedBase64 rawBase64UriP
+base64P = decode <$?> paddedBase64 rawBase64P
 
 paddedBase64 :: Parser ByteString -> Parser ByteString
 paddedBase64 raw = (<>) <$> raw <*> pad
@@ -41,8 +36,8 @@ paddedBase64 raw = (<>) <$> raw <*> pad
 rawBase64P :: Parser ByteString
 rawBase64P = A.takeWhile1 (\c -> isAlphaNum c || c == '+' || c == '/')
 
-rawBase64UriP :: Parser ByteString
-rawBase64UriP = A.takeWhile1 (\c -> isAlphaNum c || c == '-' || c == '_')
+-- rawBase64UriP :: Parser ByteString
+-- rawBase64UriP = A.takeWhile1 (\c -> isAlphaNum c || c == '-' || c == '_')
 
 tsISO8601P :: Parser UTCTime
 tsISO8601P = maybe (fail "timestamp") pure . parseISO8601 . B.unpack =<< A.takeTill wordEnd
@@ -53,6 +48,12 @@ parse parser err = first (const err) . parseAll parser
 parseAll :: Parser a -> (ByteString -> Either String a)
 parseAll parser = A.parseOnly (parser <* A.endOfInput)
 
+parseE :: (String -> e) -> Parser a -> (ByteString -> ExceptT e IO a)
+parseE err parser = except . first err . parseAll parser
+
+parseE' :: (String -> e) -> Parser a -> (ByteString -> ExceptT e IO a)
+parseE' err parser = except . first err . A.parseOnly parser
+
 parseRead :: Read a => Parser ByteString -> Parser a
 parseRead = (>>= maybe (fail "cannot read") pure . readMaybe . B.unpack)
 
@@ -71,10 +72,58 @@ wordEnd c = c == ' ' || c == '\n'
 parseString :: (ByteString -> Either String a) -> (String -> a)
 parseString p = either error id . p . B.pack
 
-blobFieldParser :: Typeable k => Parser k -> FieldParser k
-blobFieldParser p = \case
-  f@(Field (SQLBlob b) _) ->
-    case parseAll p b of
-      Right k -> Ok k
-      Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
-  f -> returnError ConversionFailed f "expecting SQLBlob column type"
+blobFieldParser :: Typeable k => Parser k -> SF.FieldParser k
+blobFieldParser = blobFieldDecoder . parseAll
+
+blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> SF.FieldParser k
+blobFieldDecoder dec = \case
+  f@(SI.Field (SQLBlob b) _) ->
+    case dec b of
+      Right k -> SO.Ok k
+      Left e -> SF.returnError SF.ConversionFailed f ("couldn't parse field: " ++ e)
+  f -> SF.returnError SF.ConversionFailed f "expecting SQLBlob column type"
+
+-- blobFieldDecoderPostgres :: Typeable k => (ByteString -> Either String k) -> PF.FieldParser k
+-- blobFieldDecoderPostgres dec = \case
+--   f@(PI.Field b _ _) ->
+--     case dec b of
+--       Right k -> PO.Ok k
+--       Left e -> PF.returnError PF.ConversionFailed f ("couldn't parse field: " ++ e)
+--   f -> PF.returnError PF.ConversionFailed f "expecting SQLBlob column type"
+
+fstToLower :: String -> String
+fstToLower "" = ""
+fstToLower (h : t) = toLower h : t
+
+dropPrefix :: String -> String -> String
+dropPrefix pfx s =
+  let (p, rest) = splitAt (length pfx) s
+   in fstToLower $ if p == pfx then rest else s
+
+enumJSON :: (String -> String) -> J.Options
+enumJSON tagModifier =
+  J.defaultOptions
+    { J.constructorTagModifier = tagModifier,
+      J.allNullaryToStringTag = True
+    }
+
+sumTypeJSON :: (String -> String) -> J.Options
+sumTypeJSON = singleFieldJSON
+
+taggedObjectJSON :: (String -> String) -> J.Options
+taggedObjectJSON tagModifier =
+  J.defaultOptions
+    { J.sumEncoding = J.TaggedObject "type" "data",
+      J.constructorTagModifier = tagModifier,
+      J.nullaryToObject = True,
+      J.omitNothingFields = True
+    }
+
+singleFieldJSON :: (String -> String) -> J.Options
+singleFieldJSON tagModifier =
+  J.defaultOptions
+    { J.sumEncoding = J.ObjectWithSingleField,
+      J.constructorTagModifier = tagModifier,
+      J.nullaryToObject = True,
+      J.omitNothingFields = True
+    }

src/Simplex/Messaging/Protocol.hs

@@ -1,11 +1,17 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
@@ -23,100 +29,160 @@
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Protocol
-  ( -- * SMP protocol types
+  ( -- * SMP protocol parameters
+    smpClientVersion,
+    smpClientVRange,
+    maxMessageLength,
+    e2eEncConfirmationLength,
+    e2eEncMessageLength,
+
+    -- * SMP protocol types
+    Protocol,
     Command (..),
     Party (..),
     Cmd (..),
+    BrokerMsg (..),
     SParty (..),
+    PartyI (..),
+    QueueIdsKeys (..),
     ErrorType (..),
     CommandError (..),
     Transmission,
     SignedTransmission,
-    SignedTransmissionOrError,
-    RawTransmission,
+    SentRawTransmission,
     SignedRawTransmission,
+    ClientMsgEnvelope (..),
+    PubHeader (..),
+    ClientMessage (..),
+    PrivHeader (..),
+    SMPServer (..),
+    SrvLoc (..),
     CorrId (..),
     QueueId,
     RecipientId,
     SenderId,
-    RecipientPrivateKey,
-    RecipientPublicKey,
-    SenderPrivateKey,
-    SenderPublicKey,
-    Encoded,
+    NotifierId,
+    RcvPrivateSignKey,
+    RcvPublicVerifyKey,
+    RcvPublicDhKey,
+    RcvDhSecret,
+    SndPrivateSignKey,
+    SndPublicVerifyKey,
+    NtfPrivateSignKey,
+    NtfPublicVerifyKey,
     MsgId,
     MsgBody,
 
     -- * Parse and serialize
-    serializeTransmission,
-    serializeCommand,
-    serializeErrorType,
+    encodeTransmission,
     transmissionP,
-    commandP,
-    errorTypeP,
+    encodeProtocol,
 
     -- * TCP transport functions
     tPut,
     tGet,
-    fromClient,
-    fromServer,
+
+    -- * exports for tests
+    CommandTag (..),
+    BrokerMsgTag (..),
   )
 where
 
-import Control.Applicative ((<|>))
-import Control.Monad
+import Control.Applicative (optional, (<|>))
 import Control.Monad.Except
+import Data.Aeson (ToJSON (..))
+import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Functor (($>))
 import Data.Kind
+import Data.Maybe (isNothing)
 import Data.String
-import Data.Time.Clock
-import Data.Time.ISO8601
+import Data.Time.Clock.System (SystemTime)
+import Data.Type.Equality
 import GHC.Generics (Generic)
 import Generic.Random (genericArbitraryU)
+import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
-import Simplex.Messaging.Transport (THandle, Transport, TransportError (..), tGetEncrypted, tPutEncrypted)
-import Simplex.Messaging.Util
+import Simplex.Messaging.Transport (THandle (..), Transport, TransportError (..), tGetBlock, tPutBlock)
+import Simplex.Messaging.Util (bshow, (<$?>))
+import Simplex.Messaging.Version
 import Test.QuickCheck (Arbitrary (..))
 
--- | SMP protocol participants.
-data Party = Broker | Recipient | Sender
+smpClientVersion :: Version
+smpClientVersion = 1
+
+smpClientVRange :: VersionRange
+smpClientVRange = mkVersionRange 1 smpClientVersion
+
+maxMessageLength :: Int
+maxMessageLength = 16088
+
+-- it is shorter to allow per-queue e2e encryption DH key in the "public" header
+e2eEncConfirmationLength :: Int
+e2eEncConfirmationLength = 15936
+
+e2eEncMessageLength :: Int
+e2eEncMessageLength = 16032
+
+-- | SMP protocol clients
+data Party = Recipient | Sender | Notifier
   deriving (Show)
 
--- | Singleton types for SMP protocol participants.
+-- | Singleton types for SMP protocol clients
 data SParty :: Party -> Type where
-  SBroker :: SParty Broker
   SRecipient :: SParty Recipient
   SSender :: SParty Sender
+  SNotifier :: SParty Notifier
 
-deriving instance Show (SParty a)
+instance TestEquality SParty where
+  testEquality SRecipient SRecipient = Just Refl
+  testEquality SSender SSender = Just Refl
+  testEquality SNotifier SNotifier = Just Refl
+  testEquality _ _ = Nothing
 
--- | Type for command or response of any participant.
-data Cmd = forall a. Cmd (SParty a) (Command a)
+deriving instance Show (SParty p)
+
+class PartyI (p :: Party) where sParty :: SParty p
+
+instance PartyI Recipient where sParty = SRecipient
+
+instance PartyI Sender where sParty = SSender
+
+instance PartyI Notifier where sParty = SNotifier
+
+-- | Type for client command of any participant.
+data Cmd = forall p. PartyI p => Cmd (SParty p) (Command p)
 
 deriving instance Show Cmd
 
--- | SMP transmission without signature.
-type Transmission = (CorrId, QueueId, Cmd)
+-- | Parsed SMP transmission without signature, size and session ID.
+type Transmission c = (CorrId, QueueId, c)
 
--- | SMP transmission with signature.
-type SignedTransmission = (C.Signature, Transmission)
+-- | signed parsed transmission, with original raw bytes and parsing error.
+type SignedTransmission c = (Maybe C.ASignature, Signed, Transmission (Either ErrorType c))
 
-type TransmissionOrError = (CorrId, QueueId, Either ErrorType Cmd)
-
--- | signed parsed transmission, with parsing error.
-type SignedTransmissionOrError = (C.Signature, TransmissionOrError)
+type Signed = ByteString
 
 -- | unparsed SMP transmission with signature.
-type RawTransmission = (ByteString, ByteString, ByteString, ByteString)
+data RawTransmission = RawTransmission
+  { signature :: ByteString,
+    signed :: ByteString,
+    sessId :: ByteString,
+    corrId :: ByteString,
+    queueId :: ByteString,
+    command :: ByteString
+  }
 
--- | unparsed SMP transmission with signature.
-type SignedRawTransmission = (C.Signature, ByteString)
+-- | unparsed sent SMP transmission with signature, without session ID.
+type SignedRawTransmission = (Maybe C.ASignature, ByteString, ByteString, ByteString)
+
+-- | unparsed sent SMP transmission with signature.
+type SentRawTransmission = (Maybe C.ASignature, ByteString)
 
 -- | SMP queue ID for the recipient.
 type RecipientId = QueueId
@@ -124,62 +190,278 @@ type RecipientId = QueueId
 -- | SMP queue ID for the sender.
 type SenderId = QueueId
 
--- | SMP queue ID on the server.
-type QueueId = Encoded
+-- | SMP queue ID for notifications.
+type NotifierId = QueueId
 
--- | Parameterized type for SMP protocol commands from all participants.
-data Command (a :: Party) where
+-- | SMP queue ID on the server.
+type QueueId = ByteString
+
+-- | Parameterized type for SMP protocol commands from all clients.
+data Command (p :: Party) where
   -- SMP recipient commands
-  NEW :: RecipientPublicKey -> Command Recipient
+  NEW :: RcvPublicVerifyKey -> RcvPublicDhKey -> Command Recipient
   SUB :: Command Recipient
-  KEY :: SenderPublicKey -> Command Recipient
+  KEY :: SndPublicVerifyKey -> Command Recipient
+  NKEY :: NtfPublicVerifyKey -> Command Recipient
   ACK :: Command Recipient
   OFF :: Command Recipient
   DEL :: Command Recipient
   -- SMP sender commands
   SEND :: MsgBody -> Command Sender
   PING :: Command Sender
-  -- SMP broker commands (responses, messages, notifications)
-  IDS :: RecipientId -> SenderId -> Command Broker
-  MSG :: MsgId -> UTCTime -> MsgBody -> Command Broker
-  END :: Command Broker
-  OK :: Command Broker
-  ERR :: ErrorType -> Command Broker
-  PONG :: Command Broker
+  -- SMP notification subscriber commands
+  NSUB :: Command Notifier
 
-deriving instance Show (Command a)
+deriving instance Show (Command p)
 
-deriving instance Eq (Command a)
+deriving instance Eq (Command p)
 
--- | Base-64 encoded string.
-type Encoded = ByteString
+data BrokerMsg where
+  -- SMP broker messages (responses, client messages, notifications)
+  IDS :: QueueIdsKeys -> BrokerMsg
+  MSG :: MsgId -> SystemTime -> MsgBody -> BrokerMsg
+  NID :: NotifierId -> BrokerMsg
+  NMSG :: BrokerMsg
+  END :: BrokerMsg
+  OK :: BrokerMsg
+  ERR :: ErrorType -> BrokerMsg
+  PONG :: BrokerMsg
+  deriving (Eq, Show)
+
+-- * SMP command tags
+
+data CommandTag (p :: Party) where
+  NEW_ :: CommandTag Recipient
+  SUB_ :: CommandTag Recipient
+  KEY_ :: CommandTag Recipient
+  NKEY_ :: CommandTag Recipient
+  ACK_ :: CommandTag Recipient
+  OFF_ :: CommandTag Recipient
+  DEL_ :: CommandTag Recipient
+  SEND_ :: CommandTag Sender
+  PING_ :: CommandTag Sender
+  NSUB_ :: CommandTag Notifier
+
+data CmdTag = forall p. PartyI p => CT (SParty p) (CommandTag p)
+
+deriving instance Show (CommandTag p)
+
+deriving instance Show CmdTag
+
+data BrokerMsgTag
+  = IDS_
+  | MSG_
+  | NID_
+  | NMSG_
+  | END_
+  | OK_
+  | ERR_
+  | PONG_
+  deriving (Show)
+
+class ProtocolMsgTag t where
+  decodeTag :: ByteString -> Maybe t
+
+messageTagP :: ProtocolMsgTag t => Parser t
+messageTagP =
+  maybe (fail "bad command") pure . decodeTag
+    =<< (A.takeTill (== ' ') <* optional A.space)
+
+instance PartyI p => Encoding (CommandTag p) where
+  smpEncode = \case
+    NEW_ -> "NEW"
+    SUB_ -> "SUB"
+    KEY_ -> "KEY"
+    NKEY_ -> "NKEY"
+    ACK_ -> "ACK"
+    OFF_ -> "OFF"
+    DEL_ -> "DEL"
+    SEND_ -> "SEND"
+    PING_ -> "PING"
+    NSUB_ -> "NSUB"
+  smpP = messageTagP
+
+instance ProtocolMsgTag CmdTag where
+  decodeTag = \case
+    "NEW" -> Just $ CT SRecipient NEW_
+    "SUB" -> Just $ CT SRecipient SUB_
+    "KEY" -> Just $ CT SRecipient KEY_
+    "NKEY" -> Just $ CT SRecipient NKEY_
+    "ACK" -> Just $ CT SRecipient ACK_
+    "OFF" -> Just $ CT SRecipient OFF_
+    "DEL" -> Just $ CT SRecipient DEL_
+    "SEND" -> Just $ CT SSender SEND_
+    "PING" -> Just $ CT SSender PING_
+    "NSUB" -> Just $ CT SNotifier NSUB_
+    _ -> Nothing
+
+instance Encoding CmdTag where
+  smpEncode (CT _ t) = smpEncode t
+  smpP = messageTagP
+
+instance PartyI p => ProtocolMsgTag (CommandTag p) where
+  decodeTag s = decodeTag s >>= (\(CT _ t) -> checkParty' t)
+
+instance Encoding BrokerMsgTag where
+  smpEncode = \case
+    IDS_ -> "IDS"
+    MSG_ -> "MSG"
+    NID_ -> "NID"
+    NMSG_ -> "NMSG"
+    END_ -> "END"
+    OK_ -> "OK"
+    ERR_ -> "ERR"
+    PONG_ -> "PONG"
+  smpP = messageTagP
+
+instance ProtocolMsgTag BrokerMsgTag where
+  decodeTag = \case
+    "IDS" -> Just IDS_
+    "MSG" -> Just MSG_
+    "NID" -> Just NID_
+    "NMSG" -> Just NMSG_
+    "END" -> Just END_
+    "OK" -> Just OK_
+    "ERR" -> Just ERR_
+    "PONG" -> Just PONG_
+    _ -> Nothing
+
+-- | SMP message body format
+data ClientMsgEnvelope = ClientMsgEnvelope
+  { cmHeader :: PubHeader,
+    cmNonce :: C.CbNonce,
+    cmEncBody :: ByteString
+  }
+  deriving (Show)
+
+data PubHeader = PubHeader
+  { phVersion :: Version,
+    phE2ePubDhKey :: Maybe C.PublicKeyX25519
+  }
+  deriving (Show)
+
+instance Encoding PubHeader where
+  smpEncode (PubHeader v k) = smpEncode (v, k)
+  smpP = PubHeader <$> smpP <*> smpP
+
+instance Encoding ClientMsgEnvelope where
+  smpEncode ClientMsgEnvelope {cmHeader, cmNonce, cmEncBody} =
+    smpEncode (cmHeader, cmNonce, Tail cmEncBody)
+  smpP = do
+    (cmHeader, cmNonce, Tail cmEncBody) <- smpP
+    pure ClientMsgEnvelope {cmHeader, cmNonce, cmEncBody}
+
+data ClientMessage = ClientMessage PrivHeader ByteString
+
+data PrivHeader
+  = PHConfirmation C.APublicVerifyKey
+  | PHEmpty
+  deriving (Show)
+
+instance Encoding PrivHeader where
+  smpEncode = \case
+    PHConfirmation k -> "K" <> smpEncode k
+    PHEmpty -> "_"
+  smpP =
+    A.anyChar >>= \case
+      'K' -> PHConfirmation <$> smpP
+      '_' -> pure PHEmpty
+      _ -> fail "invalid PrivHeader"
+
+instance Encoding ClientMessage where
+  smpEncode (ClientMessage h msg) = smpEncode h <> msg
+  smpP = ClientMessage <$> smpP <*> A.takeByteString
+
+-- | SMP server location and transport key digest (hash).
+data SMPServer = SMPServer
+  { host :: HostName,
+    port :: ServiceName,
+    keyHash :: C.KeyHash
+  }
+  deriving (Eq, Ord, Show)
+
+instance IsString SMPServer where
+  fromString = parseString strDecode
+
+instance Encoding SMPServer where
+  smpEncode SMPServer {host, port, keyHash} =
+    smpEncode (host, port, keyHash)
+  smpP = do
+    (host, port, keyHash) <- smpP
+    pure SMPServer {host, port, keyHash}
+
+instance StrEncoding SMPServer where
+  strEncode SMPServer {host, port, keyHash} =
+    "smp://" <> strEncode keyHash <> "@" <> strEncode (SrvLoc host port)
+  strP = do
+    _ <- "smp://"
+    keyHash <- strP <* A.char '@'
+    SrvLoc host port <- strP
+    pure SMPServer {host, port, keyHash}
+
+data SrvLoc = SrvLoc HostName ServiceName
+  deriving (Eq, Ord, Show)
+
+instance StrEncoding SrvLoc where
+  strEncode (SrvLoc host port) = B.pack $ host <> if null port then "" else ':' : port
+  strP = SrvLoc <$> host <*> (port <|> pure "")
+    where
+      host = B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
+      port = B.unpack <$> (A.char ':' *> A.takeWhile1 A.isDigit)
 
 -- | Transmission correlation ID.
---
--- A newtype to avoid accidentally changing order of transmission parts.
 newtype CorrId = CorrId {bs :: ByteString} deriving (Eq, Ord, Show)
 
 instance IsString CorrId where
   fromString = CorrId . fromString
 
+instance StrEncoding CorrId where
+  strEncode (CorrId cId) = strEncode cId
+  strDecode s = CorrId <$> strDecode s
+  strP = CorrId <$> strP
+
+instance ToJSON CorrId where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+-- | Queue IDs and keys
+data QueueIdsKeys = QIK
+  { rcvId :: RecipientId,
+    sndId :: SenderId,
+    rcvPublicDhKey :: RcvPublicDhKey
+  }
+  deriving (Eq, Show)
+
 -- | Recipient's private key used by the recipient to authorize (sign) SMP commands.
 --
 -- Only used by SMP agent, kept here so its definition is close to respective public key.
-type RecipientPrivateKey = C.SafePrivateKey
+type RcvPrivateSignKey = C.APrivateSignKey
 
 -- | Recipient's public key used by SMP server to verify authorization of SMP commands.
-type RecipientPublicKey = C.PublicKey
+type RcvPublicVerifyKey = C.APublicVerifyKey
+
+-- | Public key used for DH exchange to encrypt message bodies from server to recipient
+type RcvPublicDhKey = C.PublicKeyX25519
+
+-- | DH Secret used to encrypt message bodies from server to recipient
+type RcvDhSecret = C.DhSecretX25519
 
 -- | Sender's private key used by the recipient to authorize (sign) SMP commands.
 --
 -- Only used by SMP agent, kept here so its definition is close to respective public key.
-type SenderPrivateKey = C.SafePrivateKey
+type SndPrivateSignKey = C.APrivateSignKey
 
 -- | Sender's public key used by SMP server to verify authorization of SMP commands.
-type SenderPublicKey = C.PublicKey
+type SndPublicVerifyKey = C.APublicVerifyKey
+
+-- | Private key used by push notifications server to authorize (sign) LSTN command.
+type NtfPrivateSignKey = C.APrivateSignKey
+
+-- | Public key used by SMP server to verify authorization of LSTN command sent by push notifications server.
+type NtfPublicVerifyKey = C.APublicVerifyKey
 
 -- | SMP message server ID.
-type MsgId = Encoded
+type MsgId = ByteString
 
 -- | SMP message body.
 type MsgBody = ByteString
@@ -188,26 +470,38 @@ type MsgBody = ByteString
 data ErrorType
   = -- | incorrect block format, encoding or signature size
     BLOCK
+  | -- | incorrect SMP session ID (TLS Finished message / tls-unique binding RFC5929)
+    SESSION
   | -- | SMP command is unknown or has invalid syntax
-    CMD CommandError
+    CMD {cmdErr :: CommandError}
   | -- | command authorization error - bad signature or non-existing SMP queue
     AUTH
   | -- | SMP queue capacity is exceeded on the server
     QUOTA
   | -- | ACK command is sent without message to be acknowledged
     NO_MSG
+  | -- | sent message is too large (> maxMessageLength = 16078 bytes)
+    LARGE_MSG
   | -- | internal server error
     INTERNAL
   | -- | used internally, never returned by the server (to be removed)
     DUPLICATE_ -- TODO remove, not part of SMP protocol
   deriving (Eq, Generic, Read, Show)
 
+instance ToJSON ErrorType where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
+instance StrEncoding ErrorType where
+  strEncode = \case
+    CMD e -> "CMD " <> bshow e
+    e -> bshow e
+  strP = "CMD " *> (CMD <$> parseRead1) <|> parseRead1
+
 -- | SMP command error type.
 data CommandError
-  = -- | server response sent from client or vice versa
-    PROHIBITED
-  | -- | bad RSA key size in NEW or KEY commands (only 1024, 2048 and 4096 bits keys are allowed)
-    KEY_SIZE
+  = -- | unknown command
+    UNKNOWN
   | -- | error parsing command
     SYNTAX
   | -- | transmission has no required credentials (signature or queue ID)
@@ -218,6 +512,10 @@ data CommandError
     NO_QUEUE
   deriving (Eq, Generic, Read, Show)
 
+instance ToJSON CommandError where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
 instance Arbitrary ErrorType where arbitrary = genericArbitraryU
 
 instance Arbitrary CommandError where arbitrary = genericArbitraryU
@@ -225,156 +523,217 @@ instance Arbitrary CommandError where arbitrary = genericArbitraryU
 -- | SMP transmission parser.
 transmissionP :: Parser RawTransmission
 transmissionP = do
-  signature <- segment
-  corrId <- segment
-  queueId <- segment
-  command <- A.takeByteString
-  return (signature, corrId, queueId, command)
+  signature <- smpP
+  signed <- A.takeByteString
+  either fail pure $ parseAll (trn signature signed) signed
   where
-    segment = A.takeTill (== ' ') <* " "
+    trn signature signed = do
+      sessId <- smpP
+      corrId <- smpP
+      queueId <- smpP
+      command <- A.takeByteString
+      pure RawTransmission {signature, signed, sessId, corrId, queueId, command}
 
--- | SMP command parser.
-commandP :: Parser Cmd
-commandP =
-  "NEW " *> newCmd
-    <|> "IDS " *> idsResp
-    <|> "SUB" $> Cmd SRecipient SUB
-    <|> "KEY " *> keyCmd
-    <|> "ACK" $> Cmd SRecipient ACK
-    <|> "OFF" $> Cmd SRecipient OFF
-    <|> "DEL" $> Cmd SRecipient DEL
-    <|> "SEND " *> sendCmd
-    <|> "PING" $> Cmd SSender PING
-    <|> "MSG " *> message
-    <|> "END" $> Cmd SBroker END
-    <|> "OK" $> Cmd SBroker OK
-    <|> "ERR " *> serverError
-    <|> "PONG" $> Cmd SBroker PONG
-  where
-    newCmd = Cmd SRecipient . NEW <$> C.pubKeyP
-    idsResp = Cmd SBroker <$> (IDS <$> (base64P <* A.space) <*> base64P)
-    keyCmd = Cmd SRecipient . KEY <$> C.pubKeyP
-    sendCmd = do
-      size <- A.decimal <* A.space
-      Cmd SSender . SEND <$> A.take size <* A.space
-    message = do
-      msgId <- base64P <* A.space
-      ts <- tsISO8601P <* A.space
-      size <- A.decimal <* A.space
-      Cmd SBroker . MSG msgId ts <$> A.take size <* A.space
-    serverError = Cmd SBroker . ERR <$> errorTypeP
+class Protocol msg where
+  type Tag msg
+  encodeProtocol :: msg -> ByteString
+  protocolP :: Tag msg -> Parser msg
+  checkCredentials :: SignedRawTransmission -> msg -> Either ErrorType msg
 
--- TODO ignore the end of block, no need to parse it
+instance PartyI p => Protocol (Command p) where
+  type Tag (Command p) = CommandTag p
+  encodeProtocol = \case
+    NEW rKey dhKey -> e (NEW_, ' ', rKey, dhKey)
+    SUB -> e SUB_
+    KEY k -> e (KEY_, ' ', k)
+    NKEY k -> e (NKEY_, ' ', k)
+    ACK -> e ACK_
+    OFF -> e OFF_
+    DEL -> e DEL_
+    SEND msg -> e (SEND_, ' ', Tail msg)
+    PING -> e PING_
+    NSUB -> e NSUB_
+    where
+      e :: Encoding a => a -> ByteString
+      e = smpEncode
 
--- | Parse SMP command.
-parseCommand :: ByteString -> Either ErrorType Cmd
-parseCommand = parse (commandP <* " " <* A.takeByteString) $ CMD SYNTAX
+  protocolP tag = (\(Cmd _ c) -> checkParty c) <$?> protocolP (CT (sParty @p) tag)
 
--- | Serialize SMP command.
-serializeCommand :: Cmd -> ByteString
-serializeCommand = \case
-  Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializePubKey rKey
-  Cmd SRecipient (KEY sKey) -> "KEY " <> C.serializePubKey sKey
-  Cmd SRecipient cmd -> bshow cmd
-  Cmd SSender (SEND msgBody) -> "SEND " <> serializeMsg msgBody
-  Cmd SSender PING -> "PING"
-  Cmd SBroker (MSG msgId ts msgBody) ->
-    B.unwords ["MSG", encode msgId, B.pack $ formatISO8601Millis ts, serializeMsg msgBody]
-  Cmd SBroker (IDS rId sId) -> B.unwords ["IDS", encode rId, encode sId]
-  Cmd SBroker (ERR err) -> "ERR " <> serializeErrorType err
-  Cmd SBroker resp -> bshow resp
-  where
-    serializeMsg msgBody = bshow (B.length msgBody) <> " " <> msgBody <> " "
+  checkCredentials (sig, _, queueId, _) cmd = case cmd of
+    -- NEW must have signature but NOT queue ID
+    NEW {}
+      | isNothing sig -> Left $ CMD NO_AUTH
+      | not (B.null queueId) -> Left $ CMD HAS_AUTH
+      | otherwise -> Right cmd
+    -- SEND must have queue ID, signature is not always required
+    SEND _
+      | B.null queueId -> Left $ CMD NO_QUEUE
+      | otherwise -> Right cmd
+    -- PING must not have queue ID or signature
+    PING
+      | isNothing sig && B.null queueId -> Right cmd
+      | otherwise -> Left $ CMD HAS_AUTH
+    -- other client commands must have both signature and queue ID
+    _
+      | isNothing sig || B.null queueId -> Left $ CMD NO_AUTH
+      | otherwise -> Right cmd
 
--- | SMP error parser.
-errorTypeP :: Parser ErrorType
-errorTypeP = "CMD " *> (CMD <$> parseRead1) <|> parseRead1
+instance Protocol Cmd where
+  type Tag Cmd = CmdTag
+  encodeProtocol (Cmd _ c) = encodeProtocol c
 
--- | Serialize SMP error.
-serializeErrorType :: ErrorType -> ByteString
-serializeErrorType = bshow
+  protocolP = \case
+    CT SRecipient tag ->
+      Cmd SRecipient <$> case tag of
+        NEW_ -> NEW <$> _smpP <*> smpP
+        SUB_ -> pure SUB
+        KEY_ -> KEY <$> _smpP
+        NKEY_ -> NKEY <$> _smpP
+        ACK_ -> pure ACK
+        OFF_ -> pure OFF
+        DEL_ -> pure DEL
+    CT SSender tag ->
+      Cmd SSender <$> case tag of
+        SEND_ -> SEND . unTail <$> _smpP
+        PING_ -> pure PING
+    CT SNotifier NSUB_ -> pure $ Cmd SNotifier NSUB
+
+  checkCredentials t (Cmd p c) = Cmd p <$> checkCredentials t c
+
+instance Protocol BrokerMsg where
+  type Tag BrokerMsg = BrokerMsgTag
+  encodeProtocol = \case
+    IDS (QIK rcvId sndId srvDh) -> e (IDS_, ' ', rcvId, sndId, srvDh)
+    MSG msgId ts msgBody -> e (MSG_, ' ', msgId, ts, Tail msgBody)
+    NID nId -> e (NID_, ' ', nId)
+    NMSG -> e NMSG_
+    END -> e END_
+    OK -> e OK_
+    ERR err -> e (ERR_, ' ', err)
+    PONG -> e PONG_
+    where
+      e :: Encoding a => a -> ByteString
+      e = smpEncode
+
+  protocolP = \case
+    MSG_ -> MSG <$> _smpP <*> smpP <*> (unTail <$> smpP)
+    IDS_ -> IDS <$> (QIK <$> _smpP <*> smpP <*> smpP)
+    NID_ -> NID <$> _smpP
+    NMSG_ -> pure NMSG
+    END_ -> pure END
+    OK_ -> pure OK
+    ERR_ -> ERR <$> _smpP
+    PONG_ -> pure PONG
+
+  checkCredentials (_, _, queueId, _) cmd = case cmd of
+    -- IDS response must not have queue ID
+    IDS _ -> Right cmd
+    -- ERR response does not always have queue ID
+    ERR _ -> Right cmd
+    -- PONG response must not have queue ID
+    PONG
+      | B.null queueId -> Right cmd
+      | otherwise -> Left $ CMD HAS_AUTH
+    -- other broker responses must have queue ID
+    _
+      | B.null queueId -> Left $ CMD NO_QUEUE
+      | otherwise -> Right cmd
+
+_smpP :: Encoding a => Parser a
+_smpP = A.space *> smpP
+
+-- | Parse SMP protocol commands and broker messages
+parseProtocol :: (Protocol msg, ProtocolMsgTag (Tag msg)) => ByteString -> Either ErrorType msg
+parseProtocol s =
+  let (tag, params) = B.break (== ' ') s
+   in case decodeTag tag of
+        Just cmd -> parse (protocolP cmd) (CMD SYNTAX) params
+        Nothing -> Left $ CMD UNKNOWN
+
+checkParty :: forall t p p'. (PartyI p, PartyI p') => t p' -> Either String (t p)
+checkParty c = case testEquality (sParty @p) (sParty @p') of
+  Just Refl -> Right c
+  Nothing -> Left "bad command party"
+
+checkParty' :: forall t p p'. (PartyI p, PartyI p') => t p' -> Maybe (t p)
+checkParty' c = case testEquality (sParty @p) (sParty @p') of
+  Just Refl -> Just c
+  _ -> Nothing
+
+instance Encoding ErrorType where
+  smpEncode = \case
+    BLOCK -> "BLOCK"
+    SESSION -> "SESSION"
+    CMD err -> "CMD " <> smpEncode err
+    AUTH -> "AUTH"
+    QUOTA -> "QUOTA"
+    NO_MSG -> "NO_MSG"
+    LARGE_MSG -> "LARGE_MSG"
+    INTERNAL -> "INTERNAL"
+    DUPLICATE_ -> "DUPLICATE_"
+
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "BLOCK" -> pure BLOCK
+      "SESSION" -> pure SESSION
+      "CMD" -> CMD <$> _smpP
+      "AUTH" -> pure AUTH
+      "QUOTA" -> pure QUOTA
+      "NO_MSG" -> pure NO_MSG
+      "LARGE_MSG" -> pure LARGE_MSG
+      "INTERNAL" -> pure INTERNAL
+      "DUPLICATE_" -> pure DUPLICATE_
+      _ -> fail "bad error type"
+
+instance Encoding CommandError where
+  smpEncode e = case e of
+    UNKNOWN -> "UNKNOWN"
+    SYNTAX -> "SYNTAX"
+    NO_AUTH -> "NO_AUTH"
+    HAS_AUTH -> "HAS_AUTH"
+    NO_QUEUE -> "NO_QUEUE"
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "UNKNOWN" -> pure UNKNOWN
+      "SYNTAX" -> pure SYNTAX
+      "NO_AUTH" -> pure NO_AUTH
+      "HAS_AUTH" -> pure HAS_AUTH
+      "NO_QUEUE" -> pure NO_QUEUE
+      _ -> fail "bad command error type"
 
 -- | Send signed SMP transmission to TCP transport.
-tPut :: Transport c => THandle c -> SignedRawTransmission -> IO (Either TransportError ())
-tPut th (C.Signature sig, t) =
-  tPutEncrypted th $ encode sig <> " " <> t <> " "
+tPut :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
+tPut th (sig, t) = tPutBlock th $ smpEncode (C.signatureBytes sig) <> t
 
--- | Serialize SMP transmission.
-serializeTransmission :: Transmission -> ByteString
-serializeTransmission (CorrId corrId, queueId, command) =
-  B.intercalate " " [corrId, encode queueId, serializeCommand command]
+encodeTransmission :: Protocol c => ByteString -> Transmission c -> ByteString
+encodeTransmission sessionId (CorrId corrId, queueId, command) =
+  smpEncode (sessionId, corrId, queueId) <> encodeProtocol command
 
--- | Validate that it is an SMP client command, used with 'tGet' by 'Simplex.Messaging.Server'.
-fromClient :: Cmd -> Either ErrorType Cmd
-fromClient = \case
-  Cmd SBroker _ -> Left $ CMD PROHIBITED
-  cmd -> Right cmd
-
--- | Validate that it is an SMP server command, used with 'tGet' by 'Simplex.Messaging.Client'.
-fromServer :: Cmd -> Either ErrorType Cmd
-fromServer = \case
-  cmd@(Cmd SBroker _) -> Right cmd
-  _ -> Left $ CMD PROHIBITED
-
--- | Receive and parse transmission from the TCP transport.
+-- | Receive and parse transmission from the TCP transport (ignoring any trailing padding).
 tGetParse :: Transport c => THandle c -> IO (Either TransportError RawTransmission)
-tGetParse th = (>>= parse transmissionP TEBadBlock) <$> tGetEncrypted th
+tGetParse th = (parse transmissionP TEBadBlock =<<) <$> tGetBlock th
 
--- | Receive client and server transmissions.
---
--- The first argument is used to limit allowed senders.
--- 'fromClient' or 'fromServer' should be used here.
-tGet :: forall c m. (Transport c, MonadIO m) => (Cmd -> Either ErrorType Cmd) -> THandle c -> m SignedTransmissionOrError
-tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate
+-- | Receive client and server transmissions (determined by `cmd` type).
+tGet ::
+  forall cmd c m.
+  (Protocol cmd, ProtocolMsgTag (Tag cmd), Transport c, MonadIO m) =>
+  THandle c ->
+  m (SignedTransmission cmd)
+tGet th@THandle {sessionId} = liftIO (tGetParse th) >>= decodeParseValidate
   where
-    decodeParseValidate :: Either TransportError RawTransmission -> m SignedTransmissionOrError
+    decodeParseValidate :: Either TransportError RawTransmission -> m (SignedTransmission cmd)
     decodeParseValidate = \case
-      Right (signature, corrId, queueId, command) ->
-        let decodedTransmission = liftM2 (,corrId,,command) (validSig =<< decode signature) (decode queueId)
-         in either (const $ tError corrId) tParseValidate decodedTransmission
+      Right RawTransmission {signature, signed, sessId, corrId, queueId, command}
+        | sessId == sessionId ->
+          let decodedTransmission = (,corrId,queueId,command) <$> C.decodeSignature signature
+           in either (const $ tError corrId) (tParseValidate signed) decodedTransmission
+        | otherwise -> pure (Nothing, "", (CorrId corrId, "", Left SESSION))
       Left _ -> tError ""
 
-    validSig :: ByteString -> Either String ByteString
-    validSig sig
-      | B.null sig || C.validKeySize (B.length sig) = Right sig
-      | otherwise = Left "invalid signature size"
+    tError :: ByteString -> m (SignedTransmission cmd)
+    tError corrId = pure (Nothing, "", (CorrId corrId, "", Left BLOCK))
 
-    tError :: ByteString -> m SignedTransmissionOrError
-    tError corrId = return (C.Signature "", (CorrId corrId, "", Left BLOCK))
-
-    tParseValidate :: RawTransmission -> m SignedTransmissionOrError
-    tParseValidate t@(sig, corrId, queueId, command) = do
-      let cmd = parseCommand command >>= fromParty >>= tCredentials t
-      return (C.Signature sig, (CorrId corrId, queueId, cmd))
-
-    tCredentials :: RawTransmission -> Cmd -> Either ErrorType Cmd
-    tCredentials (signature, _, queueId, _) cmd = case cmd of
-      -- IDS response must not have queue ID
-      Cmd SBroker (IDS _ _) -> Right cmd
-      -- ERR response does not always have queue ID
-      Cmd SBroker (ERR _) -> Right cmd
-      -- PONG response must not have queue ID
-      Cmd SBroker PONG
-        | B.null queueId -> Right cmd
-        | otherwise -> Left $ CMD HAS_AUTH
-      -- other responses must have queue ID
-      Cmd SBroker _
-        | B.null queueId -> Left $ CMD NO_QUEUE
-        | otherwise -> Right cmd
-      -- NEW must have signature but NOT queue ID
-      Cmd SRecipient (NEW _)
-        | B.null signature -> Left $ CMD NO_AUTH
-        | not (B.null queueId) -> Left $ CMD HAS_AUTH
-        | otherwise -> Right cmd
-      -- SEND must have queue ID, signature is not always required
-      Cmd SSender (SEND _)
-        | B.null queueId -> Left $ CMD NO_QUEUE
-        | otherwise -> Right cmd
-      -- PING must not have queue ID or signature
-      Cmd SSender PING
-        | B.null queueId && B.null signature -> Right cmd
-        | otherwise -> Left $ CMD HAS_AUTH
-      -- other client commands must have both signature and queue ID
-      Cmd SRecipient _
-        | B.null signature || B.null queueId -> Left $ CMD NO_AUTH
-        | otherwise -> Right cmd
+    tParseValidate :: ByteString -> SignedRawTransmission -> m (SignedTransmission cmd)
+    tParseValidate signed t@(sig, corrId, queueId, command) = do
+      let cmd = parseProtocol command >>= checkCredentials t
+      pure (sig, signed, (CorrId corrId, queueId, cmd))

src/Simplex/Messaging/Server.hs

@@ -35,7 +35,9 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import qualified Data.Map.Strict as M
-import Data.Time.Clock
+import Data.Maybe (isNothing)
+import Data.Time.Clock.System (getSystemTime)
+import Data.Type.Equality
 import Network.Socket (ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
@@ -46,6 +48,7 @@ import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.STM (QueueStore)
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Util
 import UnliftIO.Concurrent
 import UnliftIO.Exception
@@ -72,46 +75,61 @@ runSMPServerBlocking started cfg@ServerConfig {transports} = do
     smpServer :: (MonadUnliftIO m', MonadReader Env m') => m' ()
     smpServer = do
       s <- asks server
-      raceAny_ (serverThread s : map runServer transports)
+      raceAny_
+        ( serverThread s subscribedQ subscribers subscriptions cancelSub :
+          serverThread s ntfSubscribedQ notifiers ntfSubscriptions (\_ -> pure ()) :
+          map runServer transports
+        )
         `finally` withLog closeStoreLog
 
     runServer :: (MonadUnliftIO m', MonadReader Env m') => (ServiceName, ATransport) -> m' ()
-    runServer (tcpPort, ATransport t) = runTransportServer started tcpPort (runClient t)
+    runServer (tcpPort, ATransport t) = do
+      serverParams <- asks tlsServerParams
+      runTransportServer started tcpPort serverParams (runClient t)
 
-    serverThread :: MonadUnliftIO m' => Server -> m' ()
-    serverThread Server {subscribedQ, subscribers} = forever $ do
-      atomically updateSubscribers >>= \case
-        Just (rId, Client {rcvQ}) ->
-          void . forkIO . atomically $
-            writeTBQueue rcvQ (CorrId "", rId, Cmd SBroker END)
-        _ -> pure ()
+    serverThread ::
+      forall m' s.
+      MonadUnliftIO m' =>
+      Server ->
+      (Server -> TBQueue (QueueId, Client)) ->
+      (Server -> TVar (M.Map QueueId Client)) ->
+      (Client -> TVar (M.Map QueueId s)) ->
+      (s -> m' ()) ->
+      m' ()
+    serverThread s subQ subs clientSubs unsub = forever $ do
+      atomically updateSubscribers
+        >>= fmap join . mapM endPreviousSubscriptions
+        >>= mapM_ unsub
       where
-        updateSubscribers :: STM (Maybe (RecipientId, Client))
+        updateSubscribers :: STM (Maybe (QueueId, Client))
         updateSubscribers = do
-          (rId, c) <- readTBQueue subscribedQ
-          stateTVar subscribers (\cs -> (M.lookup rId cs, M.insert rId c cs)) >>= \case
-            Just c' -> clientToBeNotified rId c c'
-            _ -> pure Nothing
-        clientToBeNotified :: RecipientId -> Client -> Client -> STM (Maybe (RecipientId, Client))
-        clientToBeNotified rId c c'@Client {connected}
-          | clientId c /= clientId c' = do
-            yes <- readTVar connected
-            pure $ if yes then Just (rId, c') else Nothing
-          | otherwise = pure Nothing
+          (qId, clnt) <- readTBQueue $ subQ s
+          let clientToBeNotified = \c' ->
+                if sameClientSession clnt c'
+                  then pure Nothing
+                  else do
+                    yes <- readTVar $ connected c'
+                    pure $ if yes then Just (qId, c') else Nothing
+          stateTVar (subs s) (\cs -> (M.lookup qId cs, M.insert qId clnt cs))
+            >>= fmap join . mapM clientToBeNotified
+        endPreviousSubscriptions :: (QueueId, Client) -> m' (Maybe s)
+        endPreviousSubscriptions (qId, c) = do
+          void . forkIO . atomically $
+            writeTBQueue (sndQ c) (CorrId "", qId, END)
+          atomically . stateTVar (clientSubs c) $ \ss -> (M.lookup qId ss, M.delete qId ss)
 
-runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
-runClient _ h = do
-  keyPair <- asks serverKeyPair
-  ServerConfig {blockSize} <- asks config
-  liftIO (runExceptT $ serverHandshake h blockSize keyPair) >>= \case
-    Right th -> runClientTransport th
-    Left _ -> pure ()
+    runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
+    runClient _ h = do
+      kh <- asks serverIdentity
+      liftIO (runExceptT $ serverHandshake h kh) >>= \case
+        Right th -> runClientTransport th
+        Left _ -> pure ()
 
 runClientTransport :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> m ()
-runClientTransport th = do
+runClientTransport th@THandle {sessionId} = do
   q <- asks $ tbqSize . config
+  c <- atomically $ newClient q sessionId
   s <- asks server
-  c <- atomically $ newClient s q
   raceAny_ [send th c, client c s, receive th c]
     `finally` clientDisconnected c
 
@@ -125,122 +143,130 @@ clientDisconnected c@Client {subscriptions, connected} = do
   where
     deleteCurrentClient :: Client -> Maybe Client
     deleteCurrentClient c'
-      | clientId c == clientId c' = Nothing
+      | sameClientSession c c' = Nothing
       | otherwise = Just c'
 
+sameClientSession :: Client -> Client -> Bool
+sameClientSession Client {sessionId} Client {sessionId = s'} = sessionId == s'
+
 cancelSub :: MonadUnliftIO m => Sub -> m ()
 cancelSub = \case
   Sub {subThread = SubThread t} -> killThread t
   _ -> return ()
 
 receive :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> Client -> m ()
-receive h Client {rcvQ} = forever $ do
-  (signature, (corrId, queueId, cmdOrError)) <- tGet fromClient h
-  t <- case cmdOrError of
-    Left e -> return . mkResp corrId queueId $ ERR e
-    Right cmd -> verifyTransmission (signature, (corrId, queueId, cmd))
-  atomically $ writeTBQueue rcvQ t
+receive th Client {rcvQ, sndQ} = forever $ do
+  (sig, signed, (corrId, queueId, cmdOrError)) <- tGet th
+  case cmdOrError of
+    Left e -> write sndQ (corrId, queueId, ERR e)
+    Right cmd -> do
+      verified <- verifyTransmission sig signed queueId cmd
+      if verified
+        then write rcvQ (corrId, queueId, cmd)
+        else write sndQ (corrId, queueId, ERR AUTH)
+  where
+    write q t = atomically $ writeTBQueue q t
 
 send :: (Transport c, MonadUnliftIO m) => THandle c -> Client -> m ()
-send h Client {sndQ} = forever $ do
+send h Client {sndQ, sessionId} = forever $ do
   t <- atomically $ readTBQueue sndQ
-  liftIO $ tPut h ("", serializeTransmission t)
+  liftIO $ tPut h (Nothing, encodeTransmission sessionId t)
 
-mkResp :: CorrId -> QueueId -> Command 'Broker -> Transmission
-mkResp corrId queueId command = (corrId, queueId, Cmd SBroker command)
-
-verifyTransmission :: forall m. (MonadUnliftIO m, MonadReader Env m) => SignedTransmission -> m Transmission
-verifyTransmission (sig, t@(corrId, queueId, cmd)) = do
-  (corrId,queueId,) <$> case cmd of
-    Cmd SBroker _ -> return $ smpErr INTERNAL -- it can only be client command, because `fromClient` was used
-    Cmd SRecipient (NEW k) -> pure $ verifySignature k
+verifyTransmission ::
+  forall m. (MonadUnliftIO m, MonadReader Env m) => Maybe C.ASignature -> ByteString -> QueueId -> Cmd -> m Bool
+verifyTransmission sig_ signed queueId cmd = do
+  case cmd of
+    Cmd SRecipient (NEW k _) -> pure $ verifySignature k
     Cmd SRecipient _ -> verifyCmd SRecipient $ verifySignature . recipientKey
-    Cmd SSender (SEND _) -> verifyCmd SSender $ verifySend sig . senderKey
-    Cmd SSender PING -> return cmd
+    Cmd SSender (SEND _) -> verifyCmd SSender $ verifyMaybe . senderKey
+    Cmd SSender PING -> pure True
+    Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe . fmap snd . notifier
   where
-    verifyCmd :: SParty p -> (QueueRec -> Cmd) -> m Cmd
+    verifyCmd :: SParty p -> (QueueRec -> Bool) -> m Bool
     verifyCmd party f = do
       st <- asks queueStore
       q <- atomically $ getQueue st party queueId
-      pure $ either (const $ dummyVerify authErr) f q
-    verifySend :: C.Signature -> Maybe SenderPublicKey -> Cmd
-    verifySend "" = maybe cmd (const authErr)
-    verifySend _ = maybe authErr verifySignature
-    verifySignature :: C.PublicKey -> Cmd
-    verifySignature key = if verify key then cmd else authErr
-    verify key
-      | C.publicKeySize key == sigLen = cryptoVerify key
-      | otherwise = dummyVerify False
-    cryptoVerify key = C.verify key sig (serializeTransmission t)
-    smpErr = Cmd SBroker . ERR
-    authErr = smpErr AUTH
-    dummyVerify :: a -> a
-    dummyVerify = seq $
-      cryptoVerify $ case sigLen of
-        128 -> dummyKey128
-        256 -> dummyKey256
-        384 -> dummyKey384
-        512 -> dummyKey512
-        _ -> dummyKey256
-    sigLen = B.length $ C.unSignature sig
+      pure $ either (const $ maybe False dummyVerify sig_ `seq` False) f q
+    verifyMaybe :: Maybe C.APublicVerifyKey -> Bool
+    verifyMaybe = maybe (isNothing sig_) verifySignature
+    verifySignature :: C.APublicVerifyKey -> Bool
+    verifySignature key = maybe False (verify key) sig_
+    verify :: C.APublicVerifyKey -> C.ASignature -> Bool
+    verify (C.APublicVerifyKey a k) sig@(C.ASignature a' s) =
+      case (testEquality a a', C.signatureSize k == C.signatureSize s) of
+        (Just Refl, True) -> C.verify' k s signed
+        _ -> dummyVerify sig `seq` False
+    dummyVerify :: C.ASignature -> Bool
+    dummyVerify (C.ASignature _ s) = C.verify' (dummyPublicKey s) s signed
 
 -- These dummy keys are used with `dummyVerify` function to mitigate timing attacks
 -- by having the same time of the response whether a queue exists or nor, for all valid key/signature sizes
-dummyKey128 :: C.PublicKey
-dummyKey128 = "MIIBIDANBgkqhkiG9w0BAQEFAAOCAQ0AMIIBCAKBgQC2oeA7s4roXN5K2N6022I1/2CTeMKjWH0m00bSZWa4N8LDKeFcShh8YUxZea5giAveViTRNOOVLgcuXbKvR3u24szN04xP0+KnYUuUUIIoT3YSjX0IlomhDhhSyup4BmA0gAZ+D1OaIKZFX6J8yQ1Lr/JGLEfSRsBjw8l+4hs9OwKBgQDKA+YlZvGb3BcpDwKmatiCXN7ZRDWkjXbj8VAW5zV95tSRCCVN48hrFM1H4Ju2QMMUc6kPUVX+eW4ZjdCl5blIqIHMcTmsdcmsDDCg3PjUNrwc6bv/1TcirbAKcmnKt9iurIt6eerxSO7TZUXXMUVsi7eRwb/RUNhpCrpJ/hpIOw=="
+dummyPublicKey :: C.Signature a -> C.PublicKey a
+dummyPublicKey = \case
+  C.SignatureEd25519 _ -> dummyKeyEd25519
+  C.SignatureEd448 _ -> dummyKeyEd448
 
-dummyKey256 :: C.PublicKey
-dummyKey256 = "MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAxwmTvaqmdTbkfUGNi8Yu0L/T4cxuOlQlx3zGZ9X9Qx0+oZjknWK+QHrdWTcpS+zH4Hi7fP6kanOQoQ90Hj6Ghl57VU1GEdUPywSw4i1/7t0Wv9uT9Q2ktHp2rqVo3xkC9IVIpL7EZAxdRviIN2OsOB3g4a/F1ZpjxcAaZeOMUugiAX1+GtkLuE0Xn4neYjCaOghLxQTdhybN70VtnkiQLx/X9NjkDIl/spYGm3tQFMyYKkP6IWoEpj0926hJ0fmlmhy8tAOhlZsb/baW5cgkEZ3E9jVVrySCgQzoLQgma610FIISRpRJbSyv26jU7MkMxiyuBiDaFOORkXFttoKbtQKBgEbDS9II2brsz+vfI7uP8atFcawkE52cx4M1UWQhqb1H3tBiRl+qO+dMq1pPQF2bW7dlZAWYzS4W/367bTAuALHBDGB8xi1P4Njhh9vaOgTvuqrHG9NJQ85BLy0qGw8rjIWSIXVmVpfrXFJ8po5l04UE258Ll2yocv3QRQmddQW9"
+dummyKeyEd25519 :: C.PublicKey 'C.Ed25519
+dummyKeyEd25519 = "MCowBQYDK2VwAyEA139Oqs4QgpqbAmB0o7rZf6T19ryl7E65k4AYe0kE3Qs="
 
-dummyKey384 :: C.PublicKey
-dummyKey384 = "MIICITANBgkqhkiG9w0BAQEFAAOCAg4AMIICCQKCAYEAthExp77lSFBMB0RedjgKIU+oNH5lMGdMqDCG0E5Ly7X49rFpfDMMN08GDIgvzg9kcwV3ScbPcjUE19wmAShX9f9k3w38KM3wmIBKSiuCREQl0V3xAYp1SYwiAkMNSSwxuIkDEeSOR56WdEcZvqbB4lY9MQlUv70KriPDxZaqKCTKslUezXHQuYPQX6eMnGFK7hxz5Kl5MajV52d+5iXsa8CA+m/e1KVnbelCO+xhN89xG8ALt0CJ9k5Wwo3myLgXi4dmNankCmg8jkh+7y2ywkzxMwH1JydDtV/FLzkbZsbPR2w93TNrTq1RJOuqMyh0VtdBSpxNW/Ft988TkkX2BAWzx82INw7W6/QbHGNtHNB995R4sgeYy8QbEpNGBhQnfQh7yRWygLTVXWKApQzzfCeIoDDWUS7dMv/zXoasAnpDBj+6UhHv3BHrps7kBvRyZQ2d/nUuAqiGd43ljJ++n6vNyFLgZoiV7HLia/FOGMkdt7j92CNmFHxiT6Xl7kRHAoGBAPNoWny2O7LBxzAKMLmQVHBAiKp6RMx+7URvtQDHDHPaZ7F3MvtvmYWwGzund3cQFAaV1EkJoYeI3YRuj6xdXgMyMaP54On++btArb6jUtZuvlC98qE8dEEHQNh+7TsCiMU+ivbeKFxS9A/B7OVedoMnPoJWhatbA9zB/6L1GNPh"
-
-dummyKey512 :: C.PublicKey
-dummyKey512 = "MIICoDANBgkqhkiG9w0BAQEFAAOCAo0AMIICiAKCAgEArkCY9DuverJ4mmzDektv9aZMFyeRV46WZK9NsOBKEc+1ncqMs+LhLti9asKNgUBRbNzmbOe0NYYftrUpwnATaenggkTFxxbJ4JGJuGYbsEdFWkXSvrbWGtM8YUmn5RkAGme12xQ89bSM4VoJAGnrYPHwmcQd+KYCPZvTUsxaxgrJTX65ejHN9BsAn8XtGViOtHTDJO9yUMD2WrJvd7wnNa+0ugEteDLzMU++xS98VC+uA1vfauUqi3yXVchdfrLdVUuM+JE0gUEXCgzjuHkaoHiaGNiGhdPYoAJJdOKQOIHAKdk7Th6OPhirPhc9XYNB4O8JDthKhNtfokvFIFlC4QBRzJhpLIENaEBDt08WmgpOnecZB/CuxkqqOrNa8j5K5jNrtXAI67W46VEC2jeQy/gZwb64Zit2A4D00xXzGbQTPGj4ehcEMhLx5LSCygViEf0w0tN3c3TEyUcgPzvECd2ZVpQLr9Z4a07Ebr+YSuxcHhjg4Rg1VyJyOTTvaCBGm5X2B3+tI4NUttmikIHOYpBnsLmHY2BgfH2KcrIsDyAhInXmTFr/L2+erFarUnlfATd2L8Ti43TNHDedO6k6jI5Gyi62yPwjqPLEIIK8l+pIeNfHJ3pPmjhHBfzFcQLMMMXffHWNK8kWklrQXK+4j4HiPcTBvlO1FEtG9nEIZhUCgYA4a6WtI2k5YNli1C89GY5rGUY7RP71T6RWri/D3Lz9T7GvU+FemAyYmsvCQwqijUOur0uLvwSP8VdxpSUcrjJJSWur2hrPWzWlu0XbNaeizxpFeKbQP+zSrWJ1z8RwfAeUjShxt8q1TuqGqY10wQyp3nyiTGvS+KwZVj5h5qx8NQ=="
+dummyKeyEd448 :: C.PublicKey 'C.Ed448
+dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"
 
 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
-client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
+client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} =
   forever $
     atomically (readTBQueue rcvQ)
       >>= processCommand
       >>= atomically . writeTBQueue sndQ
   where
-    processCommand :: Transmission -> m Transmission
+    processCommand :: Transmission Cmd -> m (Transmission BrokerMsg)
     processCommand (corrId, queueId, cmd) = do
       st <- asks queueStore
       case cmd of
-        Cmd SBroker END -> unsubscribeQueue $> (corrId, queueId, cmd)
-        Cmd SBroker _ -> return (corrId, queueId, cmd)
-        Cmd SSender command -> case command of
-          SEND msgBody -> sendMessage st msgBody
-          PING -> return (corrId, queueId, Cmd SBroker PONG)
-        Cmd SRecipient command -> case command of
-          NEW rKey -> createQueue st rKey
-          SUB -> subscribeQueue queueId
-          ACK -> acknowledgeMsg
-          KEY sKey -> secureQueue_ st sKey
-          OFF -> suspendQueue_ st
-          DEL -> delQueueAndMsgs st
+        Cmd SSender command ->
+          case command of
+            SEND msgBody -> sendMessage st msgBody
+            PING -> pure (corrId, "", PONG)
+        Cmd SNotifier NSUB -> subscribeNotifications
+        Cmd SRecipient command ->
+          case command of
+            NEW rKey dhKey -> createQueue st rKey dhKey
+            SUB -> subscribeQueue queueId
+            ACK -> acknowledgeMsg
+            KEY sKey -> secureQueue_ st sKey
+            NKEY nKey -> addQueueNotifier_ st nKey
+            OFF -> suspendQueue_ st
+            DEL -> delQueueAndMsgs st
       where
-        createQueue :: QueueStore -> RecipientPublicKey -> m Transmission
-        createQueue st rKey =
-          checkKeySize rKey addSubscribe
+        createQueue :: QueueStore -> RcvPublicVerifyKey -> RcvPublicDhKey -> m (Transmission BrokerMsg)
+        createQueue st recipientKey dhKey = do
+          (rcvPublicDhKey, privDhKey) <- liftIO C.generateKeyPair'
+          let rcvDhSecret = C.dh' dhKey privDhKey
+              qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey}
+              qRec (recipientId, senderId) =
+                QueueRec
+                  { recipientId,
+                    senderId,
+                    recipientKey,
+                    rcvDhSecret,
+                    senderKey = Nothing,
+                    notifier = Nothing,
+                    status = QueueActive
+                  }
+          (corrId,queueId,) <$> addQueueRetry 3 qik qRec
           where
-            addSubscribe =
-              addQueueRetry 3 >>= \case
-                Left e -> return $ ERR e
-                Right (rId, sId) -> do
+            addQueueRetry ::
+              Int -> ((RecipientId, SenderId) -> QueueIdsKeys) -> ((RecipientId, SenderId) -> QueueRec) -> m BrokerMsg
+            addQueueRetry 0 _ _ = pure $ ERR INTERNAL
+            addQueueRetry n qik qRec = do
+              ids@(rId, _) <- getIds
+              -- create QueueRec record with these ids and keys
+              atomically (addQueue st $ qRec ids) >>= \case
+                Left DUPLICATE_ -> addQueueRetry (n - 1) qik qRec
+                Left e -> pure $ ERR e
+                Right _ -> do
                   withLog (`logCreateById` rId)
-                  subscribeQueue rId $> IDS rId sId
-
-            addQueueRetry :: Int -> m (Either ErrorType (RecipientId, SenderId))
-            addQueueRetry 0 = return $ Left INTERNAL
-            addQueueRetry n = do
-              ids <- getIds
-              atomically (addQueue st rKey ids) >>= \case
-                Left DUPLICATE_ -> addQueueRetry $ n - 1
-                Left e -> return $ Left e
-                Right _ -> return $ Right ids
+                  subscribeQueue rId $> IDS (qik ids)
 
             logCreateById :: StoreLog 'WriteMode -> RecipientId -> IO ()
             logCreateById s rId =
@@ -253,24 +279,31 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
               n <- asks $ queueIdBytes . config
               liftM2 (,) (randomId n) (randomId n)
 
-        secureQueue_ :: QueueStore -> SenderPublicKey -> m Transmission
+        secureQueue_ :: QueueStore -> SndPublicVerifyKey -> m (Transmission BrokerMsg)
         secureQueue_ st sKey = do
           withLog $ \s -> logSecureQueue s queueId sKey
-          atomically . checkKeySize sKey $ either ERR (const OK) <$> secureQueue st queueId sKey
+          atomically $ (corrId,queueId,) . either ERR (const OK) <$> secureQueue st queueId sKey
 
-        checkKeySize :: Monad m' => C.PublicKey -> m' (Command 'Broker) -> m' Transmission
-        checkKeySize key action =
-          mkResp corrId queueId
-            <$> if C.validKeySize $ C.publicKeySize key
-              then action
-              else pure . ERR $ CMD KEY_SIZE
+        addQueueNotifier_ :: QueueStore -> NtfPublicVerifyKey -> m (Transmission BrokerMsg)
+        addQueueNotifier_ st nKey = (corrId,queueId,) <$> addNotifierRetry 3
+          where
+            addNotifierRetry :: Int -> m BrokerMsg
+            addNotifierRetry 0 = pure $ ERR INTERNAL
+            addNotifierRetry n = do
+              nId <- randomId =<< asks (queueIdBytes . config)
+              atomically (addQueueNotifier st queueId nId nKey) >>= \case
+                Left DUPLICATE_ -> addNotifierRetry $ n - 1
+                Left e -> pure $ ERR e
+                Right _ -> do
+                  withLog $ \s -> logAddNotifier s queueId nId nKey
+                  pure $ NID nId
 
-        suspendQueue_ :: QueueStore -> m Transmission
+        suspendQueue_ :: QueueStore -> m (Transmission BrokerMsg)
         suspendQueue_ st = do
           withLog (`logDeleteQueue` queueId)
           okResp <$> atomically (suspendQueue st queueId)
 
-        subscribeQueue :: RecipientId -> m Transmission
+        subscribeQueue :: RecipientId -> m (Transmission BrokerMsg)
         subscribeQueue rId =
           atomically (getSubscription rId) >>= deliverMessage tryPeekMsg rId
 
@@ -285,13 +318,15 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
               writeTVar subscriptions $ M.insert rId s subs
               return s
 
-        unsubscribeQueue :: m ()
-        unsubscribeQueue = do
-          sub <- atomically . stateTVar subscriptions $
-            \cs -> (M.lookup queueId cs, M.delete queueId cs)
-          mapM_ cancelSub sub
+        subscribeNotifications :: m (Transmission BrokerMsg)
+        subscribeNotifications = atomically $ do
+          subs <- readTVar ntfSubscriptions
+          when (isNothing $ M.lookup queueId subs) $ do
+            writeTBQueue ntfSubscribedQ (queueId, clnt)
+            writeTVar ntfSubscriptions $ M.insert queueId () subs
+          pure ok
 
-        acknowledgeMsg :: m Transmission
+        acknowledgeMsg :: m (Transmission BrokerMsg)
         acknowledgeMsg =
           atomically (withSub queueId $ \s -> const s <$$> tryTakeTMVar (delivered s))
             >>= \case
@@ -301,31 +336,47 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
         withSub :: RecipientId -> (Sub -> STM a) -> STM (Maybe a)
         withSub rId f = readTVar subscriptions >>= mapM f . M.lookup rId
 
-        sendMessage :: QueueStore -> MsgBody -> m Transmission
-        sendMessage st msgBody = do
-          qr <- atomically $ getQueue st SSender queueId
-          either (return . err) storeMessage qr
+        sendMessage :: QueueStore -> MsgBody -> m (Transmission BrokerMsg)
+        sendMessage st msgBody
+          | B.length msgBody > maxMessageLength = pure $ err LARGE_MSG
+          | otherwise = do
+            qr <- atomically $ getQueue st SSender queueId
+            either (return . err) storeMessage qr
           where
-            mkMessage :: m Message
-            mkMessage = do
-              msgId <- asks (msgIdBytes . config) >>= randomId
-              ts <- liftIO getCurrentTime
-              return $ Message {msgId, ts, msgBody}
-
-            storeMessage :: QueueRec -> m Transmission
+            storeMessage :: QueueRec -> m (Transmission BrokerMsg)
             storeMessage qr = case status qr of
               QueueOff -> return $ err AUTH
-              QueueActive -> do
-                ms <- asks msgStore
-                msg <- mkMessage
-                quota <- asks $ msgQueueQuota . config
-                atomically $ do
-                  q <- getMsgQueue ms (recipientId qr) quota
-                  isFull q >>= \case
-                    False -> writeMsg q msg $> ok
-                    True -> pure $ err QUOTA
+              QueueActive ->
+                mkMessage >>= \case
+                  Left _ -> pure $ err LARGE_MSG
+                  Right msg -> do
+                    ms <- asks msgStore
+                    quota <- asks $ msgQueueQuota . config
+                    atomically $ do
+                      q <- getMsgQueue ms (recipientId qr) quota
+                      ifM (isFull q) (pure $ err QUOTA) $ do
+                        trySendNotification
+                        writeMsg q msg
+                        pure ok
+              where
+                mkMessage :: m (Either C.CryptoError Message)
+                mkMessage = do
+                  msgId <- randomId =<< asks (msgIdBytes . config)
+                  ts <- liftIO getSystemTime
+                  let c = C.cbEncrypt (rcvDhSecret qr) (C.cbNonce msgId) msgBody (maxMessageLength + 2)
+                  pure $ Message msgId ts <$> c
 
-        deliverMessage :: (MsgQueue -> STM (Maybe Message)) -> RecipientId -> Sub -> m Transmission
+                trySendNotification :: STM ()
+                trySendNotification =
+                  forM_ (notifier qr) $ \(nId, _) ->
+                    mapM_ (writeNtf nId) . M.lookup nId =<< readTVar notifiers
+
+                writeNtf :: NotifierId -> Client -> STM ()
+                writeNtf nId Client {sndQ = q} =
+                  unlessM (isFullTBQueue sndQ) $
+                    writeTBQueue q (CorrId "", nId, NMSG)
+
+        deliverMessage :: (MsgQueue -> STM (Maybe Message)) -> RecipientId -> Sub -> m (Transmission BrokerMsg)
         deliverMessage tryPeek rId = \case
           Sub {subThread = NoSub} -> do
             ms <- asks msgStore
@@ -333,8 +384,8 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
             q <- atomically $ getMsgQueue ms rId quota
             atomically (tryPeek q) >>= \case
               Nothing -> forkSub q $> ok
-              Just msg -> atomically setDelivered $> mkResp corrId rId (msgCmd msg)
-          _ -> return ok
+              Just msg -> atomically setDelivered $> (corrId, rId, msgCmd msg)
+          _ -> pure ok
           where
             forkSub :: MsgQueue -> m ()
             forkSub q = do
@@ -347,7 +398,7 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
             subscriber :: MsgQueue -> m ()
             subscriber q = atomically $ do
               msg <- peekMsg q
-              writeTBQueue sndQ $ mkResp (CorrId "") rId (msgCmd msg)
+              writeTBQueue sndQ (CorrId "", rId, msgCmd msg)
               setSub (\s -> s {subThread = NoSub})
               void setDelivered
 
@@ -357,33 +408,33 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
             setDelivered :: STM (Maybe Bool)
             setDelivered = withSub rId $ \s -> tryPutTMVar (delivered s) ()
 
-        delQueueAndMsgs :: QueueStore -> m Transmission
+            msgCmd :: Message -> BrokerMsg
+            msgCmd Message {msgId, ts, msgBody} = MSG msgId ts msgBody
+
+        delQueueAndMsgs :: QueueStore -> m (Transmission BrokerMsg)
         delQueueAndMsgs st = do
           withLog (`logDeleteQueue` queueId)
           ms <- asks msgStore
           atomically $
             deleteQueue st queueId >>= \case
-              Left e -> return $ err e
+              Left e -> pure $ err e
               Right _ -> delMsgQueue ms queueId $> ok
 
-        ok :: Transmission
-        ok = mkResp corrId queueId OK
+        ok :: Transmission BrokerMsg
+        ok = (corrId, queueId, OK)
 
-        err :: ErrorType -> Transmission
-        err = mkResp corrId queueId . ERR
+        err :: ErrorType -> Transmission BrokerMsg
+        err e = (corrId, queueId, ERR e)
 
-        okResp :: Either ErrorType () -> Transmission
+        okResp :: Either ErrorType () -> Transmission BrokerMsg
         okResp = either err $ const ok
 
-        msgCmd :: Message -> Command 'Broker
-        msgCmd Message {msgId, ts, msgBody} = MSG msgId ts msgBody
-
 withLog :: (MonadUnliftIO m, MonadReader Env m) => (StoreLog 'WriteMode -> IO a) -> m ()
 withLog action = do
   env <- ask
   liftIO . mapM_ action $ storeLog (env :: Env)
 
-randomId :: (MonadUnliftIO m, MonadReader Env m) => Int -> m Encoded
+randomId :: (MonadUnliftIO m, MonadReader Env m) => Int -> m ByteString
 randomId n = do
   gVar <- asks idsDrg
   atomically (randomBytes n gVar)

src/Simplex/Messaging/Server/Env/STM.hs

@@ -6,20 +6,23 @@
 module Simplex.Messaging.Server.Env.STM where
 
 import Control.Concurrent (ThreadId)
-import Control.Concurrent.STM (stateTVar)
 import Control.Monad.IO.Unlift
 import Crypto.Random
+import Data.ByteString.Char8 (ByteString)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (ServiceName)
+import qualified Network.TLS as T
 import Numeric.Natural
-import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto (KeyHash (..))
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.QueueStore (QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Transport (ATransport)
+import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
 import System.IO (IOMode (..))
 import UnliftIO.STM
 
@@ -31,32 +34,36 @@ data ServerConfig = ServerConfig
     queueIdBytes :: Int,
     msgIdBytes :: Int,
     storeLog :: Maybe (StoreLog 'ReadMode),
-    blockSize :: Int,
-    serverPrivateKey :: C.FullPrivateKey
-    -- serverId :: ByteString
+    -- CA certificate private key is not needed for initialization
+    caCertificateFile :: FilePath,
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath
   }
 
 data Env = Env
   { config :: ServerConfig,
     server :: Server,
+    serverIdentity :: KeyHash,
     queueStore :: QueueStore,
     msgStore :: STMMsgStore,
     idsDrg :: TVar ChaChaDRG,
-    serverKeyPair :: C.FullKeyPair,
-    storeLog :: Maybe (StoreLog 'WriteMode)
+    storeLog :: Maybe (StoreLog 'WriteMode),
+    tlsServerParams :: T.ServerParams
   }
 
 data Server = Server
   { subscribedQ :: TBQueue (RecipientId, Client),
     subscribers :: TVar (Map RecipientId Client),
-    nextClientId :: TVar Natural
+    ntfSubscribedQ :: TBQueue (NotifierId, Client),
+    notifiers :: TVar (Map NotifierId Client)
   }
 
 data Client = Client
   { subscriptions :: TVar (Map RecipientId Sub),
-    rcvQ :: TBQueue Transmission,
-    sndQ :: TBQueue Transmission,
-    clientId :: Natural,
+    ntfSubscriptions :: TVar (Map NotifierId ()),
+    rcvQ :: TBQueue (Transmission Cmd),
+    sndQ :: TBQueue (Transmission BrokerMsg),
+    sessionId :: ByteString,
     connected :: TVar Bool
   }
 
@@ -71,17 +78,18 @@ newServer :: Natural -> STM Server
 newServer qSize = do
   subscribedQ <- newTBQueue qSize
   subscribers <- newTVar M.empty
-  nextClientId <- newTVar 0
-  return Server {subscribedQ, subscribers, nextClientId}
+  ntfSubscribedQ <- newTBQueue qSize
+  notifiers <- newTVar M.empty
+  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers}
 
-newClient :: Server -> Natural -> STM Client
-newClient Server {nextClientId} qSize = do
+newClient :: Natural -> ByteString -> STM Client
+newClient qSize sessionId = do
   subscriptions <- newTVar M.empty
+  ntfSubscriptions <- newTVar M.empty
   rcvQ <- newTBQueue qSize
   sndQ <- newTBQueue qSize
-  clientId <- stateTVar nextClientId $ \i -> (i, i + 1)
   connected <- newTVar True
-  return Client {subscriptions, rcvQ, sndQ, clientId, connected}
+  return Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, connected}
 
 newSubscription :: STM Sub
 newSubscription = do
@@ -89,20 +97,31 @@ newSubscription = do
   return Sub {subThread = NoSub, delivered}
 
 newEnv :: forall m. (MonadUnliftIO m, MonadRandom m) => ServerConfig -> m Env
-newEnv config = do
+newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile} = do
   server <- atomically $ newServer (serverTbqSize config)
   queueStore <- atomically newQueueStore
   msgStore <- atomically newMsgStore
   idsDrg <- drgNew >>= newTVarIO
   s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig)
-  let pk = serverPrivateKey config
-      serverKeyPair = (C.publicKey' pk, pk)
-  return Env {config, server, queueStore, msgStore, idsDrg, serverKeyPair, storeLog = s'}
+  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
+  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
+  let serverIdentity = KeyHash fp
+  return Env {config, server, serverIdentity, queueStore, msgStore, idsDrg, storeLog = s', tlsServerParams}
   where
     restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)
     restoreQueues queueStore s = do
       (queues, s') <- liftIO $ readWriteStoreLog s
-      atomically $ modifyTVar queueStore $ \d -> d {queues, senders = M.foldr' addSender M.empty queues}
+      atomically $
+        modifyTVar queueStore $ \d ->
+          d
+            { queues,
+              senders = M.foldr' addSender M.empty queues,
+              notifiers = M.foldr' addNotifier M.empty queues
+            }
       pure s'
     addSender :: QueueRec -> Map SenderId RecipientId -> Map SenderId RecipientId
     addSender q = M.insert (senderId q) (recipientId q)
+    addNotifier :: QueueRec -> Map NotifierId RecipientId -> Map NotifierId RecipientId
+    addNotifier q = case notifier q of
+      Nothing -> id
+      Just (nId, _) -> M.insert nId (recipientId q)

src/Simplex/Messaging/Server/MsgStore.hs

@@ -2,13 +2,13 @@
 
 module Simplex.Messaging.Server.MsgStore where
 
-import Data.Time.Clock
+import Data.Time.Clock.System (SystemTime)
 import Numeric.Natural
-import Simplex.Messaging.Protocol (Encoded, MsgBody, RecipientId)
+import Simplex.Messaging.Protocol (MsgBody, MsgId, RecipientId)
 
 data Message = Message
-  { msgId :: Encoded,
-    ts :: UTCTime,
+  { msgId :: MsgId,
+    ts :: SystemTime,
     msgBody :: MsgBody
   }
 

src/Simplex/Messaging/Server/QueueStore.hs

@@ -1,35 +1,27 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Messaging.Server.QueueStore where
 
 import Simplex.Messaging.Protocol
 
 data QueueRec = QueueRec
-  { recipientId :: QueueId,
-    senderId :: QueueId,
-    recipientKey :: RecipientPublicKey,
-    senderKey :: Maybe SenderPublicKey,
+  { recipientId :: RecipientId,
+    recipientKey :: RcvPublicVerifyKey,
+    rcvDhSecret :: RcvDhSecret,
+    senderId :: SenderId,
+    senderKey :: Maybe SndPublicVerifyKey,
+    notifier :: Maybe (NotifierId, NtfPublicVerifyKey),
     status :: QueueStatus
   }
 
-data QueueStatus = QueueActive | QueueOff deriving (Eq)
+data QueueStatus = QueueActive | QueueOff deriving (Eq, Show)
 
 class MonadQueueStore s m where
-  addQueue :: s -> RecipientPublicKey -> (RecipientId, SenderId) -> m (Either ErrorType ())
-  getQueue :: s -> SParty (a :: Party) -> QueueId -> m (Either ErrorType QueueRec)
-  secureQueue :: s -> RecipientId -> SenderPublicKey -> m (Either ErrorType ())
+  addQueue :: s -> QueueRec -> m (Either ErrorType ())
+  getQueue :: s -> SParty p -> QueueId -> m (Either ErrorType QueueRec)
+  secureQueue :: s -> RecipientId -> SndPublicVerifyKey -> m (Either ErrorType QueueRec)
+  addQueueNotifier :: s -> RecipientId -> NotifierId -> NtfPublicVerifyKey -> m (Either ErrorType QueueRec)
   suspendQueue :: s -> RecipientId -> m (Either ErrorType ())
   deleteQueue :: s -> RecipientId -> m (Either ErrorType ())
-
-mkQueueRec :: RecipientPublicKey -> (RecipientId, SenderId) -> QueueRec
-mkQueueRec recipientKey (recipientId, senderId) =
-  QueueRec
-    { recipientId,
-      senderId,
-      recipientKey,
-      senderKey = Nothing,
-      status = QueueActive
-    }

src/Simplex/Messaging/Server/QueueStore/STM.hs

@@ -19,44 +19,69 @@ import UnliftIO.STM
 
 data QueueStoreData = QueueStoreData
   { queues :: Map RecipientId QueueRec,
-    senders :: Map SenderId RecipientId
+    senders :: Map SenderId RecipientId,
+    notifiers :: Map NotifierId RecipientId
   }
 
 type QueueStore = TVar QueueStoreData
 
 newQueueStore :: STM QueueStore
-newQueueStore = newTVar QueueStoreData {queues = M.empty, senders = M.empty}
+newQueueStore = newTVar QueueStoreData {queues = M.empty, senders = M.empty, notifiers = M.empty}
 
 instance MonadQueueStore QueueStore STM where
-  addQueue :: QueueStore -> RecipientPublicKey -> (RecipientId, SenderId) -> STM (Either ErrorType ())
-  addQueue store rKey ids@(rId, sId) = do
+  addQueue :: QueueStore -> QueueRec -> STM (Either ErrorType ())
+  addQueue store qRec@QueueRec {recipientId = rId, senderId = sId} = do
     cs@QueueStoreData {queues, senders} <- readTVar store
     if M.member rId queues || M.member sId senders
       then return $ Left DUPLICATE_
       else do
         writeTVar store $
           cs
-            { queues = M.insert rId (mkQueueRec rKey ids) queues,
+            { queues = M.insert rId qRec queues,
               senders = M.insert sId rId senders
             }
         return $ Right ()
 
-  getQueue :: QueueStore -> SParty (p :: Party) -> QueueId -> STM (Either ErrorType QueueRec)
-  getQueue store SRecipient rId = do
-    cs <- readTVar store
-    return $ getRcpQueue cs rId
-  getQueue store SSender sId = do
-    cs <- readTVar store
-    let rId = M.lookup sId $ senders cs
-    return $ maybe (Left AUTH) (getRcpQueue cs) rId
-  getQueue _ SBroker _ =
-    return $ Left INTERNAL
+  getQueue :: QueueStore -> SParty p -> QueueId -> STM (Either ErrorType QueueRec)
+  getQueue st party qId = do
+    cs <- readTVar st
+    pure $ case party of
+      SRecipient -> getRcpQueue cs qId
+      SSender -> getPartyQueue cs senders
+      SNotifier -> getPartyQueue cs notifiers
+    where
+      getPartyQueue ::
+        QueueStoreData ->
+        (QueueStoreData -> Map QueueId RecipientId) ->
+        Either ErrorType QueueRec
+      getPartyQueue cs recipientIds =
+        case M.lookup qId $ recipientIds cs of
+          Just rId -> getRcpQueue cs rId
+          Nothing -> Left AUTH
 
+  secureQueue :: QueueStore -> RecipientId -> SndPublicVerifyKey -> STM (Either ErrorType QueueRec)
   secureQueue store rId sKey =
     updateQueues store rId $ \cs c ->
       case senderKey c of
         Just _ -> (Left AUTH, cs)
-        _ -> (Right (), cs {queues = M.insert rId c {senderKey = Just sKey} (queues cs)})
+        _ -> (Right c, cs {queues = M.insert rId c {senderKey = Just sKey} (queues cs)})
+
+  addQueueNotifier :: QueueStore -> RecipientId -> NotifierId -> NtfPublicVerifyKey -> STM (Either ErrorType QueueRec)
+  addQueueNotifier store rId nId nKey = do
+    cs@QueueStoreData {queues, notifiers} <- readTVar store
+    if M.member nId notifiers
+      then pure $ Left DUPLICATE_
+      else case M.lookup rId queues of
+        Nothing -> pure $ Left AUTH
+        Just q -> case notifier q of
+          Just _ -> pure $ Left AUTH
+          _ -> do
+            writeTVar store $
+              cs
+                { queues = M.insert rId q {notifier = Just (nId, nKey)} queues,
+                  notifiers = M.insert nId rId notifiers
+                }
+            pure $ Right q
 
   suspendQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ())
   suspendQueue store rId =
@@ -76,8 +101,8 @@ instance MonadQueueStore QueueStore STM where
 updateQueues ::
   QueueStore ->
   RecipientId ->
-  (QueueStoreData -> QueueRec -> (Either ErrorType (), QueueStoreData)) ->
-  STM (Either ErrorType ())
+  (QueueStoreData -> QueueRec -> (Either ErrorType a, QueueStoreData)) ->
+  STM (Either ErrorType a)
 updateQueues store rId update = do
   cs <- readTVar store
   let conn = getRcpQueue cs rId

src/Simplex/Messaging/Server/StoreLog.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Simplex.Messaging.Server.StoreLog
   ( StoreLog, -- constructors are not exported
@@ -14,6 +15,7 @@ module Simplex.Messaging.Server.StoreLog
     closeStoreLog,
     logCreateQueue,
     logSecureQueue,
+    logAddNotifier,
     logDeleteQueue,
     readWriteStoreLog,
   )
@@ -21,10 +23,7 @@ where
 
 import Control.Applicative (optional, (<|>))
 import Control.Monad (unless)
-import Data.Attoparsec.ByteString.Char8 (Parser)
-import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first, second)
-import Data.ByteString.Base64 (encode)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -33,8 +32,7 @@ import Data.Functor (($>))
 import Data.List (foldl')
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Parsers (base64P, parseAll)
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore (QueueRec (..), QueueStatus (..))
 import Simplex.Messaging.Transport (trimCR)
@@ -49,37 +47,44 @@ data StoreLog (a :: IOMode) where
 
 data StoreLogRecord
   = CreateQueue QueueRec
-  | SecureQueue QueueId SenderPublicKey
+  | SecureQueue QueueId SndPublicVerifyKey
+  | AddNotifier QueueId NotifierId NtfPublicVerifyKey
   | DeleteQueue QueueId
 
-storeLogRecordP :: Parser StoreLogRecord
-storeLogRecordP =
-  "CREATE " *> createQueueP
-    <|> "SECURE " *> secureQueueP
-    <|> "DELETE " *> (DeleteQueue <$> base64P)
-  where
-    createQueueP = CreateQueue <$> queueRecP
-    secureQueueP = SecureQueue <$> base64P <* A.space <*> C.pubKeyP
-    queueRecP = do
-      recipientId <- "rid=" *> base64P <* A.space
-      senderId <- "sid=" *> base64P <* A.space
-      recipientKey <- "rk=" *> C.pubKeyP <* A.space
-      senderKey <- "sk=" *> optional C.pubKeyP
-      pure QueueRec {recipientId, senderId, recipientKey, senderKey, status = QueueActive}
+instance StrEncoding QueueRec where
+  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier} =
+    B.unwords
+      [ "rid=" <> strEncode recipientId,
+        "rk=" <> strEncode recipientKey,
+        "rdh=" <> strEncode rcvDhSecret,
+        "sid=" <> strEncode senderId,
+        "sk=" <> strEncode senderKey
+      ]
+      <> maybe "" notifierStr notifier
+    where
+      notifierStr (nId, nKey) = " nid=" <> strEncode nId <> " nk=" <> strEncode nKey
 
-serializeStoreLogRecord :: StoreLogRecord -> ByteString
-serializeStoreLogRecord = \case
-  CreateQueue q -> "CREATE " <> serializeQueue q
-  SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializePubKey sKey
-  DeleteQueue rId -> "DELETE " <> encode rId
-  where
-    serializeQueue QueueRec {recipientId, senderId, recipientKey, senderKey} =
-      B.unwords
-        [ "rid=" <> encode recipientId,
-          "sid=" <> encode senderId,
-          "rk=" <> C.serializePubKey recipientKey,
-          "sk=" <> maybe "" C.serializePubKey senderKey
-        ]
+  strP = do
+    recipientId <- "rid=" *> strP_
+    recipientKey <- "rk=" *> strP_
+    rcvDhSecret <- "rdh=" *> strP_
+    senderId <- "sid=" *> strP_
+    senderKey <- "sk=" *> strP
+    notifier <- optional $ (,) <$> (" nid=" *> strP_) <*> ("nk=" *> strP)
+    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier, status = QueueActive}
+
+instance StrEncoding StoreLogRecord where
+  strEncode = \case
+    CreateQueue q -> strEncode (Str "CREATE", q)
+    SecureQueue rId sKey -> strEncode (Str "SECURE", rId, sKey)
+    AddNotifier rId nId nKey -> strEncode (Str "NOTIFIER", rId, nId, nKey)
+    DeleteQueue rId -> strEncode (Str "DELETE", rId)
+
+  strP =
+    "CREATE " *> (CreateQueue <$> strP)
+      <|> "SECURE " *> (SecureQueue <$> strP_ <*> strP)
+      <|> "NOTIFIER " *> (AddNotifier <$> strP_ <*> strP_ <*> strP)
+      <|> "DELETE " *> (DeleteQueue <$> strP)
 
 openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
 openWriteStoreLog f = WriteStoreLog f <$> openFile f WriteMode
@@ -101,15 +106,18 @@ closeStoreLog = \case
 
 writeStoreLogRecord :: StoreLog 'WriteMode -> StoreLogRecord -> IO ()
 writeStoreLogRecord (WriteStoreLog _ h) r = do
-  B.hPutStrLn h $ serializeStoreLogRecord r
+  B.hPutStrLn h $ strEncode r
   hFlush h
 
 logCreateQueue :: StoreLog 'WriteMode -> QueueRec -> IO ()
 logCreateQueue s = writeStoreLogRecord s . CreateQueue
 
-logSecureQueue :: StoreLog 'WriteMode -> QueueId -> SenderPublicKey -> IO ()
+logSecureQueue :: StoreLog 'WriteMode -> QueueId -> SndPublicVerifyKey -> IO ()
 logSecureQueue s qId sKey = writeStoreLogRecord s $ SecureQueue qId sKey
 
+logAddNotifier :: StoreLog 'WriteMode -> QueueId -> NotifierId -> NtfPublicVerifyKey -> IO ()
+logAddNotifier s qId nId nKey = writeStoreLogRecord s $ AddNotifier qId nId nKey
+
 logDeleteQueue :: StoreLog 'WriteMode -> QueueId -> IO ()
 logDeleteQueue s = writeStoreLogRecord s . DeleteQueue
 
@@ -136,11 +144,12 @@ readQueues (ReadStoreLog _ h) = LB.hGetContents h >>= returnResult . procStoreLo
     returnResult :: ([LogParsingError], Map RecipientId QueueRec) -> IO (Map RecipientId QueueRec)
     returnResult (errs, res) = mapM_ printError errs $> res
     parseLogRecord :: LB.ByteString -> Either LogParsingError StoreLogRecord
-    parseLogRecord = (\s -> first (,s) $ parseAll storeLogRecordP s) . trimCR . LB.toStrict
+    parseLogRecord = (\s -> first (,s) $ strDecode s) . trimCR . LB.toStrict
     procLogRecord :: Map RecipientId QueueRec -> StoreLogRecord -> Map RecipientId QueueRec
     procLogRecord m = \case
       CreateQueue q -> M.insert (recipientId q) q m
       SecureQueue qId sKey -> M.adjust (\q -> q {senderKey = Just sKey}) qId m
+      AddNotifier qId nId nKey -> M.adjust (\q -> q {notifier = Just (nId, nKey)}) qId m
       DeleteQueue qId -> M.delete qId m
     printError :: LogParsingError -> IO ()
     printError (e, s) = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s

src/Simplex/Messaging/Transport.hs

@@ -1,10 +1,11 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -24,28 +25,33 @@
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
 module Simplex.Messaging.Transport
-  ( -- * Transport connection class
+  ( -- * SMP transport parameters
+    smpBlockSize,
+    supportedSMPVersions,
+    simplexMQVersion,
+
+    -- * Transport connection class
     Transport (..),
     TProxy (..),
     ATransport (..),
+    TransportPeer (..),
 
-    -- * Transport over TCP
-    runTransportServer,
-    runTransportClient,
+    -- * TLS Transport
+    TLS (..),
+    connectTLS,
+    closeTLS,
+    supportedParameters,
+    withTlsUnique,
 
-    -- * TCP transport
-    TCP (..),
-
-    -- * SMP encrypted transport
+    -- * SMP transport
     THandle (..),
     TransportError (..),
     serverHandshake,
     clientHandshake,
-    tPutEncrypted,
-    tGetEncrypted,
+    tPutBlock,
+    tGetBlock,
     serializeTransportError,
     transportErrorP,
-    currentSMPVersionStr,
 
     -- * Trim trailing CR
     trimCR,
@@ -54,38 +60,44 @@ where
 
 import Control.Applicative ((<|>))
 import Control.Monad.Except
-import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except (throwE)
-import Crypto.Cipher.Types (AuthTag)
+import Data.Aeson (ToJSON)
+import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
-import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
-import Data.ByteArray (xor)
+import Data.Bitraversable (bimapM)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as BL
+import Data.Default (def)
 import Data.Functor (($>))
-import Data.Maybe (fromMaybe)
-import Data.Set (Set)
-import qualified Data.Set as S
-import Data.String
-import Data.Word (Word32)
 import GHC.Generics (Generic)
-import GHC.IO.Exception (IOErrorType (..))
 import GHC.IO.Handle.Internals (ioe_EOF)
 import Generic.Random (genericArbitraryU)
 import Network.Socket
-import Network.Transport.Internal (decodeNum16, decodeNum32, encodeEnum16, encodeEnum32, encodeWord32)
+import qualified Network.TLS as T
+import qualified Network.TLS.Extra as TE
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Parsers (parse, parseAll, parseRead1, parseString)
-import Simplex.Messaging.Util (bshow, liftError)
-import System.IO
-import System.IO.Error
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Parsers (dropPrefix, parse, parseRead1, sumTypeJSON)
+import Simplex.Messaging.Util (bshow)
+import Simplex.Messaging.Version
 import Test.QuickCheck (Arbitrary (..))
-import UnliftIO.Concurrent
-import UnliftIO.Exception (Exception, IOException)
+import UnliftIO.Exception (Exception)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
+-- * Transport parameters
+
+smpBlockSize :: Int
+smpBlockSize = 16384
+
+supportedSMPVersions :: VersionRange
+supportedSMPVersions = mkVersionRange 1 1
+
+simplexMQVersion :: String
+simplexMQVersion = "1.0.2"
+
 -- * Transport connection class
 
 class Transport c where
@@ -94,11 +106,16 @@ class Transport c where
 
   transportName :: TProxy c -> String
 
-  -- | Upgrade client socket to connection (used in the server)
-  getServerConnection :: Socket -> IO c
+  transportPeer :: c -> TransportPeer
 
-  -- | Upgrade server socket to connection (used in the client)
-  getClientConnection :: Socket -> IO c
+  -- | Upgrade server TLS context to connection (used in the server)
+  getServerConnection :: T.Context -> IO c
+
+  -- | Upgrade client TLS context to connection (used in the client)
+  getClientConnection :: T.Context -> IO c
+
+  -- | tls-unique channel binding per RFC5929
+  tlsUnique :: c -> ByteString
 
   -- | Close connection
   closeConnection :: c -> IO ()
@@ -116,179 +133,183 @@ class Transport c where
   putLn :: c -> ByteString -> IO ()
   putLn c = cPut c . (<> "\r\n")
 
+data TransportPeer = TClient | TServer
+  deriving (Eq, Show)
+
 data TProxy c = TProxy
 
 data ATransport = forall c. Transport c => ATransport (TProxy c)
 
--- * Transport over TCP
+-- * TLS Transport
 
--- | Run transport server (plain TCP or WebSockets) on passed TCP port and signal when server started and stopped via passed TMVar.
---
--- All accepted connections are passed to the passed function.
-runTransportServer :: (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> (c -> m ()) -> m ()
-runTransportServer started port server = do
-  clients <- newTVarIO S.empty
-  E.bracket (liftIO $ startTCPServer started port) (liftIO . closeServer clients) \sock -> forever $ do
-    c <- liftIO $ acceptConnection sock
-    tid <- forkFinally (server c) (const $ liftIO $ closeConnection c)
-    atomically . modifyTVar clients $ S.insert tid
+data TLS = TLS
+  { tlsContext :: T.Context,
+    tlsPeer :: TransportPeer,
+    tlsUniq :: ByteString,
+    buffer :: TVar ByteString,
+    getLock :: TMVar ()
+  }
+
+connectTLS :: T.TLSParams p => p -> Socket -> IO T.Context
+connectTLS params sock =
+  E.bracketOnError (T.contextNew sock params) closeTLS $ \ctx -> do
+    T.handshake ctx
+      `E.catch` \(e :: E.SomeException) -> putStrLn ("exception: " <> show e) >> E.throwIO e
+    pure ctx
+
+getTLS :: TransportPeer -> T.Context -> IO TLS
+getTLS tlsPeer cxt = withTlsUnique tlsPeer cxt newTLS
   where
-    closeServer :: TVar (Set ThreadId) -> Socket -> IO ()
-    closeServer clients sock = do
-      readTVarIO clients >>= mapM_ killThread
-      close sock
-      void . atomically $ tryPutTMVar started False
-    acceptConnection :: Transport c => Socket -> IO c
-    acceptConnection sock = accept sock >>= getServerConnection . fst
+    newTLS tlsUniq = do
+      buffer <- newTVarIO ""
+      getLock <- newTMVarIO ()
+      pure TLS {tlsContext = cxt, tlsPeer, tlsUniq, buffer, getLock}
 
-startTCPServer :: TMVar Bool -> ServiceName -> IO Socket
-startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
+withTlsUnique :: TransportPeer -> T.Context -> (ByteString -> IO c) -> IO c
+withTlsUnique peer cxt f =
+  cxtFinished peer cxt
+    >>= maybe (closeTLS cxt >> ioe_EOF) f
   where
-    resolve =
-      let hints = defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Stream}
-       in head <$> getAddrInfo (Just hints) Nothing (Just port)
-    open addr = do
-      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
-      setSocketOption sock ReuseAddr 1
-      withFdSocket sock setCloseOnExecIfNeeded
-      bind sock $ addrAddress addr
-      listen sock 1024
-      return sock
-    setStarted sock = atomically (tryPutTMVar started True) >> pure sock
+    cxtFinished TServer = T.getPeerFinished
+    cxtFinished TClient = T.getFinished
 
--- | Connect to passed TCP host:port and pass handle to the client.
-runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> (c -> m a) -> m a
-runTransportClient host port client = do
-  c <- liftIO $ startTCPClient host port
-  client c `E.finally` liftIO (closeConnection c)
+closeTLS :: T.Context -> IO ()
+closeTLS ctx =
+  (T.bye ctx >> T.contextClose ctx) -- sometimes socket was closed before 'TLS.bye'
+    `E.catch` (\(_ :: E.SomeException) -> pure ()) -- so we catch the 'Broken pipe' error here
 
-startTCPClient :: forall c. Transport c => HostName -> ServiceName -> IO c
-startTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
-  where
-    err :: IOException
-    err = mkIOError NoSuchThing "no address" Nothing Nothing
+supportedParameters :: T.Supported
+supportedParameters =
+  def
+    { T.supportedVersions = [T.TLS13, T.TLS12],
+      T.supportedCiphers =
+        [ TE.cipher_TLS13_CHACHA20POLY1305_SHA256, -- for TLS13
+          TE.cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 -- for TLS12
+        ],
+      T.supportedHashSignatures = [(T.HashIntrinsic, T.SignatureEd448), (T.HashIntrinsic, T.SignatureEd25519)],
+      T.supportedSecureRenegotiation = False,
+      T.supportedGroups = [T.X448, T.X25519]
+    }
 
-    resolve :: IO [AddrInfo]
-    resolve =
-      let hints = defaultHints {addrSocketType = Stream}
-       in getAddrInfo (Just hints) (Just host) (Just port)
+instance Transport TLS where
+  transportName _ = "TLS"
+  transportPeer = tlsPeer
+  getServerConnection = getTLS TServer
+  getClientConnection = getTLS TClient
+  tlsUnique = tlsUniq
+  closeConnection tls = closeTLS $ tlsContext tls
 
-    tryOpen :: IOException -> [AddrInfo] -> IO c
-    tryOpen e [] = E.throwIO e
-    tryOpen _ (addr : as) =
-      E.try (open addr) >>= either (`tryOpen` as) pure
+  cGet :: TLS -> Int -> IO ByteString
+  cGet TLS {tlsContext, buffer, getLock} n =
+    E.bracket_
+      (atomically $ takeTMVar getLock)
+      (atomically $ putTMVar getLock ())
+      $ do
+        b <- readChunks =<< readTVarIO buffer
+        let (s, b') = B.splitAt n b
+        atomically $ writeTVar buffer b'
+        pure s
+    where
+      readChunks :: ByteString -> IO ByteString
+      readChunks b
+        | B.length b >= n = pure b
+        | otherwise = readChunks . (b <>) =<< T.recvData tlsContext `E.catch` handleEOF
+      handleEOF = \case
+        T.Error_EOF -> E.throwIO TEBadBlock
+        e -> E.throwIO e
 
-    open :: AddrInfo -> IO c
-    open addr = do
-      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
-      connect sock $ addrAddress addr
-      getClientConnection sock
+  cPut :: TLS -> ByteString -> IO ()
+  cPut tls = T.sendData (tlsContext tls) . BL.fromStrict
 
--- * TCP transport
-
-newtype TCP = TCP {tcpHandle :: Handle}
-
-instance Transport TCP where
-  transportName _ = "TCP"
-  getServerConnection = fmap TCP . getSocketHandle
-  getClientConnection = getServerConnection
-  closeConnection = hClose . tcpHandle
-  cGet = B.hGet . tcpHandle
-  cPut = B.hPut . tcpHandle
-  getLn = fmap trimCR . B.hGetLine . tcpHandle
-
-getSocketHandle :: Socket -> IO Handle
-getSocketHandle conn = do
-  h <- socketToHandle conn ReadWriteMode
-  hSetBinaryMode h True
-  hSetNewlineMode h NewlineMode {inputNL = CRLF, outputNL = CRLF}
-  hSetBuffering h LineBuffering
-  return h
+  getLn :: TLS -> IO ByteString
+  getLn TLS {tlsContext, buffer, getLock} = do
+    E.bracket_
+      (atomically $ takeTMVar getLock)
+      (atomically $ putTMVar getLock ())
+      $ do
+        b <- readChunks =<< readTVarIO buffer
+        let (s, b') = B.break (== '\n') b
+        atomically $ writeTVar buffer (B.drop 1 b') -- drop '\n' we made a break at
+        pure $ trimCR s
+    where
+      readChunks :: ByteString -> IO ByteString
+      readChunks b
+        | B.elem '\n' b = pure b
+        | otherwise = readChunks . (b <>) =<< T.recvData tlsContext `E.catch` handleEOF
+      handleEOF = \case
+        T.Error_EOF -> E.throwIO TEBadBlock
+        e -> E.throwIO e
 
 -- | Trim trailing CR from ByteString.
 trimCR :: ByteString -> ByteString
 trimCR "" = ""
 trimCR s = if B.last s == '\r' then B.init s else s
 
--- * SMP encrypted transport
-
-data SMPVersion = SMPVersion Int Int Int Int
-  deriving (Eq, Ord)
-
-instance IsString SMPVersion where
-  fromString = parseString $ parseAll smpVersionP
-
-major :: SMPVersion -> (Int, Int)
-major (SMPVersion a b _ _) = (a, b)
-
-currentSMPVersion :: SMPVersion
-currentSMPVersion = "0.5.1.0"
-
-currentSMPVersionStr :: ByteString
-currentSMPVersionStr = serializeSMPVersion currentSMPVersion
-
-serializeSMPVersion :: SMPVersion -> ByteString
-serializeSMPVersion (SMPVersion a b c d) = B.intercalate "." [bshow a, bshow b, bshow c, bshow d]
-
-smpVersionP :: Parser SMPVersion
-smpVersionP =
-  let ver = A.decimal <* A.char '.'
-   in SMPVersion <$> ver <*> ver <*> ver <*> A.decimal
+-- * SMP transport
 
 -- | The handle for SMP encrypted transport connection over Transport .
 data THandle c = THandle
   { connection :: c,
-    sndKey :: SessionKey,
-    rcvKey :: SessionKey,
-    blockSize :: Int
+    sessionId :: ByteString,
+    -- | agreed SMP server protocol version
+    smpVersion :: Version
   }
 
-data SessionKey = SessionKey
-  { aesKey :: C.Key,
-    baseIV :: C.IV,
-    counter :: TVar Word32
+data ServerHandshake = ServerHandshake
+  { smpVersionRange :: VersionRange,
+    sessionId :: ByteString
   }
 
 data ClientHandshake = ClientHandshake
-  { blockSize :: Int,
-    sndKey :: SessionKey,
-    rcvKey :: SessionKey
+  { -- | agreed SMP server protocol version
+    smpVersion :: Version,
+    -- | server identity - CA certificate fingerprint
+    keyHash :: C.KeyHash
   }
 
+instance Encoding ClientHandshake where
+  smpEncode ClientHandshake {smpVersion, keyHash} = smpEncode (smpVersion, keyHash)
+  smpP = do
+    (smpVersion, keyHash) <- smpP
+    pure ClientHandshake {smpVersion, keyHash}
+
+instance Encoding ServerHandshake where
+  smpEncode ServerHandshake {smpVersionRange, sessionId} =
+    smpEncode (smpVersionRange, sessionId)
+  smpP = do
+    (smpVersionRange, sessionId) <- smpP
+    pure ServerHandshake {smpVersionRange, sessionId}
+
 -- | Error of SMP encrypted transport over TCP.
 data TransportError
   = -- | error parsing transport block
     TEBadBlock
-  | -- | block encryption error
-    TEEncrypt
-  | -- | block decryption error
-    TEDecrypt
+  | -- | message does not fit in transport block
+    TELargeMsg
+  | -- | incorrect session ID
+    TEBadSession
   | -- | transport handshake error
-    TEHandshake HandshakeError
+    TEHandshake {handshakeErr :: HandshakeError}
   deriving (Eq, Generic, Read, Show, Exception)
 
+instance ToJSON TransportError where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "TE"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "TE"
+
 -- | Transport handshake error.
 data HandshakeError
-  = -- | encryption error
-    ENCRYPT
-  | -- | decryption error
-    DECRYPT
-  | -- | error parsing protocol version
+  = -- | parsing error
+    PARSE
+  | -- | incompatible peer version
     VERSION
-  | -- | error parsing RSA key
-    RSA_KEY
-  | -- | error parsing server transport header or invalid block size
-    HEADER
-  | -- | error parsing AES keys
-    AES_KEYS
-  | -- | not matching RSA key hash
-    BAD_HASH
-  | -- | lower major agent version than protocol version
-    MAJOR_VERSION
-  | -- | TCP transport terminated
-    TERMINATED
+  | -- | incorrect server identity
+    IDENTITY
   deriving (Eq, Generic, Read, Show, Exception)
 
+instance ToJSON HandshakeError where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
 instance Arbitrary TransportError where arbitrary = genericArbitraryU
 
 instance Arbitrary HandshakeError where arbitrary = genericArbitraryU
@@ -297,202 +318,67 @@ instance Arbitrary HandshakeError where arbitrary = genericArbitraryU
 transportErrorP :: Parser TransportError
 transportErrorP =
   "BLOCK" $> TEBadBlock
-    <|> "AES_ENCRYPT" $> TEEncrypt
-    <|> "AES_DECRYPT" $> TEDecrypt
+    <|> "LARGE_MSG" $> TELargeMsg
+    <|> "SESSION" $> TEBadSession
     <|> TEHandshake <$> parseRead1
 
 -- | Serialize SMP encrypted transport error.
 serializeTransportError :: TransportError -> ByteString
 serializeTransportError = \case
-  TEEncrypt -> "AES_ENCRYPT"
-  TEDecrypt -> "AES_DECRYPT"
   TEBadBlock -> "BLOCK"
+  TELargeMsg -> "LARGE_MSG"
+  TEBadSession -> "SESSION"
   TEHandshake e -> bshow e
 
--- | Encrypt and send block to SMP encrypted transport.
-tPutEncrypted :: Transport c => THandle c -> ByteString -> IO (Either TransportError ())
-tPutEncrypted THandle {connection = c, sndKey, blockSize} block =
-  encryptBlock sndKey (blockSize - C.authTagSize) block >>= \case
-    Left _ -> pure $ Left TEEncrypt
-    Right (authTag, msg) -> Right <$> cPut c (C.authTagToBS authTag <> msg)
+-- | Pad and send block to SMP transport.
+tPutBlock :: Transport c => THandle c -> ByteString -> IO (Either TransportError ())
+tPutBlock THandle {connection = c} block =
+  bimapM (const $ pure TELargeMsg) (cPut c) $
+    C.pad block smpBlockSize
 
--- | Receive and decrypt block from SMP encrypted transport.
-tGetEncrypted :: Transport c => THandle c -> IO (Either TransportError ByteString)
-tGetEncrypted THandle {connection = c, rcvKey, blockSize} =
-  cGet c blockSize >>= decryptBlock rcvKey >>= \case
-    Left _ -> pure $ Left TEDecrypt
-    Right "" -> ioe_EOF
-    Right msg -> pure $ Right msg
+-- | Receive block from SMP transport.
+tGetBlock :: Transport c => THandle c -> IO (Either TransportError ByteString)
+tGetBlock THandle {connection = c} =
+  cGet c smpBlockSize >>= \case
+    "" -> ioe_EOF
+    msg -> pure . first (const TELargeMsg) $ C.unPad msg
 
-encryptBlock :: SessionKey -> Int -> ByteString -> IO (Either C.CryptoError (AuthTag, ByteString))
-encryptBlock k@SessionKey {aesKey} size block = do
-  ivBytes <- makeNextIV k
-  runExceptT $ C.encryptAES aesKey ivBytes size block
-
-decryptBlock :: SessionKey -> ByteString -> IO (Either C.CryptoError ByteString)
-decryptBlock k@SessionKey {aesKey} block = do
-  let (authTag, msg') = B.splitAt C.authTagSize block
-  ivBytes <- makeNextIV k
-  runExceptT $ C.decryptAES aesKey ivBytes msg' (C.bsToAuthTag authTag)
-
-makeNextIV :: SessionKey -> IO C.IV
-makeNextIV SessionKey {baseIV, counter} = atomically $ do
-  c <- readTVar counter
-  writeTVar counter $ c + 1
-  pure $ iv c
-  where
-    (start, rest) = B.splitAt 4 $ C.unIV baseIV
-    iv c = C.IV $ (start `xor` encodeWord32 c) <> rest
-
--- | Server SMP encrypted transport handshake.
+-- | Server SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
---
--- The numbers in function names refer to the steps in the document.
-serverHandshake :: forall c. Transport c => c -> Int -> C.FullKeyPair -> ExceptT TransportError IO (THandle c)
-serverHandshake c srvBlockSize (k, pk) = do
-  checkValidBlockSize srvBlockSize
-  liftIO sendHeaderAndPublicKey_1
-  encryptedKeys <- receiveEncryptedKeys_4
-  ClientHandshake {blockSize, sndKey, rcvKey} <- decryptParseKeys_5 encryptedKeys
-  checkValidBlockSize blockSize
-  th <- liftIO $ transportHandle c rcvKey sndKey blockSize -- keys are swapped here
-  sendWelcome_6 th
-  pure th
-  where
-    sendHeaderAndPublicKey_1 :: IO ()
-    sendHeaderAndPublicKey_1 = do
-      let sKey = C.encodePubKey k
-          header = ServerHeader {blockSize = srvBlockSize, keySize = B.length sKey}
-      cPut c $ binaryServerHeader header
-      cPut c sKey
-    receiveEncryptedKeys_4 :: ExceptT TransportError IO ByteString
-    receiveEncryptedKeys_4 =
-      liftIO (cGet c $ C.publicKeySize k) >>= \case
-        "" -> throwE $ TEHandshake TERMINATED
-        ks -> pure ks
-    decryptParseKeys_5 :: ByteString -> ExceptT TransportError IO ClientHandshake
-    decryptParseKeys_5 encKeys =
-      liftError (const $ TEHandshake DECRYPT) (C.decryptOAEP pk encKeys)
-        >>= liftEither . parseClientHandshake
-    sendWelcome_6 :: THandle c -> ExceptT TransportError IO ()
-    sendWelcome_6 th = ExceptT . tPutEncrypted th $ currentSMPVersionStr <> " "
+serverHandshake :: forall c. Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
+serverHandshake c kh = do
+  let th@THandle {sessionId} = tHandle c
+  sendHandshake th $ ServerHandshake {sessionId, smpVersionRange = supportedSMPVersions}
+  getHandshake th >>= \case
+    ClientHandshake {smpVersion, keyHash}
+      | keyHash /= kh ->
+        throwE $ TEHandshake IDENTITY
+      | smpVersion `isCompatible` supportedSMPVersions -> do
+        pure (th :: THandle c) {smpVersion}
+      | otherwise -> throwE $ TEHandshake VERSION
 
--- | Client SMP encrypted transport handshake.
+-- | Client SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
---
--- The numbers in function names refer to the steps in the document.
-clientHandshake :: forall c. Transport c => c -> Maybe Int -> Maybe C.KeyHash -> ExceptT TransportError IO (THandle c)
-clientHandshake c blkSize_ keyHash = do
-  mapM_ checkValidBlockSize blkSize_
-  (k, blkSize) <- getHeaderAndPublicKey_1_2
-  let clientBlkSize = fromMaybe blkSize blkSize_
-  chs@ClientHandshake {sndKey, rcvKey} <- liftIO $ generateKeys_3 clientBlkSize
-  sendEncryptedKeys_4 k chs
-  th <- liftIO $ transportHandle c sndKey rcvKey clientBlkSize
-  getWelcome_6 th >>= checkVersion
-  pure th
-  where
-    getHeaderAndPublicKey_1_2 :: ExceptT TransportError IO (C.PublicKey, Int)
-    getHeaderAndPublicKey_1_2 = do
-      header <- liftIO (cGet c serverHeaderSize)
-      ServerHeader {blockSize, keySize} <- liftEither $ parse serverHeaderP (TEHandshake HEADER) header
-      checkValidBlockSize blockSize
-      s <- liftIO $ cGet c keySize
-      maybe (pure ()) (validateKeyHash_2 s) keyHash
-      key <- liftEither $ parseKey s
-      pure (key, blockSize)
-    parseKey :: ByteString -> Either TransportError C.PublicKey
-    parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.binaryPubKeyP
-    validateKeyHash_2 :: ByteString -> C.KeyHash -> ExceptT TransportError IO ()
-    validateKeyHash_2 k (C.KeyHash kHash)
-      | C.sha256Hash k == kHash = pure ()
-      | otherwise = throwE $ TEHandshake BAD_HASH
-    generateKeys_3 :: Int -> IO ClientHandshake
-    generateKeys_3 blkSize = ClientHandshake blkSize <$> generateKey <*> generateKey
-    generateKey :: IO SessionKey
-    generateKey = do
-      aesKey <- C.randomAesKey
-      baseIV <- C.randomIV
-      pure SessionKey {aesKey, baseIV, counter = undefined}
-    sendEncryptedKeys_4 :: C.PublicKey -> ClientHandshake -> ExceptT TransportError IO ()
-    sendEncryptedKeys_4 k chs =
-      liftError (const $ TEHandshake ENCRYPT) (C.encryptOAEP k $ serializeClientHandshake chs)
-        >>= liftIO . cPut c
-    getWelcome_6 :: THandle c -> ExceptT TransportError IO SMPVersion
-    getWelcome_6 th = ExceptT $ (>>= parseSMPVersion) <$> tGetEncrypted th
-    parseSMPVersion :: ByteString -> Either TransportError SMPVersion
-    parseSMPVersion = first (const $ TEHandshake VERSION) . A.parseOnly (smpVersionP <* A.space)
-    checkVersion :: SMPVersion -> ExceptT TransportError IO ()
-    checkVersion smpVersion =
-      when (major smpVersion > major currentSMPVersion) . throwE $
-        TEHandshake MAJOR_VERSION
+clientHandshake :: forall c. Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
+clientHandshake c keyHash = do
+  let th@THandle {sessionId} = tHandle c
+  ServerHandshake {sessionId = sessId, smpVersionRange} <- getHandshake th
+  if sessionId /= sessId
+    then throwE TEBadSession
+    else case smpVersionRange `compatibleVersion` supportedSMPVersions of
+      Just (Compatible smpVersion) -> do
+        sendHandshake th $ ClientHandshake {smpVersion, keyHash}
+        pure (th :: THandle c) {smpVersion}
+      Nothing -> throwE $ TEHandshake VERSION
 
-checkValidBlockSize :: Int -> ExceptT TransportError IO ()
-checkValidBlockSize blkSize =
-  when (blkSize `notElem` transportBlockSizes) . throwError $ TEHandshake HEADER
+sendHandshake :: (Transport c, Encoding smp) => THandle c -> smp -> ExceptT TransportError IO ()
+sendHandshake th = ExceptT . tPutBlock th . smpEncode
 
-data ServerHeader = ServerHeader {blockSize :: Int, keySize :: Int}
-  deriving (Eq, Show)
+getHandshake :: (Transport c, Encoding smp) => THandle c -> ExceptT TransportError IO smp
+getHandshake th = ExceptT $ (parse smpP (TEHandshake PARSE) =<<) <$> tGetBlock th
 
-binaryRsaTransport :: Int
-binaryRsaTransport = 0
-
-transportBlockSizes :: [Int]
-transportBlockSizes = map (* 1024) [4, 8, 16, 32, 64]
-
-serverHeaderSize :: Int
-serverHeaderSize = 8
-
-binaryServerHeader :: ServerHeader -> ByteString
-binaryServerHeader ServerHeader {blockSize, keySize} =
-  encodeEnum32 blockSize <> encodeEnum16 binaryRsaTransport <> encodeEnum16 keySize
-
-serverHeaderP :: Parser ServerHeader
-serverHeaderP = ServerHeader <$> int32 <* binaryRsaTransportP <*> int16
-
-serializeClientHandshake :: ClientHandshake -> ByteString
-serializeClientHandshake ClientHandshake {blockSize, sndKey, rcvKey} =
-  encodeEnum32 blockSize <> encodeEnum16 binaryRsaTransport <> serializeKey sndKey <> serializeKey rcvKey
-  where
-    serializeKey :: SessionKey -> ByteString
-    serializeKey SessionKey {aesKey, baseIV} = C.unKey aesKey <> C.unIV baseIV
-
-clientHandshakeP :: Parser ClientHandshake
-clientHandshakeP = ClientHandshake <$> int32 <* binaryRsaTransportP <*> keyP <*> keyP
-  where
-    keyP :: Parser SessionKey
-    keyP = do
-      aesKey <- C.aesKeyP
-      baseIV <- C.ivP
-      pure SessionKey {aesKey, baseIV, counter = undefined}
-
-int32 :: Parser Int
-int32 = decodeNum32 <$> A.take 4
-
-int16 :: Parser Int
-int16 = decodeNum16 <$> A.take 2
-
-binaryRsaTransportP :: Parser ()
-binaryRsaTransportP = binaryRsa =<< int16
-  where
-    binaryRsa :: Int -> Parser ()
-    binaryRsa n
-      | n == binaryRsaTransport = pure ()
-      | otherwise = fail "unknown transport mode"
-
-parseClientHandshake :: ByteString -> Either TransportError ClientHandshake
-parseClientHandshake = parse clientHandshakeP $ TEHandshake AES_KEYS
-
-transportHandle :: c -> SessionKey -> SessionKey -> Int -> IO (THandle c)
-transportHandle c sk rk blockSize = do
-  sndCounter <- newTVarIO 0
-  rcvCounter <- newTVarIO 0
-  pure
-    THandle
-      { connection = c,
-        sndKey = sk {counter = sndCounter},
-        rcvKey = rk {counter = rcvCounter},
-        blockSize
-      }
+tHandle :: Transport c => c -> THandle c
+tHandle c =
+  THandle {connection = c, sessionId = tlsUnique c, smpVersion = 0}

src/Simplex/Messaging/Transport/Client.hs

@@ -0,0 +1,82 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Transport.Client
+  ( runTransportClient,
+    clientHandshake,
+  )
+where
+
+import Control.Monad.Except
+import Control.Monad.IO.Unlift
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Default (def)
+import qualified Data.X509 as X
+import qualified Data.X509.CertificateStore as XS
+import Data.X509.Validation (Fingerprint (..))
+import qualified Data.X509.Validation as XV
+import GHC.IO.Exception (IOErrorType (..))
+import Network.Socket
+import qualified Network.TLS as T
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Transport
+import System.IO.Error
+import UnliftIO.Exception (IOException)
+import qualified UnliftIO.Exception as E
+
+-- | Connect to passed TCP host:port and pass handle to the client.
+runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> C.KeyHash -> (c -> m a) -> m a
+runTransportClient host port keyHash client = do
+  let clientParams = mkTLSClientParams host port keyHash
+  c <- liftIO $ startTCPClient host port clientParams
+  client c `E.finally` liftIO (closeConnection c)
+
+startTCPClient :: forall c. Transport c => HostName -> ServiceName -> T.ClientParams -> IO c
+startTCPClient host port clientParams = withSocketsDo $ resolve >>= tryOpen err
+  where
+    err :: IOException
+    err = mkIOError NoSuchThing "no address" Nothing Nothing
+
+    resolve :: IO [AddrInfo]
+    resolve =
+      let hints = defaultHints {addrSocketType = Stream}
+       in getAddrInfo (Just hints) (Just host) (Just port)
+
+    tryOpen :: IOException -> [AddrInfo] -> IO c
+    tryOpen e [] = E.throwIO e
+    tryOpen _ (addr : as) =
+      E.try (open addr) >>= either (`tryOpen` as) pure
+
+    open :: AddrInfo -> IO c
+    open addr = do
+      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+      connect sock $ addrAddress addr
+      ctx <- connectTLS clientParams sock
+      getClientConnection ctx
+
+mkTLSClientParams :: HostName -> ServiceName -> C.KeyHash -> T.ClientParams
+mkTLSClientParams host port keyHash = do
+  let p = B.pack port
+  (T.defaultParamsClient host p)
+    { T.clientShared = def,
+      T.clientHooks = def {T.onServerCertificate = \_ _ _ -> validateCertificateChain keyHash host p},
+      T.clientSupported = supportedParameters
+    }
+
+validateCertificateChain :: C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
+validateCertificateChain _ _ _ (X.CertificateChain []) = pure [XV.EmptyChain]
+validateCertificateChain _ _ _ (X.CertificateChain [_]) = pure [XV.EmptyChain]
+validateCertificateChain (C.KeyHash kh) host port cc@(X.CertificateChain sc@[_, caCert]) =
+  if Fingerprint kh == XV.getFingerprint caCert X.HashSHA256
+    then x509validate
+    else pure [XV.UnknownCA]
+  where
+    x509validate :: IO [XV.FailedReason]
+    x509validate = XV.validate X.HashSHA256 hooks checks certStore cache serviceID cc
+      where
+        hooks = XV.defaultHooks
+        checks = XV.defaultChecks
+        certStore = XS.makeCertificateStore sc
+        cache = XV.exceptionValidationCache [] -- we manually check fingerprint only of the identity certificate (ca.crt)
+        serviceID = (host, port)
+validateCertificateChain _ _ _ _ = pure [XV.AuthorityTooDeep]

src/Simplex/Messaging/Transport/Server.hs

@@ -0,0 +1,94 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Transport.Server
+  ( runTransportServer,
+    loadTLSServerParams,
+    loadFingerprint,
+    serverHandshake,
+  )
+where
+
+import Control.Monad.Except
+import Control.Monad.IO.Unlift
+import qualified Crypto.Store.X509 as SX
+import Data.Default (def)
+import Data.Set (Set)
+import qualified Data.Set as S
+import qualified Data.X509 as X
+import Data.X509.Validation (Fingerprint (..))
+import qualified Data.X509.Validation as XV
+import Network.Socket
+import qualified Network.TLS as T
+import Simplex.Messaging.Transport
+import System.Exit (exitFailure)
+import UnliftIO.Concurrent
+import qualified UnliftIO.Exception as E
+import UnliftIO.STM
+
+-- | Run transport server (plain TCP or WebSockets) on passed TCP port and signal when server started and stopped via passed TMVar.
+--
+-- All accepted connections are passed to the passed function.
+runTransportServer :: forall c m. (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> T.ServerParams -> (c -> m ()) -> m ()
+runTransportServer started port serverParams server = do
+  u <- askUnliftIO
+  liftIO $ do
+    clients <- newTVarIO S.empty
+    E.bracket
+      (startTCPServer started port)
+      (closeServer clients)
+      $ \sock -> forever $ do
+        (connSock, _) <- accept sock
+        tid <- forkIO $ connectClient u connSock `E.catch` \(_ :: E.SomeException) -> pure ()
+        atomically . modifyTVar clients $ S.insert tid
+  where
+    connectClient :: UnliftIO m -> Socket -> IO ()
+    connectClient u connSock =
+      E.bracket
+        (connectTLS serverParams connSock >>= getServerConnection)
+        closeConnection
+        (unliftIO u . server)
+    closeServer :: TVar (Set ThreadId) -> Socket -> IO ()
+    closeServer clients sock = do
+      readTVarIO clients >>= mapM_ killThread
+      close sock
+      void . atomically $ tryPutTMVar started False
+
+startTCPServer :: TMVar Bool -> ServiceName -> IO Socket
+startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
+  where
+    resolve =
+      let hints = defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Stream}
+       in head <$> getAddrInfo (Just hints) Nothing (Just port)
+    open addr = do
+      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+      setSocketOption sock ReuseAddr 1
+      withFdSocket sock setCloseOnExecIfNeeded
+      bind sock $ addrAddress addr
+      listen sock 1024
+      return sock
+    setStarted sock = atomically (tryPutTMVar started True) >> pure sock
+
+loadTLSServerParams :: FilePath -> FilePath -> FilePath -> IO T.ServerParams
+loadTLSServerParams caCertificateFile certificateFile privateKeyFile =
+  fromCredential <$> loadServerCredential
+  where
+    loadServerCredential :: IO T.Credential
+    loadServerCredential =
+      T.credentialLoadX509Chain certificateFile [caCertificateFile] privateKeyFile >>= \case
+        Right credential -> pure credential
+        Left _ -> putStrLn "invalid credential" >> exitFailure
+    fromCredential :: T.Credential -> T.ServerParams
+    fromCredential credential =
+      def
+        { T.serverWantClientCert = False,
+          T.serverShared = def {T.sharedCredentials = T.Credentials [credential]},
+          T.serverHooks = def,
+          T.serverSupported = supportedParameters
+        }
+
+loadFingerprint :: FilePath -> IO Fingerprint
+loadFingerprint certificateFile = do
+  (cert : _) <- SX.readSignedObject certificateFile
+  pure $ XV.getFingerprint (cert :: X.SignedExact X.Certificate) X.HashSHA256

src/Simplex/Messaging/Transport/WebSockets.hs

@@ -1,23 +1,39 @@
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Messaging.Transport.WebSockets (WS (..)) where
 
 import qualified Control.Exception as E
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Network.Socket (Socket)
+import qualified Data.ByteString.Lazy as BL
+import qualified Network.TLS as T
 import Network.WebSockets
 import Network.WebSockets.Stream (Stream)
 import qualified Network.WebSockets.Stream as S
-import Simplex.Messaging.Transport (TProxy, Transport (..), TransportError (..), trimCR)
+import Simplex.Messaging.Transport
+  ( TProxy,
+    Transport (..),
+    TransportError (..),
+    TransportPeer (..),
+    closeTLS,
+    trimCR,
+    withTlsUnique,
+  )
 
-data WS = WS {wsStream :: Stream, wsConnection :: Connection}
+data WS = WS
+  { wsPeer :: TransportPeer,
+    tlsUniq :: ByteString,
+    wsStream :: Stream,
+    wsConnection :: Connection
+  }
 
 websocketsOpts :: ConnectionOptions
 websocketsOpts =
   defaultConnectionOptions
     { connectionCompressionOptions = NoCompression,
-      connectionFramePayloadSizeLimit = SizeLimit 8192,
+      connectionFramePayloadSizeLimit = SizeLimit $ 16 * 1024, -- TODO move to Protocol
       connectionMessageDataSizeLimit = SizeLimit 65536
     }
 
@@ -25,21 +41,17 @@ instance Transport WS where
   transportName :: TProxy WS -> String
   transportName _ = "WebSockets"
 
-  getServerConnection :: Socket -> IO WS
-  getServerConnection sock = do
-    s <- S.makeSocketStream sock
-    WS s <$> acceptClientRequest s
-    where
-      acceptClientRequest :: Stream -> IO Connection
-      acceptClientRequest s = makePendingConnectionFromStream s websocketsOpts >>= acceptRequest
+  transportPeer :: WS -> TransportPeer
+  transportPeer = wsPeer
 
-  getClientConnection :: Socket -> IO WS
-  getClientConnection sock = do
-    s <- S.makeSocketStream sock
-    WS s <$> sendClientRequest s
-    where
-      sendClientRequest :: Stream -> IO Connection
-      sendClientRequest s = newClientConnection s "" "/" websocketsOpts []
+  getServerConnection :: T.Context -> IO WS
+  getServerConnection = getWS TServer
+
+  getClientConnection :: T.Context -> IO WS
+  getClientConnection = getWS TClient
+
+  tlsUnique :: WS -> ByteString
+  tlsUnique = tlsUniq
 
   closeConnection :: WS -> IO ()
   closeConnection = S.close . wsStream
@@ -60,3 +72,28 @@ instance Transport WS where
     if B.null s || B.last s /= '\n'
       then E.throwIO TEBadBlock
       else pure $ B.init s
+
+getWS :: TransportPeer -> T.Context -> IO WS
+getWS wsPeer cxt = withTlsUnique wsPeer cxt connectWS
+  where
+    connectWS tlsUniq = do
+      s <- makeTLSContextStream cxt
+      wsConnection <- connectPeer wsPeer s
+      pure $ WS {wsPeer, tlsUniq, wsStream = s, wsConnection}
+    connectPeer :: TransportPeer -> Stream -> IO Connection
+    connectPeer TServer = acceptClientRequest
+    connectPeer TClient = sendClientRequest
+    acceptClientRequest s = makePendingConnectionFromStream s websocketsOpts >>= acceptRequest
+    sendClientRequest s = newClientConnection s "" "/" websocketsOpts []
+
+makeTLSContextStream :: T.Context -> IO Stream
+makeTLSContextStream cxt =
+  S.makeStream readStream writeStream
+  where
+    readStream :: IO (Maybe ByteString)
+    readStream =
+      (Just <$> T.recvData cxt) `E.catch` \case
+        T.Error_EOF -> pure Nothing
+        e -> E.throwIO e
+    writeStream :: Maybe BL.ByteString -> IO ()
+    writeStream = maybe (closeTLS cxt) (T.sendData cxt)

src/Simplex/Messaging/Util.hs

@@ -1,29 +1,14 @@
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE RankNTypes #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Messaging.Util where
 
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import UnliftIO.Async
-import UnliftIO.Exception (Exception)
-import qualified UnliftIO.Exception as E
-
-newtype InternalException e = InternalException {unInternalException :: e}
-  deriving (Eq, Show)
-
-instance Exception e => Exception (InternalException e)
-
-instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where
-  withRunInIO :: ((forall a. ExceptT e m a -> IO a) -> IO b) -> ExceptT e m b
-  withRunInIO exceptToIO =
-    withExceptT unInternalException . ExceptT . E.try $
-      withRunInIO $ \run ->
-        exceptToIO $ run . (either (E.throwIO . InternalException) return <=< runExceptT)
 
 raceAny_ :: MonadUnliftIO m => [m a] -> m ()
 raceAny_ = r []
@@ -35,21 +20,44 @@ infixl 4 <$$>, <$?>
 
 (<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
 (<$$>) = fmap . fmap
+{-# INLINE (<$$>) #-}
 
 (<$?>) :: MonadFail m => (a -> Either String b) -> m a -> m b
-f <$?> m = m >>= either fail pure . f
+f <$?> m = either fail pure . f =<< m
+{-# INLINE (<$?>) #-}
 
 bshow :: Show a => a -> ByteString
 bshow = B.pack . show
+{-# INLINE bshow #-}
+
+maybeWord :: (a -> ByteString) -> Maybe a -> ByteString
+maybeWord f = maybe "" $ B.cons ' ' . f
+{-# INLINE maybeWord #-}
 
 liftIOEither :: (MonadIO m, MonadError e m) => IO (Either e a) -> m a
 liftIOEither a = liftIO a >>= liftEither
+{-# INLINE liftIOEither #-}
 
 liftError :: (MonadIO m, MonadError e' m) => (e -> e') -> ExceptT e IO a -> m a
 liftError f = liftEitherError f . runExceptT
+{-# INLINE liftError #-}
 
 liftEitherError :: (MonadIO m, MonadError e' m) => (e -> e') -> IO (Either e a) -> m a
 liftEitherError f a = liftIOEither (first f <$> a)
+{-# INLINE liftEitherError #-}
 
 tryError :: MonadError e m => m a -> m (Either e a)
 tryError action = (Right <$> action) `catchError` (pure . Left)
+{-# INLINE tryError #-}
+
+tryE :: Monad m => ExceptT e m a -> ExceptT e m (Either e a)
+tryE m = (Right <$> m) `catchE` (pure . Left)
+{-# INLINE tryE #-}
+
+ifM :: Monad m => m Bool -> m a -> m a -> m a
+ifM ba t f = ba >>= \b -> if b then t else f
+{-# INLINE ifM #-}
+
+unlessM :: Monad m => m Bool -> m () -> m ()
+unlessM b = ifM b $ pure ()
+{-# INLINE unlessM #-}

src/Simplex/Messaging/Version.hs

@@ -0,0 +1,126 @@
+{-# LANGUAGE ConstrainedClassMethods #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Simplex.Messaging.Version
+  ( Version,
+    VersionRange (minVersion, maxVersion),
+    pattern VersionRange,
+    VersionI (..),
+    VersionRangeI (..),
+    Compatible,
+    pattern Compatible,
+    mkVersionRange,
+    safeVersionRange,
+    isCompatible,
+    proveCompatible,
+    compatibleVersion,
+  )
+where
+
+import Control.Applicative (optional)
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Word (Word16)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Util ((<$?>))
+
+pattern VersionRange :: Word16 -> Word16 -> VersionRange
+pattern VersionRange v1 v2 <- VRange v1 v2
+
+{-# COMPLETE VersionRange #-}
+
+type Version = Word16
+
+data VersionRange = VRange
+  { minVersion :: Version,
+    maxVersion :: Version
+  }
+  deriving (Eq, Show)
+
+-- | construct valid version range, to be used in constants
+mkVersionRange :: Version -> Version -> VersionRange
+mkVersionRange v1 v2
+  | v1 <= v2 = VRange v1 v2
+  | otherwise = error "invalid version range"
+
+safeVersionRange :: Version -> Version -> Maybe VersionRange
+safeVersionRange v1 v2
+  | v1 <= v2 = Just $ VRange v1 v2
+  | otherwise = Nothing
+
+instance Encoding VersionRange where
+  smpEncode (VRange v1 v2) = smpEncode (v1, v2)
+  smpP =
+    maybe (fail "invalid version range") pure
+      =<< safeVersionRange <$> smpP <*> smpP
+
+instance StrEncoding VersionRange where
+  strEncode (VRange v1 v2)
+    | v1 == v2 = strEncode v1
+    | otherwise = strEncode v1 <> "-" <> strEncode v2
+  strP = do
+    v1 <- strP
+    v2 <- maybe (pure v1) (const strP) =<< optional (A.char '-')
+    maybe (fail "invalid version range") pure $ safeVersionRange v1 v2
+
+instance ToJSON VersionRange where
+  toJSON (VRange v1 v2) = toJSON (v1, v2)
+  toEncoding (VRange v1 v2) = toEncoding (v1, v2)
+
+instance FromJSON VersionRange where
+  parseJSON v =
+    (\(v1, v2) -> maybe (Left "bad VersionRange") Right $ safeVersionRange v1 v2)
+      <$?> parseJSON v
+
+class VersionI a where
+  type VersionRangeT a
+  version :: a -> Version
+  toVersionRangeT :: a -> VersionRange -> VersionRangeT a
+
+class VersionRangeI a where
+  type VersionT a
+  versionRange :: a -> VersionRange
+  toVersionT :: a -> Version -> VersionT a
+
+instance VersionI Version where
+  type VersionRangeT Version = VersionRange
+  version = id
+  toVersionRangeT _ vr = vr
+
+instance VersionRangeI VersionRange where
+  type VersionT VersionRange = Version
+  versionRange = id
+  toVersionT _ v = v
+
+newtype Compatible a = Compatible_ a
+
+pattern Compatible :: a -> Compatible a
+pattern Compatible a <- Compatible_ a
+
+{-# COMPLETE Compatible #-}
+
+isCompatible :: VersionI a => a -> VersionRange -> Bool
+isCompatible x (VRange v1 v2) = let v = version x in v1 <= v && v <= v2
+
+isCompatibleRange :: VersionRangeI a => a -> VersionRange -> Bool
+isCompatibleRange x (VRange min2 max2) = min1 <= max2 && min2 <= max1
+  where
+    VRange min1 max1 = versionRange x
+
+proveCompatible :: VersionI a => a -> VersionRange -> Maybe (Compatible a)
+proveCompatible x vr = x `mkCompatibleIf` (x `isCompatible` vr)
+
+compatibleVersion :: VersionRangeI a => a -> VersionRange -> Maybe (Compatible (VersionT a))
+compatibleVersion x vr =
+  toVersionT x (min max1 max2) `mkCompatibleIf` isCompatibleRange x vr
+  where
+    max1 = maxVersion $ versionRange x
+    max2 = maxVersion vr
+
+mkCompatibleIf :: a -> Bool -> Maybe (Compatible a)
+x `mkCompatibleIf` cond = if cond then Just $ Compatible_ x else Nothing

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-18.0
+resolver: lts-18.21
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -36,14 +36,22 @@ 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
-# - network-run-0.2.4@sha256:7dbb06def522dab413bce4a46af476820bffdff2071974736b06f52f4ab57c96,885
-# - git: https://github.com/commercialhaskell/stack.git
-#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#
-# extra-deps: []
+  - tls-1.5.7@sha256:1cc30253a9696b65a9cafc0317fbf09f7dcea15e3a145ed6c9c0e28c632fa23a,6991
+# below dependancies are to update Aeson to 2.0.3
+  - OneTuple-0.3.1@sha256:a848c096c9d29e82ffdd30a9998aa2931cbccb3a1bc137539d80f6174d31603e,2262
+  - attoparsec-0.14.4@sha256:79584bdada8b730cb5138fca8c35c76fbef75fc1d1e01e6b1d815a5ee9843191,5810
+  - hashable-1.4.0.2@sha256:0cddd0229d1aac305ea0404409c0bbfab81f075817bd74b8b2929eff58333e55,5005
+  - semialign-1.2.0.1@sha256:0e179b4d3a8eff79001d374d6c91917c6221696b9620f0a4d86852fc6a9b9501,2836
+  - text-short-0.1.5@sha256:962c6228555debdc46f758d0317dea16e5240d01419b42966674b08a5c3d8fa6,3498
+  - time-compat-1.9.6.1@sha256:42d8f2e08e965e1718917d54ad69e1d06bd4b87d66c41dc7410f59313dba4ed1,5033
+  - github: simplex-chat/aeson
+    commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7
+  # - ../hs-tls/core
+  # - github: simplex-chat/hs-tls
+  #   commit: f6cc753611f80af300401cfae63846e9d7c40d9e
+  #   subdirs:
+  #     - core
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

tests/AgentTests.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -11,9 +10,12 @@
 module AgentTests (agentTests) where
 
 import AgentTests.ConnectionRequestTests
+import AgentTests.DoubleRatchetTests (doubleRatchetTests)
 import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.SQLiteTests (storeTests)
+import AgentTests.PostgresTests (postgresStoreTests)
 import Control.Concurrent
+import Control.Monad (forM_)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Network.HTTP.Types (urlEncode)
@@ -21,8 +23,10 @@ import SMPAgentClient
 import SMPClient (testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Agent.Protocol as A
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..), TProxy (..), Transport (..))
+import Simplex.Messaging.Util (bshow)
 import System.Directory (removeFile)
 import System.Timeout
 import Test.Hspec
@@ -30,10 +34,12 @@ import Test.Hspec
 agentTests :: ATransport -> Spec
 agentTests (ATransport t) = do
   describe "Connection request" connectionRequestTests
+  describe "Double ratchet tests" doubleRatchetTests
   describe "Functional API" $ functionalAPITests (ATransport t)
   describe "SQLite store" storeTests
+  describe "Postgres store" postgresStoreTests
   describe "SMP agent protocol syntax" $ syntaxTests t
-  describe "Establishing duplex connection" do
+  describe "Establishing duplex connection" $ do
     it "should connect via one server and one agent" $
       smpAgentTest2_1_1 $ testDuplexConnection t
     it "should connect via one server and one agent (random IDs)" $
@@ -46,23 +52,27 @@ agentTests (ATransport t) = do
       smpAgentTest2_2_2 $ testDuplexConnection t
     it "should connect via 2 servers and 2 agents (random IDs)" $
       smpAgentTest2_2_2 $ testDuplexConnRandomIds t
-  describe "Establishing connections via `contact connection`" do
+  describe "Establishing connections via `contact connection`" $ do
     it "should connect via contact connection with one server and 3 agents" $
       smpAgentTest3 $ testContactConnection t
     it "should connect via contact connection with one server and 2 agents (random IDs)" $
       smpAgentTest2_2_1 $ testContactConnRandomIds t
     it "should support rejecting contact request" $
       smpAgentTest2_2_1 $ testRejectContactRequest t
-  describe "Connection subscriptions" do
+  describe "Connection subscriptions" $ do
     it "should connect via one server and one agent" $
       smpAgentTest3_1_1 $ testSubscription t
     it "should send notifications to client when server disconnects" $
       smpAgentServerTest $ testSubscrNotification t
-  describe "Message delivery" do
+  describe "Message delivery" $ do
     it "should deliver messages after losing server connection and re-connecting" $
       smpAgentTest2_2_2_needs_server $ testMsgDeliveryServerRestart t
     it "should deliver pending messages after agent restarting" $
       smpAgentTest1_1_1 $ testMsgDeliveryAgentRestart t
+    it "should concurrently deliver messages to connections without blocking" $
+      smpAgentTest2_2_1 $ testConcurrentMsgDelivery t
+    it "should deliver messages if one of connections has quota exceeded" $
+      smpAgentTest2_2_1 $ testMsgDeliveryQuotaExceeded t
 
 -- | receive message to handle `h`
 (<#:) :: Transport c => c -> IO (ATransmissionOrError 'Agent)
@@ -75,7 +85,7 @@ h #: t = tPutRaw h t >> (<#:) h
 -- | action and expected response
 -- `h #:t #> r` is the test that sends `t` to `h` and validates that the response is `r`
 (#>) :: IO (ATransmissionOrError 'Agent) -> ATransmission 'Agent -> Expectation
-action #> (corrId, cAlias, cmd) = action `shouldReturn` (corrId, cAlias, Right cmd)
+action #> (corrId, connId, cmd) = action `shouldReturn` (corrId, connId, Right cmd)
 
 -- | action and predicate for the response
 -- `h #:t =#> p` is the test that sends `t` to `h` and validates the response using `p`
@@ -83,13 +93,13 @@ action #> (corrId, cAlias, cmd) = action `shouldReturn` (corrId, cAlias, Right c
 action =#> p = action >>= (`shouldSatisfy` p . correctTransmission)
 
 correctTransmission :: ATransmissionOrError a -> ATransmission a
-correctTransmission (corrId, cAlias, cmdOrErr) = case cmdOrErr of
-  Right cmd -> (corrId, cAlias, cmd)
+correctTransmission (corrId, connId, cmdOrErr) = case cmdOrErr of
+  Right cmd -> (corrId, connId, cmd)
   Left e -> error $ show e
 
 -- | receive message to handle `h` and validate that it is the expected one
 (<#) :: Transport c => c -> ATransmission 'Agent -> Expectation
-h <# (corrId, cAlias, cmd) = (h <#:) `shouldReturn` (corrId, cAlias, Right cmd)
+h <# (corrId, connId, cmd) = (h <#:) `shouldReturn` (corrId, connId, Right cmd)
 
 -- | receive message to handle `h` and validate it using predicate `p`
 (<#=) :: Transport c => c -> (ATransmission 'Agent -> Bool) -> Expectation
@@ -110,39 +120,40 @@ pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} msgBody
 testDuplexConnection :: Transport c => TProxy c -> c -> c -> IO ()
 testDuplexConnection _ alice bob = do
   ("1", "bob", Right (INV cReq)) <- alice #: ("1", "bob", "NEW INV")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
   bob #: ("11", "alice", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice", OK)
   ("", "bob", Right (CONF confId "bob's connInfo")) <- (alice <#:)
   alice #: ("2", "bob", "LET " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
   bob <# ("", "alice", INFO "alice's connInfo")
   bob <# ("", "alice", CON)
   alice <# ("", "bob", CON)
-  alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 1)
-  alice <# ("", "bob", SENT 1)
+  -- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
+  alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 4)
+  alice <# ("", "bob", SENT 4)
   bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
-  bob #: ("12", "alice", "ACK 1") #> ("12", "alice", OK)
-  alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", MID 2)
-  alice <# ("", "bob", SENT 2)
+  bob #: ("12", "alice", "ACK 4") #> ("12", "alice", OK)
+  alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", MID 5)
+  alice <# ("", "bob", SENT 5)
   bob <#= \case ("", "alice", Msg "how are you?") -> True; _ -> False
-  bob #: ("13", "alice", "ACK 2") #> ("13", "alice", OK)
-  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 3)
-  bob <# ("", "alice", SENT 3)
+  bob #: ("13", "alice", "ACK 5") #> ("13", "alice", OK)
+  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 6)
+  bob <# ("", "alice", SENT 6)
   alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
-  alice #: ("3a", "bob", "ACK 3") #> ("3a", "bob", OK)
-  bob #: ("15", "alice", "SEND 9\nmessage 1") #> ("15", "alice", MID 4)
-  bob <# ("", "alice", SENT 4)
+  alice #: ("3a", "bob", "ACK 6") #> ("3a", "bob", OK)
+  bob #: ("15", "alice", "SEND 9\nmessage 1") #> ("15", "alice", MID 7)
+  bob <# ("", "alice", SENT 7)
   alice <#= \case ("", "bob", Msg "message 1") -> True; _ -> False
-  alice #: ("4a", "bob", "ACK 4") #> ("4a", "bob", OK)
+  alice #: ("4a", "bob", "ACK 7") #> ("4a", "bob", OK)
   alice #: ("5", "bob", "OFF") #> ("5", "bob", OK)
-  bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 5)
-  bob <# ("", "alice", MERR 5 (SMP AUTH))
+  bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 8)
+  bob <# ("", "alice", MERR 8 (SMP AUTH))
   alice #: ("6", "bob", "DEL") #> ("6", "bob", OK)
   alice #:# "nothing else should be delivered to alice"
 
 testDuplexConnRandomIds :: Transport c => TProxy c -> c -> c -> IO ()
 testDuplexConnRandomIds _ alice bob = do
   ("1", bobConn, Right (INV cReq)) <- alice #: ("1", "", "NEW INV")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
   ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo")
   ("", bobConn', Right (CONF confId "bob's connInfo")) <- (alice <#:)
   bobConn' `shouldBe` bobConn
@@ -150,32 +161,32 @@ testDuplexConnRandomIds _ alice bob = do
   bob <# ("", aliceConn, INFO "alice's connInfo")
   bob <# ("", aliceConn, CON)
   alice <# ("", bobConn, CON)
-  alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, MID 1)
-  alice <# ("", bobConn, SENT 1)
+  alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, MID 4)
+  alice <# ("", bobConn, SENT 4)
   bob <#= \case ("", c, Msg "hello") -> c == aliceConn; _ -> False
-  bob #: ("12", aliceConn, "ACK 1") #> ("12", aliceConn, OK)
-  alice #: ("3", bobConn, "SEND :how are you?") #> ("3", bobConn, MID 2)
-  alice <# ("", bobConn, SENT 2)
+  bob #: ("12", aliceConn, "ACK 4") #> ("12", aliceConn, OK)
+  alice #: ("3", bobConn, "SEND :how are you?") #> ("3", bobConn, MID 5)
+  alice <# ("", bobConn, SENT 5)
   bob <#= \case ("", c, Msg "how are you?") -> c == aliceConn; _ -> False
-  bob #: ("13", aliceConn, "ACK 2") #> ("13", aliceConn, OK)
-  bob #: ("14", aliceConn, "SEND 9\nhello too") #> ("14", aliceConn, MID 3)
-  bob <# ("", aliceConn, SENT 3)
+  bob #: ("13", aliceConn, "ACK 5") #> ("13", aliceConn, OK)
+  bob #: ("14", aliceConn, "SEND 9\nhello too") #> ("14", aliceConn, MID 6)
+  bob <# ("", aliceConn, SENT 6)
   alice <#= \case ("", c, Msg "hello too") -> c == bobConn; _ -> False
-  alice #: ("3a", bobConn, "ACK 3") #> ("3a", bobConn, OK)
-  bob #: ("15", aliceConn, "SEND 9\nmessage 1") #> ("15", aliceConn, MID 4)
-  bob <# ("", aliceConn, SENT 4)
+  alice #: ("3a", bobConn, "ACK 6") #> ("3a", bobConn, OK)
+  bob #: ("15", aliceConn, "SEND 9\nmessage 1") #> ("15", aliceConn, MID 7)
+  bob <# ("", aliceConn, SENT 7)
   alice <#= \case ("", c, Msg "message 1") -> c == bobConn; _ -> False
-  alice #: ("4a", bobConn, "ACK 4") #> ("4a", bobConn, OK)
+  alice #: ("4a", bobConn, "ACK 7") #> ("4a", bobConn, OK)
   alice #: ("5", bobConn, "OFF") #> ("5", bobConn, OK)
-  bob #: ("17", aliceConn, "SEND 9\nmessage 3") #> ("17", aliceConn, MID 5)
-  bob <# ("", aliceConn, MERR 5 (SMP AUTH))
+  bob #: ("17", aliceConn, "SEND 9\nmessage 3") #> ("17", aliceConn, MID 8)
+  bob <# ("", aliceConn, MERR 8 (SMP AUTH))
   alice #: ("6", bobConn, "DEL") #> ("6", bobConn, OK)
   alice #:# "nothing else should be delivered to alice"
 
 testContactConnection :: Transport c => TProxy c -> c -> c -> c -> IO ()
 testContactConnection _ alice bob tom = do
   ("1", "alice_contact", Right (INV cReq)) <- alice #: ("1", "alice_contact", "NEW CON")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
 
   bob #: ("11", "alice", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice", OK)
   ("", "alice_contact", Right (REQ aInvId "bob's connInfo")) <- (alice <#:)
@@ -185,10 +196,10 @@ testContactConnection _ alice bob tom = do
   alice <# ("", "bob", INFO "bob's connInfo 2")
   alice <# ("", "bob", CON)
   bob <# ("", "alice", CON)
-  alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 1)
-  alice <# ("", "bob", SENT 1)
+  alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 4)
+  alice <# ("", "bob", SENT 4)
   bob <#= \case ("", "alice", Msg "hi") -> True; _ -> False
-  bob #: ("13", "alice", "ACK 1") #> ("13", "alice", OK)
+  bob #: ("13", "alice", "ACK 4") #> ("13", "alice", OK)
 
   tom #: ("21", "alice", "JOIN " <> cReq' <> " 14\ntom's connInfo") #> ("21", "alice", OK)
   ("", "alice_contact", Right (REQ aInvId' "tom's connInfo")) <- (alice <#:)
@@ -198,15 +209,15 @@ testContactConnection _ alice bob tom = do
   alice <# ("", "tom", INFO "tom's connInfo 2")
   alice <# ("", "tom", CON)
   tom <# ("", "alice", CON)
-  alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 1)
-  alice <# ("", "tom", SENT 1)
+  alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 4)
+  alice <# ("", "tom", SENT 4)
   tom <#= \case ("", "alice", Msg "hi there") -> True; _ -> False
-  tom #: ("23", "alice", "ACK 1") #> ("23", "alice", OK)
+  tom #: ("23", "alice", "ACK 4") #> ("23", "alice", OK)
 
 testContactConnRandomIds :: Transport c => TProxy c -> c -> c -> IO ()
 testContactConnRandomIds _ alice bob = do
   ("1", aliceContact, Right (INV cReq)) <- alice #: ("1", "", "NEW CON")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
 
   ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo")
   ("", aliceContact', Right (REQ aInvId "bob's connInfo")) <- (alice <#:)
@@ -221,15 +232,15 @@ testContactConnRandomIds _ alice bob = do
   alice <# ("", bobConn, CON)
   bob <# ("", aliceConn, CON)
 
-  alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 1)
-  alice <# ("", bobConn, SENT 1)
+  alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 4)
+  alice <# ("", bobConn, SENT 4)
   bob <#= \case ("", c, Msg "hi") -> c == aliceConn; _ -> False
-  bob #: ("13", aliceConn, "ACK 1") #> ("13", aliceConn, OK)
+  bob #: ("13", aliceConn, "ACK 4") #> ("13", aliceConn, OK)
 
 testRejectContactRequest :: Transport c => TProxy c -> c -> c -> IO ()
 testRejectContactRequest _ alice bob = do
   ("1", "a_contact", Right (INV cReq)) <- alice #: ("1", "a_contact", "NEW CON")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
   bob #: ("11", "alice", "JOIN " <> cReq' <> " 10\nbob's info") #> ("11", "alice", OK)
   ("", "a_contact", Right (REQ aInvId "bob's info")) <- (alice <#:)
   -- RJCT must use correct contact connection
@@ -241,20 +252,20 @@ testRejectContactRequest _ alice bob = do
 testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO ()
 testSubscription _ alice1 alice2 bob = do
   (alice1, "alice") `connect` (bob, "bob")
-  bob #: ("12", "alice", "SEND 5\nhello") #> ("12", "alice", MID 1)
-  bob <# ("", "alice", SENT 1)
+  bob #: ("12", "alice", "SEND 5\nhello") #> ("12", "alice", MID 4)
+  bob <# ("", "alice", SENT 4)
   alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False
-  alice1 #: ("1", "bob", "ACK 1") #> ("1", "bob", OK)
-  bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 2)
-  bob <# ("", "alice", SENT 2)
+  alice1 #: ("1", "bob", "ACK 4") #> ("1", "bob", OK)
+  bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 5)
+  bob <# ("", "alice", SENT 5)
   alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
-  alice1 #: ("2", "bob", "ACK 2") #> ("2", "bob", OK)
+  alice1 #: ("2", "bob", "ACK 5") #> ("2", "bob", OK)
   alice2 #: ("21", "bob", "SUB") #> ("21", "bob", OK)
   alice1 <# ("", "bob", END)
-  bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 3)
-  bob <# ("", "alice", SENT 3)
+  bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 6)
+  bob <# ("", "alice", SENT 6)
   alice2 <#= \case ("", "bob", Msg "hi") -> True; _ -> False
-  alice2 #: ("22", "bob", "ACK 3") #> ("22", "bob", OK)
+  alice2 #: ("22", "bob", "ACK 6") #> ("22", "bob", OK)
   alice1 #:# "nothing else should be delivered to alice1"
 
 testSubscrNotification :: Transport c => TProxy c -> (ThreadId, ThreadId) -> c -> IO ()
@@ -270,22 +281,22 @@ testMsgDeliveryServerRestart :: Transport c => TProxy c -> c -> c -> IO ()
 testMsgDeliveryServerRestart t alice bob = do
   withServer $ do
     connect (alice, "alice") (bob, "bob")
-    bob #: ("1", "alice", "SEND 2\nhi") #> ("1", "alice", MID 1)
-    bob <# ("", "alice", SENT 1)
+    bob #: ("1", "alice", "SEND 2\nhi") #> ("1", "alice", MID 4)
+    bob <# ("", "alice", SENT 4)
     alice <#= \case ("", "bob", Msg "hi") -> True; _ -> False
-    alice #: ("11", "bob", "ACK 1") #> ("11", "bob", OK)
+    alice #: ("11", "bob", "ACK 4") #> ("11", "bob", OK)
     alice #:# "nothing else delivered before the server is killed"
 
   alice <# ("", "bob", DOWN)
-  bob #: ("2", "alice", "SEND 11\nhello again") #> ("2", "alice", MID 2)
+  bob #: ("2", "alice", "SEND 11\nhello again") #> ("2", "alice", MID 5)
   bob #:# "nothing else delivered before the server is restarted"
   alice #:# "nothing else delivered before the server is restarted"
 
   withServer $ do
-    bob <# ("", "alice", SENT 2)
+    bob <# ("", "alice", SENT 5)
     alice <# ("", "bob", UP)
     alice <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
-    alice #: ("12", "bob", "ACK 2") #> ("12", "bob", OK)
+    alice #: ("12", "bob", "ACK 5") #> ("12", "bob", OK)
 
   removeFile testStoreLogFile
   where
@@ -296,14 +307,14 @@ testMsgDeliveryAgentRestart t bob = do
   withAgent $ \alice -> do
     withServer $ do
       connect (bob, "bob") (alice, "alice")
-      alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 1)
-      alice <# ("", "bob", SENT 1)
+      alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 4)
+      alice <# ("", "bob", SENT 4)
       bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
-      bob #: ("11", "alice", "ACK 1") #> ("11", "alice", OK)
+      bob #: ("11", "alice", "ACK 4") #> ("11", "alice", OK)
       bob #:# "nothing else delivered before the server is down"
 
     bob <# ("", "alice", DOWN)
-    alice #: ("2", "bob", "SEND 11\nhello again") #> ("2", "bob", MID 2)
+    alice #: ("2", "bob", "SEND 11\nhello again") #> ("2", "bob", MID 5)
     alice #:# "nothing else delivered before the server is restarted"
     bob #:# "nothing else delivered before the server is restarted"
 
@@ -313,22 +324,63 @@ testMsgDeliveryAgentRestart t bob = do
       alice <#= \case
         (corrId, "bob", cmd) ->
           (corrId == "3" && cmd == OK)
-            || (corrId == "" && cmd == SENT 2)
+            || (corrId == "" && cmd == SENT 5)
         _ -> False
       bob <# ("", "alice", UP)
       bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False
-      bob #: ("12", "alice", "ACK 2") #> ("12", "alice", OK)
+      bob #: ("12", "alice", "ACK 5") #> ("12", "alice", OK)
 
   removeFile testStoreLogFile
-  removeFile testDB
+  -- removeFile testDB
   where
     withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` ()
     withAgent = withSmpAgentThreadOn_ (ATransport t) (agentTestPort, testPort, testDB) (pure ()) . const . testSMPAgentClientOn agentTestPort
 
+testConcurrentMsgDelivery :: Transport c => TProxy c -> c -> c -> IO ()
+testConcurrentMsgDelivery _ alice bob = do
+  connect (alice, "alice") (bob, "bob")
+
+  ("1", "bob2", Right (INV cReq)) <- alice #: ("1", "bob2", "NEW INV")
+  let cReq' = strEncode cReq
+  bob #: ("11", "alice2", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice2", OK)
+  ("", "bob2", Right (CONF _confId "bob's connInfo")) <- (alice <#:)
+  -- below commands would be needed to accept bob's connection, but alice does not
+  -- alice #: ("2", "bob", "LET " <> _confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
+  -- bob <# ("", "alice", INFO "alice's connInfo")
+  -- bob <# ("", "alice", CON)
+  -- alice <# ("", "bob", CON)
+
+  -- the first connection should not be blocked by the second one
+  sendMessage (alice, "alice") (bob, "bob") "hello"
+  -- alice #: ("2", "bob", "SEND :hello") #> ("2", "bob", MID 1)
+  -- alice <# ("", "bob", SENT 1)
+  -- bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
+  -- bob #: ("12", "alice", "ACK 1") #> ("12", "alice", OK)
+  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 5)
+  bob <# ("", "alice", SENT 5)
+  -- if delivery is blocked it won't go further
+  alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
+  alice #: ("3", "bob", "ACK 5") #> ("3", "bob", OK)
+
+testMsgDeliveryQuotaExceeded :: Transport c => TProxy c -> c -> c -> IO ()
+testMsgDeliveryQuotaExceeded _ alice bob = do
+  connect (alice, "alice") (bob, "bob")
+  connect (alice, "alice2") (bob, "bob2")
+  forM_ [1 .. 4 :: Int] $ \i -> do
+    let corrId = bshow i
+        msg = "message " <> bshow i
+    (_, "bob", Right (MID mId)) <- alice #: (corrId, "bob", "SEND :" <> msg)
+    alice <#= \case ("", "bob", SENT m) -> m == mId; _ -> False
+  (_, "bob", Right (MID _)) <- alice #: ("5", "bob", "SEND :over quota")
+
+  alice #: ("1", "bob2", "SEND :hello") #> ("1", "bob2", MID 4)
+  -- if delivery is blocked it won't go further
+  alice <# ("", "bob2", SENT 4)
+
 connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO ()
 connect (h1, name1) (h2, name2) = do
   ("c1", _, Right (INV cReq)) <- h1 #: ("c1", name2, "NEW INV")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
   h2 #: ("c2", name1, "JOIN " <> cReq' <> " 5\ninfo2") #> ("c2", name1, OK)
   ("", _, Right (CONF connId "info2")) <- (h1 <#:)
   h1 #: ("c3", name2, "LET " <> connId <> " 5\ninfo1") #> ("c3", name2, OK)
@@ -336,10 +388,20 @@ connect (h1, name1) (h2, name2) = do
   h2 <# ("", name1, CON)
   h1 <# ("", name2, CON)
 
+sendMessage :: Transport c => (c, ConnId) -> (c, ConnId) -> ByteString -> IO ()
+sendMessage (h1, name1) (h2, name2) msg = do
+  ("m1", name2', Right (MID mId)) <- h1 #: ("m1", name2, "SEND :" <> msg)
+  name2' `shouldBe` name2
+  h1 <#= \case ("", n, SENT m) -> n == name2 && m == mId; _ -> False
+  ("", name1', Right (MSG MsgMeta {recipient = (msgId', _)} msg')) <- (h2 <#:)
+  name1' `shouldBe` name1
+  msg' `shouldBe` msg
+  h2 #: ("m2", name1, "ACK " <> bshow msgId') =#> \case ("m2", n, OK) -> n == name1; _ -> False
+
 -- connect' :: forall c. Transport c => c -> c -> IO (ByteString, ByteString)
 -- connect' h1 h2 = do
 --   ("c1", conn2, Right (INV cReq)) <- h1 #: ("c1", "", "NEW INV")
---   let cReq' = serializeConnReq cReq
+--   let cReq' = strEncode cReq
 --   ("c2", conn1, Right OK) <- h2 #: ("c2", "", "JOIN " <> cReq' <> " 5\ninfo2")
 --   ("", _, Right (REQ connId "info2")) <- (h1 <#:)
 --   h1 #: ("c3", conn2, "ACPT " <> connId <> " 5\ninfo1") =#> \case ("c3", c, OK) -> c == conn2; _ -> False
@@ -348,28 +410,36 @@ connect (h1, name1) (h2, name2) = do
 --   h1 <# ("", conn2, CON)
 --   pure (conn1, conn2)
 
-samplePublicKey :: ByteString
-samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj-toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP-Tm4sokaFDTIG3QJFzOjC-_9nW4MUjAOFll9PCp9kaEFHJ_YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju_f6kAayvYKW3_lbJNXCmyinAccBosO08_0sUxvtuniIo18kfYJE0UmP1ReCjhMP-O-yOmwZJini_QelJk_Pez8IIDDWnY1qYQsN_q7ocjakOYrpGG7mig6JMFpDJtD6istR"
+sampleDhKey :: ByteString
+sampleDhKey = "MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
 
 syntaxTests :: forall c. Transport c => TProxy c -> Spec
 syntaxTests t = do
   it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX")
-  describe "NEW" do
-    describe "valid" do
-      -- TODO: add tests with defined connection alias
+  describe "NEW" $ do
+    describe "valid" $ do
+      -- TODO: add tests with defined connection id
       it "with correct parameter" $ ("211", "", "NEW INV") >#>= \case ("211", _, "INV" : _) -> True; _ -> False
-    describe "invalid" do
-      -- TODO: add tests with defined connection alias
+    describe "invalid" $ do
+      -- TODO: add tests with defined connection id
       it "with incorrect parameter" $ ("222", "", "NEW hi") >#> ("222", "", "ERR CMD SYNTAX")
 
-  describe "JOIN" do
-    describe "valid" do
-      -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided)
-      -- TODO: add tests with defined connection alias
+  -- focus this test to test postgres
+  describe "JOIN" $ do
+    describe "valid" $ do
       it "using same server as in invitation" $
-        ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5000%2F1234-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH")
-    describe "invalid" do
-      -- TODO: JOIN is not merged yet - to be added
+        ( "311",
+          "a",
+          "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2F"
+            <> urlEncode True "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
+            <> "%40localhost%3A5001%2F3456-w%3D%3D%23"
+            <> urlEncode True sampleDhKey
+            <> "&v=1"
+            <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
+            <> " 14\nbob's connInfo"
+        )
+          >#> ("311", "a", "ERR SMP AUTH")
+    describe "invalid" $ do
       it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX")
   where
     -- simple test for one command with the expected response
@@ -378,4 +448,4 @@ syntaxTests t = do
 
     -- simple test for one command with a predicate for the expected response
     (>#>=) :: ARawTransmission -> ((ByteString, ByteString, [ByteString]) -> Bool) -> Expectation
-    command >#>= p = smpAgentTest t command >>= (`shouldSatisfy` p . \(cId, cAlias, cmd) -> (cId, cAlias, B.words cmd))
+    command >#>= p = smpAgentTest t command >>= (`shouldSatisfy` p . \(cId, connId, cmd) -> (cId, connId, B.words cmd))

tests/AgentTests/ConnectionRequestTests.hs

@@ -1,11 +1,18 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module AgentTests.ConnectionRequestTests where
 
+import Data.ByteString (ByteString)
+import Network.HTTP.Types (urlEncode)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Crypto.Ratchet
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (smpClientVRange)
+import Simplex.Messaging.Version
 import Test.Hspec
 
 uri :: String
@@ -15,54 +22,118 @@ srv :: SMPServer
 srv =
   SMPServer
     { host = "smp.simplex.im",
-      port = Just "5223",
-      keyHash = Just (C.KeyHash "\215m\248\251")
+      port = "5223",
+      keyHash = C.KeyHash "\215m\248\251"
     }
 
 queue :: SMPQueueUri
 queue =
   SMPQueueUri
     { smpServer = srv,
-      senderId = "\215m\248\251",
-      serverVerifyKey = reservedServerKey
+      senderId = "\223\142z\251",
+      clientVRange = smpClientVRange,
+      dhPublicKey = testDhKey
     }
 
-appServer :: ConnReqScheme
-appServer = CRSAppServer "simplex.chat" Nothing
+testDhKey :: C.PublicKeyX25519
+testDhKey = "MCowBQYDK2VuAyEAjiswwI3O/NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
 
-connectionRequest :: AConnectionRequest
+testDhKeyStr :: ByteString
+testDhKeyStr = strEncode testDhKey
+
+testDhKeyStrUri :: ByteString
+testDhKeyStrUri = urlEncode True testDhKeyStr
+
+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
+
+testE2ERatchetParams13 :: E2ERatchetParamsUri 'C.X448
+testE2ERatchetParams13 = E2ERatchetParamsUri (mkVersionRange 1 3) testDhPubKey testDhPubKey
+
+connectionRequest :: AConnectionRequestUri
 connectionRequest =
-  ACR SCMInvitation . CRInvitation $
-    ConnReqData
-      { crScheme = appServer,
-        crSmpQueues = [queue],
-        crEncryptKey = reservedServerKey
-      }
+  ACR SCMInvitation $
+    CRInvitationUri connReqData testE2ERatchetParams
+
+connectionRequest12 :: AConnectionRequestUri
+connectionRequest12 =
+  ACR SCMInvitation $
+    CRInvitationUri
+      connReqData {crAgentVRange = mkVersionRange 1 2, crSmpQueues = [queue, queue]}
+      testE2ERatchetParams13
 
 connectionRequestTests :: Spec
-connectionRequestTests = do
+connectionRequestTests =
   describe "connection request parsing / serializing" $ do
     it "should serialize SMP queue URIs" $ do
-      serializeSMPQueueUri queue {smpServer = srv {port = Nothing, keyHash = Nothing}}
-        `shouldBe` "smp://smp.simplex.im/1234-w==#"
-      serializeSMPQueueUri queue {smpServer = srv {keyHash = Nothing}}
-        `shouldBe` "smp://smp.simplex.im:5223/1234-w==#"
-      serializeSMPQueueUri queue {smpServer = srv {port = Nothing}}
-        `shouldBe` "smp://1234-w==@smp.simplex.im/1234-w==#"
-      serializeSMPQueueUri queue
-        `shouldBe` "smp://1234-w==@smp.simplex.im:5223/1234-w==#"
+      strEncode (queue :: SMPQueueUri) {smpServer = srv {port = ""}}
+        `shouldBe` "smp://1234-w==@smp.simplex.im/3456-w==#" <> testDhKeyStr
+      strEncode queue {clientVRange = mkVersionRange 1 2}
+        `shouldBe` "smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr
     it "should parse SMP queue URIs" $ do
-      parseAll smpQueueUriP "smp://smp.simplex.im/1234-w==#"
-        `shouldBe` Right queue {smpServer = srv {port = Nothing, keyHash = Nothing}}
-      parseAll smpQueueUriP "smp://smp.simplex.im:5223/1234-w==#"
-        `shouldBe` Right queue {smpServer = srv {keyHash = Nothing}}
-      parseAll smpQueueUriP "smp://1234-w==@smp.simplex.im/1234-w==#"
-        `shouldBe` Right queue {smpServer = srv {port = Nothing}}
-      parseAll smpQueueUriP "smp://1234-w==@smp.simplex.im:5223/1234-w==#"
+      strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1&dh=" <> testDhKeyStr)
+        `shouldBe` Right (queue :: SMPQueueUri) {smpServer = srv {port = ""}}
+      strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#" <> testDhKeyStr)
+        `shouldBe` Right (queue :: SMPQueueUri) {smpServer = srv {port = ""}}
+      strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr)
         `shouldBe` Right queue
+      strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1&extra_param=abc")
+        `shouldBe` Right queue
+      strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#/?extra_param=abc&v=1-2&dh=" <> testDhKeyStr)
+        `shouldBe` Right queue {clientVRange = mkVersionRange 1 2}
+      strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1-2&extra_param=abc")
+        `shouldBe` Right queue {clientVRange = mkVersionRange 1 2}
     it "should serialize connection requests" $ do
-      serializeConnReq connectionRequest
-        `shouldBe` "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D"
+      strEncode connectionRequest
+        `shouldBe` "https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
+        <> testDhKeyStrUri
+        <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
+      strEncode connectionRequest12
+        `shouldBe` "https://simplex.chat/invitation#/?v=1-2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
+        <> testDhKeyStrUri
+        <> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
+        <> testDhKeyStrUri
+        <> "&e2e=v%3D1-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
     it "should parse connection requests" $ do
-      parseAll connReqP "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D"
+      strDecode
+        ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
+            <> testDhKeyStrUri
+            <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
+            <> "&v=1"
+        )
         `shouldBe` Right connectionRequest
+      strDecode
+        ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
+            <> testDhKeyStrUri
+            <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
+            <> "&v=1"
+        )
+        `shouldBe` Right connectionRequest
+      strDecode
+        ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
+            <> testDhKeyStrUri
+            <> "&e2e=v%3D1-1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
+            <> "&v=1-1"
+        )
+        `shouldBe` Right connectionRequest
+      strDecode
+        ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26extra_param%3Dabc%26dh%3D"
+            <> testDhKeyStrUri
+            <> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
+            <> testDhKeyStrUri
+            <> "&e2e=extra_key%3Dnew%26v%3D1-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
+            <> "&some_new_param=abc"
+            <> "&v=1-2"
+        )
+        `shouldBe` Right connectionRequest12

tests/AgentTests/DoubleRatchetTests.hs

@@ -0,0 +1,232 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
+
+module AgentTests.DoubleRatchetTests where
+
+import Control.Concurrent.STM
+import Control.Monad.Except
+import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson as J
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.Map.Strict as M
+import Simplex.Messaging.Crypto (Algorithm (..), AlgorithmI, CryptoError, DhAlgorithm)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Ratchet
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Util ((<$$>))
+import Test.Hspec
+
+doubleRatchetTests :: Spec
+doubleRatchetTests = do
+  describe "double-ratchet encryption/decryption" $ do
+    it "should serialize and parse message header" testMessageHeader
+    it "should encrypt and decrypt messages" $ do
+      withRatchets @X25519 testEncryptDecrypt
+      withRatchets @X448 testEncryptDecrypt
+    it "should encrypt and decrypt skipped messages" $ do
+      withRatchets @X25519 testSkippedMessages
+      withRatchets @X448 testSkippedMessages
+    it "should encrypt and decrypt many messages" $ do
+      withRatchets @X25519 testManyMessages
+    it "should allow skipped after ratchet advance" $ do
+      withRatchets @X25519 testSkippedAfterRatchetAdvance
+    it "should encode/decode ratchet as JSON" $ do
+      testKeyJSON C.SX25519
+      testKeyJSON C.SX448
+      testRatchetJSON C.SX25519
+      testRatchetJSON C.SX448
+    it "should agree the same ratchet parameters" $ do
+      testX3dh C.SX25519
+      testX3dh C.SX448
+
+paddedMsgLen :: Int
+paddedMsgLen = 100
+
+fullMsgLen :: Int
+fullMsgLen = 1 + fullHeaderLen + C.authTagSize + paddedMsgLen
+
+testMessageHeader :: Expectation
+testMessageHeader = do
+  (k, _) <- C.generateKeyPair' @X25519
+  let hdr = MsgHeader {msgMaxVersion = e2eEncryptVersion, msgDHRs = k, msgPN = 0, msgNs = 0}
+  parseAll (smpP @(MsgHeader 'X25519)) (smpEncode hdr) `shouldBe` Right hdr
+
+pattern Decrypted :: ByteString -> Either CryptoError (Either CryptoError ByteString)
+pattern Decrypted msg <- Right (Right msg)
+
+type TestRatchets a = (AlgorithmI a, DhAlgorithm a) => TVar (Ratchet a, SkippedMsgKeys) -> TVar (Ratchet a, SkippedMsgKeys) -> IO ()
+
+testEncryptDecrypt :: TestRatchets a
+testEncryptDecrypt alice bob = do
+  (bob, "hello alice") #> alice
+  (alice, "hello bob") #> bob
+  Right b1 <- encrypt bob "how are you, alice?"
+  Right b2 <- encrypt bob "are you there?"
+  Right b3 <- encrypt bob "hey?"
+  Right a1 <- encrypt alice "how are you, bob?"
+  Right a2 <- encrypt alice "are you there?"
+  Right a3 <- encrypt alice "hey?"
+  Decrypted "how are you, alice?" <- decrypt alice b1
+  Decrypted "are you there?" <- decrypt alice b2
+  Decrypted "hey?" <- decrypt alice b3
+  Decrypted "how are you, bob?" <- decrypt bob a1
+  Decrypted "are you there?" <- decrypt bob a2
+  Decrypted "hey?" <- decrypt bob a3
+  (bob, "I'm here, all good") #> alice
+  (alice, "I'm here too, same") #> bob
+  pure ()
+
+testSkippedMessages :: TestRatchets a
+testSkippedMessages alice bob = do
+  Right msg1 <- encrypt bob "hello alice"
+  Right msg2 <- encrypt bob "hello there again"
+  Right msg3 <- encrypt bob "are you there?"
+  Decrypted "are you there?" <- decrypt alice msg3
+  Right (Left C.CERatchetDuplicateMessage) <- decrypt alice msg3
+  Decrypted "hello there again" <- decrypt alice msg2
+  Decrypted "hello alice" <- decrypt alice msg1
+  pure ()
+
+testManyMessages :: TestRatchets a
+testManyMessages alice bob = do
+  (bob, "b1") #> alice
+  (bob, "b2") #> alice
+  (bob, "b3") #> alice
+  (bob, "b4") #> alice
+  (alice, "a5") #> bob
+  (alice, "a6") #> bob
+  (alice, "a7") #> bob
+  (bob, "b8") #> alice
+  (alice, "a9") #> bob
+  (alice, "a10") #> bob
+  (bob, "b11") #> alice
+  (bob, "b12") #> alice
+  (alice, "a14") #> bob
+  (bob, "b15") #> alice
+  (bob, "b16") #> alice
+
+testSkippedAfterRatchetAdvance :: TestRatchets a
+testSkippedAfterRatchetAdvance alice bob = do
+  (bob, "b1") #> alice
+  Right b2 <- encrypt bob "b2"
+  Right b3 <- encrypt bob "b3"
+  Right b4 <- encrypt bob "b4"
+  (alice, "a5") #> bob
+  Right b5 <- encrypt bob "b5"
+  Right b6 <- encrypt bob "b6"
+  (bob, "b7") #> alice
+  Right b8 <- encrypt bob "b8"
+  Right b9 <- encrypt bob "b9"
+  (alice, "a10") #> bob
+  Right b11 <- encrypt bob "b11"
+  Right b12 <- encrypt bob "b12"
+  (alice, "a14") #> bob
+  Decrypted "b12" <- decrypt alice b12
+  Decrypted "b2" <- decrypt alice b2
+  -- fails on duplicate message
+  Left C.CERatchetHeader <- decrypt alice b2
+  (alice, "a15") #> bob
+  Right a16 <- encrypt bob "a16"
+  Right a17 <- encrypt bob "a17"
+  Decrypted "b8" <- decrypt alice b8
+  Decrypted "b3" <- decrypt alice b3
+  Decrypted "b4" <- decrypt alice b4
+  Decrypted "b5" <- decrypt alice b5
+  Decrypted "b6" <- decrypt alice b6
+  (alice, "a18") #> bob
+  Decrypted "a16" <- decrypt alice a16
+  Decrypted "a17" <- decrypt alice a17
+  Decrypted "b9" <- decrypt alice b9
+  Decrypted "b11" <- decrypt alice b11
+  pure ()
+
+testKeyJSON :: forall a. AlgorithmI a => C.SAlgorithm a -> IO ()
+testKeyJSON _ = do
+  (k, pk) <- C.generateKeyPair' @a
+  testEncodeDecode k
+  testEncodeDecode pk
+
+testRatchetJSON :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
+testRatchetJSON _ = do
+  (alice, bob) <- initRatchets @a
+  testEncodeDecode alice
+  testEncodeDecode bob
+
+testEncodeDecode :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Expectation
+testEncodeDecode x = do
+  let j = J.encode x
+      x' = J.eitherDecode' j
+  x' `shouldBe` Right x
+
+testX3dh :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
+testX3dh _ = do
+  (pkBob1, pkBob2, e2eBob) <- generateE2EParams @a e2eEncryptVersion
+  (pkAlice1, pkAlice2, e2eAlice) <- generateE2EParams @a e2eEncryptVersion
+  let paramsBob = x3dhSnd pkBob1 pkBob2 e2eAlice
+      paramsAlice = x3dhRcv pkAlice1 pkAlice2 e2eBob
+  paramsAlice `shouldBe` paramsBob
+
+(#>) :: (AlgorithmI a, DhAlgorithm a) => (TVar (Ratchet a, SkippedMsgKeys), ByteString) -> TVar (Ratchet a, SkippedMsgKeys) -> Expectation
+(alice, msg) #> bob = do
+  Right msg' <- encrypt alice msg
+  Decrypted msg'' <- decrypt bob msg'
+  msg'' `shouldBe` msg
+
+withRatchets :: forall a. (AlgorithmI a, DhAlgorithm a) => (TVar (Ratchet a, SkippedMsgKeys) -> TVar (Ratchet a, SkippedMsgKeys) -> IO ()) -> Expectation
+withRatchets test = do
+  (a, b) <- initRatchets @a
+  alice <- newTVarIO (a, M.empty)
+  bob <- newTVarIO (b, M.empty)
+  test alice bob `shouldReturn` ()
+
+initRatchets :: (AlgorithmI a, DhAlgorithm a) => IO (Ratchet a, Ratchet a)
+initRatchets = do
+  (pkBob1, pkBob2, e2eBob) <- generateE2EParams e2eEncryptVersion
+  (pkAlice1, pkAlice2, e2eAlice) <- generateE2EParams e2eEncryptVersion
+  let paramsBob = x3dhSnd pkBob1 pkBob2 e2eAlice
+      paramsAlice = x3dhRcv pkAlice1 pkAlice2 e2eBob
+  (_, pkBob3) <- C.generateKeyPair'
+  let bob = initSndRatchet (C.publicKey pkAlice2) pkBob3 paramsBob
+      alice = initRcvRatchet pkAlice2 paramsAlice
+  pure (alice, bob)
+
+encrypt_ :: AlgorithmI a => (Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (ByteString, Ratchet a, SkippedMsgDiff))
+encrypt_ (rc, _) msg =
+  runExceptT (rcEncrypt rc paddedMsgLen msg)
+    >>= either (pure . Left) checkLength
+  where
+    checkLength (msg', rc') = do
+      B.length msg' `shouldBe` fullMsgLen
+      pure $ Right (msg', rc', SMDNoChange)
+
+decrypt_ :: (AlgorithmI a, DhAlgorithm a) => (Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString, Ratchet a, SkippedMsgDiff))
+decrypt_ (rc, smks) msg = runExceptT $ rcDecrypt rc smks msg
+
+encrypt :: AlgorithmI a => TVar (Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError ByteString)
+encrypt = withTVar encrypt_
+
+decrypt :: (AlgorithmI a, DhAlgorithm a) => TVar (Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString))
+decrypt = withTVar decrypt_
+
+withTVar ::
+  AlgorithmI a =>
+  ((Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either e (r, Ratchet a, SkippedMsgDiff))) ->
+  TVar (Ratchet a, SkippedMsgKeys) ->
+  ByteString ->
+  IO (Either e r)
+withTVar op rcVar msg =
+  readTVarIO rcVar
+    >>= (\(rc, smks) -> applyDiff smks <$$> (testEncodeDecode rc >> op (rc, smks) msg))
+    >>= \case
+      Right (res, rc', smks') -> atomically (writeTVar rcVar (rc', smks')) >> pure (Right res)
+      Left e -> pure $ Left e
+  where
+    applyDiff smks (res, rc', smDiff) = (res, rc', applySMDiff smks smDiff)

tests/AgentTests/FunctionalAPITests.hs

@@ -12,7 +12,7 @@ import Control.Monad.IO.Unlift
 import SMPAgentClient
 import SMPClient (withSmpServer)
 import Simplex.Messaging.Agent
-import Simplex.Messaging.Agent.Env.SQLite (dbFile)
+import Simplex.Messaging.Agent.Env.Postgres (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..))
@@ -42,16 +42,15 @@ functionalAPITests t = do
       withSmpServer t testAsyncInitiatingOffline
     it "should connect with joining client going offline before its queue activation" $
       withSmpServer t testAsyncJoiningOfflineBeforeActivation
-    -- TODO a valid test case but not trivial to implement, probably requires some agent rework
-    xit "should connect with joining client going offline after its queue activation" $
-      withSmpServer t testAsyncJoiningOfflineAfterActivation
     it "should connect with both clients going offline" $
       withSmpServer t testAsyncBothOffline
+    it "should notify after HELLO timeout" $
+      withSmpServer t testAsyncHelloTimeout
 
 testAgentClient :: IO ()
 testAgentClient = do
   alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  bob <- getSMPAgentClient cfg {dbConnInfo = testDB2}
   Right () <- runExceptT $ do
     (bobId, qInfo) <- createConnection alice SCMInvitation
     aliceId <- joinConnection bob qInfo "bob's connInfo"
@@ -60,25 +59,26 @@ testAgentClient = do
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, INFO "alice's connInfo")
     get bob ##> ("", aliceId, CON)
-    1 <- sendMessage alice bobId "hello"
-    get alice ##> ("", bobId, SENT 1)
-    2 <- sendMessage alice bobId "how are you?"
-    get alice ##> ("", bobId, SENT 2)
+    -- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
+    4 <- sendMessage alice bobId "hello"
+    get alice ##> ("", bobId, SENT 4)
+    5 <- sendMessage alice bobId "how are you?"
+    get alice ##> ("", bobId, SENT 5)
     get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
-    ackMessage bob aliceId 1
+    ackMessage bob aliceId 4
     get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False
-    ackMessage bob aliceId 2
-    3 <- sendMessage bob aliceId "hello too"
-    get bob ##> ("", aliceId, SENT 3)
-    4 <- sendMessage bob aliceId "message 1"
-    get bob ##> ("", aliceId, SENT 4)
+    ackMessage bob aliceId 5
+    6 <- sendMessage bob aliceId "hello too"
+    get bob ##> ("", aliceId, SENT 6)
+    7 <- sendMessage bob aliceId "message 1"
+    get bob ##> ("", aliceId, SENT 7)
     get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
-    ackMessage alice bobId 3
+    ackMessage alice bobId 6
     get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False
-    ackMessage alice bobId 4
+    ackMessage alice bobId 7
     suspendConnection alice bobId
-    5 <- sendMessage bob aliceId "message 2"
-    get bob ##> ("", aliceId, MERR 5 (SMP AUTH))
+    8 <- sendMessage bob aliceId "message 2"
+    get bob ##> ("", aliceId, MERR 8 (SMP AUTH))
     deleteConnection alice bobId
     liftIO $ noMessages alice "nothing else should be delivered to alice"
   pure ()
@@ -94,7 +94,7 @@ testAgentClient = do
 testAsyncInitiatingOffline :: IO ()
 testAsyncInitiatingOffline = do
   alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  bob <- getSMPAgentClient cfg {dbConnInfo = testDB2}
   Right () <- runExceptT $ do
     (bobId, cReq) <- createConnection alice SCMInvitation
     disconnectAgentClient alice
@@ -112,14 +112,14 @@ testAsyncInitiatingOffline = do
 testAsyncJoiningOfflineBeforeActivation :: IO ()
 testAsyncJoiningOfflineBeforeActivation = do
   alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  bob <- getSMPAgentClient cfg {dbConnInfo = testDB2}
   Right () <- runExceptT $ do
     (bobId, qInfo) <- createConnection alice SCMInvitation
     aliceId <- joinConnection bob qInfo "bob's connInfo"
     disconnectAgentClient bob
     ("", _, CONF confId "bob's connInfo") <- get alice
     allowConnection alice bobId confId "alice's connInfo"
-    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
+    bob' <- liftIO $ getSMPAgentClient cfg {dbConnInfo = testDB2}
     subscribeConnection bob' aliceId
     get alice ##> ("", bobId, CON)
     get bob' ##> ("", aliceId, INFO "alice's connInfo")
@@ -127,13 +127,10 @@ testAsyncJoiningOfflineBeforeActivation = do
     exchangeGreetings alice bobId bob' aliceId
   pure ()
 
-testAsyncJoiningOfflineAfterActivation :: IO ()
-testAsyncJoiningOfflineAfterActivation = error "not implemented"
-
 testAsyncBothOffline :: IO ()
 testAsyncBothOffline = do
   alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  bob <- getSMPAgentClient cfg {dbConnInfo = testDB2}
   Right () <- runExceptT $ do
     (bobId, cReq) <- createConnection alice SCMInvitation
     disconnectAgentClient alice
@@ -143,7 +140,7 @@ testAsyncBothOffline = do
     subscribeConnection alice' bobId
     ("", _, CONF confId "bob's connInfo") <- get alice'
     allowConnection alice' bobId confId "alice's connInfo"
-    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
+    bob' <- liftIO $ getSMPAgentClient cfg {dbConnInfo = testDB2}
     subscribeConnection bob' aliceId
     get alice' ##> ("", bobId, CON)
     get bob' ##> ("", aliceId, INFO "alice's connInfo")
@@ -151,13 +148,24 @@ testAsyncBothOffline = do
     exchangeGreetings alice' bobId bob' aliceId
   pure ()
 
+testAsyncHelloTimeout :: IO ()
+testAsyncHelloTimeout = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbConnInfo = testDB2, helloTimeout = 1}
+  Right () <- runExceptT $ do
+    (_, cReq) <- createConnection alice SCMInvitation
+    disconnectAgentClient alice
+    aliceId <- joinConnection bob cReq "bob's connInfo"
+    get bob ##> ("", aliceId, ERR $ CONN NOT_ACCEPTED)
+  pure ()
+
 exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetings alice bobId bob aliceId = do
-  1 <- sendMessage alice bobId "hello"
-  get alice ##> ("", bobId, SENT 1)
+  4 <- sendMessage alice bobId "hello"
+  get alice ##> ("", bobId, SENT 4)
   get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
-  ackMessage bob aliceId 1
-  2 <- sendMessage bob aliceId "hello too"
-  get bob ##> ("", aliceId, SENT 2)
+  ackMessage bob aliceId 4
+  5 <- sendMessage bob aliceId "hello too"
+  get bob ##> ("", aliceId, SENT 5)
   get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
-  ackMessage alice bobId 2
+  ackMessage alice bobId 5

tests/AgentTests/PostgresTests.hs

@@ -0,0 +1,136 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module AgentTests.PostgresTests (postgresStoreTests) where
+
+import Control.Concurrent.Async (concurrently_)
+import Control.Concurrent.STM
+import Control.Monad (replicateM_)
+import Control.Monad.Except (ExceptT, runExceptT)
+import Crypto.Random (drgNew)
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Data.Time
+import Data.Word (Word32)
+import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
+import qualified Database.PostgreSQL.Simple as DB
+import SMPClient (testKeyHash)
+import Simplex.Messaging.Agent.Client ()
+import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.Store
+import Simplex.Messaging.Agent.Store.Postgres
+import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
+import qualified Simplex.Messaging.Crypto as C
+import System.Random
+import Test.Hspec
+import UnliftIO.Directory (removeFile)
+
+withStore :: SpecWith PostgresStore -> Spec
+withStore = before createStore
+
+createStore :: IO PostgresStore
+createStore = do
+  let dbConnInfo = defaultConnectInfo {connectDatabase = "agent_poc_1"}
+  createPostgresStore dbConnInfo 1 Migrations.app
+
+returnsResult :: (Eq a, Eq e, Show a, Show e) => ExceptT e IO a -> a -> Expectation
+action `returnsResult` r = runExceptT action `shouldReturn` Right r
+
+throwsError :: (Eq a, Eq e, Show a, Show e) => ExceptT e IO a -> e -> Expectation
+action `throwsError` e = runExceptT action `shouldReturn` Left e
+
+-- TODO add null port tests
+postgresStoreTests :: Spec
+postgresStoreTests = do
+  -- withStore2 $ do
+  --   describe "stress test" testConcurrentWrites
+  withStore $ do
+    -- describe "store setup" $ do
+    --   testCompiledThreadsafe
+    --   testForeignKeysEnabled
+    describe "store methods" $ do
+      describe "Queue and Connection management" $ do
+        -- describe "createRcvConn" $ do
+        --   testCreateRcvConn
+        --   testCreateRcvConnRandomId
+        --   testCreateRcvConnDuplicate
+        fdescribe "createSndConn" $ do
+          testCreateSndConn
+
+--     testCreateSndConnRandomID
+--     testCreateSndConnDuplicate
+--   describe "getRcvConn" testGetRcvConn
+--   describe "deleteConn" $ do
+--     testDeleteRcvConn
+--     testDeleteSndConn
+--     testDeleteDuplexConn
+--   describe "upgradeRcvConnToDuplex" $ do
+--     testUpgradeRcvConnToDuplex
+--   describe "upgradeSndConnToDuplex" $ do
+--     testUpgradeSndConnToDuplex
+--   describe "set Queue status" $ do
+--     describe "setRcvQueueStatus" $ do
+--       testSetRcvQueueStatus
+--     describe "setSndQueueStatus" $ do
+--       testSetSndQueueStatus
+--     testSetQueueStatusDuplex
+-- describe "Msg management" $ do
+--   describe "create Msg" $ do
+--     testCreateRcvMsg
+--     testCreateSndMsg
+--     testCreateRcvAndSndMsgs
+
+cData1 :: ConnData
+cData1 = ConnData {connId = "conn1"}
+
+testPrivateSignKey :: C.APrivateSignKey
+testPrivateSignKey = C.APrivateSignKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"
+
+testPrivDhKey :: C.PrivateKeyX25519
+testPrivDhKey = "MC4CAQAwBQYDK2VuBCIEINCzbVFaCiYHoYncxNY8tSIfn0pXcIAhLBfFc0m+gOpk"
+
+testDhSecret :: C.DhSecretX25519
+testDhSecret = "01234567890123456789012345678901"
+
+rcvQueue1 :: RcvQueue
+rcvQueue1 =
+  RcvQueue
+    { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
+      rcvId = "1234",
+      rcvPrivateKey = testPrivateSignKey,
+      rcvDhSecret = testDhSecret,
+      e2ePrivKey = testPrivDhKey,
+      e2eDhSecret = Nothing,
+      sndId = Just "2345",
+      status = New
+    }
+
+sndQueue1 :: SndQueue
+sndQueue1 =
+  SndQueue
+    { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
+      sndId = "3456",
+      sndPrivateKey = testPrivateSignKey,
+      e2eDhSecret = testDhSecret,
+      status = New
+    }
+
+testCreateSndConn :: SpecWith PostgresStore
+testCreateSndConn =
+  it "should create SndConnection and add RcvQueue" $ \store -> do
+    g <- newTVarIO =<< drgNew
+    createSndConn store g cData1 sndQueue1
+      `returnsResult` "conn1"
+    getConn store "conn1"
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 sndQueue1)
+
+-- upgradeSndConnToDuplex store "conn1" rcvQueue1
+--   `returnsResult` ()
+-- getConn store "conn1"
+--   `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)

tests/AgentTests/SQLiteTests.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -12,7 +12,6 @@ import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.STM
 import Control.Monad (replicateM_)
 import Control.Monad.Except (ExceptT, runExceptT)
-import qualified Crypto.PubKey.RSA as R
 import Crypto.Random (drgNew)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.Text as T
@@ -22,6 +21,7 @@ import Data.Word (Word32)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import SMPClient (testKeyHash)
+import Simplex.Messaging.Agent.Client ()
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
@@ -70,42 +70,39 @@ action `throwsError` e = runExceptT action `shouldReturn` Left e
 -- TODO add null port tests
 storeTests :: Spec
 storeTests = do
-  withStore2 do
+  withStore2 $ do
     describe "stress test" testConcurrentWrites
-  withStore do
-    describe "store setup" do
+  withStore $ do
+    describe "store setup" $ do
       testCompiledThreadsafe
       testForeignKeysEnabled
-    describe "store methods" do
-      describe "Queue and Connection management" do
-        describe "createRcvConn" do
+    describe "store methods" $ do
+      describe "Queue and Connection management" $ do
+        describe "createRcvConn" $ do
           testCreateRcvConn
           testCreateRcvConnRandomId
           testCreateRcvConnDuplicate
-        describe "createSndConn" do
+        describe "createSndConn" $ do
           testCreateSndConn
           testCreateSndConnRandomID
           testCreateSndConnDuplicate
-        describe "getAllConnIds" testGetAllConnIds
         describe "getRcvConn" testGetRcvConn
-        describe "deleteConn" do
+        describe "deleteConn" $ do
           testDeleteRcvConn
           testDeleteSndConn
           testDeleteDuplexConn
-        describe "upgradeRcvConnToDuplex" do
+        describe "upgradeRcvConnToDuplex" $ do
           testUpgradeRcvConnToDuplex
-        describe "upgradeSndConnToDuplex" do
+        describe "upgradeSndConnToDuplex" $ do
           testUpgradeSndConnToDuplex
-        describe "set Queue status" do
-          describe "setRcvQueueStatus" do
+        describe "set Queue status" $ do
+          describe "setRcvQueueStatus" $ do
             testSetRcvQueueStatus
-            testSetRcvQueueStatusNoQueue
-          describe "setSndQueueStatus" do
+          describe "setSndQueueStatus" $ do
             testSetSndQueueStatus
-            testSetSndQueueStatusNoQueue
           testSetQueueStatusDuplex
-      describe "Msg management" do
-        describe "create Msg" do
+      describe "Msg management" $ do
+        describe "create Msg" $ do
           testCreateRcvMsg
           testCreateSndMsg
           testCreateRcvAndSndMsgs
@@ -138,10 +135,10 @@ testForeignKeysEnabled =
   it "foreign keys should be enabled" . withStoreConnection $ \db -> do
     let inconsistentQuery =
           [sql|
-            INSERT INTO connections
-              (conn_alias, rcv_host, rcv_port, rcv_id, snd_host, snd_port, snd_id)
+            INSERT INTO snd_queues
+              ( host, port, snd_id, conn_id, snd_private_key, e2e_dh_secret, status)
             VALUES
-              ("conn1", "smp.simplex.im", "5223", "1234", "smp.simplex.im", "5223", "2345");
+              ('smp.simplex.im', '5223', '1234', '2345', x'', x'', 'new');
           |]
     DB.execute_ db inconsistentQuery
       `shouldThrow` (\e -> DB.sqlError e == DB.ErrorConstraint)
@@ -149,26 +146,35 @@ testForeignKeysEnabled =
 cData1 :: ConnData
 cData1 = ConnData {connId = "conn1"}
 
+testPrivateSignKey :: C.APrivateSignKey
+testPrivateSignKey = C.APrivateSignKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"
+
+testPrivDhKey :: C.PrivateKeyX25519
+testPrivDhKey = "MC4CAQAwBQYDK2VuBCIEINCzbVFaCiYHoYncxNY8tSIfn0pXcIAhLBfFc0m+gOpk"
+
+testDhSecret :: C.DhSecretX25519
+testDhSecret = "01234567890123456789012345678901"
+
 rcvQueue1 :: RcvQueue
 rcvQueue1 =
   RcvQueue
-    { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
+    { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
       rcvId = "1234",
-      rcvPrivateKey = C.safePrivateKey (1, 2, 3),
+      rcvPrivateKey = testPrivateSignKey,
+      rcvDhSecret = testDhSecret,
+      e2ePrivKey = testPrivDhKey,
+      e2eDhSecret = Nothing,
       sndId = Just "2345",
-      decryptKey = C.safePrivateKey (1, 2, 3),
-      verifyKey = Nothing,
       status = New
     }
 
 sndQueue1 :: SndQueue
 sndQueue1 =
   SndQueue
-    { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
+    { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
       sndId = "3456",
-      sndPrivateKey = C.safePrivateKey (1, 2, 3),
-      encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
-      signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
+      sndPrivateKey = testPrivateSignKey,
+      e2eDhSecret = testDhSecret,
       status = New
     }
 
@@ -238,19 +244,10 @@ testCreateSndConnDuplicate =
     createSndConn store g cData1 sndQueue1
       `throwsError` SEConnDuplicate
 
-testGetAllConnIds :: SpecWith SQLiteStore
-testGetAllConnIds =
-  it "should get all conn aliases" $ \store -> do
-    g <- newTVarIO =<< drgNew
-    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
-    _ <- runExceptT $ createSndConn store g cData1 {connId = "conn2"} sndQueue1
-    getAllConnIds store
-      `returnsResult` ["conn1" :: ConnId, "conn2" :: ConnId]
-
 testGetRcvConn :: SpecWith SQLiteStore
 testGetRcvConn =
   it "should get connection using rcv queue id and server" $ \store -> do
-    let smpServer = SMPServer "smp.simplex.im" (Just "5223") testKeyHash
+    let smpServer = SMPServer "smp.simplex.im" "5223" testKeyHash
     let recipientId = "1234"
     g <- newTVarIO =<< drgNew
     _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
@@ -304,11 +301,10 @@ testUpgradeRcvConnToDuplex =
     _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     let anotherSndQueue =
           SndQueue
-            { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
+            { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
               sndId = "2345",
-              sndPrivateKey = C.safePrivateKey (1, 2, 3),
-              encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
-              signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
+              sndPrivateKey = testPrivateSignKey,
+              e2eDhSecret = testDhSecret,
               status = New
             }
     upgradeRcvConnToDuplex store "conn1" anotherSndQueue
@@ -324,12 +320,13 @@ testUpgradeSndConnToDuplex =
     _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
     let anotherRcvQueue =
           RcvQueue
-            { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
+            { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
               rcvId = "3456",
-              rcvPrivateKey = C.safePrivateKey (1, 2, 3),
+              rcvPrivateKey = testPrivateSignKey,
+              rcvDhSecret = testDhSecret,
+              e2ePrivKey = testPrivDhKey,
+              e2eDhSecret = Nothing,
               sndId = Just "4567",
-              decryptKey = C.safePrivateKey (1, 2, 3),
-              verifyKey = Nothing,
               status = New
             }
     upgradeSndConnToDuplex store "conn1" anotherRcvQueue
@@ -379,18 +376,6 @@ testSetQueueStatusDuplex =
     getConn store "conn1"
       `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 {status = Secured} sndQueue1 {status = Confirmed})
 
-testSetRcvQueueStatusNoQueue :: SpecWith SQLiteStore
-testSetRcvQueueStatusNoQueue =
-  xit "should throw error on attempt to update status of non-existent RcvQueue" $ \store -> do
-    setRcvQueueStatus store rcvQueue1 Confirmed
-      `throwsError` SEConnNotFound
-
-testSetSndQueueStatusNoQueue :: SpecWith SQLiteStore
-testSetSndQueueStatusNoQueue =
-  xit "should throw error on attempt to update status of non-existent SndQueue" $ \store -> do
-    setSndQueueStatus store sndQueue1 Confirmed
-      `throwsError` SEConnNotFound
-
 hw :: ByteString
 hw = encodeUtf8 "Hello world!"
 
@@ -405,16 +390,17 @@ mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
         MsgMeta
           { integrity = MsgOk,
             recipient = (unId internalId, ts),
-            sender = (externalSndId, ts),
+            sndMsgId = externalSndId,
             broker = (brokerId, ts)
           },
+      msgType = A_MSG_,
       msgBody = hw,
       internalHash,
       externalPrevSndHash = "hash_from_sender"
     }
 
-testCreateRcvMsg' :: SQLiteStore -> PrevExternalSndId -> PrevRcvMsgHash -> ConnId -> RcvMsgData -> Expectation
-testCreateRcvMsg' st expectedPrevSndId expectedPrevHash connId rcvMsgData@RcvMsgData {..} = do
+testCreateRcvMsg_ :: SQLiteStore -> PrevExternalSndId -> PrevRcvMsgHash -> ConnId -> RcvMsgData -> Expectation
+testCreateRcvMsg_ st expectedPrevSndId expectedPrevHash connId rcvMsgData@RcvMsgData {..} = do
   let MsgMeta {recipient = (internalId, _)} = msgMeta
   updateRcvIds st connId
     `returnsResult` (InternalId internalId, internalRcvId, expectedPrevSndId, expectedPrevHash)
@@ -427,9 +413,8 @@ testCreateRcvMsg =
     g <- newTVarIO =<< drgNew
     let ConnData {connId} = cData1
     _ <- runExceptT $ createRcvConn st g cData1 rcvQueue1 SCMInvitation
-    -- TODO getMsg to check message
-    testCreateRcvMsg' st 0 "" connId $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "hash_dummy"
-    testCreateRcvMsg' st 1 "hash_dummy" connId $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "new_hash_dummy"
+    testCreateRcvMsg_ st 0 "" connId $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "hash_dummy"
+    testCreateRcvMsg_ st 1 "hash_dummy" connId $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "new_hash_dummy"
 
 mkSndMsgData :: InternalId -> InternalSndId -> MsgHash -> SndMsgData
 mkSndMsgData internalId internalSndId internalHash =
@@ -437,13 +422,14 @@ mkSndMsgData internalId internalSndId internalHash =
     { internalId,
       internalSndId,
       internalTs = ts,
+      msgType = A_MSG_,
       msgBody = hw,
       internalHash,
-      previousMsgHash = internalHash
+      prevMsgHash = internalHash
     }
 
-testCreateSndMsg' :: SQLiteStore -> PrevSndMsgHash -> ConnId -> SndMsgData -> Expectation
-testCreateSndMsg' store expectedPrevHash connId sndMsgData@SndMsgData {..} = do
+testCreateSndMsg_ :: SQLiteStore -> PrevSndMsgHash -> ConnId -> SndMsgData -> Expectation
+testCreateSndMsg_ store expectedPrevHash connId sndMsgData@SndMsgData {..} = do
   updateSndIds store connId
     `returnsResult` (internalId, internalSndId, expectedPrevHash)
   createSndMsg store connId sndMsgData
@@ -455,9 +441,8 @@ testCreateSndMsg =
     g <- newTVarIO =<< drgNew
     let ConnData {connId} = cData1
     _ <- runExceptT $ createSndConn store g cData1 sndQueue1
-    -- TODO getMsg to check message
-    testCreateSndMsg' store "" connId $ mkSndMsgData (InternalId 1) (InternalSndId 1) "hash_dummy"
-    testCreateSndMsg' store "hash_dummy" connId $ mkSndMsgData (InternalId 2) (InternalSndId 2) "new_hash_dummy"
+    testCreateSndMsg_ store "" connId $ mkSndMsgData (InternalId 1) (InternalSndId 1) "hash_dummy"
+    testCreateSndMsg_ store "hash_dummy" connId $ mkSndMsgData (InternalId 2) (InternalSndId 2) "new_hash_dummy"
 
 testCreateRcvAndSndMsgs :: SpecWith SQLiteStore
 testCreateRcvAndSndMsgs =
@@ -466,9 +451,9 @@ testCreateRcvAndSndMsgs =
     let ConnData {connId} = cData1
     _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
     _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
-    testCreateRcvMsg' store 0 "" connId $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "rcv_hash_1"
-    testCreateRcvMsg' store 1 "rcv_hash_1" connId $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "rcv_hash_2"
-    testCreateSndMsg' store "" connId $ mkSndMsgData (InternalId 3) (InternalSndId 1) "snd_hash_1"
-    testCreateRcvMsg' store 2 "rcv_hash_2" connId $ mkRcvMsgData (InternalId 4) (InternalRcvId 3) 3 "3" "rcv_hash_3"
-    testCreateSndMsg' store "snd_hash_1" connId $ mkSndMsgData (InternalId 5) (InternalSndId 2) "snd_hash_2"
-    testCreateSndMsg' store "snd_hash_2" connId $ mkSndMsgData (InternalId 6) (InternalSndId 3) "snd_hash_3"
+    testCreateRcvMsg_ store 0 "" connId $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "rcv_hash_1"
+    testCreateRcvMsg_ store 1 "rcv_hash_1" connId $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "rcv_hash_2"
+    testCreateSndMsg_ store "" connId $ mkSndMsgData (InternalId 3) (InternalSndId 1) "snd_hash_1"
+    testCreateRcvMsg_ store 2 "rcv_hash_2" connId $ mkRcvMsgData (InternalId 4) (InternalRcvId 3) 3 "3" "rcv_hash_3"
+    testCreateSndMsg_ store "snd_hash_1" connId $ mkSndMsgData (InternalId 5) (InternalSndId 2) "snd_hash_2"
+    testCreateSndMsg_ store "snd_hash_2" connId $ mkSndMsgData (InternalId 6) (InternalSndId 3) "snd_hash_3"

tests/CoreTests/EncodingTests.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module CoreTests.EncodingTests where
+
+import Data.Bits (shiftR)
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.ByteString.Internal (w2c)
+import Data.Int (Int64)
+import Data.Time.Clock.System (SystemTime (..), getSystemTime, utcToSystemTime)
+import Data.Time.ISO8601 (parseISO8601)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Parsers (parseAll)
+import Test.Hspec
+import Test.Hspec.QuickCheck (modifyMaxSuccess)
+import Test.QuickCheck
+
+int64 :: Int64
+int64 = 1234567890123456789
+
+s64 :: ByteString
+s64 = B.pack $ map (w2c . fromIntegral . (int64 `shiftR`)) [56, 48, 40, 32, 24, 16, 8, 0]
+
+encodingTests :: Spec
+encodingTests = modifyMaxSuccess (const 1000) $ do
+  describe "Encoding Int64" $ do
+    it "should encode and decode Int64 example" $ do
+      s64 `shouldBe` "\17\34\16\244\125\233\129\21"
+      smpEncode int64 `shouldBe` s64
+      parseAll smpP s64 `shouldBe` Right int64
+    it "parse(encode(Int64) should equal the same Int64" . property $
+      \i -> parseAll smpP (smpEncode i) == Right (i :: Int64)
+  describe "Encoding SystemTime" $ do
+    it "should encode and decode SystemTime" $ do
+      t <- getSystemTime
+      testSystemTime t
+      Just t' <- pure $ utcToSystemTime <$> parseISO8601 "2022-01-01T10:24:05.000Z"
+      systemSeconds t' `shouldBe` 1641032645
+      testSystemTime t'
+    it "parse(encode(SystemTime) should equal the same Int64" . property $
+      \i -> parseAll smpP (smpEncode i) == Right (i :: Int64)
+  where
+    testSystemTime :: SystemTime -> Expectation
+    testSystemTime t = do
+      smpEncode t `shouldBe` smpEncode (systemSeconds t)
+      parseAll smpP (smpEncode t) `shouldBe` Right t {systemNanoseconds = 0}

tests/CoreTests/ProtocolErrorTests.hs

@@ -1,8 +1,9 @@
-module ProtocolErrorTests where
+module CoreTests.ProtocolErrorTests where
 
-import Simplex.Messaging.Agent.Protocol (AgentErrorType, agentErrorTypeP, serializeAgentError)
+import Simplex.Messaging.Agent.Protocol (AgentErrorType)
 import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Protocol (ErrorType, errorTypeP, serializeErrorType)
+import Simplex.Messaging.Protocol (ErrorType)
+import Simplex.Messaging.Encoding.String
 import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck
@@ -11,8 +12,8 @@ protocolErrorTests :: Spec
 protocolErrorTests = modifyMaxSuccess (const 1000) $ do
   describe "errors parsing / serializing" $ do
     it "should parse SMP protocol errors" . property $ \err ->
-      parseAll errorTypeP (serializeErrorType err)
+      parseAll strP (strEncode err)
         == Right (err :: ErrorType)
     it "should parse SMP agent errors" . property $ \err ->
-      parseAll agentErrorTypeP (serializeAgentError err)
+      parseAll strP (strEncode err)
         == Right (err :: AgentErrorType)

tests/CoreTests/VersionRangeTests.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module CoreTests.VersionRangeTests where
+
+import GHC.Generics (Generic)
+import Generic.Random (genericArbitraryU)
+import Simplex.Messaging.Version
+import Test.Hspec
+import Test.Hspec.QuickCheck (modifyMaxSuccess)
+import Test.QuickCheck
+
+data V = V1 | V2 | V3 | V4 | V5 deriving (Eq, Enum, Ord, Generic, Show)
+
+instance Arbitrary V where arbitrary = genericArbitraryU
+
+versionRangeTests :: Spec
+versionRangeTests = modifyMaxSuccess (const 1000) $ do
+  describe "VersionRange construction" $ do
+    it "should fail on invalid range" $ do
+      vr 1 1 `shouldBe` vr 1 1
+      vr 1 2 `shouldBe` vr 1 2
+      (pure $! vr 2 1) `shouldThrow` anyErrorCall
+  describe "compatible version" $ do
+    it "should choose mutually compatible max version" $ do
+      (vr 1 1, vr 1 1) `compatible` Just 1
+      (vr 1 1, vr 1 2) `compatible` Just 1
+      (vr 1 2, vr 1 2) `compatible` Just 2
+      (vr 1 2, vr 2 3) `compatible` Just 2
+      (vr 1 3, vr 2 3) `compatible` Just 3
+      (vr 1 3, vr 2 4) `compatible` Just 3
+      (vr 1 2, vr 3 4) `compatible` Nothing
+    it "should check if version is compatible" $ do
+      isCompatible (1 :: Version) (vr 1 2) `shouldBe` True
+      isCompatible (2 :: Version) (vr 1 2) `shouldBe` True
+      isCompatible (2 :: Version) (vr 1 1) `shouldBe` False
+      isCompatible (1 :: Version) (vr 2 2) `shouldBe` False
+    it "compatibleVersion should pass isCompatible check" . property $
+      \((min1, max1) :: (V, V)) ((min2, max2) :: (V, V)) ->
+        min1 > max1 || min2 > max2 -- one of ranges is invalid, skip testing it
+          || let w = fromIntegral . fromEnum
+                 vr1 = mkVersionRange (w min1) (w max1) :: VersionRange
+                 vr2 = mkVersionRange (w min2) (w max2) :: VersionRange
+              in case compatibleVersion vr1 vr2 of
+                   Just (Compatible v) -> v `isCompatible` vr1 && v `isCompatible` vr2
+                   _ -> True
+  where
+    vr = mkVersionRange
+    compatible :: (VersionRange, VersionRange) -> Maybe Version -> Expectation
+    (vr1, vr2) `compatible` v = do
+      (vr1, vr2) `checkCompatible` v
+      (vr2, vr1) `checkCompatible` v
+    (vr1, vr2) `checkCompatible` v =
+      case compatibleVersion vr1 vr2 of
+        Just (Compatible v') -> Just v' `shouldBe` v
+        Nothing -> Nothing `shouldBe` v

tests/SMPAgentClient.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -11,6 +10,7 @@ import Control.Monad.IO.Unlift
 import Crypto.Random
 import qualified Data.ByteString.Char8 as B
 import qualified Data.List.NonEmpty as L
+import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
 import Network.Socket (HostName, ServiceName)
 import SMPClient
   ( serverBracket,
@@ -21,12 +21,13 @@ import SMPClient
     withSmpServerOn,
     withSmpServerThreadOn,
   )
-import Simplex.Messaging.Agent (runSMPAgentBlocking)
-import Simplex.Messaging.Agent.Env.SQLite
+import Simplex.Messaging.Agent.Env.Postgres
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Agent.Server (runSMPAgentBlocking)
 import Simplex.Messaging.Client (SMPClientConfig (..), smpDefaultConfig)
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.Client
 import Test.Hspec
 import UnliftIO.Concurrent
 import UnliftIO.Directory
@@ -43,14 +44,23 @@ agentTestPort2 = "5011"
 agentTestPort3 :: ServiceName
 agentTestPort3 = "5012"
 
-testDB :: String
-testDB = "tests/tmp/smp-agent.test.protocol.db"
+-- testDB :: String
+-- testDB = "tests/tmp/smp-agent.test.protocol.db"
 
-testDB2 :: String
-testDB2 = "tests/tmp/smp-agent2.test.protocol.db"
+testDB :: ConnectInfo
+testDB = defaultConnectInfo {connectDatabase = "agent_poc_1"}
 
-testDB3 :: String
-testDB3 = "tests/tmp/smp-agent3.test.protocol.db"
+-- testDB2 :: String
+-- testDB2 = "tests/tmp/smp-agent2.test.protocol.db"
+
+testDB2 :: ConnectInfo
+testDB2 = defaultConnectInfo {connectDatabase = "agent_poc_2"}
+
+-- testDB3 :: String
+-- testDB3 = "tests/tmp/smp-agent3.test.protocol.db"
+
+testDB3 :: ConnectInfo
+testDB3 = defaultConnectInfo {connectDatabase = "agent_poc_3"}
 
 smpAgentTest :: forall c. Transport c => TProxy c -> ARawTransmission -> IO ARawTransmission
 smpAgentTest _ cmd = runSmpAgentTest $ \(h :: c) -> tPutRaw h cmd >> tGetRaw h
@@ -71,10 +81,10 @@ runSmpAgentServerTest test =
 smpAgentServerTest :: Transport c => ((ThreadId, ThreadId) -> c -> IO ()) -> Expectation
 smpAgentServerTest test' = runSmpAgentServerTest test' `shouldReturn` ()
 
-runSmpAgentTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => [(ServiceName, ServiceName, String)] -> ([c] -> m a) -> m a
+runSmpAgentTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => [(ServiceName, ServiceName, ConnectInfo)] -> ([c] -> m a) -> m a
 runSmpAgentTestN agents test = withSmpServer t $ run agents []
   where
-    run :: [(ServiceName, ServiceName, String)] -> [c] -> m a
+    run :: [(ServiceName, ServiceName, ConnectInfo)] -> [c] -> m a
     run [] hs = test hs
     run (a@(p, _, _) : as) hs = withSmpAgentOn t a $ testSMPAgentClientOn p $ \h -> run as (h : hs)
     t = transport @c
@@ -87,7 +97,7 @@ runSmpAgentTestN_1 nClients test = withSmpServer t . withSmpAgent t $ run nClien
     run n hs = testSMPAgentClient $ \h -> run (n - 1) (h : hs)
     t = transport @c
 
-smpAgentTestN :: Transport c => [(ServiceName, ServiceName, String)] -> ([c] -> IO ()) -> Expectation
+smpAgentTestN :: Transport c => [(ServiceName, ServiceName, ConnectInfo)] -> ([c] -> IO ()) -> Expectation
 smpAgentTestN agents test' = runSmpAgentTestN agents test' `shouldReturn` ()
 
 smpAgentTestN_1 :: Transport c => Int -> ([c] -> IO ()) -> Expectation
@@ -157,29 +167,32 @@ cfg :: AgentConfig
 cfg =
   defaultAgentConfig
     { tcpPort = agentTestPort,
-      smpServers = L.fromList ["localhost:5000#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="],
+      smpServers = L.fromList ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
       tbqSize = 1,
-      dbFile = testDB,
+      dbConnInfo = testDB,
       smpCfg =
         smpDefaultConfig
           { qSize = 1,
-            defaultTransport = (testPort, transport @TCP),
+            defaultTransport = (testPort, transport @TLS),
             tcpTimeout = 500_000
           },
-      retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50_000}
+      reconnectInterval = (reconnectInterval defaultAgentConfig) {initialInterval = 50_000},
+      caCertificateFile = "tests/fixtures/ca.crt",
+      privateKeyFile = "tests/fixtures/server.key",
+      certificateFile = "tests/fixtures/server.crt"
     }
 
-withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a
+withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, ConnectInfo) -> m () -> (ThreadId -> m a) -> m a
 withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
-  let cfg' = cfg {tcpPort = port', dbFile = db', smpServers = L.fromList [SMPServer "localhost" (Just smpPort') testKeyHash]}
+  let cfg' = cfg {tcpPort = port', dbConnInfo = db', smpServers = L.fromList [SMPServer "localhost" smpPort' testKeyHash]}
    in serverBracket
         (\started -> runSMPAgentBlocking t started cfg')
         afterProcess
 
-withSmpAgentThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> (ThreadId -> m a) -> m a
-withSmpAgentThreadOn t a@(_, _, db') = withSmpAgentThreadOn_ t a $ removeFile db'
+withSmpAgentThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, ConnectInfo) -> (ThreadId -> m a) -> m a
+withSmpAgentThreadOn t a@(_, _, db') = withSmpAgentThreadOn_ t a $ pure () -- $ removeFile db'
 
-withSmpAgentOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m a -> m a
+withSmpAgentOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, ConnectInfo) -> m a -> m a
 withSmpAgentOn t (port', smpPort', db') = withSmpAgentThreadOn t (port', smpPort', db') . const
 
 withSmpAgent :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
@@ -187,11 +200,12 @@ withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB)
 
 testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m a) -> m a
 testSMPAgentClientOn port' client = do
-  runTransportClient agentTestHost port' $ \h -> do
+  runTransportClient agentTestHost port' testKeyHash $ \h -> do
     line <- liftIO $ getLn h
-    if line == "Welcome to SMP agent v" <> currentSMPVersionStr
+    if line == "Welcome to SMP agent v" <> B.pack simplexMQVersion
       then client h
-      else error $ "wrong welcome message: " <> B.unpack line
+      else do
+        error $ "wrong welcome message: " <> B.unpack line
 
 testSMPAgentClient :: (Transport c, MonadUnliftIO m) => (c -> m a) -> m a
 testSMPAgentClient = testSMPAgentClientOn agentTestPort

tests/SMPClient.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -8,19 +9,19 @@
 
 module SMPClient where
 
-import Control.Monad (void)
 import Control.Monad.Except (runExceptT)
 import Control.Monad.IO.Unlift
 import Crypto.Random
-import Data.ByteString.Base64 (encode)
-import qualified Data.ByteString.Char8 as B
+import Data.ByteString.Char8 (ByteString)
 import Network.Socket
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server (runSMPServerBlocking)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (openReadStoreLog)
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.Client
 import Test.Hspec
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
@@ -31,27 +32,21 @@ testHost :: HostName
 testHost = "localhost"
 
 testPort :: ServiceName
-testPort = "5000"
+testPort = "5001"
 
 testPort2 :: ServiceName
-testPort2 = "5001"
+testPort2 = "5002"
 
-testKeyHashStr :: B.ByteString
-testKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
-
-testBlockSize :: Maybe Int
-testBlockSize = Just 8192
-
-testKeyHash :: Maybe C.KeyHash
-testKeyHash = Just "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
+testKeyHash :: C.KeyHash
+testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
 
 testStoreLogFile :: FilePath
 testStoreLogFile = "tests/tmp/smp-server-store.log"
 
 testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testSMPClient client =
-  runTransportClient testHost testPort $ \h ->
-    liftIO (runExceptT $ clientHandshake h testBlockSize testKeyHash) >>= \case
+  runTransportClient testHost testPort testKeyHash $ \h ->
+    liftIO (runExceptT $ clientHandshake h testKeyHash) >>= \case
       Right th -> client th
       Left e -> error $ show e
 
@@ -62,54 +57,26 @@ cfg =
       tbqSize = 1,
       serverTbqSize = 1,
       msgQueueQuota = 4,
-      queueIdBytes = 12,
-      msgIdBytes = 6,
+      queueIdBytes = 24,
+      msgIdBytes = 24,
       storeLog = Nothing,
-      blockSize = 8192,
-      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/ca.crt",
+      privateKeyFile = "tests/fixtures/server.key",
+      certificateFile = "tests/fixtures/server.crt"
     }
 
 withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerStoreLogOn t port client = do
+withSmpServerStoreLogOn t port' client = do
   s <- liftIO $ openReadStoreLog testStoreLogFile
   serverBracket
-    (\started -> runSMPServerBlocking started cfg {transports = [(port, t)], storeLog = Just s})
+    (\started -> runSMPServerBlocking started cfg {transports = [(port', t)], storeLog = Just s})
     (pure ())
     client
 
 withSmpServerThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerThreadOn t port =
+withSmpServerThreadOn t port' =
   serverBracket
-    (\started -> runSMPServerBlocking started cfg {transports = [(port, t)]})
+    (\started -> runSMPServerBlocking started cfg {transports = [(port', t)]})
     (pure ())
 
 serverBracket :: MonadUnliftIO m => (TMVar Bool -> m ()) -> m () -> (ThreadId -> m a) -> m a
@@ -126,7 +93,7 @@ serverBracket process afterProcess f = do
         _ -> pure ()
 
 withSmpServerOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> m a -> m a
-withSmpServerOn t port = withSmpServerThreadOn t port . const
+withSmpServerOn t port' = withSmpServerThreadOn t port' . const
 
 withSmpServer :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
 withSmpServer t = withSmpServerOn t testPort
@@ -141,8 +108,21 @@ runSmpTestN nClients test = withSmpServer (transport @c) $ run nClients []
     run 0 hs = test hs
     run n hs = testSMPClient $ \h -> run (n - 1) (h : hs)
 
-smpServerTest :: forall c. Transport c => TProxy c -> RawTransmission -> IO RawTransmission
-smpServerTest _ cmd = runSmpTest $ \(h :: THandle c) -> tPutRaw h cmd >> tGetRaw h
+smpServerTest ::
+  forall c smp.
+  (Transport c, Encoding smp) =>
+  TProxy c ->
+  (Maybe C.ASignature, ByteString, ByteString, smp) ->
+  IO (Maybe C.ASignature, ByteString, ByteString, BrokerMsg)
+smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
+  where
+    tPut' h (sig, corrId, queueId, smp) = do
+      let t' = smpEncode (sessionId (h :: THandle c), corrId, queueId, smp)
+      Right () <- tPut h (sig, t')
+      pure ()
+    tGet' h = do
+      (Nothing, _, (CorrId corrId, qId, Right cmd)) <- tGet h
+      pure (Nothing, corrId, qId, cmd)
 
 smpTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
 smpTest _ test' = runSmpTest test' `shouldReturn` ()
@@ -162,12 +142,8 @@ smpTest3 _ test' = smpTestN 3 _test
     _test [h1, h2, h3] = test' h1 h2 h3
     _test _ = error "expected 3 handles"
 
-tPutRaw :: Transport c => THandle c -> RawTransmission -> IO ()
-tPutRaw h (sig, corrId, queueId, command) = do
-  let t = B.intercalate " " [corrId, queueId, command]
-  void $ tPut h (C.Signature sig, t)
-
-tGetRaw :: Transport c => THandle c -> IO RawTransmission
-tGetRaw h = do
-  ("", (CorrId corrId, qId, Right cmd)) <- tGet fromServer h
-  pure ("", corrId, encode qId, serializeCommand cmd)
+smpTest4 :: Transport c => TProxy c -> (THandle c -> THandle c -> THandle c -> THandle c -> IO ()) -> Expectation
+smpTest4 _ test' = smpTestN 4 _test
+  where
+    _test [h1, h2, h3, h4] = test' h1 h2 h3 h4
+    _test _ = error "expected 4 handles"

tests/ServerTests.hs

@@ -1,10 +1,11 @@
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module ServerTests where
 
@@ -17,6 +18,8 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import SMPClient
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
 import System.Directory (removeFile)
@@ -25,37 +28,38 @@ import System.Timeout
 import Test.HUnit
 import Test.Hspec
 
-rsaKeySize :: Int
-rsaKeySize = 2048 `div` 8
-
 serverTests :: ATransport -> Spec
 serverTests t = do
   describe "SMP syntax" $ syntaxTests t
-  describe "SMP queues" do
+  describe "SMP queues" $ do
     describe "NEW and KEY commands, SEND messages" $ testCreateSecure t
     describe "NEW, OFF and DEL commands, SEND messages" $ testCreateDelete t
     describe "Stress test" $ stressTest t
-  describe "SMP messages" do
+  describe "SMP messages" $ do
     describe "duplex communication over 2 SMP connections" $ testDuplex t
-    describe "switch subscription to another SMP queue" $ testSwitchSub t
+    describe "switch subscription to another TCP connection" $ testSwitchSub t
   describe "Store log" $ testWithStoreLog t
   describe "Timing of AUTH error" $ testTiming t
+  describe "Message notifications" $ testMessageNotifications t
 
-pattern Resp :: CorrId -> QueueId -> Command 'Broker -> SignedTransmissionOrError
-pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker command)))
+pattern Resp :: CorrId -> QueueId -> BrokerMsg -> SignedTransmission BrokerMsg
+pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command))
 
-sendRecv :: Transport c => THandle c -> (ByteString, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
-sendRecv h (sgn, corrId, qId, cmd) = tPutRaw h (sgn, corrId, encode qId, cmd) >> tGet fromServer h
+pattern Ids :: RecipientId -> SenderId -> RcvPublicDhKey -> BrokerMsg
+pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh)
 
-signSendRecv :: Transport c => THandle c -> C.SafePrivateKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
-signSendRecv h pk (corrId, qId, cmd) = do
-  let t = B.intercalate " " [corrId, encode qId, cmd]
+sendRecv :: forall c p. (Transport c, PartyI p) => THandle c -> (Maybe C.ASignature, ByteString, ByteString, Command p) -> IO (SignedTransmission BrokerMsg)
+sendRecv h@THandle {sessionId} (sgn, corrId, qId, cmd) = do
+  let t = encodeTransmission sessionId (CorrId corrId, qId, cmd)
+  Right () <- tPut h (sgn, t)
+  tGet h
+
+signSendRecv :: forall c p. (Transport c, PartyI p) => THandle c -> C.APrivateSignKey -> (ByteString, ByteString, Command p) -> IO (SignedTransmission BrokerMsg)
+signSendRecv h@THandle {sessionId} pk (corrId, qId, cmd) = do
+  let t = encodeTransmission sessionId (CorrId corrId, qId, cmd)
   Right sig <- runExceptT $ C.sign pk t
-  _ <- tPut h (sig, t)
-  tGet fromServer h
-
-cmdSEND :: ByteString -> ByteString
-cmdSEND msg = serializeCommand (Cmd SSender . SEND $ msg)
+  Right () <- tPut h (Just sig, t)
+  tGet h
 
 (#==) :: (HasCallStack, Eq a, Show a) => (a, a) -> String -> Assertion
 (actual, expected) #== message = assertEqual message expected actual
@@ -64,132 +68,136 @@ testCreateSecure :: ATransport -> Spec
 testCreateSecure (ATransport t) =
   it "should create (NEW) and secure (KEY) queue" $
     smpTest t $ \h -> do
-      (rPub, rKey) <- C.generateKeyPair rsaKeySize
-      Resp "abcd" rId1 (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
+      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+      let dec nonce = C.cbDecrypt (C.dh' srvDh dhPriv) (C.cbNonce nonce)
       (rId1, "") #== "creates queue"
 
-      Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, "SEND 5 hello ")
+      Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, SEND "hello")
       (ok1, OK) #== "accepts unsigned SEND"
       (sId1, sId) #== "same queue ID in response 1"
 
-      Resp "" _ (MSG _ _ msg1) <- tGet fromServer h
-      (msg1, "hello") #== "delivers message"
+      Resp "" _ (MSG mId1 _ msg1) <- tGet h
+      (dec mId1 msg1, Right "hello") #== "delivers message"
 
-      Resp "cdab" _ ok4 <- signSendRecv h rKey ("cdab", rId, "ACK")
+      Resp "cdab" _ ok4 <- signSendRecv h rKey ("cdab", rId, ACK)
       (ok4, OK) #== "replies OK when message acknowledged if no more messages"
 
-      Resp "dabc" _ err6 <- signSendRecv h rKey ("dabc", rId, "ACK")
+      Resp "dabc" _ err6 <- signSendRecv h rKey ("dabc", rId, ACK)
       (err6, ERR NO_MSG) #== "replies ERR when message acknowledged without messages"
 
-      (sPub, sKey) <- C.generateKeyPair rsaKeySize
-      Resp "abcd" sId2 err1 <- signSendRecv h sKey ("abcd", sId, "SEND 5 hello ")
+      (sPub, sKey) <- C.generateSignatureKeyPair C.SEd448
+      Resp "abcd" sId2 err1 <- signSendRecv h sKey ("abcd", sId, SEND "hello")
       (err1, ERR AUTH) #== "rejects signed SEND"
       (sId2, sId) #== "same queue ID in response 2"
 
-      let keyCmd = "KEY " <> C.serializePubKey sPub
-      Resp "bcda" _ err2 <- sendRecv h (sampleSig, "bcda", rId, keyCmd)
+      Resp "bcda" _ err2 <- sendRecv h (sampleSig, "bcda", rId, KEY sPub)
       (err2, ERR AUTH) #== "rejects KEY with wrong signature"
 
-      Resp "cdab" _ err3 <- signSendRecv h rKey ("cdab", sId, keyCmd)
+      Resp "cdab" _ err3 <- signSendRecv h rKey ("cdab", sId, KEY sPub)
       (err3, ERR AUTH) #== "rejects KEY with sender's ID"
 
-      Resp "dabc" rId2 ok2 <- signSendRecv h rKey ("dabc", rId, keyCmd)
+      Resp "dabc" rId2 ok2 <- signSendRecv h rKey ("dabc", rId, KEY sPub)
       (ok2, OK) #== "secures queue"
       (rId2, rId) #== "same queue ID in response 3"
 
-      Resp "abcd" _ err4 <- signSendRecv h rKey ("abcd", rId, keyCmd)
+      Resp "abcd" _ err4 <- signSendRecv h rKey ("abcd", rId, KEY sPub)
       (err4, ERR AUTH) #== "rejects KEY if already secured"
 
-      Resp "bcda" _ ok3 <- signSendRecv h sKey ("bcda", sId, "SEND 11 hello again ")
+      Resp "bcda" _ ok3 <- signSendRecv h sKey ("bcda", sId, SEND "hello again")
       (ok3, OK) #== "accepts signed SEND"
 
-      Resp "" _ (MSG _ _ msg) <- tGet fromServer h
-      (msg, "hello again") #== "delivers message 2"
+      Resp "" _ (MSG mId2 _ msg2) <- tGet h
+      (dec mId2 msg2, Right "hello again") #== "delivers message 2"
 
-      Resp "cdab" _ ok5 <- signSendRecv h rKey ("cdab", rId, "ACK")
+      Resp "cdab" _ ok5 <- signSendRecv h rKey ("cdab", rId, ACK)
       (ok5, OK) #== "replies OK when message acknowledged 2"
 
-      Resp "dabc" _ err5 <- sendRecv h ("", "dabc", sId, "SEND 5 hello ")
+      Resp "dabc" _ err5 <- sendRecv h ("", "dabc", sId, SEND "hello")
       (err5, ERR AUTH) #== "rejects unsigned SEND"
 
 testCreateDelete :: ATransport -> Spec
 testCreateDelete (ATransport t) =
   it "should create (NEW), suspend (OFF) and delete (DEL) queue" $
     smpTest2 t $ \rh sh -> do
-      (rPub, rKey) <- C.generateKeyPair rsaKeySize
-      Resp "abcd" rId1 (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
+      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd25519
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub)
+      let dec nonce = C.cbDecrypt (C.dh' srvDh dhPriv) (C.cbNonce nonce)
       (rId1, "") #== "creates queue"
 
-      (sPub, sKey) <- C.generateKeyPair rsaKeySize
-      Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, "KEY " <> C.serializePubKey sPub)
+      (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519
+      Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, KEY sPub)
       (ok1, OK) #== "secures queue"
 
-      Resp "cdab" _ ok2 <- signSendRecv sh sKey ("cdab", sId, "SEND 5 hello ")
+      Resp "cdab" _ ok2 <- signSendRecv sh sKey ("cdab", sId, SEND "hello")
       (ok2, OK) #== "accepts signed SEND"
 
-      Resp "dabc" _ ok7 <- signSendRecv sh sKey ("dabc", sId, "SEND 7 hello 2 ")
+      Resp "dabc" _ ok7 <- signSendRecv sh sKey ("dabc", sId, SEND "hello 2")
       (ok7, OK) #== "accepts signed SEND 2 - this message is not delivered because the first is not ACKed"
 
-      Resp "" _ (MSG _ _ msg1) <- tGet fromServer rh
-      (msg1, "hello") #== "delivers message"
+      Resp "" _ (MSG mId1 _ msg1) <- tGet rh
+      (dec mId1 msg1, Right "hello") #== "delivers message"
 
-      Resp "abcd" _ err1 <- sendRecv rh (sampleSig, "abcd", rId, "OFF")
+      Resp "abcd" _ err1 <- sendRecv rh (sampleSig, "abcd", rId, OFF)
       (err1, ERR AUTH) #== "rejects OFF with wrong signature"
 
-      Resp "bcda" _ err2 <- signSendRecv rh rKey ("bcda", sId, "OFF")
+      Resp "bcda" _ err2 <- signSendRecv rh rKey ("bcda", sId, OFF)
       (err2, ERR AUTH) #== "rejects OFF with sender's ID"
 
-      Resp "cdab" rId2 ok3 <- signSendRecv rh rKey ("cdab", rId, "OFF")
+      Resp "cdab" rId2 ok3 <- signSendRecv rh rKey ("cdab", rId, OFF)
       (ok3, OK) #== "suspends queue"
       (rId2, rId) #== "same queue ID in response 2"
 
-      Resp "dabc" _ err3 <- signSendRecv sh sKey ("dabc", sId, "SEND 5 hello ")
+      Resp "dabc" _ err3 <- signSendRecv sh sKey ("dabc", sId, SEND "hello")
       (err3, ERR AUTH) #== "rejects signed SEND"
 
-      Resp "abcd" _ err4 <- sendRecv sh ("", "abcd", sId, "SEND 5 hello ")
+      Resp "abcd" _ err4 <- sendRecv sh ("", "abcd", sId, SEND "hello")
       (err4, ERR AUTH) #== "reject unsigned SEND too"
 
-      Resp "bcda" _ ok4 <- signSendRecv rh rKey ("bcda", rId, "OFF")
+      Resp "bcda" _ ok4 <- signSendRecv rh rKey ("bcda", rId, OFF)
       (ok4, OK) #== "accepts OFF when suspended"
 
-      Resp "cdab" _ (MSG _ _ msg) <- signSendRecv rh rKey ("cdab", rId, "SUB")
-      (msg, "hello") #== "accepts SUB when suspended and delivers the message again (because was not ACKed)"
+      Resp "cdab" _ (MSG mId2 _ msg2) <- signSendRecv rh rKey ("cdab", rId, SUB)
+      (dec mId2 msg2, Right "hello") #== "accepts SUB when suspended and delivers the message again (because was not ACKed)"
 
-      Resp "dabc" _ err5 <- sendRecv rh (sampleSig, "dabc", rId, "DEL")
+      Resp "dabc" _ err5 <- sendRecv rh (sampleSig, "dabc", rId, DEL)
       (err5, ERR AUTH) #== "rejects DEL with wrong signature"
 
-      Resp "abcd" _ err6 <- signSendRecv rh rKey ("abcd", sId, "DEL")
+      Resp "abcd" _ err6 <- signSendRecv rh rKey ("abcd", sId, DEL)
       (err6, ERR AUTH) #== "rejects DEL with sender's ID"
 
-      Resp "bcda" rId3 ok6 <- signSendRecv rh rKey ("bcda", rId, "DEL")
+      Resp "bcda" rId3 ok6 <- signSendRecv rh rKey ("bcda", rId, DEL)
       (ok6, OK) #== "deletes queue"
       (rId3, rId) #== "same queue ID in response 3"
 
-      Resp "cdab" _ err7 <- signSendRecv sh sKey ("cdab", sId, "SEND 5 hello ")
+      Resp "cdab" _ err7 <- signSendRecv sh sKey ("cdab", sId, SEND "hello")
       (err7, ERR AUTH) #== "rejects signed SEND when deleted"
 
-      Resp "dabc" _ err8 <- sendRecv sh ("", "dabc", sId, "SEND 5 hello ")
+      Resp "dabc" _ err8 <- sendRecv sh ("", "dabc", sId, SEND "hello")
       (err8, ERR AUTH) #== "rejects unsigned SEND too when deleted"
 
-      Resp "abcd" _ err11 <- signSendRecv rh rKey ("abcd", rId, "ACK")
+      Resp "abcd" _ err11 <- signSendRecv rh rKey ("abcd", rId, ACK)
       (err11, ERR AUTH) #== "rejects ACK when conn deleted - the second message is deleted"
 
-      Resp "bcda" _ err9 <- signSendRecv rh rKey ("bcda", rId, "OFF")
+      Resp "bcda" _ err9 <- signSendRecv rh rKey ("bcda", rId, OFF)
       (err9, ERR AUTH) #== "rejects OFF when deleted"
 
-      Resp "cdab" _ err10 <- signSendRecv rh rKey ("cdab", rId, "SUB")
+      Resp "cdab" _ err10 <- signSendRecv rh rKey ("cdab", rId, SUB)
       (err10, ERR AUTH) #== "rejects SUB when deleted"
 
 stressTest :: ATransport -> Spec
 stressTest (ATransport t) =
   it "should create many queues, disconnect and re-connect" $
     smpTest3 t $ \h1 h2 h3 -> do
-      (rPub, rKey) <- C.generateKeyPair rsaKeySize
+      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd25519
+      (dhPub, _ :: C.PrivateKeyX25519) <- C.generateKeyPair'
       rIds <- forM [1 .. 50 :: Int] . const $ do
-        Resp "" "" (IDS rId _) <- signSendRecv h1 rKey ("", "", "NEW " <> C.serializePubKey rPub)
+        Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub)
         pure rId
       let subscribeQueues h = forM_ rIds $ \rId -> do
-            Resp "" rId' OK <- signSendRecv h rKey ("", rId, "SUB")
+            Resp "" rId' OK <- signSendRecv h rKey ("", rId, SUB)
             rId' `shouldBe` rId
       closeConnection $ connection h1
       subscribeQueues h2
@@ -200,240 +208,309 @@ testDuplex :: ATransport -> Spec
 testDuplex (ATransport t) =
   it "should create 2 simplex connections and exchange messages" $
     smpTest2 t $ \alice bob -> do
-      (arPub, arKey) <- C.generateKeyPair rsaKeySize
-      Resp "abcd" _ (IDS aRcv aSnd) <- signSendRecv alice arKey ("abcd", "", "NEW " <> C.serializePubKey arPub)
+      (arPub, arKey) <- C.generateSignatureKeyPair C.SEd448
+      (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
+      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub)
+      let aDec nonce = C.cbDecrypt (C.dh' aSrvDh aDhPriv) (C.cbNonce nonce)
       -- aSnd ID is passed to Bob out-of-band
 
-      (bsPub, bsKey) <- C.generateKeyPair rsaKeySize
-      Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, cmdSEND $ "key " <> C.serializePubKey bsPub)
-      -- "key ..." is ad-hoc, different from SMP protocol
+      (bsPub, bsKey) <- C.generateSignatureKeyPair C.SEd448
+      Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, SEND $ "key " <> strEncode bsPub)
+      -- "key ..." is ad-hoc, not a part of SMP protocol
 
-      Resp "" _ (MSG _ _ msg1) <- tGet fromServer alice
-      Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, "ACK")
-      ["key", bobKey] <- return $ B.words msg1
-      (bobKey, C.serializePubKey bsPub) #== "key received from Bob"
-      Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, "KEY " <> bobKey)
+      Resp "" _ (MSG mId1 _ msg1) <- tGet alice
+      Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, ACK)
+      Right ["key", bobKey] <- pure $ B.words <$> aDec mId1 msg1
+      (bobKey, strEncode bsPub) #== "key received from Bob"
+      Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, KEY bsPub)
 
-      (brPub, brKey) <- C.generateKeyPair rsaKeySize
-      Resp "abcd" _ (IDS bRcv bSnd) <- signSendRecv bob brKey ("abcd", "", "NEW " <> C.serializePubKey brPub)
-      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, cmdSEND $ "reply_id " <> encode bSnd)
-      -- "reply_id ..." is ad-hoc, it is not a part of SMP protocol
+      (brPub, brKey) <- C.generateSignatureKeyPair C.SEd448
+      (bDhPub, bDhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
+      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub)
+      let bDec nonce = C.cbDecrypt (C.dh' bSrvDh bDhPriv) (C.cbNonce nonce)
+      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, SEND $ "reply_id " <> encode bSnd)
+      -- "reply_id ..." is ad-hoc, not a part of SMP protocol
 
-      Resp "" _ (MSG _ _ msg2) <- tGet fromServer alice
-      Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, "ACK")
-      ["reply_id", bId] <- return $ B.words msg2
+      Resp "" _ (MSG mId2 _ msg2) <- tGet alice
+      Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, ACK)
+      Right ["reply_id", bId] <- pure $ B.words <$> aDec mId2 msg2
       (bId, encode bSnd) #== "reply queue ID received from Bob"
 
-      (asPub, asKey) <- C.generateKeyPair rsaKeySize
-      Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, cmdSEND $ "key " <> C.serializePubKey asPub)
-      -- "key ..." is ad-hoc, different from SMP protocol
+      (asPub, asKey) <- C.generateSignatureKeyPair C.SEd448
+      Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, SEND $ "key " <> strEncode asPub)
+      -- "key ..." is ad-hoc, not a part of  SMP protocol
 
-      Resp "" _ (MSG _ _ msg3) <- tGet fromServer bob
-      Resp "abcd" _ OK <- signSendRecv bob brKey ("abcd", bRcv, "ACK")
-      ["key", aliceKey] <- return $ B.words msg3
-      (aliceKey, C.serializePubKey asPub) #== "key received from Alice"
-      Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, "KEY " <> aliceKey)
+      Resp "" _ (MSG mId3 _ msg3) <- tGet bob
+      Resp "abcd" _ OK <- signSendRecv bob brKey ("abcd", bRcv, ACK)
+      Right ["key", aliceKey] <- pure $ B.words <$> bDec mId3 msg3
+      (aliceKey, strEncode asPub) #== "key received from Alice"
+      Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, KEY asPub)
 
-      Resp "cdab" _ OK <- signSendRecv bob bsKey ("cdab", aSnd, "SEND 8 hi alice ")
+      Resp "cdab" _ OK <- signSendRecv bob bsKey ("cdab", aSnd, SEND "hi alice")
 
-      Resp "" _ (MSG _ _ msg4) <- tGet fromServer alice
-      Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, "ACK")
-      (msg4, "hi alice") #== "message received from Bob"
+      Resp "" _ (MSG mId4 _ msg4) <- tGet alice
+      Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, ACK)
+      (aDec mId4 msg4, Right "hi alice") #== "message received from Bob"
 
-      Resp "abcd" _ OK <- signSendRecv alice asKey ("abcd", bSnd, cmdSEND "how are you bob")
+      Resp "abcd" _ OK <- signSendRecv alice asKey ("abcd", bSnd, SEND "how are you bob")
 
-      Resp "" _ (MSG _ _ msg5) <- tGet fromServer bob
-      Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, "ACK")
-      (msg5, "how are you bob") #== "message received from alice"
+      Resp "" _ (MSG mId5 _ msg5) <- tGet bob
+      Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, ACK)
+      (bDec mId5 msg5, Right "how are you bob") #== "message received from alice"
 
 testSwitchSub :: ATransport -> Spec
 testSwitchSub (ATransport t) =
   it "should create simplex connections and switch subscription to another TCP connection" $
     smpTest3 t $ \rh1 rh2 sh -> do
-      (rPub, rKey) <- C.generateKeyPair rsaKeySize
-      Resp "abcd" _ (IDS rId sId) <- signSendRecv rh1 rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
-      Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, "SEND 5 test1 ")
+      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
+      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub)
+      let dec nonce = C.cbDecrypt (C.dh' srvDh dhPriv) (C.cbNonce nonce)
+      Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, SEND "test1")
       (ok1, OK) #== "sent test message 1"
-      Resp "cdab" _ ok2 <- sendRecv sh ("", "cdab", sId, cmdSEND "test2, no ACK")
+      Resp "cdab" _ ok2 <- sendRecv sh ("", "cdab", sId, SEND "test2, no ACK")
       (ok2, OK) #== "sent test message 2"
 
-      Resp "" _ (MSG _ _ msg1) <- tGet fromServer rh1
-      (msg1, "test1") #== "test message 1 delivered to the 1st TCP connection"
-      Resp "abcd" _ (MSG _ _ msg2) <- signSendRecv rh1 rKey ("abcd", rId, "ACK")
-      (msg2, "test2, no ACK") #== "test message 2 delivered, no ACK"
+      Resp "" _ (MSG mId1 _ msg1) <- tGet rh1
+      (dec mId1 msg1, Right "test1") #== "test message 1 delivered to the 1st TCP connection"
+      Resp "abcd" _ (MSG mId2 _ msg2) <- signSendRecv rh1 rKey ("abcd", rId, ACK)
+      (dec mId2 msg2, Right "test2, no ACK") #== "test message 2 delivered, no ACK"
 
-      Resp "bcda" _ (MSG _ _ msg2') <- signSendRecv rh2 rKey ("bcda", rId, "SUB")
-      (msg2', "test2, no ACK") #== "same simplex queue via another TCP connection, tes2 delivered again (no ACK in 1st queue)"
-      Resp "cdab" _ OK <- signSendRecv rh2 rKey ("cdab", rId, "ACK")
+      Resp "bcda" _ (MSG mId2' _ msg2') <- signSendRecv rh2 rKey ("bcda", rId, SUB)
+      (dec mId2' msg2', Right "test2, no ACK") #== "same simplex queue via another TCP connection, tes2 delivered again (no ACK in 1st queue)"
+      Resp "cdab" _ OK <- signSendRecv rh2 rKey ("cdab", rId, ACK)
 
-      Resp "" _ end <- tGet fromServer rh1
+      Resp "" _ end <- tGet rh1
       (end, END) #== "unsubscribed the 1st TCP connection"
 
-      Resp "dabc" _ OK <- sendRecv sh ("", "dabc", sId, "SEND 5 test3 ")
+      Resp "dabc" _ OK <- sendRecv sh ("", "dabc", sId, SEND "test3")
 
-      Resp "" _ (MSG _ _ msg3) <- tGet fromServer rh2
-      (msg3, "test3") #== "delivered to the 2nd TCP connection"
+      Resp "" _ (MSG mId3 _ msg3) <- tGet rh2
+      (dec mId3 msg3, Right "test3") #== "delivered to the 2nd TCP connection"
 
-      Resp "abcd" _ err <- signSendRecv rh1 rKey ("abcd", rId, "ACK")
+      Resp "abcd" _ err <- signSendRecv rh1 rKey ("abcd", rId, ACK)
       (err, ERR NO_MSG) #== "rejects ACK from the 1st TCP connection"
 
-      Resp "bcda" _ ok3 <- signSendRecv rh2 rKey ("bcda", rId, "ACK")
+      Resp "bcda" _ ok3 <- signSendRecv rh2 rKey ("bcda", rId, ACK)
       (ok3, OK) #== "accepts ACK from the 2nd TCP connection"
 
-      1000 `timeout` tGet fromServer rh1 >>= \case
+      1000 `timeout` tGet @BrokerMsg rh1 >>= \case
         Nothing -> return ()
         Just _ -> error "nothing else is delivered to the 1st TCP connection"
 
 testWithStoreLog :: ATransport -> Spec
 testWithStoreLog at@(ATransport t) =
   it "should store simplex queues to log and restore them after server restart" $ do
-    (sPub1, sKey1) <- C.generateKeyPair rsaKeySize
-    (sPub2, sKey2) <- C.generateKeyPair rsaKeySize
+    (sPub1, sKey1) <- C.generateSignatureKeyPair C.SEd25519
+    (sPub2, sKey2) <- C.generateSignatureKeyPair C.SEd25519
+    (nPub, nKey) <- C.generateSignatureKeyPair C.SEd25519
+    recipientId1 <- newTVarIO ""
+    recipientKey1 <- newTVarIO Nothing
+    dhShared1 <- newTVarIO Nothing
     senderId1 <- newTVarIO ""
     senderId2 <- newTVarIO ""
+    notifierId <- newTVarIO ""
 
-    withSmpServerStoreLogOn at testPort . runTest t $ \h -> do
-      (sId1, _, _) <- createAndSecureQueue h sPub1
-      atomically $ writeTVar senderId1 sId1
-      Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ")
-      Resp "" _ (MSG _ _ "hello") <- tGet fromServer h
+    withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
+      (sId1, rId1, rKey1, dhShared) <- createAndSecureQueue h sPub1
+      Resp "abcd" _ (NID nId) <- signSendRecv h rKey1 ("abcd", rId1, NKEY nPub)
+      atomically $ do
+        writeTVar recipientId1 rId1
+        writeTVar recipientKey1 $ Just rKey1
+        writeTVar dhShared1 $ Just dhShared
+        writeTVar senderId1 sId1
+        writeTVar notifierId nId
+      Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, NSUB)
+      Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, SEND "hello")
+      Resp "" _ (MSG mId1 _ msg1) <- tGet h
+      (C.cbDecrypt dhShared (C.cbNonce mId1) msg1, Right "hello") #== "delivered from queue 1"
+      Resp "" _ NMSG <- tGet h1
 
-      (sId2, rId2, rKey2) <- createAndSecureQueue h sPub2
+      (sId2, rId2, rKey2, dhShared2) <- createAndSecureQueue h sPub2
       atomically $ writeTVar senderId2 sId2
-      Resp "cdab" _ OK <- signSendRecv h sKey2 ("cdab", sId2, "SEND 9 hello too ")
-      Resp "" _ (MSG _ _ "hello too") <- tGet fromServer h
+      Resp "cdab" _ OK <- signSendRecv h sKey2 ("cdab", sId2, SEND "hello too")
+      Resp "" _ (MSG mId2 _ msg2) <- tGet h
+      (C.cbDecrypt dhShared2 (C.cbNonce mId2) msg2, Right "hello too") #== "delivered from queue 2"
 
-      Resp "dabc" _ OK <- signSendRecv h rKey2 ("dabc", rId2, "DEL")
+      Resp "dabc" _ OK <- signSendRecv h rKey2 ("dabc", rId2, DEL)
       pure ()
 
-    logSize `shouldReturn` 5
+    logSize `shouldReturn` 6
 
     withSmpServerThreadOn at testPort . runTest t $ \h -> do
       sId1 <- readTVarIO senderId1
       -- fails if store log is disabled
-      Resp "bcda" _ (ERR AUTH) <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ")
+      Resp "bcda" _ (ERR AUTH) <- signSendRecv h sKey1 ("bcda", sId1, SEND "hello")
       pure ()
 
-    withSmpServerStoreLogOn at testPort . runTest t $ \h -> do
+    withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
       -- this queue is restored
+      rId1 <- readTVarIO recipientId1
+      Just rKey1 <- readTVarIO recipientKey1
+      Just dh1 <- readTVarIO dhShared1
       sId1 <- readTVarIO senderId1
-      Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ")
+      nId <- readTVarIO notifierId
+      Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, NSUB)
+      Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, SEND "hello")
+      Resp "cdab" _ (MSG mId3 _ msg3) <- signSendRecv h rKey1 ("cdab", rId1, SUB)
+      (C.cbDecrypt dh1 (C.cbNonce mId3) msg3, Right "hello") #== "delivered from restored queue"
+      Resp "" _ NMSG <- tGet h1
       -- this queue is removed - not restored
       sId2 <- readTVarIO senderId2
-      Resp "cdab" _ (ERR AUTH) <- signSendRecv h sKey2 ("cdab", sId2, "SEND 9 hello too ")
+      Resp "cdab" _ (ERR AUTH) <- signSendRecv h sKey2 ("cdab", sId2, SEND "hello too")
       pure ()
 
     logSize `shouldReturn` 1
     removeFile testStoreLogFile
   where
-    createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.SafePrivateKey)
-    createAndSecureQueue h sPub = do
-      (rPub, rKey) <- C.generateKeyPair rsaKeySize
-      Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
-      let keyCmd = "KEY " <> C.serializePubKey sPub
-      Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, keyCmd)
-      (rId', rId) #== "same queue ID"
-      pure (sId, rId, rKey)
-
     runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
     runTest _ test' server = do
       testSMPClient test' `shouldReturn` ()
       killThread server
 
+    runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
+    runClient _ test' = testSMPClient test' `shouldReturn` ()
+
     logSize :: IO Int
     logSize =
       try (length . B.lines <$> B.readFile testStoreLogFile) >>= \case
         Right l -> pure l
         Left (_ :: SomeException) -> logSize
 
+createAndSecureQueue :: Transport c => THandle c -> SndPublicVerifyKey -> IO (SenderId, RecipientId, RcvPrivateSignKey, RcvDhSecret)
+createAndSecureQueue h sPub = do
+  (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
+  (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
+  Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+  let dhShared = C.dh' srvDh dhPriv
+  Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
+  (rId', rId) #== "same queue ID"
+  pure (sId, rId, rKey, dhShared)
+
 testTiming :: ATransport -> Spec
 testTiming (ATransport t) =
   it "should have similar time for auth error, whether queue exists or not, for all key sizes" $
     smpTest2 t $ \rh sh ->
       mapM_
         (testSameTiming rh sh)
-        [ (128, 128, 100),
-          (128, 256, 25),
-          (128, 384, 15),
-          -- (128, 512, 15),
-          (256, 128, 100),
-          (256, 256, 25),
-          (256, 384, 15),
-          -- (256, 512, 15),
-          (384, 128, 100),
-          (384, 256, 25),
-          (384, 384, 15)
-          -- (384, 512, 15),
-          -- (512, 128, 100),
-          -- (512, 256, 25),
-          -- (512, 384, 15),
-          -- (512, 512, 15)
+        [ (32, 32, 200),
+          (32, 57, 100),
+          (57, 32, 200),
+          (57, 57, 100)
         ]
   where
     timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
-    similarTime t1 t2 = abs (t1 - t2) / t1 < 0.2 `shouldBe` True
+    similarTime t1 t2 = abs (t2 / t1 - 1) < 0.25 `shouldBe` True
     testSameTiming :: Transport c => THandle c -> THandle c -> (Int, Int, Int) -> Expectation
-    testSameTiming rh sh (senderKeySize, badKeySize, n) = do
-      (rPub, rKey) <- C.generateKeyPair rsaKeySize
-      Resp "abcd" "" (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
+    testSameTiming rh sh (goodKeySize, badKeySize, n) = do
+      (rPub, rKey) <- generateKeys goodKeySize
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
+      Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub)
+      let dec nonce = C.cbDecrypt (C.dh' srvDh dhPriv) (C.cbNonce nonce)
+      Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, SUB)
 
-      (sPub, sKey) <- C.generateKeyPair senderKeySize
-      let keyCmd = "KEY " <> C.serializePubKey sPub
-      Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, keyCmd)
+      (_, badKey) <- generateKeys badKeySize
+      -- runTimingTest rh badKey rId "SUB"
 
-      (_, badKey) <- C.generateKeyPair badKeySize
-      Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, "SEND 5 hello ")
-      timeWrongKey <- timeRepeat n $ do
-        Resp "cdab" _ (ERR AUTH) <- signSendRecv sh badKey ("cdab", sId, "SEND 5 hello ")
-        return ()
-      timeNoQueue <- timeRepeat n $ do
-        Resp "dabc" _ (ERR AUTH) <- signSendRecv sh badKey ("dabc", "1234", "SEND 5 hello ")
-        return ()
-      Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh
-      similarTime timeNoQueue timeWrongKey
+      (sPub, sKey) <- generateKeys goodKeySize
+      Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, KEY sPub)
 
-samplePubKey :: ByteString
-samplePubKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"
+      Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, SEND "hello")
+      Resp "" _ (MSG mId _ msg) <- tGet rh
+      (dec mId msg, Right "hello") #== "delivered from queue"
 
-sampleSig :: ByteString
-sampleSig = "\128\207*\159eq\220i!\"\157\161\130\184\226\246\232_\\\170`\180\160\230sI\154\197\211\252\SUB\246\206ELL\t9K\ESC\196?\128\215%\222\148\NAK;9\155f\164\217e\242\156\CAN9\253\r\170\174'w\211\228?\205)\215\150\255\247z\DC115\DC1{\bn\145\rKD,K\230\202d8\233\167|7y\t_S\EM\248\EOT\216\172\167d\181\224)\137\ACKo\197j#c\217\243\228.\167\228\205\144\vr\134"
+      runTimingTest sh badKey sId $ SEND "hello"
+      where
+        generateKeys = \case
+          32 -> C.generateSignatureKeyPair C.SEd25519
+          57 -> C.generateSignatureKeyPair C.SEd448
+          _ -> error "unsupported key size"
+        runTimingTest h badKey qId cmd = do
+          timeWrongKey <- timeRepeat n $ do
+            Resp "cdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdab", qId, cmd)
+            return ()
+          timeNoQueue <- timeRepeat n $ do
+            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", "1234", cmd)
+            return ()
+          -- (putStrLn . unwords . map show)
+          --   [ fromIntegral goodKeySize,
+          --     fromIntegral badKeySize,
+          --     timeWrongKey,
+          --     timeNoQueue,
+          --     timeWrongKey / timeNoQueue - 1
+          --   ]
+          similarTime timeNoQueue timeWrongKey
+
+testMessageNotifications :: ATransport -> Spec
+testMessageNotifications (ATransport t) =
+  it "should create simplex connection, subscribe notifier and deliver notifications" $ do
+    (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519
+    (nPub, nKey) <- C.generateSignatureKeyPair C.SEd25519
+    smpTest4 t $ \rh sh nh1 nh2 -> do
+      (sId, rId, rKey, dhShared) <- createAndSecureQueue rh sPub
+      let dec nonce = C.cbDecrypt dhShared (C.cbNonce nonce)
+      Resp "1" _ (NID nId) <- signSendRecv rh rKey ("1", rId, NKEY nPub)
+      Resp "2" _ OK <- signSendRecv nh1 nKey ("2", nId, NSUB)
+      Resp "3" _ OK <- signSendRecv sh sKey ("3", sId, SEND "hello")
+      Resp "" _ (MSG mId1 _ msg1) <- tGet rh
+      (dec mId1 msg1, Right "hello") #== "delivered from queue"
+      Resp "3a" _ OK <- signSendRecv rh rKey ("3a", rId, ACK)
+      Resp "" _ NMSG <- tGet nh1
+      Resp "4" _ OK <- signSendRecv nh2 nKey ("4", nId, NSUB)
+      Resp "" _ END <- tGet nh1
+      Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, SEND "hello again")
+      Resp "" _ (MSG mId2 _ msg2) <- tGet rh
+      (dec mId2 msg2, Right "hello again") #== "delivered from queue again"
+      Resp "" _ NMSG <- tGet nh2
+      1000 `timeout` tGet @BrokerMsg nh1 >>= \case
+        Nothing -> return ()
+        Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection"
+
+samplePubKey :: C.APublicVerifyKey
+samplePubKey = C.APublicVerifyKey C.SEd25519 "MCowBQYDK2VwAyEAfAOflyvbJv1fszgzkQ6buiZJVgSpQWsucXq7U6zjMgY="
+
+sampleDhPubKey :: C.PublicKey 'C.X25519
+sampleDhPubKey = "MCowBQYDK2VuAyEAriy+HcARIhqsgSjVnjKqoft+y6pxrxdY68zn4+LjYhQ="
+
+sampleSig :: Maybe C.ASignature
+sampleSig = "e8JK+8V3fq6kOLqco/SaKlpNaQ7i1gfOrXoqekEl42u4mF8Bgu14T5j0189CGcUhJHw2RwCMvON+qbvQ9ecJAA=="
 
 syntaxTests :: ATransport -> Spec
 syntaxTests (ATransport t) = do
-  it "unknown command" $ ("", "abcd", "1234", "HELLO") >#> ("", "abcd", "1234", "ERR CMD SYNTAX")
-  describe "NEW" do
-    it "no parameters" $ (sampleSig, "bcda", "", "NEW") >#> ("", "bcda", "", "ERR CMD SYNTAX")
-    it "many parameters" $ (sampleSig, "cdab", "", "NEW 1 " <> samplePubKey) >#> ("", "cdab", "", "ERR CMD SYNTAX")
-    it "no signature" $ ("", "dabc", "", "NEW " <> samplePubKey) >#> ("", "dabc", "", "ERR CMD NO_AUTH")
-    it "queue ID" $ (sampleSig, "abcd", "12345678", "NEW " <> samplePubKey) >#> ("", "abcd", "12345678", "ERR CMD HAS_AUTH")
-  describe "KEY" do
-    it "valid syntax" $ (sampleSig, "bcda", "12345678", "KEY " <> samplePubKey) >#> ("", "bcda", "12345678", "ERR AUTH")
-    it "no parameters" $ (sampleSig, "cdab", "12345678", "KEY") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX")
-    it "many parameters" $ (sampleSig, "dabc", "12345678", "KEY 1 " <> samplePubKey) >#> ("", "dabc", "12345678", "ERR CMD SYNTAX")
-    it "no signature" $ ("", "abcd", "12345678", "KEY " <> samplePubKey) >#> ("", "abcd", "12345678", "ERR CMD NO_AUTH")
-    it "no queue ID" $ (sampleSig, "bcda", "", "KEY " <> samplePubKey) >#> ("", "bcda", "", "ERR CMD NO_AUTH")
-  noParamsSyntaxTest "SUB"
-  noParamsSyntaxTest "ACK"
-  noParamsSyntaxTest "OFF"
-  noParamsSyntaxTest "DEL"
-  describe "SEND" do
-    it "valid syntax 1" $ (sampleSig, "cdab", "12345678", "SEND 5 hello ") >#> ("", "cdab", "12345678", "ERR AUTH")
-    it "valid syntax 2" $ (sampleSig, "dabc", "12345678", "SEND 11 hello there ") >#> ("", "dabc", "12345678", "ERR AUTH")
-    it "no parameters" $ (sampleSig, "abcd", "12345678", "SEND") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX")
-    it "no queue ID" $ (sampleSig, "bcda", "", "SEND 5 hello ") >#> ("", "bcda", "", "ERR CMD NO_QUEUE")
-    it "bad message body 1" $ (sampleSig, "cdab", "12345678", "SEND 11 hello ") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX")
-    it "bad message body 2" $ (sampleSig, "dabc", "12345678", "SEND hello ") >#> ("", "dabc", "12345678", "ERR CMD SYNTAX")
-    it "bigger body" $ (sampleSig, "abcd", "12345678", "SEND 4 hello ") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX")
-  describe "PING" do
-    it "valid syntax" $ ("", "abcd", "", "PING") >#> ("", "abcd", "", "PONG")
-  describe "broker response not allowed" do
-    it "OK" $ (sampleSig, "bcda", "12345678", "OK") >#> ("", "bcda", "12345678", "ERR CMD PROHIBITED")
+  it "unknown command" $ ("", "abcd", "1234", ('H', 'E', 'L', 'L', 'O')) >#> ("", "abcd", "1234", ERR $ CMD UNKNOWN)
+  describe "NEW" $ do
+    it "no parameters" $ (sampleSig, "bcda", "", NEW_) >#> ("", "bcda", "", ERR $ CMD SYNTAX)
+    it "many parameters" $ (sampleSig, "cdab", "", (NEW_, ' ', ('\x01', 'A'), samplePubKey, sampleDhPubKey)) >#> ("", "cdab", "", ERR $ CMD SYNTAX)
+    it "no signature" $ ("", "dabc", "", (NEW_, ' ', samplePubKey, sampleDhPubKey)) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
+    it "queue ID" $ (sampleSig, "abcd", "12345678", (NEW_, ' ', samplePubKey, sampleDhPubKey)) >#> ("", "abcd", "12345678", ERR $ CMD HAS_AUTH)
+  describe "KEY" $ do
+    it "valid syntax" $ (sampleSig, "bcda", "12345678", (KEY_, ' ', samplePubKey)) >#> ("", "bcda", "12345678", ERR AUTH)
+    it "no parameters" $ (sampleSig, "cdab", "12345678", KEY_) >#> ("", "cdab", "12345678", ERR $ CMD SYNTAX)
+    it "many parameters" $ (sampleSig, "dabc", "12345678", (KEY_, ' ', ('\x01', 'A'), samplePubKey)) >#> ("", "dabc", "12345678", ERR $ CMD SYNTAX)
+    it "no signature" $ ("", "abcd", "12345678", (KEY_, ' ', samplePubKey)) >#> ("", "abcd", "12345678", ERR $ CMD NO_AUTH)
+    it "no queue ID" $ (sampleSig, "bcda", "", (KEY_, ' ', samplePubKey)) >#> ("", "bcda", "", ERR $ CMD NO_AUTH)
+  noParamsSyntaxTest "SUB" SUB_
+  noParamsSyntaxTest "ACK" ACK_
+  noParamsSyntaxTest "OFF" OFF_
+  noParamsSyntaxTest "DEL" DEL_
+  describe "SEND" $ do
+    it "valid syntax" $ (sampleSig, "cdab", "12345678", (SEND_, ' ', "hello" :: ByteString)) >#> ("", "cdab", "12345678", ERR AUTH)
+    it "no parameters" $ (sampleSig, "abcd", "12345678", SEND_) >#> ("", "abcd", "12345678", ERR $ CMD SYNTAX)
+    it "no queue ID" $ (sampleSig, "bcda", "", (SEND_, ' ', "hello" :: ByteString)) >#> ("", "bcda", "", ERR $ CMD NO_QUEUE)
+  describe "PING" $ do
+    it "valid syntax" $ ("", "abcd", "", PING_) >#> ("", "abcd", "", PONG)
+  describe "broker response not allowed" $ do
+    it "OK" $ (sampleSig, "bcda", "12345678", OK_) >#> ("", "bcda", "12345678", ERR $ CMD UNKNOWN)
   where
-    noParamsSyntaxTest :: ByteString -> Spec
-    noParamsSyntaxTest cmd = describe (B.unpack cmd) do
-      it "valid syntax" $ (sampleSig, "abcd", "12345678", cmd) >#> ("", "abcd", "12345678", "ERR AUTH")
-      it "wrong terminator" $ (sampleSig, "bcda", "12345678", cmd <> "=") >#> ("", "bcda", "12345678", "ERR CMD SYNTAX")
-      it "no signature" $ ("", "cdab", "12345678", cmd) >#> ("", "cdab", "12345678", "ERR CMD NO_AUTH")
-      it "no queue ID" $ (sampleSig, "dabc", "", cmd) >#> ("", "dabc", "", "ERR CMD NO_AUTH")
-    (>#>) :: RawTransmission -> RawTransmission -> Expectation
+    noParamsSyntaxTest :: PartyI p => String -> CommandTag p -> Spec
+    noParamsSyntaxTest description cmd = describe description $ do
+      it "valid syntax" $ (sampleSig, "abcd", "12345678", cmd) >#> ("", "abcd", "12345678", ERR AUTH)
+      it "wrong terminator" $ (sampleSig, "bcda", "12345678", (cmd, '=')) >#> ("", "bcda", "12345678", ERR $ CMD UNKNOWN)
+      it "no signature" $ ("", "cdab", "12345678", cmd) >#> ("", "cdab", "12345678", ERR $ CMD NO_AUTH)
+      it "no queue ID" $ (sampleSig, "dabc", "", cmd) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
+    (>#>) ::
+      Encoding smp =>
+      (Maybe C.ASignature, ByteString, ByteString, smp) ->
+      (Maybe C.ASignature, ByteString, ByteString, BrokerMsg) ->
+      Expectation
     command >#> response = smpServerTest t command `shouldReturn` response

tests/Test.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE TypeApplications #-}
 
 import AgentTests (agentTests)
-import ProtocolErrorTests
+import CoreTests.EncodingTests
+import CoreTests.ProtocolErrorTests
+import CoreTests.VersionRangeTests
 import ServerTests
-import Simplex.Messaging.Transport (TCP, Transport (..))
+import Simplex.Messaging.Transport (TLS, Transport (..))
 import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
 import Test.Hspec
@@ -12,8 +14,11 @@ main :: IO ()
 main = do
   createDirectoryIfMissing False "tests/tmp"
   hspec $ do
-    describe "Protocol errors" protocolErrorTests
-    describe "SMP server via TCP" $ serverTests (transport @TCP)
+    describe "Core tests" $ do
+      describe "Encoding tests" encodingTests
+      describe "Protocol error tests" protocolErrorTests
+      describe "Version range" versionRangeTests
+    describe "SMP server via TLS" $ serverTests (transport @TLS)
     describe "SMP server via WebSockets" $ serverTests (transport @WS)
-    describe "SMP client agent" $ agentTests (transport @TCP)
+    describe "SMP client agent" $ agentTests (transport @TLS)
   removeDirectoryRecursive "tests/tmp"

tests/fixtures/.gitignore

@@ -0,0 +1 @@
+server.csr

tests/fixtures/README.md

@@ -0,0 +1,28 @@
+To generate fixtures:
+
+(keep these instructions and *openssl_ca.conf* and *openssl_server.conf* files consistent with certificate generation on server)
+
+```sh
+# CA certificate (identity/offline)
+openssl genpkey -algorithm ED448 -out ca.key
+openssl req -new -x509 -days 999999 -config openssl_ca.conf -extensions v3 -key ca.key -out ca.crt
+
+# Server certificate (online)
+openssl genpkey -algorithm ED448 -out server.key
+openssl req -new -config openssl_server.conf -reqexts v3 -key server.key -out server.csr
+openssl x509 -req -days 999999 -extfile openssl_server.conf -extensions v3 -in server.csr -CA ca.crt -CAkey ca.key -CAcreateserial -out server.crt
+
+# To pretty-print
+openssl x509 -in ca.crt -text -noout
+openssl req -in server.csr -text -noout
+openssl x509 -in server.crt -text -noout
+```
+
+To compute fingerprint for tests:
+
+```haskell
+stack ghci
+> import Data.X509.Validation (Fingerprint (..))
+> Fingerprint fp <- loadFingerprint "tests/fixtures/ca.crt"
+> strEncode fp
+```

tests/fixtures/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/ca.key

@@ -0,0 +1,4 @@
+-----BEGIN PRIVATE KEY-----
+MEcCAQAwBQYDK2VxBDsEOW6vCN7H7or3VsiMaNrFUoCf4LsuhYchWJKataA1mXhN
+VIYFo7xWZWBnczDf5hkWQLIHNHm7DDr6+A==
+-----END PRIVATE KEY-----

tests/fixtures/openssl_ca.conf

@@ -0,0 +1,12 @@
+[req]
+distinguished_name = req_distinguished_name
+prompt = no
+
+[req_distinguished_name]
+CN = SMP server CA
+O = SimpleX
+
+[v3]
+subjectKeyIdentifier = hash
+authorityKeyIdentifier = keyid:always
+basicConstraints = critical,CA:true

tests/fixtures/openssl_server.conf

@@ -0,0 +1,11 @@
+[req]
+distinguished_name = req_distinguished_name
+prompt = no
+
+[req_distinguished_name]
+CN = localhost
+
+[v3]
+basicConstraints = CA:FALSE
+keyUsage = digitalSignature, nonRepudiation, keyAgreement
+extendedKeyUsage = serverAuth

tests/fixtures/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/server.key

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