fix

CHANGELOG.md

@@ -1,14 +1,3 @@
-# 6.0.3
-
-Agent:
-- fix possible stuck queue rotation (#1290).
-
-SMP server:
-- batch END responses when subscribed client switches to reduce server and client traffic.
-- reduce STM transactions for better performance.
-- add stats for END events and for SUB/DEL event batches.
-- remove "expensive" stats to save memory.
-
 # 6.0.2
 
 SMP agent:

apps/ntf-server/Main.hs

@@ -15,7 +15,7 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 main :: IO ()
 main = do
-  setLogLevel LogInfo
+  setLogLevel LogDebug -- change to LogError in production
   cfgPath <- getEnvPath "NTF_SERVER_CFG_PATH" defaultCfgPath
   logPath <- getEnvPath "NTF_SERVER_LOG_PATH" defaultLogPath
   withGlobalLogging logCfg $ ntfServerCLI cfgPath logPath

package.yaml

@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.3.0
+version: 6.0.2.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -47,7 +47,6 @@ dependencies:
   - direct-sqlcipher == 2.3.*
   - directory == 1.3.*
   - filepath == 1.4.*
-  - hashable == 1.4.*
   - hourglass == 0.2.*
   - http-types == 0.12.*
   - http2 >= 4.2.2 && < 4.3

protocol/xrcp.md

@@ -250,7 +250,7 @@ In pseudo-code:
 ```
 // session 1
 hostHelloSecret(1) = dhSecret(1)
-sessionSecret(1) = sha3-256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
+sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
 dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1))
 kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1))
 // kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO
@@ -262,7 +262,7 @@ dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n))
 
 // session n
 hostHelloSecret(n) = dhSecret(n)
-sessionSecret(n) = sha3-256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
+sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
 dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n))
 // controllerDhKey(n) is either from invitation or from multicast announcement
 kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n))

rfcs/2024-06-21-short-links.md

@@ -1,124 +0,0 @@
-# Short invitation links
-
-## Problem
-
-Long links look scary and unsafe for many users. While this is a perceived problem, rather than a real one, it hurts adoption.
-
-What is worse, long links do not fit in profile descriptions of other social networks where people might want to advertize their contact addresses.
-
-The current link size limitation is also the reason for not including PQ KEM keys into invitation links and addresses, postponing the moment when PQ-resistant encryption kicks in - if we include PQ KEM key into the link, the QR code will not be scannable.
-
-Additionally, if we store short links, they can also include chat preferences and public profile data.
-
-## Solution
-
-MITM-resistant link shortening.
-
-Instead of generating the random address that would resolve into the link - doing so would create the possibility of MITM by the server hosting this link - we can use private key as the link ID that will be passed to the accepting party, and the hash of the public key as ID for the server - the accepting party would present this key itself as ID and it will also be used for server to client encryption (see Protocol below). HKDF will be used to derive symmetric key from private key and used in secret_box together with random nonce (to allow replacing data with the same key but with a different nonce - nonce will be sent to the server too). secret_box construction is authenticated encryption, so it would protect from MITM.
-
-The proposed syntax:
-
-```abnf
-shortConnectionRequest = connectionScheme "/" connReqType "#/" smpServer "/" linkHash
-connReqType = %s"invitation" / %s"contact"
-connectionScheme = (%s"https://" clientAppServer) / %s"simplex:"
-clientAppServer = hostname [ ":" port ]
-  ; client app server, e.g. simplex.chat
-smpServer = serverIdentity "@" srvHosts [":" port] ; no smp:// prefix, no escaping
-srvHosts = <hostname> ["," srvHosts] ; RFC1123, RFC5891
-linkHash = <base64url encoded SHA256 or SHA512 hash of the original link>
-```
-
-If SMP server supports pages, its name can be used as clientAppServer, without repeating it after #, for a shorter link.
-
-Example link:
-
-```
-https://simplex.chat/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im/abcdefghij0123456789abcdefghij0123456789abc=
-```
-
-This link has the length of ~136 characters (256 bits), which is shorter than the full contact address (~310 characters) and much shorter than invitation links (~528 characters) even without post-quantum keys added to them.
-
-This size can be further reduced by
-- use server domain in the link.
-- do not include onion address, as the connection happens via proxy anyway, if it's untrusted server.
-- not pinning server TLS certificate - the downside here is that while the attack that compromises TLS will not be able to substitute the link (because it's hash will not match), it will be able to intercept and to block it.
-- using shorter hash, e.g. SHA128 - reducing the collision resistance.
-
-If the server is known, the client could use it's hash and onion address, otherwise it could trust the proxy to use any existing session with the same hostname or to accept the risk of interception - given that there is no risk of substitution.
-
-With the first two of these "improvements" the link could be ~122 characters:
-
-```
-https://smp8.simplex.im/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@/abcdefghij0123456789abcdefghij0123456789abc
-```
-
-If onion address is preserved the link will be ~184 characters (won't fit in Twitter 160 characters bio):
-
-```
-https://smp8.simplex.im/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion/abcdefghij0123456789abcdefghij0123456789abc
-```
-
-If we implement it, the request to resolve the link would be made via proxied SMP command (to avoid the direct connection between the client and the recipient's server).
-
-Pros:
-- a bit shorter link.
-- possibility to include post-quantum keys into the full link keeping the same shortened link size.
-- possibility to include chat profile of contact or group, and preferences, for a much better connection experience, and to show this information when the link sent in the conversation (clients can resolve them automatically, without connecting - it can be resolved by the sending clients).
-- server will not have access to the link.
-
-Cons:
-- protocol complexity.
-- observers can access the link content, so for 1-time invitation we should only include permissions and not profile.
-
-Pros are a huge improvement of UX of connecting both within and from outside of the app (e.g., link can be resolved even before creating chat profile, as part of the onboarding).
-
-## Protocol
-
-To support short links, the SMP servers would provide a simple key-value store enabled by three additional commands: `WRT`, `CLR` and `READ`
-
-`WRT` command is used to store and to update values in the store. The size of the value is limited by the same size as sent messages (or, possibly, smaller - as connection information size used in confirmation messages) - the clients would use this fixed size irrespective of the content. `WRT` command will be sent with the data blob ID in the transaction entityId field, public authorization key used to authorize `WRT` and `CLR` commands (subsequent WRT commands to the existing key must use the same key), and the data blob.
-
-`CLR` command must use with the same entity ID and must be authorized by the same key.
-
-`READ` command must use the ID which hash would be equal of the ID used to create the data blob, and this ID would also be used as public authorization
-
-## Algorithm to store and to retrieve data blob.
-
-**Store data blob**
-
-- the data blob owner generates X25519 key pair: `(k, pk)`.
-- private key `pk` will be included in the short link shared with the other party (only base64url encoded key bytes, not X509 encoding).
-- `HKDF(pk)` will be used to encrypt the link data with secret_box before storing it on the server.
-- the hash of public key `sha256(k)` will be used as ID by the owner to store and to remove the data blob (`WRT` and `CLR` commands).
-
-**Retrieve data blob**
-
-- the sender uses the public key `k` derived from the private key `pk` included in the link as entity ID to retrieve data blob (the server will compute the ID used by the owner as `sha256(k)` and will be able to look it up). This provides the quality that the traffic of the parties has no shared IDs inside TLS. It also means that unlike message queue creation, the ID to retrieve the blob was never sent to the blob creator, and also is not known to the server in advance (the second part is only an observation, in itself it does not increase security, as server has access to an encrypted blob anyway).
-- note that the sender does not authorize the request to retrieve the blob, as it would not increase security unless a different key is used to authorize, and adding a key would increase link size.
-- server session keys with the sender will be `(sk, spk)`, where `sk` is public key shared with the sender during session handshake, and `spk` is the private key known only to the server.
-- this public key `k` will also be combined with server session key `spk` using `dh(k, spk)` to encrypt the response, so that there is no ciphertext in common in sent and received traffic for these blobs. Correlation ID will be used as a nonce for this encryption.
-- having received the blob, the client can now decrypt it using secret_box with `HKDF(pk)`.
-
-Using the same key as ID for the request, and also to additionally encrypt the response allows to use a single key in the link, without increasing the link size.
-
-## Threat model
-
-**Compromised SMP server**
-
-can:
-- delete link data.
-- hide link selectively from some requests.
-
-cannot:
-- undetectably replace link data.
-- access unencrypted link data, whether it was or was not accessed by the accepting party.
-- observe IP addresses of the users accessing link data.
-
-**Passive observer who observed short link**:
-
-can:
-- access original unencrypted link data
-
-cannot:
-- replace or delete the link data

rfcs/2024-07-06-ios-notifications.md

@@ -1,18 +0,0 @@
-# iOS notifications stability
-
-## Problem
-
-iOS notifications may fail to deliver for several reasons, but there are two important reasons that we could address:
-- when notification server is not subscribed to SMP server(s), the notifications can be dropped - it can happen because either notification server restarts or becuase SMP server restarted and some messages are received before notification server resubscribed. We lose approximately 3% of notifications because of this reason.
-- when user device is offline or has low power condition, Apple does not deliver notification, but puts them to storage. If while the notification is in storage a new one arrives it would overwrite the previous notification. If it was the message to the same message queue, the client will download messages anyway, up to a limit, but if the message was to another queue, it will not be delivered until the app is opened. Apple delivers about 88% of notifications that should be delivered (not accounting for uninstalled apps), the rest is replaced with the newer notifications.
-
-## Solution
-
-The first problem can be solved by preserving notifications for a limited time (say 1 hour) in case there is no subscription to notification from notification server. At the very least, they can be preserved in SMP server memory but can also be stored to a file on restart, similar to messages, and be delivered when notification server resubscribes. It is sufficient to store one notification per messaging queue.
-
-The second problem is both more damaging and more complex to solve. The solution could be to always deliver several last notifications to different queues in one packet (Apple allows up to ~4-5kb notification size, and we are sending packets of fixed size 512 bytes, so we could fit up to 8-10 of them in each notification).
-
-Every time a client receives such batch of notifications if can:
-- check if that notification was already received in the previous batch.
-- if it was received, it would be ignored, otherwise it would be processed.
-- process them one by one, started from the most recent one while the time allows.

rfcs/2024-09-05-queue-storage.md

@@ -1,81 +0,0 @@
-# Storage considerations for SMP queues
-
-See [Short invitation links](./2024-06-21-short-links.md).
-
-## Problem
-
-1) queue records are created permanently, until the clients delete them.
-
-2) clients only delete queue records based on some user action, pending connections do not expire.
-
-While part 2 should be improved in the client, indefinite storage of queue records becomes a much bigger issue if each of them would result in a permanent storage of 4-16kb blob in server memory, without server-side expiration for short invitation links.
-
-## Possible solutions
-
-1) Add some queue timestamp, e.g. queue creation date, to expire unsecured queues after say 3 weeks.
-
-The problem with this approach is that contact addresses are also unsecured queues, and they should not be expired.
-
-We could set really large expiration time, and require that clients "update" the unsecured queues they need at least every 1-2 years, but it would not solve the problem of storing a large number of blobs in the server memory for unused/abandoned 1-time invitations.
-
-2) Do not store blobs in memory / append-only log, and instead use something like RocksDB. While it may be a correct long term solution, it may be not expedient enough at the current POC stage for this feature. Also, the lack of expiration is wrong in any case and would indefinitely grow server storage.
-
-3) Add flag allowing the server to differentiate permanent queues used as contact addresses, also using different blob sizes for them. In this case, messaging queues will be expired if not secured after 3 weeks, and contact address queues would be expired if not "updated" by the owner within 2 years.
-
-Probably all three solutions need to be used, to avoid creating a non-expiring blob storage in memory, as in case too many of such blobs are created it would not be possible to differentiate between real users and resource exhaustion attacks, and unlike with messages, they won't be expiring too.
-
-Servers already can differentiate messaging queues and contact address queues, if they want to:
-- with the old 4-message handshake, the confirmation message on a normal queue was different, and also KEY command was eventually used.
-- with the fast 2-message handshake, while the confirmation message has the same syntax, and the differences are inside encrypted envelope, the client still uses SKEY command.
-- in both cases, the usual messaging queues are secured, and contact addresses are not, so this difference is visible in the storage as well (although it is not easy to differentiate between abandoned 1-time invitations and contact addresses).
-
-Differentiating these queues can also allow different message retention times - e.g., the queues for contact addresses could have bigger size, but have lower message retention time.
-
-## Proposed solution
-
-1. Add queue updated_at date into queue records. While it adds some metadata, it seems necessary to manage retention and quality of service. It will not include exact time, only date, and the time of creation will be replaced by the time of any update - queue secured, a message is sent, or queue owner subscribes to the queue. To avoid the need to update store log on every message this information can be appended to store log on server termination. Or given that only one update per day is needed it may be ok to make these updates as they happen (temporarily making the sequence and time of these events available in storage).
-
-2. Add flag to indicate the queue usage - messaging queue or queue for contact address connection requests. This would result in different queue size and different retention policy for queue and its messages. We already have "sender can secure flag" which is, effectively, this flag - contact address queues are never secured. So this does not increase stored metadata in any way.
-
-## Possible changes to short links
-
-This is a design considerations and a concept, not a design yet.
-
-Instead of implementing a generic blob storage that can be used as an attack vector, and adds additional failure point (another server storing blob that is necessary to connect to the queue on the current server), but instead adds an extended queue information blobs, most of which could be dropped without the loss of connectivity, so that the attack can be mitigated by deleting these blobs without users losing the ability to connect, as long as the queue and minimal extended information is retained.
-
-So, to make the connection there need to be these elements:
-
-- queue server and queue ID - mandatory part, that can be included in short link
-- SMP key - mandatory part for all queues. We are considering initializing ratchets earlier for contact addresses, and include ratchet keys and pre-keys into queue data as well, but it is out of scope here.
-- Ratchet keys - mandatory part for 1-time invitation that won't fit in short link.
-- PQ key - optional part that can be stored with addresses if ratchet keys are added and with 1-time invitations.
-- App blobs - chat preferences for 1-time invitation links and profile information for contact addresses.
-
-So rather that storing one blob with a large address inside it, not associated with the queue, increasing probability of failure and reducing our ability to mitigate resource exhaustion, we could store extended blobs associated with the queues.
-
-Also, we need the address shared with the sender (party accepting the connection) to be short. We could use a similar approach that was proposed for data blobs, using a single random seed per queues to derive multiple keys and IDs from it. For example:
-
-1. The queue owner:
-  - generates Ed25529 key pair `(sk, spk)` and X25519 key pair `(dhk, dhpk)` to use with the server, same as now sent in NEW command.
-  - generates queue recipient ID (this ID can still be server-generated).
-  - generates X25519 key pair `(k, pk)` to use with the accepting party.
-  - derives from `k`:
-    - sender ID.
-    - symmetric key for authenticated encryption of blobs.
-  - `k` will be used as short link.
-2. All other data from the invitation can be included in queue creation request and be associated with the queue as 1-3 blobs with different priority:
-  - ratchet keys - it will have a small size, so only this blob cannot be removed, while other blobs can be removed in case of resource exhaustion.
-  - PQ keys - optional blob.
-  - conversation preferences and profile - can be removed depending on creation time, e.g. all new blobs can be removed.
-
-The algorithm used to derive key and ID from `k` needs to be cryptographically secure, e.g. it could be some KDF or ChaCha DRG initialized with `k` as seed, TBC.
-
-So, coupling blob storage with messaging queues has these pros/cons:
-
-Cons:
-- no additional layer of privacy - the server used for connection is visible in the link, even after the blobs are removed from the server.
-
-Pros:
-- no additional point of failure in the connection process - the same server will be used to retrieve necessary blobs as for connection.
-- queue blobs of messaging blobs will be automatically removed once the queue is secured or expired, without additional request from the recipient - reducing the storage and the time these blobs are available.
-- queue blobs for contact addresses will be structured and some of the large blobs can be removed in case of resource exhaustion attack (and recreated by the client if needed), with the only downside that PQ handshake will be postponed (which is the case now) and profile will not be available at a point of connection.

simplexmq.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.3.0
+version:        6.0.2.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -167,8 +167,6 @@ library
       Simplex.Messaging.Server
       Simplex.Messaging.Server.CLI
       Simplex.Messaging.Server.Control
-      Simplex.Messaging.Server.DataLog
-      Simplex.Messaging.Server.DataStore
       Simplex.Messaging.Server.Env.STM
       Simplex.Messaging.Server.Expiration
       Simplex.Messaging.Server.Information
@@ -238,7 +236,6 @@ library
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
-    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -313,7 +310,6 @@ executable ntf-server
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
-    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -393,7 +389,6 @@ executable smp-server
     , directory ==1.3.*
     , file-embed
     , filepath ==1.4.*
-    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -472,7 +467,6 @@ executable xftp
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
-    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -548,7 +542,6 @@ executable xftp-server
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
-    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -660,7 +653,6 @@ test-suite simplexmq-test
     , directory ==1.3.*
     , filepath ==1.4.*
     , generic-random ==1.5.*
-    , hashable ==1.4.*
     , hourglass ==0.2.*
     , hspec ==2.11.*
     , hspec-core ==2.11.*

src/Simplex/FileTransfer/Agent.hs

@@ -45,7 +45,7 @@ import Data.List (foldl', partition, sortOn)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Maybe (mapMaybe)
 import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
@@ -74,7 +74,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (strDecode, strEncode)
-import Simplex.Messaging.Protocol (ProtocolServer, ProtocolType (..), XFTPServer)
+import Simplex.Messaging.Protocol (EntityId, ProtocolServer, ProtocolType (..), XFTPServer)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (catchAll_, liftError, tshow, unlessM, whenM)
 import System.FilePath (takeFileName, (</>))
@@ -190,9 +190,8 @@ runXFTPRcvWorker c srv Worker {doWork} = do
     runXFTPOperation :: AgentConfig -> AM ()
     runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpConsecutiveRetries} =
       withWork c doWork (\db -> getNextRcvChunkToDownload db srv rcvFilesTTL) $ \case
-        (RcvFileChunk {rcvFileId, rcvFileEntityId, fileTmpPath, replicas = []}, _, redirectEntityId_) ->
-          rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ (Just fileTmpPath) (INTERNAL "chunk has no replicas")
-        (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays, redirectEntityId_) -> do
+        (RcvFileChunk {rcvFileId, rcvFileEntityId, fileTmpPath, replicas = []}, _) -> rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) (INTERNAL "chunk has no replicas")
+        (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays) -> do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
             liftIO $ waitWhileSuspended c
@@ -203,7 +202,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
           where
             retryLoop loop e replicaDelay = do
               flip catchAgentError (\_ -> pure ()) $ do
-                when (serverHostError e) $ notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFWARN e)
+                when (serverHostError e) $ notify c rcvFileEntityId $ RFWARN e
                 liftIO $ closeXFTPServerClient c userId server digest
                 withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
               liftIO $ assertAgentForeground c
@@ -212,7 +211,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
               atomically . incXFTPServerStat c userId srv $ case e of
                 XFTP _ XFTP.AUTH -> downloadAuthErrs
                 _ -> downloadErrs
-              rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ (Just fileTmpPath) e
+              rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) e
     downloadFileChunk :: RcvFileChunk -> RcvFileChunkReplica -> Bool -> AM ()
     downloadFileChunk RcvFileChunk {userId, rcvFileId, rcvFileEntityId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath} replica approvedRelays = do
       unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwE $ FILE NOT_APPROVED
@@ -263,11 +262,11 @@ retryOnError name loop done e = do
     then loop
     else done
 
-rcvWorkerInternalError :: AgentClient -> DBRcvFileId -> RcvFileId -> Maybe RcvFileId -> Maybe FilePath -> AgentErrorType -> AM ()
-rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ tmpPath err = do
+rcvWorkerInternalError :: AgentClient -> DBRcvFileId -> RcvFileId -> Maybe FilePath -> AgentErrorType -> AM ()
+rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath err = do
   lift $ forM_ tmpPath (removePath <=< toFSFilePath)
   withStore' c $ \db -> updateRcvFileError db rcvFileId (show err)
-  notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFERR err)
+  notify c rcvFileEntityId $ RFERR err
 
 runXFTPRcvLocalWorker :: AgentClient -> Worker -> AM ()
 runXFTPRcvLocalWorker c Worker {doWork} = do
@@ -280,8 +279,8 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
     runXFTPOperation :: AgentConfig -> AM ()
     runXFTPOperation AgentConfig {rcvFilesTTL} =
       withWork c doWork (`getNextRcvFileToDecrypt` rcvFilesTTL) $
-        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath, redirect} ->
-          decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId (redirectEntityId <$> redirect) tmpPath
+        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath} ->
+          decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath
     decryptFile :: RcvFile -> AM ()
     decryptFile RcvFile {rcvFileId, rcvFileEntityId, size, digest, key, nonce, tmpPath, saveFile, status, chunks, redirect} = do
       let CryptoFile savePath cfArgs = saveFile
@@ -347,7 +346,7 @@ xftpDeleteRcvFiles' c rcvFileEntityIds = do
     batchFiles :: (DB.Connection -> DBRcvFileId -> IO a) -> [RcvFile] -> AM' [Either AgentErrorType a]
     batchFiles f rcvFiles = withStoreBatch' c $ \db -> map (\RcvFile {rcvFileId} -> f db rcvFileId) rcvFiles
 
-notify :: forall m e. (MonadIO m, AEntityI e) => AgentClient -> AEntityId -> AEvent e -> m ()
+notify :: forall m e. (MonadIO m, AEntityI e) => AgentClient -> EntityId -> AEvent e -> m ()
 notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, AEvt (sAEntity @e) cmd)
 
 xftpSendFile' :: AgentClient -> UserId -> CryptoFile -> Int -> AM SndFileId

src/Simplex/FileTransfer/Client.hs

@@ -50,7 +50,6 @@ import Simplex.Messaging.Protocol
     ProtocolServer (..),
     RecipientId,
     SenderId,
-    pattern NoEntity,
   )
 import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters)
 import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
@@ -223,7 +222,7 @@ createXFTPChunk ::
   Maybe BasicAuth ->
   ExceptT XFTPClientError IO (SenderId, NonEmpty RecipientId)
 createXFTPChunk c spKey file rcps auth_ =
-  sendXFTPCommand c spKey NoEntity (FNEW file rcps auth_) Nothing >>= \case
+  sendXFTPCommand c spKey "" (FNEW file rcps auth_) Nothing >>= \case
     (FRSndIds sId rIds, body) -> noFile body (sId, rIds)
     (r, _) -> throwE $ unexpectedResponse r
 
@@ -279,7 +278,7 @@ pingXFTP :: XFTPClient -> ExceptT XFTPClientError IO ()
 pingXFTP c@XFTPClient {thParams} = do
   t <-
     liftEither . first PCETransportError $
-      xftpEncodeTransmission thParams ("", NoEntity, FileCmd SFRecipient PING)
+      xftpEncodeTransmission thParams ("", "", FileCmd SFRecipient PING)
   (r, _) <- sendXFTPTransmission c t Nothing
   case r of
     FRPong -> pure ()

src/Simplex/FileTransfer/Client/Main.hs

@@ -44,7 +44,7 @@ import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
+import qualified Data.Map as M
 import Data.Maybe (fromMaybe, listToMaybe)
 import qualified Data.Text as T
 import Data.Word (Word32)

src/Simplex/FileTransfer/Description.hs

@@ -1,9 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -55,7 +53,7 @@ import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
+import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Data.String
 import Data.Text (Text)
@@ -141,9 +139,12 @@ data FileChunkReplica = FileChunkReplica
   }
   deriving (Eq, Show)
 
-newtype ChunkReplicaId = ChunkReplicaId {unChunkReplicaId :: XFTPFileId}
+newtype ChunkReplicaId = ChunkReplicaId {unChunkReplicaId :: ByteString}
   deriving (Eq, Show)
-  deriving newtype (StrEncoding)
+
+instance StrEncoding ChunkReplicaId where
+  strEncode (ChunkReplicaId fid) = strEncode fid
+  strP = ChunkReplicaId <$> strP
 
 instance FromJSON ChunkReplicaId where
   parseJSON = strParseJSON "ChunkReplicaId"
@@ -152,6 +153,10 @@ instance ToJSON ChunkReplicaId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
+instance FromField ChunkReplicaId where fromField f = ChunkReplicaId <$> fromField f
+
+instance ToField ChunkReplicaId where toField (ChunkReplicaId s) = toField s
+
 data YAMLFileDescription = YAMLFileDescription
   { party :: FileParty,
     size :: String,

src/Simplex/FileTransfer/Protocol.hs

@@ -41,7 +41,6 @@ import Simplex.Messaging.Protocol
     ProtocolType (..),
     RcvPublicAuthKey,
     RcvPublicDhKey,
-    EntityId (..),
     RecipientId,
     SenderId,
     SentRawTransmission,
@@ -171,7 +170,7 @@ data FileInfo = FileInfo
   }
   deriving (Show)
 
-type XFTPFileId = EntityId
+type XFTPFileId = ByteString
 
 instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand p) where
   type Tag (FileCommand p) = FileCommandTag p
@@ -192,7 +191,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, _, fileId, _) cmd = case cmd of
     -- FNEW must not have signature and chunk ID
     FNEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
@@ -302,7 +301,7 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials (_, _, entId, _) cmd = case cmd of
     FRSndIds {} -> noEntity
     -- ERR response does not always have entity ID
     FRErr _ -> Right cmd

src/Simplex/FileTransfer/Server.hs

@@ -9,7 +9,6 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -38,7 +37,6 @@ import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Word (Word32)
 import qualified Data.X509 as X
 import GHC.IO.Handle (hSetNewlineMode)
-import GHC.IORef (atomicSwapIORef)
 import GHC.Stats (getRTSStats)
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Server as H
@@ -54,7 +52,7 @@ 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 (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
+import Simplex.Messaging.Protocol (CorrId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth)
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Stats
@@ -65,7 +63,7 @@ import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
 import Simplex.Messaging.Transport.HTTP2.Server
-import Simplex.Messaging.Transport.Server (runLocalTCPServer, tlsServerCredentials)
+import Simplex.Messaging.Transport.Server (runTCPServer, tlsServerCredentials)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Exit (exitFailure)
@@ -209,17 +207,17 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
           hSetBuffering h LineBuffering
           ts <- getCurrentTime
-          fromTime' <- atomicSwapIORef fromTime ts
-          filesCreated' <- atomicSwapIORef filesCreated 0
-          fileRecipients' <- atomicSwapIORef fileRecipients 0
-          filesUploaded' <- atomicSwapIORef filesUploaded 0
-          filesExpired' <- atomicSwapIORef filesExpired 0
-          filesDeleted' <- atomicSwapIORef filesDeleted 0
-          files <- liftIO $ periodStatCounts filesDownloaded ts
-          fileDownloads' <- atomicSwapIORef fileDownloads 0
-          fileDownloadAcks' <- atomicSwapIORef fileDownloadAcks 0
-          filesCount' <- readIORef filesCount
-          filesSize' <- readIORef filesSize
+          fromTime' <- atomically $ swapTVar fromTime ts
+          filesCreated' <- atomically $ swapTVar filesCreated 0
+          fileRecipients' <- atomically $ swapTVar fileRecipients 0
+          filesUploaded' <- atomically $ swapTVar filesUploaded 0
+          filesExpired' <- atomically $ swapTVar filesExpired 0
+          filesDeleted' <- atomically $ swapTVar filesDeleted 0
+          files <- atomically $ periodStatCounts filesDownloaded ts
+          fileDownloads' <- atomically $ swapTVar fileDownloads 0
+          fileDownloadAcks' <- atomically $ swapTVar fileDownloadAcks 0
+          filesCount' <- readTVarIO filesCount
+          filesSize' <- readTVarIO filesSize
           hPutStrLn h $
             intercalate
               ","
@@ -249,7 +247,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
       u <- askUnliftIO
       liftIO $ do
         labelMyThread "control port server"
-        runLocalTCPServer cpStarted port $ runCPClient u
+        runTCPServer cpStarted port $ runCPClient u
       where
         runCPClient :: UnliftIO (ReaderT XFTPEnv IO) -> Socket -> IO ()
         runCPClient u sock = do
@@ -311,7 +309,7 @@ data ServerFile = ServerFile
 
 processRequest :: XFTPTransportRequest -> M ()
 processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse}
-  | B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", NoEntity, FRErr BLOCK) Nothing
+  | B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", "", FRErr BLOCK) Nothing
   | otherwise = do
       case xftpDecodeTransmission thParams bodyHead of
         Right (sig_, signed, (corrId, fId, cmdOrErr)) ->
@@ -324,7 +322,7 @@ processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHea
             Left e -> send (FRErr e) Nothing
           where
             send resp = sendXFTPResponse (corrId, fId, resp)
-        Left e -> sendXFTPResponse ("", NoEntity, FRErr e) Nothing
+        Left e -> sendXFTPResponse ("", "", FRErr e) Nothing
   where
     sendXFTPResponse (corrId, fId, resp) serverFile_ = do
       let t_ = xftpEncodeTransmission thParams (corrId, fId, resp)
@@ -407,8 +405,8 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
           logAddFile sl sId file ts
           logAddRecipients sl sId rcps
         stats <- asks serverStats
-        lift $ incFileStat filesCreated
-        liftIO $ atomicModifyIORef'_ (fileRecipients stats) (+ length rks)
+        atomically $ modifyTVar' (filesCreated stats) (+ 1)
+        atomically $ modifyTVar' (fileRecipients stats) (+ length rks)
         let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
         pure $ FRSndIds sId rIds
       pure $ either FRErr id r
@@ -437,7 +435,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
         rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks
         lift $ withFileLog $ \sl -> logAddRecipients sl sId rcps
         stats <- asks serverStats
-        liftIO $ atomicModifyIORef'_ (fileRecipients stats) (+ length rks)
+        atomically $ modifyTVar' (fileRecipients stats) (+ length rks)
         let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
         pure $ FRRcvIds rIds
       pure $ either FRErr id r
@@ -465,19 +463,19 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
               \used -> let used' = used + fromIntegral size in if used' <= quota then (True, used') else (False, used)
           receive = do
             path <- asks $ filesPath . config
-            let fPath = path </> B.unpack (B64.encode $ unEntityId senderId)
+            let fPath = path </> B.unpack (B64.encode senderId)
             receiveChunk (XFTPRcvChunkSpec fPath size digest) >>= \case
               Right () -> do
                 stats <- asks serverStats
                 withFileLog $ \sl -> logPutFile sl senderId fPath
                 atomically $ writeTVar filePath (Just fPath)
-                incFileStat filesUploaded
-                incFileStat filesCount
-                liftIO $ atomicModifyIORef'_ (filesSize stats) (+ fromIntegral size)
+                atomically $ modifyTVar' (filesUploaded stats) (+ 1)
+                atomically $ modifyTVar' (filesCount stats) (+ 1)
+                atomically $ modifyTVar' (filesSize stats) (+ fromIntegral size)
                 pure FROk
               Left e -> do
                 us <- asks $ usedStorage . store
-                atomically $ modifyTVar' us $ subtract (fromIntegral size)
+                atomically . modifyTVar' us $ subtract (fromIntegral size)
                 liftIO $ whenM (doesFileExist fPath) (removeFile fPath) `catch` logFileError
                 pure $ FRErr e
           receiveChunk spec = do
@@ -496,8 +494,8 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
               case LC.cbInit dhSecret cbNonce of
                 Right sbState -> do
                   stats <- asks serverStats
-                  incFileStat fileDownloads
-                  liftIO $ updatePeriodStats (filesDownloaded stats) senderId
+                  atomically $ modifyTVar' (fileDownloads stats) (+ 1)
+                  atomically $ updatePeriodStats (filesDownloaded stats) senderId
                   pure (FRFile sDhKey cbNonce, Just ServerFile {filePath = path, fileSize = size, sbState})
                 _ -> pure (FRErr INTERNAL, Nothing)
         _ -> pure (FRErr NO_FILE, Nothing)
@@ -513,7 +511,8 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
       withFileLog (`logAckFile` rId)
       st <- asks store
       atomically $ deleteRecipient st rId fr
-      incFileStat fileDownloadAcks
+      stats <- asks serverStats
+      atomically $ modifyTVar' (fileDownloadAcks stats) (+ 1)
       pure FROk
 
 deleteServerFile_ :: FileRec -> M (Either XFTPErrorType ())
@@ -525,11 +524,11 @@ deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do
     ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats))
     st <- asks store
     void $ atomically $ deleteFile st senderId
-    lift $ incFileStat filesDeleted
+    atomically $ modifyTVar' (filesDeleted stats) (+ 1)
   where
     deletedStats stats = do
-      liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1)
-      liftIO $ atomicModifyIORef'_ (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
+      atomically $ modifyTVar' (filesCount stats) (subtract 1)
+      atomically $ modifyTVar' (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
 
 expireServerFiles :: Maybe Int -> ExpirationConfig -> M ()
 expireServerFiles itemDelay expCfg = do
@@ -555,21 +554,24 @@ expireServerFiles itemDelay expCfg = do
     delete st sId = do
       withFileLog (`logDeleteFile` sId)
       void . atomically $ deleteFile st sId -- will not update usedStorage if sId isn't in store
-      incFileStat filesExpired
+      FileServerStats {filesExpired} <- asks serverStats
+      atomically $ modifyTVar' filesExpired (+ 1)
 
 randomId :: Int -> M ByteString
 randomId n = atomically . C.randomBytes n =<< asks random
 
 getFileId :: M XFTPFileId
-getFileId = fmap EntityId . randomId =<< asks (fileIdSize . config)
+getFileId = do
+  size <- asks (fileIdSize . config)
+  atomically . C.randomBytes size =<< asks random
 
 withFileLog :: (StoreLog 'WriteMode -> IO a) -> M ()
 withFileLog action = liftIO . mapM_ action =<< asks storeLog
 
-incFileStat :: (FileServerStats -> IORef Int) -> M ()
+incFileStat :: (FileServerStats -> TVar Int) -> M ()
 incFileStat statSel = do
   stats <- asks serverStats
-  liftIO $ atomicModifyIORef'_ (statSel stats) (+ 1)
+  atomically $ modifyTVar (statSel stats) (+ 1)
 
 saveServerStats :: M ()
 saveServerStats =
@@ -592,7 +594,7 @@ restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStat
           FileStore {files, usedStorage} <- asks store
           _filesCount <- M.size <$> readTVarIO files
           _filesSize <- readTVarIO usedStorage
-          liftIO $ setFileServerStats s d {_filesCount, _filesSize}
+          atomically $ setFileServerStats s d {_filesCount, _filesSize}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
           when (statsFilesCount /= _filesCount) $ logWarn $ "Files count differs: stats: " <> tshow statsFilesCount <> ", store: " <> tshow _filesCount

src/Simplex/FileTransfer/Server/Control.hs

@@ -4,7 +4,7 @@
 module Simplex.FileTransfer.Server.Control where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Simplex.FileTransfer.Protocol (XFTPFileId)
+import Data.ByteString (ByteString)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth)
 
@@ -13,7 +13,7 @@ data CPClientRole = CPRNone | CPRUser | CPRAdmin
 data ControlProtocol
   = CPAuth BasicAuth
   | CPStatsRTS
-  | CPDelete XFTPFileId
+  | CPDelete ByteString
   | CPHelp
   | CPQuit
   | CPSkip

src/Simplex/FileTransfer/Server/Stats.hs

@@ -7,24 +7,25 @@ module Simplex.FileTransfer.Server.Stats where
 import Control.Applicative ((<|>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
-import Data.IORef
 import Data.Int (Int64)
 import Data.Time.Clock (UTCTime)
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (SenderId)
 import Simplex.Messaging.Server.Stats (PeriodStats, PeriodStatsData, getPeriodStatsData, newPeriodStats, setPeriodStats)
+import UnliftIO.STM
 
 data FileServerStats = FileServerStats
-  { fromTime :: IORef UTCTime,
-    filesCreated :: IORef Int,
-    fileRecipients :: IORef Int,
-    filesUploaded :: IORef Int,
-    filesExpired :: IORef Int,
-    filesDeleted :: IORef Int,
-    filesDownloaded :: PeriodStats,
-    fileDownloads :: IORef Int,
-    fileDownloadAcks :: IORef Int,
-    filesCount :: IORef Int,
-    filesSize :: IORef Int64
+  { fromTime :: TVar UTCTime,
+    filesCreated :: TVar Int,
+    fileRecipients :: TVar Int,
+    filesUploaded :: TVar Int,
+    filesExpired :: TVar Int,
+    filesDeleted :: TVar Int,
+    filesDownloaded :: PeriodStats SenderId,
+    fileDownloads :: TVar Int,
+    fileDownloadAcks :: TVar Int,
+    filesCount :: TVar Int,
+    filesSize :: TVar Int64
   }
 
 data FileServerStatsData = FileServerStatsData
@@ -34,7 +35,7 @@ data FileServerStatsData = FileServerStatsData
     _filesUploaded :: Int,
     _filesExpired :: Int,
     _filesDeleted :: Int,
-    _filesDownloaded :: PeriodStatsData,
+    _filesDownloaded :: PeriodStatsData SenderId,
     _fileDownloads :: Int,
     _fileDownloadAcks :: Int,
     _filesCount :: Int,
@@ -44,48 +45,47 @@ data FileServerStatsData = FileServerStatsData
 
 newFileServerStats :: UTCTime -> IO FileServerStats
 newFileServerStats ts = do
-  fromTime <- newIORef ts
-  filesCreated <- newIORef 0
-  fileRecipients <- newIORef 0
-  filesUploaded <- newIORef 0
-  filesExpired <- newIORef 0
-  filesDeleted <- newIORef 0
+  fromTime <- newTVarIO ts
+  filesCreated <- newTVarIO 0
+  fileRecipients <- newTVarIO 0
+  filesUploaded <- newTVarIO 0
+  filesExpired <- newTVarIO 0
+  filesDeleted <- newTVarIO 0
   filesDownloaded <- newPeriodStats
-  fileDownloads <- newIORef 0
-  fileDownloadAcks <- newIORef 0
-  filesCount <- newIORef 0
-  filesSize <- newIORef 0
+  fileDownloads <- newTVarIO 0
+  fileDownloadAcks <- newTVarIO 0
+  filesCount <- newTVarIO 0
+  filesSize <- newTVarIO 0
   pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
 
 getFileServerStatsData :: FileServerStats -> IO FileServerStatsData
 getFileServerStatsData s = do
-  _fromTime <- readIORef $ fromTime (s :: FileServerStats)
-  _filesCreated <- readIORef $ filesCreated s
-  _fileRecipients <- readIORef $ fileRecipients s
-  _filesUploaded <- readIORef $ filesUploaded s
-  _filesExpired <- readIORef $ filesExpired s
-  _filesDeleted <- readIORef $ filesDeleted s
+  _fromTime <- readTVarIO $ fromTime (s :: FileServerStats)
+  _filesCreated <- readTVarIO $ filesCreated s
+  _fileRecipients <- readTVarIO $ fileRecipients s
+  _filesUploaded <- readTVarIO $ filesUploaded s
+  _filesExpired <- readTVarIO $ filesExpired s
+  _filesDeleted <- readTVarIO $ filesDeleted s
   _filesDownloaded <- getPeriodStatsData $ filesDownloaded s
-  _fileDownloads <- readIORef $ fileDownloads s
-  _fileDownloadAcks <- readIORef $ fileDownloadAcks s
-  _filesCount <- readIORef $ filesCount s
-  _filesSize <- readIORef $ filesSize s
+  _fileDownloads <- readTVarIO $ fileDownloads s
+  _fileDownloadAcks <- readTVarIO $ fileDownloadAcks s
+  _filesCount <- readTVarIO $ filesCount s
+  _filesSize <- readTVarIO $ filesSize s
   pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
 
--- this function is not thread safe, it is used on server start only
-setFileServerStats :: FileServerStats -> FileServerStatsData -> IO ()
+setFileServerStats :: FileServerStats -> FileServerStatsData -> STM ()
 setFileServerStats s d = do
-  writeIORef (fromTime (s :: FileServerStats)) $! _fromTime (d :: FileServerStatsData)
-  writeIORef (filesCreated s) $! _filesCreated d
-  writeIORef (fileRecipients s) $! _fileRecipients d
-  writeIORef (filesUploaded s) $! _filesUploaded d
-  writeIORef (filesExpired s) $! _filesExpired d
-  writeIORef (filesDeleted s) $! _filesDeleted d
+  writeTVar (fromTime (s :: FileServerStats)) $! _fromTime (d :: FileServerStatsData)
+  writeTVar (filesCreated s) $! _filesCreated d
+  writeTVar (fileRecipients s) $! _fileRecipients d
+  writeTVar (filesUploaded s) $! _filesUploaded d
+  writeTVar (filesExpired s) $! _filesExpired d
+  writeTVar (filesDeleted s) $! _filesDeleted d
   setPeriodStats (filesDownloaded s) $! _filesDownloaded d
-  writeIORef (fileDownloads s) $! _fileDownloads d
-  writeIORef (fileDownloadAcks s) $! _fileDownloadAcks d
-  writeIORef (filesCount s) $! _filesCount d
-  writeIORef (filesSize s) $! _filesSize d
+  writeTVar (fileDownloads s) $! _fileDownloads d
+  writeTVar (fileDownloadAcks s) $! _fileDownloadAcks d
+  writeTVar (filesCount s) $! _filesCount d
+  writeTVar (filesSize s) $! _filesSize d
 
 instance StrEncoding FileServerStatsData where
   strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =

src/Simplex/FileTransfer/Types.hs

@@ -25,9 +25,9 @@ import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (XFTPServer)
 import System.FilePath ((</>))
 
-type RcvFileId = ByteString -- Agent entity ID
+type RcvFileId = ByteString
 
-type SndFileId = ByteString -- Agent entity ID
+type SndFileId = ByteString
 
 authTagSize :: Int64
 authTagSize = fromIntegral C.authTagSize

src/Simplex/Messaging/Agent.hs

@@ -174,10 +174,10 @@ import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId)
-import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..), pnMessagesP)
+import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..))
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, sndAuthKeySMPClientVersion)
+import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, sndAuthKeySMPClientVersion)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
@@ -334,7 +334,7 @@ createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe
 createConnection c userId enableNtfs = withAgentEnv c .:: newConn c userId "" enableNtfs
 {-# INLINE createConnection #-}
 
--- | Changes the user id associated with a connection
+-- | Changes the user id associated with a connection 
 changeConnectionUser :: AgentClient -> UserId -> ConnId -> UserId -> AE ()
 changeConnectionUser c oldUserId connId newUserId = withAgentEnv c $ changeConnectionUser' c oldUserId connId newUserId
 {-# INLINE changeConnectionUser #-}
@@ -891,7 +891,7 @@ joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo
   lift (compatibleContactUri cReqUri) >>= \case
     Just (qInfo, vrsn) -> do
       (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
-      void $ sendInvitation c userId connId' qInfo vrsn cReq cInfo
+      void $ sendInvitation c userId qInfo vrsn cReq cInfo
       pure (connId', False)
     Nothing -> throwE $ AGENT A_VERSION
 
@@ -1020,7 +1020,7 @@ subscribeConnections' c connIds = do
         SomeConn _ conn -> do
           let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCDelete
               ConnData {connId} = toConnData conn
-          atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)
+          atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)            
     resumeDelivery :: Map ConnId SomeConn -> AM ()
     resumeDelivery conns = do
       conns' <- M.restrictKeys conns . S.fromList <$> withStore' c getConnectionsForDelivery
@@ -1065,8 +1065,7 @@ getNotificationMessage' c nonce encNtfInfo = do
   withStore' c getActiveNtfToken >>= \case
     Just NtfToken {ntfDhSecret = Just dhSecret} -> do
       ntfData <- agentCbDecrypt dhSecret nonce encNtfInfo
-      pnMsgs <- liftEither (parse pnMessagesP (INTERNAL "error parsing PNMessageData") ntfData)
-      let PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} = L.last pnMsgs
+      PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} <- liftEither (parse strP (INTERNAL "error parsing PNMessageData") ntfData)
       (ntfConnId, rcvNtfDhSecret) <- withStore c (`getNtfRcvQueue` smpQueue)
       ntfMsgMeta <- (eitherToMaybe . smpDecode <$> agentCbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta) `catchAgentError` \_ -> pure Nothing
       msgMeta <- getConnectionMessage' c ntfConnId
@@ -1104,8 +1103,8 @@ sendMessagesB_ c reqs connIds = withConnLocks c connIds "sendMessages" $ do
   where
     getConn_ :: DB.Connection -> TVar (Maybe (Either AgentErrorType SomeConn)) -> MsgReq -> IO (Either AgentErrorType (MsgReq, SomeConn))
     getConn_ db prev req@(connId, _, _, _) =
-      (req,)
-        <$$> if B.null connId
+      (req,) <$$> 
+        if B.null connId
           then fromMaybe (Left $ INTERNAL "sendMessagesB_: empty prev connId") <$> readTVarIO prev
           else do
             conn <- first storeError <$> getConn db connId
@@ -1344,7 +1343,7 @@ enqueueMessageB c reqs = do
     storeSentMsg db cfg req@(cData@ConnData {connId}, sq :| _, pqEnc_, msgFlags, aMessage) = fmap (first storeError) $ runExceptT $ do
       let AgentConfig {smpAgentVRange, e2eEncryptVRange} = cfg
       internalTs <- liftIO getCurrentTime
-      (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
+      (internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId
       let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
           agentMsg = AgentMessage privHeader aMessage
           agentMsgStr = smpEncode agentMsg
@@ -2209,7 +2208,7 @@ cleanupManager c@AgentClient {subQ} = do
     deleteExpiredReplicasForDeletion = do
       rcvFilesTTL <- asks $ rcvFilesTTL . config
       withStore' c (`deleteDeletedSndChunkReplicasExpired` rcvFilesTTL)
-    notify :: forall e. AEntityI e => AEntityId -> AEvent e -> AM ()
+    notify :: forall e. AEntityI e => EntityId -> AEvent e -> AM ()
     notify entId cmd = atomically $ writeTBQueue subQ ("", entId, AEvt (sAEntity @e) cmd)
 
 data ACKd = ACKd | ACKPending
@@ -2346,7 +2345,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                               HELLO -> helloMsg srvMsgId msgMeta conn'' >> ackDel msgId
                               -- note that there is no ACK sent for A_MSG, it is sent with agent's user ACK command
                               A_MSG body -> do
-                                logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' srvMsgId
+                                logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret srvMsgId
                                 notify $ MSG msgMeta msgFlags body
                                 pure ACKPending
                               A_RCVD rcpts -> qDuplex conn'' "RCVD" $ messagesRcvd rcpts msgMeta
@@ -2356,7 +2355,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                               QUSE qs -> qDuplexAckDel conn'' "QUSE" $ qUseMsg srvMsgId qs
                               -- no action needed for QTEST
                               -- any message in the new queue will mark it active and trigger deletion of the old queue
-                              QTEST _ -> logServer "<--" c srv rId ("MSG <QTEST>:" <> logSecret' srvMsgId) >> ackDel msgId
+                              QTEST _ -> logServer "<--" c srv rId ("MSG <QTEST>:" <> logSecret srvMsgId) >> ackDel msgId
                               EREADY _ -> qDuplexAckDel conn'' "EREADY" $ ereadyMsg rcPrev
                             where
                               qDuplexAckDel :: Connection c -> String -> (Connection 'CDuplex -> AM ()) -> AM ACKd
@@ -2379,7 +2378,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                                 | otherwise ->
                                     liftEither (parse smpP (AGENT A_MESSAGE) agentMsgBody) >>= \case
                                       AgentMessage _ (A_MSG body) -> do
-                                        logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' srvMsgId
+                                        logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret srvMsgId
                                         notify $ MSG msgMeta msgFlags body
                                         pure ACKPending
                                       _ -> ack
@@ -2501,7 +2500,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
 
           smpConfirmation :: SMP.MsgId -> Connection c -> Maybe C.APublicAuthKey -> C.PublicKeyX25519 -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> ByteString -> VersionSMPC -> VersionSMPA -> AM ()
           smpConfirmation srvMsgId conn' senderKey e2ePubKey e2eEncryption encConnInfo smpClientVersion agentVersion = do
-            logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret srvMsgId
             AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
             let ConnData {pqSupport} = toConnData conn'
             unless
@@ -2570,7 +2569,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
 
           helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM ()
           helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do
-            logServer "<--" c srv rId $ "MSG <HELLO>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <HELLO>:" <> logSecret srvMsgId
             case status of
               Active -> prohibited "hello: active"
               _ ->
@@ -2594,7 +2593,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
           continueSending srvMsgId addr (DuplexConnection _ _ sqs) =
             case findQ addr sqs of
               Just sq -> do
-                logServer "<--" c srv rId $ "MSG <QCONT>:" <> logSecret' srvMsgId
+                logServer "<--" c srv rId $ "MSG <QCONT>:" <> logSecret srvMsgId
                 atomically $
                   TM.lookup (qAddress sq) (smpDeliveryWorkers c)
                     >>= mapM_ (\(_, retryLock) -> tryPutTMVar retryLock ())
@@ -2603,7 +2602,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
 
           messagesRcvd :: NonEmpty AMessageReceipt -> MsgMeta -> Connection 'CDuplex -> AM ACKd
           messagesRcvd rcpts msgMeta@MsgMeta {broker = (srvMsgId, _)} _ = do
-            logServer "<--" c srv rId $ "MSG <RCPT>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <RCPT>:" <> logSecret srvMsgId
             rs <- forM rcpts $ \rcpt -> clientReceipt rcpt `catchAgentError` \e -> notify (ERR e) $> Nothing
             case L.nonEmpty . catMaybes $ L.toList rs of
               Just rs' -> notify (RCVD msgMeta rs') $> ACKPending
@@ -2643,7 +2642,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                         sq2 <- withStore c $ \db -> do
                           liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
                           addConnSndQueue db connId (sq_ :: NewSndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
-                        logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret' srvMsgId <> " " <> logSecret (senderId queueAddress)
+                        logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret srvMsgId <> " " <> logSecret (senderId queueAddress)
                         let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
                         void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPublicKey)]
                         sq1 <- withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
@@ -2664,7 +2663,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
               Just rq'@RcvQueue {rcvId, e2ePrivKey = dhPrivKey, smpClientVersion = cVer, status = status'}
                 | status' == New || status' == Confirmed -> do
                     checkRQSwchStatus rq RSSendingQADD
-                    logServer "<--" c srv rId $ "MSG <QKEY>:" <> logSecret' srvMsgId <> " " <> logSecret senderId
+                    logServer "<--" c srv rId $ "MSG <QKEY>:" <> logSecret srvMsgId <> " " <> logSecret senderId
                     let dhSecret = C.dh' dhPublicKey dhPrivKey
                     withStore' c $ \db -> setRcvQueueConfirmedE2E db rq' dhSecret $ min cVer cVer'
                     enqueueCommand c "" connId (Just smpServer) $ AInternalCommand $ ICQSecure rcvId senderKey
@@ -2685,7 +2684,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                 case find ((replaceQId ==) . dbQId) sqs of
                   Just sq1 -> do
                     checkSQSwchStatus sq1 SSSendingQKEY
-                    logServer "<--" c srv rId $ "MSG <QUSE>:" <> logSecret' srvMsgId <> " " <> logSecret (snd addr)
+                    logServer "<--" c srv rId $ "MSG <QUSE>:" <> logSecret srvMsgId <> " " <> logSecret (snd addr)
                     withStore' c $ \db -> setSndQueueStatus db sq' Secured
                     let sq'' = (sq' :: SndQueue) {status = Secured}
                     -- sending QTEST to the new queue only, the old one will be removed if sent successfully
@@ -2709,7 +2708,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
 
           smpInvitation :: SMP.MsgId -> Connection c -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM ()
           smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData _) cInfo = do
-            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret srvMsgId
             case conn' of
               ContactConnection {} -> do
                 -- show connection request even if invitaion via contact address is not compatible.
@@ -2854,7 +2853,7 @@ secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv
       currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
       withStore c $ \db -> runExceptT $ do
         let agentMsgBody = smpEncode aMessage
-        (_, internalSndId, _) <- ExceptT $ updateSndIds db connId
+        (_, internalSndId, _) <- liftIO $ updateSndIds db connId
         liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody)
         let pqEnc = CR.pqSupportToEnc pqSupport
         (encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
@@ -2887,7 +2886,7 @@ storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq
   currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
   withStore c $ \db -> runExceptT $ do
     internalTs <- liftIO getCurrentTime
-    (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
+    (internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId
     let agentMsgStr = smpEncode agentMsg
         internalHash = C.sha256Hash agentMsgStr
         pqEnc = CR.pqSupportToEnc pqSupport
@@ -2913,7 +2912,7 @@ enqueueRatchetKey c cData@ConnData {connId} sq e2eEncryption = do
     storeRatchetKey :: VersionSMPA -> AM InternalId
     storeRatchetKey agentVersion = withStore c $ \db -> runExceptT $ do
       internalTs <- liftIO getCurrentTime
-      (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
+      (internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId
       let agentMsg = AgentRatchetInfo ""
           agentMsgStr = smpEncode agentMsg
           internalHash = C.sha256Hash agentMsgStr

src/Simplex/Messaging/Agent/Client.hs

@@ -12,7 +12,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
@@ -83,7 +82,6 @@ module Simplex.Messaging.Agent.Client
     deleteQueues,
     logServer,
     logSecret,
-    logSecret',
     removeSubscription,
     hasActiveSubscription,
     hasPendingSubscription,
@@ -230,7 +228,7 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parse, sumT
 import Simplex.Messaging.Protocol
   ( AProtocolType (..),
     BrokerMsg,
-    EntityId (..),
+    EntityId,
     ErrorType,
     MsgFlags (..),
     MsgId,
@@ -243,6 +241,7 @@ import Simplex.Messaging.Protocol
     ProtocolServer (..),
     ProtocolType (..),
     ProtocolTypeI (..),
+    QueueId,
     QueueIdsKeys (..),
     RcvMessage (..),
     RcvNtfPublicDhKey,
@@ -256,7 +255,6 @@ import Simplex.Messaging.Protocol
     VersionSMPC,
     XFTPServer,
     XFTPServerWithAuth,
-    pattern NoEntity,
     sameSrvAddr',
   )
 import qualified Simplex.Messaging.Protocol as SMP
@@ -998,7 +996,7 @@ withClient_ c tSess@(_, srv, _) action = do
   where
     logServerError :: AgentErrorType -> AM a
     logServerError e = do
-      logServer "<--" c srv NoEntity $ bshow e
+      logServer "<--" c srv "" $ bshow e
       throwE e
 
 withProxySession :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
@@ -1015,32 +1013,32 @@ withProxySession c proxySrv_ destSess@(_, destSrv, _) entId cmdStr action = do
     proxySrv = showServer . protocolClientServer' . protocolClient
     logServerError :: SMPConnectedClient -> AgentErrorType -> AM a
     logServerError cl e = do
-      logServer ("<-- " <> proxySrv cl <> " <") c destSrv NoEntity $ bshow e
+      logServer ("<-- " <> proxySrv cl <> " <") c destSrv "" $ bshow e
       throwE e
 
-withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> ByteString -> ByteString -> (Client msg -> AM a) -> AM a
+withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> ByteString -> (Client msg -> AM a) -> AM a
 withLogClient_ c tSess@(_, srv, _) entId cmdStr action = do
-  logServer' "-->" c srv entId cmdStr
+  logServer "-->" c srv entId cmdStr
   res <- withClient_ c tSess action
-  logServer' "<--" c srv entId "OK"
+  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
 {-# 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 :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> 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
 {-# INLINE withLogClient #-}
 
 withSMPClient :: SMPQueueRec q => AgentClient -> q -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> AM a
 withSMPClient c q cmdStr action = do
   tSess <- mkSMPTransportSession c q
-  withLogClient c tSess (unEntityId $ queueId q) cmdStr $ action . connectedClient
+  withLogClient c tSess (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 =
-  sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendViaProxy sendDirectly
+sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
+sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg =
+  sendOrProxySMPCommand c userId destSrv cmdStr senderId sendViaProxy sendDirectly
   where
     sendViaProxy smp proxySess = do
       atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts
@@ -1054,15 +1052,14 @@ sendOrProxySMPCommand ::
   AgentClient ->
   UserId ->
   SMPServer ->
-  ConnId ->
   ByteString ->
   SMP.SenderId ->
   (SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError ())) ->
   (SMPClient -> ExceptT SMPClientError IO ()) ->
   AM (Maybe SMPServer)
-sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
-  tSess <- mkTransportSession c userId destSrv connId
-  ifM shouldUseProxy (sendViaProxy Nothing tSess) (sendDirectly tSess $> Nothing)
+sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
+  sess <- mkTransportSession c userId destSrv senderId
+  ifM shouldUseProxy (sendViaProxy Nothing sess) (sendDirectly sess $> Nothing)
   where
     shouldUseProxy = do
       cfg <- getNetworkConfig c
@@ -1081,7 +1078,7 @@ sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendCmdViaProxy se
         SPFProhibit -> False
     unknownServer = liftIO $ maybe True (notElem destSrv . knownSrvs) <$> TM.lookupIO userId (smpServers c)
     sendViaProxy :: Maybe SMPServerWithAuth -> SMPTransportSession -> AM (Maybe SMPServer)
-    sendViaProxy proxySrv_ destSess@(_, _, connId_) = do
+    sendViaProxy proxySrv_ destSess@(_, _, qId) = do
       r <- tryAgentError . withProxySession c proxySrv_ destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess@ProxiedRelay {prBasicAuth}) -> do
         r' <- liftClient SMP (clientServer smp) $ sendCmdViaProxy smp proxySess
         let proxySrv = protocolClientServer' smp
@@ -1108,7 +1105,7 @@ sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendCmdViaProxy se
               -- checks that the current proxied relay session is the same one that was used to send the message and removes it
               deleteRelaySession =
                 ( TM.lookup destSess (smpProxiedRelays c)
-                    $>>= \(ProtoServerWithAuth srv _) -> tryReadSessVar (userId, srv, connId_) (smpClients c)
+                    $>>= \(ProtoServerWithAuth srv _) -> tryReadSessVar (userId, srv, qId) (smpClients c)
                 )
                   >>= \case
                     Just (Right (SMPConnectedClient smp' prs))
@@ -1128,7 +1125,7 @@ sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendCmdViaProxy se
           | serverHostError e -> ifM directAllowed (sendDirectly destSess $> Nothing) (throwE e)
           | otherwise -> throwE e
     sendDirectly tSess =
-      withLogClient_ c tSess (unEntityId senderId) ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
+      withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
         r <- tryAgentError $ liftClient SMP (clientServer smp) $ sendCmdDirectly smp
         case r of
           Right () -> atomically $ incSMPServerStat c userId destSrv sentDirect
@@ -1141,18 +1138,18 @@ ipAddressProtected NetworkConfig {socksProxy, hostMode} (ProtocolServer _ hosts
     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 c srv = withLogClient c (0, srv, Nothing)
 
 withXFTPClient ::
   ProtocolServerClient v err msg =>
   AgentClient ->
-  (UserId, ProtoServer msg, ByteString) ->
+  (UserId, ProtoServer msg, EntityId) ->
   ByteString ->
   (Client msg -> ExceptT (ProtocolClientError err) IO b) ->
   AM b
-withXFTPClient c (userId, srv, sessEntId) cmdStr action = do
-  tSess <- mkTransportSession c userId srv sessEntId
-  withLogClient c tSess sessEntId cmdStr action
+withXFTPClient c (userId, srv, entityId) cmdStr action = do
+  tSess <- mkTransportSession c userId srv entityId
+  withLogClient c tSess entityId cmdStr action
 
 liftClient :: (Show err, Encoding err) => (HostName -> err -> AgentErrorType) -> HostName -> ExceptT (ProtocolClientError err) IO a -> AM a
 liftClient protocolError_ = liftError . protocolClientError protocolError_
@@ -1294,12 +1291,12 @@ getXFTPWorkPath = do
   workDir <- readTVarIO =<< asks (xftpWorkDir . xftpAgent)
   maybe getTemporaryDirectory pure workDir
 
-mkTransportSession :: MonadIO m => AgentClient -> UserId -> ProtoServer msg -> ByteString -> m (TransportSession msg)
-mkTransportSession c userId srv sessEntId = mkTSession userId srv sessEntId <$> getSessionMode c
+mkTransportSession :: MonadIO m => AgentClient -> UserId -> ProtoServer msg -> EntityId -> m (TransportSession msg)
+mkTransportSession c userId srv entityId = mkTSession userId srv entityId <$> getSessionMode c
 {-# INLINE mkTransportSession #-}
 
-mkTSession :: UserId -> ProtoServer msg -> ByteString -> TransportSessionMode -> TransportSession msg
-mkTSession userId srv sessEntId mode = (userId, srv, if mode == TSMEntity then Just sessEntId else Nothing)
+mkTSession :: UserId -> ProtoServer msg -> EntityId -> TransportSessionMode -> TransportSession msg
+mkTSession userId srv entityId mode = (userId, srv, if mode == TSMEntity then Just entityId else Nothing)
 {-# INLINE mkTSession #-}
 
 mkSMPTransportSession :: (SMPQueueRec q, MonadIO m) => AgentClient -> q -> m SMPTransportSession
@@ -1321,12 +1318,12 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode sender
   rKeys@(_, rcvPrivateKey) <- atomically $ C.generateAuthKeyPair a g
   (dhKey, privDhKey) <- atomically $ C.generateKeyPair g
   (e2eDhKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
-  logServer "-->" c srv NoEntity "NEW"
+  logServer "-->" c srv "" "NEW"
   tSess <- mkTransportSession c userId srv connId
   (sessId, QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}) <-
     withClient c tSess $ \(SMPConnectedClient smp _) ->
       (sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode senderCanSecure
-  liftIO . logServer "<--" c srv NoEntity $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
+  liftIO . logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
   let rq =
         RcvQueue
           { userId,
@@ -1460,7 +1457,7 @@ sendTSessionBatches statCmd toRQ action c qs =
       tryAgentError' (getSMPServerClient c tSess) >>= \case
         Left e -> pure $ L.map ((,Left e) . toRQ) qs'
         Right (SMPConnectedClient smp _) -> liftIO $ do
-          logServer' "-->" c srv (bshow (length qs') <> " queues") statCmd
+          logServer "-->" c srv (bshow (length qs') <> " queues") statCmd
           L.map agentError <$> action smp qs'
           where
             agentError = second . first $ protocolClientError SMP $ clientServer smp
@@ -1514,39 +1511,32 @@ getSubscriptions :: AgentClient -> IO (Set ConnId)
 getSubscriptions = readTVarIO . subscrConns
 {-# INLINE getSubscriptions #-}
 
-logServer :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> EntityId -> ByteString -> m ()
-logServer dir c srv = logServer' dir c srv . unEntityId
+logServer :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> QueueId -> ByteString -> m ()
+logServer dir AgentClient {clientId} srv qId cmdStr =
+  logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret qId, cmdStr]
 {-# INLINE logServer #-}
 
-logServer' :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> ByteString -> ByteString -> m ()
-logServer' dir AgentClient {clientId} srv qStr cmdStr =
-  logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret' qStr, cmdStr]
-
 showServer :: ProtocolServer s -> ByteString
 showServer ProtocolServer {host, port} =
   strEncode host <> B.pack (if null port then "" else ':' : port)
 {-# INLINE showServer #-}
 
-logSecret :: EntityId -> ByteString
-logSecret = logSecret' . unEntityId
+logSecret :: ByteString -> ByteString
+logSecret bs = B64.encode $ B.take 3 bs
 {-# INLINE logSecret #-}
 
-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, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
+sendConfirmation c sq@SndQueue {userId, server, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
   let (privHdr, spKey) = if sndSecure 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
+  sendOrProxySMPMessage c userId server "<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 -> UserId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
+sendInvitation c userId (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 userId smpServer "<INV>" Nothing senderId (MsgFlags {notification = True}) msg
   where
     mkInvitation :: AM ByteString
     -- this is only encrypted with per-queue E2E, not with double ratchet
@@ -1582,8 +1572,8 @@ secureQueue c rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
     secureSMPQueue smp 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 c SndQueue {userId, server, sndId, sndPrivateKey, sndPublicKey} =
+  void $ sendOrProxySMPCommand c userId server "SKEY <key>" sndId secureViaProxy secureDirectly
   where
     -- TODO track statistics
     secureViaProxy smp proxySess = proxySecureSndSMPQueue smp proxySess sndPrivateKey sndId sndPublicKey
@@ -1613,7 +1603,7 @@ disableQueuesNtfs = sendTSessionBatches "NDEL" id $ sendBatch disableSMPQueuesNt
 
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
-  withSMPClient c rq ("ACK:" <> logSecret' msgId) $ \smp ->
+  withSMPClient c rq ("ACK:" <> logSecret msgId) $ \smp ->
     ackSMPMessage smp rcvPrivateKey rcvId msgId
   atomically $ releaseGetLock c rq
 
@@ -1647,10 +1637,10 @@ deleteQueues c = sendTSessionBatches "DEL" id deleteQueues_ c
       pure rs
 
 sendAgentMessage :: AgentClient -> SndQueue -> MsgFlags -> ByteString -> AM (Maybe SMPServer)
-sendAgentMessage c sq@SndQueue {userId, server, connId, sndId, sndPrivateKey} msgFlags agentMsg = do
+sendAgentMessage c sq@SndQueue {userId, server, 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 userId server "<MSG>" (Just sndPrivateKey) sndId msgFlags msg
 
 data ServerQueueInfo = ServerQueueInfo
   { server :: SMPServer,
@@ -1669,7 +1659,7 @@ getQueueInfo c rq@RcvQueue {server, rcvId, rcvPrivateKey, sndId, status, clientN
     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
+    enc = decodeLatin1 . B64.encode
 
 agentNtfRegisterToken :: AgentClient -> NtfToken -> NtfPublicAuthKey -> C.PublicKeyX25519 -> AM (NtfTokenId, C.PublicKeyX25519)
 agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
@@ -1717,10 +1707,10 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize},
   rKeys <- xftpRcvKeys n
   (sndKey, replicaKey) <- atomically . C.generateAuthKeyPair C.SEd25519 =<< asks random
   let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest}
-  logServer "-->" c srv NoEntity "FNEW"
+  logServer "-->" c srv "" "FNEW"
   tSess <- mkTransportSession c userId srv chunkDigest
   (sndId, rIds) <- withClient c tSess $ \xftp -> X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth
-  logServer "<--" c srv NoEntity $ B.unwords ["SIDS", logSecret sndId]
+  logServer "<--" c srv "" $ B.unwords ["SIDS", logSecret sndId]
   pure NewSndChunkReplica {server = srv, replicaId = ChunkReplicaId sndId, replicaKey, rcvIdsKeys = L.toList $ xftpRcvIdsKeys rIds rKeys}
 
 agentXFTPUploadChunk :: AgentClient -> UserId -> FileDigest -> SndFileChunkReplica -> XFTPChunkSpec -> AM ()
@@ -1744,7 +1734,7 @@ xftpRcvKeys n = do
     Just rKeys' -> pure rKeys'
     _ -> throwE $ INTERNAL "non-positive number of recipients"
 
-xftpRcvIdsKeys :: NonEmpty EntityId -> NonEmpty C.AAuthKeyPair -> NonEmpty (ChunkReplicaId, C.APrivateAuthKey)
+xftpRcvIdsKeys :: NonEmpty ByteString -> NonEmpty C.AAuthKeyPair -> NonEmpty (ChunkReplicaId, C.APrivateAuthKey)
 xftpRcvIdsKeys rIds rKeys = L.map ChunkReplicaId rIds `L.zip` L.map snd rKeys
 
 agentCbEncrypt :: SndQueue -> Maybe C.PublicKeyX25519 -> ByteString -> AM ByteString
@@ -1930,7 +1920,6 @@ withStoreBatch' c actions = withStoreBatch c (fmap (fmap Right) . actions)
 storeError :: StoreError -> AgentErrorType
 storeError = \case
   SEConnNotFound -> CONN NOT_FOUND
-  SEUserNotFound -> NO_USER
   SERatchetNotFound -> CONN NOT_FOUND
   SEConnDuplicate -> CONN DUPLICATE
   SEBadConnType CRcv -> CONN SIMPLEX

src/Simplex/Messaging/Agent/Protocol.hs

@@ -51,7 +51,6 @@ module Simplex.Messaging.Agent.Protocol
     -- * SMP agent protocol types
     ConnInfo,
     SndQueueSecured,
-    AEntityId,
     ACommand (..),
     AEvent (..),
     AEvt (..),
@@ -191,6 +190,7 @@ import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol
   ( AProtocolType,
     BrokerErrorType (..),
+    EntityId,
     ErrorType,
     MsgBody,
     MsgFlags,
@@ -287,12 +287,10 @@ e2eEncAgentMsgLength v = \case
   _ -> 15856
 
 -- | SMP agent event
-type ATransmission = (ACorrId, AEntityId, AEvt)
+type ATransmission = (ACorrId, EntityId, AEvt)
 
 type UserId = Int64
 
-type AEntityId = ByteString
-
 type ACorrId = ByteString
 
 data AEntity = AEConn | AERcvFile | AESndFile | AENone
@@ -1338,8 +1336,6 @@ data AgentErrorType
     CMD {cmdErr :: CommandErrorType, errContext :: String}
   | -- | connection errors
     CONN {connErr :: ConnectionErrorType}
-  | -- | user not found in database
-    NO_USER
   | -- | SMP protocol errors forwarded to agent clients
     SMP {serverAddress :: String, smpErr :: ErrorType}
   | -- | NTF protocol errors forwarded to agent clients

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

@@ -1,12 +1,10 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -17,7 +15,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
@@ -971,12 +968,12 @@ createRcvMsg db connId rq rcvMsgData@RcvMsgData {msgMeta = MsgMeta {sndMsgId}, i
   insertRcvMsgDetails_ db connId rq rcvMsgData
   updateRcvMsgHash db connId sndMsgId internalRcvId internalHash
 
-updateSndIds :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
-updateSndIds db connId = runExceptT $ do
-  (lastInternalId, lastInternalSndId, prevSndHash) <- ExceptT $ retrieveLastIdsAndHashSnd_ db connId
+updateSndIds :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
+updateSndIds db connId = do
+  (lastInternalId, lastInternalSndId, prevSndHash) <- retrieveLastIdsAndHashSnd_ db connId
   let internalId = InternalId $ unId lastInternalId + 1
       internalSndId = InternalSndId $ unSndId lastInternalSndId + 1
-  liftIO $ updateLastIdsSnd_ db connId internalId internalSndId
+  updateLastIdsSnd_ db connId internalId internalSndId
   pure (internalId, internalSndId, prevSndHash)
 
 createSndMsg :: DB.Connection -> ConnId -> SndMsgData -> IO ()
@@ -1817,14 +1814,6 @@ instance ToField (Version v) where toField (Version v) = toField v
 
 instance FromField (Version v) where fromField f = Version <$> fromField f
 
-deriving newtype instance ToField EntityId
-
-deriving newtype instance FromField EntityId
-
-deriving newtype instance ToField ChunkReplicaId
-
-deriving newtype instance FromField ChunkReplicaId
-
 listToEither :: e -> [a] -> Either e a
 listToEither _ (x : _) = Right x
 listToEither e _ = Left e
@@ -2219,9 +2208,9 @@ updateRcvMsgHash db connId sndMsgId internalRcvId internalHash =
 
 -- * updateSndIds helpers
 
-retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
+retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
 retrieveLastIdsAndHashSnd_ dbConn connId = do
-  firstRow id SEConnNotFound $
+  [(lastInternalId, lastInternalSndId, lastSndHash)] <-
     DB.queryNamed
       dbConn
       [sql|
@@ -2230,6 +2219,7 @@ retrieveLastIdsAndHashSnd_ dbConn connId = do
         WHERE conn_id = :conn_id;
       |]
       [":conn_id" := connId]
+  return (lastInternalId, lastInternalSndId, lastSndHash)
 
 updateLastIdsSnd_ :: DB.Connection -> ConnId -> InternalId -> InternalSndId -> IO ()
 updateLastIdsSnd_ dbConn connId newInternalId newInternalSndId =
@@ -2525,7 +2515,7 @@ deleteRcvFile' :: DB.Connection -> DBRcvFileId -> IO ()
 deleteRcvFile' db rcvFileId =
   DB.execute db "DELETE FROM rcv_files WHERE rcv_file_id = ?" (Only rcvFileId)
 
-getNextRcvChunkToDownload :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe (RcvFileChunk, Bool, Maybe RcvFileId)))
+getNextRcvChunkToDownload :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe (RcvFileChunk, Bool)))
 getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = do
   getWorkItem "rcv_file_download" getReplicaId getChunkData (markRcvFileFailed db . snd)
   where
@@ -2549,7 +2539,7 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
             LIMIT 1
           |]
           (host, port, keyHash, RFSReceiving, cutoffTs)
-    getChunkData :: (Int64, DBRcvFileId) -> IO (Either StoreError (RcvFileChunk, Bool, Maybe RcvFileId))
+    getChunkData :: (Int64, DBRcvFileId) -> IO (Either StoreError (RcvFileChunk, Bool))
     getChunkData (rcvFileChunkReplicaId, _fileId) =
       firstRow toChunk SEFileNotFound $
         DB.query
@@ -2558,7 +2548,7 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
             SELECT
               f.rcv_file_id, f.rcv_file_entity_id, f.user_id, c.rcv_file_chunk_id, c.chunk_no, c.chunk_size, c.digest, f.tmp_path, c.tmp_path,
               r.rcv_file_chunk_replica_id, r.replica_id, r.replica_key, r.received, r.delay, r.retries,
-              f.approved_relays, f.redirect_entity_id
+              f.approved_relays
             FROM rcv_file_chunk_replicas r
             JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
             JOIN rcv_file_chunks c ON c.rcv_file_chunk_id = r.rcv_file_chunk_id
@@ -2567,8 +2557,8 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
           |]
           (Only rcvFileChunkReplicaId)
       where
-        toChunk :: ((DBRcvFileId, RcvFileId, UserId, Int64, Int, FileSize Word32, FileDigest, FilePath, Maybe FilePath) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, Bool, Maybe Int64, Int) :. (Bool, Maybe RcvFileId)) -> (RcvFileChunk, Bool, Maybe RcvFileId)
-        toChunk ((rcvFileId, rcvFileEntityId, userId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath, chunkTmpPath) :. (rcvChunkReplicaId, replicaId, replicaKey, received, delay, retries) :. (approvedRelays, redirectEntityId_)) =
+        toChunk :: ((DBRcvFileId, RcvFileId, UserId, Int64, Int, FileSize Word32, FileDigest, FilePath, Maybe FilePath) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, Bool, Maybe Int64, Int) :. Only Bool) -> (RcvFileChunk, Bool)
+        toChunk ((rcvFileId, rcvFileEntityId, userId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath, chunkTmpPath) :. (rcvChunkReplicaId, replicaId, replicaKey, received, delay, retries) :. (Only approvedRelays)) =
           ( RcvFileChunk
               { rcvFileId,
                 rcvFileEntityId,
@@ -2581,8 +2571,7 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
                 chunkTmpPath,
                 replicas = [RcvFileChunkReplica {rcvChunkReplicaId, server, replicaId, replicaKey, received, delay, retries}]
               },
-            approvedRelays,
-            redirectEntityId_
+            approvedRelays
           )
 
 getNextRcvFileToDecrypt :: DB.Connection -> NominalDiffTime -> IO (Either StoreError (Maybe RcvFile))

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

@@ -29,7 +29,7 @@ import Control.Monad (forM_, when)
 import qualified Data.Aeson.TH as J
 import Data.List (intercalate, sortOn)
 import Data.List.NonEmpty (NonEmpty)
-import qualified Data.Map.Strict as M
+import qualified Data.Map as M
 import Data.Maybe (isNothing, mapMaybe)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1)

src/Simplex/Messaging/Agent/TRcvQueues.hs

@@ -31,7 +31,7 @@ import Simplex.Messaging.Transport
 
 class Queue q where
   connId' :: q -> ConnId
-  qKey :: q -> (UserId, SMPServer, RecipientId)
+  qKey :: q -> (UserId, SMPServer, ConnId)
 
 -- the fields in this record have the same data with swapped keys for lookup efficiency,
 -- and all methods must maintain this invariant.
@@ -63,7 +63,7 @@ addQueue rq (TRcvQueues qs cs) = do
     addQ = Just . maybe (k :| []) (k <|)
     k = qKey rq
 
--- Save time by aggregating modifyTVar'
+-- Save time by aggregating modifyTVar
 batchAddQueues :: (Foldable t, Queue q) => TRcvQueues q -> t q -> STM ()
 batchAddQueues (TRcvQueues qs cs) rqs = do
   modifyTVar' qs $ \now -> foldl' (\rqs' rq -> M.insert (qKey rq) rq rqs') now rqs
@@ -97,7 +97,7 @@ getDelSessQueues tSess sessId' (TRcvQueues qs cs) = do
     delQ acc@(removed, qs') (sessId, rq)
       | rq `isSession` tSess && sessId == sessId' = (rq : removed, M.delete (qKey rq) qs')
       | otherwise = acc
-    delConn :: ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, RecipientId))) -> RcvQueue -> ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, RecipientId)))
+    delConn :: ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, ConnId))) -> RcvQueue -> ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, ConnId)))
     delConn (removed, cs') rq = M.alterF f cId cs'
       where
         cId = connId rq
@@ -113,7 +113,7 @@ isSession rq (uId, srv, connId_) =
 
 instance Queue RcvQueue where
   connId' = connId
-  qKey rq = (userId rq, server rq, rcvId rq)
+  qKey rq = (userId rq, server rq, connId rq)
 
 instance Queue (SessionId, RcvQueue) where
   connId' = connId . snd

src/Simplex/Messaging/Client.hs

@@ -58,10 +58,6 @@ module Simplex.Messaging.Client
     suspendSMPQueue,
     deleteSMPQueue,
     deleteSMPQueues,
-    createSMPDataBlob,
-    deleteSMPDataBlob,
-    getSMPDataBlob,
-    proxyGetSMPDataBlob,
     connectSMPProxiedRelay,
     proxySMPMessage,
     forwardSMPTransmission,
@@ -118,8 +114,6 @@ import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.Bitraversable (bimapM)
-import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
@@ -447,8 +441,7 @@ transportSession' = transportSession . client_
 type UserId = Int64
 
 -- | Transport session key - includes entity ID if `sessionMode = TSMEntity`.
--- Please note that for SMP connection ID is used as entity ID, not queue ID.
-type TransportSession msg = (UserId, ProtoServer msg, Maybe ByteString)
+type TransportSession msg = (UserId, ProtoServer msg, Maybe EntityId)
 
 -- | Connects to 'ProtocolServer' using passed client configuration
 -- and queue for messages and notifications.
@@ -551,7 +544,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 Nothing "" (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
@@ -677,7 +670,7 @@ createSMPQueue ::
   Bool ->
   ExceptT SMPClientError IO QueueIdsKeys
 createSMPQueue c (rKey, rpKey) dhKey auth subMode sndSecure =
-  sendSMPCommand c (Just rpKey) NoEntity (NEW rKey dhKey auth subMode sndSecure) >>= \case
+  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey auth subMode sndSecure) >>= \case
     IDS qik -> pure qik
     r -> throwE $ unexpectedResponse r
 
@@ -755,14 +748,9 @@ secureSndSMPQueue c spKey sId senderKey = okSMPCommand (SKEY senderKey) c spKey
 {-# INLINE secureSndSMPQueue #-}
 
 proxySecureSndSMPQueue :: SMPClient -> ProxiedRelay -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySecureSndSMPQueue c proxiedRelay spKey sId senderKey = proxySMPCommand c proxiedRelay (Just spKey) sId (SKEY senderKey) okResult
+proxySecureSndSMPQueue c proxiedRelay spKey sId senderKey = proxySMPCommand c proxiedRelay (Just spKey) sId (SKEY senderKey)
 {-# INLINE proxySecureSndSMPQueue #-}
 
-okResult :: BrokerMsg -> Maybe ()
-okResult = \case
-  OK -> Just ()
-  _ -> Nothing
-
 -- | Enable notifications for the queue for push notifications server.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
@@ -804,7 +792,7 @@ sendSMPMessage c spKey sId flags msg =
     r -> throwE $ unexpectedResponse r
 
 proxySMPMessage :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> MsgFlags -> MsgBody -> ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySMPMessage c proxiedRelay spKey sId flags msg = proxySMPCommand c proxiedRelay spKey sId (SEND flags msg) okResult
+proxySMPMessage c proxiedRelay spKey sId flags msg = proxySMPCommand c proxiedRelay spKey sId (SEND flags msg)
 
 -- | Acknowledge message delivery (server deletes the message).
 --
@@ -836,49 +824,12 @@ deleteSMPQueues :: SMPClient -> NonEmpty (RcvPrivateAuthKey, RecipientId) -> IO
 deleteSMPQueues = okSMPCommands DEL
 {-# INLINE deleteSMPQueues #-}
 
-createSMPDataBlob :: SMPClient -> C.AAuthKeyPair -> BlobId -> DataBlob -> ExceptT SMPClientError IO ()
-createSMPDataBlob c (dKey, dpKey) dId blob = okSMPCommand (WRT dKey blob) c dpKey dId
-{-# INLINE createSMPDataBlob #-}
-
-deleteSMPDataBlob :: SMPClient -> DataPrivateAuthKey -> BlobId -> ExceptT SMPClientError IO ()
-deleteSMPDataBlob = okSMPCommand CLR
-{-# INLINE deleteSMPDataBlob #-}
-
--- pk is the private key passed to the client out of band.
--- Associated public key is used as ID to retrieve data blob
-getSMPDataBlob :: SMPClient -> C.PrivateKeyX25519 -> ExceptT SMPClientError IO DataBlob
-getSMPDataBlob c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} pk = do
-  serverKey <- case thAuth thParams of
-    Nothing -> throwE $ PCETransportError TENoServerAuth
-    Just THAuthClient {serverPeerPubKey = k} -> pure k
-  nonce <- liftIO . atomically $ C.randomCbNonce g
-  let dId = EntityId $ BA.convert $ C.pubKeyBytes $ C.publicKey pk
-  sendProtocolCommand_ c (Just nonce) Nothing Nothing dId (Cmd SSender READ) >>= \case
-    DATA encBlob -> decryptDataBlob serverKey pk nonce encBlob
-    r -> throwE $ unexpectedResponse r
-
-proxyGetSMPDataBlob :: SMPClient -> ProxiedRelay -> C.PrivateKeyX25519 -> ExceptT SMPClientError IO (Either ProxyClientError DataBlob)
-proxyGetSMPDataBlob c@ProtocolClient {client_ = PClient {clientCorrId = g}} proxiedRelay@ProxiedRelay {prServerKey} pk = do
-  nonce <- liftIO . atomically $ C.randomCbNonce g
-  let dId = EntityId $ BA.convert $ C.pubKeyBytes $ C.publicKey pk
-  encBlob_ <-
-    proxySMPCommand_ c (Just nonce) proxiedRelay Nothing dId READ $ \case
-      DATA encBlob -> Just encBlob
-      _ -> Nothing
-  bimapM pure (decryptDataBlob prServerKey pk nonce) encBlob_
-
-decryptDataBlob :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> ExceptT (ProtocolClientError ErrorType) IO DataBlob
-decryptDataBlob serverKey pk nonce encBlob = do
-  let ss = C.dh' serverKey pk
-  blobStr <- liftEitherWith PCECryptoError $ C.cbDecrypt ss nonce encBlob
-  liftEitherWith (const $ PCEResponseError BLOCK) $ smpDecode blobStr
-
 -- 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
   | thVersion (thParams c) >= sendingProxySMPVersion =
-      sendProtocolCommand_ c Nothing tOut Nothing NoEntity (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
+      sendProtocolCommand_ c Nothing tOut Nothing "" (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
         PKEY sId vr (chain, key) ->
           case supportedClientSMPRelayVRange `compatibleVersion` vr of
             Nothing -> throwE $ transportErr TEVersion
@@ -926,9 +877,6 @@ instance StrEncoding ProxyClientError where
       "SYNTAX" -> ProxyResponseError <$> _strP
       _ -> fail "bad ProxyClientError"
 
-proxySMPCommand :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> Command 'Sender -> (BrokerMsg -> Maybe r) -> ExceptT SMPClientError IO (Either ProxyClientError r)
-proxySMPCommand c = proxySMPCommand_ c Nothing
-
 -- consider how to process slow responses - is it handled somehow locally or delegated to the caller
 -- this method is used in the client
 -- sends PFWD :: C.PublicKeyX25519 -> EncTransmission -> Command Sender
@@ -956,25 +904,22 @@ proxySMPCommand c = proxySMPCommand_ c Nothing
 -- - other errors from the client running on proxy and connected to relay in PREProxiedRelayError
 
 -- This function proxies Sender commands that return OK or ERR
-proxySMPCommand_ ::
+proxySMPCommand ::
   SMPClient ->
-  -- optional correlation ID/nonce for the sending client
-  Maybe C.CbNonce ->
   -- proxy session from PKEY
   ProxiedRelay ->
-  -- command to deliver
+  -- message to deliver
   Maybe SndPrivateAuthKey ->
   SenderId ->
   Command 'Sender ->
-  (BrokerMsg -> Maybe r) ->
-  ExceptT SMPClientError IO (Either ProxyClientError r)
-proxySMPCommand_ c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} nonce_ (ProxiedRelay sessionId v _ serverKey) spKey sId command toResult = do
+  ExceptT SMPClientError IO (Either ProxyClientError ())
+proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v _ serverKey) spKey sId command = do
   -- prepare params
   let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
       serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
   (cmdPubKey, cmdPrivKey) <- liftIO . atomically $ C.generateKeyPair @'C.X25519 g
   let cmdSecret = C.dh' serverKey cmdPrivKey
-  nonce@(C.CbNonce corrId) <- liftIO $ maybe (atomically $ C.randomCbNonce g) pure nonce_
+  nonce@(C.CbNonce corrId) <- liftIO . atomically $ C.randomCbNonce g
   -- encode
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender command)
   auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth spKey nonce tForAuth
@@ -986,7 +931,7 @@ proxySMPCommand_ c@ProtocolClient {thParams = proxyThParams, client_ = PClient {
   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
+  tryE (sendProtocolCommand_ c (Just nonce) tOut Nothing sessionId (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
     Right r -> case r of
       PRES (EncResponse er) -> do
         -- server interaction errors are thrown directly
@@ -994,11 +939,9 @@ proxySMPCommand_ c@ProtocolClient {thParams = proxyThParams, client_ = PClient {
         case tParse serverThParams t' of
           t'' :| [] -> case tDecodeParseValidate serverThParams t'' of
             (_auth, _signed, (_c, _e, cmd)) -> case cmd of
-              Right r' -> case toResult r' of
-                Just r'' -> pure $ Right r''
-                Nothing -> case r' of
-                  ERR e -> throwE $ PCEProtocolError e -- this is the error from the destination relay
-                  _ -> throwE $ unexpectedResponse r'
+              Right OK -> pure $ Right ()
+              Right (ERR e) -> throwE $ PCEProtocolError e -- this is the error from the destination relay
+              Right r' -> throwE $ unexpectedResponse r'
               Left e -> throwE $ PCEResponseError e
           _ -> throwE $ PCETransportError TEBadBlock
       ERR e -> pure . Left $ ProxyProtocolError e -- this will not happen, this error is returned via Left
@@ -1024,7 +967,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 SSender (RFWD eft)) >>= \case
+  sendProtocolCommand_ c (Just nonce) Nothing Nothing "" (Cmd SSender (RFWD eft)) >>= \case
     RRES (EncFwdResponse efr) -> do
       -- unwrap
       r' <- liftEitherWith PCECryptoError $ C.cbDecryptNoPad sessSecret (C.reverseNonce nonce) efr
@@ -1072,7 +1015,7 @@ sendProtocolCommands c@ProtocolClient {thParams = THandleParams {batch, blockSiz
       | diff == 0 = pure $ L.fromList rs
       | diff > 0 = do
           putStrLn "send error: fewer responses than expected"
-          pure $ L.fromList $ rs <> replicate diff (Response NoEntity $ Left $ PCETransportError TEBadBlock)
+          pure $ L.fromList $ rs <> replicate diff (Response "" $ Left $ PCETransportError TEBadBlock)
       | otherwise = do
           putStrLn "send error: more responses than expected"
           pure $ L.fromList $ take (L.length cs) rs

src/Simplex/Messaging/Crypto/SNTRUP761.hs

@@ -4,7 +4,7 @@
 
 module Simplex.Messaging.Crypto.SNTRUP761 where
 
-import Crypto.Hash (Digest, SHA3_256, hash)
+import Crypto.Hash (Digest, SHA256, hash)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
@@ -28,4 +28,4 @@ kcbEncrypt (KEMHybridSecret k) = sbEncrypt_ k
 kemHybridSecret :: PublicKeyX25519 -> PrivateKeyX25519 -> KEMSharedKey -> KEMHybridSecret
 kemHybridSecret k pk (KEMSharedKey kem) =
   let DhSecretX25519 dh = C.dh' k pk
-   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA3_256)
+   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA256)

src/Simplex/Messaging/Encoding.hs

@@ -42,12 +42,10 @@ class Encoding a where
   -- | decoding of type (default implementation uses parser)
   smpDecode :: ByteString -> Either String a
   smpDecode = parseAll smpP
-  {-# INLINE smpDecode #-}
 
   -- | protocol parser of type (default implementation parses protocol ByteString encoding)
   smpP :: Parser a
   smpP = smpDecode <$?> smpP
-  {-# INLINE smpP #-}
 
 instance Encoding Char where
   smpEncode = B.singleton

src/Simplex/Messaging/Encoding/String.hs

@@ -28,8 +28,6 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlphaNum)
 import Data.Int (Int64)
-import Data.IntSet (IntSet)
-import qualified Data.IntSet as IS
 import qualified Data.List.NonEmpty as L
 import Data.Set (Set)
 import qualified Data.Set as S
@@ -41,7 +39,7 @@ import Data.Time.Format.ISO8601
 import Data.Word (Word16, Word32)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Util (bshow, (<$?>))
+import Simplex.Messaging.Util ((<$?>))
 
 class TextEncoding a where
   textEncode :: a -> Text
@@ -55,20 +53,14 @@ class StrEncoding a where
   -- Please note - if you only specify strDecode, it will use base64urlP as default parser before decoding the string
   strDecode :: ByteString -> Either String a
   strDecode = parseAll strP
-  {-# INLINE strDecode #-}
-
   strP :: Parser a
   strP = strDecode <$?> base64urlP
-  {-# INLINE strP #-}
 
 -- base64url encoding/decoding of ByteStrings - the parser only allows non-empty strings
 instance StrEncoding ByteString where
   strEncode = U.encode
-  {-# INLINE strEncode #-}
   strDecode = U.decode
-  {-# INLINE strDecode #-}
   strP = base64urlP
-  {-# INLINE strP #-}
 
 base64urlP :: Parser ByteString
 base64urlP = do
@@ -127,15 +119,15 @@ instance StrEncoding Bool where
   {-# INLINE strP #-}
 
 instance StrEncoding Int where
-  strEncode = bshow
+  strEncode = B.pack . show
   {-# INLINE strEncode #-}
-  strP = A.signed A.decimal
+  strP = A.decimal
   {-# INLINE strP #-}
 
 instance StrEncoding Int64 where
-  strEncode = bshow
+  strEncode = B.pack . show
   {-# INLINE strEncode #-}
-  strP = A.signed A.decimal
+  strP = A.decimal
   {-# INLINE strP #-}
 
 instance StrEncoding SystemTime where
@@ -162,10 +154,6 @@ instance (StrEncoding a, Ord a) => StrEncoding (Set a) where
   strEncode = strEncodeList . S.toList
   strP = S.fromList <$> listItem `A.sepBy'` A.char ','
 
-instance StrEncoding IntSet where
-  strEncode = strEncodeList . IS.toList
-  strP = IS.fromList <$> listItem `A.sepBy'` A.char ','
-
 listItem :: StrEncoding a => Parser a
 listItem = parseAll strP <$?> A.takeTill (\c -> c == ',' || c == ' ' || c == '\n')
 

src/Simplex/Messaging/Notifications/Client.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 
 module Simplex.Messaging.Notifications.Client where
 
@@ -12,7 +11,7 @@ import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Transport (NTFVersion, supportedClientNTFVRange, supportedNTFHandshakes)
-import Simplex.Messaging.Protocol (ErrorType, pattern NoEntity)
+import Simplex.Messaging.Protocol (ErrorType)
 
 type NtfClient = ProtocolClient NTFVersion ErrorType NtfResponse
 
@@ -23,7 +22,7 @@ defaultNTFClientConfig = defaultClientConfig (Just supportedNTFHandshakes) suppo
 
 ntfRegisterToken :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Token -> ExceptT NtfClientError IO (NtfTokenId, C.PublicKeyX25519)
 ntfRegisterToken c pKey newTkn =
-  sendNtfCommand c (Just pKey) NoEntity (TNEW newTkn) >>= \case
+  sendNtfCommand c (Just pKey) "" (TNEW newTkn) >>= \case
     NRTknId tknId dhKey -> pure (tknId, dhKey)
     r -> throwE $ unexpectedResponse r
 
@@ -47,7 +46,7 @@ ntfEnableCron c pKey tknId int = okNtfCommand (TCRN int) c 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 (Just pKey) "" (SNEW newSub) >>= \case
     NRSubId subId -> pure subId
     r -> throwE $ unexpectedResponse r
 

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -208,7 +208,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, _) cmd = case cmd of
     -- TNEW and SNEW must have signature but NOT token/subscription IDs
     TNEW {} -> sigNoEntity
     SNEW {} -> sigNoEntity
