comment

* servers: prohibit changing role during control port session

* quota for blocked queues

* allow disabling blocking and quota

* fix test

* fix INI file

CHANGELOG.md

@@ -1,3 +1,30 @@
+# 6.4.1
+
+SMP protocol:
+- create notification credentials via NEW command that creates the queue (#1586)
+
+SMP server:
+- control port session improvements (#1591)
+- additional stat counter for ntf credentials created together with the queue (#1589)
+
+# 6.4.0
+
+SMP protocol (server/client):
+- support associated queue data and short connection links (see [RFC](./rfcs/2025-03-16-smp-queues.md)).
+- service certificates to optimize subscriptions.
+
+SMP agent:
+- support retries for interactive connection handshakes.
+- use web port 443 by default for preset servers.
+- use static RNG function to avoid creating dynamic C stubs when generating sntrup keys (it was detected as Dynamic Code Loading in GrapheneOS).
+- different timeouts for interactive and background operations.
+
+Ntf server:
+- PostgreSQL storage.
+- Prometheus metrics.
+- use service certificates.
+- fix repeat token registration.
+
 # 6.3.2
 
 Servers:
@@ -18,7 +45,7 @@ Servers:
 - update script (simplex-servers-update) downloads scripts from the specified or the latest stable tag.
 
 SMP server:
-- support for PostrgreSQL database for queue records for higher traffic servers.
+- support for PostgreSQL database for queue records for higher traffic servers.
 - fix old clients sending messages to new servers (#1443)
 - remove empty journals when opening message queues and expiring idle queues (#1456, #1458).
 - additional start options (#1465):
@@ -74,7 +101,7 @@ Servers: more reliable restoring of state.
 
 SMP server: reduced memory usage and faster start.
 
-Notifications: compensate for iOS notifications being droppted by Apple while device is offline (#1378):
+Notifications: compensate for iOS notifications being dropped by Apple while device is offline (#1378):
 - Ntf server: send multiple SMP notifications in one iOS notification.
 - Agent: get multiple messages for one iOS notification.
 

README.md

@@ -1,6 +1,6 @@
 # SimpleXMQ
 
-[![GitHub build](https://github.com/simplex-chat/simplexmq/workflows/build/badge.svg)](https://github.com/simplex-chat/simplexmq/actions?query=workflow%3Abuild)
+[![GitHub build](https://github.com/simplex-chat/simplexmq/actions/workflows/build.yml/badge.svg)](https://github.com/simplex-chat/simplexmq/actions/workflows/build.yml)
 [![GitHub release](https://img.shields.io/github/v/release/simplex-chat/simplexmq)](https://github.com/simplex-chat/simplexmq/releases)
 
 📢 SimpleXMQ v1 is released - with many security, privacy and efficiency improvements, new functionality - see [release notes](https://github.com/simplex-chat/simplexmq/releases/tag/v1.0.0).
@@ -116,7 +116,7 @@ On Linux, you can deploy smp and xftp server using Docker. This will download im
 2. Run your Docker container.
 
    - `smp-server`
-   
+
      You must change **your_ip_or_domain**. `-e "pass=password"` is optional variable to password-protect your `smp` server:
      ```sh
      docker run -d \
@@ -129,7 +129,7 @@ On Linux, you can deploy smp and xftp server using Docker. This will download im
      ```
 
    - `xftp-server`
-   
+
      You must change **your_ip_or_domain** and **maximum_storage**.
      ```sh
      docker run -d \
@@ -187,7 +187,7 @@ On Linux, you can build smp server using Docker.
 3. Run your Docker container.
 
    - `smp-server`
-   
+
      You must change **your_ip_or_domain**. `-e "pass=password"` is optional variable to password-protect your `smp` server:
      ```sh
      docker run -d \
@@ -200,7 +200,7 @@ On Linux, you can build smp server using Docker.
      ```
 
    - `xftp-server`
-   
+
      You must change **your_ip_or_domain** and **maximum_storage**.
      ```sh
      docker run -d \
@@ -247,7 +247,7 @@ On Linux, you can build smp server using Docker.
 
    `xftp-server`
    ```sh
-   cabal list-bin exe:xftp-server 
+   cabal list-bin exe:xftp-server
    ```
 
 - Initialize SMP server with `smp-server init [-l] -n <fqdn>` or `smp-server init [-l] --ip <ip>` - depending on how you initialize it, either FQDN or IP will be used for server's address.

rfcs/2025-03-16-smp-queues.md

@@ -5,22 +5,19 @@
 This change is related to these problems:
 - differentiating queue retention time,
 - supporting MITM-resistant short connection links,
-- improving notifications.
 
 This RFC is based on the previous discussions about short links, blob storage and notifications ([1](./2024-06-21-short-links.md), [2](./2024-09-09-smp-blobs.md), [3](./2024-11-25-queue-blobs-2.md), [4](./2024-09-25-ios-notifications-2.md)).
 
-SMP protocol supports two types of queues - queues to communicate over and queues to send invitations. While SMP protocol was originally "unaware" of these queue types, it could differentiate it by message flow, and with the recent addition of SKEY command to allow securing the queue by the sender this difference became persistent.
+SMP protocol supports two types of queues - queues to send messages (messaging queues) and queues to send invitations to connect (contact queues). While SMP protocol was originally "unaware" of these queue types, it could differentiate it by message flow, and with the recent addition of SKEY command to allow securing the queue by the sender this difference became persistent.
 
 Simply designating queue types would allow to use this information to decide for how long to retain queues, and potentially extending it:
 - unsecured 1-time invitation queues with sndSecure (support of securing by sender) - e.g., 3 months.
 - contact address queues without sndSecure - e.g., 3 years without activity.
-- Possibly, "queues" that prohibit messages and used only as blob storage - they would be used to store group profiles and superpeer addresses for the group.
-
-This proposal also combines NEW and NKEY command to streamline notifications in preparation to reworking of the notifications protocol.
+- Possibly, "queues" that prohibit messages and used only as blob storage - they would be used to store group profiles and super-peer addresses for the group.
 
 ## Design objectives
 
-We want to achieve these objectives:
+We want to achieve these objectives for short links and associated queue data:
 1. no possibility to provide incorrect SenderId inside link data (e.g. from another queue).
 2. link data cannot be accessed by the server unless it has the link.
 3. prevent MITM attack by the server, including the server that obtained the link.
@@ -28,17 +25,17 @@ We want to achieve these objectives:
 5. for one-time links, prevent accessing link data by link observers who did not compromise the server.
 6. allow changing the user-defined part of link data.
 7. avoid changing the link when user-defined part of link data changes, while preventing MITM attack by the server on user-defined part, even if it has the link.
-8. retain the quality that it is impossible to check the existense of secured queue from having any of its temporary visible IDs (sender ID and link ID in 1-time invitations) - it requires that these IDs remain server-generated (contrary to the previous RFCs).
+8. retain the quality that it is impossible to check the existence of secured queue from having any of its temporary visible IDs (sender ID and link ID in 1-time invitations) - it requires that these IDs remain server-generated (contrary to the previous RFCs).
 
-To achieve these objectives the queue data must have immutable part and mutable part.
+To achieve these objectives the queue data will include fixed (immutable) and user-defined (mutable) parts.
 
-Immutable part would include:
-- full conection request (the current long link with all keys, including PQ keys). This includes SenderId that must match server response.
+Fixed part would include:
+- full connection request (the current long link with all keys, including PQ keys). This includes SenderId that must match server response.
 - public signature key to verify mutable part of link data.
 
-Signed mutable part would inlcude:
-- any links to chat relays that should be contacted instead of this queue (not in this RFC), but would allow delegating group connections and contact request connections to prevent spam, hiding online presense, etc.
-- and user-defined data - user profile or group profile.
+Signed mutable part would include:
+- any links to chat relays that should be contacted instead of this queue (not in this RFC), to allow delegating group connections and contact request connections to prevent spam, hiding online presence, etc.
+- and user-defined data - user profile or group profile, chat preferences, welcome message, etc.
 
 The link itself should include both the key and auth tag from the encryption of immutable part. Accessing one-time link data should require providing sender key and signing the command (`LKEY`).
 
@@ -49,8 +46,6 @@ Current NEW and NKEY commands:
 ```haskell
 NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Command Recipient
 
-NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Command Recipient
-
 -- | Queue IDs and keys, returned in IDS response
 data QueueIdsKeys = QIK
   { rcvId :: RecipientId,
@@ -70,43 +65,48 @@ data NewQueueReq = NewQueueReq
     rcvDhKey :: RcvPublicDhKey,
     auth_ :: Maybe BasicAuth,
     subMode :: SubscriptionMode,
-    queueData :: Maybe QueueReqData,
-    ntfCreds :: Maybe NewNtfCreds
+    queueReqData :: Maybe QueueReqData,
   }
 
--- Replaces NKEY command
--- This avoids additional command required from the client to enable notifications.
--- Further changes would move NotifierId generation to the client, and including a signed and encrypted command to be forwarded by SMP server to notification server.
-data NtfRequest = NtfRequest NtfPublicAuthKey RcvNtfPublicDhKey
-
 -- QRMessaging implies that sender can secure the queue.
 -- LinkId is not used with QRMessaging, to prevent the possibility of checking when connection is established by re-using the same link ID when creating another queue – the creating would have to fail if it is used.
 -- LinkId is required with QRContact, to have shorter link - it will be derived from the link_uri. And in this case we do not need to prevent checks that this queue exists.
-data QueueReqData = QRMessaging (Maybe QueueLinkData) | QRContact (Maybe (LinkId, QueueLinkData))
+data QueueReqData
+  = QRMessaging (Maybe (SenderId, QueueLinkData))
+  | QRContact (Maybe (LinkId, (SenderId, QueueLinkData)))
 
 -- SenderId should be computed client-side as the first 24 bytes of sha3-384(correlation_id),
 -- The server must verify it and reject if it is not.
-type QueueLinkData = (SenderId, EncImmutableDataBytes, EncUserDataBytes)
+-- It allows to include sender ID inside encrypted associated link data as part of full connection URI without requesting it from the server, but prevents checking if a given sender ID exists (queue creation would fail for a duplicate sender ID), as sha3-384 derivation is not reversible.
+type QueueLinkData = (EncFixedLinkData, EncUserDataBytes)
 
-type EncImmutableDataBytes = ByteString
+type EncFixedLinkData = ByteString
 
 type EncUserDataBytes = ByteString
 
--- We need to use binary encoding for AConnectionRequestUri to reduce its size
--- connReq including the full link allows connection redundancy.
--- The clients would reject changed immutable data (based on auth tag in the link) and
--- AConnectionRequestUri where SenderId of the queue does not match.
-data ImmutableLinkData = ImmutableLinkData
-  { signature :: SignatureEd25519, -- signature of the remaining part of immutable data
-    connReq :: AConnectionRequestUri,
-    sigKey :: PublicKeyEd25519
+-- We need to use binary encoding for ConnectionRequestUri to reduce its size
+-- The clients would reject changed immutable data and
+-- ConnectionRequestUri where server or SenderId of the queue do not match.
+data FixedLinkData c = FixedLinkData
+  { agentVRange :: VersionRangeSMPA,
+    rootKey :: C.PublicKeyEd25519,
+    connReq :: ConnectionRequestUri c
   }
 
--- This part of link data can also include any relays, but possibly we need a separate blob for it
-data UserLinkData = UserLinkData
-  { signature :: SignatureEd25519, -- signs the remaining part of the data
-    userData :: ByteString -- the max size needs to be estimated, but it is likely to be ~ 14kb
-  }
+data ConnLinkData c where
+  InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
+  ContactLinkData ::
+    { agentVRange :: VersionRangeSMPA,
+      -- direct connection via connReq in fixed data is allowed.
+      direct :: Bool,
+      -- additional owner keys to sign changes of mutable data.
+      owners :: [OwnerAuth],
+      -- alternative addresses of chat relays that receive requests for this contact address.
+      relays :: [ConnShortLink 'CMContact],
+      userData :: UserLinkData
+    } -> ConnLinkData 'CMContact
+
+newtype UserLinkData = UserLinkData ByteString
 
 -- | Updated queue IDs and keys, returned in IDS response
 data QueueIdsKeys = QIK
@@ -114,17 +114,14 @@ data QueueIdsKeys = QIK
     sndId :: SenderId, -- server-generated
     rcvPublicDhKey :: RcvPublicDhKey,
     sndSecure :: SenderCanSecure, -- possibly, can be removed? or implied?
-    linkId :: Maybe LinkId, -- server-generated
-    serverNtfCreds :: Maybe ServerNtfCreds -- currently returned in NID response
+    linkId :: Maybe LinkId -- server-generated
   }
-
-data ServerNtfCreds = ServerNtfCreds NotifierId RcvNtfPublicDhKey -- NotifierId is server-generated.
 ```
 
-In addition to that we add the command allowing to update and also to retrieve and, optionally, secure the queue and get link data in one request, to have only one request:
+In addition to that we add the command allowing to update and also to retrieve and secure the queue and get link data in one request, to have only one request:
 
 ```haskell
--- This command allows to set all data or to update mutlable part of contact address queue.
+-- This command allows to set all data or to update mutable part of contact address queue.
 -- This command should fail on queues that support sndSecure and also on new queues created with QRMessaging.
 -- This should fail if LinkId or immutable part of data is changed with the update, but will succeed if only mutable part is updated, so it can be retried.
 -- Entity ID is RecipientId.
@@ -147,58 +144,43 @@ LKEY :: SndPublicAuthKey -> Command Sender
 -- Entity ID is LinkId
 LGET :: Command Sender
 
--- Response to LGET, LSKEY and LSGET
+-- Response to LGET and LSET
 -- Entity ID is the same as in the command
 LNK :: SenderId -> QueueLinkData -> BrokerMsg
 ```
 
-To both include sender_id into the full link before the server response, and to prevent "oracle attack" when a failure to create the queue with the supplied `sender_id` can be used as a proof of queue existense, it is proposed that `sender_id` is computed client-side as the first 24 bytes of 48 in `sha3-384(correlation_id)` and validated server-side, where `corelation_id` is the transmission correlation ID.
+To both include sender_id into the full link before the server response, and to prevent "oracle attack" when a failure to create the queue with the supplied `sender_id` can be used as a proof of queue existence, it is proposed that `sender_id` is computed client-side as the first 24 bytes of 48 in `sha3-384(correlation_id)` and validated server-side, where `corelation_id` is the transmission correlation ID.
 
-To allow retries and to avoid regenerating all queue data, NEW command must be idempotent, and `correlation_id` must be preserved in command for queue creation, so that the same `correlation_id` and all other data is used in retries. `correlation_id` should be removed after queue creation success.
+To allow retries, every time the command is sent a new random `correlation_id` and new `sender_id` (and for contact queue, also `link_id`, which would be random as it is derived from hash of fixed link data that includes a random signature key) should be used on each attempt, because other IDs would be generated randomly on the server, and in case the previous command succeeded on the server but failed to be communicated to the client, the retry will fail if the same ID is used.
 
-To allow retries, every time the command is sent a new random `correlation_id` and new `sender_id` / `link_id` should be used on each attempt, because other IDs would be generated randomly on the server, and in case the previous command succeeded on the server but failed to be communicated to the client, the retry will fail if the same ID is used.
-
-Alternative solutions considered and rejected:
+Alternative solutions that would allow retries that were considered and rejected:
 - additional request to save queue data, after `sender_id` is returned by the server. The scenarios that require short links are interactive - creating user addresses and 1-time invitations - so making two requests instead of one would make the UX worse.
 - include empty sender_id in the immutable data and have it replaced by the accepting party with `sender_id` received in `LINK` response - both a weird design, and might create possibility for some attacks via server, especially for contact addresses.
 - making NEW commands idempotent. Doing it would require generating all IDs client-side, not only `sender_id`. It increases complexity, and it is not really necessary as the only scenarios when retries are needed are async NEW commands, that do not require short links. For future short links of chat relays the retries are much less likely, as chat relays will have good network connections.
 
 ## Algorithm to prepare and to interpret queue link data.
 
-For contact addresses this approach follows the design proposed in [Short links](./2024-06-21-short-links.md) RFC - when link id is derived from the same random binary as key. For 1-time invitations link ID is independent and server-generated, to prevent existense checks.
+For contact addresses this approach follows the design proposed in [Short links](./2024-06-21-short-links.md) RFC - when link id is derived from the same random binary as key. For 1-time invitations link ID is independent and server-generated, to prevent existence checks (oracle attack).
 
-**Prepare queue link data**
+This scheme results in 32 byte binary size for contact addresses and 56 bytes for 1-time invitation links.
 
-- the queue owner generates a random 256 bit `link_key` that will be used in the link URI.
-- for 1-time links: crypto_box key and 2 nonces to encrypt link data are derived from link_uri using HKDF: `cb_key <> nonce1 <> nonce2 = HKDF(link_key, 80 bytes)` (nonce1 is used for immutable and nonce2 for user-defined parts).
-- for contact address links: key and 2 nonces and linkId will be derived: `link_id <> cb_key <> nonce1 <> nonce2 = HKDF(link_key, 104 bytes)`
-- both parts of link data are encrypted with crypto_box, and included into `NEW` or `LNEW` commands.
+For fixed link data.
 
-**Retrieving queue link data**
-
-- the sender uses `LinkId` from URI (or derived from URI) as entity ID to retrieve link data.
-- for one time links the sender must authorize the request to retrieve the data, the key is provided with the first request, preventing undetected access by link observers.
-- having received the link data, the client can now decrypt it using secret_box.
-
-## Improved algorithm to prepare and to interpret queue link data.
-
-This scheme reduces the size of the binary in the link from 48 bytes (72 in case of 1-time links) to 32 bytes (56 bytes for 1-time links).
-
-For immutable data.
-
-1. `link_key = SHA3-256(immutable_data)` - used as part of link, and to encrypt content.
-2. HKDF:
+1. Generate random `nonce` (also used as a correlation ID for server command) and signature key (public `rootKey` included in fixed data).
+2. Compute sender ID from `nonce` as the first 24 bytes of sha3-384 of `nonce`.
+3. Generate other keys for queue address, including queue e2e encryption keys and double ratchet connection e2e encryption keys.
+4. Construct the full connection address to be included in fixed data.
+5. `link_key = SHA3-256(fixed_data)` - used as part of the link, and to derive the key to encrypt content.
+6. HKDF:
   1) contact address: `(link_id, key) = HKDF(link_key, 56 bytes)`.
-  2) 1-time invitation: `key = HKDF(link_key, 32 bytes)`, `link-id` - server-generated. 
-3. 
-3. Random `nonce1` (for immutable data), to be stored with the link data.
-4. Encrypt: `(ct1, tag1) = secret_box(immutable_data, key, nonce1)`.
-5. Store: `(nonce1, ct1, tag1)` stored as immutable link data.
+  2) 1-time invitation: `key = HKDF(link_key, 32 bytes)`, `link-id` - server-generated.
+7. Encrypt: `(ct1, tag1) = secret_box(fixed_data, key, nonce1)`, where `nonce1` is a random nonce
+5. Store: `(nonce1, ct1, tag1)` stored as fixed link data.
 
 For mutable user data:
 
 1. Random `nonce2` and the same key are used.
-2. Sign `user_data` with key included in `immutable_data`.
+2. Sign `user_data` with key included in `fixed_data`.
 3. Encrypt: `(ct2, tag2) = secret_box(signed_used_data, key, nonce2)`.
 4. Store: `(nonce2, ct2, tag2)`
 
@@ -208,13 +190,15 @@ Link recipient:
 2. HKDF:
   1) contact address: `(link_id, key) = HKDF(link_key, 56 bytes)`.
   2) 1-time invitation: `key = HKDF(link_key, 32 bytes)`.
-3. Retrieves via `link_id`: `(nonce1, ct1, tag1)` and `(nonce2, ct2, tag2)`.
-4. Decrypt: `immutable_data = decrypt (nonce1, ct1, tag1)`.
-5. Verify: `SHA3-256(immutable_data) == link_key`, abort if not.
-6. Decrypt: `signed_used_data = decrypt(nonce2, ct2, tag2)`
-7. Verify signature with key in immutable data.
+3. Retrieves via `link_id`: `(nonce1, ct1, tag1)` and `(nonce2, ct2, tag2)`:
+  1) contact address: `LGET` command, that allows retrieving link data multiple times.
+  2) 1-time invitation: `LKEY` command, that non-optionally secures the queue, and only allows repeated link data retrievals if the same sender's key is provided and signs the transmission. This prevents link data retrieval by link observers.
+4. Decrypt: `(signature1, fixed_data) = decrypt (nonce1, ct1, tag1)`.
+5. Verify: `SHA3-256(fixed_data) == link_key`, abort if not.
+6. Decrypt: `(signature2, used_data) = decrypt(nonce2, ct2, tag2)`.
+7. Verify signatures using key in the fixed data, abort if they don't match.
 
-While using content hash as encryption key is unconventional, it is not completely unheard of - e.g., it is used in convergent encryption (although in our case using random nonce makes it not convergent, but other use cases suggest that this approach preserves encryption security). It is particularly acceptable for our use case, as `immutable_data` contains mostly random keys.
+While using content hash as encryption key is unconventional, it is not completely unusual - e.g., it is used in convergent encryption (although in our case using random nonce makes it not convergent, but other use cases suggest that this approach preserves encryption security). It is particularly acceptable for our use case, as `fixed_data` contains mostly random keys.
 
 ## Threat model
 
@@ -222,10 +206,10 @@ While using content hash as encryption key is unconventional, it is not complete
 
 can:
 - delete link data.
-- hide link selectively from some requests.
+- hide link data selectively for some or for all requests.
 
 cannot:
-- undetectably replace link data, even if they have the link (objective 3).
+- undetectably replace link data, even if it has the link (objective 3).
 - access unencrypted link data, whether it was or was not accessed by the accepting party, provided it has no link (objective 2).
 - observe IP addresses of the users accessing link data, if private routing is used.
 
@@ -236,10 +220,10 @@ can:
 
 cannot:
 - undetectably access observed 1-time link data, accessing the link would make the link inaccessible to the sender (objective 5).
-- undetectbly check the existense of messaging queue or 1-time link (objective 8).
+- undetectably check the existence of messaging queue or 1-time link (objective 8).
 - replace or delete the link data.
 
-**Queue owner who did not comprmise the server**:
+**Queue owner who did not compromise the server**:
 
 cannot:
 - redirect connecting user to another queue, on the same or on another server (objective 1).
@@ -247,40 +231,42 @@ cannot:
 
 ## Correlation of design objectives with design elements
 
-1. The presense of `SenderId` in `LINK` response from the server.
+1. The presence of `SenderId` in `LNK` response from the server.
 2. Encryption of link data with crypto_box.
-3. Auth tag in the link prevents server modification of immutable part of link data. Signature verification key in immutable part, and signing of mutable part prevents server modification of mutable part of link data.
-4. No server command to change immutable part of link data once it's set.
+3. Deriving encryption key from the hash of fixed data prevents it being modified by the server - any change would be detected and rejected by the client, as the hash of fixed data won't match the link. Signature verification with the key from fixed data, and signing of mutable data prevents server modification of mutable data.
+4. No server command to change fixed data once it's set. Also, changing fixed data would require changing the link.
 5. 1-time link data can only be accessed with `LKEY` command, that while allows retries to mitigate network failures, will require the same key for retries.
 6. `LSET` command.
-7. The link only includes auth tag for immutable part, mutable part includes signature.
-8. Temporarily public IDs (SenderId and LinkId for 1-time invitations) are generated server-side, and cannot be provided by the clients when creating the queues to check if these IDs are free.
+7. The link is derived from fixed data only, so it does not change when mutable link data changes. Mutable part is signed preventing server MITM attacks.
+8. SenderId is derived from request correlation ID, so it cannot be arbitrary defined to check existence of some known queue. LinkId for 1-time invitation is generated server-side, so it cannot be provided by the client when creating the queues to check if these IDs are used.
 
 ## Syntax for short links
 
-The proposed syntax:
+The syntax:
 
 ```abnf
-shortConnectionLink = %s"https://" smpServerHost "/" linkUri [ "?" param *( "&" param ) ]
+shortConnectionLink = uriAuthority "/" linkUri [ "?" param *( "&" param ) ]
+uriAuthority = %s"https://" smpServerHost / "simplex:" ; using simplex: scheme requires including host in the parameter hostParam
 smpServerHost = <hostname> ; RFC1123, RFC5891
-linkUri = %s"i#" serverInfo oneTimeLinkBytes / %s"c#" serverInfo contactLinkBytes
-oneTimeLinkBytes = <base64url(linkId | linkKey)> ; 56 bytes / 75 base64 encoded characters
-contactLinkBytes = <base64url(linkKey)> ; 32 bytes / 43 base64 encoded characters
-; linkId - 96 bits/24 bytes
+linkUri = %s"i#" oneTimeLink / contactType "#" contactLink
+contactType = %s"a" / %s"g" / %s"c" ; contact / group / channel address, respectively
+oneTimeLink = <base64url(linkId)> "/" <base64url(linkKey)> ; 56 bytes / 75 base64 encoded characters
+contactLink = <base64url(linkKey)> ; 32 bytes / 43 base64 encoded characters
+; linkId - 192 bits/24 bytes
 ; linkKey - 256 bits/32 bytes
 
-serverInfo = [fingerprint "@" [hostnames "/"]] ; not needed for preset servers, required otherwise - the clients must refuse to connect if they don't have fingerprint in the code.
-
-fingerprint = <base64url(server offline certificate fingerprint)>
-hostnames = "h=" <hostname> *( "," <hostname> ) ; additional hostnames, e.g. onion
+param = hostsParam / portParam / certHashParam
+hostsParam = %s"h=" host *("," host) ; additional hostnames, e.g. onion
+portParam = %s"p=" 1*DIGIT ; server port
+certHashParam = %s"c=" <base64url(server offline certificate fingerprint)>
 ```
 
-To have shorter links fingerpring and additional server hostnames do not need to be specified for preconfigured servers, even if they are disabled - they can be used from the client code. Any user defined servers will require including additional hosts and server fingerprint.
+To have shorter links fingerprint and additional server hostnames do not need to be specified for pre-configured servers, even if they are disabled - they can be used from the client code. Any user defined servers will require including additional hosts and server fingerprint.
 
-Example one-time link for preset server (103 characters):
+Example one-time link for preset server (104 characters):
 
 ```
-https://smp12.simplex.im/i#abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij01234
+https://smp12.simplex.im/i#abcdefghij0123456789abcdefghij01/23456789abcdefghij0123456789abcdefghij01234
 ```
 
 Example contact link for preset server (71 characters):
@@ -289,16 +275,16 @@ Example contact link for preset server (71 characters):
 https://smp12.simplex.im/c#abcdefghij0123456789abcdefghij0123456789abc
 ```
 
-Example contact link for user-defined server (with fingerprint, but without onion hostname - 115 characters):
+Example contact link for user-defined server (with fingerprint, but without onion hostname - 117 characters):
 
 ```
-https://smp1.example.com/c#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@abcdefghij0123456789abcdefghij0123456789abc
+https://smp1.example.com/c#abcdefghij0123456789abcdefghij0123456789abc?c=0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU
 ```
 
-Example contact link for user-defined server (with fingerprint ant onion hostname - 178 characters):
+Example contact link for user-defined server (with fingerprint ant onion hostname - 182 characters):
 
 ```
-https://smp1.example.com/c#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion/abcdefghij0123456789abcdefghij0123456789abc
+https://smp1.example.com/c#abcdefghij0123456789abcdefghij0123456789abc?c=0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU&h=beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion
 ```
 
 For the links to work in the browser the servers must provide server pages.

simplexmq.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           simplexmq
-version:        6.4.0.8
+version:        6.4.1.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -162,6 +162,7 @@ library
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete
   else
       exposed-modules:
           Simplex.Messaging.Agent.Store.SQLite
@@ -208,6 +209,14 @@ library
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
+  if flag(client_postgres) || flag(server_postgres)
+      exposed-modules:
+          Simplex.Messaging.Agent.Store.Postgres
+          Simplex.Messaging.Agent.Store.Postgres.Common
+          Simplex.Messaging.Agent.Store.Postgres.DB
+          Simplex.Messaging.Agent.Store.Postgres.Migrations
+          Simplex.Messaging.Agent.Store.Postgres.Util
   if !flag(client_library)
       exposed-modules:
           Simplex.FileTransfer.Client.Main
@@ -240,14 +249,6 @@ library
           Simplex.Messaging.Server.StoreLog.ReadWrite
           Simplex.Messaging.Server.StoreLog.Types
           Simplex.Messaging.Transport.WebSockets
-      if flag(client_postgres) || flag(server_postgres)
-          exposed-modules:
-              Simplex.Messaging.Agent.Store.Postgres
-              Simplex.Messaging.Agent.Store.Postgres.Common
-              Simplex.Messaging.Agent.Store.Postgres.DB
-              Simplex.Messaging.Agent.Store.Postgres.Migrations
-              Simplex.Messaging.Agent.Store.Postgres.Util
-
       if flag(server_postgres)
           exposed-modules:
               Simplex.Messaging.Notifications.Server
@@ -559,7 +560,7 @@ test-suite simplexmq-test
     build-depends:
         memory
       , sqlcipher-simple
-  if !flag(client_postgres) || flag(server_postgres)
+  if !flag(client_postgres) || flag(client_postgres) || flag(server_postgres)
     build-depends:
         deepseq ==1.4.*
       , process

src/Simplex/FileTransfer/Client.hs

@@ -36,8 +36,10 @@ import Simplex.FileTransfer.Protocol
 import Simplex.FileTransfer.Transport
 import Simplex.Messaging.Client
   ( NetworkConfig (..),
+    NetworkRequestMode (..),
     ProtocolClientError (..),
     TransportSession,
+    netTimeoutInt,
     chooseTransportHost,
     defaultNetworkConfig,
     transportClientConfig,
@@ -107,7 +109,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
   let socksCreds = clientSocksCredentials xftpNetworkConfig proxySessTs transportSession
       ProtocolServer _ host port keyHash = srv
   useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
-  let tcConfig = transportClientConfig xftpNetworkConfig useHost False clientALPN
+  let tcConfig = transportClientConfig xftpNetworkConfig NRMBackground useHost False clientALPN
       http2Config = xftpHTTP2Config tcConfig config
   clientVar <- newTVarIO Nothing
   let usePort = if null port then "443" else port
@@ -178,7 +180,7 @@ xftpHTTP2Config transportConfig XFTPClientConfig {xftpNetworkConfig = NetworkCon
   defaultHTTP2ClientConfig
     { bodyHeadSize = xftpBlockSize,
       suportedTLSParams = defaultSupportedParams,
-      connTimeout = tcpConnectTimeout,
+      connTimeout = netTimeoutInt tcpConnectTimeout NRMBackground,
       transportConfig
     }
 
@@ -204,7 +206,7 @@ sendXFTPTransmission XFTPClient {config, thParams, http2Client} t chunkSpec_ = d
   HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- withExceptT xftpClientError . ExceptT $ sendRequest http2Client req (Just reqTimeout)
   when (B.length bodyHead /= xftpBlockSize) $ throwE $ PCEResponseError BLOCK
   -- TODO validate that the file ID is the same as in the request?
-  (_, _, (_, _fId, respOrErr)) <- liftEither . first PCEResponseError $ xftpDecodeTransmission thParams bodyHead
+  (_, _fId, respOrErr) <-liftEither $ first PCEResponseError $ xftpDecodeTClient thParams bodyHead
   case respOrErr of
     Right r -> case protocolError r of
       Just e -> throwE $ PCEProtocolError e
@@ -268,11 +270,11 @@ downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {
 
 xftpReqTimeout :: XFTPClientConfig -> Maybe Word32 -> Int
 xftpReqTimeout cfg@XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpTimeout}} chunkSize_ =
-  maybe tcpTimeout (chunkTimeout cfg) chunkSize_
+  maybe (netTimeoutInt tcpTimeout NRMBackground) (chunkTimeout cfg) chunkSize_
 
 chunkTimeout :: XFTPClientConfig -> Word32 -> Int
 chunkTimeout XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpTimeout, tcpTimeoutPerKb}} sz =
-  tcpTimeout + fromIntegral (min ((fromIntegral sz `div` 1024) * tcpTimeoutPerKb) (fromIntegral (maxBound :: Int)))
+  netTimeoutInt tcpTimeout NRMBackground + fromIntegral (min ((fromIntegral sz `div` 1024) * tcpTimeoutPerKb) (fromIntegral (maxBound :: Int)))
 
 deleteXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> SenderId -> ExceptT XFTPClientError IO ()
 deleteXFTPChunk c spKey sId = sendXFTPCommand c spKey sId FDEL Nothing >>= okResponse

src/Simplex/FileTransfer/Client/Agent.hs

@@ -19,7 +19,7 @@ import Data.Text.Encoding (decodeUtf8)
 import Data.Time.Clock (UTCTime, getCurrentTime)
 import Simplex.FileTransfer.Client
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientError (..), temporaryClientError)
+import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), ProtocolClientError (..), netTimeoutInt, temporaryClientError)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtocolServer (..), XFTPServer)
 import Simplex.Messaging.TMap (TMap)
@@ -90,7 +90,7 @@ getXFTPServerClient XFTPClientAgent {xftpClients, startedAt, config} srv = do
     waitForXFTPClient :: XFTPClientVar -> ME XFTPClient
     waitForXFTPClient clientVar = do
       let XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpConnectTimeout}} = xftpConfig config
-      client_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar clientVar)
+      client_ <- liftIO $ netTimeoutInt tcpConnectTimeout NRMBackground `timeout` atomically (readTMVar clientVar)
       liftEither $ case client_ of
         Just (Right c) -> Right c
         Just (Left e) -> Left e
@@ -127,6 +127,6 @@ closeXFTPServerClient XFTPClientAgent {xftpClients, config} srv =
   where
     closeClient cVar = do
       let NetworkConfig {tcpConnectTimeout} = xftpNetworkConfig $ xftpConfig config
-      tcpConnectTimeout `timeout` atomically (readTMVar cVar) >>= \case
+      netTimeoutInt tcpConnectTimeout NRMBackground `timeout` atomically (readTMVar cVar) >>= \case
         Just (Right client) -> closeXFTPClient client `catchAll_` pure ()
         _ -> pure ()

src/Simplex/FileTransfer/Protocol.hs

@@ -44,8 +44,9 @@ import Simplex.Messaging.Protocol
     EntityId (..),
     RecipientId,
     SenderId,
+    RawTransmission,
     SentRawTransmission,
-    SignedTransmission,
+    SignedTransmissionOrError,
     SndPublicAuthKey,
     Transmission,
     TransmissionForAuth (..),
@@ -53,7 +54,8 @@ import Simplex.Messaging.Protocol
     encodeTransmission,
     encodeTransmissionForAuth,
     messageTagP,
-    tDecodeParseValidate,
+    tDecodeServer,
+    tDecodeClient,
     tEncodeBatch1,
     tParse,
   )
@@ -197,7 +199,7 @@ instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand
   fromProtocolError = fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (auth, _, EntityId fileId, _) cmd = case cmd of
+  checkCredentials auth (EntityId fileId) cmd = case cmd of
     -- FNEW must not have signature and chunk ID
     FNEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
@@ -231,7 +233,7 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileCmd where
   fromProtocolError = fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials t (FileCmd p c) = FileCmd p <$> checkCredentials t c
+  checkCredentials tAuth entId (FileCmd p c) = FileCmd p <$> checkCredentials tAuth entId c
   {-# INLINE checkCredentials #-}
 
 instance Encoding FileInfo where
@@ -310,7 +312,7 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials _ (EntityId entId) cmd = case cmd of
     FRSndIds {} -> noEntity
     -- ERR response does not always have entity ID
     FRErr _ -> Right cmd
@@ -335,25 +337,35 @@ checkParty' c = case testEquality (sFileParty @p) (sFileParty @p') of
   Just Refl -> Just c
   _ -> Nothing
 
-xftpEncodeAuthTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion 'TClient -> C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
-xftpEncodeAuthTransmission thParams@THandleParams {thAuth} pKey (corrId, fId, msg) = do
-  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (corrId, fId, msg)
+xftpEncodeAuthTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion 'TClient -> C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
+xftpEncodeAuthTransmission thParams@THandleParams {thAuth} pKey t@(corrId, _, _) = do
+  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams t
   xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth False (Just pKey) (C.cbNonce $ bs corrId) tForAuth
 
-xftpEncodeTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
-xftpEncodeTransmission thParams (corrId, fId, msg) = do
-  let t = encodeTransmission thParams (corrId, fId, msg)
-  xftpEncodeBatch1 (Nothing, t)
+xftpEncodeTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
+xftpEncodeTransmission thParams t = xftpEncodeBatch1 (Nothing, encodeTransmission thParams t)
 
 -- this function uses batch syntax but puts only one transmission in the batch
 xftpEncodeBatch1 :: SentRawTransmission -> Either TransportError ByteString
 xftpEncodeBatch1 t = first (const TELargeMsg) $ C.pad (tEncodeBatch1 False t) xftpBlockSize
 
-xftpDecodeTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion p -> ByteString -> Either XFTPErrorType (SignedTransmission e c)
-xftpDecodeTransmission thParams t = do
+xftpDecodeTServer :: THandleParams XFTPVersion 'TServer -> ByteString -> Either XFTPErrorType (SignedTransmissionOrError XFTPErrorType FileCmd)
+xftpDecodeTServer = xftpDecodeTransmission tDecodeServer
+{-# INLINE xftpDecodeTServer #-}
+
+xftpDecodeTClient :: THandleParams XFTPVersion 'TClient -> ByteString -> Either XFTPErrorType (Transmission (Either XFTPErrorType FileResponse))
+xftpDecodeTClient = xftpDecodeTransmission tDecodeClient
+{-# INLINE xftpDecodeTClient #-}
+
+xftpDecodeTransmission ::
+  (THandleParams XFTPVersion p -> Either TransportError RawTransmission -> r) ->
+  THandleParams XFTPVersion p ->
+  ByteString ->
+  Either XFTPErrorType r
+xftpDecodeTransmission tDecode thParams t = do
   t' <- first (const BLOCK) $ C.unPad t
   case tParse thParams t' of
-    t'' :| [] -> Right $ tDecodeParseValidate thParams t''
+    t'' :| [] -> Right $ tDecode thParams t''
     _ -> Left BLOCK
 
 $(J.deriveJSON (enumJSON $ dropPrefix "F") ''FileParty)

src/Simplex/FileTransfer/Server.hs

@@ -53,8 +53,8 @@ import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (CorrId (..), BlockingInfo, EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TAuthorizations, pattern NoEntity)
-import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
+import Simplex.Messaging.Protocol (BlockingInfo, EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, SignedTransmission, pattern NoEntity)
+import Simplex.Messaging.Server (controlPortAuth, dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Control (CPClientRole (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, ServerEntityStatus (..), getRoundedSystemTime)
@@ -277,12 +277,9 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
                   CPSkip -> False
                   _ -> True
             processCP h role = \case
-              CPAuth auth -> atomically $ writeTVar role $! newRole cfg
+              CPAuth auth -> controlPortAuth h user admin role auth
                 where
-                  newRole XFTPServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin}
-                    | Just auth == admin = CPRAdmin
-                    | Just auth == user = CPRUser
-                    | otherwise = CPRNone
+                  XFTPServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin} = cfg
               CPStatsRTS -> E.tryAny getRTSStats >>= either (hPrint h) (hPrint h)
               CPDelete fileId -> withUserRole $ unliftIO u $ do
                 fs <- asks store
@@ -317,22 +314,20 @@ data ServerFile = ServerFile
 processRequest :: XFTPTransportRequest -> M ()
 processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse}
   | B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", NoEntity, FRErr BLOCK) Nothing
-  | otherwise = do
-      case xftpDecodeTransmission thParams bodyHead of
-        Right (sig_, signed, (corrId, fId, cmdOrErr)) ->
-          case cmdOrErr of
-            Right cmd -> do
-              let THandleParams {thAuth} = thParams
-              verifyXFTPTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) sig_ signed fId cmd >>= \case
-                VRVerified req -> uncurry send =<< processXFTPRequest body req
-                VRFailed e -> send (FRErr e) Nothing
-            Left e -> send (FRErr e) Nothing
+  | otherwise =
+      case xftpDecodeTServer thParams bodyHead of
+        Right (Right t@(_, _, (corrId, fId, _))) -> do
+          let THandleParams {thAuth} = thParams
+          verifyXFTPTransmission thAuth t >>= \case
+            VRVerified req -> uncurry send =<< processXFTPRequest body req
+            VRFailed e -> send (FRErr e) Nothing
           where
             send resp = sendXFTPResponse (corrId, fId, resp)
+        Right (Left (corrId, fId, e)) -> sendXFTPResponse (corrId, fId, FRErr e) Nothing
         Left e -> sendXFTPResponse ("", NoEntity, FRErr e) Nothing
   where
-    sendXFTPResponse (corrId, fId, resp) serverFile_ = do
-      let t_ = xftpEncodeTransmission thParams (corrId, fId, resp)
+    sendXFTPResponse t' serverFile_ = do
+      let t_ = xftpEncodeTransmission thParams t'
 #ifdef slow_servers
       randomDelay
 #endif
@@ -361,8 +356,8 @@ randomDelay = do
 
 data VerificationResult = VRVerified XFTPRequest | VRFailed XFTPErrorType
 
-verifyXFTPTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TAuthorizations -> ByteString -> XFTPFileId -> FileCmd -> M VerificationResult
-verifyXFTPTransmission auth_ tAuth authorized fId cmd =
+verifyXFTPTransmission :: Maybe (THandleAuth 'TServer) -> SignedTransmission FileCmd -> M VerificationResult
+verifyXFTPTransmission thAuth (tAuth, authorized, (corrId, fId, cmd)) =
   case cmd of
     FileCmd SFSender (FNEW file rcps auth') -> pure $ XFTPReqNew file rcps auth' `verifyWith` sndKey file
     FileCmd SFRecipient PING -> pure $ VRVerified XFTPReqPing
@@ -381,9 +376,9 @@ verifyXFTPTransmission auth_ tAuth authorized fId cmd =
                 EntityBlocked info -> VRFailed $ BLOCKED info
                 EntityOff -> noFileAuth
           Left _ -> pure noFileAuth
-        noFileAuth = maybe False (dummyVerifyCmd Nothing authorized) tAuth `seq` VRFailed AUTH
+        noFileAuth = dummyVerifyCmd thAuth tAuth authorized corrId `seq` VRFailed AUTH
     -- TODO verify with DH authorization
-    req `verifyWith` k = if verifyCmdAuthorization auth_ tAuth authorized k then VRVerified req else VRFailed AUTH
+    req `verifyWith` k = if verifyCmdAuthorization thAuth tAuth authorized corrId k then VRVerified req else VRFailed AUTH
 
 processXFTPRequest :: HTTP2Body -> XFTPRequest -> M (FileResponse, Maybe ServerFile)
 processXFTPRequest HTTP2Body {bodyPart} = \case

src/Simplex/Messaging/Agent/Client.hs

@@ -33,6 +33,7 @@ module Simplex.Messaging.Agent.Client
     withConnLocks,
     withInvLock,
     withLockMap,
+    withLocksMap,
     getMapLock,
     ipAddressProtected,
     closeAgentClient,
@@ -250,7 +251,6 @@ import Simplex.Messaging.Protocol
     ErrorType,
     MsgFlags (..),
     MsgId,
-    NtfPublicAuthKey,
     NtfServer,
     NtfServerWithAuth,
     ProtoServer,
@@ -260,12 +260,14 @@ import Simplex.Messaging.Protocol
     ProtocolType (..),
     ProtocolTypeI (..),
     QueueIdsKeys (..),
+    ServerNtfCreds (..),
     RcvMessage (..),
     RcvNtfPublicDhKey,
     SMPMsgMeta (..),
     SProtocolType (..),
     SndPublicAuthKey,
     SubscriptionMode (..),
+    NewNtfCreds (..),
     QueueReqData (..),
     QueueLinkData,
     UserProtocol,
@@ -282,7 +284,7 @@ import Simplex.Messaging.Session
 import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (SMPVersion, SessionId, THandleParams (sessionId, thVersion), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion)
+import Simplex.Messaging.Transport (SMPVersion, SessionId, THandleParams (sessionId, thVersion), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
@@ -567,8 +569,9 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg, presetDomai
 
 slowNetworkConfig :: NetworkConfig -> NetworkConfig
 slowNetworkConfig cfg@NetworkConfig {tcpConnectTimeout, tcpTimeout, tcpTimeoutPerKb} =
-  cfg {tcpConnectTimeout = slow tcpConnectTimeout, tcpTimeout = slow tcpTimeout, tcpTimeoutPerKb = slow tcpTimeoutPerKb}
+  cfg {tcpConnectTimeout = slowTimeout tcpConnectTimeout, tcpTimeout = slowTimeout tcpTimeout, tcpTimeoutPerKb = slow tcpTimeoutPerKb}
   where
+    slowTimeout (NetworkTimeout t1 t2) =  NetworkTimeout (slow t1) (slow t2)
     slow :: Integral a => a -> a
     slow t = (t * 3) `div` 2
 
@@ -582,7 +585,7 @@ agentDRG AgentClient {agentEnv = Env {random}} = random
 
 class (Encoding err, Show err) => ProtocolServerClient v err msg | msg -> v, msg -> err where
   type Client msg = c | c -> msg
-  getProtocolServerClient :: AgentClient -> TransportSession msg -> AM (Client msg)
+  getProtocolServerClient :: AgentClient -> NetworkRequestMode -> TransportSession msg -> AM (Client msg)
   type ProtoClient msg = c | c -> msg
   protocolClient :: Client msg -> ProtoClient msg
   clientProtocolError :: HostName -> err -> AgentErrorType
@@ -612,7 +615,7 @@ instance ProtocolServerClient NTFVersion ErrorType NtfResponse where
 
 instance ProtocolServerClient XFTPVersion XFTPErrorType FileResponse where
   type Client FileResponse = XFTPClient
-  getProtocolServerClient = getXFTPServerClient
+  getProtocolServerClient c _ = getXFTPServerClient c
   type ProtoClient FileResponse = XFTPClient
   protocolClient = id
   clientProtocolError = XFTP
@@ -620,19 +623,19 @@ instance ProtocolServerClient XFTPVersion XFTPErrorType FileResponse where
   clientServer = X.xftpClientServer
   clientTransportHost = X.xftpTransportHost
 
-getSMPServerClient :: AgentClient -> SMPTransportSession -> AM SMPConnectedClient
-getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
+getSMPServerClient :: AgentClient -> NetworkRequestMode -> SMPTransportSession -> AM SMPConnectedClient
+getSMPServerClient c@AgentClient {active, smpClients, workerSeq} nm tSess = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess smpClients ts)
-    >>= either newClient (waitForProtocolClient c tSess smpClients)
+    >>= either newClient (waitForProtocolClient c nm tSess smpClients)
   where
     newClient v = do
       prs <- liftIO TM.emptyIO
-      smpConnectClient c tSess prs v
+      smpConnectClient c nm tSess prs v
 
-getSMPProxyClient :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
-getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} proxySrv_ destSess@(userId, destSrv, qId) = do
+getSMPProxyClient :: AgentClient -> NetworkRequestMode -> Maybe SMPServerWithAuth -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
+getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} nm proxySrv_ destSess@(userId, destSrv, qId) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   proxySrv <- maybe (getNextServer c userId proxySrvs [destSrv]) pure proxySrv_
   ts <- liftIO getCurrentTime
@@ -650,11 +653,11 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
       -- we do not need to check if it is a new proxied relay session,
       -- as the client is just created and there are no sessions yet
       rv <- atomically $ either id id <$> getSessVar workerSeq destSrv prs ts
-      clnt <- smpConnectClient c tSess prs v
+      clnt <- smpConnectClient c nm tSess prs v
       (clnt,) <$> newProxiedRelay clnt auth rv
     waitForProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
     waitForProxyClient tSess auth v = do
-      clnt@(SMPConnectedClient _ prs) <- waitForProtocolClient c tSess smpClients v
+      clnt@(SMPConnectedClient _ prs) <- waitForProtocolClient c nm tSess smpClients v
       ts <- liftIO getCurrentTime
       sess <-
         atomically (getSessVar workerSeq destSrv prs ts)
@@ -662,7 +665,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
       pure (clnt, sess)
     newProxiedRelay :: SMPConnectedClient -> Maybe SMP.BasicAuth -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay)
     newProxiedRelay (SMPConnectedClient smp prs) proxyAuth rv =
-      tryAgentError (liftClient SMP (clientServer smp) $ connectSMPProxiedRelay smp destSrv proxyAuth) >>= \case
+      tryAgentError (liftClient SMP (clientServer smp) $ connectSMPProxiedRelay smp nm destSrv proxyAuth) >>= \case
         Right sess -> do
           atomically $ putTMVar (sessionVar rv) (Right sess)
           pure $ Right sess
@@ -676,14 +679,14 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
     waitForProxiedRelay :: SMPTransportSession -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay)
     waitForProxiedRelay (_, srv, _) rv = do
       NetworkConfig {tcpConnectTimeout} <- getNetworkConfig c
-      sess_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar rv)
+      sess_ <- liftIO $ netTimeoutInt tcpConnectTimeout nm `timeout` atomically (readTMVar $ sessionVar rv)
       pure $ case sess_ of
         Just (Right sess) -> Right sess
         Just (Left e) -> Left e
         Nothing -> Left $ BROKER (B.unpack $ strEncode srv) TIMEOUT
 
-smpConnectClient :: AgentClient -> SMPTransportSession -> TMap SMPServer ProxiedRelayVar -> SMPClientVar -> AM SMPConnectedClient
-smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs} tSess@(_, srv, _) prs v =
+smpConnectClient :: AgentClient -> NetworkRequestMode -> SMPTransportSession -> TMap SMPServer ProxiedRelayVar -> SMPClientVar -> AM SMPConnectedClient
+smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs} nm tSess@(_, srv, _) prs v =
   newProtocolClient c tSess smpClients connectClient v
     `catchAgentError` \e -> lift (resubscribeSMPSession c tSess) >> throwE e
   where
@@ -694,7 +697,7 @@ smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs} tSess@(_, srv, _)
       env <- ask
       liftError (protocolClientError SMP $ B.unpack $ strEncode srv) $ do
         ts <- readTVarIO proxySessTs
-        smp <- ExceptT $ getProtocolClient g tSess cfg (presetSMPDomains c) (Just msgQ) ts $ smpClientDisconnected c tSess env v' prs
+        smp <- ExceptT $ getProtocolClient g nm tSess cfg (presetSMPDomains c) (Just msgQ) ts $ smpClientDisconnected c tSess env v' prs
         pure SMPConnectedClient {connectedClient = smp, proxiedRelays = prs}
 
 smpClientDisconnected :: AgentClient -> SMPTransportSession -> Env -> SMPClientVar -> TMap SMPServer ProxiedRelayVar -> SMPClient -> IO ()
@@ -782,14 +785,14 @@ reconnectSMPClient c tSess@(_, srv, _) qs = handleNotify $ do
     notifySub :: forall e. AEntityI e => ConnId -> AEvent e -> AM' ()
     notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, AEvt (sAEntity @e) cmd)
 
-getNtfServerClient :: AgentClient -> NtfTransportSession -> AM NtfClient
-getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} tSess@(_, srv, _) = do
+getNtfServerClient :: AgentClient -> NetworkRequestMode -> NtfTransportSession -> AM NtfClient
+getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} nm tSess@(_, srv, _) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess ntfClients ts)
     >>= either
       (newProtocolClient c tSess ntfClients connectClient)
-      (waitForProtocolClient c tSess ntfClients)
+      (waitForProtocolClient c nm tSess ntfClients)
   where
     connectClient :: NtfClientVar -> AM NtfClient
     connectClient v = do
@@ -797,7 +800,7 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} tS
       g <- asks random
       ts <- readTVarIO proxySessTs
       liftError' (protocolClientError NTF $ B.unpack $ strEncode srv) $
-        getProtocolClient g tSess cfg [] Nothing ts $
+        getProtocolClient g nm tSess cfg [] Nothing ts $
           clientDisconnected v
 
     clientDisconnected :: NtfClientVar -> NtfClient -> IO ()
@@ -813,7 +816,7 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs}
   atomically (getSessVar workerSeq tSess xftpClients ts)
     >>= either
       (newProtocolClient c tSess xftpClients connectClient)
-      (waitForProtocolClient c tSess xftpClients)
+      (waitForProtocolClient c NRMBackground tSess xftpClients)
   where
     connectClient :: XFTPClientVar -> AM XFTPClient
     connectClient v = do
@@ -833,13 +836,14 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs}
 waitForProtocolClient ::
   (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) =>
   AgentClient ->
+  NetworkRequestMode ->
   TransportSession msg ->
   TMap (TransportSession msg) (ClientVar msg) ->
   ClientVar msg ->
   AM (Client msg)
-waitForProtocolClient c tSess@(_, srv, _) clients v = do
+waitForProtocolClient c nm tSess@(_, srv, _) clients v = do
   NetworkConfig {tcpConnectTimeout} <- getNetworkConfig c
-  client_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v)
+  client_ <- liftIO $ netTimeoutInt tcpConnectTimeout nm `timeout` atomically (readTMVar $ sessionVar v)
   case client_ of
     Just (Right smpClient) -> pure smpClient
     Just (Left (e, ts_)) -> case ts_ of
@@ -847,7 +851,7 @@ waitForProtocolClient c tSess@(_, srv, _) clients v = do
       Just ts ->
         ifM
           ((ts <) <$> liftIO getCurrentTime)
-          (atomically (removeSessVar v tSess clients) >> getProtocolServerClient c tSess)
+          (atomically (removeSessVar v tSess clients) >> getProtocolServerClient c nm tSess)
           (throwE e)
     Nothing -> throwE $ BROKER (B.unpack $ strEncode srv) TIMEOUT
 
@@ -866,7 +870,7 @@ newProtocolClient c tSess@(userId, srv, entityId_) clients connectClient v =
     Right client -> do
       logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv <> " (user " <> bshow userId <> maybe "" (" for entity " <>) entityId_ <> ")"
       atomically $ putTMVar (sessionVar v) (Right client)
-      atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent CONNECT client)
+      liftIO $ nonBlockingWriteTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent CONNECT client)
       pure client
     Left e -> do
       ei <- asks $ persistErrorInterval . config
@@ -978,7 +982,7 @@ closeClient_ :: ProtocolServerClient v err msg => AgentClient -> ClientVar msg -
 closeClient_ c v = do
   NetworkConfig {tcpConnectTimeout} <- getNetworkConfig c
   E.handle (\BlockedIndefinitelyOnSTM -> pure ()) $
-    tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v) >>= \case
+    netTimeoutInt tcpConnectTimeout NRMBackground `timeout` atomically (readTMVar $ sessionVar v) >>= \case
       Just (Right client) -> closeProtocolServerClient (protocolClient client) `catchAll_` pure ()
       _ -> pure ()
 
@@ -1004,25 +1008,25 @@ withInvLock' AgentClient {invLocks} = withLockMap invLocks
 {-# INLINE withInvLock' #-}
 
 withConnLocks :: AgentClient -> Set ConnId -> Text -> AM' a -> AM' a
-withConnLocks AgentClient {connLocks} = withLocksMap_ connLocks
+withConnLocks AgentClient {connLocks} = withLocksMap connLocks
 {-# INLINE withConnLocks #-}
 
 withLockMap :: (Ord k, MonadUnliftIO m) => TMap k Lock -> k -> Text -> m a -> m a
 withLockMap = withGetLock . getMapLock
 {-# INLINE withLockMap #-}
 
-withLocksMap_ :: (Ord k, MonadUnliftIO m) => TMap k Lock -> Set k -> Text -> m a -> m a
-withLocksMap_ = withGetLocks . getMapLock
-{-# INLINE withLocksMap_ #-}
+withLocksMap :: (Ord k, MonadUnliftIO m) => TMap k Lock -> Set k -> Text -> m a -> m a
+withLocksMap = withGetLocks . getMapLock
+{-# INLINE withLocksMap #-}
 
 getMapLock :: Ord k => TMap k Lock -> k -> STM Lock
 getMapLock locks key = TM.lookup key locks >>= maybe newLock pure
   where
     newLock = createLock >>= \l -> TM.insert key l locks $> l
 
-withClient_ :: forall a v err msg. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> (Client msg -> AM a) -> AM a
-withClient_ c tSess@(_, srv, _) action = do
-  cl <- getProtocolServerClient c tSess
+withClient_ :: forall a v err msg. ProtocolServerClient v err msg => AgentClient -> NetworkRequestMode -> TransportSession msg -> (Client msg -> AM a) -> AM a
+withClient_ c nm tSess@(_, srv, _) action = do
+  cl <- getProtocolServerClient c nm tSess
   action cl `catchAgentError` logServerError
   where
     logServerError :: AgentErrorType -> AM a
@@ -1030,9 +1034,9 @@ withClient_ c tSess@(_, srv, _) action = do
       logServer "<--" c srv NoEntity $ bshow e
       throwE e
 
-withProxySession :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
-withProxySession c proxySrv_ destSess@(_, destSrv, _) entId cmdStr action = do
-  (cl, sess_) <- getSMPProxyClient c proxySrv_ destSess
+withProxySession :: AgentClient -> NetworkRequestMode -> Maybe SMPServerWithAuth -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
+withProxySession c nm proxySrv_ destSess@(_, destSrv, _) entId cmdStr action = do
+  (cl, sess_) <- getSMPProxyClient c nm proxySrv_ destSess
   logServer ("--> " <> proxySrv cl <> " >") c destSrv entId cmdStr
   case sess_ of
     Right sess -> do
@@ -1047,41 +1051,42 @@ withProxySession c proxySrv_ destSess@(_, destSrv, _) entId cmdStr action = do
       logServer ("<-- " <> proxySrv cl <> " <") c destSrv NoEntity $ bshow e
       throwE e
 
-withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> ByteString -> ByteString -> (Client msg -> AM a) -> AM a
-withLogClient_ c tSess@(_, srv, _) entId cmdStr action = do
+withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> NetworkRequestMode -> TransportSession msg -> ByteString -> ByteString -> (Client msg -> AM a) -> AM a
+withLogClient_ c nm tSess@(_, srv, _) entId cmdStr action = do
   logServer' "-->" c srv entId cmdStr
-  res <- withClient_ c tSess action
+  res <- withClient_ c nm tSess action
   logServer' "<--" c srv entId "OK"
   return res
 
-withClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
-withClient c tSess action = withClient_ c tSess $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
+withClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> NetworkRequestMode -> TransportSession msg -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
+withClient c nm tSess action = withClient_ c nm tSess $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
 {-# INLINE withClient #-}
 
-withLogClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> ByteString -> ByteString -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
-withLogClient c tSess entId cmdStr action = withLogClient_ c tSess entId cmdStr $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
+withLogClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> NetworkRequestMode -> TransportSession msg -> ByteString -> ByteString -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
+withLogClient c nm tSess entId cmdStr action = withLogClient_ c nm tSess entId cmdStr $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
 {-# INLINE withLogClient #-}
 
-withSMPClient :: SMPQueueRec q => AgentClient -> q -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> AM a
-withSMPClient c q cmdStr action = do
+withSMPClient :: SMPQueueRec q => AgentClient -> NetworkRequestMode -> q -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> AM a
+withSMPClient c nm q cmdStr action = do
   tSess <- mkSMPTransportSession c q
-  withLogClient c tSess (unEntityId $ queueId q) cmdStr $ action . connectedClient
+  withLogClient c nm tSess (unEntityId $ queueId q) cmdStr $ action . connectedClient
 
-sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ConnId -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
-sendOrProxySMPMessage c userId destSrv connId cmdStr spKey_ senderId msgFlags msg =
-  fst <$> sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendViaProxy sendDirectly
+sendOrProxySMPMessage :: AgentClient -> NetworkRequestMode -> UserId -> SMPServer -> ConnId -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
+sendOrProxySMPMessage c nm userId destSrv connId cmdStr spKey_ senderId msgFlags msg =
+  fst <$> sendOrProxySMPCommand c nm userId destSrv connId cmdStr senderId sendViaProxy sendDirectly
   where
     sendViaProxy smp proxySess = do
       atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts
       atomically $ incSMPServerStat c userId (protocolClientServer' smp) sentProxiedAttempts
-      proxySMPMessage smp proxySess spKey_ senderId msgFlags msg
+      proxySMPMessage smp nm proxySess spKey_ senderId msgFlags msg
     sendDirectly smp = do
       atomically $ incSMPServerStat c userId destSrv sentDirectAttempts
-      sendSMPMessage smp spKey_ senderId msgFlags msg
+      sendSMPMessage smp nm spKey_ senderId msgFlags msg
 
 sendOrProxySMPCommand ::
   forall a.
   AgentClient ->
+  NetworkRequestMode ->
   UserId ->
   SMPServer ->
   ConnId -> -- session entity ID, for short links LinkId is used
@@ -1090,7 +1095,7 @@ sendOrProxySMPCommand ::
   (SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError a)) ->
   (SMPClient -> ExceptT SMPClientError IO a) ->
   AM (Maybe SMPServer, a)
-sendOrProxySMPCommand c userId destSrv@ProtocolServer {host = destHosts} connId cmdStr entId sendCmdViaProxy sendCmdDirectly = do
+sendOrProxySMPCommand c nm userId destSrv@ProtocolServer {host = destHosts} connId cmdStr entId sendCmdViaProxy sendCmdDirectly = do
   tSess <- mkTransportSession c userId destSrv connId
   ifM shouldUseProxy (sendViaProxy Nothing tSess) ((Nothing,) <$> sendDirectly tSess)
   where
@@ -1112,7 +1117,7 @@ sendOrProxySMPCommand c userId destSrv@ProtocolServer {host = destHosts} connId
     unknownServer = liftIO $ maybe True (\srvs -> all (`S.notMember` knownHosts srvs) destHosts) <$> TM.lookupIO userId (smpServers c)
     sendViaProxy :: Maybe SMPServerWithAuth -> SMPTransportSession -> AM (Maybe SMPServer, a)
     sendViaProxy proxySrv_ destSess@(_, _, connId_) = do
-      r <- tryAgentError . withProxySession c proxySrv_ destSess entId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess@ProxiedRelay {prBasicAuth}) -> do
+      r <- tryAgentError . withProxySession c nm proxySrv_ destSess entId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess@ProxiedRelay {prBasicAuth}) -> do
         r' <- liftClient SMP (clientServer smp) $ sendCmdViaProxy smp proxySess
         let proxySrv = protocolClientServer' smp
         case r' of
@@ -1158,7 +1163,7 @@ sendOrProxySMPCommand c userId destSrv@ProtocolServer {host = destHosts} connId
           | serverHostError e -> ifM directAllowed ((Nothing,) <$> sendDirectly destSess) (throwE e)
           | otherwise -> throwE e
     sendDirectly tSess =
-      withLogClient_ c tSess (unEntityId entId) ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
+      withLogClient_ c nm tSess (unEntityId entId) ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
         tryAgentError (liftClient SMP (clientServer smp) $ sendCmdDirectly smp) >>= \case
           Right r -> r <$ atomically (incSMPServerStat c userId destSrv sentDirect)
           Left e -> throwE e
@@ -1169,8 +1174,8 @@ ipAddressProtected NetworkConfig {socksProxy, hostMode} (ProtocolServer _ hosts
   where
     isOnionHost = \case THOnionHost _ -> True; _ -> False
 
-withNtfClient :: AgentClient -> NtfServer -> EntityId -> ByteString -> (NtfClient -> ExceptT NtfClientError IO a) -> AM a
-withNtfClient c srv (EntityId entId) = withLogClient c (0, srv, Nothing) entId
+withNtfClient :: AgentClient -> NetworkRequestMode -> NtfServer -> EntityId -> ByteString -> (NtfClient -> ExceptT NtfClientError IO a) -> AM a
+withNtfClient c nm srv (EntityId entId) = withLogClient c nm (0, srv, Nothing) entId
 
 withXFTPClient ::
   ProtocolServerClient v err msg =>
@@ -1181,7 +1186,7 @@ withXFTPClient ::
   AM b
 withXFTPClient c (userId, srv, sessEntId) cmdStr action = do
   tSess <- mkTransportSession c userId srv sessEntId
-  withLogClient c tSess sessEntId cmdStr action
+  withLogClient c NRMBackground tSess sessEntId cmdStr action
 
 liftClient :: (Show err, Encoding err) => (HostName -> err -> AgentErrorType) -> HostName -> ExceptT (ProtocolClientError err) IO a -> AM a
 liftClient protocolError_ = liftError . protocolClientError protocolError_
@@ -1221,8 +1226,8 @@ data ProtocolTestFailure = ProtocolTestFailure
   }
   deriving (Eq, Show)
 
-runSMPServerTest :: AgentClient -> UserId -> SMPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
-runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
+runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
+runSMPServerTest c nm userId (ProtoServerWithAuth srv auth) = do
   cfg <- getClientConfig c smpCfg
   C.AuthAlg ra <- asks $ rcvAuthAlg . config
   C.AuthAlg sa <- asks $ sndAuthAlg . config
@@ -1230,20 +1235,19 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
   liftIO $ do
     let tSess = (userId, srv, Nothing)
     ts <- readTVarIO $ proxySessTs c
-    getProtocolClient g tSess cfg (presetSMPDomains c) Nothing ts (\_ -> pure ()) >>= \case
+    getProtocolClient g nm tSess cfg (presetSMPDomains c) Nothing ts (\_ -> pure ()) >>= \case
       Right smp -> do
         rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
         (sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
         (dhKey, _) <- atomically $ C.generateKeyPair g
         r <- runExceptT $ do
-          -- TODO [notifications]
-          SMP.QIK {rcvId, sndId, queueMode} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp Nothing rKeys dhKey auth SMSubscribe (QRMessaging Nothing) -- Nothing
+          SMP.QIK {rcvId, sndId, queueMode} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp nm Nothing rKeys dhKey auth SMSubscribe (QRMessaging Nothing) Nothing
           liftError (testErr TSSecureQueue) $
             case queueMode of
-              Just QMMessaging -> secureSndSMPQueue smp spKey sndId sKey
-              _ -> secureSMPQueue smp rpKey rcvId sKey
-          liftError (testErr TSDeleteQueue) $ deleteSMPQueue smp rpKey rcvId
-        ok <- tcpTimeout (networkConfig cfg) `timeout` closeProtocolClient smp
+              Just QMMessaging -> secureSndSMPQueue smp nm spKey sndId sKey
+              _ -> secureSMPQueue smp nm rpKey rcvId sKey
+          liftError (testErr TSDeleteQueue) $ deleteSMPQueue smp nm rpKey rcvId
+        ok <- netTimeoutInt (tcpTimeout $ networkConfig cfg) nm `timeout` closeProtocolClient smp
         pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
       Left e -> pure (Just $ testErr TSConnect e)
   where
@@ -1251,8 +1255,8 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
     testErr :: ProtocolTestStep -> SMPClientError -> ProtocolTestFailure
     testErr step = ProtocolTestFailure step . protocolClientError SMP addr
 
-runXFTPServerTest :: AgentClient -> UserId -> XFTPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
-runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
+runXFTPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> XFTPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
+runXFTPServerTest c nm userId (ProtoServerWithAuth srv auth) = do
   cfg <- asks $ xftpCfg . config
   g <- asks random
   xftpNetworkConfig <- getNetworkConfig c
@@ -1276,7 +1280,7 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
           rcvDigest <- liftIO $ C.sha256Hash <$> B.readFile rcvPath
           unless (digest == rcvDigest) $ throwE $ ProtocolTestFailure TSCompareFile $ XFTP (B.unpack $ strEncode srv) DIGEST
           liftError (testErr TSDeleteFile) $ X.deleteXFTPChunk xftp spKey sId
-        ok <- tcpTimeout xftpNetworkConfig `timeout` X.closeXFTPClient xftp
+        ok <- netTimeoutInt (tcpTimeout xftpNetworkConfig) nm `timeout` X.closeXFTPClient xftp
         pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
       Left e -> pure (Just $ testErr TSConnect e)
   where
@@ -1299,23 +1303,23 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
     createTestChunk :: FilePath -> IO ()
     createTestChunk fp = B.writeFile fp =<< atomically . C.randomBytes chSize =<< C.newRandom
 
-runNTFServerTest :: AgentClient -> UserId -> NtfServerWithAuth -> AM' (Maybe ProtocolTestFailure)
-runNTFServerTest c userId (ProtoServerWithAuth srv _) = do
+runNTFServerTest :: AgentClient -> NetworkRequestMode -> UserId -> NtfServerWithAuth -> AM' (Maybe ProtocolTestFailure)
+runNTFServerTest c nm userId (ProtoServerWithAuth srv _) = do
   cfg <- getClientConfig c ntfCfg
   C.AuthAlg a <- asks $ rcvAuthAlg . config
   g <- asks random
   liftIO $ do
     let tSess = (userId, srv, Nothing)
     ts <- readTVarIO $ proxySessTs c
-    getProtocolClient g tSess cfg [] Nothing ts (\_ -> pure ()) >>= \case
+    getProtocolClient g nm tSess cfg [] Nothing ts (\_ -> pure ()) >>= \case
       Right ntf -> do
         (nKey, npKey) <- atomically $ C.generateAuthKeyPair a g
         (dhKey, _) <- atomically $ C.generateKeyPair g
         r <- runExceptT $ do
           let deviceToken = DeviceToken PPApnsNull "test_ntf_token"
-          (tknId, _) <- liftError (testErr TSCreateNtfToken) $ ntfRegisterToken ntf npKey (NewNtfTkn deviceToken nKey dhKey)
-          liftError (testErr TSDeleteNtfToken) $ ntfDeleteToken ntf npKey tknId
-        ok <- tcpTimeout (networkConfig cfg) `timeout` closeProtocolClient ntf
+          (tknId, _) <- liftError (testErr TSCreateNtfToken) $ ntfRegisterToken ntf nm npKey (NewNtfTkn deviceToken nKey dhKey)
+          liftError (testErr TSDeleteNtfToken) $ ntfDeleteToken ntf nm npKey tknId
+        ok <- netTimeoutInt (tcpTimeout $ networkConfig cfg) nm `timeout` closeProtocolClient ntf
         pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
       Left e -> pure (Just $ testErr TSConnect e)
   where
@@ -1348,12 +1352,11 @@ getSessionMode :: MonadIO m => AgentClient -> m TransportSessionMode
 getSessionMode = fmap sessionMode . getNetworkConfig
 {-# INLINE getSessionMode #-}
 
--- TODO [notifications]
-newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SConnectionMode c -> SubscriptionMode -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
-newRcvQueue c userId connId srv vRange cMode subMode = do
+newRcvQueue :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SConnectionMode c -> Bool -> SubscriptionMode -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
+newRcvQueue c nm userId connId srv vRange cMode enableNtfs subMode = do
   let qrd = case cMode of SCMInvitation -> CQRMessaging Nothing; SCMContact -> CQRContact Nothing
   e2eKeys <- atomically . C.generateKeyPair =<< asks random
-  newRcvQueue_ c userId connId srv vRange qrd subMode Nothing e2eKeys
+  newRcvQueue_ c nm userId connId srv vRange qrd enableNtfs subMode Nothing e2eKeys
 
 data ClntQueueReqData
   = CQRMessaging (Maybe (CQRData (SMP.SenderId, QueueLinkData)))
@@ -1370,21 +1373,21 @@ queueReqData = \case
   CQRMessaging d -> QRMessaging $ srvReq <$> d
   CQRContact d -> QRContact $ srvReq <$> d
 
-newRcvQueue_ :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> ClntQueueReqData -> SubscriptionMode -> Maybe C.CbNonce -> C.KeyPairX25519 -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
-newRcvQueue_ c userId connId (ProtoServerWithAuth srv auth) vRange cqrd subMode nonce_ (e2eDhKey, e2ePrivKey) = do
+newRcvQueue_ :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> ClntQueueReqData -> Bool -> SubscriptionMode -> Maybe C.CbNonce -> C.KeyPairX25519 -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
+newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enableNtfs subMode nonce_ (e2eDhKey, e2ePrivKey) = do
   C.AuthAlg a <- asks (rcvAuthAlg . config)
   g <- asks random
   rKeys@(_, rcvPrivateKey) <- atomically $ C.generateAuthKeyPair a g
   (dhKey, privDhKey) <- atomically $ C.generateKeyPair g
   logServer "-->" c srv NoEntity "NEW"
   tSess <- mkTransportSession c userId srv connId
-  -- TODO [notifications]
-  r@(thParams', QIK {rcvId, sndId, rcvPublicDhKey, queueMode, serviceId}) <-
-    withClient c tSess $ \(SMPConnectedClient smp _) ->
-      (thParams smp,) <$> createSMPQueue smp nonce_ rKeys dhKey auth subMode (queueReqData cqrd)
+  (thParams', ntfKeys, qik@QIK {rcvId, sndId, rcvPublicDhKey, queueMode, serviceId, serverNtfCreds}) <-
+    withClient c nm tSess $ \(SMPConnectedClient smp _) -> do
+      (ntfKeys, ntfCreds) <- liftIO $ mkNtfCreds a g smp
+      (thParams smp,ntfKeys,) <$> createSMPQueue smp nm nonce_ rKeys dhKey auth subMode (queueReqData cqrd) ntfCreds
   -- TODO [certs rcv] validate that serviceId is the same as in the client session
   liftIO . logServer "<--" c srv NoEntity $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
-  shortLink <- mkShortLinkCreds r
+  shortLink <- mkShortLinkCreds thParams' qik
   let rq =
         RcvQueue
           { userId,
@@ -1405,14 +1408,26 @@ newRcvQueue_ c userId connId (ProtoServerWithAuth srv auth) vRange cqrd subMode
             dbReplaceQueueId = Nothing,
             rcvSwchStatus = Nothing,
             smpClientVersion = maxVersion vRange,
-            clientNtfCreds = Nothing,
+            clientNtfCreds = mkClientNtfCreds ntfKeys serverNtfCreds,
             deleteErrors = 0
           }
       qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey queueMode
   pure (rq, qUri, tSess, sessionId thParams')
   where
-    mkShortLinkCreds :: (THandleParams SMPVersion 'TClient, QueueIdsKeys) -> AM (Maybe ShortLinkCreds)
-    mkShortLinkCreds (thParams', QIK {sndId, queueMode, linkId}) = case (cqrd, queueMode) of
+    mkNtfCreds :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> TVar ChaChaDRG -> SMPClient -> IO (Maybe (C.AAuthKeyPair, C.PrivateKeyX25519), Maybe NewNtfCreds)
+    mkNtfCreds a g smp
+      | enableNtfs && thVersion (thParams smp) >= newNtfCredsSMPVersion = do
+          authKeys@(k, _) <- atomically $ C.generateAuthKeyPair a g
+          (dhk, dhpk) <- atomically $ C.generateKeyPair g
+          pure (Just (authKeys, dhpk), Just $ NewNtfCreds k dhk)
+      | otherwise = pure (Nothing, Nothing)
+    mkClientNtfCreds :: Maybe (C.AAuthKeyPair, C.PrivateKeyX25519) -> Maybe ServerNtfCreds -> Maybe ClientNtfCreds
+    mkClientNtfCreds ntfKeys serverNtfCreds = case (ntfKeys, serverNtfCreds) of
+      (Just ((ntfPublicKey, ntfPrivateKey), dhpk), Just (ServerNtfCreds notifierId dhk')) ->
+        Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret = C.dh' dhk' dhpk}
+      _ -> Nothing
+    mkShortLinkCreds :: THandleParams SMPVersion 'TClient -> QueueIdsKeys -> AM (Maybe ShortLinkCreds)
+    mkShortLinkCreds thParams' QIK {sndId, queueMode, linkId} = case (cqrd, queueMode) of
       (CQRMessaging ld, Just QMMessaging) ->
         withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (sndId', d)} ->
           if sndId == sndId'
@@ -1492,7 +1507,7 @@ subscribeQueues c qs = do
   env <- ask
   -- only "checked" queues are subscribed
   session <- newTVarIO Nothing
-  rs <- sendTSessionBatches "SUB" id (subscribeQueues_ env session) c qs'
+  rs <- sendTSessionBatches "SUB" id (subscribeQueues_ env session) c NRMBackground qs'
   (errs <> rs,) <$> readTVarIO session
   where
     checkQueue rq = do
@@ -1502,7 +1517,7 @@ subscribeQueues c qs = do
     subscribeQueues_ env session smp qs' = do
       let (userId, srv, _) = transportSession' smp
       atomically $ incSMPServerStat' c userId srv connSubAttempts $ length qs'
-      rs <- sendBatch subscribeSMPQueues smp qs'
+      rs <- sendBatch (\smp' _ -> subscribeSMPQueues smp')  smp NRMBackground qs'
       active <-
         atomically $
           ifM
@@ -1533,8 +1548,8 @@ type BatchResponses q e r = NonEmpty (q, Either e r)
 
 -- Please note: this function does not preserve order of results to be the same as the order of arguments,
 -- it includes arguments in the results instead.
-sendTSessionBatches :: forall q r. ByteString -> (q -> RcvQueue) -> (SMPClient -> NonEmpty q -> IO (BatchResponses q SMPClientError r)) -> AgentClient -> [q] -> AM' [(q, Either AgentErrorType r)]
-sendTSessionBatches statCmd toRQ action c qs =
+sendTSessionBatches :: forall q r. ByteString -> (q -> RcvQueue) -> (SMPClient -> NonEmpty q -> IO (BatchResponses q SMPClientError r)) -> AgentClient -> NetworkRequestMode -> [q] -> AM' [(q, Either AgentErrorType r)]
+sendTSessionBatches statCmd toRQ action c nm qs =
   concatMap L.toList <$> (mapConcurrently sendClientBatch =<< batchQueues)
   where
     batchQueues :: AM' [(SMPTransportSession, NonEmpty q)]
@@ -1547,7 +1562,7 @@ sendTSessionBatches statCmd toRQ action c qs =
            in M.alter (Just . maybe [q] (q <|)) tSess m
     sendClientBatch :: (SMPTransportSession, NonEmpty q) -> AM' (BatchResponses q AgentErrorType r)
     sendClientBatch (tSess@(_, srv, _), qs') =
-      tryAgentError' (getSMPServerClient c tSess) >>= \case
+      tryAgentError' (getSMPServerClient c nm tSess) >>= \case
         Left e -> pure $ L.map (,Left e) qs'
         Right (SMPConnectedClient smp _) -> liftIO $ do
           logServer' "-->" c srv (bshow (length qs') <> " queues") statCmd
@@ -1555,8 +1570,8 @@ sendTSessionBatches statCmd toRQ action c qs =
           where
             agentError = second . first $ protocolClientError SMP $ clientServer smp
 
-sendBatch :: (SMPClient -> NonEmpty (SMP.RecipientId, SMP.RcvPrivateAuthKey) -> IO (NonEmpty (Either SMPClientError a))) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses RcvQueue SMPClientError a)
-sendBatch smpCmdFunc smp qs = L.zip qs <$> smpCmdFunc smp (L.map queueCreds qs)
+sendBatch :: (SMPClient -> NetworkRequestMode -> NonEmpty (SMP.RecipientId, SMP.RcvPrivateAuthKey) -> IO (NonEmpty (Either SMPClientError a))) -> SMPClient -> NetworkRequestMode -> NonEmpty RcvQueue -> IO (BatchResponses RcvQueue SMPClientError a)
+sendBatch smpCmdFunc smp nm qs = L.zip qs <$> smpCmdFunc smp nm (L.map queueCreds qs)
   where
     queueCreds RcvQueue {rcvPrivateKey, rcvId} = (rcvId, rcvPrivateKey)
 
@@ -1625,18 +1640,18 @@ logSecret' :: ByteString -> ByteString
 logSecret' = B64.encode . B.take 3
 {-# INLINE logSecret' #-}
 
-sendConfirmation :: AgentClient -> SndQueue -> ByteString -> AM (Maybe SMPServer)
-sendConfirmation c sq@SndQueue {userId, server, connId, sndId, queueMode, sndPublicKey, sndPrivateKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
+sendConfirmation :: AgentClient -> NetworkRequestMode -> SndQueue -> ByteString -> AM (Maybe SMPServer)
+sendConfirmation c nm sq@SndQueue {userId, server, connId, sndId, queueMode, sndPublicKey, sndPrivateKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
   let (privHdr, spKey) = if senderCanSecure queueMode then (SMP.PHEmpty, Just sndPrivateKey) else (SMP.PHConfirmation sndPublicKey, Nothing)
       clientMsg = SMP.ClientMessage privHdr agentConfirmation
   msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
-  sendOrProxySMPMessage c userId server connId "<CONF>" spKey sndId (MsgFlags {notification = True}) msg
-sendConfirmation _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
+  sendOrProxySMPMessage c nm userId server connId "<CONF>" spKey sndId (MsgFlags {notification = True}) msg
+sendConfirmation _ _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
 
-sendInvitation :: AgentClient -> UserId -> ConnId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
-sendInvitation c userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo = do
+sendInvitation :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
+sendInvitation c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo = do
   msg <- mkInvitation
-  sendOrProxySMPMessage c userId smpServer connId "<INV>" Nothing senderId (MsgFlags {notification = True}) msg
+  sendOrProxySMPMessage c nm userId smpServer connId "<INV>" Nothing senderId (MsgFlags {notification = True}) msg
   where
     mkInvitation :: AM ByteString
     -- this is only encrypted with per-queue E2E, not with double ratchet
@@ -1648,7 +1663,7 @@ sendInvitation c userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpS
 getQueueMessage :: AgentClient -> RcvQueue -> AM (Maybe SMPMsgMeta)
 getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do
   atomically createTakeGetLock
-  msg_ <- withSMPClient c rq "GET" $ \smp ->
+  msg_ <- withSMPClient c NRMInteractive rq "GET" $ \smp ->
     getSMPMessage smp rcvPrivateKey rcvId
   mapM decryptMeta msg_
   where
@@ -1667,44 +1682,44 @@ decryptSMPMessage rq SMP.RcvMessage {msgId, msgBody = SMP.EncRcvMsgBody body} =
   where
     decrypt = agentCbDecrypt (rcvDhSecret rq) (C.cbNonce msgId)
 
-secureQueue :: AgentClient -> RcvQueue -> SndPublicAuthKey -> AM ()
-secureQueue c rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
-  withSMPClient c rq "KEY <key>" $ \smp ->
-    secureSMPQueue smp rcvPrivateKey rcvId senderKey
+secureQueue :: AgentClient -> NetworkRequestMode -> RcvQueue -> SndPublicAuthKey -> AM ()
+secureQueue c nm rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
+  withSMPClient c nm rq "KEY <key>" $ \smp ->
+    secureSMPQueue smp nm rcvPrivateKey rcvId senderKey
 
-secureSndQueue :: AgentClient -> SndQueue -> AM ()
-secureSndQueue c SndQueue {userId, connId, server, sndId, sndPrivateKey, sndPublicKey} =
-  void $ sendOrProxySMPCommand c userId server connId "SKEY <key>" sndId secureViaProxy secureDirectly
+secureSndQueue :: AgentClient -> NetworkRequestMode -> SndQueue -> AM ()
+secureSndQueue c nm SndQueue {userId, connId, server, sndId, sndPrivateKey, sndPublicKey} =
+  void $ sendOrProxySMPCommand c nm userId server connId "SKEY <key>" sndId secureViaProxy secureDirectly
   where
     -- TODO track statistics
-    secureViaProxy smp proxySess = proxySecureSndSMPQueue smp proxySess sndPrivateKey sndId sndPublicKey
-    secureDirectly smp = secureSndSMPQueue smp sndPrivateKey sndId sndPublicKey
+    secureViaProxy smp proxySess = proxySecureSndSMPQueue smp nm proxySess sndPrivateKey sndId sndPublicKey
+    secureDirectly smp = secureSndSMPQueue smp nm sndPrivateKey sndId sndPublicKey
 
-addQueueLink :: AgentClient -> RcvQueue -> SMP.LinkId -> QueueLinkData -> AM ()
-addQueueLink c rq@RcvQueue {rcvId, rcvPrivateKey} lnkId d =
-  withSMPClient c rq "LSET" $ \smp -> addSMPQueueLink smp rcvPrivateKey rcvId lnkId d
+addQueueLink :: AgentClient -> NetworkRequestMode -> RcvQueue -> SMP.LinkId -> QueueLinkData -> AM ()
+addQueueLink c nm rq@RcvQueue {rcvId, rcvPrivateKey} lnkId d =
+  withSMPClient c nm rq "LSET" $ \smp -> addSMPQueueLink smp nm rcvPrivateKey rcvId lnkId d
 
-deleteQueueLink :: AgentClient -> RcvQueue -> AM ()
-deleteQueueLink c rq@RcvQueue {rcvId, rcvPrivateKey} =
-  withSMPClient c rq "LDEL" $ \smp -> deleteSMPQueueLink smp rcvPrivateKey rcvId
+deleteQueueLink :: AgentClient -> NetworkRequestMode -> RcvQueue -> AM ()
+deleteQueueLink c nm rq@RcvQueue {rcvId, rcvPrivateKey} =
+  withSMPClient c nm rq "LDEL" $ \smp -> deleteSMPQueueLink smp nm rcvPrivateKey rcvId
 
-secureGetQueueLink :: AgentClient -> UserId -> InvShortLink -> AM (SMP.SenderId, QueueLinkData)
-secureGetQueueLink c userId InvShortLink {server, linkId, sndPrivateKey, sndPublicKey} =
-  snd <$> sendOrProxySMPCommand c userId server (unEntityId linkId) "LKEY <key>" linkId secureGetViaProxy secureGetDirectly
+secureGetQueueLink :: AgentClient -> NetworkRequestMode -> UserId -> InvShortLink -> AM (SMP.SenderId, QueueLinkData)
+secureGetQueueLink c nm userId InvShortLink {server, linkId, sndPrivateKey, sndPublicKey} =
+  snd <$> sendOrProxySMPCommand c nm userId server (unEntityId linkId) "LKEY <key>" linkId secureGetViaProxy secureGetDirectly
   where
-    secureGetViaProxy smp proxySess = proxySecureGetSMPQueueLink smp proxySess sndPrivateKey linkId sndPublicKey
-    secureGetDirectly smp = secureGetSMPQueueLink smp sndPrivateKey linkId sndPublicKey
+    secureGetViaProxy smp proxySess = proxySecureGetSMPQueueLink smp nm proxySess sndPrivateKey linkId sndPublicKey
+    secureGetDirectly smp = secureGetSMPQueueLink smp nm sndPrivateKey linkId sndPublicKey
 
-getQueueLink :: AgentClient -> UserId -> SMPServer -> SMP.LinkId -> AM (SMP.SenderId, QueueLinkData)
-getQueueLink c userId server lnkId =
-  snd <$> sendOrProxySMPCommand c userId server (unEntityId lnkId) "LGET" lnkId getViaProxy getDirectly
+getQueueLink :: AgentClient -> NetworkRequestMode -> UserId -> SMPServer -> SMP.LinkId -> AM (SMP.SenderId, QueueLinkData)
+getQueueLink c nm userId server lnkId =
+  snd <$> sendOrProxySMPCommand c nm userId server (unEntityId lnkId) "LGET" lnkId getViaProxy getDirectly
   where
-    getViaProxy smp proxySess = proxyGetSMPQueueLink smp proxySess lnkId
-    getDirectly smp = getSMPQueueLink smp lnkId
+    getViaProxy smp proxySess = proxyGetSMPQueueLink smp nm proxySess lnkId
+    getDirectly smp = getSMPQueueLink smp nm lnkId
 
 enableQueueNotifications :: AgentClient -> RcvQueue -> SMP.NtfPublicAuthKey -> SMP.RcvNtfPublicDhKey -> AM (SMP.NotifierId, SMP.RcvNtfPublicDhKey)
 enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtfPublicDhKey =
-  withSMPClient c rq "NKEY <nkey>" $ \smp ->
+  withSMPClient c NRMBackground rq "NKEY <nkey>" $ \smp ->
     enableSMPQueueNotifications smp rcvPrivateKey rcvId notifierKey rcvNtfPublicDhKey
 
 data EnableQueueNtfReq = EnableQueueNtfReq
@@ -1715,7 +1730,7 @@ data EnableQueueNtfReq = EnableQueueNtfReq
   }
 
 enableQueuesNtfs :: AgentClient -> [EnableQueueNtfReq] -> AM' [(EnableQueueNtfReq, Either AgentErrorType (SMP.NotifierId, SMP.RcvNtfPublicDhKey))]
-enableQueuesNtfs = sendTSessionBatches "NKEY" eqnrRq enableQueues_
+enableQueuesNtfs c = sendTSessionBatches "NKEY" eqnrRq enableQueues_ c NRMBackground
   where
     enableQueues_ :: SMPClient -> NonEmpty EnableQueueNtfReq -> IO (NonEmpty (EnableQueueNtfReq, Either (ProtocolClientError ErrorType) (SMP.NotifierId, RcvNtfPublicDhKey)))
     enableQueues_ smp qs' = L.zip qs' <$> enableSMPQueuesNtfs smp (L.map queueCreds qs')
@@ -1728,13 +1743,13 @@ enableQueuesNtfs = sendTSessionBatches "NKEY" eqnrRq enableQueues_
 
 disableQueueNotifications :: AgentClient -> RcvQueue -> AM ()
 disableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} =
-  withSMPClient c rq "NDEL" $ \smp ->
+  withSMPClient c NRMBackground rq "NDEL" $ \smp ->
     disableSMPQueueNotifications smp rcvPrivateKey rcvId
 
 type DisableQueueNtfReq = (NtfSubscription, RcvQueue)
 
 disableQueuesNtfs :: AgentClient -> [DisableQueueNtfReq] -> AM' [(DisableQueueNtfReq, Either AgentErrorType ())]
-disableQueuesNtfs = sendTSessionBatches "NDEL" snd disableQueues_
+disableQueuesNtfs c = sendTSessionBatches "NDEL" snd disableQueues_ c NRMBackground
   where
     disableQueues_ :: SMPClient -> NonEmpty DisableQueueNtfReq -> IO (NonEmpty (DisableQueueNtfReq, Either (ProtocolClientError ErrorType) ()))
     disableQueues_ smp qs' = L.zip qs' <$> disableSMPQueuesNtfs smp (L.map queueCreds qs')
@@ -1743,7 +1758,7 @@ disableQueuesNtfs = sendTSessionBatches "NDEL" snd disableQueues_
 
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId =
-  withSMPClient c rq ("ACK:" <> logSecret' msgId) $ \smp ->
+  withSMPClient c NRMBackground rq ("ACK:" <> logSecret' msgId) $ \smp ->
     ackSMPMessage smp rcvPrivateKey rcvId msgId
 
 hasGetLock :: AgentClient -> RcvQueue -> IO Bool
@@ -1756,32 +1771,33 @@ releaseGetLock c RcvQueue {server, rcvId} =
   TM.lookup (server, rcvId) (getMsgLocks c) >>= mapM_ (`tryPutTMVar` ())
 {-# INLINE releaseGetLock #-}
 
-suspendQueue :: AgentClient -> RcvQueue -> AM ()
-suspendQueue c rq@RcvQueue {rcvId, rcvPrivateKey} =
-  withSMPClient c rq "OFF" $ \smp ->
-    suspendSMPQueue smp rcvPrivateKey rcvId
+suspendQueue :: AgentClient -> NetworkRequestMode -> RcvQueue -> AM ()
+suspendQueue c nm rq@RcvQueue {rcvId, rcvPrivateKey} =
+  withSMPClient c nm rq "OFF" $ \smp ->
+    suspendSMPQueue smp nm rcvPrivateKey rcvId
 
-deleteQueue :: AgentClient -> RcvQueue -> AM ()
-deleteQueue c rq@RcvQueue {rcvId, rcvPrivateKey} = do
-  withSMPClient c rq "DEL" $ \smp ->
-    deleteSMPQueue smp rcvPrivateKey rcvId
+deleteQueue :: AgentClient -> NetworkRequestMode -> RcvQueue -> AM ()
+deleteQueue c nm rq@RcvQueue {rcvId, rcvPrivateKey} = do
+  withSMPClient c nm rq "DEL" $ \smp ->
+    deleteSMPQueue smp nm rcvPrivateKey rcvId
 
-deleteQueues :: AgentClient -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())]
-deleteQueues c = sendTSessionBatches "DEL" id deleteQueues_ c
+deleteQueues :: AgentClient -> NetworkRequestMode -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())]
+deleteQueues c nm = sendTSessionBatches "DEL" id deleteQueues_ c nm
   where
     deleteQueues_ smp rqs = do
       let (userId, srv, _) = transportSession' smp
       atomically $ incSMPServerStat' c userId srv connDelAttempts $ length rqs
-      rs <- sendBatch deleteSMPQueues smp rqs
+      rs <- sendBatch deleteSMPQueues smp nm rqs
       let successes = foldl' (\n (_, r) -> if isRight r then n + 1 else n) 0 rs
       atomically $ incSMPServerStat' c userId srv connDeleted successes
       pure rs
 
+-- This is only used in background
 sendAgentMessage :: AgentClient -> SndQueue -> MsgFlags -> ByteString -> AM (Maybe SMPServer)
 sendAgentMessage c sq@SndQueue {userId, server, connId, sndId, sndPrivateKey} msgFlags agentMsg = do
   let clientMsg = SMP.ClientMessage SMP.PHEmpty agentMsg
   msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
-  sendOrProxySMPMessage c userId server connId "<MSG>" (Just sndPrivateKey) sndId msgFlags msg
+  sendOrProxySMPMessage c NRMBackground userId server connId "<MSG>" (Just sndPrivateKey) sndId msgFlags msg
 
 data ServerQueueInfo = ServerQueueInfo
   { server :: SMPServer,
@@ -1793,50 +1809,50 @@ data ServerQueueInfo = ServerQueueInfo
   }
   deriving (Show)
 
-getQueueInfo :: AgentClient -> RcvQueue -> AM ServerQueueInfo
-getQueueInfo c rq@RcvQueue {server, rcvId, rcvPrivateKey, sndId, status, clientNtfCreds} =
-  withSMPClient c rq "QUE" $ \smp -> do
-    info <- getSMPQueueInfo smp rcvPrivateKey rcvId
+getQueueInfo :: AgentClient -> NetworkRequestMode -> RcvQueue -> AM ServerQueueInfo
+getQueueInfo c nm rq@RcvQueue {server, rcvId, rcvPrivateKey, sndId, status, clientNtfCreds} =
+  withSMPClient c nm rq "QUE" $ \smp -> do
+    info <- getSMPQueueInfo smp nm rcvPrivateKey rcvId
     let ntfId = enc . (\ClientNtfCreds {notifierId} -> notifierId) <$> clientNtfCreds
     pure ServerQueueInfo {server, rcvId = enc rcvId, sndId = enc sndId, ntfId, status = serializeQueueStatus status, info}
   where
     enc = decodeLatin1 . B64.encode . unEntityId
 
-agentNtfRegisterToken :: AgentClient -> NtfToken -> NtfPublicAuthKey -> C.PublicKeyX25519 -> AM (NtfTokenId, C.PublicKeyX25519)
-agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
-  withClient c (0, ntfServer, Nothing) $ \ntf -> ntfRegisterToken ntf ntfPrivKey (NewNtfTkn deviceToken ntfPubKey pubDhKey)
+agentNtfRegisterToken :: AgentClient -> NetworkRequestMode -> NtfToken -> SMP.NtfPublicAuthKey -> C.PublicKeyX25519 -> AM (NtfTokenId, C.PublicKeyX25519)
+agentNtfRegisterToken c nm NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
+  withClient c nm (0, ntfServer, Nothing) $ \ntf -> ntfRegisterToken ntf nm ntfPrivKey (NewNtfTkn deviceToken ntfPubKey pubDhKey)
 
-agentNtfVerifyToken :: AgentClient -> NtfTokenId -> NtfToken -> NtfRegCode -> AM ()
-agentNtfVerifyToken c tknId NtfToken {ntfServer, ntfPrivKey} code =
-  withNtfClient c ntfServer tknId "TVFY" $ \ntf -> ntfVerifyToken ntf ntfPrivKey tknId code
+agentNtfVerifyToken :: AgentClient -> NetworkRequestMode -> NtfTokenId -> NtfToken -> NtfRegCode -> AM ()
+agentNtfVerifyToken c nm tknId NtfToken {ntfServer, ntfPrivKey} code =
+  withNtfClient c nm ntfServer tknId "TVFY" $ \ntf -> ntfVerifyToken ntf nm ntfPrivKey tknId code
 
-agentNtfCheckToken :: AgentClient -> NtfTokenId -> NtfToken -> AM NtfTknStatus
-agentNtfCheckToken c tknId NtfToken {ntfServer, ntfPrivKey} =
-  withNtfClient c ntfServer tknId "TCHK" $ \ntf -> ntfCheckToken ntf ntfPrivKey tknId
+agentNtfCheckToken :: AgentClient -> NetworkRequestMode -> NtfTokenId -> NtfToken -> AM NtfTknStatus
+agentNtfCheckToken c nm tknId NtfToken {ntfServer, ntfPrivKey} =
+  withNtfClient c nm ntfServer tknId "TCHK" $ \ntf -> ntfCheckToken ntf nm ntfPrivKey tknId
 
-agentNtfReplaceToken :: AgentClient -> NtfTokenId -> NtfToken -> DeviceToken -> AM ()
-agentNtfReplaceToken c tknId NtfToken {ntfServer, ntfPrivKey} token =
-  withNtfClient c ntfServer tknId "TRPL" $ \ntf -> ntfReplaceToken ntf ntfPrivKey tknId token
+agentNtfReplaceToken :: AgentClient -> NetworkRequestMode -> NtfTokenId -> NtfToken -> DeviceToken -> AM ()
+agentNtfReplaceToken c nm tknId NtfToken {ntfServer, ntfPrivKey} token =
+  withNtfClient c nm ntfServer tknId "TRPL" $ \ntf -> ntfReplaceToken ntf nm ntfPrivKey tknId token
 
-agentNtfDeleteToken :: AgentClient -> NtfServer -> C.APrivateAuthKey -> NtfTokenId -> AM ()
-agentNtfDeleteToken c ntfServer ntfPrivKey tknId =
-  withNtfClient c ntfServer tknId "TDEL" $ \ntf -> ntfDeleteToken ntf ntfPrivKey tknId
+agentNtfDeleteToken :: AgentClient -> NetworkRequestMode -> NtfServer -> C.APrivateAuthKey -> NtfTokenId -> AM ()
+agentNtfDeleteToken c nm ntfServer ntfPrivKey tknId =
+  withNtfClient c nm ntfServer tknId "TDEL" $ \ntf -> ntfDeleteToken ntf nm ntfPrivKey tknId
 
 -- set to 0 to disable
-agentNtfSetCronInterval :: AgentClient -> NtfTokenId -> NtfToken -> Word16 -> AM ()
-agentNtfSetCronInterval c tknId NtfToken {ntfServer, ntfPrivKey} interval =
-  withNtfClient c ntfServer tknId "TCRN" $ \ntf -> ntfSetCronInterval ntf ntfPrivKey tknId interval
+agentNtfSetCronInterval :: AgentClient -> NetworkRequestMode -> NtfTokenId -> NtfToken -> Word16 -> AM ()
+agentNtfSetCronInterval c nm tknId NtfToken {ntfServer, ntfPrivKey} interval =
+  withNtfClient c nm ntfServer tknId "TCRN" $ \ntf -> ntfSetCronInterval ntf nm ntfPrivKey tknId interval
 
 agentNtfCreateSubscription :: AgentClient -> NtfTokenId -> NtfToken -> SMPQueueNtf -> SMP.NtfPrivateAuthKey -> AM NtfSubscriptionId
 agentNtfCreateSubscription c tknId NtfToken {ntfServer, ntfPrivKey} smpQueue nKey =
-  withNtfClient c ntfServer tknId "SNEW" $ \ntf -> ntfCreateSubscription ntf ntfPrivKey (NewNtfSub tknId smpQueue nKey)
+  withNtfClient c NRMBackground ntfServer tknId "SNEW" $ \ntf -> ntfCreateSubscription ntf ntfPrivKey (NewNtfSub tknId smpQueue nKey)
 
 agentNtfCreateSubscriptions :: AgentClient -> NtfToken -> NonEmpty (NewNtfEntity 'Subscription) -> AM' (NonEmpty (Either AgentErrorType NtfSubscriptionId))
 agentNtfCreateSubscriptions = withNtfBatch "SNEW" ntfCreateSubscriptions
 
 agentNtfCheckSubscription :: AgentClient -> NtfToken -> NtfSubscriptionId -> AM NtfSubStatus
 agentNtfCheckSubscription c NtfToken {ntfServer, ntfPrivKey} subId =
-  withNtfClient c ntfServer subId "SCHK" $ \ntf -> ntfCheckSubscription ntf ntfPrivKey subId
+  withNtfClient c NRMBackground ntfServer subId "SCHK" $ \ntf -> ntfCheckSubscription ntf ntfPrivKey subId
 
 agentNtfCheckSubscriptions :: AgentClient -> NtfToken -> NonEmpty NtfSubscriptionId -> AM' (NonEmpty (Either AgentErrorType NtfSubStatus))
 agentNtfCheckSubscriptions = withNtfBatch "SCHK" ntfCheckSubscriptions
@@ -1851,7 +1867,7 @@ withNtfBatch ::
   AM' (NonEmpty (Either AgentErrorType r))
 withNtfBatch cmdStr action c NtfToken {ntfServer, ntfPrivKey} subs = do
   let tSess = (0, ntfServer, Nothing)
-  tryAgentError' (getNtfServerClient c tSess) >>= \case
+  tryAgentError' (getNtfServerClient c NRMBackground tSess) >>= \case
     Left e -> pure $ L.map (\_ -> Left e) subs
     Right ntf -> liftIO $ do
       logServer' "-->" c ntfServer (bshow (length subs) <> " subscriptions") cmdStr
@@ -1861,7 +1877,7 @@ withNtfBatch cmdStr action c NtfToken {ntfServer, ntfPrivKey} subs = do
 
 agentNtfDeleteSubscription :: AgentClient -> NtfSubscriptionId -> NtfToken -> AM ()
 agentNtfDeleteSubscription c subId NtfToken {ntfServer, ntfPrivKey} =
-  withNtfClient c ntfServer subId "SDEL" $ \ntf -> ntfDeleteSubscription ntf ntfPrivKey subId
+  withNtfClient c NRMBackground ntfServer subId "SDEL" $ \ntf -> ntfDeleteSubscription ntf ntfPrivKey subId
 
 agentXFTPDownloadChunk :: AgentClient -> UserId -> FileDigest -> RcvFileChunkReplica -> XFTPRcvChunkSpec -> AM ()
 agentXFTPDownloadChunk c userId (FileDigest chunkDigest) RcvFileChunkReplica {server, replicaId = ChunkReplicaId fId, replicaKey} chunkSpec = do
@@ -1875,7 +1891,7 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize},
   let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest}
   logServer "-->" c srv NoEntity "FNEW"
   tSess <- mkTransportSession c userId srv chunkDigest
-  (sndId, rIds) <- withClient c tSess $ \xftp -> X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth
+  (sndId, rIds) <- withClient c NRMBackground tSess $ \xftp -> X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth
   logServer "<--" c srv NoEntity $ B.unwords ["SIDS", logSecret sndId]
   pure NewSndChunkReplica {server = srv, replicaId = ChunkReplicaId sndId, replicaKey, rcvIdsKeys = L.toList $ xftpRcvIdsKeys rIds rKeys}
 
@@ -2125,12 +2141,12 @@ withStoreBatch' c actions = withStoreBatch c (fmap (fmap Right) . actions)
 
 storeError :: StoreError -> AgentErrorType
 storeError = \case
-  SEConnNotFound -> CONN NOT_FOUND
+  SEConnNotFound -> CONN NOT_FOUND ""
   SEUserNotFound -> NO_USER
-  SERatchetNotFound -> CONN NOT_FOUND
-  SEConnDuplicate -> CONN DUPLICATE
-  SEBadConnType CRcv -> CONN SIMPLEX
-  SEBadConnType CSnd -> CONN SIMPLEX
+  SERatchetNotFound -> CONN NOT_FOUND ""
+  SEConnDuplicate -> CONN DUPLICATE ""
+  SEBadConnType cxt CRcv -> CONN SIMPLEX cxt
+  SEBadConnType cxt CSnd -> CONN SIMPLEX cxt
   SEInvitationNotFound cxt invId -> CMD PROHIBITED $ "SEInvitationNotFound " <> cxt <> ", invitationId = " <> show invId
   -- this error is never reported as store error,
   -- it is used to wrap agent operations when "transaction-like" store access is needed

src/Simplex/Messaging/Agent/NtfSubSupervisor.hs

@@ -14,6 +14,7 @@ module Simplex.Messaging.Agent.NtfSubSupervisor
     nsUpdateToken,
     nsRemoveNtfToken,
     sendNtfSubCommand,
+    hasInstantNotifications,
     instantNotifications,
     deleteToken,
     closeNtfSupervisor,
@@ -45,12 +46,13 @@ import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.AgentStore
 import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Client (NetworkRequestMode (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Protocol (NtfServer, sameSrvAddr)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow)
+import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, whenM)
 import System.Random (randomR)
 import UnliftIO
 import UnliftIO.Concurrent (forkIO)
@@ -525,15 +527,19 @@ nsUpdateToken ns tkn = writeTVar (ntfTkn ns) $ Just tkn
 nsRemoveNtfToken :: NtfSupervisor -> STM ()
 nsRemoveNtfToken ns = writeTVar (ntfTkn ns) Nothing
 
-sendNtfSubCommand :: NtfSupervisor -> (NtfSupervisorCommand, NonEmpty ConnId) -> STM ()
-sendNtfSubCommand ns cmd = do
-  tkn <- readTVar (ntfTkn ns)
-  when (instantNotifications tkn) $ writeTBQueue (ntfSubQ ns) cmd
+sendNtfSubCommand :: NtfSupervisor -> (NtfSupervisorCommand, NonEmpty ConnId) -> IO ()
+sendNtfSubCommand ns cmd =
+  whenM (hasInstantNotifications ns) $ atomically $ writeTBQueue (ntfSubQ ns) cmd
 
-instantNotifications :: Maybe NtfToken -> Bool
-instantNotifications = \case
-  Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> True
-  _ -> False
+hasInstantNotifications :: NtfSupervisor -> IO Bool
+hasInstantNotifications ns = do
+  tkn <- readTVarIO $ ntfTkn ns
+  pure $ maybe False instantNotifications tkn
+
+instantNotifications :: NtfToken -> Bool
+instantNotifications NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} = True
+instantNotifications _ = False
+{-# INLINE instantNotifications #-}
 
 deleteToken :: AgentClient -> NtfToken -> AM ()
 deleteToken c tkn@NtfToken {ntfServer, ntfTokenId, ntfPrivKey} = do
@@ -572,7 +578,7 @@ runNtfTknDelWorker c srv Worker {doWork} =
           notifyInternalError' c (show e)
     processTknToDelete :: NtfTokenToDelete -> AM ()
     processTknToDelete (tknDbId, ntfPrivKey, tknId) = do
-      agentNtfDeleteToken c srv ntfPrivKey tknId
+      agentNtfDeleteToken c NRMBackground srv ntfPrivKey tknId
       withStore' c $ \db -> deleteNtfTokenToDelete db tknDbId
 
 closeNtfSupervisor :: NtfSupervisor -> IO ()

src/Simplex/Messaging/Agent/Protocol.hs

@@ -111,6 +111,7 @@ module Simplex.Messaging.Agent.Protocol
     ServiceScheme,
     FixedLinkData (..),
     ConnLinkData (..),
+    UserLinkData (..),
     OwnerAuth (..),
     OwnerId,
     ConnectionLink (..),
@@ -167,11 +168,14 @@ module Simplex.Messaging.Agent.Protocol
     shortenShortLink,
     restoreShortLink,
     linkUserData,
+    linkUserData',
   )
 where
 
 import Control.Applicative (optional, (<|>))
 import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.:), (.:?))
+import qualified Data.Aeson as J'
+import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.TH as J
 import qualified Data.Aeson.Types as JT
 import Data.Attoparsec.ByteString.Char8 (Parser)
@@ -190,6 +194,7 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.System (SystemTime)
@@ -1148,22 +1153,39 @@ connReqUriP overrideScheme = do
 
 instance ConnectionModeI m => FromJSON (ConnectionRequestUri m) where
   parseJSON = strParseJSON "ConnectionRequestUri"
+  {-# INLINE parseJSON #-}
 
 instance ConnectionModeI m => ToJSON (ConnectionRequestUri m) where
   toJSON = strToJSON
+  {-# INLINE toJSON #-}
   toEncoding = strToJEncoding
+  {-# INLINE toEncoding #-}
 
 instance FromJSON AConnectionRequestUri where
   parseJSON = strParseJSON "ConnectionRequestUri"
+  {-# INLINE parseJSON #-}
 
 instance ToJSON AConnectionRequestUri where
   toJSON = strToJSON
+  {-# INLINE toJSON #-}
   toEncoding = strToJEncoding
+  {-# INLINE toEncoding #-}
 
 instance ConnectionModeI m => FromJSON (ConnShortLink m) where
   parseJSON = strParseJSON "ConnShortLink"
+  {-# INLINE parseJSON #-}
 
 instance ConnectionModeI m => ToJSON (ConnShortLink m) where
+  toJSON = strToJSON
+  {-# INLINE toJSON #-}
+  toEncoding = strToJEncoding
+  {-# INLINE toEncoding #-}
+
+instance FromJSON AConnShortLink where
+  parseJSON = strParseJSON "AConnShortLink"
+  {-# INLINE parseJSON #-}
+
+instance ToJSON AConnShortLink where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
@@ -1191,6 +1213,16 @@ instance Encoding ConnectionMode where
       'C' -> pure CMContact
       _ -> fail "bad connection mode"
 
+instance ToJSON ConnectionMode where
+  toJSON = J'.String . T.toLower . decodeLatin1 . strEncode
+  {-# INLINE toJSON #-}
+  toEncoding = JE.text . T.toLower . decodeLatin1 . strEncode
+  {-# INLINE toEncoding #-}
+
+instance FromJSON ConnectionMode where
+  parseJSON = J'.withText "ConnectionMode" $ either fail pure . parseAll strP . encodeUtf8 . T.toUpper
+  {-# INLINE parseJSON #-}
+
 connModeT :: Text -> Maybe ConnectionMode
 connModeT = \case
   "INV" -> Just CMInvitation
@@ -1417,6 +1449,13 @@ data ContactConnType = CCTContact | CCTChannel | CCTGroup deriving (Eq, Show)
 
 data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
 
+instance Eq AConnShortLink where
+  ACSL m sl == ACSL m' sl' = case testEquality m m' of
+    Just Refl -> sl == sl'
+    Nothing -> False
+
+deriving instance Show AConnShortLink
+
 instance ToField AConnShortLink where toField = toField . Binary . strEncode
 
 instance FromField AConnShortLink where fromField = blobFieldDecoder strDecode
@@ -1633,7 +1672,7 @@ data FixedLinkData c = FixedLinkData
   }
 
 data ConnLinkData c where
-  InvitationLinkData :: VersionRangeSMPA -> ConnInfo -> ConnLinkData 'CMInvitation
+  InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
   ContactLinkData ::
     { agentVRange :: VersionRangeSMPA,
       -- direct connection via connReq in fixed data is allowed.
@@ -1642,15 +1681,22 @@ data ConnLinkData c where
       owners :: [OwnerAuth],
       -- alternative addresses of chat relays that receive requests for this contact address.
       relays :: [ConnShortLink 'CMContact],
-      userData :: ConnInfo
+      userData :: UserLinkData
     } -> ConnLinkData 'CMContact
 
+newtype UserLinkData = UserLinkData ByteString
+
 data AConnLinkData = forall m. ConnectionModeI m => ACLD (SConnectionMode m) (ConnLinkData m)
 
-linkUserData :: ConnLinkData c -> ConnInfo
+linkUserData :: ConnLinkData c -> UserLinkData
 linkUserData = \case
   InvitationLinkData _ d -> d
   ContactLinkData {userData} -> userData
+{-# INLINE linkUserData #-}
+
+linkUserData' :: ConnLinkData c -> ByteString
+linkUserData' d = let UserLinkData s = linkUserData d in s
+{-# INLINE linkUserData' #-}
 
 type OwnerId = ByteString
 
@@ -1697,15 +1743,21 @@ instance Encoding AConnLinkData where
   smpP =
     smpP >>= \case
       CMInvitation -> do
-        (vr, userData) <- smpP
+        (vr, userData) <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
         pure $ ACLD SCMInvitation $ InvitationLinkData vr userData
       CMContact -> do
         (agentVRange, direct) <- smpP
         owners <- smpListP
         relays <- smpListP
-        userData <- smpP
+        userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
         pure $ ACLD SCMContact ContactLinkData {agentVRange, direct, owners, relays, userData}
 
+instance Encoding UserLinkData where
+  smpEncode (UserLinkData s) = if B.length s <= 254 then smpEncode s else smpEncode ('\255', Large s)
+  {-# INLINE smpEncode #-}
+  smpP = UserLinkData <$> ((A.char '\255' *> (unLarge <$> smpP)) <|> smpP)
+  {-# INLINE smpP #-}
+
 data StoredClientService (s :: DBStored) = ClientService
   { dbServiceId :: DBEntityId' s,
     serviceId :: SMP.ServiceId
@@ -1785,7 +1837,7 @@ data AgentErrorType
   = -- | command or response error
     CMD {cmdErr :: CommandErrorType, errContext :: String}
   | -- | connection errors
-    CONN {connErr :: ConnectionErrorType}
+    CONN {connErr :: ConnectionErrorType, errContext :: String}
   | -- | user not found in database
     NO_USER
   | -- | SMP protocol errors forwarded to agent clients
@@ -1919,7 +1971,7 @@ commandP binaryP =
     s :: Parser a -> Parser a
     s p = A.space *> p
     pqIKP :: Parser InitialKeys
-    pqIKP = strP_ <|> pure (IKNoPQ PQSupportOff)
+    pqIKP = strP_ <|> pure (IKLinkPQ PQSupportOff)
     pqSupP :: Parser PQSupport
     pqSupP = strP_ <|> pure PQSupportOff
 

src/Simplex/Messaging/Agent/Store.hs

@@ -119,6 +119,10 @@ rcvQueueInfo :: RcvQueue -> RcvQueueInfo
 rcvQueueInfo rq@RcvQueue {server, rcvSwchStatus} =
   RcvQueueInfo {rcvServer = server, rcvSwitchStatus = rcvSwchStatus, canAbortSwitch = canAbortRcvSwitch rq}
 
+rcvSMPQueueAddress :: RcvQueue -> SMPQueueAddress
+rcvSMPQueueAddress RcvQueue {server, sndId, e2ePrivKey, queueMode} =
+  SMPQueueAddress server sndId (C.publicKey e2ePrivKey) queueMode
+
 canAbortRcvSwitch :: RcvQueue -> Bool
 canAbortRcvSwitch = maybe False canAbort . rcvSwchStatus
   where
@@ -511,7 +515,7 @@ data NewInvitation = NewInvitation
 
 data Invitation = Invitation
   { invitationId :: InvitationId,
-    contactConnId :: ConnId,
+    contactConnId_ :: Maybe ConnId,
     connReq :: ConnectionRequestUri 'CMInvitation,
     recipientConnInfo :: ConnInfo,
     ownConnInfo :: Maybe ConnInfo,
@@ -662,7 +666,7 @@ data StoreError
     SESndQueueExists
   | -- | Wrong connection type, e.g. "send" connection when "receive" or "duplex" is expected, or vice versa.
     -- 'upgradeRcvConnToDuplex' and 'upgradeSndConnToDuplex' do not allow duplex connections - they would also return this error.
-    SEBadConnType ConnType
+    SEBadConnType String ConnType
   | -- | Confirmation not found.
     SEConfirmationNotFound
   | -- | Invitation not found

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

@@ -387,7 +387,7 @@ updateNewConnRcv db connId rq =
   getConn db connId $>>= \case
     (SomeConn _ NewConnection {}) -> updateConn
     (SomeConn _ RcvConnection {}) -> updateConn -- to allow retries
-    (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    (SomeConn c _) -> pure . Left . SEBadConnType "updateNewConnRcv" $ connType c
   where
     updateConn :: IO (Either StoreError RcvQueue)
     updateConn = Right <$> addConnRcvQueue_ db connId rq
@@ -396,7 +396,7 @@ updateNewConnSnd :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreEr
 updateNewConnSnd db connId sq =
   getConn db connId $>>= \case
     (SomeConn _ NewConnection {}) -> updateConn
-    (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    (SomeConn c _) -> pure . Left . SEBadConnType "updateNewConnSnd" $ connType c
   where
     updateConn :: IO (Either StoreError SndQueue)
     updateConn = Right <$> addConnSndQueue_ db connId sq
@@ -472,14 +472,14 @@ upgradeRcvConnToDuplex :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either S
 upgradeRcvConnToDuplex db connId sq =
   getConn db connId $>>= \case
     (SomeConn _ RcvConnection {}) -> Right <$> addConnSndQueue_ db connId sq
-    (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    (SomeConn c _) -> pure . Left . SEBadConnType "upgradeRcvConnToDuplex" $ connType c
 
 -- TODO [certs rcv] store clientServiceId from NewRcvQueue
 upgradeSndConnToDuplex :: DB.Connection -> ConnId -> NewRcvQueue -> IO (Either StoreError RcvQueue)
 upgradeSndConnToDuplex db connId rq =
   getConn db connId >>= \case
     Right (SomeConn _ SndConnection {}) -> Right <$> addConnRcvQueue_ db connId rq
-    Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    Right (SomeConn c _) -> pure . Left . SEBadConnType "upgradeSndConnToDuplex" $ connType c
     _ -> pure $ Left SEConnNotFound
 
 -- TODO [certs rcv] store clientServiceId from NewRcvQueue
@@ -487,7 +487,7 @@ addConnRcvQueue :: DB.Connection -> ConnId -> NewRcvQueue -> IO (Either StoreErr
 addConnRcvQueue db connId rq =
   getConn db connId >>= \case
     Right (SomeConn _ DuplexConnection {}) -> Right <$> addConnRcvQueue_ db connId rq
-    Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    Right (SomeConn c _) -> pure . Left . SEBadConnType "addConnRcvQueue" $ connType c
     _ -> pure $ Left SEConnNotFound
 
 addConnRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> IO RcvQueue
@@ -499,7 +499,7 @@ addConnSndQueue :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreErr
 addConnSndQueue db connId sq =
   getConn db connId >>= \case
     Right (SomeConn _ DuplexConnection {}) -> Right <$> addConnSndQueue_ db connId sq
-    Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    Right (SomeConn c _) -> pure . Left . SEBadConnType "addConnSndQueue" $ connType c
     _ -> pure $ Left SEConnNotFound
 
 addConnSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> IO SndQueue
@@ -728,7 +728,7 @@ createInvitation db gVar NewInvitation {contactConnId, connReq, recipientConnInf
       db
       [sql|
         INSERT INTO conn_invitations
-        (invitation_id,  contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
+        (invitation_id, contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
       |]
       (Binary invitationId, contactConnId, connReq, Binary recipientConnInfo)
 
@@ -745,8 +745,8 @@ getInvitation db cxt invitationId =
       |]
       (Only (Binary invitationId))
   where
-    invitation (contactConnId, connReq, recipientConnInfo, ownConnInfo, BI accepted) =
-      Invitation {invitationId, contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted}
+    invitation (contactConnId_, connReq, recipientConnInfo, ownConnInfo, BI accepted) =
+      Invitation {invitationId, contactConnId_, connReq, recipientConnInfo, ownConnInfo, accepted}
 
 acceptInvitation :: DB.Connection -> InvitationId -> ConnInfo -> IO ()
 acceptInvitation db invitationId ownConnInfo =
@@ -764,12 +764,9 @@ unacceptInvitation :: DB.Connection -> InvitationId -> IO ()
 unacceptInvitation db invitationId =
   DB.execute db "UPDATE conn_invitations SET accepted = 0, own_conn_info = NULL WHERE invitation_id = ?" (Only (Binary invitationId))
 
-deleteInvitation :: DB.Connection -> ConnId -> InvitationId -> IO (Either StoreError ())
-deleteInvitation db contactConnId invId =
-  getConn db contactConnId $>>= \case
-    SomeConn SCContact _ ->
-      Right <$> DB.execute db "DELETE FROM conn_invitations WHERE contact_conn_id = ? AND invitation_id = ?" (contactConnId, Binary invId)
-    _ -> pure $ Left SEConnNotFound
+deleteInvitation :: DB.Connection -> InvitationId -> IO ()
+deleteInvitation db invId =
+  DB.execute db "DELETE FROM conn_invitations WHERE invitation_id = ?" (Only (Binary invId))
 
 getInvShortLink :: DB.Connection -> SMPServer -> LinkId -> IO (Maybe InvShortLink)
 getInvShortLink db server linkId =
@@ -1972,15 +1969,22 @@ insertRcvQueue_ db connId' rq@RcvQueue {..} serverKeyHash_ = do
       INSERT INTO rcv_queues
         ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret,
           snd_id, queue_mode, status, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash,
-          link_id, link_key, link_priv_sig_key, link_enc_fixed_data
-        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
+          link_id, link_key, link_priv_sig_key, link_enc_fixed_data,
+          ntf_public_key, ntf_private_key, ntf_id, rcv_ntf_dh_secret
+        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
     |]
     ( (host server, port server, rcvId, connId', rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret)
         :. (sndId, queueMode, status, qId, BI primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_)
         :. (shortLinkId <$> shortLink, shortLinkKey <$> shortLink, linkPrivSigKey <$> shortLink, linkEncFixedData <$> shortLink)
+        :. ntfCredsFields
     )
   -- TODO [certs rcv] save client service
   pure (rq :: NewRcvQueue) {connId = connId', dbQueueId = qId, clientService = Nothing}
+  where
+    ntfCredsFields = case clientNtfCreds of
+      Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret} ->
+        (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret)
+      Nothing -> (Nothing, Nothing, Nothing, Nothing)
 
 -- * createSndConn helpers
 

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

@@ -11,21 +11,23 @@ module Simplex.Messaging.Agent.Store.Postgres.DB
     execute,
     execute_,
     executeMany,
-    PSQL.query,
-    PSQL.query_,
+    query,
+    query_,
     blobFieldDecoder,
     fromTextField_,
   )
 where
 
+import qualified Control.Exception as E
 import Control.Monad (void)
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8)
 import Data.Typeable (Typeable)
 import Data.Word (Word16, Word32)
-import Database.PostgreSQL.Simple (ResultError (..))
+import Database.PostgreSQL.Simple (ResultError (..), SqlError (..))
 import qualified Database.PostgreSQL.Simple as PSQL
 import Database.PostgreSQL.Simple.FromField (Field (..), FieldParser, FromField (..), returnError)
 import Database.PostgreSQL.Simple.ToField (ToField (..))
@@ -42,17 +44,49 @@ instance ToField BoolInt where
   {-# INLINE toField #-}
 
 execute :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> q -> IO ()
-execute db q qs = void $ PSQL.execute db q qs
+execute db q qs = withLoggedErrors q $ void $ PSQL.execute db q qs
 {-# INLINE execute #-}
 
 execute_ :: PSQL.Connection -> PSQL.Query -> IO ()
-execute_ db q = void $ PSQL.execute_ db q
+execute_ db q = withLoggedErrors q $ void $ PSQL.execute_ db q
 {-# INLINE execute_ #-}
 
 executeMany :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> [q] -> IO ()
-executeMany db q qs = void $ PSQL.executeMany db q qs
+executeMany db q qs = withLoggedErrors q $ void $ PSQL.executeMany db q qs
 {-# INLINE executeMany #-}
 
+query :: (PSQL.ToRow q, PSQL.FromRow r) => PSQL.Connection -> PSQL.Query -> q -> IO [r]
+query db q qs = withLoggedErrors q $ PSQL.query db q qs
+{-# INLINE query #-}
+
+query_ :: PSQL.FromRow r => PSQL.Connection -> PSQL.Query -> IO [r]
+query_ db q = withLoggedErrors q $ PSQL.query_ db q
+{-# INLINE query_ #-}
+
+withLoggedErrors :: Show q => q -> IO a -> IO a
+withLoggedErrors q action =
+  action
+    `E.catch` (\(e :: SqlError) -> logSqlErrorAndRethrow e)
+    `E.catch`
+      (\(e :: E.SomeException) ->
+        case E.fromException e :: Maybe SqlError of
+          Just sqlErr -> E.throwIO sqlErr -- rethrow SqlError without logging
+          Nothing -> logGenericErrorAndRethrow e
+      )
+  where
+    logSqlErrorAndRethrow :: SqlError -> IO a
+    logSqlErrorAndRethrow e = do
+      putStrLn "Caught SqlError"
+      putStrLn $ "Message: " <> B.unpack (sqlErrorMsg e)
+      putStrLn $ "SQL State: " <> B.unpack (sqlState e)
+      putStrLn $ "Query: " <> show q
+      E.throwIO e
+    logGenericErrorAndRethrow :: E.SomeException -> IO a
+    logGenericErrorAndRethrow e = do
+      putStrLn $ "Caught generic exception: " <> show e
+      putStrLn $ "Query: " <> show q
+      E.throwIO e
+
 -- orphan instances
 
 -- used in FileSize

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

@@ -7,13 +7,15 @@ import Data.Text (Text)
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Text, Maybe Text)]
 schemaMigrations =
   [ ("20241210_initial", m20241210_initial, Nothing),
     ("20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies),
-    ("20250322_short_links", m20250322_short_links, Just down_m20250322_short_links)
+    ("20250322_short_links", m20250322_short_links, Just down_m20250322_short_links),
+    ("20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete)
   ]
 
 -- | The list of migrations in ascending order by date

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

@@ -0,0 +1,37 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.RawString.QQ (r)
+
+m20250702_conn_invitations_remove_cascade_delete :: Text
+m20250702_conn_invitations_remove_cascade_delete =
+  T.pack
+    [r|
+ALTER TABLE conn_invitations DROP CONSTRAINT conn_invitations_contact_conn_id_fkey;
+
+ALTER TABLE conn_invitations ALTER COLUMN contact_conn_id DROP NOT NULL;
+
+ALTER TABLE conn_invitations
+  ADD CONSTRAINT conn_invitations_contact_conn_id_fkey
+  FOREIGN KEY (contact_conn_id)
+  REFERENCES connections(conn_id)
+  ON DELETE SET NULL;
+|]
+
+down_m20250702_conn_invitations_remove_cascade_delete :: Text
+down_m20250702_conn_invitations_remove_cascade_delete =
+  T.pack
+    [r|
+ALTER TABLE conn_invitations DROP CONSTRAINT conn_invitations_contact_conn_id_fkey;
+
+ALTER TABLE conn_invitations ALTER COLUMN contact_conn_id SET NOT NULL;
+
+ALTER TABLE conn_invitations
+  ADD CONSTRAINT conn_invitations_contact_conn_id_fkey
+  FOREIGN KEY (contact_conn_id)
+  REFERENCES connections(conn_id)
+  ON DELETE CASCADE;
+|]

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

@@ -43,6 +43,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -85,7 +86,8 @@ schemaMigrations =
     ("m20241007_rcv_queues_last_broker_ts", m20241007_rcv_queues_last_broker_ts, Just down_m20241007_rcv_queues_last_broker_ts),
     ("m20241224_ratchet_e2e_snd_params", m20241224_ratchet_e2e_snd_params, Just down_m20241224_ratchet_e2e_snd_params),
     ("m20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies),
-    ("m20250322_short_links", m20250322_short_links, Just down_m20250322_short_links)
+    ("m20250322_short_links", m20250322_short_links, Just down_m20250322_short_links),
+    ("m20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete)
   ]
 
 -- | The list of migrations in ascending order by date

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

@@ -5,6 +5,7 @@ module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250517_service_certs w
 import Database.SQLite.Simple (Query)
 import Database.SQLite.Simple.QQ (sql)
 
+-- TODO move date forward, create migration for postgres
 m20250517_service_certs :: Query
 m20250517_service_certs =
   [sql|

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

@@ -0,0 +1,38 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20250702_conn_invitations_remove_cascade_delete :: Query
+m20250702_conn_invitations_remove_cascade_delete =
+  [sql|
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master
+SET sql = replace(
+            sql,
+            'contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE',
+            'contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL'
+          )
+WHERE name = 'conn_invitations' AND type = 'table';
+
+PRAGMA writable_schema=0;
+|]
+
+down_m20250702_conn_invitations_remove_cascade_delete :: Query
+down_m20250702_conn_invitations_remove_cascade_delete =
+  [sql|
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master
+SET sql = replace(
+            sql,
+            'contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL',
+            'contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE'
+          )
+WHERE name = 'conn_invitations' AND type = 'table';
+
+PRAGMA writable_schema=0;
+|]

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql

@@ -154,7 +154,7 @@ CREATE TABLE conn_confirmations(
 ) WITHOUT ROWID;
 CREATE TABLE conn_invitations(
   invitation_id BLOB NOT NULL PRIMARY KEY,
-  contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL,
   cr_invitation BLOB NOT NULL,
   recipient_conn_info BLOB NOT NULL,
   accepted INTEGER NOT NULL DEFAULT 0,

src/Simplex/Messaging/Client.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
@@ -81,12 +82,16 @@ module Simplex.Messaging.Client
     unexpectedResponse,
     ProtocolClientConfig (..),
     NetworkConfig (..),
+    NetworkTimeout (..),
+    NetworkRequestMode (..),
+    pattern NRMInteractive,
     TransportSessionMode (..),
     HostMode (..),
     SocksMode (..),
     SMPProxyMode (..),
     SMPProxyFallback (..),
     SMPWebPortServers (..),
+    netTimeoutInt,
     defaultClientConfig,
     defaultSMPClientConfig,
     defaultNetworkConfig,
@@ -154,7 +159,7 @@ import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultSMPPort, defaultTcpConnectTimeout, runTransportClient)
+import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultSMPPort, runTransportClient)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
@@ -175,15 +180,15 @@ data PClient v err msg = PClient
   { connected :: TVar Bool,
     transportSession :: TransportSession msg,
     transportHost :: TransportHost,
-    tcpConnectTimeout :: Int,
-    tcpTimeout :: Int,
+    tcpConnectTimeout :: NetworkTimeout,
+    tcpTimeout :: NetworkTimeout,
     sendPings :: TVar Bool,
     lastReceived :: TVar UTCTime,
     timeoutErrorCount :: TVar Int,
     clientCorrId :: TVar ChaChaDRG,
     sentCommands :: TMap CorrId (Request err msg),
     sndQ :: TBQueue (Maybe (Request err msg), ByteString),
-    rcvQ :: TBQueue (NonEmpty (SignedTransmission err msg)),
+    rcvQ :: TBQueue (NonEmpty (Transmission (Either err msg))),
     msgQ :: Maybe (TBQueue (ServerTransmissionBatch v err msg))
   }
 
@@ -198,6 +203,7 @@ smpClientStub g sessionId thVersion thAuth = do
   timeoutErrorCount <- newTVarIO 0
   sndQ <- newTBQueueIO 100
   rcvQ <- newTBQueueIO 100
+  let NetworkConfig {tcpConnectTimeout, tcpTimeout} = defaultNetworkConfig
   return
     ProtocolClient
       { action = Nothing,
@@ -219,8 +225,8 @@ smpClientStub g sessionId thVersion thAuth = do
             { connected,
               transportSession = (1, "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001", Nothing),
               transportHost = "localhost",
-              tcpConnectTimeout = 20_000_000,
-              tcpTimeout = 15_000_000,
+              tcpConnectTimeout,
+              tcpTimeout,
               sendPings,
               lastReceived,
               timeoutErrorCount,
@@ -298,9 +304,9 @@ data NetworkConfig = NetworkConfig
     -- | use web port 443 for SMP protocol
     smpWebPortServers :: SMPWebPortServers,
     -- | timeout for the initial client TCP/TLS connection (microseconds)
-    tcpConnectTimeout :: Int,
+    tcpConnectTimeout :: NetworkTimeout,
     -- | timeout of protocol commands (microseconds)
-    tcpTimeout :: Int,
+    tcpTimeout :: NetworkTimeout,
     -- | additional timeout per kilobyte (1024 bytes) to be sent
     tcpTimeoutPerKb :: Int64,
     -- | break response timeouts into groups, so later responses get later deadlines
@@ -315,6 +321,28 @@ data NetworkConfig = NetworkConfig
   }
   deriving (Eq, Show)
 
+data NetworkTimeout = NetworkTimeout {backgroundTimeout :: Int, interactiveTimeout :: Int}
+  deriving (Eq, Show)
+
+data NetworkRequestMode
+  = NRMBackground
+  | NRMInteractive' {retryCount :: Int}
+
+pattern NRMInteractive :: NetworkRequestMode
+pattern NRMInteractive = NRMInteractive' 0
+
+netTimeoutInt :: NetworkTimeout -> NetworkRequestMode -> Int
+netTimeoutInt NetworkTimeout {backgroundTimeout, interactiveTimeout} = \case
+  NRMBackground -> backgroundTimeout
+  NRMInteractive' n
+    | n <= 0 -> interactiveTimeout
+    | otherwise ->
+        let (m, d)
+              | n == 1 = (3, 2)
+              | n == 2 = (9, 4)
+              | otherwise = (27, 8)
+         in (interactiveTimeout * m) `div` d
+
 data TransportSessionMode = TSMUser | TSMSession | TSMServer | TSMEntity
   deriving (Eq, Show)
 
@@ -387,8 +415,8 @@ defaultNetworkConfig =
       smpProxyMode = SPMNever,
       smpProxyFallback = SPFAllow,
       smpWebPortServers = SWPPreset,
-      tcpConnectTimeout = defaultTcpConnectTimeout,
-      tcpTimeout = 15_000_000,
+      tcpConnectTimeout = NetworkTimeout {backgroundTimeout = 45_000000, interactiveTimeout = 15_000000},
+      tcpTimeout = NetworkTimeout {backgroundTimeout = 30_000000, interactiveTimeout = 10_000000},
       tcpTimeoutPerKb = 5_000,
       rcvConcurrency = 8,
       tcpKeepAlive = Just defaultKeepAliveOpts,
@@ -397,10 +425,11 @@ defaultNetworkConfig =
       logTLSErrors = False
     }
 
-transportClientConfig :: NetworkConfig -> TransportHost -> Bool -> Maybe [ALPN] -> TransportClientConfig
-transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host useSNI clientALPN =
-  TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, clientALPN, useSNI}
+transportClientConfig :: NetworkConfig -> NetworkRequestMode -> TransportHost -> Bool -> Maybe [ALPN] -> TransportClientConfig
+transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} nm host useSNI clientALPN =
+  TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout = tOut, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, clientALPN, useSNI}
   where
+    tOut = netTimeoutInt tcpConnectTimeout nm
     socksProxy' = (\(SocksProxyWithAuth _ proxy) -> proxy) <$> socksProxy
     useSocksProxy SMAlways = socksProxy'
     useSocksProxy SMOnion = case host of
@@ -523,8 +552,8 @@ type TransportSession msg = (UserId, ProtoServer msg, Maybe ByteString)
 --
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
-getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> [HostName] -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> UTCTime -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
-getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serviceCredentials, serverVRange, agreeSecret, proxyServer, useSNI} presetDomains msgQ proxySessTs disconnected = do
+getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> NetworkRequestMode -> TransportSession msg -> ProtocolClientConfig v -> [HostName] -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> UTCTime -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
+getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serviceCredentials, serverVRange, agreeSecret, proxyServer, useSNI} presetDomains msgQ proxySessTs disconnected = do
   case chooseTransportHost networkConfig (host srv) of
     Right useHost ->
       (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
@@ -562,12 +591,12 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
     runClient :: (ServiceName, ATransport 'TClient) -> TransportHost -> PClient v err msg -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
     runClient (port', ATransport t) useHost c = do
       cVar <- newEmptyTMVarIO
-      let tcConfig = (transportClientConfig networkConfig useHost useSNI clientALPN) {clientCredentials = serviceCreds <$> serviceCredentials}
+      let tcConfig = (transportClientConfig networkConfig nm useHost useSNI clientALPN) {clientCredentials = serviceCreds <$> serviceCredentials}
           socksCreds = clientSocksCredentials networkConfig proxySessTs transportSession
       tId <-
         runTransportClient tcConfig socksCreds useHost port' (Just $ keyHash srv) (client t c cVar)
           `forkFinally` \_ -> void (atomically . tryPutTMVar cVar $ Left PCENetworkError)
-      c_ <- tcpConnectTimeout `timeout` atomically (takeTMVar cVar)
+      c_ <- netTimeoutInt tcpConnectTimeout nm `timeout` atomically (takeTMVar cVar)
       case c_ of
         Just (Right c') -> mkWeakThreadId tId >>= \tId' -> pure $ Right c' {action = Just tId'}
         Just (Left e) -> pure $ Left e
@@ -615,7 +644,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
 
     receive :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO ()
     receive ProtocolClient {client_ = PClient {rcvQ, lastReceived, timeoutErrorCount}} h = forever $ do
-      tGet h >>= atomically . writeTBQueue rcvQ
+      tGetClient h >>= atomically . writeTBQueue rcvQ
       getCurrentTime >>= atomically . writeTVar lastReceived
       atomically $ writeTVar timeoutErrorCount 0
 
@@ -631,7 +660,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
           if remaining > 1_000_000 -- delay pings only for significant time
             then loop remaining
             else do
-              whenM (readTVarIO sendPings) $ void . runExceptT $ sendProtocolCommand c Nothing NoEntity (protocolPing @v @err @msg)
+              whenM (readTVarIO sendPings) $ void . runExceptT $ sendProtocolCommand c NRMBackground Nothing NoEntity (protocolPing @v @err @msg)
               -- sendProtocolCommand/getResponse updates counter for each command
               cnt <- readTVarIO timeoutErrorCount
               -- drop client when maxCnt of commands have timed out in sequence, but only after some time has passed after last received response
@@ -642,14 +671,14 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
     process :: ProtocolClient v err msg -> IO ()
     process c = forever $ atomically (readTBQueue $ rcvQ $ client_ c) >>= processMsgs c
 
-    processMsgs :: ProtocolClient v err msg -> NonEmpty (SignedTransmission err msg) -> IO ()
+    processMsgs :: ProtocolClient v err msg -> NonEmpty (Transmission (Either err msg)) -> IO ()
     processMsgs c ts = do
       ts' <- catMaybes <$> mapM (processMsg c) (L.toList ts)
       forM_ msgQ $ \q ->
         mapM_ (atomically . writeTBQueue q . serverTransmission c) (L.nonEmpty ts')
 
-    processMsg :: ProtocolClient v err msg -> SignedTransmission err msg -> IO (Maybe (EntityId, ServerTransmission err msg))
-    processMsg ProtocolClient {client_ = PClient {sentCommands}} (_, _, (corrId, entId, respOrErr))
+    processMsg :: ProtocolClient v err msg -> Transmission (Either err msg) -> IO (Maybe (EntityId, ServerTransmission err msg))
+    processMsg ProtocolClient {client_ = PClient {sentCommands}} (corrId, entId, respOrErr)
       | B.null $ bs corrId = sendMsg $ STEvent clientResp
       | otherwise =
           TM.lookupIO corrId sentCommands >>= \case
@@ -757,38 +786,41 @@ smpProxyError = \case
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#create-queue-command
 createSMPQueue ::
   SMPClient ->
+  NetworkRequestMode ->
   Maybe C.CbNonce -> -- used as correlation ID to allow deriving SenderId from it for short links
   C.AAuthKeyPair -> -- SMP v6 - signature key pair, SMP v7 - DH key pair
   RcvPublicDhKey ->
   Maybe BasicAuth ->
   SubscriptionMode ->
   QueueReqData ->
-  -- TODO [notifications]
-  -- Maybe NewNtfCreds ->
+  Maybe NewNtfCreds ->
   ExceptT SMPClientError IO QueueIdsKeys
-createSMPQueue c nonce_ (rKey, rpKey) dhKey auth subMode qrd =
-  sendProtocolCommand_ c nonce_ Nothing (Just rpKey) NoEntity (Cmd SRecipient $ NEW $ NewQueueReq rKey dhKey auth subMode (Just qrd)) >>= \case
+createSMPQueue c nm nonce_ (rKey, rpKey) dhKey auth subMode qrd ntfCreds =
+  sendProtocolCommand_ c nm nonce_ Nothing (Just rpKey) NoEntity (Cmd SCreator $ NEW $ NewQueueReq rKey dhKey auth subMode (Just qrd) ntfCreds) >>= \case
     IDS qik -> pure qik
     r -> throwE $ unexpectedResponse r
 
 -- | Subscribe to the SMP queue.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue
+-- This command is always sent in background request mode
 subscribeSMPQueue :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> ExceptT SMPClientError IO (Maybe ServiceId)
 subscribeSMPQueue c rpKey rId = do
   liftIO $ enablePings c
-  sendSMPCommand c (Just rpKey) rId SUB >>= liftIO . processSUBResponse_ c rId >>= except
+  sendSMPCommand c NRMBackground (Just rpKey) rId SUB >>= liftIO . processSUBResponse_ c rId >>= except
 
 -- | Subscribe to multiple SMP queues batching commands if supported.
+-- This command is always sent in background request mode
 subscribeSMPQueues :: SMPClient -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> IO (NonEmpty (Either SMPClientError (Maybe ServiceId)))
 subscribeSMPQueues c qs = do
   liftIO $ enablePings c
-  sendProtocolCommands c cs >>= mapM (processSUBResponse c)
+  sendProtocolCommands c NRMBackground cs >>= mapM (processSUBResponse c)
   where
     cs = L.map (\(rId, rpKey) -> (rId, Just rpKey, Cmd SRecipient SUB)) qs
 
+-- This command is always sent in background request mode
 streamSubscribeSMPQueues :: SMPClient -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> ([(RecipientId, Either SMPClientError (Maybe ServiceId))] -> IO ()) -> IO ()
-streamSubscribeSMPQueues c qs cb = streamProtocolCommands c cs $ mapM process >=> cb
+streamSubscribeSMPQueues c qs cb = streamProtocolCommands c NRMBackground cs $ mapM process >=> cb
   where
     cs = L.map (\(rId, rpKey) -> (rId, Just rpKey, Cmd SRecipient SUB)) qs
     process r@(Response rId _) = (rId,) <$> processSUBResponse c r
@@ -813,9 +845,10 @@ serverTransmission ProtocolClient {thParams = THandleParams {thVersion, sessionI
 -- | 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
+-- This command is always sent in interactive request mode, as NSE has limited time
 getSMPMessage :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> ExceptT SMPClientError IO (Maybe RcvMessage)
 getSMPMessage c rpKey rId =
-  sendSMPCommand c (Just rpKey) rId GET >>= \case
+  sendSMPCommand c NRMInteractive (Just rpKey) rId GET >>= \case
     OK -> pure Nothing
     cmd@(MSG msg) -> liftIO (writeSMPMessage c rId cmd) $> Just msg
     r -> throwE $ unexpectedResponse r
@@ -824,16 +857,18 @@ getSMPMessage c rpKey rId =
 -- | Subscribe to the SMP queue notifications.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue-notifications
+-- This command is always sent in background request mode
 subscribeSMPQueueNotifications :: SMPClient -> NtfPrivateAuthKey -> NotifierId -> ExceptT SMPClientError IO (Maybe ServiceId)
 subscribeSMPQueueNotifications c npKey nId = do
   liftIO $ enablePings c
-  sendSMPCommand c (Just npKey) nId NSUB >>= except . nsubResponse_
+  sendSMPCommand c NRMBackground (Just npKey) nId NSUB >>= except . nsubResponse_
 
 -- | Subscribe to multiple SMP queues notifications batching commands if supported.
+-- This command is always sent in background request mode
 subscribeSMPQueuesNtfs :: SMPClient -> NonEmpty (NotifierId, NtfPrivateAuthKey) -> IO (NonEmpty (Either SMPClientError (Maybe ServiceId)))
 subscribeSMPQueuesNtfs c qs = do
   liftIO $ enablePings c
-  L.map nsubResponse <$> sendProtocolCommands c cs
+  L.map nsubResponse <$> sendProtocolCommands c NRMBackground cs
   where
     cs = L.map (\(nId, npKey) -> (nId, Just npKey, Cmd SNotifier NSUB)) qs
 
@@ -848,18 +883,19 @@ nsubResponse_ = \case
   r' -> Left $ unexpectedResponse r'
 {-# INLINE nsubResponse_ #-}
 
-subscribeService :: forall p. (PartyI p, SubscriberParty p) => SMPClient -> SParty p -> ExceptT SMPClientError IO Int64
+-- This command is always sent in background request mode
+subscribeService :: forall p. (PartyI p, ServiceParty p) => SMPClient -> SParty p -> ExceptT SMPClientError IO Int64
 subscribeService c party = case smpClientService c of
   Just THClientService {serviceId, serviceKey} -> do
     liftIO $ enablePings c
-    sendSMPCommand c (Just (C.APrivateAuthKey C.SEd25519 serviceKey)) serviceId subCmd >>= \case
+    sendSMPCommand c NRMBackground (Just (C.APrivateAuthKey C.SEd25519 serviceKey)) serviceId subCmd >>= \case
       SOKS n -> pure n
       r -> throwE $ unexpectedResponse r
     where
       subCmd :: Command p
       subCmd = case party of
-        SRecipient -> SUBS
-        SNotifier -> NSUBS
+        SRecipientService -> SUBS
+        SNotifierService -> NSUBS
   Nothing -> throwE PCEServiceUnavailable
 
 smpClientService :: SMPClient -> Maybe THClientService
@@ -873,53 +909,54 @@ enablePings ProtocolClient {client_ = PClient {sendPings}} = atomically $ writeT
 -- | Secure the SMP queue by adding a sender public key.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#secure-queue-command
-secureSMPQueue :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> SndPublicAuthKey -> ExceptT SMPClientError IO ()
-secureSMPQueue c rpKey rId senderKey = okSMPCommand (KEY senderKey) c rpKey rId
+secureSMPQueue :: SMPClient -> NetworkRequestMode -> RcvPrivateAuthKey -> RecipientId -> SndPublicAuthKey -> ExceptT SMPClientError IO ()
+secureSMPQueue c nm rpKey rId senderKey = okSMPCommand (KEY senderKey) c nm rpKey rId
 {-# INLINE secureSMPQueue #-}
 
 -- | Secure the SMP queue via sender queue ID.
-secureSndSMPQueue :: SMPClient -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO ()
-secureSndSMPQueue c spKey sId senderKey = okSMPCommand (SKEY senderKey) c spKey sId
+secureSndSMPQueue :: SMPClient -> NetworkRequestMode -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO ()
+secureSndSMPQueue c nm spKey sId senderKey = okSMPCommand (SKEY senderKey) c nm spKey sId
 {-# INLINE secureSndSMPQueue #-}
 
-proxySecureSndSMPQueue :: SMPClient -> ProxiedRelay -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySecureSndSMPQueue c proxiedRelay spKey sId senderKey = proxyOKSMPCommand c proxiedRelay (Just spKey) sId (SKEY senderKey)
+proxySecureSndSMPQueue :: SMPClient -> NetworkRequestMode -> ProxiedRelay -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO (Either ProxyClientError ())
+proxySecureSndSMPQueue c nm proxiedRelay spKey sId senderKey = proxyOKSMPCommand c nm proxiedRelay (Just spKey) sId (SKEY senderKey)
 {-# INLINE proxySecureSndSMPQueue #-}
 
 -- | Add or update date for queue link
-addSMPQueueLink :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> LinkId -> QueueLinkData -> ExceptT SMPClientError IO ()
-addSMPQueueLink c rpKey rId lnkId d = okSMPCommand (LSET lnkId d) c rpKey rId
+addSMPQueueLink :: SMPClient -> NetworkRequestMode -> RcvPrivateAuthKey -> RecipientId -> LinkId -> QueueLinkData -> ExceptT SMPClientError IO ()
+addSMPQueueLink c nm rpKey rId lnkId d = okSMPCommand (LSET lnkId d) c nm rpKey rId
 {-# INLINE addSMPQueueLink #-}
 
 -- | Delete queue link
-deleteSMPQueueLink :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> ExceptT SMPClientError IO ()
+deleteSMPQueueLink :: SMPClient -> NetworkRequestMode -> RcvPrivateAuthKey -> RecipientId -> ExceptT SMPClientError IO ()
 deleteSMPQueueLink = okSMPCommand LDEL
 {-# INLINE deleteSMPQueueLink #-}
 
 -- | Get 1-time inviation SMP queue link data and secure the queue via queue link ID.
-secureGetSMPQueueLink :: SMPClient -> SndPrivateAuthKey -> LinkId -> SndPublicAuthKey -> ExceptT SMPClientError IO (SenderId, QueueLinkData)
-secureGetSMPQueueLink c spKey lnkId senderKey =
-  sendSMPCommand c (Just spKey) lnkId (LKEY senderKey) >>= \case
+secureGetSMPQueueLink :: SMPClient -> NetworkRequestMode -> SndPrivateAuthKey -> LinkId -> SndPublicAuthKey -> ExceptT SMPClientError IO (SenderId, QueueLinkData)
+secureGetSMPQueueLink c nm spKey lnkId senderKey =
+  sendSMPCommand c nm (Just spKey) lnkId (LKEY senderKey) >>= \case
     LNK sId d -> pure (sId, d)
     r -> throwE $ unexpectedResponse r
 
-proxySecureGetSMPQueueLink :: SMPClient -> ProxiedRelay -> SndPrivateAuthKey -> LinkId -> SndPublicAuthKey -> ExceptT SMPClientError IO (Either ProxyClientError (SenderId, QueueLinkData))
-proxySecureGetSMPQueueLink c proxiedRelay spKey lnkId senderKey =
-  proxySMPCommand  c proxiedRelay (Just spKey) lnkId (LKEY senderKey) >>= \case
+proxySecureGetSMPQueueLink :: SMPClient -> NetworkRequestMode -> ProxiedRelay -> SndPrivateAuthKey -> LinkId -> SndPublicAuthKey -> ExceptT SMPClientError IO (Either ProxyClientError (SenderId, QueueLinkData))
+proxySecureGetSMPQueueLink c nm proxiedRelay spKey lnkId senderKey =
+  proxySMPCommand  c nm proxiedRelay (Just spKey) lnkId (LKEY senderKey) >>= \case
     Right (LNK sId d) -> pure $ Right (sId, d)
     Right r -> throwE $ unexpectedResponse r
     Left e -> pure $ Left e
 
 -- | Get contact address SMP queue link data.
-getSMPQueueLink :: SMPClient -> LinkId -> ExceptT SMPClientError IO (SenderId, QueueLinkData)
-getSMPQueueLink c lnkId =
-  sendSMPCommand c Nothing lnkId LGET >>= \case
+getSMPQueueLink :: SMPClient -> NetworkRequestMode -> LinkId -> ExceptT SMPClientError IO (SenderId, QueueLinkData)
+getSMPQueueLink c nm lnkId =
+  sendSMPCommand c nm Nothing lnkId LGET >>= \case
     LNK sId d -> pure (sId, d)
     r -> throwE $ unexpectedResponse r
 
-proxyGetSMPQueueLink :: SMPClient -> ProxiedRelay -> LinkId -> ExceptT SMPClientError IO (Either ProxyClientError (SenderId, QueueLinkData))
-proxyGetSMPQueueLink c proxiedRelay lnkId =
-  proxySMPCommand  c proxiedRelay Nothing lnkId LGET >>= \case
+-- LGET command - get short link data
+proxyGetSMPQueueLink :: SMPClient -> NetworkRequestMode -> ProxiedRelay -> LinkId -> ExceptT SMPClientError IO (Either ProxyClientError (SenderId, QueueLinkData))
+proxyGetSMPQueueLink c nm proxiedRelay lnkId =
+  proxySMPCommand c nm proxiedRelay Nothing lnkId LGET >>= \case
     Right (LNK sId d) -> pure $ Right (sId, d)
     Right r -> throwE $ unexpectedResponse r
     Left e -> pure $ Left e
@@ -929,13 +966,14 @@ proxyGetSMPQueueLink c proxiedRelay lnkId =
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
 enableSMPQueueNotifications :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> ExceptT SMPClientError IO (NotifierId, RcvNtfPublicDhKey)
 enableSMPQueueNotifications c rpKey rId notifierKey rcvNtfPublicDhKey =
-  sendSMPCommand c (Just rpKey) rId (NKEY notifierKey rcvNtfPublicDhKey) >>= \case
+  sendSMPCommand c NRMBackground (Just rpKey) rId (NKEY notifierKey rcvNtfPublicDhKey) >>= \case
     NID nId rcvNtfSrvPublicDhKey -> pure (nId, rcvNtfSrvPublicDhKey)
     r -> throwE $ unexpectedResponse r
 
 -- | Enable notifications for the multiple queues for push notifications server.
+-- This command is always sent in background request mode
 enableSMPQueuesNtfs :: SMPClient -> NonEmpty (RecipientId, RcvPrivateAuthKey, NtfPublicAuthKey, RcvNtfPublicDhKey) -> IO (NonEmpty (Either SMPClientError (NotifierId, RcvNtfPublicDhKey)))
-enableSMPQueuesNtfs c qs = L.map process <$> sendProtocolCommands c cs
+enableSMPQueuesNtfs c qs = L.map process <$> sendProtocolCommands c NRMBackground cs
   where
     cs = L.map (\(rId, rpKey, notifierKey, rcvNtfPublicDhKey) -> (rId, Just rpKey, Cmd SRecipient $ NKEY notifierKey rcvNtfPublicDhKey)) qs
     process (Response _ r) = case r of
@@ -946,33 +984,36 @@ enableSMPQueuesNtfs c qs = L.map process <$> sendProtocolCommands c cs
 -- | Disable notifications for the queue for push notifications server.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#disable-notifications-command
+-- This command is always sent in background request mode
 disableSMPQueueNotifications :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> ExceptT SMPClientError IO ()
-disableSMPQueueNotifications = okSMPCommand NDEL
+disableSMPQueueNotifications c = okSMPCommand NDEL c NRMBackground
 {-# INLINE disableSMPQueueNotifications #-}
 
 -- | Disable notifications for multiple queues for push notifications server.
+-- This command is always sent in background request mode
 disableSMPQueuesNtfs :: SMPClient -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> IO (NonEmpty (Either SMPClientError ()))
-disableSMPQueuesNtfs = okSMPCommands NDEL
+disableSMPQueuesNtfs c = okSMPCommands NDEL c NRMBackground
 {-# INLINE disableSMPQueuesNtfs #-}
 
 -- | Send SMP message.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message
-sendSMPMessage :: SMPClient -> Maybe SndPrivateAuthKey -> SenderId -> MsgFlags -> MsgBody -> ExceptT SMPClientError IO ()
-sendSMPMessage c spKey sId flags msg =
-  sendSMPCommand c spKey sId (SEND flags msg) >>= \case
+sendSMPMessage :: SMPClient -> NetworkRequestMode -> Maybe SndPrivateAuthKey -> SenderId -> MsgFlags -> MsgBody -> ExceptT SMPClientError IO ()
+sendSMPMessage c nm spKey sId flags msg =
+  sendSMPCommand c nm spKey sId (SEND flags msg) >>= \case
     OK -> pure ()
     r -> throwE $ unexpectedResponse r
 
-proxySMPMessage :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> MsgFlags -> MsgBody -> ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySMPMessage c proxiedRelay spKey sId flags msg = proxyOKSMPCommand c proxiedRelay spKey sId (SEND flags msg)
+proxySMPMessage :: SMPClient -> NetworkRequestMode -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> MsgFlags -> MsgBody -> ExceptT SMPClientError IO (Either ProxyClientError ())
+proxySMPMessage c nm proxiedRelay spKey sId flags msg = proxyOKSMPCommand c nm proxiedRelay spKey sId (SEND flags msg)
 
 -- | Acknowledge message delivery (server deletes the message).
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
+-- This command is always sent in background request mode
 ackSMPMessage :: SMPClient -> RcvPrivateAuthKey -> QueueId -> MsgId -> ExceptT SMPClientError IO ()
 ackSMPMessage c rpKey rId msgId =
-  sendSMPCommand c (Just rpKey) rId (ACK msgId) >>= \case
+  sendSMPCommand c NRMBackground (Just rpKey) rId (ACK msgId) >>= \case
     OK -> return ()
     cmd@MSG {} -> liftIO $ writeSMPMessage c rId cmd
     r -> throwE $ unexpectedResponse r
@@ -981,28 +1022,28 @@ ackSMPMessage c rpKey rId msgId =
 -- The existing messages from the queue will still be delivered.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#suspend-queue
-suspendSMPQueue :: SMPClient -> RcvPrivateAuthKey -> QueueId -> ExceptT SMPClientError IO ()
+suspendSMPQueue :: SMPClient -> NetworkRequestMode -> RcvPrivateAuthKey -> QueueId -> ExceptT SMPClientError IO ()
 suspendSMPQueue = okSMPCommand OFF
 {-# INLINE suspendSMPQueue #-}
 
 -- | Irreversibly delete SMP queue and all messages in it.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#delete-queue
-deleteSMPQueue :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> ExceptT SMPClientError IO ()
+deleteSMPQueue :: SMPClient -> NetworkRequestMode -> RcvPrivateAuthKey -> RecipientId -> ExceptT SMPClientError IO ()
 deleteSMPQueue = okSMPCommand DEL
 {-# INLINE deleteSMPQueue #-}
 
 -- | Delete multiple SMP queues batching commands if supported.
-deleteSMPQueues :: SMPClient -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> IO (NonEmpty (Either SMPClientError ()))
+deleteSMPQueues :: SMPClient -> NetworkRequestMode -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> IO (NonEmpty (Either SMPClientError ()))
 deleteSMPQueues = okSMPCommands DEL
 {-# INLINE deleteSMPQueues #-}
 
 -- send PRXY :: SMPServer -> Maybe BasicAuth -> Command Sender
 -- receives PKEY :: SessionId -> X.CertificateChain -> X.SignedExact X.PubKey -> BrokerMsg
-connectSMPProxiedRelay :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO ProxiedRelay
-connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, tcpTimeout}} relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth
+connectSMPProxiedRelay :: SMPClient -> NetworkRequestMode -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO ProxiedRelay
+connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, tcpTimeout}} nm relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth
   | thVersion (thParams c) >= sendingProxySMPVersion =
-      sendProtocolCommand_ c Nothing tOut Nothing NoEntity (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
+      sendProtocolCommand_ c nm Nothing tOut Nothing NoEntity (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
         PKEY sId vr (CertChainPubKey chain key) ->
           case supportedClientSMPRelayVRange `compatibleVersion` vr of
             Nothing -> throwE $ transportErr TEVersion
@@ -1010,7 +1051,7 @@ connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, t
         r -> throwE $ unexpectedResponse r
   | otherwise = throwE $ PCETransportError TEVersion
   where
-    tOut = Just $ tcpConnectTimeout + tcpTimeout
+    tOut = Just $ netTimeoutInt tcpConnectTimeout nm + netTimeoutInt tcpTimeout nm
     transportErr = PCEProtocolError . PROXY . BROKER . TRANSPORT
     validateRelay :: X.CertificateChain -> X.SignedExact X.PubKey -> Either String C.PublicKeyX25519
     validateRelay (X.CertificateChain cert) exact = do
@@ -1076,9 +1117,9 @@ instance StrEncoding ProxyClientError where
 -- - other errors from the client running on proxy and connected to relay in PREProxiedRelayError
 
 -- This function proxies Sender commands that return OK or ERR
-proxyOKSMPCommand :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> Command 'Sender -> ExceptT SMPClientError IO (Either ProxyClientError ())
-proxyOKSMPCommand c proxiedRelay spKey sId command =
-  proxySMPCommand  c proxiedRelay spKey sId command >>= \case
+proxyOKSMPCommand :: SMPClient -> NetworkRequestMode -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> Command 'Sender -> ExceptT SMPClientError IO (Either ProxyClientError ())
+proxyOKSMPCommand c nm proxiedRelay spKey sId command =
+  proxySMPCommand  c nm proxiedRelay spKey sId command >>= \case
     Right OK -> pure $ Right ()
     Right r -> throwE $ unexpectedResponse r
     Left e -> pure $ Left e
@@ -1087,6 +1128,7 @@ proxySMPCommand ::
   forall p.
   PartyI p =>
   SMPClient ->
+  NetworkRequestMode ->
   -- proxy session from PKEY
   ProxiedRelay ->
   -- message to deliver
@@ -1094,7 +1136,7 @@ proxySMPCommand ::
   SenderId ->
   Command p ->
   ExceptT SMPClientError IO (Either ProxyClientError BrokerMsg)
-proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v _ serverKey) spKey sId command = do
+proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} nm (ProxiedRelay sessionId v _ serverKey) spKey sId command = do
   -- prepare params
   let serverThAuth = (\ta -> ta {peerServerPubKey = serverKey}) <$> thAuth proxyThParams
       serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
@@ -1112,15 +1154,15 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
     TBTransmissions s _ _ : _ -> pure s
   et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedTLength
   -- proxy interaction errors are wrapped
-  let tOut = Just $ 2 * tcpTimeout
-  tryE (sendProtocolCommand_ c (Just nonce) tOut Nothing (EntityId sessionId) (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
+  let tOut = Just $ 2 * netTimeoutInt tcpTimeout nm
+  tryE (sendProtocolCommand_ c nm (Just nonce) tOut Nothing (EntityId sessionId) (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
     Right r -> case r of
       PRES (EncResponse er) -> do
         -- server interaction errors are thrown directly
         t' <- liftEitherWith PCECryptoError $ C.cbDecrypt cmdSecret (C.reverseNonce nonce) er
         case tParse serverThParams t' of
-          t'' :| [] -> case tDecodeParseValidate serverThParams t'' of
-            (_auth, _signed, (_c, _e, cmd)) -> case cmd of
+          t'' :| [] -> case tDecodeClient serverThParams t'' of
+            (_, _, cmd) -> case cmd of
               Right (ERR e) -> throwE $ PCEProtocolError e -- this is the error from the destination relay
               Right r' -> pure $ Right r'
               Left e -> throwE $ PCEResponseError e
@@ -1137,6 +1179,7 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
 -- sends RFWD :: EncFwdTransmission -> Command Sender
 -- receives RRES :: EncFwdResponse -> BrokerMsg
 -- proxy should send PRES to the client with EncResponse
+-- Always uses background timeout mode
 forwardSMPTransmission :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO EncResponse
 forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
   -- prepare params
@@ -1148,7 +1191,7 @@ forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorr
   let fwdT = FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission}
       eft = EncFwdTransmission $ C.cbEncryptNoPad sessSecret nonce (smpEncode fwdT)
   -- send
-  sendProtocolCommand_ c (Just nonce) Nothing Nothing NoEntity (Cmd SProxyService (RFWD eft)) >>= \case
+  sendProtocolCommand_ c NRMBackground (Just nonce) Nothing Nothing NoEntity (Cmd SProxyService (RFWD eft)) >>= \case
     RRES (EncFwdResponse efr) -> do
       -- unwrap
       r' <- liftEitherWith PCECryptoError $ C.cbDecryptNoPad sessSecret (C.reverseNonce nonce) efr
@@ -1156,20 +1199,21 @@ forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorr
       pure fwdResponse
     r -> throwE $ unexpectedResponse r
 
-getSMPQueueInfo :: SMPClient -> C.APrivateAuthKey -> QueueId -> ExceptT SMPClientError IO QueueInfo
-getSMPQueueInfo c pKey qId =
-  sendSMPCommand c (Just pKey) qId QUE >>= \case
+-- get queue information - always sent interactively
+getSMPQueueInfo :: SMPClient -> NetworkRequestMode -> C.APrivateAuthKey -> QueueId -> ExceptT SMPClientError IO QueueInfo
+getSMPQueueInfo c nm pKey qId =
+  sendSMPCommand c nm (Just pKey) qId QUE >>= \case
     INFO info -> pure info
     r -> throwE $ unexpectedResponse r
 
-okSMPCommand :: PartyI p => Command p -> SMPClient -> C.APrivateAuthKey -> QueueId -> ExceptT SMPClientError IO ()
-okSMPCommand cmd c pKey qId =
-  sendSMPCommand c (Just pKey) qId cmd >>= \case
+okSMPCommand :: PartyI p => Command p -> SMPClient -> NetworkRequestMode -> C.APrivateAuthKey -> QueueId -> ExceptT SMPClientError IO ()
+okSMPCommand cmd c nm pKey qId =
+  sendSMPCommand c nm (Just pKey) qId cmd >>= \case
     OK -> return ()
     r -> throwE $ unexpectedResponse r
 
-okSMPCommands :: PartyI p => Command p -> SMPClient -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO (NonEmpty (Either SMPClientError ()))
-okSMPCommands cmd c qs = L.map process <$> sendProtocolCommands c cs
+okSMPCommands :: PartyI p => Command p -> SMPClient -> NetworkRequestMode -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO (NonEmpty (Either SMPClientError ()))
+okSMPCommands cmd c nm qs = L.map process <$> sendProtocolCommands c nm cs
   where
     aCmd = Cmd sParty cmd
     cs = L.map (\(qId, pKey) -> (qId, Just pKey, aCmd)) qs
@@ -1179,17 +1223,17 @@ okSMPCommands cmd c qs = L.map process <$> sendProtocolCommands c cs
       Left e -> Left e
 
 -- | Send SMP command
-sendSMPCommand :: PartyI p => SMPClient -> Maybe C.APrivateAuthKey -> QueueId -> Command p -> ExceptT SMPClientError IO BrokerMsg
-sendSMPCommand c pKey qId cmd = sendProtocolCommand c pKey qId (Cmd sParty cmd)
+sendSMPCommand :: PartyI p => SMPClient -> NetworkRequestMode -> Maybe C.APrivateAuthKey -> EntityId -> Command p -> ExceptT SMPClientError IO BrokerMsg
+sendSMPCommand c nm pKey entId cmd = sendProtocolCommand c nm pKey entId (Cmd sParty cmd)
 {-# INLINE sendSMPCommand #-}
 
 type PCTransmission err msg = (Either TransportError SentRawTransmission, Request err msg)
 
 -- | Send multiple commands with batching and collect responses
-sendProtocolCommands :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> NonEmpty (ClientCommand msg) -> IO (NonEmpty (Response err msg))
-sendProtocolCommands c@ProtocolClient {thParams} cs = do
+sendProtocolCommands :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> NetworkRequestMode -> NonEmpty (ClientCommand msg) -> IO (NonEmpty (Response err msg))
+sendProtocolCommands c@ProtocolClient {thParams} nm cs = do
   bs <- batchTransmissions' thParams <$> mapM (mkTransmission c) cs
-  validate . concat =<< mapM (sendBatch c) bs
+  validate . concat =<< mapM (sendBatch c nm) bs
   where
     validate :: [Response err msg] -> IO (NonEmpty (Response err msg))
     validate rs
@@ -1203,13 +1247,13 @@ sendProtocolCommands c@ProtocolClient {thParams} cs = do
       where
         diff = L.length cs - length rs
 
-streamProtocolCommands :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> NonEmpty (ClientCommand msg) -> ([Response err msg] -> IO ()) -> IO ()
-streamProtocolCommands c@ProtocolClient {thParams} cs cb = do
+streamProtocolCommands :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> NetworkRequestMode -> NonEmpty (ClientCommand msg) -> ([Response err msg] -> IO ()) -> IO ()
+streamProtocolCommands c@ProtocolClient {thParams} nm cs cb = do
   bs <- batchTransmissions' thParams <$> mapM (mkTransmission c) cs
-  mapM_ (cb <=< sendBatch c) bs
+  mapM_ (cb <=< sendBatch c nm) bs
 
-sendBatch :: ProtocolClient v err msg -> TransportBatch (Request err msg) -> IO [Response err msg]
-sendBatch c@ProtocolClient {client_ = PClient {sndQ}} b = do
+sendBatch :: ProtocolClient v err msg -> NetworkRequestMode -> TransportBatch (Request err msg) -> IO [Response err msg]
+sendBatch c@ProtocolClient {client_ = PClient {sndQ}} nm b = do
   case b of
     TBError e Request {entityId} -> do
       putStrLn "send error: large message"
@@ -1217,15 +1261,15 @@ sendBatch c@ProtocolClient {client_ = PClient {sndQ}} b = do
     TBTransmissions s n rs
       | n > 0 -> do
           nonBlockingWriteTBQueue sndQ (Nothing, s) -- do not expire batched responses
-          mapConcurrently (getResponse c Nothing) rs
+          mapConcurrently (getResponse c nm Nothing) rs
       | otherwise -> pure []
     TBTransmission s r -> do
       nonBlockingWriteTBQueue sndQ (Nothing, s)
-      (: []) <$> getResponse c Nothing r
+      (: []) <$> getResponse c nm Nothing r
 
 -- | Send Protocol command
-sendProtocolCommand :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> Maybe C.APrivateAuthKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
-sendProtocolCommand c = sendProtocolCommand_ c Nothing Nothing
+sendProtocolCommand :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> NetworkRequestMode -> Maybe C.APrivateAuthKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
+sendProtocolCommand c nm = sendProtocolCommand_ c nm Nothing Nothing
 
 -- Currently there is coupling - batch commands do not expire, and individually sent commands do.
 -- This is to reflect the fact that we send subscriptions only as batches, and also because we do not track a separate timeout for the whole batch, so it is not obvious when should we expire it.
@@ -1233,8 +1277,8 @@ sendProtocolCommand c = sendProtocolCommand_ c Nothing Nothing
 -- But a better solution is to process delayed delete responses.
 --
 -- Please note: if nonce is passed it is also used as a correlation ID
-sendProtocolCommand_ :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> Maybe C.CbNonce -> Maybe Int -> Maybe C.APrivateAuthKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
-sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ}, thParams = THandleParams {batch, blockSize, serviceAuth}} nonce_ tOut pKey entId cmd =
+sendProtocolCommand_ :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> NetworkRequestMode -> Maybe C.CbNonce -> Maybe Int -> Maybe C.APrivateAuthKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
+sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ}, thParams = THandleParams {batch, blockSize, serviceAuth}} nm nonce_ tOut pKey entId cmd =
   ExceptT $ uncurry sendRecv =<< mkTransmission_ c nonce_ (entId, pKey, cmd)
   where
     -- two separate "atomically" needed to avoid blocking
@@ -1245,7 +1289,7 @@ sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ}, thParams = THan
         | B.length s > blockSize - 2 -> pure . Left $ PCETransportError TELargeMsg
         | otherwise -> do
             nonBlockingWriteTBQueue sndQ (Just r, s)
-            response <$> getResponse c tOut r
+            response <$> getResponse c nm tOut r
         where
           s
             | batch = tEncodeBatch1 serviceAuth t
@@ -1256,9 +1300,9 @@ nonBlockingWriteTBQueue q x = do
   sent <- atomically $ tryWriteTBQueue q x
   unless sent $ void $ forkIO $ atomically $ writeTBQueue q x
 
-getResponse :: ProtocolClient v err msg -> Maybe Int -> Request err msg -> IO (Response err msg)
-getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount}} tOut Request {entityId, pending, responseVar} = do
-  r <- fromMaybe tcpTimeout tOut `timeout` atomically (takeTMVar responseVar)
+getResponse :: ProtocolClient v err msg -> NetworkRequestMode -> Maybe Int -> Request err msg -> IO (Response err msg)
+getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount}} nm tOut Request {entityId, pending, responseVar} = do
+  r <- fromMaybe (netTimeoutInt tcpTimeout nm) tOut `timeout` atomically (takeTMVar responseVar)
   response <- atomically $ do
     writeTVar pending False
     -- Try to read response again in case it arrived after timeout expired
@@ -1345,6 +1389,8 @@ $(J.deriveJSON (enumJSON $ dropPrefix "SPF") ''SMPProxyFallback)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "SWP") ''SMPWebPortServers)
 
+$(J.deriveJSON defaultJSON ''NetworkTimeout)
+
 $(J.deriveJSON defaultJSON ''NetworkConfig)
 
 $(J.deriveJSON (sumTypeJSON $ dropPrefix "Proxy") ''ProxyClientError)

src/Simplex/Messaging/Client/Agent.hs

@@ -70,9 +70,9 @@ import Simplex.Messaging.Protocol
     QueueId,
     SMPServer,
     SParty (..),
-    SubscriberParty,
-    subscriberParty,
-    subscriberServiceRole
+    ServiceParty,
+    serviceParty,
+    partyServiceRole
   )
 import Simplex.Messaging.Session
 import Simplex.Messaging.TMap (TMap)
@@ -203,7 +203,7 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
     waitForSMPClient :: SMPClientVar -> ExceptT SMPClientError IO (OwnServer, SMPClient)
     waitForSMPClient v = do
       let ProtocolClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = smpCfg agentCfg
-      smpClient_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v)
+      smpClient_ <- liftIO $ netTimeoutInt tcpConnectTimeout NRMBackground `timeout` atomically (readTMVar $ sessionVar v)
       case smpClient_ of
         Just (Right smpClient) -> pure smpClient
         Just (Left (e, ts_)) -> case ts_ of
@@ -249,7 +249,7 @@ isOwnServer SMPClientAgent {agentCfg} ProtocolServer {host} =
 -- | Run an SMP client for SMPClientVar
 connectClient :: SMPClientAgent p -> SMPServer -> SMPClientVar -> IO (Either SMPClientError SMPClient)
 connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, randomDrg, startedAt} srv v =
-  getProtocolClient randomDrg (1, srv, Nothing) (smpCfg agentCfg) [] (Just msgQ) startedAt clientDisconnected
+  getProtocolClient randomDrg NRMBackground (1, srv, Nothing) (smpCfg agentCfg) [] (Just msgQ) startedAt clientDisconnected
   where
     clientDisconnected :: SMPClient -> IO ()
     clientDisconnected smp = do
@@ -313,7 +313,7 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
       withRetryInterval (reconnectInterval agentCfg) $ \_ loop -> do
         subs <- getPending TM.lookupIO readTVarIO
         unless (noPending subs) $ whenM (readTVarIO active) $ do
-          void $ tcpConnectTimeout `timeout` runExceptT (reconnectSMPClient ca srv subs)
+          void $ netTimeoutInt tcpConnectTimeout NRMBackground `timeout` runExceptT (reconnectSMPClient ca srv subs)
           loop
     ProtocolClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = smpCfg agentCfg
     noPending (sSub, qSubs) = isNothing sSub && maybe True M.null qSubs
@@ -331,11 +331,11 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
 
 reconnectSMPClient :: forall p. SMPClientAgent p -> SMPServer -> (Maybe (ServiceId, Int64), Maybe (Map QueueId C.APrivateAuthKey)) -> ExceptT SMPClientError IO ()
 reconnectSMPClient ca@SMPClientAgent {agentCfg, agentParty} srv (sSub_, qSubs_) =
-  withSMP ca srv $ \smp -> liftIO $ case subscriberParty agentParty of
+  withSMP ca srv $ \smp -> liftIO $ case serviceParty agentParty of
     Just Dict -> resubscribe smp
     Nothing -> pure ()
   where
-    resubscribe :: (PartyI p, SubscriberParty p) => SMPClient -> IO ()
+    resubscribe :: (PartyI p, ServiceParty p) => SMPClient -> IO ()
     resubscribe smp = do
       mapM_ (smpSubscribeService ca smp srv) sSub_
       forM_ qSubs_ $ \qSubs -> do
@@ -394,22 +394,22 @@ withSMP ca srv action = (getSMPServerClient' ca srv >>= action) `catchE` logSMPE
       logInfo $ "SMP error (" <> safeDecodeUtf8 (strEncode $ host srv) <> "): " <> tshow e
       throwE e
 
-subscribeQueuesNtfs :: SMPClientAgent 'Notifier -> SMPServer -> NonEmpty (NotifierId, NtfPrivateAuthKey) -> IO ()
+subscribeQueuesNtfs :: SMPClientAgent 'NotifierService -> SMPServer -> NonEmpty (NotifierId, NtfPrivateAuthKey) -> IO ()
 subscribeQueuesNtfs = subscribeQueues_
 {-# INLINE subscribeQueuesNtfs #-}
 
-subscribeQueues_ :: SubscriberParty p => SMPClientAgent p -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
+subscribeQueues_ :: ServiceParty p => SMPClientAgent p -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
 subscribeQueues_ ca srv subs = do
   atomically $ addPendingSubs ca srv $ L.toList subs
   runExceptT (getSMPServerClient' ca srv) >>= \case
     Right smp -> smpSubscribeQueues ca smp srv subs
     Left _ -> pure () -- no call to reconnectClient - failing getSMPServerClient' does that
 
-smpSubscribeQueues :: SubscriberParty p => SMPClientAgent p -> SMPClient -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
+smpSubscribeQueues :: ServiceParty p => SMPClientAgent p -> SMPClient -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
 smpSubscribeQueues ca smp srv subs = do
   rs <- case agentParty ca of
-    SRecipient -> subscribeSMPQueues smp subs
-    SNotifier -> subscribeSMPQueuesNtfs smp subs
+    SRecipientService -> subscribeSMPQueues smp subs
+    SNotifierService -> subscribeSMPQueuesNtfs smp subs
   rs' <-
     atomically $
       ifM
@@ -454,18 +454,18 @@ smpSubscribeQueues ca smp srv subs = do
     notify_ :: (SMPServer -> NonEmpty a -> SMPClientAgentEvent) -> [a] -> IO ()
     notify_ evt qs = mapM_ (notify ca . evt srv) $ L.nonEmpty qs
 
-subscribeServiceNtfs :: SMPClientAgent 'Notifier -> SMPServer -> (ServiceId, Int64) -> IO ()
+subscribeServiceNtfs :: SMPClientAgent 'NotifierService -> SMPServer -> (ServiceId, Int64) -> IO ()
 subscribeServiceNtfs = subscribeService_
 {-# INLINE subscribeServiceNtfs #-}
 
-subscribeService_ :: (PartyI p, SubscriberParty p) => SMPClientAgent p -> SMPServer -> (ServiceId, Int64) -> IO ()
+subscribeService_ :: (PartyI p, ServiceParty p) => SMPClientAgent p -> SMPServer -> (ServiceId, Int64) -> IO ()
 subscribeService_ ca srv serviceSub = do
   atomically $ setPendingServiceSub ca srv $ Just serviceSub
   runExceptT (getSMPServerClient' ca srv) >>= \case
     Right smp -> smpSubscribeService ca smp srv serviceSub
     Left _ -> pure () -- no call to reconnectClient - failing getSMPServerClient' does that
 
-smpSubscribeService :: (PartyI p, SubscriberParty p) => SMPClientAgent p -> SMPClient -> SMPServer -> (ServiceId, Int64) -> IO ()
+smpSubscribeService :: (PartyI p, ServiceParty p) => SMPClientAgent p -> SMPClient -> SMPServer -> (ServiceId, Int64) -> IO ()
 smpSubscribeService ca smp srv serviceSub@(serviceId, _) = case smpClientService smp of
   Just service | serviceAvailable service -> subscribe
   _ -> notifyUnavailable
@@ -490,7 +490,7 @@ smpSubscribeService ca smp srv serviceSub@(serviceId, _) = case smpClientService
       setActiveServiceSub ca srv $ Just ((serviceId, n), sessId)
       setPendingServiceSub ca srv Nothing
     serviceAvailable THClientService {serviceRole, serviceId = serviceId'} =
-      serviceId == serviceId' && subscriberServiceRole (agentParty ca) == serviceRole
+      serviceId == serviceId' && partyServiceRole (agentParty ca) == serviceRole
     notifyUnavailable = do
       atomically $ setPendingServiceSub ca srv Nothing
       notify ca $ CAServiceUnavailable srv serviceSub -- this will resubscribe all queues directly

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -55,8 +55,10 @@ module Simplex.Messaging.Crypto.Ratchet
     supportedE2EEncryptVRange,
     generateRcvE2EParams,
     generateSndE2EParams,
+    mkRcvE2ERatchetParams,
     initialPQEncryption,
     connPQEncryption,
+    joinContactInitialKeys,
     replyKEM_,
     pqSupportToEnc,
     pqEncToSupport,
@@ -195,6 +197,8 @@ data ARKEMParams = forall s. RatchetKEMStateI s => ARKP (SRatchetKEMState s) (RK
 
 deriving instance Show ARKEMParams
 
+type RcvRKEMParams = RKEMParams 'RKSProposed
+
 instance RatchetKEMStateI s => Encoding (RKEMParams s) where
   smpEncode = \case
     RKParamsProposed k -> smpEncode ('P', k)
@@ -308,7 +312,7 @@ instance (RatchetKEMStateI s, AlgorithmI a) => StrEncoding (E2ERatchetParamsUri
             RKParamsAccepted ct k -> [("kem_ct", strEncode ct), ("kem_key", strEncode k)]
   strP = toE2ERatchetParamsUri <$?> strP
   {-# INLINE strP #-}
-    
+
 toE2ERatchetParamsUri :: RatchetKEMStateI s => AE2ERatchetParamsUri a -> Either String (E2ERatchetParamsUri s a)
 toE2ERatchetParamsUri = \case
   AE2ERatchetParamsUri _ (E2ERatchetParamsUri vr k1 k2 Nothing) -> Right $ E2ERatchetParamsUri vr k1 k2 Nothing
@@ -405,6 +409,12 @@ data UseKEM (s :: RatchetKEMState) where
 
 data AUseKEM = forall s. RatchetKEMStateI s => AUseKEM (SRatchetKEMState s) (UseKEM s)
 
+mkRcvE2ERatchetParams :: VersionE2E -> (PrivateKey a, PrivateKey a, Maybe RcvPrivRKEMParams) -> RcvE2ERatchetParams a
+mkRcvE2ERatchetParams v (pk1, pk2, pKem) = E2ERatchetParams v (publicKey pk1) (publicKey pk2) (mkKem <$> pKem)
+  where
+    mkKem :: RcvPrivRKEMParams -> RcvRKEMParams
+    mkKem (PrivateRKParamsProposed (k, _)) = RKParamsProposed k
+
 generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s), E2ERatchetParams s a)
 generateE2EParams g v useKEM_ = do
   (k1, pk1) <- atomically $ generateKeyPair g
@@ -851,32 +861,39 @@ instance StrEncoding PQSupport where
   strP = pqEncToSupport <$> strP
   {-# INLINE strP #-}
 
-data InitialKeys = IKUsePQ | IKNoPQ PQSupport
+data InitialKeys
+  = IKUsePQ -- use PQ keys in contact request and short link data
+  | IKLinkPQ PQSupport -- use PQ keys in short link data only, if PQSupport enabled
   deriving (Eq, Show)
 
 pattern IKPQOn :: InitialKeys
-pattern IKPQOn = IKNoPQ PQSupportOn
+pattern IKPQOn = IKLinkPQ PQSupportOn
 
 pattern IKPQOff :: InitialKeys
-pattern IKPQOff = IKNoPQ PQSupportOff
+pattern IKPQOff = IKLinkPQ PQSupportOff
 
 instance StrEncoding InitialKeys where
   strEncode = \case
     IKUsePQ -> "pq=invitation"
-    IKNoPQ pq -> strEncode pq
-  strP = IKNoPQ <$> strP <|> "pq=invitation" $> IKUsePQ
+    IKLinkPQ pq -> strEncode pq
+  strP = IKLinkPQ <$> strP <|> "pq=invitation" $> IKUsePQ
 
 -- determines whether PQ key should be included in invitation link
-initialPQEncryption :: InitialKeys -> PQSupport
-initialPQEncryption = \case
+initialPQEncryption :: Bool -> InitialKeys -> PQSupport
+initialPQEncryption shortLink = \case
   IKUsePQ -> PQSupportOn
-  IKNoPQ _ -> PQSupportOff -- default
+  IKLinkPQ (PQSupport enable) -> PQSupport $ enable && shortLink
 
 -- determines whether PQ encryption should be used in connection
 connPQEncryption :: InitialKeys -> PQSupport
 connPQEncryption = \case
   IKUsePQ -> PQSupportOn
-  IKNoPQ pq -> pq -- default for creating connection is IKNoPQ PQEncOn
+  IKLinkPQ pq -> pq -- default for creating connection is IKLinkPQ PQEncOn
+
+joinContactInitialKeys :: Bool -> PQSupport -> InitialKeys
+joinContactInitialKeys pqCompatible = \case
+  PQSupportOn | pqCompatible -> IKUsePQ
+  pqEnc -> IKLinkPQ pqEnc
 
 rcCheckCanPad :: Int -> ByteString -> ExceptT CryptoError IO ()
 rcCheckCanPad paddedMsgLen msg =
@@ -1187,7 +1204,7 @@ instance (AlgorithmI a, Typeable a) => FromField (Ratchet a) where fromField = b
 
 instance ToField PQEncryption where toField (PQEncryption pqEnc) = toField (BI pqEnc)
 
-instance FromField PQEncryption where 
+instance FromField PQEncryption where
 #if defined(dbPostgres)
   fromField f dat = PQEncryption . unBI <$> fromField f dat
 #else

src/Simplex/Messaging/Crypto/ShortLink.hs

@@ -48,17 +48,17 @@ contactShortLinkKdf (LinkKey k) =
 invShortLinkKdf :: LinkKey -> C.SbKey
 invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
 
-encodeSignLinkData :: forall c. ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> ConnInfo -> (LinkKey, (ByteString, ByteString))
+encodeSignLinkData :: forall c. ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserLinkData -> (LinkKey, (ByteString, ByteString))
 encodeSignLinkData (rootKey, pk) agentVRange connReq userData =
   let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq}
       md = smpEncode $ connLinkData @c agentVRange userData
    in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md))
 
-encodeSignUserData :: C.PrivateKeyEd25519 -> VersionRangeSMPA -> ConnInfo -> ByteString
-encodeSignUserData pk agentVRange userData =
-  encodeSign pk $ smpEncode $ connLinkData @'CMContact agentVRange userData
+encodeSignUserData :: forall c. ConnectionModeI c => SConnectionMode c -> C.PrivateKeyEd25519 -> VersionRangeSMPA -> UserLinkData -> ByteString
+encodeSignUserData _ pk agentVRange userData =
+  encodeSign pk $ smpEncode $ connLinkData @c agentVRange userData
 
-connLinkData :: forall c. ConnectionModeI c => VersionRangeSMPA -> ConnInfo -> ConnLinkData c
+connLinkData :: forall c. ConnectionModeI c => VersionRangeSMPA -> UserLinkData -> ConnLinkData c
 connLinkData agentVRange userData = case sConnectionMode @c of
   SCMInvitation -> InvitationLinkData agentVRange userData
   SCMContact -> ContactLinkData {agentVRange, direct = True, owners = [], relays = [], userData}

src/Simplex/Messaging/Notifications/Client.hs

@@ -28,39 +28,39 @@ defaultNTFClientConfig =
     {defaultTransport = ("443", transport @TLS)}
 {-# INLINE defaultNTFClientConfig #-}
 
-ntfRegisterToken :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Token -> ExceptT NtfClientError IO (NtfTokenId, C.PublicKeyX25519)
-ntfRegisterToken c pKey newTkn =
-  sendNtfCommand c (Just pKey) NoEntity (TNEW newTkn) >>= \case
+ntfRegisterToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NewNtfEntity 'Token -> ExceptT NtfClientError IO (NtfTokenId, C.PublicKeyX25519)
+ntfRegisterToken c nm pKey newTkn =
+  sendNtfCommand c nm (Just pKey) NoEntity (TNEW newTkn) >>= \case
     NRTknId tknId dhKey -> pure (tknId, dhKey)
     r -> throwE $ unexpectedResponse r
 
-ntfVerifyToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> NtfRegCode -> ExceptT NtfClientError IO ()
-ntfVerifyToken c pKey tknId code = okNtfCommand (TVFY code) c pKey tknId
+ntfVerifyToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> NtfRegCode -> ExceptT NtfClientError IO ()
+ntfVerifyToken c nm pKey tknId code = okNtfCommand (TVFY code) c nm pKey tknId
 
-ntfCheckToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClientError IO NtfTknStatus
-ntfCheckToken c pKey tknId =
-  sendNtfCommand c (Just pKey) tknId TCHK >>= \case
+ntfCheckToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClientError IO NtfTknStatus
+ntfCheckToken c nm pKey tknId =
+  sendNtfCommand c nm (Just pKey) tknId TCHK >>= \case
     NRTkn stat -> pure stat
     r -> throwE $ unexpectedResponse r
 
-ntfReplaceToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> DeviceToken -> ExceptT NtfClientError IO ()
-ntfReplaceToken c pKey tknId token = okNtfCommand (TRPL token) c pKey tknId
+ntfReplaceToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> DeviceToken -> ExceptT NtfClientError IO ()
+ntfReplaceToken c nm pKey tknId token = okNtfCommand (TRPL token) c nm pKey tknId
 
-ntfDeleteToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClientError IO ()
+ntfDeleteToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClientError IO ()
 ntfDeleteToken = okNtfCommand TDEL
 
 -- set to 0 to disable
-ntfSetCronInterval :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> Word16 -> ExceptT NtfClientError IO ()
-ntfSetCronInterval c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId
+ntfSetCronInterval :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> Word16 -> ExceptT NtfClientError IO ()
+ntfSetCronInterval c nm pKey tknId int = okNtfCommand (TCRN int) c nm pKey tknId
 
 ntfCreateSubscription :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Subscription -> ExceptT NtfClientError IO NtfSubscriptionId
 ntfCreateSubscription c pKey newSub =
-  sendNtfCommand c (Just pKey) NoEntity (SNEW newSub) >>= \case
+  sendNtfCommand c NRMBackground (Just pKey) NoEntity (SNEW newSub) >>= \case
     NRSubId subId -> pure subId
     r -> throwE $ unexpectedResponse r
 
 ntfCreateSubscriptions :: NtfClient -> C.APrivateAuthKey -> NonEmpty (NewNtfEntity 'Subscription) -> IO (NonEmpty (Either NtfClientError NtfSubscriptionId))
-ntfCreateSubscriptions c pKey newSubs = L.map process <$> sendProtocolCommands c cs
+ntfCreateSubscriptions c pKey newSubs = L.map process <$> sendProtocolCommands c NRMBackground cs
   where
     cs = L.map (\newSub -> (NoEntity, Just pKey, NtfCmd SSubscription $ SNEW newSub)) newSubs
     process (Response _ r) = case r of
@@ -70,12 +70,12 @@ ntfCreateSubscriptions c pKey newSubs = L.map process <$> sendProtocolCommands c
 
 ntfCheckSubscription :: NtfClient -> C.APrivateAuthKey -> NtfSubscriptionId -> ExceptT NtfClientError IO NtfSubStatus
 ntfCheckSubscription c pKey subId =
-  sendNtfCommand c (Just pKey) subId SCHK >>= \case
+  sendNtfCommand c NRMBackground (Just pKey) subId SCHK >>= \case
     NRSub stat -> pure stat
     r -> throwE $ unexpectedResponse r
 
 ntfCheckSubscriptions :: NtfClient -> C.APrivateAuthKey -> NonEmpty NtfSubscriptionId -> IO (NonEmpty (Either NtfClientError NtfSubStatus))
-ntfCheckSubscriptions c pKey subIds = L.map process <$> sendProtocolCommands c cs
+ntfCheckSubscriptions c pKey subIds = L.map process <$> sendProtocolCommands c NRMBackground cs
   where
     cs = L.map (\subId -> (subId, Just pKey, NtfCmd SSubscription SCHK)) subIds
     process (Response _ r) = case r of
@@ -84,14 +84,14 @@ ntfCheckSubscriptions c pKey subIds = L.map process <$> sendProtocolCommands c c
       Left e -> Left e
 
 ntfDeleteSubscription :: NtfClient -> C.APrivateAuthKey -> NtfSubscriptionId -> ExceptT NtfClientError IO ()
-ntfDeleteSubscription = okNtfCommand SDEL
+ntfDeleteSubscription c = okNtfCommand SDEL c NRMBackground
 
 -- | Send notification server command
-sendNtfCommand :: NtfEntityI e => NtfClient -> Maybe C.APrivateAuthKey -> NtfEntityId -> NtfCommand e -> ExceptT NtfClientError IO NtfResponse
-sendNtfCommand c pKey entId cmd = sendProtocolCommand c pKey entId (NtfCmd sNtfEntity cmd)
+sendNtfCommand :: NtfEntityI e => NtfClient -> NetworkRequestMode -> Maybe C.APrivateAuthKey -> NtfEntityId -> NtfCommand e -> ExceptT NtfClientError IO NtfResponse
+sendNtfCommand c nm pKey entId cmd = sendProtocolCommand c nm pKey entId (NtfCmd sNtfEntity cmd)
 
-okNtfCommand :: NtfEntityI e => NtfCommand e -> NtfClient -> C.APrivateAuthKey -> NtfEntityId -> ExceptT NtfClientError IO ()
-okNtfCommand cmd c pKey entId =
-  sendNtfCommand c (Just pKey) entId cmd >>= \case
+okNtfCommand :: NtfEntityI e => NtfCommand e -> NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfEntityId -> ExceptT NtfClientError IO ()
+okNtfCommand cmd c nm pKey entId =
+  sendNtfCommand c nm (Just pKey) entId cmd >>= \case
     NROk -> return ()
     r -> throwE $ unexpectedResponse r

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -214,7 +214,7 @@ instance NtfEntityI e => ProtocolEncoding NTFVersion ErrorType (NtfCommand e) wh
   fromProtocolError = fromProtocolError @NTFVersion @ErrorType @NtfResponse
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (auth, _, EntityId entityId, _) cmd = case cmd of
+  checkCredentials auth (EntityId entityId) cmd = case cmd of
     -- TNEW and SNEW must have signature but NOT token/subscription IDs
     TNEW {} -> sigNoEntity
     SNEW {} -> sigNoEntity
@@ -254,7 +254,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfCmd where
   fromProtocolError = fromProtocolError @NTFVersion @ErrorType @NtfResponse
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials t (NtfCmd e c) = NtfCmd e <$> checkCredentials t c
+  checkCredentials tAuth entId (NtfCmd e c) = NtfCmd e <$> checkCredentials tAuth entId c
 
 data NtfResponseTag
   = NRTknId_
@@ -334,7 +334,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfResponse where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials _ (EntityId entId) cmd = case cmd of
     -- IDTKN response must not have queue ID
     NRTknId {} -> noEntity
     -- IDSUB response must not have queue ID

src/Simplex/Messaging/Notifications/Server.hs

@@ -62,7 +62,7 @@ import Simplex.Messaging.Notifications.Server.Store (NtfSTMStore, TokenNtfMessag
 import Simplex.Messaging.Notifications.Server.Store.Postgres
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Transport
-import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), NotifierId, Party (..), ProtocolServer (host), SMPServer, ServiceId, SignedTransmission, Transmission, pattern NoEntity, pattern SMPServer, encodeTransmission, tGet, tPut)
+import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), NotifierId, Party (..), ProtocolServer (host), SMPServer, ServiceId, SignedTransmission, Transmission, pattern NoEntity, pattern SMPServer, encodeTransmission, tGetServer, tPut)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
 import Simplex.Messaging.Server.Control (CPClientRole (..))
@@ -277,21 +277,21 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
             apnsPushQLength
           }
       where
-        getSMPServiceSubMetrics :: forall sub. SMPClientAgent 'Notifier -> (SMPClientAgent 'Notifier -> TMap SMPServer (TVar (Maybe sub))) -> (sub -> Int64) -> IO NtfSMPSubMetrics
+        getSMPServiceSubMetrics :: forall sub. SMPClientAgent 'NotifierService -> (SMPClientAgent 'NotifierService -> TMap SMPServer (TVar (Maybe sub))) -> (sub -> Int64) -> IO NtfSMPSubMetrics
         getSMPServiceSubMetrics a sel subQueueCount = getSubMetrics_ a sel countSubs
           where
             countSubs :: (NtfSMPSubMetrics, S.Set Text) -> (SMPServer, TVar (Maybe sub)) -> IO (NtfSMPSubMetrics, S.Set Text)
             countSubs acc (srv, serviceSubs) = subMetricsResult a acc srv . fromIntegral . maybe 0 subQueueCount <$> readTVarIO serviceSubs
 
-        getSMPSubMetrics :: SMPClientAgent 'Notifier -> (SMPClientAgent 'Notifier -> TMap SMPServer (TMap NotifierId a)) -> IO NtfSMPSubMetrics
+        getSMPSubMetrics :: SMPClientAgent 'NotifierService -> (SMPClientAgent 'NotifierService -> TMap SMPServer (TMap NotifierId a)) -> IO NtfSMPSubMetrics
         getSMPSubMetrics a sel = getSubMetrics_ a sel countSubs
           where
             countSubs :: (NtfSMPSubMetrics, S.Set Text) -> (SMPServer, TMap NotifierId a) -> IO (NtfSMPSubMetrics, S.Set Text)
             countSubs acc (srv, queueSubs) = subMetricsResult a acc srv . M.size <$> readTVarIO queueSubs
 
         getSubMetrics_ ::
-          SMPClientAgent 'Notifier ->
-          (SMPClientAgent 'Notifier -> TVar (M.Map SMPServer sub')) ->
+          SMPClientAgent 'NotifierService ->
+          (SMPClientAgent 'NotifierService -> TVar (M.Map SMPServer sub')) ->
           ((NtfSMPSubMetrics, S.Set Text) -> (SMPServer, sub') -> IO (NtfSMPSubMetrics, S.Set Text)) ->
           IO NtfSMPSubMetrics
         getSubMetrics_ a sel countSubs = do
@@ -300,7 +300,7 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
           (metrics', otherSrvs) <- foldM countSubs (metrics, S.empty) $ M.assocs subs
           pure (metrics' :: NtfSMPSubMetrics) {otherServers = S.size otherSrvs}
 
-        subMetricsResult :: SMPClientAgent 'Notifier -> (NtfSMPSubMetrics, S.Set Text) -> SMPServer -> Int -> (NtfSMPSubMetrics, S.Set Text)
+        subMetricsResult :: SMPClientAgent 'NotifierService -> (NtfSMPSubMetrics, S.Set Text) -> SMPServer -> Int -> (NtfSMPSubMetrics, S.Set Text)
         subMetricsResult a acc@(metrics, !otherSrvs) srv@(SMPServer (h :| _) _ _) cnt
           | isOwnServer a srv =
               let !ownSrvSubs' = M.alter (Just . maybe cnt (+ cnt)) host ownSrvSubs
@@ -314,9 +314,9 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
             NtfSMPSubMetrics {ownSrvSubs, otherSrvSubCount} = metrics
             host = safeDecodeUtf8 $ strEncode h
 
-        getSMPWorkerMetrics :: SMPClientAgent 'Notifier -> TMap SMPServer a -> IO NtfSMPWorkerMetrics
+        getSMPWorkerMetrics :: SMPClientAgent 'NotifierService -> TMap SMPServer a -> IO NtfSMPWorkerMetrics
         getSMPWorkerMetrics a v = workerMetrics a . M.keys <$> readTVarIO v
-        workerMetrics :: SMPClientAgent 'Notifier -> [SMPServer] -> NtfSMPWorkerMetrics
+        workerMetrics :: SMPClientAgent 'NotifierService -> [SMPServer] -> NtfSMPWorkerMetrics
         workerMetrics a srvs = NtfSMPWorkerMetrics {ownServers = reverse ownSrvs, otherServers}
           where
             (ownSrvs, otherServers) = foldl' countSrv ([], 0) srvs
@@ -364,12 +364,9 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
                   CPSkip -> False
                   _ -> True
             processCP h role = \case
-              CPAuth auth -> atomically $ writeTVar role $! newRole cfg
+              CPAuth auth -> controlPortAuth h user admin role auth
                 where
-                  newRole NtfServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin}
-                    | Just auth == admin = CPRAdmin
-                    | Just auth == user = CPRUser
-                    | otherwise = CPRNone
+                  NtfServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin} = cfg
               CPStats -> withUserRole $ do
                 ss <- unliftIO u $ asks serverStats
                 let getStat :: (NtfServerStats -> IORef a) -> IO a
@@ -455,7 +452,7 @@ resubscribe NtfSubscriber {smpAgent = ca} = do
     counts <- mapConcurrently (subscribeSrvSubs ca st batchSize) srvs
     logNote $ "Completed all SMP resubscriptions for " <> tshow (length srvs) <> " servers (" <> tshow (sum counts) <> " subscriptions)"
 
-subscribeSrvSubs :: SMPClientAgent 'Notifier -> NtfPostgresStore -> Int -> (SMPServer, Int64, Maybe (ServiceId, Int64)) -> IO Int
+subscribeSrvSubs :: SMPClientAgent 'NotifierService -> NtfPostgresStore -> Int -> (SMPServer, Int64, Maybe (ServiceId, Int64)) -> IO Int
 subscribeSrvSubs ca st batchSize (srv, srvId, service_) = do
   let srvStr = safeDecodeUtf8 (strEncode $ L.head $ host srv)
   logNote $ "Starting SMP resubscriptions for " <> srvStr
@@ -480,8 +477,8 @@ subscribeSrvSubs ca st batchSize (srv, srvId, service_) = do
 
 -- this function is concurrency-safe - only onle subscriber per server can be created at a time,
 -- other threads would wait for the first thread to create it.
-subscribeNtfs :: NtfSubscriber -> NtfPostgresStore -> SMPServer -> ServerNtfSub -> IO ()
-subscribeNtfs NtfSubscriber {smpSubscribers, subscriberSeq, smpAgent = ca} st smpServer ntfSub =
+subscribeNtfs :: NtfSubscriber -> NtfPostgresStore -> SMPServer -> Int64 -> ServerNtfSub -> IO ()
+subscribeNtfs NtfSubscriber {smpSubscribers, subscriberSeq, smpAgent = ca} st smpServer srvId ntfSub =
   getSubscriberVar
     >>= either createSMPSubscriber waitForSMPSubscriber
     >>= mapM_ (\sub -> atomically $ writeTQueue (subscriberSubQ sub) ntfSub)
@@ -493,8 +490,8 @@ subscribeNtfs NtfSubscriber {smpSubscribers, subscriberSeq, smpAgent = ca} st sm
     createSMPSubscriber v =
       E.handle (\(e :: SomeException) -> logError ("SMP subscriber exception: " <> tshow e) >> removeSubscriber v) $ do
         q <- newTQueueIO
-        tId <- mkWeakThreadId =<< forkIO (runSMPSubscriber q)
-        let sub = SMPSubscriber {smpServer, subscriberSubQ = q, subThreadId = tId}
+        tId <- mkWeakThreadId =<< forkIO (runSMPSubscriber smpServer srvId q)
+        let sub = SMPSubscriber {smpServer, smpServerId = srvId, subscriberSubQ = q, subThreadId = tId}
         atomically $ putTMVar (sessionVar v) sub -- this makes it available for other threads
         pure $ Just sub
 
@@ -510,13 +507,13 @@ subscribeNtfs NtfSubscriber {smpSubscribers, subscriberSeq, smpAgent = ca} st sm
       atomically $ removeSessVar v smpServer smpSubscribers
       pure Nothing
 
-    runSMPSubscriber :: TQueue ServerNtfSub -> IO ()
-    runSMPSubscriber q = forever $ do
+    runSMPSubscriber :: SMPServer -> Int64 -> TQueue ServerNtfSub -> IO ()
+    runSMPSubscriber smpServer' srvId' q = forever $ do
       -- TODO [ntfdb] possibly, the subscriptions can be batched here and sent every say 5 seconds
       -- this should be analysed once we have prometheus stats
       (nId, sub) <- atomically $ readTQueue q
-      void $ updateSubStatus st nId NSPending
-      subscribeQueuesNtfs ca smpServer [sub]
+      void $ updateSubStatus st srvId' nId NSPending
+      subscribeQueuesNtfs ca smpServer' [sub]
 
 ntfSubscriber :: NtfSubscriber -> M ()
 ntfSubscriber NtfSubscriber {smpAgent = ca@SMPClientAgent {msgQ, agentQ}} =
@@ -722,25 +719,24 @@ clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connecte
 
 receive :: Transport c => NtfPostgresStore -> THandleNTF c 'TServer -> NtfServerClient -> IO ()
 receive st th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
-  ts <- L.toList <$> tGet th
+  ts <- L.toList <$> tGetServer th
   atomically . (writeTVar rcvActiveAt $!) =<< getSystemTime
   (errs, cmds) <- partitionEithers <$> mapM cmdAction ts
   write sndQ errs
   write rcvQ cmds
   where
-    cmdAction t@(_, _, (corrId, entId, cmdOrError)) =
-      case cmdOrError of
-        Left e -> do
-          logError $ "invalid client request: " <> tshow e
-          pure $ Left (corrId, entId, NRErr e)
-        Right cmd ->
-          verified =<< verifyNtfTransmission st ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd
-          where
-            verified = \case
-              VRVerified req -> pure $ Right req
-              VRFailed e -> do
-                logError "unauthorized client request"
-                pure $ Left (corrId, entId, NRErr e)
+    cmdAction = \case
+      Left (corrId, entId, e) -> do
+        logError $ "invalid client request: " <> tshow e
+        pure $ Left (corrId, entId, NRErr e)
+      Right t@(_, _, (corrId, entId, _)) ->
+        verified =<< verifyNtfTransmission st thAuth t
+        where
+          verified = \case
+            VRVerified req -> pure $ Right req
+            VRFailed e -> do
+              logError "unauthorized client request"
+              pure $ Left (corrId, entId, NRErr e)
     write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
 send :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> IO ()
@@ -751,10 +747,10 @@ send h@THandle {params} NtfServerClient {sndQ, sndActiveAt} = forever $ do
 
 data VerificationResult = VRVerified NtfRequest | VRFailed ErrorType
 
-verifyNtfTransmission :: NtfPostgresStore -> Maybe (THandleAuth 'TServer, C.CbNonce) -> SignedTransmission ErrorType NtfCmd -> NtfCmd -> IO VerificationResult
-verifyNtfTransmission st auth_ (tAuth, authorized, (corrId, entId, _)) = \case
+verifyNtfTransmission :: NtfPostgresStore -> Maybe (THandleAuth 'TServer) -> SignedTransmission NtfCmd -> IO VerificationResult
+verifyNtfTransmission st thAuth (tAuth, authorized, (corrId, entId, cmd)) = case cmd of
   NtfCmd SToken c@(TNEW tkn@(NewNtfTkn _ k _))
-    | verifyCmdAuthorization auth_ tAuth authorized k ->
+    | verifyCmdAuthorization thAuth tAuth authorized corrId k ->
         result <$> findNtfTokenRegistration st tkn
     | otherwise -> pure $ VRFailed AUTH
     where
@@ -783,10 +779,10 @@ verifyNtfTransmission st auth_ (tAuth, authorized, (corrId, entId, _)) = \case
     subCmd s c = NtfReqCmd SSubscription (NtfSub s) (corrId, entId, c)
     verifyToken :: NtfTknRec -> NtfRequest -> VerificationResult
     verifyToken NtfTknRec {tknVerifyKey} r
-      | verifyCmdAuthorization auth_ tAuth authorized tknVerifyKey = VRVerified r
+      | verifyCmdAuthorization thAuth tAuth authorized corrId tknVerifyKey = VRVerified r
       | otherwise = VRFailed AUTH
     err = \case -- signature verification for AUTH errors mitigates timing attacks for existence checks
-      AUTH -> maybe False (dummyVerifyCmd auth_ authorized) tAuth `seq` VRFailed AUTH
+      AUTH -> dummyVerifyCmd thAuth tAuth authorized corrId `seq` VRFailed AUTH
       e -> VRFailed e
 
 client :: NtfServerClient -> NtfSubscriber -> NtfPushServer -> M ()
@@ -867,12 +863,12 @@ client NtfServerClient {rcvQ, sndQ} ns@NtfSubscriber {smpAgent = ca} NtfPushServ
         let sub = mkNtfSubRec subId newSub
         resp <-
           withNtfStore (`addNtfSubscription` sub) $ \case
-            True -> do
+            (srvId, True) -> do
               st <- asks store
-              liftIO $ subscribeNtfs ns st srv (subId, (nId, nKey))
+              liftIO $ subscribeNtfs ns st srv srvId (subId, (nId, nKey))
               incNtfStat subCreated
               pure $ NRSubId subId
-            False -> pure $ NRErr AUTH
+            (_, False) -> pure $ NRErr AUTH
         pure (corrId, NoEntity, resp)
       NtfReqCmd SSubscription (NtfSub NtfSubRec {ntfSubId, smpQueue = SMPQueueNtf {smpServer, notifierId}, notifierKey = registeredNKey, subStatus}) (corrId, subId, cmd) -> do
         (corrId,subId,) <$> case cmd of

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

@@ -127,7 +127,7 @@ newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, dbSt
 data NtfSubscriber = NtfSubscriber
   { smpSubscribers :: TMap SMPServer SMPSubscriberVar,
     subscriberSeq :: TVar Int,
-    smpAgent :: SMPClientAgent 'Notifier
+    smpAgent :: SMPClientAgent 'NotifierService
   }
 
 type SMPSubscriberVar = SessionVar SMPSubscriber
@@ -136,11 +136,12 @@ newNtfSubscriber :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO NtfSubscriber
 newNtfSubscriber smpAgentCfg random = do
   smpSubscribers <- TM.emptyIO
   subscriberSeq <- newTVarIO 0
-  smpAgent <- newSMPClientAgent SNotifier smpAgentCfg random
+  smpAgent <- newSMPClientAgent SNotifierService smpAgentCfg random
   pure NtfSubscriber {smpSubscribers, subscriberSeq, smpAgent}
 
 data SMPSubscriber = SMPSubscriber
   { smpServer :: SMPServer,
+    smpServerId :: Int64,
     subscriberSubQ :: TQueue ServerNtfSub,
     subThreadId :: Weak ThreadId
   }

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

@@ -27,7 +27,7 @@ import Options.Applicative
 import Simplex.Messaging.Agent.Store.Postgres (checkSchemaExists)
 import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
-import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
+import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SMPWebPortServers (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol (NtfTokenId)
@@ -246,6 +246,7 @@ ntfServerCLI cfgPath logPath =
                                 socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini,
                                 hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "SUBSCRIBER" "host_mode" ini,
                                 requiredHostMode = fromMaybe False $ iniOnOff "SUBSCRIBER" "required_host_mode" ini,
+                                smpWebPortServers = SWPOff,
                                 smpPingInterval = 60_000_000 -- 1 minute
                               }
                         },

src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs

@@ -56,6 +56,7 @@ import Simplex.Messaging.Agent.Store.Postgres (closeDBStore, createDBStore)
 import Simplex.Messaging.Agent.Store.Postgres.Common
 import Simplex.Messaging.Agent.Store.Postgres.DB (blobFieldDecoder, fromTextField_)
 import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Store (NtfSTMStore (..), NtfSubData (..), NtfTknData (..), TokenNtfMessageRecord (..), ntfSubServer)
@@ -75,7 +76,6 @@ import System.IO (IOMode (..), hFlush, stdout, withFile)
 import Text.Hex (decodeHex)
 
 #if !defined(dbPostgres)
-import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Util (eitherToMaybe)
 #endif
 
@@ -401,13 +401,13 @@ updateTokenCronSentAt st tknId now =
   withDB' "updateTokenCronSentAt" st $ \db ->
     void $ DB.execute db "UPDATE tokens t SET cron_sent_at = ? WHERE token_id = ?" (now, tknId)
 
-addNtfSubscription :: NtfPostgresStore -> NtfSubRec -> IO (Either ErrorType Bool)
+addNtfSubscription :: NtfPostgresStore -> NtfSubRec -> IO (Either ErrorType (Int64, Bool))
 addNtfSubscription st sub =
   withFastDB "addNtfSubscription" st $ \db -> runExceptT $ do
     srvId :: Int64 <- ExceptT $ upsertServer db $ ntfSubServer' sub
     n <- liftIO $ DB.execute db insertNtfSubQuery $ ntfSubToRow srvId sub
     withLog "addNtfSubscription" st (`logCreateSubscription` sub)
-    pure $ n > 0
+    pure (srvId, n > 0)
   where
     -- It is possible to combine these two statements into one with CTEs,
     -- to reduce roundtrips in case of `insert`, but it would be making 2 queries in all cases.
@@ -454,8 +454,8 @@ deleteNtfSubscription st subId =
       DB.execute db "DELETE FROM subscriptions WHERE subscription_id = ?" (Only subId)
     withLog "deleteNtfSubscription" st (`logDeleteSubscription` subId)
 
-updateSubStatus :: NtfPostgresStore -> NotifierId -> NtfSubStatus -> IO (Either ErrorType ())
-updateSubStatus st nId status =
+updateSubStatus :: NtfPostgresStore -> Int64 -> NotifierId -> NtfSubStatus -> IO (Either ErrorType ())
+updateSubStatus st srvId nId status =
   withFastDB' "updateSubStatus" st $ \db -> do
     sub_ :: Maybe (NtfSubscriptionId, NtfAssociatedService) <-
       maybeFirstRow id $
@@ -463,10 +463,10 @@ updateSubStatus st nId status =
           db
           [sql|
             UPDATE subscriptions SET status = ?
-            WHERE smp_notifier_id = ? AND status != ?
+            WHERE smp_server_id = ? AND smp_notifier_id = ? AND status != ?
             RETURNING subscription_id, ntf_service_assoc
           |]
-          (status, nId, status)
+          (status, srvId, nId, status)
     forM_ sub_ $ \(subId, serviceAssoc) ->
       withLog "updateSubStatus" st $ \sl -> logSubscriptionStatus sl (subId, status, serviceAssoc)
 
@@ -493,11 +493,11 @@ updateSrvSubStatus st q status =
 batchUpdateSrvSubStatus :: NtfPostgresStore -> SMPServer -> Maybe ServiceId -> NonEmpty NotifierId -> NtfSubStatus -> IO Int
 batchUpdateSrvSubStatus st srv newServiceId nIds status =
   fmap (fromRight (-1)) $ withDB "batchUpdateSrvSubStatus" st $ \db -> runExceptT $ do
-    (srvId, currServiceId) <- ExceptT $ getSMPServerService db
+    (srvId :: Int64, currServiceId) <- ExceptT $ getSMPServerService db
     unless (currServiceId == newServiceId) $ liftIO $ void $
       DB.execute db "UPDATE smp_servers SET ntf_service_id = ? WHERE smp_server_id = ?" (newServiceId, srvId)
     let params = L.toList $ L.map (srvId,isJust newServiceId,status,) nIds
-    batchUpdateStatus_ st db params
+    liftIO $ fromIntegral <$> DB.executeMany db updateSubStatusQuery params
   where
     getSMPServerService db =
       firstRow id AUTH $
@@ -514,9 +514,11 @@ batchUpdateSrvSubStatus st srv newServiceId nIds status =
 batchUpdateSrvSubErrors :: NtfPostgresStore -> SMPServer -> NonEmpty (NotifierId, NtfSubStatus) -> IO Int
 batchUpdateSrvSubErrors st srv subs =
   fmap (fromRight (-1)) $ withDB "batchUpdateSrvSubErrors" st $ \db -> runExceptT $ do
-    srvId <- ExceptT $ getSMPServerId db
-    let params = L.toList $ L.map (\(nId, status) -> (srvId, False, status, nId)) subs
-    batchUpdateStatus_ st db params
+    srvId :: Int64 <- ExceptT $ getSMPServerId db
+    let params = map (\(nId, status) -> (srvId, False, status, nId)) $ L.toList subs
+    subs' <- liftIO $ DB.returning db (updateSubStatusQuery <> " RETURNING s.subscription_id, s.status, s.ntf_service_assoc") params
+    withLog "batchUpdateStatus_" st $ forM_ subs' . logSubscriptionStatus
+    pure $ length subs'
   where
     getSMPServerId db =
       firstRow fromOnly AUTH $
@@ -529,24 +531,16 @@ batchUpdateSrvSubErrors st srv subs =
           |]
           (srvToRow srv)
 
-batchUpdateStatus_ :: NtfPostgresStore -> DB.Connection -> [(Int64, NtfAssociatedService, NtfSubStatus, NotifierId)] -> ExceptT ErrorType IO Int
-batchUpdateStatus_ st db params = do
-  subs <-
-    liftIO $
-      DB.returning
-        db
-        [sql|
-          UPDATE subscriptions s
-          SET status = upd.status, ntf_service_assoc = upd.ntf_service_assoc
-          FROM (VALUES(?, ?, ?, ?)) AS upd(smp_server_id, ntf_service_assoc, status, smp_notifier_id)
-          WHERE s.smp_server_id = upd.smp_server_id
-            AND s.smp_notifier_id = (upd.smp_notifier_id :: BYTEA)
-            AND (s.status != upd.status OR s.ntf_service_assoc != upd.ntf_service_assoc)
-          RETURNING s.subscription_id, s.status, s.ntf_service_assoc
-        |]
-        params
-  withLog "batchUpdateStatus_" st $ forM_ subs . logSubscriptionStatus
-  pure $ length subs
+updateSubStatusQuery :: Query
+updateSubStatusQuery =
+  [sql|
+    UPDATE subscriptions s
+    SET status = upd.status, ntf_service_assoc = upd.ntf_service_assoc
+    FROM (VALUES(?, ?, ?, ?)) AS upd(smp_server_id, ntf_service_assoc, status, smp_notifier_id)
+    WHERE s.smp_server_id = upd.smp_server_id
+      AND s.smp_notifier_id = (upd.smp_notifier_id :: BYTEA)
+      AND (s.status != upd.status OR s.ntf_service_assoc != upd.ntf_service_assoc)
+  |]
 
 removeServiceAssociation :: NtfPostgresStore -> SMPServer -> IO (Either ErrorType (Int64, Int))
 removeServiceAssociation st srv = do

src/Simplex/Messaging/Protocol.hs

@@ -64,10 +64,13 @@ module Simplex.Messaging.Protocol
     EncFixedDataBytes,
     EncUserDataBytes,
     EncDataBytes (..),
+    NewNtfCreds (..),
+    ServerNtfCreds (..),
     Party (..),
     Cmd (..),
-    DirectParty,
-    SubscriberParty,
+    QueueParty,
+    BatchParty,
+    ServiceParty,
     ASubscriberParty (..),
     BrokerMsg (..),
     SParty (..),
@@ -80,12 +83,13 @@ module Simplex.Messaging.Protocol
     BrokerErrorType (..),
     BlockingInfo (..),
     BlockingReason (..),
+    RawTransmission,
     Transmission,
     TAuthorizations,
     TransmissionAuth (..),
     SignedTransmission,
+    SignedTransmissionOrError,
     SentRawTransmission,
-    SignedRawTransmission,
     ClientMsgEnvelope (..),
     PubHeader (..),
     ClientMessage (..),
@@ -112,6 +116,7 @@ module Simplex.Messaging.Protocol
     BasicAuth (..),
     SrvLoc (..),
     CorrId (..),
+    pattern NoCorrId,
     EntityId (..),
     pattern NoEntity,
     QueueId,
@@ -153,8 +158,11 @@ module Simplex.Messaging.Protocol
     currentSMPClientVersion,
     senderCanSecure,
     queueReqMode,
-    subscriberParty,
-    subscriberServiceRole,
+    queueParty,
+    batchParty,
+    serviceParty,
+    partyClientRole,
+    partyServiceRole,
     userProtocol,
     rcvMessageMeta,
     noMsgFlags,
@@ -186,9 +194,11 @@ module Simplex.Messaging.Protocol
     TransportBatch (..),
     tPut,
     tPutLog,
-    tGet,
+    tGetServer,
+    tGetClient,
     tParse,
-    tDecodeParseValidate,
+    tDecodeServer,
+    tDecodeClient,
     tEncode,
     tEncodeBatch1,
     batchTransmissions,
@@ -208,7 +218,7 @@ import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser, (<?>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.Bifunctor (first)
+import Data.Bifunctor (bimap, first)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -303,22 +313,40 @@ e2eEncMessageLength :: Int
 e2eEncMessageLength = 16000 -- 15988 .. 16005
 
 -- | SMP protocol clients
-data Party = Recipient | Sender | Notifier | LinkClient | ProxiedClient | ProxyService
+data Party
+  = Creator
+  | Recipient
+  | RecipientService
+  | Sender
+  | IdleClient
+  | Notifier
+  | NotifierService
+  | LinkClient
+  | ProxiedClient
+  | ProxyService
   deriving (Show)
 
 -- | Singleton types for SMP protocol clients
 data SParty :: Party -> Type where
+  SCreator :: SParty Creator
   SRecipient :: SParty Recipient
+  SRecipientService :: SParty RecipientService
   SSender :: SParty Sender
+  SIdleClient :: SParty IdleClient
   SNotifier :: SParty Notifier
+  SNotifierService :: SParty NotifierService
   SSenderLink :: SParty LinkClient
   SProxiedClient :: SParty ProxiedClient
   SProxyService :: SParty ProxyService
 
 instance TestEquality SParty where
+  testEquality SCreator SCreator = Just Refl
   testEquality SRecipient SRecipient = Just Refl
+  testEquality SRecipientService SRecipientService = Just Refl
   testEquality SSender SSender = Just Refl
+  testEquality SIdleClient SIdleClient = Just Refl
   testEquality SNotifier SNotifier = Just Refl
+  testEquality SNotifierService SNotifierService = Just Refl
   testEquality SSenderLink SSenderLink = Just Refl
   testEquality SProxiedClient SProxiedClient = Just Refl
   testEquality SProxyService SProxyService = Just Refl
@@ -328,34 +356,72 @@ deriving instance Show (SParty p)
 
 class PartyI (p :: Party) where sParty :: SParty p
 
+instance PartyI Creator where sParty = SCreator
+
 instance PartyI Recipient where sParty = SRecipient
 
+instance PartyI RecipientService where sParty = SRecipientService
+
 instance PartyI Sender where sParty = SSender
 
+instance PartyI IdleClient where sParty = SIdleClient
+
 instance PartyI Notifier where sParty = SNotifier
 
+instance PartyI NotifierService where sParty = SNotifierService
+
 instance PartyI LinkClient where sParty = SSenderLink
 
 instance PartyI ProxiedClient where sParty = SProxiedClient
 
 instance PartyI ProxyService where sParty = SProxyService
 
-type family DirectParty (p :: Party) :: Constraint where
-  DirectParty Recipient = ()
-  DirectParty Sender = ()
-  DirectParty Notifier = ()
-  DirectParty LinkClient = ()
-  DirectParty ProxyService = ()
-  DirectParty p =
-    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not direct"))
+-- command parties that can read queues
+type family QueueParty (p :: Party) :: Constraint where
+  QueueParty Recipient = ()
+  QueueParty Sender = ()
+  QueueParty Notifier = ()
+  QueueParty LinkClient = ()
+  QueueParty p =
+    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not QueueParty"))
 
-type family SubscriberParty (p :: Party) :: Constraint where
-  SubscriberParty Recipient = ()
-  SubscriberParty Notifier = ()
-  SubscriberParty p =
-    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not subscriber"))
+queueParty :: SParty p -> Maybe (Dict (PartyI p, QueueParty p))
+queueParty = \case
+  SRecipient -> Just Dict
+  SSender -> Just Dict
+  SSenderLink -> Just Dict
+  SNotifier -> Just Dict
+  _ -> Nothing
+{-# INLINE queueParty #-}
 
-data ASubscriberParty = forall p. (PartyI p, SubscriberParty p) => ASP (SParty p)
+type family BatchParty (p :: Party) :: Constraint where
+  BatchParty Recipient = ()
+  BatchParty Notifier = ()
+  BatchParty p =
+    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not BatchParty"))
+
+batchParty :: SParty p -> Maybe (Dict (PartyI p, BatchParty p))
+batchParty = \case
+  SRecipient -> Just Dict
+  SNotifier -> Just Dict
+  _ -> Nothing
+{-# INLINE batchParty #-}
+
+-- command parties that can subscribe to individual queues
+type family ServiceParty (p :: Party) :: Constraint where
+  ServiceParty RecipientService = ()
+  ServiceParty NotifierService = ()
+  ServiceParty p =
+    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not ServiceParty"))
+
+serviceParty :: SParty p -> Maybe (Dict (PartyI p, ServiceParty p))
+serviceParty = \case
+  SRecipientService -> Just Dict
+  SNotifierService -> Just Dict
+  _ -> Nothing
+{-# INLINE serviceParty #-}
+
+data ASubscriberParty = forall p. (PartyI p, ServiceParty p) => ASP (SParty p)
 
 deriving instance Show ASubscriberParty
 
@@ -364,30 +430,37 @@ instance Eq ASubscriberParty where
 
 instance Encoding ASubscriberParty where
   smpEncode = \case
-    ASP SRecipient -> "R"
-    ASP SNotifier -> "N"
+    ASP SRecipientService -> "R"
+    ASP SNotifierService -> "N"
   smpP =
     A.anyChar >>= \case
-      'R' -> pure $ ASP SRecipient
-      'N' -> pure $ ASP SNotifier
+      'R' -> pure $ ASP SRecipientService
+      'N' -> pure $ ASP SNotifierService
       _ -> fail "bad ASubscriberParty"
 
 instance StrEncoding ASubscriberParty where
   strEncode = smpEncode
   strP = smpP
 
-subscriberParty :: SParty p -> Maybe (Dict (PartyI p, SubscriberParty p))
-subscriberParty = \case
-  SRecipient -> Just Dict
-  SNotifier -> Just Dict
-  _ -> Nothing
-{-# INLINE subscriberParty #-}
+partyClientRole :: SParty p -> Maybe SMPServiceRole
+partyClientRole = \case
+  SCreator -> Just SRMessaging
+  SRecipient -> Just SRMessaging
+  SRecipientService -> Just SRMessaging
+  SSender -> Just SRMessaging
+  SIdleClient -> Nothing
+  SNotifier -> Just SRNotifier
+  SNotifierService -> Just SRNotifier
+  SSenderLink -> Just SRMessaging
+  SProxiedClient -> Just SRMessaging
+  SProxyService -> Just SRProxy
+{-# INLINE partyClientRole #-}
 
-subscriberServiceRole :: SubscriberParty p => SParty p -> SMPServiceRole
-subscriberServiceRole = \case
-  SRecipient -> SRMessaging
-  SNotifier -> SRNotifier
-{-# INLINE subscriberServiceRole #-}
+partyServiceRole :: ServiceParty p => SParty p -> SMPServiceRole
+partyServiceRole = \case
+  SRecipientService -> SRMessaging
+  SNotifierService -> SRNotifier
+{-# INLINE partyServiceRole #-}
 
 -- | Type for client command of any participant.
 data Cmd = forall p. PartyI p => Cmd (SParty p) (Command p)
@@ -398,7 +471,9 @@ deriving instance Show Cmd
 type Transmission c = (CorrId, EntityId, c)
 
 -- | signed parsed transmission, with original raw bytes and parsing error.
-type SignedTransmission e c = (Maybe TAuthorizations, Signed, Transmission (Either e c))
+type SignedTransmission c = (Maybe TAuthorizations, Signed, Transmission c)
+
+type SignedTransmissionOrError e c = Either (Transmission e) (SignedTransmission c)
 
 type Signed = ByteString
 
@@ -439,9 +514,6 @@ decodeTAuthBytes s serviceSig
   | B.length s == C.cbAuthenticatorSize = Right $ Just (TAAuthenticator (C.CbAuthenticator s), serviceSig)
   | otherwise = (\sig -> Just (TASignature sig, serviceSig)) <$> C.decodeSignature s
 
--- | unparsed sent SMP transmission with signature, without session ID.
-type SignedRawTransmission = (Maybe TAuthorizations, CorrId, EntityId, ByteString)
-
 -- | unparsed sent SMP transmission with signature.
 type SentRawTransmission = (Maybe TAuthorizations, ByteString)
 
@@ -466,10 +538,10 @@ data Command (p :: Party) where
   -- v6 of SMP servers only support signature algorithm for command authorization.
   -- v7 of SMP servers additionally support additional layer of authenticated encryption.
   -- RcvPublicAuthKey is defined as C.APublicKey - it can be either signature or DH public keys.
-  NEW :: NewQueueReq -> Command Recipient
+  NEW :: NewQueueReq -> Command Creator
   SUB :: Command Recipient
   -- | subscribe all associated queues. Service ID must be used as entity ID, and service session key must sign the command.
-  SUBS :: Command Recipient
+  SUBS :: Command RecipientService
   KEY :: SndPublicAuthKey -> Command Recipient
   RKEY :: NonEmpty RcvPublicAuthKey -> Command Recipient
   LSET :: LinkId -> QueueLinkData -> Command Recipient
@@ -486,14 +558,14 @@ data Command (p :: Party) where
   -- SEND v1 has to be supported for encoding/decoding
   -- SEND :: MsgBody -> Command Sender
   SEND :: MsgFlags -> MsgBody -> Command Sender
-  PING :: Command Sender
+  PING :: Command IdleClient
   -- Client accessing short links
   LKEY :: SndPublicAuthKey -> Command LinkClient
   LGET :: Command LinkClient
   -- SMP notification subscriber commands
   NSUB :: Command Notifier
   -- | subscribe all associated queues. Service ID must be used as entity ID, and service session key must sign the command.
-  NSUBS :: Command Notifier
+  NSUBS :: Command NotifierService
   PRXY :: SMPServer -> Maybe BasicAuth -> Command ProxiedClient -- request a relay server connection by URI
   -- Transmission to proxy:
   -- - entity ID: ID of the session with relay returned in PKEY (response to PRXY)
@@ -513,9 +585,8 @@ data NewQueueReq = NewQueueReq
     rcvDhKey :: RcvPublicDhKey,
     auth_ :: Maybe BasicAuth,
     subMode :: SubscriptionMode,
-    queueReqData :: Maybe QueueReqData
-    -- TODO [notifications]
-    -- ntfCreds :: Maybe NewNtfCreds
+    queueReqData :: Maybe QueueReqData,
+    ntfCreds :: Maybe NewNtfCreds
   }
   deriving (Show)
 
@@ -559,8 +630,7 @@ instance ToField EncDataBytes where
   toField (EncDataBytes s) = toField (Binary s)
   {-# INLINE toField #-}
 
--- TODO [notifications]
--- data NewNtfCreds = NewNtfCreds NtfPublicAuthKey RcvNtfPublicDhKey deriving (Show)
+data NewNtfCreds = NewNtfCreds NtfPublicAuthKey RcvNtfPublicDhKey deriving (Show)
 
 instance StrEncoding SubscriptionMode where
   strEncode = \case
@@ -591,10 +661,9 @@ instance Encoding QueueReqData where
       'C' -> QRContact <$> smpP
       _ -> fail "bad QueueReqData"
 
--- TODO [notifications]
--- instance Encoding NewNtfCreds where
---   smpEncode (NewNtfCreds authKey dhKey) = smpEncode (authKey, dhKey)
---   smpP = NewNtfCreds <$> smpP <*> smpP
+instance Encoding NewNtfCreds where
+  smpEncode (NewNtfCreds authKey dhKey) = smpEncode (authKey, dhKey)
+  smpP = NewNtfCreds <$> smpP <*> smpP
 
 newtype EncTransmission = EncTransmission ByteString
   deriving (Show)
@@ -827,9 +896,9 @@ noMsgFlags = MsgFlags {notification = False}
 -- * SMP command tags
 
 data CommandTag (p :: Party) where
-  NEW_ :: CommandTag Recipient
+  NEW_ :: CommandTag Creator
   SUB_ :: CommandTag Recipient
-  SUBS_ :: CommandTag Recipient
+  SUBS_ :: CommandTag RecipientService
   KEY_ :: CommandTag Recipient
   RKEY_ :: CommandTag Recipient
   LSET_ :: CommandTag Recipient
@@ -843,14 +912,14 @@ data CommandTag (p :: Party) where
   QUE_ :: CommandTag Recipient
   SKEY_ :: CommandTag Sender
   SEND_ :: CommandTag Sender
-  PING_ :: CommandTag Sender
+  PING_ :: CommandTag IdleClient
   LKEY_ :: CommandTag LinkClient
   LGET_ :: CommandTag LinkClient
   PRXY_ :: CommandTag ProxiedClient
   PFWD_ :: CommandTag ProxiedClient
   RFWD_ :: CommandTag ProxyService
   NSUB_ :: CommandTag Notifier
-  NSUBS_ :: CommandTag Notifier
+  NSUBS_ :: CommandTag NotifierService
 
 data CmdTag = forall p. PartyI p => CT (SParty p) (CommandTag p)
 
@@ -916,9 +985,9 @@ instance PartyI p => Encoding (CommandTag p) where
 
 instance ProtocolMsgTag CmdTag where
   decodeTag = \case
-    "NEW" -> Just $ CT SRecipient NEW_
+    "NEW" -> Just $ CT SCreator NEW_
     "SUB" -> Just $ CT SRecipient SUB_
-    "SUBS" -> Just $ CT SRecipient SUBS_
+    "SUBS" -> Just $ CT SRecipientService SUBS_
     "KEY" -> Just $ CT SRecipient KEY_
     "RKEY" -> Just $ CT SRecipient RKEY_
     "LSET" -> Just $ CT SRecipient LSET_
@@ -932,14 +1001,14 @@ instance ProtocolMsgTag CmdTag where
     "QUE" -> Just $ CT SRecipient QUE_
     "SKEY" -> Just $ CT SSender SKEY_
     "SEND" -> Just $ CT SSender SEND_
-    "PING" -> Just $ CT SSender PING_
+    "PING" -> Just $ CT SIdleClient PING_
     "LKEY" -> Just $ CT SSenderLink LKEY_
     "LGET" -> Just $ CT SSenderLink LGET_
     "PRXY" -> Just $ CT SProxiedClient PRXY_
     "PFWD" -> Just $ CT SProxiedClient PFWD_
     "RFWD" -> Just $ CT SProxyService RFWD_
     "NSUB" -> Just $ CT SNotifier NSUB_
-    "NSUBS" -> Just $ CT SNotifier NSUBS_
+    "NSUBS" -> Just $ CT SNotifierService NSUBS_
     _ -> Nothing
 
 instance Encoding CmdTag where
@@ -1301,6 +1370,9 @@ newtype CorrId = CorrId {bs :: ByteString}
   deriving (Eq, Ord, Show)
   deriving newtype (Encoding)
 
+pattern NoCorrId :: CorrId
+pattern NoCorrId = CorrId ""
+
 instance IsString CorrId where
   fromString = CorrId . fromString
   {-# INLINE fromString #-}
@@ -1324,19 +1396,17 @@ data QueueIdsKeys = QIK
     rcvPublicDhKey :: RcvPublicDhKey,
     queueMode :: Maybe QueueMode, -- TODO remove Maybe when min version is 9 (sndAuthKeySMPVersion)
     linkId :: Maybe LinkId,
-    serviceId :: Maybe ServiceId
-    -- TODO [notifications]
-    -- serverNtfCreds :: Maybe ServerNtfCreds
+    serviceId :: Maybe ServiceId,
+    serverNtfCreds :: Maybe ServerNtfCreds
   }
   deriving (Eq, Show)
 
--- TODO [notifications]
--- data ServerNtfCreds = ServerNtfCreds NotifierId RcvNtfPublicDhKey
---   deriving (Eq, Show)
+data ServerNtfCreds = ServerNtfCreds NotifierId RcvNtfPublicDhKey
+  deriving (Eq, Show)
 
--- instance Encoding ServerNtfCreds where
---   smpEncode (ServerNtfCreds nId dhKey) = smpEncode (nId, dhKey)
---   smpP = ServerNtfCreds <$> smpP <*> smpP
+instance Encoding ServerNtfCreds where
+  smpEncode (ServerNtfCreds nId dhKey) = smpEncode (nId, dhKey)
+  smpP = ServerNtfCreds <$> smpP <*> smpP
 
 -- | Recipient's private key used by the recipient to authorize (v6: sign, v7: encrypt hash) SMP commands.
 --
@@ -1564,7 +1634,7 @@ instance Protocol SMPVersion ErrorType BrokerMsg where
     Cmd _ NSUB -> True
     _ -> False
   {-# INLINE useServiceAuth #-}
-  protocolPing = Cmd SSender PING
+  protocolPing = Cmd SIdleClient PING
   {-# INLINE protocolPing #-}
   protocolError = \case
     ERR e -> Just e
@@ -1576,12 +1646,13 @@ class ProtocolMsgTag (Tag msg) => ProtocolEncoding v err msg | msg -> err, msg -
   encodeProtocol :: Version v -> msg -> ByteString
   protocolP :: Version v -> Tag msg -> Parser msg
   fromProtocolError :: ProtocolErrorType -> err
-  checkCredentials :: SignedRawTransmission -> msg -> Either err msg
+  checkCredentials :: Maybe TAuthorizations -> EntityId -> msg -> Either err msg
 
 instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
   type Tag (Command p) = CommandTag p
   encodeProtocol v = \case
-    NEW NewQueueReq {rcvAuthKey = rKey, rcvDhKey = dhKey, auth_, subMode, queueReqData}
+    NEW NewQueueReq {rcvAuthKey = rKey, rcvDhKey = dhKey, auth_, subMode, queueReqData, ntfCreds}
+      | v >= newNtfCredsSMPVersion -> new <> e (auth_, subMode, queueReqData, ntfCreds)
       | v >= shortLinksSMPVersion -> new <> e (auth_, subMode, queueReqData)
       | v >= sndAuthKeySMPVersion -> new <> e (auth_, subMode, senderCanSecure (queueReqMode <$> queueReqData))
       | otherwise -> new <> auth <> e subMode
@@ -1620,7 +1691,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
   fromProtocolError = fromProtocolError @SMPVersion @ErrorType @BrokerMsg
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (auth, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials auth (EntityId entId) cmd = case cmd of
     -- NEW must have signature but NOT queue ID
     NEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
@@ -1663,26 +1734,28 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
   {-# INLINE encodeProtocol #-}
 
   protocolP v = \case
-    CT SRecipient tag ->
-      Cmd SRecipient <$> case tag of
-        NEW_
-          | v >= shortLinksSMPVersion -> NEW <$> new smpP smpP
-          | v >= sndAuthKeySMPVersion -> NEW <$> new smpP (qReq <$> smpP)
-          | otherwise -> NEW <$> new auth (pure Nothing)
+    CT SCreator NEW_ -> Cmd SCreator <$> newCmd
+      where
+        newCmd
+          | v >= newNtfCredsSMPVersion = new smpP smpP smpP
+          | v >= shortLinksSMPVersion = new smpP smpP nothing
+          | v >= sndAuthKeySMPVersion = new smpP (qReq <$> smpP) nothing
+          | otherwise = new auth nothing nothing
           where
-            new p1 p2 = do
+            nothing = pure Nothing
+            new p1 p2 p3 = NEW <$> do
               rcvAuthKey <- _smpP
               rcvDhKey <- smpP
               auth_ <- p1
               subMode <- smpP
               queueReqData <- p2
-              -- TODO [notifications]
-              -- ntfCreds <- p3
-              pure NewQueueReq {rcvAuthKey, rcvDhKey, auth_, subMode, queueReqData} -- ntfCreds
+              ntfCreds <- p3
+              pure NewQueueReq {rcvAuthKey, rcvDhKey, auth_, subMode, queueReqData, ntfCreds}
             auth = optional (A.char 'A' *> smpP)
             qReq sndSecure = Just $ if sndSecure then QRMessaging Nothing else QRContact Nothing
+    CT SRecipient tag ->
+      Cmd SRecipient <$> case tag of
         SUB_ -> pure SUB
-        SUBS_ -> pure SUBS
         KEY_ -> KEY <$> _smpP
         RKEY_ -> RKEY <$> _smpP
         LSET_ -> LSET <$> _smpP <*> smpP
@@ -1694,11 +1767,12 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
         OFF_ -> pure OFF
         DEL_ -> pure DEL
         QUE_ -> pure QUE
+    CT SRecipientService SUBS_ -> pure $ Cmd SRecipientService SUBS
     CT SSender tag ->
       Cmd SSender <$> case tag of
         SKEY_ -> SKEY <$> _smpP
         SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP)
-        PING_ -> pure PING
+    CT SIdleClient PING_ -> pure $ Cmd SIdleClient PING
     CT SProxyService RFWD_ ->
       Cmd SProxyService . RFWD . EncFwdTransmission . unTail <$> _smpP
     CT SSenderLink tag ->
@@ -1709,21 +1783,20 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
       Cmd SProxiedClient <$> case tag of
         PFWD_ -> PFWD <$> _smpP <*> smpP <*> (EncTransmission . unTail <$> smpP)
         PRXY_ -> PRXY <$> _smpP <*> smpP
-    CT SNotifier tag ->
-      pure $ Cmd SNotifier $ case tag of
-        NSUB_ -> NSUB
-        NSUBS_ -> NSUBS
+    CT SNotifier NSUB_ -> pure $ Cmd SNotifier NSUB
+    CT SNotifierService NSUBS_ -> pure $ Cmd SNotifierService NSUBS
 
   fromProtocolError = fromProtocolError @SMPVersion @ErrorType @BrokerMsg
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials t (Cmd p c) = Cmd p <$> checkCredentials t c
+  checkCredentials tAuth entId (Cmd p c) = Cmd p <$> checkCredentials tAuth entId c
   {-# INLINE checkCredentials #-}
 
 instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
   type Tag BrokerMsg = BrokerMsgTag
   encodeProtocol v = \case
-    IDS QIK {rcvId, sndId, rcvPublicDhKey = srvDh, queueMode, linkId, serviceId}
+    IDS QIK {rcvId, sndId, rcvPublicDhKey = srvDh, queueMode, linkId, serviceId, serverNtfCreds}
+      | v >= newNtfCredsSMPVersion -> ids <> e queueMode <> e linkId <> e serviceId <> e serverNtfCreds
       | v >= serviceCertsSMPVersion -> ids <> e queueMode <> e linkId <> e serviceId
       | v >= shortLinksSMPVersion -> ids <> e queueMode <> e linkId
       | v >= sndAuthKeySMPVersion -> ids <> e (senderCanSecure queueMode)
@@ -1764,23 +1837,23 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
       where
         bodyP = EncRcvMsgBody . unTail <$> smpP
     IDS_
-      | v >= serviceCertsSMPVersion -> ids smpP smpP smpP
-      | v >= shortLinksSMPVersion -> ids smpP smpP nothing
-      | v >= sndAuthKeySMPVersion -> ids (qm <$> smpP) nothing nothing
-      | otherwise -> ids nothing nothing nothing
+      | v >= newNtfCredsSMPVersion -> ids smpP smpP smpP smpP
+      | v >= serviceCertsSMPVersion -> ids smpP smpP smpP nothing
+      | v >= shortLinksSMPVersion -> ids smpP smpP nothing nothing
+      | v >= sndAuthKeySMPVersion -> ids (qm <$> smpP) nothing nothing nothing
+      | otherwise -> ids nothing nothing nothing nothing
       where
         qm sndSecure = Just $ if sndSecure then QMMessaging else QMContact
         nothing = pure Nothing
-        ids p1 p2 p3 = do
+        ids p1 p2 p3 p4 = do
           rcvId <- _smpP
           sndId <- smpP
           rcvPublicDhKey <- smpP
           queueMode <- p1
           linkId <- p2
           serviceId <- p3
-          -- TODO [notifications]
-          -- serverNtfCreds <- p3
-          pure $ IDS QIK {rcvId, sndId, rcvPublicDhKey, queueMode, linkId, serviceId}
+          serverNtfCreds <- p4
+          pure $ IDS QIK {rcvId, sndId, rcvPublicDhKey, queueMode, linkId, serviceId, serverNtfCreds}
     LNK_ -> LNK <$> _smpP <*> smpP
     SOK_ -> SOK <$> _smpP
     SOKS_ -> SOKS <$> _smpP
@@ -1804,7 +1877,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials _ (EntityId entId) cmd = case cmd of
     -- IDS response should not have queue ID
     IDS _ -> Right cmd
     -- ERR response does not always have queue ID
@@ -2077,26 +2150,51 @@ tParse thParams@THandleParams {batch} s
 eitherList :: (a -> NonEmpty (Either e b)) -> Either e a -> NonEmpty (Either e b)
 eitherList = either (\e -> [Left e])
 
--- | Receive client and server transmissions (determined by `cmd` type).
-tGet :: forall v err cmd c p. (ProtocolEncoding v err cmd, Transport c) => THandle v c p -> IO (NonEmpty (SignedTransmission err cmd))
-tGet th@THandle {params} = L.map (tDecodeParseValidate params) <$> tGetParse th
+-- | Receive server transmissions
+tGetServer :: (ProtocolEncoding v err cmd, Transport c) => THandle v c 'TServer -> IO (NonEmpty (SignedTransmissionOrError err cmd))
+tGetServer = tGet tDecodeServer
+{-# INLINE tGetServer #-}
 
-tDecodeParseValidate :: forall v p err cmd. ProtocolEncoding v err cmd => THandleParams v p -> Either TransportError RawTransmission -> SignedTransmission err cmd
-tDecodeParseValidate THandleParams {sessionId, thVersion = v, implySessId} = \case
+-- | Receive client transmissions
+tGetClient :: (ProtocolEncoding v err cmd, Transport c) => THandle v c 'TClient -> IO (NonEmpty (Transmission (Either err cmd)))
+tGetClient = tGet tDecodeClient
+{-# INLINE tGetClient #-}
+
+tGet ::
+  Transport c =>
+  (THandleParams v p -> Either TransportError RawTransmission -> r) ->
+  THandle v c p ->
+  IO (NonEmpty r)
+tGet tDecode th@THandle {params} = L.map (tDecode params) <$> tGetParse th
+{-# INLINE tGet #-}
+
+tDecodeServer :: forall v err cmd. ProtocolEncoding v err cmd => THandleParams v 'TServer -> Either TransportError RawTransmission -> SignedTransmissionOrError err cmd
+tDecodeServer THandleParams {sessionId, thVersion = v, implySessId} = \case
   Right RawTransmission {authenticator, serviceSig, authorized, sessId, corrId, entityId, command}
-    | implySessId || sessId == sessionId ->
-        let decodedTransmission = (,corrId,entityId,command) <$> decodeTAuthBytes authenticator serviceSig
-         in either (const $ tError corrId) (tParseValidate authorized) decodedTransmission
-    | otherwise -> (Nothing, "", (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd PESession))
-  Left _ -> tError ""
+    | implySessId || sessId == sessionId -> case decodeTAuthBytes authenticator serviceSig of
+        Right tAuth -> bimap t ((tAuth,authorized,) . t) cmdOrErr
+          where
+            cmdOrErr = parseProtocol @v @err @cmd v command >>= checkCredentials tAuth entityId
+            t :: a -> (CorrId, EntityId, a)
+            t = (corrId,entityId,)
+        Left _ -> tError corrId PEBlock
+    | otherwise -> tError corrId PESession
+  Left _ -> tError "" PEBlock
   where
-    tError :: CorrId -> SignedTransmission err cmd
-    tError corrId = (Nothing, "", (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd PEBlock))
+    tError :: CorrId -> ProtocolErrorType -> SignedTransmissionOrError err cmd
+    tError corrId err = Left (corrId, NoEntity, fromProtocolError @v @err @cmd err)
 
-    tParseValidate :: ByteString -> SignedRawTransmission -> SignedTransmission err cmd
-    tParseValidate signed t@(sig, corrId, entityId, command) =
-      let cmd = parseProtocol @v @err @cmd v command >>= checkCredentials t
-       in (sig, signed, (corrId, entityId, cmd))
+tDecodeClient :: forall v err cmd. ProtocolEncoding v err cmd => THandleParams v 'TClient -> Either TransportError RawTransmission -> Transmission (Either err cmd)
+tDecodeClient THandleParams {sessionId, thVersion = v, implySessId} = \case
+  Right RawTransmission {sessId, corrId, entityId, command}
+    | implySessId || sessId == sessionId -> (corrId, entityId, cmdOrErr)
+    | otherwise -> tError corrId PESession
+    where
+      cmdOrErr = parseProtocol @v @err @cmd v command >>= checkCredentials Nothing entityId
+  Left _ -> tError "" PEBlock
+  where
+    tError :: CorrId -> ProtocolErrorType -> Transmission (Either err cmd)
+    tError corrId err = (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd err)
 
 $(J.deriveJSON defaultJSON ''MsgFlags)
 

src/Simplex/Messaging/Server/Control.hs

@@ -8,7 +8,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth, BlockingInfo, SenderId)
 
 data CPClientRole = CPRNone | CPRUser | CPRAdmin
-  deriving (Eq)
+  deriving (Eq, Show)
 
 data ControlProtocol
   = CPAuth BasicAuth

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

@@ -39,6 +39,8 @@ module Simplex.Messaging.Server.Env.STM
     MsgStoreType,
     MsgStore (..),
     AStoreType (..),
+    VerifiedTransmission,
+    ResponseAndMessage,
     newEnv,
     mkJournalStoreConfig,
     msgStore,
@@ -147,6 +149,7 @@ data ServerConfig s = ServerConfig
     -- | control port passwords,
     controlPortUserAuth :: Maybe BasicAuth,
     controlPortAdminAuth :: Maybe BasicAuth,
+    dailyBlockQueueQuota :: Int,
     -- | time after which the messages can be removed from the queues and check interval, seconds
     messageExpiration :: Maybe ExpirationConfig,
     expireMessagesOnStart :: Bool,
@@ -376,7 +379,7 @@ sameClient c cv = maybe False (sameClientId c) <$> readTVar cv
 data ClientSub
   = CSClient QueueId (Maybe ServiceId) (Maybe ServiceId) -- includes previous and new associated service IDs
   | CSDeleted QueueId (Maybe ServiceId) -- includes previously associated service IDs
-  | CSService ServiceId -- only send END to idividual client subs on message delivery, not of SSUB/NSSUB
+  | CSService ServiceId Int64 -- only send END to idividual client subs on message delivery, not of SSUB/NSSUB
 
 newtype ProxyAgent = ProxyAgent
   { smpAgent :: SMPClientAgent 'Sender
@@ -388,10 +391,12 @@ data Client s = Client
   { clientId :: ClientId,
     subscriptions :: TMap RecipientId Sub,
     ntfSubscriptions :: TMap NotifierId (),
+    serviceSubscribed :: TVar Bool, -- set independently of serviceSubsCount, to track whether service subscription command was received
+    ntfServiceSubscribed :: TVar Bool,
     serviceSubsCount :: TVar Int64, -- only one service can be subscribed, based on its certificate, this is subscription count
     ntfServiceSubsCount :: TVar Int64, -- only one service can be subscribed, based on its certificate, this is subscription count
-    rcvQ :: TBQueue (NonEmpty (Maybe (StoreQueue s, QueueRec), Transmission Cmd)),
-    sndQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
+    rcvQ :: TBQueue (NonEmpty (VerifiedTransmission s)),
+    sndQ :: TBQueue (NonEmpty (Transmission BrokerMsg), [Transmission BrokerMsg]),
     msgQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
     procThreads :: TVar Int,
     endThreads :: TVar (IntMap (Weak ThreadId)),
@@ -403,13 +408,17 @@ data Client s = Client
     sndActiveAt :: TVar SystemTime
   }
 
+type VerifiedTransmission s = (Maybe (StoreQueue s, QueueRec), Transmission Cmd)
+
+type ResponseAndMessage = (Transmission BrokerMsg, Maybe (Transmission BrokerMsg))
+
 data ServerSub = ServerSub (TVar SubscriptionThread) | ProhibitSub
 
 data SubscriptionThread = NoSub | SubPending | SubThread (Weak ThreadId)
 
 data Sub = Sub
   { subThread :: ServerSub, -- Nothing value indicates that sub
-    delivered :: TMVar MsgId
+    delivered :: TVar (Maybe (MsgId, RoundedSystemTime))
   }
 
 newServer :: IO (Server s)
@@ -455,6 +464,8 @@ newClient :: ClientId -> Natural -> THandleParams SMPVersion 'TServer -> SystemT
 newClient clientId qSize clientTHParams createdAt = do
   subscriptions <- TM.emptyIO
   ntfSubscriptions <- TM.emptyIO
+  serviceSubscribed <- newTVarIO False
+  ntfServiceSubscribed <- newTVarIO False
   serviceSubsCount <- newTVarIO 0
   ntfServiceSubsCount <- newTVarIO 0
   rcvQ <- newTBQueueIO qSize
@@ -471,6 +482,8 @@ newClient clientId qSize clientTHParams createdAt = do
       { clientId,
         subscriptions,
         ntfSubscriptions,
+        serviceSubscribed,
+        ntfServiceSubscribed,
         serviceSubsCount,
         ntfServiceSubsCount,
         rcvQ,
@@ -488,13 +501,13 @@ newClient clientId qSize clientTHParams createdAt = do
 
 newSubscription :: SubscriptionThread -> STM Sub
 newSubscription st = do
-  delivered <- newEmptyTMVar
+  delivered <- newTVar Nothing
   subThread <- ServerSub <$> newTVar st
   return Sub {subThread, delivered}
 
 newProhibitedSub :: STM Sub
 newProhibitedSub = do
-  delivered <- newEmptyTMVar
+  delivered <- newTVar Nothing
   return Sub {subThread = ProhibitSub, delivered}
 
 newEnv :: ServerConfig s -> IO (Env s)

src/Simplex/Messaging/Server/Main.hs

@@ -40,7 +40,7 @@ import Options.Applicative
 import Simplex.Messaging.Agent.Protocol (connReqUriP')
 import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
-import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
+import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SMPWebPortServers (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -420,6 +420,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               newQueueBasicAuth = either error id <$!> strDecodeIni "AUTH" "create_password" ini,
               controlPortAdminAuth = either error id <$!> strDecodeIni "AUTH" "control_port_admin_password" ini,
               controlPortUserAuth = either error id <$!> strDecodeIni "AUTH" "control_port_user_password" ini,
+              dailyBlockQueueQuota = readIniDefault 20 "AUTH" "daily_block_queue_quota" ini,
               messageExpiration =
                 Just
                   defaultMessageExpiration
@@ -464,7 +465,8 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                               { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini,
                                 socksMode = maybe SMOnion (either error id) $! strDecodeIni "PROXY" "socks_mode" ini,
                                 hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "PROXY" "host_mode" ini,
-                                requiredHostMode = fromMaybe False $ iniOnOff "PROXY" "required_host_mode" ini
+                                requiredHostMode = fromMaybe False $ iniOnOff "PROXY" "required_host_mode" ini,
+                                smpWebPortServers = SWPOff
                               }
                         },
                     ownServerDomains = either (const []) textToOwnServers $ lookupValue "PROXY" "own_server_domains" ini,

src/Simplex/Messaging/Server/Main/Init.hs

@@ -107,8 +107,11 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
         )
     <> "\n\n"
     <> (optDisabled controlPortPwds <> "control_port_admin_password: " <> maybe "" fst controlPortPwds <> "\n")
-    <> (optDisabled controlPortPwds <> "control_port_user_password: " <> maybe "" snd controlPortPwds <> "\n")
-    <> "\n\
+    <> (optDisabled controlPortPwds <> "control_port_user_password: " <> maybe "" snd controlPortPwds <> "\n\n")
+    <> "# The limit for queues that can be blocked via control port per day, resets at 0:00 UTC.\n\
+        \# Set to 0 to disable limit, to -1 to prohibit blocking. Default is 20.\n\
+        \# daily_block_queue_quota: 20\n\
+        \\n\
         \[TRANSPORT]\n\
         \# Host is only used to print server address on start.\n\
         \# You can specify multiple server ports.\n"

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

@@ -324,6 +324,8 @@ instance QueueStoreClass (JournalQueue s) (QStore s) where
   {-# INLINE addQueue_ #-}
   getQueue_ = withQS getQueue_
   {-# INLINE getQueue_ #-}
+  getQueues_ = withQS getQueues_
+  {-# INLINE getQueues_ #-}
   addQueueLinkData = withQS addQueueLinkData
   {-# INLINE addQueueLinkData #-}
   getQueueLinkData = withQS getQueueLinkData
@@ -354,8 +356,8 @@ instance QueueStoreClass (JournalQueue s) (QStore s) where
   {-# INLINE setQueueService #-}
   getQueueNtfServices = withQS (getQueueNtfServices @(JournalQueue s))
   {-# INLINE getQueueNtfServices #-}
-  getNtfServiceQueueCount = withQS (getNtfServiceQueueCount @(JournalQueue s))
-  {-# INLINE getNtfServiceQueueCount #-}
+  getServiceQueueCount = withQS (getServiceQueueCount @(JournalQueue s))
+  {-# INLINE getServiceQueueCount #-}
 
 makeQueue_ :: JournalMsgStore s -> RecipientId -> QueueRec -> Lock -> IO (JournalQueue s)
 makeQueue_ JournalMsgStore {sharedLock} rId qr queueLock = do

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

@@ -18,6 +18,7 @@
 module Simplex.Messaging.Server.MsgStore.Types where
 
 import Control.Concurrent.STM
+import Control.Monad
 import Control.Monad.Trans.Except
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -107,14 +108,23 @@ addQueue :: MsgStoreClass s => s -> RecipientId -> QueueRec -> IO (Either ErrorT
 addQueue st = addQueue_ (queueStore st) (mkQueue st True)
 {-# INLINE addQueue #-}
 
-getQueue :: (MsgStoreClass s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
+getQueue :: (MsgStoreClass s, QueueParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
 getQueue st = getQueue_ (queueStore st) (mkQueue st)
 {-# INLINE getQueue #-}
 
-getQueueRec :: (MsgStoreClass s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s, QueueRec))
-getQueueRec st party qId =
-  getQueue st party qId
-    $>>= (\q -> maybe (Left AUTH) (Right . (q,)) <$> readTVarIO (queueRec q))
+getQueueRec :: (MsgStoreClass s, QueueParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s, QueueRec))
+getQueueRec st party qId = getQueue st party qId $>>= readQueueRec
+
+getQueues :: (MsgStoreClass s, BatchParty p) => s -> SParty p -> [QueueId] -> IO [Either ErrorType (StoreQueue s)]
+getQueues st = getQueues_ (queueStore st) (mkQueue st)
+{-# INLINE getQueues #-}
+
+getQueueRecs :: (MsgStoreClass s, BatchParty p) => s -> SParty p -> [QueueId] -> IO [Either ErrorType (StoreQueue s, QueueRec)]
+getQueueRecs st party qIds = getQueues st party qIds >>= mapM (fmap join . mapM readQueueRec)
+
+readQueueRec :: StoreQueueClass q => q -> IO (Either ErrorType (q, QueueRec))
+readQueueRec q = maybe (Left AUTH) (Right . (q,)) <$> readTVarIO (queueRec q)
+{-# INLINE readQueueRec #-}
 
 getQueueSize :: MsgStoreClass s => s -> StoreQueue s -> ExceptT ErrorType IO Int
 getQueueSize st q = withPeekMsgQueue st q "getQueueSize" $ maybe (pure 0) (getQueueSize_ . fst)

src/Simplex/Messaging/Server/Prometheus.hs

@@ -6,6 +6,8 @@
 module Simplex.Messaging.Server.Prometheus where
 
 import Data.Int (Int64)
+import qualified Data.IntMap.Strict as IM
+import Data.List (mapAccumL)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffUTCTime)
@@ -34,6 +36,8 @@ data RealTimeMetrics = RealTimeMetrics
   { socketStats :: [(ServiceName, SocketStats)],
     threadsCount :: Int,
     clientsCount :: Int,
+    deliveredSubs :: RTSubscriberMetrics,
+    deliveredTimes :: TimeBuckets,
     smpSubs :: RTSubscriberMetrics,
     ntfSubs :: RTSubscriberMetrics,
     loadedCounts :: LoadedQueueCounts
@@ -55,6 +59,8 @@ prometheusMetrics sm rtm ts =
       { socketStats,
         threadsCount,
         clientsCount,
+        deliveredSubs,
+        deliveredTimes,
         smpSubs,
         ntfSubs,
         loadedCounts
@@ -76,6 +82,7 @@ prometheusMetrics sm rtm ts =
         _qSubEnd,
         _qSubEndB,
         _ntfCreated,
+        _ntfNewCreated,
         _ntfDeleted,
         _ntfDeletedB,
         _ntfSub,
@@ -88,6 +95,7 @@ prometheusMetrics sm rtm ts =
         _msgSentLarge,
         _msgSentBlock,
         _msgRecv,
+        _msgRecvAckTimes,
         _msgRecvGet,
         _msgGet,
         _msgGetNoMsg,
@@ -255,15 +263,19 @@ prometheusMetrics sm rtm ts =
       \simplex_smp_messages_notify_get_errors{type=\"duplicate\"} " <> mshow _msgGetDuplicate <> "\n# msgGetDuplicate\n\
       \simplex_smp_messages_notify_get_errors{type=\"prohibited\"} " <> mshow _msgGetProhibited <> "\n# msgGetProhibited\n\
       \\n\
-      \# HELP simplex_smp_queues_notify_created Created queues with notification flag (client).\n\
+      \# HELP simplex_smp_queues_notify_created Created queue notification credentials.\n\
       \# TYPE simplex_smp_queues_notify_created counter\n\
       \simplex_smp_queues_notify_created " <> mshow _ntfCreated <> "\n# ntfCreated\n\
       \\n\
-      \# HELP simplex_smp_queues_notify_deleted Deleted queues with notification flag (client).\n\
+      \# HELP simplex_smp_queues_notify_new_created Created new queues with notification credentials.\n\
+      \# TYPE simplex_smp_queues_notify_new_created counter\n\
+      \simplex_smp_queues_notify_new_created " <> mshow _ntfNewCreated <> "\n# ntfNewCreated\n\
+      \\n\
+      \# HELP simplex_smp_queues_notify_deleted Deleted queue notification credentials.\n\
       \# TYPE simplex_smp_queues_notify_deleted counter\n\
       \simplex_smp_queues_notify_deleted " <> mshow _ntfDeleted <> "\n# ntfDeleted\n\
       \\n\
-      \# HELP simplex_smp_queues_notify_deleted_batch Deleted batched queues with notification flag (client).\n\
+      \# HELP simplex_smp_queues_notify_deleted_batch Deleted batched queue notification credentials.\n\
       \# TYPE simplex_smp_queues_notify_deleted_batch counter\n\
       \simplex_smp_queues_notify_deleted_batch " <> mshow _ntfDeletedB <> "\n# ntfDeletedB\n\
       \\n\
@@ -426,6 +438,33 @@ prometheusMetrics sm rtm ts =
       \# TYPE simplex_smp_clients_total gauge\n\
       \simplex_smp_clients_total " <> mshow clientsCount <> "\n\
       \\n\
+      \# HELP simplex_smp_delivered_total Total SMP subscriptions with delivered messages\n\
+      \# TYPE simplex_smp_delivered_total gauge\n\
+      \simplex_smp_delivered_total " <> mshow (subsCount deliveredSubs) <> "\n# delivered.subsCount\n\
+      \\n\
+      \# HELP simplex_smp_delivered_clients_total Subscribed clients\n\
+      \# TYPE simplex_smp_delivered_clients_total gauge\n\
+      \simplex_smp_delivered_clients_total " <> mshow (subClientsCount deliveredSubs) <> "\n# delivered.subClientsCount\n\
+      \\n\
+      \# HELP simplex_smp_delivery_ack_confirmed_time Times to confirm message delivery, only confirmed deliveries\n\
+      \# TYPE simplex_smp_delivery_ack_confirmed_time histogram\n\
+      \simplex_smp_delivery_ack_confirmed_time_sum " <> mshow (sumTime _msgRecvAckTimes) <> "\n\
+      \simplex_smp_delivery_ack_confirmed_time_count " <> mshow (_msgRecv + _msgRecvGet) <> "\n"
+      <> showTimeBuckets "simplex_smp_delivery_ack_confirmed_time" (timeBuckets _msgRecvAckTimes)
+      <> showTimeBucket "simplex_smp_delivery_ack_confirmed_time" "+Inf" (_msgRecv + _msgRecvGet)
+      <> "\n\
+      \# HELP simplex_smp_delivery_ack_confirmed_count Counts for confirmed deliveries\n\
+      \# TYPE simplex_smp_delivery_ack_confirmed_count counter\n"
+      <> showBucketSums "simplex_smp_delivery_ack_confirmed_count" (timeBuckets _msgRecvAckTimes)
+      <> "\n\
+      \# HELP simplex_smp_delivery_ack_pending_count Counts for pending delivery\n\
+      \# TYPE simplex_smp_delivery_ack_pending_count gauge\n"
+      <> showBucketSums "simplex_smp_delivery_ack_pending_count" (timeBuckets deliveredTimes)
+      <> "\n\
+      \# HELP simplex_smp_delivery_ack_time_max Max time to confirm message delivery\n\
+      \# TYPE simplex_smp_delivery_ack_time_max gauge\n\
+      \simplex_smp_delivery_ack_time_max " <> mshow (maxTime deliveredTimes) <> "\n# delivered.maxTime\n\
+      \\n\
       \# HELP simplex_smp_subscribtion_total Total SMP subscriptions\n\
       \# TYPE simplex_smp_subscribtion_total gauge\n\
       \simplex_smp_subscribtion_total " <> mshow (subsCount smpSubs) <> "\n# smp.subsCount\n\
@@ -470,15 +509,32 @@ prometheusMetrics sm rtm ts =
       \# TYPE simplex_smp_loaded_queues_ntf_lock_count gauge\n\
       \simplex_smp_loaded_queues_ntf_lock_count " <> mshow (notifierLockCount loadedCounts) <> "\n# loadedCounts.notifierLockCount\n"
 
+    showTimeBuckets :: Text -> IM.IntMap Int -> Text
+    showTimeBuckets metric = T.concat . snd . mapAccumL accumBucket (0, 0) . IM.assocs
+      where
+        accumBucket (prevSec, total) (sec, cnt) =
+          let t
+                | sec - 60 > prevSec = showTimeBucket metric (tshow (sec - 60)) total
+                | otherwise = ""
+           in ((sec, total + cnt), t <> showTimeBucket metric (tshow sec) (total + cnt))
+    showTimeBucket :: Text -> Text -> Int -> Text
+    showTimeBucket metric sec count = metric <> "_bucket{le=\"" <> sec <> "\"} " <> mshow count <> "\n"
+    showBucketSums :: Text -> IM.IntMap Int -> Text
+    showBucketSums metric buckets = T.concat $ map showBucketSum [(0, 60), (60, 300), (300, 1200), (1200, 3600), (3600, maxBound)]
+      where
+        showBucketSum (minTime, maxTime) =
+          metric <> "{period=\"" <> tshow minTime <> (if maxTime <= 3600 then "-" <> tshow maxTime else "+") <> "\"} " <> mshow bucketsSum <> "\n"
+          where
+            bucketsSum = IM.foldl' (+) 0 $ IM.filter (\sec -> minTime <= sec && sec < maxTime) buckets
     socketsMetric :: (SocketStats -> Int) -> Text -> Text -> Text
     socketsMetric sel metric descr =
       "# HELP " <> metric <> " " <> descr <> "\n"
         <> "# TYPE " <> metric <> " gauge\n"
         <> T.concat (map (\(port, ss) -> metric <> "{port=\"" <> T.pack port <> "\"} " <> mshow (sel ss) <> "\n") socketStats)
         <> "\n"
-    mstr a = a <> " " <> tsEpoch
+    mstr a = a <> " " <> tsEpoch ts
     mshow :: Show a => a -> Text
     mshow = mstr . tshow
-    tsEpoch = tshow @Int64 $ floor @Double $ realToFrac (ts `diffUTCTime` epoch) * 1000
+    tsEpoch t = tshow @Int64 $ floor @Double $ realToFrac (t `diffUTCTime` epoch) * 1000
     epoch = UTCTime systemEpochDay 0
 {-# FOURMOLU_ENABLE\n#-}

src/Simplex/Messaging/Server/QueueStore.hs

@@ -127,3 +127,6 @@ getRoundedSystemTime prec = (\t -> RoundedSystemTime $ (systemSeconds t `div` pr
 
 getSystemDate :: IO RoundedSystemTime
 getSystemDate = getRoundedSystemTime 86400
+
+getSystemSeconds :: IO RoundedSystemTime
+getSystemSeconds = RoundedSystemTime . systemSeconds <$> getSystemTime

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

@@ -37,12 +37,13 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
+import Data.Bifunctor (first)
 import Data.ByteString.Builder (Builder)
 import qualified Data.ByteString.Builder as BB
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy as LB
 import Data.Bitraversable (bimapM)
-import Data.Either (fromRight)
+import Data.Either (fromRight, lefts)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (foldl', intersperse, partition)
@@ -51,6 +52,7 @@ import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe)
 import qualified Data.Set as S
 import Data.Text (Text)
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
@@ -67,7 +69,7 @@ import Simplex.Messaging.Agent.Lock (Lock)
 import Simplex.Messaging.Agent.Store.AgentStore ()
 import Simplex.Messaging.Agent.Store.Postgres (createDBStore, closeDBStore)
 import Simplex.Messaging.Agent.Store.Postgres.Common
-import Simplex.Messaging.Agent.Store.Postgres.DB (blobFieldDecoder)
+import Simplex.Messaging.Agent.Store.Postgres.DB (blobFieldDecoder, fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (parseAll)
@@ -87,8 +89,6 @@ import System.IO (IOMode (..), hFlush, stdout)
 import UnliftIO.STM
 
 #if !defined(dbPostgres)
-import Data.Text.Encoding (decodeLatin1, encodeUtf8)
-import Simplex.Messaging.Agent.Store.Postgres.DB (fromTextField_)
 import Simplex.Messaging.Encoding.String
 #endif
 
@@ -180,18 +180,16 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
       -- hasId = anyM [TM.memberIO rId queues, TM.memberIO senderId senders, hasNotifier]
       -- hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.memberIO notifierId notifiers) notifier
 
-  getQueue_ :: DirectParty p => PostgresQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueue_ :: QueueParty p => PostgresQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
   getQueue_ st mkQ party qId = case party of
     SRecipient -> getRcvQueue qId
-    SSender -> getSndQueue
-    SProxyService -> getSndQueue
+    SSender -> TM.lookupIO qId senders >>= maybe (mask loadSndQueue) getRcvQueue
     SSenderLink -> TM.lookupIO qId links >>= maybe (mask loadLinkQueue) getRcvQueue
     -- loaded queue is deleted from notifiers map to reduce cache size after queue was subscribed to by ntf server
     SNotifier -> TM.lookupIO qId notifiers >>= maybe (mask loadNtfQueue) (getRcvQueue >=> (atomically (TM.delete qId notifiers) $>))
     where
       PostgresQueueStore {queues, senders, links, notifiers} = st
       getRcvQueue rId = TM.lookupIO rId queues >>= maybe (mask loadRcvQueue) (pure . Right)
-      getSndQueue = TM.lookupIO qId senders >>= maybe (mask loadSndQueue) getRcvQueue
       loadRcvQueue = do
         (rId, qRec) <- loadQueue " WHERE recipient_id = ?"
         liftIO $ cacheQueue rId qRec $ \_ -> pure () -- recipient map already checked, not caching sender ref
@@ -210,7 +208,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
       mask = E.uninterruptibleMask_ . runExceptT
       cacheSender rId = TM.insert qId rId senders
       loadQueue condition =
-        withFastDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
+        withDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
           DB.query db (queueRecQuery <> condition <> " AND deleted_at IS NULL") (Only qId)
       cacheQueue rId qRec insertRef = do
         sq <- mkQ True rId qRec -- loaded queue
@@ -228,6 +226,47 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
               TM.insert rId sq queues
               pure sq
 
+  getQueues_ :: forall p. BatchParty p => PostgresQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueues_ st mkQ party qIds = case party of
+    SRecipient -> do
+      qs <- readTVarIO queues
+      let qs' = map (\qId -> get qs qId qId) qIds
+      E.uninterruptibleMask_ $ loadQueues qs' " WHERE recipient_id IN ?" cacheRcvQueue
+    SNotifier -> do
+      ns <- readTVarIO notifiers
+      qs <- readTVarIO queues
+      let qs' = map (\qId -> get ns qId qId >>= get qs qId) qIds
+      E.uninterruptibleMask_ $ loadQueues qs' " WHERE notifier_id IN ?" $ \(rId, qRec) ->
+        forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> -- it is always Just with this query
+          (nId,) <$> maybe (mkQ False rId qRec) pure (M.lookup rId qs)
+    where
+      PostgresQueueStore {queues, notifiers} = st
+      get :: M.Map QueueId a -> QueueId -> QueueId -> Either QueueId a
+      get m qId = maybe (Left qId) Right . (`M.lookup` m)
+      loadQueues :: [Either QueueId q] -> Query -> ((RecipientId, QueueRec) -> IO (Maybe (QueueId, q))) -> IO [Either ErrorType q]
+      loadQueues qs' cond mkCacheQueue = do
+        let qIds' = lefts qs'
+        if null qIds'
+          then pure $ map (first (const INTERNAL)) qs'
+          else do
+            qs_ <-
+              runExceptT $ fmap M.fromList $
+                withDB' "getQueues_" st (\db -> DB.query db (queueRecQuery <> cond <> " AND deleted_at IS NULL") (Only (In qIds')))
+                  >>= liftIO . fmap catMaybes . mapM (mkCacheQueue . rowToQueueRec)
+            pure $ map (result qs_) qs'
+        where
+          result :: Either ErrorType (M.Map QueueId q) -> Either QueueId q -> Either ErrorType q
+          result _ (Right q) = Right q
+          result qs_ (Left qId) = maybe (Left AUTH) Right . M.lookup qId =<< qs_
+      cacheRcvQueue (rId, qRec) = do
+        sq <- mkQ True rId qRec
+        sq' <- withQueueLock sq "getQueue_" $ atomically $
+          -- checking the cache again for concurrent reads, use previously loaded queue if exists.
+          TM.lookup rId queues >>= \case
+            Just sq' -> pure sq'
+            Nothing -> sq <$ TM.insert rId sq queues
+        pure $ Just (rId, sq')
+
   getQueueLinkData :: PostgresQueueStore q -> q -> LinkId -> IO (Either ErrorType QueueLinkData)
   getQueueLinkData st sq lnkId = runExceptT $ do
     qr <- ExceptT $ readQueueRecIO $ queueRec sq
@@ -311,7 +350,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
           db
           [sql|
             UPDATE msg_queues
-            SET notifier_id = ?, notifier_key = ?, rcv_ntf_dh_secret = ?
+            SET notifier_id = ?, notifier_key = ?, rcv_ntf_dh_secret = ?, ntf_service_id = NULL
             WHERE recipient_id = ? AND deleted_at IS NULL
           |]
           (nId, notifierKey, rcvNtfDhSecret, rId)
@@ -333,7 +372,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
           db
           [sql|
             UPDATE msg_queues
-            SET notifier_id = NULL, notifier_key = NULL, rcv_ntf_dh_secret = NULL
+            SET notifier_id = NULL, notifier_key = NULL, rcv_ntf_dh_secret = NULL, ntf_service_id = NULL
             WHERE recipient_id = ? AND deleted_at IS NULL
           |]
           (Only rId)
@@ -391,7 +430,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
   getCreateService st sr@ServiceRec {serviceId = newSrvId, serviceRole, serviceCertHash = XV.Fingerprint fp} =
     withLockMap (serviceLocks st) fp "getCreateService" $ E.uninterruptibleMask_ $ runExceptT $ do
       (serviceId, new) <-
-        withFastDB "getCreateService" st $ \db ->
+        withDB "getCreateService" st $ \db ->
           maybeFirstRow id (DB.query db "SELECT service_id, service_role FROM services WHERE service_cert_hash = ?" (Only (Binary fp))) >>= \case
             Just (serviceId, role)
               | role == serviceRole -> pure $ Right (serviceId, False)
@@ -402,15 +441,15 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
       when new $ withLog "getCreateService" st (`logNewService` sr)
       pure serviceId
 
-  setQueueService :: (PartyI p, SubscriberParty p) => PostgresQueueStore q -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
+  setQueueService :: (PartyI p, ServiceParty p) => PostgresQueueStore q -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
   setQueueService st sq party serviceId = withQueueRec sq "setQueueService" $ \q -> case party of
-    SRecipient
+    SRecipientService
       | rcvServiceId q == serviceId -> pure ()
       | otherwise -> do
           assertUpdated $ withDB' "setQueueService" st $ \db ->
             DB.execute db "UPDATE msg_queues SET rcv_service_id = ? WHERE recipient_id = ? AND deleted_at IS NULL" (serviceId, rId)
           updateQueueRec q {rcvServiceId = serviceId}
-    SNotifier -> case notifier q of
+    SNotifierService -> case notifier q of
       Nothing -> throwE AUTH
       Just nc@NtfCreds {ntfServiceId = prevSrvId}
         | prevSrvId == serviceId -> pure ()
@@ -445,11 +484,15 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
         let (sNtfs, restNtfs) = partition (\(nId, _) -> S.member nId snIds) ntfs'
          in ((serviceId, sNtfs) : ssNtfs, restNtfs)
 
-  getNtfServiceQueueCount :: PostgresQueueStore q -> ServiceId -> IO (Either ErrorType Int64)
-  getNtfServiceQueueCount st serviceId =
-    E.uninterruptibleMask_ $ runExceptT $ withDB' "getNtfServiceQueueCount" st $ \db ->
+  getServiceQueueCount :: (PartyI p, ServiceParty p) => PostgresQueueStore q -> SParty p -> ServiceId -> IO (Either ErrorType Int64)
+  getServiceQueueCount st party serviceId =
+    E.uninterruptibleMask_ $ runExceptT $ withDB' "getServiceQueueCount" st $ \db ->
       fmap (fromMaybe 0) $ maybeFirstRow fromOnly $
-        DB.query db "SELECT count(1) FROM msg_queues WHERE ntf_service_id = ? AND deleted_at IS NULL" (Only serviceId)
+        DB.query db query (Only serviceId)
+    where
+      query = case party of
+        SRecipientService -> "SELECT count(1) FROM msg_queues WHERE rcv_service_id = ? AND deleted_at IS NULL"
+        SNotifierService -> "SELECT count(1) FROM msg_queues WHERE ntf_service_id = ? AND deleted_at IS NULL"
 
 batchInsertServices :: [STMService] -> PostgresQueueStore q -> IO Int64
 batchInsertServices services' toStore =
@@ -640,19 +683,10 @@ assertUpdated = (>>= \n -> when (n == 0) (throwE AUTH))
 
 withDB' :: Text -> PostgresQueueStore q -> (DB.Connection -> IO a) -> ExceptT ErrorType IO a
 withDB' op st action = withDB op st $ fmap Right . action
-{-# INLINE withDB' #-}
-
-withFastDB :: forall a q. Text -> PostgresQueueStore q -> (DB.Connection -> IO (Either ErrorType a)) -> ExceptT ErrorType IO a
-withFastDB op st = withDB_ op st True
-{-# INLINE withFastDB #-}
 
 withDB :: forall a q. Text -> PostgresQueueStore q -> (DB.Connection -> IO (Either ErrorType a)) -> ExceptT ErrorType IO a
-withDB op st = withDB_ op st False
-{-# INLINE withDB #-}
-
-withDB_ :: forall a q. Text -> PostgresQueueStore q -> Bool -> (DB.Connection -> IO (Either ErrorType a)) -> ExceptT ErrorType IO a
-withDB_ op st priority action =
-  ExceptT $ E.try (withTransactionPriority (dbStore st) priority action) >>= either logErr pure
+withDB op st action =
+  ExceptT $ E.try (withConnection (dbStore st) action) >>= either logErr pure
   where
     logErr :: E.SomeException -> IO (Either ErrorType a)
     logErr e = logError ("STORE: " <> err) $> Left (STORE err)

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

@@ -128,17 +128,29 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
       hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.member notifierId notifiers) notifier
       hasLink = maybe (pure False) (\(lnkId, _) -> TM.member lnkId links) queueData
 
-  getQueue_ :: DirectParty p => STMQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueue_ :: QueueParty p => STMQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
   getQueue_ st _ party qId =
     maybe (Left AUTH) Right <$> case party of
       SRecipient -> TM.lookupIO qId queues
-      SSender -> getSndQueue
-      SProxyService -> getSndQueue
+      SSender -> TM.lookupIO qId senders $>>= (`TM.lookupIO` queues)
       SNotifier -> TM.lookupIO qId notifiers $>>= (`TM.lookupIO` queues)
       SSenderLink -> TM.lookupIO qId links $>>= (`TM.lookupIO` queues)
     where
       STMQueueStore {queues, senders, notifiers, links} = st
-      getSndQueue = TM.lookupIO qId senders $>>= (`TM.lookupIO` queues)
+
+  getQueues_ :: BatchParty p => STMQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueues_ st _ party qIds = case party of
+    SRecipient -> do
+      qs <- readTVarIO queues
+      pure $ map (get qs) qIds
+    SNotifier -> do
+      ns <- readTVarIO notifiers
+      qs <- readTVarIO queues
+      pure $ map (get qs <=< get ns) qIds
+    where
+      STMQueueStore {queues, notifiers} = st
+      get :: M.Map QueueId a -> QueueId -> Either ErrorType a
+      get m = maybe (Left AUTH) Right . (`M.lookup` m)
 
   getQueueLinkData :: STMQueueStore q -> q -> LinkId -> IO (Either ErrorType QueueLinkData)
   getQueueLinkData _ q lnkId = atomically $ readQueueRec (queueRec q) $>>= pure . getData
@@ -292,7 +304,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
         serviceNtfQueues <- newTVar S.empty
         pure STMService {serviceRec = sr, serviceRcvQueues, serviceNtfQueues}
 
-  setQueueService :: (PartyI p, SubscriberParty p) => STMQueueStore q -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
+  setQueueService :: (PartyI p, ServiceParty p) => STMQueueStore q -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
   setQueueService st sq party serviceId =
     atomically (readQueueRec qr $>>= setService)
       $>> withLog "setQueueService" st (\sl -> logQueueService sl rId party serviceId)
@@ -301,13 +313,13 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
       rId = recipientId sq
       setService :: QueueRec -> STM (Either ErrorType ())
       setService q@QueueRec {rcvServiceId = prevSrvId} = case party of
-        SRecipient
+        SRecipientService
           | prevSrvId == serviceId -> pure $ Right ()
           | otherwise -> do
               updateServiceQueues serviceRcvQueues rId prevSrvId
               let !q' = Just q {rcvServiceId = serviceId}
               writeTVar qr q' $> Right ()
-        SNotifier -> case notifier q of
+        SNotifierService -> case notifier q of
           Nothing -> pure $ Left AUTH
           Just nc@NtfCreds {notifierId = nId, ntfServiceId = prevNtfSrvId}
             | prevNtfSrvId == serviceId -> pure $ Right ()
@@ -334,10 +346,15 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
         let (sNtfs, restNtfs) = partition (\(nId, _) -> S.member nId snIds) ntfs'
         pure ((Just serviceId, sNtfs) : ssNtfs, restNtfs)
 
-  getNtfServiceQueueCount :: STMQueueStore q -> ServiceId -> IO (Either ErrorType Int64)
-  getNtfServiceQueueCount st serviceId =
+  getServiceQueueCount :: (PartyI p, ServiceParty p) => STMQueueStore q -> SParty p -> ServiceId -> IO (Either ErrorType Int64)
+  getServiceQueueCount st party serviceId =
     TM.lookupIO serviceId (services st) >>=
-      maybe (pure $ Left AUTH) (fmap (Right . fromIntegral . S.size) . readTVarIO . serviceNtfQueues)
+      maybe (pure $ Left AUTH) (fmap (Right . fromIntegral . S.size) . readTVarIO . serviceSel)
+    where
+      serviceSel :: STMService -> TVar (Set QueueId)
+      serviceSel = case party of
+        SRecipientService -> serviceRcvQueues
+        SNotifierService -> serviceNtfQueues
 
 withQueueRec :: TVar (Maybe QueueRec) -> (QueueRec -> STM a) -> IO (Either ErrorType a)
 withQueueRec qr a = atomically $ readQueueRec qr >>= mapM a

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

@@ -31,7 +31,8 @@ class StoreQueueClass q => QueueStoreClass q s where
   loadedQueues :: s -> TMap RecipientId q
   compactQueues :: s -> IO Int64
   addQueue_ :: s -> (RecipientId -> QueueRec -> IO q) -> RecipientId -> QueueRec -> IO (Either ErrorType q)
-  getQueue_ :: DirectParty p => s -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueue_ :: QueueParty p => s -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueues_ :: BatchParty p => s -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
   getQueueLinkData :: s -> q -> LinkId -> IO (Either ErrorType QueueLinkData)
   addQueueLinkData :: s -> q -> LinkId -> QueueLinkData -> IO (Either ErrorType ())
   deleteQueueLinkData :: s -> q -> IO (Either ErrorType ())
@@ -45,9 +46,9 @@ class StoreQueueClass q => QueueStoreClass q s where
   updateQueueTime :: s -> q -> RoundedSystemTime -> IO (Either ErrorType QueueRec)
   deleteStoreQueue :: s -> q -> IO (Either ErrorType (QueueRec, Maybe (MsgQueue q)))
   getCreateService :: s -> ServiceRec -> IO (Either ErrorType ServiceId)
-  setQueueService :: (PartyI p, SubscriberParty p) => s -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
+  setQueueService :: (PartyI p, ServiceParty p) => s -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
   getQueueNtfServices :: s -> [(NotifierId, a)] -> IO (Either ErrorType ([(Maybe ServiceId, [(NotifierId, a)])], [(NotifierId, a)]))
-  getNtfServiceQueueCount :: s -> ServiceId -> IO (Either ErrorType Int64)
+  getServiceQueueCount :: (PartyI p, ServiceParty p) => s -> SParty p -> ServiceId -> IO (Either ErrorType Int64)
 
 data EntityCounts = EntityCounts
   { queueCount :: Int,

src/Simplex/Messaging/Server/Stats.hs

@@ -14,6 +14,8 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Hashable (hash)
 import Data.IORef
+import Data.Int (Int64)
+import qualified Data.IntMap.Strict as IM
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as IS
 import Data.Set (Set)
@@ -25,6 +27,7 @@ import Data.Time.Clock (UTCTime (..))
 import GHC.IORef (atomicSwapIORef)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (EntityId (..))
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime (..))
 import Simplex.Messaging.Util (atomicModifyIORef'_, tshow, unlessM)
 
 data ServerStats = ServerStats
@@ -45,6 +48,7 @@ data ServerStats = ServerStats
     qSubEnd :: IORef Int,
     qSubEndB :: IORef Int,
     ntfCreated :: IORef Int,
+    ntfNewCreated :: IORef Int, -- credentials created at the time of queue creation
     ntfDeleted :: IORef Int,
     ntfDeletedB :: IORef Int,
     ntfSub :: IORef Int,
@@ -57,6 +61,7 @@ data ServerStats = ServerStats
     msgSentLarge :: IORef Int,
     msgSentBlock :: IORef Int,
     msgRecv :: IORef Int,
+    msgRecvAckTimes :: IORef TimeBuckets,
     msgRecvGet :: IORef Int,
     msgGet :: IORef Int,
     msgGetNoMsg :: IORef Int,
@@ -103,6 +108,7 @@ data ServerStatsData = ServerStatsData
     _qSubEnd :: Int,
     _qSubEndB :: Int,
     _ntfCreated :: Int,
+    _ntfNewCreated :: Int,
     _ntfDeleted :: Int,
     _ntfDeletedB :: Int,
     _ntfSub :: Int,
@@ -115,6 +121,7 @@ data ServerStatsData = ServerStatsData
     _msgSentLarge :: Int,
     _msgSentBlock :: Int,
     _msgRecv :: Int,
+    _msgRecvAckTimes :: TimeBuckets,
     _msgRecvGet :: Int,
     _msgGet :: Int,
     _msgGetNoMsg :: Int,
@@ -162,6 +169,7 @@ newServerStats ts = do
   qSubEnd <- newIORef 0
   qSubEndB <- newIORef 0
   ntfCreated <- newIORef 0
+  ntfNewCreated <- newIORef 0
   ntfDeleted <- newIORef 0
   ntfDeletedB <- newIORef 0
   ntfSub <- newIORef 0
@@ -174,6 +182,7 @@ newServerStats ts = do
   msgSentLarge <- newIORef 0
   msgSentBlock <- newIORef 0
   msgRecv <- newIORef 0
+  msgRecvAckTimes <- newIORef $ TimeBuckets 0 0 IM.empty
   msgRecvGet <- newIORef 0
   msgGet <- newIORef 0
   msgGetNoMsg <- newIORef 0
@@ -218,6 +227,7 @@ newServerStats ts = do
         qSubEnd,
         qSubEndB,
         ntfCreated,
+        ntfNewCreated,
         ntfDeleted,
         ntfDeletedB,
         ntfSub,
@@ -230,6 +240,7 @@ newServerStats ts = do
         msgSentLarge,
         msgSentBlock,
         msgRecv,
+        msgRecvAckTimes,
         msgRecvGet,
         msgGet,
         msgGetNoMsg,
@@ -276,6 +287,7 @@ getServerStatsData s = do
   _qSubEnd <- readIORef $ qSubEnd s
   _qSubEndB <- readIORef $ qSubEndB s
   _ntfCreated <- readIORef $ ntfCreated s
+  _ntfNewCreated <- readIORef $ ntfNewCreated s
   _ntfDeleted <- readIORef $ ntfDeleted s
   _ntfDeletedB <- readIORef $ ntfDeletedB s
   _ntfSub <- readIORef $ ntfSub s
@@ -288,6 +300,7 @@ getServerStatsData s = do
   _msgSentLarge <- readIORef $ msgSentLarge s
   _msgSentBlock <- readIORef $ msgSentBlock s
   _msgRecv <- readIORef $ msgRecv s
+  _msgRecvAckTimes <- readIORef $ msgRecvAckTimes s
   _msgRecvGet <- readIORef $ msgRecvGet s
   _msgGet <- readIORef $ msgGet s
   _msgGetNoMsg <- readIORef $ msgGetNoMsg s
@@ -332,6 +345,7 @@ getServerStatsData s = do
         _qSubEnd,
         _qSubEndB,
         _ntfCreated,
+        _ntfNewCreated,
         _ntfDeleted,
         _ntfDeletedB,
         _ntfSub,
@@ -344,6 +358,7 @@ getServerStatsData s = do
         _msgSentLarge,
         _msgSentBlock,
         _msgRecv,
+        _msgRecvAckTimes,
         _msgRecvGet,
         _msgGet,
         _msgGetNoMsg,
@@ -391,6 +406,7 @@ setServerStats s d = do
   writeIORef (qSubEnd s) $! _qSubEnd d
   writeIORef (qSubEndB s) $! _qSubEndB d
   writeIORef (ntfCreated s) $! _ntfCreated d
+  writeIORef (ntfNewCreated s) $! _ntfNewCreated d
   writeIORef (ntfDeleted s) $! _ntfDeleted d
   writeIORef (ntfDeletedB s) $! _ntfDeletedB d
   writeIORef (ntfSub s) $! _ntfSub d
@@ -403,6 +419,7 @@ setServerStats s d = do
   writeIORef (msgSentLarge s) $! _msgSentLarge d
   writeIORef (msgSentBlock s) $! _msgSentBlock d
   writeIORef (msgRecv s) $! _msgRecv d
+  writeIORef (msgRecvAckTimes s) $! _msgRecvAckTimes d
   writeIORef (msgRecvGet s) $! _msgRecvGet d
   writeIORef (msgGet s) $! _msgGet d
   writeIORef (msgGetNoMsg s) $! _msgGetNoMsg d
@@ -450,6 +467,7 @@ instance StrEncoding ServerStatsData where
         "qSubEnd=" <> strEncode (_qSubEnd d),
         "qSubEndB=" <> strEncode (_qSubEndB d),
         "ntfCreated=" <> strEncode (_ntfCreated d),
+        "ntfNewCreated=" <> strEncode (_ntfNewCreated d),
         "ntfDeleted=" <> strEncode (_ntfDeleted d),
         "ntfDeletedB=" <> strEncode (_ntfDeletedB d),
         "ntfSub=" <> strEncode (_ntfSub d),
@@ -513,6 +531,7 @@ instance StrEncoding ServerStatsData where
     _qSubEnd <- opt "qSubEnd="
     _qSubEndB <- opt "qSubEndB="
     _ntfCreated <- opt "ntfCreated="
+    _ntfNewCreated <- opt "ntfNewCreated="
     _ntfDeleted <- opt "ntfDeleted="
     _ntfDeletedB <- opt "ntfDeletedB="
     _ntfSub <- opt "ntfSub="
@@ -580,6 +599,7 @@ instance StrEncoding ServerStatsData where
           _qSubEnd,
           _qSubEndB,
           _ntfCreated,
+          _ntfNewCreated,
           _ntfDeleted,
           _ntfDeletedB,
           _ntfSub,
@@ -592,6 +612,7 @@ instance StrEncoding ServerStatsData where
           _msgSentLarge,
           _msgSentBlock,
           _msgRecv,
+          _msgRecvAckTimes = emptyTimeBuckets,
           _msgRecvGet,
           _msgGet,
           _msgGetNoMsg,
@@ -944,3 +965,33 @@ instance StrEncoding ServiceStatsData where
           _srvSubQueues,
           _srvSubEnd
         }
+
+data TimeBuckets = TimeBuckets
+  { sumTime :: Int64,
+    maxTime :: Int64,
+    timeBuckets :: IM.IntMap Int
+  }
+  deriving (Show)
+
+emptyTimeBuckets :: TimeBuckets
+emptyTimeBuckets = TimeBuckets 0 0 IM.empty
+
+updateTimeBuckets :: RoundedSystemTime -> RoundedSystemTime -> TimeBuckets -> TimeBuckets
+updateTimeBuckets
+  (RoundedSystemTime deliveryTime)
+  (RoundedSystemTime currTime)
+  TimeBuckets {sumTime, maxTime, timeBuckets} =
+    TimeBuckets
+      { sumTime = sumTime + t,
+        maxTime = max maxTime t,
+        timeBuckets = IM.alter (Just . maybe 1 (+ 1)) seconds timeBuckets
+      }
+  where
+    t = currTime - deliveryTime
+    seconds
+      | t <= 5 = fromIntegral t
+      | t <= 30 = t `toBucket` 5
+      | t <= 60 = t `toBucket` 10
+      | t <= 180 = t `toBucket` 30
+      | otherwise = t `toBucket` 60
+    toBucket n m = - fromIntegral (((- n) `div` m) * m) -- round up

src/Simplex/Messaging/Server/StoreLog.hs

@@ -286,7 +286,7 @@ logUpdateQueueTime s qId t = writeStoreLogRecord s $ UpdateTime qId t
 logNewService :: StoreLog 'WriteMode -> ServiceRec -> IO ()
 logNewService s  = writeStoreLogRecord s . NewService
 
-logQueueService :: (PartyI p, SubscriberParty p) => StoreLog 'WriteMode -> RecipientId -> SParty p -> Maybe ServiceId -> IO ()
+logQueueService :: (PartyI p, ServiceParty p) => StoreLog 'WriteMode -> RecipientId -> SParty p -> Maybe ServiceId -> IO ()
 logQueueService s rId party = writeStoreLogRecord s . QueueService rId (ASP party)
 
 readWriteStoreLog :: (FilePath -> s -> IO ()) -> (StoreLog 'WriteMode -> s -> IO ()) -> FilePath -> s -> IO (StoreLog 'WriteMode)

src/Simplex/Messaging/Transport.hs

@@ -44,9 +44,7 @@ module Simplex.Messaging.Transport
     proxiedSMPRelayVRange,
     minClientSMPRelayVersion,
     minServerSMPRelayVersion,
-    legacyServerSMPRelayVRange,
     currentClientSMPRelayVersion,
-    legacyServerSMPRelayVersion,
     currentServerSMPRelayVersion,
     authCmdsSMPVersion,
     sendingProxySMPVersion,
@@ -56,6 +54,7 @@ module Simplex.Messaging.Transport
     blockedEntitySMPVersion,
     shortLinksSMPVersion,
     serviceCertsSMPVersion,
+    newNtfCredsSMPVersion,
     simplexMQVersion,
     smpBlockSize,
     TransportConfig (..),
@@ -168,6 +167,7 @@ smpBlockSize = 16384
 -- 14 - proxyServer handshake property to disable transport encryption between server and proxy (1/19/2025)
 -- 15 - short links, with associated data passed in NEW of LSET command (3/30/2025)
 -- 16 - service certificates (5/31/2025)
+-- 17 - create notification credentials with NEW (7/12/2025)
 
 data SMPVersion
 
@@ -210,6 +210,9 @@ shortLinksSMPVersion = VersionSMP 15
 serviceCertsSMPVersion :: VersionSMP
 serviceCertsSMPVersion = VersionSMP 16
 
+newNtfCredsSMPVersion :: VersionSMP
+newNtfCredsSMPVersion = VersionSMP 17
+
 minClientSMPRelayVersion :: VersionSMP
 minClientSMPRelayVersion = VersionSMP 6
 
@@ -217,13 +220,13 @@ minServerSMPRelayVersion :: VersionSMP
 minServerSMPRelayVersion = VersionSMP 6
 
 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 16
+currentClientSMPRelayVersion = VersionSMP 17
 
 legacyServerSMPRelayVersion :: VersionSMP
 legacyServerSMPRelayVersion = VersionSMP 6
 
 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 16
+currentServerSMPRelayVersion = VersionSMP 17
 
 -- Max SMP protocol version to be used in e2e encrypted
 -- connection between client and server, as defined by SMP proxy.
@@ -231,7 +234,7 @@ currentServerSMPRelayVersion = VersionSMP 16
 -- to prevent client version fingerprinting by the
 -- destination relays when clients upgrade at different times.
 proxiedSMPRelayVersion :: VersionSMP
-proxiedSMPRelayVersion = VersionSMP 15
+proxiedSMPRelayVersion = VersionSMP 16
 
 -- minimal supported protocol version is 6
 -- TODO remove code that supports sending commands without batching

src/Simplex/Messaging/Transport/Server.hs

@@ -5,10 +5,12 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Transport.Server
   ( TransportServerConfig (..),
     ServerCredentials (..),
+    TLSServerCredential (..),
     AddHTTP,
     mkTransportServerConfig,
     runTransportServerState,
@@ -74,6 +76,15 @@ data ServerCredentials = ServerCredentials
 
 type AddHTTP = Bool
 
+data TLSServerCredential = TLSServerCredential
+  { credential :: T.Credential,
+    -- `sniCredential` is used when SNI is sent by the client.
+    --  It is needed to provide different credential when the server is accessed from the browser.
+    sniCredential :: Maybe T.Credential
+  }
+
+type SNICredentialUsed = Bool
+
 mkTransportServerConfig :: Bool -> Maybe [ALPN] -> Bool -> TransportServerConfig
 mkTransportServerConfig logTLSErrors serverALPN askClientCert =
   TransportServerConfig
@@ -98,47 +109,55 @@ runTransportServer started port srvSupported srvCreds cfg server = do
   runTransportServerState ss started port srvSupported srvCreds cfg server
 
 runTransportServerState :: Transport c => SocketState -> TMVar Bool -> ServiceName -> T.Supported -> T.Credential -> TransportServerConfig -> (c 'TServer -> IO ()) -> IO ()
-runTransportServerState ss started port srvSupported srvCreds cfg server = runTransportServerState_ ss started port srvSupported (const srvCreds) cfg (const server)
+runTransportServerState ss started port srvSupported credential cfg server = runTransportServerState_ ss started port srvSupported srvCreds cfg (\_ -> server . snd)
+  where
+    srvCreds = TLSServerCredential {credential, sniCredential = Nothing}
 
-runTransportServerState_ :: forall c. Transport c => SocketState -> TMVar Bool -> ServiceName -> T.Supported -> (Maybe HostName -> T.Credential) -> TransportServerConfig -> (Socket -> c 'TServer -> IO ()) -> IO ()
+runTransportServerState_ :: forall c. Transport c => SocketState -> TMVar Bool -> ServiceName -> T.Supported -> TLSServerCredential -> TransportServerConfig -> (Socket -> (SNICredentialUsed, c 'TServer) -> IO ()) -> IO ()
 runTransportServerState_ ss started port = runTransportServerSocketState ss started (startTCPServer started Nothing port) (transportName (TProxy :: TProxy c 'TServer))
 
 -- | Run a transport server with provided connection setup and handler.
 runTransportServerSocket :: Transport c => TMVar Bool -> IO Socket -> String -> T.ServerParams -> TransportServerConfig -> (c 'TServer -> IO ()) -> IO ()
 runTransportServerSocket started getSocket threadLabel srvParams cfg server = do
   ss <- newSocketState
-  runTransportServerSocketState_ ss started getSocket threadLabel (tlsSetupTimeout cfg) setupTLS (const server)
+  runTransportServerSocketState_ ss started getSocket threadLabel (tlsSetupTimeout cfg) setupTLS (\_ -> server . snd)
   where
     tCfg = serverTransportConfig cfg
     setupTLS conn = do
       tls <- connectTLS Nothing tCfg srvParams conn
-      getTransportConnection tCfg True (X.CertificateChain []) tls
+      (False,) <$> getTransportConnection tCfg True (X.CertificateChain []) tls
 
-runTransportServerSocketState :: Transport c => SocketState -> TMVar Bool -> IO Socket -> String -> T.Supported -> (Maybe HostName -> T.Credential) -> TransportServerConfig -> (Socket -> c 'TServer -> IO ()) -> IO ()
+runTransportServerSocketState :: Transport c => SocketState -> TMVar Bool -> IO Socket -> String -> T.Supported -> TLSServerCredential -> TransportServerConfig -> (Socket -> (SNICredentialUsed, c 'TServer) -> IO ()) -> IO ()
 runTransportServerSocketState ss started getSocket threadLabel srvSupported srvCreds cfg server =
   runTransportServerSocketState_ ss started getSocket threadLabel (tlsSetupTimeout cfg) setupTLS server
   where
     tCfg = serverTransportConfig cfg
-    srvParams = supportedTLSServerParams srvSupported srvCreds $ serverALPN cfg
-    setupTLS conn
-      | askClientCert cfg = do
-          clientCert <- newEmptyTMVarIO
-          tls <- connectTLS Nothing tCfg (paramsAskClientCert clientCert srvParams) conn
-          chain <- takePeerCertChain clientCert `E.onException` closeTLS tls
-          getTransportConnection tCfg True chain tls
-      | otherwise = do
-          tls <- connectTLS Nothing tCfg srvParams conn
-          getTransportConnection tCfg True (X.CertificateChain []) tls
+    setupTLS conn = do
+      sniUsed <- newTVarIO False
+      let srvParams = supportedTLSServerParams srvSupported srvCreds sniUsed $ serverALPN cfg
+      h <- setupTLS_ srvParams
+      sni <- readTVarIO sniUsed
+      pure (sni, h)
+      where
+        setupTLS_ srvParams
+          | askClientCert cfg = do
+              clientCert <- newEmptyTMVarIO
+              tls <- connectTLS Nothing tCfg (paramsAskClientCert clientCert srvParams) conn
+              chain <- takePeerCertChain clientCert `E.onException` closeTLS tls
+              getTransportConnection tCfg True chain tls
+          | otherwise = do
+              tls <- connectTLS Nothing tCfg srvParams conn
+              getTransportConnection tCfg True (X.CertificateChain []) tls
 
 -- | Run a transport server with provided connection setup and handler.
-runTransportServerSocketState_ :: Transport c => SocketState -> TMVar Bool -> IO Socket -> String -> Int -> (Socket -> IO (c 'TServer)) -> (Socket -> c 'TServer -> IO ()) -> IO ()
+runTransportServerSocketState_ :: Transport c => SocketState -> TMVar Bool -> IO Socket -> String -> Int -> (Socket -> IO (SNICredentialUsed, c 'TServer)) -> (Socket -> (SNICredentialUsed, c 'TServer) -> IO ()) -> IO ()
 runTransportServerSocketState_ ss started getSocket threadLabel tlsSetupTimeout setupTLS server = do
   labelMyThread $ "transport server for " <> threadLabel
   runTCPServerSocket ss started getSocket $ \conn -> do
     labelMyThread $ threadLabel <> "/setup"
     E.bracket
       (timeout tlsSetupTimeout (setupTLS conn) >>= maybe (fail "tls setup timeout") pure)
-      closeConnection
+      (closeConnection . snd)
       (server conn)
 
 -- | Run TCP server without TLS
@@ -232,13 +251,17 @@ loadServerCredential ServerCredentials {caCertificateFile, certificateFile, priv
     Right credential -> pure credential
     Left _ -> putStrLn "invalid credential" >> exitFailure
 
-supportedTLSServerParams :: T.Supported -> (Maybe HostName -> T.Credential) -> Maybe [ALPN] -> T.ServerParams
-supportedTLSServerParams serverSupported creds alpn_ =
+supportedTLSServerParams :: T.Supported -> TLSServerCredential -> TVar SNICredentialUsed -> Maybe [ALPN] -> T.ServerParams
+supportedTLSServerParams serverSupported TLSServerCredential {credential, sniCredential} sniCredUsed alpn_ =
   def
     { T.serverWantClientCert = False,
       T.serverHooks =
         def
-          { T.onServerNameIndication = \host_ -> pure $ T.Credentials [creds host_],
+          { T.onServerNameIndication = case sniCredential of
+              Nothing -> \_ -> pure $ T.Credentials [credential]
+              Just sniCred -> \case
+                Nothing -> pure $ T.Credentials [credential]
+                Just _host -> T.Credentials [sniCred] <$ atomically (writeTVar sniCredUsed True),
             T.onALPNClientSuggest = (\alpn -> pure . fromMaybe "" . find (`elem` alpn)) <$> alpn_
           },
       T.serverSupported = serverSupported

src/Simplex/Messaging/Util.hs

@@ -265,9 +265,11 @@ atomicModifyIORef'_ r f = atomicModifyIORef' r (\v -> (f v, ()))
 
 encodeJSON :: ToJSON a => a -> Text
 encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
+{-# INLINE encodeJSON #-}
 
 decodeJSON :: FromJSON a => Text -> Maybe a
-decodeJSON = J.decode . LB.fromStrict . encodeUtf8
+decodeJSON = J.decodeStrict . encodeUtf8
+{-# INLINE decodeJSON #-}
 
 traverseWithKey_ :: Monad m => (k -> v -> m ()) -> Map k v -> m ()
 traverseWithKey_ f = M.foldrWithKey (\k v -> (f k v >>)) (pure ())

tests/AgentTests/EqInstances.hs

@@ -5,7 +5,7 @@
 module AgentTests.EqInstances where
 
 import Data.Type.Equality
-import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), OwnerAuth (..))
+import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), OwnerAuth (..), UserLinkData (..))
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client (ProxiedRelay (..))
 
@@ -30,6 +30,10 @@ deriving instance Show (ConnLinkData c)
 
 deriving instance Eq (ConnLinkData c)
 
+deriving instance Show UserLinkData
+
+deriving instance Eq UserLinkData
+
 deriving instance Show OwnerAuth
 
 deriving instance Eq OwnerAuth

tests/AgentTests/FunctionalAPITests.hs

@@ -66,7 +66,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (isRight)
 import Data.Int (Int64)
-import Data.List (find, nub)
+import Data.List (find, isSuffixOf, nub)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map as M
 import Data.Maybe (isJust, isNothing)
@@ -81,7 +81,7 @@ import Data.Word (Word16)
 import GHC.Stack (withFrozenCallStack)
 import SMPAgentClient
 import SMPClient
-import Simplex.Messaging.Agent hiding (createConnection, joinConnection, subscribeConnection, sendMessage)
+import Simplex.Messaging.Agent hiding (acceptContact, createConnection, deleteConnection, deleteConnections, getConnShortLink, joinConnection, sendMessage, setConnShortLink, subscribeConnection, suspendConnection)
 import qualified Simplex.Messaging.Agent as A
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), ServerQueueInfo (..), UserNetworkInfo (..), UserNetworkType (..), waitForUserNetwork)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), Env (..), InitialAgentServers (..), createAgentStore)
@@ -91,7 +91,7 @@ import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction)
 import Simplex.Messaging.Agent.Store.Interface
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError (..))
-import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), TransportSessionMode (..), defaultClientConfig)
+import Simplex.Messaging.Client (pattern NRMInteractive, NetworkConfig (..), ProtocolClientConfig (..), TransportSessionMode (..), defaultClientConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
@@ -253,6 +253,12 @@ runRight action =
     Right x -> pure x
     Left e -> error $ "Unexpected error: " <> show e
 
+runLeft :: (Show a, HasCallStack) => ExceptT e IO a -> IO e
+runLeft action =
+  runExceptT action >>= \case
+    Right x -> error $ "unexpected result " <> show x
+    Left e -> pure e
+
 getInAnyOrder :: HasCallStack => AgentClient -> [ATransmission -> Bool] -> Expectation
 getInAnyOrder c ts = withFrozenCallStack $ inAnyOrder (pGet c) ts
 
@@ -270,15 +276,18 @@ inAnyOrder g rs = withFrozenCallStack $ do
 
 createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c)
 createConnection c userId enableNtfs cMode clientData subMode = do
-  (connId, (CCLink cReq _, Nothing)) <- A.createConnection c userId enableNtfs cMode Nothing clientData (IKNoPQ PQSupportOn) subMode
+  (connId, (CCLink cReq _, Nothing)) <- A.createConnection c NRMInteractive userId enableNtfs cMode Nothing clientData IKPQOn subMode
   pure (connId, cReq)
 
 joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
 joinConnection c userId enableNtfs cReq connInfo subMode = do
   connId <- A.prepareConnectionToJoin c userId enableNtfs cReq PQSupportOn
-  (sndSecure, Nothing) <- A.joinConnection c userId connId enableNtfs cReq connInfo PQSupportOn subMode
+  (sndSecure, Nothing) <- A.joinConnection c NRMInteractive userId connId enableNtfs cReq connInfo PQSupportOn subMode
   pure (connId, sndSecure)
 
+acceptContact :: AgentClient -> UserId -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (SndQueueSecured, Maybe ClientServiceId)
+acceptContact c = A.acceptContact c NRMInteractive
+
 subscribeConnection :: AgentClient -> ConnId -> AE ()
 subscribeConnection c = void . A.subscribeConnection c
 
@@ -288,6 +297,21 @@ sendMessage c connId msgFlags msgBody = do
   liftIO $ pqEnc `shouldBe` PQEncOn
   pure msgId
 
+deleteConnection :: AgentClient -> ConnId -> AE ()
+deleteConnection c = A.deleteConnection c NRMInteractive
+
+deleteConnections :: AgentClient -> [ConnId] -> AE (M.Map ConnId (Either AgentErrorType ()))
+deleteConnections c = A.deleteConnections c NRMInteractive
+
+getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c)
+getConnShortLink c = A.getConnShortLink c NRMInteractive
+
+setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserLinkData -> Maybe CRClientData -> AE (ConnShortLink c)
+setConnShortLink c = A.setConnShortLink c NRMInteractive
+
+suspendConnection :: AgentClient -> ConnId -> AE ()
+suspendConnection c = A.suspendConnection c NRMInteractive
+
 functionalAPITests :: (ASrvTransport, AStoreType) -> Spec
 functionalAPITests ps = do
   describe "Establishing duplex connection" $ do
@@ -331,6 +355,13 @@ functionalAPITests ps = do
       testAsyncServerOffline ps
     it "should restore confirmation after client restart" $
       testAllowConnectionClientRestart ps
+  describe "Establishing connections with user retries" $ do
+    describe "Via invitation" $ do
+      it "should connect after errors" $ testInvitationErrors ps False
+      it "should connect after errors with client restarts" $ testInvitationErrors ps True
+    describe "Via contact" $ do
+      it "should connect after errors" $ testContactErrors ps False
+      it "should connect after errors with client restarts" $ testContactErrors ps True
   describe "Short connection links" $ do
     describe "should connect via 1-time short link" $ testProxyMatrix ps testInviationShortLink
     describe "should connect via 1-time short link with async join" $ testProxyMatrix ps testInviationShortLinkAsync
@@ -662,14 +693,14 @@ withAgentClients3 runTest =
 
 runAgentClientTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientTest pqSupport sqSecured viaProxy alice bob baseId =
-  runAgentClientTestPQ sqSecured viaProxy (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
+  runAgentClientTestPQ sqSecured viaProxy (alice, IKLinkPQ pqSupport) (bob, pqSupport) baseId
 
 runAgentClientTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
 runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId =
   runRight_ $ do
-    (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing aPQ SMSubscribe
+    (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice NRMInteractive 1 True SCMInvitation Nothing Nothing aPQ SMSubscribe
     aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
-    (sqSecured', Nothing) <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
+    (sqSecured', Nothing) <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
     liftIO $ sqSecured' `shouldBe` sqSecured
     ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
     liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ
@@ -864,19 +895,19 @@ testAgentClient3 =
 
 runAgentClientContactTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId =
-  runAgentClientContactTestPQ sqSecured viaProxy pqSupport (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
+  runAgentClientContactTestPQ sqSecured viaProxy pqSupport (alice, IKLinkPQ pqSupport) (bob, pqSupport) baseId
 
 runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
 runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId =
   runRight_ $ do
-    (_, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe
+    (_, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice NRMInteractive 1 True SCMContact Nothing Nothing aPQ SMSubscribe
     aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
-    (sqSecuredJoin, Nothing) <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
+    (sqSecuredJoin, Nothing) <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
     liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
     ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
     liftIO $ pqSup' `shouldBe` reqPQSupport
-    bobId <- A.prepareConnectionToAccept alice True invId (CR.connPQEncryption aPQ)
-    (sqSecured', Nothing) <- acceptContact alice bobId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
+    bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ)
+    (sqSecured', Nothing) <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
     liftIO $ sqSecured' `shouldBe` sqSecured
     ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get bob
     liftIO $ pqSup'' `shouldBe` bPQ
@@ -913,7 +944,7 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b
 
 runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
 runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do
-  (_, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe
+  (_, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice NRMInteractive 1 True SCMContact Nothing Nothing aPQ SMSubscribe
   (bAliceId, bobId, abPQEnc) <- connectViaContact bob bPQ qInfo
   sentMessages abPQEnc alice bobId bob bAliceId
   (tAliceId, tomId, atPQEnc) <- connectViaContact tom tPQ qInfo
@@ -922,12 +953,12 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId
     msgId = subtract baseId . fst
     connectViaContact b pq qInfo = do
       aId <- A.prepareConnectionToJoin b 1 True qInfo pq
-      (sqSecuredJoin, Nothing) <- A.joinConnection b 1 aId True qInfo "bob's connInfo" pq SMSubscribe
+      (sqSecuredJoin, Nothing) <- A.joinConnection b NRMInteractive 1 aId True qInfo "bob's connInfo" pq SMSubscribe
       liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
       ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
       liftIO $ pqSup' `shouldBe` PQSupportOn
-      bId <- A.prepareConnectionToAccept alice True invId (CR.connPQEncryption aPQ)
-      (sqSecuredAccept, Nothing) <- acceptContact alice bId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
+      bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ)
+      (sqSecuredAccept, Nothing) <- acceptContact alice 1 bId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
       liftIO $ sqSecuredAccept `shouldBe` False -- agent cfg is v8
       ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b
       liftIO $ pqSup'' `shouldBe` pq
@@ -966,13 +997,12 @@ noMessages_ ingoreQCONT c err = tryGet `shouldReturn` ()
 testRejectContactRequest :: HasCallStack => IO ()
 testRejectContactRequest =
   withAgentClients2 $ \alice bob -> runRight_ $ do
-    (addrConnId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing IKPQOn SMSubscribe
+    (_addrConnId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice NRMInteractive 1 True SCMContact Nothing Nothing IKPQOn SMSubscribe
     aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-    (sqSecured, Nothing) <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    (sqSecured, Nothing) <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
     liftIO $ sqSecured `shouldBe` False -- joining via contact address connection
     ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice
-    liftIO $ runExceptT (rejectContact alice "abcd" invId) `shouldReturn` Left (CONN NOT_FOUND)
-    rejectContact alice addrConnId invId
+    rejectContact alice invId
     liftIO $ noMessages bob "nothing delivered to bob"
 
 testUpdateConnectionUserId :: HasCallStack => IO ()
@@ -982,7 +1012,7 @@ testUpdateConnectionUserId =
     newUserId <- createUser alice [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
     _ <- changeConnectionUser alice 1 connId newUserId
     aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-    (sqSecured', Nothing) <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    (sqSecured', Nothing) <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
     liftIO $ sqSecured' `shouldBe` True
     ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
     liftIO $ pqSup' `shouldBe` PQSupportOn
@@ -1134,11 +1164,166 @@ testAllowConnectionClientRestart ps@(t, ASType qsType _) = do
     disposeAgentClient alice2
     disposeAgentClient bob
 
+testInvitationErrors :: HasCallStack => (ASrvTransport, AStoreType) -> Bool -> IO ()
+testInvitationErrors ps restart = do
+  a <- getAgentA
+  b <- getAgentB
+  (bId, cReq) <- withServer1 ps $ runRight $ createConnection a 1 True SCMInvitation Nothing SMSubscribe
+  ("", "", DOWN _ [_]) <- nGet a
+  aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn
+  -- fails to secure the queue on testPort
+  BROKER srv NETWORK <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe
+  (testPort `isSuffixOf` srv) `shouldBe` True
+  withServer1 ps $ do
+    ("", "", UP _ [_]) <- nGet a
+    let loopSecure = do
+          -- secures the queue on testPort, but fails to create reply queue on testPort2
+          BROKER srv2 NETWORK <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe
+          unless (testPort2 `isSuffixOf` srv2) $ putStrLn "retrying secure" >> threadDelay 200000 >> loopSecure
+    loopSecure
+  ("", "", DOWN _ [_]) <- nGet a
+  b' <- withServer2 ps $ do
+    threadDelay 200000
+    let loopCreate = do
+          -- creates the reply queue on testPort2, but fails to send it to testPort
+          BROKER srv' NETWORK <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe
+          unless (testPort `isSuffixOf` srv') $ putStrLn "retrying create" >> threadDelay 200000 >> loopCreate
+    loopCreate
+    restartAgentB restart b [aId]
+  ("", "", DOWN _ [_]) <- nGet b'
+  n <- withServer1 ps $ do
+    ("", "", UP _ [_]) <- nGet a
+    threadDelay 200000
+    let loopConfirm n =
+          runExceptT (A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe) >>= \case
+            Right (True, Nothing) -> pure n
+            Right r -> error $ "unexpected result " <> show r
+            Left _ -> putStrLn "retrying confirm" >> threadDelay 200000 >> loopConfirm (n + 1)
+    n <- loopConfirm 1
+    runRight $ do
+      ("", _, CONF confId _ "bob's connInfo") <- get a
+      allowConnectionAsync a "1" bId confId "alice's connInfo"
+      get a ##> ("1", bId, OK)
+    pure n
+  ("", "", DOWN _ [_]) <- nGet a
+  withServer2 ps $ do
+    get a ##> ("", bId, CON) -- note that server 1 is down, CON event is sent when HELLO is sent to server 2
+    ("", "", UP _ [_]) <- nGet b'
+    get b' ##> ("", aId, INFO "alice's connInfo")
+    get b' ##> ("", aId, CON)
+    withServer1 ps $ do
+      ("", "", UP _ [_]) <- nGet a
+      runRight_ $ exchangeGreetingsViaProxyMsgId_ False PQEncOn 2 (2 + n) a bId b' aId
+      disposeAgentClient a
+      disposeAgentClient b'
+
+restartAgentA :: Bool -> AgentClient -> [ConnId] -> IO AgentClient
+restartAgentA = restartAgent_ getAgentA
+
+restartAgentB :: Bool -> AgentClient -> [ConnId] -> IO AgentClient
+restartAgentB = restartAgent_ getAgentB
+
+restartAgent_ :: IO AgentClient -> Bool -> AgentClient -> [ConnId] -> IO AgentClient
+restartAgent_ getAgent restart c cIds
+  | restart = do
+      disposeAgentClient c
+      threadDelay 200000
+      c' <- getAgent
+      rs <- runRight $ subscribeConnections c' cIds
+      all isRight rs `shouldBe` True
+      pure c'
+  | otherwise = pure c
+
+testContactErrors :: HasCallStack => (ASrvTransport, AStoreType) -> Bool -> IO ()
+testContactErrors ps restart = do
+  a <- getAgentA
+  b <- getAgentB
+  (contactId, cReq) <- withServer1 ps $ runRight $ createConnection a 1 True SCMContact Nothing SMSubscribe
+  ("", "", DOWN _ [_]) <- nGet a
+  aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn
+  -- fails to create queue on testPort2
+  BROKER srv2 NETWORK <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe
+  (testPort2 `isSuffixOf` srv2) `shouldBe` True
+  b' <- restartAgentB restart b [aId]
+  let loopCreate2 = do
+        -- creates the reply queue on testPort2, but fails to send invitation to testPort
+        BROKER srv' NETWORK <- runLeft $ A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe
+        unless (testPort `isSuffixOf` srv') $ putStrLn "retrying create 2" >> threadDelay 200000 >> loopCreate2
+  b'' <- withServer2 ps $ do
+    loopCreate2
+    restartAgentB restart b' [aId]
+  ("", "", DOWN _ [_]) <- nGet b''
+  invId <- withServer1 ps $ do
+    ("", "", UP _ [_]) <- nGet a
+    let loopSend = do
+          -- sends the invitation to testPort
+          runExceptT (A.joinConnection b'' NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe) >>= \case
+            Right (False, Nothing) -> pure ()
+            Right r -> error $ "unexpected result " <> show r
+            Left _ -> putStrLn "retrying send" >> threadDelay 200000 >> loopSend
+    loopSend
+    ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get a
+    pure invId
+  ("", "", DOWN _ [_]) <- nGet a
+  bId <- runRight $ A.prepareConnectionToAccept a 1 True invId PQSupportOn
+  withServer2 ps $ do
+    ("", "", UP _ [_]) <- nGet b''
+    let loopSecure = do
+          -- secures the queue on testPort2, but fails to create reply queue on testPort
+          BROKER srv NETWORK <- runLeft $ acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe
+          unless (testPort `isSuffixOf` srv) $ putStrLn "retrying secure" >> threadDelay 200000 >> loopSecure
+    loopSecure
+  ("", "", DOWN _ [_]) <- nGet b''
+  a' <- withServer1 ps $ do
+    ("", "", UP _ [_]) <- nGet a
+    let loopCreate = do
+          -- creates the reply queue on testPort, but fails to send confirmation to testPort2
+          BROKER srv2' NETWORK <- runLeft $ acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe
+          unless (testPort2 `isSuffixOf` srv2') $ putStrLn "retrying create" >> threadDelay 200000 >> loopCreate
+    loopCreate
+    restartAgentA restart a [contactId, bId]
+  ("", "", DOWN _ [_, _]) <- nGet a' -- the second connection is from accept
+  (n, confId) <- withServer2 ps $ do
+    ("", "", UP _ [_]) <- nGet b''
+    let loopConfirm n =
+          runExceptT (acceptContact a' 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe) >>= \case
+            Right (True, Nothing) -> pure n
+            Right r -> error $ "unexpected result " <> show r
+            Left _ -> putStrLn "retrying accept confirm" >> threadDelay 200000 >> loopConfirm (n + 1)
+    n <- loopConfirm 1
+    ("", _, A.CONF confId PQSupportOn _ "alice's connInfo") <- get b''
+    pure (n, confId)
+  ("", "", DOWN _ [_]) <- nGet b''
+  runRight_ $ allowConnection b'' aId confId "bob's connInfo"
+  withServer1 ps $ do
+    ("", "", UP _ [_, _]) <- nGet a'
+    get a' ##> ("", bId, A.INFO PQSupportOn "bob's connInfo")
+    get a' ##> ("", bId, A.CON PQEncOn)
+    get b'' ##> ("", aId, A.CON PQEncOn) -- note that server 2 is down, this event is delivered when HELLO is sent to server 1
+    a'' <- restartAgentA restart a' [contactId, bId]
+    withServer2 ps $ do
+      ("", "", UP _ [_]) <- nGet b''
+      runRight_ $ exchangeGreetingsViaProxyMsgId_ False PQEncOn (2 + n) 2 a'' bId b'' aId
+      disposeAgentClient a''
+      disposeAgentClient b''
+
+getAgentA :: IO AgentClient
+getAgentA = getSMPAgentClient' 1 agentCfg initAgentServers testDB
+
+getAgentB :: IO AgentClient
+getAgentB = getSMPAgentClient' 2 agentCfg (initAgentServers {smp = userServers [testSMPServer2]}) testDB2
+
+withServer1 :: (ASrvTransport, AStoreType) -> IO a -> IO a
+withServer1 ps = withSmpServerStoreLogOn ps testPort . const
+
+withServer2 :: (ASrvTransport, AStoreType) -> IO a -> IO a
+withServer2 (t, ASType qsType _) = withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 . const
+
 testInviationShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
 testInviationShortLink viaProxy a b =
   withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
-    let userData = "some user data"
-    (bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
+    let userData = UserLinkData "some user data"
+    (bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
     (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
@@ -1160,7 +1345,7 @@ testInviationShortLink viaProxy a b =
 testJoinConn_ :: Bool -> Bool -> AgentClient -> ConnId -> AgentClient -> ConnectionRequestUri c -> ExceptT AgentErrorType IO ()
 testJoinConn_ viaProxy sndSecure a bId b connReq = do
   aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn
-  (sndSecure', Nothing) <- A.joinConnection b 1 aId True connReq "bob's connInfo" PQSupportOn SMSubscribe
+  (sndSecure', Nothing) <- A.joinConnection b NRMInteractive 1 aId True connReq "bob's connInfo" PQSupportOn SMSubscribe
   liftIO $ sndSecure' `shouldBe` sndSecure
   ("", _, CONF confId _ "bob's connInfo") <- get a
   allowConnection a bId confId "alice's connInfo"
@@ -1171,15 +1356,15 @@ testJoinConn_ viaProxy sndSecure a bId b connReq = do
 
 testInviationShortLinkPrev :: HasCallStack => Bool -> Bool -> AgentClient -> AgentClient -> IO ()
 testInviationShortLinkPrev viaProxy sndSecure a b = runRight_ $ do
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
   -- can't create short link with previous version
-  (bId, (CCLink connReq Nothing, Nothing)) <- A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKPQOn SMSubscribe
+  (bId, (CCLink connReq Nothing, Nothing)) <- A.createConnection a NRMInteractive 1 True SCMInvitation (Just userData) Nothing CR.IKPQOn SMSubscribe
   testJoinConn_ viaProxy sndSecure a bId b connReq
 
 testInviationShortLinkAsync :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
 testInviationShortLinkAsync viaProxy a b = do
-  let userData = "some user data"
-  (bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
+  let userData = UserLinkData "some user data"
+  (bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
   (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
   strDecode (strEncode shortLink) `shouldBe` Right shortLink
   connReq' `shouldBe` connReq
@@ -1197,8 +1382,8 @@ testInviationShortLinkAsync viaProxy a b = do
 testContactShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
 testContactShortLink viaProxy a b =
   withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
-    let userData = "some user data"
-    (contactId, (CCLink connReq0 (Just shortLink), Nothing)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
+    let userData = UserLinkData "some user data"
+    (contactId, (CCLink connReq0 (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
     Right connReq <- pure $ smpDecode (smpEncode connReq0)
     (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
@@ -1216,8 +1401,8 @@ testContactShortLink viaProxy a b =
       (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
       liftIO $ sndSecure `shouldBe` False
       ("", _, REQ invId _ "bob's connInfo") <- get a
-      bId <- A.prepareConnectionToAccept a True invId PQSupportOn
-      (sndSecure', Nothing) <- acceptContact a bId True invId "alice's connInfo" PQSupportOn SMSubscribe
+      bId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
+      (sndSecure', Nothing) <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe
       liftIO $ sndSecure' `shouldBe` True
       ("", _, CONF confId  _ "alice's connInfo") <- get b
       allowConnection b aId confId "bob's connInfo"
@@ -1226,7 +1411,7 @@ testContactShortLink viaProxy a b =
       get b ##> ("", aId, CON)
       exchangeGreetingsViaProxy viaProxy a bId b aId
     -- update user data
-    let updatedData = "updated user data"
+    let updatedData = UserLinkData "updated user data"
     shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
     shortLink' `shouldBe` shortLink
     (connReq4, updatedConnData') <- runRight $ getConnShortLink c 1 shortLink
@@ -1236,16 +1421,16 @@ testContactShortLink viaProxy a b =
     shortLink2 <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
     shortLink2 `shouldBe` shortLink
     -- delete short link
-    runRight_ $ deleteConnShortLink a contactId SCMContact
+    runRight_ $ deleteConnShortLink a NRMInteractive contactId SCMContact
     Left (SMP _ AUTH) <- runExceptT $ getConnShortLink c 1 shortLink
     pure ()
 
 testAddContactShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
 testAddContactShortLink viaProxy a b =
   withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
-    (contactId, (CCLink connReq0 Nothing, Nothing)) <- runRight $ A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe
+    (contactId, (CCLink connReq0 Nothing, Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe
     Right connReq <- pure $ smpDecode (smpEncode connReq0) --
-    let userData = "some user data"
+    let userData = UserLinkData "some user data"
     shortLink <- runRight $ setConnShortLink a contactId SCMContact userData Nothing
     (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
@@ -1263,8 +1448,8 @@ testAddContactShortLink viaProxy a b =
       (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
       liftIO $ sndSecure `shouldBe` False
       ("", _, REQ invId _ "bob's connInfo") <- get a
-      bId <- A.prepareConnectionToAccept a True invId PQSupportOn
-      (sndSecure', Nothing) <- acceptContact a bId True invId "alice's connInfo" PQSupportOn SMSubscribe
+      bId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
+      (sndSecure', Nothing) <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe
       liftIO $ sndSecure' `shouldBe` True
       ("", _, CONF confId  _ "alice's connInfo") <- get b
       allowConnection b aId confId "bob's connInfo"
@@ -1273,7 +1458,7 @@ testAddContactShortLink viaProxy a b =
       get b ##> ("", aId, CON)
       exchangeGreetingsViaProxy viaProxy a bId b aId
     -- update user data
-    let updatedData = "updated user data"
+    let updatedData = UserLinkData "updated user data"
     shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
     shortLink' `shouldBe` shortLink
     (connReq4, updatedConnData') <- runRight $ getConnShortLink c 1 shortLink
@@ -1282,9 +1467,9 @@ testAddContactShortLink viaProxy a b =
 
 testInviationShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
 testInviationShortLinkRestart ps = withAgentClients2 $ \a b -> do
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
   (bId, (CCLink connReq (Just shortLink), Nothing)) <- withSmpServer ps $
-    runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMOnlyCreate
+    runRight $ A.createConnection a NRMInteractive 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMOnlyCreate
   withSmpServer ps $ do
     runRight_ $ subscribeConnection a bId
     (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
@@ -1294,11 +1479,11 @@ testInviationShortLinkRestart ps = withAgentClients2 $ \a b -> do
 
 testContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
 testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
   (contactId, (CCLink connReq0 (Just shortLink), Nothing)) <- withSmpServer ps $
-    runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMOnlyCreate
+    runRight $ A.createConnection a NRMInteractive 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMOnlyCreate
   Right connReq <- pure $ smpDecode (smpEncode connReq0)
-  let updatedData = "updated user data"
+  let updatedData = UserLinkData "updated user data"
   withSmpServer ps $ do
     (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
@@ -1314,12 +1499,12 @@ testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
 
 testAddContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
 testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
   ((contactId, (CCLink connReq0 Nothing, Nothing)), shortLink) <- withSmpServer ps $ runRight $ do
-    r@(contactId, _) <- A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate
+    r@(contactId, _) <- A.createConnection a NRMInteractive 1 True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate
     (r,) <$> setConnShortLink a contactId SCMContact userData Nothing
   Right connReq <- pure $ smpDecode (smpEncode connReq0)
-  let updatedData = "updated user data"
+  let updatedData = UserLinkData "updated user data"
   withSmpServer ps $ do
     (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
@@ -1336,7 +1521,7 @@ testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
 testOldContactQueueShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
 testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
   (contactId, (CCLink connReq Nothing, Nothing)) <- withSmpServer ps $ runRight $
-    A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate
+    A.createConnection a NRMInteractive 1 True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate
   -- make it an "old" queue
   let updateStoreLog f = replaceSubstringInFile f " queue_mode=C" ""
   () <- case testServerStoreConfig msType of
@@ -1355,14 +1540,14 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
     _ -> pure ()
 
   withSmpServer ps $ do
-    let userData = "some user data"
+    let userData = UserLinkData "some user data"
     shortLink <- runRight $ setConnShortLink a contactId SCMContact userData Nothing
     (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
     linkUserData connData' `shouldBe` userData
     -- update user data
-    let updatedData = "updated user data"
+    let updatedData = UserLinkData "updated user data"
     shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
     shortLink' `shouldBe` shortLink
     -- check updated
@@ -2067,9 +2252,9 @@ makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn True
 
 makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
 makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do
-  (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice aliceUserId True SCMInvitation Nothing Nothing (CR.IKNoPQ pqSupport) SMSubscribe
+  (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice NRMInteractive aliceUserId True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) SMSubscribe
   aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport
-  (sqSecured', Nothing) <- A.joinConnection bob bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe
+  (sqSecured', Nothing) <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe
   liftIO $ sqSecured' `shouldBe` sqSecured
   ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
   liftIO $ pqSup' `shouldBe` pqSupport
@@ -2235,7 +2420,7 @@ testBatchedSubscriptions nCreate nDel ps@(t, ASType qsType _) =
       liftIO $ do
         let dc = S.fromList $ take nDel cs
         all isRight (M.withoutKeys r dc) `shouldBe` True
-        all (== Left (CONN NOT_FOUND)) (M.restrictKeys r dc) `shouldBe` True
+        all (== Left (CONN NOT_FOUND "")) (M.restrictKeys r dc) `shouldBe` True
         M.keys r `shouldMatchList` cs
     delete :: AgentClient -> [ConnId] -> ExceptT AgentErrorType IO ()
     delete c cs = do
@@ -2247,7 +2432,7 @@ testBatchedSubscriptions nCreate nDel ps@(t, ASType qsType _) =
     deleteFail c cs = do
       r <- deleteConnections c cs
       liftIO $ do
-        all (== Left (CONN NOT_FOUND)) r `shouldBe` True
+        all (== Left (CONN NOT_FOUND "")) r `shouldBe` True
         M.keys r `shouldMatchList` cs
     runServers :: ExceptT AgentErrorType IO a -> IO a
     runServers a = do
@@ -2338,7 +2523,7 @@ receiveMsg c cId msgId msg = do
 testAsyncCommands :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 testAsyncCommands sqSecured alice bob baseId =
   runRight_ $ do
-    bobId <- createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
+    bobId <- createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe
     ("1", bobId', INV (ACR _ qInfo)) <- get alice
     liftIO $ bobId' `shouldBe` bobId
     aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
@@ -2389,7 +2574,7 @@ testAsyncCommands sqSecured alice bob baseId =
 testAsyncCommandsRestore :: (ASrvTransport, AStoreType) -> IO ()
 testAsyncCommandsRestore ps = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
-  bobId <- runRight $ createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
+  bobId <- runRight $ createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe
   liftIO $ noMessages alice "alice doesn't receive INV because server is down"
   disposeAgentClient alice
   withAgent 2 agentCfg initAgentServers testDB $ \alice' ->
@@ -2405,7 +2590,7 @@ testAcceptContactAsync sqSecured alice bob baseId =
     (aliceId, sqSecuredJoin) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
     liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
     ("", _, REQ invId _ "bob's connInfo") <- get alice
-    bobId <- acceptContactAsync alice "1" True invId "alice's connInfo" PQSupportOn SMSubscribe
+    bobId <- acceptContactAsync alice 1 "1" True invId "alice's connInfo" PQSupportOn SMSubscribe
     get alice =##> \case ("1", c, JOINED sqSecured') -> c == bobId && sqSecured' == sqSecured; _ -> False
     ("", _, CONF confId _ "alice's connInfo") <- get bob
     allowConnection bob aliceId confId "bob's connInfo"
@@ -2670,7 +2855,7 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do
   withAgent 1 cfg' initAgentServers testDB $ \a ->
     withAgent 2 cfg' initAgentServersSrv2 testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
-        bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
+        bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
         ("1", bId', INV (ACR _ qInfo)) <- get a
         liftIO $ bId' `shouldBe` bId
         aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
@@ -2715,7 +2900,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withAgent 2 agentCfg initAgentServersSrv2 testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
-        bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
+        bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
         ("1", bId', INV (ACR _ qInfo)) <- get a
         liftIO $ bId' `shouldBe` bId
         aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
@@ -3216,7 +3401,7 @@ testSMPServerConnectionTest (t, msType) newQueueBasicAuth srv =
   withSmpServerConfigOn t cfg' testPort2 $ \_ -> do
     -- initially passed server is not running
     withAgent 1 agentCfg initAgentServers testDB $ \a ->
-      testProtocolServer a 1 srv
+      testProtocolServer a NRMInteractive 1 srv
   where
     cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {newQueueBasicAuth}
 
@@ -3614,7 +3799,7 @@ testServerQueueInfo = do
       liftIO $ isJust r `shouldBe` True
       pure r
     checkQ c cId qiSnd' qiSubThread_ qiSize' msgType_ = do
-      ServerQueueInfo {info = QueueInfo {qiSnd, qiNtf, qiSub, qiSize, qiMsg}} <- getConnectionQueueInfo c cId
+      ServerQueueInfo {info = QueueInfo {qiSnd, qiNtf, qiSub, qiSize, qiMsg}} <- getConnectionQueueInfo c NRMInteractive cId
       liftIO $ do
         qiSnd `shouldBe` qiSnd'
         qiNtf `shouldBe` False
@@ -3651,24 +3836,29 @@ exchangeGreetingsMsgId :: HasCallStack => Int64 -> AgentClient -> ConnId -> Agen
 exchangeGreetingsMsgId = exchangeGreetingsMsgId_ PQEncOn
 
 exchangeGreetingsMsgId_ :: HasCallStack => PQEncryption -> Int64 -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
-exchangeGreetingsMsgId_ = exchangeGreetingsViaProxyMsgId_ False
+exchangeGreetingsMsgId_ pqEnc msgId = exchangeGreetingsViaProxyMsgId_ False pqEnc msgId msgId
 
 exchangeGreetingsViaProxy :: HasCallStack => Bool -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
-exchangeGreetingsViaProxy viaProxy = exchangeGreetingsViaProxyMsgId_ viaProxy PQEncOn 2
+exchangeGreetingsViaProxy viaProxy = exchangeGreetingsViaProxyMsgId_ viaProxy PQEncOn 2 2
 
-exchangeGreetingsViaProxyMsgId_ :: HasCallStack => Bool -> PQEncryption -> Int64 -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
-exchangeGreetingsViaProxyMsgId_ viaProxy pqEnc msgId alice bobId bob aliceId = do
+exchangeGreetingsViaProxyMsgId_ :: HasCallStack => Bool -> PQEncryption -> Int64 -> Int64 -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
+exchangeGreetingsViaProxyMsgId_ viaProxy pqEnc aMsgId bMsgId alice bobId bob aliceId = do
   msgId1 <- A.sendMessage alice bobId pqEnc SMP.noMsgFlags "hello"
-  liftIO $ msgId1 `shouldBe` (msgId, pqEnc)
-  get alice =##> \case ("", c, A.SENT mId srv_) -> c == bobId && mId == msgId && viaProxy == isJust srv_; _ -> False
-  get bob =##> \case ("", c, Msg' mId pq "hello") -> c == aliceId && mId == msgId && pq == pqEnc; _ -> False
-  ackMessage bob aliceId msgId Nothing
+  liftIO $ msgId1 `shouldBe` (aMsgId, pqEnc)
+  get alice =##> \case ("", c, A.SENT mId srv_) -> c == bobId && mId == aMsgId && viaProxy == isJust srv_; _ -> False
+  if aMsgId <= bMsgId
+    then get bob =##> \case ("", c, Msg' mId pq "hello") -> c == aliceId && mId == bMsgId && pq == pqEnc; _ -> False
+    else get bob =##> \case ("", c, MsgErr' mId (MsgSkipped 2 _) pq "hello") -> c == aliceId && mId == bMsgId && pq == pqEnc; _ -> False
+  ackMessage bob aliceId bMsgId Nothing
   msgId2 <- A.sendMessage bob aliceId pqEnc SMP.noMsgFlags "hello too"
-  let msgId' = msgId + 1
-  liftIO $ msgId2 `shouldBe` (msgId', pqEnc)
-  get bob =##> \case ("", c, A.SENT mId srv_) -> c == aliceId && mId == msgId' && viaProxy == isJust srv_; _ -> False
-  get alice =##> \case ("", c, Msg' mId pq "hello too") -> c == bobId && mId == msgId' && pq == pqEnc; _ -> False
-  ackMessage alice bobId msgId' Nothing
+  let aMsgId' = aMsgId + 1
+      bMsgId' = bMsgId + 1
+  liftIO $ msgId2 `shouldBe` (bMsgId', pqEnc)
+  get bob =##> \case ("", c, A.SENT mId srv_) -> c == aliceId && mId == bMsgId' && viaProxy == isJust srv_; _ -> False
+  if aMsgId >= bMsgId
+    then get alice =##> \case ("", c, Msg' mId pq "hello too") -> c == bobId && mId == aMsgId' && pq == pqEnc; _ -> False
+    else get alice =##> \case ("", c, MsgErr' mId (MsgSkipped 2 _) pq "hello too") -> c == bobId && mId == aMsgId' && pq == pqEnc; _ -> False
+  ackMessage alice bobId aMsgId' Nothing
 
 exchangeGreetingsMsgIds :: HasCallStack => AgentClient -> ConnId -> Int64 -> AgentClient -> ConnId -> Int64 -> ExceptT AgentErrorType IO ()
 exchangeGreetingsMsgIds alice bobId aliceMsgId bob aliceId bobMsgId = do

tests/AgentTests/NotificationTests.hs

@@ -61,7 +61,8 @@ import qualified Database.PostgreSQL.Simple as PSQL
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
 import SMPClient
-import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
+import Simplex.Messaging.Agent hiding (checkNtfToken, createConnection, joinConnection, registerNtfToken, sendMessage, verifyNtfToken)
+import qualified Simplex.Messaging.Agent as A
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, SENT)
@@ -69,6 +70,7 @@ import Simplex.Messaging.Agent.Store.AgentStore (getSavedNtfToken)
 import Simplex.Messaging.Agent.Store.Common (withTransaction)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.Interface (closeDBStore, reopenDBStore)
+import Simplex.Messaging.Client (pattern NRMInteractive)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
@@ -194,6 +196,15 @@ testNtfMatrix ps@(_, msType) runTest = do
     cfg' = cfgMS msType
     cfgVPrev' = cfgVPrev msType
 
+registerNtfToken :: AgentClient -> DeviceToken -> NotificationsMode -> AE NtfTknStatus
+registerNtfToken c = A.registerNtfToken c NRMInteractive
+
+checkNtfToken :: AgentClient -> DeviceToken -> AE NtfTknStatus
+checkNtfToken c = A.checkNtfToken c NRMInteractive
+
+verifyNtfToken :: AgentClient -> DeviceToken -> C.CbNonce -> ByteString -> AE ()
+verifyNtfToken c = A.verifyNtfToken c NRMInteractive
+
 runNtfTestCfg :: HasCallStack => (ASrvTransport, AStoreType) -> AgentMsgId -> AServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO ()
 runNtfTestCfg (t, msType) baseId smpCfg ntfCfg aCfg bCfg runTest = do
   ASSCfg qt mt serverStoreCfg <- pure $ testServerStoreConfig msType
@@ -529,7 +540,7 @@ testRunNTFServerTests :: ASrvTransport -> NtfServer -> IO (Maybe ProtocolTestFai
 testRunNTFServerTests t srv =
   withNtfServer t $
     withAgent 1 agentCfg initAgentServers testDB $ \a ->
-      testProtocolServer a 1 $ ProtoServerWithAuth srv Nothing
+      testProtocolServer a NRMInteractive 1 $ ProtoServerWithAuth srv Nothing
 
 testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
 testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do

tests/AgentTests/SQLiteTests.hs

@@ -49,7 +49,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
-import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), pattern PQSupportOn)
+import Simplex.Messaging.Crypto.Ratchet (pattern IKPQOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Protocol (EntityId (..), QueueMode (..), SubscriptionMode (..), pattern VersionSMPC)
@@ -421,10 +421,10 @@ testUpgradeRcvConnToDuplex =
               smpClientVersion = VersionSMPC 1
             }
     upgradeRcvConnToDuplex db "conn1" anotherSndQueue
-      `shouldReturn` Left (SEBadConnType CSnd)
+      `shouldReturn` Left (SEBadConnType "upgradeRcvConnToDuplex" CSnd)
     _ <- upgradeSndConnToDuplex db "conn1" rcvQueue1
     upgradeRcvConnToDuplex db "conn1" anotherSndQueue
-      `shouldReturn` Left (SEBadConnType CDuplex)
+      `shouldReturn` Left (SEBadConnType "upgradeRcvConnToDuplex" CDuplex)
 
 testUpgradeSndConnToDuplex :: SpecWith DBStore
 testUpgradeSndConnToDuplex =
@@ -455,10 +455,10 @@ testUpgradeSndConnToDuplex =
               deleteErrors = 0
             }
     upgradeSndConnToDuplex db "conn1" anotherRcvQueue
-      `shouldReturn` Left (SEBadConnType CRcv)
+      `shouldReturn` Left (SEBadConnType "upgradeSndConnToDuplex" CRcv)
     _ <- upgradeRcvConnToDuplex db "conn1" sndQueue1
     upgradeSndConnToDuplex db "conn1" anotherRcvQueue
-      `shouldReturn` Left (SEBadConnType CDuplex)
+      `shouldReturn` Left (SEBadConnType "upgradeSndConnToDuplex" CDuplex)
 
 testSetRcvQueueStatus :: SpecWith DBStore
 testSetRcvQueueStatus =
@@ -697,7 +697,7 @@ testGetPendingServerCommand st = do
     Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db connId (Just smpServer1)
     corrId' `shouldBe` "4"
   where
-    command = AClientCommand $ NEW True (ACM SCMInvitation) (IKNoPQ PQSupportOn) SMSubscribe
+    command = AClientCommand $ NEW True (ACM SCMInvitation) IKPQOn SMSubscribe
     corruptCmd :: DB.Connection -> ByteString -> ConnId -> IO ()
     corruptCmd db corrId connId = DB.execute db "UPDATE commands SET command = cast('bad' as blob) WHERE conn_id = ? AND corr_id = ?" (connId, corrId)
 

tests/AgentTests/ShortLinkTests.hs

@@ -8,7 +8,7 @@ import AgentTests.ConnectionRequestTests (contactConnRequest, invConnRequest)
 import AgentTests.EqInstances ()
 import Control.Concurrent.STM
 import Control.Monad.Except
-import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), ConnectionMode (..), LinkKey (..), SMPAgentError (..), linkUserData, supportedSMPAgentVRange)
+import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), ConnectionMode (..), LinkKey (..), SConnectionMode (..), SMPAgentError (..), UserLinkData (..), linkUserData, supportedSMPAgentVRange)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.ShortLink as SL
 import Test.Hspec hiding (fit, it)
@@ -30,7 +30,7 @@ testInvShortLink = do
   -- encrypt
   g <- C.newRandom
   sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
       (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest userData
       k = SL.invShortLinkKdf linkKey
   Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
@@ -44,7 +44,7 @@ testInvShortLinkBadDataHash = do
   -- encrypt
   g <- C.newRandom
   sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
       (_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest userData
   -- different key
   linkKey <- LinkKey <$> atomically (C.randomBytes 32 g)
@@ -59,7 +59,7 @@ testContactShortLink = do
   -- encrypt
   g <- C.newRandom
   sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
       (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userData
       (_linkId, k) = SL.contactShortLinkKdf linkKey
   Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
@@ -73,13 +73,13 @@ testUpdateContactShortLink = do
   -- encrypt
   g <- C.newRandom
   sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
       (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userData
       (_linkId, k) = SL.contactShortLinkKdf linkKey
   Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
   -- encrypt updated user data
-  let updatedUserData = "updated user data"
-      signed = SL.encodeSignUserData (snd sigKeys) supportedSMPAgentVRange updatedUserData
+  let updatedUserData = UserLinkData "updated user data"
+      signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange updatedUserData
   Right ud' <- runExceptT $ SL.encryptUserData g k signed
   -- decrypt
   Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k (fd, ud')
@@ -91,7 +91,7 @@ testContactShortLinkBadDataHash = do
   -- encrypt
   g <- C.newRandom
   sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
       (_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userData
   -- different key
   linkKey <- LinkKey <$> atomically (C.randomBytes 32 g)
@@ -106,15 +106,15 @@ testContactShortLinkBadSignature = do
   -- encrypt
   g <- C.newRandom
   sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
-  let userData = "some user data"
+  let userData = UserLinkData "some user data"
       (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userData
       (_linkId, k) = SL.contactShortLinkKdf linkKey
   Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
   -- encrypt updated user data
-  let updatedUserData = "updated user data"
+  let updatedUserData = UserLinkData "updated user data"
   -- another signature key
   (_, pk) <- atomically $ C.generateKeyPair @'C.Ed25519 g
-  let signed = SL.encodeSignUserData pk supportedSMPAgentVRange updatedUserData
+  let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange updatedUserData
   Right ud' <- runExceptT $ SL.encryptUserData g k signed
   -- decryption fails
   SL.decryptLinkData @'CMContact linkKey k (fd, ud')

tests/CoreTests/BatchingTests.hs

@@ -47,6 +47,7 @@ batchingTests = do
       it "should batch with 135 subscriptions per batch" testClientBatchSubscriptions
       it "should batch with 255 ENDs per batch" testClientBatchENDs
       it "should batch with 80 NMSGs per batch" testClientBatchNMSGs
+      it "should batch subscription responses with message" testBatchSubResponses
       it "should break on message that does not fit" testClientBatchWithMessage
       it "should break on large message" testClientBatchWithLargeMessage
 
@@ -207,6 +208,20 @@ testClientBatchNMSGs = do
   (length rs1, length rs2, length rs3) `shouldBe` (40, 80, 80)
   all lenOk [s1, s2, s3] `shouldBe` True
 
+-- 4 responses are used in Simplex.Messaging.Server / `send`
+testBatchSubResponses :: IO ()
+testBatchSubResponses = do
+  client <- testClientStub
+  soks <- replicateM 4 $ randomSOK
+  msg <- randomMSG
+  let msgs = map (\t -> Right (Nothing, encodeTransmission (thParams client) t)) (soks <> [msg])
+      batches = batchTransmissions (thParams client) $ L.fromList msgs
+  length batches `shouldBe` 1
+  soks' <- replicateM 5 $ randomSOK
+  let msgs' = map (\t -> Right (Nothing, encodeTransmission (thParams client) t)) (soks' <> [msg])
+      batches' = batchTransmissions (thParams client) $ L.fromList msgs'
+  length batches' `shouldBe` 2
+
 testClientBatchWithMessageV6 :: IO ()
 testClientBatchWithMessageV6 = do
   client <- testClientStubV6
@@ -361,6 +376,22 @@ randomNMSGCmd ts = do
   Right encNMsgMeta <- pure $ C.cbEncrypt (C.dh' k pk) nonce (smpEncode msgMeta) 128
   pure (CorrId "", EntityId nId, NMSG nonce encNMsgMeta)
 
+randomSOK :: IO (Transmission BrokerMsg)
+randomSOK = do
+  g <- C.newRandom
+  corrId <- atomically $ C.randomBytes 24 g
+  rId <- atomically $ C.randomBytes 24 g
+  pure (CorrId corrId, EntityId rId, SOK Nothing)
+
+randomMSG :: IO (Transmission BrokerMsg)
+randomMSG = do
+  g <- C.newRandom
+  corrId <- atomically $ C.randomBytes 24 g
+  rId <- atomically $ C.randomBytes 24 g
+  msgId <- atomically $ C.randomBytes 24 g
+  msg <- atomically $ C.randomBytes (maxMessageLength currentClientSMPRelayVersion) g
+  pure (CorrId corrId, EntityId rId, MSG RcvMessage {msgId, msgBody = EncRcvMsgBody msg})
+
 randomSENDv6 :: ByteString -> Int -> IO (Either TransportError (Maybe TAuthorizations, ByteString))
 randomSENDv6 = randomSEND_ C.SEd25519 minServerSMPRelayVersion
 

tests/CoreTests/SOCKSSettings.hs

@@ -91,7 +91,7 @@ testSocksMode = do
   where
     transportSocks proxy socksMode = transportSocksCfg defaultNetworkConfig {socksProxy = proxy, socksMode}
     transportSocksCfg cfg host =
-      let TransportClientConfig {socksProxy} = transportClientConfig cfg host False Nothing
+      let TransportClientConfig {socksProxy} = transportClientConfig cfg NRMInteractive host False Nothing
        in socksProxy
 
 testSocksProxyEncoding :: Spec

tests/CoreTests/StoreLogTests.hs

@@ -122,7 +122,7 @@ storeLogTests =
           },
         SLTC
           { name = "create queue, add notifier, register and associate notification service",
-            saved = [CreateQueue rId qr, AddNotifier rId ntfCreds, NewService sr, QueueService rId (ASP SNotifier) (Just serviceId)],
+            saved = [CreateQueue rId qr, AddNotifier rId ntfCreds, NewService sr, QueueService rId (ASP SNotifierService) (Just serviceId)],
             compacted = [NewService sr, CreateQueue rId qr {notifier = Just ntfCreds {ntfServiceId = Just serviceId}}],
             state = M.fromList [(rId, qr {notifier = Just ntfCreds {ntfServiceId = Just serviceId}})]
           },

tests/NtfClient.hs

@@ -206,7 +206,7 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
       [Right ()] <- tPut h [Right (sig, t')]
       pure ()
     tGet' h = do
-      [(Nothing, _, (CorrId corrId, EntityId qId, Right cmd))] <- tGet h
+      [(CorrId corrId, EntityId qId, Right cmd)] <- tGetClient h
       pure (Nothing, corrId, qId, cmd)
 
 ntfTest :: Transport c => TProxy c 'TServer -> (THandleNTF c 'TClient -> IO ()) -> Expectation

tests/NtfServerTests.hs

@@ -72,18 +72,18 @@ ntfSyntaxTests (ATransport t) = do
       Expectation
     command >#> response = withAPNSMockServer $ \_ -> ntfServerTest t command `shouldReturn` response
 
-pattern RespNtf :: CorrId -> QueueId -> NtfResponse -> SignedTransmission ErrorType NtfResponse
-pattern RespNtf corrId queueId command <- (_, _, (corrId, queueId, Right command))
+pattern RespNtf :: CorrId -> QueueId -> NtfResponse -> Transmission (Either ErrorType NtfResponse)
+pattern RespNtf corrId queueId command <- (corrId, queueId, Right command)
 
 deriving instance Eq NtfResponse
 
-sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c 'TClient -> (Maybe TAuthorizations, ByteString, NtfEntityId, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
+sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c 'TClient -> (Maybe TAuthorizations, ByteString, NtfEntityId, NtfCommand e) -> IO (Transmission (Either ErrorType NtfResponse))
 sendRecvNtf h@THandle {params} (sgn, corrId, qId, cmd) = do
   let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
   Right () <- tPut1 h (sgn, tToSend)
   tGet1 h
 
-signSendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c 'TClient -> C.APrivateAuthKey -> (ByteString, NtfEntityId, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
+signSendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c 'TClient -> C.APrivateAuthKey -> (ByteString, NtfEntityId, NtfCommand e) -> IO (Transmission (Either ErrorType NtfResponse))
 signSendRecvNtf h@THandle {params} (C.APrivateAuthKey a pk) (corrId, qId, cmd) = do
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
   Right () <- tPut1 h (authorize tForAuth, tToSend)

tests/SMPAgentClient.hs

@@ -19,7 +19,7 @@ import SMPClient (proxyVRangeV8, ntfTestPort, testPort)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Client (ProtocolClientConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig, defaultSMPClientConfig)
+import Simplex.Messaging.Client (NetworkTimeout (..), ProtocolClientConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig, defaultSMPClientConfig)
 import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
 import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth (..), ProtocolServer)
 import Simplex.Messaging.Transport
@@ -64,7 +64,7 @@ initAgentServers =
     { smp = userServers [testSMPServer],
       ntf = [testNtfServer],
       xftp = userServers [testXFTPServer],
-      netCfg = defaultNetworkConfig {tcpTimeout = 500_000, tcpConnectTimeout = 500_000},
+      netCfg = defaultNetworkConfig {tcpTimeout = NetworkTimeout 500000 500000, tcpConnectTimeout = NetworkTimeout 500000 500000},
       presetDomains = []
     }
 
@@ -96,7 +96,7 @@ agentCfg =
       certificateFile = "tests/fixtures/server.crt"
     }
   where
-    networkConfig = defaultNetworkConfig {tcpConnectTimeout = 1_000_000, tcpTimeout = 2_000_000}
+    networkConfig = defaultNetworkConfig {tcpConnectTimeout = NetworkTimeout 1_000000 1_000000, tcpTimeout = NetworkTimeout 2_000000 2_000000}
 
 agentProxyCfgV8 :: AgentConfig
 agentProxyCfgV8 = agentCfg {smpCfg = (smpCfg agentCfg) {serverVRange = proxyVRangeV8}}

tests/SMPClient.hs

@@ -226,6 +226,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
       newQueueBasicAuth = Nothing,
       controlPortUserAuth = Nothing,
       controlPortAdminAuth = Nothing,
+      dailyBlockQueueQuota = 20,
       messageExpiration = Just defaultMessageExpiration,
       expireMessagesOnStart = True,
       idleQueueInterval = defaultIdleQueueInterval,
@@ -394,7 +395,7 @@ smpServerTest _ t = runSmpTest (ASType SQSMemory SMSJournal) $ \h -> tPut' h t >
       [Right ()] <- tPut h [Right (sig, t')]
       pure ()
     tGet' h = do
-      [(Nothing, _, (CorrId corrId, EntityId qId, Right cmd))] <- tGet h
+      [(CorrId corrId, EntityId qId, Right cmd)] <- tGetClient h
       pure (Nothing, corrId, qId, cmd)
 
 smpTest :: (HasCallStack, Transport c) => TProxy c 'TServer -> AStoreType -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation

tests/SMPProxyTests.hs

@@ -167,37 +167,37 @@ deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
   g <- C.newRandom
   -- set up proxy
   ts <- getCurrentTime
-  pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion currentClientSMPRelayVersion} [] Nothing ts (\_ -> pure ())
+  pc' <- getProtocolClient g NRMInteractive (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion currentClientSMPRelayVersion} [] Nothing ts (\_ -> pure ())
   pc <- either (fail . show) pure pc'
   THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc
   -- set up relay
   msgQ <- newTBQueueIO 1024
-  rc' <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion currentClientSMPRelayVersion} [] (Just msgQ) ts (\_ -> pure ())
+  rc' <- getProtocolClient g NRMInteractive (2, relayServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion currentClientSMPRelayVersion} [] (Just msgQ) ts (\_ -> pure ())
   rc <- either (fail . show) pure rc'
   -- prepare receiving queue
   (rPub, rPriv) <- atomically $ C.generateAuthKeyPair alg g
   (rdhPub, rdhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-  SMP.QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc Nothing (rPub, rPriv) rdhPub (Just "correct") SMSubscribe (QRMessaging Nothing)
+  SMP.QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc NRMInteractive Nothing (rPub, rPriv) rdhPub (Just "correct") SMSubscribe (QRMessaging Nothing) Nothing
   let dec = decryptMsgV3 $ C.dh' srvDh rdhPriv
   -- get proxy session
-  sess0 <- runExceptT' $ connectSMPProxiedRelay pc relayServ (Just "correct")
-  sess <- runExceptT' $ connectSMPProxiedRelay pc relayServ (Just "correct")
+  sess0 <- runExceptT' $ connectSMPProxiedRelay pc NRMInteractive relayServ (Just "correct")
+  sess <- runExceptT' $ connectSMPProxiedRelay pc NRMInteractive relayServ (Just "correct")
   sess0 `shouldBe` sess
   -- send via proxy to unsecured queue
   forM_ unsecuredMsgs $ \msg -> do
-    runExceptT' (proxySMPMessage pc sess Nothing sndId noMsgFlags msg) `shouldReturn` Right ()
-    runExceptT' (proxySMPMessage pc sess {prSessionId = "bad session"} Nothing sndId noMsgFlags msg) `shouldReturn` Left (ProxyProtocolError $ SMP.PROXY SMP.NO_SESSION)
+    runExceptT' (proxySMPMessage pc NRMInteractive sess Nothing sndId noMsgFlags msg) `shouldReturn` Right ()
+    runExceptT' (proxySMPMessage pc NRMInteractive sess {prSessionId = "bad session"} Nothing sndId noMsgFlags msg) `shouldReturn` Left (ProxyProtocolError $ SMP.PROXY SMP.NO_SESSION)
     -- receive 1
     (_tSess, _v, _sid, [(_entId, STEvent (Right (SMP.MSG RcvMessage {msgId, msgBody = EncRcvMsgBody encBody})))]) <- atomically $ readTBQueue msgQ
     dec msgId encBody `shouldBe` Right msg
     runExceptT' $ ackSMPMessage rc rPriv rcvId msgId
   -- secure queue
   (sPub, sPriv) <- atomically $ C.generateAuthKeyPair alg g
-  runExceptT' $ secureSMPQueue rc rPriv rcvId sPub
+  runExceptT' $ secureSMPQueue rc NRMInteractive rPriv rcvId sPub
   -- send via proxy to secured queue
   waitSendRecv
     ( forM_ securedMsgs $ \msg' ->
-        runExceptT' (proxySMPMessage pc sess (Just sPriv) sndId noMsgFlags msg') `shouldReturn` Right ()
+        runExceptT' (proxySMPMessage pc NRMInteractive sess (Just sPriv) sndId noMsgFlags msg') `shouldReturn` Right ()
     )
     ( forM_ securedMsgs $ \msg' -> do
         (_tSess, _v, _sid, [(_entId, STEvent (Right (SMP.MSG RcvMessage {msgId = msgId', msgBody = EncRcvMsgBody encBody'})))]) <- atomically $ readTBQueue msgQ
@@ -210,12 +210,12 @@ proxyConnectDeadRelay n d proxyServ = do
   g <- C.newRandom
   -- set up proxy
   ts <- getCurrentTime
-  pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion sendingProxySMPVersion} [] Nothing ts (\_ -> pure ())
+  pc' <- getProtocolClient g NRMInteractive (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion sendingProxySMPVersion} [] Nothing ts (\_ -> pure ())
   pc <- either (fail . show) pure pc'
   THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc
   -- get proxy session
   replicateM_ n $ do
-    sess0 <- runExceptT $ connectSMPProxiedRelay pc (SMPServer testHost "45678" testKeyHash) (Just "correct")
+    sess0 <- runExceptT $ connectSMPProxiedRelay pc NRMInteractive (SMPServer testHost "45678" testKeyHash) (Just "correct")
     case sess0 of
       Right !_noWay -> error "got unexpected client"
       Left !_err -> threadDelay d
@@ -224,9 +224,9 @@ agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty
 agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 baseId =
   withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->
     withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do
-      (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
+      (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice NRMInteractive 1 True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
       aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-      (sqSecured, Nothing) <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+      (sqSecured, Nothing) <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
       liftIO $ sqSecured `shouldBe` True
       ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
       liftIO $ pqSup' `shouldBe` PQSupportOn
@@ -280,9 +280,9 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
     -- agent connections have to be set up in advance
     -- otherwise the CONF messages would get mixed with MSG
     prePair alice bob = do
-      (bobId, (CCLink qInfo Nothing, Nothing)) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
+      (bobId, (CCLink qInfo Nothing, Nothing)) <- runExceptT' $ A.createConnection alice NRMInteractive 1 True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
       aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-      (sqSecured, Nothing) <- runExceptT' $ A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+      (sqSecured, Nothing) <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
       liftIO $ sqSecured `shouldBe` True
       confId <-
         get alice >>= \case
@@ -331,9 +331,9 @@ agentViaProxyVersionError =
   withAgent 1 agentCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do
     Left (A.BROKER _ (TRANSPORT TEVersion)) <-
       withAgent 2 agentCfg (servers [SMPServer testHost2 testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do
-        (_bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
+        (_bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice NRMInteractive 1 True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
         aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-        A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+        A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
     pure ()
   where
     servers srvs = (initAgentServersProxy_ SPMUnknown SPFProhibit) {smp = userServers srvs}
@@ -351,9 +351,9 @@ agentViaProxyRetryOffline = do
       let pqEnc = CR.PQEncOn
       withServer $ \_ -> do
         (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do
-          (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
+          (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice NRMInteractive 1 True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
           aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-          (sqSecured, Nothing) <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+          (sqSecured, Nothing) <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
           liftIO $ sqSecured `shouldBe` True
           ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
           liftIO $ pqSup' `shouldBe` PQSupportOn
@@ -435,14 +435,14 @@ testNoProxy :: AStoreType -> IO ()
 testNoProxy msType = do
   withSmpServerConfigOn (transport @TLS) (cfgMS msType) testPort2 $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort2 proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
-      (_, _, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", NoEntity, SMP.PRXY testSMPServer Nothing)
+      (_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PRXY testSMPServer Nothing)
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
 
 testProxyAuth :: AStoreType -> IO ()
 testProxyAuth msType = do
   withSmpServerConfigOn (transport @TLS) proxyCfgAuth testPort $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
-      (_, _s, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", NoEntity, SMP.PRXY testSMPServer2 $ Just "wrong")
+      (_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PRXY testSMPServer2 $ Just "wrong")
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
   where
     proxyCfgAuth = updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {newQueueBasicAuth = Just "correct"}

tests/ServerTests.hs

@@ -18,6 +18,7 @@
 module ServerTests where
 
 import Control.Concurrent (ThreadId, killThread, threadDelay)
+import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.STM
 import Control.Exception (SomeException, throwIO, try)
 import Control.Monad
@@ -29,6 +30,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Hashable (hash)
 import qualified Data.IntSet as IS
+import Data.List.NonEmpty (NonEmpty)
 import Data.String (IsString (..))
 import Data.Type.Equality
 import qualified Data.X509.Validation as XV
@@ -75,6 +77,7 @@ serverTests = do
     describe "GET command" testGetCommand
     describe "GET & SUB commands" testGetSubCommands
     describe "Exceeding queue quota" testExceedQueueQuota
+    describe "Concurrent sending and delivery" testConcurrentSendDelivery
   describe "Store log" testWithStoreLog
   describe "Restore messages" testRestoreMessages
   describe "Restore messages (old / v2)" testRestoreExpireMessages
@@ -92,35 +95,44 @@ serverTests = do
     testInvQueueLinkData
     testContactQueueLinkData
 
-pattern Resp :: CorrId -> QueueId -> BrokerMsg -> SignedTransmission ErrorType BrokerMsg
-pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command))
+pattern Resp :: CorrId -> QueueId -> BrokerMsg -> Transmission (Either ErrorType BrokerMsg)
+pattern Resp corrId queueId command <- (corrId, queueId, Right command)
 
-pattern New :: RcvPublicAuthKey -> RcvPublicDhKey -> Command 'Recipient
-pattern New rPub dhPub = NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just (QRMessaging Nothing)))
+pattern New :: RcvPublicAuthKey -> RcvPublicDhKey -> Command 'Creator
+pattern New rPub dhPub = NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just (QRMessaging Nothing)) Nothing)
 
 pattern Ids :: RecipientId -> SenderId -> RcvPublicDhKey -> BrokerMsg
-pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh _sndSecure _linkId Nothing)
+pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh _sndSecure _linkId Nothing Nothing)
 
 pattern Msg :: MsgId -> MsgBody -> BrokerMsg
 pattern Msg msgId body <- MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body}
 
-sendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> (Maybe TAuthorizations, ByteString, EntityId, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
+sendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> (Maybe TAuthorizations, ByteString, EntityId, Command p) -> IO (Transmission (Either ErrorType BrokerMsg))
 sendRecv h@THandle {params} (sgn, corrId, qId, cmd) = do
   let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
   Right () <- tPut1 h (sgn, tToSend)
   tGet1 h
 
-signSendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> (ByteString, EntityId, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
-signSendRecv h pk = signSendRecv_ h pk Nothing
+signSendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> (ByteString, EntityId, Command p) -> IO (Transmission (Either ErrorType BrokerMsg))
+signSendRecv h pk t = do
+  [r] <- signSendRecv_ h pk Nothing t
+  pure r
 
-serviceSignSendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> C.PrivateKeyEd25519 -> (ByteString, EntityId, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
-serviceSignSendRecv h pk = signSendRecv_ h pk . Just
+signSendRecv2 :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> (ByteString, EntityId, Command p) -> IO (Transmission (Either ErrorType BrokerMsg), Transmission (Either ErrorType BrokerMsg))
+signSendRecv2 h pk t = do
+  [r1, r2] <- signSendRecv_ h pk Nothing t
+  pure (r1, r2)
 
-signSendRecv_ :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> Maybe C.PrivateKeyEd25519 -> (ByteString, EntityId, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
+serviceSignSendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> C.PrivateKeyEd25519 -> (ByteString, EntityId, Command p) -> IO (Transmission (Either ErrorType BrokerMsg))
+serviceSignSendRecv h pk serviceKey t = do
+  [r] <- signSendRecv_ h pk (Just serviceKey) t
+  pure r
+
+signSendRecv_ :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> Maybe C.PrivateKeyEd25519 -> (ByteString, EntityId, Command p) -> IO (NonEmpty (Transmission (Either ErrorType BrokerMsg)))
 signSendRecv_ h@THandle {params} (C.APrivateAuthKey a pk) serviceKey_ (corrId, qId, cmd) = do
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
   Right () <- tPut1 h (authorize tForAuth, tToSend)
-  tGet1 h
+  liftIO $ tGetClient h
   where
     authorize t = (,(`C.sign'` t) <$> serviceKey_) <$> case a of
       C.SEd25519 -> Just . TASignature . C.ASignature C.SEd25519 $ C.sign' pk t'
@@ -139,9 +151,9 @@ tPut1 h t = do
   [r] <- tPut h [Right t]
   pure r
 
-tGet1 :: (ProtocolEncoding v err cmd, Transport c) => THandle v c 'TClient -> IO (SignedTransmission err cmd)
+tGet1 :: (ProtocolEncoding v err cmd, Transport c) => THandle v c 'TClient -> IO (Transmission (Either err cmd))
 tGet1 h = do
-  [r] <- liftIO $ tGet h
+  [r] <- liftIO $ tGetClient h
   pure r
 
 (#==) :: (HasCallStack, Eq a, Show a) => (a, a) -> String -> Assertion
@@ -282,7 +294,7 @@ testSndSecureProhibited =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, _dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" rId1 (Ids _rId sId _srvDh) <- signSendRecv r rKey ("abcd", NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just (QRContact Nothing))))
+      Resp "abcd" rId1 (Ids _rId sId _srvDh) <- signSendRecv r rKey ("abcd", NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just (QRContact Nothing)) Nothing))
       (rId1, NoEntity) #== "creates queue"
 
       (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
@@ -297,7 +309,7 @@ testCreateUpdateKeys =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, _dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "1" NoEntity (Ids rId _sId _srvDh) <- signSendRecv h rKey ("1", NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just (QRContact Nothing))))
+      Resp "1" NoEntity (Ids rId _sId _srvDh) <- signSendRecv h rKey ("1", NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just (QRContact Nothing)) Nothing))
       (rPub', rKey') <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       Resp "2" rId1 OK <- signSendRecv h rKey ("2", rId, RKEY [rPub, rPub'])
       rId1 `shouldBe` rId
@@ -365,7 +377,7 @@ testCreateDelete =
       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" _ (SOK Nothing), Resp "" _ (Msg mId2 msg2)) <- signSendRecv2 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)
@@ -404,7 +416,7 @@ stressTest =
         Resp "" NoEntity (Ids rId _ _) <- signSendRecv h1 rKey ("", NoEntity, New rPub dhPub)
         pure rId
       let subscribeQueues h = forM_ rIds $ \rId -> do
-            Resp "" rId' OK <- signSendRecv h rKey ("", rId, SUB)
+            Resp "" rId' (SOK Nothing) <- signSendRecv h rKey ("", rId, SUB)
             rId' `shouldBe` rId
       closeConnection $ connection h1
       subscribeQueues h2
@@ -497,7 +509,7 @@ testSwitchSub =
       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" _ (SOK Nothing), Resp "" _ (Msg mId2' msg2')) <- signSendRecv2 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')
 
@@ -519,7 +531,7 @@ testSwitchSub =
       Resp "" rId' DELD <- tGet1 rh2
       (rId', rId) #== "connection deleted event delivered to subscribed client"
 
-      1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh1 >>= \case
+      1000 `timeout` tGetClient @SMPVersion @ErrorType @BrokerMsg rh1 >>= \case
         Nothing -> return ()
         Just _ -> error "nothing else is delivered to the 1st TCP connection"
 
@@ -620,6 +632,27 @@ testExceedQueueQuota =
         Resp "10" _ OK <- signSendRecv rh rKey ("10", rId, ACK mId4)
         pure ()
 
+testConcurrentSendDelivery :: SpecWith (ASrvTransport, AStoreType)
+testConcurrentSendDelivery =
+  it "should continue delivering messages if message is sent before it is acknowledged" $ \(ATransport t, msType) -> do
+    g <- C.newRandom
+    smpTest3 t msType $ \rh sh1 sh2 -> do
+      (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      (sId, rId, rKey, dhShared) <- createAndSecureQueue rh sPub
+      let dec = decryptMsgV3 dhShared
+          sndMsg sh n = do
+            Resp (CorrId n') _ OK <- signSendRecv sh sKey (n, sId, _SEND ("msg " <> n))
+            n' `shouldBe` n
+          isMsg1or2 mId msg = dec mId msg == Right "msg 1" || dec mId msg == Right "msg 2" `shouldBe` True
+      replicateM_ 50 $ do
+        concurrently_ (sndMsg sh1 "1") (sndMsg sh2 "2")
+        Resp "" _ (Msg mId1 msg1) <- tGet1 rh
+        isMsg1or2 mId1 msg1
+        Resp "3" _ (Msg mId2 msg2) <- signSendRecv rh rKey ("3", rId, ACK mId1)
+        isMsg1or2 mId2 msg2
+        Resp "4" _ OK <- signSendRecv rh rKey ("4", rId, ACK mId2)
+        pure ()
+
 testWithStoreLog :: SpecWith (ASrvTransport, AStoreType)
 testWithStoreLog =
   it "should store simplex queues to log and restore them after server restart" $ \(at@(ATransport t), msType) -> do
@@ -684,7 +717,7 @@ testWithStoreLog =
       nId <- readTVarIO notifierId
       Resp "dabc" _ (SOK Nothing) <- 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)
+      (Resp "cdab" _ (SOK Nothing), Resp "" _ (Msg mId3 msg3)) <- signSendRecv2 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
@@ -762,14 +795,14 @@ testRestoreMessages =
       pure ()
     rId <- readTVarIO recipientId
     logSize testStoreLogFile `shouldReturn` 2
-    logSize testServerStatsBackupFile `shouldReturn` 94
+    logSize testServerStatsBackupFile `shouldReturn` 95
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
     withSmpServerConfigOn at cfg' testPort . runTest t $ \h -> do
       Just rKey <- readTVarIO recipientKey
       Just dh <- readTVarIO dhShared
       let dec = decryptMsgV3 dh
-      Resp "2" _ (Msg mId2 msg2) <- signSendRecv h rKey ("2", rId, SUB)
+      (Resp "2" _ (SOK Nothing), Resp "" _ (Msg mId2 msg2)) <- signSendRecv2 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"
@@ -778,7 +811,7 @@ testRestoreMessages =
     logSize testStoreLogFile `shouldReturn` (if compacting then 1 else 2)
     -- the last message is not removed because it was not ACK'd
     -- logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 94
+    logSize testServerStatsBackupFile `shouldReturn` 95
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -786,7 +819,7 @@ testRestoreMessages =
       Just rKey <- readTVarIO recipientKey
       Just dh <- readTVarIO dhShared
       let dec = decryptMsgV3 dh
-      Resp "4" _ (Msg mId4 msg4) <- signSendRecv h rKey ("4", rId, SUB)
+      (Resp "4" _ (SOK Nothing), Resp "" _ (Msg mId4 msg4)) <- signSendRecv2 h rKey ("4", rId, SUB)
       (dec mId4 msg4, Right "hello 4") #== "restored message delivered"
       Resp "5" _ (Msg mId5 msg5) <- signSendRecv h rKey ("5", rId, ACK mId4)
       (dec mId5 msg5, Right "hello 5") #== "restored message delivered"
@@ -796,7 +829,7 @@ testRestoreMessages =
       pure ()
     logSize testStoreLogFile `shouldReturn` (if compacting then 1 else 2)
     removeFile testStoreLogFile
-    logSize testServerStatsBackupFile `shouldReturn` 94
+    logSize testServerStatsBackupFile `shouldReturn` 95
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
     removeFileIfExists testStoreMsgsFile
@@ -939,7 +972,7 @@ testTiming =
       ]
     timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
     similarTime t1 t2
-      | t1 <= t2 = abs (1 - t1 / t2) < 0.35 -- normally the difference between "no queue" and "wrong key" is less than 5%
+      | t1 <= t2 = abs (1 - t1 / t2) < 0.3 -- normally the difference between "no queue" and "wrong key" is less than 5%
       | otherwise = similarTime t2 t1
     testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg, Int) -> Expectation
     testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, n) = do
@@ -1017,7 +1050,7 @@ testMessageNotifications =
       Resp "5a" _ OK <- signSendRecv rh rKey ("5a", rId, ACK mId2)
       (dec mId2 msg2, Right "hello again") #== "delivered from queue again"
       Resp "" _ (NMSG _ _) <- tGet1 nh2
-      1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg nh1 >>= \case
+      1000 `timeout` tGetClient @SMPVersion @ErrorType @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)
@@ -1027,7 +1060,7 @@ testMessageNotifications =
       Resp "" _ (Msg mId3 msg3) <- tGet1 rh
       (dec mId3 msg3, Right "hello there") #== "delivered from queue again"
       Resp "7a" _ OK <- signSendRecv rh rKey ("7a", rId, ACK mId3)
-      1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg nh2 >>= \case
+      1000 `timeout` tGetClient @SMPVersion @ErrorType @BrokerMsg nh2 >>= \case
         Nothing -> pure ()
         Just _ -> error "nothing else should be delivered to the 2nd notifier's TCP connection"
       (nPub'', nKey'') <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -1069,7 +1102,7 @@ testMessageServiceNotifications =
           Resp "" serviceId2 (ENDS 1) <- tGet1 nh1
           serviceId2 `shouldBe` serviceId
           deliverMessage rh rId rKey sh sId sKey nh2 "hello again" dec
-          1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg nh1 >>= \case
+          1000 `timeout` tGetClient @SMPVersion @ErrorType @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)
@@ -1079,7 +1112,7 @@ testMessageServiceNotifications =
           Resp "" _ (Msg mId3 msg3) <- tGet1 rh
           (dec mId3 msg3, Right "hello there") #== "delivered from queue again"
           Resp "7a" _ OK <- signSendRecv rh rKey ("7a", rId, ACK mId3)
-          1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg nh2 >>= \case
+          1000 `timeout` tGetClient @SMPVersion @ErrorType @BrokerMsg nh2 >>= \case
             Nothing -> pure ()
             Just _ -> error "nothing else should be delivered to the 2nd notifier's TCP connection"
           -- new notification credentials
@@ -1131,16 +1164,15 @@ testMsgExpireOnSend =
         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" _ (SOK Nothing), Resp "" _ (Msg mId msg)) <- signSendRecv2 rh rKey ("3", rId, SUB)
           (dec mId msg, Right "hello (should NOT expire)") #== "delivered"
-          1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh >>= \case
+          1000 `timeout` tGetClient @SMPVersion @ErrorType @BrokerMsg rh >>= \case
             Nothing -> return ()
             Just _ -> error "nothing else should be delivered"
 
 testMsgExpireOnInterval :: SpecWith (ASrvTransport, AStoreType)
 testMsgExpireOnInterval =
-  -- fails on ubuntu
-  xit' "should expire messages that are not received before messageTTL after expiry interval" $ \(ATransport (t :: TProxy c 'TServer), msType) -> do
+  it "should expire messages that are not received before messageTTL after expiry interval" $ \(ATransport (t :: TProxy c 'TServer), msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}, idleQueueInterval = 1}
@@ -1151,9 +1183,9 @@ testMsgExpireOnInterval =
         threadDelay 3000000
         testSMPClient @c $ \rh -> do
           signSendRecv rh rKey ("2", rId, SUB) >>= \case
-            Resp "2" _ OK -> pure ()
+            Resp "2" _ (SOK Nothing) -> pure ()
             r -> unexpected r
-          1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh >>= \case
+          1000 `timeout` tGetClient @SMPVersion @ErrorType @BrokerMsg rh >>= \case
             Nothing -> return ()
             Just _ -> error "nothing should be delivered"
 
@@ -1170,9 +1202,9 @@ testMsgNOTExpireOnInterval =
         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" _ (SOK Nothing), Resp "" _ (Msg mId msg)) <- signSendRecv2 rh rKey ("2", rId, SUB)
           (dec mId msg, Right "hello (should NOT expire)") #== "delivered"
-          1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh >>= \case
+          1000 `timeout` tGetClient @SMPVersion @ErrorType @BrokerMsg rh >>= \case
             Nothing -> return ()
             Just _ -> error "nothing else should be delivered"
 
@@ -1215,9 +1247,9 @@ testInvQueueLinkData =
           qrd = QRMessaging $ Just (sId, ld)
       -- sender ID must be derived from corrId
       Resp "1" NoEntity (ERR (CMD PROHIBITED)) <-
-        signSendRecv r rKey ("1", NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just qrd)))
-      Resp corrId' NoEntity (IDS (QIK rId sId' _srvDh (Just QMMessaging) (Just lnkId) Nothing)) <-
-        signSendRecv r rKey (corrId, NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just qrd)))
+        signSendRecv r rKey ("1", NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just qrd) Nothing))
+      Resp corrId' NoEntity (IDS (QIK rId sId' _srvDh (Just QMMessaging) (Just lnkId) Nothing Nothing)) <-
+        signSendRecv r rKey (corrId, NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just qrd) Nothing))
       (sId', sId) #== "should return the same sender ID"
       corrId' `shouldBe` CorrId corrId
       -- can't read link data with LGET
@@ -1272,9 +1304,9 @@ testContactQueueLinkData =
           qrd = QRContact $ Just (lnkId, (sId, ld))
       -- sender ID must be derived from corrId
       Resp "1" NoEntity (ERR (CMD PROHIBITED)) <-
-        signSendRecv r rKey ("1", NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just qrd)))
-      Resp corrId' NoEntity (IDS (QIK rId sId' _srvDh (Just QMContact) (Just lnkId') Nothing)) <-
-        signSendRecv r rKey (corrId, NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just qrd)))
+        signSendRecv r rKey ("1", NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just qrd) Nothing))
+      Resp corrId' NoEntity (IDS (QIK rId sId' _srvDh (Just QMContact) (Just lnkId') Nothing Nothing)) <-
+        signSendRecv r rKey (corrId, NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just qrd) Nothing))
       (lnkId', lnkId) #== "should return the same link ID"
       (sId', sId) #== "should return the same sender ID"
       corrId' `shouldBe` CorrId corrId
@@ -1346,8 +1378,8 @@ serverSyntaxTests (ATransport t) = do
   describe "NEW" $ do
     it "no parameters" $ (sampleSig, "bcda", "", NEW_) >#> ("", "bcda", "", ERR $ CMD SYNTAX)
     it "many parameters" $ (sampleSig, "cdab", "", (NEW_, ' ', ('\x01', 'A'), samplePubKey, sampleDhPubKey)) >#> ("", "cdab", "", ERR $ CMD SYNTAX)
-    it "no signature" $ ("", "dabc", "", ((NEW_, ' ', samplePubKey, sampleDhPubKey), ('0', SMSubscribe, Just (QRMessaging Nothing)))) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
-    it "queue ID" $ (sampleSig, "abcd", "12345678", ((NEW_, ' ', samplePubKey, sampleDhPubKey), ('0', SMSubscribe, Just (QRMessaging Nothing)))) >#> ("", "abcd", "12345678", ERR $ CMD HAS_AUTH)
+    it "no signature" $ ("", "dabc", "", ((NEW_, ' ', samplePubKey, sampleDhPubKey), ('0', SMSubscribe, Just (QRMessaging Nothing), '0'))) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
+    it "queue ID" $ (sampleSig, "abcd", "12345678", ((NEW_, ' ', samplePubKey, sampleDhPubKey), ('0', SMSubscribe, Just (QRMessaging Nothing), '0'))) >#> ("", "abcd", "12345678", ERR $ CMD HAS_AUTH)
   describe "KEY" $ do
     it "valid syntax" $ (sampleSig, "bcda", "12345678", (KEY_, ' ', samplePubKey)) >#> ("", "bcda", "12345678", ERR AUTH)
     it "no parameters" $ (sampleSig, "cdab", "12345678", KEY_) >#> ("", "cdab", "12345678", ERR $ CMD SYNTAX)

tests/XFTPAgent.hs

@@ -33,6 +33,7 @@ import Simplex.Messaging.Agent (AgentClient, testProtocolServer, xftpDeleteRcvFi
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, xftpCfg)
 import Simplex.Messaging.Agent.Protocol (AEvent (..), AgentErrorType (..), BrokerErrorType (..), noAuthSrv)
+import Simplex.Messaging.Client (pattern NRMInteractive)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.File as CF
@@ -674,4 +675,4 @@ testXFTPServerTest newFileBasicAuth srv =
   withXFTPServerCfg testXFTPServerConfig {newFileBasicAuth, xftpPort = xftpTestPort2} $ \_ ->
     -- initially passed server is not running
     withAgent 1 agentCfg initAgentServers testDB $ \a ->
-      testProtocolServer a 1 srv
+      testProtocolServer a NRMInteractive 1 srv