migration

* make sending confirmation asynchronous

* confirm first queue synchronously (on JOIN, and delete connection on failure), second queue asynchronously (from REPLY msg)

* test to retry JOIN when the first attempt fails

* process confirmation delivery errors

.github/changelog_conf.json

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

.github/workflows/build.yml

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

.gitignore

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

CHANGELOG.md

@@ -1,3 +1,33 @@
+# 1.0.3
+
+SMP server:
+- Reduce server message queue quota to 128 messages.
+
+SMP agent:
+- Add "yes to migrations" option.
+- Make new SMP client attempt to reconnect on network error.
+- Reduce connection handshake expiration to 2 days.
+
+JSON encoding of types used in simplex-chat, some other minor adjustments.
+
+# 1.0.2
+
+General:
+- Enable TLS 1.3 parameters for TLS handshake (server and client).
+- Switch from hs-tls fork to original repo now that it supports getFinished and getPeerFinished APIs for both TLS 1.2 and TLS 1.3.
+
+SMP server:
+- Perform TLS handshake in a separate thread per-connection.
+
+SMP agent:
+- Cease attempts to send HELLO after one week timeout.
+- Coalesce requests to connect to SMP servers, to have 1 connection per server.
+
+# 1.0.1
+
+SMP server:
+- Explicitly set line buffering in stdout/stderr to log each line when output is redirected to files.
+
 # 1.0.0
 
 Security and privacy improvements:

README.md

@@ -27,11 +27,15 @@ SimpleXMQ is implemented in Haskell - it benefits from robust software transacti
 
 ### SMP server
 
-[SMP server](https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-server/Main.hs) can be run on any Linux distribution without any dependencies, including low power/low memory devices. It uses in-memory persistence with an optional append-only log of created queues that allows to re-start the server without losing the connections. This log is compacted on every server restart, permanently removing suspended and removed queues.
+[SMP server](https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-server/Main.hs) can be run on any Linux distribution without any dependencies, including low power/low memory devices.
 
-To enable the queue logging, uncomment `enable: on` option in `smp-server.ini` configuration file that is created the first time the server is started.
+To initialize the server use `smp-server init` command - it will generate keys and certificates for TLS transport. The fingerprint of offline certificate is used as part of the server address to protect client/server connection against man-in-the-middle attacks: `smp://<fingerprint>@<hostname>[:5223]`.
 
-To initialize the server use `smp-server init` command - it will generate keys and certificates for TLS transport. The fingerprint of offline certificate is used as part of the server address to protect client/server connection against man-in-the-middle attacks: `smp://<fingerprint>@<hostname>:5223`.
+SMP server uses in-memory persistence with an optional append-only log of created queues that allows to re-start the server without losing the connections. This log is compacted on every server restart, permanently removing suspended and removed queues.
+
+To enable store log, initialize server using `smp-server -l` command, or modify `smp-server.ini` created during initialization (uncomment `enable: on` option in the store log section). Use `smp-server --help` for other usage tips.
+
+> **Please note:** On initialization SMP server creates a chain of two certificates: a self-signed CA certificate ("offline") and a server certificate used for TLS handshake ("online"). **You should store CA certificate private key securely and delete it from the server. If server TLS credential is compromised this key can be used to sign a new one, keeping the same server identity and established connections.** CA private key location by default is `/etc/opt/simplex/ca.key`.
 
 SMP server implements [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md).
 
@@ -75,10 +79,11 @@ See [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI for
 
 You can either run your own SMP server locally or deploy using [Linode StackScript](https://cloud.linode.com/stackscripts/748014), or try local SMP agent with the deployed servers:
 
-<!-- TODO update -->
+`smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im`
 
-`smp2.simplex.im#z5W2QLQ1Br3Yd6CoWg7bIq1bHdwK7Y8bEiEXBs/WfAg=` (London, UK)
-`smp3.simplex.im#nxc7HnrnM8dOKgkMp008ub/9o9LXJlxlMrMpR+mfMQw=` (Fremont, CA)
+`smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im`
+
+`smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im`
 
 It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI.
 
@@ -93,10 +98,12 @@ Deployment on Linode is performed via StackScripts, which serve as recipes for L
 - 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, fingerprint, 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 create tags), 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).