@@ -322,7 +322,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfResponse where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials (_, _, entId, _) cmd = case cmd of
     -- IDTKN response must not have queue ID
     NRTknId {} -> noEntity
     -- IDSUB response must not have queue ID
@@ -426,7 +426,7 @@ instance FromJSON DeviceToken where
     t <- encodeUtf8 <$> o .: "token"
     pure $ DeviceToken pp t
 
-type NtfEntityId = EntityId
+type NtfEntityId = ByteString
 
 type NtfSubscriptionId = NtfEntityId
 

src/Simplex/Messaging/Notifications/Server.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -20,7 +19,6 @@ import Control.Monad.Reader
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
-import Data.IORef
 import Data.Int (Int64)
 import Data.List (intercalate, sort)
 import Data.List.NonEmpty (NonEmpty (..))
@@ -32,7 +30,6 @@ import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
-import GHC.IORef (atomicSwapIORef)
 import Network.Socket (ServiceName)
 import Simplex.Messaging.Client (ProtocolClientError (..), SMPClientError, ServerTransmission (..))
 import Simplex.Messaging.Client.Agent
@@ -45,7 +42,7 @@ import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Notifications.Server.StoreLog
 import Simplex.Messaging.Notifications.Transport
-import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), ProtocolServer (host), SMPServer, SignedTransmission, Transmission, pattern NoEntity, encodeTransmission, tGet, tPut)
+import Simplex.Messaging.Protocol (ErrorType (..), ProtocolServer (host), SMPServer, SignedTransmission, Transmission, encodeTransmission, tGet, tPut)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
 import Simplex.Messaging.Server.Stats
