rename simplexmq-legacy into simplexmq-v0 (#270)

* rename simplexmq-legacy into simplexmq-v0

* split UnliftIO instance of ExceptT

.github/FUNDING.yml

@@ -0,0 +1 @@
+open_collective: simplex-chat

.github/workflows/build.yml

@@ -4,52 +4,14 @@ on:
   push:
     branches:
       - master
+      - stable
     tags:
       - "v*"
   pull_request:
 
 jobs:
-  prepare-release:
-    if: startsWith(github.ref, 'refs/tags/v')
-    runs-on: ubuntu-latest
-    steps:
-      - name: Clone project
-        uses: actions/checkout@v2
-
-      - name: Build changelog
-        id: build_changelog
-        uses: mikepenz/release-changelog-builder-action@v1
-        with:
-          configuration: .github/changelog_conf.json
-          failOnError: true
-          ignorePreReleases: true
-          commitMode: true
-        env:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-
-      - name: Create release
-        uses: softprops/action-gh-release@v1
-        with:
-          body: ${{ steps.build_changelog.outputs.changelog }}
-          files: |
-            LICENSE
-          fail_on_unmatched_files: true
-        env:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-
   build:
-    name: build-${{ matrix.os }}
-    if: always()
-    needs: prepare-release
-    runs-on: ${{ matrix.os }}
-    strategy:
-      fail-fast: false
-      matrix:
-        include:
-          - os: ubuntu-20.04
-            asset_name: smp-server-ubuntu-20_04-x86-64
-          - os: ubuntu-18.04
-            asset_name: smp-server-ubuntu-18_04-x86-64
+    runs-on: ubuntu-20.04
     steps:
       - name: Clone project
         uses: actions/checkout@v2
@@ -65,19 +27,38 @@ jobs:
         uses: actions/cache@v2
         with:
           path: ~/.stack
-          key: ${{ matrix.os }}-${{ hashFiles('stack.yaml') }}
+          key: ${{ hashFiles('stack.yaml') }}
 
       - name: Build & test
         id: build_test
         run: |
-          stack build --test
-          echo "::set-output name=LOCAL_INSTALL_ROOT::$(stack path --local-install-root)"
-
-      - name: Upload binaries to release
+          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')
-        uses: svenstaro/upload-release-action@v2
+        id: build_changelog
+        uses: mikepenz/release-changelog-builder-action@v1
         with:
-          repo_token: ${{ secrets.GITHUB_TOKEN }}
-          file: ${{ steps.build_test.outputs.LOCAL_INSTALL_ROOT }}/bin/smp-server
-          asset_name: ${{ matrix.asset_name }}
-          tag: ${{ github.ref }}
+          configuration: .github/changelog_conf.json
+          failOnError: true
+          ignorePreReleases: true
+          commitMode: true
+        env:
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+      
+      - 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:
+            ${{ steps.build_changelog.outputs.changelog }}
+          files: |
+            LICENSE
+            smp-server-ubuntu-20_04-x86-64
+          fail_on_unmatched_files: true
+        env:
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}

.gitignore

@@ -1,4 +1,4 @@
 *.lock
-*.cabal
 *.db
+*.db.bak
 *.session.sql

CHANGELOG.md

@@ -0,0 +1,77 @@
+# 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.
+
+# 0.5.0
+
+- No changes in SMP server implementation - it is backwards compatible with v0.4.1
+- SMP agent changes:
+  - URI syntax for SMP queues and connection requests.
+  - long-term connections links ("contacts") in SMP agent protocol.
+  - agent command changes:
+    - `REQ` notification and `ACPT` command are used only with long-term connection links.
+    - `CONF` notification and `LET` commands are used for normal duplex connections.
+
+# 0.4.1
+
+- Include migrations in the package
+
+# 0.4.0
+
+- SMP server implementation and [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md) changes:
+  - support 3072 bit RSA key size
+  - add SMP queue quotas
+  - set default transport block size to 4096 bits
+  - allow SMP client to change transport block size during transport connection handshake
+- SMP agent implementation and protocol changes:
+  - additional connection confirmation step for initiating party
+  - automatically resume subscribed duplex connections once transport connection is resumed
+  - passing an arbitrary binary information between parties during the duplex connection handshake - can be used to identify parties
+  - asynchronous duplex connection handshake - the parties do not have to be online at the same time
+  - asynchronous message delivery - the agent does not need transport connection to accept client messages for delivery
+  - additional confirmation of message reception from the client to prevent message loss in case of process termination
+  - set transport block size to 8192 bits (in the future the agent protocol can allow to have different block sizes for different duplex connections)
+  - added client commands and notifications (see [agent protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md)):
+    - `REQ` - the notification about joining party establishing connection
+    - `ACPT` - the command to accept connection with the joining party
+    - `INFO` - the notification with the information from the initiating party
+    - `DOWN`/`UP` - the notifications about losing/resuming the connection
+    - `ACK` - the command to confirm that the message reception/processing is complete
+    - `MID` - the response to `SEND` confirming that the message is accepted by the agent
+    - `MERR` - the notification about permanent message delivery error (e.g., `ERR AUTH` indicating that the queue was removed)
+
+# 0.3.2
+
+- Support websockets
+- SMP server CLI commands
+
+# 0.3.1
+
+- Released to hackage.org
+- SMP agent protocol changes:
+  - move SMP server from agent commands NEW/JOIN to agent config
+  - send CON to user only when the 1st party responds HELLO
+- Fix REPLY vulnerability
+- Fix transaction busy error
+
+# 0.3.0
+
+- SMP encrypted transport over TCP
+- Standard X509/PKCS8 encoding for RSA keys
+- Sign and verify agent messages
+- Verify message integrity based on previous message hash and ID
+- Prevent timing attack allowing to determine if queue exists
+- Only allow correct RSA keys and signature sizes
+
+# 0.2.0
+
+- SMP client library
+- SMP agent with E2E encryption
+
+# 0.1.0
+
+- SMP protocol server implementation without encryption

README.md

@@ -3,9 +3,17 @@
 [![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.
+
+```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
+systemctl start smp-server
+```
+
 ## 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](./protocol/simplex-messaging.md) for client-server communication and [SMP agent protocol](./protocol/agent-protocol.md) to manage duplex connections via simplex queues on multiple SMP servers.
+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.
 
@@ -13,57 +21,93 @@ SimpleXMQ is implemented in Haskell - it benefits from robust software transacti
 
 ## SimpleXMQ roadmap
 
-- Streams - high performance message queues. See [Streams RFC](./rfcs/2021-02-28-streams.md) for details.
-- "Small" connection groups, when each message will be sent by the SMP agent to multiple connections with a single client command. See [Groups RFC](./rfcs/2021-03-18-groups.md) for details.
-- SMP agents cluster to share connections and message management by multiple agents (for example, it would enable multi-device use for [simplex-chat](https://github.com/simplex-chat/simplex-chat)).
 - SMP queue redundancy and rotation in SMP agent duplex connections.
-- "Large" groups design and implementation. 
+- 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](./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. 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.
 
 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.
 
 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 implements [SMP protocol](./protocol/simplex-messaging.md).
+SMP server implements [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md).
 
 ### SMP client library
 
-[SMP client](./src/Simplex/Messaging/Client.hs) is a Haskell library to connect to SMP servers that allows to:
+[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:
 - execute commands with a functional API.
 - receive messages and other notifications via STM queue.
 - automatically send keep-alive commands.
 
 ### SMP agent
 
-[SMP agent library](./src/Simplex/Messaging/Agent.hs) can be used to run SMP agent as part of another application and to communicate with the agent via STM queues, without serializing and parsing commands and responses.
+[SMP agent library](https://github.com/simplex-chat/simplexmq/blob/master/src/Simplex/Messaging/Agent.hs) can be used to run SMP agent as part of another application and to communicate with the agent via STM queues, without serializing and parsing commands and responses.
 
-Haskell type [ACommand](./src/Simplex/Messaging/Agent/Transmission.hs) represents SMP agent protocol to communicate via STM queues.
+Haskell type [ACommand](https://github.com/simplex-chat/simplexmq/blob/master/src/Simplex/Messaging/Agent/Protocol.hs) represents SMP agent protocol to communicate via STM queues.
 
 See [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI for the example of integrating SMP agent into another application.
 
-[SMP agent executable](./apps/smp-agent/Main.hs) can be used to run a standalone SMP agent process that implements plaintext [SMP agent protocol](./protocol/agent-protocol.md) via TCP port 5224, so it can be used via telnet. It can be deployed in private networks to share access to the connections between multiple applications and services.
+[SMP agent executable](https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-agent/Main.hs) can be used to run a standalone SMP agent process that implements plaintext [SMP agent protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md) via TCP port 5224, so it can be used via telnet. It can be deployed in private networks to share access to the connections between multiple applications and services.
 
 ## Using SMP server and SMP agent
 
-You can either run SMP server locally or try local SMP agent with the deployed demo server:
+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:
 
-`smp1.simplex.im:5223#pLdiGvm0jD1CMblnov6Edd/391OrYsShw+RgdfR0ChA=`
+`smp2.simplex.im#z5W2QLQ1Br3Yd6CoWg7bIq1bHdwK7Y8bEiEXBs/WfAg=` (London, UK)
+`smp3.simplex.im#nxc7HnrnM8dOKgkMp008ub/9o9LXJlxlMrMpR+mfMQw=` (Fremont, CA)
 
 It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI.
 
+[<img alt="Linode" src="https://raw.githubusercontent.com/simplex-chat/simplexmq/master/img/linode.svg" align="right" width="200">](https://cloud.linode.com/stackscripts/748014)
+
+## 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.
+
+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:
+
+- 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.
+- 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.
+
+Please submit an [issue](https://github.com/simplex-chat/simplexmq/issues) if any problems occur.
+
+[<img alt="DigitalOcean" src="https://raw.githubusercontent.com/simplex-chat/simplexmq/master/img/digitalocean.png" align="right" width="300">](https://marketplace.digitalocean.com/apps/simplex-server)
+
+## 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:
+
+- 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.
+
+Please submit an [issue](https://github.com/simplex-chat/simplexmq/issues) if any problems occur.
+
 ## SMP server design
 
-![SMP server design](./design/server.svg)
+![SMP server design](https://raw.githubusercontent.com/simplex-chat/simplexmq/master/design/server.svg)
 
 ## SMP agent design
 
-![SMP agent design](./design/agent2.svg)
+![SMP agent design](https://raw.githubusercontent.com/simplex-chat/simplexmq/master/design/agent2.svg)
 
 ## License
 
-[AGPL v3](./LICENSE)
+[AGPL v3](https://github.com/simplex-chat/simplexmq/blob/master/LICENSE)

apps/smp-agent/Main.hs

@@ -1,22 +1,17 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
 
 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.Client (smpDefaultConfig)
+import Simplex.Messaging.Transport (TCP, Transport (..))
 
 cfg :: AgentConfig
-cfg =
-  AgentConfig
-    { tcpPort = "5224",
-      rsaKeySize = 2048 `div` 8,
-      connIdBytes = 12,
-      tbqSize = 16,
-      dbFile = "smp-agent.db",
-      smpCfg = smpDefaultConfig
-    }
+cfg = defaultAgentConfig {smpServers = L.fromList ["localhost:5223#bU0K+bRg24xWW//lS0umO1Zdw/SXqpJNtm1/RrPLViE="]}
 
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
@@ -25,4 +20,4 @@ main :: IO ()
 main = do
   putStrLn $ "SMP agent listening on port " ++ tcpPort (cfg :: AgentConfig)
   setLogLevel LogInfo -- LogError
-  withGlobalLogging logCfg $ runSMPAgent cfg
+  withGlobalLogging logCfg $ runSMPAgent (transport @TCP) cfg

apps/smp-server/Main.hs

@@ -3,37 +3,52 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Main where
 
-import Control.Monad (unless, when)
+import Control.Monad.Except
+import Control.Monad.Trans.Except
 import qualified Crypto.Store.PKCS8 as S
 import Data.ByteString.Base64 (encode)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (toLower)
-import Data.Functor (($>))
-import Data.Ini (lookupValue, readIniFile)
+import Data.Ini (Ini, lookupValue, readIniFile)
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.X509 (PrivKey (PrivKeyRSA))
+import Network.Socket (ServiceName)
 import Options.Applicative
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.Env.STM
-import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog)
-import System.Directory (createDirectoryIfMissing, doesFileExist)
+import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath)
+import Simplex.Messaging.Transport (ATransport (..), TCP, Transport (..))
+import Simplex.Messaging.Transport.WebSockets (WS)
+import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
 import System.IO (IOMode (..), hFlush, stdout)
+import Text.Read (readEither)
 
-cfg :: ServerConfig
-cfg =
+defaultServerPort :: ServiceName
+defaultServerPort = "5223"
+
+defaultBlockSize :: Int
+defaultBlockSize = 4096
+
+serverConfig :: ServerConfig
+serverConfig =
   ServerConfig
-    { tcpPort = "5223",
-      tbqSize = 16,
+    { tbqSize = 16,
+      serverTbqSize = 128,
+      msgQueueQuota = 256,
       queueIdBytes = 12,
       msgIdBytes = 6,
-      storeLog = Nothing,
-      -- key is loaded from the file server_key in /etc/opt/simplex directory
+      -- below parameters are set based on ini file /etc/opt/simplex/smp-server.ini
+      transports = undefined,
+      storeLog = undefined,
+      blockSize = undefined,
       serverPrivateKey = undefined
     }
 
@@ -49,76 +64,168 @@ 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"
+
 main :: IO ()
 main = do
   opts <- getServerOpts
-  putStrLn "SMP Server (-h for help)"
-  ini <- readCreateIni opts
-  storeLog <- openStoreLog ini
-  pk <- readCreateKey
-  B.putStrLn $ "transport key hash: " <> serverKeyHash pk
-  putStrLn $ "listening on port " <> tcpPort cfg
-  runSMPServer cfg {serverPrivateKey = pk, storeLog}
+  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"
+
+getConfig :: ServerOpts -> ExceptT String IO ServerConfig
+getConfig opts = do
+  ini <- readIni
+  pk <- readKey ini
+  storeLog <- liftIO $ openStoreLog opts ini
+  pure $ makeConfig ini pk storeLog
+
+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}
+
+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
   { enableStoreLog :: Bool,
-    storeLogFile :: FilePath
+    storeLogFile :: FilePath,
+    serverKeyFile :: FilePath,
+    serverPort :: ServiceName,
+    blockSize :: Int,
+    enableWebsockets :: Bool
   }
 
-readCreateIni :: ServerOpts -> IO IniOpts
-readCreateIni ServerOpts {configFile} = do
-  createDirectoryIfMissing True cfgDir
-  doesFileExist configFile >>= (`unless` createIni)
-  readIni
+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}
   where
-    readIni :: IO IniOpts
-    readIni = do
-      ini <- either exitError pure =<< readIniFile configFile
-      let enableStoreLog = (== Right "on") $ lookupValue "STORE_LOG" "enable" ini
-          storeLogFile = either (const defaultStoreLogFile) T.unpack $ lookupValue "STORE_LOG" "file" ini
-      pure IniOpts {enableStoreLog, storeLogFile}
-    exitError e = do
-      putStrLn $ "error reading config file " <> configFile <> ": " <> e
-      exitFailure
-    createIni :: IO ()
-    createIni = do
-      confirm $ "Save default ini file to " <> configFile
-      writeFile
-        configFile
-        "[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\
-        \# enable: on\n\
-        \# file: /var/opt/simplex/smp-server-store.log\n"
+    opt :: String -> Text -> Text -> Ini -> String
+    opt def section key ini = either (const def) T.unpack $ lookupValue section key ini
 
-readCreateKey :: IO C.FullPrivateKey
-readCreateKey = do
-  createDirectoryIfMissing True cfgDir
-  let path = combine cfgDir "server_key"
-  hasKey <- doesFileExist path
-  (if hasKey then readKey else createKey) path
+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"
   where
-    createKey :: FilePath -> IO C.FullPrivateKey
-    createKey path = do
-      confirm "Generate new server key pair"
-      (_, pk) <- C.generateKeyPair newKeySize
-      S.writeKeyFile S.TraditionalFormat path [PrivKeyRSA $ C.rsaPrivateKey pk]
-      pure pk
-    readKey :: FilePath -> IO C.FullPrivateKey
-    readKey path = do
-      S.readKeyFile path >>= \case
-        [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.FullPrivateKey pk
-        [_] -> errorExit "not RSA key"
-        [] -> errorExit "invalid key file format"
-        _ -> errorExit "more than one key"
-      where
-        errorExit :: String -> IO b
-        errorExit e = putStrLn (e <> ": " <> path) >> exitFailure
+    err :: String -> ExceptT String IO b
+    err e = throwE $ e <> ": " <> serverKeyFile
+
+createKey :: IniOpts -> IO C.FullPrivateKey
+createKey IniOpts {serverKeyFile} = do
+  (_, pk) <- C.generateKeyPair newKeySize
+  S.writeKeyFile S.TraditionalFormat serverKeyFile [PrivKeyRSA $ C.rsaPrivateKey pk]
+  pure pk
+
+fileExists :: FilePath -> ExceptT String IO ()
+fileExists path = do
+  exists <- liftIO $ doesFileExist path
+  unless exists . throwE $ "file " <> path <> " not found"
+
+deleteIfExists :: FilePath -> IO ()
+deleteIfExists path = doesFileExist path >>= (`when` removeFile path)
 
 confirm :: String -> IO ()
 confirm msg = do
@@ -128,40 +235,43 @@ confirm msg = do
   when (map toLower ok /= "y") exitFailure
 
 serverKeyHash :: C.FullPrivateKey -> B.ByteString
-serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey
+serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey'
 
-openStoreLog :: IniOpts -> IO (Maybe (StoreLog 'ReadMode))
-openStoreLog IniOpts {enableStoreLog, storeLogFile = f}
-  | enableStoreLog = do
+openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode))
+openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f}
+  | l || l' = do
     createDirectoryIfMissing True logDir
-    putStrLn ("store log: " <> f)
     Just <$> openReadStoreLog f
-  | otherwise = putStrLn "store log disabled" $> Nothing
+  | otherwise = pure Nothing
 
-newtype ServerOpts = ServerOpts
-  { configFile :: FilePath
+data ServerOpts = ServerOpts
+  { serverCommand :: ServerCommand,
+    enableStoreLog :: Bool
   }
 
+data ServerCommand = ServerInit | ServerStart | ServerDelete
+
 serverOpts :: Parser ServerOpts
 serverOpts =
   ServerOpts
-    <$> strOption
-      ( long "config"
-          <> short 'c'
-          <> metavar "INI_FILE"
-          <> help ("config file (" <> defaultIniFile <> ")")
-          <> value defaultIniFile
+    <$> 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"
       )
-  where
-    defaultIniFile = combine cfgDir "smp-server.ini"
 
 getServerOpts :: IO ServerOpts
-getServerOpts = execParser opts
+getServerOpts = customExecParser p opts
   where
+    p = prefs showHelpOnEmpty
     opts =
       info
         (serverOpts <**> helper)
         ( fullDesc
             <> header "Simplex Messaging Protocol (SMP) Server"
-            <> progDesc "Start server with INI_FILE (created on first run)"
         )

img/linode.svg

@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 506.94 131.5"><path d="m109.65 58.21-18.21-10.07-15.37 9.38-.19 9.59-7.47-4.92-10.16 6.19-.44-10.48-10.48-7 10-5.17c-.08 0 0 1-1.48-34.34l-23.65-11.39-32.2 10 7.19 34.63 10.81 8.37-8.22 3.9 5.37 26.1 7.55 7.09-5.4 3.29 4.19 20.18 16.94 17.94c.08-.1 1.78-1.41 21.79-17.32l-.58-13.71 8.58 7.28c.12-.12 1.84-1.39 17.56-13.89l.61-10.14 6.48 4.5c.13-.12 1.58-1.22 14.26-11.33z" fill="#231f20"/><path d="m94.54 69 15.11-10.79-18.21-10.07-15.37 9.38z"/><path d="m92.87 88.2 1.67-19.2-18.47-11.48-.38 18.75z" fill="#004b16"/><path d="m68.22 107.73v-19.89l-18.66-14.15 1.47 19.54z" fill="#004b16"/><path d="m68.22 87.84 18.74-13.43-18.55-12.22-18.85 11.5z"/><path d="m38.43 131.48-2.98-20.32-18.15-17.8 4.19 20.18z" fill="#004b16"/><path d="m35.45 111.16 23.91-17.06-18.53-15.09-23.53 14.35z"/><path d="m33.9 100.6-3.94-26.88-20.22-16.81 5.41 26.07z" fill="#004b16"/><path d="m29.96 73.72 27.85-15.82-20.8-13.94-27.27 12.95z"/><path d="m28.07 60.88-5.4-36.81-22.67-14.06 7.19 34.62z" fill="#004b16"/><path d="m22.67 24.07 33.14-12.7-23.61-11.37-32.2 10.01z"/><g fill="#1cb35c"><path d="m107.13 76.87c-14.02 11.13-14.33 11.33-14.26 11.33 1.74-20.1 1.59-19.2 1.67-19.2 16-11.45 15-10.79 15.11-10.79z"/><path d="m85.78 93.84c-17.35 13.8-17.63 13.89-17.56 13.89-.17-20.82-.07-19.89 0-19.89 20-14.3 18.67-13.43 18.74-13.43z"/><path d="m60.22 114.16c-21.66 17.22-21.86 17.32-21.79 17.32-3.07-20.94-3-20.32-3-20.32 25.47-18.16 23.86-17.06 23.93-17.06z"/><path d="m55.81 11.37c1.52 35.37 1.4 34.34 1.48 34.34-28.66 14.89-29.29 15.17-29.22 15.17-5.52-37.63-5.47-36.81-5.4-36.81z"/><path d="m57.81 57.9c1.15 26.81 1 25.88 1.11 25.88-24.81 16.67-25.09 16.82-25 16.82-4-27.58-4-26.88-3.94-26.88z"/></g><path xmlns="http://www.w3.org/2000/svg" d="m151.61 14.24 16.58-4v79.88q0 13.13 7.83 15.65-3.84 7.31-13.13 7.3-11.28 0-11.28-15.66z"/><path d="m186.66 111.72v-57.42h-9.08v-13.6h25.86v71zm8.56-98.54a9.62 9.62 0 1 1 -9.62 9.62 9.63 9.63 0 0 1 9.62-9.62z"/><path d="m262.94 111.74v-41.06c0-6.05-1.16-10.48-3.48-13.26s-6.11-4.18-11.37-4.18a17.74 17.74 0 0 0 -7.8 2.06 18 18 0 0 0 -6.46 5.1v51.34h-16.59v-71h11.94l3 6.64q6.76-8 20-8 12.66 0 20 7.59t7.33 21.19v43.58z"/><path d="m288.42 76.06q0-16.26 9.38-26.47t24.77-10.21q16.19 0 25.14 9.82t9 26.86q0 17-9.12 27t-25 10q-16.18 0-25.17-10.12t-9-26.88zm17.24 0q0 23.47 16.91 23.48a14.54 14.54 0 0 0 12.31-6.11q4.55-6.09 4.54-17.37 0-23.14-16.85-23.15a14.61 14.61 0 0 0 -12.33 6.09q-4.58 6.11-4.58 17.06z"/><path d="m412.37 111.74v-4.31c-1.37 1.5-3.71 2.82-7 3.95a31.33 31.33 0 0 1 -10.15 1.69q-14.87 0-23.38-9.42t-8.52-26.27q0-16.84 9.78-27.42a32 32 0 0 1 24.51-10.58 32.37 32.37 0 0 1 14.72 3.32v-28.46l16.58-4v101.5zm0-54.06a17.6 17.6 0 0 0 -11.07-4.24q-10 0-15.33 6.07t-5.37 17.41q0 22.15 21.36 22.15a16.11 16.11 0 0 0 5.87-1.42c2.32-1 3.83-1.92 4.54-2.89z"/><path d="m505.55 81.3h-50.74q.46 8.49 5.83 13.2t14.46 4.7q11.34 0 17.25-5.9l6.43 12.7q-8.75 7.09-26.13 7.1-16.25 0-25.7-9.52t-9.45-26.58q0-16.78 10.38-27.2a33.91 33.91 0 0 1 24.9-10.41q15.45 0 24.81 9.22t9.35 23.48a46.28 46.28 0 0 1 -1.39 9.21zm-50.15-12.47h34.89q-1.73-15.58-17.24-15.59-14.2 0-17.65 15.59z"/></svg>

migrations/20210101_initial.sql

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

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

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

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

@@ -0,0 +1,9 @@
+# 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,18 +1,29 @@
-name: simplexmq
-version: 0.3.0
-#synopsis:
-#description:
+name: simplexmq-v0
+version: 0.5.3
+synopsis: SimpleXMQ message broker
+description:  |
+  This package includes <./docs/Simplex-Messaging-Server.html server>,
+  <./docs/Simplex-Messaging-Client.html client> and
+  <./docs/Simplex-Messaging-Agent.html agent> for SMP protocols:
+  .
+  * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md SMP protocol>
+  * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md SMP agent protocol>
+  .
+  See <https://github.com/simplex-chat/simplex-chat terminal chat prototype> built with SimpleXMQ broker.
+
 homepage: https://github.com/simplex-chat/simplexmq#readme
 license: AGPL-3
-author: Evgeny Poberezkin
-maintainer: evgeny@poberezkin.com
-copyright: 2020 Evgeny Poberezkin
-category: Web, System, Services, Cryptography
+author: simplex.chat
+maintainer: chat@simplex.chat
+copyright: 2020 simplex.chat
+category: Chat, Network, Web, System, Cryptography
 extra-source-files:
   - README.md
+  - CHANGELOG.md
+  - migrations/*.*
 
 dependencies:
-  - ansi-terminal == 0.10.*
+  - ansi-terminal >= 0.10 && < 0.12
   - asn1-encoding == 0.9.*
   - asn1-types == 0.3.*
   - async == 2.2.*
@@ -20,26 +31,33 @@ dependencies:
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
   - bytestring == 0.10.*
-  - containers
-  - cryptonite == 0.26.*
+  - composition == 1.0.*
+  - constraints >= 0.12 && < 0.14
+  - containers == 0.6.*
+  - cryptonite >= 0.27 && < 0.30
+  - direct-sqlite == 2.3.*
   - directory == 1.3.*
+  - file-embed >= 0.0.14.0 && <= 0.0.15.0
   - filepath == 1.4.*
-  - generic-random == 1.3.*
+  - http-types == 0.12.*
+  - generic-random >= 1.3 && < 1.5
   - iso8601-time == 0.1.*
   - memory == 0.15.*
-  - mtl
+  - mtl == 2.2.*
   - network == 3.1.*
   - network-transport == 0.5.*
-  - QuickCheck == 2.13.*
+  - QuickCheck == 2.14.*
+  - random >= 1.1 && < 1.3
   - simple-logger == 0.1.*
   - sqlite-simple == 0.4.*
-  - stm
-  - template-haskell == 2.15.*
+  - stm == 2.5.*
+  - template-haskell == 2.16.*
   - text == 1.2.*
   - time == 1.9.*
   - transformers == 0.5.*
   - unliftio == 0.2.*
-  - unliftio-core == 0.1.*
+  - unliftio-core == 0.2.*
+  - websockets == 0.12.*
   - x509 == 1.7.*
 
 library:
@@ -52,8 +70,8 @@ executables:
     dependencies:
       - cryptostore == 0.2.*
       - ini == 0.4.*
-      - optparse-applicative == 0.15.*
-      - simplexmq
+      - optparse-applicative >= 0.15 && < 0.17
+      - simplexmq-v0
     ghc-options:
       - -threaded
 
@@ -61,7 +79,7 @@ executables:
     source-dirs: apps/smp-agent
     main: Main.hs
     dependencies:
-      - simplexmq
+      - simplexmq-v0
     ghc-options:
       - -threaded
 
@@ -70,12 +88,11 @@ tests:
     source-dirs: tests
     main: Test.hs
     dependencies:
-      - simplexmq
+      - simplexmq-v0
       - hspec == 2.7.*
       - hspec-core == 2.7.*
       - HUnit == 1.6.*
-      - random == 1.1.*
-      - QuickCheck == 2.13.*
+      - QuickCheck == 2.14.*
       - timeit == 2.0.*
 
 ghc-options:

protocol/agent-protocol.md

@@ -4,6 +4,7 @@
 
 - [Abstract](#abstract)
 - [SMP agent](#smp-agent)
+- [SMP servers management](#smp-servers-management)
 - [SMP agent protocol components](#smp-agent-protocol-components)
 - [Duplex connection procedure](#duplex-connection-procedure)
 - [Communication between SMP agents](#communication-between-smp-agents)
@@ -11,73 +12,86 @@
     - [HELLO message](#hello-message)
     - [REPLY message](#reply-message)
     - [MSG message](#msg-message)
+    - [INV message](#inv-message)
+    - [ACK message](#ack-message)
+    - [NEW message](#new-message)
+    - [DEL message](#del-message)
 - [SMP agent commands](#smp-agent-commands)
   - [Client commands and server responses](#client-commands-and-server-responses)
     - [NEW command and INV response](#new-command-and-inv-response)
     - [JOIN command](#join-command)
-    - [CON notification](#con-notification)
+    - [CONF notification and LET command](#conf-notification-and-let-command)
+    - [REQ notification and ACPT command](#req-notification-and-acpt-command)
+    - [INFO and CON notifications](#info-and-con-notifications)
     - [SUB command](#sub-command)
-    - [SEND command and SENT response](#send-command-and-sent-response)
+    - [SEND command and MID, SENT and MERR responses](#send-command-and-mid-sent-and-merr-responses)
     - [MSG notification](#msg-notification)
     - [END notification](#end-notification)
     - [OFF command](#off-command)
     - [DEL command](#del-command)
-- [Connection invitation](#connection-invitation)
+- [Connection request](#connection-request)
 
 ## Abstract
 
 The purpose of SMP agent protocol is to define the syntax and the semantics of communications between the client and the agent that connects to [SMP](./simplex-messaging.md) servers.
 
 It provides:
-- convenient protocol to create and manage a bi-directional (duplex) connection to the users of SMP agents consisting of two separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections.
-- management of E2E encryption between SMP agents, generating ephemeral RSA keys for each connection.
-- SMP command authentication on SMP servers, generating ephemeral RSA keys for each SMP queue.
-- TCP transport handshake and encryption with SMP servers.
+- protocol to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the agent protocol.
+- management of E2E encryption between SMP agents, generating ephemeral asymmetric keys for each connection.
+- SMP command authentication on SMP servers, generating ephemeral keys for each SMP queue.
+- TCP/TLS transport handshake with SMP servers.
 - validation of message integrity.
 
-SMP agent protocols provides no encryption or any security on the client side - it is assumed that the agent is executed in the trusted and secure environment.
-
-The future versions of this protocol could provide:
-- managing redundant SMP queues with more than 1 queue in each direction.
-- managing simple symmetric groups as a foundation for chat groups and device synchronization.
-- agent cluster - synchronizing states of multiple agents.
-- secure "synchronous" streams with symmetric message encryption and connection-level authentication (requires extending [SMP protocol](./simplex-messaging.md)) - it can be used, e.g., for file transfers.
+SMP agent protocol provides no encryption or security on the client side - it is assumed that the agent is executed in the trusted and secure environment, in one of three ways:
+- via TCP network using secure connection.
+- 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 - [SimpleX Chat for terminal](https://github.com/simplex-chat/simplex-chat) uses this approach.
 
 ## SMP agent
 
-SMP agent is a client-side process or library that communicates via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) with other SMP agents according to the commands received from its users. This protocol is a middle layer in SMP protocols stack (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections").
+SMP agents communicate with each other via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) according to the commands received from its users. This protocol is a middle layer in SimpleX protocols (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections").
 
-The agent must have a persistent storage to manage the states of known connections and of the client-side information of two SMP queues that each connection consists of, and also the buffer of the most recent messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hash and id of the last received message.
+The agent must have a persistent storage to manage the states of known connections and of the client-side information of SMP queues that each connection consists of, and also the buffer of the most recent sent and received messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hashes and IDs of the last received and sent messages.
+
+## SMP servers management
+
+SMP agent protocol commands do not contain the addresses of the SMP servers that the agent will use to create and use the connections (excluding the server address in queue URIs used in JOIN command). The list of the servers is a part of the agent configuration and can be dynamically changed by the agent implementation:
+- by the client applications via any API that is outside of scope of this protocol.
+- by the agents themselves based on availability and latency of the configured servers.
 
 ## SMP agent protocol components
 
 SMP agent protocol has 3 main parts:
 
-- the syntax and semantics of messages that SMP agents exchange between each other in order to:
-  - negotiate establishing unidirectional (simplex) encrypted queues on SMP server(s)
+- the syntax and semantics of the messages that SMP agents exchange with each other in order to:
+  - negotiate establishing unidirectional (simplex) encrypted queues on SMP servers.
   - exchange client messages and delivery notifications, providing sequential message IDs and message integrity (by including the hash of the previous message).
-- the syntax and semantics of the commands (a higher level interface than SMP protocol) that are sent over TCP or other sequential protocol by agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two simplex SMP queues.
-- the syntax and semantics of the message that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including SMP server, queue ID and encryption key) to ensure [E2E encryption][1] the integrity of SMP queues and protection against active attacks ([MITM attacks][2]).
+- the syntax and semantics of the commands that are sent by the agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two or more SMP queues.
+- the syntax and semantics of the message that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including queue URIs) to protect [E2E encryption][1] from active attacks ([MITM attacks][2]).
 
 ## Duplex connection procedure
 
 ![Duplex connection procedure](./diagrams/duplex-messaging/duplex-creating.svg)
 
-The procedure of establishing a duplex connection is explained on the example of Alice and Bob creating a bi-directional connection comprised of two unidirectional (simplex) queues, using SMP agents (A and B) to facilitate it, and two different SMP servers (which could be the same server). It is shown on the diagram above and has these steps:
+The procedure of establishing a duplex connection is explained on the example of Alice and Bob creating a bi-directional connection consisting of two unidirectional (simplex) queues, using SMP agents (A and B) to facilitate it, and two different SMP servers (which could be the same server). It is shown on the diagram above and has these steps:
 
-1. Alice requests the new connection from the SMP agent A using `NEW` command.
-2. Agent A creates an SMP queue on the server (using [SMP protocol](./simplex-messaging.md)) and responds to Alice with the invitation that contains queue information and the encryption key Bob's agent B should use. The invitation format is described in [Connection invitation](#connection-invitation).
-3. Alice sends the invitation to Bob via any secure channel they have (out-of-band message).
-4. Bob sends `JOIN` command with the invitation as a parameter to agent B to accept the connection.
+1. Alice requests the new connection from the SMP agent A using SMP NEW command.
+2. Agent A creates an SMP connection on the server (using [SMP protocol](./simplex-messaging.md)) and responds to Alice with the invitation that contains queue information and the encryption key Bob's agent B should use. The invitation format is described in [Connection request](#connection-request).
+3. Alice sends the [connection request](#connection-request) to Bob via any secure channel (out-of-band message).
+4. Bob sends `JOIN` command with the connection request as a parameter to agent B to accept the connection.
 5. Establishing Alice's SMP queue (with SMP protocol commands):
-  - Agent B sends unauthenticated message to SMP queue with ephemeral key that will be used to authenticate commands to the queue, as described in SMP protocol.
-  - Agent A receives the KEY and secures the queue.
+  - Agent B sends an "SMP confirmation" with SMP SEND command to the SMP queue specified in the connection request - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info (profile, public key for E2E encryption, etc.). This message is encrypted using key passed in the connection request (or with the derived key, in which case public key for key derivation should be sent in clear text).
+  - Agent A receives the SMP confirmation containing Bob's key and info as SMP MSG.
+  - Agent A notifies Alice sending REQ notification with Bob's info.
+  - Alice accepts connection request with ACPT command.
+  - Agent A secures the queue with SMP KEY command.
   - Agent B tries sending authenticated SMP SEND command with agent `HELLO` message until it succeeds. Once it succeeds, Bob's agent "knows" the queue is secured.
 6. Agent B creates a new SMP queue on the server.
 7. Establish Bob's SMP queue:
-  - Agent B sends `REPLY` message with the invitation to this 2nd queue to Alice's agent (via the 1st queue).
-  - Agent A having received this `REPLY` message sends unauthenticated message to SMP queue with Alice agent's ephemeral key that will be used to authenticate commands to the queue, as described in SMP protocol.
-  - Bob's agent receives the key and secures the queue.
+  - Agent B sends `REPLY` message (SMP SEND command) with the connection request to this 2nd queue to Alice's agent (via the 1st queue) - this connection request SHOULD use "simplex" URI scheme.
+  - Agent A, having received `REPLY` message, sends unauthenticated message (SMP SEND) to SMP queue with Alice agent's ephemeral key that will be used to authenticate Alice's commands to the queue, as described in SMP protocol, and Alice's info.
+  - Bob's agent receives the key and Alice's information and secures the queue (SMP KEY).
+  - Bob's agent sends the notification `INFO` with Alice's information to Bob.
   - Alice's agent keeps sending `HELLO` message until it succeeds.
 8. Agents A and B notify Alice and Bob that connection is established.
   - Once sending `HELLO` succeeds, Alice's agent sends to Alice `CON` notification that confirms that now both parties can communicate.
@@ -85,17 +99,21 @@ The procedure of establishing a duplex connection is explained on the example of
 
 At this point the duplex connection between Alice and Bob is established, they can use `SEND` command to send messages. The diagram also shows how the connection status changes for both parties, where the first part is the status of the SMP queue to receive messages, and the second part - the status of the queue to send messages.
 
-The most communication happens between the agents and servers, from the point of view of Alice and Bob they have only 3 steps to do:
+The most communication happens between the agents and servers, from the point of view of Alice and Bob there are 4 steps (not including notifications):
 
 1. Alice requests a new connection with `NEW` command and receives the invitation.
-2. Alice passes invitation out-of-band to Bob.
-3. Bob accepts the connection by sending `JOIN` command with the invitation to his agent.
+2. Alice passes connection request out-of-band to Bob.
+3. Bob accepts the connection with `JOIN` command with the connection request to his agent.
+4. Alice accepts the connection with `ACPT` command.
+5. Both parties receive `CON` notification once duplex connection is established.
+
+Clients SHOULD support establishing duplex connection asynchronously (when parties are intermittently offline) by persisting intermediate states and resuming SMP queue subscriptions.
 
 ## Communication between SMP agents
 
-SMP agents communicate via SMP servers managing creation, deletion and operations of SMP queues.
+To establish duplex connections and to send messages on behalf of their clients, SMP agents communicate via SMP servers.
 
-Agents can use SMP message client body (the part of the SMP message after header - see [SMP protocol](./simplex-messaging.md)) to transmit agent client messages and exchange messages between each other.
+Agents use SMP message client body (the part of the SMP message after header - see [SMP protocol](./simplex-messaging.md)) to transmit agent client messages and exchange messages between each other.
 
 Each SMP message client body, once decrypted, contains 3 parts (one of them may include binary message body), as defined by `decryptedSmpMessageBody` syntax:
 
@@ -103,8 +121,9 @@ Each SMP message client body, once decrypted, contains 3 parts (one of them may
 - `agentMessage` - a command/message to the other SMP agent:
   - to establish the connection with two SMP queues (`helloMsg`, `replyQueueMsg`)
   - to send and to acknowledge user messages (`clientMsg`, `acknowledgeMsg`)
-  - to notify another agent about queue deletion (`deleteQueueMsg`)
-- `msgPadding` - an optional message padding to make all SMP messages have consistent size as an additional privacy protection measure.
+  - 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.
 
 ### Messages between SMP agents
 
@@ -112,31 +131,37 @@ 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
-agentMsgId = 1*DIGIT ; sequential agent message ID set by the sending agent
+agentMsgHeader = agentMsgId SP agentTimestamp 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 / deleteQueueMsg
-               / clientMsg / acknowledgeMsg
+agentMessage = helloMsg / replyQueueMsg /
+               clientMsg / invitationMsg/ acknowledgeMsg /
+               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 ; base64 encoded
+signatureVerificationKey = encoded
 
-replyQueueMsg = %s"REPLY" SP qInfo ; `qInfo` is the same as in out-of-band message
+replyQueueMsg = %s"REPLY" SP connectionRequest ; `connectionRequest` is defined below
 ; this message can only be sent by the second connection party
 
-deleteQueueMsg = %s"DEL" ; notification that recipient queue will be deleted
-; no need to notify the other party about suspending queue separately, as suspended and deleted queues are the same to the sender 
-; NOT SUPPORTED with the current implementation
-
 clientMsg = %s"MSG" SP size CRLF clientMsgBody CRLF ; CRLF is in addition to CRLF in decryptedSmpMessageBody
 size = 1*DIGIT
 clientMsgBody = *OCTET
 
-acknowledgeMsg = %s"ACK" SP agentMsgId SP ackStatus
-; NOT SUPPORTED with the current implementation
+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
 
@@ -146,26 +171,51 @@ ackErrorType = ackUnknownMsg / ackProhibitedMsg / ackSyntaxErr
 
 ackUnknownMsg = %s"UNKNOWN"
 
-ackProhibitedMsg = %"PROHIBITED" ; e.g. "HELLO" or "REPLY"
+ackProhibitedMsg = %s"PROHIBITED" ; unexpected message e.g. "HELLO" or "REPLY"
 
-ackSyntaxErr = %"SYNTAX" SP syntaxErrCode
+ackSyntaxErr = %s"SYNTAX" SP syntaxErrCode
 syntaxErrCode = 1*DIGIT ; TODO
+
+newQueueMsg = %s"NEW" SP 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
+; 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
 ```
 
 #### HELLO message
 
-This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram). It contains the verification key that the sender will use to cryptographically sign the messages.
+This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram). It MAY contain the public key that the recipient would use to verify messages signed by the sender.
 
-Sending agent might need to retry sending HELLO message, as it would not have any other confirmation that the queue is secured other than the success of sending this message with the signed SEND command of SMP protocol.
+Sending agent might need to retry sending HELLO message, as it would not have any other confirmation that the queue is secured other than the success of sending this message with the signed SMP SEND command.
 
 #### REPLY message
 
-This is the message that is sent by the agent that received an out-of-band invitation to pass the invitation to the reply SMP queue to the agent that originated the connection (see diagram).
+This is the message that is sent by the agent that received an out-of-band connection request to pass the connection request for the reply SMP queues to the agent that originated the connection (see diagram).
 
 #### MSG message
 
 This is the agent envelope used to send client messages once the connection is established. Do not confuse it with the MSG response from SMP server to the agent and MSG response from SMP agent to the client that are sent in different contexts.
 
+#### INV message
+
+This message is sent to the SMP queue(s) in `connReqContact`, to establish a new connection via existing unsecured queue, that acts as a permanent connection link of a user.
+
+#### ACK message
+
+This message is sent to confirm the client message reception. It includes received message number, message hash and the reception status.
+
+#### NEW message
+
+This message is sent to add an additional SMP queue to the connection. Unlike REPLY message it can be sent at any time.
+
+#### 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.
+
 ## SMP agent commands
 
 This part describes the transmissions between users and client-side SMP agents: commands that the users send to create and operate duplex connections and SMP agent responses and messages they deliver.
@@ -184,24 +234,34 @@ cId = encoded
 cName = 1*(ALPHA / DIGIT / "_" / "-")
 
 agentCommand = (userCmd / agentMsg) CRLF
-userCmd = newCmd / joinCmd
-          / acceptCmd / subscribeCmd
-          / sendCmd / acknowledgeCmd
-          / suspendCmd / deleteCmd
+userCmd = newCmd / joinCmd / letCmd / acceptCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd
+agentMsg = invitation / confMsg / connReqMsg / connInfo / connected / unsubscribed / connDown / connUp / messageId / sent / messageError / message / received / ok / error
 
-agentMsg = invitation / confirmation
-          / connected / unsubscribed
-          / message / sent / received
-          / ok / error
+newCmd = %s"NEW" SP connectionMode [SP %s"NO_ACK"] ; response is `invitation` or `error`
+; NO_ACK parameter currently not supported
 
-newCmd = %s"NEW" SP smpServer [SP %s"NO_ACK"]
-; response is `invitation` or `error`
-smpServer = srvHost [":" port] ["#" keyFingerprint]
-srvHost = hostname ; RFC1123, RFC5891
-port = 1*DIGIT
-keyFingerprint = encoded
+connectionMode = %s"INV" / %s"CON"
 
-invitation = %s"INV" SP qInfo
+invitation = %s"INV" SP connectionRequest ; `connectionRequest` is defined below
+
+confMsg = %s"CONF" SP confirmationId SP msgBody
+; msgBody here is any binary information identifying connection request
+
+letCmd = %s"LET" SP confirmationId SP msgBody
+; msgBody here is any binary information identifying connecting party
+
+confirmationId = 1*DIGIT
+
+connReqMsg = %s"REQ" SP invitationId SP msgBody
+; msgBody here is any binary information identifying connection request
+
+acceptCmd = %s"ACPT" SP invitationId SP msgBody
+; msgBody here is any binary information identifying connecting party
+
+invitationId = 1*DIGIT
+
+connInfo = %s"INFO" SP msgBody
+; msgBody here is any binary information identifying connecting party
 
 connected = %s"CON"
 
@@ -211,17 +271,16 @@ unsubscribed = %s"END"
 ; when another agent (or another client of the same agent)
 ; subscribes to the same SMP queue on the server
 
-joinCmd = %s"JOIN" SP qInfo
-                [SP (smpServer / %s"NO_REPLY")] ; reply queue SMP server
-                ; server from qInfo is used by default
-                [SP %s"NO_ACK"]         
+connDown = %s"DOWN"
+; lost connection (e.g. because of Internet connectivity or server is down)
+
+connUp = %s"UP"
+; restored connection
+
+joinCmd = %s"JOIN" SP connectionRequest SP connInfo [SP %s"NO_REPLY"] [SP %s"NO_ACK"]
+; `connectionRequest` and `connInfo` are defined below
 ; response is `connected` or `error`
-
-confirmation = %s"CONF" SP partyId SP partyInfo
-; currently not implemented
-
-acceptCmd = %s"LET" SP partyId ; response is `ok` or `error`
-; currently not implemented
+; parameters NO_REPLY and NO_ACK are currently not supported
 
 suspendCmd = %s"OFF" ; can be sent by either party, response `ok` or `error`
 
@@ -236,63 +295,91 @@ binaryMsg = size CRLF msgBody CRLF ; the last CRLF is in addition to CRLF in the
 size = 1*DIGIT ; size in bytes
 msgBody = *OCTET ; any content of specified size - safe for binary
 
+messageId = %s"MID" SP agentMsgId
+
 sent = %s"SENT" SP agentMsgId
 
-message = %s"MSG" SP msgIntegrity
-          SP %s"R=" agentMsgId "," agentTimestamp ; receiving agent
-          SP %s"B=" brokerMsgId "," srvTimestamp ; broker (server)
-          SP %s"S=" agentMsgId "," agentTimestamp ; sending agent
-          SP binaryMsg
-agentMsgId = 1*DIGIT
-srvTimestamp = date-time ; RFC3339
-agentTimestamp = date-time
-msgIntegrity = ok / messageError
+messageError = %s"MERR" SP agentMsgId SP <errorType>
 
-messageError = %s"ERR" SP messageErrorType
-messageErrorType = skippedMsgErr / badMsgIdErr / badHashErr
+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 
+brokerMsgId = encoded
+brokerTimestamp = <date-time>
+msgIntegrity = ok / msgIntegrityError
 
-skippedMsgErr = %"IDS" SP missingFromMsgId SP missingToMsgId
-badMsgIdErr = %"ID" SP previousMsgId ; ID is lower than the previous
-badHashErr = %"HASH"
+msgIntegrityError = %s"ERR" SP msgIntegrityErrorType
+msgIntegrityErrorType = skippedMsgErr / badMsgIdErr / badHashErr
 
-acknowledge = %s"ACK" SP agentMsgId ; ID assigned by receiving agent (in MSG "R")
+skippedMsgErr = %s"NO_ID" SP missingFromMsgId SP missingToMsgId
+badMsgIdErr = %s"ID" SP previousMsgId ; ID is lower than the previous
+badHashErr = %s"HASH"
+
+missingFromMsgId = agentMsgId
+missingToMsgId = agentMsgId
+previousMsgId = agentMsgId
+
+acknowledgeCmd = %s"ACK" SP agentMsgId ; ID assigned by receiving agent (in MSG "R")
+
+received = %s"RCVD" SP agentMsgId SP msgIntegrity
+; ID assigned by sending agent (in SENT response)
 ; currently not implemented
 
-received = %s"RCVD" SP agentMsgId ; ID assigned by sending agent (in SENT response)
-; currently not implemented
+msgStatus = ok | error
 
 ok = %s"OK"
 
-error = %s"ERR" SP errorType
-
-encoded = base64
+error = %s"ERR" SP <errorType>
 ```
 
 ### Client commands and server responses
 
 #### NEW command and INV response
 
-`NEW` command is used to create a connection and an invitation to be sent out-of-band to another protocol user. It should be used by the client of the agent that initiates creating a duplex connection.
+`NEW` command is used to create a connection and a connection request to be sent out-of-band to another protocol user (the joining party). It should be used by the client of the agent that initiates creating a duplex connection (the initiating party).
 
-`INV` response is sent by the agent to the client.
+`INV` response is sent by the agent to the client of the initiating party.
+
+`NEW` command has `connectionMode` parameter to define the connection mode - to be used to communicate with a single contact (invitation mode, `connectionMode` is `INV`) or to accept connection requests from anybody (contact mode, `connectionMode` is `CON`). The type of connection request is determined by `connectionMode` parameter.
 
 #### JOIN command
 
-It is used to create a connection and accept the invitation received out-of-band. It should be used by the client of the agent that accepts the connection.
+It is used to create a connection and accept the connection request received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party).
 
-#### CON notification
+#### CONF notification and LET command
 
-It is sent by both agents managing duplex connection to their clients once the connection is established and ready to accept client messages.
+When the joining party uses `JOIN` command to accept connection invitation created with `NEW INV` command, the initiating party will receive `CONF` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
+
+To continue with the connection the initiating party should use `LET` command.
+
+#### REQ notification and ACPT command
+
+When the joining party uses `JOIN` command to connect to the contact created with `NEW CON` command, the initiating party will receive `REQ` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
+
+To continue with the connection the party that created the contact should use `ACPT` command.
+
+#### INFO and CON notifications
+
+After the initiating party proceeds with the connection using `ACPT` command, the joining party will receive `INFO` notification that can be used to identify the initiating party or for any other purpose.
+
+Once the connection is established and ready to accept client messages, both agents will send `CON` notification to their clients.
 
 #### SUB command
 
 This command can be used by the client to resume receiving messages from the connection that was created in another TCP/client session. Agent response to this command can be `OK` or `ERR` in case connection does not exist (or can only be used to send connections - e.g. when the reply queue was not created).
 
-#### SEND command and SENT response
+#### SEND command and MID, SENT, RCVD and MERR responses
 
-`SEND` command is used to the client to send messages
+`SEND` command is used by the client to send messages.
 
-`SENT` response is sent by the agent to confirm that the message was delivered to the SMP server. Message ID in this response is the sequential message number that includes both sent and received messages in the connection.
+`MID` response with the message ID (the sequential message number that includes both sent and received messages in the connection) is sent to the client to confirm that the message is accepted by the agent, before it is sent to the SMP server.
+
+`SENT` notification is sent by the agent to confirm that the message was delivered to at least one of SMP servers. This notification contains the same message ID as `MID` notification. `SENT` notification, depending on network availability, can be sent at any time later, potentially in the next client session.
+
+`RCVD` notification is sent by the agent when it receives `ACK` message from the receiving agent. This notification contains reception status, only one successful notification will be sent, and multiple error notifications will be sent in case `ACK` had error status.
+
+In case of the failure to send the message for any other reason than network connection or message queue quota - e.g. authentication error (`ERR AUTH`) or syntax error (`ERR CMD error`), the agent will send to the client `MERR` notification with the message ID, and this message delivery will no longer be attempted to this SMP queue.
 
 #### MSG notification
 
@@ -305,6 +392,12 @@ It is sent by the agent to the client when agent receives the message from the S
 
 It is sent by the agent to the client when agent receives SMP protocol `END` notification from SMP server. It indicates that another agent has subscribed to the same SMP queue on the server and the server terminated the subscription of the current agent.
 
+#### DOWN and UP notifications
+
+These notifications are sent when server or network connection is, respectively, `DOWN` or back `UP`.
+
+All the subscriptions made in the current client session will be automatically resumed when `UP` notification is received.
+
 #### OFF command
 
 It is used to suspend the receiving SMP queue - sender will no longer be able to send the messages to the connection, but the recipient can retrieve the remaining messages. Agent response to this command can be `OK` or `ERR`. This command is irreversible.
@@ -313,19 +406,38 @@ It is used to suspend the receiving SMP queue - sender will no longer be able to
 
 It is used to delete the connection and all messages in it, as well as the receiving SMP queue and all messages in it that were remaining on the server. Agent response to this command can be `OK` or `ERR`. This command is irreversible.
 
-## Connection invitation
+## Connection request
 
-Connection invitation `qInfo` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another invitation is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users).
+Connection request `connectionRequest` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another connection request is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users).
 
-Connection invitation is a text with the following syntax:
+Connection request syntax:
 
 ```
-qInfo = %s"smp::" smpServer "::" queueId "::" ephemeralPublicKey
-queueId = encoded
-ephemeralPublicKey = %s"rsa:" encoded ; RSA key for sender to encrypt messages X509 base64 encoded
+connectionRequest = connectionScheme "/" connReqType "#/?smp=" smpQueues "&e2e=" e2eEncryption
+connReqType = %s"invitation" / %s"contact"
+; this parameter has the same meaning as connectionMode in agent commands
+; `NEW INV` creates `invitation` connection request, `NEW CON` - `contact`
+connectionScheme = (%s"https://" clientAppServer) | %s"simplex:"
+clientAppServer = hostname [ ":" port ]
+; client app server, e.g. simplex.chat
+e2eEncryption = encryptionScheme ":" publicKey
+encryptionScheme = %s"rsa" ; end-to-end encryption and key exchange protocols,
+                           ; the current hybrid encryption scheme (RSA-OAEP/AES-256-GCM-SHA256)
+                           ; will be replaced with double ratchet protocol and DH key exchange.
+publicKey = <base64url X509 SPKI key encoding>
+smpQueues = smpQueue [ "," 1*smpQueue ] ; SMP queues for the connection
+smpQueue = <URL-encoded queueURI defined in SMP protocol>
 ```
 
+All parameters are passed via URI hash to avoid sending them to the server (in case "https" scheme is used) - they can be used by the client-side code and processed by the client application. Parameters `smp` and `e2e` can be present in any order, any unknown additional parameters SHOULD be ignored.
+
+`clientAppServer` is not an SMP server - it is a server that shows the instruction on how to download the client app that will connect using this connection request. This server can also host a mobile or desktop app manifest so that this link is opened directly in the app if it is installed on the device.
+
+"simplex" URI scheme in `connectionProtocol` can be used instead of client app server, to connect without creating any web traffic. Client apps MUST support this URI scheme.
+
+See SMP protocol [out-of-band messages](./simplex-messaging.md#out-of-band-messages) for syntax of `queueURI`.
+
 [1]: https://en.wikipedia.org/wiki/End-to-end_encryption
 [2]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack
 [3]: https://tools.ietf.org/html/rfc5234
-[4]: https://tools.ietf.org/html/rfc7405
+[4]: https://tools.ietf.org/html/rfc7405

protocol/diagrams/duplex-messaging/duplex-creating.mmd

@@ -27,11 +27,14 @@ sequenceDiagram
   note over BA: status: NONE/NEW
 
   note over BA, AA: 5. establish Alice's SMP queue
-  BA ->> AS: SEND: KEY: sender's server key
+  BA ->> AS: SEND: Bob's info and sender server key (SMP confirmation)
   note over BA: status: NONE/CONFIRMED
   activate BA
-  AS ->> AA: MSG: KEY: sender's server key
+  AS ->> AA: MSG: Bob's info and<br>sender server key
   note over AA: status: CONFIRMED/NONE
+  AA ->> AS: ACK: confirm message
+  AA ->> A: REQ: connection request ID<br>and Bob's info
+  A ->> AA: ACPT: accept connection request,<br>send Alice's info
   AA ->> AS: KEY: secure queue
   note over AA: status: SECURED/NONE
 
@@ -40,6 +43,7 @@ sequenceDiagram
   note over BA: status: NONE/ACTIVE
   AS ->> AA: MSG: HELLO: Alice's agent<br>knows Bob can send
   note over AA: status: ACTIVE/NONE
+  AA ->> AS: ACK: confirm message
 
   note over BA, BS: 6. create Bob's SMP queue
   BA ->> BS: NEW: create SMP queue
@@ -51,12 +55,15 @@ sequenceDiagram
   note over BA: status: PENDING/ACTIVE
   AS ->> AA: MSG: REPLY: invitation<br>to connect
   note over AA: status: ACTIVE/NEW
+  AA ->> AS: ACK: confirm message
 
-  AA ->> BS: SEND: KEY: sender's server key
+  AA ->> BS: SEND: Alice's info and sender's server key
   note over AA: status: ACTIVE/CONFIRMED
   activate AA
-  BS ->> BA: MSG: KEY: sender's server key
+  BS ->> BA: MSG: Alice's info and<br>sender's server key
   note over BA: status: CONFIRMED/ACTIVE
+  BA ->> B: INFO: Alice's info
+  BA ->> BS: ACK: confirm message
   BA ->> BS: KEY: secure queue
   note over BA: status: SECURED/ACTIVE
 
@@ -65,6 +72,7 @@ sequenceDiagram
   note over AA: status: ACTIVE/ACTIVE
   BS ->> BA: MSG: HELLO: Bob's agent<br>knows Alice can send
   note over BA: status: ACTIVE/ACTIVE
+  BA ->> BS: ACK: confirm message
 
   note over A, B: 8. notify users about connection success
   AA ->> A: CON: connected

protocol/overview.md

@@ -0,0 +1,259 @@
+# 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

@@ -7,11 +7,13 @@
 - [SMP Model](#smp-model)
 - [Out-of-band messages](#out-of-band-messages)
 - [Simplex queue](#simplex-queue)
+- [SMP queue URI](#smp-queue-uri)
 - [SMP procedure](#smp-procedure)
 - [SMP qualities and features](#smp-qualities-and-features)
 - [Cryptographic algorithms](#cryptographic-algorithms)
 - [Simplex queue IDs](#simplex-queue-ids)
-- [Server privacy requirements](#server-privacy-requirements)
+- [Server security requirements](#server-security-requirements)
+- [Message delivery notifications](#message-delivery-notifications)
 - [SMP commands](#smp-commands)
   - [Correlating responses with commands](#correlating-responses-with-commands)
   - [Command authentication](#command-authentication)
@@ -20,14 +22,19 @@
     - [Create queue command](#create-queue-command)
     - [Subscribe to queue](#subscribe-to-queue)
     - [Secure queue command](#secure-queue-command)
+    - [Enable notifications command](#enable-notifications-command)
     - [Acknowledge message delivery](#acknowledge-message-delivery)
     - [Suspend queue](#suspend-queue)
     - [Delete queue](#delete-queue)
   - [Sender commands](#sender-commands)
     - [Send message](#send-message)
+  - [Notifier commands](#notifier-commands)
+    - [Subscribe to queue notifications](#subscribe-to-queue-notifications)
   - [Server messages](#server-messages)
     - [Queue IDs response](#queue-ids-response)
     - [Deliver queue message](#deliver-queue-message)
+    - [Notifier queue ID response](#notifier-queue-id-response)
+    - [Deliver message notification](#deliver-message-notification)
     - [Subscription END notification](#subscription-end-notification)
     - [Error responses](#error-responses)
     - [OK response](#ok-response)
@@ -66,36 +73,15 @@ The SMP model has three communication participants: the recipient, the message b
 
 SMP server manages multiple "simplex queues" - data records on the server that identify communication channels from the senders to the recipients. The same communicating party that is the sender in one queue, can be the recipient in another - without exposing this fact to the server.
 
-The queue record consists of 2 unique random IDs generated by the server, one for the recipient and another for the sender, and 2 keys to authenticate the recipient and the sender respectively, provided by the client. The users of SMP protocol must use a unique key for each queue, to avoid the possibility of aggregating and analysing their queues in case SMP server is compromised.
+The queue record consists of 2 unique random IDs generated by the server, one for the recipient and another for the sender, and 2 keys to authenticate the recipient and the sender respectively, provided by the client. The users of SMP protocol must use a unique key for each queue, to avoid the possibility of aggregating and analyzing their queues in case SMP server is compromised.
 
 Creating and using the queue requires sending commands to the SMP server from the recipient and the sender - they are described in detail in [SMP commands](#smp-commands) section.
 
 ## Out-of-band messages
 
-The out-of-band message with the queue information is sent via some trusted alternative channel from the recipient to the sender. This message is used to share the encryption (a.k.a. "public") key that the sender will use to encrypt the messages (to be decrypted by the recipient), sender queue ID, server hostname and any other information necessary to establish secure encrypted connection with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol).
+The out-of-band message with the queue information is sent via some trusted alternative channel from the recipient to the sender. This message is used to share one or several [queue URIs](#smp-queue-uri) that parties can use to establish the initial connection, the encryption scheme and, it can include the public key(s) for end-to-end encryption.
 
-The [ABNF][8] syntax of the message is:
-
-```abnf
-outOfBandMsg = "smp::" server "::" queueId "::" encryptionKey
-server = <hostname> [":" port] ["#" serverKeyHash]
-port = 1*DIGIT
-serverKeyHash = encoded
-queueId = encoded
-encryptionKey = %s"rsa:" x509encoded ; the recipient's RSA public key for sender to encrypt messages
-x509encoded = <base64 X509 key encoding>
-encoded = <base64 encoded binary>
-```
-
-`hostname` can be IP address or domain name, as defined in RFC 1123, section 2.1.
-
-`port` is optional, the default TCP port for SMP protocol is 5223.
-
-`serverKeyHash` is an optional hash of the server transport key used during transport handshake (see [Appendix A](#appendix-a)).
-
-Encryption keys are encoded using [X509][11] specification.
-
-Defining the approach to out-of-band message passing is out of scope of this protocol.
+The approach to out-of-band message passing and their syntax should be defined in application-level protocols.
 
 ## Simplex queue
 
@@ -123,6 +109,29 @@ Queue is defined by recipient ID `RID` and sender ID `SID`, unique for the serve
 
 The protocol uses different IDs for sender and recipient in order to provide an additional privacy by preventing the correlation of senders and recipients commands sent over the network - in case the encrypted transport is compromised, it would still be difficult to correlate senders and recipients without access to the queue records on the server.
 
+## SMP queue URI
+
+The SMP queue URIs MUST include server identity, queue hostname, an optional port, sender queue ID and the public key that the clients must use to verify responses. Server identity is used to establish secure connection protected from MITM attack with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol).
+
+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] 
+srvHost = <hostname> ; RFC1123, RFC5891
+port = 1*DIGIT
+serverIdentity = base64url
+queueId = base64url
+base64url = <base64url encoded binary> ; RFC4648, section 5
+```
+
+`hostname` can be IP address or domain name, as defined in RFC 1123, section 2.1.
+
+`port` is optional, the default TCP port for SMP protocol is 5223.
+
+`serverIdentity` is a required hash of the server certificate SPKI block (without line breaks, header and footer) used by the client to validate server certificate during transport handshake (see [Appendix A](#appendix-a))
+
 ## SMP procedure
 
 The SMP procedure of creating a simplex queue on SMP server is explained using participants Alice (the recipient) who wants to receive messages from Bob (the sender).
@@ -137,7 +146,7 @@ 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 sign the following commands related to the same queue, 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. 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).
 
     5. The server sends `"IDS"` response with queue IDs (`queueIds`):
 
@@ -175,7 +184,7 @@ To create and start using a simplex queue Alice and Bob follow these steps:
 
 5. Alice secures the queue `RID` with `"KEY"` command so only Bob can send messages to it (see [Secure queue command](#secure-queue-command)):
 
-    1. She sends the `KEY` command with `RID` signed with "private" key `RK` to update the queue to only accept requests signed by "private" key `SK` provided by Bob.
+    1. She sends the `KEY` command with `RID` signed with "private" key `RK` to update the queue to only accept requests signed by "private" key `SK` provided by Bob. This command contains unique "public" key `SK` previously generated by Bob.
 
     2. From this moment the server will accept only signed commands to `SID`, so only Bob will be able to send messages to the queue `SID` (corresponding to `RID` that Alice has).
 
@@ -265,7 +274,7 @@ Simplex Messaging Protocol:
 
   - One unique "public" key is used by the servers to authenticate requests to send the messages into the queue, and another unique "public" key - to retrieve the messages from the queue. "Unique" here means that each "public" key is used only for one queue and is not used for any other context - effectively, this key is not public and does not represent any participant identity.
 
-  - Both "public" keys are provided to the server by the queue recipient when the queue is created.
+  - Both recipient and sender "public" keys are provided to the server by the queue recipient. "Public" key `RK` is provided when the queue is created, public key `SK` is provided when the queue is secured.
 
   - The "public" keys known to the server and used to authenticate commands from the participants are unrelated to the keys used to encrypt and decrypt the messages - the latter keys are also unique per each queue but they are only known to participants, not to the servers.
 
@@ -273,29 +282,36 @@ Simplex Messaging Protocol:
 
 ## Cryptographic algorithms
 
-Simplex messaging clients need to cryptographically sign commands for the following operations:
+Simplex messaging clients and servers must cryptographically sign commands, responses and messages for the following operations:
 
 - With the recipient's key `RK` (server to verify):
   - create the queue (`NEW`)
   - subscribe to queue (`SUB`)
   - secure the queue (`KEY`)
+  - enable queue notifications (`NKEY`)
   - acknowledge received messages (`ACK`)
   - suspend the queue (`OFF`)
   - delete the queue (`DEL`)
 - With the sender's key `SK` (server to verify):
   - send messages (`SEND`)
+- With the optional notifier's key:
+  - subscribe to message notifications (`NSUB`)
+- With the server's key (for recipient and sender to verify)
+  - queue IDs response (`IDS`)
+  - notifier queue ID response (`NID`)
+  - delivered messages (`MSG`)
+  - `OK` and `ERR` responses (excluding error responses not related to a queue)
 
-To sign and verify commands, clients and servers MUST use RSA-PSS algorithm defined in [RFC3447][2].
+To sign/verify transmissions clients and servers MUST use Ed25519 or Ed448 algorithm defined in [RFC8709][15].
 
-To optionally sign and verify messages, clients SHOULD use RSA-PSS algorithm.
+To encrypt/decrypt message bodies delivered to the recipients, servers/clients MUST use x25519 or x448 algorithm defined in [RFC8709][15] to derive the shared secret (TODO encryption scheme).
 
-To encrypt and decrypt messages, clients and servers SHOULD use RSA-OAEP algorithm defined in [RFC3447][2].
+Clients MUST encrypt message bodies sent via SMP servers - the protocol for this end-to-end encryption should be chosen by the clients using SMP protocol.
 
 The reasons to use these algorithms:
 
-- They are supported by WebCrypto API.
-- They are more widely supported than ECC algorithms.
-- They are newer versions than RSA-PKCS1-v1_5 encryption and signature schemes.
+- Faster operation than RSA algorithms.
+- DH key exchange provides forward secrecy.
 
 Future versions of the protocol may allow different cryptographic algorithms.
 
@@ -318,6 +334,18 @@ Simplex messaging server implementations MUST NOT create, store or send to any o
 
 - Any other information that may compromise privacy or [forward secrecy][4] of communication between clients using simplex messaging servers.
 
+## Message delivery notifications
+
+Supporting message delivery while the client mobile app is not running requires sending push notifications with the device token. All alternative mechanisms for background message delivery are unreliable, particularly on iOS platform. Obviously, supporting push notification delivery by simply subscribing to messages would reduce meta-data privacy as it allows to see all queues that a given device uses.
+
+To protect the privacy of the recipients, there are several commands in SMP protocol that allow enabling and subscribing to message notifications from SMP queues, using separate set of "notifier keys" and via separate queue IDs - as long as SMP server is not compromised, these notifier queue IDs cannot be correlated with recipient or sender queue IDs.
+
+The clients can optionally instruct a dedicated push notification server to subscribe to notifications and deliver push notifications to the device, which can then retrieve the messages in the background and send local notifications to the user - this is out of scope of SMP protocol. The commands that SMP protocol provides to allow it:
+
+- `enableNotifications` (`"NKEY"`) with `notifierId` (`"NID"`) response - see [Enable notifications command](#enable-notifications-command).
+- `subscribeNotifications` (`"NSUB"`) - see [Subscribe to queue notifications](#subscribe-to-queue-notifications).
+- `messageNotification` (`"NMSG"`) - see [Deliver message notification](#deliver-message-notification).
+
 ## SMP commands
 
 Commands syntax below is provided using [ABNF][8] with [case-sensitive strings extension][8a].
@@ -326,14 +354,18 @@ Each transmission between the client and the server must have this format/syntax
 
 ```abnf
 transmission = [signature] SP signed SP pad ; pad to the fixed block size
-signed = [corrId] SP [queueId] SP cmd
-cmd = ping / recipientCmd / send / serverMsg
-recipientCmd = create / subscribe / secure / acknowledge / suspend / delete
-serverMsg = pong / queueIds / message / unsubscribed / ok / error
+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
 signature = encoded
-; empty signature can be used with "create", "send" and "ping" commands and server messages
+; empty signature can be used with "send" before the queue is secured with secure command
+; signature is always empty with "ping" and "serverMsg"
 encoded = <base64 encoded binary>
 ```
 
@@ -343,23 +375,24 @@ The syntax of specific commands and responses is defined below.
 
 ### Correlating responses with commands
 
-The server should send `queueIds`, `error` and `ok` responses in the same order within each queue ID as the commands received in the transport connection, so that they can be correlated by the clients. To simplify correlation of commands and responses, the server should use the same `corrId` in the response as in the command sent by the client.
+The server should send `queueIds`, `error` and `ok` responses in the same order within each queue ID as the commands received in the transport connection, so that they can be correlated by the clients. To simplify correlation of commands and responses, the server must use the same `corrId` in the response as in the command sent by the client.
 
 If the transport connection is closed before some responses are sent, these responses should be discarded.
 
 ### Command authentication
 
-SMP servers must authenticate all transmissions (excluding `ping` and `send` commands) by verifying the provided signatures. Command signature should be generated by applying RSA-PSS algorithm to the `signed` block of the transmission using the key associated with the queue ID (sender's or recipient's, depending on which queue ID is used).
+SMP servers must authenticate all transmissions (excluding `ping` and initial `send` commands) by verifying the client signatures. Command signature should be generated by applying the algorithm specified for the queue to the `signed` block of the transmission, using the key associated with the queue ID (recipient's, sender's or notifier's, depending on which queue ID is used).
 
 ### Keep-alive command
 
-To keep the transport connection alive and to generate noise traffic the clients should use `ping` command to which the server responds with `pong` response. This command should be sent unsigned and without queue ID.
+To keep the transport connection alive and to generate noise traffic the clients should use `ping` command to which the server responds with `ok` response. This command should be sent unsigned and without queue ID.
 
 ```abnf
 ping = %s"PING"
-pong = %s"PONG"
 ```
 
+This command is always send unsigned.
+
 ### Recipient commands
 
 Sending any of the commands in this section (other than `create`, that is sent without queue ID) is only allowed with recipient's ID (`RID`). If sender's ID is used the server must respond with `"ERR AUTH"` response (see [Error responses](#error-responses)).
@@ -369,24 +402,45 @@ 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 recipientKey
-recipientKey = %s"rsa:" x509encoded ;  the recipient's RSA public key for this queue
+create = %s"NEW" SP recipientSignaturePublicKey SP recipientDhPublicKey
+recipientSignaturePublicKey = signaturePublicKey
+; the recipient's 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
+; that the server will use to encrypt delivered message bodies
+
+encryptionScheme = %s"x25519" | %s"x448"
+; TODO change to define the encryption scheme, e.g. "crypto_box"
+
 x509encoded = <base64 X509 key encoding>
 ```
 
-If the queue is created successfully, the server must send `queueIds` response with the recipient's and sender's queue IDs:
+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
+; that the server will use to encrypt delivered message bodies to the recipient
 recipientId = encoded
 senderId = encoded
 ```
 
-This response should be sent with empty queue ID (the second part of the transmission).
-
 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 `recipientKey` that was passed in the transmission.
+`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).
 
 #### Subscribe to queue
 
@@ -400,19 +454,42 @@ If subscription is successful the server must respond with the first available m
 
 The first message will be delivered either immediately or as soon as it is available; to receive the following message the recipient must acknowledge the reception of the message (see [Acknowledge message delivery](#acknowledge-message-delivery)).
 
+This transmission and its response MUST be signed.
+
 #### Secure queue command
 
 This command is sent by the recipient to the server to add sender's key to the queue:
 
-```
-secure = %s"KEY" SP senderKey
-senderKey = %s"rsa:" x509encoded ; the sender's RSA public key for this queue
+```abnf
+secure = %s"KEY" SP senderSignaturePublicKey
+senderSignaturePublicKey = signaturePublicKey
+; the sender's key to verify SEND commands for this queue
 ```
 
-`senderKey` is received from the sender as part of the first message - see [Send Message Command](#send-message-command).
+`senderKey` is received from the sender as part of the first message - see [Send Message](#send-message) command.
 
 Once the queue is secured only signed messages can be sent to it.
 
+#### Enable notifications command
+
+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
+```
+
+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
+```
+
+This response is sent with the recipient's queue ID (the third part of the transmission).
+
+To receive the message notifications, `subscribeNotifications` command ("NSUB") must be sent signed with the notifier's key.
+
 #### Acknowledge message delivery
 
 The recipient should send the acknowledgement of message delivery once the message was stored in the client, to notify the server that the message should be deleted:
@@ -484,12 +561,26 @@ The body should be encrypted with the recipient's "public" key (`EK`); once decr
 decryptedBody = [clientHeader] CRLF clientBody CRLF
 clientHeader = senderKeyMsg
 senderKeyMsg = %s"KEY" SP senderKey
-senderKey = %s"rsa:" x509encoded ; the sender's RSA public key for this queue
+senderKey = signatureScheme ":" x509encoded ; the sender's public key to sign SEND commands for this queue
 clientBody = *OCTET
 ```
 
 `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.
 
+### Notifier commands
+
+#### Subscribe to queue notifications
+
+The push notifications server (notifier) must use this command to start receiving message notifications from the queue:
+
+```abnf
+subscribeNotifications = %s"NSUB"
+```
+
+If subscription is successful the server must respond with `ok` response if no messages are available. The notifier will be receiving the message notifications from this queue until the transport connection is closed or until another transport connection subscribes to notifications from the same simplex queue - in this case the first subscription should be cancelled and [subscription END notification](#subscription-end-notification) delivered.
+
+The first message notification will be delivered either immediately or as soon as the message is available.
+
 ### Server messages
 
 #### Queue IDs response
@@ -503,7 +594,9 @@ 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 msgId SP timestamp SP size SP msgBody SP
+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>
 ```
@@ -512,7 +605,27 @@ timestamp = <date-time defined in RFC3339>
 
 `timestamp` - the UTC time when the server received the message from the sender, must be in date-time format defined by [RFC 3339][10]
 
-`binaryMsg` - see syntax in [Send message](#send-message)
+`msgBody` - 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.
+
+This is done to prevent the possibility of correlation of incoming and outgoing traffic of SMP server inside transport protocol.
+
+#### Notifier queue ID response
+
+Server must respond with this message when queue notifications are enabled.
+
+See its syntax in [Enable notifications command](#enable-notifications-command)
+
+#### Deliver message notification
+
+The server must deliver message notifications to all simplex queues that were subscribed with `subscribeNotifications` command ("NSUB") on the currently open transport connection. The syntax for the message notification delivery is:
+
+```abnf
+messageNotification = %s"NMSG"
+```
+
+Message notification does not contain any message data or meta-data, it only notifies that the message is available.
 
 #### Subscription END notification
 
@@ -534,7 +647,8 @@ No further messages should be delivered to unsubscribed transport connection.
   - 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 command](#send-message-command)).
+- 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`).
 - internal server error (`INTERNAL`).
 
@@ -564,52 +678,47 @@ ok = %s"OK"
 
 Both the recipient and the sender can use TCP or some other, possibly higher level, transport protocol to communicate with the server. The default TCP port for SMP server is 5223.
 
-By default, the client and server should use the protocol presented below, that does not depend on a centralized certificate authority.
+For scenarios when meta-data privacy is critical, it is recommended that clients:
+- communicating over Tor network,
+- establish a separate connection for each SMP queue,
+- send noise traffic (using PING command).
 
-Transport is encrypted with [AEAD-GCM][12] protocol with two random symmetric AES 256-bit keys and two random base IVs that will be agreed during the handshake. Both client and the server should maintain two 32-bit word counters, one for the sent and one for the received messages. The IV for each message should be computed by xor-ing the sequential message counter, starting from 0, with the first 32 bits of agreed base IV (the number is encoded in network byte order).
+In addition to that, the servers can be deployed as Tor onion services.
 
-To establish the session keys and base IVs, the server should have an asymmetric key pair generated during server deployment and unknown to the clients. The users should know the key hash (256 bits) in advance in order to be able to validate the server public key during transport connection handshake.
+The transport protocol should provide the following:
+- server authentication (by matching server certificate hash with `serverIdentity`),
+- forward secrecy (by encrypting the traffic using ephemeral keys agreed during transport handshake),
+- integrity (preventing data modification by the attacker without detection),
+- unique channel binding (`sessionIdentifier`) to include in the signed part of SMP transmissions.
 
-The handshake sequence is the following:
+By default, the client and server communicate using [TLS 1.3 protocol][13] restricted to:
+- TLS_AES_256_GCM_SHA384 cypher suite,
+- 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.
+- server and client TLS configuration should not allow resuming the sessions.
 
-1. Once the connection is established, the server sends the `server_header` followed by its public RSA key encoded in X509 binary (not base-64 encoded) format to the client.
-2. The client compares the SHA256 hash of the received key with the hash it already has (e.g. received as part of connection invitation or as SMP server configuration). If the hash does not match, the client must terminate the connection.
-3. If the hash is the same, the client should generate two random symmetric 256-bit AES keys and two base IVs that will be used as session keys/IVs by the client and the server.
-4. The client then should create the `client_handshake` block and send it to the server, encrypted using [RSA-OAEP][2] scheme with the server public key: `rsa-encrypt(client_handshake)`. `snd_aes_key` and `snd_base_iv` will be used by the client to encrypt **sent** messages and by the server to decrypt them, `rcv_aes_key` and `rcv_base_iv` will be used by the client to decrypt **received** messages and by the server to encrypt them. `client_handshake` also contains `block_size` and reserved `protocol` blocks (see syntax).
-5. The server should decrypt the received AES keys and base IVs with its private RSA key.
-6. In case of successful decryption, the server should send encrypted welcome block (`encrypted_welcome_block`) that contains SMP protocol version supported by the server.
+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.
 
-All the subsequent data, both from the client and from the server, should be sent padded to the fixed agreed block size, encrypted with symmetric AES keys and base IVs (incremented by counters on both sides), that were sent by the client during the handshake. If the application needs to transmit a larger message, it should be broken down into fragments.
+Once TLS handshake is complete, client and server will exchange blocks of fixed size (16384 bytes).
 
-Handshake blocks sent by the client and the server have this syntax:
+The first block sent by the client should be `clientHello` and the server should respond with `serverHello`:
 
 ```abnf
-server_header = block_size protocol key_size
-block_size = 4*4(OCTET) ; 4-byte block size sent by the server
-protocol = 2*2(%x00) ; 0, reserved
-key_size = 2*2(OCTET) ; the size of the encoded key in bytes (binary encoded in X509 standard)
+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.
 
-client_handshake = client_block_size protocol snd_aes_key snd_base_iv rcv_aes_key rcv_base_iv
-client_block_size = 4*4(OCTET) ; 4-byte block size sent by the client,
-; to confirm or override the block size sent by the server
-client_protocol = 2*2(%x00) ; 0, reserved
-snd_aes_key = 32*32(OCTET)
-snd_base_iv = 16*16(OCTET)
-rcv_aes_key = 32*32(OCTET)
-rcv_base_iv = 16*16(OCTET)
-
-transport_block = aes_body_auth_tag aes_encrypted_body
-; size is sent by server during handshake, usually 4096 bytes
-aes_body_auth_tag = 16*16(OCTET)
-aes_encrypted_body = 1*OCTET
-
-encrypted_welcome_block = transport_block
-welcome_block = smp_version SP pad ; decrypt(encrypted_welcome_block)
-smp_version = %s"v" 1*DIGIT "." 1*DIGIT "." 1*DIGIT ["-" 1*ALPHA "." 1*DIGIT] ; in semver format
-  ; for example: v123.456.789-alpha.7
+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
 ```
 
+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.
+
 [1]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack
 [2]: https://en.wikipedia.org/wiki/End-to-end_encryption
 [3]: https://en.wikipedia.org/wiki/QR_code
@@ -622,3 +731,6 @@ pad = 1*OCTET
 [10]: https://tools.ietf.org/html/rfc3339
 [11]: https://tools.ietf.org/html/rfc5280
 [12]: https://tools.ietf.org/html/rfc7714
+[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

rfcs/2021-03-18-groups.md

@@ -1,25 +0,0 @@
-# SMP agent groups
-
-## Problems
-
-- device/user profile synchronisation
-- chat group communication
-
-Both problems would require message broadcast between a group of SMP agents.
-
-## Solution: basic symmetric groups via SMP agent protocol
-
-Additional commands and message envelopes to SMP agent protocol to provide an abstraction layer for device synchronisation and chat groups.
-
-The groups are fully symmetric, all agent who are members of the group have equal rights and can join and leave group at any time.
-
-All the information about the groups is stored only in agents, the commands are used to synchronise the group state between the agents.
-
-```abnf
-group_command = create_group / add_to_group / remove_from_group / leave_group
-group_response = group_created / added_to_group / removed_from_group
-group_notification = added_to_group_by / removed_from_group_by / left_group
-create_group = %s"GNEW " group_name ; cAlias must be empty
-add_to_group = %s"GADD " group_name ; cAlias is the connection to add to the group
-added_to_group = %s"GADDED " name ; cAlias is the connection added to the group
-```

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

@@ -0,0 +1,52 @@
+# Open connections
+
+## Problem
+
+This proposal describes how to create invitations that can be used multiple times. 
+
+It can be used for:
+- an open invitation to join a group.
+- an open invitation to connect to a person - e.g. QR code/invitation link on a person's website, or passed from one person to another.
+- part of the solution for public DNS-based addresses (when a directory server would map address in some domain name#example.tld to an open invitation).
+
+## Solution
+
+No changes to SMP protocol - a dedicated unsecured SMP queue is used to receive invitations to connect that are sent in encrypted agent message. An unsecured SMP queue is used as an out-of-band channel for establishing another SMP queue.
+
+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):
+  - 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).
+
+e.g. `smp:<queue_type>::<server1>/<queue_id1>,<server2>/<queue_id2>::<key1>`
+
+`queue_type`:
+  - `prv` - original invitation, should be accepted with KEY SMP message
+  - `pub` - open invitation, should be accepted with INV SMP message (to be added to SMP protocol)
+
+```mmd
+A ->> AA: oidA? OPEN
+AA ->> A: oidA INV pub_inv
+
+...
+
+B ->> BA: cidBA? JOIN pub_inv len CRLF meta_binary CRLF ; change command to require meta, len can be 0 for the current usage ; meta is used to send user profile
+BA ->> B: cidBA OK
+BA ->> SA ->> AA: INV prv_inv CRLF meta_binary
+AA ->> A: oidA CONF invID len meta_binary
+A ->> AA cidAB? LET invID
+
+establish connection as usual
+
+BA ->> B: cidBA CON
+AA ->> A: cidAB CON
+```
+
+That protocol requires addressing the current problem when an invitation cannot be accepted when the party that generated the invitation is not online.
+
+Questions.
+
+1. Do we need to differentiate the semantics of the invitation on the syntax level, or should we allow to just manage it outside of protocol when the receiving agent decides which SMP messages to accept and which to ignore (KEY / INV).

rfcs/done/2021-01-26-crypto.md

@@ -145,9 +145,9 @@ For each message, the agent performs the following actions to encrypt it:
 3. Encrypt the message using this AES256 key with [AES-GCM-SIV](https://hackage.haskell.org/package/cryptonite-0.28/docs/Crypto-Cipher-AESGCMSIV.html) (AEAD scheme) using the function `encrypt` with a random nonce.
 4. Encrypt the AES256 key with public encryption key for the queue using RSA-OAEP [encrypt](https://hackage.haskell.org/package/cryptonite-0.28/docs/Crypto-PubKey-RSA-OAEP.html#v:encrypt) function parameterized with [SHA256](https://hackage.haskell.org/package/cryptonite-0.28/docs/Crypto-Hash-Algorithms.html#t:SHA256) algorithm.
 5. The message to send is concatenation of:
-  1. encrypted AES256 key,
-  2. AuthTag from encryption in step 3, 
-  3. encrypted message (in this order)
+    1. encrypted AES256 key,
+    2. AuthTag from encryption in step 3, 
+    3. encrypted message (in this order).
 
 As there is no additional data that is sent e2e in clear text, we potentially need some simpler algorithm, possibly the one implemented in the tutorial, that implements authenticated encryption without additional (unencrypted) data.
 
@@ -155,7 +155,7 @@ Or we could use this algorithm to allow some data that is sent e2e in clear text
 
 ### Message decryption
 
-Agent decrypt the message following the same steps in the opposite order
+Agent decrypts the message following the same steps in the opposite order:
 
 1. Split encrypted message to AES256 key, AuthTag and encrypted message - tag and key have fixed size (?).
 2. Decrypt AES256 key using the decryption key (the private key that recipient has).

rfcs/groups.mmd

@@ -0,0 +1,135 @@
+sequenceDiagram
+  participant M as Existing<br>member (M)
+  participant MA as Existing<br>member<br>agent (MA)
+  participant A as Alice (A)
+  participant AA as Alice's<br>agent (AA)
+  participant BA as Bob's<br>agent (BA)
+  participant B as Bob (B)
+
+  note over A, AA: 1. create new group (no members)
+  A ->> AA: G:gidA? NEW<br>(gidA - group ID of this group for A,<br>can be generated by the agent)
+
+  note over AA: create "internal" broadcast associated with the group<br>(B: NEW)
+
+  AA ->> A: G:gidA OK
+
+  note over A, BA: 2. add Bob to group
+
+  A ->> AA: C:idAB INTRO G:gidA gInfo<br>(idAB - conn alias A has for B)
+  
+  note over AA: generate new random ID for member B (midB, unique per group)<br>initiate "internal" connection gidAB for B in group<br>(internal means that it is not visible to the clients<br>and cannot be used with client commands)
+
+  AA ->> BA: via idAB: GROUP C:midB g:gInvAB gInfo
+  BA ->> B: C:idBA REQ G:invID gInfo<br>(invID - to refer to it in ACPT)
+  B ->> BA: G:gidB? ACPT G:invID<br>(RJCT G:invID could be added)
+
+  note over BA: create group and "internal" broadcast associated with the group<br>(B: NEW)
+
+  BA ->> B: G:gidB OK
+
+  BA ->> AA: establish internal connection gidBA (using g:gInvAB) for A in group
+
+  note over BA, AA: add connections gidBA and gidAB to broadcasts<br>(B: ADD)
+ 
+  AA ->> A: G:gidA CON C:idAB
+  BA ->> B: G:gidA CON C:idBA
+
+  note over M, B: For each existing member M:<br>create and accept internal introduction between connections, related to the group, via gidAB/BA/AM/MA, connections created are gidBM and gidMB<br>The fact that the introduction arrives via connection allocated for the group, allows agents identify it as a new group member, ID used in introductions is group-scoped member ID.
+
+  note over A, BA: once all members were sent to B
+  AA ->> BA: via gidAB: MEM C:midB
+
+  note over BA, B: once all members are connected
+  BA ->> B: G:gidB MEM
+
+  note over A, AA: once all members reported connection
+  AA ->> A: G:gidA MEM C:idAB
+
+  note over M, AA: for each member M
+
+  AA ->> MA: via gidAM: MEM C:midB
+  MA ->> M: G:gidM MEM C:idMB
+  
+  note over M, B: 3. B sends message to the group
+
+  B ->> BA: G:gidB SEND msg
+
+  note over BA: send message via associated broadcast and respond to client with SENT notifications
+
+  BA ->> B: G:gidB SENT C:idBA intMsgID
+  BA ->> B: G:gidB SENT C:idBM intMsgID
+  
+  note over BA, B: once sent to all
+  BA ->> B: G:gidB SENT intMsgID
+
+  AA ->> A: G:gidA MSG C:idAB intMsgID msgdata
+  A ->> AA: G:gidA ACK intMsgID
+  AA ->> BA: via gidAB: RCVD extMsgID hash sig
+  BA ->> B: G:gidA RCVD C:idBA intMsgID status<br>(status - message integrity check)
+
+  MA ->> M: G:gidM MSG C:idMB intMsgID msgdata
+  M ->> MA: G:gidM ACK intMsgID
+  MA ->> BA: via gidMB: RCVD extMsgID hash sig
+  BA ->> B: G:gidM RCVD C:idBM intMsgID status
+
+  note over BA, B: once received by all
+  BA ->> B: G:gidM RCVD intMsgID status
+
+  note over M, B: 4a. A leaves group
+
+  A ->> AA: G:gidA LEAVE
+  AA ->> A: G:gidA OK
+  AA ->> BA: via gidAB: LEFT
+  note over AA: remove gidAB, remove from broadcast
+  note over BA: remove gidBA, remove from broadcast
+  BA ->> B: G:gidB LEFT C:idBA
+
+  AA ->> MA: via gidAM: LEFT
+  note over AA: remove gidAM, remove from broadcast
+  note over MA: remove gidMA, remove from broadcast
+  MA ->> M: G:gidM LEFT C:idMA
+
+  AA ->> A: G:gidA LEFT
+
+  note over B, BA: if all members left
+  BA ->> B: G:gidB: EMPTY
+
+  note over M, B: 4b. A removes B from group
+
+  A ->> AA: G:gidA REM C:idAB
+  AA ->> A: G:gidA OK
+  AA ->> BA: via gidAB: OUT
+  note over BA: remove gidBA, all gidBM
+  BA ->> B: G:gidB OUT C:idBA
+
+  note over AA: remove gidAB
+  AA ->> A: G:gidA OK
+
+  note over M, B: below steps happen for each existing member M
+
+  AA ->> MA: via gidAM: REM C:midB
+  note over MA: remove gidMB
+  MA ->> AA: via gidMA: REMD C:midB
+  MA ->> M: G:gidM REMD C:idMB C:idMA<br>(B removed by A)
+
+  note over A, AA: once all members removed B
+
+  AA ->> A: G:gidA REMD C:idAB<br>(B removed by this agent)
+
+  note over M, B: 4c. A deletes group
+  A ->> AA: G:gidA DEL
+  AA ->> A: G:gidA OK
+  
+  AA ->> BA: via gidAB: DEL
+  note over BA: remove all group connections and messages
+  BA ->> B: G:gidB DELD C:idBA<br>(group deleted by A)
+  BA ->> AA: via gidBA: DELD
+  AA ->> A: G:gidA DELD C:idAB
+
+  AA ->> MA: via gidAM: DEL
+  note over MA: remove all group connections and messages
+  MA ->> M: G:gidM DELD C:idMA<br>(group deleted by A)
+  MA ->> AA: via gidMA: DELD
+  AA ->> A: G:gidA DELD C:idAM
+
+  AA ->> A: G:gidA DELD<br>(group deleted by this agent - all confirmed)

rfcs/intro.mmd

@@ -0,0 +1,42 @@
+sequenceDiagram
+  participant A as Alice (A) - the introducer
+  participant AA as Alice's<br>agent (AA)
+  participant B as Bob (B) - introduced
+  participant BA as Bob's<br>agent (BA)
+  participant M as Mark (M) - introduced to
+  participant MA as Mark's<br>agent (MA)
+
+  note over A, AA: 1. create introduction
+  A ->> AA: C:idAB INTRO C:idAM infoM<br>(idAB - conn alias A has for B,<br>idAM - for M)
+  AA ->> A: C:idAB OK
+
+  note over A, BA: 2. send intro to Bob
+
+  AA ->> BA: via idAB: INTRO C:extIntroIdM infoM
+  BA ->> B: C:idBA REQ C:intIntroIdM infoM
+  B ->> BA: C:idBM? ACPT C:intIntroIdM
+  BA ->> B: C:idBM OK
+
+  note over BA: 3. create connection for  M idBM
+
+  BA ->> AA: via idBA: INV C:extIntroIdM invBM infoB
+
+  note over AA, M: 4. send intro to Mark
+
+  AA ->> MA: via idAM: REQ C:extIntroIdB invBM infoB
+
+  note over MA, B: 5. Mark connects to Bob
+
+  MA ->> M: C:idMA REQ C:intIntroIdB infoB
+  M ->> MA: C:idMB? ACPT C:intIntroIdB
+  MA ->> M: C:idMB OK
+
+  MA ->> BA:  establish connection idBM -> idMB
+
+  note over A, MA: 6. notify all clients
+
+  MA ->> M: C:idMB CON
+  MA ->> AA: via idMA: CON C:extIntroIdB
+  BA ->> B: C:idBM CON
+  BA ->> AA: via idBA: CON C:extIntroIdB
+  AA ->> A: C:idAB CON C:idAM

rfcs/protocol_overview.md

@@ -0,0 +1,146 @@
+# Overview of SMP agent protocol commands
+
+## Connections
+
+### Commands and messages
+
+A initiates connection, B accepts
+
+- command `C:idB? NEW` - create connection
+- message `C:idB INV cInv`
+- command `C:idA? JOIN cInv replyMode` - join connection (response `OK`, followed by `CON`)
+- *message* `C:idB REQ prv:invId infoB` - request from B joining sent to A (not implemented)
+- *command* `C:idB ACPT prv:invId` - A confirms B joining (not implemented)
+- message `C:id CON` - connection is established
+- command `C:id SUB` - subscribe to connection
+- message `C:id END` - unsubscribed from connection
+- command `C:idB SEND msg` - send message
+- message `C:idA SENT msgId` - confirmation that the message is sent
+- message `C:id MSG msgId msgMeta msgIntegrity msgBody` - received message
+- *command* `C:idB ACK msgId` - acknowledge message reception (not implemented)
+- *message* `C:idA RCVD msgId msgIntegrity` - confirmation of message reception and integrity (not implemented)
+- command `C:id OFF` - suspend connection
+- command `C:id DEL` - delete connection
+- message `C:id? OK` - command confirmation
+- message `C:id? ERR e` - error
+
+### Envelopes
+
+- `MSG `
+- `HELLO verificationKey ackMode`
+- `REPLY replyInv`
+
+## Broadcasts
+
+### Commands & messages
+
+- command `B:id? NEW` - create broadcast (response is `B:id OK`)
+- command `B:id SEND msg` - broadcast message (response is multiple `C:id SENT msgId` or ERR, separately for each connection, followed by `B:id SENT msgId` once sent to all)
+- message `B:id SENT msgId` - notification that the message is sent and its internal ID, same as SENT
+- command `B:id ADD cId` - add existing connection to a broadcast (response is `B:id OK` or `ERR`, e.g. if bId is used)
+- command `B:id REM cId` - remove connection from the broadcast (response is `REMD`)
+- message `B:id REMD cId` - connection removed from the broadcast
+- message `B:id EMPTY` - all connections were removed from the broadcast
+- command `B:id DEL` - delete broadcast (response is `B:id OK`)
+- command `B:id LS` - list connections in broadcast, response is `B:id MEM space_separated_connections`
+- message `B:id MEM space_separated_connections`
+
+## Open/public connection
+
+### Commands
+
+- command `O:id? NEW` - create open connection
+- message `O:id INV oInv` - open invitation
+- command `C:id? JOIN oInv replyMode` - join connection (response `OK`, followed by `CON`)
+- message `O:id REQ open:invId infoB` - confirmation from B joining sent to A
+- command `C:idC? ACPT open:invId` - note, that it creates new connection, keeping OPEN connection
+- command `O:id SUB` - subscribe to open connection
+- message `O:id END` - unsubscribed from open connection
+- command `O:id OFF` - suspend open connection
+- command `O:id DEL` - delete open connection
+- message `O:id? OK` - command confirmation
+- message `O:id? ERR e` - error
+
+## Introductions
+
+### Commands
+
+- command `C:idAB INTRO C:idAM infoM` - introduce connection cIdB to connection cIdM (response is `OK`)
+- message `C:idBA REQ C:invId infoM` - notification to confirm introduction
+- command `C:idBM? ACPT C:invId` - accept offer to be introduced (response is `cIdBM OK`, followed by `ICON`)
+- message `C:idBM CON` - confirmation that connection is established to both introduced parties
+- message `C:idAB CON C:idAM` - confirmation that connection is established to the introducer
+
+### Envelopes
+
+- `INTRO C:extIntroIdM infoM` - new introduction offered by introducer
+- `INV C:extIntroIdB prv:invBM infoB` - invitation to join connection from B to M sent via A (can be pub:)
+- `REQ C:extIntroIdB prv:invBM infoB` - new introduction forwarded by introducer
+- `CON C:extIntroIdM` - confirmation that the connection is established sent by both introduced parties to the introducer
+
+## Groups
+
+## Agent commands and messages syntax
+
+- command `G:gId? NEW` - create group (response is `G:gId OK`)
+- command `C:cId INTRO G:gId gInfo` - add existing connection to a group
+- message `C:cId REQ g:invID gInfo` - invitation to join the group
+- command `G:gId? ACPT g:invId` - accept invitation (response is `G gId OK`)
+- message `G:gId CON C:cId` - 2 connections created with some group member (both for group and direct messages)
+- message `G:gId MEM [C:cId]` - connection created with all group members for a given member or current client
+- command `G:gId SEND msg` - send message to group
+- message `G:gId SENT msgId` - notification that the message is sent and its internal ID, same as SENT
+- message `G:gId MSG C:cId msgId msgdata` - received group message from cId, msgdata is the same set of parameters as in `MSG`
+- command `G:gId ACK msgId` - acknowledge message reception by the client
+- message `G:gId RCVD t:cId msgId status` - message delivery notification
+- command `G:gId LEAVE` - leave the group
+- message `G:gId LEFT [C:cId]` - connection cId left the group
+- command `G:gId REM C:cId` - remove group member (response is `gId OK`, followed by `GREMD` notification)
+- message `G:gId REMD C:cId [C:cId]` - member removed
+- message `G:gId OUT C:cId` - you are removed (see question below - should it be just a sequence of GLEFT?)
+- message `G:gId EMPTY` - all members left the group and it is now empty
+- command `G:gId DEL` - delete the group (response is `gId OK`)
+- message `G:gId DELD [C:cId]` - group deleted
+
+## Agent message envelopes syntax
+
+- `GROUP C:mid G:inv gInfo` - invitation to join the group
+- `MEM C:mid` - confirmation that member connected to all members
+- `LEFT` - notification that member left the group
+- `OUT` - you are removed from the group
+- `REM C:mid` - remove member mid from the group
+- `REMD C:mid` - confirmation that member is removed
+- `DEL` - group is deleted
+- `DELD` - confirmation that group is deleted
+
+## Commands and objects
+
+| Dir     | Command / message    | (C)onnection | (O)pen connection | (B)roadcast | (G)roup |
+|:---------:|:--------------------:|:------------:|:-----------------:|:-----------:|:-------:|
+| command | `t:id? NEW`           | ✓ | ✓ | ✓ | ✓ |
+| command | `C:id INTRO t:id info` | ✓ | - | - | ✓ |
+| message | `t:id INV inv`        | ✓ | ✓ | - | - |
+| command | `C:id? JOIN inv replyMode info` | ✓ | - | - | - |
+| message | `t:id REQ invId info` | ✓ | ✓ | - | ✓ |
+| command | `t:id? ACPT invId`    | ✓ | - | - | ✓ |
+| message | `t:id CON [C:id]`     | ✓ | - | - | ✓ |
+| message | `t:id MEM [C:id]`     | - | - | - | ✓ |
+| command | `t:id SUB`            | ✓ | ✓ | - | ✓ |
+| message | `t:id END`            | ✓ | ✓ | - | ✓ |
+| command | `t:id OFF`            | ✓ | ✓ | - | - |
+| command | `t:id DEL`            | ✓ | ✓ | ✓ | ✓ |
+| message | `t:id DELD [C:Id]`    | ✓ | ✓ | ✓ | ✓ |
+| command | `t:id SEND msg`       | ✓ | - | ✓ | ✓ |
+| message | `t:id SENT [t':id] msgId` | ✓ | - | ✓ | ✓ |
+| message | `t:id MSG [C:id] msgId msgdata` | ✓ | - | - | ✓ |
+| command | `t:id ACK msgId`      | ✓ | - | - | ✓ |
+| message | `t:id RCVD [t':id] msgId status` | ✓ | - | - | ✓ |
+| command | `t:id ADD C:id`       | - | - | - | ✓ |
+| command | `t:id REM C:id`       | - | - | ✓ | ✓ |
+| command | `t:id REMD C:id`      | - | - | ✓ | ✓ |
+| message | `t:id EMPTY`          | - | - | ✓ | ✓ |
+| message | `G:id OUT C:id`       | - | - | - | ✓ |
+| command | `t:id LS`             | - | - | ✓ | ✓ |
+| message | `t:id MS cIds`        | - | - | ✓ | ✓ |
+| command | `G:id LEAVE`          | - | - | - | ✓ |
+| message | `G:id LEFT [C:id]`    | - | - | - | ✓ |

rfcs/rejected/2021-05-23-broadcast.md

@@ -0,0 +1,50 @@
+# SMP agent broadcast
+
+## Problem
+
+Support agent message broadcast to multiple connections.
+
+It is done in ad-hoc way as part of the previous [groups proposal](./2021-05-23-groups2.md) - this proposal defines broadcast as a separate agent primitive to simplify group management.
+
+It can also be used for other purposes when the same message needs to be sent to multiple recipients without creating groups.
+
+## Solution
+
+A minimal protocol of additional client commands to create, manage and use broadcasts.
+
+From the point of view of the recipient this will look like a normal message, as if the sending agent executed multiple send commands (in fact, broadcast can be implemented by agent sending itself multiple SEND commands)
+
+### Commands and messages
+
+- command `B:bId? NEW` - create broadcast (response is `B:bId OK`, or `ERR` if broadcast already exists)
+- command `B:bId ADD C:cId` - add existing connection to a broadcast (response is `B:bId OK` or `ERR`, e.g. if connection already added or does not exist)
+- command `B:bId SEND msg` - broadcast message (response is multiple `B:cId SENT [C:bId] msgId` or ERR, separately for each connection and then for the broadcast)
+- message `B:bId SENT [C:bId] msgId` - notification that the message is sent to a specific or all recipients
+- command `B:bId REM C:cId` - remove connection from broadcast (response is `B:bId OK` or `ERR`)
+- message `B:bId EMPTY` - all connections were removed from the broadcast
+- command `B:bId DEL` - delete broadcast (response is `B:bId OK` and when the last connection is removed an additional `B:bId EMPTY` is sent)
+- command `B:bId LS` - list connections in broadcast, response is `B:Id MS space_separated_connections`
+- message `B:bId MS space_separated_connections`
+
+## Questions
+
+1. Should broadcast IDs use the same namespace as connection IDs (and as group IDs)? Having the same namespace for all abstractions that the agent can operate on can be helpful, as it can also allow implementing some queries to determine which type a given ID has, but it also increases implementation complexity.
+
+2. Given that this abstraction would be used as internal abstraction for groups (same as connections internal to the group), it might be better to implement "agent users", each with its own connection namespace. In this case agent would use itself as one of the users.
+
+3. There is a similarity of commands for connections, groups and broadcasts, they only differ on the single-letter prefix. We could do one of the following:
+  - use the same command for different object types. This feels incorrect and error prone on its own.
+  - extend transmission structure with the field defining the object type (connection, group, broadcast, etc.).
+
+In this case, the transmission would look like:
+
+```
+agentTransmission = [corrId] CRLF objectType:[objectID] CRLF agentCommand
+objectType = C | B | G ; this is the additional field
+```
+
+This approach would allow reusing the existing command avoiding the unnecessary repetition.
+
+In this case, the command type could be parameterized with the list of supported agent object types, so we can ensure on the type level that only allowed commands can be constructed.
+
+EDIT: This approach is already implemented

rfcs/rejected/2021-05-23-introduction.md

@@ -0,0 +1,41 @@
+# SMP agent introduction
+
+## Problem
+
+Allow an agent client to connect two connections it has directly, with the agent acting as an out-of-band channel.
+
+It can be used both separately as part of some client functionality, and as part of group protocol.
+
+## Solution
+
+A protocol with commands and message envelopes to exchange the information between parties to establish connection.
+
+### Commands and messages
+
+Below commands are for the scenario when A introduces B to M.
+
+- command `C:idAB INTRO C:idAM infoM` - initiate introduction of the connection cIdB to connection cIdM (response is `C:idAB OK`)
+- message `C:idBA REQ C:invId infoM` - notification to confirm introduction
+- command `C:idBM? ACPT C:invId` - accept offer to be introduced (response is `C:idBM OK`, followed by `C:idBM CON`)
+- message `C:idBM CON` - confirmation that connection is established to both introduced parties
+- message `C:idAB CON C:idAM` - confirmation that connection is established to the introducer
+
+### Agent envelopes
+
+- `INTRO C:extIntroIdM infoM` - new introduction offered by introducer
+- `INV C:extIntroIdB prv:invBM infoB` - invitation to join connection from B to M sent via A
+- `REQ C:extIntroIdB prv:invBM infoB` - new introduction forwarded by the introducer
+- `CON C:extIntroId` - confirmation that the connection is established sent by both introduced parties to the introducer
+
+## Namespace
+
+Given that the introduction objects are short lived, they should not reuse the same commands or share the same namespace as connections, broadcasts and groups, but they probably should share the namespace with group and connection invitations.
+
+## Introduction protocol costs
+
+5 messages + cost to establish a connection
+
+
+The [sequence digram for introduction](https://mermaid.ink/img/eyJjb2RlIjoic2VxdWVuY2VEaWFncmFtXG4gIHBhcnRpY2lwYW50IEEgYXMgQWxpY2UgKEEpIC0gdGhlIGludHJvZHVjZXJcbiAgcGFydGljaXBhbnQgQUEgYXMgQWxpY2Unczxicj5hZ2VudCAoQUEpXG4gIHBhcnRpY2lwYW50IEIgYXMgQm9iIChCKSAtIGludHJvZHVjZWRcbiAgcGFydGljaXBhbnQgQkEgYXMgQm9iJ3M8YnI-YWdlbnQgKEJBKVxuICBwYXJ0aWNpcGFudCBNIGFzIE1hcmsgKE0pIC0gaW50cm9kdWNlZCB0b1xuICBwYXJ0aWNpcGFudCBNQSBhcyBNYXJrJ3M8YnI-YWdlbnQgKE1BKVxuXG4gIG5vdGUgb3ZlciBBLCBBQTogMS4gY3JlYXRlIGludHJvZHVjdGlvblxuICBBIC0-PiBBQTogQzppZEFCIElOVFJPIEM6aWRBTSBpbmZvTTxicj4oaWRBQiAtIGNvbm4gYWxpYXMgQSBoYXMgZm9yIEIsPGJyPmlkQU0gLSBmb3IgTSlcbiAgQUEgLT4-IEE6IEM6aWRBQiBPS1xuXG4gIG5vdGUgb3ZlciBBLCBCQTogMi4gc2VuZCBpbnRybyB0byBCb2JcblxuICBBQSAtPj4gQkE6IHZpYSBpZEFCOiBJTlRSTyBDOmV4dEludHJvSWRNIGluZm9NXG4gIEJBIC0-PiBCOiBDOmlkQkEgUkVRIEM6aW50SW50cm9JZE0gaW5mb01cbiAgQiAtPj4gQkE6IEM6aWRCTT8gQUNQVCBDOmludEludHJvSWRNXG4gIEJBIC0-PiBCOiBDOmlkQk0gT0tcblxuICBub3RlIG92ZXIgQkE6IDMuIGNyZWF0ZSBjb25uZWN0aW9uIGZvciAgTSBpZEJNXG5cbiAgQkEgLT4-IEFBOiB2aWEgaWRCQTogSU5WIEM6ZXh0SW50cm9JZE0gcHJ2OmludkJNIGluZm9CXG5cbiAgbm90ZSBvdmVyIEFBLCBNOiA0LiBzZW5kIGludHJvIHRvIE1hcmtcblxuICBBQSAtPj4gTUE6IHZpYSBpZEFNOiBSRVEgQzpleHRJbnRyb0lkQiBwcnY6aW52Qk0gaW5mb0JcblxuICBub3RlIG92ZXIgTUEsIEI6IDUuIE1hcmsgY29ubmVjdHMgdG8gQm9iXG5cbiAgTUEgLT4-IE06IEM6aWRNQSBSRVEgQzppbnRJbnRyb0lkQiBpbmZvQlxuICBNIC0-PiBNQTogQzppZE1CPyBBQ1BUIEM6aW50SW50cm9JZEJcbiAgTUEgLT4-IE06IEM6aWRNQiBPS1xuXG4gIE1BIC0-PiBCQTogIGVzdGFibGlzaCBjb25uZWN0aW9uIGlkQk0gLT4gaWRNQlxuXG4gIG5vdGUgb3ZlciBBLCBNQTogNi4gbm90aWZ5IGFsbCBjbGllbnRzXG5cbiAgTUEgLT4-IE06IEM6aWRNQiBDT05cbiAgTUEgLT4-IEFBOiB2aWEgaWRNQTogQ09OIEM6ZXh0SW50cm9JZEJcbiAgQkEgLT4-IEI6IEM6aWRCTSBDT05cbiAgQkEgLT4-IEFBOiB2aWEgaWRCQTogQ09OIEM6ZXh0SW50cm9JZEJcbiAgQUEgLT4-IEE6IEM6aWRBQiBDT04gQzppZEFNXG4iLCJtZXJtYWlkIjp7fSwidXBkYXRlRWRpdG9yIjpmYWxzZX0), the source is [here](./intro.mmd).
+
+![sequence digram for introduction](https://mermaid.ink/svg/eyJjb2RlIjoic2VxdWVuY2VEaWFncmFtXG4gIHBhcnRpY2lwYW50IEEgYXMgQWxpY2UgKEEpIC0gdGhlIGludHJvZHVjZXJcbiAgcGFydGljaXBhbnQgQUEgYXMgQWxpY2Unczxicj5hZ2VudCAoQUEpXG4gIHBhcnRpY2lwYW50IEIgYXMgQm9iIChCKSAtIGludHJvZHVjZWRcbiAgcGFydGljaXBhbnQgQkEgYXMgQm9iJ3M8YnI-YWdlbnQgKEJBKVxuICBwYXJ0aWNpcGFudCBNIGFzIE1hcmsgKE0pIC0gaW50cm9kdWNlZCB0b1xuICBwYXJ0aWNpcGFudCBNQSBhcyBNYXJrJ3M8YnI-YWdlbnQgKE1BKVxuXG4gIG5vdGUgb3ZlciBBLCBBQTogMS4gY3JlYXRlIGludHJvZHVjdGlvblxuICBBIC0-PiBBQTogQzppZEFCIElOVFJPIEM6aWRBTSBpbmZvTTxicj4oaWRBQiAtIGNvbm4gYWxpYXMgQSBoYXMgZm9yIEIsPGJyPmlkQU0gLSBmb3IgTSlcbiAgQUEgLT4-IEE6IEM6aWRBQiBPS1xuXG4gIG5vdGUgb3ZlciBBLCBCQTogMi4gc2VuZCBpbnRybyB0byBCb2JcblxuICBBQSAtPj4gQkE6IHZpYSBpZEFCOiBJTlRSTyBDOmV4dEludHJvSWRNIGluZm9NXG4gIEJBIC0-PiBCOiBDOmlkQkEgUkVRIEM6aW50SW50cm9JZE0gaW5mb01cbiAgQiAtPj4gQkE6IEM6aWRCTT8gQUNQVCBDOmludEludHJvSWRNXG4gIEJBIC0-PiBCOiBDOmlkQk0gT0tcblxuICBub3RlIG92ZXIgQkE6IDMuIGNyZWF0ZSBjb25uZWN0aW9uIGZvciAgTSBpZEJNXG5cbiAgQkEgLT4-IEFBOiB2aWEgaWRCQTogSU5WIEM6ZXh0SW50cm9JZE0gcHJ2OmludkJNIGluZm9CXG5cbiAgbm90ZSBvdmVyIEFBLCBNOiA0LiBzZW5kIGludHJvIHRvIE1hcmtcblxuICBBQSAtPj4gTUE6IHZpYSBpZEFNOiBSRVEgQzpleHRJbnRyb0lkQiBwcnY6aW52Qk0gaW5mb0JcblxuICBub3RlIG92ZXIgTUEsIEI6IDUuIE1hcmsgY29ubmVjdHMgdG8gQm9iXG5cbiAgTUEgLT4-IE06IEM6aWRNQSBSRVEgQzppbnRJbnRyb0lkQiBpbmZvQlxuICBNIC0-PiBNQTogQzppZE1CPyBBQ1BUIEM6aW50SW50cm9JZEJcbiAgTUEgLT4-IE06IEM6aWRNQiBPS1xuXG4gIE1BIC0-PiBCQTogIGVzdGFibGlzaCBjb25uZWN0aW9uIGlkQk0gLT4gaWRNQlxuXG4gIG5vdGUgb3ZlciBBLCBNQTogNi4gbm90aWZ5IGFsbCBjbGllbnRzXG5cbiAgTUEgLT4-IE06IEM6aWRNQiBDT05cbiAgTUEgLT4-IEFBOiB2aWEgaWRNQTogQ09OIEM6ZXh0SW50cm9JZEJcbiAgQkEgLT4-IEI6IEM6aWRCTSBDT05cbiAgQkEgLT4-IEFBOiB2aWEgaWRCQTogQ09OIEM6ZXh0SW50cm9JZEJcbiAgQUEgLT4-IEE6IEM6aWRBQiBDT04gQzppZEFNXG4iLCJtZXJtYWlkIjp7fSwidXBkYXRlRWRpdG9yIjpmYWxzZX0)

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

@@ -0,0 +1,24 @@
+# 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.
+
+## How to build an image
+
+1. [Create an API token](https://cloud.digitalocean.com/account/api/tokens) in vendor account in DigitalOcean.
+2. Install [packer](https://www.packer.io/downloads) downloading binary or with brew (on Mac):
+
+```shell
+brew tap hashicorp/tap
+brew install hashicorp/tap/packer
+```
+
+3. Run `packer build` in the `smp-server-digitalocean-droplet` repository:
+
+```shell
+cd ./scripts/smp-server-digitalocean-droplet
+DIGITALOCEAN_TOKEN=$YOUR_TOKEN packer build -on-error=ask -color=false ./marketplace-image.json
+```

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

@@ -0,0 +1,18 @@
+#!/bin/bash
+# receives pubkey_hash file location as the first parameter
+
+ip_address=$(hostname -I | awk '{print$1}')
+hash=$(cat $1)
+
+cat <<EOF
+********************************************************************************
+
+SMP server address: $ip_address#$hash
+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).
+
+********************************************************************************
+To stop seeing this message delete line - bash /opt/simplex/on_login.sh - from /root/.bashrc
+EOF

scripts/smp-server-digitalocean-droplet/marketplace-image.json

@@ -0,0 +1,47 @@
+{
+  "variables": {
+    "token": "{{env `DIGITALOCEAN_TOKEN`}}",
+    "image_name": "smp-server-snapshot",
+    "application_name": "SMP server"
+  },
+  "sensitive-variables": ["token"],
+  "builders": [
+    {
+      "type": "digitalocean",
+      "api_token": "{{user `token`}}",
+      "image": "ubuntu-20-04-x64",
+      "region": "fra1",
+      "size": "s-1vcpu-1gb",
+      "ssh_username": "root",
+      "snapshot_name": "{{user `image_name`}}"
+    }
+  ],
+  "provisioners": [
+    {
+      "type": "shell",
+      "inline": [
+        "cloud-init status --wait",
+        "mkdir -p /opt/simplex"
+      ]
+    },
+    {
+      "type": "file",
+      "source": "files/opt/",
+      "destination": "/opt/"
+    },
+    {
+      "type": "shell",
+      "environment_vars": [
+        "application_name={{user `application_name`}}",
+        "DEBIAN_FRONTEND=noninteractive"
+      ],
+      "scripts": [
+        "scripts/01-packages.sh",
+        "scripts/02-firewall.sh",
+        "scripts/03-init-start.sh",
+        "scripts/90-cleanup.sh",
+        "scripts/99-img-check.sh"
+      ]
+    }
+  ]
+}

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

@@ -0,0 +1,8 @@
+#!/bin/sh
+
+# update apt
+apt-get -y update
+apt-get -y upgrade
+
+# packages needed for smp-server init-start.sh
+apt-get install -y jq

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

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

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

@@ -0,0 +1,57 @@
+#!/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
+
+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
+[Unit]
+Description=SMP server systemd service
+
+[Service]
+Type=simple
+ExecStart=/bin/sh -c "$bin_dir/smp-server start"
+
+[Install]
+WantedBy=multi-user.target
+
+EOT
+chmod 644 /etc/systemd/system/smp-server.service
+
+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

scripts/smp-server-digitalocean-droplet/scripts/90-cleanup.sh

@@ -0,0 +1,60 @@
+#!/bin/bash
+
+# DigitalOcean Marketplace Image Validation Tool
+# © 2021 DigitalOcean LLC.
+# This code is licensed under Apache 2.0 license (see LICENSE.md for details)
+
+set -o errexit
+
+# Ensure /tmp exists and has the proper permissions before
+# checking for security updates
+# https://github.com/digitalocean/marketplace-partners/issues/94
+if [[ ! -d /tmp ]]; then
+  mkdir /tmp
+fi
+chmod 1777 /tmp
+
+if [ -n "$(command -v yum)" ]; then
+  yum update -y
+  yum clean all
+elif [ -n "$(command -v apt-get)" ]; then
+  apt-get -y update
+  apt-get -y upgrade
+  apt-get -y autoremove
+  apt-get -y autoclean
+fi
+
+rm -rf /tmp/* /var/tmp/*
+history -c
+cat /dev/null > /root/.bash_history
+unset HISTFILE
+find /var/log -mtime -1 -type f -exec truncate -s 0 {} \;
+rm -rf /var/log/*.gz /var/log/*.[0-9] /var/log/*-????????
+rm -rf /var/lib/cloud/instances/*
+rm -f /root/.ssh/authorized_keys /etc/ssh/*key*
+touch /etc/ssh/revoked_keys
+chmod 600 /etc/ssh/revoked_keys
+
+# Securely erase the unused portion of the filesystem
+GREEN='\033[0;32m'
+NC='\033[0m'
+printf "\n${GREEN}Writing zeros to the remaining disk space to securely
+erase the unused portion of the file system.
+Depending on your disk size this may take several minutes.
+The secure erase will complete successfully when you see:${NC}
+    dd: writing to '/zerofile': No space left on device\n
+Beginning secure erase now\n"
+
+dd if=/dev/zero of=/zerofile &
+  PID=$!
+  while [ -d /proc/$PID ]
+    do
+      printf "."
+      sleep 5
+    done
+sync; rm /zerofile; sync
+cat /dev/null > /var/log/lastlog; cat /dev/null > /var/log/wtmp
+
+rm /var/log/auth.log
+rm /var/log/kern.log
+rm /var/log/ufw.log

scripts/smp-server-digitalocean-droplet/scripts/99-img-check.sh

@@ -0,0 +1,682 @@
+#!/bin/bash
+
+# DigitalOcean Marketplace Image Validation Tool
+# © 2021 DigitalOcean LLC.
+# This code is licensed under Apache 2.0 license (see LICENSE.md for details)
+
+VERSION="v. 1.6"
+RUNDATE=$( date )
+
+# Script should be run with SUDO
+if [ "$EUID" -ne 0 ]
+  then echo "[Error] - This script must be run with sudo or as the root user."
+  exit 1
+fi
+
+STATUS=0
+PASS=0
+WARN=0
+FAIL=0
+
+# $1 == command to check for
+# returns: 0 == true, 1 == false
+cmdExists() {
+    if command -v "$1" > /dev/null 2>&1; then
+        return 0
+    else
+        return 1
+    fi
+}
+
+function getDistro {
+    if [ -f /etc/os-release ]; then
+    # freedesktop.org and systemd
+    . /etc/os-release
+    OS=$NAME
+    VER=$VERSION_ID
+elif type lsb_release >/dev/null 2>&1; then
+    # linuxbase.org
+    OS=$(lsb_release -si)
+    VER=$(lsb_release -sr)
+elif [ -f /etc/lsb-release ]; then
+    # For some versions of Debian/Ubuntu without lsb_release command
+    . /etc/lsb-release
+    OS=$DISTRIB_ID
+    VER=$DISTRIB_RELEASE
+elif [ -f /etc/debian_version ]; then
+    # Older Debian/Ubuntu/etc.
+    OS=Debian
+    VER=$(cat /etc/debian_version)
+elif [ -f /etc/SuSe-release ]; then
+    # Older SuSE/etc.
+    :
+elif [ -f /etc/redhat-release ]; then
+    # Older Red Hat, CentOS, etc.
+    VER=$( cat /etc/redhat-release | cut -d" " -f3 | cut -d "." -f1)
+    d=$( cat /etc/redhat-release | cut -d" " -f1 | cut -d "." -f1)
+    if [[ $d == "CentOS" ]]; then
+      OS="CentOS Linux"
+    fi
+else
+    # Fall back to uname, e.g. "Linux <version>", also works for BSD, etc.
+    OS=$(uname -s)
+    VER=$(uname -r)
+fi
+}
+function loadPasswords {
+SHADOW=$(cat /etc/shadow)
+}
+
+function checkAgent {
+  # Check for the presence of the do-agent in the filesystem
+  if [ -d /var/opt/digitalocean/do-agent ];then
+     echo -en "\e[41m[FAIL]\e[0m DigitalOcean Monitoring Agent detected.\n"
+            ((FAIL++))
+            STATUS=2
+      if [[ $OS == "CentOS Linux" ]]; then
+        echo "The agent can be removed with 'sudo yum remove do-agent' "
+      elif [[ $OS == "Ubuntu" ]]; then
+        echo "The agent can be removed with 'sudo apt-get purge do-agent' "
+      fi
+  else
+    echo -en "\e[32m[PASS]\e[0m DigitalOcean Monitoring agent was not found\n"
+    ((PASS++))
+  fi
+}
+
+function checkLogs {
+    cp_ignore="/var/log/cpanel-install.log"
+    echo -en "\nChecking for log files in /var/log\n\n"
+    # Check if there are log archives or log files that have not been recently cleared.
+    for f in /var/log/*-????????; do
+      [[ -e $f ]] || break
+      if [ $f != $cp_ignore ]; then
+        echo -en "\e[93m[WARN]\e[0m Log archive ${f} found\n"
+        ((WARN++))
+        if [[ $STATUS != 2 ]]; then
+            STATUS=1
+        fi
+      fi
+    done
+    for f in  /var/log/*.[0-9];do
+      [[ -e $f ]] || break
+        echo -en "\e[93m[WARN]\e[0m Log archive ${f} found\n"
+        ((WARN++))
+        if [[ $STATUS != 2 ]]; then
+            STATUS=1
+        fi
+    done
+    for f in /var/log/*.log; do
+      [[ -e $f ]] || break
+      if [[ "${f}" = '/var/log/lfd.log' && "$( cat "${f}" | egrep -v '/var/log/messages has been reset| Watching /var/log/messages' | wc -c)" -gt 50 ]]; then
+        if [ $f != $cp_ignore ]; then
+        echo -en "\e[93m[WARN]\e[0m un-cleared log file, ${f} found\n"
+        ((WARN++))
+        if [[ $STATUS != 2 ]]; then
+            STATUS=1
+        fi
+      fi
+      elif [[ "${f}" != '/var/log/lfd.log' && "$( cat "${f}" | wc -c)" -gt 50 ]]; then
+      if [ $f != $cp_ignore ]; then
+        echo -en "\e[93m[WARN]\e[0m un-cleared log file, ${f} found\n"
+        ((WARN++))
+        if [[ $STATUS != 2 ]]; then
+            STATUS=1
+        fi
+      fi
+    fi
+    done
+}
+function checkTMP {
+  # Check the /tmp directory to ensure it is empty.  Warn on any files found.
+  return 1
+}
+function checkRoot {
+    user="root"
+    uhome="/root"
+    for usr in $SHADOW
+    do
+      IFS=':' read -r -a u <<< "$usr"
+      if [[ "${u[0]}" == "${user}" ]]; then
+        if [[ ${u[1]} == "!" ]] || [[ ${u[1]} == "!!" ]] || [[ ${u[1]} == "*" ]]; then
+            echo -en "\e[32m[PASS]\e[0m User ${user} has no password set.\n"
+            ((PASS++))
+        else
+            echo -en "\e[41m[FAIL]\e[0m User ${user} has a password set on their account.\n"
+            ((FAIL++))
+            STATUS=2
+        fi
+      fi
+    done
+    if [ -d ${uhome}/ ]; then
+            if [ -d ${uhome}/.ssh/ ]; then
+                if  ls ${uhome}/.ssh/*> /dev/null 2>&1; then
+                    for key in ${uhome}/.ssh/*
+                        do
+                             if  [ "${key}" == "${uhome}/.ssh/authorized_keys" ]; then
+
+                                if [ "$( cat "${key}" | wc -c)" -gt 50 ]; then
+                                    echo -en "\e[41m[FAIL]\e[0m User \e[1m${user}\e[0m has a populated authorized_keys file in \e[93m${key}\e[0m\n"
+                                    akey=$(cat ${key})
+                                    echo "File Contents:"
+                                    echo $akey
+                                    echo "--------------"
+                                    ((FAIL++))
+                                    STATUS=2
+                                fi
+                            elif  [ "${key}" == "${uhome}/.ssh/id_rsa" ]; then
+                                if [ "$( cat "${key}" | wc -c)" -gt 0 ]; then
+                                  echo -en "\e[41m[FAIL]\e[0m User \e[1m${user}\e[0m has a private key file in \e[93m${key}\e[0m\n"
+                                      akey=$(cat ${key})
+                                      echo "File Contents:"
+                                      echo $akey
+                                      echo "--------------"
+                                      ((FAIL++))
+                                      STATUS=2
+                                else
+                                  echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has empty private key file in \e[93m${key}\e[0m\n"
+                                  ((WARN++))
+                                  if [[ $STATUS != 2 ]]; then
+                                    STATUS=1
+                                  fi
+                                fi
+                            elif  [ "${key}" != "${uhome}/.ssh/known_hosts" ]; then
+                                 echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has a file in their .ssh directory at \e[93m${key}\e[0m\n"
+                                    ((WARN++))
+                                    if [[ $STATUS != 2 ]]; then
+                                        STATUS=1
+                                    fi
+                            else
+                                if [ "$( cat "${key}" | wc -c)" -gt 50 ]; then
+                                    echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has a populated known_hosts file in \e[93m${key}\e[0m\n"
+                                    ((WARN++))
+                                    if [[ $STATUS != 2 ]]; then
+                                        STATUS=1
+                                    fi
+                                fi
+                            fi
+                        done
+                else
+                    echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m has no SSH keys present\n"
+                fi
+            else
+                echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m does not have an .ssh directory\n"
+            fi
+             if [ -f /root/.bash_history ];then
+
+                      BH_S=$( cat /root/.bash_history | wc -c)
+
+                      if [[ $BH_S -lt 200 ]]; then
+                          echo -en "\e[32m[PASS]\e[0m ${user}'s Bash History appears to have been cleared\n"
+                          ((PASS++))
+                      else
+                          echo -en "\e[41m[FAIL]\e[0m ${user}'s Bash History should be cleared to prevent sensitive information from leaking\n"
+                          ((FAIL++))
+                              STATUS=2
+                      fi
+
+                      return 1;
+                  else
+                      echo -en "\e[32m[PASS]\e[0m The Root User's Bash History is not present\n"
+                      ((PASS++))
+                  fi
+        else
+            echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m does not have a directory in /home\n"
+        fi
+        echo -en "\n\n"
+    return 1
+}
+
+function checkUsers {
+    # Check each user-created account
+    for user in $(awk -F: '$3 >= 1000 && $1 != "nobody" {print $1}' /etc/passwd;)
+    do
+      # Skip some other non-user system accounts
+      if [[ $user == "centos" ]]; then
+        :
+      elif [[ $user == "nfsnobody" ]]; then
+        :
+    else
+      echo -en "\nChecking user: ${user}...\n"
+      for usr in $SHADOW
+        do
+          IFS=':' read -r -a u <<< "$usr"
+          if [[ "${u[0]}" == "${user}" ]]; then
+              if [[ ${u[1]} == "!" ]] || [[ ${u[1]} == "!!" ]] || [[ ${u[1]} == "*" ]]; then
+                  echo -en "\e[32m[PASS]\e[0m User ${user} has no password set.\n"
+                  ((PASS++))
+              else
+                  echo -en "\e[41m[FAIL]\e[0m User ${user} has a password set on their account. Only system users are allowed on the image.\n"
+                  ((FAIL++))
+                  STATUS=2
+              fi
+          fi
+        done
+        #echo "User Found: ${user}"
+        uhome="/home/${user}"
+        if [ -d "${uhome}/" ]; then
+            if [ -d "${uhome}/.ssh/" ]; then
+                if  ls "${uhome}/.ssh/*"> /dev/null 2>&1; then
+                    for key in ${uhome}/.ssh/*
+                        do
+                            if  [ "${key}" == "${uhome}/.ssh/authorized_keys" ]; then
+                                if [ "$( cat "${key}" | wc -c)" -gt 50 ]; then
+                                    echo -en "\e[41m[FAIL]\e[0m User \e[1m${user}\e[0m has a populated authorized_keys file in \e[93m${key}\e[0m\n"
+                                    akey=$(cat ${key})
+                                    echo "File Contents:"
+                                    echo $akey
+                                    echo "--------------"
+                                    ((FAIL++))
+                                    STATUS=2
+                                fi
+                              elif  [ "${key}" == "${uhome}/.ssh/id_rsa" ]; then
+                                if [ "$( cat "${key}" | wc -c)" -gt 0 ]; then
+                                  echo -en "\e[41m[FAIL]\e[0m User \e[1m${user}\e[0m has a private key file in \e[93m${key}\e[0m\n"
+                                      akey=$(cat ${key})
+                                      echo "File Contents:"
+                                      echo $akey
+                                      echo "--------------"
+                                      ((FAIL++))
+                                      STATUS=2
+                                else
+                                  echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has empty private key file in \e[93m${key}\e[0m\n"
+                                  ((WARN++))
+                                  if [[ $STATUS != 2 ]]; then
+                                    STATUS=1
+                                  fi
+                                fi
+                            elif  [ "${key}" != "${uhome}/.ssh/known_hosts" ]; then
+
+                                 echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has a file in their .ssh directory named \e[93m${key}\e[0m\n"
+                                 ((WARN++))
+                                 if [[ $STATUS != 2 ]]; then
+                                        STATUS=1
+                                    fi
+
+                            else
+                                if [ "$( cat "${key}" | wc -c)" -gt 50 ]; then
+                                    echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has a known_hosts file in \e[93m${key}\e[0m\n"
+                                    ((WARN++))
+                                    if [[ $STATUS != 2 ]]; then
+                                        STATUS=1
+                                    fi
+                                fi
+                            fi
+
+
+                        done
+                else
+                    echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m has no SSH keys present\n"
+                fi
+            else
+                echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m does not have an .ssh directory\n"
+            fi
+        else
+            echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m does not have a directory in /home\n"
+        fi
+
+         # Check for an uncleared .bash_history for this user
+              if [ -f "${uhome}/.bash_history" ]; then
+                            BH_S=$( cat "${uhome}/.bash_history" | wc -c )
+
+                            if [[ $BH_S -lt 200 ]]; then
+                                echo -en "\e[32m[PASS]\e[0m ${user}'s Bash History appears to have been cleared\n"
+                                ((PASS++))
+                            else
+                                echo -en "\e[41m[FAIL]\e[0m ${user}'s Bash History should be cleared to prevent sensitive information from leaking\n"
+                                ((FAIL++))
+                                    STATUS=2
+
+                            fi
+                           echo -en "\n\n"
+                         fi
+        fi
+    done
+}
+function checkFirewall {
+
+    if [[ $OS == "Ubuntu" ]]; then
+      fw="ufw"
+      ufwa=$(ufw status |head -1| sed -e "s/^Status:\ //")
+      if [[ $ufwa == "active" ]]; then
+        FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+      else
+        FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+      fi
+    elif [[ $OS == "CentOS Linux" ]]; then
+      if [ -f /usr/lib/systemd/system/csf.service ]; then
+        fw="csf"
+        if [[ $(systemctl status $fw >/dev/null 2>&1) ]]; then
+
+        FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+        elif cmdExists "firewall-cmd"; then
+          if [[ $(systemctl is-active firewalld >/dev/null 2>&1 && echo 1 || echo 0) ]]; then
+           FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+          ((PASS++))
+          else
+            FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+          ((WARN++))
+          fi
+        else
+          FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+        fi
+      else
+        fw="firewalld"
+        if [[ $(systemctl is-active firewalld >/dev/null 2>&1 && echo 1 || echo 0) ]]; then
+          FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+        else
+          FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+        fi
+      fi
+    elif [[ "$OS" =~ Debian.* ]]; then
+      # user could be using a number of different services for managing their firewall
+      # we will check some of the most common
+      if cmdExists 'ufw'; then
+        fw="ufw"
+        ufwa=$(ufw status |head -1| sed -e "s/^Status:\ //")
+        if [[ $ufwa == "active" ]]; then
+        FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+      else
+        FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+      fi
+      elif cmdExists "firewall-cmd"; then
+        fw="firewalld"
+        if [[ $(systemctl is-active --quiet $fw) ]]; then
+          FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+        else
+          FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+        fi
+      else
+        # user could be using vanilla iptables, check if kernel module is loaded
+        fw="iptables"
+        if [[ $(lsmod | grep -q '^ip_tables' 2>/dev/null) ]]; then
+          FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+        else
+          FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+        fi
+      fi
+    fi
+
+}
+function checkUpdates {
+    if [[ $OS == "Ubuntu" ]] || [[ "$OS" =~ Debian.* ]]; then
+        # Ensure /tmp exists and has the proper permissions before
+        # checking for security updates
+        # https://github.com/digitalocean/marketplace-partners/issues/94
+        if [[ ! -d /tmp ]]; then
+          mkdir /tmp
+        fi
+        chmod 1777 /tmp
+
+        echo -en "\nUpdating apt package database to check for security updates, this may take a minute...\n\n"
+        apt-get -y update > /dev/null
+
+        uc=$(apt-get --just-print upgrade | grep -i "security" | wc -l)
+        if [[ $uc -gt 0 ]]; then
+          update_count=$(( ${uc} / 2 ))
+        else
+          update_count=0
+        fi
+
+        if [[ $update_count -gt 0 ]]; then
+            echo -en "\e[41m[FAIL]\e[0m There are ${update_count} security updates available for this image that have not been installed.\n"
+            echo -en
+            echo -en "Here is a list of the security updates that are not installed:\n"
+            sleep 2
+            apt-get --just-print upgrade | grep -i security | awk '{print $2}' | awk '!seen[$0]++'
+            echo -en
+            ((FAIL++))
+            STATUS=2
+        else
+            echo -en "\e[32m[PASS]\e[0m There are no pending security updates for this image.\n\n"
+        fi
+    elif [[ $OS == "CentOS Linux" ]]; then
+        echo -en "\nChecking for available security updates, this may take a minute...\n\n"
+
+        update_count=$(yum check-update --security --quiet | wc -l)
+         if [[ $update_count -gt 0 ]]; then
+            echo -en "\e[41m[FAIL]\e[0m There are ${update_count} security updates available for this image that have not been installed.\n"
+            ((FAIL++))
+            STATUS=2
+        else
+            echo -en "\e[32m[PASS]\e[0m There are no pending security updates for this image.\n"
+            ((PASS++))
+        fi
+    else
+        echo "Error encountered"
+        exit 1
+    fi
+
+    return 1;
+}
+function checkCloudInit {
+
+    if hash cloud-init 2>/dev/null; then
+        CI="\e[32m[PASS]\e[0m Cloud-init is installed.\n"
+        ((PASS++))
+    else
+        CI="\e[41m[FAIL]\e[0m No valid verison of cloud-init was found.\n"
+        ((FAIL++))
+        STATUS=2
+    fi
+    return 1
+}
+function checkMongoDB {
+  # Check if MongoDB is installed
+  # If it is, verify the version is allowed (non-SSPL)
+
+   if [[ $OS == "Ubuntu" ]] || [[ "$OS" =~ Debian.* ]]; then
+
+     if [[ -f "/usr/bin/mongod" ]]; then
+       version=$(/usr/bin/mongod --version --quiet | grep "db version" | sed -e "s/^db\ version\ v//")
+
+      if version_gt $version 4.0.0; then
+        if version_gt $version 4.0.3; then
+          echo -en "\e[41m[FAIL]\e[0m An SSPL version of MongoDB is present, ${version}"
+          ((FAIL++))
+           STATUS=2
+        else
+          echo -en "\e[32m[PASS]\e[0m The version of MongoDB installed, ${version} is not under the SSPL"
+          ((PASS++))
+        fi
+      else
+         if version_gt $version 3.6.8; then
+          echo -en "\e[41m[FAIL]\e[0m An SSPL version of MongoDB is present, ${version}"
+          ((FAIL++))
+           STATUS=2
+        else
+          echo -en "\e[32m[PASS]\e[0m The version of MongoDB installed, ${version} is not under the SSPL"
+          ((PASS++))
+        fi
+      fi
+
+
+     else
+       echo -en "\e[32m[PASS]\e[0m MongoDB is not installed"
+       ((PASS++))
+     fi
+
+   elif [[ $OS == "CentOS Linux" ]]; then
+
+    if [[ -f "/usr/bin/mongod" ]]; then
+       version=$(/usr/bin/mongod --version --quiet | grep "db version" | sed -e "s/^db\ version\ v//")
+
+
+       if version_gt $version 4.0.0; then
+        if version_gt $version 4.0.3; then
+          echo -en "\e[41m[FAIL]\e[0m An SSPL version of MongoDB is present"
+          ((FAIL++))
+           STATUS=2
+        else
+          echo -en "\e[32m[PASS]\e[0m The version of MongoDB installed is not under the SSPL"
+          ((PASS++))
+        fi
+      else
+         if version_gt $version 3.6.8; then
+          echo -en "\e[41m[FAIL]\e[0m An SSPL version of MongoDB is present"
+          ((FAIL++))
+           STATUS=2
+        else
+          echo -en "\e[32m[PASS]\e[0m The version of MongoDB installed is not under the SSPL"
+          ((PASS++))
+        fi
+      fi
+
+
+
+     else
+       echo -en "\e[32m[PASS]\e[0m MongoDB is not installed"
+       ((PASS++))
+     fi
+
+  else
+    echo "ERROR: Unable to identify distribution"
+    ((FAIL++))
+    STATUS 2
+    return 1
+  fi
+
+
+}
+
+function version_gt() { test "$(printf '%s\n' "$@" | sort -V | head -n 1)" != "$1"; }
+
+
+clear
+echo "DigitalOcean Marketplace Image Validation Tool ${VERSION}"
+echo "Executed on: ${RUNDATE}"
+echo "Checking local system for Marketplace compatibility..."
+
+getDistro
+
+echo -en "\n\e[1mDistribution:\e[0m ${OS}\n"
+echo -en "\e[1mVersion:\e[0m ${VER}\n\n"
+
+ost=0
+osv=0
+
+if [[ $OS == "Ubuntu" ]]; then
+        ost=1
+    if [[ $VER == "20.04" ]]; then
+        osv=1
+    elif [[ $VER == "18.04" ]]; then
+        osv=1
+    elif [[ $VER == "16.04" ]]; then
+        osv=1
+    else
+        osv=0
+    fi
+
+elif [[ "$OS" =~ Debian.* ]]; then
+    ost=1
+    case "$VER" in
+        9)
+            osv=1
+            ;;
+        10)
+            osv=1
+            ;;
+        *)
+            osv=2
+            ;;
+    esac
+
+elif [[ $OS == "CentOS Linux" ]]; then
+        ost=1
+    if [[ $VER == "8" ]]; then
+        osv=1
+    elif [[ $VER == "7" ]]; then
+        osv=1
+    elif [[ $VER == "6" ]]; then
+        osv=1
+    else
+        osv=2
+    fi
+else
+    ost=0
+fi
+
+if [[ $ost == 1 ]]; then
+    echo -en "\e[32m[PASS]\e[0m Supported Operating System Detected: ${OS}\n"
+    ((PASS++))
+else
+    echo -en "\e[41m[FAIL]\e[0m ${OS} is not a supported Operating System\n"
+    ((FAIL++))
+    STATUS=2
+fi
+
+if [[ $osv == 1 ]]; then
+    echo -en "\e[32m[PASS]\e[0m Supported Release Detected: ${VER}\n"
+    ((PASS++))
+elif [[ $ost == 1 ]]; then
+    echo -en "\e[41m[FAIL]\e[0m ${OS} ${VER} is not a supported Operating System Version\n"
+    ((FAIL++))
+    STATUS=2
+else
+    echo "Exiting..."
+    exit 1
+fi
+
+checkCloudInit
+
+echo -en "${CI}"
+
+checkFirewall
+
+echo -en "${FW_VER}"
+
+checkUpdates
+
+loadPasswords
+
+checkLogs
+
+echo -en "\n\nChecking all user-created accounts...\n"
+checkUsers
+
+echo -en "\n\nChecking the root account...\n"
+checkRoot
+
+checkAgent
+
+checkMongoDB
+
+
+# Summary
+echo -en "\n\n---------------------------------------------------------------------------------------------------\n"
+
+if [[ $STATUS == 0 ]]; then
+    echo -en "Scan Complete.\n\e[32mAll Tests Passed!\e[0m\n"
+elif [[ $STATUS == 1 ]]; then
+    echo -en "Scan Complete. \n\e[93mSome non-critical tests failed.  Please review these items.\e[0m\e[0m\n"
+else
+    echo -en "Scan Complete. \n\e[41mOne or more tests failed.  Please review these items and re-test.\e[0m\n"
+fi
+echo "---------------------------------------------------------------------------------------------------"
+echo -en "\e[1m${PASS} Tests PASSED\e[0m\n"
+echo -en "\e[1m${WARN} WARNINGS\e[0m\n"
+echo -en "\e[1m${FAIL} Tests FAILED\e[0m\n"
+echo -en "---------------------------------------------------------------------------------------------------\n"
+
+if [[ $STATUS == 0 ]]; then
+    echo -en "We did not detect any issues with this image. Please be sure to manually ensure that all software installed on the base system is functional, secure and properly configured (or facilities for configuration on first-boot have been created).\n\n"
+    exit 0
+elif [[ $STATUS == 1 ]]; then
+    echo -en "Please review all [WARN] items above and ensure they are intended or resolved.  If you do not have a specific requirement, we recommend resolving these items before image submission\n\n"
+    exit 0
+else
+    echo -en "Some critical tests failed.  These items must be resolved and this scan re-run before you submit your image to the DigitalOcean Marketplace.\n\n"
+    exit 1
+fi

scripts/smp-server-linode.sh

@@ -0,0 +1,125 @@
+#!/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
+exec &> >(tee -i /var/log/stackscript.log)
+# 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
+
+# add firewall
+echo "y" | ufw enable
+# open ports
+ufw allow ssh
+ufw allow http
+ufw allow 5223
+
+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
+
+# 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
+#!/bin/bash
+
+export PATH="$PATH:$bin_dir"
+
+EOT
+source /etc/profile.d/simplex.sh
+
+# initialize SMP 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
+on_login_script="/opt/simplex/on_login.sh"
+cat <<EOT >> $on_login_script
+#!/bin/bash
+# receives pubkey_hash file location as the first parameter
+
+ip_address=\$(hostname -I | awk '{print\$1}')
+hash=\$(cat \$1)
+
+cat <<EOF
+********************************************************************************
+
+SMP server address: \$ip_address#\$hash
+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).
+
+********************************************************************************
+To stop seeing this message delete line - bash /opt/simplex/on_login.sh - from /root/.bashrc
+EOF
+
+EOT
+chmod +x $on_login_script
+echo "bash $on_login_script $hash_file" >> /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
+
+     hash=$(cat $hash_file)
+     release_version=$(jq '.tag_name' release.json | tr -d \")
+
+     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
+fi
+
+# create, enable and start SMP server systemd service
+cat <<EOT >> /etc/systemd/system/smp-server.service
+[Unit]
+Description=SMP server systemd service
+
+[Service]
+Type=simple
+ExecStart=/bin/sh -c "$bin_dir/smp-server start"
+
+[Install]
+WantedBy=multi-user.target
+
+EOT
+chmod 644 /etc/systemd/system/smp-server.service
+sudo systemctl enable smp-server
+sudo systemctl start smp-server
+
+# cleanup
+rm release.json

simplexmq-v0.cabal

@@ -0,0 +1,259 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+
+name:           simplexmq-v0
+version:        0.5.3
+synopsis:       SimpleXMQ message broker
+description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
+                <./docs/Simplex-Messaging-Client.html client> and
+                <./docs/Simplex-Messaging-Agent.html agent> for SMP protocols:
+                .
+                * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md SMP protocol>
+                * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md SMP agent protocol>
+                .
+                See <https://github.com/simplex-chat/simplex-chat terminal chat prototype> built with SimpleXMQ broker.
+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
+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.SQLite
+      Simplex.Messaging.Agent.ExceptT
+      Simplex.Messaging.Agent.Protocol
+      Simplex.Messaging.Agent.RetryInterval
+      Simplex.Messaging.Agent.Store
+      Simplex.Messaging.Agent.Store.SQLite
+      Simplex.Messaging.Agent.Store.SQLite.Migrations
+      Simplex.Messaging.Client
+      Simplex.Messaging.Crypto
+      Simplex.Messaging.Parsers
+      Simplex.Messaging.Protocol
+      Simplex.Messaging.Server
+      Simplex.Messaging.Server.Env.STM
+      Simplex.Messaging.Server.MsgStore
+      Simplex.Messaging.Server.MsgStore.STM
+      Simplex.Messaging.Server.QueueStore
+      Simplex.Messaging.Server.QueueStore.STM
+      Simplex.Messaging.Server.StoreLog
+      Simplex.Messaging.Transport
+      Simplex.Messaging.Transport.WebSockets
+      Simplex.Messaging.Util
+  other-modules:
+      Paths_simplexmq_v0
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
+  build-depends:
+      QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , file-embed >=0.0.14.0 && <=0.0.15.0
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , http-types ==0.12.*
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.*
+    , network-transport ==0.5.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+  default-language: Haskell2010
+
+executable smp-agent
+  main-is: Main.hs
+  other-modules:
+      Paths_simplexmq_v0
+  hs-source-dirs:
+      apps/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.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , file-embed >=0.0.14.0 && <=0.0.15.0
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , http-types ==0.12.*
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.*
+    , network-transport ==0.5.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , simplexmq-v0
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+  default-language: Haskell2010
+
+executable smp-server
+  main-is: Main.hs
+  other-modules:
+      Paths_simplexmq_v0
+  hs-source-dirs:
+      apps/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.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , file-embed >=0.0.14.0 && <=0.0.15.0
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , http-types ==0.12.*
+    , ini ==0.4.*
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.*
+    , network-transport ==0.5.*
+    , optparse-applicative >=0.15 && <0.17
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , simplexmq-v0
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+  default-language: Haskell2010
+
+test-suite smp-server-test
+  type: exitcode-stdio-1.0
+  main-is: Test.hs
+  other-modules:
+      AgentTests
+      AgentTests.ConnectionRequestTests
+      AgentTests.FunctionalAPITests
+      AgentTests.SQLiteTests
+      ProtocolErrorTests
+      ServerTests
+      SMPAgentClient
+      SMPClient
+      Paths_simplexmq_v0
+  hs-source-dirs:
+      tests
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
+  build-depends:
+      HUnit ==1.6.*
+    , QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , file-embed >=0.0.14.0 && <=0.0.15.0
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , hspec ==2.7.*
+    , hspec-core ==2.7.*
+    , http-types ==0.12.*
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.*
+    , network-transport ==0.5.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , simplexmq-v0
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , timeit ==2.0.*
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+  default-language: Haskell2010

src/Simplex/Markdown.hs

@@ -1,138 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Simplex.Markdown where
-
-import Control.Applicative ((<|>))
-import Data.Attoparsec.Text (Parser)
-import qualified Data.Attoparsec.Text as A
-import Data.Either (fromRight)
-import Data.Functor (($>))
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-import Data.String
-import Data.Text (Text)
-import qualified Data.Text as T
-import System.Console.ANSI.Types
-
-data Markdown = Markdown Format Text | Markdown :|: Markdown
-  deriving (Eq, Show)
-
-data Format
-  = Bold
-  | Italic
-  | Underline
-  | StrikeThrough
-  | Snippet
-  | Secret
-  | Colored Color
-  | NoFormat
-  deriving (Eq, Show)
-
-instance Semigroup Markdown where (<>) = (:|:)
-
-instance Monoid Markdown where mempty = unmarked ""
-
-instance IsString Markdown where fromString = unmarked . T.pack
-
-unmarked :: Text -> Markdown
-unmarked = Markdown NoFormat
-
-colorMD :: Char
-colorMD = '!'
-
-secretMD :: Char
-secretMD = '#'
-
-formats :: Map Char Format
-formats =
-  M.fromList
-    [ ('*', Bold),
-      ('_', Italic),
-      ('+', Underline),
-      ('~', StrikeThrough),
-      ('`', Snippet),
-      (secretMD, Secret),
-      (colorMD, Colored White)
-    ]
-
-colors :: Map Text Color
-colors =
-  M.fromList
-    [ ("red", Red),
-      ("green", Green),
-      ("blue", Blue),
-      ("yellow", Yellow),
-      ("cyan", Cyan),
-      ("magenta", Magenta),
-      ("r", Red),
-      ("g", Green),
-      ("b", Blue),
-      ("y", Yellow),
-      ("c", Cyan),
-      ("m", Magenta),
-      ("1", Red),
-      ("2", Green),
-      ("3", Blue),
-      ("4", Yellow),
-      ("5", Cyan),
-      ("6", Magenta)
-    ]
-
-parseMarkdown :: Text -> Markdown
-parseMarkdown s = fromRight (unmarked s) $ A.parseOnly (markdownP <* A.endOfInput) s
-
-markdownP :: Parser Markdown
-markdownP = merge <$> A.many' fragmentP
-  where
-    merge :: [Markdown] -> Markdown
-    merge [] = ""
-    merge fs = foldr1 (:|:) fs
-    fragmentP :: Parser Markdown
-    fragmentP =
-      A.anyChar >>= \case
-        ' ' -> unmarked . T.cons ' ' <$> A.takeWhile (== ' ')
-        c -> case M.lookup c formats of
-          Just Secret -> secretP
-          Just (Colored White) -> coloredP
-          Just f -> formattedP c "" f
-          Nothing -> unformattedP c
-    formattedP :: Char -> Text -> Format -> Parser Markdown
-    formattedP c p f = do
-      s <- A.takeTill (== c)
-      (A.char c $> markdown c p f s) <|> noFormat (c `T.cons` p <> s)
-    markdown :: Char -> Text -> Format -> Text -> Markdown
-    markdown c p f s
-      | T.null s || T.head s == ' ' || T.last s == ' ' =
-        unmarked $ c `T.cons` p <> s `T.snoc` c
-      | otherwise = Markdown f s
-    secretP :: Parser Markdown
-    secretP = secret <$> A.takeWhile (== secretMD) <*> A.takeTill (== secretMD) <*> A.takeWhile (== secretMD)
-    secret :: Text -> Text -> Text -> Markdown
-    secret b s a
-      | T.null a || T.null s || T.head s == ' ' || T.last s == ' ' =
-        unmarked $ secretMD `T.cons` ss
-      | otherwise = Markdown Secret $ T.init ss
-      where
-        ss = b <> s <> a
-    coloredP :: Parser Markdown
-    coloredP = do
-      color <- A.takeWhile (\c -> c /= ' ' && c /= colorMD)
-      case M.lookup color colors of
-        Just c ->
-          let f = Colored c
-           in (A.char ' ' *> formattedP colorMD (color `T.snoc` ' ') f)
-                <|> noFormat (colorMD `T.cons` color)
-        _ -> noFormat (colorMD `T.cons` color)
-    unformattedP :: Char -> Parser Markdown
-    unformattedP c = unmarked . T.cons c <$> wordsP
-    wordsP :: Parser Text
-    wordsP = do
-      s <- (<>) <$> A.takeTill (== ' ') <*> A.takeWhile (== ' ')
-      A.peekChar >>= \case
-        Nothing -> pure s
-        Just c -> case M.lookup c formats of
-          Just _ -> pure s
-          Nothing -> (s <>) <$> wordsP
-    noFormat :: Text -> Parser Markdown
-    noFormat = pure . unmarked

src/Simplex/Messaging/Agent.hs

@@ -1,69 +1,185 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 
+-- |
+-- Module      : Simplex.Messaging.Agent
+-- Copyright   : (c) simplex.chat
+-- License     : AGPL-3
+--
+-- Maintainer  : chat@simplex.chat
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- This module defines SMP protocol agent with SQLite persistence.
+--
+-- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md
 module Simplex.Messaging.Agent
-  ( runSMPAgent,
+  ( -- * SMP agent over TCP
+    runSMPAgent,
     runSMPAgentBlocking,
+
+    -- * queue-based SMP agent
+    getAgentClient,
+    runAgentClient,
+
+    -- * SMP agent functional API
+    AgentClient (..),
+    AgentMonad,
+    AgentErrorMonad,
     getSMPAgentClient,
-    runSMPAgentClient,
+    disconnectAgentClient, -- used in tests
+    withAgentLock,
+    createConnection,
+    joinConnection,
+    allowConnection,
+    acceptContact,
+    rejectContact,
+    subscribeConnection,
+    sendMessage,
+    ackMessage,
+    suspendConnection,
+    deleteConnection,
   )
 where
 
+import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple (logInfo, showText)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
+import Data.Bifunctor (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 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 Database.SQLite.Simple (SQLError)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
+import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
-import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore, connectSQLiteStore)
-import Simplex.Messaging.Agent.Transmission
+import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
 import Simplex.Messaging.Client (SMPServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (CorrId (..), MsgBody, SenderPublicKey)
+import Simplex.Messaging.Protocol (MsgBody, SenderPublicKey)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Transport (putLn, runTCPServer)
-import Simplex.Messaging.Util (bshow)
-import System.IO (Handle)
-import UnliftIO.Async (race_)
+import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), currentSMPVersionStr, runTransportServer)
+import Simplex.Messaging.Util (bshow, tryError, unlessM)
+import System.Random (randomR)
+import UnliftIO.Async (async, race_)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
-runSMPAgent :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> m ()
-runSMPAgent cfg = newEmptyTMVarIO >>= (`runSMPAgentBlocking` cfg)
+-- | 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
 
-runSMPAgentBlocking :: (MonadRandom m, MonadUnliftIO m) => TMVar Bool -> AgentConfig -> m ()
-runSMPAgentBlocking started cfg@AgentConfig {tcpPort} = runReaderT smpAgent =<< newSMPAgentEnv 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 :: (MonadUnliftIO m', MonadReader Env m') => m' ()
-    smpAgent = runTCPServer started tcpPort $ \h -> do
-      liftIO $ putLn h "Welcome to SMP v0.2.0 agent"
-      c <- getSMPAgentClient
+    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) (runSMPAgentClient c)
-        `E.finally` (closeSMPServerClients c >> logConnection c False)
+      race_ (connectClient h c) (runAgentClient c)
+        `E.finally` disconnectAgentClient c
 
-getSMPAgentClient :: (MonadUnliftIO m, MonadReader Env m) => m AgentClient
-getSMPAgentClient = do
-  n <- asks clientCounter
-  cfg <- asks config
-  atomically $ newAgentClient n cfg
+-- | Creates an SMP agent client instance
+getSMPAgentClient :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> m AgentClient
+getSMPAgentClient cfg = newSMPAgentEnv cfg >>= runReaderT runAgent
+  where
+    runAgent = do
+      c <- getAgentClient
+      action <- async $ subscriber c `E.finally` disconnectAgentClient c
+      pure c {smpSubscriber = action}
 
-connectClient :: MonadUnliftIO m => Handle -> AgentClient -> m ()
+disconnectAgentClient :: MonadUnliftIO m => AgentClient -> m ()
+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 c cMode = withAgentEnv c $ newConn c "" cMode
+
+-- | Join SMP agent connection (JOIN command)
+joinConnection :: AgentErrorMonad m => AgentClient -> ConnectionRequest c -> ConnInfo -> m ConnId
+joinConnection c = withAgentEnv c .: joinConn c ""
+
+-- | Allow connection to continue after CONF notification (LET command)
+allowConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
+allowConnection c = withAgentEnv c .:. allowConnection' c
+
+-- | Accept contact after REQ notification (ACPT command)
+acceptContact :: AgentErrorMonad m => AgentClient -> ConfirmationId -> ConnInfo -> m ConnId
+acceptContact c = withAgentEnv c .: acceptContact' c ""
+
+-- | Reject contact (RJCT command)
+rejectContact :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> m ()
+rejectContact c = withAgentEnv c .: rejectContact' c
+
+-- | Subscribe to receive connection messages (SUB command)
+subscribeConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
+subscribeConnection c = withAgentEnv c . subscribeConnection' c
+
+-- | Send message to the connection (SEND command)
+sendMessage :: AgentErrorMonad m => AgentClient -> ConnId -> MsgBody -> m AgentMsgId
+sendMessage c = withAgentEnv c .: sendMessage' c
+
+ackMessage :: AgentErrorMonad m => AgentClient -> ConnId -> AgentMsgId -> m ()
+ackMessage c = withAgentEnv c .: ackMessage' c
+
+-- | Suspend SMP agent connection (OFF command)
+suspendConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
+suspendConnection c = withAgentEnv c . suspendConnection' c
+
+-- | Delete SMP agent connection (DEL command)
+deleteConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
+deleteConnection c = withAgentEnv c . deleteConnection' c
+
+withAgentEnv :: AgentClient -> ReaderT Env m a -> m a
+withAgentEnv c = (`runReaderT` agentEnv c)
+
+-- withAgentClient :: AgentErrorMonad m => AgentClient -> ReaderT Env m a -> m a
+-- withAgentClient c = withAgentLock c . withAgentEnv c
+
+-- | Creates an SMP agent client instance that receives commands and sends responses via 'TBQueue's.
+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 ()
@@ -71,260 +187,445 @@ logConnection c connected =
   let event = if connected then "connected to" else "disconnected from"
    in logInfo $ T.unwords ["client", showText (clientId c), event, "Agent"]
 
-runSMPAgentClient :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
-runSMPAgentClient c = do
-  db <- asks $ dbFile . config
-  s1 <- connectSQLiteStore db
-  s2 <- connectSQLiteStore db
-  race_ (subscriber c s1) (client c s2)
+-- | Runs an SMP agent instance that receives commands and sends responses via 'TBQueue's.
+runAgentClient :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
+runAgentClient c = race_ (subscriber c) (client c)
 
-receive :: forall m. MonadUnliftIO m => Handle -> AgentClient -> m ()
-receive h c@AgentClient {rcvQ, sndQ} = forever $ do
-  (corrId, cAlias, cmdOrErr) <- tGet SClient h
+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, cAlias, cmd)
-    Left e -> write sndQ (corrId, cAlias, ERR e)
+    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 :: MonadUnliftIO m => Handle -> AgentClient -> m ()
-send h c@AgentClient {sndQ} = forever $ do
-  t <- atomically $ readTBQueue sndQ
+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 corrId, cAlias, cmd) = do
-  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, cAlias, B.takeWhile (/= ' ') $ serializeCommand cmd]
+logClient AgentClient {clientId} dir (corrId, connId, cmd) = do
+  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, connId, B.takeWhile (/= ' ') $ serializeCommand cmd]
 
-client :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> SQLiteStore -> m ()
-client c@AgentClient {rcvQ, sndQ} st = forever $ do
-  t@(corrId, cAlias, _) <- atomically $ readTBQueue rcvQ
-  runExceptT (processCommand c st t) >>= \case
-    Left e -> atomically $ writeTBQueue sndQ (corrId, cAlias, ERR e)
-    Right _ -> return ()
+client :: forall m. (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
+client c@AgentClient {rcvQ, subQ} = forever $ do
+  (corrId, connId, cmd) <- atomically $ readTBQueue rcvQ
+  withAgentLock c (runExceptT $ processCommand c (connId, cmd))
+    >>= atomically . writeTBQueue subQ . \case
+      Left e -> (corrId, connId, ERR e)
+      Right (connId', resp) -> (corrId, connId', resp)
 
 withStore ::
   AgentMonad m =>
-  (forall m'. (MonadUnliftIO m', MonadError StoreError m') => m' a) ->
+  (forall m'. (MonadUnliftIO m', MonadError StoreError m') => SQLiteStore -> m' a) ->
   m a
 withStore action = do
-  runExceptT (action `E.catch` handleInternal) >>= \case
+  st <- asks store
+  runExceptT (action st `E.catch` handleInternal) >>= \case
     Right c -> return c
     Left 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
     storeError :: StoreError -> AgentErrorType
     storeError = \case
-      SEConnNotFound -> CONN UNKNOWN
+      SEConnNotFound -> CONN NOT_FOUND
       SEConnDuplicate -> CONN DUPLICATE
+      SEBadConnType CRcv -> CONN SIMPLEX
+      SEBadConnType CSnd -> CONN SIMPLEX
+      SEInvitationNotFound -> CMD PROHIBITED
       e -> INTERNAL $ show e
 
-processCommand :: forall m. AgentMonad m => AgentClient -> SQLiteStore -> ATransmission 'Client -> m ()
-processCommand c@AgentClient {sndQ} st (corrId, connAlias, cmd) =
-  case cmd of
-    NEW smpServer -> createNewConnection smpServer
-    JOIN smpQueueInfo replyMode -> joinConnection smpQueueInfo replyMode
-    SUB -> subscribeConnection connAlias
-    SUBALL -> subscribeAll
-    SEND msgBody -> sendMessage msgBody
-    OFF -> suspendConnection
-    DEL -> deleteConnection
+-- | execute any SMP agent command
+processCommand :: forall m. AgentMonad m => AgentClient -> (ConnId, ACommand 'Client) -> m (ConnId, ACommand 'Agent)
+processCommand c (connId, cmd) = case cmd of
+  NEW (ACM cMode) -> second (INV . ACR cMode) <$> newConn c connId cMode
+  JOIN (ACR _ cReq) connInfo -> (,OK) <$> joinConn c connId cReq connInfo
+  LET confId ownCInfo -> allowConnection' c connId confId ownCInfo $> (connId, OK)
+  ACPT invId ownCInfo -> (,OK) <$> acceptContact' c connId invId ownCInfo
+  RJCT invId -> rejectContact' c connId invId $> (connId, OK)
+  SUB -> subscribeConnection' c connId $> (connId, OK)
+  SEND msgBody -> (connId,) . MID <$> sendMessage' c connId msgBody
+  ACK msgId -> ackMessage' c connId msgId $> (connId, OK)
+  OFF -> suspendConnection' c connId $> (connId, OK)
+  DEL -> deleteConnection' c connId $> (connId, OK)
+
+newConn :: AgentMonad m => AgentClient -> ConnId -> SConnectionMode c -> m (ConnId, ConnectionRequest c)
+newConn c connId cMode = do
+  srv <- getSMPServer
+  (rq, qUri, encryptKey) <- 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
+
+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'
+
+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
-    createNewConnection :: SMPServer -> m ()
-    createNewConnection server = do
-      -- TODO create connection alias if not passed
-      -- make connAlias Maybe?
-      (rq, qInfo) <- newReceiveQueue c server connAlias
-      withStore $ createRcvConn st rq
-      respond $ INV qInfo
+    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
 
-    joinConnection :: SMPQueueInfo -> ReplyMode -> m ()
-    joinConnection qInfo@(SMPQueueInfo srv _ _) replyMode = do
-      -- TODO create connection alias if not passed
-      -- make connAlias Maybe?
-      (sq, senderKey, verifyKey) <- newSendQueue qInfo connAlias
-      withStore $ createSndConn st sq
-      connectToSendQueue c st sq senderKey verifyKey
-      case replyMode of
-        ReplyOn -> sendReplyQInfo srv sq
-        ReplyVia srv' -> sendReplyQInfo srv' sq
-        ReplyOff -> return ()
-      respond CON
+-- | 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
+    _ -> throwError $ CMD PROHIBITED
 
-    subscribeConnection :: ConnAlias -> m ()
-    subscribeConnection cAlias =
-      withStore (getConn st cAlias) >>= \case
-        SomeConn _ (DuplexConnection _ rq _) -> subscribe rq
-        SomeConn _ (RcvConnection _ rq) -> subscribe rq
-        _ -> throwError $ CONN SIMPLEX
+-- | Accept contact (ACPT command) in Reader monad
+acceptContact' :: AgentMonad m => AgentClient -> ConnId -> InvitationId -> ConnInfo -> m ConnId
+acceptContact' c connId invId ownConnInfo = do
+  Invitation {contactConnId, connReq} <- withStore (`getInvitation` invId)
+  withStore (`getConn` contactConnId) >>= \case
+    SomeConn _ ContactConnection {} -> do
+      withStore $ \st -> acceptInvitation st invId ownConnInfo
+      joinConn c connId connReq ownConnInfo
+    _ -> throwError $ CMD PROHIBITED
+
+-- | Reject contact (RJCT command) in Reader monad
+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
+  withStore $ \st -> setRcvQueueStatus st rq Secured
+
+-- | Subscribe to receive connection messages (SUB command) in Reader monad
+subscribeConnection' :: forall m. AgentMonad m => AgentClient -> ConnId -> m ()
+subscribeConnection' c connId =
+  withStore (`getConn` connId) >>= \case
+    SomeConn _ (DuplexConnection _ rq sq) -> do
+      resumeMsgDelivery c connId sq
+      case status (sq :: SndQueue) of
+        Confirmed -> withVerifyKey sq $ \verifyKey -> do
+          conf <- withStore (`getAcceptedConfirmation` connId)
+          secureQueue c rq $ senderKey (conf :: AcceptedConfirmation)
+          withStore $ \st -> setRcvQueueStatus st rq Secured
+          activateSecuredQueue rq sq verifyKey
+        Secured -> withVerifyKey sq $ activateSecuredQueue rq sq
+        Active -> subscribeQueue c rq connId
+        _ -> throwError $ INTERNAL "unexpected queue status"
+    SomeConn _ (SndConnection _ sq) -> do
+      resumeMsgDelivery c connId sq
+      case status (sq :: SndQueue) of
+        Confirmed -> withVerifyKey sq $ \verifyKey ->
+          activateQueueJoining c connId sq verifyKey =<< resumeInterval
+        Active -> throwError $ CONN SIMPLEX
+        _ -> throwError $ INTERNAL "unexpected queue status"
+    SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId
+    SomeConn _ (ContactConnection _ rq) -> subscribeQueue c rq connId
+  where
+    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
+    _ -> throwError $ CONN SIMPLEX
+  where
+    enqueueMessage :: SndQueue -> m AgentMsgId
+    enqueueMessage sq = do
+      resumeMsgDelivery c connId sq
+      msgId <- storeSentMsg
+      queuePendingMsgs c connId sq [msgId]
+      pure $ unId msgId
       where
-        subscribe rq = subscribeQueue c rq cAlias >> respond' cAlias OK
-
-    -- TODO remove - hack for subscribing to all; respond' and parameterization of subscribeConnection are byproduct
-    subscribeAll :: m ()
-    subscribeAll = withStore (getAllConnAliases st) >>= mapM_ subscribeConnection
-
-    sendMessage :: MsgBody -> m ()
-    sendMessage msgBody =
-      withStore (getConn st connAlias) >>= \case
-        SomeConn _ (DuplexConnection _ _ sq) -> sendMsg sq
-        SomeConn _ (SndConnection _ sq) -> sendMsg sq
-        _ -> throwError $ CONN SIMPLEX
-      where
-        sendMsg sq = do
+        storeSentMsg :: m InternalId
+        storeSentMsg = do
           internalTs <- liftIO getCurrentTime
-          (internalId, internalSndId, previousMsgHash) <- withStore $ updateSndIds st sq
-          let msgStr =
-                serializeSMPMessage
-                  SMPMessage
-                    { senderMsgId = unSndId internalSndId,
-                      senderTimestamp = internalTs,
-                      previousMsgHash,
-                      agentMessage = A_MSG msgBody
-                    }
-              msgHash = C.sha256Hash msgStr
-          withStore $
-            createSndMsg st sq $
-              SndMsgData {internalId, internalSndId, internalTs, msgBody, internalHash = msgHash}
-          sendAgentMessage c sq msgStr
-          respond $ SENT (unId internalId)
+          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
 
-    suspendConnection :: m ()
-    suspendConnection =
-      withStore (getConn st connAlias) >>= \case
-        SomeConn _ (DuplexConnection _ rq _) -> suspend rq
-        SomeConn _ (RcvConnection _ rq) -> suspend rq
-        _ -> throwError $ CONN SIMPLEX
-      where
-        suspend rq = suspendQueue c rq >> respond OK
+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
+    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))
 
-    deleteConnection :: m ()
-    deleteConnection =
-      withStore (getConn st connAlias) >>= \case
-        SomeConn _ (DuplexConnection _ rq _) -> delete rq
-        SomeConn _ (RcvConnection _ rq) -> delete rq
-        _ -> delConn
-      where
-        delConn = withStore (deleteConn st connAlias) >> respond OK
-        delete rq = do
-          deleteQueue c rq
-          removeSubscription c connAlias
-          delConn
+queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> [InternalId] -> m ()
+queuePendingMsgs c connId sq msgIds = atomically $ do
+  q <- getPendingMsgQ c connId sq
+  mapM_ (writeTQueue q) msgIds
 
-    sendReplyQInfo :: SMPServer -> SndQueue -> m ()
-    sendReplyQInfo srv sq = do
-      (rq, qInfo) <- newReceiveQueue c srv connAlias
-      withStore $ upgradeSndConnToDuplex st connAlias rq
-      senderTimestamp <- liftIO getCurrentTime
-      sendAgentMessage c sq . serializeSMPMessage $
-        SMPMessage
-          { senderMsgId = 0,
-            senderTimestamp,
-            previousMsgHash = "",
-            agentMessage = REPLY qInfo
-          }
+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 (smpQueueMsgQueues c) $ M.insert qKey mq
+      pure mq
 
-    respond :: ACommand 'Agent -> m ()
-    respond = respond' connAlias
+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
+    msgId <- atomically $ readTQueue mq
+    let mId = unId msgId
+    withStore (\st -> E.try $ getPendingMsgData st connId msgId) >>= \case
+      Left (e :: E.SomeException) ->
+        notify $ MERR mId (INTERNAL $ show e)
+      Right msgBody -> do
+        withRetryInterval ri $ \loop -> do
+          tryError (sendAgentMessage c sq msgBody) >>= \case
+            Left e -> case e of
+              SMP SMP.QUOTA -> loop
+              SMP {} -> notify $ MERR mId e
+              CMD {} -> notify $ MERR mId e
+              _ -> loop
+            Right () -> do
+              notify $ SENT mId
+              withStore $ \st -> updateSndMsgStatus st connId msgId SndMsgSent
+  where
+    notify :: ACommand 'Agent -> m ()
+    notify cmd = atomically $ writeTBQueue subQ ("", connId, cmd)
 
-    respond' :: ConnAlias -> ACommand 'Agent -> m ()
-    respond' cAlias resp = atomically $ writeTBQueue sndQ (corrId, cAlias, resp)
+ackMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> AgentMsgId -> m ()
+ackMessage' c connId msgId = do
+  withStore (`getConn` connId) >>= \case
+    SomeConn _ (DuplexConnection _ rq _) -> ack rq
+    SomeConn _ (RcvConnection _ rq) -> ack rq
+    _ -> throwError $ CONN SIMPLEX
+  where
+    ack :: RcvQueue -> m ()
+    ack rq = do
+      let mId = InternalId msgId
+      withStore $ \st -> checkRcvMsg st connId mId
+      sendAck c rq
+      withStore $ \st -> updateRcvMsgAck st connId mId
 
-subscriber :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> SQLiteStore -> m ()
-subscriber c@AgentClient {msgQ} st = forever $ do
-  -- TODO this will only process messages and notifications
+-- | Suspend SMP agent connection (OFF command) in Reader monad
+suspendConnection' :: AgentMonad m => AgentClient -> ConnId -> m ()
+suspendConnection' c connId =
+  withStore (`getConn` connId) >>= \case
+    SomeConn _ (DuplexConnection _ rq _) -> suspendQueue c rq
+    SomeConn _ (RcvConnection _ rq) -> suspendQueue c rq
+    _ -> throwError $ CONN SIMPLEX
+
+-- | Delete SMP agent connection (DEL command) in Reader monad
+deleteConnection' :: forall m. AgentMonad m => AgentClient -> ConnId -> m ()
+deleteConnection' c connId =
+  withStore (`getConn` connId) >>= \case
+    SomeConn _ (DuplexConnection _ rq _) -> delete rq
+    SomeConn _ (RcvConnection _ rq) -> delete rq
+    SomeConn _ (ContactConnection _ rq) -> delete rq
+    SomeConn _ (SndConnection _ _) -> withStore (`deleteConn` connId)
+  where
+    delete :: RcvQueue -> m ()
+    delete rq = do
+      deleteQueue c rq
+      removeSubscription c connId
+      withStore (`deleteConn` connId)
+
+getSMPServer :: AgentMonad m => m SMPServer
+getSMPServer =
+  asks (smpServers . config) >>= \case
+    srv :| [] -> pure srv
+    servers -> do
+      gen <- asks randomServer
+      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
-  runExceptT (processSMPTransmission c st t) >>= \case
+  withAgentLock c (runExceptT $ processSMPTransmission c t) >>= \case
     Left e -> liftIO $ print e
     Right _ -> return ()
 
-processSMPTransmission :: forall m. AgentMonad m => AgentClient -> SQLiteStore -> SMPServerTransmission -> m ()
-processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
-  rq@RcvQueue {connAlias, status} <- withStore $ getRcvQueue st srv rId
-  case cmd of
-    SMP.MSG srvMsgId srvTs msgBody -> do
-      -- TODO deduplicate with previously received
-      msg <- decryptAndVerify rq msgBody
-      let msgHash = C.sha256Hash msg
-      agentMsg <- liftEither $ parseSMPMessage msg
-      case agentMsg of
-        SMPConfirmation senderKey -> do
+processSMPTransmission :: forall m. AgentMonad m => AgentClient -> SMPServerTransmission -> m ()
+processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
+  withStore (\st -> getRcvConn st srv rId) >>= \case
+    SomeConn SCDuplex (DuplexConnection cData rq _) -> processSMP SCDuplex cData rq
+    SomeConn SCRcv (RcvConnection cData rq) -> processSMP SCRcv cData rq
+    SomeConn SCContact (ContactConnection cData rq) -> processSMP SCContact cData rq
+    _ -> atomically $ writeTBQueue subQ ("", "", ERR $ CONN NOT_FOUND)
+  where
+    processSMP :: SConnType c -> ConnData -> RcvQueue -> m ()
+    processSMP cType ConnData {connId} rq@RcvQueue {status} =
+      case cmd of
+        SMP.MSG srvMsgId srvTs msgBody -> 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
+        SMP.END -> do
+          removeSubscription c connId
+          logServer "<--" c srv rId "END"
+          notify END
+        _ -> do
+          logServer "<--" c srv rId $ "unexpected: " <> bshow cmd
+          notify . ERR $ BROKER UNEXPECTED
+      where
+        notify :: ACommand 'Agent -> m ()
+        notify msg = atomically $ writeTBQueue subQ ("", connId, msg)
+
+        prohibited :: m ()
+        prohibited = notify . ERR $ AGENT A_PROHIBITED
+
+        smpConfirmation :: SenderPublicKey -> ConnInfo -> m ()
+        smpConfirmation senderKey cInfo = do
           logServer "<--" c srv rId "MSG <KEY>"
           case status of
-            New -> do
-              -- TODO currently it automatically allows whoever sends the confirmation
-              -- Commands CONF and LET are not supported in v0.2
-              withStore $ setRcvQueueStatus st rq Confirmed
-              -- TODO update sender key in the store?
-              secureQueue c rq senderKey
-              withStore $ setRcvQueueStatus st rq Secured
-            _ -> notify connAlias . ERR $ AGENT A_PROHIBITED
-        SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
-          case agentMessage of
-            HELLO verifyKey _ -> do
-              logServer "<--" c srv rId "MSG <HELLO>"
-              case status of
-                Active -> notify connAlias . ERR $ AGENT A_PROHIBITED
-                _ -> do
-                  void $ verifyMessage (Just verifyKey) msgBody
-                  withStore $ setRcvQueueActive st rq verifyKey
-            REPLY qInfo -> do
-              logServer "<--" c srv rId "MSG <REPLY>"
-              (sq, senderKey, verifyKey) <- newSendQueue qInfo connAlias
-              withStore $ upgradeRcvConnToDuplex st connAlias sq
-              connectToSendQueue c st sq senderKey verifyKey
-              notify connAlias CON
-            A_MSG body -> agentClientMsg rq previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash
-      sendAck c rq
-      return ()
-    SMP.END -> do
-      removeSubscription c connAlias
-      logServer "<--" c srv rId "END"
-      notify connAlias END
-    _ -> do
-      logServer "<--" c srv rId $ "unexpected: " <> bshow cmd
-      notify connAlias . ERR $ BROKER UNEXPECTED
-  where
-    notify :: ConnAlias -> ACommand 'Agent -> m ()
-    notify connAlias msg = atomically $ writeTBQueue sndQ ("", connAlias, msg)
-    agentClientMsg :: RcvQueue -> PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m ()
-    agentClientMsg rq@RcvQueue {connAlias, status} receivedPrevMsgHash senderMeta brokerMeta msgBody msgHash = do
-      logServer "<--" c srv rId "MSG <MSG>"
-      case status of
-        Active -> do
+            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
+              _ -> prohibited
+            _ -> prohibited
+
+        helloMsg :: SenderPublicKey -> ByteString -> m ()
+        helloMsg verifyKey msgBody = do
+          logServer "<--" c srv rId "MSG <HELLO>"
+          case status of
+            Active -> prohibited
+            _ -> do
+              void $ verifyMessage (Just verifyKey) msgBody
+              withStore $ \st -> setRcvQueueActive st rq verifyKey
+              case cType of
+                SCDuplex -> notifyConnected c connId
+                _ -> pure ()
+
+        replyMsg :: ConnectionRequest 'CMInvitation -> m ()
+        replyMsg (CRInvitation (ConnReqData _ (qUri :| _) encryptKey)) = 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
+            _ -> prohibited
+
+        agentClientMsg :: PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m ()
+        agentClientMsg externalPrevSndHash sender broker msgBody internalHash = do
+          logServer "<--" c srv rId "MSG <MSG>"
           internalTs <- liftIO getCurrentTime
-          (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore $ updateRcvIds st rq
-          let msgIntegrity = checkMsgIntegrity prevExtSndId (fst senderMeta) prevRcvMsgHash
-          withStore $
-            createRcvMsg st rq $
-              RcvMsgData
-                { internalId,
-                  internalRcvId,
-                  internalTs,
-                  senderMeta,
-                  brokerMeta,
-                  msgBody,
-                  internalHash = msgHash,
-                  externalPrevSndHash = receivedPrevMsgHash,
-                  msgIntegrity
-                }
-          notify connAlias $
-            MSG
-              { recipientMeta = (unId internalId, internalTs),
-                senderMeta,
-                brokerMeta,
-                msgBody,
-                msgIntegrity
-              }
-        _ -> notify connAlias . ERR $ AGENT A_PROHIBITED
-      where
-        checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> MsgIntegrity
-        checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash
+          (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore (`updateRcvIds` connId)
+          let integrity = checkMsgIntegrity prevExtSndId (fst sender) prevRcvMsgHash externalPrevSndHash
+              recipient = (unId internalId, internalTs)
+              msgMeta = MsgMeta {integrity, recipient, sender, broker}
+              rcvMsg = RcvMsgData {..}
+          withStore $ \st -> createRcvMsg st connId rcvMsg
+          notify $ MSG msgMeta msgBody
+
+        smpInvitation :: ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
+        smpInvitation connReq cInfo = do
+          logServer "<--" c srv rId "MSG <KEY>"
+          case cType of
+            SCContact -> do
+              g <- asks idsDrg
+              let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo}
+              invId <- withStore $ \st -> createInvitation st g newInv
+              notify $ REQ invId cInfo
+            _ -> prohibited
+
+        checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity
+        checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash receivedPrevMsgHash
           | extSndId == prevExtSndId + 1 && internalPrevMsgHash == receivedPrevMsgHash = MsgOk
           | extSndId < prevExtSndId = MsgError $ MsgBadId extSndId
           | extSndId == prevExtSndId = MsgError MsgDuplicate -- ? deduplicate
@@ -332,16 +633,39 @@ processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
           | internalPrevMsgHash /= receivedPrevMsgHash = MsgError MsgBadHash
           | otherwise = MsgError MsgDuplicate -- this case is not possible
 
-connectToSendQueue :: AgentMonad m => AgentClient -> SQLiteStore -> SndQueue -> SenderPublicKey -> VerificationKey -> m ()
-connectToSendQueue c st sq senderKey verifyKey = do
-  sendConfirmation c sq senderKey
-  withStore $ setSndQueueStatus st sq Confirmed
-  sendHello c sq verifyKey
-  withStore $ setSndQueueStatus st sq Active
+confirmQueue :: AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> ConnInfo -> m ()
+confirmQueue c sq senderKey cInfo = do
+  sendConfirmation c sq senderKey cInfo
+  withStore $ \st -> setSndQueueStatus st sq Confirmed
 
-newSendQueue ::
-  (MonadUnliftIO m, MonadReader Env m) => SMPQueueInfo -> ConnAlias -> m (SndQueue, SenderPublicKey, VerificationKey)
-newSendQueue (SMPQueueInfo smpServer senderId encryptKey) connAlias = do
+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
+
+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
@@ -349,7 +673,6 @@ newSendQueue (SMPQueueInfo smpServer senderId encryptKey) connAlias = do
         SndQueue
           { server = smpServer,
             sndId = senderId,
-            connAlias,
             sndPrivateKey,
             encryptKey,
             signKey,

src/Simplex/Messaging/Agent/Client.hs

@@ -11,11 +11,14 @@ module Simplex.Messaging.Agent.Client
   ( AgentClient (..),
     newAgentClient,
     AgentMonad,
-    getSMPServerClient,
-    closeSMPServerClients,
-    newReceiveQueue,
+    withAgentLock,
+    closeAgentClient,
+    newRcvQueue,
     subscribeQueue,
+    addSubscription,
     sendConfirmation,
+    sendInvitation,
+    RetryInterval (..),
     sendHello,
     secureQueue,
     sendAgentMessage,
@@ -27,9 +30,14 @@ module Simplex.Messaging.Agent.Client
     logServer,
     removeSubscription,
     cryptoError,
+    addActivation,
+    getActivation,
+    removeActivation,
   )
 where
 
+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
@@ -40,44 +48,62 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+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.ExceptT ()
+import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
-import Simplex.Messaging.Agent.Transmission
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgBody, QueueId, SenderPublicKey)
+import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Util (bshow, liftEitherError, liftError)
-import UnliftIO.Concurrent
 import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
 data AgentClient = AgentClient
   { rcvQ :: TBQueue (ATransmission 'Client),
-    sndQ :: TBQueue (ATransmission 'Agent),
+    subQ :: TBQueue (ATransmission 'Agent),
     msgQ :: TBQueue SMPServerTransmission,
     smpClients :: TVar (Map SMPServer SMPClient),
-    subscrSrvrs :: TVar (Map SMPServer (Set ConnAlias)),
-    subscrConns :: TVar (Map ConnAlias SMPServer),
-    clientId :: Int
+    subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
+    subscrConns :: TVar (Map ConnId SMPServer),
+    activations :: TVar (Map ConnId (Async ())), -- activations of send queues in progress
+    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,
+    smpSubscriber :: Async (),
+    lock :: TMVar ()
   }
 
-newAgentClient :: TVar Int -> AgentConfig -> STM AgentClient
-newAgentClient cc AgentConfig {tbqSize} = do
-  rcvQ <- newTBQueue tbqSize
-  sndQ <- newTBQueue tbqSize
-  msgQ <- newTBQueue tbqSize
+newAgentClient :: Env -> STM AgentClient
+newAgentClient agentEnv = do
+  let qSize = tbqSize $ config agentEnv
+  rcvQ <- newTBQueue qSize
+  subQ <- newTBQueue qSize
+  msgQ <- newTBQueue qSize
   smpClients <- newTVar M.empty
   subscrSrvrs <- newTVar M.empty
   subscrConns <- newTVar M.empty
-  clientId <- (+ 1) <$> readTVar cc
-  writeTVar cc clientId
-  return AgentClient {rcvQ, sndQ, msgQ, smpClients, subscrSrvrs, subscrConns, clientId}
+  activations <- 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, 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)
 
 getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPServer -> m SMPClient
@@ -95,33 +121,75 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
     connectClient :: m SMPClient
     connectClient = do
       cfg <- asks $ smpCfg . config
-      liftEitherError smpClientError (getSMPClient srv cfg msgQ clientDisconnected)
+      u <- askUnliftIO
+      liftEitherError smpClientError (getSMPClient srv cfg msgQ $ clientDisconnected u)
         `E.catch` internalError
       where
         internalError :: IOException -> m SMPClient
         internalError = throwError . INTERNAL . show
 
-    clientDisconnected :: IO ()
-    clientDisconnected = do
-      removeSubs >>= mapM_ (mapM_ notifySub)
+    clientDisconnected :: UnliftIO m -> IO ()
+    clientDisconnected u = do
+      removeClientSubs >>= (`forM_` serverDown u)
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
-    removeSubs :: IO (Maybe (Set ConnAlias))
-    removeSubs = atomically $ do
+    removeClientSubs :: IO (Maybe (Map ConnId RcvQueue))
+    removeClientSubs = atomically $ do
       modifyTVar smpClients $ M.delete srv
       cs <- M.lookup srv <$> readTVar (subscrSrvrs c)
       modifyTVar (subscrSrvrs c) $ M.delete srv
-      modifyTVar (subscrConns c) $ maybe id deleteKeys cs
+      modifyTVar (subscrConns c) $ maybe id (deleteKeys . M.keysSet) cs
       return cs
       where
         deleteKeys :: Ord k => Set k -> Map k a -> Map k a
         deleteKeys ks m = S.foldr' M.delete m ks
 
-    notifySub :: ConnAlias -> IO ()
-    notifySub connAlias = atomically $ writeTBQueue (sndQ c) ("", connAlias, END)
+    serverDown :: UnliftIO m -> Map ConnId RcvQueue -> IO ()
+    serverDown u cs = unless (M.null cs) $ do
+      mapM_ (notifySub DOWN) $ M.keysSet cs
+      a <- async . unliftIO u $ tryReconnectClient cs
+      atomically $ modifyTVar (reconnections c) (a :)
 
-closeSMPServerClients :: MonadUnliftIO m => AgentClient -> m ()
-closeSMPServerClients c = liftIO $ readTVarIO (smpClients c) >>= mapM_ closeSMPClient
+    tryReconnectClient :: Map ConnId RcvQueue -> m ()
+    tryReconnectClient cs = do
+      ri <- asks $ reconnectInterval . config
+      withRetryInterval ri $ \loop ->
+        reconnectClient cs `catchError` const loop
+
+    reconnectClient :: Map ConnId RcvQueue -> m ()
+    reconnectClient cs = do
+      withAgentLock c . withSMP c srv $ \smp -> do
+        subs <- readTVarIO $ subscrConns c
+        forM_ (M.toList cs) $ \(connId, rq@RcvQueue {rcvPrivateKey, rcvId}) ->
+          when (isNothing $ M.lookup connId subs) $ do
+            subscribeSMPQueue smp rcvPrivateKey rcvId
+              `catchError` \case
+                SMPServerError e -> liftIO $ notifySub (ERR $ SMP e) connId
+                e -> throwError e
+            addSubscription c rq connId
+            liftIO $ notifySub UP connId
+
+    notifySub :: ACommand 'Agent -> ConnId -> IO ()
+    notifySub cmd connId = atomically $ writeTBQueue (subQ c) ("", connId, cmd)
+
+closeAgentClient :: MonadUnliftIO m => AgentClient -> m ()
+closeAgentClient c = liftIO $ do
+  closeSMPServerClients c
+  cancelActions $ activations c
+  cancelActions $ reconnections c
+  cancelActions $ smpQueueMsgDeliveries c
+
+closeSMPServerClients :: AgentClient -> IO ()
+closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ closeSMPClient
+
+cancelActions :: Foldable f => TVar (f (Async ())) -> IO ()
+cancelActions as = readTVarIO as >>= mapM_ uninterruptibleCancel
+
+withAgentLock :: MonadUnliftIO m => AgentClient -> m a -> m a
+withAgentLock AgentClient {lock} =
+  E.bracket_
+    (void . atomically $ takeTMVar lock)
+    (atomically $ putTMVar lock ())
 
 withSMP_ :: forall a m. AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> m a) -> m a
 withSMP_ c srv action =
@@ -158,8 +226,8 @@ smpClientError = \case
   SMPTransportError e -> BROKER $ TRANSPORT e
   e -> INTERNAL $ show e
 
-newReceiveQueue :: AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> m (RcvQueue, SMPQueueInfo)
-newReceiveQueue c srv connAlias = do
+newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri, EncryptionKey)
+newRcvQueue c srv = do
   size <- asks $ rsaKeySize . config
   (recipientKey, rcvPrivateKey) <- liftIO $ C.generateKeyPair size
   logServer "-->" c srv "" "NEW"
@@ -170,44 +238,50 @@ newReceiveQueue c srv connAlias = do
         RcvQueue
           { server = srv,
             rcvId,
-            connAlias,
             rcvPrivateKey,
             sndId = Just sId,
-            sndKey = Nothing,
             decryptKey,
             verifyKey = Nothing,
             status = New
           }
-  addSubscription c rq connAlias
-  return (rq, SMPQueueInfo srv sId encryptKey)
+  pure (rq, SMPQueueUri srv sId reservedServerKey, encryptKey)
 
-subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnAlias -> m ()
-subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connAlias = do
+subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
+subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
   withLogSMP c server rcvId "SUB" $ \smp ->
     subscribeSMPQueue smp rcvPrivateKey rcvId
-  addSubscription c rq connAlias
+  addSubscription c rq connId
 
-addSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnAlias -> m ()
-addSubscription c RcvQueue {server} connAlias = atomically $ do
-  modifyTVar (subscrConns c) $ M.insert connAlias server
+addSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnId -> m ()
+addSubscription c rq@RcvQueue {server} connId = atomically $ do
+  modifyTVar (subscrConns c) $ M.insert connId server
   modifyTVar (subscrSrvrs c) $ M.alter (Just . addSub) server
   where
-    addSub :: Maybe (Set ConnAlias) -> Set ConnAlias
-    addSub (Just cs) = S.insert connAlias cs
-    addSub _ = S.singleton connAlias
+    addSub :: Maybe (Map ConnId RcvQueue) -> Map ConnId RcvQueue
+    addSub (Just cs) = M.insert connId rq cs
+    addSub _ = M.singleton connId rq
 
-removeSubscription :: AgentMonad m => AgentClient -> ConnAlias -> m ()
-removeSubscription AgentClient {subscrConns, subscrSrvrs} connAlias = atomically $ do
+removeSubscription :: AgentMonad m => AgentClient -> ConnId -> m ()
+removeSubscription AgentClient {subscrConns, subscrSrvrs} connId = atomically $ do
   cs <- readTVar subscrConns
-  writeTVar subscrConns $ M.delete connAlias cs
+  writeTVar subscrConns $ M.delete connId cs
   mapM_
     (modifyTVar subscrSrvrs . M.alter (>>= delSub))
-    (M.lookup connAlias cs)
+    (M.lookup connId cs)
   where
-    delSub :: Set ConnAlias -> Maybe (Set ConnAlias)
+    delSub :: Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue)
     delSub cs =
-      let cs' = S.delete connAlias cs
-       in if S.null cs' then Nothing else Just cs'
+      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 =
@@ -219,20 +293,23 @@ showServer srv = B.pack $ host srv <> maybe "" (":" <>) (port srv)
 logSecret :: ByteString -> ByteString
 logSecret bs = encode $ B.take 3 bs
 
-sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> m ()
-sendConfirmation c sq@SndQueue {server, sndId} senderKey =
+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
+    mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey cInfo
 
-sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> m ()
-sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey =
+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 $ send 8 100000 msg smp
+    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
@@ -245,14 +322,22 @@ sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey =
             agentMessage = HELLO verifyKey ackMode
           }
 
-    send :: Int -> Int -> ByteString -> SMPClient -> ExceptT SMPClientError IO ()
-    send 0 _ _ _ = throwE $ SMPServerError AUTH
-    send retry delay msg smp =
-      sendSMPMessage smp (Just sndPrivateKey) sndId msg `catchE` \case
-        SMPServerError AUTH -> do
-          threadDelay delay
-          send (retry - 1) (delay * 3 `div` 2) msg smp
-        e -> throwE e
+sendInvitation :: forall m. AgentMonad m => AgentClient -> SMPQueueUri -> EncryptionKey -> ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
+sendInvitation c SMPQueueUri {smpServer, senderId} encryptKey cReq connInfo = do
+  withLogSMP_ c smpServer senderId "SEND <INV>" $ \smp -> do
+    msg <- mkInvitation smp
+    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
+          }
 
 secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
 secureQueue c RcvQueue {server, rcvId, rcvPrivateKey} senderKey =
@@ -293,6 +378,15 @@ decryptAndVerify RcvQueue {decryptKey, verifyKey} msg =
   verifyMessage verifyKey msg
     >>= liftError cryptoError . C.decrypt decryptKey
 
+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

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

@@ -1,43 +1,84 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 module Simplex.Messaging.Agent.Env.SQLite where
 
 import Control.Monad.IO.Unlift
 import Crypto.Random
+import Data.List.NonEmpty (NonEmpty)
 import Network.Socket
 import Numeric.Natural
+import Simplex.Messaging.Agent.Protocol (SMPServer)
+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 System.Random (StdGen, newStdGen)
 import UnliftIO.STM
 
 data AgentConfig = AgentConfig
   { tcpPort :: ServiceName,
+    smpServers :: NonEmpty SMPServer,
     rsaKeySize :: Int,
     connIdBytes :: Int,
     tbqSize :: Natural,
     dbFile :: FilePath,
-    smpCfg :: SMPClientConfig
+    dbPoolSize :: Int,
+    smpCfg :: SMPClientConfig,
+    retryInterval :: RetryInterval,
+    reconnectInterval :: RetryInterval
   }
 
+minute :: Int
+minute = 60_000_000
+
+defaultAgentConfig :: AgentConfig
+defaultAgentConfig =
+  AgentConfig
+    { tcpPort = "5224",
+      smpServers = undefined,
+      rsaKeySize = 2048 `div` 8,
+      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
+          }
+    }
+
 data Env = Env
   { config :: AgentConfig,
+    store :: SQLiteStore,
     idsDrg :: TVar ChaChaDRG,
     clientCounter :: TVar Int,
-    reservedMsgSize :: Int
+    reservedMsgSize :: Int,
+    randomServer :: TVar StdGen
   }
 
 newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env
-newSMPAgentEnv config = do
-  idsDrg <- drgNew >>= newTVarIO
-  _ <- createSQLiteStore $ dbFile config
+newSMPAgentEnv cfg = do
+  idsDrg <- newTVarIO =<< drgNew
+  store <- liftIO $ createSQLiteStore (dbFile cfg) (dbPoolSize cfg) Migrations.app
   clientCounter <- newTVarIO 0
-  return Env {config, idsDrg, clientCounter, reservedMsgSize}
+  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 config + smpCommandSize (smpCfg config)
+    reservedMsgSize = 3 * rsaKeySize cfg + smpCommandSize (smpCfg cfg)

src/Simplex/Messaging/Agent/ExceptT.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Simplex.Messaging.Agent.ExceptT where
+
+import Control.Monad.Except
+import Control.Monad.IO.Unlift
+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)

src/Simplex/Messaging/Agent/Protocol.hs

@@ -0,0 +1,862 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
+
+-- |
+-- Module      : Simplex.Messaging.Agent.Protocol
+-- Copyright   : (c) simplex.chat
+-- License     : AGPL-3
+--
+-- Maintainer  : chat@simplex.chat
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- Types, parsers, serializers and functions to send and receive SMP agent protocol commands and responses.
+--
+-- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md
+module Simplex.Messaging.Agent.Protocol
+  ( -- * SMP agent protocol types
+    ConnInfo,
+    ACommand (..),
+    AParty (..),
+    SAParty (..),
+    MsgHash,
+    MsgMeta (..),
+    SMPMessage (..),
+    AMessage (..),
+    SMPServer (..),
+    SMPQueueUri (..),
+    ConnectionMode (..),
+    SConnectionMode (..),
+    AConnectionMode (..),
+    cmInvitation,
+    cmContact,
+    ConnectionModeI (..),
+    ConnectionRequest (..),
+    AConnectionRequest (..),
+    ConnReqData (..),
+    ConnReqScheme (..),
+    simplexChat,
+    AgentErrorType (..),
+    CommandErrorType (..),
+    ConnectionErrorType (..),
+    BrokerErrorType (..),
+    SMPAgentError (..),
+    ATransmission,
+    ATransmissionOrError,
+    ARawTransmission,
+    ConnId,
+    ConfirmationId,
+    InvitationId,
+    AckMode (..),
+    OnOff (..),
+    MsgIntegrity (..),
+    MsgErrorType (..),
+    QueueStatus (..),
+    SignatureKey,
+    VerificationKey,
+    EncryptionKey,
+    DecryptionKey,
+    ACorrId,
+    AgentMsgId,
+
+    -- * Parse and serialize
+    serializeCommand,
+    serializeSMPMessage,
+    serializeMsgIntegrity,
+    serializeServer,
+    serializeSMPQueueUri,
+    reservedServerKey, -- TODO remove
+    serializeConnMode,
+    serializeConnMode',
+    connMode,
+    connMode',
+    serializeConnReq,
+    serializeConnReq',
+    serializeAgentError,
+    commandP,
+    parseSMPMessage,
+    smpServerP,
+    smpQueueUriP,
+    connModeT,
+    connReqP,
+    connReqP',
+    msgIntegrityP,
+    agentErrorTypeP,
+    agentMessageP,
+
+    -- * TCP transport functions
+    tPut,
+    tGet,
+    tPutRaw,
+    tGetRaw,
+  )
+where
+
+import Control.Applicative (optional, (<|>))
+import Control.Monad.IO.Class
+import qualified Crypto.PubKey.RSA as R
+import Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Attoparsec.ByteString.Char8 as A
+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.Functor (($>))
+import Data.Int (Int64)
+import Data.Kind (Type)
+import Data.List (find)
+import qualified Data.List.NonEmpty as L
+import Data.Maybe (isJust)
+import Data.String (IsString (..))
+import Data.Text (Text)
+import Data.Time.Clock (UTCTime)
+import Data.Time.ISO8601
+import Data.Type.Equality
+import Data.Typeable ()
+import GHC.Generics (Generic)
+import Generic.Random (genericArbitraryU)
+import Network.HTTP.Types (parseSimpleQuery, renderSimpleQuery)
+import Network.Socket (HostName, ServiceName)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Parsers
+import Simplex.Messaging.Protocol
+  ( ErrorType,
+    MsgBody,
+    MsgId,
+    SenderPublicKey,
+  )
+import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTransportError, transportErrorP)
+import Simplex.Messaging.Util
+import Test.QuickCheck (Arbitrary (..))
+import Text.Read
+import UnliftIO.Exception (Exception)
+
+-- | Raw (unparsed) SMP agent protocol transmission.
+type ARawTransmission = (ByteString, ByteString, ByteString)
+
+-- | Parsed SMP agent protocol transmission.
+type ATransmission p = (ACorrId, ConnId, ACommand p)
+
+-- | SMP agent protocol transmission or transmission error.
+type ATransmissionOrError p = (ACorrId, ConnId, Either AgentErrorType (ACommand p))
+
+type ACorrId = ByteString
+
+-- | SMP agent protocol participants.
+data AParty = Agent | Client
+  deriving (Eq, Show)
+
+-- | Singleton types for SMP agent protocol participants.
+data SAParty :: AParty -> Type where
+  SAgent :: SAParty Agent
+  SClient :: SAParty Client
+
+deriving instance Show (SAParty p)
+
+deriving instance Eq (SAParty p)
+
+instance TestEquality SAParty where
+  testEquality SAgent SAgent = Just Refl
+  testEquality SClient SClient = Just Refl
+  testEquality _ _ = Nothing
+
+data ACmd = forall p. ACmd (SAParty p) (ACommand p)
+
+deriving instance Show ACmd
+
+type ConnInfo = ByteString
+
+-- | Parameterized type for SMP agent protocol commands and responses from all participants.
+data ACommand (p :: AParty) where
+  NEW :: AConnectionMode -> ACommand Client -- response INV
+  INV :: AConnectionRequest -> ACommand Agent
+  JOIN :: AConnectionRequest -> ConnInfo -> ACommand Client -- response OK
+  CONF :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
+  LET :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
+  REQ :: InvitationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
+  ACPT :: InvitationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
+  RJCT :: InvitationId -> ACommand Client
+  INFO :: ConnInfo -> ACommand Agent
+  CON :: ACommand Agent -- notification that connection is established
+  SUB :: ACommand Client
+  END :: ACommand Agent
+  DOWN :: ACommand Agent
+  UP :: ACommand Agent
+  -- QST :: QueueDirection -> ACommand Client
+  -- STAT :: QueueDirection -> Maybe QueueStatus -> Maybe SubMode -> ACommand Agent
+  SEND :: MsgBody -> ACommand Client
+  MID :: AgentMsgId -> ACommand Agent
+  SENT :: AgentMsgId -> ACommand Agent
+  MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent
+  MSG :: MsgMeta -> MsgBody -> ACommand Agent
+  ACK :: AgentMsgId -> ACommand Client
+  -- RCVD :: AgentMsgId -> ACommand Agent
+  OFF :: ACommand Client
+  DEL :: ACommand Client
+  OK :: ACommand Agent
+  ERR :: AgentErrorType -> ACommand Agent
+
+deriving instance Eq (ACommand p)
+
+deriving instance Show (ACommand p)
+
+data ConnectionMode = CMInvitation | CMContact
+  deriving (Eq, Show)
+
+data SConnectionMode (m :: ConnectionMode) where
+  SCMInvitation :: SConnectionMode CMInvitation
+  SCMContact :: SConnectionMode CMContact
+
+deriving instance Eq (SConnectionMode m)
+
+deriving instance Show (SConnectionMode m)
+
+instance TestEquality SConnectionMode where
+  testEquality SCMInvitation SCMInvitation = Just Refl
+  testEquality SCMContact SCMContact = Just Refl
+  testEquality _ _ = Nothing
+
+data AConnectionMode = forall m. ACM (SConnectionMode m)
+
+instance Eq AConnectionMode where
+  ACM m == ACM m' = isJust $ testEquality m m'
+
+cmInvitation :: AConnectionMode
+cmInvitation = ACM SCMInvitation
+
+cmContact :: AConnectionMode
+cmContact = ACM SCMContact
+
+deriving instance Show AConnectionMode
+
+connMode :: SConnectionMode m -> ConnectionMode
+connMode SCMInvitation = CMInvitation
+connMode SCMContact = CMContact
+
+connMode' :: ConnectionMode -> AConnectionMode
+connMode' CMInvitation = cmInvitation
+connMode' CMContact = cmContact
+
+class ConnectionModeI (m :: ConnectionMode) where sConnectionMode :: SConnectionMode m
+
+instance ConnectionModeI CMInvitation where sConnectionMode = SCMInvitation
+
+instance ConnectionModeI CMContact where sConnectionMode = SCMContact
+
+type MsgHash = ByteString
+
+-- | Agent message metadata sent to the client
+data MsgMeta = MsgMeta
+  { integrity :: MsgIntegrity,
+    recipient :: (AgentMsgId, UTCTime),
+    broker :: (MsgId, UTCTime),
+    sender :: (AgentMsgId, UTCTime)
+  }
+  deriving (Eq, Show)
+
+-- | SMP message formats.
+data SMPMessage
+  = -- | SMP confirmation
+    -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message SMP protocol>)
+    SMPConfirmation
+      { -- | sender's public key to use for authentication of sender's commands at the recepient's server
+        senderKey :: SenderPublicKey,
+        -- | sender's information to be associated with the connection, e.g. sender's profile information
+        connInfo :: ConnInfo
+      }
+  | -- | Agent message header and envelope for client messages
+    -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents SMP agent protocol>)
+    SMPMessage
+      { -- | sequential ID assigned by the sending agent
+        senderMsgId :: AgentMsgId,
+        -- | timestamp from the sending agent
+        senderTimestamp :: SenderTimestamp,
+        -- | digest of the previous message
+        previousMsgHash :: MsgHash,
+        -- | messages sent between agents once queue is secured
+        agentMessage :: AMessage
+      }
+  deriving (Show)
+
+-- | Messages sent between SMP agents once SMP queue is secured.
+--
+-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents
+data AMessage where
+  -- | the first message in the queue to validate it is secured
+  HELLO :: VerificationKey -> AckMode -> AMessage
+  -- | reply queue information
+  REPLY :: ConnectionRequest CMInvitation -> AMessage
+  -- | agent envelope for the client message
+  A_MSG :: MsgBody -> AMessage
+  -- | connection request with the invitation to connect
+  A_INV :: ConnectionRequest CMInvitation -> ConnInfo -> AMessage
+  deriving (Show)
+
+-- | Parse SMP message.
+parseSMPMessage :: ByteString -> Either AgentErrorType SMPMessage
+parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
+  where
+    smpMessageP :: Parser SMPMessage
+    smpMessageP = A.endOfLine *> smpClientMessageP <|> smpConfirmationP
+
+    smpConfirmationP :: Parser SMPMessage
+    smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.pubKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine)
+
+    smpClientMessageP :: Parser SMPMessage
+    smpClientMessageP =
+      SMPMessage
+        <$> A.decimal <* A.space
+        <*> tsISO8601P <* A.space
+        -- TODO previous message hash should become mandatory when we support HELLO and REPLY
+        -- (for HELLO it would be the hash of SMPConfirmation)
+        <*> (base64P <|> pure "") <* A.endOfLine
+        <*> agentMessageP
+
+-- | Serialize SMP message.
+serializeSMPMessage :: SMPMessage -> ByteString
+serializeSMPMessage = \case
+  SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializePubKey sKey) "" (serializeBinary cInfo) <> "\n"
+  SMPMessage {senderMsgId, senderTimestamp, previousMsgHash, agentMessage} ->
+    let header = messageHeader senderMsgId senderTimestamp previousMsgHash
+        body = serializeAgentMessage agentMessage
+     in smpMessage "" header body
+  where
+    messageHeader msgId ts prevMsgHash =
+      B.unwords [bshow msgId, B.pack $ formatISO8601Millis ts, encode prevMsgHash]
+    smpMessage smpHeader aHeader aBody = B.intercalate "\n" [smpHeader, aHeader, aBody, ""]
+
+agentMessageP :: Parser AMessage
+agentMessageP =
+  "HELLO " *> hello
+    <|> "REPLY " *> reply
+    <|> "MSG " *> a_msg
+    <|> "INV " *> a_inv
+  where
+    hello = HELLO <$> C.pubKeyP <*> ackMode
+    reply = REPLY <$> connReqP'
+    a_msg = A_MSG <$> binaryBodyP <* A.endOfLine
+    a_inv = A_INV <$> connReqP' <* A.space <*> binaryBodyP <* A.endOfLine
+    ackMode = AckMode <$> (" NO_ACK" $> Off <|> pure On)
+
+-- | SMP server location parser.
+smpServerP :: Parser SMPServer
+smpServerP = SMPServer <$> server <*> optional port <*> optional kHash
+  where
+    server = B.unpack <$> A.takeWhile1 (A.notInClass ":#,; ")
+    port = A.char ':' *> (B.unpack <$> A.takeWhile1 A.isDigit)
+    kHash = C.KeyHash <$> (A.char '#' *> base64P)
+
+serializeAgentMessage :: AMessage -> ByteString
+serializeAgentMessage = \case
+  HELLO verifyKey ackMode -> "HELLO " <> C.serializePubKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else ""
+  REPLY cReq -> "REPLY " <> serializeConnReq' cReq
+  A_MSG body -> "MSG " <> serializeBinary body <> "\n"
+  A_INV cReq cInfo -> B.unwords ["INV", serializeConnReq' cReq, serializeBinary cInfo] <> "\n"
+
+-- | Serialize SMP queue information that is sent out-of-band.
+serializeSMPQueueUri :: SMPQueueUri -> ByteString
+serializeSMPQueueUri (SMPQueueUri srv qId _) =
+  serializeServerUri srv <> "/" <> U.encode qId <> "#"
+
+-- | SMP queue information parser.
+smpQueueUriP :: Parser SMPQueueUri
+smpQueueUriP =
+  SMPQueueUri <$> smpServerUriP <* "/" <*> base64UriP <* "#" <*> pure reservedServerKey
+
+reservedServerKey :: C.PublicKey
+reservedServerKey = C.PublicKey $ R.PublicKey 1 0 0
+
+serializeConnReq :: AConnectionRequest -> ByteString
+serializeConnReq (ACR _ cr) = serializeConnReq' cr
+
+serializeConnReq' :: ConnectionRequest m -> ByteString
+serializeConnReq' = \case
+  CRInvitation crData -> serialize CMInvitation crData
+  CRContact crData -> serialize CMContact crData
+  where
+    serialize crMode ConnReqData {crScheme, crSmpQueues, crEncryptKey} =
+      sch <> "/" <> m <> "#/" <> queryStr
+      where
+        sch = case crScheme of
+          CRSSimplex -> "simplex:"
+          CRSAppServer host port -> B.pack $ "https://" <> host <> maybe "" (':' :) port
+        m = case crMode of
+          CMInvitation -> "invitation"
+          CMContact -> "contact"
+        queryStr = renderSimpleQuery True [("smp", queues), ("e2e", key)]
+        queues = B.intercalate "," . map serializeSMPQueueUri $ L.toList crSmpQueues
+        key = C.serializePubKeyUri crEncryptKey
+
+connReqP' :: forall m. ConnectionModeI m => Parser (ConnectionRequest m)
+connReqP' = do
+  ACR m cr <- connReqP
+  case testEquality m $ sConnectionMode @m of
+    Just Refl -> pure cr
+    _ -> fail "bad connection request mode"
+
+connReqP :: Parser AConnectionRequest
+connReqP = do
+  crScheme <- "simplex:" $> CRSSimplex <|> "https://" *> appServer
+  crMode <- "/" *> mode <* "#/?"
+  query <- parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
+  crSmpQueues <- paramP "smp" smpQueues query
+  crEncryptKey <- paramP "e2e" C.pubKeyUriP query
+  let cReq = ConnReqData {crScheme, crSmpQueues, crEncryptKey}
+  pure $ case crMode of
+    CMInvitation -> ACR SCMInvitation $ CRInvitation cReq
+    CMContact -> ACR SCMContact $ CRContact cReq
+  where
+    appServer = CRSAppServer <$> host <*> optional port
+    host = B.unpack <$> A.takeTill (\c -> c == ':' || c == '/')
+    port = B.unpack <$> (A.char ':' *> A.takeTill (== '/'))
+    mode = "invitation" $> CMInvitation <|> "contact" $> CMContact
+    paramP param parser query =
+      let p = maybe (fail "") (pure . snd) $ find ((== param) . fst) query
+       in parseAll parser <$?> p
+    smpQueues =
+      maybe (fail "no SMP queues") pure . L.nonEmpty
+        =<< (smpQueue `A.sepBy1'` A.char ',')
+    smpQueue = parseAll smpQueueUriP <$?> A.takeTill (== ',')
+
+-- | Serialize SMP server location.
+serializeServer :: SMPServer -> ByteString
+serializeServer SMPServer {host, port, keyHash} =
+  B.pack $ host <> maybe "" (':' :) port <> maybe "" (('#' :) . B.unpack . encode . C.unKeyHash) keyHash
+
+serializeServerUri :: SMPServer -> ByteString
+serializeServerUri SMPServer {host, port, keyHash} = "smp://" <> kh <> B.pack host <> p
+  where
+    kh = maybe "" ((<> "@") . U.encode . C.unKeyHash) keyHash
+    p = B.pack $ maybe "" (':' :) port
+
+smpServerUriP :: Parser SMPServer
+smpServerUriP = do
+  _ <- "smp://"
+  keyHash <- optional $ C.KeyHash <$> (U.decode <$?> A.takeTill (== '@') <* A.char '@')
+  host <- B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
+  port <- optional $ B.unpack <$> (A.char ':' *> A.takeWhile1 A.isDigit)
+  pure SMPServer {host, port, keyHash}
+
+serializeConnMode :: AConnectionMode -> ByteString
+serializeConnMode (ACM cMode) = serializeConnMode' $ connMode cMode
+
+serializeConnMode' :: ConnectionMode -> ByteString
+serializeConnMode' = \case
+  CMInvitation -> "INV"
+  CMContact -> "CON"
+
+connModeP' :: Parser ConnectionMode
+connModeP' = "INV" $> CMInvitation <|> "CON" $> CMContact
+
+connModeP :: Parser AConnectionMode
+connModeP = connMode' <$> connModeP'
+
+connModeT :: Text -> Maybe ConnectionMode
+connModeT = \case
+  "INV" -> Just CMInvitation
+  "CON" -> Just CMContact
+  _ -> Nothing
+
+-- | SMP server location and transport key digest (hash).
+data SMPServer = SMPServer
+  { host :: HostName,
+    port :: Maybe ServiceName,
+    keyHash :: Maybe C.KeyHash
+  }
+  deriving (Eq, Ord, Show)
+
+instance IsString SMPServer where
+  fromString = parseString $ parseAll smpServerP
+
+-- | SMP agent connection alias.
+type ConnId = ByteString
+
+type ConfirmationId = ByteString
+
+type InvitationId = ByteString
+
+-- | Connection modes.
+data OnOff = On | Off deriving (Eq, Show, Read)
+
+-- | Message acknowledgement mode of the connection.
+newtype AckMode = AckMode OnOff deriving (Eq, Show)
+
+-- | SMP queue information sent out-of-band.
+--
+-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#out-of-band-messages
+data SMPQueueUri = SMPQueueUri
+  { smpServer :: SMPServer,
+    senderId :: SMP.SenderId,
+    serverVerifyKey :: VerificationKey
+  }
+  deriving (Eq, Show)
+
+data ConnectionRequest (m :: ConnectionMode) where
+  CRInvitation :: ConnReqData -> ConnectionRequest CMInvitation
+  CRContact :: ConnReqData -> ConnectionRequest CMContact
+
+deriving instance Eq (ConnectionRequest m)
+
+deriving instance Show (ConnectionRequest m)
+
+data AConnectionRequest = forall m. ACR (SConnectionMode m) (ConnectionRequest m)
+
+instance Eq AConnectionRequest where
+  ACR m cr == ACR m' cr' = case testEquality m m' of
+    Just Refl -> cr == cr'
+    _ -> False
+
+deriving instance Show AConnectionRequest
+
+data ConnReqData = ConnReqData
+  { crScheme :: ConnReqScheme,
+    crSmpQueues :: L.NonEmpty SMPQueueUri,
+    crEncryptKey :: EncryptionKey
+  }
+  deriving (Eq, Show)
+
+data ConnReqScheme = CRSSimplex | CRSAppServer HostName (Maybe ServiceName)
+  deriving (Eq, Show)
+
+simplexChat :: ConnReqScheme
+simplexChat = CRSAppServer "simplex.chat" Nothing
+
+-- | Public key used to E2E encrypt SMP messages.
+type EncryptionKey = C.PublicKey
+
+-- | Private key used to E2E decrypt SMP messages.
+type DecryptionKey = C.SafePrivateKey
+
+-- | Private key used to sign SMP commands
+type SignatureKey = C.APrivateKey
+
+-- | Public key used by SMP server to authorize (verify) SMP commands.
+type VerificationKey = C.PublicKey
+
+data QueueDirection = SND | RCV deriving (Show)
+
+-- | SMP queue status.
+data QueueStatus
+  = -- | queue is created
+    New
+  | -- | queue is confirmed by the sender
+    Confirmed
+  | -- | queue is secured with sender key (only used by the queue recipient)
+    Secured
+  | -- | queue is active
+    Active
+  | -- | queue is disabled (only used by the queue recipient)
+    Disabled
+  deriving (Eq, Show, Read)
+
+type AgentMsgId = Int64
+
+type SenderTimestamp = UTCTime
+
+-- | Result of received message integrity validation.
+data MsgIntegrity = MsgOk | MsgError MsgErrorType
+  deriving (Eq, Show)
+
+-- | Error of message integrity validation.
+data MsgErrorType = MsgSkipped AgentMsgId AgentMsgId | MsgBadId AgentMsgId | MsgBadHash | MsgDuplicate
+  deriving (Eq, Show)
+
+-- | Error type used in errors sent to agent clients.
+data AgentErrorType
+  = -- | command or response error
+    CMD CommandErrorType
+  | -- | connection errors
+    CONN ConnectionErrorType
+  | -- | SMP protocol errors forwarded to agent clients
+    SMP ErrorType
+  | -- | SMP server errors
+    BROKER BrokerErrorType
+  | -- | errors of other agents
+    AGENT SMPAgentError
+  | -- | agent implementation or dependency errors
+    INTERNAL String
+  deriving (Eq, Generic, Read, Show, Exception)
+
+-- | SMP agent protocol command or response error.
+data CommandErrorType
+  = -- | command is prohibited in this context
+    PROHIBITED
+  | -- | command syntax is invalid
+    SYNTAX
+  | -- | entity ID is required with this command
+    NO_CONN
+  | -- | message size is not correct (no terminating space)
+    SIZE
+  | -- | message does not fit in SMP block
+    LARGE
+  deriving (Eq, Generic, Read, Show, Exception)
+
+-- | Connection error.
+data ConnectionErrorType
+  = -- | connection alias is not in the database
+    NOT_FOUND
+  | -- | connection alias already exists
+    DUPLICATE
+  | -- | connection is simplex, but operation requires another queue
+    SIMPLEX
+  deriving (Eq, Generic, Read, Show, Exception)
+
+-- | SMP server errors.
+data BrokerErrorType
+  = -- | invalid server response (failed to parse)
+    RESPONSE ErrorType
+  | -- | unexpected response
+    UNEXPECTED
+  | -- | network error
+    NETWORK
+  | -- | handshake or other transport error
+    TRANSPORT TransportError
+  | -- | command response timeout
+    TIMEOUT
+  deriving (Eq, Generic, Read, Show, Exception)
+
+-- | Errors of another SMP agent.
+data SMPAgentError
+  = -- | possibly should include bytestring that failed to parse
+    A_MESSAGE
+  | -- | possibly should include the prohibited SMP/agent message
+    A_PROHIBITED
+  | -- | cannot RSA/AES-decrypt or parse decrypted header
+    A_ENCRYPTION
+  | -- | invalid RSA signature
+    A_SIGNATURE
+  deriving (Eq, Generic, Read, Show, Exception)
+
+instance Arbitrary AgentErrorType where arbitrary = genericArbitraryU
+
+instance Arbitrary CommandErrorType where arbitrary = genericArbitraryU
+
+instance Arbitrary ConnectionErrorType where arbitrary = genericArbitraryU
+
+instance Arbitrary BrokerErrorType where arbitrary = genericArbitraryU
+
+instance Arbitrary SMPAgentError where arbitrary = genericArbitraryU
+
+-- | SMP agent command and response parser
+commandP :: Parser ACmd
+commandP =
+  "NEW " *> newCmd
+    <|> "INV " *> invResp
+    <|> "JOIN " *> joinCmd
+    <|> "CONF " *> confMsg
+    <|> "LET " *> letCmd
+    <|> "REQ " *> reqMsg
+    <|> "ACPT " *> acptCmd
+    <|> "RJCT " *> rjctCmd
+    <|> "INFO " *> infoCmd
+    <|> "SUB" $> ACmd SClient SUB
+    <|> "END" $> ACmd SAgent END
+    <|> "DOWN" $> ACmd SAgent DOWN
+    <|> "UP" $> ACmd SAgent UP
+    <|> "SEND " *> sendCmd
+    <|> "MID " *> msgIdResp
+    <|> "SENT " *> sentResp
+    <|> "MERR " *> msgErrResp
+    <|> "MSG " *> message
+    <|> "ACK " *> ackCmd
+    <|> "OFF" $> ACmd SClient OFF
+    <|> "DEL" $> ACmd SClient DEL
+    <|> "ERR " *> agentError
+    <|> "CON" $> ACmd SAgent CON
+    <|> "OK" $> ACmd SAgent OK
+  where
+    newCmd = ACmd SClient . NEW <$> connModeP
+    invResp = ACmd SAgent . INV <$> connReqP
+    joinCmd = ACmd SClient <$> (JOIN <$> connReqP <* A.space <*> A.takeByteString)
+    confMsg = ACmd SAgent <$> (CONF <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    letCmd = ACmd SClient <$> (LET <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    reqMsg = ACmd SAgent <$> (REQ <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    acptCmd = ACmd SClient <$> (ACPT <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    rjctCmd = ACmd SClient . RJCT <$> A.takeByteString
+    infoCmd = ACmd SAgent . INFO <$> A.takeByteString
+    sendCmd = ACmd SClient . SEND <$> A.takeByteString
+    msgIdResp = ACmd SAgent . MID <$> A.decimal
+    sentResp = ACmd SAgent . SENT <$> A.decimal
+    msgErrResp = ACmd SAgent <$> (MERR <$> A.decimal <* A.space <*> agentErrorTypeP)
+    message = ACmd SAgent <$> (MSG <$> msgMetaP <* A.space <*> A.takeByteString)
+    ackCmd = ACmd SClient . ACK <$> A.decimal
+    msgMetaP = do
+      integrity <- msgIntegrityP
+      recipient <- " R=" *> partyMeta A.decimal
+      broker <- " B=" *> partyMeta base64P
+      sender <- " S=" *> partyMeta A.decimal
+      pure MsgMeta {integrity, recipient, broker, sender}
+    partyMeta idParser = (,) <$> idParser <* "," <*> tsISO8601P
+    agentError = ACmd SAgent . ERR <$> agentErrorTypeP
+
+-- | Message integrity validation result parser.
+msgIntegrityP :: Parser MsgIntegrity
+msgIntegrityP = "OK" $> MsgOk <|> "ERR " *> (MsgError <$> msgErrorType)
+  where
+    msgErrorType =
+      "ID " *> (MsgBadId <$> A.decimal)
+        <|> "IDS " *> (MsgSkipped <$> A.decimal <* A.space <*> A.decimal)
+        <|> "HASH" $> MsgBadHash
+        <|> "DUPLICATE" $> MsgDuplicate
+
+parseCommand :: ByteString -> Either AgentErrorType ACmd
+parseCommand = parse commandP $ CMD SYNTAX
+
+-- | Serialize SMP agent command.
+serializeCommand :: ACommand p -> ByteString
+serializeCommand = \case
+  NEW cMode -> "NEW " <> serializeConnMode cMode
+  INV cReq -> "INV " <> serializeConnReq cReq
+  JOIN cReq cInfo -> B.unwords ["JOIN", serializeConnReq cReq, serializeBinary cInfo]
+  CONF confId cInfo -> B.unwords ["CONF", confId, serializeBinary cInfo]
+  LET confId cInfo -> B.unwords ["LET", confId, serializeBinary cInfo]
+  REQ invId cInfo -> B.unwords ["REQ", invId, serializeBinary cInfo]
+  ACPT invId cInfo -> B.unwords ["ACPT", invId, serializeBinary cInfo]
+  RJCT invId -> "RJCT " <> invId
+  INFO cInfo -> "INFO " <> serializeBinary cInfo
+  SUB -> "SUB"
+  END -> "END"
+  DOWN -> "DOWN"
+  UP -> "UP"
+  SEND msgBody -> "SEND " <> serializeBinary msgBody
+  MID mId -> "MID " <> bshow mId
+  SENT mId -> "SENT " <> bshow mId
+  MERR mId e -> B.unwords ["MERR", bshow mId, serializeAgentError e]
+  MSG msgMeta msgBody -> B.unwords ["MSG", serializeMsgMeta msgMeta, serializeBinary msgBody]
+  ACK mId -> "ACK " <> bshow mId
+  OFF -> "OFF"
+  DEL -> "DEL"
+  CON -> "CON"
+  ERR e -> "ERR " <> serializeAgentError e
+  OK -> "OK"
+  where
+    showTs :: UTCTime -> ByteString
+    showTs = B.pack . formatISO8601Millis
+    serializeMsgMeta :: MsgMeta -> ByteString
+    serializeMsgMeta MsgMeta {integrity, recipient = (rmId, rTs), broker = (bmId, bTs), sender = (smId, sTs)} =
+      B.unwords
+        [ serializeMsgIntegrity integrity,
+          "R=" <> bshow rmId <> "," <> showTs rTs,
+          "B=" <> encode bmId <> "," <> showTs bTs,
+          "S=" <> bshow smId <> "," <> showTs sTs
+        ]
+
+-- | Serialize message integrity validation result.
+serializeMsgIntegrity :: MsgIntegrity -> ByteString
+serializeMsgIntegrity = \case
+  MsgOk -> "OK"
+  MsgError e ->
+    "ERR " <> case e of
+      MsgSkipped fromMsgId toMsgId ->
+        B.unwords ["NO_ID", bshow fromMsgId, bshow toMsgId]
+      MsgBadId aMsgId -> "ID " <> bshow aMsgId
+      MsgBadHash -> "HASH"
+      MsgDuplicate -> "DUPLICATE"
+
+-- | SMP agent protocol error parser.
+agentErrorTypeP :: Parser AgentErrorType
+agentErrorTypeP =
+  "SMP " *> (SMP <$> SMP.errorTypeP)
+    <|> "BROKER RESPONSE " *> (BROKER . RESPONSE <$> SMP.errorTypeP)
+    <|> "BROKER TRANSPORT " *> (BROKER . TRANSPORT <$> transportErrorP)
+    <|> "INTERNAL " *> (INTERNAL <$> parseRead A.takeByteString)
+    <|> parseRead2
+
+-- | Serialize SMP agent protocol error.
+serializeAgentError :: AgentErrorType -> ByteString
+serializeAgentError = \case
+  SMP e -> "SMP " <> SMP.serializeErrorType e
+  BROKER (RESPONSE e) -> "BROKER RESPONSE " <> SMP.serializeErrorType e
+  BROKER (TRANSPORT e) -> "BROKER TRANSPORT " <> serializeTransportError e
+  e -> bshow e
+
+binaryBodyP :: Parser ByteString
+binaryBodyP = do
+  size :: Int <- A.decimal <* A.endOfLine
+  A.take size
+
+serializeBinary :: ByteString -> ByteString
+serializeBinary body = bshow (B.length body) <> "\n" <> body
+
+-- | Send raw (unparsed) SMP agent protocol transmission to TCP connection.
+tPutRaw :: Transport c => c -> ARawTransmission -> IO ()
+tPutRaw h (corrId, entity, command) = do
+  putLn h corrId
+  putLn h entity
+  putLn h command
+
+-- | Receive raw (unparsed) SMP agent protocol transmission from TCP connection.
+tGetRaw :: Transport c => c -> IO ARawTransmission
+tGetRaw h = (,,) <$> getLn h <*> getLn h <*> getLn h
+
+-- | Send SMP agent protocol command (or response) to TCP connection.
+tPut :: (Transport c, MonadIO m) => c -> ATransmission p -> m ()
+tPut h (corrId, connAlias, command) =
+  liftIO $ tPutRaw h (corrId, connAlias, serializeCommand command)
+
+-- | Receive client and agent transmissions from TCP connection.
+tGet :: forall c m p. (Transport c, MonadIO m) => SAParty p -> c -> m (ATransmissionOrError p)
+tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
+  where
+    tParseLoadBody :: ARawTransmission -> m (ATransmissionOrError p)
+    tParseLoadBody t@(corrId, connId, command) = do
+      let cmd = parseCommand command >>= fromParty >>= tConnId t
+      fullCmd <- either (return . Left) cmdWithMsgBody cmd
+      return (corrId, connId, fullCmd)
+
+    fromParty :: ACmd -> Either AgentErrorType (ACommand p)
+    fromParty (ACmd (p :: p1) cmd) = case testEquality party p of
+      Just Refl -> Right cmd
+      _ -> Left $ CMD PROHIBITED
+
+    tConnId :: ARawTransmission -> ACommand p -> Either AgentErrorType (ACommand p)
+    tConnId (_, connId, _) cmd = case cmd of
+      -- NEW, JOIN and ACPT have optional connId
+      NEW _ -> Right cmd
+      JOIN {} -> Right cmd
+      ACPT {} -> Right cmd
+      -- ERROR response does not always have connId
+      ERR _ -> Right cmd
+      -- other responses must have connId
+      _
+        | B.null connId -> Left $ CMD NO_CONN
+        | otherwise -> Right cmd
+
+    cmdWithMsgBody :: ACommand p -> m (Either AgentErrorType (ACommand p))
+    cmdWithMsgBody = \case
+      SEND body -> SEND <$$> getBody body
+      MSG msgMeta body -> MSG msgMeta <$$> getBody body
+      JOIN qUri cInfo -> JOIN qUri <$$> getBody cInfo
+      CONF confId cInfo -> CONF confId <$$> getBody cInfo
+      LET confId cInfo -> LET confId <$$> getBody cInfo
+      REQ invId cInfo -> REQ invId <$$> getBody cInfo
+      ACPT invId cInfo -> ACPT invId <$$> getBody cInfo
+      INFO cInfo -> INFO <$$> getBody cInfo
+      cmd -> pure $ Right cmd
+
+    -- TODO refactor with server
+    getBody :: ByteString -> m (Either AgentErrorType ByteString)
+    getBody binary =
+      case B.unpack binary of
+        ':' : body -> return . Right $ B.pack body
+        str -> case readMaybe str :: Maybe Int of
+          Just size -> liftIO $ do
+            body <- cGet h size
+            s <- getLn h
+            return $ if B.null s then Right body else Left $ CMD SIZE
+          Nothing -> return . Left $ CMD SYNTAX

src/Simplex/Messaging/Agent/RetryInterval.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Agent.RetryInterval where
+
+import Control.Concurrent (threadDelay)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+
+data RetryInterval = RetryInterval
+  { initialInterval :: Int,
+    increaseAfter :: Int,
+    maxInterval :: Int
+  }
+
+withRetryInterval :: forall m. MonadIO m => RetryInterval -> (m () -> m ()) -> m ()
+withRetryInterval RetryInterval {initialInterval, increaseAfter, maxInterval} action =
+  callAction 0 initialInterval
+  where
+    callAction :: Int -> Int -> m ()
+    callAction elapsedTime delay = action loop
+      where
+        loop = do
+          let newDelay =
+                if elapsedTime < increaseAfter || delay == maxInterval
+                  then delay
+                  else min (delay * 3 `div` 2) maxInterval
+          liftIO $ threadDelay delay
+          callAction (elapsedTime + delay) newDelay

src/Simplex/Messaging/Agent/Store.hs

@@ -9,13 +9,15 @@
 
 module Simplex.Messaging.Agent.Store where
 
+import Control.Concurrent.STM (TVar)
 import Control.Exception (Exception)
+import Crypto.Random (ChaChaDRG)
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Kind (Type)
 import Data.Time (UTCTime)
 import Data.Type.Equality
-import Simplex.Messaging.Agent.Transmission
+import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Protocol
   ( MsgBody,
     MsgId,
@@ -30,26 +32,42 @@ import qualified Simplex.Messaging.Protocol as SMP
 -- | Store class type. Defines store access methods for implementations.
 class Monad m => MonadAgentStore s m where
   -- Queue and Connection management
-  createRcvConn :: s -> RcvQueue -> m ()
-  createSndConn :: s -> SndQueue -> m ()
-  getConn :: s -> ConnAlias -> m SomeConn
-  getAllConnAliases :: s -> m [ConnAlias] -- TODO remove - hack for subscribing to all
-  getRcvQueue :: s -> SMPServer -> SMP.RecipientId -> m RcvQueue
-  deleteConn :: s -> ConnAlias -> m ()
-  upgradeRcvConnToDuplex :: s -> ConnAlias -> SndQueue -> m ()
-  upgradeSndConnToDuplex :: s -> ConnAlias -> RcvQueue -> m ()
+  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 ()
   setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m ()
+  updateSignKey :: s -> SndQueue -> SignatureKey -> m ()
+
+  -- Confirmations
+  createConfirmation :: s -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
+  acceptConfirmation :: s -> ConfirmationId -> ConnInfo -> m AcceptedConfirmation
+  getAcceptedConfirmation :: s -> ConnId -> m AcceptedConfirmation
+  removeConfirmations :: s -> ConnId -> m ()
+
+  -- Invitations - sent via Contact connections
+  createInvitation :: s -> TVar ChaChaDRG -> NewInvitation -> m InvitationId
+  getInvitation :: s -> InvitationId -> m Invitation
+  acceptInvitation :: s -> InvitationId -> ConnInfo -> m ()
+  deleteInvitation :: s -> ConnId -> InvitationId -> m ()
 
   -- Msg management
-  updateRcvIds :: s -> RcvQueue -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
-  createRcvMsg :: s -> RcvQueue -> RcvMsgData -> m ()
-
-  updateSndIds :: s -> SndQueue -> m (InternalId, InternalSndId, PrevSndMsgHash)
-  createSndMsg :: s -> SndQueue -> SndMsgData -> m ()
-
-  getMsg :: s -> ConnAlias -> InternalId -> m Msg
+  updateRcvIds :: s -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
+  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 MsgBody
+  getPendingMsgs :: s -> ConnId -> m [InternalId]
+  getMsg :: s -> ConnId -> InternalId -> m Msg
+  checkRcvMsg :: s -> ConnId -> InternalId -> m ()
+  updateRcvMsgAck :: s -> ConnId -> InternalId -> m ()
 
 -- * Queue types
 
@@ -57,10 +75,8 @@ class Monad m => MonadAgentStore s m where
 data RcvQueue = RcvQueue
   { server :: SMPServer,
     rcvId :: SMP.RecipientId,
-    connAlias :: ConnAlias,
     rcvPrivateKey :: RecipientPrivateKey,
     sndId :: Maybe SMP.SenderId,
-    sndKey :: Maybe SenderPublicKey,
     decryptKey :: DecryptionKey,
     verifyKey :: Maybe VerificationKey,
     status :: QueueStatus
@@ -71,7 +87,6 @@ data RcvQueue = RcvQueue
 data SndQueue = SndQueue
   { server :: SMPServer,
     sndId :: SMP.SenderId,
-    connAlias :: ConnAlias,
     sndPrivateKey :: SenderPrivateKey,
     encryptKey :: EncryptionKey,
     signKey :: SignatureKey,
@@ -82,7 +97,7 @@ data SndQueue = SndQueue
 -- * Connection types
 
 -- | Type of a connection.
-data ConnType = CRcv | CSnd | CDuplex deriving (Eq, Show)
+data ConnType = CRcv | CSnd | CDuplex | CContact deriving (Eq, Show)
 
 -- | Connection of a specific type.
 --
@@ -95,9 +110,10 @@ data ConnType = CRcv | CSnd | CDuplex deriving (Eq, Show)
 -- - DuplexConnection is a connection that has both receive and send queues set up,
 --   typically created by upgrading a receive or a send connection with a missing queue.
 data Connection (d :: ConnType) where
-  RcvConnection :: ConnAlias -> RcvQueue -> Connection CRcv
-  SndConnection :: ConnAlias -> SndQueue -> Connection CSnd
-  DuplexConnection :: ConnAlias -> RcvQueue -> SndQueue -> Connection CDuplex
+  RcvConnection :: ConnData -> RcvQueue -> Connection CRcv
+  SndConnection :: ConnData -> SndQueue -> Connection CSnd
+  DuplexConnection :: ConnData -> RcvQueue -> SndQueue -> Connection CDuplex
+  ContactConnection :: ConnData -> RcvQueue -> Connection CContact
 
 deriving instance Eq (Connection d)
 
@@ -107,11 +123,13 @@ data SConnType :: ConnType -> Type where
   SCRcv :: SConnType CRcv
   SCSnd :: SConnType CSnd
   SCDuplex :: SConnType CDuplex
+  SCContact :: SConnType CContact
 
 connType :: SConnType c -> ConnType
 connType SCRcv = CRcv
 connType SCSnd = CSnd
 connType SCDuplex = CDuplex
+connType SCContact = CContact
 
 deriving instance Eq (SConnType d)
 
@@ -121,6 +139,7 @@ instance TestEquality SConnType where
   testEquality SCRcv SCRcv = Just Refl
   testEquality SCSnd SCSnd = Just Refl
   testEquality SCDuplex SCDuplex = Just Refl
+  testEquality SCContact SCContact = Just Refl
   testEquality _ _ = Nothing
 
 -- | Connection of an unknown type.
@@ -134,9 +153,43 @@ instance Eq SomeConn where
 
 deriving instance Show SomeConn
 
--- * Message integrity validation types
+newtype ConnData = ConnData {connId :: ConnId}
+  deriving (Eq, Show)
 
-type MsgHash = ByteString
+-- * Confirmation types
+
+data NewConfirmation = NewConfirmation
+  { connId :: ConnId,
+    senderKey :: SenderPublicKey,
+    senderConnInfo :: ConnInfo
+  }
+
+data AcceptedConfirmation = AcceptedConfirmation
+  { confirmationId :: ConfirmationId,
+    connId :: ConnId,
+    senderKey :: SenderPublicKey,
+    senderConnInfo :: ConnInfo,
+    ownConnInfo :: ConnInfo
+  }
+
+-- * Invitations
+
+data NewInvitation = NewInvitation
+  { contactConnId :: ConnId,
+    connReq :: ConnectionRequest 'CMInvitation,
+    recipientConnInfo :: ConnInfo
+  }
+
+data Invitation = Invitation
+  { invitationId :: InvitationId,
+    contactConnId :: ConnId,
+    connReq :: ConnectionRequest 'CMInvitation,
+    recipientConnInfo :: ConnInfo,
+    ownConnInfo :: Maybe ConnInfo,
+    accepted :: Bool
+  }
+
+-- * Message integrity validation types
 
 -- | Corresponds to `last_external_snd_msg_id` in `connections` table
 type PrevExternalSndId = Int64
@@ -148,18 +201,15 @@ type PrevRcvMsgHash = MsgHash
 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
-  { internalId :: InternalId,
-    internalRcvId :: InternalRcvId,
-    internalTs :: InternalTs,
-    senderMeta :: (ExternalSndId, ExternalSndTs),
-    brokerMeta :: (BrokerId, BrokerTs),
+  { msgMeta :: MsgMeta,
     msgBody :: MsgBody,
+    internalRcvId :: InternalRcvId,
     internalHash :: MsgHash,
-    externalPrevSndHash :: MsgHash,
-    msgIntegrity :: MsgIntegrity
+    externalPrevSndHash :: MsgHash
   }
 
 data SndMsgData = SndMsgData
@@ -167,9 +217,20 @@ data SndMsgData = SndMsgData
     internalSndId :: InternalSndId,
     internalTs :: InternalTs,
     msgBody :: MsgBody,
-    internalHash :: MsgHash
+    internalHash :: MsgHash,
+    previousMsgHash :: MsgHash
   }
 
+data PendingMsg = PendingMsg
+  { connId :: ConnId,
+    msgId :: InternalId
+  }
+  deriving (Show)
+
+-- * Broadcast types
+
+type BroadcastId = ByteString
+
 -- * Message types
 
 -- | A message in either direction that is stored by the agent.
@@ -240,9 +301,9 @@ data SndMsg = SndMsg
 newtype InternalSndId = InternalSndId {unSndId :: Int64} deriving (Eq, Show)
 
 data SndMsgStatus
-  = Created
-  | Sent
-  | Delivered
+  = SndMsgCreated
+  | SndMsgSent
+  | SndMsgDelivered
   deriving (Eq, Show)
 
 type SentTs = UTCTime
@@ -251,7 +312,7 @@ type DeliveredTs = UTCTime
 
 -- | Base message data independent of direction.
 data MsgBase = MsgBase
-  { connAlias :: ConnAlias,
+  { connAlias :: 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)
@@ -271,11 +332,29 @@ type InternalTs = UTCTime
 
 -- * Store errors
 
+-- | Agent store error.
 data StoreError
-  = SEInternal ByteString
-  | SEConnNotFound
-  | SEConnDuplicate
-  | SEBadConnType ConnType
-  | SEBadQueueStatus -- not used, planned to check strictly
-  | SENotImplemented -- TODO remove
+  = -- | IO exceptions in store actions.
+    SEInternal ByteString
+  | -- | failed to generate unique random ID
+    SEUniqueID
+  | -- | Connection alias not found (or both queues absent).
+    SEConnNotFound
+  | -- | Connection alias 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.
+    SEBadConnType ConnType
+  | -- | Confirmation not found.
+    SEConfirmationNotFound
+  | -- | Invitation not found
+    SEInvitationNotFound
+  | -- | Message not found
+    SEMsgNotFound
+  | -- | Currently not used. The intention was to pass current expected queue status in methods,
+    -- 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
+  | -- | Used in `getMsg` that is not implemented/used. TODO remove.
+    SENotImplemented
   deriving (Eq, Show, Exception)

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

@@ -0,0 +1,72 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations
+  ( Migration (..),
+    app,
+    initialize,
+    get,
+    run,
+  )
+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 qualified Database.SQLite.Simple as DB
+import Database.SQLite.Simple.QQ (sql)
+import qualified Database.SQLite3 as SQLite3
+import System.FilePath (takeBaseName, takeExtension)
+
+data Migration = Migration {name :: String, up :: Text}
+  deriving (Show)
+
+-- | The list of migrations in ascending order by date
+app :: [Migration]
+app =
+  sortBy (compare `on` name) . map migration . filter sqlFile $
+    $(makeRelativeToProject "migrations" >>= embedDir)
+  where
+    sqlFile (file, _) = takeExtension file == ".sql"
+    migration (file, qStr) = Migration {name = takeBaseName file, up = decodeUtf8 qStr}
+
+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 = DB.withImmediateTransaction conn . forM_ ms $
+  \Migration {name, up} -> insert name >> execSQL up
+  where
+    insert name = DB.execute conn "INSERT INTO migrations (name, ts) VALUES (?, ?);" . (name,) =<< getCurrentTime
+    execSQL = SQLite3.exec $ DB.connectionHandle conn
+
+initialize :: Connection -> IO ()
+initialize conn =
+  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/SQLite/Schema.hs

@@ -1,167 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Messaging.Agent.Store.SQLite.Schema (createSchema) where
-
-import Database.SQLite.Simple (Connection, Query, execute_)
-import Database.SQLite.Simple.QQ (sql)
-
-createSchema :: Connection -> IO ()
-createSchema conn =
-  mapM_
-    (execute_ conn)
-    [ servers,
-      rcvQueues,
-      sndQueues,
-      connections,
-      messages,
-      rcvMessages,
-      sndMessages
-    ]
-
--- port is either a port number or a service name, see Network.Socket.Info.ServiceName
-servers :: Query
-servers =
-  [sql|
-    CREATE TABLE IF NOT EXISTS servers(
-      host TEXT NOT NULL,
-      port TEXT NOT NULL,
-      key_hash BLOB,
-      PRIMARY KEY (host, port)
-    ) WITHOUT ROWID;
-  |]
-
-rcvQueues :: Query
-rcvQueues =
-  [sql|
-    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;
-  |]
-
-sndQueues :: Query
-sndQueues =
-  [sql|
-    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;
-  |]
-
-connections :: Query
-connections =
-  [sql|
-    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,
-      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;
-  |]
-
-messages :: Query
-messages =
-  [sql|
-    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,
-      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;
-  |]
-
-rcvMessages :: Query
-rcvMessages =
-  [sql|
-    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;
-  |]
-
-sndMessages :: Query
-sndMessages =
-  [sql|
-    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;
-  |]

src/Simplex/Messaging/Agent/Transmission.hs

@@ -1,461 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
-
-module Simplex.Messaging.Agent.Transmission where
-
-import Control.Applicative (optional, (<|>))
-import Control.Monad.IO.Class
-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.Int (Int64)
-import Data.Kind (Type)
-import Data.Time.Clock (UTCTime)
-import Data.Time.ISO8601
-import Data.Type.Equality
-import Data.Typeable ()
-import GHC.Generics (Generic)
-import Generic.Random (genericArbitraryU)
-import Network.Socket
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Parsers
-import Simplex.Messaging.Protocol
-  ( CorrId (..),
-    Encoded,
-    ErrorType,
-    MsgBody,
-    MsgId,
-    SenderPublicKey,
-  )
-import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Transport
-import Simplex.Messaging.Util
-import System.IO
-import Test.QuickCheck (Arbitrary (..))
-import Text.Read
-import UnliftIO.Exception
-
-type ARawTransmission = (ByteString, ByteString, ByteString)
-
-type ATransmission p = (CorrId, ConnAlias, ACommand p)
-
-type ATransmissionOrError p = (CorrId, ConnAlias, Either AgentErrorType (ACommand p))
-
-data AParty = Agent | Client
-  deriving (Eq, Show)
-
-data SAParty :: AParty -> Type where
-  SAgent :: SAParty Agent
-  SClient :: SAParty Client
-
-deriving instance Show (SAParty p)
-
-deriving instance Eq (SAParty p)
-
-instance TestEquality SAParty where
-  testEquality SAgent SAgent = Just Refl
-  testEquality SClient SClient = Just Refl
-  testEquality _ _ = Nothing
-
-data ACmd = forall p. ACmd (SAParty p) (ACommand p)
-
-deriving instance Show ACmd
-
-data ACommand (p :: AParty) where
-  NEW :: SMPServer -> ACommand Client -- response INV
-  INV :: SMPQueueInfo -> ACommand Agent
-  JOIN :: SMPQueueInfo -> ReplyMode -> ACommand Client -- response OK
-  CON :: ACommand Agent -- notification that connection is established
-  -- TODO currently it automatically allows whoever sends the confirmation
-  -- CONF :: OtherPartyId -> ACommand Agent
-  -- LET :: OtherPartyId -> ACommand Client
-  SUB :: ACommand Client
-  SUBALL :: ACommand Client -- TODO should be moved to chat protocol - hack for subscribing to all
-  END :: ACommand Agent
-  -- QST :: QueueDirection -> ACommand Client
-  -- STAT :: QueueDirection -> Maybe QueueStatus -> Maybe SubMode -> ACommand Agent
-  SEND :: MsgBody -> ACommand Client
-  SENT :: AgentMsgId -> ACommand Agent
-  MSG ::
-    { recipientMeta :: (AgentMsgId, UTCTime),
-      brokerMeta :: (MsgId, UTCTime),
-      senderMeta :: (AgentMsgId, UTCTime),
-      msgIntegrity :: MsgIntegrity,
-      msgBody :: MsgBody
-    } ->
-    ACommand Agent
-  -- ACK :: AgentMsgId -> ACommand Client
-  -- RCVD :: AgentMsgId -> ACommand Agent
-  OFF :: ACommand Client
-  DEL :: ACommand Client
-  OK :: ACommand Agent
-  ERR :: AgentErrorType -> ACommand Agent
-
-deriving instance Eq (ACommand p)
-
-deriving instance Show (ACommand p)
-
-type Message = ByteString
-
-data SMPMessage
-  = SMPConfirmation SenderPublicKey
-  | SMPMessage
-      { senderMsgId :: AgentMsgId,
-        senderTimestamp :: SenderTimestamp,
-        previousMsgHash :: ByteString,
-        agentMessage :: AMessage
-      }
-  deriving (Show)
-
-data AMessage where
-  HELLO :: VerificationKey -> AckMode -> AMessage
-  REPLY :: SMPQueueInfo -> AMessage
-  A_MSG :: MsgBody -> AMessage
-  deriving (Show)
-
-parseSMPMessage :: ByteString -> Either AgentErrorType SMPMessage
-parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
-  where
-    smpMessageP :: Parser SMPMessage
-    smpMessageP =
-      smpConfirmationP <* A.endOfLine
-        <|> A.endOfLine *> smpClientMessageP
-
-    smpConfirmationP :: Parser SMPMessage
-    smpConfirmationP = SMPConfirmation <$> ("KEY " *> C.pubKeyP <* A.endOfLine)
-
-    smpClientMessageP :: Parser SMPMessage
-    smpClientMessageP =
-      SMPMessage
-        <$> A.decimal <* A.space
-        <*> tsISO8601P <* A.space
-        -- TODO previous message hash should become mandatory when we support HELLO and REPLY
-        -- (for HELLO it would be the hash of SMPConfirmation)
-        <*> (base64P <|> pure "") <* A.endOfLine
-        <*> agentMessageP
-
-serializeSMPMessage :: SMPMessage -> ByteString
-serializeSMPMessage = \case
-  SMPConfirmation sKey -> smpMessage ("KEY " <> C.serializePubKey sKey) "" ""
-  SMPMessage {senderMsgId, senderTimestamp, previousMsgHash, agentMessage} ->
-    let header = messageHeader senderMsgId senderTimestamp previousMsgHash
-        body = serializeAgentMessage agentMessage
-     in smpMessage "" header body
-  where
-    messageHeader msgId ts prevMsgHash =
-      B.unwords [bshow msgId, B.pack $ formatISO8601Millis ts, encode prevMsgHash]
-    smpMessage smpHeader aHeader aBody = B.intercalate "\n" [smpHeader, aHeader, aBody, ""]
-
-agentMessageP :: Parser AMessage
-agentMessageP =
-  "HELLO " *> hello
-    <|> "REPLY " *> reply
-    <|> "MSG " *> a_msg
-  where
-    hello = HELLO <$> C.pubKeyP <*> ackMode
-    reply = REPLY <$> smpQueueInfoP
-    a_msg = do
-      size :: Int <- A.decimal <* A.endOfLine
-      A_MSG <$> A.take size <* A.endOfLine
-    ackMode = " NO_ACK" $> AckMode Off <|> pure (AckMode On)
-
-smpQueueInfoP :: Parser SMPQueueInfo
-smpQueueInfoP =
-  "smp::" *> (SMPQueueInfo <$> smpServerP <* "::" <*> base64P <* "::" <*> C.pubKeyP)
-
-smpServerP :: Parser SMPServer
-smpServerP = SMPServer <$> server <*> optional port <*> optional kHash
-  where
-    server = B.unpack <$> A.takeTill (A.inClass ":# ")
-    port = A.char ':' *> (B.unpack <$> A.takeWhile1 A.isDigit)
-    kHash = C.KeyHash <$> (A.char '#' *> base64P)
-
-parseAgentMessage :: ByteString -> Either AgentErrorType AMessage
-parseAgentMessage = parse agentMessageP $ AGENT A_MESSAGE
-
-serializeAgentMessage :: AMessage -> ByteString
-serializeAgentMessage = \case
-  HELLO verifyKey ackMode -> "HELLO " <> C.serializePubKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else ""
-  REPLY qInfo -> "REPLY " <> serializeSmpQueueInfo qInfo
-  A_MSG body -> "MSG " <> serializeMsg body <> "\n"
-
-serializeSmpQueueInfo :: SMPQueueInfo -> ByteString
-serializeSmpQueueInfo (SMPQueueInfo srv qId ek) =
-  B.intercalate "::" ["smp", serializeServer srv, encode qId, C.serializePubKey ek]
-
-serializeServer :: SMPServer -> ByteString
-serializeServer SMPServer {host, port, keyHash} =
-  B.pack $ host <> maybe "" (':' :) port <> maybe "" (('#' :) . B.unpack . encode . C.unKeyHash) keyHash
-
-data SMPServer = SMPServer
-  { host :: HostName,
-    port :: Maybe ServiceName,
-    keyHash :: Maybe C.KeyHash
-  }
-  deriving (Eq, Ord, Show)
-
-type ConnAlias = ByteString
-
-type OtherPartyId = Encoded
-
-data Mode = On | Off deriving (Eq, Show, Read)
-
-newtype AckMode = AckMode Mode deriving (Eq, Show)
-
-data SMPQueueInfo = SMPQueueInfo SMPServer SMP.SenderId EncryptionKey
-  deriving (Eq, Show)
-
-data ReplyMode = ReplyOff | ReplyOn | ReplyVia SMPServer deriving (Eq, Show)
-
-type EncryptionKey = C.PublicKey
-
-type DecryptionKey = C.SafePrivateKey
-
-type SignatureKey = C.SafePrivateKey
-
-type VerificationKey = C.PublicKey
-
-data QueueDirection = SND | RCV deriving (Show)
-
-data QueueStatus = New | Confirmed | Secured | Active | Disabled
-  deriving (Eq, Show, Read)
-
-type AgentMsgId = Int64
-
-type SenderTimestamp = UTCTime
-
-data MsgIntegrity = MsgOk | MsgError MsgErrorType
-  deriving (Eq, Show)
-
-data MsgErrorType = MsgSkipped AgentMsgId AgentMsgId | MsgBadId AgentMsgId | MsgBadHash | MsgDuplicate
-  deriving (Eq, Show)
-
--- | error type used in errors sent to agent clients
-data AgentErrorType
-  = CMD CommandErrorType -- command errors
-  | CONN ConnectionErrorType -- connection state errors
-  | SMP ErrorType -- SMP protocol errors forwarded to agent clients
-  | BROKER BrokerErrorType -- SMP server errors
-  | AGENT SMPAgentError -- errors of other agents
-  | INTERNAL String -- agent implementation errors
-  deriving (Eq, Generic, Read, Show, Exception)
-
-data CommandErrorType
-  = PROHIBITED -- command is prohibited
-  | SYNTAX -- command syntax is invalid
-  | NO_CONN -- connection alias is required with this command
-  | SIZE -- message size is not correct (no terminating space)
-  | LARGE -- message does not fit SMP block
-  deriving (Eq, Generic, Read, Show, Exception)
-
-data ConnectionErrorType
-  = UNKNOWN -- connection alias not in database
-  | DUPLICATE -- connection alias already exists
-  | SIMPLEX -- connection is simplex, but operation requires another queue
-  deriving (Eq, Generic, Read, Show, Exception)
-
-data BrokerErrorType
-  = RESPONSE ErrorType -- invalid server response (failed to parse)
-  | UNEXPECTED -- unexpected response
-  | NETWORK -- network error
-  | TRANSPORT TransportError -- handshake or other transport error
-  | TIMEOUT -- command response timeout
-  deriving (Eq, Generic, Read, Show, Exception)
-
-data SMPAgentError
-  = A_MESSAGE -- possibly should include bytestring that failed to parse
-  | A_PROHIBITED -- possibly should include the prohibited SMP/agent message
-  | A_ENCRYPTION -- cannot RSA/AES-decrypt or parse decrypted header
-  | A_SIGNATURE -- invalid RSA signature
-  deriving (Eq, Generic, Read, Show, Exception)
-
-instance Arbitrary AgentErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary CommandErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary ConnectionErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary BrokerErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary SMPAgentError where arbitrary = genericArbitraryU
-
-commandP :: Parser ACmd
-commandP =
-  "NEW " *> newCmd
-    <|> "INV " *> invResp
-    <|> "JOIN " *> joinCmd
-    <|> "SUB" $> ACmd SClient SUB
-    <|> "SUBALL" $> ACmd SClient SUBALL -- TODO remove - hack for subscribing to all
-    <|> "END" $> ACmd SAgent END
-    <|> "SEND " *> sendCmd
-    <|> "SENT " *> sentResp
-    <|> "MSG " *> message
-    <|> "OFF" $> ACmd SClient OFF
-    <|> "DEL" $> ACmd SClient DEL
-    <|> "ERR " *> agentError
-    <|> "CON" $> ACmd SAgent CON
-    <|> "OK" $> ACmd SAgent OK
-  where
-    newCmd = ACmd SClient . NEW <$> smpServerP
-    invResp = ACmd SAgent . INV <$> smpQueueInfoP
-    joinCmd = ACmd SClient <$> (JOIN <$> smpQueueInfoP <*> replyMode)
-    sendCmd = ACmd SClient . SEND <$> A.takeByteString
-    sentResp = ACmd SAgent . SENT <$> A.decimal
-    message = do
-      msgIntegrity <- msgIntegrityP <* A.space
-      recipientMeta <- "R=" *> partyMeta A.decimal
-      brokerMeta <- "B=" *> partyMeta base64P
-      senderMeta <- "S=" *> partyMeta A.decimal
-      msgBody <- A.takeByteString
-      return $ ACmd SAgent MSG {recipientMeta, brokerMeta, senderMeta, msgIntegrity, msgBody}
-    replyMode =
-      " NO_REPLY" $> ReplyOff
-        <|> A.space *> (ReplyVia <$> smpServerP)
-        <|> pure ReplyOn
-    partyMeta idParser = (,) <$> idParser <* "," <*> tsISO8601P <* A.space
-    agentError = ACmd SAgent . ERR <$> agentErrorTypeP
-
-msgIntegrityP :: Parser MsgIntegrity
-msgIntegrityP = "OK" $> MsgOk <|> "ERR " *> (MsgError <$> msgErrorType)
-  where
-    msgErrorType =
-      "ID " *> (MsgBadId <$> A.decimal)
-        <|> "IDS " *> (MsgSkipped <$> A.decimal <* A.space <*> A.decimal)
-        <|> "HASH" $> MsgBadHash
-        <|> "DUPLICATE" $> MsgDuplicate
-
-parseCommand :: ByteString -> Either AgentErrorType ACmd
-parseCommand = parse commandP $ CMD SYNTAX
-
-serializeCommand :: ACommand p -> ByteString
-serializeCommand = \case
-  NEW srv -> "NEW " <> serializeServer srv
-  INV qInfo -> "INV " <> serializeSmpQueueInfo qInfo
-  JOIN qInfo rMode -> "JOIN " <> serializeSmpQueueInfo qInfo <> replyMode rMode
-  SUB -> "SUB"
-  SUBALL -> "SUBALL" -- TODO remove - hack for subscribing to all
-  END -> "END"
-  SEND msgBody -> "SEND " <> serializeMsg msgBody
-  SENT mId -> "SENT " <> bshow mId
-  MSG {recipientMeta = (rmId, rTs), brokerMeta = (bmId, bTs), senderMeta = (smId, sTs), msgIntegrity, msgBody} ->
-    B.unwords
-      [ "MSG",
-        serializeMsgIntegrity msgIntegrity,
-        "R=" <> bshow rmId <> "," <> showTs rTs,
-        "B=" <> encode bmId <> "," <> showTs bTs,
-        "S=" <> bshow smId <> "," <> showTs sTs,
-        serializeMsg msgBody
-      ]
-  OFF -> "OFF"
-  DEL -> "DEL"
-  CON -> "CON"
-  ERR e -> "ERR " <> serializeAgentError e
-  OK -> "OK"
-  where
-    replyMode :: ReplyMode -> ByteString
-    replyMode = \case
-      ReplyOff -> " NO_REPLY"
-      ReplyVia srv -> " " <> serializeServer srv
-      ReplyOn -> ""
-    showTs :: UTCTime -> ByteString
-    showTs = B.pack . formatISO8601Millis
-
-serializeMsgIntegrity :: MsgIntegrity -> ByteString
-serializeMsgIntegrity = \case
-  MsgOk -> "OK"
-  MsgError e ->
-    "ERR " <> case e of
-      MsgSkipped fromMsgId toMsgId ->
-        B.unwords ["NO_ID", bshow fromMsgId, bshow toMsgId]
-      MsgBadId aMsgId -> "ID " <> bshow aMsgId
-      MsgBadHash -> "HASH"
-      MsgDuplicate -> "DUPLICATE"
-
-agentErrorTypeP :: Parser AgentErrorType
-agentErrorTypeP =
-  "SMP " *> (SMP <$> SMP.errorTypeP)
-    <|> "BROKER RESPONSE " *> (BROKER . RESPONSE <$> SMP.errorTypeP)
-    <|> "BROKER TRANSPORT " *> (BROKER . TRANSPORT <$> transportErrorP)
-    <|> "INTERNAL " *> (INTERNAL <$> parseRead A.takeByteString)
-    <|> parseRead2
-
-serializeAgentError :: AgentErrorType -> ByteString
-serializeAgentError = \case
-  SMP e -> "SMP " <> SMP.serializeErrorType e
-  BROKER (RESPONSE e) -> "BROKER RESPONSE " <> SMP.serializeErrorType e
-  BROKER (TRANSPORT e) -> "BROKER TRANSPORT " <> serializeTransportError e
-  e -> bshow e
-
-serializeMsg :: ByteString -> ByteString
-serializeMsg body = bshow (B.length body) <> "\n" <> body
-
-tPutRaw :: Handle -> ARawTransmission -> IO ()
-tPutRaw h (corrId, connAlias, command) = do
-  putLn h corrId
-  putLn h connAlias
-  putLn h command
-
-tGetRaw :: Handle -> IO ARawTransmission
-tGetRaw h = (,,) <$> getLn h <*> getLn h <*> getLn h
-
-tPut :: MonadIO m => Handle -> ATransmission p -> m ()
-tPut h (CorrId corrId, connAlias, command) =
-  liftIO $ tPutRaw h (corrId, connAlias, serializeCommand command)
-
--- | get client and agent transmissions
-tGet :: forall m p. MonadIO m => SAParty p -> Handle -> m (ATransmissionOrError p)
-tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
-  where
-    tParseLoadBody :: ARawTransmission -> m (ATransmissionOrError p)
-    tParseLoadBody t@(corrId, connAlias, command) = do
-      let cmd = parseCommand command >>= fromParty >>= tConnAlias t
-      fullCmd <- either (return . Left) cmdWithMsgBody cmd
-      return (CorrId corrId, connAlias, fullCmd)
-
-    fromParty :: ACmd -> Either AgentErrorType (ACommand p)
-    fromParty (ACmd (p :: p1) cmd) = case testEquality party p of
-      Just Refl -> Right cmd
-      _ -> Left $ CMD PROHIBITED
-
-    tConnAlias :: ARawTransmission -> ACommand p -> Either AgentErrorType (ACommand p)
-    tConnAlias (_, connAlias, _) cmd = case cmd of
-      -- NEW and JOIN have optional connAlias
-      NEW _ -> Right cmd
-      JOIN _ _ -> Right cmd
-      -- ERROR response does not always have connAlias
-      ERR _ -> Right cmd
-      -- other responses must have connAlias
-      _
-        | B.null connAlias -> Left $ CMD NO_CONN
-        | otherwise -> Right cmd
-
-    cmdWithMsgBody :: ACommand p -> m (Either AgentErrorType (ACommand p))
-    cmdWithMsgBody = \case
-      SEND body -> SEND <$$> getMsgBody body
-      MSG agentMsgId srvTS agentTS integrity body -> MSG agentMsgId srvTS agentTS integrity <$$> getMsgBody body
-      cmd -> return $ Right cmd
-
-    -- TODO refactor with server
-    getMsgBody :: MsgBody -> m (Either AgentErrorType MsgBody)
-    getMsgBody msgBody =
-      case B.unpack msgBody of
-        ':' : body -> return . Right $ B.pack body
-        str -> case readMaybe str :: Maybe Int of
-          Just size -> liftIO $ do
-            body <- B.hGet h size
-            s <- getLn h
-            return $ if B.null s then Right body else Left $ CMD SIZE
-          Nothing -> return . Left $ CMD SYNTAX

src/Simplex/Messaging/Client.hs

@@ -7,19 +7,37 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
+-- |
+-- Module      : Simplex.Messaging.Client
+-- Copyright   : (c) simplex.chat
+-- License     : AGPL-3
+--
+-- Maintainer  : chat@simplex.chat
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- This module provides a functional client API for SMP protocol.
+--
+-- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Client
-  ( SMPClient (blockSize),
+  ( -- * Connect (disconnect) client to (from) SMP server
+    SMPClient (blockSize),
     getSMPClient,
     closeSMPClient,
+
+    -- * SMP protocol command functions
     createSMPQueue,
     subscribeSMPQueue,
     secureSMPQueue,
     sendSMPMessage,
     ackSMPMessage,
-    sendSMPCommand,
     suspendSMPQueue,
     deleteSMPQueue,
+    sendSMPCommand,
+
+    -- * Supporting types and client configuration
     SMPClientError (..),
     SMPClientConfig (..),
     smpDefaultConfig,
@@ -35,19 +53,26 @@ import Control.Monad
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe
+import Data.Maybe (fromMaybe)
 import Network.Socket (ServiceName)
 import Numeric.Natural
-import Simplex.Messaging.Agent.Transmission (SMPServer (..))
+import Simplex.Messaging.Agent.Protocol (SMPServer (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport (ATransport (..), TCP, THandle (..), TProxy, Transport (..), TransportError, clientHandshake, runTransportClient)
+import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
-import System.IO
-import System.Timeout
+import System.Timeout (timeout)
 
+-- | 'SMPClient' is a handle used to send commands to a specific SMP server.
+--
+-- The only exported selector is blockSize that is negotiated
+-- with the server during the TCP transport handshake.
+--
+-- Use 'getSMPClient' to connect to an SMP server and create a client handle.
 data SMPClient = SMPClient
   { action :: Async (),
     connected :: TVar Bool,
@@ -61,23 +86,36 @@ data SMPClient = SMPClient
     blockSize :: Int
   }
 
+-- | Type synonym for transmission from some SPM server queue.
 type SMPServerTransmission = (SMPServer, RecipientId, Command 'Broker)
 
+-- | SMP client configuration.
 data SMPClientConfig = SMPClientConfig
-  { qSize :: Natural,
-    defaultPort :: ServiceName,
+  { -- | size of TBQueue to use for server commands and responses
+    qSize :: Natural,
+    -- | default SMP server port if port is not specified in SMPServer
+    defaultTransport :: (ServiceName, ATransport),
+    -- | 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
   }
 
+-- | Default SMP client configuration.
 smpDefaultConfig :: SMPClientConfig
 smpDefaultConfig =
   SMPClientConfig
     { qSize = 16,
-      defaultPort = "5223",
+      defaultTransport = ("5223", transport @TCP),
       tcpTimeout = 4_000_000,
       smpPing = 30_000_000,
+      smpBlockSize = Just 8192,
       smpCommandSize = 256
     }
 
@@ -88,103 +126,135 @@ data Request = Request
 
 type Response = Either SMPClientError Cmd
 
+-- | Connects to 'SMPServer' using passed client configuration
+-- and queue for messages and notifications.
+--
+-- 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@SMPServer {host, port, keyHash}
-  SMPClientConfig {qSize, defaultPort, tcpTimeout, smpPing}
-  msgQ
-  disconnected = do
-    c <- atomically mkSMPClient
-    thVar <- newEmptyTMVarIO
-    action <-
-      async $
-        runTCPClient host (fromMaybe defaultPort port) (client c thVar)
-          `finally` atomically (putTMVar thVar $ Left SMPNetworkError)
-    tHandle <- tcpTimeout `timeout` atomically (takeTMVar thVar)
-    pure $ case tHandle of
-      Just (Right THandle {blockSize}) -> Right c {action, blockSize}
-      Just (Left e) -> Left e
-      Nothing -> Left SMPNetworkError
-    where
-      mkSMPClient :: STM SMPClient
-      mkSMPClient = do
-        connected <- newTVar False
-        clientCorrId <- newTVar 0
-        sentCommands <- newTVar M.empty
-        sndQ <- newTBQueue qSize
-        rcvQ <- newTBQueue qSize
-        return
-          SMPClient
-            { action = undefined,
-              blockSize = undefined,
-              connected,
-              smpServer,
-              tcpTimeout,
-              clientCorrId,
-              sentCommands,
-              sndQ,
-              rcvQ,
-              msgQ
-            }
+getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlockSize} msgQ disconnected =
+  atomically mkSMPClient >>= runClient useTransport
+  where
+    mkSMPClient :: STM SMPClient
+    mkSMPClient = do
+      connected <- newTVar False
+      clientCorrId <- newTVar 0
+      sentCommands <- newTVar M.empty
+      sndQ <- newTBQueue qSize
+      rcvQ <- newTBQueue qSize
+      return
+        SMPClient
+          { action = undefined,
+            blockSize = undefined,
+            connected,
+            smpServer,
+            tcpTimeout,
+            clientCorrId,
+            sentCommands,
+            sndQ,
+            rcvQ,
+            msgQ
+          }
 
-      client :: SMPClient -> TMVar (Either SMPClientError THandle) -> Handle -> IO ()
-      client c thVar h =
-        runExceptT (clientHandshake h keyHash) >>= \case
-          Right th -> clientTransport c thVar th
-          Left e -> atomically . putTMVar thVar . Left $ SMPTransportError e
+    runClient :: (ServiceName, ATransport) -> SMPClient -> IO (Either SMPClientError SMPClient)
+    runClient (port', ATransport t) c = do
+      thVar <- newEmptyTMVarIO
+      action <-
+        async $
+          runTransportClient (host smpServer) port' (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}
+        Just (Left e) -> Left e
+        Nothing -> Left SMPNetworkError
 
-      clientTransport :: SMPClient -> TMVar (Either SMPClientError THandle) -> THandle -> IO ()
-      clientTransport c thVar th = do
-        atomically $ do
-          writeTVar (connected c) True
-          putTMVar thVar $ Right th
-        raceAny_ [send c th, process c, receive c th, ping c]
-          `finally` disconnected
+    useTransport :: (ServiceName, ATransport)
+    useTransport = case port smpServer of
+      Nothing -> defaultTransport cfg
+      Just "80" -> ("80", transport @WS)
+      Just p -> (p, transport @TCP)
 
-      send :: SMPClient -> THandle -> IO ()
-      send SMPClient {sndQ} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
+    client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError Int) -> c -> IO ()
+    client _ c thVar h =
+      runExceptT (clientHandshake h smpBlockSize $ keyHash smpServer) >>= \case
+        Left e -> atomically . putTMVar thVar . Left $ SMPTransportError e
+        Right th -> 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]
+            `finally` disconnected
 
-      receive :: SMPClient -> THandle -> IO ()
-      receive SMPClient {rcvQ} h = forever $ tGet fromServer h >>= atomically . writeTBQueue rcvQ
+    send :: Transport c => SMPClient -> THandle c -> IO ()
+    send SMPClient {sndQ} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
 
-      ping :: SMPClient -> IO ()
-      ping c = forever $ do
-        threadDelay smpPing
-        runExceptT $ sendSMPCommand c Nothing "" (Cmd SSender PING)
+    receive :: Transport c => SMPClient -> THandle c -> IO ()
+    receive SMPClient {rcvQ} h = forever $ tGet fromServer h >>= atomically . writeTBQueue rcvQ
 
-      process :: SMPClient -> IO ()
-      process SMPClient {rcvQ, sentCommands} = forever $ do
-        (_, (corrId, qId, respOrErr)) <- atomically $ readTBQueue rcvQ
-        cs <- readTVarIO sentCommands
-        case M.lookup corrId cs of
-          Nothing -> do
-            case respOrErr of
-              Right (Cmd SBroker cmd) -> atomically $ writeTBQueue msgQ (smpServer, qId, cmd)
-              -- TODO send everything else to errQ and log in agent
-              _ -> return ()
-          Just Request {queueId, responseVar} -> atomically $ do
-            modifyTVar sentCommands $ M.delete corrId
-            putTMVar responseVar $
-              if queueId == qId
-                then case respOrErr of
-                  Left e -> Left $ SMPResponseError e
-                  Right (Cmd _ (ERR e)) -> Left $ SMPServerError e
-                  Right r -> Right r
-                else Left SMPUnexpectedResponse
+    ping :: SMPClient -> IO ()
+    ping c = forever $ do
+      threadDelay smpPing
+      runExceptT $ sendSMPCommand c Nothing "" (Cmd SSender PING)
 
+    process :: SMPClient -> IO ()
+    process SMPClient {rcvQ, sentCommands} = forever $ do
+      (_, (corrId, qId, respOrErr)) <- atomically $ readTBQueue rcvQ
+      if B.null $ bs corrId
+        then sendMsg qId respOrErr
+        else do
+          cs <- readTVarIO sentCommands
+          case M.lookup corrId cs of
+            Nothing -> sendMsg qId respOrErr
+            Just Request {queueId, responseVar} -> atomically $ do
+              modifyTVar sentCommands $ M.delete corrId
+              putTMVar responseVar $
+                if queueId == qId
+                  then case respOrErr of
+                    Left e -> Left $ SMPResponseError e
+                    Right (Cmd _ (ERR e)) -> Left $ SMPServerError e
+                    Right r -> Right r
+                  else Left SMPUnexpectedResponse
+
+    sendMsg :: QueueId -> Either ErrorType Cmd -> IO ()
+    sendMsg qId = \case
+      Right (Cmd SBroker cmd) -> atomically $ writeTBQueue msgQ (smpServer, qId, cmd)
+      -- TODO send everything else to errQ and log in agent
+      _ -> return ()
+
+-- | Disconnects SMP client from the server and terminates client threads.
 closeSMPClient :: SMPClient -> IO ()
 closeSMPClient = uninterruptibleCancel . action
 
+-- | SMP client error type.
 data SMPClientError
-  = SMPServerError ErrorType
-  | SMPResponseError ErrorType
-  | SMPUnexpectedResponse
-  | SMPResponseTimeout
-  | SMPNetworkError
-  | SMPTransportError TransportError
-  | SMPSignatureError C.CryptoError
+  = -- | Correctly parsed SMP server ERR response.
+    -- This error is forwarded to the agent client as `ERR SMP err`.
+    SMPServerError ErrorType
+  | -- | Invalid server response that failed to parse.
+    -- Forwarded to the agent client as `ERR BROKER RESPONSE`.
+    SMPResponseError ErrorType
+  | -- | Different response from what is expected to a certain SMP command,
+    -- e.g. server should respond `IDS` or `ERR` to `NEW` command,
+    -- other responses would result in this error.
+    -- Forwarded to the agent client as `ERR BROKER UNEXPECTED`.
+    SMPUnexpectedResponse
+  | -- | Used for TCP connection and command response timeouts.
+    -- Forwarded to the agent client as `ERR BROKER TIMEOUT`.
+    SMPResponseTimeout
+  | -- | Failure to establish TCP connection.
+    -- Forwarded to the agent client as `ERR BROKER NETWORK`.
+    SMPNetworkError
+  | -- | TCP transport handshake or some other transport error.
+    -- Forwarded to the agent client as `ERR BROKER TRANSPORT e`.
+    SMPTransportError TransportError
+  | -- | Error when cryptographically "signing" the command.
+    SMPSignatureError C.CryptoError
   deriving (Eq, Show, Exception)
 
+-- | Create a new SMP queue.
+--
+-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#create-queue-command
 createSMPQueue ::
   SMPClient ->
   RecipientPrivateKey ->
@@ -196,6 +266,9 @@ createSMPQueue c rpKey rKey =
     Cmd _ (IDS rId sId) -> return (rId, sId)
     _ -> 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 c@SMPClient {smpServer, msgQ} rpKey rId =
   sendSMPCommand c (Just rpKey) rId (Cmd SRecipient SUB) >>= \case
@@ -204,15 +277,24 @@ subscribeSMPQueue c@SMPClient {smpServer, msgQ} rpKey rId =
       lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd)
     _ -> throwE SMPUnexpectedResponse
 
+-- | 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
 
+-- | 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 c spKey sId msg =
   sendSMPCommand c spKey sId (Cmd SSender $ SEND msg) >>= \case
     Cmd _ OK -> return ()
     _ -> 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 c@SMPClient {smpServer, msgQ} rpKey rId =
   sendSMPCommand c (Just rpKey) rId (Cmd SRecipient ACK) >>= \case
@@ -221,9 +303,16 @@ ackSMPMessage c@SMPClient {smpServer, msgQ} rpKey rId =
       lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd)
     _ -> throwE SMPUnexpectedResponse
 
+-- | Irreversibly suspend SMP queue.
+-- 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
 
+-- | 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
 
@@ -233,6 +322,7 @@ okSMPCommand cmd c pKey qId =
     Cmd _ 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
   corrId <- lift_ getNextCorrId
@@ -244,9 +334,8 @@ sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId
 
     getNextCorrId :: STM CorrId
     getNextCorrId = do
-      i <- (+ 1) <$> readTVar clientCorrId
-      writeTVar clientCorrId i
-      return . CorrId $ bshow i
+      i <- stateTVar clientCorrId $ \i -> (i, i + 1)
+      pure . CorrId $ bshow i
 
     signTransmission :: ByteString -> ExceptT SMPClientError IO SignedRawTransmission
     signTransmission t = case pKey of

src/Simplex/Messaging/Crypto.hs

@@ -7,39 +7,52 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
+-- |
+-- Module      : Simplex.Messaging.Crypto
+-- Copyright   : (c) simplex.chat
+-- License     : AGPL-3
+--
+-- Maintainer  : chat@simplex.chat
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- This module provides cryptography implementation for SMP protocols based on
+-- <https://hackage.haskell.org/package/cryptonite cryptonite package>.
 module Simplex.Messaging.Crypto
-  ( PrivateKey (rsaPrivateKey),
-    SafePrivateKey, -- constructor is not exported
+  ( -- * RSA keys
+    PrivateKey (rsaPrivateKey, publicKey),
+    SafePrivateKey (..), -- constructor is not exported
     FullPrivateKey (..),
+    APrivateKey (..),
     PublicKey (..),
-    Signature (..),
-    CryptoError (..),
     SafeKeyPair,
     FullKeyPair,
-    Key (..),
-    IV (..),
     KeyHash (..),
     generateKeyPair,
-    publicKey,
+    publicKey',
     publicKeySize,
     validKeySize,
     safePrivateKey,
-    sign,
-    verify,
+    removePublicKey,
+
+    -- * E2E hybrid encryption scheme
     encrypt,
     decrypt,
+
+    -- * RSA OAEP encryption
     encryptOAEP,
     decryptOAEP,
+
+    -- * RSA PSS signing
+    Signature (..),
+    sign,
+    verify,
+
+    -- * AES256 AEAD-GCM scheme
+    Key (..),
+    IV (..),
     encryptAES,
     decryptAES,
-    serializePrivKey,
-    serializePubKey,
-    encodePubKey,
-    publicKeyHash,
-    sha256Hash,
-    privKeyP,
-    pubKeyP,
-    binaryPubKeyP,
     authTagSize,
     authTagToBS,
     bsToAuthTag,
@@ -47,6 +60,23 @@ module Simplex.Messaging.Crypto
     randomIV,
     aesKeyP,
     ivP,
+
+    -- * Encoding of RSA keys
+    serializePrivKey,
+    serializePubKey,
+    serializePubKeyUri,
+    encodePubKey,
+    publicKeyHash,
+    privKeyP,
+    pubKeyP,
+    pubKeyUriP,
+    binaryPubKeyP,
+
+    -- * SHA256 hash
+    sha256Hash,
+
+    -- * Cryptography error type
+    CryptoError (..),
   )
 where
 
@@ -71,6 +101,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Base64 (decode, encode)
+import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Internal (c2w, w2c)
@@ -80,70 +111,117 @@ import Data.X509
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
 import Network.Transport.Internal (decodeWord32, encodeWord32)
-import Simplex.Messaging.Parsers (base64P, blobFieldParser, parseAll)
+import Simplex.Messaging.Parsers (base64P, base64UriP, blobFieldParser, parseAll, parseString)
 import Simplex.Messaging.Util (liftEitherError, (<$?>))
 
+-- | A newtype of 'Crypto.PubKey.RSA.PublicKey'.
 newtype PublicKey = PublicKey {rsaPublicKey :: R.PublicKey} deriving (Eq, Show)
 
+-- | A newtype of 'Crypto.PubKey.RSA.PrivateKey', with PublicKey removed.
+--
+-- It is not possible to recover PublicKey from SafePrivateKey.
+-- The constructor of this type is not exported.
 newtype SafePrivateKey = SafePrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show)
 
+-- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (with PublicKey inside).
 newtype FullPrivateKey = FullPrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show)
 
+-- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (PublicKey may be inside).
+newtype APrivateKey = APrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show)
+
+-- | Type-class used for both private key types: SafePrivateKey and FullPrivateKey.
 class PrivateKey k where
+  -- unwraps 'Crypto.PubKey.RSA.PrivateKey'
   rsaPrivateKey :: k -> R.PrivateKey
+
+  -- equivalent to data type constructor, not exported
   _privateKey :: R.PrivateKey -> k
+
+  -- smart constructor removing public key from SafePrivateKey but keeping it in FullPrivateKey
   mkPrivateKey :: R.PrivateKey -> k
 
+  -- extracts public key from private key
+  publicKey :: k -> Maybe PublicKey
+
+-- | Remove public key exponent from APrivateKey.
+removePublicKey :: APrivateKey -> APrivateKey
+removePublicKey (APrivateKey R.PrivateKey {private_pub = k, private_d}) =
+  APrivateKey $ unPrivateKey (safePrivateKey (R.public_size k, R.public_n k, private_d) :: SafePrivateKey)
+
 instance PrivateKey SafePrivateKey where
   rsaPrivateKey = unPrivateKey
   _privateKey = SafePrivateKey
   mkPrivateKey R.PrivateKey {private_pub = k, private_d} =
     safePrivateKey (R.public_size k, R.public_n k, private_d)
+  publicKey _ = Nothing
 
 instance PrivateKey FullPrivateKey where
   rsaPrivateKey = unPrivateKey
   _privateKey = FullPrivateKey
   mkPrivateKey = FullPrivateKey
+  publicKey = Just . PublicKey . R.private_pub . rsaPrivateKey
+
+instance PrivateKey APrivateKey where
+  rsaPrivateKey = unPrivateKey
+  _privateKey = APrivateKey
+  mkPrivateKey = APrivateKey
+  publicKey pk =
+    let k = R.private_pub $ rsaPrivateKey pk
+     in if R.public_e k == 0
+          then Nothing
+          else Just $ PublicKey k
 
 instance IsString FullPrivateKey where
-  fromString = parseString (decode >=> decodePrivKey)
+  fromString = parseString $ decode >=> decodePrivKey
 
 instance IsString PublicKey where
-  fromString = parseString (decode >=> decodePubKey)
-
-parseString :: (ByteString -> Either String a) -> (String -> a)
-parseString parse = either error id . parse . B.pack
+  fromString = parseString $ decode >=> decodePubKey
 
 instance ToField SafePrivateKey where toField = toField . encodePrivKey
 
+instance ToField APrivateKey where toField = toField . encodePrivKey
+
 instance ToField PublicKey where toField = toField . encodePubKey
 
 instance FromField SafePrivateKey where fromField = blobFieldParser binaryPrivKeyP
 
+instance FromField APrivateKey where fromField = blobFieldParser binaryPrivKeyP
+
 instance FromField PublicKey where fromField = blobFieldParser binaryPubKeyP
 
+-- | Tuple of RSA 'PublicKey' and 'PrivateKey'.
 type KeyPair k = (PublicKey, k)
 
+-- | Tuple of RSA 'PublicKey' and 'SafePrivateKey'.
 type SafeKeyPair = (PublicKey, SafePrivateKey)
 
+-- | Tuple of RSA 'PublicKey' and 'FullPrivateKey'.
 type FullKeyPair = (PublicKey, FullPrivateKey)
 
+-- | RSA signature newtype.
 newtype Signature = Signature {unSignature :: ByteString} deriving (Eq, Show)
 
 instance IsString Signature where
   fromString = Signature . fromString
 
-newtype Verified = Verified ByteString deriving (Show)
-
+-- | Various cryptographic or related errors.
 data CryptoError
-  = RSAEncryptError R.Error
-  | RSADecryptError R.Error
-  | RSASignError R.Error
-  | AESCipherError CE.CryptoError
-  | CryptoIVError
-  | AESDecryptError
-  | CryptoLargeMsgError
-  | CryptoHeaderError String
+  = -- | RSA OAEP encryption error
+    RSAEncryptError R.Error
+  | -- | RSA OAEP decryption error
+    RSADecryptError R.Error
+  | -- | RSA PSS signature error
+    RSASignError R.Error
+  | -- | AES initialization error
+    AESCipherError CE.CryptoError
+  | -- | IV generation error
+    CryptoIVError
+  | -- | AES decryption error
+    AESDecryptError
+  | -- | message does not fit in SMP block
+    CryptoLargeMsgError
+  | -- | failure parsing RSA-encrypted message header
+    CryptoHeaderError String
   deriving (Eq, Show, Exception)
 
 pubExpRange :: Integer
@@ -155,6 +233,7 @@ aesKeySize = 256 `div` 8
 authTagSize :: Int
 authTagSize = 128 `div` 8
 
+-- | Generate RSA key pair with either SafePrivateKey or FullPrivateKey.
 generateKeyPair :: PrivateKey k => Int -> IO (KeyPair k)
 generateKeyPair size = loop
   where
@@ -170,8 +249,8 @@ generateKeyPair size = loop
 privateKeySize :: PrivateKey k => k -> Int
 privateKeySize = R.public_size . R.private_pub . rsaPrivateKey
 
-publicKey :: FullPrivateKey -> PublicKey
-publicKey = PublicKey . R.private_pub . rsaPrivateKey
+publicKey' :: FullPrivateKey -> PublicKey
+publicKey' = PublicKey . R.private_pub . rsaPrivateKey
 
 publicKeySize :: PublicKey -> Int
 publicKeySize = R.public_size . rsaPublicKey
@@ -180,6 +259,7 @@ validKeySize :: Int -> Bool
 validKeySize = \case
   128 -> True
   256 -> True
+  384 -> True
   512 -> True
   _ -> False
 
@@ -190,10 +270,13 @@ data Header = Header
     msgSize :: Int
   }
 
+-- | AES key newtype.
 newtype Key = Key {unKey :: ByteString}
 
+-- | IV bytes newtype.
 newtype IV = IV {unIV :: ByteString}
 
+-- | Key hash newtype.
 newtype KeyHash = KeyHash {unKeyHash :: ByteString} deriving (Eq, Ord, Show)
 
 instance IsString KeyHash where
@@ -203,9 +286,11 @@ instance ToField KeyHash where toField = toField . encode . unKeyHash
 
 instance FromField KeyHash where fromField = blobFieldParser $ KeyHash <$> base64P
 
+-- | Digest (hash) of binary X509 encoding of RSA public key.
 publicKeyHash :: PublicKey -> KeyHash
 publicKeyHash = KeyHash . sha256Hash . encodePubKey
 
+-- | SHA256 digest.
 sha256Hash :: ByteString -> ByteString
 sha256Hash = BA.convert . (hash :: ByteString -> Digest SHA256)
 
@@ -221,15 +306,22 @@ headerP = do
   msgSize <- fromIntegral . decodeWord32 <$> A.take 4
   return Header {aesKey, ivBytes, authTag, msgSize}
 
+-- | AES256 key parser.
 aesKeyP :: Parser Key
 aesKeyP = Key <$> A.take aesKeySize
 
+-- | IV bytes parser.
 ivP :: Parser IV
 ivP = IV <$> A.take (ivSize @AES256)
 
 parseHeader :: ByteString -> Either CryptoError Header
 parseHeader = first CryptoHeaderError . parseAll headerP
 
+-- * E2E hybrid encryption scheme
+
+-- | E2E encrypt SMP agent messages.
+--
+-- https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-01-26-crypto.md#e2e-encryption
 encrypt :: PublicKey -> Int -> ByteString -> ExceptT CryptoError IO ByteString
 encrypt k paddedSize msg = do
   aesKey <- liftIO randomAesKey
@@ -239,6 +331,9 @@ encrypt k paddedSize msg = do
   encHeader <- encryptOAEP k $ serializeHeader header
   return $ encHeader <> msg'
 
+-- | E2E decrypt SMP agent messages.
+--
+-- https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-01-26-crypto.md#e2e-encryption
 decrypt :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO ByteString
 decrypt pk msg'' = do
   let (encHeader, msg') = B.splitAt (privateKeySize pk) msg''
@@ -247,6 +342,9 @@ decrypt pk msg'' = do
   msg <- decryptAES aesKey ivBytes msg' authTag
   return $ B.take msgSize msg
 
+-- | AEAD-GCM encryption.
+--
+-- Used as part of hybrid E2E encryption scheme and for SMP transport blocks encryption.
 encryptAES :: Key -> IV -> Int -> ByteString -> ExceptT CryptoError IO (AES.AuthTag, ByteString)
 encryptAES aesKey ivBytes paddedSize msg = do
   aead <- initAEAD @AES256 aesKey ivBytes
@@ -258,6 +356,9 @@ encryptAES aesKey ivBytes paddedSize msg = do
       | len >= paddedSize = throwE CryptoLargeMsgError
       | otherwise = return (msg <> B.replicate (paddedSize - len) '#')
 
+-- | AEAD-GCM decryption.
+--
+-- Used as part of hybrid E2E encryption scheme and for SMP transport blocks decryption.
 decryptAES :: Key -> IV -> ByteString -> AES.AuthTag -> ExceptT CryptoError IO ByteString
 decryptAES aesKey ivBytes msg authTag = do
   aead <- initAEAD @AES256 aesKey ivBytes
@@ -270,9 +371,11 @@ initAEAD (Key aesKey) (IV ivBytes) = do
     cipher <- AES.cipherInit aesKey
     AES.aeadInit AES.AEAD_GCM cipher iv
 
+-- | Random AES256 key.
 randomAesKey :: IO Key
 randomAesKey = Key <$> getRandomBytes aesKeySize
 
+-- | Random IV bytes for AES256 encryption.
 randomIV :: IO IV
 randomIV = IV <$> getRandomBytes (ivSize @AES256)
 
@@ -285,9 +388,11 @@ makeIV bs = maybeError CryptoIVError $ AES.makeIV bs
 maybeError :: CryptoError -> Maybe a -> ExceptT CryptoError IO a
 maybeError e = maybe (throwE e) return
 
+-- | Convert AEAD 'AuthTag' to ByteString.
 authTagToBS :: AES.AuthTag -> ByteString
 authTagToBS = B.pack . map w2c . BA.unpack . AES.unAuthTag
 
+-- | Convert ByteString to AEAD 'AuthTag'.
 bsToAuthTag :: ByteString -> AES.AuthTag
 bsToAuthTag = AES.AuthTag . BA.pack . map c2w . B.unpack
 
@@ -297,11 +402,17 @@ cryptoFailable = liftEither . first AESCipherError . CE.eitherCryptoError
 oaepParams :: OAEP.OAEPParams SHA256 ByteString ByteString
 oaepParams = OAEP.defaultOAEPParams SHA256
 
+-- | RSA OAEP encryption.
+--
+-- Used as part of hybrid E2E encryption scheme and for SMP transport handshake.
 encryptOAEP :: PublicKey -> ByteString -> ExceptT CryptoError IO ByteString
 encryptOAEP (PublicKey k) aesKey =
   liftEitherError RSAEncryptError $
     OAEP.encrypt oaepParams k aesKey
 
+-- | RSA OAEP decryption.
+--
+-- Used as part of hybrid E2E encryption scheme and for SMP transport handshake.
 decryptOAEP :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO ByteString
 decryptOAEP pk encKey =
   liftEitherError RSADecryptError $
@@ -310,30 +421,53 @@ decryptOAEP pk encKey =
 pssParams :: PSS.PSSParams SHA256 ByteString ByteString
 pssParams = PSS.defaultPSSParams SHA256
 
+-- | RSA PSS message signing.
+--
+-- Used by SMP clients to sign SMP commands and by SMP agents to sign messages.
 sign :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO Signature
 sign pk msg = ExceptT $ bimap RSASignError Signature <$> PSS.signSafer pssParams (rsaPrivateKey pk) msg
 
+-- | RSA PSS signature verification.
+--
+-- Used by SMP servers to authorize SMP commands and by SMP agents to verify messages.
 verify :: PublicKey -> Signature -> ByteString -> Bool
 verify (PublicKey k) (Signature sig) msg = PSS.verify pssParams k msg sig
 
+-- | Base-64 X509 encoding of RSA public key.
+--
+-- Used as part of SMP queue information (out-of-band message).
 serializePubKey :: PublicKey -> ByteString
 serializePubKey = ("rsa:" <>) . encode . encodePubKey
 
+serializePubKeyUri :: PublicKey -> ByteString
+serializePubKeyUri = ("rsa:" <>) . U.encode . encodePubKey
+
+-- | Base-64 PKCS8 encoding of PSA private key.
+--
+-- Not used as part of SMP protocols.
 serializePrivKey :: PrivateKey k => k -> ByteString
 serializePrivKey = ("rsa:" <>) . encode . encodePrivKey
 
+-- Base-64 X509 RSA public key parser.
 pubKeyP :: Parser PublicKey
 pubKeyP = decodePubKey <$?> ("rsa:" *> base64P)
 
+pubKeyUriP :: Parser PublicKey
+pubKeyUriP = decodePubKey <$?> ("rsa:" *> base64UriP)
+
+-- Binary X509 RSA public key parser.
 binaryPubKeyP :: Parser PublicKey
 binaryPubKeyP = decodePubKey <$?> A.takeByteString
 
+-- Base-64 PKCS8 RSA private key parser.
 privKeyP :: PrivateKey k => Parser k
 privKeyP = decodePrivKey <$?> ("rsa:" *> base64P)
 
+-- Binary PKCS8 RSA private key parser.
 binaryPrivKeyP :: PrivateKey k => Parser k
 binaryPrivKeyP = decodePrivKey <$?> A.takeByteString
 
+-- | Construct 'SafePrivateKey' from three numbers - used internally and in the tests.
 safePrivateKey :: (Int, Integer, Integer) -> SafePrivateKey
 safePrivateKey = SafePrivateKey . safeRsaPrivateKey
 
@@ -354,21 +488,25 @@ safeRsaPrivateKey (size, n, d) =
       private_qinv = 0
     }
 
+-- Binary X509 encoding of 'PublicKey'.
 encodePubKey :: PublicKey -> ByteString
 encodePubKey = encodeKey . PubKeyRSA . rsaPublicKey
 
+-- Binary PKCS8 encoding of 'PrivateKey'.
 encodePrivKey :: PrivateKey k => k -> ByteString
 encodePrivKey = encodeKey . PrivKeyRSA . rsaPrivateKey
 
 encodeKey :: ASN1Object a => a -> ByteString
 encodeKey k = toStrict . encodeASN1 DER $ toASN1 k []
 
+-- Decoding of binary X509 'PublicKey'.
 decodePubKey :: ByteString -> Either String PublicKey
 decodePubKey =
   decodeKey >=> \case
     (PubKeyRSA k, []) -> Right $ PublicKey k
     r -> keyError r
 
+-- Decoding of binary PKCS8 'PrivateKey'.
 decodePrivKey :: PrivateKey k => ByteString -> Either String k
 decodePrivKey =
   decodeKey >=> \case

src/Simplex/Messaging/Parsers.hs

@@ -7,6 +7,7 @@ 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)
@@ -24,13 +25,27 @@ base64P :: Parser ByteString
 base64P = decode <$?> base64StringP
 
 base64StringP :: Parser ByteString
-base64StringP = do
-  str <- A.takeWhile1 (\c -> isAlphaNum c || c == '+' || c == '/')
-  pad <- A.takeWhile (== '=')
-  pure $ str <> pad
+base64StringP = paddedBase64 rawBase64P
+
+base64UriP :: Parser ByteString
+base64UriP = U.decode <$?> base64UriStringP
+
+base64UriStringP :: Parser ByteString
+base64UriStringP = paddedBase64 rawBase64UriP
+
+paddedBase64 :: Parser ByteString -> Parser ByteString
+paddedBase64 raw = (<>) <$> raw <*> pad
+  where
+    pad = A.takeWhile (== '=')
+
+rawBase64P :: Parser ByteString
+rawBase64P = 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 (== ' ')
+tsISO8601P = maybe (fail "timestamp") pure . parseISO8601 . B.unpack =<< A.takeTill wordEnd
 
 parse :: Parser a -> e -> (ByteString -> Either e a)
 parse parser err = first (const err) . parseAll parser
@@ -42,14 +57,20 @@ parseRead :: Read a => Parser ByteString -> Parser a
 parseRead = (>>= maybe (fail "cannot read") pure . readMaybe . B.unpack)
 
 parseRead1 :: Read a => Parser a
-parseRead1 = parseRead $ A.takeTill (== ' ')
+parseRead1 = parseRead $ A.takeTill wordEnd
 
 parseRead2 :: Read a => Parser a
 parseRead2 = parseRead $ do
-  w1 <- A.takeTill (== ' ') <* A.char ' '
-  w2 <- A.takeTill (== ' ')
+  w1 <- A.takeTill wordEnd <* A.char ' '
+  w2 <- A.takeTill wordEnd
   pure $ w1 <> " " <> w2
 
+wordEnd :: Char -> Bool
+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) _) ->

src/Simplex/Messaging/Protocol.hs

@@ -10,7 +10,58 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
-module Simplex.Messaging.Protocol where
+-- |
+-- Module      : Simplex.Messaging.Protocol
+-- Copyright   : (c) simplex.chat
+-- License     : AGPL-3
+--
+-- Maintainer  : chat@simplex.chat
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- Types, parsers, serializers and functions to send and receive SMP protocol commands and responses.
+--
+-- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
+module Simplex.Messaging.Protocol
+  ( -- * SMP protocol types
+    Command (..),
+    Party (..),
+    Cmd (..),
+    SParty (..),
+    ErrorType (..),
+    CommandError (..),
+    Transmission,
+    SignedTransmission,
+    SignedTransmissionOrError,
+    RawTransmission,
+    SignedRawTransmission,
+    CorrId (..),
+    QueueId,
+    RecipientId,
+    SenderId,
+    RecipientPrivateKey,
+    RecipientPublicKey,
+    SenderPrivateKey,
+    SenderPublicKey,
+    Encoded,
+    MsgId,
+    MsgBody,
+
+    -- * Parse and serialize
+    serializeTransmission,
+    serializeCommand,
+    serializeErrorType,
+    transmissionP,
+    commandP,
+    errorTypeP,
+
+    -- * TCP transport functions
+    tPut,
+    tGet,
+    fromClient,
+    fromServer,
+  )
+where
 
 import Control.Applicative ((<|>))
 import Control.Monad
@@ -29,13 +80,15 @@ import GHC.Generics (Generic)
 import Generic.Random (genericArbitraryU)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers
-import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport (THandle, Transport, TransportError (..), tGetEncrypted, tPutEncrypted)
 import Simplex.Messaging.Util
 import Test.QuickCheck (Arbitrary (..))
 
+-- | SMP protocol participants.
 data Party = Broker | Recipient | Sender
   deriving (Show)
 
+-- | Singleton types for SMP protocol participants.
 data SParty :: Party -> Type where
   SBroker :: SParty Broker
   SRecipient :: SParty Recipient
@@ -43,28 +96,38 @@ data SParty :: Party -> Type where
 
 deriving instance Show (SParty a)
 
+-- | Type for command or response of any participant.
 data Cmd = forall a. Cmd (SParty a) (Command a)
 
 deriving instance Show Cmd
 
+-- | SMP transmission without signature.
 type Transmission = (CorrId, QueueId, Cmd)
 
+-- | SMP transmission with signature.
 type SignedTransmission = (C.Signature, Transmission)
 
 type TransmissionOrError = (CorrId, QueueId, Either ErrorType Cmd)
 
+-- | signed parsed transmission, with parsing error.
 type SignedTransmissionOrError = (C.Signature, TransmissionOrError)
 
+-- | unparsed SMP transmission with signature.
 type RawTransmission = (ByteString, ByteString, ByteString, ByteString)
 
+-- | unparsed SMP transmission with signature.
 type SignedRawTransmission = (C.Signature, ByteString)
 
+-- | SMP queue ID for the recipient.
 type RecipientId = QueueId
 
+-- | SMP queue ID for the sender.
 type SenderId = QueueId
 
+-- | SMP queue ID on the server.
 type QueueId = Encoded
 
+-- | Parameterized type for SMP protocol commands from all participants.
 data Command (a :: Party) where
   -- SMP recipient commands
   NEW :: RecipientPublicKey -> Command Recipient
@@ -88,50 +151,78 @@ deriving instance Show (Command a)
 
 deriving instance Eq (Command a)
 
+-- | Base-64 encoded string.
 type Encoded = ByteString
 
--- newtype to avoid accidentally changing order of transmission parts
+-- | 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
 
--- only used by Agent, kept here so its definition is close to respective public key
+-- | 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
 
+-- | Recipient's public key used by SMP server to verify authorization of SMP commands.
 type RecipientPublicKey = C.PublicKey
 
--- only used by Agent, kept here so its definition is close to respective public key
+-- | 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
 
+-- | Sender's public key used by SMP server to verify authorization of SMP commands.
 type SenderPublicKey = C.PublicKey
 
+-- | SMP message server ID.
 type MsgId = Encoded
 
+-- | SMP message body.
 type MsgBody = ByteString
 
+-- | Type for protocol errors.
 data ErrorType
-  = BLOCK
-  | CMD CommandError
-  | AUTH
-  | NO_MSG
-  | INTERNAL
-  | DUPLICATE_ -- TODO remove, not part of SMP protocol
+  = -- | incorrect block format, encoding or signature size
+    BLOCK
+  | -- | SMP command is unknown or has invalid syntax
+    CMD 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
+  | -- | 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)
 
+-- | SMP command error type.
 data CommandError
-  = PROHIBITED
-  | KEY_SIZE
-  | SYNTAX
-  | NO_AUTH
-  | HAS_AUTH
-  | NO_QUEUE
+  = -- | 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
+  | -- | error parsing command
+    SYNTAX
+  | -- | transmission has no required credentials (signature or queue ID)
+    NO_AUTH
+  | -- | transmission has credentials that are not allowed for this command
+    HAS_AUTH
+  | -- | transmission has no required queue ID
+    NO_QUEUE
   deriving (Eq, Generic, Read, Show)
 
 instance Arbitrary ErrorType where arbitrary = genericArbitraryU
 
 instance Arbitrary CommandError where arbitrary = genericArbitraryU
 
+-- | SMP transmission parser.
 transmissionP :: Parser RawTransmission
 transmissionP = do
   signature <- segment
@@ -142,6 +233,7 @@ transmissionP = do
   where
     segment = A.takeTill (== ' ') <* " "
 
+-- | SMP command parser.
 commandP :: Parser Cmd
 commandP =
   "NEW " *> newCmd
@@ -173,9 +265,12 @@ commandP =
     serverError = Cmd SBroker . ERR <$> errorTypeP
 
 -- TODO ignore the end of block, no need to parse it
+
+-- | Parse SMP command.
 parseCommand :: ByteString -> Either ErrorType Cmd
 parseCommand = parse (commandP <* " " <* A.takeByteString) $ CMD SYNTAX
 
+-- | Serialize SMP command.
 serializeCommand :: Cmd -> ByteString
 serializeCommand = \case
   Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializePubKey rKey
@@ -191,36 +286,45 @@ serializeCommand = \case
   where
     serializeMsg msgBody = bshow (B.length msgBody) <> " " <> msgBody <> " "
 
+-- | SMP error parser.
 errorTypeP :: Parser ErrorType
 errorTypeP = "CMD " *> (CMD <$> parseRead1) <|> parseRead1
 
+-- | Serialize SMP error.
 serializeErrorType :: ErrorType -> ByteString
 serializeErrorType = bshow
 
-tPut :: THandle -> SignedRawTransmission -> IO (Either TransportError ())
+-- | 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 <> " "
 
+-- | Serialize SMP transmission.
 serializeTransmission :: Transmission -> ByteString
 serializeTransmission (CorrId corrId, queueId, command) =
   B.intercalate " " [corrId, encode queueId, serializeCommand 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
 
-tGetParse :: THandle -> IO (Either TransportError RawTransmission)
+-- | Receive and parse transmission from the TCP transport.
+tGetParse :: Transport c => THandle c -> IO (Either TransportError RawTransmission)
 tGetParse th = (>>= parse transmissionP TEBadBlock) <$> tGetEncrypted th
 
--- | get client and server transmissions
--- `fromParty` is used to limit allowed senders - `fromClient` or `fromServer` should be used
-tGet :: forall m. MonadIO m => (Cmd -> Either ErrorType Cmd) -> THandle -> m SignedTransmissionOrError
+-- | 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
   where
     decodeParseValidate :: Either TransportError RawTransmission -> m SignedTransmissionOrError

src/Simplex/Messaging/Server.hs

@@ -10,8 +10,20 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
--- TODO move randomBytes to another module
-module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking, randomBytes) where
+-- |
+-- Module      : Simplex.Messaging.Server
+-- Copyright   : (c) simplex.chat
+-- License     : AGPL-3
+--
+-- Maintainer  : chat@simplex.chat
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- This module defines SMP protocol server with in-memory persistence
+-- and optional append only log of SMP queue records.
+--
+-- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
+module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking) where
 
 import Control.Concurrent.STM (stateTVar)
 import Control.Monad
@@ -24,6 +36,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import qualified Data.Map.Strict as M
 import Data.Time.Clock
+import Network.Socket (ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Env.STM
@@ -34,60 +47,93 @@ import Simplex.Messaging.Server.QueueStore.STM (QueueStore)
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Util
-import UnliftIO.Async
 import UnliftIO.Concurrent
 import UnliftIO.Exception
 import UnliftIO.IO
 import UnliftIO.STM
 
+-- | Runs an SMP server using passed configuration.
+--
+-- See a full server here: https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-server/Main.hs
 runSMPServer :: (MonadRandom m, MonadUnliftIO m) => ServerConfig -> m ()
-runSMPServer cfg = newEmptyTMVarIO >>= (`runSMPServerBlocking` cfg)
+runSMPServer cfg = do
+  started <- newEmptyTMVarIO
+  runSMPServerBlocking started cfg
 
+-- | Runs an SMP server 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).
 runSMPServerBlocking :: (MonadRandom m, MonadUnliftIO m) => TMVar Bool -> ServerConfig -> m ()
-runSMPServerBlocking started cfg@ServerConfig {tcpPort} = do
+runSMPServerBlocking started cfg@ServerConfig {transports} = do
   env <- newEnv cfg
   runReaderT smpServer env
   where
-    smpServer :: (MonadUnliftIO m, MonadReader Env m) => m ()
+    smpServer :: (MonadUnliftIO m', MonadReader Env m') => m' ()
     smpServer = do
       s <- asks server
-      race_ (runTCPServer started tcpPort runClient) (serverThread s)
+      raceAny_ (serverThread s : map runServer transports)
         `finally` withLog closeStoreLog
 
-    serverThread :: MonadUnliftIO m => Server -> m ()
-    serverThread Server {subscribedQ, subscribers} = forever . atomically $ do
-      (rId, clnt) <- readTBQueue subscribedQ
-      cs <- readTVar subscribers
-      case M.lookup rId cs of
-        Just Client {rcvQ} -> writeTBQueue rcvQ (CorrId B.empty, rId, Cmd SBroker END)
-        Nothing -> return ()
-      writeTVar subscribers $ M.insert rId clnt cs
+    runServer :: (MonadUnliftIO m', MonadReader Env m') => (ServiceName, ATransport) -> m' ()
+    runServer (tcpPort, ATransport t) = runTransportServer started tcpPort (runClient t)
 
-runClient :: (MonadUnliftIO m, MonadReader Env m) => Handle -> m ()
-runClient h = do
+    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 ()
+      where
+        updateSubscribers :: STM (Maybe (RecipientId, 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
+
+runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
+runClient _ h = do
   keyPair <- asks serverKeyPair
-  liftIO (runExceptT $ serverHandshake h keyPair) >>= \case
+  ServerConfig {blockSize} <- asks config
+  liftIO (runExceptT $ serverHandshake h blockSize keyPair) >>= \case
     Right th -> runClientTransport th
     Left _ -> pure ()
 
-runClientTransport :: (MonadUnliftIO m, MonadReader Env m) => THandle -> m ()
+runClientTransport :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> m ()
 runClientTransport th = do
   q <- asks $ tbqSize . config
-  c <- atomically $ newClient q
   s <- asks server
+  c <- atomically $ newClient s q
   raceAny_ [send th c, client c s, receive th c]
-    `finally` cancelSubscribers c
+    `finally` clientDisconnected c
 
-cancelSubscribers :: MonadUnliftIO m => Client -> m ()
-cancelSubscribers Client {subscriptions} =
-  readTVarIO subscriptions >>= mapM_ cancelSub
+clientDisconnected :: (MonadUnliftIO m, MonadReader Env m) => Client -> m ()
+clientDisconnected c@Client {subscriptions, connected} = do
+  atomically $ writeTVar connected False
+  subs <- readTVarIO subscriptions
+  mapM_ cancelSub subs
+  cs <- asks $ subscribers . server
+  atomically . mapM_ (modifyTVar cs . M.update deleteCurrentClient) $ M.keys subs
+  where
+    deleteCurrentClient :: Client -> Maybe Client
+    deleteCurrentClient c'
+      | clientId c == clientId c' = Nothing
+      | otherwise = Just c'
 
 cancelSub :: MonadUnliftIO m => Sub -> m ()
 cancelSub = \case
   Sub {subThread = SubThread t} -> killThread t
   _ -> return ()
 
-receive :: (MonadUnliftIO m, MonadReader Env m) => THandle -> Client -> m ()
+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
@@ -95,7 +141,7 @@ receive h Client {rcvQ} = forever $ do
     Right cmd -> verifyTransmission (signature, (corrId, queueId, cmd))
   atomically $ writeTBQueue rcvQ t
 
-send :: MonadUnliftIO m => THandle -> Client -> m ()
+send :: (Transport c, MonadUnliftIO m) => THandle c -> Client -> m ()
 send h Client {sndQ} = forever $ do
   t <- atomically $ readTBQueue sndQ
   liftIO $ tPut h ("", serializeTransmission t)
@@ -133,6 +179,7 @@ verifyTransmission (sig, t@(corrId, queueId, cmd)) = do
       cryptoVerify $ case sigLen of
         128 -> dummyKey128
         256 -> dummyKey256
+        384 -> dummyKey384
         512 -> dummyKey512
         _ -> dummyKey256
     sigLen = B.length $ C.unSignature sig
@@ -145,6 +192,9 @@ dummyKey128 = "MIIBIDANBgkqhkiG9w0BAQEFAAOCAQ0AMIIBCAKBgQC2oeA7s4roXN5K2N6022I1/
 dummyKey256 :: C.PublicKey
 dummyKey256 = "MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAxwmTvaqmdTbkfUGNi8Yu0L/T4cxuOlQlx3zGZ9X9Qx0+oZjknWK+QHrdWTcpS+zH4Hi7fP6kanOQoQ90Hj6Ghl57VU1GEdUPywSw4i1/7t0Wv9uT9Q2ktHp2rqVo3xkC9IVIpL7EZAxdRviIN2OsOB3g4a/F1ZpjxcAaZeOMUugiAX1+GtkLuE0Xn4neYjCaOghLxQTdhybN70VtnkiQLx/X9NjkDIl/spYGm3tQFMyYKkP6IWoEpj0926hJ0fmlmhy8tAOhlZsb/baW5cgkEZ3E9jVVrySCgQzoLQgma610FIISRpRJbSyv26jU7MkMxiyuBiDaFOORkXFttoKbtQKBgEbDS9II2brsz+vfI7uP8atFcawkE52cx4M1UWQhqb1H3tBiRl+qO+dMq1pPQF2bW7dlZAWYzS4W/367bTAuALHBDGB8xi1P4Njhh9vaOgTvuqrHG9NJQ85BLy0qGw8rjIWSIXVmVpfrXFJ8po5l04UE258Ll2yocv3QRQmddQW9"
 
+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=="
 
@@ -268,16 +318,19 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
               QueueActive -> do
                 ms <- asks msgStore
                 msg <- mkMessage
+                quota <- asks $ msgQueueQuota . config
                 atomically $ do
-                  q <- getMsgQueue ms (recipientId qr)
-                  writeMsg q msg
-                  return ok
+                  q <- getMsgQueue ms (recipientId qr) quota
+                  isFull q >>= \case
+                    False -> writeMsg q msg $> ok
+                    True -> pure $ err QUOTA
 
         deliverMessage :: (MsgQueue -> STM (Maybe Message)) -> RecipientId -> Sub -> m Transmission
         deliverMessage tryPeek rId = \case
           Sub {subThread = NoSub} -> do
             ms <- asks msgStore
-            q <- atomically $ getMsgQueue ms rId
+            quota <- asks $ msgQueueQuota . config
+            q <- atomically $ getMsgQueue ms rId quota
             atomically (tryPeek q) >>= \case
               Nothing -> forkSub q $> ok
               Just msg -> atomically setDelivered $> mkResp corrId rId (msgCmd msg)
@@ -294,7 +347,7 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
             subscriber :: MsgQueue -> m ()
             subscriber q = atomically $ do
               msg <- peekMsg q
-              writeTBQueue sndQ $ mkResp (CorrId B.empty) rId (msgCmd msg)
+              writeTBQueue sndQ $ mkResp (CorrId "") rId (msgCmd msg)
               setSub (\s -> s {subThread = NoSub})
               void setDelivered
 

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

@@ -6,6 +6,7 @@
 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.Map.Strict (Map)
@@ -18,15 +19,19 @@ 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 System.IO (IOMode (..))
 import UnliftIO.STM
 
 data ServerConfig = ServerConfig
-  { tcpPort :: ServiceName,
+  { transports :: [(ServiceName, ATransport)],
     tbqSize :: Natural,
+    serverTbqSize :: Natural,
+    msgQueueQuota :: Natural,
     queueIdBytes :: Int,
     msgIdBytes :: Int,
     storeLog :: Maybe (StoreLog 'ReadMode),
+    blockSize :: Int,
     serverPrivateKey :: C.FullPrivateKey
     -- serverId :: ByteString
   }
@@ -43,13 +48,16 @@ data Env = Env
 
 data Server = Server
   { subscribedQ :: TBQueue (RecipientId, Client),
-    subscribers :: TVar (Map RecipientId Client)
+    subscribers :: TVar (Map RecipientId Client),
+    nextClientId :: TVar Natural
   }
 
 data Client = Client
   { subscriptions :: TVar (Map RecipientId Sub),
     rcvQ :: TBQueue Transmission,
-    sndQ :: TBQueue Transmission
+    sndQ :: TBQueue Transmission,
+    clientId :: Natural,
+    connected :: TVar Bool
   }
 
 data SubscriptionThread = NoSub | SubPending | SubThread ThreadId
@@ -63,14 +71,17 @@ newServer :: Natural -> STM Server
 newServer qSize = do
   subscribedQ <- newTBQueue qSize
   subscribers <- newTVar M.empty
-  return Server {subscribedQ, subscribers}
+  nextClientId <- newTVar 0
+  return Server {subscribedQ, subscribers, nextClientId}
 
-newClient :: Natural -> STM Client
-newClient qSize = do
+newClient :: Server -> Natural -> STM Client
+newClient Server {nextClientId} qSize = do
   subscriptions <- newTVar M.empty
   rcvQ <- newTBQueue qSize
   sndQ <- newTBQueue qSize
-  return Client {subscriptions, rcvQ, sndQ}
+  clientId <- stateTVar nextClientId $ \i -> (i, i + 1)
+  connected <- newTVar True
+  return Client {subscriptions, rcvQ, sndQ, clientId, connected}
 
 newSubscription :: STM Sub
 newSubscription = do
@@ -79,13 +90,13 @@ newSubscription = do
 
 newEnv :: forall m. (MonadUnliftIO m, MonadRandom m) => ServerConfig -> m Env
 newEnv config = do
-  server <- atomically $ newServer (tbqSize config)
+  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)
+      serverKeyPair = (C.publicKey' pk, pk)
   return Env {config, server, queueStore, msgStore, idsDrg, serverKeyPair, storeLog = s'}
   where
     restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)

src/Simplex/Messaging/Server/MsgStore.hs

@@ -3,6 +3,7 @@
 module Simplex.Messaging.Server.MsgStore where
 
 import Data.Time.Clock
+import Numeric.Natural
 import Simplex.Messaging.Protocol (Encoded, MsgBody, RecipientId)
 
 data Message = Message
@@ -12,10 +13,11 @@ data Message = Message
   }
 
 class MonadMsgStore s q m | s -> q where
-  getMsgQueue :: s -> RecipientId -> m q
+  getMsgQueue :: s -> RecipientId -> Natural -> m q
   delMsgQueue :: s -> RecipientId -> m ()
 
 class MonadMsgQueue q m where
+  isFull :: q -> m Bool
   writeMsg :: q -> Message -> m () -- non blocking
   tryPeekMsg :: q -> m (Maybe Message) -- non blocking
   peekMsg :: q -> m Message -- blocking

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

@@ -8,11 +8,12 @@ module Simplex.Messaging.Server.MsgStore.STM where
 
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Numeric.Natural
 import Simplex.Messaging.Protocol (RecipientId)
 import Simplex.Messaging.Server.MsgStore
 import UnliftIO.STM
 
-newtype MsgQueue = MsgQueue {msgQueue :: TQueue Message}
+newtype MsgQueue = MsgQueue {msgQueue :: TBQueue Message}
 
 newtype MsgStoreData = MsgStoreData {messages :: Map RecipientId MsgQueue}
 
@@ -22,13 +23,13 @@ newMsgStore :: STM STMMsgStore
 newMsgStore = newTVar $ MsgStoreData M.empty
 
 instance MonadMsgStore STMMsgStore MsgQueue STM where
-  getMsgQueue :: STMMsgStore -> RecipientId -> STM MsgQueue
-  getMsgQueue store rId = do
+  getMsgQueue :: STMMsgStore -> RecipientId -> Natural -> STM MsgQueue
+  getMsgQueue store rId quota = do
     m <- messages <$> readTVar store
     maybe (newQ m) return $ M.lookup rId m
     where
       newQ m' = do
-        q <- MsgQueue <$> newTQueue
+        q <- MsgQueue <$> newTBQueue quota
         writeTVar store . MsgStoreData $ M.insert rId q m'
         return q
 
@@ -37,15 +38,18 @@ instance MonadMsgStore STMMsgStore MsgQueue STM where
     modifyTVar store $ MsgStoreData . M.delete rId . messages
 
 instance MonadMsgQueue MsgQueue STM where
+  isFull :: MsgQueue -> STM Bool
+  isFull = isFullTBQueue . msgQueue
+
   writeMsg :: MsgQueue -> Message -> STM ()
-  writeMsg = writeTQueue . msgQueue
+  writeMsg = writeTBQueue . msgQueue
 
   tryPeekMsg :: MsgQueue -> STM (Maybe Message)
-  tryPeekMsg = tryPeekTQueue . msgQueue
+  tryPeekMsg = tryPeekTBQueue . msgQueue
 
   peekMsg :: MsgQueue -> STM Message
-  peekMsg = peekTQueue . msgQueue
+  peekMsg = peekTBQueue . msgQueue
 
   -- atomic delete (== read) last and peek next message if available
   tryDelPeekMsg :: MsgQueue -> STM (Maybe Message)
-  tryDelPeekMsg (MsgQueue q) = tryReadTQueue q >> tryPeekTQueue q
+  tryDelPeekMsg (MsgQueue q) = tryReadTBQueue q >> tryPeekTBQueue q

src/Simplex/Messaging/Server/StoreLog.hs

@@ -10,6 +10,7 @@ module Simplex.Messaging.Server.StoreLog
   ( StoreLog, -- constructors are not exported
     openWriteStoreLog,
     openReadStoreLog,
+    storeLogFilePath,
     closeStoreLog,
     logCreateQueue,
     logSecureQueue,
@@ -88,6 +89,11 @@ openReadStoreLog f = do
   doesFileExist f >>= (`unless` writeFile f "")
   ReadStoreLog f <$> openFile f ReadMode
 
+storeLogFilePath :: StoreLog a -> FilePath
+storeLogFilePath = \case
+  WriteStoreLog f _ -> f
+  ReadStoreLog f _ -> f
+
 closeStoreLog :: StoreLog a -> IO ()
 closeStoreLog = \case
   WriteStoreLog _ h -> hClose h

src/Simplex/Messaging/Transport.hs

@@ -9,8 +9,48 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
-module Simplex.Messaging.Transport where
+-- |
+-- Module      : Simplex.Messaging.Transport
+-- Copyright   : (c) simplex.chat
+-- License     : AGPL-3
+--
+-- Maintainer  : chat@simplex.chat
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- This module defines basic TCP server and client and SMP protocol encrypted transport over TCP.
+--
+-- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
+module Simplex.Messaging.Transport
+  ( -- * Transport connection class
+    Transport (..),
+    TProxy (..),
+    ATransport (..),
+
+    -- * Transport over TCP
+    runTransportServer,
+    runTransportClient,
+
+    -- * TCP transport
+    TCP (..),
+
+    -- * SMP encrypted transport
+    THandle (..),
+    TransportError (..),
+    serverHandshake,
+    clientHandshake,
+    tPutEncrypted,
+    tGetEncrypted,
+    serializeTransportError,
+    transportErrorP,
+    currentSMPVersionStr,
+
+    -- * Trim trailing CR
+    trimCR,
+  )
+where
 
 import Control.Applicative ((<|>))
 import Control.Monad.Except
@@ -24,8 +64,10 @@ import Data.ByteArray (xor)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 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 (..))
@@ -34,7 +76,7 @@ import Generic.Random (genericArbitraryU)
 import Network.Socket
 import Network.Transport.Internal (decodeNum16, decodeNum32, encodeEnum16, encodeEnum32, encodeWord32)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Parsers (parse, parseAll, parseRead1)
+import Simplex.Messaging.Parsers (parse, parseAll, parseRead1, parseString)
 import Simplex.Messaging.Util (bshow, liftError)
 import System.IO
 import System.IO.Error
@@ -42,17 +84,53 @@ import Test.QuickCheck (Arbitrary (..))
 import UnliftIO.Concurrent
 import UnliftIO.Exception (Exception, IOException)
 import qualified UnliftIO.Exception as E
-import qualified UnliftIO.IO as IO
 import UnliftIO.STM
 
--- * TCP transport
+-- * Transport connection class
 
-runTCPServer :: MonadUnliftIO m => TMVar Bool -> ServiceName -> (Handle -> m ()) -> m ()
-runTCPServer started port server = do
+class Transport c where
+  transport :: ATransport
+  transport = ATransport (TProxy @c)
+
+  transportName :: TProxy c -> String
+
+  -- | Upgrade client socket to connection (used in the server)
+  getServerConnection :: Socket -> IO c
+
+  -- | Upgrade server socket to connection (used in the client)
+  getClientConnection :: Socket -> IO c
+
+  -- | Close connection
+  closeConnection :: c -> IO ()
+
+  -- | Read fixed number of bytes from connection
+  cGet :: c -> Int -> IO ByteString
+
+  -- | Write bytes to connection
+  cPut :: c -> ByteString -> IO ()
+
+  -- | Receive ByteString from connection, allowing LF or CRLF termination.
+  getLn :: c -> IO ByteString
+
+  -- | Send ByteString to connection terminating it with CRLF.
+  putLn :: c -> ByteString -> IO ()
+  putLn c = cPut c . (<> "\r\n")
+
+data TProxy c = TProxy
+
+data ATransport = forall c. Transport c => ATransport (TProxy c)
+
+-- * Transport over TCP
+
+-- | 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
-    h <- liftIO $ acceptTCPConn sock
-    tid <- forkFinally (server h) (const $ IO.hClose h)
+    c <- liftIO $ acceptConnection sock
+    tid <- forkFinally (server c) (const $ liftIO $ closeConnection c)
     atomically . modifyTVar clients $ S.insert tid
   where
     closeServer :: TVar (Set ThreadId) -> Socket -> IO ()
@@ -60,6 +138,8 @@ runTCPServer started port server = do
       readTVarIO clients >>= mapM_ killThread
       close sock
       void . atomically $ tryPutTMVar started False
+    acceptConnection :: Transport c => Socket -> IO c
+    acceptConnection sock = accept sock >>= getServerConnection . fst
 
 startTCPServer :: TMVar Bool -> ServiceName -> IO Socket
 startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
@@ -74,17 +154,15 @@ startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
       bind sock $ addrAddress addr
       listen sock 1024
       return sock
-    setStarted sock = atomically (putTMVar started True) >> pure sock
+    setStarted sock = atomically (tryPutTMVar started True) >> pure sock
 
-acceptTCPConn :: Socket -> IO Handle
-acceptTCPConn sock = accept sock >>= getSocketHandle . fst
+-- | 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)
 
-runTCPClient :: MonadUnliftIO m => HostName -> ServiceName -> (Handle -> m a) -> m a
-runTCPClient host port client = do
-  h <- liftIO $ startTCPClient host port
-  client h `E.finally` IO.hClose h
-
-startTCPClient :: HostName -> ServiceName -> IO Handle
+startTCPClient :: forall c. Transport c => HostName -> ServiceName -> IO c
 startTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
   where
     err :: IOException
@@ -95,16 +173,29 @@ startTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
       let hints = defaultHints {addrSocketType = Stream}
        in getAddrInfo (Just hints) (Just host) (Just port)
 
-    tryOpen :: IOException -> [AddrInfo] -> IO Handle
+    tryOpen :: IOException -> [AddrInfo] -> IO c
     tryOpen e [] = E.throwIO e
     tryOpen _ (addr : as) =
       E.try (open addr) >>= either (`tryOpen` as) pure
 
-    open :: AddrInfo -> IO Handle
+    open :: AddrInfo -> IO c
     open addr = do
       sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
       connect sock $ addrAddress addr
-      getSocketHandle sock
+      getClientConnection sock
+
+-- * 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
@@ -114,26 +205,27 @@ getSocketHandle conn = do
   hSetBuffering h LineBuffering
   return h
 
-putLn :: Handle -> ByteString -> IO ()
-putLn h = B.hPut h . (<> "\r\n")
-
-getLn :: Handle -> IO ByteString
-getLn h = trimCR <$> B.hGetLine h
-
+-- | Trim trailing CR from ByteString.
 trimCR :: ByteString -> ByteString
 trimCR "" = ""
 trimCR s = if B.last s == '\r' then B.init s else s
 
--- * Encrypted transport
+-- * 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 = SMPVersion 0 3 0 0
+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]
@@ -143,8 +235,9 @@ smpVersionP =
   let ver = A.decimal <* A.char '.'
    in SMPVersion <$> ver <*> ver <*> ver <*> A.decimal
 
-data THandle = THandle
-  { handle :: Handle,
+-- | The handle for SMP encrypted transport connection over Transport .
+data THandle c = THandle
+  { connection :: c,
     sndKey :: SessionKey,
     rcvKey :: SessionKey,
     blockSize :: Int
@@ -162,29 +255,45 @@ data ClientHandshake = ClientHandshake
     rcvKey :: SessionKey
   }
 
+-- | Error of SMP encrypted transport over TCP.
 data TransportError
-  = TEBadBlock
-  | TEEncrypt
-  | TEDecrypt
-  | TEHandshake HandshakeError
+  = -- | error parsing transport block
+    TEBadBlock
+  | -- | block encryption error
+    TEEncrypt
+  | -- | block decryption error
+    TEDecrypt
+  | -- | transport handshake error
+    TEHandshake HandshakeError
   deriving (Eq, Generic, Read, Show, Exception)
 
+-- | Transport handshake error.
 data HandshakeError
-  = ENCRYPT
-  | DECRYPT
-  | VERSION
-  | RSA_KEY
-  | HEADER
-  | AES_KEYS
-  | BAD_HASH
-  | MAJOR_VERSION
-  | TERMINATED
+  = -- | encryption error
+    ENCRYPT
+  | -- | decryption error
+    DECRYPT
+  | -- | error parsing protocol 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
   deriving (Eq, Generic, Read, Show, Exception)
 
 instance Arbitrary TransportError where arbitrary = genericArbitraryU
 
 instance Arbitrary HandshakeError where arbitrary = genericArbitraryU
 
+-- | SMP encrypted transport error parser.
 transportErrorP :: Parser TransportError
 transportErrorP =
   "BLOCK" $> TEBadBlock
@@ -192,6 +301,7 @@ transportErrorP =
     <|> "AES_DECRYPT" $> TEDecrypt
     <|> TEHandshake <$> parseRead1
 
+-- | Serialize SMP encrypted transport error.
 serializeTransportError :: TransportError -> ByteString
 serializeTransportError = \case
   TEEncrypt -> "AES_ENCRYPT"
@@ -199,15 +309,17 @@ serializeTransportError = \case
   TEBadBlock -> "BLOCK"
   TEHandshake e -> bshow e
 
-tPutEncrypted :: THandle -> ByteString -> IO (Either TransportError ())
-tPutEncrypted THandle {handle = h, sndKey, blockSize} block =
+-- | 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 <$> B.hPut h (C.authTagToBS authTag <> msg)
+    Right (authTag, msg) -> Right <$> cPut c (C.authTagToBS authTag <> msg)
 
-tGetEncrypted :: THandle -> IO (Either TransportError ByteString)
-tGetEncrypted THandle {handle = h, rcvKey, blockSize} =
-  B.hGet h blockSize >>= decryptBlock rcvKey >>= \case
+-- | 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
@@ -232,55 +344,62 @@ makeNextIV SessionKey {baseIV, counter} = atomically $ do
     (start, rest) = B.splitAt 4 $ C.unIV baseIV
     iv c = C.IV $ (start `xor` encodeWord32 c) <> rest
 
--- | implements server transport handshake as per /rfcs/2021-01-26-crypto.md#transport-encryption
--- The numbers in function names refer to the steps in the document
-serverHandshake :: Handle -> C.FullKeyPair -> ExceptT TransportError IO THandle
-serverHandshake h (k, pk) = do
+-- | Server SMP encrypted 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
-  -- TODO server currently ignores blockSize returned by the client
-  -- this is reserved for future support of streams
-  ClientHandshake {blockSize = _, sndKey, rcvKey} <- decryptParseKeys_5 encryptedKeys
-  th <- liftIO $ transportHandle h rcvKey sndKey transportBlockSize -- keys are swapped here
+  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 = transportBlockSize, keySize = B.length sKey}
-      B.hPut h $ binaryServerHeader header <> sKey
+          header = ServerHeader {blockSize = srvBlockSize, keySize = B.length sKey}
+      cPut c $ binaryServerHeader header
+      cPut c sKey
     receiveEncryptedKeys_4 :: ExceptT TransportError IO ByteString
     receiveEncryptedKeys_4 =
-      liftIO (B.hGet h $ C.publicKeySize k) >>= \case
+      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 -> ExceptT TransportError IO ()
-    sendWelcome_6 th = ExceptT . tPutEncrypted th $ serializeSMPVersion currentSMPVersion <> " "
+    sendWelcome_6 :: THandle c -> ExceptT TransportError IO ()
+    sendWelcome_6 th = ExceptT . tPutEncrypted th $ currentSMPVersionStr <> " "
 
--- | implements client transport handshake as per /rfcs/2021-01-26-crypto.md#transport-encryption
--- The numbers in function names refer to the steps in the document
-clientHandshake :: Handle -> Maybe C.KeyHash -> ExceptT TransportError IO THandle
-clientHandshake h keyHash = do
+-- | Client SMP encrypted 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
-  -- TODO currently client always uses the blkSize returned by the server
-  keys@ClientHandshake {sndKey, rcvKey} <- liftIO $ generateKeys_3 blkSize
-  sendEncryptedKeys_4 k keys
-  th <- liftIO $ transportHandle h sndKey rcvKey blkSize
+  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 (B.hGet h serverHeaderSize)
+      header <- liftIO (cGet c serverHeaderSize)
       ServerHeader {blockSize, keySize} <- liftEither $ parse serverHeaderP (TEHandshake HEADER) header
-      when (blockSize < transportBlockSize || blockSize > maxTransportBlockSize) $
-        throwError $ TEHandshake HEADER
-      s <- liftIO $ B.hGet h keySize
+      checkValidBlockSize blockSize
+      s <- liftIO $ cGet c keySize
       maybe (pure ()) (validateKeyHash_2 s) keyHash
       key <- liftEither $ parseKey s
       pure (key, blockSize)
@@ -298,10 +417,10 @@ clientHandshake h keyHash = do
       baseIV <- C.randomIV
       pure SessionKey {aesKey, baseIV, counter = undefined}
     sendEncryptedKeys_4 :: C.PublicKey -> ClientHandshake -> ExceptT TransportError IO ()
-    sendEncryptedKeys_4 k keys =
-      liftError (const $ TEHandshake ENCRYPT) (C.encryptOAEP k $ serializeClientHandshake keys)
-        >>= liftIO . B.hPut h
-    getWelcome_6 :: THandle -> ExceptT TransportError IO SMPVersion
+    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)
@@ -310,17 +429,18 @@ clientHandshake h keyHash = do
       when (major smpVersion > major currentSMPVersion) . throwE $
         TEHandshake MAJOR_VERSION
 
+checkValidBlockSize :: Int -> ExceptT TransportError IO ()
+checkValidBlockSize blkSize =
+  when (blkSize `notElem` transportBlockSizes) . throwError $ TEHandshake HEADER
+
 data ServerHeader = ServerHeader {blockSize :: Int, keySize :: Int}
   deriving (Eq, Show)
 
 binaryRsaTransport :: Int
 binaryRsaTransport = 0
 
-transportBlockSize :: Int
-transportBlockSize = 4096
-
-maxTransportBlockSize :: Int
-maxTransportBlockSize = 65536
+transportBlockSizes :: [Int]
+transportBlockSizes = map (* 1024) [4, 8, 16, 32, 64]
 
 serverHeaderSize :: Int
 serverHeaderSize = 8
@@ -365,13 +485,13 @@ binaryRsaTransportP = binaryRsa =<< int16
 parseClientHandshake :: ByteString -> Either TransportError ClientHandshake
 parseClientHandshake = parse clientHandshakeP $ TEHandshake AES_KEYS
 
-transportHandle :: Handle -> SessionKey -> SessionKey -> Int -> IO THandle
-transportHandle h sk rk blockSize = do
+transportHandle :: c -> SessionKey -> SessionKey -> Int -> IO (THandle c)
+transportHandle c sk rk blockSize = do
   sndCounter <- newTVarIO 0
   rcvCounter <- newTVarIO 0
   pure
     THandle
-      { handle = h,
+      { connection = c,
         sndKey = sk {counter = sndCounter},
         rcvKey = rk {counter = rcvCounter},
         blockSize

src/Simplex/Messaging/Transport/WebSockets.hs

@@ -0,0 +1,62 @@
+{-# LANGUAGE InstanceSigs #-}
+
+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 Network.WebSockets
+import Network.WebSockets.Stream (Stream)
+import qualified Network.WebSockets.Stream as S
+import Simplex.Messaging.Transport (TProxy, Transport (..), TransportError (..), trimCR)
+
+data WS = WS {wsStream :: Stream, wsConnection :: Connection}
+
+websocketsOpts :: ConnectionOptions
+websocketsOpts =
+  defaultConnectionOptions
+    { connectionCompressionOptions = NoCompression,
+      connectionFramePayloadSizeLimit = SizeLimit 8192,
+      connectionMessageDataSizeLimit = SizeLimit 65536
+    }
+
+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
+
+  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 []
+
+  closeConnection :: WS -> IO ()
+  closeConnection = S.close . wsStream
+
+  cGet :: WS -> Int -> IO ByteString
+  cGet c n = do
+    s <- receiveData (wsConnection c)
+    if B.length s == n
+      then pure s
+      else E.throwIO TEBadBlock
+
+  cPut :: WS -> ByteString -> IO ()
+  cPut = sendBinaryData . wsConnection
+
+  getLn :: WS -> IO ByteString
+  getLn c = do
+    s <- trimCR <$> receiveData (wsConnection c)
+    if B.null s || B.last s /= '\n'
+      then E.throwIO TEBadBlock
+      else pure $ B.init s

src/Simplex/Messaging/Util.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE RankNTypes #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -10,20 +9,6 @@ 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 []
@@ -50,3 +35,14 @@ liftError f = liftEitherError f . runExceptT
 
 liftEitherError :: (MonadIO m, MonadError e' m) => (e -> e') -> IO (Either e a) -> m a
 liftEitherError f a = liftIOEither (first f <$> a)
+
+tryError :: MonadError e m => m a -> m (Either e a)
+tryError action = (Right <$> action) `catchError` (pure . Left)
+
+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/errors.md

@@ -1,99 +0,0 @@
-# Errors
-
-## Problems
-
-- using numbers and strings to indicate errors (in protocol and in code) - ErrorType, AgentErrorType, TransportError
-- re-using the same type in multiple contexts (with some constructors not applicable to all contexts) - ErrorType
-
-## Error types
-
-### ErrorType (Protocol.hs)
-
-- BLOCK - incorrect block format, encoding or signature size
-- CMD error - command is unknown or has invalid syntax, where `error` can be:
-  - PROHIBITED - server response sent from client or vice versa
-  - KEY_SIZE - bad RSA key size in NEW or KEY commands (only 1024, 2048 and 4096 bits keys are allowed)
-  - SYNTAX - error parsing command
-  - NO_AUTH - transmission has no required credentials (signature or queue ID)
-  - HAS_AUTH - transmission has not allowed credentials
-  - NO_QUEUE - transmission has not queue ID
-- AUTH - command is not authorised (queue does not exist or signature verification failed).
-- NO_MSG - acknowledging (ACK) the message without message
-- INTERNAL - internal server error.
-- DUPLICATE_ - it is used internally to signal that the queue ID is already used. This is NOT used in the protocol, instead INTERNAL is sent to the client. It has to be removed.
-
-### AgentErrorType (Agent/Transmission.hs)
-
-Some of these errors are not correctly serialized/parsed - see line 322 in Agent/Transmission.hs
-
-- CMD e - command or response error
-  - PROHIBITED - server response sent as client command (and vice versa)
-  - SYNTAX - command is unknown or has invalid syntax.
-  - NO_CONN - connection is required in the command (and absent)
-  - SIZE - incorrect message size of messages (when parsing SEND and MSG)
-  - LARGE -- message does not fit SMP block
-- CONN e - connection errors
-  - UNKNOWN - connection alias not in database
-  - DUPLICATE - connection alias already exists
-  - SIMPLEX - connection is simplex, but operation requires another queue
-- SMP ErrorType - forwarding SMP errors (SMPServerError) to the agent client
-- BROKER e - SMP server errors
-  - RESPONSE ErrorType - invalid SMP server response
-  - UNEXPECTED - unexpected response
-  - NETWORK - network TCP connection error
-  - TRANSPORT TransportError -- handshake or other transport error
-  - TIMEOUT - command response timeout
-- AGENT e - errors of other agents
-  - A_MESSAGE - SMP message failed to parse
-  - A_PROHIBITED - SMP message is prohibited with the current queue status
-  - A_ENCRYPTION - cannot RSA/AES-decrypt or parse decrypted header
-  - A_SIGNATURE - invalid RSA signature
-- INTERNAL ByteString - agent implementation or dependency error
-
-### SMPClientError (Client.hs)
-
-- SMPServerError ErrorType - this is correctly parsed server ERR response. This error is forwarded to the agent client as `ERR SMP err`
-- SMPResponseError ErrorType - this is invalid server response that failed to parse - forwarded to the client as `ERR BROKER RESPONSE`.
-- SMPUnexpectedResponse - different response from what is expected to a given command, e.g. server should respond `IDS` or `ERR` to `NEW` command, other responses would result in this error - forwarded to the client as `ERR BROKER UNEXPECTED`.
-- SMPResponseTimeout - used for TCP connection and command response timeouts -> `ERR BROKER TIMEOUT`.
-- SMPNetworkError - fails to establish TCP connection -> `ERR BROKER NETWORK`
-- SMPTransportError e - fails connection handshake or some other transport error -> `ERR BROKER TRANSPORT e`
-- SMPSignatureError C.CryptoError - error when cryptographically "signing" the command.
-
-### StoreError (Agent/Store.hs)
-
-- SEInternal ByteString - signals exceptions in store actions.
-- SEConnNotFound - connection alias not found (or both queues absent).
-- SEConnDuplicate - connection alias already used.
-- SEBadConnType ConnType - wrong connection type, e.g. "send" connection when "receive" or "duplex" is expected, or vice versa. `updateRcvConnWithSndQueue` and `updateSndConnWithRcvQueue` do not allow duplex connections - they would also return this error.
-- SEBadQueueStatus - the intention was to pass current expected queue status in methods, as we always know what it should be at any stage of the protocol, and in case it does not match use this error. **Currently not used**.
-- SENotImplemented - used in `getMsg` that is not implemented/used.
-
-### CryptoError (Crypto.hs)
-
-- RSAEncryptError R.Error - RSA encryption error
-- RSADecryptError R.Error - RSA decryption error
-- RSASignError R.Error - RSA signature error
-- AESCipherError CE.CryptoError - AES initialization error
-- CryptoIVError - IV generation error
-- AESDecryptError - AES decryption error
-- CryptoLargeMsgError - message does not fit in SMP block
-- CryptoHeaderError String - failure parsing RSA-encrypted message header
-
-### TransportError (Transport.hs)
-
-  - TEBadBlock - error parsing block
-  - TEEncrypt - block encryption error
-  - TEDecrypt - block decryption error
-  - TEHandshake HandshakeError
-
-### HandshakeError (Transport.hs)
-
-  - ENCRYPT - encryption error
-  - DECRYPT - decryption error
-  - VERSION - error parsing protocol version
-  - RSA_KEY - error parsing RSA key
-  - AES_KEYS - error parsing AES keys
-  - BAD_HASH - not matching RSA key hash
-  - MAJOR_VERSION - lower agent version than protocol version
-  - TERMINATED - transport terminated

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-16.17
+resolver: lts-18.21
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -36,9 +36,7 @@ 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

tests/AgentTests.hs

@@ -2,50 +2,81 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PostfixOperators #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
 
-module AgentTests where
+module AgentTests (agentTests) where
 
+import AgentTests.ConnectionRequestTests
+import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.SQLiteTests (storeTests)
 import Control.Concurrent
+import Control.Monad (forM_)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Network.HTTP.Types (urlEncode)
 import SMPAgentClient
-import SMPClient (testKeyHashStr)
-import Simplex.Messaging.Agent.Transmission
+import SMPClient (testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServerStoreLogOn)
+import Simplex.Messaging.Agent.Protocol
+import qualified Simplex.Messaging.Agent.Protocol as A
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
-import System.IO (Handle)
+import Simplex.Messaging.Transport (ATransport (..), TProxy (..), Transport (..))
+import Simplex.Messaging.Util (bshow)
+import System.Directory (removeFile)
 import System.Timeout
 import Test.Hspec
 
-agentTests :: Spec
-agentTests = do
+agentTests :: ATransport -> Spec
+agentTests (ATransport t) = do
+  describe "Connection request" connectionRequestTests
+  describe "Functional API" $ functionalAPITests (ATransport t)
   describe "SQLite store" storeTests
-  describe "SMP agent protocol syntax" syntaxTests
+  describe "SMP agent protocol syntax" $ syntaxTests t
   describe "Establishing duplex connection" do
     it "should connect via one server and one agent" $
-      smpAgentTest2_1 testDuplexConnection
+      smpAgentTest2_1_1 $ testDuplexConnection t
+    it "should connect via one server and one agent (random IDs)" $
+      smpAgentTest2_1_1 $ testDuplexConnRandomIds t
     it "should connect via one server and 2 agents" $
-      smpAgentTest2 testDuplexConnection
+      smpAgentTest2_2_1 $ testDuplexConnection t
+    it "should connect via one server and 2 agents (random IDs)" $
+      smpAgentTest2_2_1 $ testDuplexConnRandomIds t
+    it "should connect via 2 servers and 2 agents" $
+      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
+    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
-    xit "should connect via one server and one agent" $
-      smpAgentTest3_1 testSubscription
+    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
+      smpAgentServerTest $ testSubscrNotification t
+  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
 
--- | simple test for one command with the expected response
-(>#>) :: ARawTransmission -> ARawTransmission -> Expectation
-command >#> response = smpAgentTest command `shouldReturn` response
-
--- | simple test for one command with a predicate for the expected response
-(>#>=) :: ARawTransmission -> ((ByteString, ByteString, [ByteString]) -> Bool) -> Expectation
-command >#>= p = smpAgentTest command >>= (`shouldSatisfy` p . \(cId, cAlias, cmd) -> (cId, cAlias, B.words cmd))
+-- | receive message to handle `h`
+(<#:) :: Transport c => c -> IO (ATransmissionOrError 'Agent)
+(<#:) = tGet SAgent
 
 -- | send transmission `t` to handle `h` and get response
-(#:) :: Handle -> (ByteString, ByteString, ByteString) -> IO (ATransmissionOrError 'Agent)
-h #: t = tPutRaw h t >> tGet SAgent h
+(#:) :: Transport c => c -> (ByteString, ByteString, ByteString) -> IO (ATransmissionOrError 'Agent)
+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`
@@ -63,15 +94,15 @@ correctTransmission (corrId, cAlias, cmdOrErr) = case cmdOrErr of
   Left e -> error $ show e
 
 -- | receive message to handle `h` and validate that it is the expected one
-(<#) :: Handle -> ATransmission 'Agent -> Expectation
-h <# (corrId, cAlias, cmd) = tGet SAgent h `shouldReturn` (corrId, cAlias, Right cmd)
+(<#) :: Transport c => c -> ATransmission 'Agent -> Expectation
+h <# (corrId, cAlias, cmd) = (h <#:) `shouldReturn` (corrId, cAlias, Right cmd)
 
 -- | receive message to handle `h` and validate it using predicate `p`
-(<#=) :: Handle -> (ATransmission 'Agent -> Bool) -> Expectation
-h <#= p = tGet SAgent h >>= (`shouldSatisfy` p . correctTransmission)
+(<#=) :: Transport c => c -> (ATransmission 'Agent -> Bool) -> Expectation
+h <#= p = (h <#:) >>= (`shouldSatisfy` p . correctTransmission)
 
 -- | test that nothing is delivered to handle `h` during 10ms
-(#:#) :: Handle -> String -> Expectation
+(#:#) :: Transport c => c -> String -> Expectation
 h #:# err = tryGet `shouldReturn` ()
   where
     tryGet =
@@ -80,79 +111,328 @@ h #:# err = tryGet `shouldReturn` ()
         _ -> return ()
 
 pattern Msg :: MsgBody -> ACommand 'Agent
-pattern Msg msgBody <- MSG {msgBody, msgIntegrity = MsgOk}
+pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} msgBody
 
-testDuplexConnection :: Handle -> Handle -> IO ()
-testDuplexConnection alice bob = do
-  ("1", "bob", Right (INV qInfo)) <- alice #: ("1", "bob", "NEW localhost:5000")
-  let qInfo' = serializeSmpQueueInfo qInfo
-  bob #: ("11", "alice", "JOIN " <> qInfo') #> ("11", "alice", CON)
+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
+  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 #: ("2", "bob", "SEND :hello") =#> \case ("2", "bob", SENT 1) -> True; _ -> False
-  alice #: ("3", "bob", "SEND :how are you?") =#> \case ("3", "bob", SENT 2) -> True; _ -> False
+  alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 1)
+  alice <# ("", "bob", SENT 1)
   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 <#= \case ("", "alice", Msg "how are you?") -> True; _ -> False
-  bob #: ("14", "alice", "SEND 9\nhello too") =#> \case ("14", "alice", SENT 3) -> 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)
   alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
-  bob #: ("15", "alice", "SEND 9\nmessage 1") =#> \case ("15", "alice", SENT 4) -> 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 <#= \case ("", "bob", Msg "message 1") -> True; _ -> False
+  alice #: ("4a", "bob", "ACK 4") #> ("4a", "bob", OK)
   alice #: ("5", "bob", "OFF") #> ("5", "bob", OK)
-  bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", ERR (SMP AUTH))
+  bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 5)
+  bob <# ("", "alice", MERR 5 (SMP AUTH))
   alice #: ("6", "bob", "DEL") #> ("6", "bob", OK)
   alice #:# "nothing else should be delivered to alice"
 
-testSubscription :: Handle -> Handle -> Handle -> IO ()
-testSubscription alice1 alice2 bob = do
-  ("1", "bob", Right (INV qInfo)) <- alice1 #: ("1", "bob", "NEW localhost:5000")
-  let qInfo' = serializeSmpQueueInfo qInfo
-  bob #: ("11", "alice", "JOIN " <> qInfo') #> ("11", "alice", CON)
-  bob #: ("12", "alice", "SEND 5\nhello") =#> \case ("12", "alice", SENT _) -> True; _ -> False
-  bob #: ("13", "alice", "SEND 11\nhello again") =#> \case ("13", "alice", SENT _) -> True; _ -> False
-  alice1 <# ("", "bob", CON)
+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
+  ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo")
+  ("", bobConn', Right (CONF confId "bob's connInfo")) <- (alice <#:)
+  bobConn' `shouldBe` bobConn
+  alice #: ("2", bobConn, "LET " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False
+  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)
+  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 <#= \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)
+  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 <#= \case ("", c, Msg "message 1") -> c == bobConn; _ -> False
+  alice #: ("4a", bobConn, "ACK 4") #> ("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))
+  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
+
+  bob #: ("11", "alice", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice", OK)
+  ("", "alice_contact", Right (REQ aInvId "bob's connInfo")) <- (alice <#:)
+  alice #: ("2", "bob", "ACPT " <> aInvId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
+  ("", "alice", Right (CONF bConfId "alice's connInfo")) <- (bob <#:)
+  bob #: ("12", "alice", "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", "alice", OK)
+  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)
+  bob <#= \case ("", "alice", Msg "hi") -> True; _ -> False
+  bob #: ("13", "alice", "ACK 1") #> ("13", "alice", OK)
+
+  tom #: ("21", "alice", "JOIN " <> cReq' <> " 14\ntom's connInfo") #> ("21", "alice", OK)
+  ("", "alice_contact", Right (REQ aInvId' "tom's connInfo")) <- (alice <#:)
+  alice #: ("4", "tom", "ACPT " <> aInvId' <> " 16\nalice's connInfo") #> ("4", "tom", OK)
+  ("", "alice", Right (CONF tConfId "alice's connInfo")) <- (tom <#:)
+  tom #: ("22", "alice", "LET " <> tConfId <> " 16\ntom's connInfo 2") #> ("22", "alice", OK)
+  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)
+  tom <#= \case ("", "alice", Msg "hi there") -> True; _ -> False
+  tom #: ("23", "alice", "ACK 1") #> ("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
+
+  ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo")
+  ("", aliceContact', Right (REQ aInvId "bob's connInfo")) <- (alice <#:)
+  aliceContact' `shouldBe` aliceContact
+
+  ("2", bobConn, Right OK) <- alice #: ("2", "", "ACPT " <> aInvId <> " 16\nalice's connInfo")
+  ("", aliceConn', Right (CONF bConfId "alice's connInfo")) <- (bob <#:)
+  aliceConn' `shouldBe` aliceConn
+
+  bob #: ("12", aliceConn, "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", aliceConn, OK)
+  alice <# ("", bobConn, INFO "bob's connInfo 2")
+  alice <# ("", bobConn, CON)
+  bob <# ("", aliceConn, CON)
+
+  alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 1)
+  alice <# ("", bobConn, SENT 1)
+  bob <#= \case ("", c, Msg "hi") -> c == aliceConn; _ -> False
+  bob #: ("13", aliceConn, "ACK 1") #> ("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
+  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
+  alice #: ("2a", "bob", "RJCT " <> aInvId) #> ("2a", "bob", ERR $ CONN NOT_FOUND)
+  alice #: ("2b", "a_contact", "RJCT " <> aInvId) #> ("2b", "a_contact", OK)
+  alice #: ("3", "bob", "ACPT " <> aInvId <> " 12\nalice's info") #> ("3", "bob", ERR $ A.CMD PROHIBITED)
+  bob #:# "nothing should be delivered to bob"
+
+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)
   alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False
-  -- alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
-  t <- tGet SAgent alice1
-  print t
-  t `shouldSatisfy` (\case ("", "bob", Msg "hello again") -> True; _ -> False) . correctTransmission
+  alice1 #: ("1", "bob", "ACK 1") #> ("1", "bob", OK)
+  bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 2)
+  bob <# ("", "alice", SENT 2)
+  alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
+  alice1 #: ("2", "bob", "ACK 2") #> ("2", "bob", OK)
   alice2 #: ("21", "bob", "SUB") #> ("21", "bob", OK)
   alice1 <# ("", "bob", END)
-  bob #: ("14", "alice", "SEND 2\nhi") =#> \case ("14", "alice", SENT _) -> True; _ -> False
+  bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 3)
+  bob <# ("", "alice", SENT 3)
   alice2 <#= \case ("", "bob", Msg "hi") -> True; _ -> False
+  alice2 #: ("22", "bob", "ACK 3") #> ("22", "bob", OK)
   alice1 #:# "nothing else should be delivered to alice1"
 
-testSubscrNotification :: (ThreadId, ThreadId) -> Handle -> IO ()
-testSubscrNotification (server, _) client = do
-  client #: ("1", "conn1", "NEW localhost:5000") =#> \case ("1", "conn1", INV _) -> True; _ -> False
+testSubscrNotification :: Transport c => TProxy c -> (ThreadId, ThreadId) -> c -> IO ()
+testSubscrNotification t (server, _) client = do
+  client #: ("1", "conn1", "NEW INV") =#> \case ("1", "conn1", INV {}) -> True; _ -> False
   client #:# "nothing should be delivered to client before the server is killed"
   killThread server
-  client <# ("", "conn1", END)
+  client <# ("", "conn1", DOWN)
+  withSmpServer (ATransport t) $
+    client <# ("", "conn1", ERR (SMP AUTH)) -- this new server does not have the queue
+
+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)
+    alice <#= \case ("", "bob", Msg "hi") -> True; _ -> False
+    alice #: ("11", "bob", "ACK 1") #> ("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 #:# "nothing else delivered before the server is restarted"
+  alice #:# "nothing else delivered before the server is restarted"
+
+  withServer $ do
+    bob <# ("", "alice", SENT 2)
+    alice <# ("", "bob", UP)
+    alice <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
+    alice #: ("12", "bob", "ACK 2") #> ("12", "bob", OK)
+
+  removeFile testStoreLogFile
+  where
+    withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` ()
+
+testMsgDeliveryAgentRestart :: Transport c => TProxy c -> c -> IO ()
+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)
+      bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
+      bob #: ("11", "alice", "ACK 1") #> ("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 #:# "nothing else delivered before the server is restarted"
+    bob #:# "nothing else delivered before the server is restarted"
+
+  withAgent $ \alice -> do
+    withServer $ do
+      tPutRaw alice ("3", "bob", "SUB")
+      alice <#= \case
+        (corrId, "bob", cmd) ->
+          (corrId == "3" && cmd == OK)
+            || (corrId == "" && cmd == SENT 2)
+        _ -> False
+      bob <# ("", "alice", UP)
+      bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False
+      bob #: ("12", "alice", "ACK 2") #> ("12", "alice", OK)
+
+  removeFile testStoreLogFile
+  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' = serializeConnReq 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 2)
+  bob <# ("", "alice", SENT 2)
+  -- if delivery is blocked it won't go further
+  alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
+  alice #: ("3", "bob", "ACK 2") #> ("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 1)
+  -- if delivery is blocked it won't go further
+  alice <# ("", "bob2", SENT 1)
+
+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
+  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)
+  h2 <# ("", name1, INFO "info1")
+  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
+--   ("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
+--   h2 <# ("", conn1, INFO "info1")
+--   h2 <# ("", conn1, CON)
+--   h1 <# ("", conn2, CON)
+--   pure (conn1, conn2)
 
 samplePublicKey :: ByteString
-samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"
+samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj-toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP-Tm4sokaFDTIG3QJFzOjC-_9nW4MUjAOFll9PCp9kaEFHJ_YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju_f6kAayvYKW3_lbJNXCmyinAccBosO08_0sUxvtuniIo18kfYJE0UmP1ReCjhMP-O-yOmwZJini_QelJk_Pez8IIDDWnY1qYQsN_q7ocjakOYrpGG7mig6JMFpDJtD6istR"
 
-syntaxTests :: Spec
-syntaxTests = do
+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: ERROR no connection alias in the response (it does not generate it yet if not provided)
       -- TODO: add tests with defined connection alias
-      xit "only server" $ ("211", "", "NEW localhost") >#>= \case ("211", "", "INV" : _) -> True; _ -> False
-      it "with port" $ ("212", "", "NEW localhost:5000") >#>= \case ("212", "", "INV" : _) -> True; _ -> False
-      xit "with keyHash" $ ("213", "", "NEW localhost#" <> testKeyHashStr) >#>= \case ("213", "", "INV" : _) -> True; _ -> False
-      it "with port and keyHash" $ ("214", "", "NEW localhost:5000#" <> testKeyHashStr) >#>= \case ("214", "", "INV" : _) -> True; _ -> False
+      it "with correct parameter" $ ("211", "", "NEW INV") >#>= \case ("211", _, "INV" : _) -> True; _ -> False
     describe "invalid" do
       -- TODO: add tests with defined connection alias
-      it "no parameters" $ ("221", "", "NEW") >#> ("221", "", "ERR CMD SYNTAX")
-      it "many parameters" $ ("222", "", "NEW localhost:5000 hi") >#> ("222", "", "ERR CMD SYNTAX")
-      it "invalid server keyHash" $ ("223", "", "NEW localhost:5000#1") >#> ("223", "", "ERR CMD SYNTAX")
+      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
       it "using same server as in invitation" $
-        ("311", "", "JOIN smp::localhost:5000::1234::" <> samplePublicKey) >#> ("311", "", "ERR SMP AUTH")
+        ("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
       it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX")
+  where
+    -- simple test for one command with the expected response
+    (>#>) :: ARawTransmission -> ARawTransmission -> Expectation
+    command >#> response = smpAgentTest t command `shouldReturn` response
+
+    -- 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))

tests/AgentTests/ConnectionRequestTests.hs

@@ -0,0 +1,68 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module AgentTests.ConnectionRequestTests where
+
+import Simplex.Messaging.Agent.Protocol
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Parsers (parseAll)
+import Test.Hspec
+
+uri :: String
+uri = "smp.simplex.im"
+
+srv :: SMPServer
+srv =
+  SMPServer
+    { host = "smp.simplex.im",
+      port = Just "5223",
+      keyHash = Just (C.KeyHash "\215m\248\251")
+    }
+
+queue :: SMPQueueUri
+queue =
+  SMPQueueUri
+    { smpServer = srv,
+      senderId = "\215m\248\251",
+      serverVerifyKey = reservedServerKey
+    }
+
+appServer :: ConnReqScheme
+appServer = CRSAppServer "simplex.chat" Nothing
+
+connectionRequest :: AConnectionRequest
+connectionRequest =
+  ACR SCMInvitation . CRInvitation $
+    ConnReqData
+      { crScheme = appServer,
+        crSmpQueues = [queue],
+        crEncryptKey = reservedServerKey
+      }
+
+connectionRequestTests :: Spec
+connectionRequestTests = do
+  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==#"
+    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==#"
+        `shouldBe` Right queue
+    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"
+    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"
+        `shouldBe` Right connectionRequest

tests/AgentTests/FunctionalAPITests.hs

@@ -0,0 +1,163 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+
+module AgentTests.FunctionalAPITests (functionalAPITests) where
+
+import Control.Monad.Except (ExceptT, runExceptT)
+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.Protocol
+import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
+import Simplex.Messaging.Transport (ATransport (..))
+import System.Timeout
+import Test.Hspec
+import UnliftIO.STM
+
+(##>) :: MonadIO m => m (ATransmission 'Agent) -> ATransmission 'Agent -> m ()
+a ##> t = a >>= \t' -> liftIO (t' `shouldBe` t)
+
+(=##>) :: MonadIO m => m (ATransmission 'Agent) -> (ATransmission 'Agent -> Bool) -> m ()
+a =##> p = a >>= \t -> liftIO (t `shouldSatisfy` p)
+
+get :: MonadIO m => AgentClient -> m (ATransmission 'Agent)
+get c = atomically (readTBQueue $ subQ c)
+
+pattern Msg :: MsgBody -> ACommand 'Agent
+pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} msgBody
+
+functionalAPITests :: ATransport -> Spec
+functionalAPITests t = do
+  describe "Establishing duplex connection" $
+    it "should connect via one server using SMP agent clients" $
+      withSmpServer t testAgentClient
+  describe "Establishing connection asynchronously" $ do
+    it "should connect with initiating client going offline" $
+      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
+
+testAgentClient :: IO ()
+testAgentClient = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  Right () <- runExceptT $ do
+    (bobId, qInfo) <- createConnection alice SCMInvitation
+    aliceId <- joinConnection bob qInfo "bob's connInfo"
+    ("", _, CONF confId "bob's connInfo") <- get alice
+    allowConnection alice bobId confId "alice's connInfo"
+    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)
+    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+    ackMessage bob aliceId 1
+    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)
+    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
+    ackMessage alice bobId 3
+    get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False
+    ackMessage alice bobId 4
+    suspendConnection alice bobId
+    5 <- sendMessage bob aliceId "message 2"
+    get bob ##> ("", aliceId, MERR 5 (SMP AUTH))
+    deleteConnection alice bobId
+    liftIO $ noMessages alice "nothing else should be delivered to alice"
+  pure ()
+  where
+    noMessages :: AgentClient -> String -> Expectation
+    noMessages c err = tryGet `shouldReturn` ()
+      where
+        tryGet =
+          10000 `timeout` get c >>= \case
+            Just _ -> error err
+            _ -> return ()
+
+testAsyncInitiatingOffline :: IO ()
+testAsyncInitiatingOffline = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  Right () <- runExceptT $ do
+    (bobId, cReq) <- createConnection alice SCMInvitation
+    disconnectAgentClient alice
+    aliceId <- joinConnection bob cReq "bob's connInfo"
+    alice' <- liftIO $ getSMPAgentClient cfg
+    subscribeConnection alice' bobId
+    ("", _, CONF confId "bob's connInfo") <- get alice'
+    allowConnection alice' bobId confId "alice's connInfo"
+    get alice' ##> ("", bobId, CON)
+    get bob ##> ("", aliceId, INFO "alice's connInfo")
+    get bob ##> ("", aliceId, CON)
+    exchangeGreetings alice' bobId bob aliceId
+  pure ()
+
+testAsyncJoiningOfflineBeforeActivation :: IO ()
+testAsyncJoiningOfflineBeforeActivation = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = 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}
+    subscribeConnection bob' aliceId
+    get alice ##> ("", bobId, CON)
+    get bob' ##> ("", aliceId, INFO "alice's connInfo")
+    get bob' ##> ("", aliceId, CON)
+    exchangeGreetings alice bobId bob' aliceId
+  pure ()
+
+testAsyncJoiningOfflineAfterActivation :: IO ()
+testAsyncJoiningOfflineAfterActivation = error "not implemented"
+
+testAsyncBothOffline :: IO ()
+testAsyncBothOffline = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  Right () <- runExceptT $ do
+    (bobId, cReq) <- createConnection alice SCMInvitation
+    disconnectAgentClient alice
+    aliceId <- joinConnection bob cReq "bob's connInfo"
+    disconnectAgentClient bob
+    alice' <- liftIO $ getSMPAgentClient cfg
+    subscribeConnection alice' bobId
+    ("", _, CONF confId "bob's connInfo") <- get alice'
+    allowConnection alice' bobId confId "alice's connInfo"
+    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
+    subscribeConnection bob' aliceId
+    get alice' ##> ("", bobId, CON)
+    get bob' ##> ("", aliceId, INFO "alice's connInfo")
+    get bob' ##> ("", aliceId, CON)
+    exchangeGreetings alice' bobId bob' aliceId
+  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)
+  get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+  ackMessage bob aliceId 1
+  2 <- sendMessage bob aliceId "hello too"
+  get bob ##> ("", aliceId, SENT 2)
+  get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
+  ackMessage alice bobId 2

tests/AgentTests/SQLiteTests.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -7,8 +8,12 @@
 
 module AgentTests.SQLiteTests (storeTests) where
 
+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
 import Data.Text.Encoding (encodeUtf8)
@@ -17,11 +22,13 @@ import Data.Word (Word32)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import SMPClient (testKeyHash)
+import Simplex.Messaging.Agent.ExceptT ()
+import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
-import Simplex.Messaging.Agent.Transmission
+import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import qualified Simplex.Messaging.Crypto as C
-import System.Random (Random (randomIO))
+import System.Random
 import Test.Hspec
 import UnliftIO.Directory (removeFile)
 
@@ -30,18 +37,30 @@ testDB = "tests/tmp/smp-agent.test.db"
 
 withStore :: SpecWith SQLiteStore -> Spec
 withStore = before createStore . after removeStore
-  where
-    createStore :: IO SQLiteStore
-    createStore = do
-      -- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous
-      -- IO operations on multiple similarly named files; error seems to be environment specific
-      r <- randomIO :: IO Word32
-      createSQLiteStore $ testDB <> show r
 
-    removeStore :: SQLiteStore -> IO ()
-    removeStore store = do
-      DB.close $ dbConn store
-      removeFile $ dbFilePath store
+withStore2 :: SpecWith (SQLiteStore, SQLiteStore) -> Spec
+withStore2 = before connect2 . after (removeStore . fst)
+  where
+    connect2 :: IO (SQLiteStore, SQLiteStore)
+    connect2 = do
+      s1 <- createStore
+      s2 <- connectSQLiteStore (dbFilePath s1) 4
+      pure (s1, s2)
+
+createStore :: IO SQLiteStore
+createStore = do
+  -- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous
+  -- IO operations on multiple similarly named files; error seems to be environment specific
+  r <- randomIO :: IO Word32
+  createSQLiteStore (testDB <> show r) 4 Migrations.app
+
+removeStore :: SQLiteStore -> IO ()
+removeStore store = do
+  close store
+  removeFile $ dbFilePath store
+  where
+    close :: SQLiteStore -> IO ()
+    close st = mapM_ DB.close =<< atomically (flushTBQueue $ dbConnPool st)
 
 returnsResult :: (Eq a, Eq e, Show a, Show e) => ExceptT e IO a -> a -> Expectation
 action `returnsResult` r = runExceptT action `shouldReturn` Right r
@@ -51,51 +70,73 @@ action `throwsError` e = runExceptT action `shouldReturn` Left e
 
 -- TODO add null port tests
 storeTests :: Spec
-storeTests = withStore do
-  describe "store setup" do
-    testCompiledThreadsafe
-    testForeignKeysEnabled
-  describe "store methods" do
-    describe "Queue and Connection management" do
-      describe "createRcvConn" do
-        testCreateRcvConn
-        testCreateRcvConnDuplicate
-      describe "createSndConn" do
-        testCreateSndConn
-        testCreateSndConnDuplicate
-      describe "getAllConnAliases" testGetAllConnAliases
-      describe "getRcvQueue" testGetRcvQueue
-      describe "deleteConn" do
-        testDeleteRcvConn
-        testDeleteSndConn
-        testDeleteDuplexConn
-      describe "upgradeRcvConnToDuplex" do
-        testUpgradeRcvConnToDuplex
-      describe "upgradeSndConnToDuplex" do
-        testUpgradeSndConnToDuplex
-      describe "set Queue status" do
-        describe "setRcvQueueStatus" do
-          testSetRcvQueueStatus
-          testSetRcvQueueStatusNoQueue
-        describe "setSndQueueStatus" do
-          testSetSndQueueStatus
-          testSetSndQueueStatusNoQueue
-        testSetQueueStatusDuplex
-    describe "Msg management" do
-      describe "create Msg" do
-        testCreateRcvMsg
-        testCreateSndMsg
-        testCreateRcvAndSndMsgs
+storeTests = 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
+        describe "createSndConn" do
+          testCreateSndConn
+          testCreateSndConnRandomID
+          testCreateSndConnDuplicate
+        describe "getAllConnIds" testGetAllConnIds
+        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
+            testSetRcvQueueStatusNoQueue
+          describe "setSndQueueStatus" do
+            testSetSndQueueStatus
+            testSetSndQueueStatusNoQueue
+          testSetQueueStatusDuplex
+      describe "Msg management" do
+        describe "create Msg" do
+          testCreateRcvMsg
+          testCreateSndMsg
+          testCreateRcvAndSndMsgs
+
+testConcurrentWrites :: SpecWith (SQLiteStore, SQLiteStore)
+testConcurrentWrites =
+  it "should complete multiple concurrent write transactions w/t sqlite busy errors" $ \(s1, s2) -> do
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn s1 g cData1 rcvQueue1 SCMInvitation
+    let ConnData {connId} = cData1
+    concurrently_ (runTest s1 connId) (runTest s2 connId)
+  where
+    runTest :: SQLiteStore -> ConnId -> IO (Either StoreError ())
+    runTest store connId = runExceptT . replicateM_ 100 $ do
+      (internalId, internalRcvId, _, _) <- updateRcvIds store connId
+      let rcvMsgData = mkRcvMsgData internalId internalRcvId 0 "0" "hash_dummy"
+      createRcvMsg store connId rcvMsgData
 
 testCompiledThreadsafe :: SpecWith SQLiteStore
-testCompiledThreadsafe = do
-  it "compiled sqlite library should be threadsafe" $ \store -> do
-    compileOptions <- DB.query_ (dbConn store) "pragma COMPILE_OPTIONS;" :: IO [[T.Text]]
+testCompiledThreadsafe =
+  it "compiled sqlite library should be threadsafe" . withStoreConnection $ \db -> do
+    compileOptions <- DB.query_ db "pragma COMPILE_OPTIONS;" :: IO [[T.Text]]
     compileOptions `shouldNotContain` [["THREADSAFE=0"]]
 
+withStoreConnection :: (DB.Connection -> IO a) -> SQLiteStore -> IO a
+withStoreConnection = flip withConnection
+
 testForeignKeysEnabled :: SpecWith SQLiteStore
-testForeignKeysEnabled = do
-  it "foreign keys should be enabled" $ \store -> do
+testForeignKeysEnabled =
+  it "foreign keys should be enabled" . withStoreConnection $ \db -> do
     let inconsistentQuery =
           [sql|
             INSERT INTO connections
@@ -103,18 +144,19 @@ testForeignKeysEnabled = do
             VALUES
               ("conn1", "smp.simplex.im", "5223", "1234", "smp.simplex.im", "5223", "2345");
           |]
-    DB.execute_ (dbConn store) inconsistentQuery
+    DB.execute_ db inconsistentQuery
       `shouldThrow` (\e -> DB.sqlError e == DB.ErrorConstraint)
 
+cData1 :: ConnData
+cData1 = ConnData {connId = "conn1"}
+
 rcvQueue1 :: RcvQueue
 rcvQueue1 =
   RcvQueue
     { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
       rcvId = "1234",
-      connAlias = "conn1",
       rcvPrivateKey = C.safePrivateKey (1, 2, 3),
       sndId = Just "2345",
-      sndKey = Nothing,
       decryptKey = C.safePrivateKey (1, 2, 3),
       verifyKey = Nothing,
       status = New
@@ -125,74 +167,104 @@ sndQueue1 =
   SndQueue
     { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
       sndId = "3456",
-      connAlias = "conn1",
       sndPrivateKey = C.safePrivateKey (1, 2, 3),
       encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
-      signKey = C.safePrivateKey (1, 2, 3),
+      signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
       status = New
     }
 
 testCreateRcvConn :: SpecWith SQLiteStore
-testCreateRcvConn = do
+testCreateRcvConn =
   it "should create RcvConnection and add SndQueue" $ \store -> do
-    createRcvConn store rcvQueue1
-      `returnsResult` ()
+    g <- newTVarIO =<< drgNew
+    createRcvConn store g cData1 rcvQueue1 SCMInvitation
+      `returnsResult` "conn1"
     getConn store "conn1"
-      `returnsResult` SomeConn SCRcv (RcvConnection "conn1" rcvQueue1)
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
     upgradeRcvConnToDuplex store "conn1" sndQueue1
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
+
+testCreateRcvConnRandomId :: SpecWith SQLiteStore
+testCreateRcvConnRandomId =
+  it "should create RcvConnection and add SndQueue with random ID" $ \store -> do
+    g <- newTVarIO =<< drgNew
+    Right connId <- runExceptT $ createRcvConn store g cData1 {connId = ""} rcvQueue1 SCMInvitation
+    getConn store connId
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 {connId} rcvQueue1)
+    upgradeRcvConnToDuplex store connId sndQueue1
+      `returnsResult` ()
+    getConn store connId
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 {connId} rcvQueue1 sndQueue1)
 
 testCreateRcvConnDuplicate :: SpecWith SQLiteStore
-testCreateRcvConnDuplicate = do
+testCreateRcvConnDuplicate =
   it "should throw error on attempt to create duplicate RcvConnection" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
-    createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
+    createRcvConn store g cData1 rcvQueue1 SCMInvitation
       `throwsError` SEConnDuplicate
 
 testCreateSndConn :: SpecWith SQLiteStore
-testCreateSndConn = do
+testCreateSndConn =
   it "should create SndConnection and add RcvQueue" $ \store -> do
-    createSndConn store sndQueue1
-      `returnsResult` ()
+    g <- newTVarIO =<< drgNew
+    createSndConn store g cData1 sndQueue1
+      `returnsResult` "conn1"
     getConn store "conn1"
-      `returnsResult` SomeConn SCSnd (SndConnection "conn1" sndQueue1)
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 sndQueue1)
     upgradeSndConnToDuplex store "conn1" rcvQueue1
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
+
+testCreateSndConnRandomID :: SpecWith SQLiteStore
+testCreateSndConnRandomID =
+  it "should create SndConnection and add RcvQueue with random ID" $ \store -> do
+    g <- newTVarIO =<< drgNew
+    Right connId <- runExceptT $ createSndConn store g cData1 {connId = ""} sndQueue1
+    getConn store connId
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 {connId} sndQueue1)
+    upgradeSndConnToDuplex store connId rcvQueue1
+      `returnsResult` ()
+    getConn store connId
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 {connId} rcvQueue1 sndQueue1)
 
 testCreateSndConnDuplicate :: SpecWith SQLiteStore
-testCreateSndConnDuplicate = do
+testCreateSndConnDuplicate =
   it "should throw error on attempt to create duplicate SndConnection" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
-    createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
+    createSndConn store g cData1 sndQueue1
       `throwsError` SEConnDuplicate
 
-testGetAllConnAliases :: SpecWith SQLiteStore
-testGetAllConnAliases = do
+testGetAllConnIds :: SpecWith SQLiteStore
+testGetAllConnIds =
   it "should get all conn aliases" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
-    _ <- runExceptT $ createSndConn store sndQueue1 {connAlias = "conn2"}
-    getAllConnAliases store
-      `returnsResult` ["conn1" :: ConnAlias, "conn2" :: ConnAlias]
+    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]
 
-testGetRcvQueue :: SpecWith SQLiteStore
-testGetRcvQueue = do
-  it "should get RcvQueue" $ \store -> do
+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 recipientId = "1234"
-    _ <- runExceptT $ createRcvConn store rcvQueue1
-    getRcvQueue store smpServer recipientId
-      `returnsResult` rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
+    getRcvConn store smpServer recipientId
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
 
 testDeleteRcvConn :: SpecWith SQLiteStore
-testDeleteRcvConn = do
+testDeleteRcvConn =
   it "should create RcvConnection and delete it" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
     getConn store "conn1"
-      `returnsResult` SomeConn SCRcv (RcvConnection "conn1" rcvQueue1)
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
     deleteConn store "conn1"
       `returnsResult` ()
     -- TODO check queues are deleted as well
@@ -200,11 +272,12 @@ testDeleteRcvConn = do
       `throwsError` SEConnNotFound
 
 testDeleteSndConn :: SpecWith SQLiteStore
-testDeleteSndConn = do
+testDeleteSndConn =
   it "should create SndConnection and delete it" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCSnd (SndConnection "conn1" sndQueue1)
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 sndQueue1)
     deleteConn store "conn1"
       `returnsResult` ()
     -- TODO check queues are deleted as well
@@ -212,12 +285,13 @@ testDeleteSndConn = do
       `throwsError` SEConnNotFound
 
 testDeleteDuplexConn :: SpecWith SQLiteStore
-testDeleteDuplexConn = do
+testDeleteDuplexConn =
   it "should create DuplexConnection and delete it" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
     _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
     deleteConn store "conn1"
       `returnsResult` ()
     -- TODO check queues are deleted as well
@@ -225,17 +299,17 @@ testDeleteDuplexConn = do
       `throwsError` SEConnNotFound
 
 testUpgradeRcvConnToDuplex :: SpecWith SQLiteStore
-testUpgradeRcvConnToDuplex = do
+testUpgradeRcvConnToDuplex =
   it "should throw error on attempt to add SndQueue to SndConnection or DuplexConnection" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     let anotherSndQueue =
           SndQueue
             { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
               sndId = "2345",
-              connAlias = "conn1",
               sndPrivateKey = C.safePrivateKey (1, 2, 3),
               encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
-              signKey = C.safePrivateKey (1, 2, 3),
+              signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
               status = New
             }
     upgradeRcvConnToDuplex store "conn1" anotherSndQueue
@@ -245,17 +319,16 @@ testUpgradeRcvConnToDuplex = do
       `throwsError` SEBadConnType CDuplex
 
 testUpgradeSndConnToDuplex :: SpecWith SQLiteStore
-testUpgradeSndConnToDuplex = do
+testUpgradeSndConnToDuplex =
   it "should throw error on attempt to add RcvQueue to RcvConnection or DuplexConnection" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
     let anotherRcvQueue =
           RcvQueue
             { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
               rcvId = "3456",
-              connAlias = "conn1",
               rcvPrivateKey = C.safePrivateKey (1, 2, 3),
               sndId = Just "4567",
-              sndKey = Nothing,
               decryptKey = C.safePrivateKey (1, 2, 3),
               verifyKey = Nothing,
               status = New
@@ -267,51 +340,54 @@ testUpgradeSndConnToDuplex = do
       `throwsError` SEBadConnType CDuplex
 
 testSetRcvQueueStatus :: SpecWith SQLiteStore
-testSetRcvQueueStatus = do
+testSetRcvQueueStatus =
   it "should update status of RcvQueue" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
     getConn store "conn1"
-      `returnsResult` SomeConn SCRcv (RcvConnection "conn1" rcvQueue1)
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
     setRcvQueueStatus store rcvQueue1 Confirmed
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCRcv (RcvConnection "conn1" rcvQueue1 {status = Confirmed})
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1 {status = Confirmed})
 
 testSetSndQueueStatus :: SpecWith SQLiteStore
-testSetSndQueueStatus = do
+testSetSndQueueStatus =
   it "should update status of SndQueue" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCSnd (SndConnection "conn1" sndQueue1)
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 sndQueue1)
     setSndQueueStatus store sndQueue1 Confirmed
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCSnd (SndConnection "conn1" sndQueue1 {status = Confirmed})
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 sndQueue1 {status = Confirmed})
 
 testSetQueueStatusDuplex :: SpecWith SQLiteStore
-testSetQueueStatusDuplex = do
+testSetQueueStatusDuplex =
   it "should update statuses of RcvQueue and SndQueue in DuplexConnection" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
     _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
     setRcvQueueStatus store rcvQueue1 Secured
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 {status = Secured} sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 {status = Secured} sndQueue1)
     setSndQueueStatus store sndQueue1 Confirmed
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 {status = Secured} sndQueue1 {status = Confirmed})
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 {status = Secured} sndQueue1 {status = Confirmed})
 
 testSetRcvQueueStatusNoQueue :: SpecWith SQLiteStore
-testSetRcvQueueStatusNoQueue = do
+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 = do
+testSetSndQueueStatusNoQueue =
   xit "should throw error on attempt to update status of non-existent SndQueue" $ \store -> do
     setSndQueueStatus store sndQueue1 Confirmed
       `throwsError` SEConnNotFound
@@ -325,31 +401,36 @@ ts = UTCTime (fromGregorian 2021 02 24) (secondsToDiffTime 0)
 mkRcvMsgData :: InternalId -> InternalRcvId -> ExternalSndId -> BrokerId -> MsgHash -> RcvMsgData
 mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
   RcvMsgData
-    { internalId,
-      internalRcvId,
-      internalTs = ts,
-      senderMeta = (externalSndId, ts),
-      brokerMeta = (brokerId, ts),
+    { internalRcvId,
+      msgMeta =
+        MsgMeta
+          { integrity = MsgOk,
+            recipient = (unId internalId, ts),
+            sender = (externalSndId, ts),
+            broker = (brokerId, ts)
+          },
       msgBody = hw,
       internalHash,
-      externalPrevSndHash = "hash_from_sender",
-      msgIntegrity = MsgOk
+      externalPrevSndHash = "hash_from_sender"
     }
 
-testCreateRcvMsg' :: SQLiteStore -> PrevExternalSndId -> PrevRcvMsgHash -> RcvQueue -> RcvMsgData -> Expectation
-testCreateRcvMsg' store expectedPrevSndId expectedPrevHash rcvQueue rcvMsgData@RcvMsgData {..} = do
-  updateRcvIds store rcvQueue
-    `returnsResult` (internalId, internalRcvId, expectedPrevSndId, expectedPrevHash)
-  createRcvMsg store rcvQueue rcvMsgData
+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)
+  createRcvMsg st connId rcvMsgData
     `returnsResult` ()
 
 testCreateRcvMsg :: SpecWith SQLiteStore
-testCreateRcvMsg = do
-  it "should reserve internal ids and create a RcvMsg" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+testCreateRcvMsg =
+  it "should reserve internal ids and create a RcvMsg" $ \st -> do
+    g <- newTVarIO =<< drgNew
+    let ConnData {connId} = cData1
+    _ <- runExceptT $ createRcvConn st g cData1 rcvQueue1 SCMInvitation
     -- TODO getMsg to check message
-    testCreateRcvMsg' store 0 "" rcvQueue1 $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "hash_dummy"
-    testCreateRcvMsg' store 1 "hash_dummy" rcvQueue1 $ 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 =
@@ -358,32 +439,37 @@ mkSndMsgData internalId internalSndId internalHash =
       internalSndId,
       internalTs = ts,
       msgBody = hw,
-      internalHash
+      internalHash,
+      previousMsgHash = internalHash
     }
 
-testCreateSndMsg' :: SQLiteStore -> PrevSndMsgHash -> SndQueue -> SndMsgData -> Expectation
-testCreateSndMsg' store expectedPrevHash sndQueue sndMsgData@SndMsgData {..} = do
-  updateSndIds store sndQueue
+testCreateSndMsg' :: SQLiteStore -> PrevSndMsgHash -> ConnId -> SndMsgData -> Expectation
+testCreateSndMsg' store expectedPrevHash connId sndMsgData@SndMsgData {..} = do
+  updateSndIds store connId
     `returnsResult` (internalId, internalSndId, expectedPrevHash)
-  createSndMsg store sndQueue sndMsgData
+  createSndMsg store connId sndMsgData
     `returnsResult` ()
 
 testCreateSndMsg :: SpecWith SQLiteStore
-testCreateSndMsg = do
+testCreateSndMsg =
   it "should create a SndMsg and return InternalId and PrevSndMsgHash" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    let ConnData {connId} = cData1
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     -- TODO getMsg to check message
-    testCreateSndMsg' store "" sndQueue1 $ mkSndMsgData (InternalId 1) (InternalSndId 1) "hash_dummy"
-    testCreateSndMsg' store "hash_dummy" sndQueue1 $ 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 = do
+testCreateRcvAndSndMsgs =
   it "should create multiple RcvMsg and SndMsg, correctly ordering internal Ids and returning previous state" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    let ConnData {connId} = cData1
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
     _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
-    testCreateRcvMsg' store 0 "" rcvQueue1 $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "rcv_hash_1"
-    testCreateRcvMsg' store 1 "rcv_hash_1" rcvQueue1 $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "rcv_hash_2"
-    testCreateSndMsg' store "" sndQueue1 $ mkSndMsgData (InternalId 3) (InternalSndId 1) "snd_hash_1"
-    testCreateRcvMsg' store 2 "rcv_hash_2" rcvQueue1 $ mkRcvMsgData (InternalId 4) (InternalRcvId 3) 3 "3" "rcv_hash_3"
-    testCreateSndMsg' store "snd_hash_1" sndQueue1 $ mkSndMsgData (InternalId 5) (InternalSndId 2) "snd_hash_2"
-    testCreateSndMsg' store "snd_hash_2" sndQueue1 $ 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/MarkdownTests.hs

@@ -1,128 +0,0 @@
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module MarkdownTests where
-
-import Data.Text (Text)
-import Simplex.Markdown
-import System.Console.ANSI.Types
-import Test.Hspec
-
-markdownTests :: Spec
-markdownTests = do
-  textFormat
-  secretText
-  textColor
-
-textFormat :: Spec
-textFormat = describe "text format (bold)" do
-  it "correct markdown" do
-    parseMarkdown "this is *bold formatted* text"
-      `shouldBe` "this is " <> Markdown Bold "bold formatted" <> " " <> "text"
-    parseMarkdown "*bold formatted* text"
-      `shouldBe` Markdown Bold "bold formatted" <> " " <> "text"
-    parseMarkdown "this is *bold*"
-      `shouldBe` "this is " <> Markdown Bold "bold"
-    parseMarkdown " *bold* text"
-      `shouldBe` " " <> Markdown Bold "bold" <> " " <> "text"
-    parseMarkdown "   *bold* text"
-      `shouldBe` "   " <> Markdown Bold "bold" <> " " <> "text"
-    parseMarkdown "this is *bold* "
-      `shouldBe` "this is " <> Markdown Bold "bold" <> " "
-    parseMarkdown "this is *bold*   "
-      `shouldBe` "this is " <> Markdown Bold "bold" <> "   "
-  it "ignored as markdown" do
-    parseMarkdown "this is * unformatted * text"
-      `shouldBe` "this is " <> "* unformatted *" <> " " <> "text"
-    parseMarkdown "this is *unformatted * text"
-      `shouldBe` "this is " <> "*unformatted *" <> " " <> "text"
-    parseMarkdown "this is * unformatted* text"
-      `shouldBe` "this is " <> "* unformatted*" <> " " <> "text"
-    parseMarkdown "this is **unformatted** text"
-      `shouldBe` "this is " <> "**" <> "unformatted** text"
-    parseMarkdown "this is*unformatted* text"
-      `shouldBe` "this is*unformatted* text"
-    parseMarkdown "this is *unformatted text"
-      `shouldBe` "this is " <> "*unformatted text"
-  it "ignored internal markdown" do
-    parseMarkdown "this is *long _bold_ (not italic)* text"
-      `shouldBe` "this is " <> Markdown Bold "long _bold_ (not italic)" <> " " <> "text"
-    parseMarkdown "snippet: `this is *bold text*`"
-      `shouldBe` "snippet: " <> Markdown Snippet "this is *bold text*"
-
-secretText :: Spec
-secretText = describe "secret text" do
-  it "correct markdown" do
-    parseMarkdown "this is #black_secret# text"
-      `shouldBe` "this is " <> Markdown Secret "black_secret" <> " " <> "text"
-    parseMarkdown "##black_secret### text"
-      `shouldBe` Markdown Secret "#black_secret##" <> " " <> "text"
-    parseMarkdown "this is #black secret# text"
-      `shouldBe` "this is " <> Markdown Secret "black secret" <> " " <> "text"
-    parseMarkdown "##black secret### text"
-      `shouldBe` Markdown Secret "#black secret##" <> " " <> "text"
-    parseMarkdown "this is #secret#"
-      `shouldBe` "this is " <> Markdown Secret "secret"
-    parseMarkdown " #secret# text"
-      `shouldBe` " " <> Markdown Secret "secret" <> " " <> "text"
-    parseMarkdown "   #secret# text"
-      `shouldBe` "   " <> Markdown Secret "secret" <> " " <> "text"
-    parseMarkdown "this is #secret# "
-      `shouldBe` "this is " <> Markdown Secret "secret" <> " "
-    parseMarkdown "this is #secret#   "
-      `shouldBe` "this is " <> Markdown Secret "secret" <> "   "
-  it "ignored as markdown" do
-    parseMarkdown "this is # unformatted # text"
-      `shouldBe` "this is " <> "# unformatted #" <> " " <> "text"
-    parseMarkdown "this is #unformatted # text"
-      `shouldBe` "this is " <> "#unformatted #" <> " " <> "text"
-    parseMarkdown "this is # unformatted# text"
-      `shouldBe` "this is " <> "# unformatted#" <> " " <> "text"
-    parseMarkdown "this is ## unformatted ## text"
-      `shouldBe` "this is " <> "## unformatted ##" <> " " <> "text"
-    parseMarkdown "this is#unformatted# text"
-      `shouldBe` "this is#unformatted# text"
-    parseMarkdown "this is #unformatted text"
-      `shouldBe` "this is " <> "#unformatted text"
-  it "ignored internal markdown" do
-    parseMarkdown "snippet: `this is #secret_text#`"
-      `shouldBe` "snippet: " <> Markdown Snippet "this is #secret_text#"
-
-red :: Text -> Markdown
-red = Markdown (Colored Red)
-
-textColor :: Spec
-textColor = describe "text color (red)" do
-  it "correct markdown" do
-    parseMarkdown "this is !1 red color! text"
-      `shouldBe` "this is " <> red "red color" <> " " <> "text"
-    parseMarkdown "!1 red! text"
-      `shouldBe` red "red" <> " " <> "text"
-    parseMarkdown "this is !1 red!"
-      `shouldBe` "this is " <> red "red"
-    parseMarkdown " !1 red! text"
-      `shouldBe` " " <> red "red" <> " " <> "text"
-    parseMarkdown "   !1 red! text"
-      `shouldBe` "   " <> red "red" <> " " <> "text"
-    parseMarkdown "this is !1 red! "
-      `shouldBe` "this is " <> red "red" <> " "
-    parseMarkdown "this is !1 red!   "
-      `shouldBe` "this is " <> red "red" <> "   "
-  it "ignored as markdown" do
-    parseMarkdown "this is !1 unformatted ! text"
-      `shouldBe` "this is " <> "!1 unformatted !" <> " " <> "text"
-    parseMarkdown "this is !1 unformatted ! text"
-      `shouldBe` "this is " <> "!1 unformatted !" <> " " <> "text"
-    parseMarkdown "this is !1  unformatted! text"
-      `shouldBe` "this is " <> "!1  unformatted!" <> " " <> "text"
-    -- parseMarkdown "this is !!1 unformatted!! text"
-    --   `shouldBe` "this is " <> "!!1" <> "unformatted!! text"
-    parseMarkdown "this is!1 unformatted! text"
-      `shouldBe` "this is!1 unformatted! text"
-    parseMarkdown "this is !1 unformatted text"
-      `shouldBe` "this is " <> "!1 unformatted text"
-  it "ignored internal markdown" do
-    parseMarkdown "this is !1 long *red* (not bold)! text"
-      `shouldBe` "this is " <> red "long *red* (not bold)" <> " " <> "text"
-    parseMarkdown "snippet: `this is !1 red text!`"
-      `shouldBe` "snippet: " <> Markdown Snippet "this is !1 red text!"

tests/ProtocolErrorTests.hs

@@ -1,6 +1,6 @@
 module ProtocolErrorTests where
 
-import Simplex.Messaging.Agent.Transmission (AgentErrorType, agentErrorTypeP, serializeAgentError)
+import Simplex.Messaging.Agent.Protocol (AgentErrorType, agentErrorTypeP, serializeAgentError)
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (ErrorType, errorTypeP, serializeErrorType)
 import Test.Hspec

tests/SMPAgentClient.hs

@@ -3,34 +3,45 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module SMPAgentClient where
 
 import Control.Monad.IO.Unlift
 import Crypto.Random
+import qualified Data.ByteString.Char8 as B
+import qualified Data.List.NonEmpty as L
 import Network.Socket (HostName, ServiceName)
-import SMPClient (serverBracket, testPort, withSmpServer, withSmpServerThreadOn)
+import SMPClient
+  ( serverBracket,
+    testKeyHash,
+    testPort,
+    testPort2,
+    withSmpServer,
+    withSmpServerOn,
+    withSmpServerThreadOn,
+  )
 import Simplex.Messaging.Agent (runSMPAgentBlocking)
 import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Agent.Transmission
+import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client (SMPClientConfig (..), smpDefaultConfig)
 import Simplex.Messaging.Transport
 import Test.Hspec
 import UnliftIO.Concurrent
 import UnliftIO.Directory
-import UnliftIO.IO
 
 agentTestHost :: HostName
 agentTestHost = "localhost"
 
 agentTestPort :: ServiceName
-agentTestPort = "5001"
+agentTestPort = "5010"
 
 agentTestPort2 :: ServiceName
 agentTestPort2 = "5011"
 
 agentTestPort3 :: ServiceName
-agentTestPort3 = "5021"
+agentTestPort3 = "5012"
 
 testDB :: String
 testDB = "tests/tmp/smp-agent.test.protocol.db"
@@ -41,104 +52,146 @@ testDB2 = "tests/tmp/smp-agent2.test.protocol.db"
 testDB3 :: String
 testDB3 = "tests/tmp/smp-agent3.test.protocol.db"
 
-smpAgentTest :: ARawTransmission -> IO ARawTransmission
-smpAgentTest cmd = runSmpAgentTest $ \h -> tPutRaw h cmd >> tGetRaw h
+smpAgentTest :: forall c. Transport c => TProxy c -> ARawTransmission -> IO ARawTransmission
+smpAgentTest _ cmd = runSmpAgentTest $ \(h :: c) -> tPutRaw h cmd >> tGetRaw h
 
-runSmpAgentTest :: (MonadUnliftIO m, MonadRandom m) => (Handle -> m a) -> m a
-runSmpAgentTest test = withSmpServer . withSmpAgent $ testSMPAgentClient test
+runSmpAgentTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => (c -> m a) -> m a
+runSmpAgentTest test = withSmpServer t . withSmpAgent t $ testSMPAgentClient test
+  where
+    t = transport @c
 
-runSmpAgentServerTest :: (MonadUnliftIO m, MonadRandom m) => ((ThreadId, ThreadId) -> Handle -> m a) -> m a
+runSmpAgentServerTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => ((ThreadId, ThreadId) -> c -> m a) -> m a
 runSmpAgentServerTest test =
-  withSmpServerThreadOn testPort $
-    \server -> withSmpAgentThreadOn (agentTestPort, testDB) $
+  withSmpServerThreadOn t testPort $
+    \server -> withSmpAgentThreadOn t (agentTestPort, testPort, testDB) $
       \agent -> testSMPAgentClient $ test (server, agent)
+  where
+    t = transport @c
 
-smpAgentServerTest :: ((ThreadId, ThreadId) -> Handle -> IO ()) -> Expectation
+smpAgentServerTest :: Transport c => ((ThreadId, ThreadId) -> c -> IO ()) -> Expectation
 smpAgentServerTest test' = runSmpAgentServerTest test' `shouldReturn` ()
 
-runSmpAgentTestN :: forall m a. (MonadUnliftIO m, MonadRandom m) => [(ServiceName, String)] -> ([Handle] -> m a) -> m a
-runSmpAgentTestN agents test = withSmpServer $ run agents []
+runSmpAgentTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => [(ServiceName, ServiceName, String)] -> ([c] -> m a) -> m a
+runSmpAgentTestN agents test = withSmpServer t $ run agents []
   where
-    run :: [(ServiceName, String)] -> [Handle] -> m a
+    run :: [(ServiceName, ServiceName, String)] -> [c] -> m a
     run [] hs = test hs
-    run (a@(p, _) : as) hs = withSmpAgentOn a $ testSMPAgentClientOn p $ \h -> run as (h : hs)
+    run (a@(p, _, _) : as) hs = withSmpAgentOn t a $ testSMPAgentClientOn p $ \h -> run as (h : hs)
+    t = transport @c
 
-runSmpAgentTestN_1 :: forall m a. (MonadUnliftIO m, MonadRandom m) => Int -> ([Handle] -> m a) -> m a
-runSmpAgentTestN_1 nClients test = withSmpServer . withSmpAgent $ run nClients []
+runSmpAgentTestN_1 :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => Int -> ([c] -> m a) -> m a
+runSmpAgentTestN_1 nClients test = withSmpServer t . withSmpAgent t $ run nClients []
   where
-    run :: Int -> [Handle] -> m a
+    run :: Int -> [c] -> m a
     run 0 hs = test hs
     run n hs = testSMPAgentClient $ \h -> run (n - 1) (h : hs)
+    t = transport @c
 
-smpAgentTestN :: [(ServiceName, String)] -> ([Handle] -> IO ()) -> Expectation
+smpAgentTestN :: Transport c => [(ServiceName, ServiceName, String)] -> ([c] -> IO ()) -> Expectation
 smpAgentTestN agents test' = runSmpAgentTestN agents test' `shouldReturn` ()
 
-smpAgentTestN_1 :: Int -> ([Handle] -> IO ()) -> Expectation
+smpAgentTestN_1 :: Transport c => Int -> ([c] -> IO ()) -> Expectation
 smpAgentTestN_1 n test' = runSmpAgentTestN_1 n test' `shouldReturn` ()
 
-smpAgentTest2 :: (Handle -> Handle -> IO ()) -> Expectation
-smpAgentTest2 test' =
-  smpAgentTestN [(agentTestPort, testDB), (agentTestPort2, testDB2)] _test
+smpAgentTest2_2_2 :: forall c. Transport c => (c -> c -> IO ()) -> Expectation
+smpAgentTest2_2_2 test' =
+  withSmpServerOn (transport @c) testPort2 $
+    smpAgentTest2_2_2_needs_server test'
+
+smpAgentTest2_2_2_needs_server :: forall c. Transport c => (c -> c -> IO ()) -> Expectation
+smpAgentTest2_2_2_needs_server test' =
+  smpAgentTestN
+    [ (agentTestPort, testPort, testDB),
+      (agentTestPort2, testPort2, testDB2)
+    ]
+    _test
   where
     _test [h1, h2] = test' h1 h2
     _test _ = error "expected 2 handles"
 
-smpAgentTest2_1 :: (Handle -> Handle -> IO ()) -> Expectation
-smpAgentTest2_1 test' = smpAgentTestN_1 2 _test
+smpAgentTest2_2_1 :: Transport c => (c -> c -> IO ()) -> Expectation
+smpAgentTest2_2_1 test' =
+  smpAgentTestN
+    [ (agentTestPort, testPort, testDB),
+      (agentTestPort2, testPort, testDB2)
+    ]
+    _test
   where
     _test [h1, h2] = test' h1 h2
     _test _ = error "expected 2 handles"
 
-smpAgentTest3 :: (Handle -> Handle -> Handle -> IO ()) -> Expectation
+smpAgentTest2_1_1 :: Transport c => (c -> c -> IO ()) -> Expectation
+smpAgentTest2_1_1 test' = smpAgentTestN_1 2 _test
+  where
+    _test [h1, h2] = test' h1 h2
+    _test _ = error "expected 2 handles"
+
+smpAgentTest3 :: Transport c => (c -> c -> c -> IO ()) -> Expectation
 smpAgentTest3 test' =
   smpAgentTestN
-    [(agentTestPort, testDB), (agentTestPort2, testDB2), (agentTestPort3, testDB3)]
+    [ (agentTestPort, testPort, testDB),
+      (agentTestPort2, testPort, testDB2),
+      (agentTestPort3, testPort, testDB3)
+    ]
     _test
   where
     _test [h1, h2, h3] = test' h1 h2 h3
     _test _ = error "expected 3 handles"
 
-smpAgentTest3_1 :: (Handle -> Handle -> Handle -> IO ()) -> Expectation
-smpAgentTest3_1 test' = smpAgentTestN_1 3 _test
+smpAgentTest3_1_1 :: Transport c => (c -> c -> c -> IO ()) -> Expectation
+smpAgentTest3_1_1 test' = smpAgentTestN_1 3 _test
   where
     _test [h1, h2, h3] = test' h1 h2 h3
     _test _ = error "expected 3 handles"
 
+smpAgentTest1_1_1 :: forall c. Transport c => (c -> IO ()) -> Expectation
+smpAgentTest1_1_1 test' =
+  smpAgentTestN
+    [(agentTestPort2, testPort2, testDB2)]
+    _test
+  where
+    _test [h] = test' h
+    _test _ = error "expected 1 handle"
+
 cfg :: AgentConfig
 cfg =
-  AgentConfig
+  defaultAgentConfig
     { tcpPort = agentTestPort,
-      rsaKeySize = 2048 `div` 8,
-      connIdBytes = 12,
+      smpServers = L.fromList ["localhost:5000#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="],
       tbqSize = 1,
       dbFile = testDB,
       smpCfg =
         smpDefaultConfig
           { qSize = 1,
-            defaultPort = testPort,
+            defaultTransport = (testPort, transport @TCP),
             tcpTimeout = 500_000
-          }
+          },
+      retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50_000}
     }
 
-withSmpAgentThreadOn :: (MonadUnliftIO m, MonadRandom m) => (ServiceName, String) -> (ThreadId -> m a) -> m a
-withSmpAgentThreadOn (port', db') =
-  serverBracket
-    (\started -> runSMPAgentBlocking started cfg {tcpPort = port', dbFile = db'})
-    (removeFile db')
+withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> 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]}
+   in serverBracket
+        (\started -> runSMPAgentBlocking t started cfg')
+        afterProcess
 
-withSmpAgentOn :: (MonadUnliftIO m, MonadRandom m) => (ServiceName, String) -> m a -> m a
-withSmpAgentOn (port', db') = withSmpAgentThreadOn (port', db') . const
+withSmpAgentThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> (ThreadId -> m a) -> m a
+withSmpAgentThreadOn t a@(_, _, db') = withSmpAgentThreadOn_ t a $ removeFile db'
 
-withSmpAgent :: (MonadUnliftIO m, MonadRandom m) => m a -> m a
-withSmpAgent = withSmpAgentOn (agentTestPort, testDB)
+withSmpAgentOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m a -> m a
+withSmpAgentOn t (port', smpPort', db') = withSmpAgentThreadOn t (port', smpPort', db') . const
 
-testSMPAgentClientOn :: MonadUnliftIO m => ServiceName -> (Handle -> m a) -> m a
+withSmpAgent :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
+withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB)
+
+testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m a) -> m a
 testSMPAgentClientOn port' client = do
-  runTCPClient agentTestHost port' $ \h -> do
+  runTransportClient agentTestHost port' $ \h -> do
     line <- liftIO $ getLn h
-    if line == "Welcome to SMP v0.2.0 agent"
+    if line == "Welcome to SMP agent v" <> currentSMPVersionStr
       then client h
-      else error "not connected"
+      else error $ "wrong welcome message: " <> B.unpack line
 
-testSMPAgentClient :: MonadUnliftIO m => (Handle -> m a) -> m a
+testSMPAgentClient :: (Transport c, MonadUnliftIO m) => (c -> m a) -> m a
 testSMPAgentClient = testSMPAgentClientOn agentTestPort

tests/SMPClient.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module SMPClient where
 
@@ -32,30 +33,39 @@ testHost = "localhost"
 testPort :: ServiceName
 testPort = "5000"
 
+testPort2 :: ServiceName
+testPort2 = "5001"
+
 testKeyHashStr :: B.ByteString
 testKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
 
+testBlockSize :: Maybe Int
+testBlockSize = Just 8192
+
 testKeyHash :: Maybe C.KeyHash
 testKeyHash = Just "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
 
 testStoreLogFile :: FilePath
 testStoreLogFile = "tests/tmp/smp-server-store.log"
 
-testSMPClient :: MonadUnliftIO m => (THandle -> m a) -> m a
+testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testSMPClient client =
-  runTCPClient testHost testPort $ \h ->
-    liftIO (runExceptT $ clientHandshake h testKeyHash) >>= \case
+  runTransportClient testHost testPort $ \h ->
+    liftIO (runExceptT $ clientHandshake h testBlockSize testKeyHash) >>= \case
       Right th -> client th
       Left e -> error $ show e
 
 cfg :: ServerConfig
 cfg =
   ServerConfig
-    { tcpPort = testPort,
+    { transports = undefined,
       tbqSize = 1,
+      serverTbqSize = 1,
+      msgQueueQuota = 4,
       queueIdBytes = 12,
       msgIdBytes = 6,
       storeLog = Nothing,
+      blockSize = 8192,
       serverPrivateKey =
         -- full RSA private key (only for tests)
         "MIIFIwIBAAKCAQEArZyrri/NAwt5buvYjwu+B/MQeJUszDBpRgVqNddlI9kNwDXu\
@@ -88,18 +98,18 @@ cfg =
         \TmKzSAw7iVWwEUZR/PeiEKazqrpp9VU="
     }
 
-withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerStoreLogOn port client = do
+withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
+withSmpServerStoreLogOn t port client = do
   s <- liftIO $ openReadStoreLog testStoreLogFile
   serverBracket
-    (\started -> runSMPServerBlocking started cfg {tcpPort = port, storeLog = Just s})
+    (\started -> runSMPServerBlocking started cfg {transports = [(port, t)], storeLog = Just s})
     (pure ())
     client
 
-withSmpServerThreadOn :: (MonadUnliftIO m, MonadRandom m) => ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerThreadOn port =
+withSmpServerThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
+withSmpServerThreadOn t port =
   serverBracket
-    (\started -> runSMPServerBlocking started cfg {tcpPort = port})
+    (\started -> runSMPServerBlocking started cfg {transports = [(port, t)]})
     (pure ())
 
 serverBracket :: MonadUnliftIO m => (TMVar Bool -> m ()) -> m () -> (ThreadId -> m a) -> m a
@@ -115,49 +125,49 @@ serverBracket process afterProcess f = do
         Nothing -> error $ "server did not " <> s
         _ -> pure ()
 
-withSmpServerOn :: (MonadUnliftIO m, MonadRandom m) => ServiceName -> m a -> m a
-withSmpServerOn port = withSmpServerThreadOn port . const
+withSmpServerOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> m a -> m a
+withSmpServerOn t port = withSmpServerThreadOn t port . const
 
-withSmpServer :: (MonadUnliftIO m, MonadRandom m) => m a -> m a
-withSmpServer = withSmpServerOn testPort
+withSmpServer :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
+withSmpServer t = withSmpServerOn t testPort
 
-runSmpTest :: (MonadUnliftIO m, MonadRandom m) => (THandle -> m a) -> m a
-runSmpTest test = withSmpServer $ testSMPClient test
+runSmpTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => (THandle c -> m a) -> m a
+runSmpTest test = withSmpServer (transport @c) $ testSMPClient test
 
-runSmpTestN :: forall m a. (MonadUnliftIO m, MonadRandom m) => Int -> ([THandle] -> m a) -> m a
-runSmpTestN nClients test = withSmpServer $ run nClients []
+runSmpTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => Int -> ([THandle c] -> m a) -> m a
+runSmpTestN nClients test = withSmpServer (transport @c) $ run nClients []
   where
-    run :: Int -> [THandle] -> m a
+    run :: Int -> [THandle c] -> m a
     run 0 hs = test hs
     run n hs = testSMPClient $ \h -> run (n - 1) (h : hs)
 
-smpServerTest :: RawTransmission -> IO RawTransmission
-smpServerTest cmd = runSmpTest $ \h -> tPutRaw h cmd >> tGetRaw h
+smpServerTest :: forall c. Transport c => TProxy c -> RawTransmission -> IO RawTransmission
+smpServerTest _ cmd = runSmpTest $ \(h :: THandle c) -> tPutRaw h cmd >> tGetRaw h
 
-smpTest :: (THandle -> IO ()) -> Expectation
-smpTest test' = runSmpTest test' `shouldReturn` ()
+smpTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
+smpTest _ test' = runSmpTest test' `shouldReturn` ()
 
-smpTestN :: Int -> ([THandle] -> IO ()) -> Expectation
+smpTestN :: Transport c => Int -> ([THandle c] -> IO ()) -> Expectation
 smpTestN n test' = runSmpTestN n test' `shouldReturn` ()
 
-smpTest2 :: (THandle -> THandle -> IO ()) -> Expectation
-smpTest2 test' = smpTestN 2 _test
+smpTest2 :: Transport c => TProxy c -> (THandle c -> THandle c -> IO ()) -> Expectation
+smpTest2 _ test' = smpTestN 2 _test
   where
     _test [h1, h2] = test' h1 h2
     _test _ = error "expected 2 handles"
 
-smpTest3 :: (THandle -> THandle -> THandle -> IO ()) -> Expectation
-smpTest3 test' = smpTestN 3 _test
+smpTest3 :: Transport c => TProxy c -> (THandle c -> THandle c -> THandle c -> IO ()) -> Expectation
+smpTest3 _ test' = smpTestN 3 _test
   where
     _test [h1, h2, h3] = test' h1 h2 h3
     _test _ = error "expected 3 handles"
 
-tPutRaw :: THandle -> RawTransmission -> IO ()
+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 :: THandle -> IO RawTransmission
+tGetRaw :: Transport c => THandle c -> IO RawTransmission
 tGetRaw h = do
   ("", (CorrId corrId, qId, Right cmd)) <- tGet fromServer h
   pure ("", corrId, encode qId, serializeCommand cmd)

tests/ServerTests.hs

@@ -11,7 +11,7 @@ module ServerTests where
 import Control.Concurrent (ThreadId, killThread)
 import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
-import Control.Monad.Except (forM_, runExceptT)
+import Control.Monad.Except (forM, forM_, runExceptT)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -28,25 +28,26 @@ import Test.Hspec
 rsaKeySize :: Int
 rsaKeySize = 2048 `div` 8
 
-serverTests :: Spec
-serverTests = do
-  describe "SMP syntax" syntaxTests
+serverTests :: ATransport -> Spec
+serverTests t = do
+  describe "SMP syntax" $ syntaxTests t
   describe "SMP queues" do
-    describe "NEW and KEY commands, SEND messages" testCreateSecure
-    describe "NEW, OFF and DEL commands, SEND messages" testCreateDelete
+    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 "duplex communication over 2 SMP connections" testDuplex
-    describe "switch subscription to another SMP queue" testSwitchSub
-  describe "Store log" testWithStoreLog
-  describe "Timing of AUTH error" testTiming
+    describe "duplex communication over 2 SMP connections" $ testDuplex t
+    describe "switch subscription to another SMP queue" $ testSwitchSub t
+  describe "Store log" $ testWithStoreLog t
+  describe "Timing of AUTH error" $ testTiming t
 
 pattern Resp :: CorrId -> QueueId -> Command 'Broker -> SignedTransmissionOrError
 pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker command)))
 
-sendRecv :: THandle -> (ByteString, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
+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
 
-signSendRecv :: THandle -> C.SafePrivateKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
+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]
   Right sig <- runExceptT $ C.sign pk t
@@ -56,16 +57,13 @@ signSendRecv h pk (corrId, qId, cmd) = do
 cmdSEND :: ByteString -> ByteString
 cmdSEND msg = serializeCommand (Cmd SSender . SEND $ msg)
 
-(>#>) :: RawTransmission -> RawTransmission -> Expectation
-command >#> response = smpServerTest command `shouldReturn` response
-
 (#==) :: (HasCallStack, Eq a, Show a) => (a, a) -> String -> Assertion
 (actual, expected) #== message = assertEqual message expected actual
 
-testCreateSecure :: Spec
-testCreateSecure =
+testCreateSecure :: ATransport -> Spec
+testCreateSecure (ATransport t) =
   it "should create (NEW) and secure (KEY) queue" $
-    smpTest \h -> do
+    smpTest t $ \h -> do
       (rPub, rKey) <- C.generateKeyPair rsaKeySize
       Resp "abcd" rId1 (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
       (rId1, "") #== "creates queue"
@@ -114,10 +112,10 @@ testCreateSecure =
       Resp "dabc" _ err5 <- sendRecv h ("", "dabc", sId, "SEND 5 hello ")
       (err5, ERR AUTH) #== "rejects unsigned SEND"
 
-testCreateDelete :: Spec
-testCreateDelete =
+testCreateDelete :: ATransport -> Spec
+testCreateDelete (ATransport t) =
   it "should create (NEW), suspend (OFF) and delete (DEL) queue" $
-    smpTest2 \rh sh -> do
+    smpTest2 t $ \rh sh -> do
       (rPub, rKey) <- C.generateKeyPair rsaKeySize
       Resp "abcd" rId1 (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
       (rId1, "") #== "creates queue"
@@ -182,10 +180,26 @@ testCreateDelete =
       Resp "cdab" _ err10 <- signSendRecv rh rKey ("cdab", rId, "SUB")
       (err10, ERR AUTH) #== "rejects SUB when deleted"
 
-testDuplex :: Spec
-testDuplex =
+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
+      rIds <- forM [1 .. 50 :: Int] . const $ do
+        Resp "" "" (IDS rId _) <- signSendRecv h1 rKey ("", "", "NEW " <> C.serializePubKey rPub)
+        pure rId
+      let subscribeQueues h = forM_ rIds $ \rId -> do
+            Resp "" rId' OK <- signSendRecv h rKey ("", rId, "SUB")
+            rId' `shouldBe` rId
+      closeConnection $ connection h1
+      subscribeQueues h2
+      closeConnection $ connection h2
+      subscribeQueues h3
+
+testDuplex :: ATransport -> Spec
+testDuplex (ATransport t) =
   it "should create 2 simplex connections and exchange messages" $
-    smpTest2 \alice bob -> do
+    smpTest2 t $ \alice bob -> do
       (arPub, arKey) <- C.generateKeyPair rsaKeySize
       Resp "abcd" _ (IDS aRcv aSnd) <- signSendRecv alice arKey ("abcd", "", "NEW " <> C.serializePubKey arPub)
       -- aSnd ID is passed to Bob out-of-band
@@ -232,10 +246,10 @@ testDuplex =
       Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, "ACK")
       (msg5, "how are you bob") #== "message received from alice"
 
-testSwitchSub :: Spec
-testSwitchSub =
+testSwitchSub :: ATransport -> Spec
+testSwitchSub (ATransport t) =
   it "should create simplex connections and switch subscription to another TCP connection" $
-    smpTest3 \rh1 rh2 sh -> do
+    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 ")
@@ -270,15 +284,15 @@ testSwitchSub =
         Nothing -> return ()
         Just _ -> error "nothing else is delivered to the 1st TCP connection"
 
-testWithStoreLog :: Spec
-testWithStoreLog =
+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
     senderId1 <- newTVarIO ""
     senderId2 <- newTVarIO ""
 
-    withSmpServerStoreLogOn testPort . runTest $ \h -> do
+    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 ")
@@ -294,13 +308,13 @@ testWithStoreLog =
 
     logSize `shouldReturn` 5
 
-    withSmpServerThreadOn testPort . runTest $ \h -> do
+    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 ")
       pure ()
 
-    withSmpServerStoreLogOn testPort . runTest $ \h -> do
+    withSmpServerStoreLogOn at testPort . runTest t $ \h -> do
       -- this queue is restored
       sId1 <- readTVarIO senderId1
       Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ")
@@ -312,7 +326,7 @@ testWithStoreLog =
     logSize `shouldReturn` 1
     removeFile testStoreLogFile
   where
-    createAndSecureQueue :: THandle -> SenderPublicKey -> IO (SenderId, RecipientId, C.SafePrivateKey)
+    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)
@@ -321,8 +335,8 @@ testWithStoreLog =
       (rId', rId) #== "same queue ID"
       pure (sId, rId, rKey)
 
-    runTest :: (THandle -> IO ()) -> ThreadId -> Expectation
-    runTest test' server = do
+    runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
+    runTest _ test' server = do
       testSMPClient test' `shouldReturn` ()
       killThread server
 
@@ -332,26 +346,33 @@ testWithStoreLog =
         Right l -> pure l
         Left (_ :: SomeException) -> logSize
 
-testTiming :: Spec
-testTiming =
+testTiming :: ATransport -> Spec
+testTiming (ATransport t) =
   it "should have similar time for auth error, whether queue exists or not, for all key sizes" $
-    smpTest2 \rh sh ->
+    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, 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)
         ]
   where
     timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
     similarTime t1 t2 = abs (t1 - t2) / t1 < 0.2 `shouldBe` True
-    testSameTiming :: THandle -> THandle -> (Int, Int, Int) -> Expectation
+    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)
@@ -377,8 +398,8 @@ samplePubKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad
 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"
 
-syntaxTests :: Spec
-syntaxTests = do
+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")
@@ -414,3 +435,5 @@ syntaxTests = do
       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
+    command >#> response = smpServerTest t command `shouldReturn` response

tests/Test.hs

@@ -1,7 +1,10 @@
-import AgentTests
-import MarkdownTests
+{-# LANGUAGE TypeApplications #-}
+
+import AgentTests (agentTests)
 import ProtocolErrorTests
 import ServerTests
+import Simplex.Messaging.Transport (TCP, Transport (..))
+import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
 import Test.Hspec
 
@@ -9,8 +12,8 @@ main :: IO ()
 main = do
   createDirectoryIfMissing False "tests/tmp"
   hspec $ do
-    describe "SimpleX markdown" markdownTests
     describe "Protocol errors" protocolErrorTests
-    describe "SMP server" serverTests
-    describe "SMP client agent" agentTests
+    describe "SMP server via TCP" $ serverTests (transport @TCP)
+    describe "SMP server via WebSockets" $ serverTests (transport @WS)
+    describe "SMP client agent" $ agentTests (transport @TCP)
   removeDirectoryRecursive "tests/tmp"