4.1.0 (#588 )

rfc: managing exceeded queue quotas (#583 )
* rfc: managing exceeded queue quotas * update
2026-08-30 16:18:24 +00:00 · 2022-12-29 21:33:55 +00:00 · 2022-12-27 16:29:07 +00:00 · 2022-12-27 12:42:53 +00:00 · 2022-12-27 10:13:51 +00:00 · 2022-12-26 22:28:42 +00:00
55 changed files with 1657 additions and 734 deletions
@@ -1,3 +1,30 @@
+# 4.1.0
+
+SMP agent and server:
+
+- option to toggle TLS handshake error logs (disabled by default).
+
+SMP agent:
+
+- include server address in BROKER error.
+- api to get hash of double ratchet associated data (for connection verification).
+- api to get agent statistics.
+
+# 4.0.0
+
+SMP server:
+
+- Basic authentication. The server address can now include an optional password that is required to create messaging queues, so the contacts who message you will not be able to receive messages via your server, unless you share with them the address with the password. It is recommended to enable basic authentication on all private servers by adding `create_password` parameter into AUTH section of server INI file (the previously deployed servers do not have this section, you need to add it).
+- Disable creating new queues completely with `new_queues: off` parameter in AUTH section of INI file - it can be used to simplify migrating the exising connections to another server.
+- Updated server CLI with changed defaults:
+  - interactive server initialization, use -y flag to initalize the server non-interactively.
+  - store log is now enabled by default, so messaging queues and messages are restored when the server is restarted (to restore undelivered messages the server needs to be stopped with SIGINT signal).
+  - a random password is now generated by default during the server initialization.
+
+SMP agent:
+
+- API to test SMP servers. It connects to the server, creates and deletes a messaging queue. The new SimpleX Chat client uses this API to allow you to test that you have the correct server address, with the valid certificate fingerprint and pasword, before enabling the new server.
+
 # 3.4.0

 SMP agent:
@@ -94,15 +94,97 @@ It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.

 You can run your SMP server as a Linux process, optionally using a service manager for booting and restarts.

- For Ubuntu you can download a binary from [the latest release](https://github.com/simplex-chat/simplexmq/releases).
+Notice that `smp-server` requires `openssl` as run-time dependency (it is used to generate server certificates during initialization). Install it with your packet manager:

-  If you're using other Linux distribution and the binary is incompatible with it, you can build from source using [Haskell stack](https://docs.haskellstack.org/en/stable/README/):
+```sh
+# For Ubuntu
+apt update && apt install openssl
+```

-  ```shell
-  curl -sSL https://get.haskellstack.org/ | sh
-  ...
-  stack install
-  ```
+### Install binaries
+
+#### Using Docker
+
+On Linux, you can deploy smp server using Docker. This will download image from [Docker Hub](https://hub.docker.com/r/simplexchat/simplexmq).
+
+1. Create `config` and `logs` directories:
+
+   ```sh
+   mkdir -p ~/simplex/{config,logs}
+   ```
+
+2. Run your Docker container. You must change **your_ip_or_domain**. `-e pass="password"` is optional variable to password-protect your `smp` server:
+   ```sh
+   docker run -d \
+       -e addr="your_ip_or_domain" \
+       -e pass="password" \
+       -p 5223:5223 \
+       -v $HOME/simplex/config:/etc/opt/simplex:z \
+       -v $HOME/simplex/logs:/var/opt/simplex:z \
+       simplexchat/simplexmq
+   ```
+
+#### Ubuntu
+
+For Ubuntu you can download a binary from [the latest release](https://github.com/simplex-chat/simplexmq/releases).
+
+### Build from source
+
+#### Using Docker
+
+> **Please note:** to build the app use source code from [stable branch](https://github.com/simplex-chat/simplexmq/tree/stable).
+
+On Linux, you can build smp server using Docker.
+
+1. Build your `smp-server` image:
+
+   ```sh
+   git clone https://github.com/simplex-chat/simplexmq
+   cd simplexmq
+   git checkout stable
+   DOCKER_BUILDKIT=1 docker build -t smp-server -f ./build.Dockerfile .
+   ```
+
+2. Create `config` and `logs` directories:
+
+   ```sh
+   mkdir -p ~/simplex/{config,logs}
+   ```
+
+3. Run your Docker container. You must change **your_ip_or_domain**. `-e pass="password"` is optional variable to password-protect your `smp` server::
+   ```sh
+   docker run -d \
+       -e addr="your_ip_or_domain" \
+       -e pass="password" \
+       -p 5223:5223 \
+       -v $HOME/simplex/config:/etc/opt/simplex:z \
+       -v $HOME/simplex/logs:/var/opt/simplex:z \
+       smp-server
+   ```
+
+#### Using your distribution
+
+1. Install [Haskell GHCup](https://www.haskell.org/ghcup/), GHC 8.10.7 and cabal:
+
+   ```sh
+   curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
+   ghcup install ghc 8.10.7
+   ghcup install cabal
+   ghcup set ghc 8.10.7
+   ghcup set cabal
+   ```
+
+2. Build the project:
+
+   ```sh
+   git clone https://github.com/simplex-chat/simplexmq
+   cd simplexmq
+   git checkout stable
+   # On Ubuntu. Depending on your distribution, use your package manager to determine package names.
+   apt-get update && apt-get install -y build-essential libgmp3-dev zlib1g-dev
+   cabal update
+   cabal install
+   ```

 - Initialize SMP server with `smp-server init [-l] -n <fqdn>` or `smp-server init [-l] --ip <ip>` - depending on how you initialize it, either FQDN or IP will be used for server's address.

@@ -112,14 +194,6 @@ You can run your SMP server as a Linux process, optionally using a service manag

 See [this section](#smp-server) for more information. Run `smp-server -h` and `smp-server init -h` for explanation of commands and options.

-<img alt="Docker" src="./img/docker.svg" align="right" width="200">
-
-## Deploy SMP server with Docker
-
-SMP server could also be deployed using `Docker`.
-
-See: [`scripts/docker`](./scripts/docker/)
-
 [<img alt="Linode" src="./img/linode.svg" align="right" width="200">](https://cloud.linode.com/stackscripts/748014)

 ## Deploy SMP server on Linode
@@ -1,18 +1,7 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
 module Main where

 import Control.Logger.Simple
-import Data.Functor (($>))
-import Data.Ini (lookupValue)
-import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
-import Simplex.Messaging.Notifications.Server (runNtfServer)
-import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
-import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
-import Simplex.Messaging.Server.CLI (ServerCLIConfig (..), protocolServerCLI)
-import System.FilePath (combine)
+import Simplex.Messaging.Notifications.Server.Main

 cfgPath :: FilePath
 cfgPath = "/etc/opt/simplex-notifications"
@@ -26,63 +15,4 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 main :: IO ()
 main = do
  setLogLevel LogDebug -- change to LogError in production
-  withGlobalLogging logCfg $ protocolServerCLI ntfServerCLIConfig runNtfServer
-
-ntfServerCLIConfig :: ServerCLIConfig NtfServerConfig
-ntfServerCLIConfig =
-  let caCrtFile = combine cfgPath "ca.crt"
-      serverKeyFile = combine cfgPath "server.key"
-      serverCrtFile = combine cfgPath "server.crt"
-   in ServerCLIConfig
-        { cfgDir = cfgPath,
-          logDir = logPath,
-          iniFile = combine cfgPath "ntf-server.ini",
-          storeLogFile = combine logPath "ntf-server-store.log",
-          caKeyFile = combine cfgPath "ca.key",
-          caCrtFile,
-          serverKeyFile,
-          serverCrtFile,
-          fingerprintFile = combine cfgPath "fingerprint",
-          defaultServerPort = "443",
-          executableName = "ntf-server",
-          serverVersion = "SMP notifications server v1.2.0",
-          mkIniFile = \enableStoreLog defaultServerPort ->
-            "[STORE_LOG]\n\
-            \# The server uses STM memory for persistence,\n\
-            \# that will be lost on restart (e.g., as with redis).\n\
-            \# This option enables saving memory to append only log,\n\
-            \# and restoring it when the server is started.\n\
-            \# Log is compacted on start (deleted objects are removed).\n\
-            \enable: "
-              <> (if enableStoreLog then "on" else "off")
-              <> "\n\
-                 \log_stats: off\n\n\
-                 \[TRANSPORT]\n\
-                 \port: "
-              <> defaultServerPort
-              <> "\n\
-                 \websockets: off\n",
-          mkServerConfig = \storeLogFile transports ini ->
-            let settingIsOn section name = if lookupValue section name ini == Right "on" then Just () else Nothing
-                logStats = settingIsOn "STORE_LOG" "log_stats"
-             in NtfServerConfig
-                  { transports,
-                    subIdBytes = 24,
-                    regCodeBytes = 32,
-                    clientQSize = 16,
-                    subQSize = 64,
-                    pushQSize = 128,
-                    smpAgentCfg = defaultSMPClientAgentConfig,
-                    apnsConfig = defaultAPNSPushClientConfig,
-                    inactiveClientExpiration = Nothing,
-                    storeLogFile,
-                    resubscribeDelay = 50000, -- 50ms
-                    caCertificateFile = caCrtFile,
-                    privateKeyFile = serverKeyFile,
-                    certificateFile = serverCrtFile,
-                    logStatsInterval = logStats $> 86400, -- seconds
-                    logStatsStartTime = 0, -- seconds from 00:00 UTC
-                    serverStatsLogFile = combine logPath "ntf-server-stats.daily.log",
-                    serverStatsBackupFile = logStats $> combine logPath "ntf-server-stats.log"
-                  }
-        }
+  withGlobalLogging logCfg $ ntfServerCLI cfgPath logPath
@@ -1,19 +1,7 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
-{-# LANGUAGE OverloadedStrings #-}
-
 module Main where

 import Control.Logger.Simple
-import Data.Functor (($>))
-import Data.Ini (lookupValue)
-import Simplex.Messaging.Server (runSMPServer)
-import Simplex.Messaging.Server.CLI (ServerCLIConfig (..), protocolServerCLI, readStrictIni)
-import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defaultInactiveClientExpiration, defaultMessageExpiration)
-import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Transport (simplexMQVersion, supportedSMPServerVRange)
-import System.FilePath (combine)
+import Simplex.Messaging.Server.Main

 cfgPath :: FilePath
 cfgPath = "/etc/opt/simplex"
@@ -27,83 +15,4 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 main :: IO ()
 main = do
  setLogLevel LogDebug
-  withGlobalLogging logCfg . protocolServerCLI smpServerCLIConfig $ \cfg@ServerConfig {inactiveClientExpiration} -> do
-    putStrLn $ case inactiveClientExpiration of
-      Just ExpirationConfig {ttl, checkInterval} -> "expiring clients inactive for " <> show ttl <> " seconds every " <> show checkInterval <> " seconds"
-      _ -> "not expiring inactive clients"
-    runSMPServer cfg
-
-smpServerCLIConfig :: ServerCLIConfig ServerConfig
-smpServerCLIConfig =
-  let caCrtFile = combine cfgPath "ca.crt"
-      serverKeyFile = combine cfgPath "server.key"
-      serverCrtFile = combine cfgPath "server.crt"
-   in ServerCLIConfig
-        { cfgDir = cfgPath,
-          logDir = logPath,
-          iniFile = combine cfgPath "smp-server.ini",
-          storeLogFile = combine logPath "smp-server-store.log",
-          caKeyFile = combine cfgPath "ca.key",
-          caCrtFile,
-          serverKeyFile,
-          serverCrtFile,
-          fingerprintFile = combine cfgPath "fingerprint",
-          defaultServerPort = "5223",
-          executableName = "smp-server",
-          serverVersion = "SMP server v" <> simplexMQVersion,
-          mkIniFile = \enableStoreLog defaultServerPort ->
-            "[STORE_LOG]\n\
-            \# The server uses STM memory for persistence,\n\
-            \# that will be lost on restart (e.g., as with redis).\n\
-            \# This option enables saving memory to append only log,\n\
-            \# and restoring it when the server is started.\n\
-            \# Log is compacted on start (deleted objects are removed).\n"
-              <> ("enable: " <> (if enableStoreLog then "on" else "off") <> "\n")
-              <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
-                 \# they are preserved in the .bak file until the next restart.\n"
-              <> ("restore_messages: " <> (if enableStoreLog then "on" else "off") <> "\n")
-              <> ("log_stats: off\n\n")
-              <> "[TRANSPORT]\n"
-              <> ("port: " <> defaultServerPort <> "\n")
-              <> "websockets: off\n\n"
-              <> "[INACTIVE_CLIENTS]\n\
-                 \# TTL and interval to check inactive clients\n\
-                 \disconnect: off\n"
-              <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
-              <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n"),
-          mkServerConfig = \storeLogFile transports ini ->
-            let settingIsOn section name = if lookupValue section name ini == Right "on" then Just () else Nothing
-                logStats = settingIsOn "STORE_LOG" "log_stats"
-             in ServerConfig
-                  { transports,
-                    tbqSize = 16,
-                    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,
-                    privateKeyFile = serverKeyFile,
-                    certificateFile = serverCrtFile,
-                    storeLogFile,
-                    storeMsgsFile =
-                      let messagesPath = combine logPath "smp-server-messages.log"
-                       in case lookupValue "STORE_LOG" "restore_messages" ini of
-                            Right "on" -> Just messagesPath
-                            Right _ -> Nothing
-                            -- if the setting is not set, it is enabled when store log is enabled
-                            _ -> storeLogFile $> messagesPath,
-                    allowNewQueues = True,
-                    messageExpiration = Just defaultMessageExpiration,
-                    inactiveClientExpiration =
-                      settingIsOn "INACTIVE_CLIENTS" "disconnect"
-                        $> ExpirationConfig
-                          { ttl = readStrictIni "INACTIVE_CLIENTS" "ttl" ini,
-                            checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
-                          },
-                    logStatsInterval = logStats $> 86400, -- seconds
-                    logStatsStartTime = 0, -- seconds from 00:00 UTC
-                    serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
-                    serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
-                    smpServerVRange = supportedSMPServerVRange
-                  }
-        }
+  withGlobalLogging logCfg $ smpServerCLI cfgPath logPath
@@ -11,17 +11,15 @@ RUN curl https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup -o /usr/bin/ghc
    chmod +x /usr/bin/ghcup

 # Install ghc
-RUN ghcup install ghc
+RUN ghcup install ghc 8.10.7
 # Install cabal
 RUN ghcup install cabal
 # Set both as default
-RUN ghcup set ghc && \
+RUN ghcup set ghc 8.10.7 && \
    ghcup set cabal

-# Clone simplexmq repository
-RUN git clone https://github.com/simplex-chat/simplexmq
-# and cd to it
-WORKDIR ./simplexmq
+COPY . /project
+WORKDIR /project

 # Adjust PATH
 ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
@@ -41,7 +39,7 @@ RUN apt-get update && apt-get install -y openssl
 COPY --from=build /root/.cabal/bin/smp-server /usr/bin/smp-server

 # Copy our helper script
-COPY ./entrypoint /usr/bin/entrypoint
+COPY ./scripts/docker/entrypoint /usr/bin/entrypoint

 # Open smp-server listening port
 EXPOSE 5223
@@ -8,7 +8,7 @@ RUN curl -L https://github.com/simplex-chat/simplexmq/releases/latest/download/s
 	chmod +x /usr/bin/smp-server

 # Copy our helper script
-COPY ./entrypoint /usr/bin/entrypoint
+COPY ./scripts/docker/entrypoint /usr/bin/entrypoint

 # Open smp-server listening port
 EXPOSE 5223
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 3.4.0
+version: 4.1.0
 synopsis: SimpleXMQ message broker
 description: |
  This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -121,6 +121,8 @@ tests:
      - hspec-core == 2.7.*
      - HUnit == 1.6.*
      - QuickCheck == 2.14.*
+      - silently == 1.2.*
+      - main-tester == 0.2.*
      - timeit == 2.0.*

 ghc-options:
@@ -0,0 +1,156 @@
+# SimpleX File Transfer protocol
+
+## Problem
+
+Sending files as currently implemented in SimpleX Chat is inefficient for these reasons:
+
+1. Slow: message delivery requires acknowledgement for each message before the server sends the next message.
+2. Not fully asynchronous:
+   a. SMP queue size is limited, so the whole file cannot be sent/stored in server memory.
+   b. Recipient needs to accept the file before it is sent.
+3. No broadcast: sending the same file to multiple recipients requires sending it multiple times.
+
+## Possible solutions
+
+These problems could be solved within SMP protocol:
+
+- streaming messages without waiting for acknowledgements.
+- bigger queue sizes stored on hard drive and accepting large files without waiting for the recipient confirmation.
+- adding broadcast to SMP servers.
+
+These solution are complex and they do not scale well.
+
+Another approach would be adopting some open-source file storage, possibly S3-compatible, to host files while "in transit". The downsides are:
+
+1. Missing features. S3-compatible file servers require a service layer that we would need to develop to manage user accounts and permissions. There are solutions that allow self-registering users and uploading files without service layer, but they are not flexible enough in managing policies for these files.
+2. Limited meta-data protection, both on the application and on transport layer: same address for sending and receiving a file, file size is known to the server, etc.
+3. More difficult to self-host for the users when the server has 2 components (a 3rd party solution with our service component).
+
+We are not considering P2P solutions because of their bad meta-data privacy and requirement of having a single network - the same reason why P2P design is not used for SimpleX messaging network.
+
+A proposed solution is to develop a file hosting service (SimpleX File Transfer service) that would have better meta-data protection and functionality than the alternatives, using the ideas from SMP protocol design.
+
+The parameters of the solution would be:
+
+1. The server does not have knowledge of the users and actual files – only anonymously uploaded fixed-size chunks (considered 8Mb, maybe we should allow 2 sizes, e.g. 1Mb and 8Mb).
+2. The server should allow broadcast, so that a chunk can be downloaded by multiple recipients.
+3. There should be no identifiers and ciphertext in common inside TLS between sender and recipient traffic, and between the traffic of different recipients of the same file. This approach can be extended to support public chunks that have persistent identifiers.
+4. The server should prevent multiple uploads of the same chunk. This can be extended to allow multiple downloads from the same persistent address.
+5. Clients can send the chunks from the same file via multiple servers, both by splitting chunks between them and for redundancy.
+
+## Design approach
+
+File transfer servers will be chosen by file senders. The servers will allow senders to anonymously upload fixed-size file chunks.
+
+### Transport protocol
+
+- binary-encoded commands sent as fixed-size padded block in the body of HTTP2 POST request, similar to SMP and notifications server protocol transmission encodings.
+- HTTP2 POST with a fixed size padded block body for file upload and download.
+
+Block size - 4096 bytes (it would fit ~120 Ed25519 recipient keys).
+
+The reasons to use HTTP2:
+
+- avoid the need to have two hostnames (or two different ports) for commands and file uploads.
+- compatibility with the existing HTTP2 client libraries.
+
+The reason not to use JSON bodies:
+
+- bigger request size, so fewer recipient keys would fit in a single request
+- signature over command has to be outside of JSON anyway.
+
+The reason not to use URI segments / HTTP verbs / REST semantics is to have consistent request size.
+
+### Required server commands:
+
+- File sender:
+  - create file chunk record.
+    - Parameters:
+      - Ed25519 key for subsequent sender commands and Ed25519 keys for commands of each recipient.
+      - chunk size.
+    - Response:
+      - chunk ID for the sender and different IDs for all recipients.
+  - add recipients to file chunk
+    - Parameters:
+      - sender's chunk ID
+      - Ed25519 keys for commands of each recipient.
+    - Response:
+      - chunk IDs for new recipients.
+  - upload file chunk.
+  - delete file chunk (invalidates all recipient IDs).
+- File recipient:
+  - download file chunk:
+    - chunk ID
+    - DH key for additional encryption of the chunk.
+    - command should be signed with the key passed by the sender when creating chunk record.
+  - delete file chunk ID (only for one recipient): signed with the same key.
+
+### Storage model
+
+Same as for SMP and notifications server - in-memory storage of the records, with adding to append-only log, restored and compacted on server restart.
+
+### Sending file
+
+To send the file, the sender will:
+
+- compute SHA512 digest
+- pad the file to match the whole number of chunks in size,
+- encrypt it with a randomly chosen symmetric key and IV (e.g., using NaCL cryptobox),
+- split into fixed size chunks
+- upload each chunk to a randomly chosen server.
+
+Then the sending client will combine addresses of all chunks and other information into "file description", different for each file recipient, that will include:
+
+- an encryption key that was used to encrypt the file (the same for all recipients).
+- file SHA512 digest
+- list of chunk descriptions; information for each chunk:
+  - private Ed25519 key to sign commands for file transfer server.
+  - chunk address (server host and chunk ID).
+
+To reduce the size, chunk descriptions will be grouped by the server host.
+
+This "file description" itself will be sent as a small file. To estimate its size:
+
+- each chunk \* redundancy per chunk, assuming chunks are grouped per server:
+  - chunk number in the file - 8 bytes (including any overhead)
+  - Ed25519 key (different for each recipient / chunk combination) - 32 bytes \* 4/3 (base64, assuming text encoding)
+  - chunk ID (different for each recipient) - 64 bytes \* 4/3
+- server addresses - say, 128 bytes per server
+- sha512 digest - 64 bytes \* 4/3
+- encryption key - 32 bytes \* 4/3
+- IV - 32 bytes \* 4/3
+- encoding overhead - say, 256 bytes
+
+For 1gb file, sent via 4 different servers, in 8Mb chunks, with redundancy 2, the size of "file description", assuming text encoding, will be ~34kb (`128 * (8 + 32 + 64) * 2 * 4/3 + 128 * 4 + (64 + 32 + 32) * 4/3 + 256`).
+
+File description format (yml):
+
+```
+name: file.ext
+size: 33200000
+chunk: 8Mb
+hash: abc=
+key: abc=
+iv: abc=
+parts:
+  - server: xftp://abc=@example1.com
+    chunks: [1:abc=:def=, 3:abc=:def=]
+  - server: xftp://abc=@example2.com
+    chunks: [2:abc=:def=, 4:abc=:def=]
+  - server: xftp://abc=@example3.com
+    chunks: [1:abc=:def=, 4:abc=:def=]
+  - server: xftp://abc=@example4.com
+    chunks: [2:abc=:def=, 3:abc=:def=]
+```
+
+This file description is sent to all recipients via normal messages, split to 15780 byte chunks if needed.
+
+### Receiving file
+
+Having received the description, the recipient will:
+
+- download all chunks falling back to secondary servers, if needed
+- combine the chunks into a file
+- decrypt the file
+- un-pad it
+- validate file digest
@@ -0,0 +1,20 @@
+# SMP and SMP agent protocol extensions to manage queue quotas
+
+## Problem
+
+SMP servers define a limit on the number of messages that can be stored on the server. When the sender reaches this limit, they continue trying to send the message with exponential back off, until the server allows it. To reduce the traffic we added expiration on unsent messages of 2 days that:
+
+- adds its own set of problems because of expired control messages - e.g., group fragmentation.
+- doesn't solve problem of traffic in active groups with many inactive members - there are still too many retries in queues that reached capacity.
+
+## Solution
+
+Sending agent permanently stops trying to send messages having received `ERR QUOTA` (or, for the period of clients migration, increases TTL much more than in cases of network errors).
+
+Add SMP server event that means "quota reached" (e.g. `QTA` or `MSG QUOTA`) - it will be delivered to the recipient once all messages are retrieved at the same point in message stream where the sender received `ERR QUOTA`. Alternatively, it could be a message flag that is set on the last message in the queue at a point the sender received `ERR QUOTA`.
+
+Add SMP agent message that means "quota available, resume sending" (e.g. `A_QTA` or `A_RESUME`) – the receiving agent will send it via the reply queue to the sending agent that will resume sending messages at this point.
+
+Possibly, increase TTL for local messages to 30 days. That might require separately addressing the problem of permanently failing servers.
+
+We discussed a possible solution of merging all messages to one server into one delivery queue, so that having multiple failing queues on this server will not result in multiple connection attempts, and this proposal also answers the question what to do with the messages when quota is exceeded - the whole queue can be marked as suspended, and processed separately from others - TBD.
@@ -0,0 +1,27 @@
+# SMP Basic Auth
+
+## Problem
+
+Users who host their own servers do not want unknown people to be able to create messaging queues on their servers after discovering server address in groups or after making a connection. As the number of self-hosted servers is growing it became more important than it was when we excluded it from the original design.
+
+## Solution
+
+Single access password that can be optionally included in server address that is passed to app configuration. It will not be allowed in the existing contexts (and parsing will fail), to avoid accidentally leaking it. Server address with password will look this way: `smp://fingerprint:password@hosts`
+
+## Implementation plan
+
+1. A separate type to include server and password, so it can only be used where allowed.
+
+2. Server password to create queues will be configured in TRANSPORT section of INI file, as `create_password` parameter.
+
+3. The password will only be required in server configuration/address to create queues only, it won't be required for other receiving queue operations on already existing queues.
+
+4. If new command is attempted in the session that does not allow creating queues, the server will send `ERR AUTH` response
+
+5. Passing password to the server can be done in one of the several ways, we need to decide:
+
+  - as a parameter of NEW command. Pros: a local change, that only needs checking when queue is created. Cons: protocol version change.
+  - as a separate command AUTH. Pros: allows to include additional parameters and potentially be extended beyond basic auth. Cons: more complex to manage server state, can be more difficult syntax in the future, if extended.
+  - as part of handshake (we currently ignore the unparsed part of handshake block, so it can be extended). Pros: probably, the simplest, and independent of the commands protocol – establishes create permission for the current session. Cons: the client won't know about whether it is able to create the queue until it tries (same as in case 1).
+
+  My preference is the last option. As a variant of the last option, we can add a server response/message that includes permission to create queues - it will only be sent to the clients who pass credential in handshake - that might simplify testing server connection (we currently do not do it). It might be unnecessary, as we could simply create and delete queue in case credential is passed as part of testing connection (and even sending a message to it).
@@ -1,25 +0,0 @@
-# smp-server docker container
-0. Install `docker` to your host.
-
-1. Build your `smp-server` image:
-    - **Option 1** - Compile `smp-server` from source (stable branch):
-    ```sh
-    DOCKER_BUILDKIT=1 docker build -t smp-server -f smp-server-build.Dockerfile .
-    ```
-    - **Option 2** - Download latest `smp-server` from [latest Github release](https://github.com/simplex-chat/simplexmq/releases/latest):
-    ```sh
-    DOCKER_BUILDKIT=1 docker build -t smp-server -f smp-server-download.Dockerfile .
-    ```
-
-2. Run new docker container:
-```sh
-docker run -d \
-	--name smp-server \
-	-e addr="your_ip_or_domain" \
-	-p 5223:5223 \
-	-v ${PWD}/config:/etc/opt/simplex \
-	-v ${PWD}/logs:/var/opt/simplex \
-	smp-server
-```
-
-Configuration files and logs will be written to [`config`](./config) and [`logs`](./logs) folders respectively.
@@ -1 +0,0 @@
-smp-server configuration, certificate and fingerprint will be stored here
@@ -4,13 +4,19 @@ logd="/var/opt/simplex/"

 # Check if server has been initialized
 if [ ! -f "$confd/smp-server.ini" ]; then
-	# If not, determine ip or domain
-	case $addr in
-		'') printf "Please specify \$addr environment variable.\n"; exit 1 ;;
-		*[a-zA-Z]*) smp-server init -l -n "$addr" ;;
-		*) smp-server init -l --ip "$addr" ;;
-	esac
+  # If not, determine ip or domain
+  case $addr in
+    '') printf "Please specify \$addr environment variable.\n"; exit 1 ;;
+    *[a-zA-Z]*) set -- -n $addr ;;
+    *) set -- --ip $addr ;;
+  esac

+  case $pass in
+    '') set -- "$@" --no-password ;;
+    *) set -- "$@" --password $pass ;;
+  esac
+
+  smp-server init -y -l "$@"
 fi

 # backup store log
@@ -1 +0,0 @@
-smp-server general logs, stored messages and statistics (if enabled) will be stored here
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack

 name:           simplexmq
-version:        3.4.0
+version:        4.1.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -66,6 +66,7 @@ library
      Simplex.Messaging.Notifications.Protocol
      Simplex.Messaging.Notifications.Server
      Simplex.Messaging.Notifications.Server.Env
+      Simplex.Messaging.Notifications.Server.Main
      Simplex.Messaging.Notifications.Server.Push.APNS
      Simplex.Messaging.Notifications.Server.Stats
      Simplex.Messaging.Notifications.Server.Store
@@ -78,6 +79,7 @@ library
      Simplex.Messaging.Server.CLI
      Simplex.Messaging.Server.Env.STM
      Simplex.Messaging.Server.Expiration
+      Simplex.Messaging.Server.Main
      Simplex.Messaging.Server.MsgStore
      Simplex.Messaging.Server.MsgStore.STM
      Simplex.Messaging.Server.QueueStore
@@ -351,6 +353,7 @@ test-suite smp-server-test
      AgentTests.NotificationTests
      AgentTests.SchemaDump
      AgentTests.SQLiteTests
+      CLITests
      CoreTests.CryptoTests
      CoreTests.EncodingTests
      CoreTests.ProtocolErrorTests
@@ -393,6 +396,7 @@ test-suite smp-server-test
    , http2 ==3.0.*
    , ini ==0.4.1
    , iso8601-time ==0.1.*
+    , main-tester ==0.2.*
    , memory ==0.15.*
    , mtl ==2.2.*
    , network >=3.1.2.7 && <3.2
@@ -400,6 +404,7 @@ test-suite smp-server-test
    , optparse-applicative >=0.15 && <0.17
    , process ==1.6.*
    , random >=1.1 && <1.3
+    , silently ==1.2.*
    , simple-logger ==0.1.*
    , simplexmq
    , socks ==0.6.*
@@ -62,7 +62,9 @@ module Simplex.Messaging.Agent
    suspendConnection,
    deleteConnection,
    getConnectionServers,
+    getConnectionRatchetAdHash,
    setSMPServers,
+    testSMPServerConnection,
    setNtfServers,
    setNetworkConfig,
    getNetworkConfig,
@@ -77,6 +79,8 @@ module Simplex.Messaging.Agent
    suspendAgent,
    execAgentStoreSQL,
    debugAgentLocks,
+    getAgentStats,
+    resetAgentStats,
    logConnection,
  )
 where
@@ -115,12 +119,12 @@ import Simplex.Messaging.Client (ProtocolClient (..), ServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId)
 import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..))
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (BrokerMsg, ErrorType (AUTH), MsgBody, MsgFlags, NtfServer, SMPMsgMeta, SndPublicVerifyKey, sameSrvAddr)
+import Simplex.Messaging.Protocol (BrokerMsg, ErrorType (AUTH), MsgBody, MsgFlags, NtfServer, SMPMsgMeta, SndPublicVerifyKey, sameSrvAddr, sameSrvAddr')
 import qualified Simplex.Messaging.Protocol as SMP
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util
@@ -247,10 +251,18 @@ deleteConnection c = withAgentEnv c . deleteConnection' c
 getConnectionServers :: AgentErrorMonad m => AgentClient -> ConnId -> m ConnectionStats
 getConnectionServers c = withAgentEnv c . getConnectionServers' c

+-- | get connection ratchet associated data hash for verification (should match peer AD hash)
+getConnectionRatchetAdHash :: AgentErrorMonad m => AgentClient -> ConnId -> m ByteString
+getConnectionRatchetAdHash c = withAgentEnv c . getConnectionRatchetAdHash' c
+
 -- | Change servers to be used for creating new queues
-setSMPServers :: AgentErrorMonad m => AgentClient -> NonEmpty SMPServer -> m ()
+setSMPServers :: AgentErrorMonad m => AgentClient -> NonEmpty SMPServerWithAuth -> m ()
 setSMPServers c = withAgentEnv c . setSMPServers' c

+-- | Test SMP server
+testSMPServerConnection :: AgentErrorMonad m => AgentClient -> SMPServerWithAuth -> m (Maybe SMPTestFailure)
+testSMPServerConnection c = withAgentEnv c . runSMPServerTest c
+
 setNtfServers :: AgentErrorMonad m => AgentClient -> [NtfServer] -> m ()
 setNtfServers c = withAgentEnv c . setNtfServers' c

@@ -304,6 +316,12 @@ execAgentStoreSQL c = withAgentEnv c . execAgentStoreSQL' c
 debugAgentLocks :: AgentErrorMonad m => AgentClient -> m AgentLocks
 debugAgentLocks c = withAgentEnv c $ debugAgentLocks' c

+getAgentStats :: AgentErrorMonad m => AgentClient -> m [(AgentStatsKey, Int)]
+getAgentStats c = readTVarIO (agentStats c) >>= mapM (\(k, cnt) -> (k,) <$> readTVarIO cnt) . M.assocs
+
+resetAgentStats :: AgentErrorMonad m => AgentClient -> m ()
+resetAgentStats = atomically . TM.clear . agentStats
+
 withAgentEnv :: AgentClient -> ReaderT Env m a -> m a
 withAgentEnv c = (`runReaderT` agentEnv c)

@@ -430,7 +448,7 @@ newConn :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionM
 newConn c connId asyncMode enableNtfs cMode clientData =
  getSMPServer c >>= newConnSrv c connId asyncMode enableNtfs cMode clientData

-newConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> SMPServer -> m (ConnId, ConnectionRequestUri c)
+newConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> SMPServerWithAuth -> m (ConnId, ConnectionRequestUri c)
 newConnSrv c connId asyncMode enableNtfs cMode clientData srv = do
  AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
  (q, qUri) <- newRcvQueue c "" srv smpClientVRange
@@ -464,7 +482,7 @@ joinConn c connId asyncMode enableNtfs cReq cInfo = do
    _ -> getSMPServer c
  joinConnSrv c connId asyncMode enableNtfs cReq cInfo srv

-joinConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> SMPServer -> m ConnId
+joinConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> SMPServerWithAuth -> m ConnId
 joinConnSrv c connId asyncMode enableNtfs (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} e2eRcvParamsUri) cInfo srv = do
  AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
  case ( qUri `compatibleVersion` smpClientVRange,
@@ -516,7 +534,7 @@ joinConnSrv c connId False enableNtfs (CRContactUri ConnReqUriData {crAgentVRang
 joinConnSrv _c _connId True _enableNtfs (CRContactUri _) _cInfo _srv = do
  throwError $ CMD PROHIBITED

-createReplyQueue :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> SMPServer -> m SMPQueueInfo
+createReplyQueue :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> m SMPQueueInfo
 createReplyQueue c ConnData {connId, enableNtfs} SndQueue {smpClientVersion} srv = do
  (rq, qUri) <- newRcvQueue c connId srv $ versionToRange smpClientVersion
  let qInfo = toVersionT qUri smpClientVersion
@@ -873,22 +891,22 @@ runCommandProcessing c@AgentClient {subQ} server_ = do
        tryCommand action = withRetryInterval ri $ \loop ->
          tryError action >>= \case
            Left e
-              | temporaryAgentError e || e == BROKER HOST -> retrySndOp c loop
+              | temporaryOrHostError e -> retrySndOp c loop
              | otherwise -> cmdError e
            Right () -> withStore' c (`deleteCommand` cmdId)
        tryWithLock name = tryCommand . withConnLock c connId name
        internalErr s = cmdError $ INTERNAL $ s <> ": " <> show (agentCommandTag command)
        cmdError e = notify (ERR e) >> withStore' c (`deleteCommand` cmdId)
        notify cmd = atomically $ writeTBQueue subQ (corrId, connId, cmd)
-        withNextSrv :: TVar [SMPServer] -> [SMPServer] -> (SMPServer -> m ()) -> m ()
+        withNextSrv :: TVar [SMPServer] -> [SMPServer] -> (SMPServerWithAuth -> m ()) -> m ()
        withNextSrv usedSrvs initUsed action = do
          used <- readTVarIO usedSrvs
-          srv <- getNextSMPServer c used
+          srvAuth@(ProtoServerWithAuth srv _) <- getNextSMPServer c used
          atomically $ do
            srvs <- readTVar $ smpServers c
            let used' = if length used + 1 >= L.length srvs then initUsed else srv : used
            writeTVar usedSrvs used'
-          action srv
+          action srvAuth
 -- ^ ^ ^ async command processing /

 enqueueMessages :: AgentMonad m => AgentClient -> ConnData -> NonEmpty SndQueue -> MsgFlags -> AMessage -> m AgentMsgId
@@ -1011,7 +1029,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {connId, duplexHandsh
                _
                  -- for other operations BROKER HOST is treated as a permanent error (e.g., when connecting to the server),
                  -- the message sending would be retried
-                  | temporaryAgentError e || e == BROKER HOST -> do
+                  | temporaryOrHostError e -> do
                    let timeoutSel = if msgType == AM_HELLO_ then helloTimeout else messageTimeout
                    ifM (msgExpired timeoutSel) (notifyDel msgId err) (retrySndOp c loop)
                  | otherwise -> notifyDel msgId err
@@ -1124,8 +1142,8 @@ switchConnection' c connId = withConnLock c connId "switchConnection" $ do
    DuplexConnection cData rqs@(rq@RcvQueue {server, dbQueueId, sndId} :| rqs_) sqs -> do
      clientVRange <- asks $ smpClientVRange . config
      -- try to get the server that is different from all queues, or at least from the primary rcv queue
-      srv <- getNextSMPServer c $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
-      srv' <- if srv == server then getNextSMPServer c [server] else pure srv
+      srvAuth@(ProtoServerWithAuth srv _) <- getNextSMPServer c $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
+      srv' <- if srv == server then getNextSMPServer c [server] else pure srvAuth
      (q, qUri) <- newRcvQueue c connId srv' clientVRange
      let rq' = (q :: RcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
      void . withStore c $ \db -> addConnRcvQueue db connId rq'
@@ -1182,6 +1200,11 @@ getConnectionServers' c connId = do
  SomeConn _ conn <- withStore c (`getConn` connId)
  pure $ connectionStats conn

+getConnectionRatchetAdHash' :: AgentMonad m => AgentClient -> ConnId -> m ByteString
+getConnectionRatchetAdHash' c connId = do
+  CR.Ratchet {rcAD = Str rcAD} <- withStore c (`getRatchet` connId)
+  pure $ C.sha256Hash rcAD
+
 connectionStats :: Connection c -> ConnectionStats
 connectionStats = \case
  RcvConnection _ rq -> ConnectionStats {rcvServers = [qServer rq], sndServers = []}
@@ -1191,7 +1214,7 @@ connectionStats = \case
  NewConnection _ -> ConnectionStats {rcvServers = [], sndServers = []}

 -- | Change servers to be used for creating new queues, in Reader monad
-setSMPServers' :: AgentMonad m => AgentClient -> NonEmpty SMPServer -> m ()
+setSMPServers' :: AgentMonad m => AgentClient -> NonEmpty SMPServerWithAuth -> m ()
 setSMPServers' c = atomically . writeTVar (smpServers c)

 registerNtfToken' :: forall m. AgentMonad m => AgentClient -> DeviceToken -> NotificationsMode -> m NtfTknStatus
@@ -1237,7 +1260,7 @@ registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
        replaceToken tknId = do
          ns <- asks ntfSupervisor
          tryReplace ns `catchError` \e ->
-            if temporaryAgentError e || e == BROKER HOST
+            if temporaryOrHostError e
              then throwError e
              else do
                withStore' c $ \db -> removeNtfToken db tkn
@@ -1436,20 +1459,20 @@ debugAgentLocks' AgentClient {connLocks = cs, reconnectLocks = rs} = do
  where
    getLocks ls = atomically $ M.mapKeys (B.unpack . strEncode) . M.mapMaybe id <$> (mapM tryReadTMVar =<< readTVar ls)

-getSMPServer :: AgentMonad m => AgentClient -> m SMPServer
+getSMPServer :: AgentMonad m => AgentClient -> m SMPServerWithAuth
 getSMPServer c = readTVarIO (smpServers c) >>= pickServer

-pickServer :: AgentMonad m => NonEmpty SMPServer -> m SMPServer
+pickServer :: AgentMonad m => NonEmpty SMPServerWithAuth -> m SMPServerWithAuth
 pickServer = \case
  srv :| [] -> pure srv
  servers -> do
    gen <- asks randomServer
    atomically $ (servers L.!!) <$> stateTVar gen (randomR (0, L.length servers - 1))

-getNextSMPServer :: AgentMonad m => AgentClient -> [SMPServer] -> m SMPServer
+getNextSMPServer :: AgentMonad m => AgentClient -> [SMPServer] -> m SMPServerWithAuth
 getNextSMPServer c usedSrvs = do
  srvs <- readTVarIO $ smpServers c
-  case L.nonEmpty $ deleteFirstsBy sameSrvAddr (L.toList srvs) usedSrvs of
+  case L.nonEmpty $ deleteFirstsBy sameSrvAddr' (L.toList srvs) (map noAuthSrv usedSrvs) of
    Just srvs' -> pickServer srvs'
    _ -> pickServer srvs

@@ -1572,7 +1595,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cm
            ignored = pure "END from disconnected client - ignored"
        _ -> do
          logServer "<--" c srv rId $ "unexpected: " <> bshow cmd
-          notify . ERR $ BROKER UNEXPECTED
+          notify . ERR $ BROKER (B.unpack $ strEncode srv) UNEXPECTED
      where
        notify :: ACommand 'Agent -> m ()
        notify msg = atomically $ writeTBQueue subQ ("", connId, msg)
@@ -1766,7 +1789,7 @@ connectReplyQueues c cData@ConnData {connId} ownConnInfo (qInfo :| _) = do
      dbQueueId <- withStore c $ \db -> upgradeRcvConnToDuplex db connId sq
      enqueueConfirmation c cData sq {dbQueueId} ownConnInfo Nothing

-confirmQueue :: forall m. AgentMonad m => Compatible Version -> AgentClient -> ConnData -> SndQueue -> SMPServer -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
+confirmQueue :: forall m. AgentMonad m => Compatible Version -> AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
 confirmQueue (Compatible agentVersion) c cData@ConnData {connId} sq srv connInfo e2eEncryption = do
  aMessage <- mkAgentMessage agentVersion
  msg <- mkConfirmation aMessage
@@ -1822,18 +1845,8 @@ agentRatchetDecrypt db connId encAgentMsg = do
  liftEither $ first (SEAgentError . cryptoError) agentMsgBody_

 newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => ConnId -> Compatible SMPQueueInfo -> m SndQueue
-newSndQueue connId qInfo =
-  asks (cmdSignAlg . config) >>= \case
-    C.SignAlg a -> newSndQueue_ a connId qInfo
-
-newSndQueue_ ::
-  (C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m) =>
-  C.SAlgorithm a ->
-  ConnId ->
-  Compatible SMPQueueInfo ->
-  m SndQueue
-newSndQueue_ a connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey = rcvE2ePubDhKey})) = do
-  -- this function assumes clientVersion is compatible - it was tested before
+newSndQueue connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey = rcvE2ePubDhKey})) = do
+  C.SignAlg a <- asks $ cmdSignAlg . config
  (sndPublicKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
  (e2ePubKey, e2ePrivKey) <- liftIO C.generateKeyPair'
  pure
@@ -17,10 +17,13 @@

 module Simplex.Messaging.Agent.Client
  ( AgentClient (..),
+    SMPTestFailure (..),
+    SMPTestStep (..),
    newAgentClient,
    withConnLock,
    closeAgentClient,
    closeProtocolServerClients,
+    runSMPServerTest,
    newRcvQueue,
    subscribeQueue,
    subscribeQueues,
@@ -31,6 +34,7 @@ module Simplex.Messaging.Agent.Client
    sendConfirmation,
    sendInvitation,
    temporaryAgentError,
+    temporaryOrHostError,
    secureQueue,
    enableQueueNotifications,
    disableQueueNotifications,
@@ -59,6 +63,7 @@ module Simplex.Messaging.Agent.Client
    AgentOpState (..),
    AgentState (..),
    AgentLocks (..),
+    AgentStatsKey (..),
    agentOperations,
    agentOperationBracket,
    waitUntilActive,
@@ -76,7 +81,8 @@ module Simplex.Messaging.Agent.Client
  )
 where

-import Control.Concurrent (forkIO)
+import Control.Applicative ((<|>))
+import Control.Concurrent (forkIO, threadDelay)
 import Control.Concurrent.Async (Async, uninterruptibleCancel)
 import Control.Concurrent.STM (retry, stateTVar, throwSTM)
 import Control.Exception (AsyncException (..))
@@ -104,6 +110,7 @@ import Data.Text.Encoding
 import Data.Word (Word16)
 import qualified Database.SQLite.Simple as DB
 import GHC.Generics (Generic)
+import Network.Socket (HostName)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
@@ -120,7 +127,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Client
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Parsers (parse)
+import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parse)
 import Simplex.Messaging.Protocol
  ( AProtocolType (..),
    BrokerMsg,
@@ -164,7 +171,7 @@ data AgentClient = AgentClient
    rcvQ :: TBQueue (ATransmission 'Client),
    subQ :: TBQueue (ATransmission 'Agent),
    msgQ :: TBQueue (ServerTransmission BrokerMsg),
-    smpServers :: TVar (NonEmpty SMPServer),
+    smpServers :: TVar (NonEmpty SMPServerWithAuth),
    smpClients :: TMap SMPServer SMPClientVar,
    ntfServers :: TVar [NtfServer],
    ntfClients :: TMap NtfServer NtfClientVar,
@@ -191,6 +198,7 @@ data AgentClient = AgentClient
    reconnectLocks :: TMap SMPServer Lock,
    reconnections :: TVar [Async ()],
    asyncClients :: TVar [Async ()],
+    agentStats :: TMap AgentStatsKey (TVar Int),
    clientId :: Int,
    agentEnv :: Env
  }
@@ -219,6 +227,9 @@ data AgentLocks = AgentLocks {connLocks :: Map String String, srvLocks :: Map St

 instance ToJSON AgentLocks where toEncoding = J.genericToEncoding J.defaultOptions

+data AgentStatsKey = AgentStatsKey {host :: ByteString, clientTs :: ByteString, cmd :: ByteString, res :: ByteString}
+  deriving (Eq, Ord, Show)
+
 newAgentClient :: InitialAgentServers -> Env -> STM AgentClient
 newAgentClient InitialAgentServers {smp, ntf, netCfg} agentEnv = do
  let qSize = tbqSize $ config agentEnv
@@ -251,8 +262,9 @@ newAgentClient InitialAgentServers {smp, ntf, netCfg} agentEnv = do
  reconnectLocks <- TM.empty
  reconnections <- newTVar []
  asyncClients <- newTVar []
+  agentStats <- TM.empty
  clientId <- stateTVar (clientCounter agentEnv) $ \i -> let i' = i + 1 in (i', i')
-  return AgentClient {active, rcvQ, subQ, msgQ, smpServers, smpClients, ntfServers, ntfClients, useNetworkConfig, subscrConns, activeSubs, pendingSubs, pendingMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, connCmdsQueued, asyncCmdQueues, asyncCmdProcesses, ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp, agentState, getMsgLocks, connLocks, reconnectLocks, reconnections, asyncClients, clientId, agentEnv}
+  return AgentClient {active, rcvQ, subQ, msgQ, smpServers, smpClients, ntfServers, ntfClients, useNetworkConfig, subscrConns, activeSubs, pendingSubs, pendingMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, connCmdsQueued, asyncCmdQueues, asyncCmdProcesses, ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp, agentState, getMsgLocks, connLocks, reconnectLocks, reconnections, asyncClients, agentStats, clientId, agentEnv}

 agentClientStore :: AgentClient -> SQLiteStore
 agentClientStore AgentClient {agentEnv = Env {store}} = store
@@ -275,13 +287,13 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} srv = do
  atomically (getClientVar srv smpClients)
    >>= either
      (newProtocolClient c srv smpClients connectClient reconnectClient)
-      (waitForProtocolClient c)
+      (waitForProtocolClient c srv)
  where
    connectClient :: m SMPClient
    connectClient = do
-      cfg <- atomically . updateClientConfig c =<< asks (smpCfg . config)
+      cfg <- getClientConfig c smpCfg
      u <- askUnliftIO
-      liftEitherError (protocolClientError SMP) (getProtocolClient srv cfg (Just msgQ) $ clientDisconnected u)
+      liftEitherError (protocolClientError SMP $ B.unpack $ strEncode srv) (getProtocolClient srv cfg (Just msgQ) $ clientDisconnected u)

    clientDisconnected :: UnliftIO m -> SMPClient -> IO ()
    clientDisconnected u client = do
@@ -300,6 +312,7 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} srv = do

        serverDown :: ([RcvQueue], [ConnId]) -> IO ()
        serverDown (qs, conns) = whenM (readTVarIO active) $ do
+          incClientStat c client "DISCONNECT" ""
          notifySub "" $ hostEvent DISCONNECT client
          unless (null conns) $ notifySub "" $ DOWN srv conns
          unless (null qs) $ do
@@ -329,7 +342,9 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} srv = do
          (client_, rs) <- subscribeQueues c srv qs
          let (errs, okConns) = partitionEithers $ map (\(RcvQueue {connId}, r) -> bimap (connId,) (const connId) r) rs
          liftIO $ do