@@ -121,16 +118,16 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
           hSetBuffering h LineBuffering
           ts <- getCurrentTime
-          fromTime' <- atomicSwapIORef fromTime ts
-          tknCreated' <- atomicSwapIORef tknCreated 0
-          tknVerified' <- atomicSwapIORef tknVerified 0
-          tknDeleted' <- atomicSwapIORef tknDeleted 0
-          subCreated' <- atomicSwapIORef subCreated 0
-          subDeleted' <- atomicSwapIORef subDeleted 0
-          ntfReceived' <- atomicSwapIORef ntfReceived 0
-          ntfDelivered' <- atomicSwapIORef ntfDelivered 0
-          tkn <- liftIO $ periodStatCounts activeTokens ts
-          sub <- liftIO $ periodStatCounts activeSubs ts
+          fromTime' <- atomically $ swapTVar fromTime ts
+          tknCreated' <- atomically $ swapTVar tknCreated 0
+          tknVerified' <- atomically $ swapTVar tknVerified 0
+          tknDeleted' <- atomically $ swapTVar tknDeleted 0
+          subCreated' <- atomically $ swapTVar subCreated 0
+          subDeleted' <- atomically $ swapTVar subDeleted 0
+          ntfReceived' <- atomically $ swapTVar ntfReceived 0
+          ntfDelivered' <- atomically $ swapTVar ntfDelivered 0
+          tkn <- atomically $ periodStatCounts activeTokens ts
+          sub <- atomically $ periodStatCounts activeSubs ts
           hPutStrLn h $
             intercalate
               ","