+    - SMP Server store log flag for queue persistence on server restart, recommended.
+    - [Linode API token](https://www.linode.com/docs/guides/getting-started-with-the-linode-api#get-an-access-token) to attach server address etc. as tags to Linode and to add A record to your 2nd level domain (e.g. `example.com` [domain should be created](https://cloud.linode.com/domains/create) in your account prior to deployment). The API token access scopes:
+      - read/write for "linodes"
+      - read/write for "domains"
+    - Domain name to use instead of Linode IP address, e.g. `smp1.example.com`.
+- Choose the region and plan, Shared CPU Nanode with 1Gb is sufficient.
 - Provide ssh key to be able to connect to your Linode via ssh. If you haven't provided a Linode API token this step is required to login to your Linode and get the server's fingerprint either from the welcome message or from the file `/etc/opt/simplex/fingerprint` after server starts. See [Linode's guide on ssh](https://www.linode.com/docs/guides/use-public-key-authentication-with-ssh/) .
 - Deploy your Linode. After it starts wait for SMP server to start and for tags to appear (if a Linode API token was provided). It may take up to 5 minutes depending on the connection speed on the Linode. Connecting Linode IP address to provided domain name may take some additional time.
 - Get `address` and `fingerprint` either from Linode tags (click on a tag and copy it's value from the browser search panel) or via ssh.
@@ -108,6 +115,8 @@ Please submit an [issue](https://github.com/simplex-chat/simplexmq/issues) if an
 
 ## Deploy SMP server on DigitalOcean
 
+> 🚧 DigitalOcean snapshot is currently not up to date, it will soon be updated 🏗️
+
 \* When creating a DigitalOcean account you can use [this link](https://try.digitalocean.com/freetrialoffer/) to get free credit. (You would still be required either to provide your credit card details or make a confirmation pre-payment with PayPal)
 
 To deploy SMP server use [SimpleX Server 1-click app](https://marketplace.digitalocean.com/apps/simplex-server) from DigitalOcean marketplace:
@@ -116,11 +125,18 @@ To deploy SMP server use [SimpleX Server 1-click app](https://marketplace.digita
 - Click 'Create SimpleX server Droplet' button.
 - Choose the region and plan according to your requirements (Basic plan should be sufficient).
 - Finalize Droplet creation.
-- Open "Console" on your Droplet management page to get SMP server fingerprint - either from the welcome message or from `/etc/opt/simplex/fingerprint`. Alternatively you can manually SSH to created Droplet, see [instruction](https://docs.digitalocean.com/products/droplets/how-to/connect-with-ssh/).
+- Open "Console" on your Droplet management page to get SMP server fingerprint - either from the welcome message or from `/etc/opt/simplex/fingerprint`. Alternatively you can manually SSH to created Droplet, see [DigitalOcean instruction](https://docs.digitalocean.com/products/droplets/how-to/connect-with-ssh/).
 - Great, your own SMP server is ready! Use `smp://<fingerprint>@<ip_address>` as SMP server address in the client.
 
 Please submit an [issue](https://github.com/simplex-chat/simplexmq/issues) if any problems occur.
 
+> **Please note:** SMP server uses server address as a Common Name for server certificate generated during initialization. If you would like your server address to be FQDN instead of IP address, you can log in to your Droplet and run the commands below to re-initialize the server. Alternatively you can use [Linode StackScript](https://cloud.linode.com/stackscripts/748014) which allows this parameterization.
+
+```sh
+smp-server delete
+smp-server init [-l] -n <fqdn>
+```
+
 ## SMP server design
 
 ![SMP server design](https://raw.githubusercontent.com/simplex-chat/simplexmq/master/design/server.svg)

apps/smp-agent/Main.hs

@@ -6,12 +6,12 @@ module Main where
 
 import Control.Logger.Simple
 import qualified Data.List.NonEmpty as L
-import Simplex.Messaging.Agent (runSMPAgent)
 import Simplex.Messaging.Agent.Env.SQLite
+import Simplex.Messaging.Agent.Server (runSMPAgent)
 import Simplex.Messaging.Transport (TLS, Transport (..))
 
 cfg :: AgentConfig
-cfg = defaultAgentConfig {smpServers = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"]}
+cfg = defaultAgentConfig {initialSMPServers = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"]}
 
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}

apps/smp-server/Main.hs

@@ -22,12 +22,13 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath)
-import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..), loadFingerprint, simplexMQVersion)
+import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..), simplexMQVersion)
+import Simplex.Messaging.Transport.Server (loadFingerprint)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeDirectoryRecursive)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
-import System.IO (IOMode (..), hGetLine, withFile)
+import System.IO (BufferMode (..), IOMode (..), hGetLine, hSetBuffering, stderr, stdout, withFile)
 import System.Process (readCreateProcess, shell)
 import Text.Read (readMaybe)
 
@@ -256,6 +257,8 @@ mkIniOptions ini =
 
 runServer :: IniOptions -> IO ()
 runServer IniOptions {enableStoreLog, port, enableWebsockets} = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stderr LineBuffering
   fp <- checkSavedFingerprint
   printServiceInfo fp
   storeLog <- openStoreLog
@@ -274,8 +277,8 @@ runServer IniOptions {enableStoreLog, port, enableWebsockets} = do
       ServerConfig
         { transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets],
           tbqSize = 16,
-          serverTbqSize = 128,
-          msgQueueQuota = 256,
+          serverTbqSize = 64,
+          msgQueueQuota = 128,
           queueIdBytes = 24,
           msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
           caCertificateFile = caCrtFile,

cabal.project

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

migrations/README.md

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

package.yaml

@@ -1,5 +1,5 @@
 name: simplexmq
-version: 1.0.0
+version: 1.0.3
 synopsis: SimpleXMQ message broker
 description:  |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -15,20 +15,19 @@ homepage: https://github.com/simplex-chat/simplexmq#readme
 license: AGPL-3
 author: simplex.chat
 maintainer: chat@simplex.chat
-copyright: 2020 simplex.chat
+copyright: 2020-2022 simplex.chat
 category: Chat, Network, Web, System, Cryptography
 extra-source-files:
   - README.md
   - CHANGELOG.md
-  - migrations/*.*
 
 dependencies:
-  - aeson == 1.5.*
+  - aeson == 2.0.*
   - ansi-terminal >= 0.10 && < 0.12
   - asn1-encoding == 0.9.*
   - asn1-types == 0.3.*
   - async == 2.2.*
-  - attoparsec == 0.13.*
+  - attoparsec == 0.14.*
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
   - bytestring == 0.10.*
@@ -40,7 +39,6 @@ dependencies:
   - data-default == 0.7.*
   - direct-sqlite == 2.3.*
   - directory == 1.3.*
-  - file-embed >= 0.0.14.0 && <= 0.0.15.0
   - filepath == 1.4.*
   - http-types == 0.12.*
   - generic-random >= 1.3 && < 1.5
@@ -57,7 +55,7 @@ dependencies:
   - template-haskell == 2.16.*
   - text == 1.2.*
   - time == 1.9.*
-  - tls == 1.5.*
+  - tls >= 1.5.7 && < 1.6
   - transformers == 0.5.*
   - unliftio == 0.2.*
   - unliftio-core == 0.2.*

protocol/simplex-messaging.md

@@ -835,7 +835,7 @@ smpVersion = 2*2OCTET ; Word16 version number
 pad = *OCTET
 ```
 
-For TLS 1.3 transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `serverHello` block to allow communication over some other transport protocol (possibly, with another channel binding).
+For TLS transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `serverHello` block to allow communication over some other transport protocol (possibly, with another channel binding).
 
 [1]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack
 [2]: https://en.wikipedia.org/wiki/End-to-end_encryption
@@ -852,4 +852,4 @@ For TLS 1.3 transport client should assert that `sessionIdentifier` is equal to
 [13]: https://datatracker.ietf.org/doc/html/rfc8446
 [14]: https://datatracker.ietf.org/doc/html/rfc5929#section-3
 [15]: https://www.rfc-editor.org/rfc/rfc8709.html
-[16]: https://nacl.cr.yp.to/box.html
+[16]: https://nacl.cr.yp.to/box.html

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

@@ -1,10 +1,4 @@
-# Server image for DigitalOcean
-
-<!-- TODO tested on a fresh DO droplet and this seems to be wrong - we have to update the image to behave as described.
-
-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. -->
+# SMP server image for DigitalOcean
 
 ## How to build an image
 
@@ -22,3 +16,8 @@ brew install hashicorp/tap/packer
 cd ./scripts/smp-server-digitalocean-droplet
 DIGITALOCEAN_TOKEN=$YOUR_TOKEN packer build -on-error=ask -color=false ./marketplace-image.json
 ```
+
+**TODO** (see Linode script)
+
+- Increase file descriptors limit
+- Configure Restart for systemd service

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

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

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

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

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

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

scripts/smp-server-linode.sh

@@ -44,6 +44,12 @@ ufw allow ssh
 ufw allow https
 ufw allow 5223
 
+# Increase file descriptors limit
+echo 'fs.file-max = 1000000' >> /etc/sysctl.conf
+echo 'fs.inode-max = 1000000' >> /etc/sysctl.conf
+echo 'root soft nofile unlimited' >> /etc/security/limits.conf
+echo 'root hard nofile unlimited' >> /etc/security/limits.conf
+
 # Download latest release
 bin_dir="/opt/simplex/bin"
 binary="$bin_dir/smp-server"
@@ -52,12 +58,12 @@ curl -L -o $binary https://github.com/simplex-chat/simplexmq/releases/latest/dow
 chmod +x $binary
 
 # / Add to PATH
-cat <<EOT >> /etc/profile.d/simplex.sh
+cat > /etc/profile.d/simplex.sh << EOF
 #!/bin/bash
 
 export PATH="$PATH:$bin_dir"
 
-EOT
+EOF
 # Add to PATH /
 
 # Source and test PATH
@@ -94,13 +100,13 @@ fi
 on_login_script="/opt/simplex/on_login.sh"
 
 # / Welcome script
-cat <<EOT >> $on_login_script
+cat > $on_login_script << EOF
 #!/bin/bash
 
 fingerprint=\$1
 server_address=\$2
 
-cat <<EOF
+cat << EOF2
 ********************************************************************************
 
 SMP server address: smp://\$fingerprint@\$server_address
@@ -111,9 +117,9 @@ All ports are BLOCKED except 22 (SSH), 443 (HTTPS), 5223 (SMP server).
 
 ********************************************************************************
 To stop seeing this message delete line - bash /opt/simplex/on_login.sh - from /root/.bashrc
-EOF
+EOF2
 
-EOT
+EOF
 # Welcome script /
 
 chmod +x $on_login_script
@@ -139,23 +145,27 @@ if [[ -n "$API_TOKEN" ]]; then
   curl \
     -s -H "Content-Type: application/json" \
     -H "Authorization: Bearer $API_TOKEN" \
-    -X PUT -d "{\"tags\":[\"$server_address\",\"#$fingerprint\",\"$version\"]}" \
+    -X PUT -d "{\"tags\":[\"$server_address\",\"$fingerprint\",\"$version\"]}" \
     https://api.linode.com/v4/linode/instances/$LINODE_ID
 fi
 
 # / Create systemd service
-cat <<EOT >> /etc/systemd/system/smp-server.service
+cat > /etc/systemd/system/smp-server.service << EOF
 [Unit]
-Description=SMP server systemd service
+Description=SMP server
 
 [Service]
 Type=simple
-ExecStart=/bin/sh -c "$binary start"
+ExecStart=/bin/sh -c "exec $binary start >> /var/opt/simplex/smp-server.log 2>&1"
+Restart=always
+RestartSec=10
+LimitNOFILE=1000000
+LimitNOFILESoft=1000000
 
 [Install]
 WantedBy=multi-user.target
 
-EOT
+EOF
 # Create systemd service /
 
 # Start systemd service

simplexmq.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        1.0.0
+version:        1.0.3
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -19,15 +19,13 @@ category:       Chat, Network, Web, System, Cryptography
 homepage:       https://github.com/simplex-chat/simplexmq#readme
 author:         simplex.chat
 maintainer:     chat@simplex.chat
-copyright:      2020 simplex.chat
+copyright:      2020-2022 simplex.chat
 license:        AGPL-3
 license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
     README.md
     CHANGELOG.md
-    migrations/20220101_initial.sql
-    migrations/README.md
 
 library
   exposed-modules:
@@ -37,9 +35,13 @@ library
       Simplex.Messaging.Agent.Protocol
       Simplex.Messaging.Agent.QueryString
       Simplex.Messaging.Agent.RetryInterval
+      Simplex.Messaging.Agent.Server
       Simplex.Messaging.Agent.Store
       Simplex.Messaging.Agent.Store.SQLite
       Simplex.Messaging.Agent.Store.SQLite.Migrations
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220320_server_ips
       Simplex.Messaging.Client
       Simplex.Messaging.Crypto
       Simplex.Messaging.Crypto.Ratchet
@@ -55,6 +57,8 @@ library
       Simplex.Messaging.Server.QueueStore.STM
       Simplex.Messaging.Server.StoreLog
       Simplex.Messaging.Transport
+      Simplex.Messaging.Transport.Client
+      Simplex.Messaging.Transport.Server
       Simplex.Messaging.Transport.WebSockets
       Simplex.Messaging.Util
       Simplex.Messaging.Version
@@ -65,12 +69,12 @@ library
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
   build-depends:
       QuickCheck ==2.14.*
-    , aeson ==1.5.*
+    , aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
@@ -82,7 +86,6 @@ library
     , data-default ==0.7.*
     , 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.*
@@ -98,7 +101,7 @@ library
     , template-haskell ==2.16.*
     , text ==1.2.*
     , time ==1.9.*
-    , tls ==1.5.*
+    , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -117,12 +120,12 @@ executable smp-agent
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       QuickCheck ==2.14.*
-    , aeson ==1.5.*
+    , aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
@@ -134,7 +137,6 @@ executable smp-agent
     , data-default ==0.7.*
     , 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.*
@@ -151,7 +153,7 @@ executable smp-agent
     , template-haskell ==2.16.*
     , text ==1.2.*
     , time ==1.9.*
-    , tls ==1.5.*
+    , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -170,12 +172,12 @@ executable smp-server
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       QuickCheck ==2.14.*
-    , aeson ==1.5.*
+    , aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
@@ -187,7 +189,6 @@ executable smp-server
     , data-default ==0.7.*
     , 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.*
@@ -207,7 +208,7 @@ executable smp-server
     , template-haskell ==2.16.*
     , text ==1.2.*
     , time ==1.9.*
-    , tls ==1.5.*
+    , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -239,12 +240,12 @@ test-suite smp-server-test
   build-depends:
       HUnit ==1.6.*
     , QuickCheck ==2.14.*
-    , aeson ==1.5.*
+    , aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
@@ -256,7 +257,6 @@ test-suite smp-server-test
     , data-default ==0.7.*
     , 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.*
@@ -276,7 +276,7 @@ test-suite smp-server-test
     , text ==1.2.*
     , time ==1.9.*
     , timeit ==2.0.*
-    , tls ==1.5.*
+    , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*

src/Simplex/Messaging/Agent.hs

@@ -26,11 +26,7 @@
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md
 module Simplex.Messaging.Agent
-  ( -- * SMP agent over TCP
-    runSMPAgent,
-    runSMPAgentBlocking,
-
-    -- * queue-based SMP agent
+  ( -- * queue-based SMP agent
     getAgentClient,
     runAgentClient,
 
@@ -51,6 +47,8 @@ module Simplex.Messaging.Agent
     ackMessage,
     suspendConnection,
     deleteConnection,
+    setSMPServers,
+    logConnection,
   )
 where
 
@@ -62,7 +60,6 @@ import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
 import Data.Bifunctor (first, second)
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.))
 import Data.Functor (($>))
 import Data.List.NonEmpty (NonEmpty (..))
@@ -70,7 +67,6 @@ 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 Data.Time.Clock.System (systemToUTCTime)
 import Database.SQLite.Simple (SQLError)
@@ -87,7 +83,6 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (parse)
 import Simplex.Messaging.Protocol (MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), loadTLSServerParams, runTransportServer, simplexMQVersion)
 import Simplex.Messaging.Util (bshow, liftError, tryError, unlessM)
 import Simplex.Messaging.Version
 import System.Random (randomR)
@@ -95,33 +90,6 @@ import UnliftIO.Async (async, race_)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
--- | Runs an SMP agent as a TCP service using passed configuration.
---
--- See a full agent executable here: https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-agent/Main.hs
-runSMPAgent :: (MonadRandom m, MonadUnliftIO m) => ATransport -> AgentConfig -> m ()
-runSMPAgent t cfg = do
-  started <- newEmptyTMVarIO
-  runSMPAgentBlocking t started cfg
-
--- | Runs an SMP agent as a TCP service using passed configuration with signalling.
---
--- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
--- and when it is disconnected from the TCP socket once the server thread is killed (False).
-runSMPAgentBlocking :: (MonadRandom m, MonadUnliftIO m) => ATransport -> TMVar Bool -> AgentConfig -> m ()
-runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, caCertificateFile, certificateFile, privateKeyFile} = do
-  runReaderT (smpAgent t) =<< newSMPAgentEnv cfg
-  where
-    smpAgent :: forall c m'. (Transport c, MonadUnliftIO m', MonadReader Env m') => TProxy c -> m' ()
-    smpAgent _ = do
-      -- tlsServerParams is not in Env to avoid breaking functional API w/t key and certificate generation
-      tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
-      runTransportServer started tcpPort tlsServerParams $ \(h :: c) -> do
-        liftIO . putLn h $ "Welcome to SMP agent v" <> B.pack simplexMQVersion
-        c <- getAgentClient
-        logConnection c True
-        race_ (connectClient h c) (runAgentClient c)
-          `E.finally` disconnectAgentClient c
-
 -- | Creates an SMP agent client instance
 getSMPAgentClient :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> m AgentClient
 getSMPAgentClient cfg = newSMPAgentEnv cfg >>= runReaderT runAgent
@@ -176,6 +144,10 @@ suspendConnection c = withAgentEnv c . suspendConnection' c
 deleteConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
 deleteConnection c = withAgentEnv c . deleteConnection' c
 
+-- | Change servers to be used for creating new queues
+setSMPServers :: AgentErrorMonad m => AgentClient -> NonEmpty SMPServer -> m ()
+setSMPServers c = withAgentEnv c . setSMPServers' c
+
 withAgentEnv :: AgentClient -> ReaderT Env m a -> m a
 withAgentEnv c = (`runReaderT` agentEnv c)
 
@@ -186,9 +158,6 @@ withAgentEnv c = (`runReaderT` agentEnv c)
 getAgentClient :: (MonadUnliftIO m, MonadReader Env m) => m AgentClient
 getAgentClient = ask >>= atomically . newAgentClient
 
-connectClient :: Transport c => MonadUnliftIO m => c -> AgentClient -> m ()
-connectClient h c = race_ (send h c) (receive h c)
-
 logConnection :: MonadUnliftIO m => AgentClient -> Bool -> m ()
 logConnection c connected =
   let event = if connected then "connected to" else "disconnected from"
@@ -198,28 +167,6 @@ logConnection c connected =
 runAgentClient :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
 runAgentClient c = race_ (subscriber c) (client c)
 
-receive :: forall c m. (Transport c, MonadUnliftIO m) => c -> AgentClient -> m ()
-receive h c@AgentClient {rcvQ, subQ} = forever $ do
-  (corrId, connId, cmdOrErr) <- tGet SClient h
-  case cmdOrErr of
-    Right cmd -> write rcvQ (corrId, connId, cmd)
-    Left e -> write subQ (corrId, connId, ERR e)
-  where
-    write :: TBQueue (ATransmission p) -> ATransmission p -> m ()
-    write q t = do
-      logClient c "-->" t
-      atomically $ writeTBQueue q t
-
-send :: (Transport c, MonadUnliftIO m) => c -> AgentClient -> m ()
-send h c@AgentClient {subQ} = forever $ do
-  t <- atomically $ readTBQueue subQ
-  tPut h t
-  logClient c "<--" t
-
-logClient :: MonadUnliftIO m => AgentClient -> ByteString -> ATransmission a -> m ()
-logClient AgentClient {clientId} dir (corrId, connId, cmd) = do
-  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, connId, B.takeWhile (/= ' ') $ serializeCommand cmd]
-
 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
 client c@AgentClient {rcvQ, subQ} = forever $ do
   (corrId, connId, cmd) <- atomically $ readTBQueue rcvQ
@@ -267,7 +214,7 @@ processCommand c (connId, cmd) = case cmd of
 
 newConn :: AgentMonad m => AgentClient -> ConnId -> SConnectionMode c -> m (ConnId, ConnectionRequestUri c)
 newConn c connId cMode = do
-  srv <- getSMPServer
+  srv <- getSMPServer c
   (rq, qUri) <- newRcvQueue c srv
   g <- asks idsDrg
   let cData = ConnData {connId}
@@ -292,16 +239,20 @@ joinConn c connId (CRInvitationUri (ConnReqUriData _ agentVRange (qUri :| _)) e2
       (pk1, pk2, e2eSndParams) <- liftIO . CR.generateE2EParams $ version e2eRcvParams
       (_, rcDHRs) <- liftIO C.generateKeyPair'
       let rc = CR.initSndRatchet rcDHRr rcDHRs $ CR.x3dhSnd pk1 pk2 e2eRcvParams
-      (sq, smpConf) <- newSndQueue qInfo cInfo
+      sq <- newSndQueue qInfo
       g <- asks idsDrg
       let cData = ConnData {connId}
       connId' <- withStore $ \st -> do
         connId' <- createSndConn st g cData sq
         createRatchet st connId' rc
         pure connId'
-      confirmQueue c connId' sq smpConf $ Just e2eSndParams
-      void $ enqueueMessage c connId' sq HELLO
-      pure connId'
+      tryError (confirmQueue c connId' sq cInfo $ Just e2eSndParams) >>= \case
+        Right _ -> do
+          void $ enqueueMessage c connId' sq HELLO
+          pure connId'
+        Left e -> do
+          withStore (`deleteConn` connId')
+          throwError e
     _ -> throwError $ AGENT A_VERSION
 joinConn c connId (CRContactUri (ConnReqUriData _ agentVRange (qUri :| _))) cInfo =
   case ( qUri `compatibleVersion` SMP.smpClientVRange,
@@ -316,7 +267,7 @@ joinConn c connId (CRContactUri (ConnReqUriData _ agentVRange (qUri :| _))) cInf
 
 createReplyQueue :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> m ()
 createReplyQueue c connId sq = do
-  srv <- getSMPServer
+  srv <- getSMPServer c
   (rq, qUri) <- newRcvQueue c srv
   -- TODO reply queue version should be the same as send queue, ignoring it in v1
   let qInfo = toVersionT qUri SMP.smpClientVersion
@@ -363,16 +314,6 @@ subscribeConnection' c connId =
     SomeConn _ (DuplexConnection _ rq sq) -> do
       resumeMsgDelivery c connId sq
       subscribeQueue c rq connId
-      case status (sq :: SndQueue) of
-        Confirmed -> do
-          -- TODO if there is no confirmation saved, just update the status without securing the queue
-          AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <-
-            withStore (`getAcceptedConfirmation` connId)
-          secureQueue c rq senderKey
-          withStore $ \st -> setRcvQueueStatus st rq Secured
-        Secured -> pure ()
-        Active -> pure ()
-        _ -> throwError $ INTERNAL "unexpected queue status"
     SomeConn _ (SndConnection _ sq) -> do
       resumeMsgDelivery c connId sq
       case status (sq :: SndQueue) of
@@ -405,12 +346,12 @@ enqueueMessage c connId sq aMessage = do
       internalTs <- liftIO getCurrentTime
       (internalId, internalSndId, prevMsgHash) <- withStore (`updateSndIds` connId)
       let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
-          agentMessage = smpEncode $ AgentMessage privHeader aMessage
-          internalHash = C.sha256Hash agentMessage
-
-      encAgentMessage <- agentRatchetEncrypt connId agentMessage e2eEncUserMsgLength
+          agentMsg = AgentMessage privHeader aMessage
+          agentMsgStr = smpEncode agentMsg
+          internalHash = C.sha256Hash agentMsgStr
+      encAgentMessage <- agentRatchetEncrypt connId agentMsgStr e2eEncUserMsgLength
       let msgBody = smpEncode $ AgentMsgEnvelope {agentVersion = smpAgentVersion, encAgentMessage}
-          msgType = aMessageType aMessage
+          msgType = agentMessageType agentMsg
           msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, internalHash, prevMsgHash}
       withStore $ \st -> createSndMsg st connId msgData
       pure internalId
@@ -458,23 +399,40 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} connId sq = do
     withStore (\st -> E.try $ getPendingMsgData st connId msgId) >>= \case
       Left (e :: E.SomeException) ->
         notify $ MERR mId (INTERNAL $ show e)
-      Right (rq_, (msgType, msgBody)) ->
+      Right (rq_, (msgType, msgBody, internalTs)) ->
         withRetryInterval ri $ \loop ->
-          tryError (sendAgentMessage c sq msgBody) >>= \case
+          tryError (send msgType c sq msgBody) >>= \case
             Left e -> do
+              let err = if msgType == AM_CONN_INFO then ERR e else MERR mId e
               case e of
-                SMP SMP.QUOTA -> loop
+                SMP SMP.QUOTA -> case msgType of
+                  AM_CONN_INFO -> connError msgId NOT_AVAILABLE
+                  _ -> loop
                 SMP SMP.AUTH -> case msgType of
-                  HELLO_ -> loop
-                  REPLY_ -> notify (ERR e) >> delMsg msgId
-                  A_MSG_ -> notify (MERR mId e) >> delMsg msgId
-                SMP (SMP.CMD _) -> notify (MERR mId e) >> delMsg msgId
-                SMP SMP.LARGE_MSG -> notify (MERR mId e) >> delMsg msgId
-                SMP {} -> notify (MERR mId e) >> loop
+                  AM_CONN_INFO -> connError msgId NOT_AVAILABLE
+                  AM_HELLO_ -> do
+                    helloTimeout <- asks $ helloTimeout . config
+                    currentTime <- liftIO getCurrentTime
+                    if diffUTCTime currentTime internalTs > helloTimeout
+                      then case rq_ of
+                        -- party initiating connection
+                        Just _ -> connError msgId NOT_AVAILABLE
+                        -- party joining connection
+                        _ -> connError msgId NOT_ACCEPTED
+                      else loop
+                  AM_REPLY_ -> notifyDel msgId $ ERR e
+                  AM_A_MSG_ -> notifyDel msgId $ MERR mId e
+                SMP (SMP.CMD _) -> notifyDel msgId err
+                SMP SMP.LARGE_MSG -> notifyDel msgId err
+                SMP {} -> notify err >> loop
                 _ -> loop
             Right () -> do
               case msgType of
-                HELLO_ -> do
+                AM_CONN_INFO -> do
+                  withStore $ \st -> setSndQueueStatus st sq Confirmed
+                  when (isJust rq_) $ withStore (`removeConfirmations` connId)
+                  void $ enqueueMessage c connId sq HELLO
+                AM_HELLO_ -> do
                   withStore $ \st -> setSndQueueStatus st sq Active
                   case rq_ of
                     -- party initiating connection
@@ -483,14 +441,20 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} connId sq = do
                       notify CON
                     -- party joining connection
                     _ -> createReplyQueue c connId sq
-                A_MSG_ -> notify $ SENT mId
+                AM_A_MSG_ -> notify $ SENT mId
                 _ -> pure ()
               delMsg msgId
   where
+    send = \case
+      AM_CONN_INFO -> sendConfirmation
+      _ -> sendAgentMessage
     delMsg :: InternalId -> m ()
     delMsg msgId = withStore $ \st -> deleteMsg st connId msgId
     notify :: ACommand 'Agent -> m ()
     notify cmd = atomically $ writeTBQueue subQ ("", connId, cmd)
+    notifyDel :: InternalId -> ACommand 'Agent -> m ()
+    notifyDel msgId cmd = notify cmd >> delMsg msgId
+    connError msgId = notifyDel msgId . ERR . CONN
 
 ackMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> AgentMsgId -> m ()
 ackMessage' c connId msgId = do
@@ -529,9 +493,15 @@ deleteConnection' c connId =
       removeSubscription c connId
       withStore (`deleteConn` connId)
 
-getSMPServer :: AgentMonad m => m SMPServer
-getSMPServer =
-  asks (smpServers . config) >>= \case
+-- | Change servers to be used for creating new queues, in Reader monad
+setSMPServers' :: forall m. AgentMonad m => AgentClient -> NonEmpty SMPServer -> m ()
+setSMPServers' c servers = do
+  atomically $ writeTVar (smpServers c) servers
+
+getSMPServer :: AgentMonad m => AgentClient -> m SMPServer
+getSMPServer c = do
+  smpServers <- readTVarIO $ smpServers c
+  case smpServers of
     srv :| [] -> pure srv
     servers -> do
       gen <- asks randomServer
@@ -576,8 +546,9 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
                 (SMP.PHEmpty, AgentMsgEnvelope _ encAgentMsg) -> do
                   agentMsgBody <- agentRatchetDecrypt connId encAgentMsg
                   parseMessage agentMsgBody >>= \case
-                    AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage -> do
-                      (msgId, msgMeta) <- agentClientMsg prevMsgHash sndMsgId (srvMsgId, systemToUTCTime srvTs) agentMsgBody aMessage
+                    agentMsg@(AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage) -> do
+                      let msgType = agentMessageType agentMsg
+                      (msgId, msgMeta) <- agentClientMsg prevMsgHash sndMsgId (srvMsgId, systemToUTCTime srvTs) agentMsgBody msgType
                       case aMessage of
                         HELLO -> helloMsg >> ack >> withStore (\st -> deleteMsg st connId msgId)
                         REPLY cReq -> replyMsg cReq >> ack >> withStore (\st -> deleteMsg st connId msgId)
@@ -667,15 +638,13 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
               case qInfo `proveCompatible` SMP.smpClientVRange of
                 Nothing -> notify . ERR $ AGENT A_VERSION
                 Just qInfo' -> do
-                  (sq, smpConf) <- newSndQueue qInfo' ownConnInfo
+                  sq <- newSndQueue qInfo'
                   withStore $ \st -> upgradeRcvConnToDuplex st connId sq
-                  confirmQueue c connId sq smpConf Nothing
-                  withStore (`removeConfirmations` connId)
-                  void $ enqueueMessage c connId sq HELLO
+                  enqueueConfirmation c connId sq ownConnInfo Nothing
             _ -> prohibited
 
-        agentClientMsg :: PrevRcvMsgHash -> ExternalSndId -> (BrokerId, BrokerTs) -> MsgBody -> AMessage -> m (InternalId, MsgMeta)
-        agentClientMsg externalPrevSndHash sndMsgId broker msgBody aMessage = do
+        agentClientMsg :: PrevRcvMsgHash -> ExternalSndId -> (BrokerId, BrokerTs) -> MsgBody -> AgentMessageType -> m (InternalId, MsgMeta)
+        agentClientMsg externalPrevSndHash sndMsgId broker msgBody msgType = do
           logServer "<--" c srv rId "MSG <MSG>"
           let internalHash = C.sha256Hash msgBody
           internalTs <- liftIO getCurrentTime
@@ -683,7 +652,6 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
           let integrity = checkMsgIntegrity prevExtSndId sndMsgId prevRcvMsgHash externalPrevSndHash
               recipient = (unId internalId, internalTs)
               msgMeta = MsgMeta {integrity, recipient, broker, sndMsgId}
-              msgType = aMessageType aMessage
               rcvMsg = RcvMsgData {msgMeta, msgType, msgBody, internalRcvId, internalHash, externalPrevSndHash}
           withStore $ \st -> createRcvMsg st connId rcvMsg
           pure (internalId, msgMeta)
@@ -708,8 +676,9 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
           | internalPrevMsgHash /= receivedPrevMsgHash = MsgError MsgBadHash
           | otherwise = MsgError MsgDuplicate -- this case is not possible
 
-confirmQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> SMPConfirmation -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
-confirmQueue c connId sq SMPConfirmation {senderKey, e2ePubKey, connInfo} e2eEncryption = do
+confirmQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
+confirmQueue c connId sq connInfo e2eEncryption = do
+  _ <- withStore (`updateSndIds` connId)
   msg <- mkConfirmation
   sendConfirmation c sq msg
   withStore $ \st -> setSndQueueStatus st sq Confirmed
@@ -717,9 +686,27 @@ confirmQueue c connId sq SMPConfirmation {senderKey, e2ePubKey, connInfo} e2eEnc
     mkConfirmation :: m MsgBody
     mkConfirmation = do
       encConnInfo <- agentRatchetEncrypt connId (smpEncode $ AgentConnInfo connInfo) e2eEncConnInfoLength
-      let agentEnvelope = AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo}
-      agentCbEncrypt sq (Just e2ePubKey) . smpEncode $
-        SMP.ClientMessage (SMP.PHConfirmation senderKey) $ smpEncode agentEnvelope
+      pure . smpEncode $ AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo}
+
+enqueueConfirmation :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
+enqueueConfirmation c connId sq connInfo e2eEncryption = do
+  resumeMsgDelivery c connId sq
+  msgId <- storeConfirmation
+  queuePendingMsgs c connId sq [msgId]
+  where
+    storeConfirmation :: m InternalId
+    storeConfirmation = do
+      internalTs <- liftIO getCurrentTime
+      (internalId, internalSndId, prevMsgHash) <- withStore (`updateSndIds` connId)
+      let agentMsg = AgentConnInfo connInfo
+          agentMsgStr = smpEncode agentMsg
+          internalHash = C.sha256Hash agentMsgStr
+      encConnInfo <- agentRatchetEncrypt connId agentMsgStr e2eEncConnInfoLength
+      let msgBody = smpEncode $ AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo}
+          msgType = agentMessageType agentMsg
+          msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, internalHash, prevMsgHash}
+      withStore $ \st -> createSndMsg st connId msgData
+      pure internalId
 
 -- encoded AgentMessage -> encoded EncAgentMessage
 agentRatchetEncrypt :: AgentMonad m => ConnId -> ByteString -> Int -> m ByteString
@@ -741,27 +728,27 @@ agentRatchetDecrypt connId encAgentMsg = do
 notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m ()
 notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON)
 
-newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => Compatible SMPQueueInfo -> ConnInfo -> m (SndQueue, SMPConfirmation)
-newSndQueue qInfo cInfo =
+newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => Compatible SMPQueueInfo -> m SndQueue
+newSndQueue qInfo =
   asks (cmdSignAlg . config) >>= \case
-    C.SignAlg a -> newSndQueue_ a qInfo cInfo
+    C.SignAlg a -> newSndQueue_ a qInfo
 
 newSndQueue_ ::
   (C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m) =>
   C.SAlgorithm a ->
   Compatible SMPQueueInfo ->
-  ConnInfo ->
-  m (SndQueue, SMPConfirmation)
-newSndQueue_ a (Compatible (SMPQueueInfo _clientVersion smpServer senderId rcvE2ePubDhKey)) cInfo = do
+  m SndQueue
+newSndQueue_ a (Compatible (SMPQueueInfo _clientVersion smpServer senderId rcvE2ePubDhKey)) = do
   -- this function assumes clientVersion is compatible - it was tested before
-  (senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
+  (sndPublicKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
   (e2ePubKey, e2ePrivKey) <- liftIO C.generateKeyPair'
-  let sndQueue =
-        SndQueue
-          { server = smpServer,
-            sndId = senderId,
-            sndPrivateKey,
-            e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
-            status = New
-          }
-  pure (sndQueue, SMPConfirmation senderKey e2ePubKey cInfo)
+  pure
+    SndQueue
+      { server = smpServer,
+        sndId = senderId,
+        sndPublicKey = Just sndPublicKey,
+        sndPrivateKey,
+        e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
+        e2ePubKey = Just e2ePubKey,
+        status = New
+      }

src/Simplex/Messaging/Agent/Client.hs

@@ -36,7 +36,8 @@ module Simplex.Messaging.Agent.Client
   )
 where
 
-import Control.Concurrent.Async (Async, async, uninterruptibleCancel)
+import Control.Concurrent (forkIO)
+import Control.Concurrent.Async (Async, uninterruptibleCancel)
 import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
 import Control.Monad.Except
@@ -46,6 +47,7 @@ import Data.Bifunctor (first)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (isNothing)
@@ -61,23 +63,30 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol (QueueId, QueueIdsKeys (..), SndPublicVerifyKey)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Util (bshow, liftEitherError, liftError)
+import Simplex.Messaging.Util (bshow, liftEitherError, liftError, tryError)
 import Simplex.Messaging.Version
+import System.Timeout (timeout)
+import UnliftIO (async)
 import UnliftIO.Exception (Exception, IOException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
+type SMPClientVar = TMVar (Either AgentErrorType SMPClient)
+
 data AgentClient = AgentClient
   { rcvQ :: TBQueue (ATransmission 'Client),
     subQ :: TBQueue (ATransmission 'Agent),
     msgQ :: TBQueue SMPServerTransmission,
-    smpClients :: TVar (Map SMPServer SMPClient),
+    smpServers :: TVar (NonEmpty SMPServer),
+    smpClients :: TVar (Map SMPServer SMPClientVar),
     subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
+    pendingSubscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
     subscrConns :: TVar (Map ConnId SMPServer),
     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 ()],
+    asyncClients :: TVar [Async ()],
     clientId :: Int,
     agentEnv :: Env,
     smpSubscriber :: Async (),
@@ -90,16 +99,19 @@ newAgentClient agentEnv = do
   rcvQ <- newTBQueue qSize
   subQ <- newTBQueue qSize
   msgQ <- newTBQueue qSize
+  smpServers <- newTVar $ initialSMPServers (config agentEnv)
   smpClients <- newTVar M.empty
   subscrSrvrs <- newTVar M.empty
+  pendingSubscrSrvrs <- newTVar M.empty
   subscrConns <- newTVar M.empty
   connMsgsQueued <- newTVar M.empty
   smpQueueMsgQueues <- newTVar M.empty
   smpQueueMsgDeliveries <- newTVar M.empty
   reconnections <- newTVar []
+  asyncClients <- newTVar []
   clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1)
   lock <- newTMVar ()
-  return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, clientId, agentEnv, smpSubscriber = undefined, lock}
+  return AgentClient {rcvQ, subQ, msgQ, smpServers, smpClients, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, asyncClients, clientId, agentEnv, smpSubscriber = undefined, lock}
 
 -- | Agent monad with MonadReader Env and MonadError AgentErrorType
 type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)
@@ -118,15 +130,51 @@ instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where
 
 getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPServer -> m SMPClient
 getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
-  readTVarIO smpClients
-    >>= maybe newSMPClient return . M.lookup srv
+  atomically getClientVar >>= either newSMPClient waitForSMPClient
   where
-    newSMPClient :: m SMPClient
-    newSMPClient = do
-      smp <- connectClient
-      logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
-      atomically . modifyTVar smpClients $ M.insert srv smp
-      return smp
+    getClientVar :: STM (Either SMPClientVar SMPClientVar)
+    getClientVar = maybe (Left <$> newClientVar) (pure . Right) . M.lookup srv =<< readTVar smpClients
+
+    newClientVar :: STM SMPClientVar
+    newClientVar = do
+      smpVar <- newEmptyTMVar
+      modifyTVar smpClients $ M.insert srv smpVar
+      pure smpVar
+
+    waitForSMPClient :: TMVar (Either AgentErrorType SMPClient) -> m SMPClient
+    waitForSMPClient smpVar = do
+      SMPClientConfig {tcpTimeout} <- asks $ smpCfg . config
+      smpClient_ <- liftIO $ tcpTimeout `timeout` atomically (readTMVar smpVar)
+      liftEither $ case smpClient_ of
+        Just (Right smpClient) -> Right smpClient
+        Just (Left e) -> Left e
+        Nothing -> Left $ BROKER TIMEOUT
+
+    newSMPClient :: TMVar (Either AgentErrorType SMPClient) -> m SMPClient
+    newSMPClient smpVar = tryConnectClient pure tryConnectAsync
+      where
+        tryConnectClient :: (SMPClient -> m a) -> m () -> m a
+        tryConnectClient successAction retryAction =
+          tryError connectClient >>= \r -> case r of
+            Right smp -> do
+              logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
+              atomically $ putTMVar smpVar r
+              successAction smp
+            Left e -> do
+              if e == BROKER NETWORK || e == BROKER TIMEOUT
+                then retryAction
+                else atomically $ do
+                  putTMVar smpVar (Left e)
+                  modifyTVar smpClients $ M.delete srv
+              throwError e
+        tryConnectAsync :: m ()
+        tryConnectAsync = do
+          a <- async connectAsync
+          atomically $ modifyTVar (asyncClients c) (a :)
+        connectAsync :: m ()
+        connectAsync = do
+          ri <- asks $ reconnectInterval . config
+          withRetryInterval ri $ \loop -> void $ tryConnectClient (const reconnectClient) loop
 
     connectClient :: m SMPClient
     connectClient = do
@@ -149,33 +197,43 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
       cs <- M.lookup srv <$> readTVar (subscrSrvrs c)
       modifyTVar (subscrSrvrs c) $ M.delete srv
       modifyTVar (subscrConns c) $ maybe id (deleteKeys . M.keysSet) cs
+      mapM_ (modifyTVar (pendingSubscrSrvrs c) . addPendingSubs) cs
       return cs
       where
+        addPendingSubs :: Map ConnId RcvQueue -> Map SMPServer (Map ConnId RcvQueue) -> Map SMPServer (Map ConnId RcvQueue)
+        addPendingSubs cs = M.alter (Just . addSubs cs) srv
+        addSubs cs = maybe cs (M.union cs)
         deleteKeys :: Ord k => Set k -> Map k a -> Map k a
         deleteKeys ks m = S.foldr' M.delete m ks
 
     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
+      unliftIO u reconnectServer
+
+    reconnectServer :: m ()
+    reconnectServer = do
+      a <- async tryReconnectClient
       atomically $ modifyTVar (reconnections c) (a :)
 
-    tryReconnectClient :: Map ConnId RcvQueue -> m ()
-    tryReconnectClient cs = do
+    tryReconnectClient :: m ()
+    tryReconnectClient = do
       ri <- asks $ reconnectInterval . config
       withRetryInterval ri $ \loop ->
-        reconnectClient cs `catchError` const loop
+        reconnectClient `catchError` const loop
 
-    reconnectClient :: Map ConnId RcvQueue -> m ()
-    reconnectClient cs = do
+    reconnectClient :: m ()
+    reconnectClient = do
       withAgentLock c . withSMP c srv $ \smp -> do
         subs <- readTVarIO $ subscrConns c
-        forM_ (M.toList cs) $ \(connId, rq@RcvQueue {rcvPrivateKey, rcvId}) ->
+        cs <- M.lookup srv <$> readTVarIO (pendingSubscrSrvrs c)
+        forM_ (maybe [] 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
+                e@SMPResponseTimeout -> throwError e
+                e@SMPNetworkError -> throwError e
+                e -> liftIO $ notifySub (ERR $ smpClientError e) connId
             addSubscription c rq connId
             liftIO $ notifySub UP connId
 
@@ -186,10 +244,16 @@ closeAgentClient :: MonadUnliftIO m => AgentClient -> m ()
 closeAgentClient c = liftIO $ do
   closeSMPServerClients c
   cancelActions $ reconnections c
+  cancelActions $ asyncClients c
   cancelActions $ smpQueueMsgDeliveries c
 
 closeSMPServerClients :: AgentClient -> IO ()
-closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ closeSMPClient
+closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ (forkIO . closeClient)
+  where
+    closeClient smpVar =
+      atomically (readTMVar smpVar) >>= \case
+        Right smp -> closeSMPClient smp `E.catch` \(_ :: E.SomeException) -> pure ()
+        _ -> pure ()
 
 cancelActions :: Foldable f => TVar (f (Async ())) -> IO ()
 cancelActions as = readTVarIO as >>= mapM_ uninterruptibleCancel
@@ -269,26 +333,40 @@ newRcvQueue_ a c srv = 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 connId
+  addPendingSubscription c rq connId
+  withLogSMP c server rcvId "SUB" $ \smp -> do
+    liftIO (runExceptT $ subscribeSMPQueue smp rcvPrivateKey rcvId) >>= \case
+      Left e -> do
+        atomically . when (e /= SMPNetworkError && e /= SMPResponseTimeout) $
+          removePendingSubscription c server connId
+        throwError e
+      Right _ -> addSubscription c rq connId
 
 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 (Map ConnId RcvQueue) -> Map ConnId RcvQueue
-    addSub (Just cs) = M.insert connId rq cs
-    addSub _ = M.singleton connId rq
+  addSubs_ (subscrSrvrs c) rq connId
+  removePendingSubscription c server connId
 
-removeSubscription :: AgentMonad m => AgentClient -> ConnId -> m ()
-removeSubscription AgentClient {subscrConns, subscrSrvrs} connId = atomically $ do
-  cs <- readTVar subscrConns
-  writeTVar subscrConns $ M.delete connId cs
-  mapM_
-    (modifyTVar subscrSrvrs . M.alter (>>= delSub))
-    (M.lookup connId cs)
+addPendingSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnId -> m ()
+addPendingSubscription c rq connId =
+  atomically $ addSubs_ (pendingSubscrSrvrs c) rq connId
+
+addSubs_ :: TVar (Map SMPServer (Map ConnId RcvQueue)) -> RcvQueue -> ConnId -> STM ()
+addSubs_ ss rq@RcvQueue {server} connId = modifyTVar ss $ M.alter (Just . addSub) server
+  where
+    addSub = maybe (M.singleton connId rq) (M.insert connId rq)
+
+removeSubscription :: MonadUnliftIO m => AgentClient -> ConnId -> m ()
+removeSubscription c@AgentClient {subscrConns} connId = atomically $ do
+  server_ <- stateTVar subscrConns $ \cs -> (M.lookup connId cs, M.delete connId cs)
+  mapM_ (\server -> removeSubs_ (subscrSrvrs c) server connId) server_
+
+removePendingSubscription :: AgentClient -> SMPServer -> ConnId -> STM ()
+removePendingSubscription c = removeSubs_ (pendingSubscrSrvrs c)
+
+removeSubs_ :: TVar (Map SMPServer (Map ConnId RcvQueue)) -> SMPServer -> ConnId -> STM ()
+removeSubs_ ss server connId = modifyTVar ss $ M.update delSub server
   where
     delSub :: Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue)
     delSub cs =
@@ -306,11 +384,13 @@ showServer SMPServer {host, port} =
 logSecret :: ByteString -> ByteString
 logSecret bs = encode $ B.take 3 bs
 
--- TODO maybe package E2ERatchetParams into SMPConfirmation
 sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
-sendConfirmation c SndQueue {server, sndId} encConfirmation =
-  withLogSMP_ c server sndId "SEND <CONF>" $ \smp ->
-    liftSMP $ sendSMPMessage smp Nothing sndId encConfirmation
+sendConfirmation c sq@SndQueue {server, sndId, sndPublicKey = Just sndPublicKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation =
+  withLogSMP_ c server sndId "SEND <CONF>" $ \smp -> do
+    let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
+    msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
+    liftSMP $ sendSMPMessage smp Nothing sndId msg
+sendConfirmation _ _ _ = throwError $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
 
 sendInvitation :: forall m. AgentMonad m => AgentClient -> Compatible SMPQueueInfo -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> m ()
 sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) connReq connInfo =
@@ -345,7 +425,6 @@ deleteQueue c RcvQueue {server, rcvId, rcvPrivateKey} =
   withLogSMP c server rcvId "DEL" $ \smp ->
     deleteSMPQueue smp rcvPrivateKey rcvId
 
--- TODO this is just wrong
 sendAgentMessage :: forall m. AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
 sendAgentMessage c sq@SndQueue {server, sndId, sndPrivateKey} agentMsg =
   withLogSMP_ c server sndId "SEND <MSG>" $ \smp -> do

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

@@ -4,11 +4,18 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
-module Simplex.Messaging.Agent.Env.SQLite where
+module Simplex.Messaging.Agent.Env.SQLite
+  ( AgentConfig (..),
+    defaultAgentConfig,
+    Env (..),
+    newSMPAgentEnv,
+  )
+where
 
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.List.NonEmpty (NonEmpty)
+import Data.Time.Clock (NominalDiffTime, nominalDay)
 import Network.Socket
 import Numeric.Natural
 import Simplex.Messaging.Agent.Protocol (SMPServer)
@@ -22,45 +29,48 @@ import UnliftIO.STM
 
 data AgentConfig = AgentConfig
   { tcpPort :: ServiceName,
-    smpServers :: NonEmpty SMPServer,
+    initialSMPServers :: NonEmpty SMPServer,
     cmdSignAlg :: C.SignAlg,
     connIdBytes :: Int,
     tbqSize :: Natural,
     dbFile :: FilePath,
     dbPoolSize :: Int,
+    yesToMigrations :: Bool,
     smpCfg :: SMPClientConfig,
     reconnectInterval :: RetryInterval,
+    helloTimeout :: NominalDiffTime,
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
     certificateFile :: FilePath
   }
 
-minute :: Int
-minute = 60_000_000
-
 defaultAgentConfig :: AgentConfig
 defaultAgentConfig =
   AgentConfig
     { tcpPort = "5224",
-      smpServers = undefined, -- TODO move it elsewhere?
+      initialSMPServers = undefined, -- TODO move it elsewhere?
       cmdSignAlg = C.SignAlg C.SEd448,
       connIdBytes = 12,
-      tbqSize = 16,
+      tbqSize = 64,
       dbFile = "smp-agent.db",
       dbPoolSize = 4,
+      yesToMigrations = False,
       smpCfg = smpDefaultConfig,
       reconnectInterval =
         RetryInterval
-          { initialInterval = 1_000_000,
-            increaseAfter = 10_000_000,
-            maxInterval = 10_000_000
+          { initialInterval = second,
+            increaseAfter = 10 * second,
+            maxInterval = 10 * second
           },
+      helloTimeout = 2 * nominalDay,
       -- CA certificate private key is not needed for initialization
       -- ! we do not generate these
       caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
       privateKeyFile = "/etc/opt/simplex-agent/agent.key",
       certificateFile = "/etc/opt/simplex-agent/agent.crt"
     }
+  where
+    second = 1_000_000
 
 data Env = Env
   { config :: AgentConfig,
@@ -71,9 +81,9 @@ data Env = Env
   }
 
 newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env
-newSMPAgentEnv cfg = do
+newSMPAgentEnv config@AgentConfig {dbFile, dbPoolSize, yesToMigrations} = do
   idsDrg <- newTVarIO =<< drgNew
-  store <- liftIO $ createSQLiteStore (dbFile cfg) (dbPoolSize cfg) Migrations.app
+  store <- liftIO $ createSQLiteStore dbFile dbPoolSize Migrations.app yesToMigrations
   clientCounter <- newTVarIO 0
   randomServer <- newTVarIO =<< liftIO newStdGen
-  return Env {config = cfg, store, idsDrg, clientCounter, randomServer}
+  return Env {config, store, idsDrg, clientCounter, randomServer}

src/Simplex/Messaging/Agent/Protocol.hs

@@ -46,9 +46,9 @@ module Simplex.Messaging.Agent.Protocol
     SMPConfirmation (..),
     AgentMsgEnvelope (..),
     AgentMessage (..),
+    AgentMessageType (..),
     APrivHeader (..),
     AMessage (..),
-    AMsgType (..),
     SMPServer (..),
     SrvLoc (..),
     SMPQueueUri (..),
@@ -83,19 +83,13 @@ module Simplex.Messaging.Agent.Protocol
 
     -- * Encode/decode
     serializeCommand,
-    serializeMsgIntegrity,
     connMode,
     connMode',
-    serializeAgentError,
-    serializeSmpErrorType,
     commandP,
     connModeT,
-    msgIntegrityP,
-    agentErrorTypeP,
-    smpErrorTypeP,
     serializeQueueStatus,
     queueStatusT,
-    aMessageType,
+    agentMessageType,
 
     -- * TCP transport functions
     tPut,
@@ -108,6 +102,7 @@ where
 import Control.Applicative (optional, (<|>))
 import Control.Monad.IO.Class
 import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Base64
@@ -131,7 +126,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (E2ERatchetParams, E2ERatchetParamsUri)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (base64P, parse, parseRead, parseRead1, parseRead2, tsISO8601P)
+import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol
   ( ErrorType,
     MsgBody,
@@ -305,7 +300,7 @@ data AgentMsgEnvelope
       }
   | AgentInvitation -- the connInfo in contactInvite is only encrypted with per-queue E2E, not with double ratchet,
       { agentVersion :: Version,
-        connReq :: (ConnectionRequestUri 'CMInvitation),
+        connReq :: ConnectionRequestUri 'CMInvitation,
         connInfo :: ByteString -- this message is only encrypted with per-queue E2E, not with double ratchet,
       }
   deriving (Show)
@@ -348,6 +343,31 @@ instance Encoding AgentMessage where
       'M' -> AgentMessage <$> smpP <*> smpP
       _ -> fail "bad AgentMessage"
 
+data AgentMessageType = AM_CONN_INFO | AM_HELLO_ | AM_REPLY_ | AM_A_MSG_
+  deriving (Eq, Show)
+
+instance Encoding AgentMessageType where
+  smpEncode = \case
+    AM_CONN_INFO -> "C"
+    AM_HELLO_ -> "H"
+    AM_REPLY_ -> "R"
+    AM_A_MSG_ -> "M"
+  smpP =
+    A.anyChar >>= \case
+      'C' -> pure AM_CONN_INFO
+      'H' -> pure AM_HELLO_
+      'R' -> pure AM_REPLY_
+      'M' -> pure AM_A_MSG_
+      _ -> fail "bad AgentMessageType"
+
+agentMessageType :: AgentMessage -> AgentMessageType
+agentMessageType = \case
+  AgentConnInfo _ -> AM_CONN_INFO
+  AgentMessage _ aMsg -> case aMsg of
+    HELLO -> AM_HELLO_
+    REPLY _ -> AM_REPLY_
+    A_MSG _ -> AM_A_MSG_
+
 data APrivHeader = APrivHeader
   { -- | sequential ID assigned by the sending agent
     sndMsgId :: AgentMsgId,
@@ -376,12 +396,6 @@ instance Encoding AMsgType where
       'M' -> pure A_MSG_
       _ -> fail "bad AMsgType"
 
-aMessageType :: AMessage -> AMsgType
-aMessageType = \case
-  HELLO -> HELLO_
-  REPLY _ -> REPLY_
-  A_MSG _ -> A_MSG_
-
 -- | 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
@@ -618,29 +632,70 @@ queueStatusT = \case
 type AgentMsgId = Int64
 
 -- | Result of received message integrity validation.
-data MsgIntegrity = MsgOk | MsgError MsgErrorType
-  deriving (Eq, Show)
+data MsgIntegrity = MsgOk | MsgError {errorInfo :: MsgErrorType}
+  deriving (Eq, Show, Generic)
+
+instance StrEncoding MsgIntegrity where
+  strP = "OK" $> MsgOk <|> "ERR " *> (MsgError <$> strP)
+  strEncode = \case
+    MsgOk -> "OK"
+    MsgError e -> "ERR" <> strEncode e
+
+instance ToJSON MsgIntegrity where
+  toJSON = J.genericToJSON $ sumTypeJSON fstToLower
+  toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
+
+instance FromJSON MsgIntegrity where
+  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
 
 -- | Error of message integrity validation.
-data MsgErrorType = MsgSkipped AgentMsgId AgentMsgId | MsgBadId AgentMsgId | MsgBadHash | MsgDuplicate
-  deriving (Eq, Show)
+data MsgErrorType
+  = MsgSkipped {fromMsgId :: AgentMsgId, toMsgId :: AgentMsgId}
+  | MsgBadId {msgId :: AgentMsgId}
+  | MsgBadHash
+  | MsgDuplicate
+  deriving (Eq, Show, Generic)
+
+instance StrEncoding MsgErrorType where
+  strP =
+    "ID " *> (MsgBadId <$> A.decimal)
+      <|> "IDS " *> (MsgSkipped <$> A.decimal <* A.space <*> A.decimal)
+      <|> "HASH" $> MsgBadHash
+      <|> "DUPLICATE" $> MsgDuplicate
+  strEncode = \case
+    MsgSkipped fromMsgId toMsgId ->
+      B.unwords ["NO_ID", bshow fromMsgId, bshow toMsgId]
+    MsgBadId aMsgId -> "ID " <> bshow aMsgId
+    MsgBadHash -> "HASH"
+    MsgDuplicate -> "DUPLICATE"
+
+instance ToJSON MsgErrorType where
+  toJSON = J.genericToJSON $ sumTypeJSON fstToLower
+  toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
+
+instance FromJSON MsgErrorType where
+  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
 
 -- | Error type used in errors sent to agent clients.
 data AgentErrorType
   = -- | command or response error
-    CMD CommandErrorType
+    CMD {cmdErr :: CommandErrorType}
   | -- | connection errors
-    CONN ConnectionErrorType
+    CONN {connErr :: ConnectionErrorType}
   | -- | SMP protocol errors forwarded to agent clients
-    SMP ErrorType
+    SMP {smpErr :: ErrorType}
   | -- | SMP server errors
-    BROKER BrokerErrorType
+    BROKER {brokerErr :: BrokerErrorType}
   | -- | errors of other agents
-    AGENT SMPAgentError
+    AGENT {agentErr :: SMPAgentError}
   | -- | agent implementation or dependency errors
-    INTERNAL String
+    INTERNAL {internalErr :: String}
   deriving (Eq, Generic, Read, Show, Exception)
 
+instance ToJSON AgentErrorType where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
 -- | SMP agent protocol command or response error.
 data CommandErrorType
   = -- | command is prohibited in this context
@@ -655,6 +710,10 @@ data CommandErrorType
     LARGE
   deriving (Eq, Generic, Read, Show, Exception)
 
+instance ToJSON CommandErrorType where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
 -- | Connection error.
 data ConnectionErrorType
   = -- | connection is not in the database
@@ -663,22 +722,34 @@ data ConnectionErrorType
     DUPLICATE
   | -- | connection is simplex, but operation requires another queue
     SIMPLEX
+  | -- | connection not accepted on join HELLO after timeout
+    NOT_ACCEPTED
+  | -- | connection not available on reply confirmation/HELLO after timeout
+    NOT_AVAILABLE
   deriving (Eq, Generic, Read, Show, Exception)
 
+instance ToJSON ConnectionErrorType where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
 -- | SMP server errors.
 data BrokerErrorType
   = -- | invalid server response (failed to parse)
-    RESPONSE ErrorType
+    RESPONSE {smpErr :: ErrorType}
   | -- | unexpected response
     UNEXPECTED
   | -- | network error
     NETWORK
   | -- | handshake or other transport error
-    TRANSPORT TransportError
+    TRANSPORT {transportErr :: TransportError}
   | -- | command response timeout
     TIMEOUT
   deriving (Eq, Generic, Read, Show, Exception)
 
+instance ToJSON BrokerErrorType where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
 -- | Errors of another SMP agent.
 -- TODO encode/decode without A prefix
 data SMPAgentError
@@ -692,6 +763,30 @@ data SMPAgentError
     A_ENCRYPTION
   deriving (Eq, Generic, Read, Show, Exception)
 
+instance ToJSON SMPAgentError where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
+instance StrEncoding AgentErrorType where
+  strP =
+    "CMD " *> (CMD <$> parseRead1)
+      <|> "CONN " *> (CONN <$> parseRead1)
+      <|> "SMP " *> (SMP <$> strP)
+      <|> "BROKER RESPONSE " *> (BROKER . RESPONSE <$> strP)
+      <|> "BROKER TRANSPORT " *> (BROKER . TRANSPORT <$> transportErrorP)
+      <|> "BROKER " *> (BROKER <$> parseRead1)
+      <|> "AGENT " *> (AGENT <$> parseRead1)
+      <|> "INTERNAL " *> (INTERNAL <$> parseRead A.takeByteString)
+  strEncode = \case
+    CMD e -> "CMD " <> bshow e
+    CONN e -> "CONN " <> bshow e
+    SMP e -> "SMP " <> strEncode e
+    BROKER (RESPONSE e) -> "BROKER RESPONSE " <> strEncode e
+    BROKER (TRANSPORT e) -> "BROKER TRANSPORT " <> serializeTransportError e
+    BROKER e -> "BROKER " <> bshow e
+    AGENT e -> "AGENT " <> bshow e
+    INTERNAL e -> "INTERNAL " <> bshow e
+
 instance Arbitrary AgentErrorType where arbitrary = genericArbitraryU
 
 instance Arbitrary CommandErrorType where arbitrary = genericArbitraryU
@@ -742,27 +837,17 @@ commandP =
     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
+    msgErrResp = ACmd SAgent .: MERR <$> A.decimal <* A.space <*> strP
     message = ACmd SAgent .: MSG <$> msgMetaP <* A.space <*> A.takeByteString
     ackCmd = ACmd SClient . ACK <$> A.decimal
     msgMetaP = do
-      integrity <- msgIntegrityP
+      integrity <- strP
       recipient <- " R=" *> partyMeta A.decimal
       broker <- " B=" *> partyMeta base64P
       sndMsgId <- " S=" *> A.decimal
       pure MsgMeta {integrity, recipient, broker, sndMsgId}
     partyMeta idParser = (,) <$> idParser <* A.char ',' <*> 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
+    agentError = ACmd SAgent . ERR <$> strP
 
 parseCommand :: ByteString -> Either AgentErrorType ACmd
 parseCommand = parse commandP $ CMD SYNTAX
@@ -786,13 +871,13 @@ serializeCommand = \case
   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]
+  MERR mId e -> B.unwords ["MERR", bshow mId, strEncode 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
+  ERR e -> "ERR " <> strEncode e
   OK -> "OK"
   where
     showTs :: UTCTime -> ByteString
@@ -800,49 +885,12 @@ serializeCommand = \case
     serializeMsgMeta :: MsgMeta -> ByteString
     serializeMsgMeta MsgMeta {integrity, recipient = (rmId, rTs), broker = (bmId, bTs), sndMsgId} =
       B.unwords
-        [ serializeMsgIntegrity integrity,
+        [ strEncode integrity,
           "R=" <> bshow rmId <> "," <> showTs rTs,
           "B=" <> encode bmId <> "," <> showTs bTs,
           "S=" <> bshow sndMsgId
         ]
 
--- | 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 <$> smpErrorTypeP)
-    <|> "BROKER RESPONSE " *> (BROKER . RESPONSE <$> smpErrorTypeP)
-    <|> "BROKER TRANSPORT " *> (BROKER . TRANSPORT <$> transportErrorP)
-    <|> "INTERNAL " *> (INTERNAL <$> parseRead A.takeByteString)
-    <|> parseRead2
-
--- | Serialize SMP agent protocol error.
-serializeAgentError :: AgentErrorType -> ByteString
-serializeAgentError = \case
-  SMP e -> "SMP " <> serializeSmpErrorType e
-  BROKER (RESPONSE e) -> "BROKER RESPONSE " <> serializeSmpErrorType e
-  BROKER (TRANSPORT e) -> "BROKER TRANSPORT " <> serializeTransportError e
-  e -> bshow e
-
--- | SMP error parser.
-smpErrorTypeP :: Parser ErrorType
-smpErrorTypeP = "CMD " *> (SMP.CMD <$> parseRead1) <|> parseRead1
-
--- | Serialize SMP error.
-serializeSmpErrorType :: ErrorType -> ByteString
-serializeSmpErrorType = bshow
-
 serializeBinary :: ByteString -> ByteString
 serializeBinary body = bshow (B.length body) <> "\n" <> body
 

src/Simplex/Messaging/Agent/Server.hs

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

src/Simplex/Messaging/Agent/Store.hs

@@ -62,7 +62,7 @@ class Monad m => MonadAgentStore s m where
   createRcvMsg :: s -> ConnId -> RcvMsgData -> m ()
   updateSndIds :: s -> ConnId -> m (InternalId, InternalSndId, PrevSndMsgHash)
   createSndMsg :: s -> ConnId -> SndMsgData -> m ()
-  getPendingMsgData :: s -> ConnId -> InternalId -> m (Maybe RcvQueue, (AMsgType, MsgBody))
+  getPendingMsgData :: s -> ConnId -> InternalId -> m (Maybe RcvQueue, (AgentMessageType, MsgBody, InternalTs))
   getPendingMsgs :: s -> ConnId -> m [InternalId]
   checkRcvMsg :: s -> ConnId -> InternalId -> m ()
   deleteMsg :: s -> ConnId -> InternalId -> m ()
@@ -102,8 +102,11 @@ data SndQueue = SndQueue
   { server :: SMPServer,
     -- | sender queue ID
     sndId :: SMP.SenderId,
-    -- | key used by the sender to sign transmissions
+    -- | key pair used by the sender to sign transmissions
+    sndPublicKey :: Maybe C.APublicVerifyKey,
     sndPrivateKey :: SndPrivateSignKey,
+    -- | DH public key used to negotiate per-queue e2e encryption
+    e2ePubKey :: Maybe C.PublicKeyX25519,
     -- | shared DH secret agreed for simple per-queue e2e encryption
     e2eDhSecret :: C.DhSecretX25519,
     -- | queue status
@@ -221,7 +224,7 @@ type PrevSndMsgHash = MsgHash
 
 data RcvMsgData = RcvMsgData
   { msgMeta :: MsgMeta,
-    msgType :: AMsgType,
+    msgType :: AgentMessageType,
     msgBody :: MsgBody,
     internalRcvId :: InternalRcvId,
     internalHash :: MsgHash,
@@ -232,7 +235,7 @@ data SndMsgData = SndMsgData
   { internalId :: InternalId,
     internalSndId :: InternalSndId,
     internalTs :: InternalTs,
-    msgType :: AMsgType,
+    msgType :: AgentMessageType,
     msgBody :: MsgBody,
     internalHash :: MsgHash,
     prevMsgHash :: MsgHash

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

@@ -76,13 +76,13 @@ data SQLiteStore = SQLiteStore
     dbNew :: Bool
   }
 
-createSQLiteStore :: FilePath -> Int -> [Migration] -> IO SQLiteStore
-createSQLiteStore dbFilePath poolSize migrations = do
+createSQLiteStore :: FilePath -> Int -> [Migration] -> Bool -> IO SQLiteStore
+createSQLiteStore dbFilePath poolSize migrations yesToMigrations = do
   let dbDir = takeDirectory dbFilePath
   createDirectoryIfMissing False dbDir
   st <- connectSQLiteStore dbFilePath poolSize
   checkThreadsafe st
-  migrateSchema st migrations
+  migrateSchema st migrations yesToMigrations
   pure st
 
 checkThreadsafe :: SQLiteStore -> IO ()
@@ -94,15 +94,16 @@ checkThreadsafe st = withConnection st $ \db -> do
     Nothing -> putStrLn "Warning: SQLite THREADSAFE compile option not found"
     _ -> return ()
 
-migrateSchema :: SQLiteStore -> [Migration] -> IO ()
-migrateSchema st migrations = withConnection st $ \db -> do
+migrateSchema :: SQLiteStore -> [Migration] -> Bool -> IO ()
+migrateSchema st migrations yesToMigrations = withConnection st $ \db -> do
   Migrations.initialize db
   Migrations.get db migrations >>= \case
     Left e -> confirmOrExit $ "Database error: " <> e
     Right [] -> pure ()
     Right ms -> do
       unless (dbNew st) $ do
-        confirmOrExit "The app has a newer version than the database - it will be backed up and upgraded."
+        unless yesToMigrations $
+          confirmOrExit "The app has a newer version than the database - it will be backed up and upgraded."
         let f = dbFilePath st
         copyFile f (f <> ".bak")
       Migrations.run db ms
@@ -440,7 +441,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
       insertSndMsgDetails_ db connId sndMsgData
       updateHashSnd_ db connId sndMsgData
 
-  getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m (Maybe RcvQueue, (AMsgType, MsgBody))
+  getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m (Maybe RcvQueue, (AgentMessageType, MsgBody, InternalTs))
   getPendingMsgData st connId msgId =
     liftIOEither . withTransaction st $ \db -> runExceptT $ do
       rq_ <- liftIO $ getRcvQueueByConnId_ db connId
@@ -449,7 +450,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
           DB.query
             db
             [sql|
-                SELECT m.msg_type, m.msg_body
+                SELECT m.msg_type, m.msg_body, m.internal_ts
                 FROM messages m
                 JOIN snd_messages s ON s.conn_id = m.conn_id AND s.internal_id = m.internal_id
                 WHERE m.conn_id = ? AND m.internal_id = ?
@@ -565,13 +566,13 @@ instance ToField InternalId where toField (InternalId x) = toField x
 
 instance FromField InternalId where fromField x = InternalId <$> fromField x
 
-instance ToField AMsgType where toField = toField . smpEncode
+instance ToField AgentMessageType where toField = toField . smpEncode
 
-instance FromField AMsgType where fromField = blobFieldParser smpP
+instance FromField AgentMessageType where fromField = blobFieldParser smpP
 
-instance ToField MsgIntegrity where toField = toField . serializeMsgIntegrity
+instance ToField MsgIntegrity where toField = toField . strEncode
 
-instance FromField MsgIntegrity where fromField = blobFieldParser msgIntegrityP
+instance FromField MsgIntegrity where fromField = blobFieldParser strP
 
 instance ToField SMPQueueUri where toField = toField . strEncode
 
@@ -655,46 +656,25 @@ upsertServer_ dbConn SMPServer {host, port, keyHash} = do
 
 insertRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()
 insertRcvQueue_ dbConn connId RcvQueue {..} = do
-  DB.executeNamed
+  DB.execute
     dbConn
     [sql|
       INSERT INTO rcv_queues
-        ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status)
-      VALUES
-        (:host,:port,:rcv_id,:conn_id,:rcv_private_key,:rcv_dh_secret,:e2e_priv_key,:e2e_dh_secret,:snd_id,:status);
+        ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status) VALUES (?,?,?,?,?,?,?,?,?,?);
     |]
-    [ ":host" := host server,
-      ":port" := port server,
-      ":rcv_id" := rcvId,
-      ":conn_id" := connId,
-      ":rcv_private_key" := rcvPrivateKey,
-      ":rcv_dh_secret" := rcvDhSecret,
-      ":e2e_priv_key" := e2ePrivKey,
-      ":e2e_dh_secret" := e2eDhSecret,
-      ":snd_id" := sndId,
-      ":status" := status
-    ]
+    (host server, port server, rcvId, connId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status)
 
 -- * createSndConn helpers
 
 insertSndQueue_ :: DB.Connection -> ConnId -> SndQueue -> IO ()
 insertSndQueue_ dbConn connId SndQueue {..} = do
-  DB.executeNamed
+  DB.execute
     dbConn
     [sql|
       INSERT INTO snd_queues
-        ( host, port, snd_id, conn_id, snd_private_key, e2e_dh_secret, status)
-      VALUES
-        (:host,:port,:snd_id,:conn_id,:snd_private_key,:e2e_dh_secret,:status);
+        (host, port, snd_id, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status) VALUES (?,?,?,?,?, ?,?, ?,?);
     |]
-    [ ":host" := host server,
-      ":port" := port server,
-      ":snd_id" := sndId,
-      ":conn_id" := connId,
-      ":snd_private_key" := sndPrivateKey,
-      ":e2e_dh_secret" := e2eDhSecret,
-      ":status" := status
-    ]
+    (host server, port server, sndId, connId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)
 
 -- * getConn helpers
 
@@ -745,16 +725,16 @@ getSndQueueByConnId_ dbConn connId =
     <$> DB.query
       dbConn
       [sql|
-        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key, q.e2e_dh_secret, q.status
+        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status
         FROM snd_queues q
         INNER JOIN servers s ON q.host = s.host AND q.port = s.port
         WHERE q.conn_id = ?;
       |]
       (Only connId)
   where
-    sndQueue [(keyHash, host, port, sndId, sndPrivateKey, e2eDhSecret, status)] =
+    sndQueue [(keyHash, host, port, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)] =
       let server = SMPServer host port keyHash
-       in Just SndQueue {server, sndId, sndPrivateKey, e2eDhSecret, status}
+       in Just SndQueue {server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status}
     sndQueue _ = Nothing
 
 -- * updateRcvIds helpers

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

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

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

@@ -1,3 +1,13 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220101_initial :: Query
+m20220101_initial =
+  [sql|
 CREATE TABLE servers (
   host TEXT NOT NULL,
   port TEXT NOT NULL,
@@ -135,3 +145,4 @@ CREATE TABLE skipped_messages (
   msg_n INTEGER NOT NULL,
   msg_key BLOB NOT NULL
 );
+|]

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

@@ -0,0 +1,13 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220301_snd_queue_keys :: Query
+m20220301_snd_queue_keys =
+  [sql|
+ALTER TABLE snd_queues ADD COLUMN snd_public_key BLOB;
+ALTER TABLE snd_queues ADD COLUMN e2e_pub_key BLOB;
+|]

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

@@ -0,0 +1,14 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220320_server_ips where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220320_server_ips :: Query
+m20220320_server_ips =
+  [sql|
+UPDATE servers SET host = '178.79.168.175' WHERE host = 'smp8.simplex.im';
+UPDATE servers SET host = '178.79.169.107' WHERE host = 'smp9.simplex.im';
+UPDATE servers SET host = '45.33.54.229' WHERE host = 'smp10.simplex.im';
+|]

src/Simplex/Messaging/Client.hs

@@ -63,7 +63,8 @@ import Network.Socket (ServiceName)
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake, runTransportClient)
+import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake)
+import Simplex.Messaging.Transport.Client (runTransportClient)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
 import System.Timeout (timeout)
@@ -106,7 +107,7 @@ data SMPClientConfig = SMPClientConfig
 smpDefaultConfig :: SMPClientConfig
 smpDefaultConfig =
   SMPClientConfig
-    { qSize = 16,
+    { qSize = 64,
       defaultTransport = ("5223", transport @TLS),
       tcpTimeout = 4_000_000,
       smpPing = 30_000_000

src/Simplex/Messaging/Parsers.hs

@@ -1,16 +1,18 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Messaging.Parsers where
 
 import Control.Monad.Trans.Except
+import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Char (isAlphaNum)
+import Data.Char (isAlphaNum, toLower)
 import Data.Time.Clock (UTCTime)
 import Data.Time.ISO8601 (parseISO8601)
 import Data.Typeable (Typeable)
@@ -78,3 +80,46 @@ blobFieldDecoder dec = \case
       Right k -> Ok k
       Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
   f -> returnError ConversionFailed f "expecting SQLBlob column type"
+
+fstToLower :: String -> String
+fstToLower "" = ""
+fstToLower (h : t) = toLower h : t
+
+dropPrefix :: String -> String -> String
+dropPrefix pfx s =
+  let (p, rest) = splitAt (length pfx) s
+   in fstToLower $ if p == pfx then rest else s
+
+enumJSON :: (String -> String) -> J.Options
+enumJSON tagModifier =
+  J.defaultOptions
+    { J.constructorTagModifier = tagModifier,
+      J.allNullaryToStringTag = True
+    }
+
+sumTypeJSON :: (String -> String) -> J.Options
+#if defined(darwin_HOST_OS)
+sumTypeJSON = singleFieldJSON
+#else
+sumTypeJSON = taggedObjectJSON
+#endif
+
+taggedObjectJSON :: (String -> String) -> J.Options
+taggedObjectJSON tagModifier =
+  J.defaultOptions
+    { J.sumEncoding = J.TaggedObject "type" "data",
+      J.constructorTagModifier = tagModifier,
+      J.allNullaryToStringTag = False,
+      J.nullaryToObject = True,
+      J.omitNothingFields = True
+    }
+
+singleFieldJSON :: (String -> String) -> J.Options
+singleFieldJSON tagModifier =
+  J.defaultOptions
+    { J.sumEncoding = J.ObjectWithSingleField,
+      J.constructorTagModifier = tagModifier,
+      J.allNullaryToStringTag = False,
+      J.nullaryToObject = True,
+      J.omitNothingFields = True
+    }

src/Simplex/Messaging/Protocol.hs

@@ -90,6 +90,8 @@ where
 
 import Control.Applicative (optional, (<|>))
 import Control.Monad.Except
+import Data.Aeson (ToJSON (..))
+import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
@@ -107,7 +109,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Transport (THandle (..), Transport, TransportError (..), tGetBlock, tPutBlock)
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (bshow, (<$?>))
 import Simplex.Messaging.Version
 import Test.QuickCheck (Arbitrary (..))
 
@@ -397,6 +399,10 @@ instance StrEncoding SMPServer where
     SrvLoc host port <- strP
     pure SMPServer {host, port, keyHash}
 
+instance ToJSON SMPServer where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
 data SrvLoc = SrvLoc HostName ServiceName
   deriving (Eq, Ord, Show)
 
@@ -413,6 +419,15 @@ newtype CorrId = CorrId {bs :: ByteString} deriving (Eq, Ord, Show)
 instance IsString CorrId where
   fromString = CorrId . fromString
 
+instance StrEncoding CorrId where
+  strEncode (CorrId cId) = strEncode cId
+  strDecode s = CorrId <$> strDecode s
+  strP = CorrId <$> strP
+
+instance ToJSON CorrId where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
 -- | Queue IDs and keys
 data QueueIdsKeys = QIK
   { rcvId :: RecipientId,
@@ -462,7 +477,7 @@ data ErrorType
   | -- | incorrect SMP session ID (TLS Finished message / tls-unique binding RFC5929)
     SESSION
   | -- | SMP command is unknown or has invalid syntax
-    CMD CommandError
+    CMD {cmdErr :: CommandError}
   | -- | command authorization error - bad signature or non-existing SMP queue
     AUTH
   | -- | SMP queue capacity is exceeded on the server
@@ -477,6 +492,16 @@ data ErrorType
     DUPLICATE_ -- TODO remove, not part of SMP protocol
   deriving (Eq, Generic, Read, Show)
 
+instance ToJSON ErrorType where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
+instance StrEncoding ErrorType where
+  strEncode = \case
+    CMD e -> "CMD " <> bshow e
+    e -> bshow e
+  strP = "CMD " *> (CMD <$> parseRead1) <|> parseRead1
+
 -- | SMP command error type.
 data CommandError
   = -- | unknown command
@@ -491,6 +516,10 @@ data CommandError
     NO_QUEUE
   deriving (Eq, Generic, Read, Show)
 
+instance ToJSON CommandError where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
 instance Arbitrary ErrorType where arbitrary = genericArbitraryU
 
 instance Arbitrary CommandError where arbitrary = genericArbitraryU

src/Simplex/Messaging/Server.hs

@@ -48,6 +48,7 @@ import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.STM (QueueStore)
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Util
 import UnliftIO.Concurrent
 import UnliftIO.Exception

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

@@ -21,7 +21,8 @@ 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, loadFingerprint, loadTLSServerParams)
+import Simplex.Messaging.Transport (ATransport)
+import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
 import System.IO (IOMode (..))
 import UnliftIO.STM
 

src/Simplex/Messaging/Transport.hs

@@ -36,15 +36,11 @@ module Simplex.Messaging.Transport
     ATransport (..),
     TransportPeer (..),
 
-    -- * Transport over TLS 1.2
-    runTransportServer,
-    runTransportClient,
-    loadTLSServerParams,
-    loadFingerprint,
-
-    -- * TLS 1.2 Transport
+    -- * TLS Transport
     TLS (..),
+    connectTLS,
     closeTLS,
+    supportedParameters,
     withTlsUnique,
 
     -- * SMP transport
@@ -64,9 +60,9 @@ where
 
 import Control.Applicative ((<|>))
 import Control.Monad.Except
-import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except (throwE)
-import qualified Crypto.Store.X509 as SX
+import Data.Aeson (ToJSON)
+import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import Data.Bifunctor (first)
 import Data.Bitraversable (bimapM)
@@ -75,14 +71,7 @@ import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as BL
 import Data.Default (def)
 import Data.Functor (($>))
-import Data.Set (Set)
-import qualified Data.Set as S
-import qualified Data.X509 as X
-import qualified Data.X509.CertificateStore as XS
-import Data.X509.Validation (Fingerprint (..))
-import qualified Data.X509.Validation as XV
 import GHC.Generics (Generic)
-import GHC.IO.Exception (IOErrorType (..))
 import GHC.IO.Handle.Internals (ioe_EOF)
 import Generic.Random (genericArbitraryU)
 import Network.Socket
@@ -90,14 +79,11 @@ import qualified Network.TLS as T
 import qualified Network.TLS.Extra as TE
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Parsers (parse, parseRead1)
+import Simplex.Messaging.Parsers (dropPrefix, parse, parseRead1, sumTypeJSON)
 import Simplex.Messaging.Util (bshow)
 import Simplex.Messaging.Version
-import System.Exit (exitFailure)
-import System.IO.Error
 import Test.QuickCheck (Arbitrary (..))
-import UnliftIO.Concurrent
-import UnliftIO.Exception (Exception, IOException)
+import UnliftIO.Exception (Exception)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
@@ -110,7 +96,7 @@ supportedSMPVersions :: VersionRange
 supportedSMPVersions = mkVersionRange 1 1
 
 simplexMQVersion :: String
-simplexMQVersion = "1.0.0"
+simplexMQVersion = "1.0.3"
 
 -- * Transport connection class
 
@@ -154,104 +140,7 @@ data TProxy c = TProxy
 
 data ATransport = forall c. Transport c => ATransport (TProxy c)
 
--- * Transport over TLS 1.2
-
--- | Run transport server (plain TCP or WebSockets) on passed TCP port and signal when server started and stopped via passed TMVar.
---
--- All accepted connections are passed to the passed function.
-runTransportServer :: forall c m. (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> T.ServerParams -> (c -> m ()) -> m ()
-runTransportServer started port serverParams server = do
-  clients <- newTVarIO S.empty
-  E.bracket
-    (liftIO $ startTCPServer started port)
-    (liftIO . closeServer clients)
-    $ \sock -> forever $ connectClients sock clients `E.catch` \(_ :: E.SomeException) -> pure ()
-  where
-    connectClients :: Socket -> TVar (Set ThreadId) -> m ()
-    connectClients sock clients = do
-      c <- liftIO $ acceptConnection sock
-      tid <- server c `forkFinally` const (liftIO $ closeConnection c)
-      atomically . modifyTVar clients $ S.insert tid
-    closeServer :: TVar (Set ThreadId) -> Socket -> IO ()
-    closeServer clients sock = do
-      readTVarIO clients >>= mapM_ killThread
-      close sock
-      void . atomically $ tryPutTMVar started False
-    acceptConnection :: Socket -> IO c
-    acceptConnection sock = do
-      (newSock, _) <- accept sock
-      ctx <- connectTLS serverParams newSock
-      getServerConnection ctx
-
-startTCPServer :: TMVar Bool -> ServiceName -> IO Socket
-startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
-  where
-    resolve =
-      let hints = defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Stream}
-       in head <$> getAddrInfo (Just hints) Nothing (Just port)
-    open addr = do
-      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
-      setSocketOption sock ReuseAddr 1
-      withFdSocket sock setCloseOnExecIfNeeded
-      bind sock $ addrAddress addr
-      listen sock 1024
-      return sock
-    setStarted sock = atomically (tryPutTMVar started True) >> pure sock
-
--- | Connect to passed TCP host:port and pass handle to the client.
-runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> C.KeyHash -> (c -> m a) -> m a
-runTransportClient host port keyHash client = do
-  let clientParams = mkTLSClientParams host port keyHash
-  c <- liftIO $ startTCPClient host port clientParams
-  client c `E.finally` liftIO (closeConnection c)
-
-startTCPClient :: forall c. Transport c => HostName -> ServiceName -> T.ClientParams -> IO c
-startTCPClient host port clientParams = withSocketsDo $ resolve >>= tryOpen err
-  where
-    err :: IOException
-    err = mkIOError NoSuchThing "no address" Nothing Nothing
-
-    resolve :: IO [AddrInfo]
-    resolve =
-      let hints = defaultHints {addrSocketType = Stream}
-       in getAddrInfo (Just hints) (Just host) (Just port)
-
-    tryOpen :: IOException -> [AddrInfo] -> IO c
-    tryOpen e [] = E.throwIO e
-    tryOpen _ (addr : as) =
-      E.try (open addr) >>= either (`tryOpen` as) pure
-
-    open :: AddrInfo -> IO c
-    open addr = do
-      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
-      connect sock $ addrAddress addr
-      ctx <- connectTLS clientParams sock
-      getClientConnection ctx
-
-loadTLSServerParams :: FilePath -> FilePath -> FilePath -> IO T.ServerParams
-loadTLSServerParams caCertificateFile certificateFile privateKeyFile =
-  fromCredential <$> loadServerCredential
-  where
-    loadServerCredential :: IO T.Credential
-    loadServerCredential =
-      T.credentialLoadX509Chain certificateFile [caCertificateFile] privateKeyFile >>= \case
-        Right credential -> pure credential
-        Left _ -> putStrLn "invalid credential" >> exitFailure
-    fromCredential :: T.Credential -> T.ServerParams
-    fromCredential credential =
-      def
-        { T.serverWantClientCert = False,
-          T.serverShared = def {T.sharedCredentials = T.Credentials [credential]},
-          T.serverHooks = def,
-          T.serverSupported = supportedParameters
-        }
-
-loadFingerprint :: FilePath -> IO Fingerprint
-loadFingerprint certificateFile = do
-  (cert : _) <- SX.readSignedObject certificateFile
-  pure $ XV.getFingerprint (cert :: X.SignedExact X.Certificate) X.HashSHA256
-
--- * TLS 1.2 Transport
+-- * TLS Transport
 
 data TLS = TLS
   { tlsContext :: T.Context,
@@ -289,45 +178,21 @@ closeTLS ctx =
   (T.bye ctx >> T.contextClose ctx) -- sometimes socket was closed before 'TLS.bye'
     `E.catch` (\(_ :: E.SomeException) -> pure ()) -- so we catch the 'Broken pipe' error here
 
-mkTLSClientParams :: HostName -> ServiceName -> C.KeyHash -> T.ClientParams
-mkTLSClientParams host port keyHash = do
-  let p = B.pack port
-  (T.defaultParamsClient host p)
-    { T.clientShared = def,
-      T.clientHooks = def {T.onServerCertificate = \_ _ _ -> validateCertificateChain keyHash host p},
-      T.clientSupported = supportedParameters
-    }
-
-validateCertificateChain :: C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
-validateCertificateChain _ _ _ (X.CertificateChain []) = pure [XV.EmptyChain]
-validateCertificateChain _ _ _ (X.CertificateChain [_]) = pure [XV.EmptyChain]
-validateCertificateChain (C.KeyHash kh) host port cc@(X.CertificateChain sc@[_, caCert]) =
-  if Fingerprint kh == XV.getFingerprint caCert X.HashSHA256
-    then x509validate
-    else pure [XV.UnknownCA]
-  where
-    x509validate :: IO [XV.FailedReason]
-    x509validate = XV.validate X.HashSHA256 hooks checks certStore cache serviceID cc
-      where
-        hooks = XV.defaultHooks
-        checks = XV.defaultChecks
-        certStore = XS.makeCertificateStore sc
-        cache = XV.exceptionValidationCache [] -- we manually check fingerprint only of the identity certificate (ca.crt)
-        serviceID = (host, port)
-validateCertificateChain _ _ _ _ = pure [XV.AuthorityTooDeep]
-
 supportedParameters :: T.Supported
 supportedParameters =
   def
-    { T.supportedVersions = [T.TLS12],
-      T.supportedCiphers = [TE.cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256],
+    { T.supportedVersions = [T.TLS13, T.TLS12],
+      T.supportedCiphers =
+        [ TE.cipher_TLS13_CHACHA20POLY1305_SHA256, -- for TLS13
+          TE.cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 -- for TLS12
+        ],
       T.supportedHashSignatures = [(T.HashIntrinsic, T.SignatureEd448), (T.HashIntrinsic, T.SignatureEd25519)],
       T.supportedSecureRenegotiation = False,
       T.supportedGroups = [T.X448, T.X25519]
     }
 
 instance Transport TLS where
-  transportName _ = "TLS 1.2"
+  transportName _ = "TLS"
   transportPeer = tlsPeer
   getServerConnection = getTLS TServer
   getClientConnection = getTLS TClient
@@ -424,9 +289,13 @@ data TransportError
   | -- | incorrect session ID
     TEBadSession
   | -- | transport handshake error
-    TEHandshake HandshakeError
+    TEHandshake {handshakeErr :: HandshakeError}
   deriving (Eq, Generic, Read, Show, Exception)
 
+instance ToJSON TransportError where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "TE"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "TE"
+
 -- | Transport handshake error.
 data HandshakeError
   = -- | parsing error
@@ -437,6 +306,10 @@ data HandshakeError
     IDENTITY
   deriving (Eq, Generic, Read, Show, Exception)
 
+instance ToJSON HandshakeError where
+  toJSON = J.genericToJSON $ sumTypeJSON id
+  toEncoding = J.genericToEncoding $ sumTypeJSON id
+
 instance Arbitrary TransportError where arbitrary = genericArbitraryU
 
 instance Arbitrary HandshakeError where arbitrary = genericArbitraryU

src/Simplex/Messaging/Transport/Client.hs

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

src/Simplex/Messaging/Transport/Server.hs

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

stack.yaml

@@ -37,16 +37,21 @@ packages:
 extra-deps:
   - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
   - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
+  - tls-1.5.7@sha256:1cc30253a9696b65a9cafc0317fbf09f7dcea15e3a145ed6c9c0e28c632fa23a,6991
+# below dependancies are to update Aeson to 2.0.3
+  - OneTuple-0.3.1@sha256:a848c096c9d29e82ffdd30a9998aa2931cbccb3a1bc137539d80f6174d31603e,2262
+  - attoparsec-0.14.4@sha256:79584bdada8b730cb5138fca8c35c76fbef75fc1d1e01e6b1d815a5ee9843191,5810
+  - hashable-1.4.0.2@sha256:0cddd0229d1aac305ea0404409c0bbfab81f075817bd74b8b2929eff58333e55,5005
+  - semialign-1.2.0.1@sha256:0e179b4d3a8eff79001d374d6c91917c6221696b9620f0a4d86852fc6a9b9501,2836
+  - text-short-0.1.5@sha256:962c6228555debdc46f758d0317dea16e5240d01419b42966674b08a5c3d8fa6,3498
+  - time-compat-1.9.6.1@sha256:42d8f2e08e965e1718917d54ad69e1d06bd4b87d66c41dc7410f59313dba4ed1,5033
+  - github: simplex-chat/aeson
+    commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7
   # - ../hs-tls/core
-  - github: simplex-chat/hs-tls
-    commit: cea6d52c512716ff09adcac86ebc95bb0b3bb797
-    subdirs:
-      - core
-# - network-run-0.2.4@sha256:7dbb06def522dab413bce4a46af476820bffdff2071974736b06f52f4ab57c96,885
-# - git: https://github.com/commercialhaskell/stack.git
-#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#
-# extra-deps: []
+  # - github: simplex-chat/hs-tls
+  #   commit: f6cc753611f80af300401cfae63846e9d7c40d9e
+  #   subdirs:
+  #     - core
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

tests/AgentTests.hs

@@ -62,9 +62,11 @@ agentTests (ATransport t) = do
       smpAgentTest3_1_1 $ testSubscription t
     it "should send notifications to client when server disconnects" $
       smpAgentServerTest $ testSubscrNotification t
-  describe "Message delivery" $ do
+  describe "Message delivery and server reconnection" $ do
     it "should deliver messages after losing server connection and re-connecting" $
       smpAgentTest2_2_2_needs_server $ testMsgDeliveryServerRestart t
+    it "should connect to the server when server goes up if it initially was down" $
+      smpAgentTestN [] $ testServerConnectionAfterError t
     it "should deliver pending messages after agent restarting" $
       smpAgentTest1_1_1 $ testMsgDeliveryAgentRestart t
     it "should concurrently deliver messages to connections without blocking" $
@@ -126,25 +128,25 @@ testDuplexConnection _ alice bob = do
   bob <# ("", "alice", CON)
   alice <# ("", "bob", CON)
   -- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
-  alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 4)
-  alice <# ("", "bob", SENT 4)
-  bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
-  bob #: ("12", "alice", "ACK 4") #> ("12", "alice", OK)
-  alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", MID 5)
+  alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 5)
   alice <# ("", "bob", SENT 5)
+  bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
+  bob #: ("12", "alice", "ACK 5") #> ("12", "alice", OK)
+  alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", MID 6)
+  alice <# ("", "bob", SENT 6)
   bob <#= \case ("", "alice", Msg "how are you?") -> True; _ -> False
-  bob #: ("13", "alice", "ACK 5") #> ("13", "alice", OK)
-  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 6)
-  bob <# ("", "alice", SENT 6)
-  alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
-  alice #: ("3a", "bob", "ACK 6") #> ("3a", "bob", OK)
-  bob #: ("15", "alice", "SEND 9\nmessage 1") #> ("15", "alice", MID 7)
+  bob #: ("13", "alice", "ACK 6") #> ("13", "alice", OK)
+  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 7)
   bob <# ("", "alice", SENT 7)
+  alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
+  alice #: ("3a", "bob", "ACK 7") #> ("3a", "bob", OK)
+  bob #: ("15", "alice", "SEND 9\nmessage 1") #> ("15", "alice", MID 8)
+  bob <# ("", "alice", SENT 8)
   alice <#= \case ("", "bob", Msg "message 1") -> True; _ -> False
-  alice #: ("4a", "bob", "ACK 7") #> ("4a", "bob", OK)
+  alice #: ("4a", "bob", "ACK 8") #> ("4a", "bob", OK)
   alice #: ("5", "bob", "OFF") #> ("5", "bob", OK)
-  bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 8)
-  bob <# ("", "alice", MERR 8 (SMP AUTH))
+  bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 9)
+  bob <# ("", "alice", MERR 9 (SMP AUTH))
   alice #: ("6", "bob", "DEL") #> ("6", "bob", OK)
   alice #:# "nothing else should be delivered to alice"
 
@@ -159,25 +161,25 @@ testDuplexConnRandomIds _ alice bob = do
   bob <# ("", aliceConn, INFO "alice's connInfo")
   bob <# ("", aliceConn, CON)
   alice <# ("", bobConn, CON)
-  alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, MID 4)
-  alice <# ("", bobConn, SENT 4)
-  bob <#= \case ("", c, Msg "hello") -> c == aliceConn; _ -> False
-  bob #: ("12", aliceConn, "ACK 4") #> ("12", aliceConn, OK)
-  alice #: ("3", bobConn, "SEND :how are you?") #> ("3", bobConn, MID 5)
+  alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, MID 5)
   alice <# ("", bobConn, SENT 5)
+  bob <#= \case ("", c, Msg "hello") -> c == aliceConn; _ -> False
+  bob #: ("12", aliceConn, "ACK 5") #> ("12", aliceConn, OK)
+  alice #: ("3", bobConn, "SEND :how are you?") #> ("3", bobConn, MID 6)
+  alice <# ("", bobConn, SENT 6)
   bob <#= \case ("", c, Msg "how are you?") -> c == aliceConn; _ -> False
-  bob #: ("13", aliceConn, "ACK 5") #> ("13", aliceConn, OK)
-  bob #: ("14", aliceConn, "SEND 9\nhello too") #> ("14", aliceConn, MID 6)
-  bob <# ("", aliceConn, SENT 6)
-  alice <#= \case ("", c, Msg "hello too") -> c == bobConn; _ -> False
-  alice #: ("3a", bobConn, "ACK 6") #> ("3a", bobConn, OK)
-  bob #: ("15", aliceConn, "SEND 9\nmessage 1") #> ("15", aliceConn, MID 7)
+  bob #: ("13", aliceConn, "ACK 6") #> ("13", aliceConn, OK)
+  bob #: ("14", aliceConn, "SEND 9\nhello too") #> ("14", aliceConn, MID 7)
   bob <# ("", aliceConn, SENT 7)
+  alice <#= \case ("", c, Msg "hello too") -> c == bobConn; _ -> False
+  alice #: ("3a", bobConn, "ACK 7") #> ("3a", bobConn, OK)
+  bob #: ("15", aliceConn, "SEND 9\nmessage 1") #> ("15", aliceConn, MID 8)
+  bob <# ("", aliceConn, SENT 8)
   alice <#= \case ("", c, Msg "message 1") -> c == bobConn; _ -> False
-  alice #: ("4a", bobConn, "ACK 7") #> ("4a", bobConn, OK)
+  alice #: ("4a", bobConn, "ACK 8") #> ("4a", bobConn, OK)
   alice #: ("5", bobConn, "OFF") #> ("5", bobConn, OK)
-  bob #: ("17", aliceConn, "SEND 9\nmessage 3") #> ("17", aliceConn, MID 8)
-  bob <# ("", aliceConn, MERR 8 (SMP AUTH))
+  bob #: ("17", aliceConn, "SEND 9\nmessage 3") #> ("17", aliceConn, MID 9)
+  bob <# ("", aliceConn, MERR 9 (SMP AUTH))
   alice #: ("6", bobConn, "DEL") #> ("6", bobConn, OK)
   alice #:# "nothing else should be delivered to alice"
 
@@ -194,10 +196,10 @@ testContactConnection _ alice bob tom = do
   alice <# ("", "bob", INFO "bob's connInfo 2")
   alice <# ("", "bob", CON)
   bob <# ("", "alice", CON)
-  alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 4)
-  alice <# ("", "bob", SENT 4)
+  alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 5)
+  alice <# ("", "bob", SENT 5)
   bob <#= \case ("", "alice", Msg "hi") -> True; _ -> False
-  bob #: ("13", "alice", "ACK 4") #> ("13", "alice", OK)
+  bob #: ("13", "alice", "ACK 5") #> ("13", "alice", OK)
 
   tom #: ("21", "alice", "JOIN " <> cReq' <> " 14\ntom's connInfo") #> ("21", "alice", OK)
   ("", "alice_contact", Right (REQ aInvId' "tom's connInfo")) <- (alice <#:)
@@ -207,10 +209,10 @@ testContactConnection _ alice bob tom = do
   alice <# ("", "tom", INFO "tom's connInfo 2")
   alice <# ("", "tom", CON)
   tom <# ("", "alice", CON)
-  alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 4)
-  alice <# ("", "tom", SENT 4)
+  alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 5)
+  alice <# ("", "tom", SENT 5)
   tom <#= \case ("", "alice", Msg "hi there") -> True; _ -> False
-  tom #: ("23", "alice", "ACK 4") #> ("23", "alice", OK)
+  tom #: ("23", "alice", "ACK 5") #> ("23", "alice", OK)
 
 testContactConnRandomIds :: Transport c => TProxy c -> c -> c -> IO ()
 testContactConnRandomIds _ alice bob = do
@@ -230,10 +232,10 @@ testContactConnRandomIds _ alice bob = do
   alice <# ("", bobConn, CON)
   bob <# ("", aliceConn, CON)
 
-  alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 4)
-  alice <# ("", bobConn, SENT 4)
+  alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 5)
+  alice <# ("", bobConn, SENT 5)
   bob <#= \case ("", c, Msg "hi") -> c == aliceConn; _ -> False
-  bob #: ("13", aliceConn, "ACK 4") #> ("13", aliceConn, OK)
+  bob #: ("13", aliceConn, "ACK 5") #> ("13", aliceConn, OK)
 
 testRejectContactRequest :: Transport c => TProxy c -> c -> c -> IO ()
 testRejectContactRequest _ alice bob = do
@@ -250,20 +252,20 @@ testRejectContactRequest _ alice bob = do
 testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO ()
 testSubscription _ alice1 alice2 bob = do
   (alice1, "alice") `connect` (bob, "bob")
-  bob #: ("12", "alice", "SEND 5\nhello") #> ("12", "alice", MID 4)
-  bob <# ("", "alice", SENT 4)
-  alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False
-  alice1 #: ("1", "bob", "ACK 4") #> ("1", "bob", OK)
-  bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 5)
+  bob #: ("12", "alice", "SEND 5\nhello") #> ("12", "alice", MID 5)
   bob <# ("", "alice", SENT 5)
+  alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False
+  alice1 #: ("1", "bob", "ACK 5") #> ("1", "bob", OK)
+  bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 6)
+  bob <# ("", "alice", SENT 6)
   alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
-  alice1 #: ("2", "bob", "ACK 5") #> ("2", "bob", OK)
+  alice1 #: ("2", "bob", "ACK 6") #> ("2", "bob", OK)
   alice2 #: ("21", "bob", "SUB") #> ("21", "bob", OK)
   alice1 <# ("", "bob", END)
-  bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 6)
-  bob <# ("", "alice", SENT 6)
+  bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 7)
+  bob <# ("", "alice", SENT 7)
   alice2 <#= \case ("", "bob", Msg "hi") -> True; _ -> False
-  alice2 #: ("22", "bob", "ACK 6") #> ("22", "bob", OK)
+  alice2 #: ("22", "bob", "ACK 7") #> ("22", "bob", OK)
   alice1 #:# "nothing else should be delivered to alice1"
 
 testSubscrNotification :: Transport c => TProxy c -> (ThreadId, ThreadId) -> c -> IO ()
@@ -279,40 +281,77 @@ 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 4)
-    bob <# ("", "alice", SENT 4)
+    bob #: ("1", "alice", "SEND 2\nhi") #> ("1", "alice", MID 5)
+    bob <# ("", "alice", SENT 5)
     alice <#= \case ("", "bob", Msg "hi") -> True; _ -> False
-    alice #: ("11", "bob", "ACK 4") #> ("11", "bob", OK)
+    alice #: ("11", "bob", "ACK 5") #> ("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 5)
+  bob #: ("2", "alice", "SEND 11\nhello again") #> ("2", "alice", MID 6)
   bob #:# "nothing else delivered before the server is restarted"
   alice #:# "nothing else delivered before the server is restarted"
 
   withServer $ do
-    bob <# ("", "alice", SENT 5)
+    bob <# ("", "alice", SENT 6)
     alice <# ("", "bob", UP)
     alice <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
-    alice #: ("12", "bob", "ACK 5") #> ("12", "bob", OK)
+    alice #: ("12", "bob", "ACK 6") #> ("12", "bob", OK)
 
   removeFile testStoreLogFile
   where
     withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` ()
 
+testServerConnectionAfterError :: forall c. Transport c => TProxy c -> [c] -> IO ()
+testServerConnectionAfterError t _ = do
+  withAgent1 $ \bob -> do
+    withAgent2 $ \alice -> do
+      withServer $ do
+        connect (bob, "bob") (alice, "alice")
+
+      bob <# ("", "alice", DOWN)
+      alice <# ("", "bob", DOWN)
+      alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 5)
+      alice #:# "nothing else delivered before the server is restarted"
+      bob #:# "nothing else delivered before the server is restarted"
+
+  withAgent1 $ \bob -> do
+    withAgent2 $ \alice -> do
+      bob #: ("1", "alice", "SUB") #> ("1", "alice", ERR (BROKER NETWORK))
+      alice #: ("1", "bob", "SUB") #> ("1", "bob", ERR (BROKER NETWORK))
+      withServer $ do
+        alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 5; _ -> False
+        alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 5; _ -> False
+        bob <# ("", "alice", UP)
+        bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
+        bob #: ("2", "alice", "ACK 5") #> ("2", "alice", OK)
+        alice #: ("1", "bob", "SEND 11\nhello again") #> ("1", "bob", MID 6)
+        alice <# ("", "bob", SENT 6)
+        bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False
+
+  removeFile testStoreLogFile
+  removeFile testDB
+  removeFile testDB2
+  where
+    withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` ()
+    withAgent1 = withAgent agentTestPort testDB
+    withAgent2 = withAgent agentTestPort2 testDB2
+    withAgent :: String -> String -> (c -> IO a) -> IO a
+    withAgent agentPort agentDB = withSmpAgentThreadOn_ (ATransport t) (agentPort, testPort2, agentDB) (pure ()) . const . testSMPAgentClientOn agentPort
+
 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 4)
-      alice <# ("", "bob", SENT 4)
+      alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 5)
+      alice <# ("", "bob", SENT 5)
       bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
-      bob #: ("11", "alice", "ACK 4") #> ("11", "alice", OK)
+      bob #: ("11", "alice", "ACK 5") #> ("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 5)
+    alice #: ("2", "bob", "SEND 11\nhello again") #> ("2", "bob", MID 6)
     alice #:# "nothing else delivered before the server is restarted"
     bob #:# "nothing else delivered before the server is restarted"
 
@@ -322,11 +361,11 @@ testMsgDeliveryAgentRestart t bob = do
       alice <#= \case
         (corrId, "bob", cmd) ->
           (corrId == "3" && cmd == OK)
-            || (corrId == "" && cmd == SENT 5)
+            || (corrId == "" && cmd == SENT 6)
         _ -> False
       bob <# ("", "alice", UP)
       bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False
-      bob #: ("12", "alice", "ACK 5") #> ("12", "alice", OK)
+      bob #: ("12", "alice", "ACK 6") #> ("12", "alice", OK)
 
   removeFile testStoreLogFile
   removeFile testDB
@@ -354,11 +393,11 @@ testConcurrentMsgDelivery _ alice bob = do
   -- alice <# ("", "bob", SENT 1)
   -- bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
   -- bob #: ("12", "alice", "ACK 1") #> ("12", "alice", OK)
-  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 5)
-  bob <# ("", "alice", SENT 5)
+  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 6)
+  bob <# ("", "alice", SENT 6)
   -- if delivery is blocked it won't go further
   alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
-  alice #: ("3", "bob", "ACK 5") #> ("3", "bob", OK)
+  alice #: ("3", "bob", "ACK 6") #> ("3", "bob", OK)
 
 testMsgDeliveryQuotaExceeded :: Transport c => TProxy c -> c -> c -> IO ()
 testMsgDeliveryQuotaExceeded _ alice bob = do
@@ -371,9 +410,9 @@ testMsgDeliveryQuotaExceeded _ alice bob = do
     alice <#= \case ("", "bob", SENT m) -> m == mId; _ -> False
   (_, "bob", Right (MID _)) <- alice #: ("5", "bob", "SEND :over quota")
 
-  alice #: ("1", "bob2", "SEND :hello") #> ("1", "bob2", MID 4)
+  alice #: ("1", "bob2", "SEND :hello") #> ("1", "bob2", MID 5)
   -- if delivery is blocked it won't go further
-  alice <# ("", "bob2", SENT 4)
+  alice <# ("", "bob2", SENT 5)
 
 connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO ()
 connect (h1, name1) (h2, name2) = do
@@ -391,10 +430,10 @@ 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', 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
+  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
@@ -429,7 +468,7 @@ syntaxTests t = do
           "a",
           "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2F"
             <> urlEncode True "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
-            <> "%40localhost%3A5001%2F3456-w%3D%3D%23"
+            <> "%40127.0.0.1%3A5001%2F3456-w%3D%3D%23"
             <> urlEncode True sampleDhKey
             <> "&v=1"
             <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"

tests/AgentTests/FunctionalAPITests.hs

@@ -10,9 +10,9 @@ module AgentTests.FunctionalAPITests (functionalAPITests) where
 import Control.Monad.Except (ExceptT, runExceptT)
 import Control.Monad.IO.Unlift
 import SMPAgentClient
-import SMPClient (withSmpServer)
+import SMPClient (testPort, withSmpServer, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent
-import Simplex.Messaging.Agent.Env.SQLite (dbFile)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..))
@@ -44,6 +44,10 @@ functionalAPITests t = do
       withSmpServer t testAsyncJoiningOfflineBeforeActivation
     it "should connect with both clients going offline" $
       withSmpServer t testAsyncBothOffline
+    it "should connect on the second attempt if server was offline" $
+      testAsyncServerOffline t
+    it "should notify after HELLO timeout" $
+      withSmpServer t testAsyncHelloTimeout
 
 testAgentClient :: IO ()
 testAgentClient = do
@@ -57,26 +61,26 @@ testAgentClient = do
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, INFO "alice's connInfo")
     get bob ##> ("", aliceId, CON)
-    -- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
-    4 <- sendMessage alice bobId "hello"
-    get alice ##> ("", bobId, SENT 4)
-    5 <- sendMessage alice bobId "how are you?"
+    -- message IDs 1 to 4 get assigned to control messages, so first MSG is assigned ID 5
+    5 <- sendMessage alice bobId "hello"
     get alice ##> ("", bobId, SENT 5)
+    6 <- sendMessage alice bobId "how are you?"
+    get alice ##> ("", bobId, SENT 6)
     get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
-    ackMessage bob aliceId 4
-    get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False
     ackMessage bob aliceId 5
-    6 <- sendMessage bob aliceId "hello too"
-    get bob ##> ("", aliceId, SENT 6)
-    7 <- sendMessage bob aliceId "message 1"
+    get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False
+    ackMessage bob aliceId 6
+    7 <- sendMessage bob aliceId "hello too"
     get bob ##> ("", aliceId, SENT 7)
+    8 <- sendMessage bob aliceId "message 1"
+    get bob ##> ("", aliceId, SENT 8)
     get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
-    ackMessage alice bobId 6
-    get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False
     ackMessage alice bobId 7
+    get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False
+    ackMessage alice bobId 8
     suspendConnection alice bobId
-    8 <- sendMessage bob aliceId "message 2"
-    get bob ##> ("", aliceId, MERR 8 (SMP AUTH))
+    9 <- sendMessage bob aliceId "message 2"
+    get bob ##> ("", aliceId, MERR 9 (SMP AUTH))
     deleteConnection alice bobId
     liftIO $ noMessages alice "nothing else should be delivered to alice"
   pure ()
@@ -146,13 +150,48 @@ testAsyncBothOffline = do
     exchangeGreetings alice' bobId bob' aliceId
   pure ()
 
+testAsyncServerOffline :: ATransport -> IO ()
+testAsyncServerOffline t = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  -- create connection and shutdown the server
+  Right (bobId, cReq) <- withSmpServerStoreLogOn t testPort $ \_ ->
+    runExceptT $ createConnection alice SCMInvitation
+  -- connection fails
+  Left (BROKER NETWORK) <- runExceptT $ joinConnection bob cReq "bob's connInfo"
+  ("", bobId1, DOWN) <- get alice
+  bobId1 `shouldBe` bobId
+  -- connection succeeds after server start
+  Right () <- withSmpServerStoreLogOn t testPort $ \_ -> runExceptT $ do
+    ("", bobId2, UP) <- get alice
+    liftIO $ bobId2 `shouldBe` bobId
+    aliceId <- joinConnection bob cReq "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)
+    exchangeGreetings alice bobId bob aliceId
+  pure ()
+
+testAsyncHelloTimeout :: IO ()
+testAsyncHelloTimeout = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = testDB2, helloTimeout = 1}
+  Right () <- runExceptT $ do
+    (_, cReq) <- createConnection alice SCMInvitation
+    disconnectAgentClient alice
+    aliceId <- joinConnection bob cReq "bob's connInfo"
+    get bob ##> ("", aliceId, ERR $ CONN NOT_ACCEPTED)
+  pure ()
+
 exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetings alice bobId bob aliceId = do
-  4 <- sendMessage alice bobId "hello"
-  get alice ##> ("", bobId, SENT 4)
+  5 <- sendMessage alice bobId "hello"
+  get alice ##> ("", bobId, SENT 5)
   get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
-  ackMessage bob aliceId 4
-  5 <- sendMessage bob aliceId "hello too"
-  get bob ##> ("", aliceId, SENT 5)
+  ackMessage bob aliceId 5
+  6 <- sendMessage bob aliceId "hello too"
+  get bob ##> ("", aliceId, SENT 6)
   get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
-  ackMessage alice bobId 5
+  ackMessage alice bobId 6

tests/AgentTests/SQLiteTests.hs

@@ -51,7 +51,7 @@ 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
+  createSQLiteStore (testDB <> show r) 4 Migrations.app True
 
 removeStore :: SQLiteStore -> IO ()
 removeStore store = do
@@ -173,7 +173,9 @@ sndQueue1 =
   SndQueue
     { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
       sndId = "3456",
+      sndPublicKey = Nothing,
       sndPrivateKey = testPrivateSignKey,
+      e2ePubKey = Nothing,
       e2eDhSecret = testDhSecret,
       status = New
     }
@@ -303,7 +305,9 @@ testUpgradeRcvConnToDuplex =
           SndQueue
             { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
               sndId = "2345",
+              sndPublicKey = Nothing,
               sndPrivateKey = testPrivateSignKey,
+              e2ePubKey = Nothing,
               e2eDhSecret = testDhSecret,
               status = New
             }
@@ -393,7 +397,7 @@ mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
             sndMsgId = externalSndId,
             broker = (brokerId, ts)
           },
-      msgType = A_MSG_,
+      msgType = AM_A_MSG_,
       msgBody = hw,
       internalHash,
       externalPrevSndHash = "hash_from_sender"
@@ -422,7 +426,7 @@ mkSndMsgData internalId internalSndId internalHash =
     { internalId,
       internalSndId,
       internalTs = ts,
-      msgType = A_MSG_,
+      msgType = AM_A_MSG_,
       msgBody = hw,
       internalHash,
       prevMsgHash = internalHash

tests/CoreTests/ProtocolErrorTests.hs

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

tests/SMPAgentClient.hs

@@ -20,12 +20,13 @@ import SMPClient
     withSmpServerOn,
     withSmpServerThreadOn,
   )
-import Simplex.Messaging.Agent (runSMPAgentBlocking)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Agent.Server (runSMPAgentBlocking)
 import Simplex.Messaging.Client (SMPClientConfig (..), smpDefaultConfig)
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.Client
 import Test.Hspec
 import UnliftIO.Concurrent
 import UnliftIO.Directory
@@ -156,7 +157,7 @@ cfg :: AgentConfig
 cfg =
   defaultAgentConfig
     { tcpPort = agentTestPort,
-      smpServers = L.fromList ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
+      initialSMPServers = L.fromList ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@127.0.0.1:5001"],
       tbqSize = 1,
       dbFile = testDB,
       smpCfg =
@@ -173,7 +174,7 @@ cfg =
 
 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" smpPort' testKeyHash]}
+  let cfg' = cfg {tcpPort = port', dbFile = db', initialSMPServers = L.fromList [SMPServer "127.0.0.1" smpPort' testKeyHash]}
    in serverBracket
         (\started -> runSMPAgentBlocking t started cfg')
         afterProcess

tests/SMPClient.hs

@@ -21,6 +21,7 @@ import Simplex.Messaging.Server (runSMPServerBlocking)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (openReadStoreLog)
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.Client
 import Test.Hspec
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
@@ -28,7 +29,7 @@ import UnliftIO.STM (TMVar, atomically, newEmptyTMVarIO, takeTMVar)
 import UnliftIO.Timeout (timeout)
 
 testHost :: HostName
-testHost = "localhost"
+testHost = "127.0.0.1"
 
 testPort :: ServiceName
 testPort = "5001"

tests/Test.hs

@@ -18,7 +18,7 @@ main = do
       describe "Encoding tests" encodingTests
       describe "Protocol error tests" protocolErrorTests
       describe "Version range" versionRangeTests
-    describe "SMP server via TLS 1.3" $ serverTests (transport @TLS)
+    describe "SMP server via TLS" $ serverTests (transport @TLS)
     describe "SMP server via WebSockets" $ serverTests (transport @WS)
     describe "SMP client agent" $ agentTests (transport @TLS)
   removeDirectoryRecursive "tests/tmp"