-            unless connected $ mapM_ (notifySub "" . hostEvent CONNECT) client_
+            unless connected . forM_ client_ $ \cl -> do
+              incClientStat c cl "CONNECT" ""
+              notifySub "" $ hostEvent CONNECT cl
            -- TODO deduplicate okConns
            let conns = okConns \\ S.toList cs
            unless (null conns) $ notifySub "" $ UP srv conns
@@ -346,16 +361,17 @@ getNtfServerClient c@AgentClient {active, ntfClients} srv = do
  atomically (getClientVar srv ntfClients)
    >>= either
      (newProtocolClient c srv ntfClients connectClient $ pure ())
-      (waitForProtocolClient c)
+      (waitForProtocolClient c srv)
  where
    connectClient :: m NtfClient
    connectClient = do
-      cfg <- atomically . updateClientConfig c =<< asks (ntfCfg . config)
-      liftEitherError (protocolClientError NTF) (getProtocolClient srv cfg Nothing clientDisconnected)
+      cfg <- getClientConfig c ntfCfg
+      liftEitherError (protocolClientError NTF $ B.unpack $ strEncode srv) (getProtocolClient srv cfg Nothing clientDisconnected)

    clientDisconnected :: NtfClient -> IO ()
    clientDisconnected client = do
      atomically $ TM.delete srv ntfClients