@@ -218,10 +215,10 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
               st <- asks store
               NtfPushServer {pushQ} <- asks pushServer
               stats <- asks serverStats
-              liftIO $ updatePeriodStats (activeSubs stats) ntfId
+              atomically $ updatePeriodStats (activeSubs stats) ntfId
               atomically $
                 findNtfSubscriptionToken st smpQueue
-                  >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| [])))
+                  >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}))
               incNtfStat ntfReceived
             Right SMP.END ->
               whenM (atomically $ activeClientSession' ca sessionId srv) $
@@ -302,7 +299,7 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
       void $ deliverNotification pp tkn ntf
     PNMessage {} -> checkActiveTkn status $ do
       stats <- asks serverStats
-      liftIO $ updatePeriodStats (activeTokens stats) ntfTknId
+      atomically $ updatePeriodStats (activeTokens stats) ntfTknId
       void $ deliverNotification pp tkn ntf
       incNtfStat ntfDelivered
   where
@@ -449,7 +446,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
         atomically $ writeTBQueue pushQ (tkn, PNVerification regCode)
         withNtfLog (`logCreateToken` tkn)
         incNtfStatT token tknCreated
-        pure (corrId, NoEntity, NRTknId tknId srvDhPubKey)
+        pure (corrId, "", NRTknId tknId srvDhPubKey)
       NtfReqCmd SToken (NtfTkn tkn@NtfTknData {token, ntfTknId, tknStatus, tknRegCode, tknDhSecret, tknDhKeys = (srvDhPubKey, srvDhPrivKey), tknCronInterval}) (corrId, tknId, cmd) -> do
         status <- readTVarIO tknStatus
         (corrId,tknId,) <$> case cmd of
@@ -540,7 +537,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
             _ -> pure $ NRErr AUTH
         withNtfLog (`logCreateSubscription` sub)
         incNtfStat subCreated
-        pure (corrId, NoEntity, resp)
+        pure (corrId, "", resp)
       NtfReqCmd SSubscription (NtfSub NtfSubData {smpQueue = SMPQueueNtf {smpServer, notifierId}, notifierKey = registeredNKey, subStatus}) (corrId, subId, cmd) -> do
         status <- readTVarIO subStatus
         (corrId,subId,) <$> case cmd of
@@ -565,7 +562,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
           PING -> pure NRPong
       NtfReqPing corrId entId -> pure (corrId, entId, NRPong)
     getId :: M NtfEntityId
-    getId = fmap EntityId . randomBytes =<< asks (subIdBytes . config)
+    getId = randomBytes =<< asks (subIdBytes . config)
     getRegCode :: M NtfRegCode
     getRegCode = NtfRegCode <$> (randomBytes =<< asks (regCodeBytes . config))
     randomBytes :: Int -> M ByteString
@@ -578,14 +575,14 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
 withNtfLog :: (StoreLog 'WriteMode -> IO a) -> M ()
 withNtfLog action = liftIO . mapM_ action =<< asks storeLog
 
-incNtfStatT :: DeviceToken -> (NtfServerStats -> IORef Int) -> M ()
+incNtfStatT :: DeviceToken -> (NtfServerStats -> TVar Int) -> M ()
 incNtfStatT (DeviceToken PPApnsNull _) _ = pure ()
 incNtfStatT _ statSel = incNtfStat statSel
 
-incNtfStat :: (NtfServerStats -> IORef Int) -> M ()
+incNtfStat :: (NtfServerStats -> TVar Int) -> M ()
 incNtfStat statSel = do
   stats <- asks serverStats
-  liftIO $ atomicModifyIORef'_ (statSel stats) (+ 1)
+  atomically $ modifyTVar' (statSel stats) (+ 1)
 
 saveServerStats :: M ()
 saveServerStats =
@@ -605,7 +602,7 @@ restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStat
       liftIO (strDecode <$> B.readFile f) >>= \case
         Right d -> do
           s <- asks serverStats
-          liftIO $ setNtfServerStats s d
+          atomically $ setNtfServerStats s d
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
         Left e -> do

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

@@ -28,16 +28,12 @@ import Data.Aeson (ToJSON, (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.TH as JQ
-import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import Data.Maybe (isNothing)
 import Data.Text (Text)
@@ -107,20 +103,11 @@ readECPrivateKey f = do
 
 data PushNotification
   = PNVerification NtfRegCode
-  | PNMessage (NonEmpty PNMessageData)
+  | PNMessage PNMessageData
   | -- | PNAlert Text
     PNCheckMessages
   deriving (Show)
 
--- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
--- because strEncode of NonEmpty list uses comma for separator,
--- and encoding of PNMessageData's smpQueue has comma in list of hosts
-encodePNMessages :: NonEmpty PNMessageData -> ByteString
-encodePNMessages = B.intercalate ";" . map strEncode . L.toList
-
-pnMessagesP :: A.Parser (NonEmpty PNMessageData)
-pnMessagesP = L.fromList <$> strP `A.sepBy1` A.char ';'
-
 data PNMessageData = PNMessageData
   { smpQueue :: SMPQueueNtf,
     ntfTs :: SystemTime,
@@ -298,7 +285,7 @@ apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
     encrypt code $ \code' ->
       apn APNSBackground {contentAvailable = 1} . Just $ J.object ["nonce" .= nonce, "verification" .= code']
   PNMessage pnMessageData ->
-    encrypt (encodePNMessages pnMessageData) $ \ntfData ->
+    encrypt (strEncode pnMessageData) $ \ntfData ->
       apn apnMutableContent . Just $ J.object ["nonce" .= nonce, "message" .= ntfData]
   -- PNAlert text -> Right $ apn (apnAlert $ APNSAlertText text) Nothing
   PNCheckMessages -> Right $ apn APNSBackground {contentAvailable = 1} . Just $ J.object ["checkMessages" .= True]

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

@@ -7,22 +7,24 @@ module Simplex.Messaging.Notifications.Server.Stats where
 import Control.Applicative (optional)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
-import Data.IORef
 import Data.Time.Clock (UTCTime)
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Notifications.Protocol (NtfTokenId)
+import Simplex.Messaging.Protocol (NotifierId)
 import Simplex.Messaging.Server.Stats
+import UnliftIO.STM
 
 data NtfServerStats = NtfServerStats
-  { fromTime :: IORef UTCTime,
-    tknCreated :: IORef Int,
-    tknVerified :: IORef Int,
-    tknDeleted :: IORef Int,
-    subCreated :: IORef Int,
-    subDeleted :: IORef Int,
-    ntfReceived :: IORef Int,
-    ntfDelivered :: IORef Int,
-    activeTokens :: PeriodStats,
-    activeSubs :: PeriodStats
+  { fromTime :: TVar UTCTime,
+    tknCreated :: TVar Int,
+    tknVerified :: TVar Int,
+    tknDeleted :: TVar Int,
+    subCreated :: TVar Int,
+    subDeleted :: TVar Int,
+    ntfReceived :: TVar Int,
+    ntfDelivered :: TVar Int,
+    activeTokens :: PeriodStats NtfTokenId,
+    activeSubs :: PeriodStats NotifierId
   }
 
 data NtfServerStatsData = NtfServerStatsData
@@ -34,49 +36,48 @@ data NtfServerStatsData = NtfServerStatsData
     _subDeleted :: Int,
     _ntfReceived :: Int,
     _ntfDelivered :: Int,
-    _activeTokens :: PeriodStatsData,
-    _activeSubs :: PeriodStatsData
+    _activeTokens :: PeriodStatsData NtfTokenId,
+    _activeSubs :: PeriodStatsData NotifierId
   }
 
 newNtfServerStats :: UTCTime -> IO NtfServerStats
 newNtfServerStats ts = do
-  fromTime <- newIORef ts
-  tknCreated <- newIORef 0
-  tknVerified <- newIORef 0
-  tknDeleted <- newIORef 0
-  subCreated <- newIORef 0
-  subDeleted <- newIORef 0
-  ntfReceived <- newIORef 0
-  ntfDelivered <- newIORef 0
+  fromTime <- newTVarIO ts
+  tknCreated <- newTVarIO 0
+  tknVerified <- newTVarIO 0
+  tknDeleted <- newTVarIO 0
+  subCreated <- newTVarIO 0
+  subDeleted <- newTVarIO 0
+  ntfReceived <- newTVarIO 0
+  ntfDelivered <- newTVarIO 0
   activeTokens <- newPeriodStats
   activeSubs <- newPeriodStats
   pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}
 
 getNtfServerStatsData :: NtfServerStats -> IO NtfServerStatsData
 getNtfServerStatsData s@NtfServerStats {fromTime} = do
-  _fromTime <- readIORef fromTime
-  _tknCreated <- readIORef $ tknCreated s
-  _tknVerified <- readIORef $ tknVerified s
-  _tknDeleted <- readIORef $ tknDeleted s
-  _subCreated <- readIORef $ subCreated s
-  _subDeleted <- readIORef $ subDeleted s
-  _ntfReceived <- readIORef $ ntfReceived s
-  _ntfDelivered <- readIORef $ ntfDelivered s
+  _fromTime <- readTVarIO fromTime
+  _tknCreated <- readTVarIO $ tknCreated s
+  _tknVerified <- readTVarIO $ tknVerified s
+  _tknDeleted <- readTVarIO $ tknDeleted s
+  _subCreated <- readTVarIO $ subCreated s
+  _subDeleted <- readTVarIO $ subDeleted s
+  _ntfReceived <- readTVarIO $ ntfReceived s
+  _ntfDelivered <- readTVarIO $ ntfDelivered s
   _activeTokens <- getPeriodStatsData $ activeTokens s
   _activeSubs <- getPeriodStatsData $ activeSubs s
   pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
 
--- this function is not thread safe, it is used on server start only
-setNtfServerStats :: NtfServerStats -> NtfServerStatsData -> IO ()
+setNtfServerStats :: NtfServerStats -> NtfServerStatsData -> STM ()
 setNtfServerStats s@NtfServerStats {fromTime} d@NtfServerStatsData {_fromTime} = do
-  writeIORef fromTime $! _fromTime
-  writeIORef (tknCreated s) $! _tknCreated d
-  writeIORef (tknVerified s) $! _tknVerified d
-  writeIORef (tknDeleted s) $! _tknDeleted d
-  writeIORef (subCreated s) $! _subCreated d
-  writeIORef (subDeleted s) $! _subDeleted d
-  writeIORef (ntfReceived s) $! _ntfReceived d
-  writeIORef (ntfDelivered s) $! _ntfDelivered d
+  writeTVar fromTime $! _fromTime
+  writeTVar (tknCreated s) $! _tknCreated d
+  writeTVar (tknVerified s) $! _tknVerified d
+  writeTVar (tknDeleted s) $! _tknDeleted d
+  writeTVar (subCreated s) $! _subCreated d
+  writeTVar (subDeleted s) $! _subDeleted d
+  writeTVar (ntfReceived s) $! _ntfReceived d
+  writeTVar (ntfDelivered s) $! _ntfDelivered d
   setPeriodStats (activeTokens s) (_activeTokens d)
   setPeriodStats (activeSubs s) (_activeSubs d)
 

src/Simplex/Messaging/Protocol.hs

@@ -2,13 +2,11 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -101,10 +99,8 @@ module Simplex.Messaging.Protocol
     BasicAuth (..),
     SrvLoc (..),
     CorrId (..),
-    EntityId (..),
-    pattern NoEntity,
+    EntityId,
     QueueId,
-    BlobId,
     RecipientId,
     SenderId,
     NotifierId,
@@ -118,8 +114,6 @@ module Simplex.Messaging.Protocol
     NtfPublicAuthKey,
     RcvNtfPublicDhKey,
     RcvNtfDhSecret,
-    DataPrivateAuthKey,
-    DataPublicAuthKey,
     Message (..),
     RcvMessage (..),
     MsgId,
@@ -139,8 +133,6 @@ module Simplex.Messaging.Protocol
     FwdResponse (..),
     FwdTransmission (..),
     MsgFlags (..),
-    DataBlob (..),
-    EncDataBlob,
     initialSMPClientVersion,
     currentSMPClientVersion,
     userProtocol,
@@ -337,8 +329,8 @@ data RawTransmission = RawTransmission
   { authenticator :: ByteString, -- signature or encrypted transmission hash
     authorized :: ByteString, -- authorized transmission
     sessId :: SessionId,
-    corrId :: CorrId,
-    entityId :: EntityId,
+    corrId :: ByteString,
+    entityId :: ByteString,
     command :: ByteString
   }
   deriving (Show)
@@ -365,7 +357,7 @@ instance IsString (Maybe TransmissionAuth) where
   fromString = parseString $ B64.decode >=> C.decodeSignature >=> pure . fmap TASignature
 
 -- | unparsed sent SMP transmission with signature, without session ID.
-type SignedRawTransmission = (Maybe TransmissionAuth, CorrId, EntityId, ByteString)
+type SignedRawTransmission = (Maybe TransmissionAuth, SessionId, ByteString, ByteString)
 
 -- | unparsed sent SMP transmission with signature.
 type SentRawTransmission = (Maybe TransmissionAuth, ByteString)
@@ -382,15 +374,7 @@ type NotifierId = QueueId
 -- | SMP queue ID on the server.
 type QueueId = EntityId
 
-type BlobId = EntityId
-
--- this type is used for server entities only
-newtype EntityId = EntityId {unEntityId :: ByteString}
-  deriving (Eq, Ord, Show)
-  deriving newtype (Encoding, StrEncoding)
-
-pattern NoEntity :: EntityId
-pattern NoEntity = EntityId ""
+type EntityId = ByteString
 
 -- | Parameterized type for SMP protocol commands from all clients.
 data Command (p :: Party) where
@@ -411,10 +395,6 @@ data Command (p :: Party) where
   OFF :: Command Recipient
   DEL :: Command Recipient
   QUE :: Command Recipient
-  -- Data storage commands
-  WRT :: DataPublicAuthKey -> DataBlob -> Command Recipient
-  CLR :: Command Recipient
-  READ :: Command Sender
   -- SMP sender commands
   SKEY :: SndPublicAuthKey -> Command Sender
   -- SEND v1 has to be supported for encoding/decoding
@@ -423,7 +403,6 @@ data Command (p :: Party) where
   PING :: Command Sender
   -- SMP notification subscriber commands
   NSUB :: Command Notifier
-  -- Proxy commands
   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)
@@ -497,7 +476,6 @@ data BrokerMsg where
   PRES :: EncResponse -> BrokerMsg -- proxy to client
   END :: BrokerMsg
   INFO :: QueueInfo -> BrokerMsg
-  DATA :: EncDataBlob -> BrokerMsg
   OK :: BrokerMsg
   ERR :: ErrorType -> BrokerMsg
   PONG :: BrokerMsg
@@ -695,9 +673,6 @@ data CommandTag (p :: Party) where
   OFF_ :: CommandTag Recipient
   DEL_ :: CommandTag Recipient
   QUE_ :: CommandTag Recipient
-  WRT_ :: CommandTag Recipient
-  CLR_ :: CommandTag Recipient
-  READ_ :: CommandTag Sender
   SKEY_ :: CommandTag Sender
   SEND_ :: CommandTag Sender
   PING_ :: CommandTag Sender
@@ -722,7 +697,6 @@ data BrokerMsgTag
   | PRES_
   | END_
   | INFO_
-  | DATA_
   | OK_
   | ERR_
   | PONG_
@@ -748,9 +722,6 @@ instance PartyI p => Encoding (CommandTag p) where
     OFF_ -> "OFF"
     DEL_ -> "DEL"
     QUE_ -> "QUE"
-    WRT_ -> "WRT"
-    CLR_ -> "CLR"
-    READ_ -> "READ"
     SKEY_ -> "SKEY"
     SEND_ -> "SEND"
     PING_ -> "PING"
@@ -772,9 +743,6 @@ instance ProtocolMsgTag CmdTag where
     "OFF" -> Just $ CT SRecipient OFF_
     "DEL" -> Just $ CT SRecipient DEL_
     "QUE" -> Just $ CT SRecipient QUE_
-    "WRT" -> Just $ CT SRecipient WRT_
-    "CLR" -> Just $ CT SRecipient CLR_
-    "READ" -> Just $ CT SSender READ_
     "SKEY" -> Just $ CT SSender SKEY_
     "SEND" -> Just $ CT SSender SEND_
     "PING" -> Just $ CT SSender PING_
@@ -802,7 +770,6 @@ instance Encoding BrokerMsgTag where
     PRES_ -> "PRES"
     END_ -> "END"
     INFO_ -> "INFO"
-    DATA_ -> "DATA"
     OK_ -> "OK"
     ERR_ -> "ERR"
     PONG_ -> "PONG"
@@ -819,7 +786,6 @@ instance ProtocolMsgTag BrokerMsgTag where
     "PRES" -> Just PRES_
     "END" -> Just END_
     "INFO" -> Just INFO_
-    "DATA" -> Just DATA_
     "OK" -> Just OK_
     "ERR" -> Just ERR_
     "PONG" -> Just PONG_
@@ -1131,13 +1097,10 @@ serverStrP = do
     portP = show <$> (A.char ':' *> (A.decimal :: Parser Int))
 
 -- | Transmission correlation ID.
-newtype CorrId = CorrId {bs :: ByteString}
-  deriving (Eq, Ord, Show)
-  deriving newtype (Encoding)
+newtype CorrId = CorrId {bs :: ByteString} deriving (Eq, Ord, Show)
 
 instance IsString CorrId where
   fromString = CorrId . fromString
-  {-# INLINE fromString #-}
 
 instance StrEncoding CorrId where
   strEncode (CorrId cId) = strEncode cId
@@ -1194,38 +1157,12 @@ type RcvNtfPublicDhKey = C.PublicKeyX25519
 -- | DH Secret used to encrypt notification metadata from server to recipient
 type RcvNtfDhSecret = C.DhSecretX25519
 
--- | private key to authorize owner access to data blobs
-type DataPrivateAuthKey = C.APrivateAuthKey
-
--- | public key to authorize owner access to data blobs
-type DataPublicAuthKey = C.APublicAuthKey
-
 -- | SMP message server ID.
 type MsgId = ByteString
 
 -- | SMP message body.
 type MsgBody = ByteString
 
-data DataBlob = DataBlob
-  { dataNonce :: C.CbNonce,
-    dataBody :: ByteString
-  }
-  deriving (Eq, Show)
-
-instance Encoding DataBlob where
-  smpEncode DataBlob {dataNonce, dataBody} = smpEncode (dataNonce, Tail dataBody)
-  smpP = do
-    (dataNonce, Tail dataBody) <- smpP
-    pure DataBlob {dataNonce, dataBody}
-
-instance StrEncoding DataBlob where
-  strEncode DataBlob {dataNonce, dataBody} = strEncode (dataNonce, dataBody)
-  strP = do
-    (dataNonce, dataBody) <- strP
-    pure DataBlob {dataNonce, dataBody}
-
-type EncDataBlob = ByteString
-
 data ProtocolErrorType = PECmdSyntax | PECmdUnknown | PESession | PEBlock
 
 -- | Type for protocol errors.
@@ -1370,9 +1307,6 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
     OFF -> e OFF_
     DEL -> e DEL_
     QUE -> e QUE_
-    WRT k blob -> e (WRT_, ' ', k, blob)
-    CLR -> e CLR_
-    READ -> e READ_
     SKEY k -> e (SKEY_, ' ', k)
     SEND flags msg -> e (SEND_, ' ', flags, ' ', Tail msg)
     PING -> e PING_
@@ -1389,7 +1323,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, _, entId, _) cmd = case cmd of
     -- NEW must have signature but NOT queue ID
     NEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
@@ -1402,12 +1336,14 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
     SKEY _
       | isNothing auth || B.null entId -> Left $ CMD NO_AUTH
       | otherwise -> Right cmd
-    READ -> entityNoAuthCmd
     PING -> noAuthCmd
     PRXY {} -> noAuthCmd
-    PFWD {} -> entityNoAuthCmd
+    PFWD {}
+      | B.null entId -> Left $ CMD NO_ENTITY
+      | isNothing auth -> Right cmd
+      | otherwise -> Left $ CMD HAS_AUTH
     RFWD _ -> noAuthCmd
-    -- other client commands must have both signature and entity ID
+    -- other client commands must have both signature and queue ID
     _
       | isNothing auth || B.null entId -> Left $ CMD NO_AUTH
       | otherwise -> Right cmd
@@ -1417,11 +1353,6 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
       noAuthCmd
         | isNothing auth && B.null entId = Right cmd
         | otherwise = Left $ CMD HAS_AUTH
-      entityNoAuthCmd :: Either ErrorType (Command p)
-      entityNoAuthCmd
-        | B.null entId = Left $ CMD NO_ENTITY
-        | isJust auth = Left $ CMD HAS_AUTH
-        | otherwise = Right cmd
 
 instance ProtocolEncoding SMPVersion ErrorType Cmd where
   type Tag Cmd = CmdTag
@@ -1447,13 +1378,10 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
         OFF_ -> pure OFF
         DEL_ -> pure DEL
         QUE_ -> pure QUE
-        WRT_ -> WRT <$> _smpP <*> smpP
-        CLR_ -> pure CLR
     CT SSender tag ->
       Cmd SSender <$> case tag of
         SKEY_ -> SKEY <$> _smpP
         SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP)
-        READ_ -> pure READ
         PING_ -> pure PING
         RFWD_ -> RFWD <$> (EncFwdTransmission . unTail <$> _smpP)
     CT SProxiedClient tag ->
@@ -1484,7 +1412,6 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     PRES (EncResponse encBlock) -> e (PRES_, ' ', Tail encBlock)
     END -> e END_
     INFO info -> e (INFO_, ' ', info)
-    DATA body -> e (DATA_, ' ', Tail body)
     OK -> e OK_
     ERR err -> e (ERR_, ' ', err)
     PONG -> e PONG_
@@ -1510,7 +1437,6 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     PRES_ -> PRES <$> (EncResponse . unTail <$> _smpP)
     END_ -> pure END
     INFO_ -> INFO <$> _smpP
-    DATA_ -> DATA . unTail <$> _smpP
     OK_ -> pure OK
     ERR_ -> ERR <$> _smpP
     PONG_ -> pure PONG
@@ -1522,7 +1448,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials (_, _, entId, _) cmd = case cmd of
     -- IDS response should not have queue ID
     IDS _ -> Right cmd
     -- ERR response does not always have queue ID
@@ -1795,16 +1721,16 @@ tDecodeParseValidate THandleParams {sessionId, thVersion = v, implySessId} = \ca
     | implySessId || sessId == sessionId ->
         let decodedTransmission = (,corrId,entityId,command) <$> decodeTAuthBytes authenticator
          in either (const $ tError corrId) (tParseValidate authorized) decodedTransmission
-    | otherwise -> (Nothing, "", (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd PESession))
+    | otherwise -> (Nothing, "", (CorrId corrId, "", Left $ fromProtocolError @v @err @cmd PESession))
   Left _ -> tError ""
   where
-    tError :: CorrId -> SignedTransmission err cmd
-    tError corrId = (Nothing, "", (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd PEBlock))
+    tError :: ByteString -> SignedTransmission err cmd
+    tError corrId = (Nothing, "", (CorrId corrId, "", Left $ fromProtocolError @v @err @cmd PEBlock))
 
     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))
+       in (sig, signed, (CorrId corrId, entityId, cmd))
 
 $(J.deriveJSON defaultJSON ''MsgFlags)
 

src/Simplex/Messaging/Server/Control.hs

@@ -4,8 +4,9 @@
 module Simplex.Messaging.Server.Control where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString (ByteString)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BasicAuth, SenderId)
