3.1.0

* batch server commands in one transport block

* subscribe to multiple queues using batched commands

* agent method to subscribe to multiple queues using batched commands

* refactor

* test for batched subscriptions

* delete part of connections in batched test

* add resubscribeConnections

* remove comment

* update SMP protocol doc

CHANGELOG.md

@@ -1,3 +1,36 @@
+# 3.1.0
+
+SMP server and agent:
+
+- SMP protocol v4: batching multiple server commands/responses in a transport block.
+
+# 3.0.0
+
+SMP server:
+
+- restore undeliverd messages when the server is restarted.
+- SMP protocol v3 to support push notification:
+  - updated SEND and MSG to add message flags (for notification flag that contros whether the notification is sent and for any future extensions) and to move message meta-data sent to the recipient into the encrypted envelope.
+  - update NKEY and NID to add e2e encryption keys (for the notification meta-data encryption between SMP server and the client), and update NMSG to include this meta-data.
+  - update ACK command to include message ID (to avoid acknowledging unprocessed message).
+  - add NDEL commands to remove notification subscription credentials from SMP queue.
+  - add GET command to receive messages without subscription - to be used in iOS notification service extension to receive messages without terminating app subscriptions.
+
+SMP agent:
+
+- new protocol for duplex connection handshake reducing traffic and connection time.
+- support for SMP notifications server and managing device token.
+- remove redundant FQDN validation from TLS handshake to prepare for access via Tor.
+- support for fully stopping agent and for termporary suspending agent operations.
+- improve management of duplicate message delivery.
+
+SMP notifications server v1.0:
+
+- SMP notifications protocol with version negotiation during handshake.
+- device token registration and verification (via background notification).
+- SMP notification subscriptions and push notifications via APNS.
+- restoring notification subscriptions when the server is restarted.
+
 # 2.3.0
 
 SMP server:

apps/ntf-server/Main.hs

@@ -42,7 +42,7 @@ ntfServerCLIConfig =
           fingerprintFile = combine cfgPath "fingerprint",
           defaultServerPort = "443",
           executableName = "ntf-server",
-          serverVersion = "SMP notifications server v1.0.0-beta.3",
+          serverVersion = "SMP notifications server v1.1.0",
           mkIniFile = \enableStoreLog defaultServerPort ->
             "[STORE_LOG]\n\
             \# The server uses STM memory for persistence,\n\
@@ -69,7 +69,7 @@ ntfServerCLIConfig =
                 apnsConfig = defaultAPNSPushClientConfig,
                 inactiveClientExpiration = Nothing,
                 storeLogFile,
-                resubscribeDelay = 100000, -- 100ms
+                resubscribeDelay = 50000, -- 50ms
                 caCertificateFile = caCrtFile,
                 privateKeyFile = serverKeyFile,
                 certificateFile = serverCrtFile

apps/smp-server/Main.hs

@@ -60,9 +60,10 @@ smpServerCLIConfig =
             \# 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")
-              <> "# The messages are optionally saved and restored when the server restarts,\n\
-                 \# they are deleted after restarting.\n"
-              <> ("restore_messages: " <> (if enableStoreLog then "on" else "off") <> "\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: " <> (if enableStoreLog then "on" else "off") <> "\n")
+              <> ("log_stats: off\n\n")
               <> "[TRANSPORT]\n"
               <> ("port: " <> defaultServerPort <> "\n")
               <> "websockets: off\n\n"
@@ -72,37 +73,38 @@ smpServerCLIConfig =
               <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
               <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n"),
           mkServerConfig = \storeLogFile transports ini ->
-            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 =
-                  if lookupValue "INACTIVE_CLIENTS" "disconnect" ini == Right "on"
-                    then
-                      Just
-                        ExpirationConfig
+            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
-                          }
-                    else Nothing,
-                logStatsInterval = Just 86400, -- seconds
-                logStatsStartTime = 0, -- seconds from 00:00 UTC
-                smpServerVRange = supportedSMPServerVRange
-              }
+                          },
+                    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
+                  }
         }

package.yaml

@@ -1,5 +1,5 @@
 name: simplexmq
-version: 3.0.0
+version: 3.1.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -28,7 +28,7 @@ dependencies:
   - asn1-types == 0.3.*
   - async == 2.2.*
   - attoparsec == 0.14.*
-  - base >= 4.7 && < 5
+  - base >= 4.14 && < 5
   - base64-bytestring >= 1.0 && < 1.3
   - bytestring == 0.10.*
   - case-insensitive == 1.2.*

protocol/simplex-messaging.md

@@ -51,6 +51,8 @@ It's designed with the focus on communication security and integrity, under the
 
 It is designed as a low level protocol for other application protocols to solve the problem of secure and private message transmission, making [MITM attack][1] very difficult at any part of the message transmission system.
 
+This document describes SMP protocol versions 3 and 4, the previous versions are discontinued.
+
 ## Introduction
 
 The objective of Simplex Messaging Protocol (SMP) is to facilitate the secure and private unidirectional transfer of messages from senders to recipients via persistent simplex queues managed by the message broker (server).
@@ -147,61 +149,61 @@ To create and start using a simplex queue Alice and Bob follow these steps:
 
 1. Alice creates a simplex queue on the server:
 