+      incClientStat c client "DISCONNECT" ""
      atomically $ writeTBQueue (subQ c) ("", "", hostEvent DISCONNECT client)
      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv

@@ -368,14 +384,14 @@ getClientVar srv clients = maybe (Left <$> newClientVar) (pure . Right) =<< TM.l
      TM.insert srv var clients
      pure var

-waitForProtocolClient :: AgentMonad m => AgentClient -> ClientVar msg -> m (ProtocolClient msg)
-waitForProtocolClient c clientVar = do
+waitForProtocolClient :: (AgentMonad m, ProtocolTypeI (ProtoType msg)) => AgentClient -> ProtoServer msg -> ClientVar msg -> m (ProtocolClient msg)
+waitForProtocolClient c srv clientVar = do
  NetworkConfig {tcpConnectTimeout} <- readTVarIO $ useNetworkConfig c
  client_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar clientVar)
  liftEither $ case client_ of
    Just (Right smpClient) -> Right smpClient
    Just (Left e) -> Left e
-    Nothing -> Left $ BROKER TIMEOUT
+    Nothing -> Left $ BROKER (B.unpack $ strEncode srv) TIMEOUT

 newProtocolClient ::
  forall msg m.
@@ -395,9 +411,11 @@ newProtocolClient c srv clients connectClient reconnectClient clientVar = tryCon
        Right client -> do
          logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
          atomically $ putTMVar clientVar r
+          liftIO $ incClientStat c client "CLIENT" "OK"
          atomically $ writeTBQueue (subQ c) ("", "", hostEvent CONNECT client)
          successAction client
        Left e -> do
+          liftIO $ incServerStat c srv "CLIENT" $ strEncode e
          if temporaryAgentError e
            then retryAction
            else atomically $ do