+import Simplex.Messaging.Protocol (BasicAuth)
 
 data CPClientRole = CPRNone | CPRUser | CPRAdmin
   deriving (Eq)
@@ -21,7 +22,7 @@ data ControlProtocol
   | CPSockets
   | CPSocketThreads
   | CPServerInfo
-  | CPDelete SenderId
+  | CPDelete ByteString
   | CPSave
   | CPHelp
   | CPQuit

src/Simplex/Messaging/Server/DataLog.hs

@@ -1,62 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Simplex.Messaging.Server.DataLog where
-
-import Control.Applicative ((<|>))
-import Control.Monad (foldM)
-import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-import Simplex.Messaging.Protocol (BlobId)
-import Simplex.Messaging.Server.DataStore
-import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Transport.Buffer (trimCR)
-import Simplex.Messaging.Util (ifM)
-import System.Directory (doesFileExist)
-import System.IO
-
-data DataLogRecord = CreateBlob DataRec | DeleteBlob BlobId
-
-instance StrEncoding DataLogRecord where
-  strEncode = \case
-    CreateBlob d -> strEncode (Str "CREATE", d)
-    DeleteBlob dId -> strEncode (Str "DELETE", dId)
-  strP =
-    "CREATE " *> (CreateBlob <$> strP)
-      <|> "DELETE " *> (DeleteBlob <$> strP)
-
-logCreateBlob :: StoreLog 'WriteMode -> DataRec -> IO ()
-logCreateBlob s = writeStoreLogRecord s . CreateBlob
-
-logDeleteBlob :: StoreLog 'WriteMode -> BlobId -> IO ()
-logDeleteBlob s = writeStoreLogRecord s . DeleteBlob
-
-readWriteDataLog :: FilePath -> IO (Map BlobId DataRec, StoreLog 'WriteMode)
-readWriteDataLog f = do
-  ds <- ifM (doesFileExist f) (readDataBlobs f) (pure M.empty)
-  s <- openWriteStoreLog f
-  writeDataBlobs s ds
-  pure (ds, s)
-
-writeDataBlobs :: StoreLog 'WriteMode -> Map BlobId DataRec -> IO ()
-writeDataBlobs = mapM_ . logCreateBlob
-
-readDataBlobs :: FilePath -> IO (Map BlobId DataRec)
-readDataBlobs f = foldM processLine M.empty . LB.lines =<< LB.readFile f
-  where
-    processLine :: Map BlobId DataRec -> LB.ByteString -> IO (Map BlobId DataRec)
-    processLine m s' = case strDecode $ trimCR s of
-      Right r -> pure $ procLogRecord r
-      Left e -> m <$ printError e
-      where
-        s = LB.toStrict s'
-        procLogRecord :: DataLogRecord -> Map BlobId DataRec
-        procLogRecord = \case
-          CreateBlob d -> M.insert (dataId d) d m
-          DeleteBlob dId -> M.delete dId m
-        printError :: String -> IO ()
-        printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s

src/Simplex/Messaging/Server/DataStore.hs

@@ -1,19 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Simplex.Messaging.Server.DataStore where
-
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol
-
-data DataRec = DataRec
-  { dataId :: BlobId,
-    dataKey :: DataPublicAuthKey,
-    dataBlob :: DataBlob
-  }
-
-instance StrEncoding DataRec where
-  strEncode DataRec {dataId, dataKey, dataBlob} = strEncode (Str "v1", dataId, dataKey, dataBlob)
-  strP = do
-    (dataId, dataKey, dataBlob) <- "v1 " *> strP
-    pure DataRec {dataId, dataKey, dataBlob}

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

@@ -31,8 +31,6 @@ import Simplex.Messaging.Client.Agent (SMPClientAgent, SMPClientAgentConfig, new
 import Simplex.Messaging.Crypto (KeyHash (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Server.DataLog
-import Simplex.Messaging.Server.DataStore
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.MsgStore.STM
@@ -56,7 +54,6 @@ data ServerConfig = ServerConfig
     queueIdBytes :: Int,
     msgIdBytes :: Int,
     storeLogFile :: Maybe FilePath,
-    dataLogFile :: Maybe FilePath,
     storeMsgsFile :: Maybe FilePath,
     -- | set to False to prohibit creating new queues
     allowNewQueues :: Bool,
@@ -79,8 +76,6 @@ data ServerConfig = ServerConfig
     serverStatsLogFile :: FilePath,
     -- | file to save and restore stats
     serverStatsBackupFile :: Maybe FilePath,
-    -- | interval between sending pending END events to unsubscribed clients, seconds
-    pendingENDInterval :: Int,
     -- | CA certificate private key is not needed for initialization
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
@@ -126,10 +121,8 @@ data Env = Env
     serverIdentity :: KeyHash,
     queueStore :: QueueStore,
     msgStore :: STMMsgStore,
-    dataStore :: TMap BlobId DataRec,
     random :: TVar ChaChaDRG,
     storeLog :: Maybe (StoreLog 'WriteMode),
-    dataLog :: Maybe (StoreLog 'WriteMode),
     tlsServerParams :: T.ServerParams,
     serverStats :: ServerStats,
     sockets :: SocketState,
@@ -141,12 +134,10 @@ data Env = Env
 type Subscribed = Bool
 
 data Server = Server
-  { subscribedQ :: TQueue (RecipientId, ClientId, Subscribed),
-    subscribers :: TMap RecipientId (TVar Client),
-    ntfSubscribedQ :: TQueue (NotifierId, ClientId, Subscribed),
-    notifiers :: TMap NotifierId (TVar Client),
-    pendingENDs :: TVar (IntMap (NonEmpty RecipientId)),
-    pendingNtfENDs :: TVar (IntMap (NonEmpty NotifierId)),
+  { subscribedQ :: TQueue (RecipientId, Client, Subscribed),
+    subscribers :: TMap RecipientId Client,
+    ntfSubscribedQ :: TQueue (NotifierId, Client, Subscribed),
+    notifiers :: TMap NotifierId Client,
     savingLock :: Lock
   }
 
@@ -156,13 +147,11 @@ newtype ProxyAgent = ProxyAgent
 
 type ClientId = Int
 
-data VerificationResult = VRVerified (Maybe QueueRec) | VRVerifiedData (Maybe DataRec) | VRFailed
-
 data Client = Client
   { clientId :: ClientId,
     subscriptions :: TMap RecipientId Sub,
     ntfSubscriptions :: TMap NotifierId (),
-    rcvQ :: TBQueue (NonEmpty (VerificationResult, Transmission Cmd)),
+    rcvQ :: TBQueue (NonEmpty (Maybe QueueRec, Transmission Cmd)),
     sndQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
     msgQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
     procThreads :: TVar Int,
@@ -191,10 +180,8 @@ newServer = do
   subscribers <- TM.emptyIO
   ntfSubscribedQ <- newTQueueIO
   notifiers <- TM.emptyIO
-  pendingENDs <- newTVarIO IM.empty
-  pendingNtfENDs <- newTVarIO IM.empty
   savingLock <- atomically createLock
-  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, pendingENDs, pendingNtfENDs, savingLock}
+  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, savingLock}
 
 newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
 newClient clientId qSize thVersion sessionId createdAt = do
@@ -223,20 +210,15 @@ newProhibitedSub = do
   return Sub {subThread = ProhibitSub, delivered}
 
 newEnv :: ServerConfig -> IO Env
-newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, dataLogFile, smpAgentCfg, transportConfig, information, messageExpiration} = do
+newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, smpAgentCfg, transportConfig, information, messageExpiration} = do
   server <- newServer
   queueStore <- newQueueStore
   msgStore <- newMsgStore
-  dataStore <- TM.emptyIO
   random <- C.newRandom
   storeLog <-
     forM storeLogFile $ \f -> do
       logInfo $ "restoring queues from file " <> T.pack f
       restoreQueues queueStore f
-  dataLog <-
-    forM dataLogFile $ \f -> do
-      logInfo $ "restoring data blobs from file " <> T.pack f
-      restoreDataBlobs dataStore f
   tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
   Fingerprint fp <- loadFingerprint caCertificateFile
   let serverIdentity = KeyHash fp
@@ -245,7 +227,7 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- newSMPProxyAgent smpAgentCfg random
-  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, dataStore, random, storeLog, dataLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     restoreQueues :: QueueStore -> FilePath -> IO (StoreLog 'WriteMode)
     restoreQueues QueueStore {queues, senders, notifiers} f = do
@@ -254,11 +236,6 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
       atomically $ writeTVar senders $! M.foldr' addSender M.empty qs
       atomically $ writeTVar notifiers $! M.foldr' addNotifier M.empty qs
       pure s
-    restoreDataBlobs :: TMap BlobId DataRec -> FilePath -> IO (StoreLog 'WriteMode)
-    restoreDataBlobs dataStore f = do
-      (ds, s) <- readWriteDataLog f
-      atomically $ writeTVar dataStore ds
-      pure s
     addSender :: QueueRec -> Map SenderId RecipientId -> Map SenderId RecipientId
     addSender q = M.insert (senderId q) (recipientId q)
     addNotifier :: QueueRec -> Map NotifierId RecipientId -> Map NotifierId RecipientId

src/Simplex/Messaging/Server/Main.hs

@@ -79,7 +79,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
     defaultServerPort = "5223"
     executableName = "smp-server"
     storeLogFilePath = combine logPath "smp-server-store.log"
-    dataLogFilePath = combine logPath "smp-server-data.log"
     httpsCertFile = combine cfgPath "web.cert"
     httpsKeyFile = combine cfgPath "web.key"
     defaultStaticPath = combine logPath "www"
@@ -263,7 +262,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
               privateKeyFile = c serverKeyFile,
               certificateFile = c serverCrtFile,
               storeLogFile = enableStoreLog $> storeLogFilePath,
-              dataLogFile = enableStoreLog $> dataLogFilePath,
               storeMsgsFile =
                 let messagesPath = combine logPath "smp-server-messages.log"
                  in case iniOnOff "STORE_LOG" "restore_messages" ini of
@@ -291,7 +289,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
               logStatsStartTime = 0, -- seconds from 00:00 UTC
               serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
               serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
-              pendingENDInterval = 15000000, -- 15 seconds
               smpServerVRange = supportedServerSMPRelayVRange,
               transportConfig =
                 defaultTransportServerConfig

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

@@ -9,18 +9,17 @@
 
 module Simplex.Messaging.Server.MsgStore.STM
   ( STMMsgStore,
-    MsgQueue (msgQueue),
+    MsgQueue (..),
     newMsgStore,
     getMsgQueue,
     delMsgQueue,
     delMsgQueueSize,
     writeMsg,
     tryPeekMsg,
-    tryPeekMsgIO,
+    peekMsg,
     tryDelMsg,
     tryDelPeekMsg,
     deleteExpiredMsgs,
-    getQueueSize,
   )
 where
 
@@ -45,14 +44,9 @@ type STMMsgStore = TMap RecipientId MsgQueue
 newMsgStore :: IO STMMsgStore
 newMsgStore = TM.emptyIO
 
--- The reason for double lookup is that majority of messaging queues exist,
--- because multiple messages are sent to the same queue,
--- so the first lookup without STM transaction will return the queue faster.
--- In case the queue does not exist, it needs to be looked-up again inside transaction.
-getMsgQueue :: STMMsgStore -> RecipientId -> Int -> IO MsgQueue
-getMsgQueue st rId quota = TM.lookupIO rId st >>= maybe (atomically maybeNewQ) pure
+getMsgQueue :: STMMsgStore -> RecipientId -> Int -> STM MsgQueue
+getMsgQueue st rId quota = maybe newQ pure =<< TM.lookup rId st
   where
-    maybeNewQ = TM.lookup rId st >>= maybe newQ pure
     newQ = do
       msgQueue <- newTQueue
       canWrite <- newTVar True
@@ -61,14 +55,14 @@ getMsgQueue st rId quota = TM.lookupIO rId st >>= maybe (atomically maybeNewQ) p
       TM.insert rId q st
       pure q
 
-delMsgQueue :: STMMsgStore -> RecipientId -> IO ()
-delMsgQueue st rId = atomically $ TM.delete rId st
+delMsgQueue :: STMMsgStore -> RecipientId -> STM ()
+delMsgQueue st rId = TM.delete rId st
 
-delMsgQueueSize :: STMMsgStore -> RecipientId -> IO Int
-delMsgQueueSize st rId = atomically (TM.lookupDelete rId st) >>= maybe (pure 0) (\MsgQueue {size} -> readTVarIO size)
+delMsgQueueSize :: STMMsgStore -> RecipientId -> STM Int
+delMsgQueueSize st rId = TM.lookupDelete rId st >>= maybe (pure 0) (\MsgQueue {size} -> readTVar size)
 
-writeMsg :: MsgQueue -> Message -> IO (Maybe (Message, Bool))
-writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = atomically $ do
+writeMsg :: MsgQueue -> Message -> STM (Maybe (Message, Bool))
+writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = do
   canWrt <- readTVar canWrite
   empty <- isEmptyTQueue q
   if canWrt || empty
@@ -83,47 +77,43 @@ writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = atomically $ do
   where
     msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
 
-tryPeekMsgIO :: MsgQueue -> IO (Maybe Message)
-tryPeekMsgIO = atomically . tryPeekTQueue . msgQueue
-{-# INLINE tryPeekMsgIO #-}
-
--- TODO remove once deliverToSub is split
 tryPeekMsg :: MsgQueue -> STM (Maybe Message)
 tryPeekMsg = tryPeekTQueue . msgQueue
 {-# INLINE tryPeekMsg #-}
 
-tryDelMsg :: MsgQueue -> MsgId -> IO (Maybe Message)
-tryDelMsg mq msgId' = atomically $
+peekMsg :: MsgQueue -> STM Message
+peekMsg = peekTQueue . msgQueue
+{-# INLINE peekMsg #-}
+
+tryDelMsg :: MsgQueue -> MsgId -> STM (Maybe Message)
+tryDelMsg mq msgId' =
   tryPeekMsg mq >>= \case
     msg_@(Just msg)
-      | msgId msg == msgId' || B.null msgId' -> tryDeleteMsg_ mq >> pure msg_
+      | msgId msg == msgId' || B.null msgId' -> tryDeleteMsg mq >> pure msg_
       | otherwise -> pure Nothing
     _ -> pure Nothing
 
 -- atomic delete (== read) last and peek next message if available
-tryDelPeekMsg :: MsgQueue -> MsgId -> IO (Maybe Message, Maybe Message)
-tryDelPeekMsg mq msgId' = atomically $
+tryDelPeekMsg :: MsgQueue -> MsgId -> STM (Maybe Message, Maybe Message)
+tryDelPeekMsg mq msgId' =
   tryPeekMsg mq >>= \case
     msg_@(Just msg)
-      | msgId msg == msgId' || B.null msgId' -> (msg_,) <$> (tryDeleteMsg_ mq >> tryPeekMsg mq)
+      | msgId msg == msgId' || B.null msgId' -> (msg_,) <$> (tryDeleteMsg mq >> tryPeekMsg mq)
       | otherwise -> pure (Nothing, msg_)
     _ -> pure (Nothing, Nothing)
 
-deleteExpiredMsgs :: MsgQueue -> Int64 -> IO Int
-deleteExpiredMsgs mq old = atomically $ loop 0
+deleteExpiredMsgs :: MsgQueue -> Int64 -> STM Int
+deleteExpiredMsgs mq old = loop 0
   where
     loop dc =
       tryPeekMsg mq >>= \case
         Just Message {msgTs}
           | systemSeconds msgTs < old ->
-              tryDeleteMsg_ mq >> loop (dc + 1)
+              tryDeleteMsg mq >> loop (dc + 1)
         _ -> pure dc
 
-tryDeleteMsg_ :: MsgQueue -> STM ()
-tryDeleteMsg_ MsgQueue {msgQueue = q, size} =
+tryDeleteMsg :: MsgQueue -> STM ()
+tryDeleteMsg MsgQueue {msgQueue = q, size} =
   tryReadTQueue q >>= \case
     Just _ -> modifyTVar' size (subtract 1)
     _ -> pure ()
-
-getQueueSize :: MsgQueue -> IO Int
-getQueueSize MsgQueue {size} = readTVarIO size

src/Simplex/Messaging/Server/QueueStore.hs

@@ -1,13 +1,10 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Messaging.Server.QueueStore where
 
-import Data.Int (Int64)
-import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 
@@ -19,8 +16,7 @@ data QueueRec = QueueRec
     senderKey :: !(Maybe SndPublicAuthKey),
     sndSecure :: !SenderCanSecure,
     notifier :: !(Maybe NtfCreds),
-    status :: !ServerQueueStatus,
-    updatedAt :: !(Maybe RoundedSystemTime)
+    status :: !ServerQueueStatus
   }
   deriving (Show)
 
@@ -38,16 +34,3 @@ instance StrEncoding NtfCreds where
     pure NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}
 
 data ServerQueueStatus = QueueActive | QueueOff deriving (Eq, Show)
-
-newtype RoundedSystemTime = RoundedSystemTime Int64
-  deriving (Eq, Ord, Show)
-
-instance StrEncoding RoundedSystemTime where
-  strEncode (RoundedSystemTime t) = strEncode t
-  strP = RoundedSystemTime <$> strP
-
-getRoundedSystemTime :: Int64 -> IO RoundedSystemTime
-getRoundedSystemTime prec = (\t -> RoundedSystemTime $ (systemSeconds t `div` prec) * prec) <$> getSystemTime
-
-getSystemDate :: IO RoundedSystemTime
-getSystemDate = getRoundedSystemTime 86400

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

@@ -19,7 +19,6 @@ module Simplex.Messaging.Server.QueueStore.STM
     addQueueNotifier,
     deleteQueueNotifier,
     suspendQueue,
-    updateQueueTime,
     deleteQueue,
   )
 where
@@ -46,8 +45,8 @@ newQueueStore = do
   notifiers <- TM.emptyIO
   pure QueueStore {queues, senders, notifiers}
 
-addQueue :: QueueStore -> QueueRec -> IO (Either ErrorType ())
-addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId = sId} = atomically $ do
+addQueue :: QueueStore -> QueueRec -> STM (Either ErrorType ())
+addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId = sId} = do
   ifM hasId (pure $ Left DUPLICATE_) $ do
     qVar <- newTVar q
     TM.insert rId qVar queues
@@ -56,52 +55,48 @@ addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId =
   where
     hasId = (||) <$> TM.member rId queues <*> TM.member sId senders
 
-getQueue :: DirectParty p => QueueStore -> SParty p -> QueueId -> IO (Either ErrorType QueueRec)
+getQueue :: DirectParty p => QueueStore -> SParty p -> QueueId -> STM (Either ErrorType QueueRec)
 getQueue QueueStore {queues, senders, notifiers} party qId =
-  toResult <$> (mapM readTVarIO =<< getVar)
+  toResult <$> (mapM readTVar =<< getVar)
   where
     getVar = case party of
-      SRecipient -> TM.lookupIO qId queues
-      SSender -> TM.lookupIO qId senders $>>= (`TM.lookupIO` queues)
-      SNotifier -> TM.lookupIO qId notifiers $>>= (`TM.lookupIO` queues)
+      SRecipient -> TM.lookup qId queues
+      SSender -> TM.lookup qId senders $>>= (`TM.lookup` queues)
+      SNotifier -> TM.lookup qId notifiers $>>= (`TM.lookup` queues)
 
-secureQueue :: QueueStore -> RecipientId -> SndPublicAuthKey -> IO (Either ErrorType QueueRec)
-secureQueue QueueStore {queues} rId sKey = toResult <$> do
-  TM.lookupIO rId queues $>>= \qVar -> atomically $ 
+secureQueue :: QueueStore -> RecipientId -> SndPublicAuthKey -> STM (Either ErrorType QueueRec)
+secureQueue QueueStore {queues} rId sKey =
+  withQueue rId queues $ \qVar ->
     readTVar qVar >>= \q -> case senderKey q of
       Just k -> pure $ if sKey == k then Just q else Nothing
       _ ->
         let !q' = q {senderKey = Just sKey}
          in writeTVar qVar q' $> Just q'
 
-addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType QueueRec)
+addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> STM (Either ErrorType QueueRec)
 addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = do
-  ifM (TM.memberIO nId notifiers) (pure $ Left DUPLICATE_) $
+  ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $
     withQueue rId queues $ \qVar -> do
       q <- readTVar qVar
       forM_ (notifier q) $ (`TM.delete` notifiers) . notifierId
-      let !q' = q {notifier = Just ntfCreds}
-      writeTVar qVar q'
+      writeTVar qVar $! q {notifier = Just ntfCreds}
       TM.insert nId rId notifiers
-      pure q'
+      pure $ Just q
 
-deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType ())
+deleteQueueNotifier :: QueueStore -> RecipientId -> STM (Either ErrorType ())
 deleteQueueNotifier QueueStore {queues, notifiers} rId =
   withQueue rId queues $ \qVar -> do
     q <- readTVar qVar
     forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers
     writeTVar qVar $! q {notifier = Nothing}
+    pure $ Just ()
 
-suspendQueue :: QueueStore -> RecipientId -> IO (Either ErrorType ())
+suspendQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ())
 suspendQueue QueueStore {queues} rId =
-  withQueue rId queues (`modifyTVar'` \q -> q {status = QueueOff})
+  withQueue rId queues $ \qVar -> modifyTVar' qVar (\q -> q {status = QueueOff}) $> Just ()
 
-updateQueueTime :: QueueStore -> RecipientId -> RoundedSystemTime -> IO ()
-updateQueueTime QueueStore {queues} rId t =
-  void $ withQueue rId queues (`modifyTVar'` \q -> q {updatedAt = Just t})
-
-deleteQueue :: QueueStore -> RecipientId -> IO (Either ErrorType QueueRec)
-deleteQueue QueueStore {queues, senders, notifiers} rId = atomically $ do
+deleteQueue :: QueueStore -> RecipientId -> STM (Either ErrorType QueueRec)
+deleteQueue QueueStore {queues, senders, notifiers} rId = do
   TM.lookupDelete rId queues >>= \case
     Just qVar ->
       readTVar qVar >>= \q -> do
@@ -113,5 +108,5 @@ deleteQueue QueueStore {queues, senders, notifiers} rId = atomically $ do
 toResult :: Maybe a -> Either ErrorType a
 toResult = maybe (Left AUTH) Right
 
-withQueue :: RecipientId -> TMap RecipientId (TVar QueueRec) -> (TVar QueueRec -> STM a) -> IO (Either ErrorType a)
-withQueue rId queues f = toResult <$> TM.lookupIO rId queues >>= atomically . mapM f
+withQueue :: RecipientId -> TMap RecipientId (TVar QueueRec) -> (TVar QueueRec -> STM (Maybe a)) -> STM (Either ErrorType a)
+withQueue rId queues f = toResult <$> TM.lookup rId queues $>>= f

src/Simplex/Messaging/Server/Stats.hs

@@ -4,78 +4,73 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Server.Stats where
 
 import Control.Applicative (optional, (<|>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Hashable (hash)
-import Data.IORef
-import Data.IntSet (IntSet)
-import qualified Data.IntSet as IS
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Time.Calendar.Month (pattern MonthDay)
 import Data.Time.Calendar.OrdinalDate (mondayStartWeek)
 import Data.Time.Clock (UTCTime (..))
-import GHC.IORef (atomicSwapIORef)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (EntityId (..))
-import Simplex.Messaging.Util (atomicModifyIORef'_, unlessM)
+import Simplex.Messaging.Protocol (RecipientId)
+import UnliftIO.STM
 
 data ServerStats = ServerStats
-  { fromTime :: IORef UTCTime,
-    qCreated :: IORef Int,
-    qSecured :: IORef Int,
-    qDeletedAll :: IORef Int,
-    qDeletedAllB :: IORef Int,
-    qDeletedNew :: IORef Int,
-    qDeletedSecured :: IORef Int,
-    qSub :: IORef Int, -- only includes subscriptions when there were pending messages
-    -- qSubNoMsg :: IORef Int, -- this stat creates too many STM transactions
-    qSubAllB :: IORef Int, -- count of all subscription batches (with and without pending messages)
-    qSubAuth :: IORef Int,
-    qSubDuplicate :: IORef Int,
-    qSubProhibited :: IORef Int,
-    qSubEnd :: IORef Int,
-    qSubEndB :: IORef Int,
-    ntfCreated :: IORef Int,
-    ntfDeleted :: IORef Int,
-    ntfDeletedB :: IORef Int,
-    ntfSub :: IORef Int,
-    ntfSubB :: IORef Int,
-    ntfSubAuth :: IORef Int,
-    ntfSubDuplicate :: IORef Int,
-    msgSent :: IORef Int,
-    msgSentAuth :: IORef Int,
-    msgSentQuota :: IORef Int,
-    msgSentLarge :: IORef Int,
-    msgRecv :: IORef Int,
-    msgRecvGet :: IORef Int,
-    msgGet :: IORef Int,
-    msgGetNoMsg :: IORef Int,
-    msgGetAuth :: IORef Int,
-    msgGetDuplicate :: IORef Int,
-    msgGetProhibited :: IORef Int,
-    msgExpired :: IORef Int,
-    activeQueues :: PeriodStats,
-    -- subscribedQueues :: PeriodStats, -- this stat uses too much memory
-    msgSentNtf :: IORef Int, -- sent messages with NTF flag
-    msgRecvNtf :: IORef Int, -- received messages with NTF flag
-    activeQueuesNtf :: PeriodStats,
-    msgNtfs :: IORef Int, -- messages notications delivered to NTF server (<= msgSentNtf)
-    msgNtfNoSub :: IORef Int, -- no subscriber to notifications (e.g., NTF server not connected)
-    msgNtfLost :: IORef Int, -- notification is lost because NTF delivery queue is full
+  { fromTime :: TVar UTCTime,
+    qCreated :: TVar Int,
+    qSecured :: TVar Int,
+    qDeletedAll :: TVar Int,
+    qDeletedAllB :: TVar Int,
+    qDeletedNew :: TVar Int,
+    qDeletedSecured :: TVar Int,
+    qSub :: TVar Int,
+    qSubNoMsg :: TVar Int,
+    qSubAllB :: TVar Int,
+    qSubAuth :: TVar Int,
+    qSubDuplicate :: TVar Int,
+    qSubProhibited :: TVar Int,
+    qSubEnd :: TVar Int,
+    qSubEndB :: TVar Int,
+    qSubEndSent :: TVar Int,
+    qSubEndSentB :: TVar Int,
+    ntfCreated :: TVar Int,
+    ntfDeleted :: TVar Int,
+    ntfDeletedB :: TVar Int,
+    ntfSub :: TVar Int,
+    ntfSubB :: TVar Int,
+    ntfSubAuth :: TVar Int,
+    ntfSubDuplicate :: TVar Int,
+    msgSent :: TVar Int,
+    msgSentAuth :: TVar Int,
+    msgSentQuota :: TVar Int,
+    msgSentLarge :: TVar Int,
+    msgRecv :: TVar Int,
+    msgRecvGet :: TVar Int,
+    msgGet :: TVar Int,
+    msgGetNoMsg :: TVar Int,
+    msgGetAuth :: TVar Int,
+    msgGetDuplicate :: TVar Int,
+    msgGetProhibited :: TVar Int,
+    msgExpired :: TVar Int,
+    activeQueues :: PeriodStats RecipientId,
+    subscribedQueues :: PeriodStats RecipientId,
+    msgSentNtf :: TVar Int, -- sent messages with NTF flag
+    msgRecvNtf :: TVar Int, -- received messages with NTF flag
+    activeQueuesNtf :: PeriodStats RecipientId,
+    msgNtfs :: TVar Int, -- messages notications delivered to NTF server (<= msgSentNtf)
+    msgNtfNoSub :: TVar Int, -- no subscriber to notifications (e.g., NTF server not connected)
+    msgNtfLost :: TVar Int, -- notification is lost because NTF delivery queue is full
     pRelays :: ProxyStats,
     pRelaysOwn :: ProxyStats,
     pMsgFwds :: ProxyStats,
     pMsgFwdsOwn :: ProxyStats,
-    pMsgFwdsRecv :: IORef Int,
-    qCount :: IORef Int,
-    msgCount :: IORef Int
+    pMsgFwdsRecv :: TVar Int,
+    qCount :: TVar Int,
+    msgCount :: TVar Int
   }
 
 data ServerStatsData = ServerStatsData
@@ -87,12 +82,15 @@ data ServerStatsData = ServerStatsData
     _qDeletedNew :: Int,
     _qDeletedSecured :: Int,
     _qSub :: Int,
+    _qSubNoMsg :: Int,
     _qSubAllB :: Int,
     _qSubAuth :: Int,
     _qSubDuplicate :: Int,
     _qSubProhibited :: Int,
     _qSubEnd :: Int,
     _qSubEndB :: Int,
+    _qSubEndSent :: Int,
+    _qSubEndSentB :: Int,
     _ntfCreated :: Int,
     _ntfDeleted :: Int,
     _ntfDeletedB :: Int,
@@ -112,10 +110,11 @@ data ServerStatsData = ServerStatsData
     _msgGetDuplicate :: Int,
     _msgGetProhibited :: Int,
     _msgExpired :: Int,
-    _activeQueues :: PeriodStatsData,
+    _activeQueues :: PeriodStatsData RecipientId,
+    _subscribedQueues :: PeriodStatsData RecipientId,
     _msgSentNtf :: Int,
     _msgRecvNtf :: Int,
-    _activeQueuesNtf :: PeriodStatsData,
+    _activeQueuesNtf :: PeriodStatsData RecipientId,
     _msgNtfs :: Int,
     _msgNtfNoSub :: Int,
     _msgNtfLost :: Int,
@@ -131,53 +130,57 @@ data ServerStatsData = ServerStatsData
 
 newServerStats :: UTCTime -> IO ServerStats
 newServerStats ts = do
-  fromTime <- newIORef ts
-  qCreated <- newIORef 0
-  qSecured <- newIORef 0
-  qDeletedAll <- newIORef 0
-  qDeletedAllB <- newIORef 0
-  qDeletedNew <- newIORef 0
-  qDeletedSecured <- newIORef 0
-  qSub <- newIORef 0
-  qSubAllB <- newIORef 0
-  qSubAuth <- newIORef 0
-  qSubDuplicate <- newIORef 0
-  qSubProhibited <- newIORef 0
-  qSubEnd <- newIORef 0
-  qSubEndB <- newIORef 0
-  ntfCreated <- newIORef 0
-  ntfDeleted <- newIORef 0
-  ntfDeletedB <- newIORef 0
-  ntfSub <- newIORef 0
-  ntfSubB <- newIORef 0
-  ntfSubAuth <- newIORef 0
-  ntfSubDuplicate <- newIORef 0
-  msgSent <- newIORef 0
-  msgSentAuth <- newIORef 0
-  msgSentQuota <- newIORef 0
-  msgSentLarge <- newIORef 0
-  msgRecv <- newIORef 0
-  msgRecvGet <- newIORef 0
-  msgGet <- newIORef 0
-  msgGetNoMsg <- newIORef 0
-  msgGetAuth <- newIORef 0
-  msgGetDuplicate <- newIORef 0
-  msgGetProhibited <- newIORef 0
-  msgExpired <- newIORef 0
+  fromTime <- newTVarIO ts
+  qCreated <- newTVarIO 0
+  qSecured <- newTVarIO 0
+  qDeletedAll <- newTVarIO 0
+  qDeletedAllB <- newTVarIO 0
+  qDeletedNew <- newTVarIO 0
+  qDeletedSecured <- newTVarIO 0
+  qSub <- newTVarIO 0
+  qSubNoMsg <- newTVarIO 0
+  qSubAllB <- newTVarIO 0
+  qSubAuth <- newTVarIO 0
+  qSubDuplicate <- newTVarIO 0
+  qSubProhibited <- newTVarIO 0
+  qSubEnd <- newTVarIO 0
+  qSubEndB <- newTVarIO 0
+  qSubEndSent <- newTVarIO 0
+  qSubEndSentB <- newTVarIO 0
+  ntfCreated <- newTVarIO 0
+  ntfDeleted <- newTVarIO 0
+  ntfDeletedB <- newTVarIO 0
+  ntfSub <- newTVarIO 0
+  ntfSubB <- newTVarIO 0
+  ntfSubAuth <- newTVarIO 0
+  ntfSubDuplicate <- newTVarIO 0
+  msgSent <- newTVarIO 0
+  msgSentAuth <- newTVarIO 0
+  msgSentQuota <- newTVarIO 0
+  msgSentLarge <- newTVarIO 0
+  msgRecv <- newTVarIO 0
+  msgRecvGet <- newTVarIO 0
+  msgGet <- newTVarIO 0
+  msgGetNoMsg <- newTVarIO 0
+  msgGetAuth <- newTVarIO 0
+  msgGetDuplicate <- newTVarIO 0
+  msgGetProhibited <- newTVarIO 0
+  msgExpired <- newTVarIO 0
   activeQueues <- newPeriodStats
-  msgSentNtf <- newIORef 0
-  msgRecvNtf <- newIORef 0
+  subscribedQueues <- newPeriodStats
+  msgSentNtf <- newTVarIO 0
+  msgRecvNtf <- newTVarIO 0
   activeQueuesNtf <- newPeriodStats
-  msgNtfs <- newIORef 0
-  msgNtfNoSub <- newIORef 0
-  msgNtfLost <- newIORef 0
+  msgNtfs <- newTVarIO 0
+  msgNtfNoSub <- newTVarIO 0
+  msgNtfLost <- newTVarIO 0
   pRelays <- newProxyStats
   pRelaysOwn <- newProxyStats
   pMsgFwds <- newProxyStats
   pMsgFwdsOwn <- newProxyStats
-  pMsgFwdsRecv <- newIORef 0
-  qCount <- newIORef 0
-  msgCount <- newIORef 0
+  pMsgFwdsRecv <- newTVarIO 0
+  qCount <- newTVarIO 0
+  msgCount <- newTVarIO 0
   pure
     ServerStats
       { fromTime,
@@ -188,12 +191,15 @@ newServerStats ts = do
         qDeletedNew,
         qDeletedSecured,
         qSub,
+        qSubNoMsg,
         qSubAllB,
         qSubAuth,
         qSubDuplicate,
         qSubProhibited,
         qSubEnd,
         qSubEndB,
+        qSubEndSent,
+        qSubEndSentB,
         ntfCreated,
         ntfDeleted,
         ntfDeletedB,
@@ -214,6 +220,7 @@ newServerStats ts = do
         msgGetProhibited,
         msgExpired,
         activeQueues,
+        subscribedQueues,
         msgSentNtf,
         msgRecvNtf,
         activeQueuesNtf,
@@ -231,53 +238,57 @@ newServerStats ts = do
 
 getServerStatsData :: ServerStats -> IO ServerStatsData
 getServerStatsData s = do
-  _fromTime <- readIORef $ fromTime s
-  _qCreated <- readIORef $ qCreated s
-  _qSecured <- readIORef $ qSecured s
-  _qDeletedAll <- readIORef $ qDeletedAll s
-  _qDeletedAllB <- readIORef $ qDeletedAllB s
-  _qDeletedNew <- readIORef $ qDeletedNew s
-  _qDeletedSecured <- readIORef $ qDeletedSecured s
-  _qSub <- readIORef $ qSub s
-  _qSubAllB <- readIORef $ qSubAllB s
-  _qSubAuth <- readIORef $ qSubAuth s
-  _qSubDuplicate <- readIORef $ qSubDuplicate s
-  _qSubProhibited <- readIORef $ qSubProhibited s
-  _qSubEnd <- readIORef $ qSubEnd s
-  _qSubEndB <- readIORef $ qSubEndB s
-  _ntfCreated <- readIORef $ ntfCreated s
-  _ntfDeleted <- readIORef $ ntfDeleted s
-  _ntfDeletedB <- readIORef $ ntfDeletedB s
-  _ntfSub <- readIORef $ ntfSub s
-  _ntfSubB <- readIORef $ ntfSubB s
-  _ntfSubAuth <- readIORef $ ntfSubAuth s
-  _ntfSubDuplicate <- readIORef $ ntfSubDuplicate s
-  _msgSent <- readIORef $ msgSent s
-  _msgSentAuth <- readIORef $ msgSentAuth s
-  _msgSentQuota <- readIORef $ msgSentQuota s
-  _msgSentLarge <- readIORef $ msgSentLarge s
-  _msgRecv <- readIORef $ msgRecv s
-  _msgRecvGet <- readIORef $ msgRecvGet s
-  _msgGet <- readIORef $ msgGet s
-  _msgGetNoMsg <- readIORef $ msgGetNoMsg s
-  _msgGetAuth <- readIORef $ msgGetAuth s
-  _msgGetDuplicate <- readIORef $ msgGetDuplicate s
-  _msgGetProhibited <- readIORef $ msgGetProhibited s
-  _msgExpired <- readIORef $ msgExpired s
+  _fromTime <- readTVarIO $ fromTime s
+  _qCreated <- readTVarIO $ qCreated s
+  _qSecured <- readTVarIO $ qSecured s
+  _qDeletedAll <- readTVarIO $ qDeletedAll s
+  _qDeletedAllB <- readTVarIO $ qDeletedAllB s
+  _qDeletedNew <- readTVarIO $ qDeletedNew s
+  _qDeletedSecured <- readTVarIO $ qDeletedSecured s
+  _qSub <- readTVarIO $ qSub s
+  _qSubNoMsg <- readTVarIO $ qSubNoMsg s
+  _qSubAllB <- readTVarIO $ qSubAllB s
+  _qSubAuth <- readTVarIO $ qSubAuth s
+  _qSubDuplicate <- readTVarIO $ qSubDuplicate s
+  _qSubProhibited <- readTVarIO $ qSubProhibited s
+  _qSubEnd <- readTVarIO $ qSubEnd s
+  _qSubEndB <- readTVarIO $ qSubEndB s
+  _qSubEndSent <- readTVarIO $ qSubEndSent s
+  _qSubEndSentB <- readTVarIO $ qSubEndSentB s
+  _ntfCreated <- readTVarIO $ ntfCreated s
+  _ntfDeleted <- readTVarIO $ ntfDeleted s
+  _ntfDeletedB <- readTVarIO $ ntfDeletedB s
+  _ntfSub <- readTVarIO $ ntfSub s
+  _ntfSubB <- readTVarIO $ ntfSubB s
+  _ntfSubAuth <- readTVarIO $ ntfSubAuth s
+  _ntfSubDuplicate <- readTVarIO $ ntfSubDuplicate s
+  _msgSent <- readTVarIO $ msgSent s
+  _msgSentAuth <- readTVarIO $ msgSentAuth s
+  _msgSentQuota <- readTVarIO $ msgSentQuota s
+  _msgSentLarge <- readTVarIO $ msgSentLarge s
+  _msgRecv <- readTVarIO $ msgRecv s
+  _msgRecvGet <- readTVarIO $ msgRecvGet s
+  _msgGet <- readTVarIO $ msgGet s
+  _msgGetNoMsg <- readTVarIO $ msgGetNoMsg s
+  _msgGetAuth <- readTVarIO $ msgGetAuth s
+  _msgGetDuplicate <- readTVarIO $ msgGetDuplicate s
+  _msgGetProhibited <- readTVarIO $ msgGetProhibited s
+  _msgExpired <- readTVarIO $ msgExpired s
   _activeQueues <- getPeriodStatsData $ activeQueues s
-  _msgSentNtf <- readIORef $ msgSentNtf s
-  _msgRecvNtf <- readIORef $ msgRecvNtf s
+  _subscribedQueues <- getPeriodStatsData $ subscribedQueues s
+  _msgSentNtf <- readTVarIO $ msgSentNtf s
+  _msgRecvNtf <- readTVarIO $ msgRecvNtf s
   _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
-  _msgNtfs <- readIORef $ msgNtfs s
-  _msgNtfNoSub <- readIORef $ msgNtfNoSub s
-  _msgNtfLost <- readIORef $ msgNtfLost s
+  _msgNtfs <- readTVarIO $ msgNtfs s
+  _msgNtfNoSub <- readTVarIO $ msgNtfNoSub s
+  _msgNtfLost <- readTVarIO $ msgNtfLost s
   _pRelays <- getProxyStatsData $ pRelays s
   _pRelaysOwn <- getProxyStatsData $ pRelaysOwn s
   _pMsgFwds <- getProxyStatsData $ pMsgFwds s
   _pMsgFwdsOwn <- getProxyStatsData $ pMsgFwdsOwn s
-  _pMsgFwdsRecv <- readIORef $ pMsgFwdsRecv s
-  _qCount <- readIORef $ qCount s
-  _msgCount <- readIORef $ msgCount s
+  _pMsgFwdsRecv <- readTVarIO $ pMsgFwdsRecv s
+  _qCount <- readTVarIO $ qCount s
+  _msgCount <- readTVarIO $ msgCount s
   pure
     ServerStatsData
       { _fromTime,
@@ -288,12 +299,15 @@ getServerStatsData s = do
         _qDeletedNew,
         _qDeletedSecured,
         _qSub,
+        _qSubNoMsg,
         _qSubAllB,
         _qSubAuth,
         _qSubDuplicate,
         _qSubProhibited,
         _qSubEnd,
         _qSubEndB,
+        _qSubEndSent,
+        _qSubEndSentB,
         _ntfCreated,
         _ntfDeleted,
         _ntfDeletedB,
@@ -314,6 +328,7 @@ getServerStatsData s = do
         _msgGetProhibited,
         _msgExpired,
         _activeQueues,
+        _subscribedQueues,
         _msgSentNtf,
         _msgRecvNtf,
         _activeQueuesNtf,
@@ -329,56 +344,59 @@ getServerStatsData s = do
         _msgCount
       }
 
--- this function is not thread safe, it is used on server start only
-setServerStats :: ServerStats -> ServerStatsData -> IO ()
+setServerStats :: ServerStats -> ServerStatsData -> STM ()
 setServerStats s d = do
-  writeIORef (fromTime s) $! _fromTime d
-  writeIORef (qCreated s) $! _qCreated d
-  writeIORef (qSecured s) $! _qSecured d
-  writeIORef (qDeletedAll s) $! _qDeletedAll d
-  writeIORef (qDeletedAllB s) $! _qDeletedAllB d
-  writeIORef (qDeletedNew s) $! _qDeletedNew d
-  writeIORef (qDeletedSecured s) $! _qDeletedSecured d
-  writeIORef (qSub s) $! _qSub d
-  writeIORef (qSubAllB s) $! _qSubAllB d
-  writeIORef (qSubAuth s) $! _qSubAuth d
-  writeIORef (qSubDuplicate s) $! _qSubDuplicate d
-  writeIORef (qSubProhibited s) $! _qSubProhibited d
-  writeIORef (qSubEnd s) $! _qSubEnd d
-  writeIORef (qSubEndB s) $! _qSubEndB d
-  writeIORef (ntfCreated s) $! _ntfCreated d
-  writeIORef (ntfDeleted s) $! _ntfDeleted d
-  writeIORef (ntfDeletedB s) $! _ntfDeletedB d
-  writeIORef (ntfSub s) $! _ntfSub d
-  writeIORef (ntfSubB s) $! _ntfSubB d
-  writeIORef (ntfSubAuth s) $! _ntfSubAuth d
-  writeIORef (ntfSubDuplicate s) $! _ntfSubDuplicate d
-  writeIORef (msgSent s) $! _msgSent d
-  writeIORef (msgSentAuth s) $! _msgSentAuth d
-  writeIORef (msgSentQuota s) $! _msgSentQuota d
-  writeIORef (msgSentLarge s) $! _msgSentLarge d
-  writeIORef (msgRecv s) $! _msgRecv d
-  writeIORef (msgRecvGet s) $! _msgRecvGet d
-  writeIORef (msgGet s) $! _msgGet d
-  writeIORef (msgGetNoMsg s) $! _msgGetNoMsg d
-  writeIORef (msgGetAuth s) $! _msgGetAuth d
-  writeIORef (msgGetDuplicate s) $! _msgGetDuplicate d
-  writeIORef (msgGetProhibited s) $! _msgGetProhibited d
-  writeIORef (msgExpired s) $! _msgExpired d
+  writeTVar (fromTime s) $! _fromTime d
+  writeTVar (qCreated s) $! _qCreated d
+  writeTVar (qSecured s) $! _qSecured d
+  writeTVar (qDeletedAll s) $! _qDeletedAll d
+  writeTVar (qDeletedAllB s) $! _qDeletedAllB d
+  writeTVar (qDeletedNew s) $! _qDeletedNew d
+  writeTVar (qDeletedSecured s) $! _qDeletedSecured d
+  writeTVar (qSub s) $! _qSub d
+  writeTVar (qSubNoMsg s) $! _qSubNoMsg d
+  writeTVar (qSubAllB s) $! _qSubAllB d
+  writeTVar (qSubAuth s) $! _qSubAuth d
+  writeTVar (qSubDuplicate s) $! _qSubDuplicate d
+  writeTVar (qSubProhibited s) $! _qSubProhibited d
+  writeTVar (qSubEnd s) $! _qSubEnd d
+  writeTVar (qSubEndB s) $! _qSubEndB d
+  writeTVar (qSubEndSent s) $! _qSubEndSent d
+  writeTVar (qSubEndSentB s) $! _qSubEndSentB d
+  writeTVar (ntfCreated s) $! _ntfCreated d
+  writeTVar (ntfDeleted s) $! _ntfDeleted d
+  writeTVar (ntfDeletedB s) $! _ntfDeletedB d
+  writeTVar (ntfSub s) $! _ntfSub d
+  writeTVar (ntfSubB s) $! _ntfSubB d
+  writeTVar (ntfSubAuth s) $! _ntfSubAuth d
+  writeTVar (ntfSubDuplicate s) $! _ntfSubDuplicate d
+  writeTVar (msgSent s) $! _msgSent d
+  writeTVar (msgSentAuth s) $! _msgSentAuth d
+  writeTVar (msgSentQuota s) $! _msgSentQuota d
+  writeTVar (msgSentLarge s) $! _msgSentLarge d
+  writeTVar (msgRecv s) $! _msgRecv d
+  writeTVar (msgRecvGet s) $! _msgRecvGet d
+  writeTVar (msgGet s) $! _msgGet d
+  writeTVar (msgGetNoMsg s) $! _msgGetNoMsg d
+  writeTVar (msgGetAuth s) $! _msgGetAuth d
+  writeTVar (msgGetDuplicate s) $! _msgGetDuplicate d
+  writeTVar (msgGetProhibited s) $! _msgGetProhibited d
+  writeTVar (msgExpired s) $! _msgExpired d
   setPeriodStats (activeQueues s) (_activeQueues d)
-  writeIORef (msgSentNtf s) $! _msgSentNtf d
-  writeIORef (msgRecvNtf s) $! _msgRecvNtf d
+  setPeriodStats (subscribedQueues s) (_subscribedQueues d)
+  writeTVar (msgSentNtf s) $! _msgSentNtf d
+  writeTVar (msgRecvNtf s) $! _msgRecvNtf d
   setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d)
-  writeIORef (msgNtfs s) $! _msgNtfs d
-  writeIORef (msgNtfNoSub s) $! _msgNtfNoSub d
-  writeIORef (msgNtfLost s) $! _msgNtfLost d
+  writeTVar (msgNtfs s) $! _msgNtfs d
+  writeTVar (msgNtfNoSub s) $! _msgNtfNoSub d
+  writeTVar (msgNtfLost s) $! _msgNtfLost d
   setProxyStats (pRelays s) $! _pRelays d
   setProxyStats (pRelaysOwn s) $! _pRelaysOwn d
   setProxyStats (pMsgFwds s) $! _pMsgFwds d
   setProxyStats (pMsgFwdsOwn s) $! _pMsgFwdsOwn d
-  writeIORef (pMsgFwdsRecv s) $! _pMsgFwdsRecv d
-  writeIORef (qCount s) $! _qCount d
-  writeIORef (msgCount s) $! _msgCount d
+  writeTVar (pMsgFwdsRecv s) $! _pMsgFwdsRecv d
+  writeTVar (qCount s) $! _qCount d
+  writeTVar (msgCount s) $! _msgCount d
 
 instance StrEncoding ServerStatsData where
   strEncode d =
@@ -392,12 +410,15 @@ instance StrEncoding ServerStatsData where
         "qDeletedAllB=" <> strEncode (_qDeletedAllB d),
         "qCount=" <> strEncode (_qCount d),
         "qSub=" <> strEncode (_qSub d),
+        "qSubNoMsg=" <> strEncode (_qSubNoMsg d),
         "qSubAllB=" <> strEncode (_qSubAllB d),
         "qSubAuth=" <> strEncode (_qSubAuth d),
         "qSubDuplicate=" <> strEncode (_qSubDuplicate d),
         "qSubProhibited=" <> strEncode (_qSubProhibited d),
         "qSubEnd=" <> strEncode (_qSubEnd d),
         "qSubEndB=" <> strEncode (_qSubEndB d),
+        "qSubEndSent=" <> strEncode (_qSubEndSent d),
+        "qSubEndSentB=" <> strEncode (_qSubEndSentB d),
         "ntfCreated=" <> strEncode (_ntfCreated d),
         "ntfDeleted=" <> strEncode (_ntfDeleted d),
         "ntfDeletedB=" <> strEncode (_ntfDeletedB d),
@@ -424,6 +445,8 @@ instance StrEncoding ServerStatsData where
         "msgNtfLost=" <> strEncode (_msgNtfLost d),
         "activeQueues:",
         strEncode (_activeQueues d),
+        "subscribedQueues:",
+        strEncode (_subscribedQueues d),
         "activeQueuesNtf:",
         strEncode (_activeQueuesNtf d),
         "pRelays:",
@@ -446,13 +469,15 @@ instance StrEncoding ServerStatsData where
     _qDeletedAllB <- opt "qDeletedAllB="
     _qCount <- opt "qCount="
     _qSub <- opt "qSub="
-    _qSubNoMsg <- skipInt "qSubNoMsg=" -- skipping it for backward compatibility
+    _qSubNoMsg <- opt "qSubNoMsg="
     _qSubAllB <- opt "qSubAllB="
     _qSubAuth <- opt "qSubAuth="
     _qSubDuplicate <- opt "qSubDuplicate="
     _qSubProhibited <- opt "qSubProhibited="
     _qSubEnd <- opt "qSubEnd="
     _qSubEndB <- opt "qSubEndB="
+    _qSubEndSent <- opt "qSubEndSent="
+    _qSubEndSentB <- opt "qSubEndSentB="
     _ntfCreated <- opt "ntfCreated="
     _ntfDeleted <- opt "ntfDeleted="
     _ntfDeletedB <- opt "ntfDeletedB="
@@ -487,7 +512,7 @@ instance StrEncoding ServerStatsData where
           pure PeriodStatsData {_day, _week, _month}
     _subscribedQueues <-
       optional ("subscribedQueues:" <* A.endOfLine) >>= \case
-        Just _ -> newPeriodStatsData <$ (strP @PeriodStatsData <* optional A.endOfLine)
+        Just _ -> strP <* optional A.endOfLine
         _ -> pure newPeriodStatsData
     _activeQueuesNtf <-
       optional ("activeQueuesNtf:" <* A.endOfLine) >>= \case
@@ -508,12 +533,15 @@ instance StrEncoding ServerStatsData where
           _qDeletedNew,
           _qDeletedSecured,
           _qSub,
+          _qSubNoMsg,
           _qSubAllB,
           _qSubAuth,
           _qSubDuplicate,
           _qSubProhibited,
           _qSubEnd,
           _qSubEndB,
+          _qSubEndSent,
+          _qSubEndSentB,
           _ntfCreated,
           _ntfDeleted,
           _ntfDeletedB,
@@ -539,6 +567,7 @@ instance StrEncoding ServerStatsData where
           _msgNtfNoSub,
           _msgNtfLost,
           _activeQueues,
+          _subscribedQueues,
           _activeQueuesNtf,
           _pRelays,
           _pRelaysOwn,
@@ -550,59 +579,55 @@ instance StrEncoding ServerStatsData where
         }
     where
       opt s = A.string s *> strP <* A.endOfLine <|> pure 0
-      skipInt s = (0 :: Int) <$ optional (A.string s *> strP @Int *> A.endOfLine)
       proxyStatsP key =
         optional (A.string key >> A.endOfLine) >>= \case
           Just _ -> strP <* optional A.endOfLine
           _ -> pure newProxyStatsData
 
-data PeriodStats = PeriodStats
-  { day :: IORef IntSet,
-    week :: IORef IntSet,
-    month :: IORef IntSet
+data PeriodStats a = PeriodStats
+  { day :: TVar (Set a),
+    week :: TVar (Set a),
+    month :: TVar (Set a)
   }
 
-newPeriodStats :: IO PeriodStats
+newPeriodStats :: IO (PeriodStats a)
 newPeriodStats = do
-  day <- newIORef IS.empty
-  week <- newIORef IS.empty
-  month <- newIORef IS.empty
+  day <- newTVarIO S.empty
+  week <- newTVarIO S.empty
+  month <- newTVarIO S.empty
   pure PeriodStats {day, week, month}
 
-data PeriodStatsData = PeriodStatsData
-  { _day :: IntSet,
-    _week :: IntSet,
-    _month :: IntSet
+data PeriodStatsData a = PeriodStatsData
+  { _day :: Set a,
+    _week :: Set a,
+    _month :: Set a
   }
   deriving (Show)
 
-newPeriodStatsData :: PeriodStatsData
-newPeriodStatsData = PeriodStatsData {_day = IS.empty, _week = IS.empty, _month = IS.empty}
+newPeriodStatsData :: PeriodStatsData a
+newPeriodStatsData = PeriodStatsData {_day = S.empty, _week = S.empty, _month = S.empty}
 
-getPeriodStatsData :: PeriodStats -> IO PeriodStatsData
+getPeriodStatsData :: PeriodStats a -> IO (PeriodStatsData a)
 getPeriodStatsData s = do
-  _day <- readIORef $ day s
-  _week <- readIORef $ week s
-  _month <- readIORef $ month s
+  _day <- readTVarIO $ day s
+  _week <- readTVarIO $ week s
+  _month <- readTVarIO $ month s
   pure PeriodStatsData {_day, _week, _month}
 
--- this function is not thread safe, it is used on server start only
-setPeriodStats :: PeriodStats -> PeriodStatsData -> IO ()
+setPeriodStats :: PeriodStats a -> PeriodStatsData a -> STM ()
 setPeriodStats s d = do
-  writeIORef (day s) $! _day d
-  writeIORef (week s) $! _week d
-  writeIORef (month s) $! _month d
+  writeTVar (day s) $! _day d
+  writeTVar (week s) $! _week d
+  writeTVar (month s) $! _month d
 
-instance StrEncoding PeriodStatsData where
+instance (Ord a, StrEncoding a) => StrEncoding (PeriodStatsData a) where
   strEncode PeriodStatsData {_day, _week, _month} =
-    "dayHashes=" <> strEncode _day <> "\nweekHashes=" <> strEncode _week <> "\nmonthHashes=" <> strEncode _month
+    "day=" <> strEncode _day <> "\nweek=" <> strEncode _week <> "\nmonth=" <> strEncode _month
   strP = do
-    _day <- ("day=" *> bsSetP <|> "dayHashes=" *> strP) <* A.endOfLine
-    _week <- ("week=" *> bsSetP <|> "weekHashes=" *> strP) <* A.endOfLine
-    _month <- "month=" *> bsSetP <|> "monthHashes=" *> strP
+    _day <- "day=" *> strP <* A.endOfLine
+    _week <- "week=" *> strP <* A.endOfLine
+    _month <- "month=" *> strP
     pure PeriodStatsData {_day, _week, _month}
-    where
-      bsSetP = S.foldl' (\s -> (`IS.insert` s) . hash) IS.empty <$> strP @(Set ByteString)
 
 data PeriodStatCounts = PeriodStatCounts
   { dayCount :: String,
@@ -610,7 +635,7 @@ data PeriodStatCounts = PeriodStatCounts
     monthCount :: String
   }
 
-periodStatCounts :: PeriodStats -> UTCTime -> IO PeriodStatCounts
+periodStatCounts :: forall a. PeriodStats a -> UTCTime -> STM PeriodStatCounts
 periodStatCounts ps ts = do
   let d = utctDay ts
       (_, wDay) = mondayStartWeek d
@@ -620,34 +645,33 @@ periodStatCounts ps ts = do
   monthCount <- periodCount mDay $ month ps
   pure PeriodStatCounts {dayCount, weekCount, monthCount}
   where
-    periodCount :: Int -> IORef IntSet -> IO String
-    periodCount 1 ref = show . IS.size <$> atomicSwapIORef ref IS.empty
+    periodCount :: Int -> TVar (Set a) -> STM String
+    periodCount 1 pVar = show . S.size <$> swapTVar pVar S.empty
     periodCount _ _ = pure ""
 
-updatePeriodStats :: PeriodStats -> EntityId -> IO ()
-updatePeriodStats ps (EntityId pId) = do
-  updatePeriod $ day ps
-  updatePeriod $ week ps
-  updatePeriod $ month ps
+updatePeriodStats :: Ord a => PeriodStats a -> a -> STM ()
+updatePeriodStats stats pId = do
+  updatePeriod day
+  updatePeriod week
+  updatePeriod month
   where
-    ph = hash pId
-    updatePeriod ref = unlessM (IS.member ph <$> readIORef ref) $ atomicModifyIORef'_ ref $ IS.insert ph
+    updatePeriod pSel = modifyTVar' (pSel stats) (S.insert pId)
 
 data ProxyStats = ProxyStats
-  { pRequests :: IORef Int,
-    pSuccesses :: IORef Int, -- includes destination server error responses that will be forwarded to the client
-    pErrorsConnect :: IORef Int,
-    pErrorsCompat :: IORef Int,
-    pErrorsOther :: IORef Int
+  { pRequests :: TVar Int,
+    pSuccesses :: TVar Int, -- includes destination server error responses that will be forwarded to the client
+    pErrorsConnect :: TVar Int,
+    pErrorsCompat :: TVar Int,
+    pErrorsOther :: TVar Int
   }
 
 newProxyStats :: IO ProxyStats
 newProxyStats = do
-  pRequests <- newIORef 0
-  pSuccesses <- newIORef 0
-  pErrorsConnect <- newIORef 0
-  pErrorsCompat <- newIORef 0
-  pErrorsOther <- newIORef 0
+  pRequests <- newTVarIO 0
+  pSuccesses <- newTVarIO 0
+  pErrorsConnect <- newTVarIO 0
+  pErrorsCompat <- newTVarIO 0
+  pErrorsOther <- newTVarIO 0
   pure ProxyStats {pRequests, pSuccesses, pErrorsConnect, pErrorsCompat, pErrorsOther}
 
 data ProxyStatsData = ProxyStatsData
@@ -664,30 +688,29 @@ newProxyStatsData = ProxyStatsData {_pRequests = 0, _pSuccesses = 0, _pErrorsCon
 
 getProxyStatsData :: ProxyStats -> IO ProxyStatsData
 getProxyStatsData s = do
-  _pRequests <- readIORef $ pRequests s
-  _pSuccesses <- readIORef $ pSuccesses s
-  _pErrorsConnect <- readIORef $ pErrorsConnect s
-  _pErrorsCompat <- readIORef $ pErrorsCompat s
-  _pErrorsOther <- readIORef $ pErrorsOther s
+  _pRequests <- readTVarIO $ pRequests s
+  _pSuccesses <- readTVarIO $ pSuccesses s
+  _pErrorsConnect <- readTVarIO $ pErrorsConnect s
+  _pErrorsCompat <- readTVarIO $ pErrorsCompat s
+  _pErrorsOther <- readTVarIO $ pErrorsOther s
   pure ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther}
 
-getResetProxyStatsData :: ProxyStats -> IO ProxyStatsData
+getResetProxyStatsData :: ProxyStats -> STM ProxyStatsData
 getResetProxyStatsData s = do
-  _pRequests <- atomicSwapIORef (pRequests s) 0
-  _pSuccesses <- atomicSwapIORef (pSuccesses s) 0
-  _pErrorsConnect <- atomicSwapIORef (pErrorsConnect s) 0
-  _pErrorsCompat <- atomicSwapIORef (pErrorsCompat s) 0
-  _pErrorsOther <- atomicSwapIORef (pErrorsOther s) 0
+  _pRequests <- swapTVar (pRequests s) 0
+  _pSuccesses <- swapTVar (pSuccesses s) 0
+  _pErrorsConnect <- swapTVar (pErrorsConnect s) 0
+  _pErrorsCompat <- swapTVar (pErrorsCompat s) 0
+  _pErrorsOther <- swapTVar (pErrorsOther s) 0
   pure ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther}
 
--- this function is not thread safe, it is used on server start only
-setProxyStats :: ProxyStats -> ProxyStatsData -> IO ()
+setProxyStats :: ProxyStats -> ProxyStatsData -> STM ()
 setProxyStats s d = do
-  writeIORef (pRequests s) $! _pRequests d
-  writeIORef (pSuccesses s) $! _pSuccesses d
-  writeIORef (pErrorsConnect s) $! _pErrorsConnect d
-  writeIORef (pErrorsCompat s) $! _pErrorsCompat d
-  writeIORef (pErrorsOther s) $! _pErrorsOther d
+  writeTVar (pRequests s) $! _pRequests d
+  writeTVar (pSuccesses s) $! _pSuccesses d
+  writeTVar (pErrorsConnect s) $! _pErrorsConnect d
+  writeTVar (pErrorsCompat s) $! _pErrorsCompat d
+  writeTVar (pErrorsOther s) $! _pErrorsOther d
 
 instance StrEncoding ProxyStatsData where
   strEncode ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther} =

src/Simplex/Messaging/Server/StoreLog.hs

@@ -20,14 +20,12 @@ module Simplex.Messaging.Server.StoreLog
     logSuspendQueue,
     logDeleteQueue,
     logDeleteNotifier,
-    logUpdateQueueTime,
     readWriteStoreLog,
   )
 where
 
 import Control.Applicative (optional, (<|>))
 import Control.Monad (foldM, unless, when)
-import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
@@ -35,7 +33,7 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Server.QueueStore
+import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..), ServerQueueStatus (..))
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Util (ifM)
 import System.Directory (doesFileExist, renameFile)
@@ -54,19 +52,9 @@ data StoreLogRecord
   | SuspendQueue QueueId
   | DeleteQueue QueueId
   | DeleteNotifier QueueId
-  | UpdateTime QueueId RoundedSystemTime
-
-data SLRTag
-  = CreateQueue_
-  | SecureQueue_
-  | AddNotifier_
-  | SuspendQueue_
-  | DeleteQueue_
-  | DeleteNotifier_
-  | UpdateTime_
 
 instance StrEncoding QueueRec where
-  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, updatedAt} =
+  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier} =
     B.unwords
       [ "rid=" <> strEncode recipientId,
         "rk=" <> strEncode recipientKey,
@@ -76,10 +64,8 @@ instance StrEncoding QueueRec where
       ]
       <> if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
       <> maybe "" notifierStr notifier