-    1. Decides which SMP server to use (can be the same or different server that Alice uses for other queues) and opens secure encrypted transport connection to the chosen SMP server (see [Appendix A](#appendix-a)).
+   1. Decides which SMP server to use (can be the same or different server that Alice uses for other queues) and opens secure encrypted transport connection to the chosen SMP server (see [Appendix A](#appendix-a)).
 
-    2. Generates a new random public/private key pair (encryption key - `EK`) that she did not use before for Bob to encrypt the messages.
+   2. Generates a new random public/private key pair (encryption key - `EK`) that she did not use before for Bob to encrypt the messages.
 
-    3. Generates another new random public/private key pair (recipient key - `RK`) that she did not use before for her to sign commands and to decrypt the transmissions received from the server.
+   3. Generates another new random public/private key pair (recipient key - `RK`) that she did not use before for her to sign commands and to decrypt the transmissions received from the server.
 
-    4. Generates one more random key pair (recipient DH key - `RDHK`) to negotiate symmetric key that will be used by the server to encrypt message bodies delivered to Alice (to avoid shared cipher-text inside transport connection).
+   4. Generates one more random key pair (recipient DH key - `RDHK`) to negotiate symmetric key that will be used by the server to encrypt message bodies delivered to Alice (to avoid shared cipher-text inside transport connection).
 
-    5. Sends `"NEW"` command to the server to create a simplex queue (see `create` in [Create queue command](#create-queue-command)). This command contains previously generated unique "public" keys `RK` and `RDHK`. `RK` will be used to verify the following commands related to the same queue signed by its private counterpart, for example to subscribe to the messages received to this queue or to update the queue, e.g. by setting the key required to send the messages (initially Alice creates the queue that accepts unsigned messages, so anybody could send the message via this queue if they knew the queue sender's ID and server address).
+   5. Sends `"NEW"` command to the server to create a simplex queue (see `create` in [Create queue command](#create-queue-command)). This command contains previously generated unique "public" keys `RK` and `RDHK`. `RK` will be used to verify the following commands related to the same queue signed by its private counterpart, for example to subscribe to the messages received to this queue or to update the queue, e.g. by setting the key required to send the messages (initially Alice creates the queue that accepts unsigned messages, so anybody could send the message via this queue if they knew the queue sender's ID and server address).
 
-    6. The server sends `"IDS"` response with queue IDs (`queueIds`):
+   6. The server sends `"IDS"` response with queue IDs (`queueIds`):
 
-        - Recipient ID `RID` for Alice to manage the queue and to receive the messages.
+      - Recipient ID `RID` for Alice to manage the queue and to receive the messages.
 
-        - Sender ID `SID` for Bob to send messages to the queue.
+      - Sender ID `SID` for Bob to send messages to the queue.
 
-        - Server public DH key (`SDHK`) to negotiate a shared secret for message body encryption, that Alice uses to derive a shared secret with the server `SS`.
+      - Server public DH key (`SDHK`) to negotiate a shared secret for message body encryption, that Alice uses to derive a shared secret with the server `SS`.
 
 2. Alice sends an out-of-band message to Bob via the alternative channel that both Alice and Bob trust (see [protocol abstract](#simplex-messaging-protocol-abstract)). The message must include:
 
-    - Unique "public" key (`EK`) that Bob must use for E2E key agreement.
+   - Unique "public" key (`EK`) that Bob must use for E2E key agreement.
 
-    - SMP server hostname and information to open secure encrypted transport connection (see [Appendix A](#appendix-a)).
+   - SMP server hostname and information to open secure encrypted transport connection (see [Appendix A](#appendix-a)).
 
-    - Sender queue ID `SID` for Bob to use.
+   - Sender queue ID `SID` for Bob to use.
 
 3. Bob, having received the out-of-band message from Alice, connects to the queue:
 
-    1. Generates a new random public/private key pair (sender key - `SK`) that he did not use before for him to sign messages sent to Alice's server.
+   1. Generates a new random public/private key pair (sender key - `SK`) that he did not use before for him to sign messages sent to Alice's server.
 
-    2. Prepares the confirmation message for Alice to secure the queue. This message includes:
+   2. Prepares the confirmation message for Alice to secure the queue. This message includes:
 
-        - Previously generated "public" key `SK` that will be used by Alice's server to authenticate Bob's messages, once the queue is secured.
+      - Previously generated "public" key `SK` that will be used by Alice's server to authenticate Bob's messages, once the queue is secured.
 
-        - Optionally, any additional information (application specific, e.g. Bob's profile name and details).
+      - Optionally, any additional information (application specific, e.g. Bob's profile name and details).
 
-    3. Encrypts the confirmation body with the "public" key `EK` (that Alice provided via the out-of-band message).
+   3. Encrypts the confirmation body with the "public" key `EK` (that Alice provided via the out-of-band message).
 
-    4. Sends the encrypted message to the server with queue ID `SID` (see `send` in [Send message](#send-message)). This initial message to the queue must not be signed - signed messages will be rejected until Alice secures the queue (below).
+   4. Sends the encrypted message to the server with queue ID `SID` (see `send` in [Send message](#send-message)). This initial message to the queue must not be signed - signed messages will be rejected until Alice secures the queue (below).
 
 4. Alice receives Bob's message from the server using recipient queue ID `RID` (possibly, via the same transport connection she already has opened - see `message` in [Deliver queue message](#deliver-queue-message)):
 
-    1. She decrypts received message body using the secret `SS`.
+   1. She decrypts received message body using the secret `SS`.
 
-    2. She decrypts received message with [key agreed with sender using] "private" key `EK`.
+   2. She decrypts received message with [key agreed with sender using] "private" key `EK`.
 
-    3. Even though anybody could have sent the message to the queue with ID `SID` before it is secured (e.g. if communication is compromised), Alice would ignore all messages until the decryption succeeds (i.e. the result contains the expected message format). Optionally, in the client application, she also may identify Bob using the information provided, but it is out of scope of SMP protocol.
+   3. Even though anybody could have sent the message to the queue with ID `SID` before it is secured (e.g. if communication is compromised), Alice would ignore all messages until the decryption succeeds (i.e. the result contains the expected message format). Optionally, in the client application, she also may identify Bob using the information provided, but it is out of scope of SMP protocol.
 
 5. Alice secures the queue `RID` with `"KEY"` command so only Bob can send messages to it (see [Secure queue command](#secure-queue-command)):
 
-    1. She sends the `KEY` command with `RID` signed with "private" key `RK` to update the queue to only accept requests signed by "private" key `SK` provided by Bob. This command contains unique "public" key `SK` previously generated by Bob.
+   1. She sends the `KEY` command with `RID` signed with "private" key `RK` to update the queue to only accept requests signed by "private" key `SK` provided by Bob. This command contains unique "public" key `SK` previously generated by Bob.
 
-    2. From this moment the server will accept only signed commands to `SID`, so only Bob will be able to send messages to the queue `SID` (corresponding to `RID` that Alice has).
+   2. From this moment the server will accept only signed commands to `SID`, so only Bob will be able to send messages to the queue `SID` (corresponding to `RID` that Alice has).
 
-    3. Once queue is secured, Alice deletes `SID` and `SK` - even if Alice's client is compromised in the future, the attacker would not be able to send messages pretending to be Bob.
+   3. Once queue is secured, Alice deletes `SID` and `SK` - even if Alice's client is compromised in the future, the attacker would not be able to send messages pretending to be Bob.
 
 6. The simplex queue `RID` is now ready to be used.
 
@@ -215,21 +217,21 @@ Bob now can securely send messages to Alice:
 
 1. Bob sends the message:
 
-    1. He encrypts the message to Alice with "public" key `EK` (provided by Alice, only known to Bob, used only for one simplex queue).
+   1. He encrypts the message to Alice with "public" key `EK` (provided by Alice, only known to Bob, used only for one simplex queue).
 
-    2. He signs `"SEND"` command to the server queue `SID` using the "private" key `SK` (that only he knows, used only for this queue).
+   2. He signs `"SEND"` command to the server queue `SID` using the "private" key `SK` (that only he knows, used only for this queue).
 
-    3. He sends the command to the server (see `send` in [Send message](#send-message)), that the server will authenticate using the "public" key `SK` (that Alice earlier received from Bob and provided to the server via `"KEY"` command).
+   3. He sends the command to the server (see `send` in [Send message](#send-message)), that the server will authenticate using the "public" key `SK` (that Alice earlier received from Bob and provided to the server via `"KEY"` command).
 
 2. Alice receives the message(s):
 
-    1. She signs `"SUB"` command to the server to subscribe to the queue `RID` with the "private" key `RK` (see `subscribe` in [Subscribe to queue](#subscribe-to-queue)).
+   1. She signs `"SUB"` command to the server to subscribe to the queue `RID` with the "private" key `RK` (see `subscribe` in [Subscribe to queue](#subscribe-to-queue)).
 
-    2. The server, having authenticated Alice's command with the "public" key `RK` that she provided, delivers Bob's message(s) (see `message` in [Deliver queue message](#deliver-queue-message)).
+   2. The server, having authenticated Alice's command with the "public" key `RK` that she provided, delivers Bob's message(s) (see `message` in [Deliver queue message](#deliver-queue-message)).
 
-    3. She decrypts Bob's message(s) with the "private" key `EK` (that only she has).
+   3. She decrypts Bob's message(s) with the "private" key `EK` (that only she has).
 
-    4. She acknowledges the message reception to the server with `"ACK"` so that the server can delete the message and deliver the next messages.
+   4. She acknowledges the message reception to the server with `"ACK"` so that the server can delete the message and deliver the next messages.
 
 This flow is show on sequence diagram below.
 
@@ -360,15 +362,18 @@ The clients can optionally instruct a dedicated push notification server to subs
 - `subscribeNotifications` (`"NSUB"`) - see [Subscribe to queue notifications](#subscribe-to-queue-notifications).
 - `messageNotification` (`"NMSG"`) - see [Deliver message notification](#deliver-message-notification).
 
-## SMP Transmission structure
+[`SEND` command](#send-message) includes the notification flag to instruct SMP server whether to send the notification - this flag is forwarded to the recepient inside encrypted envelope, together with the timestamp and the message body, so even if TLS is compromised this flag cannot be used for traffic correlation.
+
+## SMP Transmission andtransport block structure
 
 Each transport block (SMP transmission) has a fixed size of 16384 bytes for traffic uniformity.
 
+From SMP version 4 each block can contain multiple transmissions, version 3 blocks have 1 transmission.
 Some parts of SMP transmission are padded to a fixed size; this padding is uniformly added as a word16 encoded in network byte order - see `paddedString` syntax.
 
 In places where some part of the transmission should be padded, the syntax for `paddedNotation` is used:
 
-```
+```abnf
 paddedString = originalLength string pad
 originalLength = 2*2 OCTET
 pad = N*N"#" ; where N = paddedLength - originalLength - 2
@@ -378,9 +383,9 @@ paddedNotation = <padded(string, paddedLength)>
 ; paddedLength - required length after padding, including 2 bytes for originalLength
 ```
 
-Each transmission between the client and the server must have this format/syntax:
+Each transmission/block for SMP v3 between the client and the server must have this format/syntax:
 
-```
+```abnf
 paddedTransmission = <padded(transmission), 16384>
 transmission = [signature] SP signed
 signed = sessionIdentifier SP [corrId] SP [queueId] SP smpCommand
@@ -397,6 +402,16 @@ encoded = <base64 encoded binary>
 
 `base64` encoding should be used with padding, as defined in section 4 of [RFC 4648][9]
 
+Transport block for SMP v4 has this syntax:
+
+```abnf
+paddedTransportBlock = <padded(transportBlock), 16384>
+transportBlock = transmissionCount transmissions
+transmissionCount = 1*1 OCTET ; equal or greater than 1
+transmissions = transmissionLength transmission [transmissions]
+transmissionLength = 2*2 OCTET ; word16 encoded in network byte order
+```
+
 ## SMP commands
 
 Commands syntax below is provided using [ABNF][8] with [case-sensitive strings extension][8a].
@@ -587,7 +602,9 @@ Currently SMP defines only one command that can be used by senders - `send` mess
 This command is sent to the server by the sender both to confirm the queue after the sender received out-of-band message from the recipient and to send messages after the queue is secured:
 
 ```abnf
-send = %s"SEND " smpEncMessage
+send = %s"SEND " msgFlags SP smpEncMessage
+msgFlags = notificationFlag reserved
+notificationFlag = %s"T" / %s"F"
 smpEncMessage = smpPubHeader sentMsgBody ; message up to 16088 bytes
 smpPubHeader = smpClientVersion ("1" senderPublicDhKey / "0")
 smpClientVersion = word16
@@ -729,9 +746,11 @@ See its syntax in [Create queue command](#create-queue-command)
 The server must deliver messages to all subscribed simplex queues on the currently open transport connection. The syntax for the message delivery is:
 
 ```abnf
-message = %s"MSG " msgId SP timestamp SP encryptedMsgBody
+message = %s"MSG " msgId encryptedRcvMsgBody
 encryptedMsgBody = <encrypt paddedSentMsgBody> ; server-encrypted padded sent msgBody
 paddedSentMsgBody = <padded(sentMsgBody, maxMessageLength + 2)> ; maxMessageLength = 16088
+encryptedRcvMsgBody = <encrypt rcvMsgBody> ; server-encrypted meta-data and padded sent msgBody
+rcvMsgBody = timestamp msgFlags SP paddedSentMsgBody
 msgId = length 24*24OCTET
 timestamp = 8*8OCTET
 ```
@@ -823,6 +842,7 @@ ok = %s"OK"
 Both the recipient and the sender can use TCP or some other, possibly higher level, transport protocol to communicate with the server. The default TCP port for SMP server is 5223.
 
 For scenarios when meta-data privacy is critical, it is recommended that clients:
+
 - communicating over Tor network,
 - establish a separate connection for each SMP queue,
 - send noise traffic (using PING command).
@@ -830,12 +850,14 @@ For scenarios when meta-data privacy is critical, it is recommended that clients
 In addition to that, the servers can be deployed as Tor onion services.
 
 The transport protocol should provide the following:
+
 - server authentication (by matching server certificate hash with `serverIdentity`),
 - forward secrecy (by encrypting the traffic using ephemeral keys agreed during transport handshake),
 - integrity (preventing data modification by the attacker without detection),
 - unique channel binding (`sessionIdentifier`) to include in the signed part of SMP transmissions.
 
 By default, the client and server communicate using [TLS 1.3 protocol][13] restricted to:
+
 - TLS_CHACHA20_POLY1305_SHA256 cipher suite (for better performance on mobile devices),
 - ed25519 and ed448 EdDSA algorithms for signatures,
 - x25519 and x448 ECDHE groups for key exchange.

scripts/ntf-server-linode.sh

@@ -1,8 +1,8 @@
 #!/bin/bash
 
+# <UDF name="enable_store_log" label="Store log - persist notification subscriptions to append only log and restore them upon server restart." default="on" oneof="on, off" />
 # <UDF name="api_token" label="Linode API token - enable Linode to create tags with server address, fingerprint and version. Note: minimal permissions token should have are read/write access to `linodes` (to create tags) and `domains` (to add A record for the third level domain if FQDN is provided)." default="" />
-# TODO review
-# <UDF name="fqdn" label="FQDN (Fully Qualified Domain Name) - provide third level domain name (e.g. smp.example.com). If provided use `smp://fingerprint@FQDN` as server address in the client. If FQDN is not provided use `smp://fingerprint@IP` instead." default="" />
+# <UDF name="fqdn" label="FQDN (Fully Qualified Domain Name) - provide third level domain name (e.g. ntf.example.com). If provided use `ntf://fingerprint@FQDN` as server address in the client. If FQDN is not provided use `ntf://fingerprint@IP` instead." default="" />
 # <UDF name="apns_key_id" label="APNS key ID." default="" />
 
 # Log all stdout output to stackscript.log
@@ -74,6 +74,8 @@ ntf-server --version
 # Initialize server
 init_opts=()
 
+[[ $ENABLE_STORE_LOG == "on" ]] && init_opts+=(-l)
+
 ip_address=$(curl ifconfig.me)
 init_opts+=(--ip $ip_address)
 
@@ -85,10 +87,6 @@ ntf-server init "${init_opts[@]}"
 fingerprint=$(cat /etc/opt/simplex-notifications/fingerprint)
 
 # Determine server address to specify in welcome script and Linode tag
-# ! If FQDN was provided and used as part of server initialization, server's certificate will not pass validation at client
-# ! if client tries to connect by server's IP address, so we have to specify FQDN as server address in Linode tag and
-# ! in welcome script regardless of creation of A record in Linode
-# ! https://hackage.haskell.org/package/x509-validation-1.6.10/docs/src/Data-X509-Validation.html#validateCertificateName
 if [[ -n "$FQDN" ]]; then
   server_address=$FQDN
 else
@@ -98,7 +96,6 @@ fi
 # Set up welcome script
 on_login_script="/opt/simplex-notifications/on_login.sh"
 
-# TODO fix address
 # / Welcome script
 cat > $on_login_script << EOF
 #!/bin/bash
@@ -109,7 +106,7 @@ server_address=\$2
 cat << EOF2
 ********************************************************************************
 
-SimpleX notifications server address: smp://\$fingerprint@\$server_address
+SimpleX notifications server address: ntf://\$fingerprint@\$server_address
 Check server status with: systemctl status ntf-server
 
 To keep this server secure, the UFW firewall is enabled.

scripts/smp-server-linode.sh

@@ -86,10 +86,6 @@ smp-server init "${init_opts[@]}"
 fingerprint=$(cat /etc/opt/simplex/fingerprint)
 
 # Determine server address to specify in welcome script and Linode tag
-# ! If FQDN was provided and used as part of server initialization, server's certificate will not pass validation at client
-# ! if client tries to connect by server's IP address, so we have to specify FQDN as server address in Linode tag and
-# ! in welcome script regardless of creation of A record in Linode
-# ! https://hackage.haskell.org/package/x509-validation-1.6.10/docs/src/Data-X509-Validation.html#validateCertificateName
 if [[ -n "$FQDN" ]]; then
   server_address=$FQDN
 else

simplexmq.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        3.0.0
+version:        3.1.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -75,6 +75,7 @@ library
       Simplex.Messaging.Server.MsgStore.STM
       Simplex.Messaging.Server.QueueStore
       Simplex.Messaging.Server.QueueStore.STM
+      Simplex.Messaging.Server.Stats
       Simplex.Messaging.Server.StoreLog
       Simplex.Messaging.TMap
       Simplex.Messaging.Transport
@@ -100,7 +101,7 @@ library
     , asn1-types ==0.3.*
     , async ==2.2.*
     , attoparsec ==0.14.*
-    , base >=4.7 && <5
+    , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
     , case-insensitive ==1.2.*
@@ -160,7 +161,7 @@ executable ntf-server
     , asn1-types ==0.3.*
     , async ==2.2.*
     , attoparsec ==0.14.*
-    , base >=4.7 && <5
+    , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
     , case-insensitive ==1.2.*
@@ -221,7 +222,7 @@ executable smp-agent
     , asn1-types ==0.3.*
     , async ==2.2.*
     , attoparsec ==0.14.*
-    , base >=4.7 && <5
+    , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
     , case-insensitive ==1.2.*
@@ -282,7 +283,7 @@ executable smp-server
     , asn1-types ==0.3.*
     , async ==2.2.*
     , attoparsec ==0.14.*
-    , base >=4.7 && <5
+    , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
     , case-insensitive ==1.2.*
@@ -360,7 +361,7 @@ test-suite smp-server-test
     , asn1-types ==0.3.*
     , async ==2.2.*
     , attoparsec ==0.14.*
-    , base >=4.7 && <5
+    , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
     , case-insensitive ==1.2.*

src/Simplex/Messaging/Agent.hs

@@ -12,6 +12,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- |
 -- Module      : Simplex.Messaging.Agent
@@ -44,9 +45,11 @@ module Simplex.Messaging.Agent
     acceptContact,
     rejectContact,
     subscribeConnection,
+    subscribeConnections,
     getConnectionMessage,
     getNotificationMessage,
     resubscribeConnection,
+    resubscribeConnections,
     sendMessage,
     ackMessage,
     suspendConnection,
@@ -58,6 +61,7 @@ module Simplex.Messaging.Agent
     checkNtfToken,
     deleteNtfToken,
     getNtfToken,
+    getNtfTokenData,
     deleteNtfSub,
     activateAgent,
     suspendAgent,
@@ -77,6 +81,7 @@ import Data.Composition ((.:), (.:.))
 import Data.Functor (($>))
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
+import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (isJust)
 import qualified Data.Text as T
@@ -100,13 +105,13 @@ import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfReg
 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, SMPMsgMeta)
+import Simplex.Messaging.Protocol (BrokerMsg, ErrorType (AUTH), MsgBody, MsgFlags, NtfServer, SMPMsgMeta)
 import qualified Simplex.Messaging.Protocol as SMP
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (bshow, eitherToMaybe, liftE, liftError, tryError, unlessM, whenM, ($>>=))
+import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Random (randomR)
-import UnliftIO.Async (async, race_)
+import UnliftIO.Async (async, mapConcurrently, race_)
 import UnliftIO.Concurrent (forkFinally, forkIO, threadDelay)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -156,6 +161,10 @@ rejectContact c = withAgentEnv c .: rejectContact' c
 subscribeConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
 subscribeConnection c = withAgentEnv c . subscribeConnection' c
 
+-- | Subscribe to receive connection messages from multiple connections, batching commands when possible
+subscribeConnections :: AgentErrorMonad m => AgentClient -> [ConnId] -> m (Map ConnId (Either AgentErrorType ()))
+subscribeConnections c = withAgentEnv c . subscribeConnections' c
+
 -- | Get connection message (GET command)
 getConnectionMessage :: AgentErrorMonad m => AgentClient -> ConnId -> m (Maybe SMPMsgMeta)
 getConnectionMessage c = withAgentEnv c . getConnectionMessage' c
@@ -167,6 +176,9 @@ getNotificationMessage c = withAgentEnv c .: getNotificationMessage' c
 resubscribeConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
 resubscribeConnection c = withAgentEnv c . resubscribeConnection' c
 
+resubscribeConnections :: AgentErrorMonad m => AgentClient -> [ConnId] -> m (Map ConnId (Either AgentErrorType ()))
+resubscribeConnections c = withAgentEnv c . resubscribeConnections' c
+
 -- | Send message to the connection (SEND command)
 sendMessage :: AgentErrorMonad m => AgentClient -> ConnId -> MsgFlags -> MsgBody -> m AgentMsgId
 sendMessage c = withAgentEnv c .:. sendMessage' c
@@ -206,6 +218,9 @@ deleteNtfToken c = withAgentEnv c . deleteNtfToken' c
 getNtfToken :: AgentErrorMonad m => AgentClient -> m (DeviceToken, NtfTknStatus, NotificationsMode)
 getNtfToken c = withAgentEnv c $ getNtfToken' c
 
+getNtfTokenData :: AgentErrorMonad m => AgentClient -> m NtfToken
+getNtfTokenData c = withAgentEnv c $ getNtfTokenData' c
+
 -- | Delete notification subscription for connection
 deleteNtfSub :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
 deleteNtfSub c = withAgentEnv c . deleteNtfSub' c
@@ -388,12 +403,62 @@ subscribeConnection' c connId =
       ns <- asks ntfSupervisor
       atomically $ sendNtfSubCommand ns (connId, NSCCreate)
 
+subscribeConnections' :: forall m. AgentMonad m => AgentClient -> [ConnId] -> m (Map ConnId (Either AgentErrorType ()))
+subscribeConnections' _ [] = pure M.empty
+subscribeConnections' c connIds = do
+  conns :: Map ConnId (Either StoreError SomeConn) <- M.fromList . zip connIds <$> withStore' c (forM connIds . getConn)
+  let (errs, cs) = M.mapEither id conns
+      errs' = M.map (Left . storeError) errs
+      (sndQs, rcvQs) = M.mapEither rcvOrSndQueue cs
+      sndRs = M.map (sndSubResult . fst) sndQs
+      srvRcvQs :: Map SMPServer (Map ConnId (RcvQueue, ConnData)) = M.foldlWithKey' addRcvQueue M.empty rcvQs
+  mapM_ (mapM_ (uncurry $ resumeMsgDelivery c) . sndQueue) cs
+  rcvRs <- mapConcurrently subscribe (M.assocs srvRcvQs)
+  let rs = M.unions $ errs' : sndRs : rcvRs
+  notifyResultError rs
+  pure rs
+  where
+    rcvOrSndQueue :: SomeConn -> Either (SndQueue, ConnData) (RcvQueue, ConnData)
+    rcvOrSndQueue = \case
+      SomeConn _ (DuplexConnection cData rq _) -> Right (rq, cData)
+      SomeConn _ (SndConnection cData sq) -> Left (sq, cData)
+      SomeConn _ (RcvConnection cData rq) -> Right (rq, cData)
+      SomeConn _ (ContactConnection cData rq) -> Right (rq, cData)
+    sndSubResult :: SndQueue -> Either AgentErrorType ()
+    sndSubResult sq = case status (sq :: SndQueue) of
+      Confirmed -> Right ()
+      Active -> Left $ CONN SIMPLEX
+      _ -> Left $ INTERNAL "unexpected queue status"
+    addRcvQueue :: Map SMPServer (Map ConnId (RcvQueue, ConnData)) -> ConnId -> (RcvQueue, ConnData) -> Map SMPServer (Map ConnId (RcvQueue, ConnData))
+    addRcvQueue m connId rq@(RcvQueue {server}, _) = M.alter (Just . maybe (M.singleton connId rq) (M.insert connId rq)) server m
+    subscribe :: (SMPServer, Map ConnId (RcvQueue, ConnData)) -> m (Map ConnId (Either AgentErrorType ()))
+    subscribe (srv, qs) = subscribeQueues c srv (M.map fst qs)
+    sndQueue :: SomeConn -> Maybe (ConnData, SndQueue)
+    sndQueue = \case
+      SomeConn _ (DuplexConnection cData _ sq) -> Just (cData, sq)
+      SomeConn _ (SndConnection cData sq) -> Just (cData, sq)
+      _ -> Nothing
+    notifyResultError :: Map ConnId (Either AgentErrorType ()) -> m ()
+    notifyResultError rs = do
+      let actual = M.size rs
+          expected = length connIds
+      when (actual /= expected) . atomically $
+        writeTBQueue (subQ c) ("", "", ERR . INTERNAL $ "subscribeConnections result size: " <> show actual <> ", expected " <> show expected)
+
 resubscribeConnection' :: AgentMonad m => AgentClient -> ConnId -> m ()
 resubscribeConnection' c connId =
   unlessM
     (atomically $ hasActiveSubscription c connId)
     (subscribeConnection' c connId)
 
+resubscribeConnections' :: forall m. AgentMonad m => AgentClient -> [ConnId] -> m (Map ConnId (Either AgentErrorType ()))
+resubscribeConnections' _ [] = pure M.empty
+resubscribeConnections' c connIds = do
+  let r = M.fromList . zip connIds . repeat $ Right ()
+  connIds' <- filterM (fmap not . atomically . hasActiveSubscription c) connIds
+  -- union is left-biased, so results returned by subscribeConnections' take precedence
+  (`M.union` r) <$> subscribeConnections' c connIds'
+
 getConnectionMessage' :: AgentMonad m => AgentClient -> ConnId -> m (Maybe SMPMsgMeta)
 getConnectionMessage' c connId = do
   whenM (atomically $ hasActiveSubscription c connId) . throwError $ CMD PROHIBITED
@@ -637,8 +702,7 @@ deleteConnection' c connId =
 
 -- | Change servers to be used for creating new queues, in Reader monad
 setSMPServers' :: AgentMonad m => AgentClient -> NonEmpty SMPServer -> m ()
-setSMPServers' c servers = do
-  atomically $ writeTVar (smpServers c) servers
+setSMPServers' c = atomically . writeTVar (smpServers c)
 
 registerNtfToken' :: forall m. AgentMonad m => AgentClient -> DeviceToken -> NotificationsMode -> m NtfTknStatus
 registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
@@ -745,6 +809,12 @@ getNtfToken' c =
     Just NtfToken {deviceToken, ntfTknStatus, ntfMode} -> pure (deviceToken, ntfTknStatus, ntfMode)
     _ -> throwError $ CMD PROHIBITED
 
+getNtfTokenData' :: AgentMonad m => AgentClient -> m NtfToken
+getNtfTokenData' c =
+  withStore' c getSavedNtfToken >>= \case
+    Just tkn -> pure tkn
+    _ -> throwError $ CMD PROHIBITED
+
 -- | Delete notification subscription for connection, in Reader monad
 deleteNtfSub' :: AgentMonad m => AgentClient -> ConnId -> m ()
 deleteNtfSub' _c connId = do
@@ -805,17 +875,18 @@ setNtfServers' :: AgentMonad m => AgentClient -> [NtfServer] -> m ()
 setNtfServers' c = atomically . writeTVar (ntfServers c)
 
 activateAgent' :: AgentMonad m => AgentClient -> m ()
-activateAgent' c = atomically $ do
-  writeTVar (agentState c) ASActive
-  activate databaseOp
-  activate sndNetworkOp
-  activate msgDeliveryOp
-  activate rcvNetworkOp
-  activate ntfNetworkOp
+activateAgent' c = do
+  atomically $ writeTVar (agentState c) ASActive
+  mapM_ activate $ reverse agentOperations
   where
-    activate opSel = modifyTVar' (opSel c) $ \s -> s {opSuspended = False}
+    activate opSel = atomically $ modifyTVar' (opSel c) $ \s -> s {opSuspended = False}
 
 suspendAgent' :: AgentMonad m => AgentClient -> Int -> m ()
+suspendAgent' c 0 = do
+  atomically $ writeTVar (agentState c) ASSuspended
+  mapM_ suspend agentOperations
+  where
+    suspend opSel = atomically $ modifyTVar' (opSel c) $ \s -> s {opSuspended = True}
 suspendAgent' c@AgentClient {agentState = as} maxDelay = do
   state <-
     atomically $ do
@@ -851,7 +922,7 @@ subscriber c@AgentClient {msgQ} = forever $ do
       Right _ -> return ()
 
 processSMPTransmission :: forall m. AgentMonad m => AgentClient -> ServerTransmission BrokerMsg -> m ()
-processSMPTransmission c@AgentClient {smpClients, subQ} (srv, sessId, rId, cmd) =
+processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cmd) =
   withStore c (\db -> getRcvConn db srv rId) >>= \case
     SomeConn _ conn@(DuplexConnection cData rq _) -> processSMP conn cData rq
     SomeConn _ conn@(RcvConnection cData rq) -> processSMP conn cData rq
@@ -859,10 +930,10 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, sessId, rId, cmd)
     _ -> atomically $ writeTBQueue subQ ("", "", ERR $ CONN NOT_FOUND)
   where
     processSMP :: Connection c -> ConnData -> RcvQueue -> m ()
-    processSMP conn cData@ConnData {connId, duplexHandshake} rq@RcvQueue {rcvDhSecret, e2ePrivKey, e2eDhSecret, status} =
+    processSMP conn cData@ConnData {connId, duplexHandshake} rq@RcvQueue {e2ePrivKey, e2eDhSecret, status} =
       case cmd of
-        SMP.MSG srvMsgId srvTs msgFlags msgBody' -> handleNotifyAck $ do
-          msgBody <- agentCbDecrypt rcvDhSecret (C.cbNonce srvMsgId) msgBody'
+        SMP.MSG msg@SMP.RcvMessage {msgId = srvMsgId} -> handleNotifyAck $ do
+          SMP.ClientRcvMsgBody {msgTs = srvTs, msgFlags, msgBody} <- decryptSMPMessage v rq msg
           clientMsg@SMP.ClientMsgEnvelope {cmHeader = SMP.PubHeader phVer e2ePubKey_} <-
             parseMessage msgBody
           unless (phVer `isCompatible` SMP.smpClientVRange) . throwError $ AGENT A_VERSION

src/Simplex/Messaging/Agent/Client.hs

@@ -11,6 +11,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Agent.Client
@@ -20,7 +21,9 @@ module Simplex.Messaging.Agent.Client
     closeAgentClient,
     newRcvQueue,
     subscribeQueue,
+    subscribeQueues,
     getQueueMessage,
+    decryptSMPMessage,
     addSubscription,
     getSubscriptions,
     sendConfirmation,
@@ -52,6 +55,7 @@ module Simplex.Messaging.Agent.Client
     AgentOperation (..),
     AgentOpState (..),
     AgentState (..),
+    agentOperations,
     agentOperationBracket,
     beginAgentOperation,
     endAgentOperation,
@@ -61,6 +65,7 @@ module Simplex.Messaging.Agent.Client
     whenSuspending,
     withStore,
     withStore',
+    storeError,
   )
 where
 
@@ -71,19 +76,21 @@ import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
-import Data.Bifunctor (first)
+import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Either (partitionEithers)
 import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes)
+import Data.Maybe (listToMaybe)
 import Data.Set (Set)
 import Data.Text.Encoding
+import Data.Tuple (swap)
 import Data.Word (Word16)
 import qualified Database.SQLite.Simple as DB
--- import GHC.Conc (unsafeIOToSTM)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
@@ -96,14 +103,15 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Client
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Protocol (BrokerMsg, ErrorType, MsgFlags (..), MsgId, NotifierId, NtfPrivateSignKey, NtfPublicVerifyKey, ProtocolServer (..), QueueId, QueueIdsKeys (..), RcvNtfPublicDhKey, SMPMsgMeta, SndPublicVerifyKey)
+import Simplex.Messaging.Parsers (parse)
+import Simplex.Messaging.Protocol (BrokerMsg, ErrorType, MsgFlags (..), MsgId, NotifierId, NtfPrivateSignKey, NtfPublicVerifyKey, NtfServer, ProtoServer, ProtocolServer (..), QueueId, QueueIdsKeys (..), RcvMessage (..), RcvNtfPublicDhKey, SMPMsgMeta (..), SndPublicVerifyKey)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (bshow, catchAll_, ifM, liftEitherError, liftError, tryError, unlessM, whenM)
+import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Timeout (timeout)
-import UnliftIO (async, pooledForConcurrentlyN)
+import UnliftIO (async)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
@@ -153,6 +161,9 @@ agentOpSel = \case
   AOSndNetwork -> sndNetworkOp
   AODatabase -> databaseOp
 
+agentOperations :: [AgentClient -> TVar AgentOpState]
+agentOperations = [ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp]
+
 data AgentOpState = AgentOpState {opSuspended :: Bool, opsInProgress :: Int}
 
 data AgentState = ASActive | ASSuspending | ASSuspended
@@ -192,7 +203,7 @@ agentDbPath :: AgentClient -> FilePath
 agentDbPath AgentClient {agentEnv = Env {store = SQLiteStore {dbFilePath}}} = dbFilePath
 
 class ProtocolServerClient msg where
-  getProtocolServerClient :: AgentMonad m => AgentClient -> ProtocolServer -> m (ProtocolClient msg)
+  getProtocolServerClient :: AgentMonad m => AgentClient -> ProtoServer msg -> m (ProtocolClient msg)
   clientProtocolError :: ErrorType -> AgentErrorType
 
 instance ProtocolServerClient BrokerMsg where
@@ -259,34 +270,18 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} srv = do
         reconnectClient `catchError` const loop
 
     reconnectClient :: m ()
-    reconnectClient = do
-      n <- asks $ resubscriptionConcurrency . config
-      withAgentLock c . withClient c srv $ \smp -> do
-        cs <- atomically $ mapM readTVar =<< TM.lookup srv (pendingSubscrSrvrs c)
-        -- TODO if any of the subscriptions fails here (e.g. because of timeout), it terminates the whole process for all subscriptions
-        -- instead it should only report successful subscriptions and schedule the next call to reconnectClient to subscribe for the remaining subscriptions
-        -- this way, for each DOWN event there can be several UP events
-        conns <- pooledForConcurrentlyN n (maybe [] M.toList cs) $ \sub@(connId, _) ->
-          ifM
-            (atomically $ hasActiveSubscription c connId)
-            (pure $ Just connId)
-            (subscribe_ smp sub `catchError` handleError connId)
-        liftIO . unless (null conns) . notifySub "" . UP srv $ catMaybes conns
+    reconnectClient =
+      withAgentLock c $
+        atomically (TM.lookup srv (pendingSubscrSrvrs c) >>= mapM readTVar)
+          >>= mapM_ resubscribe
       where
-        subscribe_ :: SMPClient -> (ConnId, RcvQueue) -> ExceptT ProtocolClientError IO (Maybe ConnId)
-        subscribe_ smp (connId, rq@RcvQueue {rcvPrivateKey, rcvId}) = do
-          subscribeSMPQueue smp rcvPrivateKey rcvId
-          addSubscription c rq connId
-          pure $ Just connId
-
-        handleError :: ConnId -> ProtocolClientError -> ExceptT ProtocolClientError IO (Maybe ConnId)
-        handleError connId = \case
-          e@PCEResponseTimeout -> throwError e
-          e@PCENetworkError -> throwError e
-          e -> do
-            liftIO . notifySub connId . ERR $ protocolClientError SMP e
-            atomically $ removePendingSubscription c srv connId
-            pure Nothing
+        resubscribe :: Map ConnId RcvQueue -> m ()
+        resubscribe qs = do
+          (errs, oks) <- M.mapEither id <$> subscribeQueues c srv qs
+          liftIO . unless (M.null oks) . notifySub "" . UP srv $ M.keys oks
+          let (tempErrs, finalErrs) = M.partition temporaryAgentError errs
+          liftIO . mapM_ (\(connId, e) -> notifySub connId $ ERR e) $ M.assocs finalErrs
+          mapM_ throwError . listToMaybe $ M.elems tempErrs
 
     notifySub :: ConnId -> ACommand 'Agent -> IO ()
     notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, cmd)
@@ -309,7 +304,7 @@ getNtfServerClient c@AgentClient {active, ntfClients} srv = do
       atomically $ TM.delete srv ntfClients
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
-getClientVar :: forall a. ProtocolServer -> TMap ProtocolServer (TMVar a) -> STM (Either (TMVar a) (TMVar a))
+getClientVar :: forall a s. ProtocolServer s -> TMap (ProtocolServer s) (TMVar a) -> STM (Either (TMVar a) (TMVar a))
 getClientVar srv clients = maybe (Left <$> newClientVar) (pure . Right) =<< TM.lookup srv clients
   where
     newClientVar :: STM (TMVar a)
@@ -331,8 +326,8 @@ newProtocolClient ::
   forall msg m.
   AgentMonad m =>
   AgentClient ->
-  ProtocolServer ->
-  TMap ProtocolServer (ClientVar msg) ->
+  ProtoServer msg ->
+  TMap (ProtoServer msg) (ClientVar msg) ->
   m (ProtocolClient msg) ->
   m () ->
   ClientVar msg ->
@@ -381,7 +376,7 @@ closeAgentClient c = liftIO $ do
     clear :: (AgentClient -> TMap k a) -> IO ()
     clear sel = atomically $ writeTVar (sel c) M.empty
 
-closeProtocolServerClients :: Int -> TMap ProtocolServer (ClientVar msg) -> IO ()
+closeProtocolServerClients :: Int -> TMap (ProtoServer msg) (ClientVar msg) -> IO ()
 closeProtocolServerClients tcpTimeout cs = readTVarIO cs >>= mapM_ (forkIO . closeClient) >> atomically (writeTVar cs M.empty)
   where
     closeClient cVar =
@@ -398,7 +393,7 @@ withAgentLock AgentClient {lock} =
     (void . atomically $ takeTMVar lock)
     (atomically $ putTMVar lock ())
 
-withClient_ :: forall a m msg. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> (ProtocolClient msg -> m a) -> m a
+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
   where
     logServerError :: AgentErrorType -> m a
@@ -406,17 +401,17 @@ withClient_ c srv action = (getProtocolServerClient c srv >>= action) `catchErro
       logServer "<--" c srv "" $ bshow e
       throwError e
 
-withLogClient_ :: (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> QueueId -> ByteString -> (ProtocolClient msg -> m a) -> m a
+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
   logServer "<--" c srv qId "OK"
   return res
 
-withClient :: forall m msg a. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
+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
 
-withLogClient :: forall m msg a. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> QueueId -> ByteString -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
+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
 
 liftClient :: AgentMonad m => (ErrorType -> AgentErrorType) -> ExceptT ProtocolClientError IO a -> m a
@@ -470,14 +465,54 @@ subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
 subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
   whenM (atomically . TM.member (server, rcvId) $ getMsgLocks c) . throwError $ CMD PROHIBITED
   atomically $ addPendingSubscription c rq connId
-  withLogClient c server rcvId "SUB" $ \smp -> do
-    liftIO (runExceptT $ subscribeSMPQueue smp rcvPrivateKey rcvId) >>= \case
-      Left e -> do
-        atomically . when (e /= PCENetworkError && e /= PCEResponseTimeout) $
-          removePendingSubscription c server connId
-        throwError e
-      Right _ -> do
-        addSubscription c rq connId
+  withLogClient c server rcvId "SUB" $ \smp ->
+    liftIO (runExceptT (subscribeSMPQueue smp rcvPrivateKey rcvId) >>= processSubResult c rq connId)
+      >>= either throwError pure
+
+processSubResult :: AgentClient -> RcvQueue -> ConnId -> Either ProtocolClientError () -> IO (Either ProtocolClientError ())
+processSubResult c rq@RcvQueue {server} connId r = do
+  case r of
+    Left e ->
+      atomically . unless (temporaryClientError e) $
+        removePendingSubscription c server connId
+    _ -> addSubscription c rq connId
+  pure r
+
+temporaryClientError :: ProtocolClientError -> Bool
+temporaryClientError = \case
+  PCENetworkError -> True
+  PCEResponseTimeout -> True
+  _ -> False
+
+temporaryAgentError :: AgentErrorType -> Bool
+temporaryAgentError = \case
+  BROKER NETWORK -> True
+  BROKER TIMEOUT -> True
+  _ -> False
+
+-- | subscribe multiple queues - all passed queues should be on the same server
+subscribeQueues :: AgentMonad m => AgentClient -> SMPServer -> Map ConnId RcvQueue -> m (Map ConnId (Either AgentErrorType ()))
+subscribeQueues c srv qs = do
+  (errs, qs_) <- partitionEithers <$> mapM checkQueue (M.assocs qs)
+  forM_ qs_ $ atomically . uncurry (addPendingSubscription c) . swap
+  case L.nonEmpty qs_ of
+    Just qs' -> do
+      smp_ <- tryError (getSMPServerClient c srv)
+      M.fromList . (errs <>) <$> case smp_ of
+        Left e -> pure $ map (second . const $ Left e) qs_
+        Right smp -> do
+          logServer "-->" c srv (bshow (length qs_) <> " queues") "SUB"
+          let qs2 = L.map (queueCreds . snd) qs'
+          rs' :: [((ConnId, RcvQueue), Either ProtocolClientError ())] <-
+            liftIO $ zip qs_ . L.toList <$> subscribeSMPQueues smp qs2
+          forM_ rs' $ \((connId, rq), r) -> liftIO $ processSubResult c rq connId r
+          pure $ map (bimap fst (first $ protocolClientError SMP)) rs'
+    _ -> pure $ M.fromList errs
+  where
+    checkQueue rq@(connId, RcvQueue {rcvId, server}) = do
+      prohibited <- atomically . TM.member (server, rcvId) $ getMsgLocks c
+      pure $ if prohibited || srv /= server then Left (connId, Left $ CMD PROHIBITED) else Right rq
+    queueCreds RcvQueue {rcvPrivateKey, rcvId} = (rcvPrivateKey, rcvId)
 
 addSubscription :: MonadIO m => AgentClient -> RcvQueue -> ConnId -> m ()
 addSubscription c rq@RcvQueue {server} connId = atomically $ do
@@ -514,11 +549,11 @@ getSubscriptions AgentClient {subscrConns} = do
   m <- readTVar subscrConns
   pure $ M.keysSet m
 
-logServer :: MonadIO m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m ()
+logServer :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> QueueId -> ByteString -> m ()
 logServer dir AgentClient {clientId} srv qId cmdStr =
   logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret qId, cmdStr]
 
-showServer :: SMPServer -> ByteString
+showServer :: ProtocolServer s -> ByteString
 showServer ProtocolServer {host, port} =
   B.pack $ host <> if null port then "" else ':' : port
 
@@ -547,11 +582,13 @@ sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) (C
         SMP.ClientMessage SMP.PHEmpty $ smpEncode agentEnvelope
 
 getQueueMessage :: AgentMonad m => AgentClient -> RcvQueue -> m (Maybe SMPMsgMeta)
-getQueueMessage c RcvQueue {server, rcvId, rcvPrivateKey} = do
+getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do
   atomically createTakeGetLock
-  withLogClient c server rcvId "GET" $ \smp ->
-    getSMPMessage smp rcvPrivateKey rcvId
+  (v, msg_) <- withLogClient c server rcvId "GET" $ \smp ->
+    (thVersion smp,) <$> getSMPMessage smp rcvPrivateKey rcvId
+  mapM (decryptMeta v) msg_
   where
+    decryptMeta v msg@SMP.RcvMessage {msgId} = SMP.rcvMessageMeta msgId <$> decryptSMPMessage v rq msg
     createTakeGetLock = TM.alterF takeLock (server, rcvId) $ getMsgLocks c
       where
         takeLock l_ = do
@@ -559,6 +596,13 @@ getQueueMessage c RcvQueue {server, rcvId, rcvPrivateKey} = do
           takeTMVar l
           pure $ Just l
 
+decryptSMPMessage :: AgentMonad m => Version -> RcvQueue -> SMP.RcvMessage -> m SMP.ClientRcvMsgBody
+decryptSMPMessage v rq SMP.RcvMessage {msgId, msgTs, msgFlags, msgBody = SMP.EncRcvMsgBody body}
+  | v == 1 || v == 2 = SMP.ClientRcvMsgBody msgTs msgFlags <$> decrypt body
+  | otherwise = liftEither . parse SMP.clientRcvMsgBodyP (AGENT A_MESSAGE) =<< decrypt body
+  where
+    decrypt = agentCbDecrypt (rcvDhSecret rq) (C.cbNonce msgId)
+
 secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SndPublicVerifyKey -> m ()
 secureQueue c RcvQueue {server, rcvId, rcvPrivateKey} senderKey =
   withLogClient c server rcvId "KEY <key>" $ \smp ->
@@ -582,7 +626,7 @@ sendAck c rq@RcvQueue {server, rcvId, rcvPrivateKey} msgId = do
 
 releaseGetLock :: AgentClient -> RcvQueue -> STM ()
 releaseGetLock c RcvQueue {server, rcvId} =
-  TM.lookup (server, rcvId) (getMsgLocks c) >>= mapM_ (void . (`tryPutTMVar` ()))
+  TM.lookup (server, rcvId) (getMsgLocks c) >>= mapM_ (`tryPutTMVar` ())
 
 suspendQueue :: AgentMonad m => AgentClient -> RcvQueue -> m ()
 suspendQueue c RcvQueue {server, rcvId, rcvPrivateKey} =
@@ -734,7 +778,7 @@ agentOperationBracket c op action =
   E.bracket
     (atomically $ beginAgentOperation c op)
     (\_ -> atomically $ endAgentOperation c op)
-    (\_ -> action)
+    (const action)
 
 withStore' :: AgentMonad m => AgentClient -> (DB.Connection -> IO a) -> m a
 withStore' c action = withStore c $ fmap Right . action
@@ -747,15 +791,16 @@ withStore c action = do
   where
     handleInternal :: E.SomeException -> IO (Either StoreError a)
     handleInternal = pure . Left . SEInternal . bshow
-    storeError :: StoreError -> AgentErrorType
-    storeError = \case
-      SEConnNotFound -> CONN NOT_FOUND
-      SEConnDuplicate -> CONN DUPLICATE
-      SEBadConnType CRcv -> CONN SIMPLEX
-      SEBadConnType CSnd -> CONN SIMPLEX
-      SEInvitationNotFound -> CMD PROHIBITED
-      -- this error is never reported as store error,
-      -- it is used to wrap agent operations when "transaction-like" store access is needed
-      -- NOTE: network IO should NOT be used inside AgentStoreMonad
-      SEAgentError e -> e
-      e -> INTERNAL $ show e
+
+storeError :: StoreError -> AgentErrorType
+storeError = \case
+  SEConnNotFound -> CONN NOT_FOUND
+  SEConnDuplicate -> CONN DUPLICATE
+  SEBadConnType CRcv -> CONN SIMPLEX
+  SEBadConnType CSnd -> CONN SIMPLEX
+  SEInvitationNotFound -> CMD PROHIBITED
+  -- this error is never reported as store error,
+  -- it is used to wrap agent operations when "transaction-like" store access is needed
+  -- NOTE: network IO should NOT be used inside AgentStoreMonad
+  SEAgentError e -> e
+  e -> INTERNAL $ show e

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

@@ -39,6 +39,7 @@ import Simplex.Messaging.Client
 import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Types
+import Simplex.Messaging.Protocol (NtfServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (TLS, Transport (..))
@@ -66,7 +67,6 @@ data AgentConfig = AgentConfig
     ntfCfg :: ProtocolClientConfig,
     reconnectInterval :: RetryInterval,
     helloTimeout :: NominalDiffTime,
-    resubscriptionConcurrency :: Int,
     ntfCron :: Word16,
     ntfWorkerDelay :: Int,
     ntfSMPWorkerDelay :: Int,
@@ -102,7 +102,6 @@ defaultAgentConfig =
       ntfCfg = defaultClientConfig {defaultTransport = ("443", transport @TLS)},
       reconnectInterval = defaultReconnectInterval,
       helloTimeout = 2 * nominalDay,
-      resubscriptionConcurrency = 16,
       ntfCron = 20, -- minutes
       ntfWorkerDelay = 100000, -- microseconds
       ntfSMPWorkerDelay = 500000, -- microseconds

src/Simplex/Messaging/Agent/NtfSubSupervisor.hs

@@ -139,9 +139,9 @@ processNtfSub c (connId, cmd) = do
     addNtfNTFWorker = addWorker ntfWorkers runNtfWorker
     addNtfSMPWorker = addWorker ntfSMPWorkers runNtfSMPWorker
     addWorker ::
-      (NtfSupervisor -> TMap ProtocolServer (TMVar (), Async ())) ->
-      (AgentClient -> ProtocolServer -> TMVar () -> m ()) ->
-      ProtocolServer ->
+      (NtfSupervisor -> TMap (ProtocolServer s) (TMVar (), Async ())) ->
+      (AgentClient -> ProtocolServer s -> TMVar () -> m ()) ->
+      ProtocolServer s ->
       m ()
     addWorker wsSel runWorker srv = do
       ws <- asks $ wsSel . ntfSupervisor
@@ -340,7 +340,7 @@ closeNtfSupervisor ns = do
   cancelNtfWorkers_ $ ntfWorkers ns
   cancelNtfWorkers_ $ ntfSMPWorkers ns
 
-cancelNtfWorkers_ :: TMap ProtocolServer (TMVar (), Async ()) -> IO ()
+cancelNtfWorkers_ :: TMap (ProtocolServer s) (TMVar (), Async ()) -> IO ()
 cancelNtfWorkers_ wsVar = do
   ws <- atomically $ stateTVar wsVar (,M.empty)
   forM_ ws $ uninterruptibleCancel . snd

src/Simplex/Messaging/Agent/Protocol.hs

@@ -903,7 +903,7 @@ commandP =
     msgErrResp = ACmd SAgent .: MERR <$> A.decimal <* A.space <*> strP
     message = ACmd SAgent .:. MSG <$> msgMetaP <* A.space <*> smpP <* A.space <*> A.takeByteString
     ackCmd = ACmd SClient . ACK <$> A.decimal
-    connections = strP `A.sepBy'` (A.char ',')
+    connections = strP `A.sepBy'` A.char ','
     msgMetaP = do
       integrity <- strP
       recipient <- " R=" *> partyMeta A.decimal

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

@@ -127,7 +127,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..))
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (blobFieldParser, fromTextField_)
-import Simplex.Messaging.Protocol (MsgBody, MsgFlags, ProtocolServer (..), RcvNtfDhSecret)
+import Simplex.Messaging.Protocol (MsgBody, MsgFlags, NtfServer, ProtocolServer (..), RcvNtfDhSecret, pattern NtfServer)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Util (bshow, eitherToMaybe, ($>>=), (<$$>))
 import Simplex.Messaging.Version
@@ -536,8 +536,10 @@ getPendingMsgData db connId msgId = do
           WHERE m.conn_id = ? AND m.internal_id = ?
         |]
         (connId, msgId)
-    pendingMsgData :: (AgentMessageType, MsgFlags, MsgBody, InternalTs) -> PendingMsgData
-    pendingMsgData (msgType, msgFlags, msgBody, internalTs) = PendingMsgData {msgId, msgType, msgFlags, msgBody, internalTs}
+    pendingMsgData :: (AgentMessageType, Maybe MsgFlags, MsgBody, InternalTs) -> PendingMsgData
+    pendingMsgData (msgType, msgFlags_, msgBody, internalTs) =
+      let msgFlags = fromMaybe SMP.noMsgFlags msgFlags_
+       in PendingMsgData {msgId, msgType, msgFlags, msgBody, internalTs}
 
 getPendingMsgs :: DB.Connection -> ConnId -> IO [InternalId]
 getPendingMsgs db connId =
@@ -654,7 +656,7 @@ getSavedNtfToken db = do
       |]
   where
     ntfToken ((host, port, keyHash) :. (provider, dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode_)) =
-      let ntfServer = ProtocolServer {host, port, keyHash}
+      let ntfServer = NtfServer host port keyHash
           ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
           ntfMode = fromMaybe NMPeriodic ntfMode_
        in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
@@ -734,7 +736,7 @@ getNtfSubscription db connId =
   where
     ntfSubscription (smpHost, smpPort, smpKeyHash, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, ntfAction_, smpAction_, actionTs_) =
       let smpServer = SMPServer smpHost smpPort smpKeyHash
-          ntfServer = ProtocolServer ntfHost ntfPort ntfKeyHash
+          ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
           action = case (ntfAction_, smpAction_, actionTs_) of
             (Just ntfAction, Nothing, Just actionTs) -> Just (NtfSubNTFAction ntfAction, actionTs)
             (Nothing, Just smpAction, Just actionTs) -> Just (NtfSubSMPAction smpAction, actionTs)
@@ -743,7 +745,7 @@ getNtfSubscription db connId =
 
 createNtfSubscription :: DB.Connection -> NtfSubscription -> NtfSubAction -> NtfActionTs -> IO ()
 createNtfSubscription db ntfSubscription action actionTs = do
-  let NtfSubscription {connId, smpServer = (SMPServer host port _), ntfQueueId, ntfServer = (SMPServer ntfHost ntfPort _), ntfSubId, ntfSubStatus} = ntfSubscription
+  let NtfSubscription {connId, smpServer = (SMPServer host port _), ntfQueueId, ntfServer = (NtfServer ntfHost ntfPort _), ntfSubId, ntfSubStatus} = ntfSubscription
   DB.execute
     db
     [sql|
@@ -759,7 +761,7 @@ createNtfSubscription db ntfSubscription action actionTs = do
     (ntfSubAction, ntfSubSMPAction) = ntfSubAndSMPAction action
 
 supervisorUpdateNtfSubscription :: DB.Connection -> NtfSubscription -> NtfSubAction -> NtfActionTs -> IO ()
-supervisorUpdateNtfSubscription db NtfSubscription {connId, ntfQueueId, ntfServer = (ProtocolServer ntfHost ntfPort _), ntfSubId, ntfSubStatus} action actionTs = do
+supervisorUpdateNtfSubscription db NtfSubscription {connId, ntfQueueId, ntfServer = (NtfServer ntfHost ntfPort _), ntfSubId, ntfSubStatus} action actionTs = do
   updatedAt <- getCurrentTime
   DB.execute
     db
@@ -787,7 +789,7 @@ supervisorUpdateNtfSubAction db connId action actionTs = do
     (ntfSubAction, ntfSubSMPAction) = ntfSubAndSMPAction action
 
 updateNtfSubscription :: DB.Connection -> NtfSubscription -> NtfSubAction -> NtfActionTs -> IO ()
-updateNtfSubscription db NtfSubscription {connId, ntfQueueId, ntfServer = (ProtocolServer ntfHost ntfPort _), ntfSubId, ntfSubStatus} action actionTs = do
+updateNtfSubscription db NtfSubscription {connId, ntfQueueId, ntfServer = (NtfServer ntfHost ntfPort _), ntfSubId, ntfSubStatus} action actionTs = do
   r <- maybeFirstRow fromOnly $ DB.query db "SELECT updated_by_supervisor FROM ntf_subscriptions WHERE conn_id = ?" (Only connId)
   forM_ r $ \updatedBySupervisor -> do
     updatedAt <- getCurrentTime
@@ -846,7 +848,7 @@ deleteNtfSubscription db connId = do
       else DB.execute db "DELETE FROM ntf_subscriptions WHERE conn_id = ?" (Only connId)
 
 getNextNtfSubNTFAction :: DB.Connection -> NtfServer -> IO (Maybe (NtfSubscription, NtfSubNTFAction, NtfActionTs))
-getNextNtfSubNTFAction db ntfServer@(ProtocolServer ntfHost ntfPort _) = do
+getNextNtfSubNTFAction db ntfServer@(NtfServer ntfHost ntfPort _) = do
   maybeFirstRow ntfSubAction getNtfSubAction_ $>>= \a@(NtfSubscription {connId}, _, _) -> do
     DB.execute db "UPDATE ntf_subscriptions SET updated_by_supervisor = ? WHERE conn_id = ?" (False, connId)
     pure $ Just a
@@ -889,7 +891,7 @@ getNextNtfSubSMPAction db smpServer@(SMPServer smpHost smpPort _) = do
         |]
         (smpHost, smpPort)
     ntfSubAction (connId, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
-      let ntfServer = ProtocolServer ntfHost ntfPort ntfKeyHash
+      let ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
           ntfSubscription = NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
        in (ntfSubscription, action, actionTs)
 
@@ -909,7 +911,7 @@ getActiveNtfToken db =
       (Only NTActive)
   where
     ntfToken ((host, port, keyHash) :. (provider, dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode_)) =
-      let ntfServer = ProtocolServer {host, port, keyHash}
+      let ntfServer = NtfServer host port keyHash
           ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
           ntfMode = fromMaybe NMPeriodic ntfMode_
        in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}

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

@@ -16,8 +16,8 @@ module Simplex.Messaging.Agent.Store.SQLite.Migrations
 where
 
 import Control.Monad (forM_)
-import Data.Function (on)
 import Data.List (intercalate, sortBy)
+import Data.Ord (comparing)
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
 import Database.SQLite.Simple (Connection, Only (..), Query (..))
@@ -44,7 +44,7 @@ schemaMigrations =
 
 -- | The list of migrations in ascending order by date
 app :: [Migration]
-app = sortBy (compare `on` name) $ map migration schemaMigrations
+app = sortBy (comparing name) $ map migration schemaMigrations
   where
     migration (name, query) = Migration {name = name, up = fromQuery query}
 

src/Simplex/Messaging/Client.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -24,7 +25,7 @@
 -- 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 (sessionId),
+    ProtocolClient (thVersion, sessionId),
     SMPClient,
     getProtocolClient,
     closeProtocolClient,
@@ -32,11 +33,14 @@ module Simplex.Messaging.Client
     -- * SMP protocol command functions
     createSMPQueue,
     subscribeSMPQueue,
+    subscribeSMPQueues,
     getSMPMessage,
     subscribeSMPQueueNotifications,
     secureSMPQueue,
     enableSMPQueueNotifications,
     disableSMPQueueNotifications,
+    enableSMPQueuesNtfs,
+    disableSMPQueuesNtfs,
     sendSMPMessage,
     ackSMPMessage,
     suspendSMPQueue,
@@ -56,10 +60,14 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Exception
 import Control.Monad
-import Control.Monad.Trans.Class
+import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Either (rights)
+import Data.Functor (($>))
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
 import Network.Socket (ServiceName)
 import Numeric.Natural
@@ -83,19 +91,22 @@ data ProtocolClient msg = ProtocolClient
     connected :: TVar Bool,
     sessionId :: SessionId,
     thVersion :: Version,
-    protocolServer :: ProtocolServer,
+    protocolServer :: ProtoServer msg,
     tcpTimeout :: Int,
     clientCorrId :: TVar Natural,
     sentCommands :: TMap CorrId (Request msg),
-    sndQ :: TBQueue SentRawTransmission,
-    rcvQ :: TBQueue (SignedTransmission msg),
+    sndQ :: TBQueue (NonEmpty (SentRawTransmission)),
+    rcvQ :: TBQueue (NonEmpty (SignedTransmission msg)),
     msgQ :: Maybe (TBQueue (ServerTransmission msg))
   }
 
 type SMPClient = ProtocolClient SMP.BrokerMsg
 
+-- | Type for client command data
+type ClientCommand msg = (Maybe C.APrivateSignKey, QueueId, ProtoCommand msg)
+
 -- | Type synonym for transmission from some SPM server queue.
-type ServerTransmission msg = (ProtocolServer, SessionId, QueueId, msg)
+type ServerTransmission msg = (ProtoServer msg, Version, SessionId, QueueId, msg)
 
 -- | protocol client configuration.
 data ProtocolClientConfig = ProtocolClientConfig
@@ -137,7 +148,7 @@ type Response msg = Either ProtocolClientError msg
 --
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
-getProtocolClient :: forall msg. Protocol msg => ProtocolServer -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> IO () -> IO (Either ProtocolClientError (ProtocolClient msg))
+getProtocolClient :: forall msg. Protocol msg => ProtoServer msg -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> IO () -> IO (Either ProtocolClientError (ProtocolClient msg))
 getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tcpKeepAlive, smpPing, smpServerVRange} msgQ disconnected =
   (atomically mkProtocolClient >>= runClient useTransport)
     `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
@@ -208,13 +219,15 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc
       runExceptT $ sendProtocolCommand c Nothing "" protocolPing
 
     process :: ProtocolClient msg -> IO ()
-    process ProtocolClient {sessionId, rcvQ, sentCommands} = forever $ do
-      (_, _, (corrId, qId, respOrErr)) <- atomically $ readTBQueue rcvQ
+    process c = forever $ atomically (readTBQueue $ rcvQ c) >>= mapM_ (processMsg c)
+
+    processMsg :: ProtocolClient msg -> SignedTransmission msg -> IO ()
+    processMsg c@ProtocolClient {sentCommands} (_, _, (corrId, qId, respOrErr)) =
       if B.null $ bs corrId
-        then sendMsg qId respOrErr
+        then sendMsg respOrErr
         else do
           atomically (TM.lookup corrId sentCommands) >>= \case
-            Nothing -> sendMsg qId respOrErr
+            Nothing -> sendMsg respOrErr
             Just Request {queueId, responseVar} -> atomically $ do
               TM.delete corrId sentCommands
               putTMVar responseVar $
@@ -226,9 +239,9 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc
                       _ -> Right r
                   else Left . PCEUnexpectedResponse $ bshow respOrErr
       where
-        sendMsg :: QueueId -> Either ErrorType msg -> IO ()
-        sendMsg qId = \case
-          Right cmd -> atomically $ mapM_ (`writeTBQueue` (protocolServer, sessionId, qId, cmd)) msgQ
+        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 ()
 
@@ -282,23 +295,38 @@ createSMPQueue c rpKey rKey dhKey =
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue
 subscribeSMPQueue :: SMPClient -> RcvPrivateSignKey -> RecipientId -> ExceptT ProtocolClientError IO ()
-subscribeSMPQueue c@ProtocolClient {protocolServer, sessionId, msgQ} rpKey rId =
+subscribeSMPQueue c rpKey rId =
   sendSMPCommand c (Just rpKey) rId SUB >>= \case
     OK -> return ()
-    cmd@MSG {} ->
-      lift . atomically $ mapM_ (`writeTBQueue` (protocolServer, sessionId, rId, cmd)) msgQ
+    cmd@MSG {} -> liftIO $ writeSMPMessage c rId cmd
     r -> throwE . PCEUnexpectedResponse $ bshow r
 
+-- | Subscribe to multiple SMP queues batching commands if supported.
+subscribeSMPQueues :: SMPClient -> NonEmpty (RcvPrivateSignKey, RecipientId) -> IO (NonEmpty (Either ProtocolClientError ()))
+subscribeSMPQueues c qs = sendProtocolCommands c cs >>= mapM response . L.zip qs
+  where
+    cs = L.map (\(rpKey, rId) -> (Just rpKey, rId, Cmd SRecipient SUB)) qs
+    response ((_, rId), r) = case r of
+      Right OK -> pure $ Right ()
+      Right cmd@MSG {} -> writeSMPMessage c rId cmd $> Right ()
+      Right r' -> pure . Left . PCEUnexpectedResponse $ bshow r'
+      Left e -> pure $ Left e
+
+writeSMPMessage :: SMPClient -> RecipientId -> BrokerMsg -> IO ()
+writeSMPMessage c rId msg = atomically $ mapM_ (`writeTBQueue` serverTransmission c rId msg) (msgQ c)
+
+serverTransmission :: ProtocolClient msg -> RecipientId -> msg -> ServerTransmission msg
+serverTransmission ProtocolClient {protocolServer, thVersion, sessionId} 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
 --
 -- https://github.covm/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#receive-a-message-from-the-queue
-getSMPMessage :: SMPClient -> RcvPrivateSignKey -> RecipientId -> ExceptT ProtocolClientError IO (Maybe SMP.SMPMsgMeta)
-getSMPMessage c@ProtocolClient {protocolServer, sessionId, msgQ} rpKey rId =
+getSMPMessage :: SMPClient -> RcvPrivateSignKey -> RecipientId -> ExceptT ProtocolClientError IO (Maybe RcvMessage)
+getSMPMessage c rpKey rId =
   sendSMPCommand c (Just rpKey) rId GET >>= \case
     OK -> pure Nothing
-    cmd@(MSG msgId msgTs msgFlags _) -> do
-      lift . atomically $ mapM_ (`writeTBQueue` (protocolServer, sessionId, rId, cmd)) msgQ
-      pure $ Just SMP.SMPMsgMeta {msgId, msgTs, msgFlags}
+    cmd@(MSG msg) -> liftIO (writeSMPMessage c rId cmd) $> Just msg
     r -> throwE . PCEUnexpectedResponse $ bshow r
 
 -- | Subscribe to the SMP queue notifications.
@@ -322,12 +350,32 @@ enableSMPQueueNotifications c rpKey rId notifierKey rcvNtfPublicDhKey =
     NID nId rcvNtfSrvPublicDhKey -> pure (nId, rcvNtfSrvPublicDhKey)
     r -> throwE . PCEUnexpectedResponse $ bshow r
 
+-- | Enable notifications for the multiple queues for push notifications server.
+enableSMPQueuesNtfs :: SMPClient -> NonEmpty (RcvPrivateSignKey, RecipientId, NtfPublicVerifyKey, RcvNtfPublicDhKey) -> IO (NonEmpty (Either ProtocolClientError (NotifierId, RcvNtfPublicDhKey)))
+enableSMPQueuesNtfs c qs = L.map response <$> sendProtocolCommands c cs
+  where
+    cs = L.map (\(rpKey, rId, notifierKey, rcvNtfPublicDhKey) -> (Just rpKey, rId, Cmd SRecipient $ NKEY notifierKey rcvNtfPublicDhKey)) qs
+    response = \case
+      Right (NID nId rcvNtfSrvPublicDhKey) -> Right (nId, rcvNtfSrvPublicDhKey)
+      Right r -> Left . PCEUnexpectedResponse $ bshow r
+      Left e -> Left e
+
 -- | Disable notifications for the queue for push notifications server.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#disable-notifications-command
 disableSMPQueueNotifications :: SMPClient -> RcvPrivateSignKey -> RecipientId -> ExceptT ProtocolClientError IO ()
 disableSMPQueueNotifications = okSMPCommand NDEL
 
+-- | Disable notifications for multiple queues for push notifications server.
+disableSMPQueuesNtfs :: SMPClient -> NonEmpty (RcvPrivateSignKey, RecipientId) -> IO (NonEmpty (Either ProtocolClientError ()))
+disableSMPQueuesNtfs c qs = L.map response <$> sendProtocolCommands c cs
+  where
+    cs = L.map (\(rpKey, rId) -> (Just rpKey, rId, Cmd SRecipient NDEL)) qs
+    response = \case
+      Right OK -> Right ()
+      Right r -> Left . PCEUnexpectedResponse $ bshow r
+      Left e -> Left e
+
 -- | Send SMP message.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message
@@ -341,11 +389,10 @@ sendSMPMessage c spKey sId flags msg =
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
 ackSMPMessage :: SMPClient -> RcvPrivateSignKey -> QueueId -> MsgId -> ExceptT ProtocolClientError IO ()
-ackSMPMessage c@ProtocolClient {protocolServer, sessionId, msgQ} rpKey rId msgId =
+ackSMPMessage c rpKey rId msgId =
   sendSMPCommand c (Just rpKey) rId (ACK msgId) >>= \case
     OK -> return ()
-    cmd@MSG {} ->
-      lift . atomically $ mapM_ (`writeTBQueue` (protocolServer, sessionId, rId, cmd)) msgQ
+    cmd@MSG {} -> liftIO $ writeSMPMessage c rId cmd
     r -> throwE . PCEUnexpectedResponse $ bshow r
 
 -- | Irreversibly suspend SMP queue.
@@ -371,37 +418,48 @@ okSMPCommand cmd c pKey qId =
 sendSMPCommand :: PartyI p => SMPClient -> Maybe C.APrivateSignKey -> QueueId -> Command p -> ExceptT ProtocolClientError IO BrokerMsg
 sendSMPCommand c pKey qId cmd = sendProtocolCommand c pKey qId (Cmd sParty cmd)
 
--- | Send Protocol command
-sendProtocolCommand :: forall msg. ProtocolEncoding (ProtocolCommand msg) => ProtocolClient msg -> Maybe C.APrivateSignKey -> QueueId -> ProtocolCommand msg -> ExceptT ProtocolClientError IO msg
-sendProtocolCommand ProtocolClient {sndQ, sentCommands, clientCorrId, sessionId, thVersion, tcpTimeout} pKey qId cmd = do
-  corrId <- lift_ getNextCorrId
-  t <- signTransmission $ encodeTransmission thVersion sessionId (corrId, qId, cmd)
-  ExceptT $ sendRecv corrId t
+-- | 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
+  ts <- mapM (runExceptT . mkTransmission c) cs
+  mapM_ (atomically . writeTBQueue sndQ . L.map fst) . L.nonEmpty . rights $ L.toList ts
+  forConcurrently ts $ \case
+    Right (_, r) -> withTimeout . atomically $ takeTMVar r
+    Left e -> pure $ Left e
   where
-    lift_ :: STM a -> ExceptT ProtocolClientError IO a
-    lift_ action = ExceptT $ Right <$> atomically action
+    withTimeout a = fromMaybe (Left PCEResponseTimeout) <$> timeout tcpTimeout a
 
+-- | 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
+  (t, r) <- mkTransmission c (pKey, qId, cmd)
+  ExceptT $ sendRecv t r
+  where
+    -- two separate "atomically" needed to avoid blocking
+    sendRecv :: SentRawTransmission -> TMVar (Response msg) -> IO (Response msg)
+    sendRecv t r = atomically (writeTBQueue sndQ [t]) >> withTimeout (atomically $ takeTMVar r)
+      where
+        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
+  corrId <- liftIO $ atomically getNextCorrId
+  t <- signTransmission $ encodeTransmission thVersion sessionId (corrId, qId, cmd)
+  r <- liftIO . atomically $ mkRequest corrId
+  pure (t, r)
+  where
     getNextCorrId :: STM CorrId
     getNextCorrId = do
       i <- stateTVar clientCorrId $ \i -> (i, i + 1)
       pure . CorrId $ bshow i
-
     signTransmission :: ByteString -> ExceptT ProtocolClientError IO SentRawTransmission
     signTransmission t = case pKey of
-      Nothing -> return (Nothing, t)
+      Nothing -> pure (Nothing, t)
       Just pk -> do
         sig <- liftError PCESignatureError $ C.sign pk t
         return (Just sig, t)
-
-    -- two separate "atomically" needed to avoid blocking
-    sendRecv :: CorrId -> SentRawTransmission -> IO (Response msg)
-    sendRecv corrId t = atomically (send corrId t) >>= withTimeout . atomically . takeTMVar
-      where
-        withTimeout a = fromMaybe (Left PCEResponseTimeout) <$> timeout tcpTimeout a
-
-    send :: CorrId -> SentRawTransmission -> STM (TMVar (Response msg))
-    send corrId t = do
+    mkRequest :: CorrId -> STM (TMVar (Response msg))
+    mkRequest corrId = do
       r <- newEmptyTMVar
       TM.insert corrId (Request qId r) sentCommands
-      writeTBQueue sndQ t
-      return r
+      pure r

src/Simplex/Messaging/Client/Agent.hs

@@ -30,7 +30,7 @@ import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, SMPS
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Util (catchAll_, tryE, whenM, ($>>=))
+import Simplex.Messaging.Util (catchAll_, tryE, unlessM, ($>>=))
 import System.Timeout (timeout)
 import UnliftIO (async, forConcurrently_)
 import UnliftIO.Exception (Exception)
@@ -47,7 +47,7 @@ data SMPClientAgentEvent
   | CASubError SMPServer SMPSub ProtocolClientError
 
 data SMPSubParty = SPRecipient | SPNotifier
-  deriving (Eq, Ord)
+  deriving (Eq, Ord, Show)
 
 type SMPSub = (SMPSubParty, QueueId)
 
@@ -203,7 +203,7 @@ getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ} srv =
         notify $ CAReconnected srv
         cs <- atomically $ mapM readTVar =<< TM.lookup srv (pendingSrvSubs ca)
         forConcurrently_ (maybe [] M.assocs cs) $ \sub@(s, _) ->
-          whenM (atomically $ hasSub (srvSubs ca) srv s) $
+          unlessM (atomically $ hasSub (srvSubs ca) srv s) $
             subscribe_ smp sub `catchE` handleError s
       where
         subscribe_ :: SMPClient -> (SMPSub, C.APrivateSignKey) -> ExceptT ProtocolClientError IO ()

src/Simplex/Messaging/Crypto.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -101,6 +102,7 @@ module Simplex.Messaging.Crypto
     -- * NaCl crypto_box
     CbNonce (unCbNonce),
     cbEncrypt,
+    cbEncryptMaxLenBS,
     cbDecrypt,
     cbNonce,
     randomCbNonce,
@@ -118,6 +120,13 @@ module Simplex.Messaging.Crypto
 
     -- * Cryptography error type
     CryptoError (..),
+
+    -- * Limited size ByteStrings
+    MaxLenBS,
+    pattern MaxLenBS,
+    maxLenBS,
+    unsafeMaxLenBS,
+    appendMaxLenBS,
   )
 where
 
@@ -153,11 +162,11 @@ import Data.Constraint (Dict (..))
 import Data.Kind (Constraint, Type)
 import Data.String
 import Data.Type.Equality
-import Data.Typeable (Typeable)
+import Data.Typeable (Proxy (Proxy), Typeable)
 import Data.X509
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.TypeLits (ErrorMessage (..), TypeError)
+import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
 import Network.Transport.Internal (decodeWord16, encodeWord16)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -809,6 +818,41 @@ unPad padded
     (lenWrd, rest) = B.splitAt 2 padded
     len = fromIntegral $ decodeWord16 lenWrd
 
+newtype MaxLenBS (i :: Nat) = MLBS {unMaxLenBS :: ByteString}
+
+pattern MaxLenBS :: ByteString -> MaxLenBS i
+pattern MaxLenBS s <- MLBS s
+
+{-# COMPLETE MaxLenBS #-}
+
+instance KnownNat i => Encoding (MaxLenBS i) where
+  smpEncode (MLBS s) = smpEncode s
+  smpP = first show . maxLenBS <$?> smpP
+
+instance KnownNat i => StrEncoding (MaxLenBS i) where
+  strEncode (MLBS s) = strEncode s
+  strP = first show . maxLenBS <$?> strP
+
+maxLenBS :: forall i. KnownNat i => ByteString -> Either CryptoError (MaxLenBS i)
+maxLenBS s
+  | B.length s > maxLength @i = Left CryptoLargeMsgError
+  | otherwise = Right $ MLBS s
+
+unsafeMaxLenBS :: forall i. KnownNat i => ByteString -> MaxLenBS i
+unsafeMaxLenBS = MLBS
+
+padMaxLenBS :: forall i. KnownNat i => MaxLenBS i -> MaxLenBS (i + 2)
+padMaxLenBS (MLBS msg) = MLBS $ encodeWord16 (fromIntegral len) <> msg <> B.replicate padLen '#'
+  where
+    len = B.length msg
+    padLen = maxLength @i - len
+
+appendMaxLenBS :: (KnownNat i, KnownNat j) => MaxLenBS i -> MaxLenBS j -> MaxLenBS (i + j)
+appendMaxLenBS (MLBS s1) (MLBS s2) = MLBS $ s1 <> s2
+
+maxLength :: forall i. KnownNat i => Int
+maxLength = fromIntegral (natVal $ Proxy @i)
+
 initAEAD :: forall c. AES.BlockCipher c => Key -> IV -> ExceptT CryptoError IO (AES.AEAD c)
 initAEAD (Key aesKey) (IV ivBytes) = do
   iv <- makeIV @c ivBytes
@@ -864,12 +908,17 @@ dh' (PublicKeyX448 k) (PrivateKeyX448 pk _) = DhSecretX448 $ X448.dh k pk
 
 -- | NaCl @crypto_box@ encrypt with a shared DH secret and 192-bit nonce.
 cbEncrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
-cbEncrypt secret (CbNonce nonce) msg paddedLen = cryptoBox <$> pad msg paddedLen
+cbEncrypt secret (CbNonce nonce) msg paddedLen = cryptoBox secret nonce <$> pad msg paddedLen
+
+-- | NaCl @crypto_box@ encrypt with a shared DH secret and 192-bit nonce.
+cbEncryptMaxLenBS :: KnownNat i => DhSecret X25519 -> CbNonce -> MaxLenBS i -> ByteString
+cbEncryptMaxLenBS secret (CbNonce nonce) = cryptoBox secret nonce . unMaxLenBS . padMaxLenBS
+
+cryptoBox :: DhSecret 'X25519 -> ByteString -> ByteString -> ByteString
+cryptoBox secret nonce s = BA.convert tag <> c
   where
-    cryptoBox s = BA.convert tag <> c
-      where
-        (rs, c) = xSalsa20 secret nonce s
-        tag = Poly1305.auth rs c
+    (rs, c) = xSalsa20 secret nonce s
+    tag = Poly1305.auth rs c
 
 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
 cbDecrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString

src/Simplex/Messaging/Encoding.hs

@@ -13,6 +13,7 @@ module Simplex.Messaging.Encoding
     Large (..),
     smpEncodeList,
     smpListP,
+    lenEncode,
   )
 where
 
@@ -197,3 +198,9 @@ instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e, Encoding f
   {-# INLINE smpEncode #-}
   smpP = (,,,,,,) <$> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP
   {-# INLINE smpP #-}
+
+instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e, Encoding f, Encoding g, Encoding h) => Encoding (a, b, c, d, e, f, g, h) where
+  smpEncode (a, b, c, d, e, f, g, h) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d <> smpEncode e <> smpEncode f <> smpEncode g <> smpEncode h
+  {-# INLINE smpEncode #-}
+  smpP = (,,,,,,,) <$> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP
+  {-# INLINE smpP #-}

src/Simplex/Messaging/Encoding/String.hs

@@ -28,9 +28,13 @@ import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlphaNum)
 import Data.Int (Int64)
 import qualified Data.List.NonEmpty as L
+import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
+import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.System (SystemTime (..))
+import Data.Time.Format.ISO8601
 import Data.Word (Word16)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (parseAll)
@@ -101,14 +105,26 @@ instance StrEncoding Bool where
   strP = smpP
   {-# INLINE strP #-}
 
+instance StrEncoding Int where
+  strEncode = B.pack . show
+  {-# INLINE strEncode #-}
+  strP = A.decimal
+  {-# INLINE strP #-}
+
 instance StrEncoding Int64 where
   strEncode = B.pack . show
+  {-# INLINE strEncode #-}
   strP = A.decimal
+  {-# INLINE strP #-}
 
 instance StrEncoding SystemTime where
   strEncode = strEncode . systemSeconds
   strP = MkSystemTime <$> strP <*> pure 0
 
+instance StrEncoding UTCTime where
+  strEncode = B.pack . iso8601Show
+  strP = maybe (Left "bad UTCTime") Right . iso8601ParseM . B.unpack <$?> A.takeTill (\c -> c == ' ' || c == '\n')
+
 -- lists encode/parse as comma-separated strings
 strEncodeList :: StrEncoding a => [a] -> ByteString
 strEncodeList = B.intercalate "," . map strEncode
@@ -121,8 +137,12 @@ instance StrEncoding a => StrEncoding (L.NonEmpty a) where
   strEncode = strEncodeList . L.toList
   strP = L.fromList <$> listItem `A.sepBy1'` A.char ','
 
+instance (StrEncoding a, Ord a) => StrEncoding (Set a) where
+  strEncode = strEncodeList . S.toList
+  strP = S.fromList <$> listItem `A.sepBy'` A.char ','
+
 listItem :: StrEncoding a => Parser a
-listItem = parseAll strP <$?> A.takeTill (== ',')
+listItem = parseAll strP <$?> A.takeTill (\c -> c == ',' || c == ' ' || c == '\n')
 
 instance (StrEncoding a, StrEncoding b) => StrEncoding (a, b) where
   strEncode (a, b) = B.unwords [strEncode a, strEncode b]

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -146,7 +146,8 @@ instance Encoding ANewNtfEntity where
       _ -> fail "bad ANewNtfEntity"
 
 instance Protocol NtfResponse where
-  type ProtocolCommand NtfResponse = NtfCmd
+  type ProtoCommand NtfResponse = NtfCmd
+  type ProtoType NtfResponse = 'PNTF
   protocolClientHandshake = ntfClientHandshake
   protocolPing = NtfCmd SSubscription PING
   protocolError = \case
@@ -323,7 +324,7 @@ instance ProtocolEncoding NtfResponse where
         | otherwise = Left $ CMD HAS_AUTH
 
 data SMPQueueNtf = SMPQueueNtf
-  { smpServer :: ProtocolServer,
+  { smpServer :: SMPServer,
     notifierId :: NotifierId
   }
   deriving (Eq, Ord, Show)
@@ -411,6 +412,16 @@ data NtfSubStatus
     NSErr ByteString
   deriving (Eq, Show)
 
+ntfShouldSubscribe :: NtfSubStatus -> Bool
+ntfShouldSubscribe = \case
+  NSNew -> True
+  NSPending -> True
+  NSActive -> True
+  NSInactive -> True
+  NSEnd -> False
+  NSAuth -> False
+  NSErr _ -> False
+
 instance Encoding NtfSubStatus where
   smpEncode = \case
     NSNew -> "NEW"

src/Simplex/Messaging/Notifications/Server.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
@@ -31,7 +32,7 @@ import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..), Pus
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Notifications.Server.StoreLog
 import Simplex.Messaging.Notifications.Transport
-import Simplex.Messaging.Protocol (ErrorType (..), SMPServer, SignedTransmission, Transmission, encodeTransmission, tGet, tPut)
+import Simplex.Messaging.Protocol (ErrorType (..), ProtocolServer (host), SMPServer, SignedTransmission, Transmission, encodeTransmission, tGet, tPut)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
 import qualified Simplex.Messaging.TMap as TM
@@ -80,9 +81,10 @@ ntfServer NtfServerConfig {transports} started = do
 resubscribe :: (MonadUnliftIO m, MonadReader NtfEnv m) => NtfSubscriber -> Map NtfSubscriptionId NtfSubData -> m ()
 resubscribe NtfSubscriber {newSubQ} subs = do
   d <- asks $ resubscribeDelay . config
-  forM_ subs $ \sub -> do
-    atomically $ writeTBQueue newSubQ $ NtfSub sub
-    threadDelay d
+  forM_ subs $ \sub@NtfSubData {} ->
+    whenM (ntfShouldSubscribe <$> readTVarIO (subStatus sub)) $ do
+      atomically $ writeTBQueue newSubQ $ NtfSub sub
+      threadDelay d
   liftIO $ logInfo "SMP connections resubscribed"
 
 ntfSubscriber :: forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => NtfSubscriber -> m ()
@@ -128,7 +130,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
 
     receiveSMP :: m ()
     receiveSMP = forever $ do
-      (srv, _sessId, ntfId, msg) <- atomically $ readTBQueue msgQ
+      (srv, _, _, ntfId, msg) <- atomically $ readTBQueue msgQ
       let smpQueue = SMPQueueNtf srv ntfId
       case msg of
         SMP.NMSG nmsgNonce encNMsgMeta -> do
@@ -146,16 +148,19 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
       forever $
         atomically (readTBQueue agentQ) >>= \case
           CAConnected _ -> pure ()
-          CADisconnected srv subs ->
+          CADisconnected srv subs -> do
+            logInfo . T.pack $ "SMP server disconnected " <> host srv <> " (" <> show (length subs) <> ") subscriptions"
             forM_ subs $ \(_, ntfId) -> do
               let smpQueue = SMPQueueNtf srv ntfId
               updateSubStatus smpQueue NSInactive
-          CAReconnected _ -> pure ()
+          CAReconnected srv ->
+            logInfo $ "SMP server reconnected " <> T.pack (host srv)
           CAResubscribed srv sub -> do
             let ntfId = snd sub
                 smpQueue = SMPQueueNtf srv ntfId
             updateSubStatus smpQueue NSActive
-          CASubError srv (_, ntfId) err ->
+          CASubError srv (_, ntfId) err -> do
+            logError . T.pack $ "SMP subscription error on server " <> host srv <> ": " <> show err
             handleSubError (SMPQueueNtf srv ntfId) err
 
     handleSubError :: SMPQueueNtf -> ProtocolClientError -> m ()
@@ -244,22 +249,23 @@ clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connecte
 
 receive :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> NtfServerClient -> m ()
 receive th NtfServerClient {rcvQ, sndQ, activeAt} = forever $ do
-  t@(_, _, (corrId, entId, cmdOrError)) <- tGet th
-  atomically . writeTVar activeAt =<< liftIO getSystemTime
-  logDebug "received transmission"
-  case cmdOrError of
-    Left e -> write sndQ (corrId, entId, NRErr e)
-    Right cmd ->
-      verifyNtfTransmission t cmd >>= \case
-        VRVerified req -> write rcvQ req
-        VRFailed -> write sndQ (corrId, entId, NRErr AUTH)
+  ts <- tGet th
+  forM_ ts $ \t@(_, _, (corrId, entId, cmdOrError)) -> do
+    atomically . writeTVar activeAt =<< liftIO getSystemTime
+    logDebug "received transmission"
+    case cmdOrError of
+      Left e -> write sndQ (corrId, entId, NRErr e)
+      Right cmd ->
+        verifyNtfTransmission t cmd >>= \case
+          VRVerified req -> write rcvQ req
+          VRFailed -> write sndQ (corrId, entId, NRErr AUTH)
   where
     write q t = atomically $ writeTBQueue q t
 
 send :: (Transport c, MonadUnliftIO m) => THandle c -> NtfServerClient -> m ()
 send h@THandle {thVersion = v} NtfServerClient {sndQ, sessionId, activeAt} = forever $ do
   t <- atomically $ readTBQueue sndQ
-  void . liftIO $ tPut h (Nothing, encodeTransmission v sessionId t)
+  void . liftIO $ tPut h [(Nothing, encodeTransmission v sessionId t)]
   atomically . writeTVar activeAt =<< liftIO getSystemTime
 
 -- instance Show a => Show (TVar a) where

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

@@ -2,7 +2,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Messaging.Notifications.Server.Env where

src/Simplex/Messaging/Notifications/Server/Push/APNS.hs

@@ -99,6 +99,7 @@ data PushNotification
   | PNMessage PNMessageData
   | PNAlert Text
   | PNCheckMessages
+  deriving (Show)
 
 data PNMessageData = PNMessageData
   { smpQueue :: SMPQueueNtf,
@@ -106,6 +107,7 @@ data PNMessageData = PNMessageData
     nmsgNonce :: C.CbNonce,
     encNMsgMeta :: EncNMsgMeta
   }
+  deriving (Show)
 
 instance StrEncoding PNMessageData where
   strEncode PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} =

src/Simplex/Messaging/Notifications/Transport.hs

@@ -1,7 +1,13 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Simplex.Messaging.Notifications.Transport where
 
 import Control.Monad.Except
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Version
 
@@ -11,13 +17,56 @@ ntfBlockSize = 512
 supportedNTFServerVRange :: VersionRange
 supportedNTFServerVRange = mkVersionRange 1 1
 
+data NtfServerHandshake = NtfServerHandshake
+  { ntfVersionRange :: VersionRange,
+    sessionId :: SessionId
+  }
+
+data NtfClientHandshake = NtfClientHandshake
+  { -- | agreed SMP notifications server protocol version
+    ntfVersion :: Version,
+    -- | server identity - CA certificate fingerprint
+    keyHash :: C.KeyHash
+  }
+
+instance Encoding NtfServerHandshake where
+  smpEncode NtfServerHandshake {ntfVersionRange, sessionId} =
+    smpEncode (ntfVersionRange, sessionId)
+  smpP = do
+    (ntfVersionRange, sessionId) <- smpP
+    pure NtfServerHandshake {ntfVersionRange, sessionId}
+
+instance Encoding NtfClientHandshake where
+  smpEncode NtfClientHandshake {ntfVersion, keyHash} = smpEncode (ntfVersion, keyHash)
+  smpP = do
+    (ntfVersion, keyHash) <- smpP
+    pure NtfClientHandshake {ntfVersion, keyHash}
+
 -- | Notifcations server transport handshake.
-ntfServerHandshake :: Transport c => c -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
-ntfServerHandshake c _ _ = pure $ ntfTHandle c
+ntfServerHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
+ntfServerHandshake c kh ntfVRange = do
+  let th@THandle {sessionId} = ntfTHandle c
+  sendHandshake th $ NtfServerHandshake {sessionId, ntfVersionRange = ntfVRange}
+  getHandshake th >>= \case
+    NtfClientHandshake {ntfVersion, keyHash}
+      | keyHash /= kh ->
+        throwError $ TEHandshake IDENTITY
+      | ntfVersion `isCompatible` ntfVRange -> do
+        pure (th :: THandle c) {thVersion = ntfVersion}
+      | otherwise -> throwError $ TEHandshake VERSION
 
 -- | Notifcations server client transport handshake.
-ntfClientHandshake :: Transport c => c -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
-ntfClientHandshake c _ _ = pure $ ntfTHandle c
+ntfClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
+ntfClientHandshake c keyHash ntfVRange = do
+  let th@THandle {sessionId} = ntfTHandle c
+  NtfServerHandshake {sessionId = sessId, ntfVersionRange} <- getHandshake th
+  if sessionId /= sessId
+    then throwError TEBadSession
+    else case ntfVersionRange `compatibleVersion` ntfVRange of
+      Just (Compatible ntfVersion) -> do
+        sendHandshake th $ NtfClientHandshake {ntfVersion, keyHash}
+        pure (th :: THandle c) {thVersion = ntfVersion}
+      Nothing -> throwError $ TEHandshake VERSION
 
 ntfTHandle :: Transport c => c -> THandle c
-ntfTHandle c = THandle {connection = c, sessionId = tlsUnique c, blockSize = ntfBlockSize, thVersion = 0}
+ntfTHandle c = THandle {connection = c, sessionId = tlsUnique c, blockSize = ntfBlockSize, thVersion = 0, batch = False}

src/Simplex/Messaging/Notifications/Types.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Simplex.Messaging.Notifications.Types where
 
@@ -16,9 +17,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Parsers (blobFieldDecoder, fromTextField_)
-import Simplex.Messaging.Protocol (NotifierId, ProtocolServer, SMPServer)
-
-type NtfServer = ProtocolServer
+import Simplex.Messaging.Protocol (NotifierId, NtfServer, SMPServer)
 
 data NtfTknAction
   = NTARegister

src/Simplex/Messaging/Protocol.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
@@ -16,9 +17,13 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
+{-# HLINT ignore "Use newtype instead of data" #-}
+
 -- |
 -- Module      : Simplex.Messaging.ProtocolEncoding
 -- Copyright   : (c) simplex.chat
@@ -59,9 +64,13 @@ module Simplex.Messaging.Protocol
     ClientMessage (..),
     PrivHeader (..),
     Protocol (..),
+    ProtocolType (..),
     ProtocolServer (..),
+    ProtoServer,
     SMPServer,
     pattern SMPServer,
+    NtfServer,
+    pattern NtfServer,
     SrvLoc (..),
     CorrId (..),
     QueueId,
@@ -78,12 +87,20 @@ module Simplex.Messaging.Protocol
     NtfPublicVerifyKey,
     RcvNtfPublicDhKey,
     RcvNtfDhSecret,
+    Message (..),
+    RcvMessage (..),
     MsgId,
     MsgBody,
+    MaxMessageLen,
+    MaxRcvMessageLen,
+    EncRcvMsgBody (..),
+    RcvMsgBody (..),
+    ClientRcvMsgBody (..),
     EncNMsgMeta,
     SMPMsgMeta (..),
     NMsgMeta (..),
     MsgFlags (..),
+    rcvMessageMeta,
     noMsgFlags,
 
     -- * Parse and serialize
@@ -92,6 +109,8 @@ module Simplex.Messaging.Protocol
     encodeTransmission,
     transmissionP,
     _smpP,
+    encodeRcvMsgBody,
+    clientRcvMsgBodyP,
 
     -- * TCP transport functions
     tPut,
@@ -112,11 +131,14 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Kind
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Maybe (isNothing)
 import Data.String
-import Data.Time.Clock.System (SystemTime)
+import Data.Time.Clock.System (SystemTime (..))
 import Data.Type.Equality
 import GHC.Generics (Generic)
+import GHC.TypeLits (type (+))
 import Generic.Random (genericArbitraryU)
 import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
@@ -137,6 +159,11 @@ smpClientVRange = mkVersionRange 1 smpClientVersion
 maxMessageLength :: Int
 maxMessageLength = 16088
 
+type MaxMessageLen = 16088
+
+-- 16 extra bytes: 8 for timestamp and 8 for flags (7 flags and the space, only 1 flag is currently used)
+type MaxRcvMessageLen = MaxMessageLen + 16 -- 16104, the padded size is 16106
+
 -- it is shorter to allow per-queue e2e encryption DH key in the "public" header
 e2eEncConfirmationLength :: Int
 e2eEncConfirmationLength = 15936
@@ -243,9 +270,10 @@ deriving instance Eq (Command p)
 data BrokerMsg where
   -- SMP broker messages (responses, client messages, notifications)
   IDS :: QueueIdsKeys -> BrokerMsg
-  -- MSG v1 has to be supported for encoding/decoding
-  -- MSG :: MsgId -> SystemTime -> MsgBody -> BrokerMsg
-  MSG :: MsgId -> SystemTime -> MsgFlags -> MsgBody -> BrokerMsg
+  -- MSG v1/2 has to be supported for encoding/decoding
+  -- v1: MSG :: MsgId -> SystemTime -> MsgBody -> BrokerMsg
+  -- v2: MsgId -> SystemTime -> MsgFlags -> MsgBody -> BrokerMsg
+  MSG :: RcvMessage -> BrokerMsg
   NID :: NotifierId -> RcvNtfPublicDhKey -> BrokerMsg
   NMSG :: C.CbNonce -> EncNMsgMeta -> BrokerMsg
   END :: BrokerMsg
@@ -254,6 +282,79 @@ data BrokerMsg where
   PONG :: BrokerMsg
   deriving (Eq, Show)
 
+data RcvMessage = RcvMessage
+  { msgId :: MsgId,
+    msgTs :: SystemTime,
+    msgFlags :: MsgFlags,
+    msgBody :: EncRcvMsgBody -- e2e encrypted, with extra encryption for recipient
+  }
+  deriving (Eq, Show)
+
+-- | received message without server/recipient encryption
+data Message = Message
+  { msgId :: MsgId,
+    msgTs :: SystemTime,
+    msgFlags :: MsgFlags,
+    msgBody :: C.MaxLenBS MaxMessageLen
+  }
+
+instance StrEncoding RcvMessage where
+  strEncode RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} =
+    B.unwords
+      [ strEncode msgId,
+        strEncode msgTs,
+        "flags=" <> strEncode msgFlags,
+        strEncode body
+      ]
+  strP = do
+    msgId <- strP_
+    msgTs <- strP_
+    msgFlags <- ("flags=" *> strP_) <|> pure noMsgFlags
+    msgBody <- EncRcvMsgBody <$> strP
+    pure RcvMessage {msgId, msgTs, msgFlags, msgBody}
+
+newtype EncRcvMsgBody = EncRcvMsgBody ByteString
+  deriving (Eq, Show)
+
+data RcvMsgBody = RcvMsgBody
+  { msgTs :: SystemTime,
+    msgFlags :: MsgFlags,
+    msgBody :: C.MaxLenBS MaxMessageLen
+  }
+
+encodeRcvMsgBody :: RcvMsgBody -> C.MaxLenBS MaxRcvMessageLen
+encodeRcvMsgBody RcvMsgBody {msgTs, msgFlags, msgBody} =
+  let rcvMeta :: C.MaxLenBS 16 = C.unsafeMaxLenBS $ smpEncode (msgTs, msgFlags, ' ')
+   in C.appendMaxLenBS rcvMeta msgBody
+
+data ClientRcvMsgBody = ClientRcvMsgBody
+  { msgTs :: SystemTime,
+    msgFlags :: MsgFlags,
+    msgBody :: ByteString
+  }
+
+clientRcvMsgBodyP :: Parser ClientRcvMsgBody
+clientRcvMsgBodyP = do
+  msgTs <- smpP
+  msgFlags <- smpP
+  Tail msgBody <- _smpP
+  pure ClientRcvMsgBody {msgTs, msgFlags, msgBody}
+
+instance StrEncoding Message where
+  strEncode Message {msgId, msgTs, msgFlags, msgBody} =
+    B.unwords
+      [ strEncode msgId,
+        strEncode msgTs,
+        "flags=" <> strEncode msgFlags,
+        strEncode msgBody
+      ]
+  strP = do
+    msgId <- strP_
+    msgTs <- strP_
+    msgFlags <- ("flags=" *> strP_) <|> pure noMsgFlags
+    msgBody <- strP
+    pure Message {msgId, msgTs, msgFlags, msgBody}
+
 type EncNMsgMeta = ByteString
 
 data SMPMsgMeta = SMPMsgMeta
@@ -263,6 +364,9 @@ data SMPMsgMeta = SMPMsgMeta
   }
   deriving (Show)
 
+rcvMessageMeta :: MsgId -> ClientRcvMsgBody -> SMPMsgMeta
+rcvMessageMeta msgId ClientRcvMsgBody {msgTs, msgFlags} = SMPMsgMeta {msgId, msgTs, msgFlags}
+
 data NMsgMeta = NMsgMeta
   { msgId :: MsgId,
     msgTs :: SystemTime
@@ -277,11 +381,13 @@ instance Encoding NMsgMeta where
     (msgId, msgTs, Tail _) <- smpP
     pure NMsgMeta {msgId, msgTs}
 
+-- it must be data for correct JSON encoding
 data MsgFlags = MsgFlags {notification :: Bool}
   deriving (Eq, Show, Generic)
 
 instance ToJSON MsgFlags where toEncoding = J.genericToEncoding J.defaultOptions
 
+-- this encoding should not become bigger than 7 bytes (currently it is 1 byte)
 instance Encoding MsgFlags where
   smpEncode MsgFlags {notification} = smpEncode notification
   smpP = do
@@ -447,41 +553,109 @@ instance Encoding ClientMessage where
   smpEncode (ClientMessage h msg) = smpEncode h <> msg
   smpP = ClientMessage <$> smpP <*> A.takeByteString
 
-type SMPServer = ProtocolServer
+type SMPServer = ProtocolServer 'PSMP
 
-pattern SMPServer :: HostName -> ServiceName -> C.KeyHash -> ProtocolServer
-pattern SMPServer host port keyHash = ProtocolServer host port keyHash
+pattern SMPServer :: HostName -> ServiceName -> C.KeyHash -> ProtocolServer 'PSMP
+pattern SMPServer host port keyHash = ProtocolServer SPSMP host port keyHash
 
 {-# COMPLETE SMPServer #-}
 
--- | SMP server location and transport key digest (hash).
-data ProtocolServer = ProtocolServer
-  { host :: HostName,
+type NtfServer = ProtocolServer 'PNTF
+
+pattern NtfServer :: HostName -> ServiceName -> C.KeyHash -> ProtocolServer 'PNTF
+pattern NtfServer host port keyHash = ProtocolServer SPNTF host port keyHash
+
+{-# COMPLETE NtfServer #-}
+
+data ProtocolType = PSMP | PNTF
+  deriving (Eq, Ord, Show)
+
+instance StrEncoding ProtocolType where
+  strEncode = \case
+    PSMP -> "smp"
+    PNTF -> "ntf"
+  strP =
+    A.takeTill (== ':') >>= \case
+      "smp" -> pure PSMP
+      "ntf" -> pure PNTF
+      _ -> fail "bad ProtocolType"
+
+data SProtocolType (p :: ProtocolType) where
+  SPSMP :: SProtocolType 'PSMP
+  SPNTF :: SProtocolType 'PNTF
+
+deriving instance Eq (SProtocolType p)
+
+deriving instance Ord (SProtocolType p)
+
+deriving instance Show (SProtocolType p)
+
+data AProtocolType = forall p. ProtocolTypeI p => AProtocolType (SProtocolType p)
+
+instance TestEquality SProtocolType where
+  testEquality SPSMP SPSMP = Just Refl
+  testEquality SPNTF SPNTF = Just Refl
+  testEquality _ _ = Nothing
+
+protocolType :: SProtocolType p -> ProtocolType
+protocolType = \case
+  SPSMP -> PSMP
+  SPNTF -> PNTF
+
+aProtocolType :: ProtocolType -> AProtocolType
+aProtocolType = \case
+  PSMP -> AProtocolType SPSMP
+  PNTF -> AProtocolType SPNTF
+
+instance ProtocolTypeI p => StrEncoding (SProtocolType p) where
+  strEncode = strEncode . protocolType
+  strP = (\(AProtocolType p) -> checkProtocolType p) <$?> strP
+
+instance StrEncoding AProtocolType where
+  strEncode (AProtocolType p) = strEncode p
+  strP = aProtocolType <$> strP
+
+checkProtocolType :: forall t p p'. (ProtocolTypeI p, ProtocolTypeI p') => t p' -> Either String (t p)
+checkProtocolType p = case testEquality (protocolTypeI @p) (protocolTypeI @p') of
+  Just Refl -> Right p
+  Nothing -> Left "bad ProtocolType"
+
+class ProtocolTypeI (p :: ProtocolType) where
+  protocolTypeI :: SProtocolType p
+
+instance ProtocolTypeI 'PSMP where protocolTypeI = SPSMP
+
+instance ProtocolTypeI 'PNTF where protocolTypeI = SPNTF
+
+-- | server location and transport key digest (hash).
+data ProtocolServer p = ProtocolServer
+  { scheme :: SProtocolType p,
+    host :: HostName,
     port :: ServiceName,
     keyHash :: C.KeyHash
   }
   deriving (Eq, Ord, Show)
 
-instance IsString ProtocolServer where
+instance ProtocolTypeI p => IsString (ProtocolServer p) where
   fromString = parseString strDecode
 
-instance Encoding ProtocolServer where
+instance ProtocolTypeI p => Encoding (ProtocolServer p) where
   smpEncode ProtocolServer {host, port, keyHash} =
     smpEncode (host, port, keyHash)
   smpP = do
     (host, port, keyHash) <- smpP
-    pure ProtocolServer {host, port, keyHash}
+    pure ProtocolServer {scheme = protocolTypeI @p, host, port, keyHash}
 
-instance StrEncoding ProtocolServer where
-  strEncode ProtocolServer {host, port, keyHash} =
-    "smp://" <> strEncode keyHash <> "@" <> strEncode (SrvLoc host port)
+instance ProtocolTypeI p => StrEncoding (ProtocolServer p) where
+  strEncode ProtocolServer {scheme, host, port, keyHash} =
+    strEncode scheme <> "://" <> strEncode keyHash <> "@" <> strEncode (SrvLoc host port)
   strP = do
-    _ <- "smp://"
+    scheme <- strP <* "://"
     keyHash <- strP <* A.char '@'
     SrvLoc host port <- strP
-    pure ProtocolServer {host, port, keyHash}
+    pure ProtocolServer {scheme, host, port, keyHash}
 
-instance ToJSON ProtocolServer where
+instance ProtocolTypeI p => ToJSON (ProtocolServer p) where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
@@ -572,7 +746,7 @@ data ErrorType
     QUOTA
   | -- | ACK command is sent without message to be acknowledged
     NO_MSG
-  | -- | sent message is too large (> maxMessageLength = 16078 bytes)
+  | -- | sent message is too large (> maxMessageLength = 16088 bytes)
     LARGE_MSG
   | -- | internal server error
     INTERNAL
@@ -628,14 +802,18 @@ transmissionP = do
       command <- A.takeByteString
       pure RawTransmission {signature, signed, sessId, corrId, entityId, command}
 
-class (ProtocolEncoding msg, ProtocolEncoding (ProtocolCommand msg), Show msg) => Protocol msg where
-  type ProtocolCommand msg = cmd | cmd -> msg
+class (ProtocolEncoding msg, ProtocolEncoding (ProtoCommand msg), Show msg) => Protocol msg where
+  type ProtoCommand msg = cmd | cmd -> msg
+  type ProtoType msg = (sch :: ProtocolType) | sch -> msg
   protocolClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
-  protocolPing :: ProtocolCommand msg
+  protocolPing :: ProtoCommand msg
   protocolError :: msg -> Maybe ErrorType
 
+type ProtoServer msg = ProtocolServer (ProtoType msg)
+
 instance Protocol BrokerMsg where
-  type ProtocolCommand BrokerMsg = Cmd
+  type ProtoCommand BrokerMsg = Cmd
+  type ProtoType BrokerMsg = 'PSMP
   protocolClientHandshake = smpClientHandshake
   protocolPing = Cmd SSender PING
   protocolError = \case
@@ -724,9 +902,10 @@ instance ProtocolEncoding BrokerMsg where
   type Tag BrokerMsg = BrokerMsgTag
   encodeProtocol v = \case
     IDS (QIK rcvId sndId srvDh) -> e (IDS_, ' ', rcvId, sndId, srvDh)
-    MSG msgId ts flags msgBody
-      | v == 1 -> e (MSG_, ' ', msgId, ts, Tail msgBody)
-      | otherwise -> e (MSG_, ' ', msgId, ts, flags, ' ', Tail msgBody)
+    MSG RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body}
+      | v == 1 -> e (MSG_, ' ', msgId, msgTs, Tail body)
+      | v == 2 -> e (MSG_, ' ', msgId, msgTs, msgFlags, ' ', Tail body)
+      | otherwise -> e (MSG_, ' ', msgId, Tail body)
     NID nId srvNtfDh -> e (NID_, ' ', nId, srvNtfDh)
     NMSG nmsgNonce encNMsgMeta -> e (NMSG_, ' ', nmsgNonce, encNMsgMeta)
     END -> e END_
@@ -738,9 +917,14 @@ instance ProtocolEncoding BrokerMsg where
       e = smpEncode
 
   protocolP v = \case
-    MSG_
-      | v == 1 -> MSG <$> _smpP <*> smpP <*> pure noMsgFlags <*> (unTail <$> smpP)
-      | otherwise -> MSG <$> _smpP <*> smpP <*> smpP <*> (unTail <$> _smpP)
+    MSG_ -> do
+      msgId <- _smpP
+      MSG <$> case v of
+        1 -> RcvMessage msgId <$> smpP <*> pure noMsgFlags <*> bodyP
+        2 -> RcvMessage msgId <$> smpP <*> smpP <*> (A.space *> bodyP)
+        _ -> RcvMessage msgId (MkSystemTime 0 0) noMsgFlags <$> bodyP
+      where
+        bodyP = EncRcvMsgBody . unTail <$> smpP
     IDS_ -> IDS <$> (QIK <$> _smpP <*> smpP <*> smpP)
     NID_ -> NID <$> _smpP <*> smpP
     NMSG_ -> NMSG <$> _smpP <*> smpP
@@ -829,20 +1013,51 @@ instance Encoding CommandError where
       _ -> fail "bad command error type"
 
 -- | Send signed SMP transmission to TCP transport.
-tPut :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
-tPut th (sig, t) = tPutBlock th $ smpEncode (C.signatureBytes sig) <> t
+tPut :: Transport c => THandle c -> NonEmpty (SentRawTransmission) -> IO (NonEmpty (Either TransportError ()))
+tPut th trs
+  | batch th = tPutBatch [] $ L.map tEncode trs
+  | otherwise = forM trs $ tPutBlock th . tEncode
+  where
+    tPutBatch :: [Either TransportError ()] -> NonEmpty ByteString -> IO (NonEmpty (Either TransportError ()))
+    tPutBatch rs ts = do
+      let (n, s, ts_) = encodeBatch 0 "" ts
+      r <- if n == 0 then pure [Left TELargeMsg] else replicate n <$> tPutBlock th (lenEncode n `B.cons` s)
+      let rs' = rs <> r
+      case ts_ of
+        Just ts' -> tPutBatch rs' ts'
+        _ -> pure $ L.fromList rs'
+    encodeBatch :: Int -> ByteString -> NonEmpty ByteString -> (Int, ByteString, Maybe (NonEmpty ByteString))
+    encodeBatch n s ts@(t :| ts_)
+      | n == 255 = (n, s, Just ts)
+      | otherwise =
+        let s' = s <> smpEncode (Large t)
+            n' = n + 1
+         in if B.length s' > blockSize th - 1
+              then (n,s,) $ if n == 0 then L.nonEmpty ts_ else Just ts
+              else case L.nonEmpty ts_ of
+                Just ts' -> encodeBatch n' s' ts'
+                _ -> (n', s', Nothing)
+    tEncode (sig, tr) = smpEncode (C.signatureBytes sig) <> tr
 
 encodeTransmission :: ProtocolEncoding c => Version -> ByteString -> Transmission c -> ByteString
 encodeTransmission v sessionId (CorrId corrId, queueId, command) =
   smpEncode (sessionId, corrId, queueId) <> encodeProtocol v command
 
 -- | Receive and parse transmission from the TCP transport (ignoring any trailing padding).
-tGetParse :: Transport c => THandle c -> IO (Either TransportError RawTransmission)
-tGetParse th = (parse transmissionP TEBadBlock =<<) <$> tGetBlock th
+tGetParse :: Transport c => THandle c -> IO (NonEmpty (Either TransportError RawTransmission))
+tGetParse th
+  | batch th = either ((:| []) . Left) id <$> runExceptT getBatch
+  | otherwise = (:| []) . (parse transmissionP TEBadBlock =<<) <$> tGetBlock th
+  where
+    getBatch :: ExceptT TransportError IO (NonEmpty (Either TransportError RawTransmission))
+    getBatch = do
+      s <- ExceptT $ tGetBlock th
+      ts <- liftEither $ parse smpP TEBadBlock s
+      pure $ L.map (\(Large t) -> parse transmissionP TEBadBlock t) ts
 
 -- | Receive client and server transmissions (determined by `cmd` type).
-tGet :: forall cmd c m. (ProtocolEncoding cmd, Transport c, MonadIO m) => THandle c -> m (SignedTransmission cmd)
-tGet th@THandle {sessionId, thVersion = v} = liftIO (tGetParse th) >>= decodeParseValidate
+tGet :: forall cmd c m. (ProtocolEncoding cmd, Transport c, MonadIO m) => THandle c -> m (NonEmpty (SignedTransmission cmd))
+tGet th@THandle {sessionId, thVersion = v} = liftIO (tGetParse th) >>= mapM decodeParseValidate
   where
     decodeParseValidate :: Either TransportError RawTransmission -> m (SignedTransmission cmd)
     decodeParseValidate = \case

src/Simplex/Messaging/Server.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -40,21 +41,26 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random
+import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Either (fromRight)
+import Data.Either (fromRight, partitionEithers)
 import Data.Functor (($>))
 import Data.List (intercalate)
+import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (isNothing)
 import Data.Set (Set)
 import qualified Data.Set as S
 import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Calendar.Month.Compat (pattern MonthDay)
 import Data.Time.Calendar.OrdinalDate (mondayStartWeek)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
+import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Type.Equality
+import GHC.TypeLits (KnownNat)
 import Network.Socket (ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding (Encoding (smpEncode))
@@ -66,12 +72,15 @@ import Simplex.Messaging.Server.MsgStore
 import Simplex.Messaging.Server.MsgStore.STM (MsgQueue)
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.STM (QueueStore)
+import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Util
+import System.Exit (exitFailure)
+import System.IO (hPutStrLn)
 import System.Mem.Weak (deRefWeak)
 import UnliftIO.Concurrent
 import UnliftIO.Directory (doesFileExist, renameFile)
@@ -98,13 +107,14 @@ smpServer :: forall m. (MonadUnliftIO m, MonadReader Env m) => TMVar Bool -> m (
 smpServer started = do
   s <- asks server
   cfg@ServerConfig {transports} <- asks config
+  restoreServerStats
   restoreServerMessages
   raceAny_
     ( serverThread s subscribedQ subscribers subscriptions cancelSub :
       serverThread s ntfSubscribedQ notifiers ntfSubscriptions (\_ -> pure ()) :
       map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg
     )
-    `finally` (withLog closeStoreLog >> saveServerMessages)
+    `finally` (withLog closeStoreLog >> saveServerMessages >> saveServerStats)
   where
     runServer :: (ServiceName, ATransport) -> m ()
     runServer (tcpPort, ATransport t) = do
@@ -137,7 +147,7 @@ smpServer started = do
         endPreviousSubscriptions :: (QueueId, Client) -> m (Maybe s)
         endPreviousSubscriptions (qId, c) = do
           void . forkIO . atomically $
-            writeTBQueue (sndQ c) (CorrId "", qId, END)
+            writeTBQueue (sndQ c) [(CorrId "", qId, END)]
           atomically $ TM.lookupDelete qId (clientSubs c)
 
     expireMessagesThread_ :: ServerConfig -> [m ()]
@@ -158,32 +168,34 @@ smpServer started = do
             >>= atomically . (`deleteExpiredMsgs` old)
 
     serverStatsThread_ :: ServerConfig -> [m ()]
-    serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime} =
-      [logServerStats logStatsStartTime interval]
+    serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
+      [logServerStats logStatsStartTime interval serverStatsLogFile]
     serverStatsThread_ _ = []
 
-    logServerStats :: Int -> Int -> m ()
-    logServerStats startAt logInterval = do
+    logServerStats :: Int -> Int -> FilePath -> m ()
+    logServerStats startAt logInterval statsFilePath = do
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
-      logInfo $ "fromTime,qCreated,qSecured,qDeleted,msgSent,msgRecv,dayMsgQueues,weekMsgQueues,monthMsgQueues"
+      liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
       threadDelay $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
       ServerStats {fromTime, qCreated, qSecured, qDeleted, msgSent, msgRecv, dayMsgQueues, weekMsgQueues, monthMsgQueues} <- asks serverStats
       let interval = 1000000 * logInterval
-      forever $ do
-        ts <- liftIO getCurrentTime
-        fromTime' <- atomically $ swapTVar fromTime ts
-        qCreated' <- atomically $ swapTVar qCreated 0
-        qSecured' <- atomically $ swapTVar qSecured 0
-        qDeleted' <- atomically $ swapTVar qDeleted 0
-        msgSent' <- atomically $ swapTVar msgSent 0
-        msgRecv' <- atomically $ swapTVar msgRecv 0
-        let day = utctDay ts
-            (_, wDay) = mondayStartWeek day
-            MonthDay _ mDay = day
-        (dayMsgQueues', weekMsgQueues', monthMsgQueues') <-
-          atomically $ (,,) <$> periodCount 1 dayMsgQueues <*> periodCount wDay weekMsgQueues <*> periodCount mDay monthMsgQueues
-        logInfo . T.pack $ intercalate "," [show fromTime', show qCreated', show qSecured', show qDeleted', show msgSent', show msgRecv', show dayMsgQueues', weekMsgQueues', monthMsgQueues']
-        threadDelay interval
+      withFile statsFilePath AppendMode $ \h -> liftIO $ do
+        hSetBuffering h LineBuffering
+        forever $ do
+          ts <- getCurrentTime
+          fromTime' <- atomically $ swapTVar fromTime ts
+          qCreated' <- atomically $ swapTVar qCreated 0
+          qSecured' <- atomically $ swapTVar qSecured 0
+          qDeleted' <- atomically $ swapTVar qDeleted 0
+          msgSent' <- atomically $ swapTVar msgSent 0
+          msgRecv' <- atomically $ swapTVar msgRecv 0
+          let day = utctDay ts
+              (_, wDay) = mondayStartWeek day
+              MonthDay _ mDay = day
+          (dayMsgQueues', weekMsgQueues', monthMsgQueues') <-
+            atomically $ (,,) <$> periodCount 1 dayMsgQueues <*> periodCount wDay weekMsgQueues <*> periodCount mDay monthMsgQueues
+          hPutStrLn h $ intercalate "," [iso8601Show $ utctDay fromTime', show qCreated', show qSecured', show qDeleted', show msgSent', show msgRecv', dayMsgQueues', weekMsgQueues', monthMsgQueues']
+          threadDelay interval
       where
         periodCount :: Int -> TVar (Set RecipientId) -> STM String
         periodCount 1 pVar = show . S.size <$> swapTVar pVar S.empty
@@ -198,10 +210,10 @@ smpServer started = do
         Left _ -> pure ()
 
 runClientTransport :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> m ()
-runClientTransport th@THandle {sessionId} = do
+runClientTransport th@THandle {thVersion, sessionId} = do
   q <- asks $ tbqSize . config
   ts <- liftIO getSystemTime
-  c <- atomically $ newClient q sessionId ts
+  c <- atomically $ newClient q thVersion sessionId ts
   s <- asks server
   expCfg <- asks $ inactiveClientExpiration . config
   raceAny_ ([send th c, client c s, receive th c] <> disconnectThread_ c expCfg)
@@ -233,26 +245,36 @@ cancelSub sub =
     Sub {subThread = SubThread t} -> liftIO $ deRefWeak t >>= mapM_ killThread
     _ -> return ()
 
-receive :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> Client -> m ()
+receive :: forall c m. (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> Client -> m ()
 receive th Client {rcvQ, sndQ, activeAt} = forever $ do
-  (sig, signed, (corrId, queueId, cmdOrError)) <- tGet th
+  ts <- L.toList <$> tGet th
   atomically . writeTVar activeAt =<< liftIO getSystemTime
-  case cmdOrError of
-    Left e -> write sndQ (corrId, queueId, ERR e)
-    Right cmd -> do
-      verified <- verifyTransmission sig signed queueId cmd
-      if verified
-        then write rcvQ (corrId, queueId, cmd)
-        else write sndQ (corrId, queueId, ERR AUTH)
+  as <- partitionEithers <$> mapM cmdAction ts
+  write sndQ $ fst as
+  write rcvQ $ snd as
   where
-    write q t = atomically $ writeTBQueue q t
+    cmdAction :: SignedTransmission Cmd -> m (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
+    cmdAction (sig, signed, (corrId, queueId, cmdOrError)) =
+      case cmdOrError of
+        Left e -> pure $ Left (corrId, queueId, ERR e)
+        Right cmd -> verified <$> verifyTransmission sig signed queueId cmd
+          where
+            verified = \case
+              VRVerified qr -> Right (qr, (corrId, queueId, cmd))
+              VRFailed -> Left (corrId, queueId, ERR AUTH)
+    write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
 send :: (Transport c, MonadUnliftIO m) => THandle c -> Client -> m ()
 send h@THandle {thVersion = v} Client {sndQ, sessionId, activeAt} = forever $ do
-  t <- atomically $ readTBQueue sndQ
-  -- TODO the line below can return Left, but we ignore it and do not disconnect the client
-  void . liftIO $ tPut h (Nothing, encodeTransmission v sessionId t)
+  ts <- atomically $ L.sortWith tOrder <$> readTBQueue sndQ
+  -- TODO the line below can return Lefts, but we ignore it and do not disconnect the client
+  void . liftIO . tPut h $ L.map ((Nothing,) . encodeTransmission v sessionId) ts
   atomically . writeTVar activeAt =<< liftIO getSystemTime
+  where
+    tOrder :: Transmission BrokerMsg -> Int
+    tOrder (_, _, cmd) = case cmd of
+      MSG {} -> 0
+      _ -> 1
 
 disconnectTransport :: (Transport c, MonadUnliftIO m) => THandle c -> client -> (client -> TVar SystemTime) -> ExpirationConfig -> m ()
 disconnectTransport THandle {connection} c activeAt expCfg = do
@@ -263,23 +285,28 @@ disconnectTransport THandle {connection} c activeAt expCfg = do
     ts <- readTVarIO $ activeAt c
     when (systemSeconds ts < old) $ closeConnection connection
 
+data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
+
 verifyTransmission ::
-  forall m. (MonadUnliftIO m, MonadReader Env m) => Maybe C.ASignature -> ByteString -> QueueId -> Cmd -> m Bool
+  forall m. (MonadUnliftIO m, MonadReader Env m) => Maybe C.ASignature -> ByteString -> QueueId -> Cmd -> m VerificationResult
 verifyTransmission sig_ signed queueId cmd = do
   case cmd of
-    Cmd SRecipient (NEW k _) -> pure $ 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 True
+    Cmd SSender PING -> pure $ VRVerified Nothing
     Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe . fmap notifierKey . notifier
   where
-    verifyCmd :: SParty p -> (QueueRec -> Bool) -> m Bool
+    verifyCmd :: SParty p -> (QueueRec -> Bool) -> m VerificationResult
     verifyCmd party f = do
       st <- asks queueStore
-      q <- atomically $ getQueue st party queueId
-      pure $ either (const $ maybe False (dummyVerifyCmd signed) sig_ `seq` False) f q
+      q_ <- atomically (getQueue st party queueId)
+      pure $ case q_ of
+        Right q -> Just q `verified` f q
+        _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` VRFailed
     verifyMaybe :: Maybe C.APublicVerifyKey -> Bool
     verifyMaybe = maybe (isNothing sig_) $ verifyCmdSignature sig_ signed
+    verified q cond = if cond then VRVerified q else VRFailed
 
 verifyCmdSignature :: Maybe C.ASignature -> ByteString -> C.APublicVerifyKey -> Bool
 verifyCmdSignature sig_ signed key = maybe False (verify key) sig_
@@ -307,19 +334,19 @@ dummyKeyEd448 :: C.PublicKey 'C.Ed448
 dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"
 
 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
-client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} =
+client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} =
   forever $
     atomically (readTBQueue rcvQ)
-      >>= processCommand
+      >>= mapM processCommand
       >>= atomically . writeTBQueue sndQ
   where
-    processCommand :: Transmission Cmd -> m (Transmission BrokerMsg)
-    processCommand (corrId, queueId, cmd) = do
+    processCommand :: (Maybe QueueRec, Transmission Cmd) -> m (Transmission BrokerMsg)
+    processCommand (qr_, (corrId, queueId, cmd)) = do
       st <- asks queueStore
       case cmd of
         Cmd SSender command ->
           case command of
-            SEND flags msgBody -> sendMessage st flags msgBody
+            SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
             PING -> pure (corrId, "", PONG)
         Cmd SNotifier NSUB -> subscribeNotifications
         Cmd SRecipient command ->
@@ -329,9 +356,9 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
                 (asks $ allowNewQueues . config)
                 (createQueue st rKey dhKey)
                 (pure (corrId, queueId, ERR AUTH))
-            SUB -> subscribeQueue queueId
-            GET -> getMessage
-            ACK msgId -> acknowledgeMsg msgId
+            SUB -> withQueue (`subscribeQueue` queueId)
+            GET -> withQueue getMessage
+            ACK msgId -> withQueue (`acknowledgeMsg` msgId)
             KEY sKey -> secureQueue_ st sKey
             NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
             NDEL -> deleteQueueNotifier_ st
@@ -361,14 +388,15 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
             addQueueRetry n qik qRec = do
               ids@(rId, _) <- getIds
               -- create QueueRec record with these ids and keys
-              atomically (addQueue st $ qRec ids) >>= \case
+              let qr = qRec ids
+              atomically (addQueue st qr) >>= \case
                 Left DUPLICATE_ -> addQueueRetry (n - 1) qik qRec
                 Left e -> pure $ ERR e
                 Right _ -> do
                   withLog (`logCreateById` rId)
                   stats <- asks serverStats
                   atomically $ modifyTVar (qCreated stats) (+ 1)
-                  subscribeQueue rId $> IDS (qik ids)
+                  subscribeQueue qr rId $> IDS (qik ids)
 
             logCreateById :: StoreLog 'WriteMode -> RecipientId -> IO ()
             logCreateById s rId =
@@ -416,8 +444,8 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
           withLog (`logDeleteQueue` queueId)
           okResp <$> atomically (suspendQueue st queueId)
 
-        subscribeQueue :: RecipientId -> m (Transmission BrokerMsg)
-        subscribeQueue rId =
+        subscribeQueue :: QueueRec -> RecipientId -> m (Transmission BrokerMsg)
+        subscribeQueue qr rId =
           atomically (TM.lookup rId subscriptions) >>= \case
             Nothing ->
               atomically newSub >>= deliver
@@ -439,10 +467,10 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
             deliver sub = do
               q <- getStoreMsgQueue rId
               msg_ <- atomically $ tryPeekMsg q
-              deliverMessage rId sub q msg_
+              deliverMessage qr rId sub q msg_
 
-        getMessage :: m (Transmission BrokerMsg)
-        getMessage =
+        getMessage :: QueueRec -> m (Transmission BrokerMsg)
+        getMessage qr =
           atomically (TM.lookup queueId subscriptions) >>= \case
             Nothing ->
               atomically newSub >>= getMessage_
@@ -465,9 +493,14 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
               q <- getStoreMsgQueue queueId
               atomically $
                 tryPeekMsg q >>= \case
-                  Just msg -> setDelivered s msg $> (corrId, queueId, msgCmd msg)
+                  Just msg ->
+                    let encMsg = encryptMsg qr msg
+                     in setDelivered s msg $> (corrId, queueId, MSG encMsg)
                   _ -> pure (corrId, queueId, OK)
 
+        withQueue :: (QueueRec -> m (Transmission BrokerMsg)) -> m (Transmission BrokerMsg)
+        withQueue action = maybe (pure $ err AUTH) action qr_
+
         subscribeNotifications :: m (Transmission BrokerMsg)
         subscribeNotifications = atomically $ do
           unlessM (TM.member queueId ntfSubscriptions) $ do
@@ -475,8 +508,8 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
             TM.insert queueId () ntfSubscriptions
           pure ok
 
-        acknowledgeMsg :: MsgId -> m (Transmission BrokerMsg)
-        acknowledgeMsg msgId = do
+        acknowledgeMsg :: QueueRec -> MsgId -> m (Transmission BrokerMsg)
+        acknowledgeMsg qr msgId = do
           atomically (TM.lookup queueId subscriptions) >>= \case
             Nothing -> pure $ err NO_MSG
             Just sub ->
@@ -491,7 +524,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
                     _ -> do
                       (msgDeleted, msg_) <- atomically $ tryDelPeekMsg q msgId
                       when msgDeleted updateStats
-                      deliverMessage queueId sub q msg_
+                      deliverMessage qr queueId sub q msg_
                 _ -> pure $ err NO_MSG
           where
             getDelivered :: TVar Sub -> STM (Maybe Sub)
@@ -515,68 +548,64 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
           where
             updatePeriod pSel = modifyTVar (pSel stats) (S.insert qId)
 
-        sendMessage :: QueueStore -> MsgFlags -> MsgBody -> m (Transmission BrokerMsg)
-        sendMessage st flags msgBody
+        sendMessage :: QueueRec -> MsgFlags -> MsgBody -> m (Transmission BrokerMsg)
+        sendMessage qr msgFlags msgBody
           | B.length msgBody > maxMessageLength = pure $ err LARGE_MSG
-          | otherwise = do
-            qr <- atomically $ getQueue st SSender queueId
-            either (return . err) storeMessage qr
+          | otherwise = case status qr of
+            QueueOff -> return $ err AUTH
+            QueueActive ->
+              mapM mkMessage (C.maxLenBS msgBody) >>= \case
+                Left _ -> pure $ err LARGE_MSG
+                Right msg -> do
+                  ms <- asks msgStore
+                  ServerConfig {messageExpiration, msgQueueQuota} <- asks config
+                  old <- liftIO $ mapM expireBeforeEpoch messageExpiration
+                  ntfNonceDrg <- asks idsDrg
+                  resp@(_, _, sent) <- atomically $ do
+                    q <- getMsgQueue ms (recipientId qr) msgQueueQuota
+                    mapM_ (deleteExpiredMsgs q) old
+                    ifM (isFull q) (pure $ err QUOTA) $ do
+                      when (notification msgFlags) $ trySendNotification msg ntfNonceDrg
+                      writeMsg q msg
+                      pure ok
+                  when (sent == OK) $ do
+                    stats <- asks serverStats
+                    atomically $ modifyTVar (msgSent stats) (+ 1)
+                    atomically $ updateActiveQueues stats $ recipientId qr
+                  pure resp
           where
-            storeMessage :: QueueRec -> m (Transmission BrokerMsg)
-            storeMessage qr = case status qr of
-              QueueOff -> return $ err AUTH
-              QueueActive ->
-                mkMessage >>= \case
-                  Left _ -> pure $ err LARGE_MSG
-                  Right msg -> do
-                    ms <- asks msgStore
-                    ServerConfig {messageExpiration, msgQueueQuota} <- asks config
-                    old <- liftIO $ mapM expireBeforeEpoch messageExpiration
-                    ntfNonceDrg <- asks idsDrg
-                    resp@(_, _, sent) <- atomically $ do
-                      q <- getMsgQueue ms (recipientId qr) msgQueueQuota
-                      mapM_ (deleteExpiredMsgs q) old
-                      ifM (isFull q) (pure $ err QUOTA) $ do
-                        when (notification flags) $ trySendNotification msg ntfNonceDrg
-                        writeMsg q msg
-                        pure ok
-                    when (sent == OK) $ do
-                      stats <- asks serverStats
-                      atomically $ modifyTVar (msgSent stats) (+ 1)
-                      atomically $ updateActiveQueues stats $ recipientId qr
-                    pure resp
-              where
-                mkMessage :: m (Either C.CryptoError Message)
-                mkMessage = do
-                  msgId <- randomId =<< asks (msgIdBytes . config)
-                  ts <- liftIO getSystemTime
-                  let c = C.cbEncrypt (rcvDhSecret qr) (C.cbNonce msgId) msgBody (maxMessageLength + 2)
-                  pure $ Message msgId ts flags <$> c
+            mkMessage :: C.MaxLenBS MaxMessageLen -> m Message
+            mkMessage body = do
+              msgId <- randomId =<< asks (msgIdBytes . config)
+              msgTs <- liftIO getSystemTime
+              pure $ Message msgId msgTs msgFlags body
 
-                trySendNotification :: Message -> TVar ChaChaDRG -> STM ()
-                trySendNotification msg ntfNonceDrg =
-                  forM_ (notifier qr) $ \NtfCreds {notifierId, rcvNtfDhSecret} ->
-                    mapM_ (writeNtf notifierId msg rcvNtfDhSecret ntfNonceDrg) =<< TM.lookup notifierId notifiers
+            trySendNotification :: Message -> TVar ChaChaDRG -> STM ()
+            trySendNotification msg ntfNonceDrg =
+              forM_ (notifier qr) $ \NtfCreds {notifierId, rcvNtfDhSecret} ->
+                mapM_ (writeNtf notifierId msg rcvNtfDhSecret ntfNonceDrg) =<< TM.lookup notifierId notifiers
 
-                writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar ChaChaDRG -> Client -> STM ()
-                writeNtf nId msg rcvNtfDhSecret ntfNonceDrg Client {sndQ = q} =
-                  unlessM (isFullTBQueue sndQ) $ do
-                    (nmsgNonce, encNMsgMeta) <- mkMessageNotification msg rcvNtfDhSecret ntfNonceDrg
-                    writeTBQueue q (CorrId "", nId, NMSG nmsgNonce encNMsgMeta)
+            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar ChaChaDRG -> Client -> STM ()
+            writeNtf nId msg rcvNtfDhSecret ntfNonceDrg Client {sndQ = q} =
+              unlessM (isFullTBQueue sndQ) $ do
+                (nmsgNonce, encNMsgMeta) <- mkMessageNotification msg rcvNtfDhSecret ntfNonceDrg
+                writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)]
 
-                mkMessageNotification :: Message -> RcvNtfDhSecret -> TVar ChaChaDRG -> STM (C.CbNonce, EncNMsgMeta)
-                mkMessageNotification Message {msgId, ts} rcvNtfDhSecret ntfNonceDrg = do
-                  cbNonce <- C.pseudoRandomCbNonce ntfNonceDrg
-                  let msgMeta = NMsgMeta {msgId, msgTs = ts}
-                      encNMsgMeta = C.cbEncrypt rcvNtfDhSecret cbNonce (smpEncode msgMeta) 128
-                  pure . (cbNonce,) $ fromRight "" encNMsgMeta
+            mkMessageNotification :: Message -> RcvNtfDhSecret -> TVar ChaChaDRG -> STM (C.CbNonce, EncNMsgMeta)
+            mkMessageNotification Message {msgId, msgTs} rcvNtfDhSecret ntfNonceDrg = do
+              cbNonce <- C.pseudoRandomCbNonce ntfNonceDrg
+              let msgMeta = NMsgMeta {msgId, msgTs}
+                  encNMsgMeta = C.cbEncrypt rcvNtfDhSecret cbNonce (smpEncode msgMeta) 128
+              pure . (cbNonce,) $ fromRight "" encNMsgMeta
 
-        deliverMessage :: RecipientId -> TVar Sub -> MsgQueue -> Maybe Message -> m (Transmission BrokerMsg)
-        deliverMessage rId sub q msg_ =
+        deliverMessage :: QueueRec -> RecipientId -> TVar Sub -> MsgQueue -> Maybe Message -> m (Transmission BrokerMsg)
+        deliverMessage qr rId sub q msg_ = do
           readTVarIO sub >>= \case
             s@Sub {subThread = NoSub} ->
               case msg_ of
-                Just msg -> atomically (setDelivered s msg) $> (corrId, rId, msgCmd msg)
+                Just msg ->
+                  let encMsg = encryptMsg qr msg
+                   in atomically (setDelivered s msg) $> (corrId, rId, MSG encMsg)
                 _ -> forkSub $> ok
             _ -> pure ok
           where
@@ -587,14 +616,24 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
               atomically . modifyTVar sub $ \case
                 s@Sub {subThread = SubPending} -> s {subThread = SubThread t}
                 s -> s
+              where
+                subscriber = atomically $ do
+                  msg <- peekMsg q
+                  let encMsg = encryptMsg qr msg
+                  writeTBQueue sndQ [(CorrId "", rId, MSG encMsg)]
+                  s <- readTVar sub
+                  void $ setDelivered s msg
+                  writeTVar sub s {subThread = NoSub}
 
-            subscriber :: m ()
-            subscriber = atomically $ do
-              msg <- peekMsg q
-              writeTBQueue sndQ (CorrId "", rId, msgCmd msg)
-              s <- readTVar sub
-              void $ setDelivered s msg
-              writeTVar sub s {subThread = NoSub}
+        encryptMsg :: QueueRec -> Message -> RcvMessage
+        encryptMsg qr Message {msgId, msgTs, msgFlags, msgBody}
+          | thVersion == 1 || thVersion == 2 = encrypt msgBody
+          | otherwise = encrypt $ encodeRcvMsgBody RcvMsgBody {msgTs, msgFlags, msgBody}
+          where
+            encrypt :: KnownNat i => C.MaxLenBS i -> RcvMessage
+            encrypt body =
+              let encBody = EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) (C.cbNonce msgId) body
+               in RcvMessage msgId msgTs msgFlags encBody
 
         setDelivered :: Sub -> Message -> STM Bool
         setDelivered s Message {msgId} = tryPutTMVar (delivered s) msgId
@@ -605,9 +644,6 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
           quota <- asks $ msgQueueQuota . config
           atomically $ getMsgQueue ms rId quota
 
-        msgCmd :: Message -> BrokerMsg
-        msgCmd Message {msgId, ts, msgFlags, msgBody} = MSG msgId ts msgFlags msgBody
-
         delQueueAndMsgs :: QueueStore -> m (Transmission BrokerMsg)
         delQueueAndMsgs st = do
           withLog (`logDeleteQueue` queueId)
@@ -638,33 +674,76 @@ randomId n = do
   gVar <- asks idsDrg
   atomically (C.pseudoRandomBytes n gVar)
 
-saveServerMessages :: forall m. (MonadUnliftIO m, MonadReader Env m) => m ()
+saveServerMessages :: (MonadUnliftIO m, MonadReader Env m) => m ()
 saveServerMessages = asks (storeMsgsFile . config) >>= mapM_ saveMessages
   where
     saveMessages f = do
-      liftIO $ putStrLn $ "saving messages to file " <> f
+      logInfo $ "saving messages to file " <> T.pack f
       ms <- asks msgStore
       liftIO . withFile f WriteMode $ \h ->
         readTVarIO ms >>= mapM_ (saveQueueMsgs ms h) . M.keys
+      logInfo "messages saved"
       where
         saveQueueMsgs ms h rId =
           atomically (flushMsgQueue ms rId)
-            >>= mapM_ (B.hPutStrLn h . strEncode . MsgLogRecord rId)
+            >>= mapM_ (B.hPutStrLn h . strEncode . MLRv3 rId)
 
 restoreServerMessages :: forall m. (MonadUnliftIO m, MonadReader Env m) => m ()
 restoreServerMessages = asks (storeMsgsFile . config) >>= mapM_ restoreMessages
   where
     restoreMessages f = whenM (doesFileExist f) $ do
-      liftIO $ putStrLn $ "restoring messages from file " <> f
+      logInfo $ "restoring messages from file " <> T.pack f
+      st <- asks queueStore
       ms <- asks msgStore
       quota <- asks $ msgQueueQuota . config
-      liftIO $ mapM_ (restoreMsg ms quota) . B.lines =<< B.readFile f
-      renameFile f $ f <> ".bak"
+      runExceptT (liftIO (B.readFile f) >>= mapM_ (restoreMsg st ms quota) . B.lines) >>= \case
+        Left e -> do
+          logError . T.pack $ "error restoring messages: " <> e
+          liftIO exitFailure
+        _ -> do
+          renameFile f $ f <> ".bak"
+          logInfo "messages restored"
       where
-        restoreMsg ms quota s = case strDecode s of
-          Left e -> B.putStrLn $ "message parsing error (" <> B.pack e <> "): " <> B.take 100 s
-          Right (MsgLogRecord rId msg) -> do
-            full <- atomically $ do
-              q <- getMsgQueue ms rId quota
-              ifM (isFull q) (pure True) (writeMsg q msg $> False)
-            when full . B.putStrLn $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (msgId (msg :: Message))
+        restoreMsg st ms quota s = do
+          r <- liftEither . first (msgErr "parsing") $ strDecode s
+          case r of
+            MLRv3 rId msg -> addToMsgQueue rId msg
+            MLRv1 rId encMsg -> do
+              qr <- liftEitherError (msgErr "queue unknown") . atomically $ getQueue st SRecipient rId
+              msg' <- updateMsgV1toV3 qr encMsg
+              addToMsgQueue rId msg'
+          where
+            addToMsgQueue rId msg = do
+              full <- atomically $ do
+                q <- getMsgQueue ms rId quota
+                ifM (isFull q) (pure True) (writeMsg q msg $> False)
+              when full . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (msgId (msg :: Message))
+            updateMsgV1toV3 QueueRec {rcvDhSecret} RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} = do
+              let nonce = C.cbNonce msgId
+              msgBody <- liftEither . first (msgErr "v1 message decryption") $ C.maxLenBS =<< C.cbDecrypt rcvDhSecret nonce body
+              pure Message {msgId, msgTs, msgFlags, msgBody}
+            msgErr :: Show e => String -> e -> String
+            msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
+
+saveServerStats :: (MonadUnliftIO m, MonadReader Env m) => m ()
+saveServerStats =
+  asks (serverStatsBackupFile . config)
+    >>= mapM_ (\f -> asks serverStats >>= atomically . getServerStatsData >>= liftIO . saveStats f)
+  where
+    saveStats f stats = do
+      logInfo $ "saving server stats to file " <> T.pack f
+      B.writeFile f $ strEncode stats
+      logInfo "server stats saved"
+
+restoreServerStats :: (MonadUnliftIO m, MonadReader Env m) => m ()
+restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
+  where
+    restoreStats f = whenM (doesFileExist f) $ do
+      logInfo $ "restoring server stats from file " <> T.pack f
+      liftIO (strDecode <$> B.readFile f) >>= \case
+        Right d -> do
+          s <- asks serverStats
+          atomically $ setServerStatsData s d
+          renameFile f $ f <> ".bak"
+          logInfo "server stats restored"
+        Left e -> logInfo $ "error restoring server stats: " <> T.pack e

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

@@ -2,7 +2,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Server.Env.STM where
 
@@ -10,11 +9,10 @@ import Control.Concurrent (ThreadId)
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
+import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Set (Set)
-import qualified Data.Set as S
-import Data.Time.Clock (UTCTime, getCurrentTime)
+import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (ServiceName)
@@ -26,6 +24,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
+import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -57,6 +56,10 @@ data ServerConfig = ServerConfig
     -- | time of the day when the stats are logged first, to log at consistent times,
     -- irrespective of when the server is started (seconds from 00:00 UTC)
     logStatsStartTime :: Int,
+    -- | file to log stats
+    serverStatsLogFile :: FilePath,
+    -- | file to save and restore stats
+    serverStatsBackupFile :: Maybe FilePath,
     -- | CA certificate private key is not needed for initialization
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
@@ -101,25 +104,14 @@ data Server = Server
 data Client = Client
   { subscriptions :: TMap RecipientId (TVar Sub),
     ntfSubscriptions :: TMap NotifierId (),
-    rcvQ :: TBQueue (Transmission Cmd),
-    sndQ :: TBQueue (Transmission BrokerMsg),
+    rcvQ :: TBQueue (NonEmpty (Maybe QueueRec, Transmission Cmd)),
+    sndQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
+    thVersion :: Version,
     sessionId :: ByteString,
     connected :: TVar Bool,
     activeAt :: TVar SystemTime
   }
 
-data ServerStats = ServerStats
-  { qCreated :: TVar Int,
-    qSecured :: TVar Int,
-    qDeleted :: TVar Int,
-    msgSent :: TVar Int,
-    msgRecv :: TVar Int,
-    dayMsgQueues :: TVar (Set RecipientId),
-    weekMsgQueues :: TVar (Set RecipientId),
-    monthMsgQueues :: TVar (Set RecipientId),
-    fromTime :: TVar UTCTime
-  }
-
 data SubscriptionThread = NoSub | SubPending | SubThread (Weak ThreadId) | ProhibitSub
 
 data Sub = Sub
@@ -135,28 +127,15 @@ newServer qSize = do
   notifiers <- TM.empty
   return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers}
 
-newClient :: Natural -> ByteString -> SystemTime -> STM Client
-newClient qSize sessionId ts = do
+newClient :: Natural -> Version -> ByteString -> SystemTime -> STM Client
+newClient qSize thVersion sessionId ts = do
   subscriptions <- TM.empty
   ntfSubscriptions <- TM.empty
   rcvQ <- newTBQueue qSize
   sndQ <- newTBQueue qSize
   connected <- newTVar True
   activeAt <- newTVar ts
-  return Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, connected, activeAt}
-
-newServerStats :: UTCTime -> STM ServerStats
-newServerStats ts = do
-  qCreated <- newTVar 0
-  qSecured <- newTVar 0
-  qDeleted <- newTVar 0
-  msgSent <- newTVar 0
-  msgRecv <- newTVar 0
-  dayMsgQueues <- newTVar S.empty
-  weekMsgQueues <- newTVar S.empty
-  monthMsgQueues <- newTVar S.empty
-  fromTime <- newTVar ts
-  pure ServerStats {qCreated, qSecured, qDeleted, msgSent, msgRecv, dayMsgQueues, weekMsgQueues, monthMsgQueues, fromTime}
+  return Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, thVersion, sessionId, connected, activeAt}
 
 newSubscription :: SubscriptionThread -> STM Sub
 newSubscription subThread = do

src/Simplex/Messaging/Server/MsgStore.hs

@@ -1,44 +1,22 @@
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Messaging.Server.MsgStore where
 
 import Control.Applicative ((<|>))
-import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
-import Data.Time.Clock.System (SystemTime)
 import Numeric.Natural
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (MsgBody, MsgFlags, MsgId, RecipientId, noMsgFlags)
+import Simplex.Messaging.Protocol (Message (..), MsgId, RcvMessage (..), RecipientId)
 
-data Message = Message
-  { msgId :: MsgId,
-    ts :: SystemTime,
-    msgFlags :: MsgFlags,
-    msgBody :: MsgBody
-  }
-
-instance StrEncoding Message where
-  strEncode Message {msgId, ts, msgFlags, msgBody} =
-    B.unwords
-      [ strEncode msgId,
-        strEncode ts,
-        "flags=" <> strEncode msgFlags,
-        strEncode msgBody
-      ]
-  strP = do
-    msgId <- strP_
-    ts <- strP_
-    msgFlags <- ("flags=" *> strP_) <|> pure noMsgFlags
-    msgBody <- strP
-    pure Message {msgId, ts, msgFlags, msgBody}
-
-data MsgLogRecord = MsgLogRecord RecipientId Message
+data MsgLogRecord = MLRv3 RecipientId Message | MLRv1 RecipientId RcvMessage
 
 instance StrEncoding MsgLogRecord where
-  strEncode (MsgLogRecord rId msg) = strEncode (rId, msg)
-  strP = MsgLogRecord <$> strP_ <*> strP
+  strEncode = \case
+    MLRv3 rId msg -> strEncode (Str "v3", rId, msg)
+    MLRv1 rId msg -> strEncode (rId, msg)
+  strP = "v3 " *> (MLRv3 <$> strP_ <*> strP) <|> MLRv1 <$> strP_ <*> strP
 
 class MonadMsgStore s q m | s -> q where
   getMsgQueue :: s -> RecipientId -> Natural -> m q

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

@@ -16,7 +16,7 @@ import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Numeric.Natural
-import Simplex.Messaging.Protocol (MsgId, RecipientId)
+import Simplex.Messaging.Protocol (Message (..), MsgId, RecipientId)
 import Simplex.Messaging.Server.MsgStore
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -78,6 +78,6 @@ instance MonadMsgQueue MsgQueue STM where
   deleteExpiredMsgs (MsgQueue q) old = loop
     where
       loop = tryPeekTBQueue q >>= mapM_ delOldMsg
-      delOldMsg Message {ts} =
-        when (systemSeconds ts < old) $
+      delOldMsg Message {msgTs} =
+        when (systemSeconds msgTs < old) $
           tryReadTBQueue q >> loop

src/Simplex/Messaging/Server/Stats.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Server.Stats where
+
+import Control.Applicative (optional)
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.ByteString.Char8 as B
+import Data.Set (Set)
+import qualified Data.Set as S
+import Data.Time.Clock (UTCTime)
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (RecipientId)
+import UnliftIO.STM
+
+data ServerStats = ServerStats
+  { fromTime :: TVar UTCTime,
+    qCreated :: TVar Int,
+    qSecured :: TVar Int,
+    qDeleted :: TVar Int,
+    msgSent :: TVar Int,
+    msgRecv :: TVar Int,
+    dayMsgQueues :: TVar (Set RecipientId),
+    weekMsgQueues :: TVar (Set RecipientId),
+    monthMsgQueues :: TVar (Set RecipientId)
+  }
+
+data ServerStatsData = ServerStatsData
+  { _fromTime :: UTCTime,
+    _qCreated :: Int,
+    _qSecured :: Int,
+    _qDeleted :: Int,
+    _msgSent :: Int,
+    _msgRecv :: Int,
+    _dayMsgQueues :: Set RecipientId,
+    _weekMsgQueues :: Set RecipientId,
+    _monthMsgQueues :: Set RecipientId
+  }
+
+newServerStats :: UTCTime -> STM ServerStats
+newServerStats ts = do
+  fromTime <- newTVar ts
+  qCreated <- newTVar 0
+  qSecured <- newTVar 0
+  qDeleted <- newTVar 0
+  msgSent <- newTVar 0
+  msgRecv <- newTVar 0
+  dayMsgQueues <- newTVar S.empty
+  weekMsgQueues <- newTVar S.empty
+  monthMsgQueues <- newTVar S.empty
+  pure ServerStats {fromTime, qCreated, qSecured, qDeleted, msgSent, msgRecv, dayMsgQueues, weekMsgQueues, monthMsgQueues}
+
+getServerStatsData :: ServerStats -> STM ServerStatsData
+getServerStatsData s = do
+  _fromTime <- readTVar $ fromTime s
+  _qCreated <- readTVar $ qCreated s
+  _qSecured <- readTVar $ qSecured s
+  _qDeleted <- readTVar $ qDeleted s
+  _msgSent <- readTVar $ msgSent s
+  _msgRecv <- readTVar $ msgRecv s
+  _dayMsgQueues <- readTVar $ dayMsgQueues s
+  _weekMsgQueues <- readTVar $ weekMsgQueues s
+  _monthMsgQueues <- readTVar $ monthMsgQueues s
+  pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeleted, _msgSent, _msgRecv, _dayMsgQueues, _weekMsgQueues, _monthMsgQueues}
+
+setServerStatsData :: ServerStats -> ServerStatsData -> STM ()
+setServerStatsData s d = do
+  writeTVar (fromTime s) (_fromTime d)
+  writeTVar (qCreated s) (_qCreated d)
+  writeTVar (qSecured s) (_qSecured d)
+  writeTVar (qDeleted s) (_qDeleted d)
+  writeTVar (msgSent s) (_msgSent d)
+  writeTVar (msgRecv s) (_msgRecv d)
+  writeTVar (dayMsgQueues s) (_dayMsgQueues d)
+  writeTVar (weekMsgQueues s) (_weekMsgQueues d)
+  writeTVar (monthMsgQueues s) (_monthMsgQueues d)
+
+instance StrEncoding ServerStatsData where
+  strEncode ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeleted, _msgSent, _msgRecv, _dayMsgQueues, _weekMsgQueues, _monthMsgQueues} =
+    B.unlines
+      [ "fromTime=" <> strEncode _fromTime,
+        "qCreated=" <> strEncode _qCreated,
+        "qSecured=" <> strEncode _qSecured,
+        "qDeleted=" <> strEncode _qDeleted,
+        "msgSent=" <> strEncode _msgSent,
+        "msgRecv=" <> strEncode _msgRecv,
+        "dayMsgQueues=" <> strEncode _dayMsgQueues,
+        "weekMsgQueues=" <> strEncode _weekMsgQueues,
+        "monthMsgQueues=" <> strEncode _monthMsgQueues
+      ]
+  strP = do
+    _fromTime <- "fromTime=" *> strP <* A.endOfLine
+    _qCreated <- "qCreated=" *> strP <* A.endOfLine
+    _qSecured <- "qSecured=" *> strP <* A.endOfLine
+    _qDeleted <- "qDeleted=" *> strP <* A.endOfLine
+    _msgSent <- "msgSent=" *> strP <* A.endOfLine
+    _msgRecv <- "msgRecv=" *> strP <* A.endOfLine
+    _dayMsgQueues <- "dayMsgQueues=" *> strP <* A.endOfLine
+    _weekMsgQueues <- "weekMsgQueues=" *> strP <* A.endOfLine
+    _monthMsgQueues <- "monthMsgQueues=" *> strP <* optional A.endOfLine
+    pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeleted, _msgSent, _msgRecv, _dayMsgQueues, _weekMsgQueues, _monthMsgQueues}

src/Simplex/Messaging/Server/StoreLog.hs

@@ -89,7 +89,7 @@ instance StrEncoding StoreLogRecord where
       <|> "SECURE " *> (SecureQueue <$> strP_ <*> strP)
       <|> "NOTIFIER " *> (AddNotifier <$> strP_ <*> strP)
       <|> "DELETE " *> (DeleteQueue <$> strP)
-      <|> "NDELETE" *> (DeleteNotifier <$> strP)
+      <|> "NDELETE " *> (DeleteNotifier <$> strP)
 
 openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
 openWriteStoreLog f = do

src/Simplex/Messaging/Transport.hs

@@ -46,12 +46,15 @@ module Simplex.Messaging.Transport
     -- * SMP transport
     THandle (..),
     TransportError (..),
+    HandshakeError (..),
     smpServerHandshake,
     smpClientHandshake,
     tPutBlock,
     tGetBlock,
     serializeTransportError,
     transportErrorP,
+    sendHandshake,
+    getHandshake,
 
     -- * Trim trailing CR
     trimCR,
@@ -93,10 +96,10 @@ smpBlockSize :: Int
 smpBlockSize = 16384
 
 supportedSMPServerVRange :: VersionRange
-supportedSMPServerVRange = mkVersionRange 1 2
+supportedSMPServerVRange = mkVersionRange 1 4
 
 simplexMQVersion :: String
-simplexMQVersion = "3.0.0-beta.3"
+simplexMQVersion = "3.1.0"
 
 -- * Transport connection class
 
@@ -255,7 +258,10 @@ data THandle c = THandle
     sessionId :: SessionId,
     blockSize :: Int,
     -- | agreed server protocol version
-    thVersion :: Version
+    thVersion :: Version,
+    -- | send multiple transmissions in a single block
+    -- based on protocol and protocol version
+    batch :: Bool
   }
 
 -- | TLS-unique channel binding
@@ -361,7 +367,7 @@ smpServerHandshake c kh smpVRange = do
       | keyHash /= kh ->
         throwE $ TEHandshake IDENTITY
       | smpVersion `isCompatible` smpVRange -> do
-        pure (th :: THandle c) {thVersion = smpVersion}
+        pure $ smpThHandle th smpVersion
       | otherwise -> throwE $ TEHandshake VERSION
 
 -- | Client SMP transport handshake.
@@ -376,9 +382,12 @@ smpClientHandshake c keyHash smpVRange = do
     else case smpVersionRange `compatibleVersion` smpVRange of
       Just (Compatible smpVersion) -> do
         sendHandshake th $ ClientHandshake {smpVersion, keyHash}
-        pure (th :: THandle c) {thVersion = smpVersion}
+        pure $ smpThHandle th smpVersion
       Nothing -> throwE $ TEHandshake VERSION
 
+smpThHandle :: forall c. THandle c -> Version -> THandle c
+smpThHandle th v = (th :: THandle c) {thVersion = v, batch = v >= 4}
+
 sendHandshake :: (Transport c, Encoding smp) => THandle c -> smp -> ExceptT TransportError IO ()
 sendHandshake th = ExceptT . tPutBlock th . smpEncode
 
@@ -386,4 +395,4 @@ getHandshake :: (Transport c, Encoding smp) => THandle c -> ExceptT TransportErr
 getHandshake th = ExceptT $ (parse smpP (TEHandshake PARSE) =<<) <$> tGetBlock th
 
 smpTHandle :: Transport c => c -> THandle c
-smpTHandle c = THandle {connection = c, sessionId = tlsUnique c, blockSize = smpBlockSize, thVersion = 0}
+smpTHandle c = THandle {connection = c, sessionId = tlsUnique c, blockSize = smpBlockSize, thVersion = 0, batch = False}

src/Simplex/Messaging/Transport/Client.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Transport.Client

src/Simplex/Messaging/Util.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 

tests/AgentTests.hs

@@ -325,11 +325,11 @@ testServerConnectionAfterError t _ = do
       bob #: ("1", "alice", "SUB") #> ("1", "alice", ERR (BROKER NETWORK))
       alice #: ("1", "bob", "SUB") #> ("1", "bob", ERR (BROKER NETWORK))
       withServer $ do
-        alice <# ("", "bob", SENT 4)
+        alice <#= \case ("", "bob", SENT 4) -> True; ("", "", UP s ["bob"]) -> s == server; _ -> False
+        alice <#= \case ("", "bob", SENT 4) -> True; ("", "", UP s ["bob"]) -> s == server; _ -> False
         bob <# ("", "", UP server ["alice"])
         bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
         bob #: ("2", "alice", "ACK 4") #> ("2", "alice", OK)
-        alice <# ("", "", UP server ["bob"])
         alice #: ("1", "bob", "SEND F 11\nhello again") #> ("1", "bob", MID 5)
         alice <# ("", "bob", SENT 5)
         bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False

tests/AgentTests/ConnectionRequestTests.hs

@@ -19,12 +19,7 @@ uri :: String
 uri = "smp.simplex.im"
 
 srv :: SMPServer
-srv =
-  ProtocolServer
-    { host = "smp.simplex.im",
-      port = "5223",
-      keyHash = C.KeyHash "\215m\248\251"
-    }
+srv = SMPServer "smp.simplex.im" "5223" (C.KeyHash "\215m\248\251")
 
 queue :: SMPQueueUri
 queue =

tests/AgentTests/FunctionalAPITests.hs

@@ -17,12 +17,16 @@ module AgentTests.FunctionalAPITests
   )
 where
 
-import Control.Concurrent (threadDelay)
+import Control.Concurrent (killThread, threadDelay)
+import Control.Monad
 import Control.Monad.Except (ExceptT, runExceptT)
 import Control.Monad.IO.Unlift
+import Data.Int (Int64)
+import qualified Data.Map as M
+import qualified Data.Set as S
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import SMPAgentClient
-import SMPClient (cfg, testPort, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
+import SMPClient (cfg, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
@@ -102,6 +106,9 @@ functionalAPITests t = do
       testSuspendingAgentCompleteSending t
     it "should suspend agent on timeout, even if pending messages not sent" $
       testSuspendingAgentTimeout t
+  describe "Batching SMP commands" $ do
+    it "should subscribe to multiple subscriptions with batching" $
+      testBatchedSubscriptions t
 
 testAgentClient :: IO ()
 testAgentClient = do
@@ -469,7 +476,7 @@ testSuspendingAgentCompleteSending t = do
   Right () <- withSmpServerStoreLogOn t testPort $ \_ -> runExceptT $ do
     get b =##> \case ("", c, SENT 5) -> c == aId; ("", "", UP {}) -> True; _ -> False
     get b =##> \case ("", c, SENT 5) -> c == aId; ("", "", UP {}) -> True; _ -> False
-    get b =##> \case ("", c, SENT 6) -> c == aId; _ -> False
+    get b =##> \case ("", c, SENT 6) -> c == aId; ("", "", UP {}) -> True; _ -> False
     ("", "", SUSPENDED) <- get b
 
     ("", "", UP {}) <- get a
@@ -503,13 +510,64 @@ testSuspendingAgentTimeout t = do
 
   pure ()
 
+testBatchedSubscriptions :: ATransport -> IO ()
+testBatchedSubscriptions t = do
+  a <- getSMPAgentClient agentCfg initAgentServers2
+  b <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers2
+  Right conns <- runServers $ do
+    conns <- forM [1 .. 200 :: Int] . const $ makeConnection a b
+    forM_ conns $ \(aId, bId) -> exchangeGreetings a bId b aId
+    forM_ (take 10 conns) $ \(aId, bId) -> do
+      deleteConnection a bId
+      deleteConnection b aId
+    liftIO $ threadDelay 1000000
+    pure conns
+  ("", "", DOWN {}) <- get a
+  ("", "", DOWN {}) <- get a
+  ("", "", DOWN {}) <- get b
+  ("", "", DOWN {}) <- get b
+  Right () <- runServers $ do
+    ("", "", UP {}) <- get a
+    ("", "", UP {}) <- get a
+    ("", "", UP {}) <- get b
+    ("", "", UP {}) <- get b
+    liftIO $ threadDelay 1000000
+    subscribe a $ map snd conns
+    subscribe b $ map fst conns
+    forM_ (drop 10 conns) $ \(aId, bId) -> exchangeGreetingsMsgId 6 a bId b aId
+  pure ()
+  where
+    subscribe :: AgentClient -> [ConnId] -> ExceptT AgentErrorType IO ()
+    subscribe c cs = do
+      r <- subscribeConnections c cs
+      liftIO $ do
+        let dc = S.fromList $ take 10 cs
+        all (== Right ()) (M.withoutKeys r dc) `shouldBe` True
+        all (== Left (CONN NOT_FOUND)) (M.restrictKeys r dc) `shouldBe` True
+        M.keys r `shouldMatchList` cs
+    runServers :: ExceptT AgentErrorType IO a -> IO (Either AgentErrorType a)
+    runServers a = do
+      withSmpServerStoreLogOn t testPort $ \t1 -> do
+        res <- withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \t2 -> do
+          res <- runExceptT a
+          killThread t2
+          pure res
+        killThread t1
+        pure res
+
 exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
-exchangeGreetings alice bobId bob aliceId = do
-  4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
-  get alice ##> ("", bobId, SENT 4)
+exchangeGreetings = exchangeGreetingsMsgId 4
+
+exchangeGreetingsMsgId :: Int64 -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
+exchangeGreetingsMsgId msgId alice bobId bob aliceId = do
+  msgId1 <- sendMessage alice bobId SMP.noMsgFlags "hello"
+  liftIO $ msgId1 `shouldBe` msgId
+  get alice ##> ("", bobId, SENT msgId)
   get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
-  ackMessage bob aliceId 4
-  5 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
-  get bob ##> ("", aliceId, SENT 5)
+  ackMessage bob aliceId msgId
+  msgId2 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
+  let msgId' = msgId + 1
+  liftIO $ msgId2 `shouldBe` msgId'
+  get bob ##> ("", aliceId, SENT msgId')
   get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
-  ackMessage alice bobId 5
+  ackMessage alice bobId msgId'

tests/AgentTests/NotificationTests.hs

@@ -14,19 +14,21 @@ import Control.Concurrent (killThread, threadDelay)
 import Control.Monad.Except
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
-import Data.Bifunctor (bimap)
+import Data.Bifunctor (bimap, first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import Data.Text.Encoding (encodeUtf8)
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, testDB, testDB2)
-import SMPClient (withSmpServer)
+import SMPClient (testPort, withSmpServer, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS
+import Simplex.Messaging.Notifications.Types (NtfToken (..))
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), SMPMsgMeta (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (ATransport)
@@ -73,11 +75,15 @@ notificationTests t =
         withSmpServer t $
           withAPNSMockServer $ \apns ->
             withNtfServer t $ testChangeToken apns
-    describe "Notifications server store log" $ do
+    describe "Notifications server store log" $
       it "should save and restore tokens and subscriptions" $ \_ ->
         withSmpServer t $
           withAPNSMockServer $ \apns ->
             testNotificationsStoreLog t apns
+    describe "Notifications after SMP server restart" $
+      it "should resume subscriptions after SMP server is restarted" $ \_ ->
+        withAPNSMockServer $ \apns ->
+          withNtfServer t $ testNotificationsSMPRestart t apns
 
 testNotificationToken :: APNSMockServer -> IO ()
 testNotificationToken APNSMockServer {apnsQ} = do
@@ -268,25 +274,31 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} = do
     (bobId, qInfo) <- createConnection alice SCMInvitation
     liftIO $ threadDelay 500000
     aliceId <- joinConnection bob qInfo "bob's connInfo"
+    liftIO $ print 0
     void $ messageNotification apnsQ
     ("", _, CONF confId "bob's connInfo") <- get alice
     liftIO $ threadDelay 500000
     allowConnection alice bobId confId "alice's connInfo"
+    liftIO $ print 1
     void $ messageNotification apnsQ
     get bob ##> ("", aliceId, INFO "alice's connInfo")
+    liftIO $ print 2
     void $ messageNotification apnsQ
     get alice ##> ("", bobId, CON)
+    liftIO $ print 3
     void $ messageNotification apnsQ
     get bob ##> ("", aliceId, CON)
     -- bob sends message
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
+    liftIO $ print 4
     void $ messageNotification apnsQ
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId $ baseId + 1
     -- alice sends message
     2 <- msgId <$> sendMessage alice bobId (SMP.MsgFlags True) "hey there"
     get alice ##> ("", bobId, SENT $ baseId + 2)
+    liftIO $ print 5
     void $ messageNotification apnsQ
     get bob =##> \case ("", c, Msg "hey there") -> c == aliceId; _ -> False
     ackMessage bob aliceId $ baseId + 2
@@ -424,8 +436,8 @@ testNotificationsStoreLog t APNSMockServer {apnsQ} = do
   alice <- getSMPAgentClient agentCfg initAgentServers
   bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
   Right (aliceId, bobId) <- withNtfServerStoreLog t $ \threadId -> runExceptT $ do
-    _ <- registerTestToken alice "abcd" NMInstant apnsQ
     (aliceId, bobId) <- makeConnection alice bob
+    _ <- registerTestToken alice "abcd" NMInstant apnsQ
     liftIO $ threadDelay 250000
     4 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT 4)
@@ -446,9 +458,40 @@ testNotificationsStoreLog t APNSMockServer {apnsQ} = do
     liftIO $ killThread threadId
   pure ()
 
+testNotificationsSMPRestart :: ATransport -> APNSMockServer -> IO ()
+testNotificationsSMPRestart t APNSMockServer {apnsQ} = do
+  alice <- getSMPAgentClient agentCfg initAgentServers
+  bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
+  Right (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \threadId -> runExceptT $ do
+    (aliceId, bobId) <- makeConnection alice bob
+    _ <- registerTestToken alice "abcd" NMInstant apnsQ
+    liftIO $ threadDelay 250000
+    4 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
+    get bob ##> ("", aliceId, SENT 4)
+    void $ messageNotification apnsQ
+    get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
+    ackMessage alice bobId 4
+    liftIO $ killThread threadId
+    pure (aliceId, bobId)
+
+  Right () <- runExceptT $ do
+    get alice =##> \case ("", "", DOWN _ [c]) -> c == bobId; _ -> False
+    get bob =##> \case ("", "", DOWN _ [c]) -> c == aliceId; _ -> False
+
+  Right () <- withSmpServerStoreLogOn t testPort $ \threadId -> runExceptT $ do
+    get alice =##> \case ("", "", UP _ [c]) -> c == bobId; _ -> False
+    get bob =##> \case ("", "", UP _ [c]) -> c == aliceId; _ -> False
+    liftIO $ threadDelay 1000000
+    5 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
+    get bob ##> ("", aliceId, SENT 5)
+    _ <- messageNotificationData alice apnsQ
+    get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
+    liftIO $ killThread threadId
+  pure ()
+
 messageNotification :: TBQueue APNSMockRequest -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
 messageNotification apnsQ = do
-  500000 `timeout` atomically (readTBQueue apnsQ) >>= \case
+  1000000 `timeout` atomically (readTBQueue apnsQ) >>= \case
     Nothing -> error "no notification"
     Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}, sendApnsResponse} -> do
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
@@ -457,6 +500,13 @@ messageNotification apnsQ = do
       pure (nonce, message)
     _ -> error "bad notification"
 
+messageNotificationData :: AgentClient -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO PNMessageData
+messageNotificationData c apnsQ = do
+  (nonce, message) <- messageNotification apnsQ
+  NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
+  Right pnMsgData <- liftEither . first INTERNAL $ Right . strDecode =<< first show (C.cbDecrypt dhSecret nonce message)
+  pure pnMsgData
+
 noNotification :: TBQueue APNSMockRequest -> ExceptT AgentErrorType IO ()
 noNotification apnsQ = do
   500000 `timeout` atomically (readTBQueue apnsQ) >>= \case

tests/NtfClient.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -140,10 +141,10 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
   where
     tPut' h (sig, corrId, queueId, smp) = do
       let t' = smpEncode (sessionId (h :: THandle c), corrId, queueId, smp)
-      Right () <- tPut h (sig, t')
+      [Right ()] <- tPut h [(sig, t')]
       pure ()
     tGet' h = do
-      (Nothing, _, (CorrId corrId, qId, Right cmd)) <- tGet h
+      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
       pure (Nothing, corrId, qId, cmd)
 
 ntfTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation

tests/NtfServerTests.hs

@@ -13,6 +13,7 @@ import Control.Concurrent (threadDelay)
 import Control.Monad.Except (runExceptT)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
+import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import Data.Text.Encoding (encodeUtf8)
@@ -24,6 +25,8 @@ import ServerTests
     samplePubKey,
     sampleSig,
     signSendRecv,
+    tGet1,
+    tPut1,
     (#==),
     _SEND',
     pattern Resp,
@@ -35,7 +38,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import qualified Simplex.Messaging.Notifications.Server.Push.APNS as APNS
-import Simplex.Messaging.Parsers (parse)
+import Simplex.Messaging.Parsers (parse, parseAll)
 import Simplex.Messaging.Protocol hiding (notification)
 import Simplex.Messaging.Transport
 import Test.Hspec
@@ -68,15 +71,15 @@ pattern RespNtf corrId queueId command <- (_, _, (corrId, queueId, Right command
 sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandle c -> (Maybe C.ASignature, ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission NtfResponse)
 sendRecvNtf h@THandle {thVersion, sessionId} (sgn, corrId, qId, cmd) = do
   let t = encodeTransmission thVersion sessionId (CorrId corrId, qId, cmd)
-  Right () <- tPut h (sgn, t)
-  tGet h
+  Right () <- tPut1 h (sgn, t)
+  tGet1 h
 
 signSendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandle c -> C.APrivateSignKey -> (ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission NtfResponse)
 signSendRecvNtf h@THandle {thVersion, sessionId} pk (corrId, qId, cmd) = do
   let t = encodeTransmission thVersion sessionId (CorrId corrId, qId, cmd)
   Right sig <- runExceptT $ C.sign pk t
-  Right () <- tPut h (Just sig, t)
-  tGet h
+  Right () <- tPut1 h (Just sig, t)
+  tGet1 h
 
 (.->) :: J.Value -> J.Key -> Either String ByteString
 v .-> key =
@@ -131,11 +134,11 @@ testNotificationSubscription (ATransport t) =
           notifierId `shouldBe` nId
           send' APNSRespOk
           -- receive message
-          Resp "" _ (MSG mId1 mTs _ msg1) <- tGet rh
+          Resp "" _ (MSG RcvMessage {msgId = mId1, msgBody = EncRcvMsgBody body}) <- tGet1 rh
+          Right ClientRcvMsgBody {msgTs = mTs, msgBody} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId1) body)
           mId1 `shouldBe` msgId
           mTs `shouldBe` msgTs
-          let decryptedMsg = C.cbDecrypt rcvDhSecret (C.cbNonce mId1) msg1
-          (decryptedMsg, Right "hello") #== "delivered from queue"
+          (msgBody, "hello") #== "delivered from queue"
           Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, ACK mId1)
           pure ()
           -- replace token

tests/SMPAgentClient.hs

@@ -158,13 +158,19 @@ smpAgentTest1_1_1 test' =
 testSMPServer :: SMPServer
 testSMPServer = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"
 
+testSMPServer2 :: SMPServer
+testSMPServer2 = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5002"
+
 initAgentServers :: InitialAgentServers
 initAgentServers =
   InitialAgentServers
     { smp = L.fromList [testSMPServer],
-      ntf = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"]
+      ntf = ["ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"]
     }
 
+initAgentServers2 :: InitialAgentServers
+initAgentServers2 = initAgentServers {smp = L.fromList [testSMPServer, testSMPServer2]}
+
 agentCfg :: AgentConfig
 agentCfg =
   defaultAgentConfig

tests/SMPClient.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -22,6 +23,7 @@ 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
 import qualified UnliftIO.Exception as E
@@ -43,9 +45,15 @@ testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
 testStoreLogFile :: FilePath
 testStoreLogFile = "tests/tmp/smp-server-store.log"
 
+testStoreLogFile2 :: FilePath
+testStoreLogFile2 = "tests/tmp/smp-server-store.log.2"
+
 testStoreMsgsFile :: FilePath
 testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
 
+testServerStatsBackupFile :: FilePath
+testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"
+
 testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testSMPClient client =
   runTransportClient testHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
@@ -53,6 +61,9 @@ testSMPClient client =
       Right th -> client th
       Left e -> error $ show e
 
+cfgV2 :: ServerConfig
+cfgV2 = cfg {smpServerVRange = mkVersionRange 1 2}
+
 cfg :: ServerConfig
 cfg =
   ServerConfig
@@ -69,17 +80,22 @@ cfg =
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
+      serverStatsLogFile = "tests/smp-server-stats.daily.log",
+      serverStatsBackupFile = Nothing,
       caCertificateFile = "tests/fixtures/ca.crt",
       privateKeyFile = "tests/fixtures/server.key",
       certificateFile = "tests/fixtures/server.crt",
       smpServerVRange = supportedSMPServerVRange
     }
 
+withSmpServerStoreMsgLogOnV2 :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
+withSmpServerStoreMsgLogOnV2 t = withSmpServerConfigOn t cfgV2 {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile}
+
 withSmpServerStoreMsgLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile}
+withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
 
 withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile}
+withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, serverStatsBackupFile = Just testServerStatsBackupFile}
 
 withSmpServerConfigOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServerConfig -> ServiceName -> (ThreadId -> m a) -> m a
 withSmpServerConfigOn t cfg' port' =
@@ -129,10 +145,10 @@ smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
   where
     tPut' h (sig, corrId, queueId, smp) = do
       let t' = smpEncode (sessionId (h :: THandle c), corrId, queueId, smp)
-      Right () <- tPut h (sig, t')
+      [Right ()] <- tPut h [(sig, t')]
       pure ()
     tGet' h = do
-      (Nothing, _, (CorrId corrId, qId, Right cmd)) <- tGet h
+      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
       pure (Nothing, corrId, qId, cmd)
 
 smpTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation

tests/ServerTests.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -13,6 +15,8 @@ import Control.Concurrent (ThreadId, killThread, threadDelay)
 import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
 import Control.Monad.Except (forM, forM_, runExceptT)
+import Control.Monad.IO.Class
+import Data.Bifunctor (first)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -20,6 +24,7 @@ import SMPClient
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
@@ -34,7 +39,8 @@ serverTests :: ATransport -> Spec
 serverTests t@(ATransport t') = do
   describe "SMP syntax" $ syntaxTests t
   describe "SMP queues" $ do
-    describe "NEW and KEY commands, SEND messages" $ testCreateSecure t
+    describe "NEW and KEY commands, SEND messages (v2)" $ testCreateSecureV2 t'
+    describe "NEW and KEY commands, SEND messages (v3)" $ testCreateSecure t
     describe "NEW, OFF and DEL commands, SEND messages" $ testCreateDelete t
     describe "Stress test" $ stressTest t
     describe "allowNewQueues setting" $ testAllowNewQueues t'
@@ -45,6 +51,7 @@ serverTests t@(ATransport t') = do
     describe "GET & SUB commands" $ testGetSubCommands t'
   describe "Store log" $ testWithStoreLog t
   describe "Restore messages" $ testRestoreMessages t
+  describe "Restore messages (v2)" $ testRestoreMessagesV2 t
   describe "Timing of AUTH error" $ testTiming t
   describe "Message notifications" $ testMessageNotifications t
   describe "Message expiration" $ do
@@ -58,18 +65,31 @@ pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command))
 pattern Ids :: RecipientId -> SenderId -> RcvPublicDhKey -> BrokerMsg
 pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh)
 
+pattern Msg :: MsgId -> MsgBody -> BrokerMsg
+pattern Msg msgId body <- MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body}
+
 sendRecv :: forall c p. (Transport c, PartyI p) => THandle c -> (Maybe C.ASignature, ByteString, ByteString, Command p) -> IO (SignedTransmission BrokerMsg)
 sendRecv h@THandle {thVersion, sessionId} (sgn, corrId, qId, cmd) = do
   let t = encodeTransmission thVersion sessionId (CorrId corrId, qId, cmd)
-  Right () <- tPut h (sgn, t)
-  tGet h
+  Right () <- tPut1 h (sgn, t)
+  tGet1 h
 
 signSendRecv :: forall c p. (Transport c, PartyI p) => THandle c -> C.APrivateSignKey -> (ByteString, ByteString, Command p) -> IO (SignedTransmission BrokerMsg)
 signSendRecv h@THandle {thVersion, sessionId} pk (corrId, qId, cmd) = do
   let t = encodeTransmission thVersion sessionId (CorrId corrId, qId, cmd)
   Right sig <- runExceptT $ C.sign pk t
-  Right () <- tPut h (Just sig, t)
-  tGet h
+  Right () <- tPut1 h (Just sig, t)
+  tGet1 h
+
+tPut1 :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
+tPut1 h t = do
+  [r] <- tPut h [t]
+  pure r
+
+tGet1 :: (ProtocolEncoding cmd, Transport c, MonadIO m, MonadFail m) => THandle c -> m (SignedTransmission cmd)
+tGet1 h = do
+  [r] <- tGet h
+  pure r
 
 (#==) :: (HasCallStack, Eq a, Show a) => (a, a) -> String -> Assertion
 (actual, expected) #== message = assertEqual message expected actual
@@ -80,21 +100,29 @@ _SEND = SEND noMsgFlags
 _SEND' :: MsgBody -> Command 'Sender
 _SEND' = SEND MsgFlags {notification = True}
 
-testCreateSecure :: ATransport -> Spec
-testCreateSecure (ATransport t) =
+decryptMsgV2 :: C.DhSecret 'C.X25519 -> ByteString -> ByteString -> Either C.CryptoError ByteString
+decryptMsgV2 dhShared = C.cbDecrypt dhShared . C.cbNonce
+
+decryptMsgV3 :: C.DhSecret 'C.X25519 -> ByteString -> ByteString -> Either String MsgBody
+decryptMsgV3 dhShared nonce body = do
+  ClientRcvMsgBody {msgBody} <- parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt dhShared (C.cbNonce nonce) body)
+  pure msgBody
+
+testCreateSecureV2 :: forall c. Transport c => TProxy c -> Spec
+testCreateSecureV2 _ =
   it "should create (NEW) and secure (KEY) queue" $
-    smpTest t $ \h -> do
+    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)
-      let dec nonce = C.cbDecrypt (C.dh' srvDh dhPriv) (C.cbNonce nonce)
+      let dec = decryptMsgV2 $ C.dh' srvDh dhPriv
       (rId1, "") #== "creates queue"
 
       Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, _SEND "hello")
       (ok1, OK) #== "accepts unsigned SEND"
       (sId1, sId) #== "same queue ID in response 1"
 
-      Resp "" _ (MSG mId1 _ _ msg1) <- tGet h
+      Resp "" _ (Msg mId1 msg1) <- tGet1 h
       (dec mId1 msg1, Right "hello") #== "delivers message"
 
       Resp "cdab" _ ok4 <- signSendRecv h rKey ("cdab", rId, ACK mId1)
@@ -124,7 +152,7 @@ testCreateSecure (ATransport t) =
       Resp "bcda" _ ok3 <- signSendRecv h sKey ("bcda", sId, _SEND "hello again")
       (ok3, OK) #== "accepts signed SEND"
 
-      Resp "" _ (MSG mId2 _ _ msg2) <- tGet h
+      Resp "" _ (Msg mId2 msg2) <- tGet1 h
       (dec mId2 msg2, Right "hello again") #== "delivers message 2"
 
       Resp "cdab" _ ok5 <- signSendRecv h rKey ("cdab", rId, ACK mId2)
@@ -133,6 +161,77 @@ testCreateSecure (ATransport t) =
       Resp "dabc" _ err5 <- sendRecv h ("", "dabc", sId, _SEND "hello")
       (err5, ERR AUTH) #== "rejects unsigned SEND"
 
+      let maxAllowedMessage = B.replicate maxMessageLength '-'
+      Resp "bcda" _ OK <- signSendRecv h sKey ("bcda", sId, _SEND maxAllowedMessage)
+      Resp "" _ (Msg mId3 msg3) <- tGet1 h
+      (dec mId3 msg3, Right maxAllowedMessage) #== "delivers message of max size"
+
+      let biggerMessage = B.replicate (maxMessageLength + 1) '-'
+      Resp "bcda" _ (ERR LARGE_MSG) <- signSendRecv h sKey ("bcda", sId, _SEND biggerMessage)
+      pure ()
+
+testCreateSecure :: ATransport -> Spec
+testCreateSecure (ATransport t) =
+  it "should create (NEW) and secure (KEY) queue" $
+    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)
+      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
+      (rId1, "") #== "creates queue"
+
+      Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, _SEND "hello")
+      (ok1, OK) #== "accepts unsigned SEND"
+      (sId1, sId) #== "same queue ID in response 1"
+
+      Resp "" _ (Msg mId1 msg1) <- tGet1 h
+      (dec mId1 msg1, Right "hello") #== "delivers message"
+
+      Resp "cdab" _ ok4 <- signSendRecv h rKey ("cdab", rId, ACK mId1)
+      (ok4, OK) #== "replies OK when message acknowledged if no more messages"
+
+      Resp "dabc" _ err6 <- signSendRecv h rKey ("dabc", rId, ACK mId1)
+      (err6, ERR NO_MSG) #== "replies ERR when message acknowledged without messages"
+
+      (sPub, sKey) <- C.generateSignatureKeyPair C.SEd448
+      Resp "abcd" sId2 err1 <- signSendRecv h sKey ("abcd", sId, _SEND "hello")
+      (err1, ERR AUTH) #== "rejects signed SEND"
+      (sId2, sId) #== "same queue ID in response 2"
+
+      Resp "bcda" _ err2 <- sendRecv h (sampleSig, "bcda", rId, KEY sPub)
+      (err2, ERR AUTH) #== "rejects KEY with wrong signature"
+
+      Resp "cdab" _ err3 <- signSendRecv h rKey ("cdab", sId, KEY sPub)
+      (err3, ERR AUTH) #== "rejects KEY with sender's ID"
+
+      Resp "dabc" rId2 ok2 <- signSendRecv h rKey ("dabc", rId, KEY sPub)
+      (ok2, OK) #== "secures queue"
+      (rId2, rId) #== "same queue ID in response 3"
+
+      Resp "abcd" _ err4 <- signSendRecv h rKey ("abcd", rId, KEY sPub)
+      (err4, ERR AUTH) #== "rejects KEY if already secured"
+
+      Resp "bcda" _ ok3 <- signSendRecv h sKey ("bcda", sId, _SEND "hello again")
+      (ok3, OK) #== "accepts signed SEND"
+
+      Resp "" _ (Msg mId2 msg2) <- tGet1 h
+      (dec mId2 msg2, Right "hello again") #== "delivers message 2"
+
+      Resp "cdab" _ ok5 <- signSendRecv h rKey ("cdab", rId, ACK mId2)
+      (ok5, OK) #== "replies OK when message acknowledged 2"
+
+      Resp "dabc" _ err5 <- sendRecv h ("", "dabc", sId, _SEND "hello")
+      (err5, ERR AUTH) #== "rejects unsigned SEND"
+
+      let maxAllowedMessage = B.replicate maxMessageLength '-'
+      Resp "bcda" _ OK <- signSendRecv h sKey ("bcda", sId, _SEND maxAllowedMessage)
+      Resp "" _ (Msg mId3 msg3) <- tGet1 h
+      (dec mId3 msg3, Right maxAllowedMessage) #== "delivers message of max size"
+
+      let biggerMessage = B.replicate (maxMessageLength + 1) '-'
+      Resp "bcda" _ (ERR LARGE_MSG) <- signSendRecv h sKey ("bcda", sId, _SEND biggerMessage)
+      pure ()
+
 testCreateDelete :: ATransport -> Spec
 testCreateDelete (ATransport t) =
   it "should create (NEW), suspend (OFF) and delete (DEL) queue" $
@@ -140,7 +239,7 @@ testCreateDelete (ATransport t) =
       (rPub, rKey) <- C.generateSignatureKeyPair C.SEd25519
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
       Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub)
-      let dec nonce = C.cbDecrypt (C.dh' srvDh dhPriv) (C.cbNonce nonce)
+      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       (rId1, "") #== "creates queue"
 
       (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519
@@ -153,7 +252,7 @@ testCreateDelete (ATransport t) =
       Resp "dabc" _ ok7 <- signSendRecv sh sKey ("dabc", sId, _SEND "hello 2")
       (ok7, OK) #== "accepts signed SEND 2 - this message is not delivered because the first is not ACKed"
 
-      Resp "" _ (MSG mId1 _ _ msg1) <- tGet rh
+      Resp "" _ (Msg mId1 msg1) <- tGet1 rh
       (dec mId1 msg1, Right "hello") #== "delivers message"
 
       Resp "abcd" _ err1 <- sendRecv rh (sampleSig, "abcd", rId, OFF)
@@ -175,7 +274,7 @@ testCreateDelete (ATransport t) =
       Resp "bcda" _ ok4 <- signSendRecv rh rKey ("bcda", rId, OFF)
       (ok4, OK) #== "accepts OFF when suspended"
 
-      Resp "cdab" _ (MSG mId2 _ _ msg2) <- signSendRecv rh rKey ("cdab", rId, SUB)
+      Resp "cdab" _ (Msg mId2 msg2) <- signSendRecv rh rKey ("cdab", rId, SUB)
       (dec mId2 msg2, Right "hello") #== "accepts SUB when suspended and delivers the message again (because was not ACKed)"
 
       Resp "dabc" _ err5 <- sendRecv rh (sampleSig, "dabc", rId, DEL)
@@ -209,7 +308,7 @@ stressTest (ATransport t) =
     smpTest3 t $ \h1 h2 h3 -> do
       (rPub, rKey) <- C.generateSignatureKeyPair C.SEd25519
       (dhPub, _ :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      rIds <- forM [1 .. 50 :: Int] . const $ do
+      rIds <- forM ([1 .. 50] :: [Int]) . const $ do
         Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub)
         pure rId
       let subscribeQueues h = forM_ rIds $ \rId -> do
@@ -237,14 +336,14 @@ testDuplex (ATransport t) =
       (arPub, arKey) <- C.generateSignatureKeyPair C.SEd448
       (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
       Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub)
-      let aDec nonce = C.cbDecrypt (C.dh' aSrvDh aDhPriv) (C.cbNonce nonce)
+      let aDec = decryptMsgV3 $ C.dh' aSrvDh aDhPriv
       -- aSnd ID is passed to Bob out-of-band
 
       (bsPub, bsKey) <- C.generateSignatureKeyPair C.SEd448
       Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, _SEND $ "key " <> strEncode bsPub)
       -- "key ..." is ad-hoc, not a part of SMP protocol
 
-      Resp "" _ (MSG mId1 _ _ msg1) <- tGet alice
+      Resp "" _ (Msg mId1 msg1) <- tGet1 alice
       Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, ACK mId1)
       Right ["key", bobKey] <- pure $ B.words <$> aDec mId1 msg1
       (bobKey, strEncode bsPub) #== "key received from Bob"
@@ -253,11 +352,11 @@ 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)
-      let bDec nonce = C.cbDecrypt (C.dh' bSrvDh bDhPriv) (C.cbNonce nonce)
+      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
 
-      Resp "" _ (MSG mId2 _ _ msg2) <- tGet alice
+      Resp "" _ (Msg mId2 msg2) <- tGet1 alice
       Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, ACK mId2)
       Right ["reply_id", bId] <- pure $ B.words <$> aDec mId2 msg2
       (bId, encode bSnd) #== "reply queue ID received from Bob"
@@ -266,7 +365,7 @@ testDuplex (ATransport t) =
       Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, _SEND $ "key " <> strEncode asPub)
       -- "key ..." is ad-hoc, not a part of  SMP protocol
 
-      Resp "" _ (MSG mId3 _ _ msg3) <- tGet bob
+      Resp "" _ (Msg mId3 msg3) <- tGet1 bob
       Resp "abcd" _ OK <- signSendRecv bob brKey ("abcd", bRcv, ACK mId3)
       Right ["key", aliceKey] <- pure $ B.words <$> bDec mId3 msg3
       (aliceKey, strEncode asPub) #== "key received from Alice"
@@ -274,13 +373,13 @@ testDuplex (ATransport t) =
 
       Resp "cdab" _ OK <- signSendRecv bob bsKey ("cdab", aSnd, _SEND "hi alice")
 
-      Resp "" _ (MSG mId4 _ _ msg4) <- tGet alice
+      Resp "" _ (Msg mId4 msg4) <- tGet1 alice
       Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, ACK mId4)
       (aDec mId4 msg4, Right "hi alice") #== "message received from Bob"
 
       Resp "abcd" _ OK <- signSendRecv alice asKey ("abcd", bSnd, _SEND "how are you bob")
 
-      Resp "" _ (MSG mId5 _ _ msg5) <- tGet bob
+      Resp "" _ (Msg mId5 msg5) <- tGet1 bob
       Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, ACK mId5)
       (bDec mId5 msg5, Right "how are you bob") #== "message received from alice"
 
@@ -291,27 +390,27 @@ testSwitchSub (ATransport t) =
       (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
       Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub)
-      let dec nonce = C.cbDecrypt (C.dh' srvDh dhPriv) (C.cbNonce nonce)
+      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, _SEND "test1")
       (ok1, OK) #== "sent test message 1"
       Resp "cdab" _ ok2 <- sendRecv sh ("", "cdab", sId, _SEND "test2, no ACK")
       (ok2, OK) #== "sent test message 2"
 
-      Resp "" _ (MSG mId1 _ _ msg1) <- tGet rh1
+      Resp "" _ (Msg mId1 msg1) <- tGet1 rh1
       (dec mId1 msg1, Right "test1") #== "test message 1 delivered to the 1st TCP connection"
-      Resp "abcd" _ (MSG mId2 _ _ msg2) <- signSendRecv rh1 rKey ("abcd", rId, ACK mId1)
+      Resp "abcd" _ (Msg mId2 msg2) <- signSendRecv rh1 rKey ("abcd", rId, ACK mId1)
       (dec mId2 msg2, Right "test2, no ACK") #== "test message 2 delivered, no ACK"
 
-      Resp "bcda" _ (MSG mId2' _ _ msg2') <- signSendRecv rh2 rKey ("bcda", rId, SUB)
+      Resp "bcda" _ (Msg mId2' msg2') <- signSendRecv rh2 rKey ("bcda", rId, SUB)
       (dec mId2' msg2', Right "test2, no ACK") #== "same simplex queue via another TCP connection, tes2 delivered again (no ACK in 1st queue)"
       Resp "cdab" _ OK <- signSendRecv rh2 rKey ("cdab", rId, ACK mId2')
 
-      Resp "" _ end <- tGet rh1
+      Resp "" _ end <- tGet1 rh1
       (end, END) #== "unsubscribed the 1st TCP connection"
 
       Resp "dabc" _ OK <- sendRecv sh ("", "dabc", sId, _SEND "test3")
 
-      Resp "" _ (MSG mId3 _ _ msg3) <- tGet rh2
+      Resp "" _ (Msg mId3 msg3) <- tGet1 rh2
       (dec mId3 msg3, Right "test3") #== "delivered to the 2nd TCP connection"
 
       Resp "abcd" _ err <- signSendRecv rh1 rKey ("abcd", rId, ACK mId3)
@@ -334,9 +433,9 @@ testGetCommand t =
         atomically . putTMVar queue =<< createAndSecureQueue rh sPub
       testSMPClient @c $ \rh -> do
         (sId, rId, rKey, dhShared) <- atomically $ takeTMVar queue
-        let dec nonce = C.cbDecrypt dhShared (C.cbNonce nonce)
+        let dec = decryptMsgV3 dhShared
         Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, _SEND "hello")
-        Resp "2" _ (MSG mId1 _ _ msg1) <- signSendRecv rh rKey ("2", rId, GET)
+        Resp "2" _ (Msg mId1 msg1) <- signSendRecv rh rKey ("2", rId, GET)
         (dec mId1 msg1, Right "hello") #== "retrieved from queue"
         Resp "3" _ OK <- signSendRecv rh rKey ("3", rId, ACK mId1)
         Resp "4" _ OK <- signSendRecv rh rKey ("4", rId, GET)
@@ -348,14 +447,14 @@ testGetSubCommands t =
     (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519
     smpTest3 t $ \rh1 rh2 sh -> do
       (sId, rId, rKey, dhShared) <- createAndSecureQueue rh1 sPub
-      let dec nonce = C.cbDecrypt dhShared (C.cbNonce nonce)
+      let dec = decryptMsgV3 dhShared
       Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, _SEND "hello 1")
       Resp "1a" _ OK <- signSendRecv sh sKey ("1a", sId, _SEND "hello 2")
       Resp "1b" _ OK <- signSendRecv sh sKey ("1b", sId, _SEND "hello 3")
       Resp "1c" _ OK <- signSendRecv sh sKey ("1c", sId, _SEND "hello 4")
       -- both get the same if not ACK'd
-      Resp "" _ (MSG mId1 _ _ msg1) <- tGet rh1
-      Resp "2" _ (MSG mId1' _ _ msg1') <- signSendRecv rh2 rKey ("2", rId, GET)
+      Resp "" _ (Msg mId1 msg1) <- tGet1 rh1
+      Resp "2" _ (Msg mId1' msg1') <- signSendRecv rh2 rKey ("2", rId, GET)
       (dec mId1 msg1, Right "hello 1") #== "received from queue via SUB"
       (dec mId1' msg1', Right "hello 1") #== "retrieved from queue with GET"
       mId1 `shouldBe` mId1'
@@ -364,27 +463,27 @@ testGetSubCommands t =
       Resp "3" _ (ERR (CMD PROHIBITED)) <- signSendRecv rh1 rKey ("3", rId, GET)
       Resp "3a" _ (ERR (CMD PROHIBITED)) <- signSendRecv rh2 rKey ("3a", rId, SUB)
       -- ACK for SUB delivers the next message
-      Resp "4" _ (MSG mId2 _ _ msg2) <- signSendRecv rh1 rKey ("4", rId, ACK mId1)
+      Resp "4" _ (Msg mId2 msg2) <- signSendRecv rh1 rKey ("4", rId, ACK mId1)
       (dec mId2 msg2, Right "hello 2") #== "received from queue via SUB"
       -- bad msgId returns error
       Resp "5" _ (ERR NO_MSG) <- signSendRecv rh2 rKey ("5", rId, ACK "1234")
       -- already ACK'd by subscriber, but still returns OK when msgId matches
       Resp "5a" _ OK <- signSendRecv rh2 rKey ("5a", rId, ACK mId1)
       -- msg2 is not lost - even if subscriber does not ACK it, it is delivered to getter
-      Resp "6" _ (MSG mId2' _ _ msg2') <- signSendRecv rh2 rKey ("6", rId, GET)
+      Resp "6" _ (Msg mId2' msg2') <- signSendRecv rh2 rKey ("6", rId, GET)
       (dec mId2' msg2', Right "hello 2") #== "retrieved from queue with GET"
       mId2 `shouldBe` mId2'
       msg2 `shouldBe` msg2'
       -- getter ACK returns OK, even though there is the next message
       Resp "7" _ OK <- signSendRecv rh2 rKey ("7", rId, ACK mId2')
-      Resp "8" _ (MSG mId3 _ _ msg3) <- signSendRecv rh2 rKey ("8", rId, GET)
+      Resp "8" _ (Msg mId3 msg3) <- signSendRecv rh2 rKey ("8", rId, GET)
       (dec mId3 msg3, Right "hello 3") #== "retrieved from queue with GET"
       -- subscriber ACK does not lose message
-      Resp "9" _ (MSG mId3' _ _ msg3') <- signSendRecv rh1 rKey ("9", rId, ACK mId2')
+      Resp "9" _ (Msg mId3' msg3') <- signSendRecv rh1 rKey ("9", rId, ACK mId2')
       (dec mId3' msg3', Right "hello 3") #== "retrieved from queue with GET"
       mId3 `shouldBe` mId3'
       msg3 `shouldBe` msg3'
-      Resp "10" _ (MSG mId4 _ _ msg4) <- signSendRecv rh1 rKey ("10", rId, ACK mId3)
+      Resp "10" _ (Msg mId4 msg4) <- signSendRecv rh1 rKey ("10", rId, ACK mId3)
       (dec mId4 msg4, Right "hello 4") #== "retrieved from queue with GET"
       Resp "11" _ OK <- signSendRecv rh1 rKey ("11", rId, ACK mId4)
       -- no more messages for getter too
@@ -416,15 +515,15 @@ testWithStoreLog at@(ATransport t) =
         writeTVar notifierId nId
       Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, NSUB)
       Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, _SEND' "hello")
-      Resp "" _ (MSG mId1 _ _ msg1) <- tGet h
-      (C.cbDecrypt dhShared (C.cbNonce mId1) msg1, Right "hello") #== "delivered from queue 1"
-      Resp "" _ (NMSG _ _) <- tGet h1
+      Resp "" _ (Msg mId1 msg1) <- tGet1 h
+      (decryptMsgV3 dhShared mId1 msg1, Right "hello") #== "delivered from queue 1"
+      Resp "" _ (NMSG _ _) <- tGet1 h1
 
       (sId2, rId2, rKey2, dhShared2) <- createAndSecureQueue h sPub2
       atomically $ writeTVar senderId2 sId2
       Resp "cdab" _ OK <- signSendRecv h sKey2 ("cdab", sId2, _SEND "hello too")
-      Resp "" _ (MSG mId2 _ _ msg2) <- tGet h
-      (C.cbDecrypt dhShared2 (C.cbNonce mId2) msg2, Right "hello too") #== "delivered from queue 2"
+      Resp "" _ (Msg mId2 msg2) <- tGet1 h
+      (decryptMsgV3 dhShared2 mId2 msg2, Right "hello too") #== "delivered from queue 2"
 
       Resp "dabc" _ OK <- signSendRecv h rKey2 ("dabc", rId2, DEL)
       pure ()
@@ -446,9 +545,9 @@ testWithStoreLog at@(ATransport t) =
       nId <- readTVarIO notifierId
       Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, NSUB)
       Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, _SEND' "hello")
-      Resp "cdab" _ (MSG mId3 _ _ msg3) <- signSendRecv h rKey1 ("cdab", rId1, SUB)
-      (C.cbDecrypt dh1 (C.cbNonce mId3) msg3, Right "hello") #== "delivered from restored queue"
-      Resp "" _ (NMSG _ _) <- tGet h1
+      Resp "cdab" _ (Msg mId3 msg3) <- signSendRecv h rKey1 ("cdab", rId1, SUB)
+      (decryptMsgV3 dh1 mId3 msg3, Right "hello") #== "delivered from restored queue"
+      Resp "" _ (NMSG _ _) <- tGet1 h1
       -- this queue is removed - not restored
       sId2 <- readTVarIO senderId2
       Resp "cdab" _ (ERR AUTH) <- signSendRecv h sKey2 ("cdab", sId2, _SEND "hello too")
@@ -489,9 +588,9 @@ testRestoreMessages at@(ATransport t) =
           writeTVar dhShared $ Just dh
           writeTVar senderId sId
         Resp "1" _ OK <- signSendRecv h sKey ("1", sId, _SEND "hello")
-        Resp "" _ (MSG mId1 _ _ msg1) <- tGet h1
+        Resp "" _ (Msg mId1 msg1) <- tGet1 h1
         Resp "1a" _ OK <- signSendRecv h1 rKey ("1a", rId, ACK mId1)
-        (C.cbDecrypt dh (C.cbNonce mId1) msg1, Right "hello") #== "message delivered"
+        (decryptMsgV3 dh mId1 msg1, Right "hello") #== "message delivered"
       -- messages below are delivered after server restart
       sId <- readTVarIO senderId
       Resp "2" _ OK <- signSendRecv h sKey ("2", sId, _SEND "hello 2")
@@ -506,12 +605,13 @@ testRestoreMessages at@(ATransport t) =
       rId <- readTVarIO recipientId
       Just rKey <- readTVarIO recipientKey
       Just dh <- readTVarIO dhShared
-      Resp "2" _ (MSG mId2 _ _ msg2) <- signSendRecv h rKey ("2", rId, SUB)
-      (C.cbDecrypt dh (C.cbNonce mId2) msg2, Right "hello 2") #== "restored message delivered"
-      Resp "3" _ (MSG mId3 _ _ msg3) <- signSendRecv h rKey ("3", rId, ACK mId2)
-      (C.cbDecrypt dh (C.cbNonce mId3) msg3, Right "hello 3") #== "restored message delivered"
-      Resp "4" _ (MSG mId4 _ _ msg4) <- signSendRecv h rKey ("4", rId, ACK mId3)
-      (C.cbDecrypt dh (C.cbNonce mId4) msg4, Right "hello 4") #== "restored message delivered"
+      let dec = decryptMsgV3 dh
+      Resp "2" _ (Msg mId2 msg2) <- signSendRecv h rKey ("2", rId, SUB)
+      (dec mId2 msg2, Right "hello 2") #== "restored message delivered"
+      Resp "3" _ (Msg mId3 msg3) <- signSendRecv h rKey ("3", rId, ACK mId2)
+      (dec mId3 msg3, Right "hello 3") #== "restored message delivered"
+      Resp "4" _ (Msg mId4 msg4) <- signSendRecv h rKey ("4", rId, ACK mId3)
+      (dec mId4 msg4, Right "hello 4") #== "restored message delivered"
 
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
@@ -521,9 +621,78 @@ testRestoreMessages at@(ATransport t) =
       rId <- readTVarIO recipientId
       Just rKey <- readTVarIO recipientKey
       Just dh <- readTVarIO dhShared
-      Resp "4" _ (MSG mId4 _ _ msg4) <- signSendRecv h rKey ("4", rId, SUB)
+      Resp "4" _ (Msg mId4 msg4) <- signSendRecv h rKey ("4", rId, SUB)
       Resp "5" _ OK <- signSendRecv h rKey ("5", rId, ACK mId4)
-      (C.cbDecrypt dh (C.cbNonce mId4) msg4, Right "hello 4") #== "restored message delivered"
+      (decryptMsgV3 dh mId4 msg4, Right "hello 4") #== "restored message delivered"
+
+    logSize testStoreLogFile `shouldReturn` 1
+    logSize testStoreMsgsFile `shouldReturn` 0
+
+    removeFile testStoreLogFile
+    removeFile testStoreMsgsFile
+  where
+    runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
+    runTest _ test' server = do
+      testSMPClient test' `shouldReturn` ()
+      killThread server
+
+    runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
+    runClient _ test' = testSMPClient test' `shouldReturn` ()
+
+testRestoreMessagesV2 :: ATransport -> Spec
+testRestoreMessagesV2 at@(ATransport t) =
+  it "should store messages on exit and restore on start" $ do
+    (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519
+    recipientId <- newTVarIO ""
+    recipientKey <- newTVarIO Nothing
+    dhShared <- newTVarIO Nothing
+    senderId <- newTVarIO ""
+
+    withSmpServerStoreMsgLogOnV2 at testPort . runTest t $ \h -> do
+      runClient t $ \h1 -> do
+        (sId, rId, rKey, dh) <- createAndSecureQueue h1 sPub
+        atomically $ do
+          writeTVar recipientId rId
+          writeTVar recipientKey $ Just rKey
+          writeTVar dhShared $ Just dh
+          writeTVar senderId sId
+        Resp "1" _ OK <- signSendRecv h sKey ("1", sId, _SEND "hello")
+        Resp "" _ (Msg mId1 msg1) <- tGet1 h1
+        Resp "1a" _ OK <- signSendRecv h1 rKey ("1a", rId, ACK mId1)
+        (decryptMsgV2 dh mId1 msg1, Right "hello") #== "message delivered"
+      -- messages below are delivered after server restart
+      sId <- readTVarIO senderId
+      Resp "2" _ OK <- signSendRecv h sKey ("2", sId, _SEND "hello 2")
+      Resp "3" _ OK <- signSendRecv h sKey ("3", sId, _SEND "hello 3")
+      Resp "4" _ OK <- signSendRecv h sKey ("4", sId, _SEND "hello 4")
+      pure ()
+
+    logSize testStoreLogFile `shouldReturn` 2
+    logSize testStoreMsgsFile `shouldReturn` 3
+
+    withSmpServerStoreMsgLogOnV2 at testPort . runTest t $ \h -> do
+      rId <- readTVarIO recipientId
+      Just rKey <- readTVarIO recipientKey
+      Just dh <- readTVarIO dhShared
+      let dec = decryptMsgV2 dh
+      Resp "2" _ (Msg mId2 msg2) <- signSendRecv h rKey ("2", rId, SUB)
+      (dec mId2 msg2, Right "hello 2") #== "restored message delivered"
+      Resp "3" _ (Msg mId3 msg3) <- signSendRecv h rKey ("3", rId, ACK mId2)
+      (dec mId3 msg3, Right "hello 3") #== "restored message delivered"
+      Resp "4" _ (Msg mId4 msg4) <- signSendRecv h rKey ("4", rId, ACK mId3)
+      (dec mId4 msg4, Right "hello 4") #== "restored message delivered"
+
+    logSize testStoreLogFile `shouldReturn` 1
+    -- the last message is not removed because it was not ACK'd
+    logSize testStoreMsgsFile `shouldReturn` 1
+
+    withSmpServerStoreMsgLogOnV2 at testPort . runTest t $ \h -> do
+      rId <- readTVarIO recipientId
+      Just rKey <- readTVarIO recipientKey
+      Just dh <- readTVarIO dhShared
+      Resp "4" _ (Msg mId4 msg4) <- signSendRecv h rKey ("4", rId, SUB)
+      Resp "5" _ OK <- signSendRecv h rKey ("5", rId, ACK mId4)
+      (decryptMsgV2 dh mId4 msg4, Right "hello 4") #== "restored message delivered"
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
@@ -553,14 +722,15 @@ testTiming :: ATransport -> Spec
 testTiming (ATransport t) =
   it "should have similar time for auth error, whether queue exists or not, for all key sizes" $
     smpTest2 t $ \rh sh ->
-      mapM_
-        (testSameTiming rh sh)
-        [ (32, 32, 200),
-          (32, 57, 100),
-          (57, 32, 200),
-          (57, 57, 100)
-        ]
+      mapM_ (testSameTiming rh sh) timingTests
   where
+    timingTests :: [(Int, Int, Int)]
+    timingTests =
+      [ (32, 32, 200),
+        (32, 57, 100),
+        (57, 32, 200),
+        (57, 57, 100)
+      ]
     timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
     similarTime t1 t2 = abs (t2 / t1 - 1) < 0.25 `shouldBe` True
     testSameTiming :: Transport c => THandle c -> THandle c -> (Int, Int, Int) -> Expectation
@@ -568,7 +738,7 @@ testTiming (ATransport t) =
       (rPub, rKey) <- generateKeys goodKeySize
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
       Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub)
-      let dec nonce = C.cbDecrypt (C.dh' srvDh dhPriv) (C.cbNonce nonce)
+      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, SUB)
 
       (_, badKey) <- generateKeys badKeySize
@@ -578,7 +748,7 @@ testTiming (ATransport t) =
       Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, KEY sPub)
 
       Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, _SEND "hello")
-      Resp "" _ (MSG mId _ _ msg) <- tGet rh
+      Resp "" _ (Msg mId msg) <- tGet1 rh
       (dec mId msg, Right "hello") #== "delivered from queue"
 
       runTimingTest sh badKey sId $ _SEND "hello"
@@ -610,30 +780,30 @@ testMessageNotifications (ATransport t) =
     (nPub, nKey) <- C.generateSignatureKeyPair C.SEd25519
     smpTest4 t $ \rh sh nh1 nh2 -> do
       (sId, rId, rKey, dhShared) <- createAndSecureQueue rh sPub
-      let dec nonce = C.cbDecrypt dhShared (C.cbNonce nonce)
+      let dec = decryptMsgV3 dhShared
       (rcvNtfPubDhKey, _) <- C.generateKeyPair'
       Resp "1" _ (NID nId' _) <- signSendRecv rh rKey ("1", rId, NKEY nPub rcvNtfPubDhKey)
       Resp "1a" _ (NID nId _) <- signSendRecv rh rKey ("1a", rId, NKEY nPub rcvNtfPubDhKey)
       nId' `shouldNotBe` nId
       Resp "2" _ OK <- signSendRecv nh1 nKey ("2", nId, NSUB)
       Resp "3" _ OK <- signSendRecv sh sKey ("3", sId, _SEND' "hello")
-      Resp "" _ (MSG mId1 _ _ msg1) <- tGet rh
+      Resp "" _ (Msg mId1 msg1) <- tGet1 rh
       (dec mId1 msg1, Right "hello") #== "delivered from queue"
       Resp "3a" _ OK <- signSendRecv rh rKey ("3a", rId, ACK mId1)
-      Resp "" _ (NMSG _ _) <- tGet nh1
+      Resp "" _ (NMSG _ _) <- tGet1 nh1
       Resp "4" _ OK <- signSendRecv nh2 nKey ("4", nId, NSUB)
-      Resp "" _ END <- tGet nh1
+      Resp "" _ END <- tGet1 nh1
       Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello again")
-      Resp "" _ (MSG mId2 _ _ msg2) <- tGet rh
+      Resp "" _ (Msg mId2 msg2) <- tGet1 rh
       Resp "5a" _ OK <- signSendRecv rh rKey ("5a", rId, ACK mId2)
       (dec mId2 msg2, Right "hello again") #== "delivered from queue again"
-      Resp "" _ (NMSG _ _) <- tGet nh2
+      Resp "" _ (NMSG _ _) <- tGet1 nh2
       1000 `timeout` tGet @BrokerMsg nh1 >>= \case
         Nothing -> pure ()
         Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection"
       Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, NDEL)
       Resp "7" _ OK <- signSendRecv sh sKey ("7", sId, _SEND' "hello there")
-      Resp "" _ (MSG mId3 _ _ msg3) <- tGet rh
+      Resp "" _ (Msg mId3 msg3) <- tGet1 rh
       (dec mId3 msg3, Right "hello there") #== "delivered from queue again"
       1000 `timeout` tGet @BrokerMsg nh2 >>= \case
         Nothing -> pure ()
@@ -647,12 +817,12 @@ testMsgExpireOnSend t =
     withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
       testSMPClient @c $ \sh -> do
         (sId, rId, rKey, dhShared) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
-        let dec nonce = C.cbDecrypt dhShared (C.cbNonce nonce)
+        let dec = decryptMsgV3 dhShared
         Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, _SEND "hello (should expire)")
         threadDelay 2500000
         Resp "2" _ OK <- signSendRecv sh sKey ("2", sId, _SEND "hello (should NOT expire)")
         testSMPClient @c $ \rh -> do
-          Resp "3" _ (MSG mId _ _ msg) <- signSendRecv rh rKey ("3", rId, SUB)
+          Resp "3" _ (Msg mId msg) <- signSendRecv rh rKey ("3", rId, SUB)
           (dec mId msg, Right "hello (should NOT expire)") #== "delivered"
           1000 `timeout` tGet @BrokerMsg rh >>= \case
             Nothing -> return ()
@@ -682,11 +852,11 @@ testMsgNOTExpireOnInterval t =
     withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
       testSMPClient @c $ \sh -> do
         (sId, rId, rKey, dhShared) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
-        let dec nonce = C.cbDecrypt dhShared (C.cbNonce nonce)
+        let dec = decryptMsgV3 dhShared
         Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, _SEND "hello (should NOT expire)")
         threadDelay 2500000
         testSMPClient @c $ \rh -> do
-          Resp "2" _ (MSG mId _ _ msg) <- signSendRecv rh rKey ("2", rId, SUB)
+          Resp "2" _ (Msg mId msg) <- signSendRecv rh rKey ("2", rId, SUB)
           (dec mId msg, Right "hello (should NOT expire)") #== "delivered"
           1000 `timeout` tGet @BrokerMsg rh >>= \case
             Nothing -> return ()