@@ -414,11 +432,12 @@ newProtocolClient c srv clients connectClient reconnectClient clientVar = tryCon
      withRetryInterval ri $ \loop -> void $ tryConnectClient (const reconnectClient) loop

 hostEvent :: forall msg. ProtocolTypeI (ProtoType msg) => (AProtocolType -> TransportHost -> ACommand 'Agent) -> ProtocolClient msg -> ACommand 'Agent
-hostEvent event client = event (AProtocolType $ protocolTypeI @(ProtoType msg)) $ transportHost client
+hostEvent event client = event (AProtocolType $ protocolTypeI @(ProtoType msg)) $ transportHost' client

-updateClientConfig :: AgentClient -> ProtocolClientConfig -> STM ProtocolClientConfig
-updateClientConfig AgentClient {useNetworkConfig} cfg = do
-  networkConfig <- readTVar useNetworkConfig
+getClientConfig :: AgentMonad m => AgentClient -> (AgentConfig -> ProtocolClientConfig) -> m ProtocolClientConfig
+getClientConfig AgentClient {useNetworkConfig} cfgSel = do
+  cfg <- asks $ cfgSel . config
+  networkConfig <- readTVarIO useNetworkConfig
  pure cfg {networkConfig}

 closeAgentClient :: MonadIO m => AgentClient -> m ()
@@ -479,62 +498,95 @@ withLockMap_ locks key = withGetLock $ TM.lookup key locks >>= maybe newLock pur
  where
    newLock = newEmptyTMVar >>= \l -> TM.insert key l locks $> l

-withClient_ :: forall a m msg. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtoServer msg -> (ProtocolClient msg -> m a) -> m a
-withClient_ c srv action = (getProtocolServerClient c srv >>= action) `catchError` logServerError
+withClient_ :: forall a m msg. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtoServer msg -> ByteString -> (ProtocolClient msg -> m a) -> m a
+withClient_ c srv statCmd action = do
+  cl <- getProtocolServerClient c srv
+  (action cl <* stat cl "OK") `catchError` logServerError cl
  where
-    logServerError :: AgentErrorType -> m a
-    logServerError e = do
-      logServer "<--" c srv "" $ bshow e
+    stat cl = liftIO . incClientStat c cl statCmd
+    logServerError :: ProtocolClient msg -> AgentErrorType -> m a
+    logServerError cl e = do
+      logServer "<--" c srv "" $ strEncode e
+      stat cl $ strEncode e
      throwError e

 withLogClient_ :: (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtoServer msg -> QueueId -> ByteString -> (ProtocolClient msg -> m a) -> m a
 withLogClient_ c srv qId cmdStr action = do
  logServer "-->" c srv qId cmdStr
-  res <- withClient_ c srv action
+  res <- withClient_ c srv cmdStr action
  logServer "<--" c srv qId "OK"
  return res

-withClient :: forall m msg a. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtoServer msg -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
-withClient c srv action = withClient_ c srv $ liftClient (clientProtocolError @msg) . action
+withClient :: forall m msg a. (AgentMonad m, ProtocolServerClient msg, ProtocolTypeI (ProtoType msg)) => AgentClient -> ProtoServer msg -> ByteString -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
+withClient c srv statKey action = withClient_ c srv statKey $ \client -> liftClient (clientProtocolError @msg) (clientServer client) $ action client

-withLogClient :: forall m msg a. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtoServer msg -> QueueId -> ByteString -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
-withLogClient c srv qId cmdStr action = withLogClient_ c srv qId cmdStr $ liftClient (clientProtocolError @msg) . action
+withLogClient :: forall m msg a. (AgentMonad m, ProtocolServerClient msg, ProtocolTypeI (ProtoType msg)) => AgentClient -> ProtoServer msg -> QueueId -> ByteString -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
+withLogClient c srv qId cmdStr action = withLogClient_ c srv qId cmdStr $ \client -> liftClient (clientProtocolError @msg) (clientServer client) $ action client

-liftClient :: AgentMonad m => (ErrorType -> AgentErrorType) -> ExceptT ProtocolClientError IO a -> m a
-liftClient = liftError . protocolClientError
+liftClient :: AgentMonad m => (ErrorType -> AgentErrorType) -> HostName -> ExceptT ProtocolClientError IO a -> m a
+liftClient protocolError_ = liftError . protocolClientError protocolError_

-protocolClientError :: (ErrorType -> AgentErrorType) -> ProtocolClientError -> AgentErrorType
-protocolClientError protocolError_ = \case
+protocolClientError :: (ErrorType -> AgentErrorType) -> HostName -> ProtocolClientError -> AgentErrorType
+protocolClientError protocolError_ host = \case
  PCEProtocolError e -> protocolError_ e
-  PCEResponseError e -> BROKER $ RESPONSE e
-  PCEUnexpectedResponse _ -> BROKER UNEXPECTED
-  PCEResponseTimeout -> BROKER TIMEOUT
-  PCENetworkError -> BROKER NETWORK
-  PCEIncompatibleHost -> BROKER HOST
-  PCETransportError e -> BROKER $ TRANSPORT e
+  PCEResponseError e -> BROKER host $ RESPONSE e
+  PCEUnexpectedResponse _ -> BROKER host UNEXPECTED
+  PCEResponseTimeout -> BROKER host TIMEOUT
+  PCENetworkError -> BROKER host NETWORK
+  PCEIncompatibleHost -> BROKER host HOST
+  PCETransportError e -> BROKER host $ TRANSPORT e
  e@PCESignatureError {} -> INTERNAL $ show e
  e@PCEIOError {} -> INTERNAL $ show e

-newRcvQueue :: AgentMonad m => AgentClient -> ConnId -> SMPServer -> VersionRange -> m (RcvQueue, SMPQueueUri)
-newRcvQueue c connId srv vRange =
-  asks (cmdSignAlg . config) >>= \case
-    C.SignAlg a -> newRcvQueue_ a c connId srv vRange
+data SMPTestStep = TSConnect | TSCreateQueue | TSSecureQueue | TSDeleteQueue | TSDisconnect
+  deriving (Eq, Show, Generic)

-newRcvQueue_ ::
-  (C.SignatureAlgorithm a, C.AlgorithmI a, AgentMonad m) =>
-  C.SAlgorithm a ->
-  AgentClient ->
-  ConnId ->
-  SMPServer ->
-  VersionRange ->
-  m (RcvQueue, SMPQueueUri)
-newRcvQueue_ a c connId srv vRange = do
+instance ToJSON SMPTestStep where
+  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "TS"
+  toJSON = J.genericToJSON . enumJSON $ dropPrefix "TS"
+
+data SMPTestFailure = SMPTestFailure
+  { testStep :: SMPTestStep,
+    testError :: AgentErrorType
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON SMPTestFailure where
+  toEncoding = J.genericToEncoding J.defaultOptions
+  toJSON = J.genericToJSON J.defaultOptions
+
+runSMPServerTest :: AgentMonad m => AgentClient -> SMPServerWithAuth -> m (Maybe SMPTestFailure)
+runSMPServerTest c (ProtoServerWithAuth srv auth) = do
+  cfg <- getClientConfig c smpCfg
+  C.SignAlg a <- asks $ cmdSignAlg . config
+  liftIO $ do
+    getProtocolClient srv cfg Nothing (\_ -> pure ()) >>= \case
+      Right smp -> do
+        (rKey, rpKey) <- C.generateSignatureKeyPair a
+        (sKey, _) <- C.generateSignatureKeyPair a
+        (dhKey, _) <- C.generateKeyPair'
+        r <- runExceptT $ do
+          SMP.QIK {rcvId} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp rpKey rKey dhKey auth
+          liftError (testErr TSSecureQueue) $ secureSMPQueue smp rpKey rcvId sKey
+          liftError (testErr TSDeleteQueue) $ deleteSMPQueue smp rpKey rcvId
+        ok <- tcpTimeout (networkConfig cfg) `timeout` closeProtocolClient smp
+        incClientStat c smp "TEST" "OK"
+        pure $ either Just (const Nothing) r <|> maybe (Just (SMPTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
+      Left e -> pure (Just $ testErr TSConnect e)
+  where
+    addr = B.unpack $ strEncode srv
+    testErr :: SMPTestStep -> ProtocolClientError -> SMPTestFailure
+    testErr step = SMPTestFailure step . protocolClientError SMP addr
+
+newRcvQueue :: AgentMonad m => AgentClient -> ConnId -> SMPServerWithAuth -> VersionRange -> m (RcvQueue, SMPQueueUri)
+newRcvQueue c connId (ProtoServerWithAuth srv auth) vRange = do
+  C.SignAlg a <- asks (cmdSignAlg . config)
  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
  (dhKey, privDhKey) <- liftIO C.generateKeyPair'
  (e2eDhKey, e2ePrivKey) <- liftIO C.generateKeyPair'
  logServer "-->" c srv "" "NEW"
  QIK {rcvId, sndId, rcvPublicDhKey} <-
-    withClient c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey dhKey
+    withClient c srv "NEW" $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey dhKey auth
  logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
  let rq =
        RcvQueue
@@ -582,10 +634,15 @@ temporaryClientError = \case

 temporaryAgentError :: AgentErrorType -> Bool
 temporaryAgentError = \case
-  BROKER NETWORK -> True
-  BROKER TIMEOUT -> True
+  BROKER _ NETWORK -> True
+  BROKER _ TIMEOUT -> True
  _ -> False

+temporaryOrHostError :: AgentErrorType -> Bool
+temporaryOrHostError = \case
+  BROKER _ HOST -> True
+  e -> temporaryAgentError e
+
 -- | subscribe multiple queues - all passed queues should be on the same server
 subscribeQueues :: AgentMonad m => AgentClient -> SMPServer -> [RcvQueue] -> m (Maybe SMPClient, [(RcvQueue, Either AgentErrorType ())])
 subscribeQueues c srv qs = do
@@ -602,10 +659,12 @@ subscribeQueues c srv qs = do
        Right smp -> do
          logServer "-->" c srv (bshow (length qs_) <> " queues") "SUB"
          let qs2 = L.map queueCreds qs'
+              n = (length qs2 - 1) `div` 90 + 1
+          liftIO $ incClientStatN c smp n "SUBS" "OK"
          liftIO $ do
            rs <- zip qs_ . L.toList <$> subscribeSMPQueues smp qs2
            mapM_ (uncurry $ processSubResult c) rs
-            pure $ map (second . first $ protocolClientError SMP) rs
+            pure $ map (second . first $ protocolClientError SMP $ clientServer smp) rs
    _ -> pure (Nothing, errs)
  where
    checkQueue rq@RcvQueue {rcvId, server} = do
@@ -647,14 +706,14 @@ sendConfirmation c sq@SndQueue {server, sndId, sndPublicKey = Just sndPublicKey,
  withLogClient_ c server sndId "SEND <CONF>" $ \smp -> do
    let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
    msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
-    liftClient SMP $ sendSMPMessage smp Nothing sndId (SMP.MsgFlags {notification = True}) msg
+    liftClient SMP (clientServer smp) $ sendSMPMessage smp Nothing sndId (SMP.MsgFlags {notification = True}) msg
 sendConfirmation _ _ _ = throwError $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"

 sendInvitation :: forall m. AgentMonad m => AgentClient -> Compatible SMPQueueInfo -> Compatible Version -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> m ()
 sendInvitation c (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo =
  withLogClient_ c smpServer senderId "SEND <INV>" $ \smp -> do
    msg <- mkInvitation
-    liftClient SMP $ sendSMPMessage smp Nothing senderId MsgFlags {notification = True} msg
+    liftClient SMP (clientServer smp) $ sendSMPMessage smp Nothing senderId MsgFlags {notification = True} msg
  where
    mkInvitation :: m ByteString
    -- this is only encrypted with per-queue E2E, not with double ratchet
@@ -725,11 +784,11 @@ sendAgentMessage c sq@SndQueue {server, sndId, sndPrivateKey} msgFlags agentMsg
  withLogClient_ c server sndId "SEND <MSG>" $ \smp -> do
    let clientMsg = SMP.ClientMessage SMP.PHEmpty agentMsg
    msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
-    liftClient SMP $ sendSMPMessage smp (Just sndPrivateKey) sndId msgFlags msg
+    liftClient SMP (clientServer smp) $ sendSMPMessage smp (Just sndPrivateKey) sndId msgFlags msg

 agentNtfRegisterToken :: AgentMonad m => AgentClient -> NtfToken -> C.APublicVerifyKey -> C.PublicKeyX25519 -> m (NtfTokenId, C.PublicKeyX25519)
 agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
-  withClient c ntfServer $ \ntf -> ntfRegisterToken ntf ntfPrivKey (NewNtfTkn deviceToken ntfPubKey pubDhKey)
+  withClient c ntfServer "TNEW" $ \ntf -> ntfRegisterToken ntf ntfPrivKey (NewNtfTkn deviceToken ntfPubKey pubDhKey)

 agentNtfVerifyToken :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken -> NtfRegCode -> m ()
 agentNtfVerifyToken c tknId NtfToken {ntfServer, ntfPrivKey} code =
@@ -885,3 +944,25 @@ storeError = \case
  -- NOTE: network IO should NOT be used inside AgentStoreMonad
  SEAgentError e -> e
  e -> INTERNAL $ show e
+
+incStat :: AgentClient -> Int -> AgentStatsKey -> STM ()
+incStat AgentClient {agentStats} n k = do
+  TM.lookup k agentStats >>= \case
+    Just v -> modifyTVar v (+ n)
+    _ -> newTVar n >>= \v -> TM.insert k v agentStats
+
+incClientStat :: AgentClient -> ProtocolClient msg -> ByteString -> ByteString -> IO ()
+incClientStat c pc = incClientStatN c pc 1
+
+incServerStat :: AgentClient -> ProtocolServer p -> ByteString -> ByteString -> IO ()
+incServerStat c ProtocolServer {host} cmd res = do
+  threadDelay 100000
+  atomically $ incStat c 1 statsKey
+  where
+    statsKey = AgentStatsKey {host = strEncode $ L.head host, clientTs = "", cmd, res}
+
+incClientStatN :: AgentClient -> ProtocolClient msg -> Int -> ByteString -> ByteString -> IO ()
+incClientStatN c pc n cmd res = do
+  atomically $ incStat c n statsKey
+  where
+    statsKey = AgentStatsKey {host = strEncode $ transportHost' pc, clientTs = strEncode $ sessionTs pc, cmd, res}
@@ -59,7 +59,7 @@ import UnliftIO.STM
 type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)

 data InitialAgentServers = InitialAgentServers
-  { smp :: NonEmpty SMPServer,
+  { smp :: NonEmpty SMPServerWithAuth,
    ntf :: [NtfServer],
    netCfg :: NetworkConfig
  }
@@ -310,8 +310,8 @@ retryOnError :: AgentMonad m => AgentClient -> Text -> m () -> (AgentErrorType -
 retryOnError c name loop done e = do
  logError $ name <> " error: " <> tshow e
  case e of
-    BROKER NETWORK -> retryLoop
-    BROKER TIMEOUT -> retryLoop
+    BROKER _ NETWORK -> retryLoop
+    BROKER _ TIMEOUT -> retryLoop
    _ -> done e
  where
    retryLoop = do
@@ -61,9 +61,12 @@ module Simplex.Messaging.Agent.Protocol
    SndQAddr,
    SMPServer,
    pattern SMPServer,
+    pattern ProtoServerWithAuth,
+    SMPServerWithAuth,
    SrvLoc (..),
    SMPQueue (..),
    sameQAddress,
+    noAuthSrv,
    SMPQueueUri (..),
    SMPQueueInfo (..),
    SMPQueueAddress (..),
@@ -139,6 +142,7 @@ import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (isJust)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.System (SystemTime)
@@ -164,12 +168,15 @@ import Simplex.Messaging.Protocol
    NMsgMeta,
    ProtocolServer (..),
    SMPServer,
+    SMPServerWithAuth,
    SndPublicVerifyKey,
    SrvLoc (..),
    legacyEncodeServer,
    legacyServerP,
    legacyStrEncodeServer,
+    noAuthSrv,
    sameSrvAddr,
+    pattern ProtoServerWithAuth,
    pattern SMPServer,
  )
 import qualified Simplex.Messaging.Protocol as SMP
@@ -1044,7 +1051,7 @@ data AgentErrorType
  | -- | NTF protocol errors forwarded to agent clients
    NTF {ntfErr :: ErrorType}
  | -- | SMP server errors
-    BROKER {brokerErr :: BrokerErrorType}
+    BROKER {brokerAddress :: String, brokerErr :: BrokerErrorType}
  | -- | errors of other agents
    AGENT {agentErr :: SMPAgentError}
  | -- | agent implementation or dependency errors
@@ -1138,23 +1145,27 @@ instance StrEncoding AgentErrorType where
      <|> "CONN " *> (CONN <$> parseRead1)
      <|> "SMP " *> (SMP <$> strP)
      <|> "NTF " *> (NTF <$> strP)
-      <|> "BROKER RESPONSE " *> (BROKER . RESPONSE <$> strP)
-      <|> "BROKER TRANSPORT " *> (BROKER . TRANSPORT <$> transportErrorP)
-      <|> "BROKER " *> (BROKER <$> parseRead1)
+      <|> "BROKER " *> (BROKER <$> srvP <* " RESPONSE " <*> (RESPONSE <$> strP))
+      <|> "BROKER " *> (BROKER <$> srvP <* " TRANSPORT " <*> (TRANSPORT <$> transportErrorP))
+      <|> "BROKER " *> (BROKER <$> srvP <* A.space <*> parseRead1)
      <|> "AGENT QUEUE " *> (AGENT . A_QUEUE <$> parseRead A.takeByteString)
      <|> "AGENT " *> (AGENT <$> parseRead1)
      <|> "INTERNAL " *> (INTERNAL <$> parseRead A.takeByteString)
+    where
+      srvP = T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ')
  strEncode = \case
    CMD e -> "CMD " <> bshow e
    CONN e -> "CONN " <> bshow e
    SMP e -> "SMP " <> strEncode e
    NTF e -> "NTF " <> strEncode e
-    BROKER (RESPONSE e) -> "BROKER RESPONSE " <> strEncode e
-    BROKER (TRANSPORT e) -> "BROKER TRANSPORT " <> serializeTransportError e
-    BROKER e -> "BROKER " <> bshow e
+    BROKER srv (RESPONSE e) -> "BROKER " <> addr srv <> " RESPONSE " <> strEncode e
+    BROKER srv (TRANSPORT e) -> "BROKER " <> addr srv <> " TRANSPORT " <> serializeTransportError e
+    BROKER srv e -> "BROKER " <> addr srv <> " " <> bshow e
    AGENT (A_QUEUE e) -> "AGENT QUEUE " <> bshow e
    AGENT e -> "AGENT " <> bshow e
    INTERNAL e -> "INTERNAL " <> bshow e
+    where
+      addr = encodeUtf8 . T.pack

 instance Arbitrary AgentErrorType where arbitrary = genericArbitraryU

@@ -48,7 +48,7 @@ runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, caCertifica
    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
+      runTransportServer started tcpPort tlsServerParams True $ \(h :: c) -> do
        liftIO . putLn h $ "Welcome to SMP agent v" <> B.pack simplexMQVersion
        c <- getAgentClient initServers
        logConnection c True
@@ -494,8 +494,6 @@ data StoreError
    SERatchetNotFound
  | -- | connection does not have associated x3dh keys
    SEX3dhKeysNotFound
-  | -- | Used in `getMsg` that is not implemented/used. TODO remove.
-    SENotImplemented
  | -- | Used to wrap agent errors inside store operations to avoid race conditions
    SEAgentError AgentErrorType
  deriving (Eq, Show, Exception)
@@ -107,8 +107,8 @@ CREATE TABLE snd_messages (
 CREATE TABLE conn_confirmations (
  confirmation_id BLOB NOT NULL PRIMARY KEY,
  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
-  e2e_snd_pub_key BLOB NOT NULL, -- TODO per-queue key. Split?
-  sender_key BLOB NOT NULL, -- TODO per-queue key. Split?
+  e2e_snd_pub_key BLOB NOT NULL,
+  sender_key BLOB NOT NULL,
  ratchet_state BLOB NOT NULL,
  sender_conn_info BLOB NOT NULL,
  accepted INTEGER NOT NULL,
@@ -114,8 +114,8 @@ CREATE TABLE snd_messages(
 CREATE TABLE conn_confirmations(
  confirmation_id BLOB NOT NULL PRIMARY KEY,
  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
-  e2e_snd_pub_key BLOB NOT NULL, -- TODO per-queue key. Split?
-  sender_key BLOB NOT NULL, -- TODO per-queue key. Split?
+  e2e_snd_pub_key BLOB NOT NULL,
+  sender_key BLOB NOT NULL,
  ratchet_state BLOB NOT NULL,
  sender_conn_info BLOB NOT NULL,
  accepted INTEGER NOT NULL,
@@ -23,11 +23,9 @@ clear (TRcvQueues qs) = TM.clear qs
 deleteConn :: ConnId -> TRcvQueues -> STM ()
 deleteConn cId (TRcvQueues qs) = modifyTVar' qs $ M.filter (\rq -> cId /= connId rq)

-- TODO possibly, should be limited to active queues
 hasConn :: ConnId -> TRcvQueues -> STM Bool
 hasConn cId (TRcvQueues qs) = any (\rq -> cId == connId rq) <$> readTVar qs

-- TODO possibly, should be limited to active queues
 getConns :: TRcvQueues -> STM (Set ConnId)
 getConns (TRcvQueues qs) = M.foldr' (S.insert . connId) S.empty <$> readTVar qs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -26,10 +27,12 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Client
  ( -- * Connect (disconnect) client to (from) SMP server
-    ProtocolClient (thVersion, sessionId, transportHost),
+    ProtocolClient (thVersion, sessionId, sessionTs),
    SMPClient,
    getProtocolClient,
    closeProtocolClient,
+    clientServer,
+    transportHost',

    -- * SMP protocol command functions
    createSMPQueue,
@@ -54,6 +57,7 @@ module Simplex.Messaging.Client
    NetworkConfig (..),
    defaultClientConfig,
    defaultNetworkConfig,
+    transportClientConfig,
    chooseTransportHost,
    ServerTransmission,
  )
@@ -76,16 +80,18 @@ import Data.List (find)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
+import Data.Time.Clock (UTCTime, getCurrentTime)
 import GHC.Generics (Generic)
 import Network.Socket (ServiceName)
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON)
 import Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost (..), runTransportClient)
+import Simplex.Messaging.Transport.Client (SocksProxy, TransportClientConfig (..), TransportHost (..), runTransportClient)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
@@ -96,10 +102,15 @@ import System.Timeout (timeout)
 --
 -- Use 'getSMPClient' to connect to an SMP server and create a client handle.
 data ProtocolClient msg = ProtocolClient
-  { action :: Async (),
-    connected :: TVar Bool,
+  { action :: Maybe (Async ()),
    sessionId :: SessionId,
+    sessionTs :: UTCTime,
    thVersion :: Version,
+    client_ :: PClient msg
+  }
+
+data PClient msg = PClient
+  { connected :: TVar Bool,
    protocolServer :: ProtoServer msg,
    transportHost :: TransportHost,
    tcpTimeout :: Int,
@@ -149,7 +160,8 @@ data NetworkConfig = NetworkConfig
    -- | TCP keep-alive options, Nothing to skip enabling keep-alive
    tcpKeepAlive :: Maybe KeepAliveOpts,
    -- | period for SMP ping commands (microseconds)
-    smpPingInterval :: Int
+    smpPingInterval :: Int,
+    logTLSErrors :: Bool
  }
  deriving (Eq, Show, Generic, FromJSON)

@@ -166,9 +178,14 @@ defaultNetworkConfig =
      tcpConnectTimeout = 7_500_000,
      tcpTimeout = 5_000_000,
      tcpKeepAlive = Just defaultKeepAliveOpts,
-      smpPingInterval = 600_000_000 -- 10min
+      smpPingInterval = 600_000_000, -- 10min
+      logTLSErrors = False
    }

+transportClientConfig :: NetworkConfig -> TransportClientConfig
+transportClientConfig NetworkConfig {socksProxy, tcpKeepAlive, logTLSErrors} =
+  TransportClientConfig {socksProxy, tcpKeepAlive, logTLSErrors}
+
 -- | protocol client configuration.
 data ProtocolClientConfig = ProtocolClientConfig
  { -- | size of TBQueue to use for server commands and responses
@@ -212,6 +229,12 @@ chooseTransportHost NetworkConfig {socksProxy, hostMode, requiredHostMode} hosts
    onionHost = find isOnionHost hosts
    publicHost = find (not . isOnionHost) hosts

+clientServer :: ProtocolTypeI (ProtoType msg) => ProtocolClient msg -> String
+clientServer = B.unpack . strEncode . protocolServer . client_
+
+transportHost' :: ProtocolClient msg -> TransportHost
+transportHost' = transportHost . client_
+
 -- | Connects to 'ProtocolServer' using passed client configuration
 -- and queue for messages and notifications.
 --
@@ -225,8 +248,8 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, networkConfig,
        `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
    Left e -> pure $ Left e
  where
-    NetworkConfig {tcpConnectTimeout, tcpTimeout, tcpKeepAlive, socksProxy, smpPingInterval} = networkConfig
-    mkProtocolClient :: TransportHost -> STM (ProtocolClient msg)
+    NetworkConfig {tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
+    mkProtocolClient :: TransportHost -> STM (PClient msg)
    mkProtocolClient transportHost = do
      connected <- newTVar False
      clientCorrId <- newTVar 0
@@ -234,11 +257,8 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, networkConfig,
      sndQ <- newTBQueue qSize
      rcvQ <- newTBQueue qSize
      return
-        ProtocolClient
-          { action = undefined,
-            sessionId = undefined,
-            thVersion = undefined,
-            connected,
+        PClient
+          { connected,
            protocolServer,
            transportHost,
            tcpTimeout,
@@ -249,16 +269,17 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, networkConfig,
            msgQ
          }

-    runClient :: (ServiceName, ATransport) -> TransportHost -> ProtocolClient msg -> IO (Either ProtocolClientError (ProtocolClient msg))
+    runClient :: (ServiceName, ATransport) -> TransportHost -> PClient msg -> IO (Either ProtocolClientError (ProtocolClient msg))
    runClient (port', ATransport t) useHost c = do
-      thVar <- newEmptyTMVarIO
+      cVar <- newEmptyTMVarIO
+      let tcConfig = transportClientConfig networkConfig
      action <-
        async $
-          runTransportClient socksProxy useHost port' (Just $ keyHash protocolServer) tcpKeepAlive (client t c thVar)
-            `finally` atomically (putTMVar thVar $ Left PCENetworkError)
-      th_ <- tcpConnectTimeout `timeout` atomically (takeTMVar thVar)
-      pure $ case th_ of
-        Just (Right THandle {sessionId, thVersion}) -> Right c {action, sessionId, thVersion}
+          runTransportClient tcConfig useHost port' (Just $ keyHash protocolServer) (client t c cVar)
+            `finally` atomically (putTMVar cVar $ Left PCENetworkError)
+      c_ <- tcpConnectTimeout `timeout` atomically (takeTMVar cVar)
+      pure $ case c_ of
+        Just (Right c') -> Right c' {action = Just action}
        Just (Left e) -> Left e
        Nothing -> Left PCENetworkError

@@ -268,24 +289,24 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, networkConfig,
      "80" -> ("80", transport @WS)
      p -> (p, transport @TLS)

-    client :: forall c. Transport c => TProxy c -> ProtocolClient msg -> TMVar (Either ProtocolClientError (THandle c)) -> c -> IO ()
-    client _ c thVar h =
+    client :: forall c. Transport c => TProxy c -> PClient msg -> TMVar (Either ProtocolClientError (ProtocolClient msg)) -> c -> IO ()
+    client _ c cVar h =
      runExceptT (protocolClientHandshake @msg h (keyHash protocolServer) smpServerVRange) >>= \case
-        Left e -> atomically . putTMVar thVar . Left $ PCETransportError e
+        Left e -> atomically . putTMVar cVar . Left $ PCETransportError e
        Right th@THandle {sessionId, thVersion} -> do
+          sessionTs <- getCurrentTime
+          let c' = ProtocolClient {action = Nothing, client_ = c, sessionId, thVersion, sessionTs}
          atomically $ do
            writeTVar (connected c) True
-            putTMVar thVar $ Right th
-          let c' = c {sessionId, thVersion} :: ProtocolClient msg
-          -- TODO remove ping if 0 is passed (or Nothing?)
-          raceAny_ [send c' th, process c', receive c' th, ping c']
+            putTMVar cVar $ Right c'
+          raceAny_ ([send c' th, process c', receive c' th] <> [ping c' | smpPingInterval > 0])
            `finally` disconnected c'

    send :: Transport c => ProtocolClient msg -> THandle c -> IO ()
-    send ProtocolClient {sndQ} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
+    send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= tPut h

    receive :: Transport c => ProtocolClient msg -> THandle c -> IO ()
-    receive ProtocolClient {rcvQ} h = forever $ tGet h >>= atomically . writeTBQueue rcvQ
+    receive ProtocolClient {client_ = PClient {rcvQ}} h = forever $ tGet h >>= atomically . writeTBQueue rcvQ

    ping :: ProtocolClient msg -> IO ()
    ping c = forever $ do
@@ -293,10 +314,10 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, networkConfig,
      runExceptT $ sendProtocolCommand c Nothing "" protocolPing

    process :: ProtocolClient msg -> IO ()
-    process c = forever $ atomically (readTBQueue $ rcvQ c) >>= mapM_ (processMsg c)
+    process c = forever $ atomically (readTBQueue $ rcvQ $ client_ c) >>= mapM_ (processMsg c)

    processMsg :: ProtocolClient msg -> SignedTransmission msg -> IO ()
-    processMsg c@ProtocolClient {sentCommands} (_, _, (corrId, qId, respOrErr)) =
+    processMsg c@ProtocolClient {client_ = PClient {sentCommands}} (_, _, (corrId, qId, respOrErr)) =
      if B.null $ bs corrId
        then sendMsg respOrErr
        else do
@@ -316,12 +337,11 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, networkConfig,
        sendMsg :: Either ErrorType msg -> IO ()
        sendMsg = \case
          Right msg -> atomically $ mapM_ (`writeTBQueue` serverTransmission c qId msg) msgQ
-          -- TODO send everything else to errQ and log in agent
-          _ -> return ()
+          Left e -> putStrLn $ "SMP client error: " <> show e

 -- | Disconnects client from the server and terminates client threads.
 closeProtocolClient :: ProtocolClient msg -> IO ()
-closeProtocolClient = uninterruptibleCancel . action
+closeProtocolClient = mapM_ uninterruptibleCancel . action

 -- | SMP client error type.
 data ProtocolClientError
@@ -361,9 +381,10 @@ createSMPQueue ::
  RcvPrivateSignKey ->
  RcvPublicVerifyKey ->
  RcvPublicDhKey ->
+  Maybe BasicAuth ->
  ExceptT ProtocolClientError IO QueueIdsKeys
-createSMPQueue c rpKey rKey dhKey =
-  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey) >>= \case
+createSMPQueue c rpKey rKey dhKey auth =
+  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey auth) >>= \case
    IDS qik -> pure qik
    r -> throwE . PCEUnexpectedResponse $ bshow r

@@ -389,10 +410,10 @@ subscribeSMPQueues c qs = sendProtocolCommands c cs >>= mapM response . L.zip qs
      Left e -> pure $ Left e

 writeSMPMessage :: SMPClient -> RecipientId -> BrokerMsg -> IO ()
-writeSMPMessage c rId msg = atomically $ mapM_ (`writeTBQueue` serverTransmission c rId msg) (msgQ c)
+writeSMPMessage c rId msg = atomically $ mapM_ (`writeTBQueue` serverTransmission c rId msg) (msgQ $ client_ c)

 serverTransmission :: ProtocolClient msg -> RecipientId -> msg -> ServerTransmission msg
-serverTransmission ProtocolClient {protocolServer, thVersion, sessionId} entityId message =
+serverTransmission ProtocolClient {thVersion, sessionId, client_ = PClient {protocolServer}} entityId message =
  (protocolServer, thVersion, sessionId, entityId, message)

 -- | Get message from SMP queue. The server returns ERR PROHIBITED if a client uses SUB and GET via the same transport connection for the same queue
@@ -496,7 +517,7 @@ sendSMPCommand c pKey qId cmd = sendProtocolCommand c pKey qId (Cmd sParty cmd)

 -- | Send multiple commands with batching and collect responses
 sendProtocolCommands :: forall msg. ProtocolEncoding (ProtoCommand msg) => ProtocolClient msg -> NonEmpty (ClientCommand msg) -> IO (NonEmpty (Either ProtocolClientError msg))
-sendProtocolCommands c@ProtocolClient {sndQ, tcpTimeout} cs = do
+sendProtocolCommands c@ProtocolClient {client_ = PClient {sndQ, tcpTimeout}} cs = do
  ts <- mapM (runExceptT . mkTransmission c) cs
  mapM_ (atomically . writeTBQueue sndQ . L.map fst) . L.nonEmpty . rights $ L.toList ts
  forConcurrently ts $ \case
@@ -507,7 +528,7 @@ sendProtocolCommands c@ProtocolClient {sndQ, tcpTimeout} cs = do

 -- | Send Protocol command
 sendProtocolCommand :: forall msg. ProtocolEncoding (ProtoCommand msg) => ProtocolClient msg -> Maybe C.APrivateSignKey -> QueueId -> ProtoCommand msg -> ExceptT ProtocolClientError IO msg
-sendProtocolCommand c@ProtocolClient {sndQ, tcpTimeout} pKey qId cmd = do
+sendProtocolCommand c@ProtocolClient {client_ = PClient {sndQ, tcpTimeout}} pKey qId cmd = do
  (t, r) <- mkTransmission c (pKey, qId, cmd)
  ExceptT $ sendRecv t r
  where
@@ -518,7 +539,7 @@ sendProtocolCommand c@ProtocolClient {sndQ, tcpTimeout} pKey qId cmd = do
        withTimeout a = fromMaybe (Left PCEResponseTimeout) <$> timeout tcpTimeout a

 mkTransmission :: forall msg. ProtocolEncoding (ProtoCommand msg) => ProtocolClient msg -> ClientCommand msg -> ExceptT ProtocolClientError IO (SentRawTransmission, TMVar (Response msg))
-mkTransmission ProtocolClient {clientCorrId, sessionId, thVersion, sentCommands} (pKey, qId, cmd) = do
+mkTransmission ProtocolClient {sessionId, thVersion, client_ = PClient {clientCorrId, sentCommands}} (pKey, qId, cmd) = do
  corrId <- liftIO $ atomically getNextCorrId
  t <- signTransmission $ encodeTransmission thVersion sessionId (corrId, qId, cmd)
  r <- liftIO . atomically $ mkRequest corrId
@@ -472,7 +472,6 @@ rcDecrypt rc@Ratchet {rcRcv, rcAD = Str rcAD} rcMKSkipped msg' = do
    decryptMessage :: MessageKey -> EncRatchetMessage -> ExceptT CryptoError IO (Either CryptoError ByteString)
    decryptMessage (MessageKey mk iv) EncRatchetMessage {emHeader, emBody, emAuthTag} =
      -- DECRYPT(mk, cipher-text, CONCAT(AD, enc_header))
-      -- TODO add associated data
      tryE $ decryptAEAD mk iv (rcAD <> emHeader) emBody emAuthTag

 rootKdf :: (AlgorithmI a, DhAlgorithm a) => RatchetKey -> PublicKey a -> PrivateKey a -> (RatchetKey, RatchetKey, Key)
@@ -66,7 +66,7 @@ runNtfServerBlocking started cfg = runReaderT (ntfServer cfg started) =<< newNtf
 type M a = ReaderT NtfEnv IO a

 ntfServer :: NtfServerConfig -> TMVar Bool -> M ()
-ntfServer cfg@NtfServerConfig {transports} started = do
+ntfServer cfg@NtfServerConfig {transports, logTLSErrors} started = do
  restoreServerStats
  s <- asks subscriber
  ps <- asks pushServer
@@ -77,7 +77,7 @@ ntfServer cfg@NtfServerConfig {transports} started = do
    runServer :: (ServiceName, ATransport) -> M ()
    runServer (tcpPort, ATransport t) = do
      serverParams <- asks tlsServerParams
-      runTransportServer started tcpPort serverParams (runClient t)
+      runTransportServer started tcpPort serverParams logTLSErrors (runClient t)

    runClient :: Transport c => TProxy c -> c -> M ()
    runClient _ h = do
@@ -283,7 +283,6 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
        Left e -> case e of
          PPConnection _ -> retryDeliver
          PPRetryLater -> retryDeliver
-          -- TODO alert
          PPCryptoError _ -> err e
          PPResponseError _ _ -> err e
          PPTokenInvalid -> updateTknStatus NTInvalid >> err e
@@ -55,7 +55,8 @@ data NtfServerConfig = NtfServerConfig
    logStatsInterval :: Maybe Int,
    logStatsStartTime :: Int,
    serverStatsLogFile :: FilePath,
-    serverStatsBackupFile :: Maybe FilePath
+    serverStatsBackupFile :: Maybe FilePath,
+    logTLSErrors :: Bool
  }

 defaultInactiveClientExpiration :: ExpirationConfig
@@ -0,0 +1,171 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module Simplex.Messaging.Notifications.Server.Main where
+
+import Data.Either (fromRight)
+import Data.Functor (($>))
+import Data.Ini (lookupValue, readIniFile)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import Network.Socket (HostName)
+import Options.Applicative
+import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Notifications.Server (runNtfServer)
+import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
+import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
+import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
+import Simplex.Messaging.Server.CLI
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.FilePath (combine)
+import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
+import Text.Read (readMaybe)
+
+ntfServerCLI :: FilePath -> FilePath -> IO ()
+ntfServerCLI cfgPath logPath =
+  getCliCommand' (cliCommandP cfgPath logPath iniFile) serverVersion >>= \case
+    Init opts ->
+      doesFileExist iniFile >>= \case
+        True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `" <> executableName <> " start`."
+        _ -> initializeServer opts
+    Start ->
+      doesFileExist iniFile >>= \case
+        True -> readIniFile iniFile >>= either exitError runServer
+        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
+    Delete -> do
+      confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
+      deleteDirIfExists cfgPath
+      deleteDirIfExists logPath
+      putStrLn "Deleted configuration and log files"
+  where
+    iniFile = combine cfgPath "ntf-server.ini"
+    serverVersion = "SMP notifications server v1.2.0"
+    defaultServerPort = "443"
+    executableName = "ntf-server"
+    storeLogFilePath = combine logPath "ntf-server-store.log"
+    initializeServer InitOptions {enableStoreLog, signAlgorithm, ip, fqdn} = do
+      clearDirIfExists cfgPath
+      clearDirIfExists logPath
+      createDirectoryIfMissing True cfgPath
+      createDirectoryIfMissing True logPath
+      let x509cfg = defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm}
+      fp <- createServerX509 cfgPath x509cfg
+      let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
+          srv = ProtoServerWithAuth (NtfServer [THDomainName host] "" (C.KeyHash fp)) Nothing
+      writeFile iniFile $ iniFileContent host
+      putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
+      warnCAPrivateKeyFile cfgPath x509cfg
+      printServiceInfo serverVersion srv
+      where
+        iniFileContent host =
+          "[STORE_LOG]\n\
+          \# The server uses STM memory for persistence,\n\
+          \# that will be lost on restart (e.g., as with redis).\n\
+          \# This option enables saving memory to append only log,\n\
+          \# and restoring it when the server is started.\n\
+          \# Log is compacted on start (deleted objects are removed).\n"
+            <> ("enable: " <> onOff enableStoreLog <> "\n\n")
+            <> "log_stats: off\n\n\
+               \[TRANSPORT]\n\
+               \# host is only used to print server address on start\n"
+            <> ("host: " <> host <> "\n")
+            <> ("port: " <> defaultServerPort <> "\n")
+            <> "log_tls_errors: off\n\
+               \websockets: off\n"
+    runServer ini = do
+      hSetBuffering stdout LineBuffering
+      hSetBuffering stderr LineBuffering
+      fp <- checkSavedFingerprint cfgPath defaultX509Config
+      let host = fromRight "<hostnames>" $ T.unpack <$> lookupValue "TRANSPORT" "host" ini
+          port = T.unpack $ strictIni "TRANSPORT" "port" ini
+          cfg@NtfServerConfig {transports, storeLogFile} = serverConfig
+          srv = ProtoServerWithAuth (NtfServer [THDomainName host] (if port == "443" then "" else port) (C.KeyHash fp)) Nothing
+      printServiceInfo serverVersion srv
+      printServerConfig transports storeLogFile
+      runNtfServer cfg
+      where
+        enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
+        logStats = settingIsOn "STORE_LOG" "log_stats" ini
+        c = combine cfgPath . ($ defaultX509Config)
+        serverConfig =
+          NtfServerConfig
+            { transports = iniTransports ini,
+              subIdBytes = 24,
+              regCodeBytes = 32,
+              clientQSize = 16,
+              subQSize = 64,
+              pushQSize = 128,
+              smpAgentCfg = defaultSMPClientAgentConfig,
+              apnsConfig = defaultAPNSPushClientConfig,
+              inactiveClientExpiration = Nothing,
+              storeLogFile = enableStoreLog $> storeLogFilePath,
+              resubscribeDelay = 50000, -- 50ms
+              caCertificateFile = c caCrtFile,
+              privateKeyFile = c serverKeyFile,
+              certificateFile = c serverCrtFile,
+              logStatsInterval = logStats $> 86400, -- seconds
+              logStatsStartTime = 0, -- seconds from 00:00 UTC
+              serverStatsLogFile = combine logPath "ntf-server-stats.daily.log",
+              serverStatsBackupFile = logStats $> combine logPath "ntf-server-stats.log",
+              logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+            }
+
+data CliCommand
+  = Init InitOptions
+  | Start
+  | Delete
+
+data InitOptions = InitOptions
+  { enableStoreLog :: Bool,
+    signAlgorithm :: SignAlgorithm,
+    ip :: HostName,
+    fqdn :: Maybe HostName
+  }
+  deriving (Show)
+
+cliCommandP :: FilePath -> FilePath -> FilePath -> Parser CliCommand
+cliCommandP cfgPath logPath iniFile =
+  hsubparser
+    ( command "init" (info (Init <$> initP) (progDesc $ "Initialize server - creates " <> cfgPath <> " and " <> logPath <> " directories and configuration files"))
+        <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
+        <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
+    )
+  where
+    initP :: Parser InitOptions
+    initP =
+      InitOptions
+        <$> switch
+          ( long "store-log"
+              <> short 'l'
+              <> help "Enable store log for persistence"
+          )
+        <*> option
+          (maybeReader readMaybe)
+          ( long "sign-algorithm"
+              <> short 'a'
+              <> help "Signature algorithm used for TLS certificates: ED25519, ED448"
+              <> value ED448
+              <> showDefault
+              <> metavar "ALG"
+          )
+        <*> strOption
+          ( long "ip"
+              <> help
+                "Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
+              <> value "127.0.0.1"
+              <> showDefault
+              <> metavar "IP"
+          )
+        <*> (optional . strOption)
+          ( long "fqdn"
+              <> short 'n'
+              <> help "Server FQDN used as Common Name for TLS online certificate"
+              <> showDefault
+              <> metavar "FQDN"
+          )
@@ -90,7 +90,7 @@ signedJWTToken pk (JWTToken hdr claims) = do

 readECPrivateKey :: FilePath -> IO EC.PrivateKey
 readECPrivateKey f = do
-  -- TODO this is specific to APNS key
+  -- this pattern match is specific to APNS key type, it may need to be extended for other push providers
  [PK.Unprotected (X.PrivKeyEC X.PrivKeyEC_Named {privkeyEC_name, privkeyEC_priv})] <- PK.readKeyFile f
  pure EC.PrivateKey {private_curve = ECT.getCurveByName privkeyEC_name, private_d = privkeyEC_priv}

@@ -357,7 +357,7 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {toke
        _ -> err status reason'
      | status == Just N.gone410 = throwError PPTokenInvalid
      | status == Just N.serviceUnavailable503 = liftIO (disconnectApnsHTTP2Client c) >> throwError PPRetryLater
-      -- Just tooManyRequests429 -> TODO TooManyRequests - too many requests for the same token
+      -- Just tooManyRequests429 -> TooManyRequests - too many requests for the same token
      | otherwise = err status reason'
    err :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
    err s r = throwError $ PPResponseError s r
@@ -106,7 +106,7 @@ removeInactiveTokenRegistrations st NtfTknData {ntfTknId = tId, token} =
      forM_ tIds $ \(regKey, tId') -> do
        TM.delete regKey tknRegs
        TM.delete tId' $ tokens st
-        -- TODO remove token subscriptions as in deleteNtfToken
+        void $ deleteTokenSubs st tId'
      pure $ map snd tIds

 removeTokenRegistration :: NtfStore -> NtfTknData -> STM ()
@@ -120,37 +120,28 @@ removeTokenRegistration st NtfTknData {ntfTknId = tId, token, tknVerifyKey} =

 deleteNtfToken :: NtfStore -> NtfTokenId -> STM [SMPQueueNtf]
 deleteNtfToken st tknId = do
-  TM.lookupDelete tknId (tokens st)
-    >>= mapM_
-      ( \NtfTknData {token, tknVerifyKey} ->
-          TM.lookup token regs
-            >>= mapM_
-              ( \tIds -> do
-                  TM.delete (regKey tknVerifyKey) tIds
-                  whenM (TM.null tIds) $ TM.delete token regs
-              )
-      )
-
-  -- TODO refactor
-  qs <-
-    TM.lookupDelete tknId (tokenSubscriptions st)
-      >>= mapM
-        ( readTVar
-            >=> mapM
-              ( \subId -> do
-                  TM.lookupDelete subId (subscriptions st)
-                    >>= mapM
-                      ( \NtfSubData {smpQueue} ->
-                          TM.delete smpQueue (subscriptionLookup st) $> smpQueue
-                      )
-              )
-              . S.toList
-        )
-  pure $ maybe [] catMaybes qs
+  void $
+    TM.lookupDelete tknId (tokens st) $>>= \NtfTknData {token, tknVerifyKey} ->
+      TM.lookup token regs $>>= \tIds ->
+        TM.delete (regKey tknVerifyKey) tIds
+          >> whenM (TM.null tIds) (TM.delete token regs) $> Just ()
+  deleteTokenSubs st tknId
  where
    regs = tokenRegistrations st
    regKey = C.toPubKey C.pubKeyBytes

+deleteTokenSubs :: NtfStore -> NtfTokenId -> STM [SMPQueueNtf]
+deleteTokenSubs st tknId = do
+  qs <-
+    TM.lookupDelete tknId (tokenSubscriptions st)
+      >>= mapM (readTVar >=> mapM deleteSub . S.toList)
+  pure $ maybe [] catMaybes qs
+  where
+    deleteSub subId = do
+      TM.lookupDelete subId (subscriptions st)
+        $>>= \NtfSubData {smpQueue} ->
+          TM.delete smpQueue (subscriptionLookup st) $> Just smpQueue
+
 getNtfSubscription :: NtfStore -> NtfSubscriptionId -> STM (Maybe NtfSubData)
 getNtfSubscription st subId =
  TM.lookup subId (subscriptions st)
@@ -70,8 +70,11 @@ module Simplex.Messaging.Protocol
    ProtoServer,
    SMPServer,
    pattern SMPServer,
+    SMPServerWithAuth,
    NtfServer,
    pattern NtfServer,
+    ProtoServerWithAuth (..),
+    BasicAuth (..),
    SrvLoc (..),
    CorrId (..),
    QueueId,
@@ -116,6 +119,8 @@ module Simplex.Messaging.Protocol
    legacyServerP,
    legacyStrEncodeServer,
    sameSrvAddr,
+    sameSrvAddr',
+    noAuthSrv,

    -- * TCP transport functions
    tPut,
@@ -129,12 +134,13 @@ where

 import Control.Applicative (optional, (<|>))
 import Control.Monad.Except
-import Data.Aeson (ToJSON (..))
+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.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Char (isPrint, isSpace)
 import Data.Kind
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
@@ -250,7 +256,7 @@ type EntityId = ByteString
 -- | Parameterized type for SMP protocol commands from all clients.
 data Command (p :: Party) where
  -- SMP recipient commands
-  NEW :: RcvPublicVerifyKey -> RcvPublicDhKey -> Command Recipient
+  NEW :: RcvPublicVerifyKey -> RcvPublicDhKey -> Maybe BasicAuth -> Command Recipient
  SUB :: Command Recipient
  KEY :: SndPublicVerifyKey -> Command Recipient
  NKEY :: NtfPublicVerifyKey -> RcvNtfPublicDhKey -> Command Recipient
@@ -566,6 +572,8 @@ pattern SMPServer host port keyHash = ProtocolServer SPSMP host port keyHash

 {-# COMPLETE SMPServer #-}

+type SMPServerWithAuth = ProtoServerWithAuth 'PSMP
+
 type NtfServer = ProtocolServer 'PNTF

 pattern NtfServer :: NonEmpty TransportHost -> ServiceName -> C.KeyHash -> ProtocolServer 'PNTF
@@ -573,6 +581,10 @@ pattern NtfServer host port keyHash = ProtocolServer SPNTF host port keyHash

 {-# COMPLETE NtfServer #-}

+sameSrvAddr' :: ProtoServerWithAuth p -> ProtoServerWithAuth p -> Bool
+sameSrvAddr' (ProtoServerWithAuth srv _) (ProtoServerWithAuth srv' _) = sameSrvAddr srv srv'
+{-# INLINE sameSrvAddr' #-}
+
 sameSrvAddr :: ProtocolServer p -> ProtocolServer p -> Bool
 sameSrvAddr ProtocolServer {host, port} ProtocolServer {host = h', port = p'} = host == h' && port == p'
 {-# INLINE sameSrvAddr #-}
@@ -667,20 +679,57 @@ instance ProtocolTypeI p => Encoding (ProtocolServer p) where

 instance ProtocolTypeI p => StrEncoding (ProtocolServer p) where
  strEncode ProtocolServer {scheme, host, port, keyHash} =
-    strEncodeServer scheme (strEncode host) port keyHash
-  strP = do
-    scheme <- strP <* "://"
-    keyHash <- strP <* A.char '@'
-    TransportHosts host <- strP
-    port <- portP <|> pure ""
-    pure ProtocolServer {scheme, host, port, keyHash}
-    where
-      portP = show <$> (A.char ':' *> (A.decimal :: Parser Int))
+    strEncodeServer scheme (strEncode host) port keyHash Nothing
+  strP =
+    serverStrP >>= \case
+      (srv, Nothing) -> pure srv
+      _ -> fail "ProtocolServer with basic auth not allowed"

 instance ProtocolTypeI p => ToJSON (ProtocolServer p) where
  toJSON = strToJSON
  toEncoding = strToJEncoding

+newtype BasicAuth = BasicAuth {unBasicAuth :: ByteString}
+  deriving (Eq, Show)
+
+instance IsString BasicAuth where fromString = BasicAuth . B.pack
+
+instance Encoding BasicAuth where
+  smpEncode (BasicAuth s) = smpEncode s
+  smpP = basicAuth <$?> smpP
+
+instance StrEncoding BasicAuth where
+  strEncode (BasicAuth s) = s
+  strP = basicAuth <$?> A.takeWhile1 (/= '@')
+
+basicAuth :: ByteString -> Either String BasicAuth
+basicAuth s
+  | B.all valid s = Right $ BasicAuth s
+  | otherwise = Left "invalid character in BasicAuth"
+  where
+    valid c = isPrint c && not (isSpace c) && c /= '@' && c /= ':' && c /= '/'
+
+data ProtoServerWithAuth p = ProtoServerWithAuth (ProtocolServer p) (Maybe BasicAuth)
+  deriving (Show)
+
+instance ProtocolTypeI p => IsString (ProtoServerWithAuth p) where
+  fromString = parseString strDecode
+
+instance ProtocolTypeI p => StrEncoding (ProtoServerWithAuth p) where
+  strEncode (ProtoServerWithAuth ProtocolServer {scheme, host, port, keyHash} auth_) =
+    strEncodeServer scheme (strEncode host) port keyHash auth_
+  strP = uncurry ProtoServerWithAuth <$> serverStrP
+
+instance ProtocolTypeI p => ToJSON (ProtoServerWithAuth p) where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+instance ProtocolTypeI p => FromJSON (ProtoServerWithAuth p) where
+  parseJSON = strParseJSON "ProtoServerWithAuth"
+
+noAuthSrv :: ProtocolServer p -> ProtoServerWithAuth p
+noAuthSrv srv = ProtoServerWithAuth srv Nothing
+
 legacyEncodeServer :: ProtocolServer p -> ByteString
 legacyEncodeServer ProtocolServer {host, port, keyHash} =
  smpEncode (L.head host, port, keyHash)
@@ -692,14 +741,25 @@ legacyServerP = do

 legacyStrEncodeServer :: ProtocolTypeI p => ProtocolServer p -> ByteString
 legacyStrEncodeServer ProtocolServer {scheme, host, port, keyHash} =
-  strEncodeServer scheme (strEncode $ L.head host) port keyHash
+  strEncodeServer scheme (strEncode $ L.head host) port keyHash Nothing

-strEncodeServer :: ProtocolTypeI p => SProtocolType p -> ByteString -> ServiceName -> C.KeyHash -> ByteString
-strEncodeServer scheme host port keyHash =
-  strEncode scheme <> "://" <> strEncode keyHash <> "@" <> host <> portStr
+strEncodeServer :: ProtocolTypeI p => SProtocolType p -> ByteString -> ServiceName -> C.KeyHash -> Maybe BasicAuth -> ByteString
+strEncodeServer scheme host port keyHash auth_ =
+  strEncode scheme <> "://" <> strEncode keyHash <> maybe "" ((":" <>) . strEncode) auth_ <> "@" <> host <> portStr
  where
    portStr = B.pack $ if null port then "" else ':' : port

+serverStrP :: ProtocolTypeI p => Parser (ProtocolServer p, Maybe BasicAuth)
+serverStrP = do
+  scheme <- strP <* "://"
+  keyHash <- strP
+  auth_ <- optional $ A.char ':' *> strP
+  TransportHosts host <- A.char '@' *> strP
+  port <- portP <|> pure ""
+  pure (ProtocolServer {scheme, host, port, keyHash}, auth_)
+  where
+    portP = show <$> (A.char ':' *> (A.decimal :: Parser Int))
+
 data SrvLoc = SrvLoc HostName ServiceName
  deriving (Eq, Ord, Show)

@@ -870,7 +930,13 @@ class ProtocolMsgTag (Tag msg) => ProtocolEncoding msg where
 instance PartyI p => ProtocolEncoding (Command p) where
  type Tag (Command p) = CommandTag p
  encodeProtocol v = \case
-    NEW rKey dhKey -> e (NEW_, ' ', rKey, dhKey)
+    NEW rKey dhKey auth_ -> case auth_ of
+      Just auth
+        | v >= 5 -> new <> e ('A', auth)
+        | otherwise -> new
+      _ -> new
+      where
+        new = e (NEW_, ' ', rKey, dhKey)
    SUB -> e SUB_
    KEY k -> e (KEY_, ' ', k)
    NKEY k dhKey -> e (NKEY_, ' ', k, dhKey)
@@ -918,7 +984,11 @@ instance ProtocolEncoding Cmd where
  protocolP v = \case
    CT SRecipient tag ->
      Cmd SRecipient <$> case tag of
-        NEW_ -> NEW <$> _smpP <*> smpP
+        NEW_
+          | v >= 5 -> new <*> optional (A.char 'A' *> smpP)
+          | otherwise -> new <*> pure Nothing
+          where
+            new = NEW <$> _smpP <*> smpP
        SUB_ -> pure SUB
        KEY_ -> KEY <$> _smpP
        NKEY_ -> NKEY <$> _smpP <*> smpP
@@ -97,14 +97,13 @@ runSMPServer cfg = do
 -- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
 -- and when it is disconnected from the TCP socket once the server thread is killed (False).
 runSMPServerBlocking :: TMVar Bool -> ServerConfig -> IO ()
-runSMPServerBlocking started cfg = newEnv cfg >>= runReaderT (smpServer started)
+runSMPServerBlocking started cfg = newEnv cfg >>= runReaderT (smpServer started cfg)

 type M a = ReaderT Env IO a

-smpServer :: TMVar Bool -> M ()
-smpServer started = do
+smpServer :: TMVar Bool -> ServerConfig -> M ()
+smpServer started cfg@ServerConfig {transports, logTLSErrors} = do
  s <- asks server
-  cfg@ServerConfig {transports} <- asks config
  restoreServerStats
  restoreServerMessages
  raceAny_
@@ -117,7 +116,7 @@ smpServer started = do
    runServer :: (ServiceName, ATransport) -> M ()
    runServer (tcpPort, ATransport t) = do
      serverParams <- asks tlsServerParams
-      runTransportServer started tcpPort serverParams (runClient t)
+      runTransportServer started tcpPort serverParams logTLSErrors (runClient t)

    serverThread ::
      forall s.
@@ -280,7 +279,7 @@ data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
 verifyTransmission :: Maybe C.ASignature -> ByteString -> QueueId -> Cmd -> M VerificationResult
 verifyTransmission sig_ signed queueId cmd = do
  case cmd of
-    Cmd SRecipient (NEW k _) -> pure $ Nothing `verified` verifyCmdSignature sig_ signed k
+    Cmd SRecipient (NEW k _ _) -> pure $ Nothing `verified` verifyCmdSignature sig_ signed k
    Cmd SRecipient _ -> verifyCmd SRecipient $ verifyCmdSignature sig_ signed . recipientKey
    Cmd SSender SEND {} -> verifyCmd SSender $ verifyMaybe . senderKey
    Cmd SSender PING -> pure $ VRVerified Nothing
@@ -323,7 +322,7 @@ dummyKeyEd448 :: C.PublicKey 'C.Ed448
 dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"

 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
-client clnt@Client {thVersion, sessionId, subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} =
+client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} =
  forever $
    atomically (readTBQueue rcvQ)
      >>= mapM processCommand
@@ -340,11 +339,15 @@ client clnt@Client {thVersion, sessionId, subscriptions, ntfSubscriptions, rcvQ,
        Cmd SNotifier NSUB -> subscribeNotifications
        Cmd SRecipient command ->
          case command of
-            NEW rKey dhKey ->
+            NEW rKey dhKey auth ->
              ifM
-                (asks $ allowNewQueues . config)
+                allowNew
                (createQueue st rKey dhKey)
                (pure (corrId, queueId, ERR AUTH))
+              where
+                allowNew = do
+                  ServerConfig {allowNewQueues, newQueueBasicAuth} <- asks config
+                  pure $ allowNewQueues && maybe True ((== auth) . Just) newQueueBasicAuth
            SUB -> withQueue (`subscribeQueue` queueId)
            GET -> withQueue getMessage
            ACK msgId -> withQueue (`acknowledgeMsg` msgId)
@@ -13,214 +13,133 @@ import Control.Monad
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (fromRight)
-import Data.Ini (Ini, lookupValue, readIniFile)
-import Data.Maybe (fromMaybe)
+import Data.Ini (Ini, lookupValue)
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (HostName, ServiceName)
 import Options.Applicative
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI)
 import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
 import Simplex.Messaging.Transport.Server (loadFingerprint)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (whenM)
-import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, listDirectory, removeDirectoryRecursive, removePathForcibly)
+import System.Directory (doesDirectoryExist, listDirectory, removeDirectoryRecursive, removePathForcibly)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
-import System.IO (BufferMode (..), IOMode (..), hFlush, hGetLine, hSetBuffering, stderr, stdout, withFile)
+import System.IO (IOMode (..), hFlush, hGetLine, stdout, withFile)
 import System.Process (readCreateProcess, shell)
-import Text.Read (readMaybe)
-
-data ServerCLIConfig cfg = ServerCLIConfig
-  { cfgDir :: FilePath,
-    logDir :: FilePath,
-    iniFile :: FilePath,
-    storeLogFile :: FilePath,
-    caKeyFile :: FilePath,
-    caCrtFile :: FilePath,
-    serverKeyFile :: FilePath,
-    serverCrtFile :: FilePath,
-    fingerprintFile :: FilePath,
-    defaultServerPort :: ServiceName,
-    executableName :: String,
-    serverVersion :: String,
-    mkIniFile :: Bool -> ServiceName -> String,
-    mkServerConfig :: Maybe FilePath -> [(ServiceName, ATransport)] -> Ini -> cfg
-  }
-
-protocolServerCLI :: ServerCLIConfig cfg -> (cfg -> IO ()) -> IO ()
-protocolServerCLI cliCfg@ServerCLIConfig {iniFile, executableName} server =
-  getCliCommand cliCfg >>= \case
-    Init opts ->
-      doesFileExist iniFile >>= \case
-        True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `" <> executableName <> " start`."
-        _ -> initializeServer cliCfg opts
-    Start ->
-      doesFileExist iniFile >>= \case
-        True -> readIniFile iniFile >>= either exitError (runServer cliCfg server)
-        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
-    Delete -> do
-      confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
-      cleanup cliCfg
-      putStrLn "Deleted configuration and log files"

 exitError :: String -> IO ()
 exitError msg = putStrLn msg >> exitFailure

 confirmOrExit :: String -> IO ()
-confirmOrExit s = do
-  putStrLn s
-  putStr "Continue (Y/n): "
-  hFlush stdout
-  ok <- getLine
-  when (ok /= "Y") exitFailure
-
-data CliCommand
-  = Init InitOptions
-  | Start
-  | Delete
-
-data InitOptions = InitOptions
-  { enableStoreLog :: Bool,
-    signAlgorithm :: SignAlgorithm,
-    ip :: HostName,
-    fqdn :: Maybe HostName
-  }
-  deriving (Show)
+confirmOrExit s =
+  withPrompt (s <> "\nContinue (Y/n): ") $ do
+    ok <- getLine
+    when (ok /= "Y") $ putStrLn "Server NOT deleted" >> exitFailure

 data SignAlgorithm = ED448 | ED25519
  deriving (Read, Show)

-getCliCommand :: ServerCLIConfig cfg -> IO CliCommand
-getCliCommand cliCfg =
+data X509Config = X509Config
+  { commonName :: HostName,
+    signAlgorithm :: SignAlgorithm,
+    caKeyFile :: FilePath,
+    caCrtFile :: FilePath,
+    serverKeyFile :: FilePath,
+    serverCrtFile :: FilePath,
+    fingerprintFile :: FilePath,
+    opensslCaConfFile :: FilePath,
+    opensslServerConfFile :: FilePath,
+    serverCsrFile :: FilePath
+  }
+
+defaultX509Config :: X509Config
+defaultX509Config =
+  X509Config
+    { commonName = "127.0.0.1",
+      signAlgorithm = ED448,
+      caKeyFile = "ca.key",
+      caCrtFile = "ca.crt",
+      serverKeyFile = "server.key",
+      serverCrtFile = "server.crt",
+      fingerprintFile = "fingerprint",
+      opensslCaConfFile = "openssl_ca.conf",
+      opensslServerConfFile = "openssl_server.conf",
+      serverCsrFile = "server.csr"
+    }
+
+getCliCommand' :: Parser cmd -> String -> IO cmd
+getCliCommand' cmdP version =
  customExecParser
    (prefs showHelpOnEmpty)
    ( info
-        (helper <*> versionOption <*> cliCommandP cliCfg)
+        (helper <*> versionOption <*> cmdP)
        (header version <> fullDesc)
    )
  where
    versionOption = infoOption version (long "version" <> short 'v' <> help "Show version")
-    version = serverVersion cliCfg

-cliCommandP :: ServerCLIConfig cfg -> Parser CliCommand
-cliCommandP ServerCLIConfig {cfgDir, logDir, iniFile} =
-  hsubparser
-    ( command "init" (info initP (progDesc $ "Initialize server - creates " <> cfgDir <> " and " <> logDir <> " directories and configuration files"))
-        <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
-        <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
-    )
+createServerX509 :: FilePath -> X509Config -> IO ByteString
+createServerX509 cfgPath x509cfg = do
+  createOpensslCaConf
+  createOpensslServerConf
+  let alg = show $ signAlgorithm (x509cfg :: X509Config)
+  -- CA certificate (identity/offline)
+  run $ "openssl genpkey -algorithm " <> alg <> " -out " <> c caKeyFile
+  run $ "openssl req -new -x509 -days 999999 -config " <> c opensslCaConfFile <> " -extensions v3 -key " <> c caKeyFile <> " -out " <> c caCrtFile
+  -- server certificate (online)
+  run $ "openssl genpkey -algorithm " <> alg <> " -out " <> c serverKeyFile
+  run $ "openssl req -new -config " <> c opensslServerConfFile <> " -reqexts v3 -key " <> c serverKeyFile <> " -out " <> c serverCsrFile
+  run $ "openssl x509 -req -days 999999 -extfile " <> c opensslServerConfFile <> " -extensions v3 -in " <> c serverCsrFile <> " -CA " <> c caCrtFile <> " -CAkey " <> c caKeyFile <> " -CAcreateserial -out " <> c serverCrtFile
+  saveFingerprint
  where
-    initP :: Parser CliCommand
-    initP =
-      Init
-        <$> ( InitOptions
-                <$> switch
-                  ( long "store-log"
-                      <> short 'l'
-                      <> help "Enable store log for persistence"
-                  )
-                <*> option
-                  (maybeReader readMaybe)
-                  ( long "sign-algorithm"
-                      <> short 'a'
-                      <> help "Signature algorithm used for TLS certificates: ED25519, ED448"
-                      <> value ED448
-                      <> showDefault
-                      <> metavar "ALG"
-                  )
-                <*> strOption
-                  ( long "ip"
-                      <> help
-                        "Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
-                      <> value "127.0.0.1"
-                      <> showDefault
-                      <> metavar "IP"
-                  )
-                <*> (optional . strOption)
-                  ( long "fqdn"
-                      <> short 'n'
-                      <> help "Server FQDN used as Common Name for TLS online certificate"
-                      <> showDefault
-                      <> metavar "FQDN"
-                  )
-            )
-
-initializeServer :: ServerCLIConfig cfg -> InitOptions -> IO ()
-initializeServer cliCfg InitOptions {enableStoreLog, signAlgorithm, ip, fqdn} = do
-  clearDirs cliCfg
-  createDirectoryIfMissing True cfgDir
-  createDirectoryIfMissing True logDir
-  createX509
-  fp <- saveFingerprint
-  writeFile iniFile $ mkIniFile enableStoreLog defaultServerPort
-  putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
-  printServiceInfo cliCfg fp
-  warnCAPrivateKeyFile
-  where
-    ServerCLIConfig {cfgDir, logDir, iniFile, executableName, caKeyFile, caCrtFile, serverKeyFile, serverCrtFile, fingerprintFile, defaultServerPort, mkIniFile} = cliCfg
-    createX509 = do
-      createOpensslCaConf
-      createOpensslServerConf
-      -- CA certificate (identity/offline)
-      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> caKeyFile
-      run $ "openssl req -new -x509 -days 999999 -config " <> opensslCaConfFile <> " -extensions v3 -key " <> caKeyFile <> " -out " <> caCrtFile
-      -- server certificate (online)
-      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> serverKeyFile
-      run $ "openssl req -new -config " <> opensslServerConfFile <> " -reqexts v3 -key " <> serverKeyFile <> " -out " <> serverCsrFile
-      run $ "openssl x509 -req -days 999999 -extfile " <> opensslServerConfFile <> " -extensions v3 -in " <> serverCsrFile <> " -CA " <> caCrtFile <> " -CAkey " <> caKeyFile <> " -CAcreateserial -out " <> serverCrtFile
-      where
-        run cmd = void $ readCreateProcess (shell cmd) ""
-        opensslCaConfFile = combine cfgDir "openssl_ca.conf"
-        opensslServerConfFile = combine cfgDir "openssl_server.conf"
-        serverCsrFile = combine cfgDir "server.csr"
-        createOpensslCaConf =
-          writeFile
-            opensslCaConfFile
-            "[req]\n\
-            \distinguished_name = req_distinguished_name\n\
-            \prompt = no\n\n\
-            \[req_distinguished_name]\n\
-            \CN = SMP server CA\n\
-            \O = SimpleX\n\n\
-            \[v3]\n\
-            \subjectKeyIdentifier = hash\n\
-            \authorityKeyIdentifier = keyid:always\n\
-            \basicConstraints = critical,CA:true\n"
-        -- TODO revise https://www.rfc-editor.org/rfc/rfc5280#section-4.2.1.3, https://www.rfc-editor.org/rfc/rfc3279#section-2.3.5
-        -- IP and FQDN can't both be used as server address interchangeably even if IP is added
-        -- as Subject Alternative Name, unless the following validation hook is disabled:
-        -- https://hackage.haskell.org/package/x509-validation-1.6.10/docs/src/Data-X509-Validation.html#validateCertificateName
-        createOpensslServerConf =
-          writeFile
-            opensslServerConfFile
-            ( "[req]\n\
-              \distinguished_name = req_distinguished_name\n\
-              \prompt = no\n\n\
-              \[req_distinguished_name]\n"
-                <> ("CN = " <> cn <> "\n\n")
-                <> "[v3]\n\
-                   \basicConstraints = CA:FALSE\n\
-                   \keyUsage = digitalSignature, nonRepudiation, keyAgreement\n\
-                   \extendedKeyUsage = serverAuth\n"
-            )
-          where
-            cn = fromMaybe ip fqdn
+    run cmd = void $ readCreateProcess (shell cmd) ""
+    c = combine cfgPath . ($ x509cfg)
+    createOpensslCaConf =
+      writeFile
+        (c opensslCaConfFile)
+        "[req]\n\
+        \distinguished_name = req_distinguished_name\n\
+        \prompt = no\n\n\
+        \[req_distinguished_name]\n\
+        \CN = SMP server CA\n\
+        \O = SimpleX\n\n\
+        \[v3]\n\
+        \subjectKeyIdentifier = hash\n\
+        \authorityKeyIdentifier = keyid:always\n\
+        \basicConstraints = critical,CA:true\n"
+    createOpensslServerConf =
+      writeFile
+        (c opensslServerConfFile)
+        ( "[req]\n\
+          \distinguished_name = req_distinguished_name\n\
+          \prompt = no\n\n\
+          \[req_distinguished_name]\n"
+            <> ("CN = " <> commonName x509cfg <> "\n\n")
+            <> "[v3]\n\
+               \basicConstraints = CA:FALSE\n\
+               \keyUsage = digitalSignature, nonRepudiation, keyAgreement\n\
+               \extendedKeyUsage = serverAuth\n"
+        )

    saveFingerprint = do
-      Fingerprint fp <- loadFingerprint caCrtFile
-      withFile fingerprintFile WriteMode (`B.hPutStrLn` strEncode fp)
+      Fingerprint fp <- loadFingerprint $ c caCrtFile
+      withFile (c fingerprintFile) WriteMode (`B.hPutStrLn` strEncode fp)
      pure fp

-    warnCAPrivateKeyFile =
-      putStrLn $
-        "----------\n\
-        \You should store CA private key securely and delete it from the server.\n\
-        \If server TLS credential is compromised this key can be used to sign a new one, \
-        \keeping the same server identity and established connections.\n\
-        \CA private key location:\n"
-          <> caKeyFile
-          <> "\n----------"
+warnCAPrivateKeyFile :: FilePath -> X509Config -> IO ()
+warnCAPrivateKeyFile cfgPath X509Config {caKeyFile} =
+  putStrLn $
+    "----------\n\
+    \You should store CA private key securely and delete it from the server.\n\
+    \If server TLS credential is compromised this key can be used to sign a new one, \
+    \keeping the same server identity and established connections.\n\
+    \CA private key location:\n"
+      <> combine cfgPath caKeyFile
+      <> "\n----------"

 data IniOptions = IniOptions
  { enableStoreLog :: Bool,
@@ -236,57 +155,76 @@ mkIniOptions ini =
      enableWebsockets = (== "on") $ strictIni "TRANSPORT" "websockets" ini
    }

-strictIni :: String -> String -> Ini -> T.Text
+strictIni :: Text -> Text -> Ini -> Text
 strictIni section key ini =
-  fromRight (error ("no key " <> key <> " in section " <> section)) $
-    lookupValue (T.pack section) (T.pack key) ini
+  fromRight (error . T.unpack $ "no key " <> key <> " in section " <> section) $
+    lookupValue section key ini

-readStrictIni :: Read a => String -> String -> Ini -> a
+readStrictIni :: Read a => Text -> Text -> Ini -> a
 readStrictIni section key = read . T.unpack . strictIni section key

-runServer :: ServerCLIConfig cfg -> (cfg -> IO ()) -> Ini -> IO ()
-runServer cliCfg server ini = do
-  hSetBuffering stdout LineBuffering
-  hSetBuffering stderr LineBuffering
-  fp <- checkSavedFingerprint
-  printServiceInfo cliCfg fp
-  let IniOptions {enableStoreLog, port, enableWebsockets} = mkIniOptions ini
-      transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets]
-      logFile = if enableStoreLog then Just storeLogFile else Nothing
-      cfg = mkServerConfig logFile transports ini
-  printServerConfig logFile transports
-  server cfg
+iniOnOff :: Text -> Text -> Ini -> Maybe Bool
+iniOnOff section name ini = case lookupValue section name ini of
+  Right "on" -> Just True
+  Right "off" -> Just False
+  Right s -> error . T.unpack $ "invalid INI setting " <> name <> ": " <> s
+  _ -> Nothing
+
+withPrompt :: String -> IO a -> IO a
+withPrompt s a = putStr s >> hFlush stdout >> a
+
+onOffPrompt :: String -> Bool -> IO Bool
+onOffPrompt prompt def =
+  withPrompt (prompt <> if def then " (Yn): " else " (yN): ") $
+    getLine >>= \case
+      "" -> pure def
+      "y" -> pure True
+      "Y" -> pure True
+      "n" -> pure False
+      "N" -> pure False
+      _ -> putStrLn "Invalid input, please enter 'y' or 'n'" >> onOffPrompt prompt def
+
+onOff :: Bool -> String
+onOff True = "on"
+onOff _ = "off"
+
+settingIsOn :: Text -> Text -> Ini -> Maybe ()
+settingIsOn section name ini
+  | iniOnOff section name ini == Just True = Just ()
+  | otherwise = Nothing
+
+checkSavedFingerprint :: FilePath -> X509Config -> IO ByteString
+checkSavedFingerprint cfgPath x509cfg = do
+  savedFingerprint <- withFile (c fingerprintFile) ReadMode hGetLine
+  Fingerprint fp <- loadFingerprint (c caCrtFile)
+  when (B.pack savedFingerprint /= strEncode fp) $
+    exitError "Stored fingerprint is invalid."
+  pure fp
  where
-    ServerCLIConfig {storeLogFile, caCrtFile, fingerprintFile, mkServerConfig} = cliCfg
-    checkSavedFingerprint = do
-      savedFingerprint <- withFile fingerprintFile ReadMode hGetLine
-      Fingerprint fp <- loadFingerprint caCrtFile
-      when (B.pack savedFingerprint /= strEncode fp) $
-        exitError "Stored fingerprint is invalid."
-      pure fp
+    c = combine cfgPath . ($ x509cfg)

-    printServerConfig logFile transports = do
-      putStrLn $ case logFile of
-        Just f -> "Store log: " <> f
-        _ -> "Store log disabled."
-      forM_ transports $ \(p, ATransport t) ->
-        putStrLn $ "Listening on port " <> p <> " (" <> transportName t <> ")..."
+iniTransports :: Ini -> [(String, ATransport)]
+iniTransports ini =
+  let port = T.unpack $ strictIni "TRANSPORT" "port" ini
+      enableWebsockets = (== "on") $ strictIni "TRANSPORT" "websockets" ini
+   in (port, transport @TLS) : [("80", transport @WS) | enableWebsockets]

-cleanup :: ServerCLIConfig cfg -> IO ()
-cleanup ServerCLIConfig {cfgDir, logDir} = do
-  deleteDirIfExists cfgDir
-  deleteDirIfExists logDir
-  where
-    deleteDirIfExists path = whenM (doesDirectoryExist path) $ removeDirectoryRecursive path
+printServerConfig :: [(ServiceName, ATransport)] -> Maybe FilePath -> IO ()
+printServerConfig transports logFile = do
+  putStrLn $ case logFile of
+    Just f -> "Store log: " <> f
+    _ -> "Store log disabled."
+  forM_ transports $ \(p, ATransport t) ->
+    putStrLn $ "Listening on port " <> p <> " (" <> transportName t <> ")..."

-clearDirs :: ServerCLIConfig cfg -> IO ()
-clearDirs ServerCLIConfig {cfgDir, logDir} = do
-  clearDirIfExists cfgDir
-  clearDirIfExists logDir
-  where
-    clearDirIfExists path = whenM (doesDirectoryExist path) $ listDirectory path >>= mapM_ (removePathForcibly . combine path)
+deleteDirIfExists :: FilePath -> IO ()
+deleteDirIfExists path = whenM (doesDirectoryExist path) $ removeDirectoryRecursive path

-printServiceInfo :: ServerCLIConfig cfg -> ByteString -> IO ()
-printServiceInfo ServerCLIConfig {serverVersion} fpStr = do
+printServiceInfo :: ProtocolTypeI p => String -> ProtoServerWithAuth p -> IO ()
+printServiceInfo serverVersion srv@(ProtoServerWithAuth ProtocolServer {keyHash} _) = do
  putStrLn serverVersion
-  B.putStrLn $ "Fingerprint: " <> strEncode fpStr
+  B.putStrLn $ "Fingerprint: " <> strEncode keyHash
+  B.putStrLn $ "Server address: " <> strEncode srv
+
+clearDirIfExists :: FilePath -> IO ()
+clearDirIfExists path = whenM (doesDirectoryExist path) $ listDirectory path >>= mapM_ (removePathForcibly . combine path)
@@ -46,6 +46,8 @@ data ServerConfig = ServerConfig
    storeMsgsFile :: Maybe FilePath,
    -- | set to False to prohibit creating new queues
    allowNewQueues :: Bool,
+    -- | simple password that the clients need to pass in handshake to be able to create new queues
+    newQueueBasicAuth :: Maybe BasicAuth,
    -- | time after which the messages can be removed from the queues and check interval, seconds
    messageExpiration :: Maybe ExpirationConfig,
    -- | time after which the socket with inactive client can be disconnected (without any messages or commands, incl. PING),
@@ -65,7 +67,8 @@ data ServerConfig = ServerConfig
    privateKeyFile :: FilePath,
    certificateFile :: FilePath,
    -- | SMP client-server protocol version range
-    smpServerVRange :: VersionRange
+    smpServerVRange :: VersionRange,
+    logTLSErrors :: Bool
  }

 defaultMessageExpiration :: ExpirationConfig
@@ -0,0 +1,285 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module Simplex.Messaging.Server.Main where
+
+import Control.Monad (void)
+import Crypto.Random (getRandomBytes)
+import qualified Data.ByteString.Char8 as B
+import Data.Either (fromRight)
+import Data.Functor (($>))
+import Data.Ini (lookupValue, readIniFile)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Network.Socket (HostName)
+import Options.Applicative
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
+import Simplex.Messaging.Server (runSMPServer)
+import Simplex.Messaging.Server.CLI
+import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defaultInactiveClientExpiration, defaultMessageExpiration)
+import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Transport (simplexMQVersion, supportedSMPServerVRange)
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Util (safeDecodeUtf8)
+import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.FilePath (combine)
+import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
+import Text.Read (readMaybe)
+
+smpServerCLI :: FilePath -> FilePath -> IO ()
+smpServerCLI cfgPath logPath =
+  getCliCommand' (cliCommandP cfgPath logPath iniFile) serverVersion >>= \case
+    Init opts ->
+      doesFileExist iniFile >>= \case
+        True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `" <> executableName <> " start`."
+        _ -> initializeServer opts
+    Start ->
+      doesFileExist iniFile >>= \case
+        True -> readIniFile iniFile >>= either exitError runServer
+        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
+    Delete -> do
+      confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
+      deleteDirIfExists cfgPath
+      deleteDirIfExists logPath
+      putStrLn "Deleted configuration and log files"
+  where
+    iniFile = combine cfgPath "smp-server.ini"
+    serverVersion = "SMP server v" <> simplexMQVersion
+    defaultServerPort = "5223"
+    executableName = "smp-server"
+    storeLogFilePath = combine logPath "smp-server-store.log"
+    initializeServer opts
+      | scripted opts = initialize opts
+      | otherwise = do
+        putStrLn "Use `smp-server init -h` for available options."
+        void $ withPrompt "SMP server will be initialized (press Enter)" getLine
+        enableStoreLog <- onOffPrompt "Enable store log to restore queues and messages on server restart" True
+        logStats <- onOffPrompt "Enable logging daily statistics" False
+        putStrLn "Require a password to create new messaging queues?"
+        password <- withPrompt "'r' for random (default), 'n' - no password, or enter password: " serverPassword
+        let host = fromMaybe (ip opts) (fqdn opts)
+        host' <- withPrompt ("Enter server FQDN or IP address for certificate (" <> host <> "): ") getLine
+        initialize opts {enableStoreLog, logStats, fqdn = if null host' then fqdn opts else Just host', password}
+      where
+        serverPassword =
+          getLine >>= \case
+            "" -> pure $ Just SPRandom
+            "r" -> pure $ Just SPRandom
+            "n" -> pure Nothing
+            s ->
+              case strDecode $ encodeUtf8 $ T.pack s of
+                Right auth -> pure . Just $ ServerPassword auth
+                _ -> putStrLn "Invalid password. Only latin letters, digits and symbols other than '@' and ':' are allowed" >> serverPassword
+        initialize InitOptions {enableStoreLog, logStats, signAlgorithm, ip, fqdn, password} = do
+          clearDirIfExists cfgPath
+          clearDirIfExists logPath
+          createDirectoryIfMissing True cfgPath
+          createDirectoryIfMissing True logPath
+          let x509cfg = defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm}
+          fp <- createServerX509 cfgPath x509cfg
+          basicAuth <- mapM createServerPassword password
+          let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
+              srv = ProtoServerWithAuth (SMPServer [THDomainName host] "" (C.KeyHash fp)) basicAuth
+          writeFile iniFile $ iniFileContent host basicAuth
+          putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
+          warnCAPrivateKeyFile cfgPath x509cfg
+          printServiceInfo serverVersion srv
+          where
+            createServerPassword = \case
+              ServerPassword s -> pure s
+              SPRandom -> BasicAuth . strEncode <$> (getRandomBytes 32 :: IO B.ByteString)
+            iniFileContent host basicAuth =
+              "[STORE_LOG]\n\
+              \# The server uses STM memory for persistence,\n\
+              \# that will be lost on restart (e.g., as with redis).\n\
+              \# This option enables saving memory to append only log,\n\
+              \# and restoring it when the server is started.\n\
+              \# Log is compacted on start (deleted objects are removed).\n"
+                <> ("enable: " <> onOff enableStoreLog <> "\n\n")
+                <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
+                   \# they are preserved in the .bak file until the next restart.\n"
+                <> ("restore_messages: " <> onOff enableStoreLog <> "\n\n")
+                <> "# Log daily server statistics to CSV file\n"
+                <> ("log_stats: " <> onOff logStats <> "\n\n")
+                <> "[AUTH]\n\
+                   \# Set new_queues option to off to completely prohibit creating new messaging queues.\n\
+                   \# This can be useful when you want to decommission the server, but not all connections are switched yet.\n\
+                   \new_queues: on\n\n\
+                   \# Use create_password option to enable basic auth to create new messaging queues.\n\
+                   \# The password should be used as part of server address in client configuration:\n\
+                   \# smp://fingerprint:password@host1,host2\n\
+                   \# The password will not be shared with the connecting contacts, you must share it only\n\
+                   \# with the users who you want to allow creating messaging queues on your server.\n"
+                <> ( case basicAuth of
+                       Just auth -> "create_password: " <> T.unpack (safeDecodeUtf8 $ strEncode auth)
+                       _ -> "# create_password: password to create new queues (any printable ASCII characters without whitespace, '@', ':' and '/')"
+                   )
+                <> "\n\n\
+                   \[TRANSPORT]\n\
+                   \# host is only used to print server address on start\n"
+                <> ("host: " <> host <> "\n")
+                <> ("port: " <> defaultServerPort <> "\n")
+                <> "log_tls_errors: off\n\
+                   \websockets: off\n\n\
+                   \[INACTIVE_CLIENTS]\n\
+                   \# TTL and interval to check inactive clients\n\
+                   \disconnect: off\n"
+                <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
+                <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n")
+    runServer ini = do
+      hSetBuffering stdout LineBuffering
+      hSetBuffering stderr LineBuffering
+      fp <- checkSavedFingerprint cfgPath defaultX509Config
+      let host = fromRight "<hostnames>" $ T.unpack <$> lookupValue "TRANSPORT" "host" ini
+          port = T.unpack $ strictIni "TRANSPORT" "port" ini
+          cfg@ServerConfig {transports, storeLogFile, newQueueBasicAuth, inactiveClientExpiration} = serverConfig
+          srv = ProtoServerWithAuth (SMPServer [THDomainName host] (if port == "5223" then "" else port) (C.KeyHash fp)) newQueueBasicAuth
+      printServiceInfo serverVersion srv
+      printServerConfig transports storeLogFile
+      putStrLn $ case inactiveClientExpiration of
+        Just ExpirationConfig {ttl, checkInterval} -> "expiring clients inactive for " <> show ttl <> " seconds every " <> show checkInterval <> " seconds"
+        _ -> "not expiring inactive clients"
+      putStrLn $
+        "creating new queues "
+          <> if allowNewQueues cfg
+            then maybe "allowed" (const "requires password") newQueueBasicAuth
+            else "NOT allowed"
+      runSMPServer cfg
+      where
+        enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
+        logStats = settingIsOn "STORE_LOG" "log_stats" ini
+        c = combine cfgPath . ($ defaultX509Config)
+        serverConfig =
+          ServerConfig
+            { transports = iniTransports ini,
+              tbqSize = 16,
+              serverTbqSize = 64,
+              msgQueueQuota = 128,
+              queueIdBytes = 24,
+              msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
+              caCertificateFile = c caCrtFile,
+              privateKeyFile = c serverKeyFile,
+              certificateFile = c serverCrtFile,
+              storeLogFile = enableStoreLog $> storeLogFilePath,
+              storeMsgsFile =
+                let messagesPath = combine logPath "smp-server-messages.log"
+                 in case iniOnOff "STORE_LOG" "restore_messages" ini of
+                      Just True -> Just messagesPath
+                      Just False -> Nothing
+                      -- if the setting is not set, it is enabled when store log is enabled
+                      _ -> enableStoreLog $> messagesPath,
+              -- allow creating new queues by default
+              allowNewQueues = fromMaybe True $ iniOnOff "AUTH" "new_queues" ini,
+              newQueueBasicAuth = case lookupValue "AUTH" "create_password" ini of
+                Right auth -> either error Just . strDecode $ encodeUtf8 auth
+                _ -> Nothing,
+              messageExpiration = Just defaultMessageExpiration,
+              inactiveClientExpiration =
+                settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
+                  $> ExpirationConfig
+                    { ttl = readStrictIni "INACTIVE_CLIENTS" "ttl" ini,
+                      checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
+                    },
+              logStatsInterval = logStats $> 86400, -- seconds
+              logStatsStartTime = 0, -- seconds from 00:00 UTC
+              serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
+              serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
+              smpServerVRange = supportedSMPServerVRange,
+              logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+            }
+
+data CliCommand
+  = Init InitOptions
+  | Start
+  | Delete
+
+data InitOptions = InitOptions
+  { enableStoreLog :: Bool,
+    logStats :: Bool,
+    signAlgorithm :: SignAlgorithm,
+    ip :: HostName,
+    fqdn :: Maybe HostName,
+    password :: Maybe ServerPassword,
+    scripted :: Bool
+  }
+  deriving (Show)
+
+data ServerPassword = ServerPassword BasicAuth | SPRandom
+  deriving (Show)
+
+cliCommandP :: FilePath -> FilePath -> FilePath -> Parser CliCommand
+cliCommandP cfgPath logPath iniFile =
+  hsubparser
+    ( command "init" (info (Init <$> initP) (progDesc $ "Initialize server - creates " <> cfgPath <> " and " <> logPath <> " directories and configuration files"))
+        <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
+        <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
+    )
+  where
+    initP :: Parser InitOptions
+    initP = do
+      enableStoreLog <-
+        switch
+          ( long "store-log"
+              <> short 'l'
+              <> help "Enable store log for persistence"
+          )
+      logStats <-
+        switch
+          ( long "daily-stats"
+              <> short 's'
+              <> help "Enable logging daily server statistics"
+          )
+      signAlgorithm <-
+        option
+          (maybeReader readMaybe)
+          ( long "sign-algorithm"
+              <> short 'a'
+              <> help "Signature algorithm used for TLS certificates: ED25519, ED448"
+              <> value ED448
+              <> showDefault
+              <> metavar "ALG"
+          )
+      ip <-
+        strOption
+          ( long "ip"
+              <> help
+                "Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
+              <> value "127.0.0.1"
+              <> showDefault
+              <> metavar "IP"
+          )
+      fqdn <-
+        (optional . strOption)
+          ( long "fqdn"
+              <> short 'n'
+              <> help "Server FQDN used as Common Name for TLS online certificate"
+              <> showDefault
+              <> metavar "FQDN"
+          )
+      password <-
+        flag' Nothing (long "no-password" <> help "Allow creating new queues without password")
+          <|> Just
+            <$> option
+              parseBasicAuth
+              ( long "password"
+                  <> metavar "PASSWORD"
+                  <> help "Set password to create new messaging queues"
+                  <> value SPRandom
+              )
+      scripted <-
+        switch
+          ( long "yes"
+              <> short 'y'
+              <> help "Non-interactive initialization using command-line options"
+          )
+      pure InitOptions {enableStoreLog, logStats, signAlgorithm, ip, fqdn, password, scripted}
+    parseBasicAuth :: ReadM ServerPassword
+    parseBasicAuth = eitherReader $ fmap ServerPassword . strDecode . B.pack
@@ -28,6 +28,7 @@ module Simplex.Messaging.Transport
  ( -- * SMP transport parameters
    supportedSMPServerVRange,
    simplexMQVersion,
+    smpBlockSize,

    -- * Transport connection class
    Transport (..),
@@ -96,10 +97,10 @@ smpBlockSize :: Int
 smpBlockSize = 16384

 supportedSMPServerVRange :: VersionRange
-supportedSMPServerVRange = mkVersionRange 1 4
+supportedSMPServerVRange = mkVersionRange 1 5

 simplexMQVersion :: String
-simplexMQVersion = "3.4.0"
+simplexMQVersion = "4.1.0"

 -- * Transport connection class

@@ -153,12 +154,14 @@ data TLS = TLS
    getLock :: TMVar ()
  }

-connectTLS :: T.TLSParams p => p -> Socket -> IO T.Context
-connectTLS params sock =
-  E.bracketOnError (T.contextNew sock params) closeTLS $ \ctx -> do
-    T.handshake ctx
-      `catchAll` \e -> putStrLn ("exception: " <> show e) >> E.throwIO e
-    pure ctx
+connectTLS :: T.TLSParams p => Maybe HostName -> Bool -> p -> Socket -> IO T.Context
+connectTLS host_ logErrors params sock =
+  E.bracketOnError (T.contextNew sock params) closeTLS $ \ctx ->
+    logHandshakeErrors (T.handshake ctx) $> ctx
+  where
+    logHandshakeErrors = if logErrors then (`catchAll` logThrow) else id
+    logThrow e = putStrLn ("TLS error" <> host <> ": " <> show e) >> E.throwIO e
+    host = maybe "" (\h -> " (" <> h <> ")") host_

 getTLS :: TransportPeer -> T.Context -> IO TLS
 getTLS tlsPeer cxt = withTlsUnique tlsPeer cxt newTLS
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}

@@ -8,7 +9,9 @@ module Simplex.Messaging.Transport.Client
    runTLSTransportClient,
    smpClientHandshake,
    defaultSMPPort,
+    defaultTransportClientConfig,
    defaultSocksProxy,
+    TransportClientConfig (..),
    SocksProxy,
    TransportHost (..),
    TransportHosts (..),
@@ -93,20 +96,31 @@ instance IsString TransportHost where fromString = parseString strDecode

 instance IsString (NonEmpty TransportHost) where fromString = parseString strDecode

+data TransportClientConfig = TransportClientConfig
+  { socksProxy :: Maybe SocksProxy,
+    tcpKeepAlive :: Maybe KeepAliveOpts,
+    logTLSErrors :: Bool
+  }
+  deriving (Eq, Show)
+
+defaultTransportClientConfig :: TransportClientConfig
+defaultTransportClientConfig = TransportClientConfig Nothing (Just defaultKeepAliveOpts) True
+
 -- | Connect to passed TCP host:port and pass handle to the client.
-runTransportClient :: (Transport c, MonadUnliftIO m) => Maybe SocksProxy -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
+runTransportClient :: (Transport c, MonadUnliftIO m) => TransportClientConfig -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> m a) -> m a
 runTransportClient = runTLSTransportClient supportedParameters Nothing

-runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> Maybe SocksProxy -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
-runTLSTransportClient tlsParams caStore_ socksProxy_ host port keyHash keepAliveOpts client = do
-  let clientParams = mkTLSClientParams tlsParams caStore_ (B.unpack $ strEncode host) port keyHash
-      connectTCP = case socksProxy_ of
+runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> m a) -> m a
+runTLSTransportClient tlsParams caStore_ TransportClientConfig {socksProxy, tcpKeepAlive, logTLSErrors} host port keyHash client = do
+  let hostName = B.unpack $ strEncode host
+      clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash
+      connectTCP = case socksProxy of
        Just proxy -> connectSocksClient proxy $ hostAddr host
-        _ -> connectTCPClient . B.unpack $ strEncode host
+        _ -> connectTCPClient hostName
  c <- liftIO $ do
    sock <- connectTCP port
-    mapM_ (setSocketKeepAlive sock) keepAliveOpts
-    connectTLS clientParams sock >>= getClientConnection
+    mapM_ (setSocketKeepAlive sock) tcpKeepAlive
+    connectTLS (Just hostName) logTLSErrors clientParams sock >>= getClientConnection
  client c `E.finally` liftIO (closeConnection c)
  where
    hostAddr = \case
@@ -19,14 +19,13 @@ import qualified Network.HTTP2.Client as H
 import Network.Socket (HostName, ServiceName)
 import qualified Network.TLS as T
 import Numeric.Natural (Natural)
-import Simplex.Messaging.Transport.Client (TransportHost (..), runTLSTransportClient)
+import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost (..), runTLSTransportClient)
 import Simplex.Messaging.Transport.HTTP2 (http2TLSParams, withTlsConfig)
-import Simplex.Messaging.Transport.KeepAlive (KeepAliveOpts)
 import UnliftIO.STM
 import UnliftIO.Timeout

 data HTTP2Client = HTTP2Client
-  { action :: Async (),
+  { action :: Maybe (Async ()),
    connected :: TVar Bool,
    host :: HostName,
    port :: ServiceName,
@@ -43,7 +42,7 @@ data HTTP2Response = HTTP2Response
 data HTTP2ClientConfig = HTTP2ClientConfig
  { qSize :: Natural,
    connTimeout :: Int,
-    tcpKeepAlive :: Maybe KeepAliveOpts,
+    transportConfig :: TransportClientConfig,
    caStoreFile :: FilePath,
    suportedTLSParams :: T.Supported
  }
@@ -54,7 +53,7 @@ defaultHTTP2ClientConfig =
  HTTP2ClientConfig
    { qSize = 64,
      connTimeout = 10000000,
-      tcpKeepAlive = Nothing,
+      transportConfig = TransportClientConfig Nothing Nothing True,
      caStoreFile = "/etc/ssl/cert.pem",
      suportedTLSParams = http2TLSParams
    }
@@ -63,7 +62,7 @@ data HTTP2ClientError = HCResponseTimeout | HCNetworkError | HCNetworkError1 | H
  deriving (Show)

 getHTTP2Client :: HostName -> ServiceName -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
-getHTTP2Client host port config@HTTP2ClientConfig {tcpKeepAlive, connTimeout, caStoreFile, suportedTLSParams} disconnected =
+getHTTP2Client host port config@HTTP2ClientConfig {transportConfig, connTimeout, caStoreFile, suportedTLSParams} disconnected =
  (atomically mkHTTPS2Client >>= runClient)
    `E.catch` \(e :: IOException) -> pure . Left $ HCIOError e
  where
@@ -71,7 +70,7 @@ getHTTP2Client host port config@HTTP2ClientConfig {tcpKeepAlive, connTimeout, ca
    mkHTTPS2Client = do
      connected <- newTVar False
      reqQ <- newTBQueue $ qSize config
-      pure HTTP2Client {action = undefined, connected, host, port, config, reqQ}
+      pure HTTP2Client {action = Nothing, connected, host, port, config, reqQ}

    runClient :: HTTP2Client -> IO (Either HTTP2ClientError HTTP2Client)
    runClient c = do
@@ -80,11 +79,11 @@ getHTTP2Client host port config@HTTP2ClientConfig {tcpKeepAlive, connTimeout, ca
      when (isNothing caStore) . putStrLn $ "Error loading CertificateStore from " <> caStoreFile
      action <-
        async $
-          runHTTP2Client suportedTLSParams caStore host port tcpKeepAlive (client c cVar)
+          runHTTP2Client suportedTLSParams caStore transportConfig host port (client c cVar)
            `E.finally` atomically (putTMVar cVar $ Left HCNetworkError)
      conn_ <- connTimeout `timeout` atomically (takeTMVar cVar)
      pure $ case conn_ of
-        Just (Right ()) -> Right c {action}
+        Just (Right ()) -> Right c {action = Just action}
        Just (Left e) -> Left e
        Nothing -> Left HCNetworkError1

@@ -111,8 +110,7 @@ getHTTP2Client host port config@HTTP2ClientConfig {tcpKeepAlive, connTimeout, ca

 -- | Disconnects client from the server and terminates client threads.
 closeHTTP2Client :: HTTP2Client -> IO ()
-- TODO disconnect
-closeHTTP2Client = uninterruptibleCancel . action
+closeHTTP2Client = mapM_ uninterruptibleCancel . action

 sendRequest :: HTTP2Client -> Request -> IO (Either HTTP2ClientError HTTP2Response)
 sendRequest HTTP2Client {reqQ, config} req = do
@@ -120,9 +118,9 @@ sendRequest HTTP2Client {reqQ, config} req = do
  atomically $ writeTBQueue reqQ (req, resp)
  maybe (Left HCResponseTimeout) Right <$> (connTimeout config `timeout` atomically (takeTMVar resp))

-runHTTP2Client :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe KeepAliveOpts -> ((Request -> (Response -> IO ()) -> IO ()) -> IO ()) -> IO ()
-runHTTP2Client tlsParams caStore host port keepAliveOpts client =
-  runTLSTransportClient tlsParams caStore Nothing (THDomainName host) port Nothing keepAliveOpts $ \c ->
+runHTTP2Client :: T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> HostName -> ServiceName -> ((Request -> (Response -> IO ()) -> IO ()) -> IO ()) -> IO ()
+runHTTP2Client tlsParams caStore tcConfig host port client =
+  runTLSTransportClient tlsParams caStore tcConfig (THDomainName host) port Nothing $ \c ->
    withTlsConfig c 16384 (`run` client)
  where
    run = H.run $ ClientConfig "https" (B.pack host) 20
@@ -25,7 +25,8 @@ data HTTP2ServerConfig = HTTP2ServerConfig
    serverSupported :: T.Supported,
    caCertificateFile :: FilePath,
    privateKeyFile :: FilePath,
-    certificateFile :: FilePath
+    certificateFile :: FilePath,
+    logTLSErrors :: Bool
  }
  deriving (Show)

@@ -42,12 +43,12 @@ data HTTP2Server = HTTP2Server
  }

 getHTTP2Server :: HTTP2ServerConfig -> IO HTTP2Server
-getHTTP2Server HTTP2ServerConfig {qSize, http2Port, serverSupported, caCertificateFile, certificateFile, privateKeyFile} = do
+getHTTP2Server HTTP2ServerConfig {qSize, http2Port, serverSupported, caCertificateFile, certificateFile, privateKeyFile, logTLSErrors} = do
  tlsServerParams <- loadSupportedTLSServerParams serverSupported caCertificateFile certificateFile privateKeyFile
  started <- newEmptyTMVarIO
  reqQ <- newTBQueueIO qSize
  action <- async $
-    runHTTP2Server started http2Port tlsServerParams $ \r sendResponse -> do
+    runHTTP2Server started http2Port tlsServerParams logTLSErrors $ \r sendResponse -> do
      reqBody <- getRequestBody r ""
      reqTrailers <- H.getRequestTrailers r
      atomically $ writeTBQueue reqQ HTTP2Request {request = r, reqBody, reqTrailers, sendResponse}
@@ -62,9 +63,9 @@ getHTTP2Server HTTP2ServerConfig {qSize, http2Port, serverSupported, caCertifica
 closeHTTP2Server :: HTTP2Server -> IO ()
 closeHTTP2Server = uninterruptibleCancel . action

-runHTTP2Server :: TMVar Bool -> ServiceName -> T.ServerParams -> HTTP2ServerFunc -> IO ()
-runHTTP2Server started port serverParams http2Server =
-  runTransportServer started port serverParams $ \c -> withTlsConfig c 16384 (`H.run` server)
+runHTTP2Server :: TMVar Bool -> ServiceName -> T.ServerParams -> Bool -> HTTP2ServerFunc -> IO ()
+runHTTP2Server started port serverParams logTLSErrors http2Server =
+  runTransportServer started port serverParams logTLSErrors $ \c -> withTlsConfig c 16384 (`H.run` server)
  where
    server :: Request -> Aux -> (Response -> [PushPromise] -> IO ()) -> IO ()
    server req _aux sendResp = http2Server req (`sendResp` [])
@@ -35,12 +35,12 @@ 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
+runTransportServer :: forall c m. (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> T.ServerParams -> Bool -> (c -> m ()) -> m ()
+runTransportServer started port serverParams logTLSErrors server = do
  u <- askUnliftIO
  liftIO . runTCPServer started port $ \conn ->
    E.bracket
-      (connectTLS serverParams conn >>= getServerConnection)
+      (connectTLS Nothing logTLSErrors serverParams conn >>= getServerConnection)
      closeConnection
      (unliftIO u . server)

@@ -18,6 +18,7 @@ import Simplex.Messaging.Transport
    TransportError (..),
    TransportPeer (..),
    closeTLS,
+    smpBlockSize,
    trimCR,
    withTlsUnique,
  )
@@ -33,7 +34,7 @@ websocketsOpts :: ConnectionOptions
 websocketsOpts =
  defaultConnectionOptions
    { connectionCompressionOptions = NoCompression,
-      connectionFramePayloadSizeLimit = SizeLimit $ 16 * 1024, -- TODO move to Protocol
+      connectionFramePayloadSizeLimit = SizeLimit $ fromIntegral smpBlockSize,
      connectionMessageDataSizeLimit = SizeLimit 65536
    }

@@ -331,8 +331,8 @@ testServerConnectionAfterError t _ = do

  withAgent1 $ \bob -> do
    withAgent2 $ \alice -> do
-      bob #: ("1", "alice", "SUB") =#> \("1", "alice", ERR (BROKER e)) -> e == NETWORK || e == TIMEOUT
-      alice #: ("1", "bob", "SUB") =#> \("1", "bob", ERR (BROKER e)) -> e == NETWORK || e == TIMEOUT
+      bob #: ("1", "alice", "SUB") =#> \("1", "alice", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT
+      alice #: ("1", "bob", "SUB") =#> \("1", "bob", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT
      withServer $ do
        alice <#= \case ("", "bob", SENT 4) -> True; ("", "", UP s ["bob"]) -> s == server; _ -> False
        alice <#= \case ("", "bob", SENT 4) -> True; ("", "", UP s ["bob"]) -> s == server; _ -> False
@@ -3,6 +3,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -23,24 +24,29 @@ where

 import Control.Concurrent (killThread, threadDelay)
 import Control.Monad
-import Control.Monad.Except (ExceptT, runExceptT)
+import Control.Monad.Except (ExceptT, MonadError (throwError), runExceptT)
 import Control.Monad.IO.Unlift
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
 import qualified Data.Map as M
+import Data.Maybe (isNothing)
 import qualified Data.Set as S
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import SMPAgentClient
 import SMPClient (cfg, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers)
+import Simplex.Messaging.Agent.Client (SMPTestFailure (..), SMPTestStep (..))
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..))
 import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Client (ProtocolClientConfig (..))
-import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
+import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultClientConfig)
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (BasicAuth, ErrorType (..), MsgBody, ProtocolServer (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (ATransport (..))
+import Simplex.Messaging.Util (tryError)
 import Simplex.Messaging.Version
 import Test.Hspec
 import UnliftIO
@@ -127,6 +133,62 @@ functionalAPITests t = do
      testServerMatrix2 t testSwitchAsync
    describe "should delete connection during rotation" $
      testServerMatrix2 t testSwitchDelete
+  describe "SMP basic auth" $ do
+    describe "with server auth" $ do
+      --                                       allow NEW | server auth, v | clnt1 auth, v  | clnt2 auth, v    |  2 - success, 1 - JOIN fail, 0 - NEW fail
+      it "success                " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 5) (Just "abcd", 5) `shouldReturn` 2
+      it "disabled               " $ testBasicAuth t False (Just "abcd", 5) (Just "abcd", 5) (Just "abcd", 5) `shouldReturn` 0
+      it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", 5) (Nothing, 5) (Just "abcd", 5) `shouldReturn` 0
+      it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", 5) (Just "wrong", 5) (Just "abcd", 5) `shouldReturn` 0
+      it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 4) (Just "abcd", 5) `shouldReturn` 0
+      it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 5) (Nothing, 5) `shouldReturn` 1
+      it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 5) (Just "wrong", 5) `shouldReturn` 1
+      it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 5) (Just "abcd", 4) `shouldReturn` 1
+    describe "no server auth" $ do
+      it "success     " $ testBasicAuth t True (Nothing, 5) (Nothing, 5) (Nothing, 5) `shouldReturn` 2
+      it "srv disabled" $ testBasicAuth t False (Nothing, 5) (Nothing, 5) (Nothing, 5) `shouldReturn` 0
+      it "version srv " $ testBasicAuth t True (Nothing, 4) (Nothing, 5) (Nothing, 5) `shouldReturn` 2
+      it "version fst " $ testBasicAuth t True (Nothing, 5) (Nothing, 4) (Nothing, 5) `shouldReturn` 2
+      it "version snd " $ testBasicAuth t True (Nothing, 5) (Nothing, 5) (Nothing, 4) `shouldReturn` 2
+      it "version both" $ testBasicAuth t True (Nothing, 5) (Nothing, 4) (Nothing, 4) `shouldReturn` 2
+      it "version all " $ testBasicAuth t True (Nothing, 4) (Nothing, 4) (Nothing, 4) `shouldReturn` 2
+      it "auth fst    " $ testBasicAuth t True (Nothing, 5) (Just "abcd", 5) (Nothing, 5) `shouldReturn` 2
+      it "auth fst 2  " $ testBasicAuth t True (Nothing, 4) (Just "abcd", 5) (Nothing, 5) `shouldReturn` 2
+      it "auth snd    " $ testBasicAuth t True (Nothing, 5) (Nothing, 5) (Just "abcd", 5) `shouldReturn` 2
+      it "auth both   " $ testBasicAuth t True (Nothing, 5) (Just "abcd", 5) (Just "abcd", 5) `shouldReturn` 2
+      it "auth, disabled" $ testBasicAuth t False (Nothing, 5) (Just "abcd", 5) (Just "abcd", 5) `shouldReturn` 0
+  describe "SMP server test via agent API" $ do
+    it "should pass without basic auth" $ testSMPServerConnectionTest t Nothing (noAuthSrv testSMPServer2) `shouldReturn` Nothing
+    let srv1 = testSMPServer2 {keyHash = "1234"}
+    it "should fail with incorrect fingerprint" $ do
+      testSMPServerConnectionTest t Nothing (noAuthSrv srv1) `shouldReturn` Just (SMPTestFailure TSConnect $ BROKER (B.unpack $ strEncode srv1) NETWORK)
+    describe "server with password" $ do
+      let auth = Just "abcd"
+          srv = ProtoServerWithAuth testSMPServer2
+          authErr = Just (SMPTestFailure TSCreateQueue $ SMP AUTH)
+      it "should pass with correct password" $ testSMPServerConnectionTest t auth (srv auth) `shouldReturn` Nothing
+      it "should fail without password" $ testSMPServerConnectionTest t auth (srv Nothing) `shouldReturn` authErr
+      it "should fail with incorrect password" $ testSMPServerConnectionTest t auth (srv $ Just "wrong") `shouldReturn` authErr
+  describe "getRatchetAdHash" $
+    it "should return the same data for both peers" $
+      withSmpServer t testRatchetAdHash
+
+testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> IO Int
+testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 = do
+  let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = mkVersionRange 4 srvVersion}
+      canCreate1 = canCreateQueue allowNewQueues srv clnt1
+      canCreate2 = canCreateQueue allowNewQueues srv clnt2
+      expected
+        | canCreate1 && canCreate2 = 2
+        | canCreate1 = 1
+        | otherwise = 0
+  created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth clnt1 clnt2
+  created `shouldBe` expected
+  pure created
+
+canCreateQueue :: Bool -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> Bool
+canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
+  allowNew && (isNothing srvAuth || (srvVersion == 5 && clntVersion == 5 && srvAuth == clntAuth))

 testMatrix2 :: ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
@@ -300,7 +362,7 @@ testAsyncServerOffline t = do
  Right (bobId, cReq) <- withSmpServerStoreLogOn t testPort $ \_ ->
    runExceptT $ createConnection alice True SCMInvitation Nothing
  -- connection fails
-  Left (BROKER NETWORK) <- runExceptT $ joinConnection bob True cReq "bob's connInfo"
+  Left (BROKER _ NETWORK) <- runExceptT $ joinConnection bob True cReq "bob's connInfo"
  ("", "", DOWN srv conns) <- get alice
  srv `shouldBe` testSMPServer
  conns `shouldBe` [bobId]
@@ -360,7 +422,7 @@ testDuplicateMessage t = do
  -- commenting two lines below and uncommenting further two lines would also pass,
  -- it is the scenario tested above, when the message was not acknowledged by the user
  threadDelay 200000
-  Left (BROKER TIMEOUT) <- runExceptT $ ackMessage bob1 aliceId 5
+  Left (BROKER _ TIMEOUT) <- runExceptT $ ackMessage bob1 aliceId 5

  disconnectAgentClient alice
  disconnectAgentClient bob1
@@ -741,6 +803,51 @@ testSwitchDelete servers = do
    liftIO $ bId `shouldBe` bId'
  pure ()

+testCreateQueueAuth :: (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> IO Int
+testCreateQueueAuth clnt1 clnt2 = do
+  a <- getClient clnt1
+  b <- getClient clnt2
+  Right created <- runExceptT $ do
+    tryError (createConnection a True SCMInvitation Nothing) >>= \case
+      Left (SMP AUTH) -> pure 0
+      Left e -> throwError e
+      Right (bId, qInfo) ->
+        tryError (joinConnection b True qInfo "bob's connInfo") >>= \case
+          Left (SMP AUTH) -> pure 1
+          Left e -> throwError e
+          Right aId -> do
+            ("", _, CONF confId _ "bob's connInfo") <- get a
+            allowConnection a bId confId "alice's connInfo"
+            get a ##> ("", bId, CON)
+            get b ##> ("", aId, INFO "alice's connInfo")
+            get b ##> ("", aId, CON)
+            exchangeGreetings a bId b aId
+            pure 2
+  pure created
+  where
+    getClient (clntAuth, clntVersion) =
+      let servers = initAgentServers {smp = [ProtoServerWithAuth testSMPServer clntAuth]}
+          smpCfg = (defaultClientConfig :: ProtocolClientConfig) {smpServerVRange = mkVersionRange 4 clntVersion}
+       in getSMPAgentClient agentCfg {smpCfg} servers
+
+testSMPServerConnectionTest :: ATransport -> Maybe BasicAuth -> SMPServerWithAuth -> IO (Maybe SMPTestFailure)
+testSMPServerConnectionTest t newQueueBasicAuth srv =
+  withSmpServerConfigOn t cfg {newQueueBasicAuth} testPort2 $ \_ -> do
+    a <- getSMPAgentClient agentCfg initAgentServers -- initially passed server is not running
+    Right r <- runExceptT $ testSMPServerConnection a srv
+    pure r
+
+testRatchetAdHash :: IO ()
+testRatchetAdHash = do
+  a <- getSMPAgentClient agentCfg initAgentServers
+  b <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers
+  Right () <- runExceptT $ do
+    (aId, bId) <- makeConnection a b
+    ad1 <- getConnectionRatchetAdHash a bId
+    ad2 <- getConnectionRatchetAdHash b aId
+    liftIO $ ad1 `shouldBe` ad2
+  pure ()
+
 exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetings = exchangeGreetingsMsgId 4

@@ -0,0 +1,79 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module CLITests where
+
+import Data.Ini (lookupValue, readIniFile)
+import Data.List (isPrefixOf)
+import Simplex.Messaging.Notifications.Server.Main
+import Simplex.Messaging.Server.Main
+import Simplex.Messaging.Util (catchAll_)
+import System.Directory (doesFileExist)
+import System.Environment (withArgs)
+import System.IO.Silently (capture_)
+import System.Timeout (timeout)
+import Test.Hspec
+import Test.Main (withStdin)
+
+cfgPath :: FilePath
+cfgPath = "tests/tmp/cli/etc/opt/simplex"
+
+logPath :: FilePath
+logPath = "tests/tmp/cli/etc/var/simplex"
+
+ntfCfgPath :: FilePath
+ntfCfgPath = "tests/tmp/cli/etc/opt/simplex-notifications"
+
+ntfLogPath :: FilePath
+ntfLogPath = "tests/tmp/cli/etc/var/simplex-notifications"
+
+cliTests :: Spec
+cliTests = do
+  describe "SMP server CLI" $ do
+    describe "initialize, start and delete the server" $ do
+      it "no store log, random password (default)" $ smpServerTest False True
+      it "with store log, random password (default)" $ smpServerTest True True
+      it "no store log, no password" $ smpServerTest False False
+      it "with store log, no password" $ smpServerTest True False
+  describe "Ntf server CLI" $ do
+    it "should initialize, start and delete the server (no store log)" $ ntfServerTest False
+    it "should initialize, start and delete the server (with store log)" $ ntfServerTest True
+
+smpServerTest :: Bool -> Bool -> IO ()
+smpServerTest storeLog basicAuth = do
+  capture_ (withArgs (["init", "-y"] <> ["-l" | storeLog] <> ["--no-password" | not basicAuth]) $ smpServerCLI cfgPath logPath)
+    >>= (`shouldSatisfy` (("Server initialized, you can modify configuration in " <> cfgPath <> "/smp-server.ini") `isPrefixOf`))
+  Right ini <- readIniFile $ cfgPath <> "/smp-server.ini"
+  lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")
+  lookupValue "STORE_LOG" "log_stats" ini `shouldBe` Right "off"
+  lookupValue "TRANSPORT" "port" ini `shouldBe` Right "5223"
+  lookupValue "TRANSPORT" "websockets" ini `shouldBe` Right "off"
+  lookupValue "AUTH" "new_queues" ini `shouldBe` Right "on"
+  lookupValue "INACTIVE_CLIENTS" "disconnect" ini `shouldBe` Right "off"
+  doesFileExist (cfgPath <> "/ca.key") `shouldReturn` True
+  r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ()))
+  r `shouldContain` ["SMP server v4.0.0"]
+  r `shouldContain` (if storeLog then ["Store log: " <> logPath <> "/smp-server-store.log"] else ["Store log disabled."])
+  r `shouldContain` ["Listening on port 5223 (TLS)..."]
+  r `shouldContain` ["not expiring inactive clients"]
+  r `shouldContain` (if basicAuth then ["creating new queues requires password"] else ["creating new queues allowed"])
+  capture_ (withStdin "Y" . withArgs ["delete"] $ smpServerCLI cfgPath logPath)
+    >>= (`shouldSatisfy` ("WARNING: deleting the server will make all queues inaccessible" `isPrefixOf`))
+  doesFileExist (cfgPath <> "/ca.key") `shouldReturn` False
+
+ntfServerTest :: Bool -> IO ()
+ntfServerTest storeLog = do
+  capture_ (withArgs (["init"] <> ["-l" | storeLog]) $ ntfServerCLI ntfCfgPath ntfLogPath)
+    >>= (`shouldSatisfy` (("Server initialized, you can modify configuration in " <> ntfCfgPath <> "/ntf-server.ini") `isPrefixOf`))
+  Right ini <- readIniFile $ ntfCfgPath <> "/ntf-server.ini"
+  lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")
+  lookupValue "STORE_LOG" "log_stats" ini `shouldBe` Right "off"
+  lookupValue "TRANSPORT" "port" ini `shouldBe` Right "443"
+  lookupValue "TRANSPORT" "websockets" ini `shouldBe` Right "off"
+  doesFileExist (ntfCfgPath <> "/ca.key") `shouldReturn` True
+  r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` ntfServerCLI ntfCfgPath ntfLogPath) `catchAll_` pure (Just ()))
+  r `shouldContain` ["SMP notifications server v1.2.0"]
+  r `shouldContain` (if storeLog then ["Store log: " <> ntfLogPath <> "/ntf-server-store.log"] else ["Store log disabled."])
+  r `shouldContain` ["Listening on port 443 (TLS)..."]
+  capture_ (withStdin "Y" . withArgs ["delete"] $ ntfServerCLI ntfCfgPath ntfLogPath)
+    >>= (`shouldSatisfy` ("WARNING: deleting the server will make all queues inaccessible" `isPrefixOf`))
+  doesFileExist (cfgPath <> "/ca.key") `shouldReturn` False
@@ -1,9 +1,14 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module CoreTests.ProtocolErrorTests where

-import Simplex.Messaging.Agent.Protocol (AgentErrorType)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Simplex.Messaging.Agent.Protocol (AgentErrorType (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Protocol (ErrorType)
 import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck
@@ -11,9 +16,13 @@ import Test.QuickCheck
 protocolErrorTests :: Spec
 protocolErrorTests = modifyMaxSuccess (const 1000) $ do
  describe "errors parsing / serializing" $ do
-    it "should parse SMP protocol errors" . property $ \err ->
-      parseAll strP (strEncode err)
-        == Right (err :: ErrorType)
-    it "should parse SMP agent errors" . property $ \err ->
-      parseAll strP (strEncode err)
-        == Right (err :: AgentErrorType)
+    it "should parse SMP protocol errors" . property $ \(err :: AgentErrorType) ->
+      errServerHasSpaces err
+        || parseAll strP (strEncode err) == Right err
+    it "should parse SMP agent errors" . property $ \(err :: AgentErrorType) ->
+      errServerHasSpaces err
+        || parseAll strP (strEncode err) == Right err
+  where
+    errServerHasSpaces = \case
+      BROKER srv _ -> ' ' `B.elem` encodeUtf8 (T.pack srv)
+      _ -> False
@@ -44,7 +44,6 @@ import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.HTTP2 (http2TLSParams)
 import Simplex.Messaging.Transport.HTTP2.Client
 import Simplex.Messaging.Transport.HTTP2.Server
-import Simplex.Messaging.Transport.KeepAlive
 import Test.Hspec
 import UnliftIO.Async
 import UnliftIO.Concurrent
@@ -70,7 +69,7 @@ ntfTestStoreLogFile = "tests/tmp/ntf-server-store.log"
 testNtfClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandle c -> m a) -> m a
 testNtfClient client = do
  Right host <- pure $ chooseTransportHost defaultNetworkConfig testHost
-  runTransportClient Nothing host ntfTestPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
+  runTransportClient defaultTransportClientConfig host ntfTestPort (Just testKeyHash) $ \h ->
    liftIO (runExceptT $ ntfClientHandshake h testKeyHash supportedNTFServerVRange) >>= \case
      Right th -> client th
      Left e -> error $ show e
@@ -101,7 +100,8 @@ ntfServerCfg =
      logStatsInterval = Nothing,
      logStatsStartTime = 0,
      serverStatsLogFile = "tests/ntf-server-stats.daily.log",
-      serverStatsBackupFile = Nothing
+      serverStatsBackupFile = Nothing,
+      logTLSErrors = True
    }

 withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
@@ -178,7 +178,8 @@ apnsMockServerConfig =
      serverSupported = http2TLSParams,
      caCertificateFile = "tests/fixtures/ca.crt",
      privateKeyFile = "tests/fixtures/server.key",
-      certificateFile = "tests/fixtures/server.crt"
+      certificateFile = "tests/fixtures/server.crt",
+      logTLSErrors = True
    }

 withAPNSMockServer :: (APNSMockServer -> IO ()) -> IO ()
@@ -31,7 +31,6 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost,
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
-import Simplex.Messaging.Transport.KeepAlive
 import Test.Hspec
 import UnliftIO.Concurrent
 import UnliftIO.Directory
@@ -174,13 +173,13 @@ testSMPServer2 = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5
 initAgentServers :: InitialAgentServers
 initAgentServers =
  InitialAgentServers
-    { smp = L.fromList [testSMPServer],
+    { smp = L.fromList [noAuthSrv testSMPServer],
      ntf = ["ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"],
      netCfg = defaultNetworkConfig {tcpTimeout = 500_000}
    }

 initAgentServers2 :: InitialAgentServers
-initAgentServers2 = initAgentServers {smp = L.fromList [testSMPServer, testSMPServer2]}
+initAgentServers2 = initAgentServers {smp = L.fromList [noAuthSrv testSMPServer, noAuthSrv testSMPServer2]}

 agentCfg :: AgentConfig
 agentCfg =
@@ -210,7 +209,7 @@ agentCfg =
 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, AgentDatabase) -> m () -> (ThreadId -> m a) -> m a
 withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
  let cfg' = agentCfg {tcpPort = port', database = db'}
-      initServers' = initAgentServers {smp = L.fromList [SMPServer "localhost" smpPort' testKeyHash]}
+      initServers' = initAgentServers {smp = L.fromList [ProtoServerWithAuth (SMPServer "localhost" smpPort' testKeyHash) Nothing]}
   in serverBracket
        (\started -> runSMPAgentBlocking t started cfg' initServers')
        afterProcess
@@ -227,7 +226,7 @@ withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB)
 testSMPAgentClientOn :: (Transport c, MonadUnliftIO m, MonadFail m) => ServiceName -> (c -> m a) -> m a
 testSMPAgentClientOn port' client = do
  Right useHost <- pure $ chooseTransportHost defaultNetworkConfig agentTestHost
-  runTransportClient Nothing useHost port' (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> do
+  runTransportClient defaultTransportClientConfig useHost port' (Just testKeyHash) $ \h -> do
    line <- liftIO $ getLn h
    if line == "Welcome to SMP agent v" <> B.pack simplexMQVersion
      then client h
@@ -23,7 +23,6 @@ import Simplex.Messaging.Server (runSMPServerBlocking)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
-import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Version
 import Test.Hspec
 import UnliftIO.Concurrent
@@ -58,7 +57,7 @@ testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"
 testSMPClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandle c -> m a) -> m a
 testSMPClient client = do
  Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
-  runTransportClient Nothing useHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
+  runTransportClient defaultTransportClientConfig useHost testPort (Just testKeyHash) $ \h ->
    liftIO (runExceptT $ smpClientHandshake h testKeyHash supportedSMPServerVRange) >>= \case
      Right th -> client th
      Left e -> error $ show e
@@ -78,6 +77,7 @@ cfg =
      storeLogFile = Nothing,
      storeMsgsFile = Nothing,
      allowNewQueues = True,
+      newQueueBasicAuth = Nothing,
      messageExpiration = Just defaultMessageExpiration,
      inactiveClientExpiration = Just defaultInactiveClientExpiration,
      logStatsInterval = Nothing,
@@ -87,7 +87,8 @@ cfg =
      caCertificateFile = "tests/fixtures/ca.crt",
      privateKeyFile = "tests/fixtures/server.key",
      certificateFile = "tests/fixtures/server.crt",
-      smpServerVRange = supportedSMPServerVRange
+      smpServerVRange = supportedSMPServerVRange,
+      logTLSErrors = True
    }

 withSmpServerStoreMsgLogOnV2 :: ATransport -> ServiceName -> (ThreadId -> IO a) -> IO a