-      <> maybe "" updatedAtStr updatedAt
     where
       notifierStr ntfCreds = " notifier=" <> strEncode ntfCreds
-      updatedAtStr t = " updated_at=" <> strEncode t
 
   strP = do
     recipientId <- "rid=" *> strP_
@@ -89,49 +75,24 @@ instance StrEncoding QueueRec where
     senderKey <- "sk=" *> strP
     sndSecure <- (" sndSecure=" *> strP) <|> pure False
     notifier <- optional $ " notifier=" *> strP
-    updatedAt <- optional $ " updated_at=" *> strP
-    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status = QueueActive, updatedAt}
-
-instance StrEncoding SLRTag where
-  strEncode = \case
-    CreateQueue_ -> "CREATE"
-    SecureQueue_ -> "SECURE"
-    AddNotifier_ -> "NOTIFIER"
-    SuspendQueue_ -> "SUSPEND"
-    DeleteQueue_ -> "DELETE"
-    DeleteNotifier_ -> "NDELETE"
-    UpdateTime_ -> "TIME"
-
-  strP =
-    A.takeTill (== ' ') >>= \case
-      "CREATE" -> pure CreateQueue_
-      "SECURE" -> pure SecureQueue_
-      "NOTIFIER" -> pure AddNotifier_
-      "SUSPEND" -> pure SuspendQueue_
-      "DELETE" -> pure DeleteQueue_
-      "NDELETE" -> pure DeleteNotifier_
-      "TIME" -> pure UpdateTime_
-      s -> fail $ "invalid log record tag: " <> B.unpack s
+    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status = QueueActive}
 
 instance StrEncoding StoreLogRecord where
   strEncode = \case
-    CreateQueue q -> strEncode (CreateQueue_, q)
-    SecureQueue rId sKey -> strEncode (SecureQueue_, rId, sKey)
-    AddNotifier rId ntfCreds -> strEncode (AddNotifier_, rId, ntfCreds)
-    SuspendQueue rId -> strEncode (SuspendQueue_, rId)
-    DeleteQueue rId -> strEncode (DeleteQueue_, rId)
-    DeleteNotifier rId -> strEncode (DeleteNotifier_, rId)
-    UpdateTime rId t ->  strEncode (UpdateTime_, rId, t)
+    CreateQueue q -> strEncode (Str "CREATE", q)
+    SecureQueue rId sKey -> strEncode (Str "SECURE", rId, sKey)
+    AddNotifier rId ntfCreds -> strEncode (Str "NOTIFIER", rId, ntfCreds)
+    SuspendQueue rId -> strEncode (Str "SUSPEND", rId)
+    DeleteQueue rId -> strEncode (Str "DELETE", rId)
+    DeleteNotifier rId -> strEncode (Str "NDELETE", rId)
 
   strP =
-    strP_ >>= \case
-      CreateQueue_ -> CreateQueue <$> strP
-      SecureQueue_ -> SecureQueue <$> strP_ <*> strP
-      AddNotifier_ -> AddNotifier <$> strP_ <*> strP
-      SuspendQueue_ -> SuspendQueue <$> strP
-      DeleteQueue_ -> DeleteQueue <$> strP
-      DeleteNotifier_ -> DeleteNotifier <$> strP
-      UpdateTime_ -> UpdateTime <$> strP_ <*> strP
+    "CREATE " *> (CreateQueue <$> strP)
+      <|> "SECURE " *> (SecureQueue <$> strP_ <*> strP)
+      <|> "NOTIFIER " *> (AddNotifier <$> strP_ <*> strP)
+      <|> "SUSPEND " *> (SuspendQueue <$> strP)
+      <|> "DELETE " *> (DeleteQueue <$> strP)
+      <|> "NDELETE " *> (DeleteNotifier <$> strP)
 
 openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
 openWriteStoreLog f = do
@@ -177,9 +138,6 @@ logDeleteQueue s = writeStoreLogRecord s . DeleteQueue
 logDeleteNotifier :: StoreLog 'WriteMode -> QueueId -> IO ()
 logDeleteNotifier s = writeStoreLogRecord s . DeleteNotifier
 
-logUpdateQueueTime :: StoreLog 'WriteMode -> QueueId -> RoundedSystemTime -> IO ()
-logUpdateQueueTime s qId t = writeStoreLogRecord s $ UpdateTime qId t
-
 readWriteStoreLog :: FilePath -> IO (Map RecipientId QueueRec, StoreLog 'WriteMode)
 readWriteStoreLog f = do
   qs <- ifM (doesFileExist f) readQS (pure M.empty)
@@ -211,6 +169,5 @@ readQueues f = foldM processLine M.empty . LB.lines =<< LB.readFile f
           SuspendQueue qId -> M.adjust (\q -> q {status = QueueOff}) qId m
           DeleteQueue qId -> M.delete qId m
           DeleteNotifier qId -> M.adjust (\q -> q {notifier = Nothing}) qId m
-          UpdateTime qId t -> M.adjust (\q -> q {updatedAt = Just t}) qId m
         printError :: String -> IO ()
         printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s

src/Simplex/Messaging/Transport.hs

@@ -47,7 +47,6 @@ module Simplex.Messaging.Transport
     authCmdsSMPVersion,
     sendingProxySMPVersion,
     sndAuthKeySMPVersion,
-    dataBlobSMPVersion,
     simplexMQVersion,
     smpBlockSize,
     TransportConfig (..),
@@ -117,6 +116,7 @@ import Simplex.Messaging.Version.Internal
 import System.IO.Error (isEOFError)
 import UnliftIO.Exception (Exception)
 import qualified UnliftIO.Exception as E
+import UnliftIO.STM
 
 -- * Transport parameters
 
@@ -131,9 +131,6 @@ smpBlockSize = 16384
 -- 5 - basic auth for SMP servers (11/12/2022)
 -- 6 - allow creating queues without subscribing (9/10/2023)
 -- 7 - support authenticated encryption to verify senders' commands, imply but do NOT send session ID in signed part (4/30/2024)
--- 8 - forwarding proxy protecting IP addresses and sessions of command senders (5/14/2024)
--- 9 - securing message queue by sender (SKEY command) for faster connection handshake (6/30/2024)
--- 10 - storing data blobs on SMP servers for short invitation links (7/25/2024)
 
 data SMPVersion
 
@@ -164,17 +161,14 @@ sendingProxySMPVersion = VersionSMP 8
 sndAuthKeySMPVersion :: VersionSMP
 sndAuthKeySMPVersion = VersionSMP 9
 
-dataBlobSMPVersion :: VersionSMP
-dataBlobSMPVersion = VersionSMP 10
-
 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 10
+currentClientSMPRelayVersion = VersionSMP 9
 
 legacyServerSMPRelayVersion :: VersionSMP
 legacyServerSMPRelayVersion = VersionSMP 6
 
 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 10
+currentServerSMPRelayVersion = VersionSMP 9
 
 -- Max SMP protocol version to be used in e2e encrypted
 -- connection between client and server, as defined by SMP proxy.
@@ -182,7 +176,7 @@ currentServerSMPRelayVersion = VersionSMP 10
 -- to prevent client version fingerprinting by the
 -- destination relays when clients upgrade at different times.
 proxiedSMPRelayVersion :: VersionSMP
-proxiedSMPRelayVersion = VersionSMP 10
+proxiedSMPRelayVersion = VersionSMP 9
 
 -- minimal supported protocol version is 4
 -- TODO remove code that supports sending commands without batching

src/Simplex/Messaging/Transport/HTTP2.hs

@@ -2,6 +2,7 @@
 
 module Simplex.Messaging.Transport.HTTP2 where
 
+import Control.Concurrent.STM
 import qualified Control.Exception as E
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B

src/Simplex/Messaging/Transport/Server.hs

@@ -12,7 +12,7 @@ module Simplex.Messaging.Transport.Server
     newSocketState,
     runTransportServer,
     runTransportServerSocket,
-    runLocalTCPServer,
+    runTCPServer,
     runTCPServerSocket,
     startTCPServer,
     loadSupportedTLSServerParams,
@@ -80,7 +80,7 @@ runTransportServer started port params cfg server = do
   runTransportServerState ss started port params cfg server
 
 runTransportServerState :: forall c . Transport c => SocketState -> TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> IO ()) -> IO ()
-runTransportServerState ss started port = runTransportServerSocketState ss started (startTCPServer started Nothing port) (transportName (TProxy :: TProxy c))
+runTransportServerState ss started port = runTransportServerSocketState ss started (startTCPServer started port) (transportName (TProxy :: TProxy c))
 
 -- | Run a transport server with provided connection setup and handler.
 runTransportServerSocket :: Transport a => TMVar Bool -> IO Socket -> String -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
@@ -107,10 +107,10 @@ tlsServerCredentials serverParams = case T.sharedCredentials $ T.serverShared se
   _ -> error "server has more than one key"
 
 -- | Run TCP server without TLS
-runLocalTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
-runLocalTCPServer started port server = do
+runTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
+runTCPServer started port server = do
   ss <- newSocketState
-  runTCPServerSocket ss started (startTCPServer started (Just "127.0.0.1") port) server
+  runTCPServerSocket ss started (startTCPServer started port) server
 
 -- | Wrap socket provider in a TCP server bracket.
 runTCPServerSocket :: SocketState -> TMVar Bool -> IO Socket -> (Socket -> IO ()) -> IO ()
@@ -157,12 +157,12 @@ closeServer started clients sock = do
   close sock
   void . atomically $ tryPutTMVar started False
 
-startTCPServer :: TMVar Bool -> Maybe HostName -> ServiceName -> IO Socket
-startTCPServer started host port = withSocketsDo $ resolve >>= open >>= setStarted
+startTCPServer :: TMVar Bool -> ServiceName -> IO Socket
+startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
   where
     resolve =
       let hints = defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Stream}
-       in select <$> getAddrInfo (Just hints) host (Just port)
+       in select <$> getAddrInfo (Just hints) Nothing (Just port)
     select as = fromJust $ family AF_INET6 <|> family AF_INET
       where
         family f = find ((== f) . addrFamily) as

src/Simplex/Messaging/Util.hs

@@ -15,7 +15,6 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
-import Data.IORef
 import Data.List (groupBy, sortOn)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -24,7 +23,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
 import Data.Time (NominalDiffTime)
 import GHC.Conc (labelThread, myThreadId, threadDelay)
-import UnliftIO hiding (atomicModifyIORef')
+import UnliftIO
 import qualified UnliftIO.Exception as UE
 
 raceAny_ :: MonadUnliftIO m => [m a] -> m ()
@@ -168,18 +167,13 @@ threadDelay' = loop
 
 diffToMicroseconds :: NominalDiffTime -> Int64
 diffToMicroseconds diff = truncate $ diff * 1000000
-{-# INLINE diffToMicroseconds #-}
 
 diffToMilliseconds :: NominalDiffTime -> Int64
 diffToMilliseconds diff = truncate $ diff * 1000
-{-# INLINE diffToMilliseconds #-}
 
 labelMyThread :: MonadIO m => String -> m ()
 labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)
 
-atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO ()
-atomicModifyIORef'_ r f = atomicModifyIORef' r (\v -> (f v, ()))
-
 encodeJSON :: ToJSON a => a -> Text
 encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
 

src/Simplex/RemoteControl/Discovery.hs

@@ -71,7 +71,7 @@ preferAddress RCCtrlAddress {address, interface} addrs =
 startTLSServer :: Maybe Word16 -> TMVar (Maybe N.PortNumber) -> TLS.Credentials -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> IO (Async ())
 startTLSServer port_ startedOnPort credentials hooks server = async . liftIO $ do
   started <- newEmptyTMVarIO
-  bracketOnError (startTCPServer started Nothing $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
+  bracketOnError (startTCPServer started $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
     ifM
       (atomically $ readTMVar started)
       (runServer started socket)

tests/AgentTests/ConnectionRequestTests.hs

@@ -20,7 +20,7 @@ import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (EntityId (..), ProtocolServer (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC)
+import Simplex.Messaging.Protocol (ProtocolServer (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC)
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import Simplex.Messaging.Version
 import Test.Hspec
@@ -35,7 +35,7 @@ queueAddr :: SMPQueueAddress
 queueAddr =
   SMPQueueAddress
     { smpServer = srv,
-      senderId = EntityId "\223\142z\251",
+      senderId = "\223\142z\251",
       dhPublicKey = testDhKey,
       sndSecure = False
     }

tests/AgentTests/NotificationTests.hs

@@ -49,7 +49,6 @@ import Data.Bifunctor (bimap, first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.List.NonEmpty as L
 import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple.QQ (sql)
 import NtfClient
@@ -67,7 +66,6 @@ import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Types (NtfTknAction (..), NtfToken (..))
-import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), NtfServer, ProtocolServer (..), SMPMsgMeta (..), SubscriptionMode (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
@@ -166,7 +164,7 @@ testNtfMatrix t runTest = do
     it "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest
     it "curr servers; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
     it "prev servers; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
-    it "prev servers; curr clients" $ runNtfTestCfg t 1 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
+    it "prev servers; curr clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
     -- servers can be upgraded in any order
     it "servers: curr SMP, prev NTF; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
     it "servers: prev SMP, curr NTF; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
@@ -874,8 +872,8 @@ messageNotificationData :: HasCallStack => AgentClient -> TBQueue APNSMockReques
 messageNotificationData c apnsQ = do
   (nonce, message) <- messageNotification apnsQ
   NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
-  Right pnMsgs <- liftEither . first INTERNAL $ Right . parseAll pnMessagesP =<< first show (C.cbDecrypt dhSecret nonce message)
-  pure $ L.last pnMsgs
+  Right pnMsgData <- liftEither . first INTERNAL $ Right . strDecode =<< first show (C.cbDecrypt dhSecret nonce message)
+  pure pnMsgData
 
 noNotification :: TBQueue APNSMockRequest -> ExceptT AgentErrorType IO ()
 noNotification apnsQ = do

tests/AgentTests/SQLiteTests.hs

@@ -50,7 +50,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Protocol (EntityId (..), SubscriptionMode (..), pattern VersionSMPC)
+import Simplex.Messaging.Protocol (SubscriptionMode (..), pattern VersionSMPC)
 import qualified Simplex.Messaging.Protocol as SMP
 import System.Random
 import Test.Hspec
@@ -217,12 +217,12 @@ rcvQueue1 =
     { userId = 1,
       connId = "conn1",
       server = smpServer1,
-      rcvId = EntityId "1234",
+      rcvId = "1234",
       rcvPrivateKey = testPrivateAuthKey,
       rcvDhSecret = testDhSecret,
       e2ePrivKey = testPrivDhKey,
       e2eDhSecret = Nothing,
-      sndId = EntityId "2345",
+      sndId = "2345",
       sndSecure = True,
       status = New,
       dbQueueId = DBNewQueue,
@@ -240,7 +240,7 @@ sndQueue1 =
     { userId = 1,
       connId = "conn1",
       server = smpServer1,
-      sndId = EntityId "3456",
+      sndId = "3456",
       sndSecure = True,
       sndPublicKey = testPublicAuthKey,
       sndPrivateKey = testPrivateAuthKey,
@@ -332,7 +332,7 @@ testGetRcvConn :: SpecWith SQLiteStore
 testGetRcvConn =
   it "should get connection using rcv queue id and server" . withStoreTransaction $ \db -> do
     let smpServer = SMPServer "smp.simplex.im" "5223" testKeyHash
-    let recipientId = EntityId "1234"
+    let recipientId = "1234"
     g <- C.newRandom
     Right (_, rq) <- createRcvConn db g cData1 rcvQueue1 SCMInvitation
     getRcvConn db smpServer recipientId
@@ -400,7 +400,7 @@ testUpgradeRcvConnToDuplex =
             { userId = 1,
               connId = "conn1",
               server = SMPServer "smp.simplex.im" "5223" testKeyHash,
-              sndId = EntityId "2345",
+              sndId = "2345",
               sndSecure = True,
               sndPublicKey = testPublicAuthKey,
               sndPrivateKey = testPrivateAuthKey,
@@ -429,12 +429,12 @@ testUpgradeSndConnToDuplex =
             { userId = 1,
               connId = "conn1",
               server = SMPServer "smp.simplex.im" "5223" testKeyHash,
-              rcvId = EntityId "3456",
+              rcvId = "3456",
               rcvPrivateKey = testPrivateAuthKey,
               rcvDhSecret = testDhSecret,
               e2ePrivKey = testPrivDhKey,
               e2eDhSecret = Nothing,
-              sndId = EntityId "4567",
+              sndId = "4567",
               sndSecure = True,
               status = New,
               dbQueueId = DBNewQueue,
@@ -556,7 +556,7 @@ mkSndMsgData internalId internalSndId internalHash =
 testCreateSndMsg_ :: DB.Connection -> PrevSndMsgHash -> ConnId -> SndQueue -> SndMsgData -> Expectation
 testCreateSndMsg_ db expectedPrevHash connId sq sndMsgData@SndMsgData {..} = do
   updateSndIds db connId
-    `shouldReturn` Right (internalId, internalSndId, expectedPrevHash)
+    `shouldReturn` (internalId, internalSndId, expectedPrevHash)
   createSndMsg db connId sndMsgData
     `shouldReturn` ()
   createSndMsgDelivery db connId sq internalId
@@ -715,7 +715,7 @@ rcvFileDescr1 =
     }
   where
     defaultChunkSize = FileSize $ mb 8
-    replicaId = ChunkReplicaId $ EntityId "abc"
+    replicaId = ChunkReplicaId "abc"
     chunkDigest = FileDigest "ghi"
 
 testFileSbKey :: C.SbKey
@@ -741,7 +741,7 @@ testGetNextRcvChunkToDownload st = do
     show e `shouldContain` "ConversionFailed"
     DB.query_ db "SELECT rcv_file_id FROM rcv_files WHERE failed = 1" `shouldReturn` [Only (1 :: Int)]
 
-    Right (Just (RcvFileChunk {rcvFileEntityId}, _, Nothing)) <- getNextRcvChunkToDownload db xftpServer1 86400
+    Right (Just (RcvFileChunk {rcvFileEntityId}, _)) <- getNextRcvChunkToDownload db xftpServer1 86400
     rcvFileEntityId `shouldBe` fId2
 
 testGetNextRcvFileToDecrypt :: SQLiteStore -> Expectation
@@ -785,9 +785,9 @@ newSndChunkReplica1 :: NewSndChunkReplica
 newSndChunkReplica1 =
   NewSndChunkReplica
     { server = xftpServer1,
-      replicaId = ChunkReplicaId $ EntityId "abc",
+      replicaId = ChunkReplicaId "abc",
       replicaKey = testFileReplicaKey,
-      rcvIdsKeys = [(ChunkReplicaId $ EntityId "abc", testFileReplicaKey)]
+      rcvIdsKeys = [(ChunkReplicaId "abc", testFileReplicaKey)]
     }
 
 testGetNextSndChunkToUpload :: SQLiteStore -> Expectation
@@ -818,9 +818,9 @@ testGetNextDeletedSndChunkReplica st = do
   withTransaction st $ \db -> do
     Right Nothing <- getNextDeletedSndChunkReplica db xftpServer1 86400
 
-    createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId $ EntityId "abc") testFileReplicaKey) (FileDigest "ghi")
+    createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId "abc") testFileReplicaKey) (FileDigest "ghi")
     DB.execute_ db "UPDATE deleted_snd_chunk_replicas SET delay = 'bad' WHERE deleted_snd_chunk_replica_id = 1"
-    createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId $ EntityId "abc") testFileReplicaKey) (FileDigest "ghi")
+    createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId "abc") testFileReplicaKey) (FileDigest "ghi")
 
     Left e <- getNextDeletedSndChunkReplica db xftpServer1 86400
     show e `shouldContain` "ConversionFailed"

tests/CoreTests/BatchingTests.hs

@@ -301,7 +301,7 @@ randomSUB_ a v sessId = do
   (rKey, rpKey) <- atomically $ C.generateAuthKeyPair a g
   thAuth_ <- testTHandleAuth v g rKey
   let thParams = testTHandleParams v sessId
-      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId rId, Cmd SRecipient SUB)
+      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, rId, Cmd SRecipient SUB)
   pure $ (,tToSend) <$> authTransmission thAuth_ (Just rpKey) nonce tForAuth
 
 randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
@@ -315,13 +315,13 @@ randomSUBCmd_ a c = do
   g <- C.newRandom
   rId <- atomically $ C.randomBytes 24 g
   (_, rpKey) <- atomically $ C.generateAuthKeyPair a g
-  mkTransmission c (Just rpKey, EntityId rId, Cmd SRecipient SUB)
+  mkTransmission c (Just rpKey, rId, Cmd SRecipient SUB)
 
 randomENDCmd :: IO (Transmission BrokerMsg)
 randomENDCmd = do
   g <- C.newRandom
   rId <- atomically $ C.randomBytes 24 g
-  pure (CorrId "", EntityId rId, END)
+  pure (CorrId "", rId, END)
 
 randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSEND = randomSEND_ C.SEd25519 subModeSMPVersion
@@ -338,7 +338,7 @@ randomSEND_ a v sessId len = do
   thAuth_ <- testTHandleAuth v g sKey
   msg <- atomically $ C.randomBytes len g
   let thParams = testTHandleParams v sessId
-      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId sId, Cmd SSender $ SEND noMsgFlags msg)
+      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, sId, Cmd SSender $ SEND noMsgFlags msg)
   pure $ (,tToSend) <$> authTransmission thAuth_ (Just spKey) nonce tForAuth
 
 testTHandleParams :: VersionSMP -> ByteString -> THandleParams SMPVersion 'TClient
@@ -377,7 +377,7 @@ randomSENDCmd_ a c len = do
   sId <- atomically $ C.randomBytes 24 g
   (_, rpKey) <- atomically $ C.generateAuthKeyPair a g
   msg <- atomically $ C.randomBytes len g
-  mkTransmission c (Just rpKey, EntityId sId, Cmd SSender $ SEND noMsgFlags msg)
+  mkTransmission c (Just rpKey, sId, Cmd SSender $ SEND noMsgFlags msg)
 
 lenOk :: ByteString -> Bool
 lenOk s = 0 < B.length s && B.length s <= smpBlockSize - 2

tests/CoreTests/TRcvQueuesTests.hs

@@ -3,21 +3,18 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 
 module CoreTests.TRcvQueuesTests where
 
 import AgentTests.EqInstances ()
-import qualified Data.ByteString.Char8 as B
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map as M
 import qualified Data.Set as S
-import Data.String (IsString (..))
 import Simplex.Messaging.Agent.Protocol (ConnId, QueueStatus (..), UserId)
 import Simplex.Messaging.Agent.Store (DBQueueId (..), RcvQueue, StoredRcvQueue (..))
 import qualified Simplex.Messaging.Agent.TRcvQueues as RQ
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (EntityId (..), RecipientId, SMPServer, pattern NoEntity, pattern VersionSMPC)
+import Simplex.Messaging.Protocol (SMPServer, pattern VersionSMPC)
 import Test.Hspec
 import UnliftIO
 
@@ -34,8 +31,6 @@ tRcvQueuesTests = do
   describe "queue transfer" $ do
     it "getDelSessQueues-batchAddQueues preserves total length" removeSubsTest
 
-instance IsString EntityId where fromString = EntityId . B.pack
-
 checkDataInvariant :: RQ.Queue q => RQ.TRcvQueues q -> IO Bool
 checkDataInvariant trq = atomically $ do
   conns <- readTVar $ RQ.getConnections trq
@@ -49,11 +44,11 @@ checkDataInvariant trq = atomically $ do
 hasConnTest :: IO ()
 hasConnTest = do
   trq <- RQ.empty
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3" "r3") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3") trq
   checkDataInvariant trq `shouldReturn` True
   atomically (RQ.hasConn "c1" trq) `shouldReturn` True
   atomically (RQ.hasConn "c2" trq) `shouldReturn` True
@@ -63,7 +58,7 @@ hasConnTest = do
 hasConnTestBatch :: IO ()
 hasConnTestBatch = do
   trq <- RQ.empty
-  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1", dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2", dummyRQ 0 "smp://1234-w==@beta" "c3" "r3"]
+  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1", dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@beta" "c3"]
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
   atomically (RQ.hasConn "c1" trq) `shouldReturn` True
@@ -74,7 +69,7 @@ hasConnTestBatch = do
 batchIdempotentTest :: IO ()
 batchIdempotentTest = do
   trq <- RQ.empty
-  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1", dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2", dummyRQ 0 "smp://1234-w==@beta" "c3" "r3"]
+  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1", dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@beta" "c3"]
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
   qs' <- readTVarIO $ RQ.getRcvQueues trq
@@ -88,9 +83,9 @@ deleteConnTest :: IO ()
 deleteConnTest = do
   trq <- RQ.empty
   atomically $ do
-    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1") trq
-    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2") trq
-    RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3" "r3") trq
+    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
+    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
+    RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3") trq
   checkDataInvariant trq `shouldReturn` True
   atomically $ RQ.deleteConn "c1" trq
   checkDataInvariant trq `shouldReturn` True
@@ -101,16 +96,16 @@ deleteConnTest = do
 getSessQueuesTest :: IO ()
 getSessQueuesTest = do
   trq <- RQ.empty
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3" "r3") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 1 "smp://1234-w==@beta" "c4" "r4") trq
+  atomically $ RQ.addQueue (dummyRQ 1 "smp://1234-w==@beta" "c4") trq
   checkDataInvariant trq `shouldReturn` True
   let tSess1 = (0, "smp://1234-w==@alpha", Just "c1")
-  RQ.getSessQueues tSess1 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"]
+  RQ.getSessQueues tSess1 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c1"]
   atomically (RQ.hasSessQueues tSess1 trq) `shouldReturn` True
   let tSess2 = (1, "smp://1234-w==@alpha", Just "c1")
   RQ.getSessQueues tSess2 trq `shouldReturn` []
@@ -119,17 +114,17 @@ getSessQueuesTest = do
   RQ.getSessQueues tSess3 trq `shouldReturn` []
   atomically (RQ.hasSessQueues tSess3 trq) `shouldReturn` False
   let tSess4 = (0, "smp://1234-w==@alpha", Nothing)
-  RQ.getSessQueues tSess4 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2", dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"]
+  RQ.getSessQueues tSess4 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"]
   atomically (RQ.hasSessQueues tSess4 trq) `shouldReturn`True
 
 getDelSessQueuesTest :: IO ()
 getDelSessQueuesTest = do
   trq <- RQ.empty
   let qs =
-        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"),
-          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2"),
-          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3" "r3"),
-          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4" "r4")
+        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
+          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
+          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
+          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
         ]
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
@@ -142,7 +137,7 @@ getDelSessQueuesTest = do
   -- connections intact
   atomically (RQ.hasConn "c1" trq) `shouldReturn` True
   atomically (RQ.hasConn "c2" trq) `shouldReturn` True
-  atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2", dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"], ["c1", "c2"])
+  atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"], ["c1", "c2"])
   checkDataInvariant trq `shouldReturn` True
   -- connections gone
   atomically (RQ.hasConn "c1" trq) `shouldReturn` False
@@ -155,10 +150,10 @@ removeSubsTest :: IO ()
 removeSubsTest = do
   aq <- RQ.empty
   let qs =
-        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"),
-          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2"),
-          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3" "r3"),
-          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4" "r4")
+        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
+          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
+          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
+          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
         ]
   atomically $ RQ.batchAddQueues aq qs
 