@@ -114,7 +114,7 @@ testCreateSecureV2 _ =
    withSmpServerConfigOn (transport @c) cfgV2 testPort $ \_ -> testSMPClient @c $ \h -> do
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV2 $ C.dh' srvDh dhPriv
      (rId1, "") #== "creates queue"

@@ -178,7 +178,7 @@ testCreateSecure (ATransport t) =
    smpTest t $ \h -> do
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
      (rId1, "") #== "creates queue"

@@ -242,7 +242,7 @@ testCreateDelete (ATransport t) =
    smpTest2 t $ \rh sh -> do
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd25519
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
      (rId1, "") #== "creates queue"

@@ -313,7 +313,7 @@ stressTest (ATransport t) =
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd25519
      (dhPub, _ :: C.PrivateKeyX25519) <- C.generateKeyPair'
      rIds <- forM ([1 .. 50] :: [Int]) . const $ do
-        Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub)
+        Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub Nothing)
        pure rId
      let subscribeQueues h = forM_ rIds $ \rId -> do
            Resp "" rId' OK <- signSendRecv h rKey ("", rId, SUB)
@@ -330,7 +330,7 @@ testAllowNewQueues t =
      testSMPClient @c $ \h -> do
        (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
        (dhPub, _ :: C.PrivateKeyX25519) <- C.generateKeyPair'
-        Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+        Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing)
        pure ()

 testDuplex :: ATransport -> Spec