@@ -185,18 +180,18 @@ totalSize a b = do
   csizeB <- M.size <$> readTVar (RQ.getConnections b)
   pure (qsizeA + qsizeB, csizeA + csizeB)
 
-dummyRQ :: UserId -> SMPServer -> ConnId -> RecipientId -> RcvQueue
-dummyRQ userId server connId rcvId =
+dummyRQ :: UserId -> SMPServer -> ConnId -> RcvQueue
+dummyRQ userId server connId =
   RcvQueue
     { userId,
       connId,
       server,
-      rcvId,
+      rcvId = "",
       rcvPrivateKey = C.APrivateAuthKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe",
       rcvDhSecret = "01234567890123456789012345678901",
       e2ePrivKey = "MC4CAQAwBQYDK2VuBCIEINCzbVFaCiYHoYncxNY8tSIfn0pXcIAhLBfFc0m+gOpk",
       e2eDhSecret = Nothing,
-      sndId = NoEntity,
+      sndId = "",
       sndSecure = True,
       status = New,
       dbQueueId = DBQueueId 0,

tests/FileDescriptionTests.hs

@@ -13,7 +13,6 @@ import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Protocol (EntityId (..))
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import System.Directory (removeFile)
 import Test.Hspec
@@ -92,7 +91,7 @@ fileDesc =
     }
   where
     defaultChunkSize = FileSize $ mb 8
-    replicaId = ChunkReplicaId $ EntityId "abc"
+    replicaId = ChunkReplicaId "abc"
     replicaKey = C.APrivateAuthKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"
     chunkDigest = FileDigest "ghi"
 

tests/NtfClient.hs

@@ -158,7 +158,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
+      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
       pure (Nothing, corrId, qId, cmd)
 
 ntfTest :: Transport c => TProxy c -> (THandleNTF c 'TClient -> IO ()) -> Expectation

tests/NtfServerTests.hs

@@ -17,7 +17,6 @@ import qualified Data.Aeson.Types as JT
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.List.NonEmpty as L
 import Data.Text.Encoding (encodeUtf8)
 import NtfClient
 import SMPClient as SMP
@@ -36,6 +35,7 @@ import ServerTests
 import qualified Simplex.Messaging.Agent.Protocol as AP
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import qualified Simplex.Messaging.Notifications.Server.Push.APNS as APNS
@@ -72,13 +72,13 @@ 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 TransmissionAuth, ByteString, NtfEntityId, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
+sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c 'TClient -> (Maybe TransmissionAuth, ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission 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, ByteString, NtfCommand e) -> IO (SignedTransmission 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)
@@ -110,7 +110,7 @@ testNotificationSubscription (ATransport t) =
           -- create queue
           (sId, rId, rKey, rcvDhSecret) <- createAndSecureQueue rh sPub
           -- register and verify token
-          RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
+          RespNtf "1" "" (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", "", TNEW $ NewNtfTkn tkn tknPub dhPub)
           APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse = send} <-
             atomically $ readTBQueue apnsQ
           send APNSRespOk
@@ -126,7 +126,7 @@ testNotificationSubscription (ATransport t) =
           let srv = SMPServer SMP.testHost SMP.testPort SMP.testKeyHash
               q = SMPQueueNtf srv nId
               rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
-          RespNtf "4" _ (NRSubId _subId) <- signSendRecvNtf nh tknKey ("4", NoEntity, SNEW $ NewNtfSub tId q nKey)
+          RespNtf "4" _ (NRSubId _subId) <- signSendRecvNtf nh tknKey ("4", "", SNEW $ NewNtfSub tId q nKey)
           -- send message
           threadDelay 50000
           Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello")
@@ -136,8 +136,8 @@ testNotificationSubscription (ATransport t) =
               Right nonce' = C.cbNonce <$> ntfData' .-> "nonce"
               Right message = ntfData' .-> "message"
               Right ntfDataDecrypted = C.cbDecrypt dhSecret nonce' message
-              Right pnMsgs1 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
-              APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} = L.last pnMsgs1
+              Right APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} =
+                parse strP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
               Right nMsgMeta = C.cbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta
               Right NMsgMeta {msgId, msgTs} = parse smpP (AP.INTERNAL "error parsing NMsgMeta") nMsgMeta
           smpServer `shouldBe` srv
@@ -169,8 +169,8 @@ testNotificationSubscription (ATransport t) =
               Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce"
               Right message3 = ntfData3 .-> "message"
               Right ntfDataDecrypted3 = C.cbDecrypt dhSecret nonce3 message3
-              Right pnMsgs2 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
-              APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} = L.last pnMsgs2
+              Right APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} =
+                parse strP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
           smpServer3 `shouldBe` srv
           notifierId3 `shouldBe` nId
           send3 APNSRespOk

tests/SMPClient.hs

@@ -57,9 +57,6 @@ testStoreLogFile = "tests/tmp/smp-server-store.log"
 testStoreLogFile2 :: FilePath
 testStoreLogFile2 = "tests/tmp/smp-server-store.log.2"
 
-testDataLogFile :: FilePath
-testDataLogFile = "tests/tmp/smp-server-data.log"
-
 testStoreMsgsFile :: FilePath
 testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
 
@@ -107,7 +104,6 @@ cfg =
       queueIdBytes = 24,
       msgIdBytes = 24,
       storeLogFile = Nothing,
-      dataLogFile = Nothing,
       storeMsgsFile = Nothing,
       allowNewQueues = True,
       newQueueBasicAuth = Nothing,
@@ -119,7 +115,6 @@ cfg =
       logStatsStartTime = 0,
       serverStatsLogFile = "tests/smp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
-      pendingENDInterval = 500000,
       caCertificateFile = "tests/fixtures/ca.crt",
       privateKeyFile = "tests/fixtures/server.key",
       certificateFile = "tests/fixtures/server.crt",
@@ -163,7 +158,7 @@ withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasC
 withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
 
 withSmpServerStoreLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
-withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, dataLogFile = Just testDataLogFile, serverStatsBackupFile = Just testServerStatsBackupFile}
+withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, serverStatsBackupFile = Just testServerStatsBackupFile}
 
 withSmpServerConfigOn :: HasCallStack => ATransport -> ServerConfig -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerConfigOn t cfg' port' =
@@ -223,7 +218,7 @@ smpServerTest _ t = runSmpTest $ \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
+      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
       pure (Nothing, corrId, qId, cmd)
 
 smpTest :: (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation

tests/SMPProxyTests.hs

@@ -19,9 +19,6 @@ import Control.Concurrent (ThreadId, threadDelay)
 import Control.Logger.Simple
 import Control.Monad (forM, forM_, forever, replicateM_)
 import Control.Monad.Trans.Except (ExceptT, runExceptT)
-import Crypto.Hash (SHA512)
-import qualified Crypto.KDF.HKDF as H
-import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -37,7 +34,7 @@ import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
-import Simplex.Messaging.Protocol (DataBlob (..), EntityId (..), EncRcvMsgBody (..), MsgBody, RcvMessage (..), SubscriptionMode (..), pattern NoEntity, e2eEncConfirmationLength, maxMessageLength, noMsgFlags)
+import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, RcvMessage (..), SubscriptionMode (..), maxMessageLength, noMsgFlags)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Transport
@@ -136,25 +133,6 @@ smpProxyTests = do
       xdescribe "stress test 10k" $ do
         let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs])
         it "25 agents, 300 pairs, 17 messages" . oneServer . withNumCapabilities 4 $ deliver 25 17
-  describe "receive data blobs via SMP proxy" $ do
-    let srv1 = SMPServer testHost testPort testKeyHash
-        srv2 = SMPServer testHost testPort2 testKeyHash
-    describe "client API" $ do
-      describe "one server" $ do
-        it "deliver via proxy" . oneServer $ do
-          receiveBlobViaProxy srv1 srv1 C.SEd448 "hello"
-      describe "two servers" $ do
-        let proxyServ = srv1
-            relayServ = srv2
-        blob <- runIO $ atomically . C.randomBytes (e2eEncConfirmationLength - 2) =<< C.newRandom
-        it "deliver via proxy" . twoServersFirstProxy $
-          receiveBlobViaProxy proxyServ relayServ C.SEd448 "hello"
-        it "max blob size, Ed448 keys" . twoServersFirstProxy $
-          receiveBlobViaProxy proxyServ relayServ C.SEd448 blob
-        it "max blob size, Ed25519 keys" . twoServersFirstProxy $
-          receiveBlobViaProxy proxyServ relayServ C.SEd25519 blob
-        it "max blob size, X25519 keys" . twoServersFirstProxy $
-          receiveBlobViaProxy proxyServ relayServ C.SX25519 blob
   where
     oneServer = withSmpServerConfigOn (transport @TLS) proxyCfg {msgQueueQuota = 128} testPort . const
     twoServers = twoServers_ proxyCfg proxyCfg
@@ -426,65 +404,18 @@ agentViaProxyRetryNoSession = do
     withServer2 = withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsFile2} testPort2
     servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers [srv]}
 
-receiveBlobViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => SMPServer -> SMPServer -> C.SAlgorithm a -> ByteString -> IO ()
-receiveBlobViaProxy proxyServ relayServ alg origData = do
-  g <- C.newRandom
-  -- proxy client
-  pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig Nothing (\_ -> pure ())
-  pc <- either (fail . show) pure pc'
-  THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc
-  -- relay client
-  rc' <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig Nothing (\_ -> pure ())
-  rc <- either (fail . show) pure rc'
-  -- prepare blob
-  -- k: ID to retrive blob.
-  -- pk: part of the link sent to the accepting party (Sender role),
-  --     also key material for HKDF to derive key to e2e encrypt blob.
-  -- hash(k): ID used to store blob
-  -- (k, pk): used to agree additional server-to-client encryption when retrieving blob,
-  --          using DH with server session keys.
-  (C.PublicKeyX25519 k, pk'@(C.PrivateKeyX25519 pk _)) <- atomically $ C.generateKeyPair @'C.X25519 g
-  blobKeys@(_, blobPKey) <- atomically $ C.generateAuthKeyPair alg g
-  let kBytes = BA.convert k :: ByteString -- blob ID for "sender" (blob recipient)
-      rBlobId = EntityId $ C.sha256Hash kBytes
-      pkBytes = BA.convert pk :: ByteString
-      ikm = pkBytes
-      salt = "" :: ByteString
-      info = "SimpleXDataBlob" :: ByteString
-      prk = H.extract salt ikm :: H.PRK SHA512
-      skBytes = H.expand prk info 32
-  dataNonce <- atomically $ C.randomCbNonce g
-  Right sk <- pure $ C.sbKey skBytes
-  -- store blob
-  Right dataBody <- pure $ C.sbEncrypt sk dataNonce origData e2eEncConfirmationLength
-  let blob = DataBlob {dataNonce, dataBody}
-  runRight_ $ do
-    createSMPDataBlob rc blobKeys rBlobId blob
-    -- retrive blob directly
-    blob1@DataBlob {dataNonce = dataNonce1, dataBody = body1} <- getSMPDataBlob rc pk'
-    liftIO $ blob1 `shouldBe` blob
-    liftIO $ C.sbDecrypt sk dataNonce1 body1 `shouldBe` Right origData
-    -- retrive blob via proxy
-    sess <- connectSMPProxiedRelay pc relayServ (Just "correct")
-    Right blob2 <- proxyGetSMPDataBlob pc sess pk'
-    liftIO $ blob2 `shouldBe` blob
-    -- delete blob
-    deleteSMPDataBlob rc blobPKey rBlobId
-    liftIO $ runExceptT (getSMPDataBlob rc pk') `shouldReturn` Left (PCEProtocolError SMP.AUTH)
-    liftIO $ runExceptT (proxyGetSMPDataBlob pc sess pk') `shouldReturn` Left (PCEProtocolError SMP.AUTH)
-
 testNoProxy :: IO ()
 testNoProxy = do
   withSmpServerConfigOn (transport @TLS) cfg 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)
+      (_, _, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", SMP.PRXY testSMPServer Nothing)
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
 
 testProxyAuth :: IO ()
 testProxyAuth = 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")
+      (_, _s, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", SMP.PRXY testSMPServer2 $ Just "wrong")
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
   where
     proxyCfgAuth = proxyCfg {newQueueBasicAuth = Just "correct"}

tests/ServerTests.hs

@@ -21,15 +21,11 @@ import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
 import Control.Monad
 import Control.Monad.IO.Class
-import Crypto.Hash (SHA512)
-import qualified Crypto.KDF.HKDF as H
 import Data.Bifunctor (first)
-import qualified Data.ByteArray as BA
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Hashable (hash)
-import qualified Data.IntSet as IS
+import qualified Data.Set as S
 import Data.Type.Equality
 import GHC.Stack (withFrozenCallStack)
 import SMPClient
@@ -72,9 +68,6 @@ serverTests t@(ATransport t') = do
     testMsgExpireOnSend t'
     testMsgExpireOnInterval t'
     testMsgNOTExpireOnInterval t'
-  describe "Data blobs" $ do
-    testDataBlobs t'
-    testDataBlobsWithLog t
 
 pattern Resp :: CorrId -> QueueId -> BrokerMsg -> SignedTransmission ErrorType BrokerMsg
 pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command))
@@ -85,13 +78,13 @@ pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh _sndSecure)
 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 TransmissionAuth, ByteString, EntityId, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
+sendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> (Maybe TransmissionAuth, ByteString, ByteString, Command p) -> IO (SignedTransmission 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 :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> (ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
 signSendRecv 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)
@@ -141,9 +134,9 @@ testCreateSecure (ATransport t) =
       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 rPub dhPub Nothing SMSubscribe False)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv r rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
-      (rId1, NoEntity) #== "creates queue"
+      (rId1, "") #== "creates queue"
 
       Resp "bcda" sId1 ok1 <- sendRecv s ("", "bcda", sId, _SEND "hello")
       (ok1, OK) #== "accepts unsigned SEND"
@@ -206,9 +199,9 @@ testCreateDelete (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
-      (rId1, NoEntity) #== "creates queue"
+      (rId1, "") #== "creates queue"
 
       (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, KEY sPub)
@@ -278,7 +271,7 @@ stressTest (ATransport t) =
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
       rIds <- forM ([1 .. 50] :: [Int]) . const $ do
-        Resp "" NoEntity (Ids rId _ _) <- signSendRecv h1 rKey ("", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
+        Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub Nothing SMSubscribe False)
         pure rId
       let subscribeQueues h = forM_ rIds $ \rId -> do
             Resp "" rId' OK <- signSendRecv h rKey ("", rId, SUB)
@@ -296,7 +289,7 @@ testAllowNewQueues t =
         g <- C.newRandom
         (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
         (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-        Resp "abcd" NoEntity (ERR AUTH) <- signSendRecv h rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
+        Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
         pure ()
 
 testDuplex :: ATransport -> Spec
@@ -306,7 +299,7 @@ testDuplex (ATransport t) =
       g <- C.newRandom
       (arPub, arKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", NoEntity, NEW arPub aDhPub Nothing SMSubscribe False)
+      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub Nothing SMSubscribe False)
       let aDec = decryptMsgV3 $ C.dh' aSrvDh aDhPriv
       -- aSnd ID is passed to Bob out-of-band
 
@@ -322,15 +315,15 @@ testDuplex (ATransport t) =
 
       (brPub, brKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (bDhPub, bDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", NoEntity, NEW brPub bDhPub Nothing SMSubscribe False)
+      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub Nothing SMSubscribe False)
       let bDec = decryptMsgV3 $ C.dh' bSrvDh bDhPriv
-      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> encode (unEntityId bSnd))
+      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> encode bSnd)
       -- "reply_id ..." is ad-hoc, not a part of SMP protocol
 
       Resp "" _ (Msg mId2 msg2) <- tGet1 alice
       Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, ACK mId2)
       Right ["reply_id", bId] <- pure $ B.words <$> aDec mId2 msg2
-      (bId, encode (unEntityId bSnd)) #== "reply queue ID received from Bob"
+      (bId, encode bSnd) #== "reply queue ID received from Bob"
 
       (asPub, asKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, _SEND $ "key " <> strEncode asPub)
@@ -361,7 +354,7 @@ testSwitchSub (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
+      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, _SEND "test1")
       (ok1, OK) #== "sent test message 1"
@@ -498,12 +491,12 @@ testWithStoreLog at@(ATransport t) =
     (sPub1, sKey1) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (sPub2, sKey2) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    recipientId1 <- newTVarIO NoEntity
+    recipientId1 <- newTVarIO ""
     recipientKey1 <- newTVarIO Nothing
     dhShared1 <- newTVarIO Nothing
-    senderId1 <- newTVarIO NoEntity
-    senderId2 <- newTVarIO NoEntity
-    notifierId <- newTVarIO NoEntity
+    senderId1 <- newTVarIO ""
+    senderId2 <- newTVarIO ""
+    notifierId <- newTVarIO ""
 
     withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
       (sId1, rId1, rKey1, dhShared) <- createAndSecureQueue h sPub1
@@ -587,10 +580,10 @@ testRestoreMessages at@(ATransport t) =
 
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    recipientId <- newTVarIO NoEntity
+    recipientId <- newTVarIO ""
     recipientKey <- newTVarIO Nothing
     dhShared <- newTVarIO Nothing
-    senderId <- newTVarIO NoEntity
+    senderId <- newTVarIO ""
 
     withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do
       runClient t $ \h1 -> do
@@ -617,7 +610,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 72
+    logSize testServerStatsBackupFile `shouldReturn` 79
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -635,7 +628,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 72
+    logSize testServerStatsBackupFile `shouldReturn` 79
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -654,7 +647,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 72
+    logSize testServerStatsBackupFile `shouldReturn` 79
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 
@@ -682,19 +675,19 @@ checkStats s qs sent received = do
   _msgSentNtf s `shouldBe` 0
   _msgRecvNtf s `shouldBe` 0
   let PeriodStatsData {_day, _week, _month} = _activeQueues s
-  IS.toList _day `shouldBe` map (hash . unEntityId) qs
-  IS.toList _week `shouldBe` map (hash . unEntityId) qs
-  IS.toList _month `shouldBe` map (hash . unEntityId) qs
+  S.toList _day `shouldBe` qs
+  S.toList _week `shouldBe` qs
+  S.toList _month `shouldBe` qs
 
 testRestoreExpireMessages :: ATransport -> Spec
 testRestoreExpireMessages at@(ATransport t) =
   it "should store messages on exit and restore on start" $ do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    recipientId <- newTVarIO NoEntity
+    recipientId <- newTVarIO ""
     recipientKey <- newTVarIO Nothing
     dhShared <- newTVarIO Nothing
-    senderId <- newTVarIO NoEntity
+    senderId <- newTVarIO ""
 
     withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do
       runClient t $ \h1 -> do
@@ -749,7 +742,7 @@ createAndSecureQueue h sPub = do
   g <- C.newRandom
   (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
   (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-  Resp "abcd" NoEntity (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
+  Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
   let dhShared = C.dh' srvDh dhPriv
   Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
   (rId', rId) #== "same queue ID"
@@ -778,13 +771,13 @@ testTiming (ATransport t) =
         (C.AuthAlg C.SX25519, C.AuthAlg C.SX25519, 200) -- correct key type
       ]
     timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
-    similarTime t1 t2 = abs (t2 / t1 - 1) < 0.25 -- normally the difference between "no queue" and "wrong key" is less than 5%
+    similarTime t1 t2 = abs (t2 / t1 - 1) < 0.2 -- normally the difference between "no queue" and "wrong key" is less than 5%
     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
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
+      Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, SUB)
 
@@ -800,12 +793,12 @@ testTiming (ATransport t) =
 
       runTimingTest sh badKey sId $ _SEND "hello"
       where
-        runTimingTest :: PartyI p => THandleSMP c 'TClient -> C.APrivateAuthKey -> EntityId -> Command p -> IO ()
+        runTimingTest :: PartyI p => THandleSMP c 'TClient -> C.APrivateAuthKey -> ByteString -> Command p -> IO ()
         runTimingTest h badKey qId cmd = do
           threadDelay 100000
           _ <- timeRepeat n $ do
             -- "warm up" the server
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
+            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", "1234", cmd)
             return ()
           threadDelay 100000
           timeWrongKey <- timeRepeat n $ do
@@ -813,7 +806,7 @@ testTiming (ATransport t) =
             return ()
           threadDelay 100000
           timeNoQueue <- timeRepeat n $ do
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
+            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", "1234", cmd)
             return ()
           let ok = similarTime timeNoQueue timeWrongKey
           unless ok . putStrLn . unwords $
@@ -921,127 +914,6 @@ testMsgNOTExpireOnInterval t =
             Nothing -> return ()
             Just _ -> error "nothing else should be delivered"
 
-testDataBlobs :: forall c. Transport c => TProxy c -> Spec
-testDataBlobs t =
-  it "should store, retrieve, update and delete data blob directly from the server" $
-    smpTest2 t $ \r s -> do
-      g <- C.newRandom
-      -- k: ID to retrive blob.
-      -- pk: part of the link sent to the accepting party (Sender role),
-      --     also key material for HKDF to derive key to e2e encrypt blob.
-      -- hash(k): ID used to store blob
-      -- (k, pk): used to agree additional server-to-client encryption when retrieving blob,
-      --          using DH with server session keys.
-      (C.PublicKeyX25519 k, pk'@(C.PrivateKeyX25519 pk _)) <- atomically $ C.generateKeyPair @'C.X25519 g
-      (blobKey, blobPKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-      let kBytes = BA.convert k :: ByteString
-          rBlobId = EntityId $ C.sha256Hash kBytes
-          sBlobId = EntityId $ kBytes
-          pkBytes = BA.convert pk :: ByteString
-          ikm = pkBytes
-          salt = "" :: ByteString
-          info = "SimpleXDataBlob" :: ByteString
-          prk = H.extract salt ikm :: H.PRK SHA512
-          skBytes = H.expand prk info 32
-          origData = "hello"
-          origData2 = "hello 2"
-      dataNonce <- atomically $ C.randomCbNonce g
-      Right sk <- pure $ C.sbKey skBytes
-      -- store and retrieve blob
-      Right dataBody <- pure $ C.sbEncrypt sk dataNonce origData e2eEncConfirmationLength
-      let blob = DataBlob {dataNonce, dataBody}
-      -- storing data signed with the incorrect key fails (not matching key in command)
-      (_, blobPKey') <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-      Resp "0" _ (ERR AUTH) <- signSendRecv r blobPKey' ("0", rBlobId, WRT blobKey blob)
-      -- correct key succeeds
-      Resp "1" _ OK <- signSendRecv r blobPKey ("1", rBlobId, WRT blobKey blob)
-      Resp "2" _ (DATA encBlob) <- sendRecv s ("", "2",  sBlobId, READ)
-      THandle {params = THandleParams {thAuth = Just THAuthClient {serverPeerPubKey}}} <- pure s
-      let ss = C.dh' serverPeerPubKey pk'
-          respNonce = C.cbNonce "2" -- correlation ID sent in READ request
-      Right blobStr <- pure $ C.cbDecrypt ss respNonce encBlob
-      Right  blob'@DataBlob {dataNonce = dataNonce', dataBody = body'} <- pure $ smpDecode blobStr
-      blob' `shouldBe` blob
-      Right origData' <- pure $ C.sbDecrypt sk dataNonce' body'
-      origData' `shouldBe` origData
-      -- update and retrieve blob
-      dataNonce2 <- atomically $ C.randomCbNonce g
-      Right dataBody2 <- pure $ C.sbEncrypt sk dataNonce2 origData2 e2eEncConfirmationLength
-      let blob2 = DataBlob {dataNonce = dataNonce2, dataBody = dataBody2}
-      -- storing data under the same ID but signed with the different key fails (even if it matches key in command)
-      (blobKey'', blobPKey'') <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-      Resp "3" _ (ERR AUTH) <- signSendRecv r blobPKey'' ("3", rBlobId, WRT blobKey'' blob2)
-      -- same key but signed with the wrong key also fails
-      Resp "4" _ (ERR AUTH) <- signSendRecv r blobPKey'' ("4", rBlobId, WRT blobKey blob2)
-      -- same key bsucceeds
-      Resp "5" _ OK <- signSendRecv r blobPKey ("5", rBlobId, WRT blobKey blob2)
-      Resp "6" _ (DATA encBlob2) <- sendRecv s ("", "6",  sBlobId, READ)
-      let respNonce2 = C.cbNonce "6" -- correlation ID sent in READ request
-      Right blobStr2 <- pure $ C.cbDecrypt ss respNonce2 encBlob2
-      Right  blob2'@DataBlob {dataNonce = dataNonce2', dataBody = body2'} <- pure $ smpDecode blobStr2
-      blob2' `shouldBe` blob2
-      Right origData2' <- pure $ C.sbDecrypt sk dataNonce2' body2'
-      origData2' `shouldBe` origData2
-      -- remove data blob
-      -- incorrect ID fails
-      Resp "7" _ (ERR AUTH) <- signSendRecv r blobPKey ("7", sBlobId, CLR)
-      -- incorrect key fails
-      Resp "8" _ (ERR AUTH) <- signSendRecv r blobPKey'' ("8", rBlobId, CLR)
-      Resp "9" _ (DATA encBlob2') <- sendRecv s ("", "9",  sBlobId, READ)
-      encBlob2' `shouldBe` encBlob2'
-      -- correct key and ID succeed
-      Resp "10" _ OK <- signSendRecv r blobPKey ("10", rBlobId, CLR)
-      Resp "11" _ (ERR AUTH) <- sendRecv s ("", "11",  sBlobId, READ)
-      pure ()
-
-testDataBlobsWithLog :: ATransport -> Spec
-testDataBlobsWithLog at@(ATransport t) =
-  it "should store data blob to log and restore after server restart" $ do
-    g <- C.newRandom
-    (C.PublicKeyX25519 k, pk) <- atomically $ C.generateKeyPair @'C.X25519 g
-    (blobKey, blobPKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    dataNonce <- atomically $ C.randomCbNonce g
-    let kBytes = BA.convert k :: ByteString
-        rBlobId = EntityId $ C.sha256Hash kBytes
-        sBlobId = EntityId $ kBytes
-        blob = DataBlob {dataNonce, dataBody = "some random encrypted data"} -- the previous test shows e2e blob encryption
-        blob2 = DataBlob {dataNonce, dataBody = "some other encrypted data"}
-
-    clientServer t $ \h -> do
-      Resp "1" _ OK <- signSendRecv h blobPKey ("1", rBlobId, WRT blobKey blob)
-      pure ()
-    clientServer t $ \h -> do
-      testGetBlob h "2" pk sBlobId blob
-      -- update blob
-      Resp "3" _ OK <- signSendRecv h blobPKey ("3", rBlobId, WRT blobKey blob2)
-      testGetBlob h "4" pk sBlobId blob2
-    clientServer t $ \h -> do
-      -- updated after restart
-      testGetBlob h "5" pk sBlobId blob2
-      -- delete blob
-      Resp "6" _ OK <- signSendRecv h blobPKey ("6", rBlobId, CLR)
-      Resp "7" _ (ERR AUTH) <- sendRecv h ("", "7",  sBlobId, READ)
-      pure ()
-    clientServer t $ \h -> do
-      -- deleted after restart
-      Resp "8" _ (ERR AUTH) <- sendRecv h ("", "8",  sBlobId, READ)
-      pure ()
-  where
-    clientServer :: Transport c => TProxy c -> (THandleSMP c 'TClient -> IO ()) -> IO ()
-    clientServer _ test' =
-      withSmpServerStoreLogOn at testPort $ \server -> do
-        testSMPClient test' `shouldReturn` ()
-        killThread server
-    testGetBlob h corrId pk sBlobId expectedBlob = do
-      Resp (CorrId corrId') _ (DATA encBlob) <- sendRecv h ("", corrId,  sBlobId, READ)
-      corrId' `shouldBe` corrId
-      THandle {params = THandleParams {thAuth = Just THAuthClient {serverPeerPubKey}}} <- pure h
-      let ss = C.dh' serverPeerPubKey pk
-          respNonce = C.cbNonce corrId -- correlation ID sent in READ request
-      Right blobStr <- pure $ C.cbDecrypt ss respNonce encBlob
-      Right  blob' <- pure $ smpDecode blobStr
-      blob' `shouldBe` expectedBlob
-
 samplePubKey :: C.APublicVerifyKey
 samplePubKey = C.APublicVerifyKey C.SEd25519 "MCowBQYDK2VwAyEAfAOflyvbJv1fszgzkQ6buiZJVgSpQWsucXq7U6zjMgY="
 

tests/XFTPServerTests.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module XFTPServerTests where
@@ -21,13 +20,13 @@ import Data.List (isInfixOf)
 import ServerTests (logSize)
 import Simplex.FileTransfer.Client
 import Simplex.FileTransfer.Description (kb)
-import Simplex.FileTransfer.Protocol (FileInfo (..), XFTPFileId)
+import Simplex.FileTransfer.Protocol (FileInfo (..))
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
 import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPRcvChunkSpec (..))
 import Simplex.Messaging.Client (ProtocolClientError (..))
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
-import Simplex.Messaging.Protocol (BasicAuth, EntityId (..), pattern NoEntity)
+import Simplex.Messaging.Protocol (BasicAuth, SenderId)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..))
 import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive, removeFile)
 import System.FilePath ((</>))
@@ -75,8 +74,8 @@ createTestChunk fp = do
   B.writeFile fp bytes
   pure bytes
 
-readChunk :: XFTPFileId -> IO ByteString
-readChunk sId = B.readFile (xftpServerFiles </> B.unpack (B64.encode $ unEntityId sId))
+readChunk :: SenderId -> IO ByteString
+readChunk sId = B.readFile (xftpServerFiles </> B.unpack (B64.encode sId))
 
 testFileChunkDelivery :: Expectation
 testFileChunkDelivery = xftpTest $ \c -> runRight_ $ runTestFileChunkDelivery c c
@@ -268,9 +267,9 @@ testFileLog = do
   (rcvKey1, rpKey1) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
   (rcvKey2, rpKey2) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
   digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
-  sIdVar <- newTVarIO NoEntity
-  rIdVar1 <- newTVarIO NoEntity
-  rIdVar2 <- newTVarIO NoEntity
+  sIdVar <- newTVarIO ""
+  rIdVar1 <- newTVarIO ""
+  rIdVar2 <- newTVarIO ""
 
   threadDelay 100000