@@ -339,7 +339,7 @@ testDuplex (ATransport t) =
    smpTest2 t $ \alice bob -> do
      (arPub, arKey) <- C.generateSignatureKeyPair C.SEd448
      (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub)
+      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub Nothing)
      let aDec = decryptMsgV3 $ C.dh' aSrvDh aDhPriv
      -- aSnd ID is passed to Bob out-of-band

@@ -355,7 +355,7 @@ testDuplex (ATransport t) =

      (brPub, brKey) <- C.generateSignatureKeyPair C.SEd448
      (bDhPub, bDhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub)
+      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub Nothing)
      let bDec = decryptMsgV3 $ C.dh' bSrvDh bDhPriv
      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> encode bSnd)
      -- "reply_id ..." is ad-hoc, not a part of SMP protocol
@@ -393,7 +393,7 @@ testSwitchSub (ATransport t) =
    smpTest3 t $ \rh1 rh2 sh -> do
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
      Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, _SEND "test1")
      (ok1, OK) #== "sent test message 1"
@@ -716,7 +716,7 @@ createAndSecureQueue :: Transport c => THandle c -> SndPublicVerifyKey -> IO (Se
 createAndSecureQueue h sPub = do
  (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
  (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-  Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+  Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing)
  let dhShared = C.dh' srvDh dhPriv
  Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
  (rId', rId) #== "same queue ID"
@@ -741,7 +741,7 @@ testTiming (ATransport t) =
    testSameTiming rh sh (goodKeySize, badKeySize, n) = do
      (rPub, rKey) <- generateKeys goodKeySize
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
      Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, SUB)

@@ -2,6 +2,7 @@

 import AgentTests (agentTests)
 -- import Control.Logger.Simple
+import CLITests
 import CoreTests.CryptoTests
 import CoreTests.EncodingTests
 import CoreTests.ProtocolErrorTests
@@ -34,4 +35,5 @@ main = do
    describe "SMP server via WebSockets" $ serverTests (transport @WS)
    describe "Notifications server" $ ntfServerTests (transport @TLS)
    describe "SMP client agent" $ agentTests (transport @TLS)
+    describe "Server CLIs" cliTests
  removeDirectoryRecursive "tests/tmp"
Author	SHA1	Message	Date
Evgeny Poberezkin	69a5896dac	4.1.0 (#588 )	2022-12-29 21:33:55 +00:00
Evgeny Poberezkin	af903bd405	rfc: managing exceeded queue quotas (#583 ) * rfc: managing exceeded queue quotas * update	2022-12-27 16:29:07 +00:00
Evgeny Poberezkin	51b0833f98	rfc: SimpleX File Transfer protocol (#582 ) * rfc: SimpleX File Transfer protocol * update * update * remove space * update transport protocol notes * spellcheck	2022-12-27 12:42:53 +00:00
Evgeny Poberezkin	874f9f5cd6	option to enable/disable TLS handshake error logs (disable by default) (#581 ) * option to enable/disable TLS handshake error logs (disable by default) * refactor	2022-12-27 10:13:51 +00:00
Evgeny Poberezkin	66d3465c19	Merge branch 'stable'	2022-12-26 22:28:42 +00:00
sh	d5bf99c32c	docker: update (#578 ) * readme: update for recent docker changes * docker: update entrypoint logic * readme: clarify	2022-12-26 22:27:56 +00:00
Evgeny Poberezkin	1d3a604988	refactor SMP client, NTF server store (#580 ) * refactor SMP client, NTF server store * remove undefined	2022-12-26 18:54:28 +00:00
Evgeny Poberezkin	267236a4f8	remove unnecessary exception handler, error format in stats	2022-12-26 13:00:41 +00:00
Evgeny Poberezkin	aa17cc55c1	collect agent stats (#579 ) * collect agent stats * remove comment	2022-12-26 12:02:20 +00:00
Evgeny PoberezkinandJRoberts	fb21d9836e	agent: api to get hash of ratchet associated data for connection verification (#577 ) * agent: api to get hash of ratchet associated data for connection verification * enable all tests * correction Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com> Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>	2022-12-09 09:41:12 +00:00
Evgeny PoberezkinandJRoberts	e4842f4f47	agent: include server address string into BROKER errors (#575 ) * agent: include server address string into BROKER errors * eol Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com> Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>	2022-11-30 08:25:07 +00:00
Evgeny Poberezkin	dc920d90d9	v4.0.0 (#573 ) * v4.0.0 * update	2022-11-28 19:59:04 +00:00
Evgeny Poberezkin	f53c1f5559	server: clear folders during initialization instead of deleting them (#572 )	2022-11-28 07:40:59 +00:00
sh	0942bf9f1e	readme: correction (#571 )	2022-11-26 20:10:46 +00:00
shandEvgeny Poberezkin	57fc190a91	readme: fix install steps (#570 ) * readme: fix install steps * correction Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>	2022-11-26 14:29:59 +00:00
Evgeny PoberezkinandJRoberts	43fb513ef7	initialize SMP server interactively, CLI options (#566 ) * initialize SMP server interactively, CLI options * correction Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com> * corrections Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>	2022-11-18 19:07:41 +00:00
Evgeny Poberezkin	fbccca9947	refactor server CLIs (#565 ) * refactor server CLIs * refactor	2022-11-18 08:37:03 +00:00
Evgeny Poberezkin	40000047af	server: refactor CLIs, tests (#564 ) * server: refactor CLIs, tests * add files, test * rename Executable -> Main	2022-11-17 19:43:01 +00:00
Evgeny Poberezkin	c2342cba05	FromJSON instance for ProtoServerWithAuth	2022-11-15 22:42:01 +00:00
Evgeny Poberezkin	f3b6ed4db0	agent API for SMP server test (#563 ) * agent API for SMP server test * add JSON encoding	2022-11-15 07:50:46 +00:00
Evgeny Poberezkin	95db734b2d	export BasicAuth constructor	2022-11-13 08:29:54 +00:00
Evgeny PoberezkinandJRoberts	e281efdcb8	server: SMP basic auth (#561 ) * server: SMP basic auth * update ini default * rfc, types * tests * update INI file * typo Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com> * refactor * update INI options, log new queue creation mode on start (on/off/requires auth) Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>	2022-11-12 22:29:36 +00:00
				`@@ -1 +0,0 @@`
				`smp-server configuration, certificate and fingerprint will be stored here`
				`@@ -1 +0,0 @@`
				`smp-server general logs, stored messages and statistics (if enabled) will be stored here`