6.0.6.0

smp server: fix notifiers lost when compacting store log (#1347 )
6.0.5.0
2026-10-12 11:39:56 +00:00 · 2024-10-02 09:24:29 +01:00 · 2024-10-02 09:24:04 +01:00 · 2024-09-24 12:34:46 +01:00 · 2024-09-15 21:36:31 +01:00 · 2024-09-14 17:34:29 +01:00
50 changed files with 979 additions and 411 deletions
@@ -1,3 +1,31 @@
+# 6.0.5
+
+SMP agent:
+- support generic SOCKS proxy (without isolate-by-auth).
+- reduce max message sizes
+
+# 6.0.4
+
+SMP server:
+- better performance/memory: fewer map updates on re-subscriptions (#1297), split and reduce STM transactions (#1294)
+- send DELD when subscribed queue is deleted (#1312)
+- add created/updated/used date to queues to manage expiration (#1306)
+
+XFTP server: truncate file creation time to 1 hour (#1310)
+
+Servers:
+- bind control port only to 127.0.0.1 for better security in case of firewall misconfiguration (#1280)
+- reduce memory used for period stats (#1298)
+
+Agent: process last notification from list (#1307)
+- report receive file error with redirected file ID, when redirect is present (#1304)
+- special error when deleted user record is not in database (#1303)
+- fix race when sending a message to the deleted connection (#1296)
+- support for multiple messages in a single notification
+
+Ntf server:
+- only use SOCKS proxy for servers without public address (#1314)
+
 # 6.0.3

 Agent:
@@ -15,7 +15,7 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}

 main :: IO ()
 main = do
-  setLogLevel LogDebug -- change to LogError in production
+  setLogLevel LogInfo
  cfgPath <- getEnvPath "NTF_SERVER_CFG_PATH" defaultCfgPath
  logPath <- getEnvPath "NTF_SERVER_LOG_PATH" defaultLogPath
  withGlobalLogging logCfg $ ntfServerCLI cfgPath logPath
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.3.0
+version: 6.0.6.0
 synopsis: SimpleXMQ message broker
 description: |
  This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -47,6 +47,7 @@ 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
@@ -0,0 +1,18 @@
+# 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.
@@ -1,30 +1,174 @@
 #!/usr/bin/env sh
 set -eu

-path_conf_var="/var/opt"
-path_conf_smp="$path_conf_var/simplex"
-path_conf_xftp="$path_conf_var/simplex-xftp"
-path_conf_storelog_smp="$path_conf_smp/smp-server-store.log"
-path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log"
+# Common
+# ------
 date="$(date -u '+%Y-%m-%dT%H:%M:%S')"

-backup_smp() {
- if [ -e "$path_conf_storelog_smp" ]; then
-  cp "$path_conf_storelog_smp" "${path_conf_storelog_smp}.${date:-date-failed}"
- fi
+GRN='\033[0;32m'
+YLW='\033[1;33m'
+BLU='\033[1;34m'
+RED='\033[0;31m'
+NC='\033[0m'
+
+path_conf_var="/var/opt"
+
+smp_variables() {
+	path_conf_smp="$path_conf_var/simplex"
+	path_conf_smp_archive="$path_conf_smp/backups"
+	path_conf_smp_archive_storelog="$path_conf_smp_archive/queues"
+	path_conf_smp_archive_stats="$path_conf_smp_archive/stats"
+	path_conf_smp_archive_messages="$path_conf_smp_archive/messages"
+	path_conf_storelog_smp="$path_conf_smp/smp-server-store.log"
+	path_conf_storelog_smp_out="$path_conf_smp_archive_storelog/smp-server-store.log.${date:-date-failed}"
+
+	path_conf_stats_smp="$path_conf_smp/smp-server-stats.log"
+	path_conf_stats_smp_out="$path_conf_smp_archive_stats/smp-server-stats.log.${date:-date-failed}"
+
+	path_conf_messages_smp="$path_conf_smp/smp-server-messages.log"
+	path_conf_messages_smp_out="$path_conf_smp_archive_messages/smp-server-messages.log.${date:-date-failed}"
 }

-backup_xftp() {
- if [ -e "$path_conf_storelog_xftp" ]; then
-  cp "$path_conf_storelog_xftp" "${path_conf_storelog_xftp}.${date:-date-failed}"
- fi
+xftp_variables() {
+	path_conf_xftp="$path_conf_var/simplex-xftp"
+	path_conf_xftp_archive="$path_conf_xftp/backups"
+
+	path_conf_xftp_archive_storelog="$path_conf_xftp_archive/queues"
+	path_conf_xftp_archive_stats="$path_conf_xftp_archive/stats"
+
+	path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log"
+	path_conf_storelog_xftp_out="$path_conf_xftp_archive_storelog/file-server-store.log.${date:-date-failed}"
+
+	path_conf_stats_xftp="$path_conf_xftp/file-server-stats.log"
+	path_conf_stats_xftp_out="$path_conf_xftp_archive_stats/file-server-stats.log.${date:-date-failed}"
 }

-if [ "$1" = 'smp-server' ]; then
- backup_smp
-elif [ "$1" = 'xftp-server' ]; then
- backup_xftp
-else
- backup_smp
- backup_xftp
-fi
+checks() {
+	result=${SERVICE_RESULT:-exit-code}
+	status=${EXIT_STATUS:-TERM}
+
+	case "$result" in
+		success)
+			case "$status" in
+				TERM)
+					printf "${RED}Refusing to backup files with failed service state${NC}\n"
+					exit 1
+					;;
+				*)
+					:
+					;;
+			esac
+			;;
+		*)
+			printf "${RED}Refusing to backup files with failed service state${NC}\n"
+			exit 1
+			;;
+	esac
+}
+
+smp_check() {
+	if [ ! -d "$path_conf_smp_archive_storelog" ]; then
+		mkdir -p "$path_conf_smp_archive_storelog"
+	fi
+	if [ ! -d "$path_conf_smp_archive_messages" ]; then
+		mkdir -p "$path_conf_smp_archive_messages"
+	fi
+	if [ ! -d "$path_conf_smp_archive_stats" ]; then
+		mkdir -p "$path_conf_smp_archive_stats"
+	fi
+}
+
+xftp_check() {
+	if [ ! -d "$path_conf_xftp_archive_storelog" ]; then
+		mkdir -p "$path_conf_xftp_archive_storelog"
+	fi
+	if [ ! -d "$path_conf_xftp_archive_stats" ]; then
+		mkdir -p "$path_conf_xftp_archive_stats"
+	fi
+}
+
+backup() {
+	file="$1"
+	out="$2"
+	file_type="$3"
+
+	if [ -e "$file" ]; then
+		if cp "$file" "$out"; then
+			printf "${YLW}${file_type}${NC} ${GRN}backup successful:${NC} ${BLU}%s${NC}\n" "${out}"
+		else
+			printf "${YLW}${file_type}${NC} ${RED}backup failed!${NC}\n"
+		fi
+	fi
+
+	unset file out file_type
+}
+
+cleanup() {
+	directory="$1"
+	
+	file_type="$2"
+	
+	files_date=$(find "$directory" -type f -exec stat --format="%y" {} + | awk '{print $1}' | sort -nr | uniq | awk 'NR==2')
+	
+	if [ -n "$files_date" ]; then
+		files=$(find "$directory" -type f -not -newermt "$files_date" -printf "%T@ %Tc %p\n" | sort -n | awk '{print $NF}')
+
+		if [ -n "$files" ]; then
+			printf '%s' "$files" | xargs rm -f
+			printf "${YLW}Old ${file_type} files${NC}${GRN} has been deleted:${NC}\n"
+			files_colored=$(printf '%s' "$files" | awk '{print "\033[1;34m"$0"\033[0m"}')
+			printf "${files_colored}\n"
+		fi
+	fi
+
+	unset directory file_type files_date files
+}
+
+smp_backup() {
+	backup "$path_conf_storelog_smp" "$path_conf_storelog_smp_out" 'Storelog'
+	backup "$path_conf_messages_smp" "$path_conf_messages_smp_out" 'Messages'
+	backup "$path_conf_stats_smp" "$path_conf_stats_smp_out" 'Stats'
+}
+
+smp_cleanup() {
+	cleanup "$path_conf_smp_archive_storelog" 'storelog'
+	cleanup "$path_conf_smp_archive_stats" 'stats'
+	cleanup "$path_conf_smp_archive_messages" 'messages'
+}
+
+xftp_backup() {
+	backup "$path_conf_storelog_xftp" "$path_conf_storelog_xftp_out" 'Storelog'
+	backup "$path_conf_stats_xftp" "$path_conf_stats_xftp_out" 'Stats'
+}
+
+xftp_cleanup() {
+	cleanup "$path_conf_xftp_archive_storelog" 'storelog'
+	cleanup "$path_conf_xftp_archive_stats" 'stats'
+}
+
+main() {
+	type="${1:-}"
+  
+	checks
+
+	case "$type" in
+		smp-server)
+			smp_variables
+			smp_check
+			smp_backup
+			smp_cleanup
+			;;
+		xftp-server)
+			xftp_variables
+			xftp_check
+			xftp_backup
+			xftp_cleanup
+			;;
+		*)
+			printf "${YLW}Unknown server type.${NC}\n"
+			exit 1
+			;;
+	esac 
+}
+
+main "$@"
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack

 name:           simplexmq
-version:        6.0.3
+version:        6.0.6.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -236,6 +236,7 @@ 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
@@ -310,6 +311,7 @@ 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
@@ -389,6 +391,7 @@ 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
@@ -467,6 +470,7 @@ 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
@@ -542,6 +546,7 @@ 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
@@ -605,6 +610,7 @@ test-suite simplexmq-test
      CoreTests.CryptoTests
      CoreTests.EncodingTests
      CoreTests.RetryIntervalTests
+      CoreTests.SOCKSSettings
      CoreTests.TRcvQueuesTests
      CoreTests.UtilTests
      CoreTests.VersionRangeTests
@@ -653,6 +659,7 @@ 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.*
@@ -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 (mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
@@ -190,8 +190,9 @@ 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 = []}, _) -> 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
+        (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
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
          withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
            liftIO $ waitWhileSuspended c
@@ -202,7 +203,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
          where
            retryLoop loop e replicaDelay = do
              flip catchAgentError (\_ -> pure ()) $ do
-                when (serverHostError e) $ notify c rcvFileEntityId $ RFWARN e
+                when (serverHostError e) $ notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFWARN e)
                liftIO $ closeXFTPServerClient c userId server digest
                withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
              liftIO $ assertAgentForeground c
@@ -211,7 +212,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
              atomically . incXFTPServerStat c userId srv $ case e of
                XFTP _ XFTP.AUTH -> downloadAuthErrs
                _ -> downloadErrs
-              rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) e
+              rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ (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
@@ -262,11 +263,11 @@ retryOnError name loop done e = do
    then loop
    else done

-rcvWorkerInternalError :: AgentClient -> DBRcvFileId -> RcvFileId -> Maybe FilePath -> AgentErrorType -> AM ()
-rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath err = do
+rcvWorkerInternalError :: AgentClient -> DBRcvFileId -> RcvFileId -> Maybe RcvFileId -> Maybe FilePath -> AgentErrorType -> AM ()
+rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ tmpPath err = do
  lift $ forM_ tmpPath (removePath <=< toFSFilePath)
  withStore' c $ \db -> updateRcvFileError db rcvFileId (show err)
-  notify c rcvFileEntityId $ RFERR err
+  notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFERR err)

 runXFTPRcvLocalWorker :: AgentClient -> Worker -> AM ()
 runXFTPRcvLocalWorker c Worker {doWork} = do
@@ -279,8 +280,8 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
    runXFTPOperation :: AgentConfig -> AM ()
    runXFTPOperation AgentConfig {rcvFilesTTL} =
      withWork c doWork (`getNextRcvFileToDecrypt` rcvFilesTTL) $
-        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath} ->
-          decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath
+        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath, redirect} ->
+          decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId (redirectEntityId <$> redirect) tmpPath
    decryptFile :: RcvFile -> AM ()
    decryptFile RcvFile {rcvFileId, rcvFileEntityId, size, digest, key, nonce, tmpPath, saveFile, status, chunks, redirect} = do
      let CryptoFile savePath cfArgs = saveFile
@@ -38,6 +38,7 @@ import Simplex.Messaging.Client
    defaultNetworkConfig,
    proxyUsername,
    transportClientConfig,
+    clientSocksCredentials,
    unexpectedResponse,
  )
 import qualified Simplex.Messaging.Crypto as C
@@ -100,7 +101,7 @@ defaultXFTPClientConfig =

 getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
 getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} disconnected = runExceptT $ do
-  let username = proxyUsername transportSession
+  let socksCreds = clientSocksCredentials xftpNetworkConfig $ proxyUsername transportSession
      ProtocolServer _ host port keyHash = srv
  useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
  let tcConfig = (transportClientConfig xftpNetworkConfig useHost) {alpn = clientALPN}
@@ -108,7 +109,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
  clientVar <- newTVarIO Nothing
  let usePort = if null port then "443" else port
      clientDisconnected = readTVarIO clientVar >>= mapM_ disconnected
-  http2Client <- liftError' xftpClientError $ getVerifiedHTTP2Client (Just username) useHost usePort (Just keyHash) Nothing http2Config clientDisconnected
+  http2Client <- liftError' xftpClientError $ getVerifiedHTTP2Client socksCreds useHost usePort (Just keyHash) Nothing http2Config clientDisconnected
  let HTTP2Client {sessionId, sessionALPN} = http2Client
      v = VersionXFTP 1
      thServerVRange = versionToRange v
@@ -33,7 +33,6 @@ import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
-import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Word (Word32)
 import qualified Data.X509 as X
@@ -57,6 +56,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (CorrId (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getRoundedSystemTime)
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -65,7 +65,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 (runTCPServer, tlsServerCredentials)
+import Simplex.Messaging.Transport.Server (runLocalTCPServer, tlsServerCredentials)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Exit (exitFailure)
@@ -249,7 +249,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
      u <- askUnliftIO
      liftIO $ do
        labelMyThread "control port server"
-        runTCPServer cpStarted port $ runCPClient u
+        runLocalTCPServer cpStarted port $ runCPClient u
      where
        runCPClient :: UnliftIO (ReaderT XFTPEnv IO) -> Socket -> IO ()
        runCPClient u sock = do
@@ -399,7 +399,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
      r <- runExceptT $ do
        sizes <- asks $ allowedChunkSizes . config
        unless (size file `elem` sizes) $ throwE SIZE
-        ts <- liftIO getSystemTime
+        ts <- liftIO getFileTime
        -- TODO validate body empty
        sId <- ExceptT $ addFileRetry st file 3 ts
        rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks
@@ -412,7 +412,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
        let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
        pure $ FRSndIds sId rIds
      pure $ either FRErr id r
-    addFileRetry :: FileStore -> FileInfo -> Int -> SystemTime -> M (Either XFTPErrorType XFTPFileId)
+    addFileRetry :: FileStore -> FileInfo -> Int -> RoundedSystemTime -> M (Either XFTPErrorType XFTPFileId)
    addFileRetry st file n ts =
      retryAdd n $ \sId -> runExceptT $ do
        ExceptT $ addFile st sId file ts
@@ -531,6 +531,9 @@ deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do
      liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1)
      liftIO $ atomicModifyIORef'_ (filesSize stats) (subtract $ fromIntegral $ size fileInfo)

+getFileTime :: IO RoundedSystemTime
+getFileTime = getRoundedSystemTime fileTimePrecision
+
 expireServerFiles :: Maybe Int -> ExpirationConfig -> M ()
 expireServerFiles itemDelay expCfg = do
  st <- asks store
@@ -11,7 +11,6 @@ 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)

 data FileServerStats = FileServerStats
@@ -21,7 +20,7 @@ data FileServerStats = FileServerStats
    filesUploaded :: IORef Int,
    filesExpired :: IORef Int,
    filesDeleted :: IORef Int,
-    filesDownloaded :: PeriodStats SenderId,
+    filesDownloaded :: PeriodStats,
    fileDownloads :: IORef Int,
    fileDownloadAcks :: IORef Int,
    filesCount :: IORef Int,
@@ -35,7 +34,7 @@ data FileServerStatsData = FileServerStatsData
    _filesUploaded :: Int,
    _filesExpired :: Int,
    _filesDeleted :: Int,
-    _filesDownloaded :: PeriodStatsData SenderId,
+    _filesDownloaded :: PeriodStatsData,
    _fileDownloads :: Int,
    _fileDownloadAcks :: Int,
    _filesCount :: Int,
@@ -17,6 +17,7 @@ module Simplex.FileTransfer.Server.Store
    expiredFilePath,
    getFile,
    ackFile,
+    fileTimePrecision,
  )
 where

@@ -25,12 +26,12 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Int (Int64)
 import Data.Set (Set)
 import qualified Data.Set as S
-import Data.Time.Clock.System (SystemTime (..))
 import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..), XFTPFileId)
 import Simplex.FileTransfer.Transport (XFTPErrorType (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime (..))
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (ifM, ($>>=))
@@ -46,10 +47,14 @@ data FileRec = FileRec
    fileInfo :: FileInfo,
    filePath :: TVar (Maybe FilePath),
    recipientIds :: TVar (Set RecipientId),
-    createdAt :: SystemTime
+    createdAt :: RoundedSystemTime
  }

+fileTimePrecision :: Int64
+fileTimePrecision = 3600 -- truncate creation time to 1 hour
+
 data FileRecipient = FileRecipient RecipientId RcvPublicAuthKey
+  deriving (Show)

 instance StrEncoding FileRecipient where
  strEncode (FileRecipient rId rKey) = strEncode rId <> ":" <> strEncode rKey
@@ -62,14 +67,14 @@ newFileStore = do
  usedStorage <- newTVarIO 0
  pure FileStore {files, recipients, usedStorage}

-addFile :: FileStore -> SenderId -> FileInfo -> SystemTime -> STM (Either XFTPErrorType ())
+addFile :: FileStore -> SenderId -> FileInfo -> RoundedSystemTime -> STM (Either XFTPErrorType ())
 addFile FileStore {files} sId fileInfo createdAt =
  ifM (TM.member sId files) (pure $ Left DUPLICATE_) $ do
    f <- newFileRec sId fileInfo createdAt
    TM.insert sId f files
    pure $ Right ()

-newFileRec :: SenderId -> FileInfo -> SystemTime -> STM FileRec
+newFileRec :: SenderId -> FileInfo -> RoundedSystemTime -> STM FileRec
 newFileRec senderId fileInfo createdAt = do
  recipientIds <- newTVar S.empty
  filePath <- newTVar Nothing
@@ -120,8 +125,8 @@ getFile st party fId = case party of
 expiredFilePath :: FileStore -> XFTPFileId -> Int64 -> STM (Maybe (Maybe FilePath))
 expiredFilePath FileStore {files} sId old =
  TM.lookup sId files
-    $>>= \FileRec {filePath, createdAt} ->
-      if systemSeconds createdAt < old
+    $>>= \FileRec {filePath, createdAt = RoundedSystemTime createdAt} ->
+      if createdAt + fileTimePrecision < old
        then Just <$> readTVar filePath
        else pure Nothing

@@ -28,22 +28,23 @@ import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Time.Clock.System (SystemTime)
 import Simplex.FileTransfer.Protocol (FileInfo (..))
 import Simplex.FileTransfer.Server.Store
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Util (bshow, whenM)
 import System.Directory (doesFileExist, renameFile)
 import System.IO

 data FileStoreLogRecord
-  = AddFile SenderId FileInfo SystemTime
+  = AddFile SenderId FileInfo RoundedSystemTime
  | PutFile SenderId FilePath
  | AddRecipients SenderId (NonEmpty FileRecipient)
  | DeleteFile SenderId
  | AckFile RecipientId
+  deriving (Show)

 instance StrEncoding FileStoreLogRecord where
  strEncode = \case
@@ -64,7 +65,7 @@ instance StrEncoding FileStoreLogRecord where
 logFileStoreRecord :: StoreLog 'WriteMode -> FileStoreLogRecord -> IO ()
 logFileStoreRecord = writeStoreLogRecord

-logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> SystemTime -> IO ()
+logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> RoundedSystemTime -> IO ()
 logAddFile s = logFileStoreRecord s .:. AddFile

 logPutFile :: StoreLog 'WriteMode -> SenderId -> FilePath -> IO ()
@@ -166,7 +166,7 @@ import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
-import Simplex.Messaging.Client (ProtocolClient (..), SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse)
+import Simplex.Messaging.Client (SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs)
 import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
@@ -174,14 +174,14 @@ 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 (..))
+import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..), pnMessagesP)
 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 qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (SMPVersion, THandleParams (sessionId))
+import Simplex.Messaging.Transport (SMPVersion)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import Simplex.RemoteControl.Client
@@ -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 #-}
@@ -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,7 +1065,8 @@ getNotificationMessage' c nonce encNtfInfo = do
  withStore' c getActiveNtfToken >>= \case
    Just NtfToken {ntfDhSecret = Just dhSecret} -> do
      ntfData <- agentCbDecrypt dhSecret nonce encNtfInfo
-      PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} <- liftEither (parse strP (INTERNAL "error parsing PNMessageData") ntfData)
+      pnMsgs <- liftEither (parse pnMessagesP (INTERNAL "error parsing PNMessageData") ntfData)
+      let PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} = L.last pnMsgs
      (ntfConnId, rcvNtfDhSecret) <- withStore c (`getNtfRcvQueue` smpQueue)
      ntfMsgMeta <- (eitherToMaybe . smpDecode <$> agentCbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta) `catchAgentError` \_ -> pure Nothing
      msgMeta <- getConnectionMessage' c ntfConnId
@@ -1103,8 +1104,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
@@ -1343,7 +1344,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) <- liftIO $ updateSndIds db connId
+      (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
      let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
          agentMsg = AgentMessage privHeader aMessage
          agentMsgStr = smpEncode agentMsg
@@ -2449,17 +2450,14 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
              handleNotifyAck :: AM ACKd -> AM ACKd
              handleNotifyAck m = m `catchAgentError` \e -> notify (ERR e) >> ack
          SMP.END ->
-            atomically (TM.lookup tSess (smpClients c) $>>= (tryReadTMVar . sessionVar) >>= processEND)
+            atomically (ifM (activeClientSession c tSess sessId) (removeSubscription c connId $> True) (pure False))
              >>= notifyEnd
            where
-              processEND = \case
-                Just (Right clnt)
-                  | sessId == sessionId (thParams $ connectedClient clnt) ->
-                      removeSubscription c connId $> True
-                _ -> pure False
              notifyEnd removed
                | removed = notify END >> logServer "<--" c srv rId "END"
                | otherwise = logServer "<--" c srv rId "END from disconnected client - ignored"
+          -- Possibly, we need to add some flag to connection that it was deleted
+          SMP.DELD -> atomically (removeSubscription c connId) >> notify DELD
          SMP.ERR e -> notify $ ERR $ SMP (B.unpack $ strEncode srv) e
          r -> unexpected r
        where
@@ -2853,7 +2851,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, _) <- liftIO $ updateSndIds db connId
+        (_, internalSndId, _) <- ExceptT $ 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
@@ -2886,7 +2884,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) <- liftIO $ updateSndIds db connId
+    (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
    let agentMsgStr = smpEncode agentMsg
        internalHash = C.sha256Hash agentMsgStr
        pqEnc = CR.pqSupportToEnc pqSupport
@@ -2912,7 +2910,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) <- liftIO $ updateSndIds db connId
+      (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
      let agentMsg = AgentRatchetInfo ""
          agentMsgStr = smpEncode agentMsg
          internalHash = C.sha256Hash agentMsgStr
@@ -1930,6 +1930,7 @@ 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
@@ -277,14 +277,14 @@ supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPA
 e2eEncConnInfoLength :: VersionSMPA -> PQSupport -> Int
 e2eEncConnInfoLength v = \case
  -- reduced by 3726 (roughly the increase of message ratchet header size + key and ciphertext in reply link)
-  PQSupportOn | v >= pqdrSMPAgentVersion -> 11122
-  _ -> 14848
+  PQSupportOn | v >= pqdrSMPAgentVersion -> 11106
+  _ -> 14832

 e2eEncAgentMsgLength :: VersionSMPA -> PQSupport -> Int
 e2eEncAgentMsgLength v = \case
  -- reduced by 2222 (the increase of message ratchet header size)
-  PQSupportOn | v >= pqdrSMPAgentVersion -> 13634
-  _ -> 15856
+  PQSupportOn | v >= pqdrSMPAgentVersion -> 13618
+  _ -> 15840

 -- | SMP agent event
 type ATransmission = (ACorrId, AEntityId, AEvt)
@@ -344,6 +344,7 @@ data AEvent (e :: AEntity) where
  INFO :: PQSupport -> ConnInfo -> AEvent AEConn
  CON :: PQEncryption -> AEvent AEConn -- notification that connection is established
  END :: AEvent AEConn
+  DELD :: AEvent AEConn
  CONNECT :: AProtocolType -> TransportHost -> AEvent AENone
  DISCONNECT :: AProtocolType -> TransportHost -> AEvent AENone
  DOWN :: SMPServer -> [ConnId] -> AEvent AENone
@@ -413,6 +414,7 @@ data AEventTag (e :: AEntity) where
  INFO_ :: AEventTag AEConn
  CON_ :: AEventTag AEConn
  END_ :: AEventTag AEConn
+  DELD_ :: AEventTag AEConn
  CONNECT_ :: AEventTag AENone
  DISCONNECT_ :: AEventTag AENone
  DOWN_ :: AEventTag AENone
@@ -466,6 +468,7 @@ aEventTag = \case
  INFO {} -> INFO_
  CON _ -> CON_
  END -> END_
+  DELD -> DELD_
  CONNECT {} -> CONNECT_
  DISCONNECT {} -> DISCONNECT_
  DOWN {} -> DOWN_
@@ -1338,6 +1341,8 @@ 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
@@ -971,12 +971,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 (InternalId, InternalSndId, PrevSndMsgHash)
-updateSndIds db connId = do
-  (lastInternalId, lastInternalSndId, prevSndHash) <- retrieveLastIdsAndHashSnd_ db connId
+updateSndIds :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
+updateSndIds db connId = runExceptT $ do
+  (lastInternalId, lastInternalSndId, prevSndHash) <- ExceptT $ retrieveLastIdsAndHashSnd_ db connId
  let internalId = InternalId $ unId lastInternalId + 1
      internalSndId = InternalSndId $ unSndId lastInternalSndId + 1
-  updateLastIdsSnd_ db connId internalId internalSndId
+  liftIO $ updateLastIdsSnd_ db connId internalId internalSndId
  pure (internalId, internalSndId, prevSndHash)

 createSndMsg :: DB.Connection -> ConnId -> SndMsgData -> IO ()
@@ -2219,9 +2219,9 @@ updateRcvMsgHash db connId sndMsgId internalRcvId internalHash =

 -- * updateSndIds helpers

-retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
+retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
 retrieveLastIdsAndHashSnd_ dbConn connId = do
-  [(lastInternalId, lastInternalSndId, lastSndHash)] <-
+  firstRow id SEConnNotFound $
    DB.queryNamed
      dbConn
      [sql|
@@ -2230,7 +2230,6 @@ 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 =
@@ -2526,7 +2525,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)))
+getNextRcvChunkToDownload :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe (RcvFileChunk, Bool, Maybe RcvFileId)))
 getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = do
  getWorkItem "rcv_file_download" getReplicaId getChunkData (markRcvFileFailed db . snd)
  where
@@ -2550,7 +2549,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))
+    getChunkData :: (Int64, DBRcvFileId) -> IO (Either StoreError (RcvFileChunk, Bool, Maybe RcvFileId))
    getChunkData (rcvFileChunkReplicaId, _fileId) =
      firstRow toChunk SEFileNotFound $
        DB.query
@@ -2559,7 +2558,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.approved_relays, f.redirect_entity_id
            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
@@ -2568,8 +2567,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) :. Only Bool) -> (RcvFileChunk, Bool)
-        toChunk ((rcvFileId, rcvFileEntityId, userId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath, chunkTmpPath) :. (rcvChunkReplicaId, replicaId, replicaKey, received, delay, retries) :. (Only approvedRelays)) =
+        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_)) =
          ( RcvFileChunk
              { rcvFileId,
                rcvFileEntityId,
@@ -2582,7 +2581,8 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
                chunkTmpPath,
                replicas = [RcvFileChunkReplica {rcvChunkReplicaId, server, replicaId, replicaKey, received, delay, retries}]
              },
-            approvedRelays
+            approvedRelays,
+            redirectEntityId_
          )

 getNextRcvFileToDecrypt :: DB.Connection -> NominalDiffTime -> IO (Either StoreError (Maybe RcvFile))
@@ -80,10 +80,12 @@ module Simplex.Messaging.Client
    defaultSMPClientConfig,
    defaultNetworkConfig,
    transportClientConfig,
+    clientSocksCredentials,
    chooseTransportHost,
    proxyUsername,
    temporaryClientError,
    smpProxyError,
+    textToHostMode,
    ServerTransmissionBatch,
    ServerTransmission (..),
    ClientCommand,
@@ -122,10 +124,13 @@ import Data.List (find)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (catMaybes, fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
 import Network.Socket (ServiceName)
+import Network.Socks5 (SocksCredentials (..))
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -136,7 +141,7 @@ import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Transport.Client (SocksProxy, TransportClientConfig (..), TransportHost (..), defaultTcpConnectTimeout, runTransportClient)
+import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultTcpConnectTimeout, runTransportClient)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tshow, whenM)
@@ -236,6 +241,12 @@ data HostMode
    HMPublic
  deriving (Eq, Show)

+textToHostMode :: Text -> Either String HostMode
+textToHostMode = \case
+  "public" -> Right HMPublic
+  "onion" -> Right HMOnionViaSocks
+  s -> Left $ T.unpack $ "Invalid host_mode: " <> s
+
 data SocksMode
  = -- | always use SOCKS proxy when enabled
    SMAlways
@@ -257,7 +268,7 @@ instance StrEncoding SocksMode where
 -- | network configuration for the client
 data NetworkConfig = NetworkConfig
  { -- | use SOCKS5 proxy
-    socksProxy :: Maybe SocksProxy,
+    socksProxy :: Maybe SocksProxyWithAuth,
    -- | when to use SOCKS proxy
    socksMode :: SocksMode,
    -- | determines critera which host is chosen from the list
@@ -355,12 +366,22 @@ transportClientConfig :: NetworkConfig -> TransportHost -> TransportClientConfig
 transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host =
  TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing}
  where
-    useSocksProxy SMAlways = socksProxy
+    socksProxy' = (\(SocksProxyWithAuth _ proxy) -> proxy) <$> socksProxy
+    useSocksProxy SMAlways = socksProxy'
    useSocksProxy SMOnion = case host of
-      THOnionHost _ -> socksProxy
+      THOnionHost _ -> socksProxy'
      _ -> Nothing
 {-# INLINE transportClientConfig #-}

+clientSocksCredentials :: NetworkConfig -> ByteString -> Maybe SocksCredentials
+clientSocksCredentials NetworkConfig {socksProxy} sessionUsername = case socksProxy of
+  Just (SocksProxyWithAuth auth _) -> case auth of
+    SocksAuthUsername {username, password} -> Just $ SocksCredentials username password
+    SocksAuthNull -> Nothing
+    SocksIsolateByAuth -> Just $ SocksCredentials sessionUsername ""
+  Nothing -> Nothing
+{-# INLINE clientSocksCredentials #-}
+
 -- | protocol client configuration.
 data ProtocolClientConfig v = ProtocolClientConfig
  { -- | size of TBQueue to use for server commands and responses
@@ -489,9 +510,9 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
    runClient (port', ATransport t) useHost c = do
      cVar <- newEmptyTMVarIO
      let tcConfig = (transportClientConfig networkConfig useHost) {alpn = clientALPN}
-          username = proxyUsername transportSession
+          socksCreds = clientSocksCredentials networkConfig $ proxyUsername transportSession
      tId <-
-        runTransportClient tcConfig (Just username) useHost port' (Just $ keyHash srv) (client t c cVar)
+        runTransportClient tcConfig socksCreds useHost port' (Just $ keyHash srv) (client t c cVar)
          `forkFinally` \_ -> void (atomically . tryPutTMVar cVar $ Left PCENetworkError)
      c_ <- tcpConnectTimeout `timeout` atomically (takeTMVar cVar)
      case c_ of
@@ -28,6 +28,8 @@ 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
@@ -39,7 +41,7 @@ import Data.Time.Format.ISO8601
 import Data.Word (Word16, Word32)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (bshow, (<$?>))

 class TextEncoding a where
  textEncode :: a -> Text
@@ -125,15 +127,15 @@ instance StrEncoding Bool where
  {-# INLINE strP #-}

 instance StrEncoding Int where
-  strEncode = B.pack . show
+  strEncode = bshow
  {-# INLINE strEncode #-}
-  strP = A.decimal
+  strP = A.signed A.decimal
  {-# INLINE strP #-}

 instance StrEncoding Int64 where
-  strEncode = B.pack . show
+  strEncode = bshow
  {-# INLINE strEncode #-}
-  strP = A.decimal
+  strP = A.signed A.decimal
  {-# INLINE strP #-}

 instance StrEncoding SystemTime where
@@ -160,6 +162,10 @@ 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')

@@ -443,6 +443,8 @@ data NtfSubStatus
    NSInactive
  | -- | END received
    NSEnd
+  | -- | DELD received (connection was deleted)
+    NSDeleted
  | -- | SMP AUTH error
    NSAuth
  | -- | SMP error other than AUTH
@@ -456,6 +458,7 @@ ntfShouldSubscribe = \case
  NSActive -> True
  NSInactive -> True
  NSEnd -> False
+  NSDeleted -> False
  NSAuth -> False
  NSErr _ -> False

@@ -466,6 +469,7 @@ instance Encoding NtfSubStatus where
    NSActive -> "ACTIVE"
    NSInactive -> "INACTIVE"
    NSEnd -> "END"
+    NSDeleted -> "DELETED"
    NSAuth -> "AUTH"
    NSErr err -> "ERR " <> err
  smpP =
@@ -475,6 +479,7 @@ instance Encoding NtfSubStatus where
      "ACTIVE" -> pure NSActive
      "INACTIVE" -> pure NSInactive
      "END" -> pure NSEnd
+      "DELETED" -> pure NSDeleted
      "AUTH" -> pure NSAuth
      "ERR" -> NSErr <$> (A.space *> A.takeByteString)
      _ -> fail "bad NtfSubStatus"
@@ -221,11 +221,12 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
              liftIO $ 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) $
                updateSubStatus smpQueue NSEnd
+            Right SMP.DELD -> updateSubStatus smpQueue NSDeleted
            Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e
            Right _ -> logError "SMP server unexpected response"
            Left e -> logError $ "SMP client error: " <> tshow e
@@ -16,7 +16,7 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
-import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
+import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server (runNtfServer)
@@ -92,6 +92,10 @@ ntfServerCLI cfgPath logPath =
            <> "websockets: off\n\n\
               \[SUBSCRIBER]\n\
               \# Network configuration for notification server client.\n\
+               \# `host_mode` can be 'public' (default) or 'onion'.\n\
+               \# It defines prefferred hostname for destination servers with multiple hostnames.\n\
+               \# host_mode: public\n\
+               \# required_host_mode: off\n\n\
               \# SOCKS proxy port for subscribing to SMP servers.\n\
               \# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n\
               \# socks_proxy: localhost:9050\n\n\
@@ -134,6 +138,8 @@ ntfServerCLI cfgPath logPath =
                            defaultNetworkConfig
                              { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini,
                                socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini,
+                                hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "SUBSCRIBER" "host_mode" ini,
+                                requiredHostMode = fromMaybe False $ iniOnOff "SUBSCRIBER" "required_host_mode" ini,
                                smpPingInterval = 60_000_000 -- 1 minutes
                              }
                        },
@@ -28,12 +28,16 @@ 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)
@@ -103,11 +107,20 @@ readECPrivateKey f = do

 data PushNotification
  = PNVerification NtfRegCode
-  | PNMessage PNMessageData
+  | PNMessage (NonEmpty 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,
@@ -285,7 +298,7 @@ apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
    encrypt code $ \code' ->
      apn APNSBackground {contentAvailable = 1} . Just $ J.object ["nonce" .= nonce, "verification" .= code']
  PNMessage pnMessageData ->
-    encrypt (strEncode pnMessageData) $ \ntfData ->
+    encrypt (encodePNMessages 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]
@@ -10,8 +10,6 @@ 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

 data NtfServerStats = NtfServerStats
@@ -23,8 +21,8 @@ data NtfServerStats = NtfServerStats
    subDeleted :: IORef Int,
    ntfReceived :: IORef Int,
    ntfDelivered :: IORef Int,
-    activeTokens :: PeriodStats NtfTokenId,
-    activeSubs :: PeriodStats NotifierId
+    activeTokens :: PeriodStats,
+    activeSubs :: PeriodStats
  }

 data NtfServerStatsData = NtfServerStatsData
@@ -36,8 +34,8 @@ data NtfServerStatsData = NtfServerStatsData
    _subDeleted :: Int,
    _ntfReceived :: Int,
    _ntfDelivered :: Int,
-    _activeTokens :: PeriodStatsData NtfTokenId,
-    _activeSubs :: PeriodStatsData NotifierId
+    _activeTokens :: PeriodStatsData,
+    _activeSubs :: PeriodStatsData
  }

 newNtfServerStats :: UTCTime -> IO NtfServerStats
@@ -50,6 +50,7 @@ data NtfStoreLogRecord
  | CreateSubscription NtfSubRec
  | SubscriptionStatus NtfSubscriptionId NtfSubStatus
  | DeleteSubscription NtfSubscriptionId
+  deriving (Show)

 data NtfTknRec = NtfTknRec
  { ntfTknId :: NtfTokenId,
@@ -61,6 +62,7 @@ data NtfTknRec = NtfTknRec
    tknRegCode :: NtfRegCode,
    tknCronInterval :: Word16
  }
+  deriving (Show)

 mkTknData :: NtfTknRec -> STM NtfTknData
 mkTknData NtfTknRec {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval = cronInt} = do
@@ -81,6 +83,7 @@ data NtfSubRec = NtfSubRec
    tokenId :: NtfTokenId,
    subStatus :: NtfSubStatus
  }
+  deriving (Show)

 mkSubData :: NtfSubRec -> STM NtfSubData
 mkSubData NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus = status} = do
@@ -484,6 +484,7 @@ data BrokerMsg where
  RRES :: EncFwdResponse -> BrokerMsg -- relay to proxy
  PRES :: EncResponse -> BrokerMsg -- proxy to client
  END :: BrokerMsg
+  DELD :: BrokerMsg
  INFO :: QueueInfo -> BrokerMsg
  OK :: BrokerMsg
  ERR :: ErrorType -> BrokerMsg
@@ -705,6 +706,7 @@ data BrokerMsgTag
  | RRES_
  | PRES_
  | END_
+  | DELD_
  | INFO_
  | OK_
  | ERR_
@@ -778,6 +780,7 @@ instance Encoding BrokerMsgTag where
    RRES_ -> "RRES"
    PRES_ -> "PRES"
    END_ -> "END"
+    DELD_ -> "DELD"
    INFO_ -> "INFO"
    OK_ -> "OK"
    ERR_ -> "ERR"
@@ -794,6 +797,7 @@ instance ProtocolMsgTag BrokerMsgTag where
    "RRES" -> Just RRES_
    "PRES" -> Just PRES_
    "END" -> Just END_
+    "DELD" -> Just DELD_
    "INFO" -> Just INFO_
    "OK" -> Just OK_
    "ERR" -> Just ERR_
@@ -1423,6 +1427,9 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
    RRES (EncFwdResponse encBlock) -> e (RRES_, ' ', Tail encBlock)
    PRES (EncResponse encBlock) -> e (PRES_, ' ', Tail encBlock)
    END -> e END_
+    DELD
+      | v >= deletedEventSMPVersion -> e DELD_
+      | otherwise -> e END_
    INFO info -> e (INFO_, ' ', info)
    OK -> e OK_
    ERR err -> e (ERR_, ' ', err)
@@ -1448,6 +1455,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
    RRES_ -> RRES <$> (EncFwdResponse . unTail <$> _smpP)
    PRES_ -> PRES <$> (EncResponse . unTail <$> _smpP)
    END_ -> pure END
+    DELD_ -> pure DELD
    INFO_ -> INFO <$> _smpP
    OK_ -> pure OK
    ERR_ -> ERR <$> _smpP
@@ -62,7 +62,6 @@ import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
-import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
@@ -137,9 +136,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
  expired <- restoreServerMessages
  restoreServerStats expired
  raceAny_
-    ( serverThread s "server subscribedQ" subscribedQ subscribers pendingENDs subscriptions cancelSub
-        : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ())
-        : sendPendingENDsThread s
+    ( serverThread s "server subscribedQ" True subscribedQ subscribers pendingENDs subscriptions cancelSub
+        : serverThread s "server deletedQ" False deletedQ  subscribers pendingDELDs subscriptions cancelSub
+        : serverThread s "server ntfSubscribedQ" True ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ())
+        : serverThread s "server ntfDeletedQ" False ntfDeletedQ Env.notifiers pendingNtfDELDs ntfSubscriptions (\_ -> pure ())
+        : sendPendingEvtsThread s
        : receiveFromProxyAgent pa
        : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
    )
@@ -164,13 +165,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
      forall s.
      Server ->
      String ->
-      (Server -> TQueue (QueueId, Client, Subscribed)) ->
-      (Server -> TMap QueueId Client) ->
-      (Server -> IORef (IM.IntMap (NonEmpty RecipientId))) ->
+      Subscribed ->
+      (Server -> TQueue (QueueId, ClientId)) ->
+      (Server -> TMap QueueId (TVar Client)) ->
+      (Server -> TVar (IM.IntMap (NonEmpty RecipientId))) ->
      (Client -> TMap QueueId s) ->
      (s -> IO ()) ->
      M ()
-    serverThread s label subQ subs ends clientSubs unsub = do
+    serverThread s label subscribed subQ subs pendingEvts clientSubs unsub = do
      labelMyThread label
      cls <- asks clients
      liftIO . forever $
@@ -178,45 +180,65 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
          $>>= endPreviousSubscriptions
          >>= mapM_ unsub
      where
-        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, Client, Bool) -> STM (Maybe (QueueId, Client))
-        updateSubscribers cls (qId, clnt, subscribed) = do
-          current <- IM.member (clientId clnt) <$> readTVar cls
-          let updateSub
-                | not subscribed = TM.lookupDelete
-                | not current = TM.lookup -- do not insert client if it is already disconnected, but send END to any other client
-                | otherwise = (`TM.lookupInsert` clnt) -- insert subscribed and current client
-              clientToBeNotified c'
-                | sameClientId clnt c' = pure Nothing
-                | otherwise = do
-                    yes <- readTVar $ connected c'
-                    pure $ if yes then Just (qId, c') else Nothing
-          updateSub qId (subs s) $>>= clientToBeNotified
+        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId) -> STM (Maybe (QueueId, Client))
+        updateSubscribers cls (qId, clntId) =
+          -- Client lookup by ID is in the same STM transaction.
+          -- In case client disconnects during the transaction,
+          -- it will be re-evaluated, and the client won't be stored as subscribed.
+          (readTVar cls >>= updateSub (subs s) . IM.lookup clntId)
+            $>>= clientToBeNotified
+          where
+            updateSub ss = \case
+              Just (Just clnt)
+                | subscribed ->
+                    TM.lookup qId ss >>= -- insert subscribed and current client
+                      maybe
+                        (newTVar clnt >>= \cv -> TM.insert qId cv ss $> Nothing)
+                        (\cv -> Just <$> swapTVar cv clnt)
+                | otherwise -> TM.lookupDelete qId ss >>= mapM readTVar
+              -- This case catches Just Nothing - it cannot happen here.
+              -- Nothing is there only before client thread is started.
+              _ -> TM.lookup qId ss >>= mapM readTVar -- do not insert client if it is already disconnected, but send END to any other client
+            clientToBeNotified c'
+              | clntId == clientId c' = pure Nothing
+              | otherwise = (\yes -> if yes then Just (qId, c') else Nothing) <$> readTVar (connected c')
        endPreviousSubscriptions :: (QueueId, Client) -> IO (Maybe s)
        endPreviousSubscriptions (qId, c) = do
-          atomicModifyIORef'_ (ends s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
+          atomically $ modifyTVar' (pendingEvts s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
          atomically $ TM.lookupDelete qId (clientSubs c)

-    sendPendingENDsThread :: Server -> M ()
-    sendPendingENDsThread s = do
+    sendPendingEvtsThread :: Server -> M ()
+    sendPendingEvtsThread s = do
      endInt <- asks $ pendingENDInterval . config
      cls <- asks clients
      forever $ do
        threadDelay endInt
-        sendPending cls $ pendingENDs s
-        sendPending cls $ pendingNtfENDs s
+        sendPending cls END $ pendingENDs s
+        sendPending cls DELD $ pendingDELDs s
+        sendPending cls END $ pendingNtfENDs s
+        sendPending cls DELD $ pendingNtfDELDs s
      where
-        sendPending cls ref = do
-          ends <- liftIO $ atomicSwapIORef ref IM.empty
+        sendPending cls evt ref = do
+          ends <- atomically $ swapTVar ref IM.empty
          unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qIds) ->
-            queueENDs qIds . IM.lookup cId =<< readTVarIO cls
-        queueENDs qIds = \case
-          Just (Just c) -> forkClient c ("sendPendingENDsThread.queueENDs") $ do
-            stats <- asks serverStats
-            atomically $ writeTBQueue (sndQ c) $ L.map (CorrId "",,END) qIds
-            let len = L.length qIds
-            liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
-            liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
-          _ -> pure ()
+            mapM_ (queueEvts qIds evt) . join . IM.lookup cId =<< readTVarIO cls
+        queueEvts qIds evt c@Client {connected, sndQ = q} =
+          whenM (readTVarIO connected) $ do
+            sent <- atomically $ ifM (isFullTBQueue q) (pure False) (writeTBQueue q ts $> True)
+            if sent
+              then updateEndStats
+              else -- if queue is full it can block
+                forkClient c ("sendPendingEvtsThread.queueEvts") $
+                  atomically (writeTBQueue q ts) >> updateEndStats
+          where
+            ts = L.map (CorrId "",,evt) qIds
+            updateEndStats = case evt of
+              END -> do
+                stats <- asks serverStats
+                let len = L.length qIds
+                liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
+                liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
+              _ -> pure ()

    receiveFromProxyAgent :: ProxyAgent -> M ()
    receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
@@ -247,7 +269,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
        rIds <- M.keysSet <$> readTVarIO ms
        forM_ rIds $ \rId -> do
          q <- liftIO $ getMsgQueue ms rId quota
-          deleted <- atomically $ deleteExpiredMsgs q old
+          deleted <- liftIO $ deleteExpiredMsgs q old
          liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)

    serverStatsThread_ :: ServerConfig -> [M ()]
@@ -409,7 +431,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
      u <- askUnliftIO
      liftIO $ do
        labelMyThread "control port server"
-        runTCPServer cpStarted port $ runCPClient u srv
+        runLocalTCPServer cpStarted port $ runCPClient u srv
      where
        runCPClient :: UnliftIO (ReaderT Env IO) -> Server -> Socket -> IO ()
        runCPClient u srv sock = do
@@ -472,7 +494,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                putStat "qDeletedAllB" qDeletedAllB
                putStat "qDeletedNew" qDeletedNew
                putStat "qDeletedSecured" qDeletedSecured
-                getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "daily active queues: " <> show (S.size v)
+                getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "daily active queues: " <> show (IS.size v)
                -- removed to reduce memory usage
                -- getStat (day . subscribedQueues) >>= \v -> hPutStrLn h $ "daily subscribed queues: " <> show (S.size v)
                putStat "qSub" qSub
@@ -560,27 +582,15 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                  putActiveClientsInfo "SMP" subscribers
                  putActiveClientsInfo "Ntf" notifiers
                  where
-                    putActiveClientsInfo :: String -> TMap QueueId Client -> IO ()
+                    putActiveClientsInfo :: String -> TMap QueueId (TVar Client) -> IO ()
                    putActiveClientsInfo protoName clients = do
                      activeSubs <- readTVarIO clients
                      hPutStrLn h $ protoName <> " subscriptions: " <> show (M.size activeSubs)
-                      clCnt <- if r == CPRAdmin then putClientQueues activeSubs else pure $ countSubClients activeSubs
+                      clCnt <- IS.size <$> countSubClients activeSubs
                      hPutStrLn h $ protoName <> " subscribed clients: " <> show clCnt
                      where
-                        putClientQueues :: M.Map QueueId Client -> IO Int
-                        putClientQueues subs = do
-                          let cls = differentClients subs
-                          clQs <- clientTBQueueLengths cls
-                          hPutStrLn h $ protoName <> " subscribed clients queues (rcvQ, sndQ, msgQ): " <> show clQs
-                          pure $ length cls
-                        differentClients :: M.Map QueueId Client -> [Client]
-                        differentClients = fst . M.foldl' addClient ([], IS.empty)
-                          where
-                            addClient acc@(cls, clSet) cl@Client {clientId}
-                              | IS.member clientId clSet = acc
-                              | otherwise = (cl : cls, IS.insert clientId clSet)
-                        countSubClients :: M.Map QueueId Client -> Int
-                        countSubClients = IS.size . M.foldr' (IS.insert . clientId) IS.empty
+                        countSubClients :: M.Map QueueId (TVar Client) -> IO IS.IntSet
+                        countSubClients = foldM (\ !s c -> (`IS.insert` s) . clientId <$> readTVarIO c) IS.empty
                    countClientSubs :: (Client -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap (Maybe Client) -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
                    countClientSubs subSel countSubs_ = foldM addSubs (0, (0, 0, 0, 0), 0, (0, 0, 0))
                      where
@@ -597,8 +607,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                              clCnt' = if cnt == 0 then clCnt else clCnt + 1
                          qs' <- if cnt == 0 then pure qs else addQueueLengths qs cl
                          pure (subCnt + cnt, cnts', clCnt', qs')
-                    clientTBQueueLengths :: Foldable t => t Client -> IO (Natural, Natural, Natural)
-                    clientTBQueueLengths = foldM addQueueLengths (0, 0, 0)
                    clientTBQueueLengths' :: Foldable t => t (Maybe Client) -> IO (Natural, Natural, Natural)
                    clientTBQueueLengths' = foldM (\acc -> maybe (pure acc) (addQueueLengths acc)) (0, 0, 0)
                    addQueueLengths (!rl, !sl, !ml) cl = do
@@ -623,10 +631,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
              CPDelete queueId' -> withUserRole $ unliftIO u $ do
                st <- asks queueStore
                ms <- asks msgStore
-                queueId <- atomically (getQueue st SSender queueId') >>= \case
+                queueId <- liftIO (getQueue st SSender queueId') >>= \case
                  Left _ -> pure queueId' -- fallback to using as recipientId directly
                  Right QueueRec {recipientId} -> pure recipientId
-                r <- atomically $
+                r <- liftIO $
                  deleteQueue st queueId $>>= \q ->
                    Right . (q,) <$> delMsgQueueSize ms queueId
                case r of
@@ -681,24 +689,27 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
 clientDisconnected :: Client -> M ()
 clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connected, sessionId, endThreads} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disc"
-  (subs, ntfSubs) <- atomically $ do
-    writeTVar connected False
-    (,) <$> swapTVar subscriptions M.empty <*> swapTVar ntfSubscriptions M.empty
+  -- these can be in separate transactions,
+  -- because the client already disconnected and they won't change
+  atomically $ writeTVar connected False
+  subs <- atomically $ swapTVar subscriptions M.empty
+  ntfSubs <- atomically $ swapTVar ntfSubscriptions M.empty
  liftIO $ mapM_ cancelSub subs
  Server {subscribers, notifiers} <- asks server
-  updateSubscribers subs subscribers
-  updateSubscribers ntfSubs notifiers
+  liftIO $ updateSubscribers subs subscribers
+  liftIO $ updateSubscribers ntfSubs notifiers
  asks clients >>= atomically . (`modifyTVar'` IM.delete clientId)
  tIds <- atomically $ swapTVar endThreads IM.empty
  liftIO $ mapM_ (mapM_ killThread <=< deRefWeak) tIds
  where
-    updateSubscribers subs srvSubs = do
-      atomically $ modifyTVar' srvSubs $ \cs ->
-        M.foldrWithKey (\sub _ -> M.update deleteCurrentClient sub) cs subs
-    deleteCurrentClient :: Client -> Maybe Client
-    deleteCurrentClient c'
-      | sameClientId c c' = Nothing
-      | otherwise = Just c'
+    updateSubscribers :: M.Map QueueId a -> TMap QueueId (TVar Client) -> IO ()
+    updateSubscribers subs srvSubs =
+      forM_ (M.keys subs) $ \qId ->
+        -- lookup of the subscribed client TVar can be in separate transaction,
+        -- as long as the client is read in the same transaction -
+        -- it prevents removing the next subscribed client.
+        TM.lookupIO qId srvSubs >>=
+          mapM_ (\c' -> atomically $ whenM (sameClientId c <$> readTVar c') $ TM.delete qId srvSubs)

 sameClientId :: Client -> Client -> Bool
 sameClientId Client {clientId} Client {clientId = cId'} = clientId == cId'
@@ -832,7 +843,7 @@ verifyTransmission auth_ tAuth authorized queueId cmd =
    get :: DirectParty p => SParty p -> M (Either ErrorType QueueRec)
    get party = do
      st <- asks queueStore
-      atomically $ getQueue st party queueId
+      liftIO $ getQueue st party queueId

 verifyCmdAuthorization :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
 verifyCmdAuthorization auth_ tAuth authorized key = maybe False (verify key) tAuth
@@ -888,7 +899,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do
  mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId

 client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
-client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
+client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, deletedQ, ntfSubscribedQ, ntfDeletedQ, subscribers, notifiers} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
  forever $
    atomically (readTBQueue rcvQ)
@@ -981,11 +992,9 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
    processCommand (qr_, (corrId, entId, cmd)) = case cmd of
      Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
      Cmd SSender command -> Just <$> case command of
-        SKEY sKey -> (corrId,entId,) <$> case qr_ of
-          Just QueueRec {sndSecure, recipientId}
-            | sndSecure -> secureQueue_ "SKEY" recipientId sKey
-            | otherwise -> pure $ ERR AUTH
-          Nothing -> pure $ ERR INTERNAL
+        SKEY sKey ->
+          withQueue $ \QueueRec {sndSecure, recipientId} ->
+            (corrId,entId,) <$> if sndSecure then secureQueue_ "SKEY" recipientId sKey else pure $ ERR AUTH
        SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
        PING -> pure (corrId, NoEntity, PONG)
        RFWD encBlock -> (corrId, NoEntity,) <$> processForwardedCommand encBlock
@@ -1005,9 +1014,9 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
          SUB -> withQueue (`subscribeQueue` entId)
          GET -> withQueue getMessage
          ACK msgId -> withQueue (`acknowledgeMsg` msgId)
-          KEY sKey -> (corrId,entId,) <$> case qr_ of
-            Just QueueRec {recipientId} -> secureQueue_ "KEY" recipientId sKey
-            Nothing -> pure $ ERR INTERNAL
+          KEY sKey ->
+            withQueue $ \QueueRec {recipientId} ->
+              (corrId,entId,) <$> secureQueue_ "KEY" recipientId sKey
          NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
          NDEL -> deleteQueueNotifier_ st
          OFF -> suspendQueue_ st
@@ -1017,6 +1026,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
        createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
        createQueue st recipientKey dhKey subMode sndSecure = time "NEW" $ do
          (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
+          updatedAt <- Just <$> liftIO getSystemDate
          let rcvDhSecret = C.dh' dhKey privDhKey
              qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}
              qRec (recipientId, senderId) =
@@ -1028,7 +1038,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                    senderKey = Nothing,
                    notifier = Nothing,
                    status = QueueActive,
-                    sndSecure
+                    sndSecure,
+                    updatedAt
                  }
          (corrId,entId,) <$> addQueueRetry 3 qik qRec
          where
@@ -1039,11 +1050,11 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
              ids@(rId, _) <- getIds
              -- create QueueRec record with these ids and keys
              let qr = qRec ids
-              atomically (addQueue st qr) >>= \case
+              liftIO (addQueue st qr) >>= \case
                Left DUPLICATE_ -> addQueueRetry (n - 1) qik qRec
                Left e -> pure $ ERR e
-                Right _ -> do
-                  withLog (`logCreateById` rId)
+                Right () -> do
+                  withLog (`logCreateQueue` qr)
                  stats <- asks serverStats
                  incStat $ qCreated stats
                  incStat $ qCount stats
@@ -1052,12 +1063,6 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                    SMSubscribe -> void $ subscribeQueue qr rId
                  pure $ IDS (qik ids)

-            logCreateById :: StoreLog 'WriteMode -> RecipientId -> IO ()
-            logCreateById s rId =
-              atomically (getQueue st SRecipient rId) >>= \case
-                Right q -> logCreateQueue s q
-                _ -> pure ()
-
            getIds :: M (RecipientId, SenderId)
            getIds = do
              n <- asks $ queueIdBytes . config
@@ -1069,7 +1074,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
          st <- asks queueStore
          stats <- asks serverStats
          incStat $ qSecured stats
-          atomically $ either ERR (const OK) <$> secureQueue st rId sKey
+          liftIO $ either ERR (const OK) <$> secureQueue st rId sKey

        addQueueNotifier_ :: QueueStore -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> M (Transmission BrokerMsg)
        addQueueNotifier_ st notifierKey dhKey = time "NKEY" $ do
@@ -1082,29 +1087,31 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
            addNotifierRetry n rcvPublicDhKey rcvNtfDhSecret = do
              notifierId <- randomId =<< asks (queueIdBytes . config)
              let ntfCreds = NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}
-              atomically (addQueueNotifier st entId ntfCreds) >>= \case
+              liftIO (addQueueNotifier st entId ntfCreds) >>= \case
                Left DUPLICATE_ -> addNotifierRetry (n - 1) rcvPublicDhKey rcvNtfDhSecret
                Left e -> pure $ ERR e
-                Right _ -> do
+                Right nId_ -> do
                  withLog $ \s -> logAddNotifier s entId ntfCreds
                  incStat . ntfCreated =<< asks serverStats
+                  forM_ nId_ $ \nId -> atomically $ writeTQueue ntfDeletedQ (nId, clientId)
                  pure $ NID notifierId rcvPublicDhKey

        deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
        deleteQueueNotifier_ st = do
          withLog (`logDeleteNotifier` entId)
-          atomically (deleteQueueNotifier st entId) >>= \case
-            Right () -> do
+          liftIO (deleteQueueNotifier st entId) >>= \case
+            Right (Just nId) -> do
              -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue ntfSubscribedQ (entId, clnt, False)
+              atomically $ writeTQueue ntfDeletedQ (nId, clientId)
              incStat . ntfDeleted =<< asks serverStats
              pure ok
+            Right Nothing -> pure ok
            Left e -> pure $ err e

        suspendQueue_ :: QueueStore -> M (Transmission BrokerMsg)
        suspendQueue_ st = do
          withLog (`logSuspendQueue` entId)
-          okResp <$> atomically (suspendQueue st entId)
+          okResp <$> liftIO (suspendQueue st entId)

        subscribeQueue :: QueueRec -> RecipientId -> M (Transmission BrokerMsg)
        subscribeQueue qr rId = do
@@ -1123,18 +1130,19 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
          where
            newSub :: M Sub
            newSub = time "SUB newSub" . atomically $ do
-              writeTQueue subscribedQ (rId, clnt, True)
+              writeTQueue subscribedQ (rId, clientId)
              sub <- newSubscription NoSub
              TM.insert rId sub subscriptions
              pure sub
            deliver :: Bool -> Sub -> M (Transmission BrokerMsg)
            deliver inc sub = do
              q <- getStoreMsgQueue "SUB" rId
-              msg_ <- atomically $ tryPeekMsg q
+              msg_ <- liftIO $ tryPeekMsgIO q
              when (inc && isJust msg_) $
                incStat . qSub =<< asks serverStats
              deliverMessage "SUB" qr rId sub msg_

+        -- clients that use GET are not added to server subscribers
        getMessage :: QueueRec -> M (Transmission BrokerMsg)
        getMessage qr = time "GET" $ do
          atomically (TM.lookup entId subscriptions) >>= \case
@@ -1161,6 +1169,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
              q <- getStoreMsgQueue "GET" entId
              stats <- asks serverStats
              (statCnt, r) <-
+                -- TODO split STM, use tryPeekMsgIO
                atomically $
                  tryPeekMsg q >>= \case
                    Just msg ->
@@ -1172,7 +1181,17 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
              pure r

        withQueue :: (QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
-        withQueue action = maybe (pure $ err AUTH) action qr_
+        withQueue action = case qr_ of
+          Just qr -> updateQueueDate qr >> action qr
+          Nothing -> pure $ err INTERNAL
+
+        updateQueueDate :: QueueRec -> M ()
+        updateQueueDate QueueRec {updatedAt, recipientId = rId} = do
+          t <- liftIO getSystemDate
+          when (Just t /= updatedAt) $ do
+            withLog $ \s -> logUpdateQueueTime s rId t
+            st <- asks queueStore
+            liftIO $ updateQueueTime st rId t 

        subscribeNotifications :: M (Transmission BrokerMsg)
        subscribeNotifications = do
@@ -1186,7 +1205,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
          pure ok
          where
            newSub = do
-              writeTQueue ntfSubscribedQ (entId, clnt, True)
+              writeTQueue ntfSubscribedQ (entId, clientId)
              TM.insert entId () ntfSubscriptions

        acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
@@ -1199,11 +1218,11 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                  q <- getStoreMsgQueue "ACK" entId
                  case st of
                    ProhibitSub -> do
-                      deletedMsg_ <- atomically $ tryDelMsg q msgId
+                      deletedMsg_ <- liftIO $ tryDelMsg q msgId
                      mapM_ (updateStats True) deletedMsg_
                      pure ok
                    _ -> do
-                      (deletedMsg_, msg_) <- atomically $ tryDelPeekMsg q msgId
+                      (deletedMsg_, msg_) <- liftIO $ tryDelPeekMsg q msgId
                      mapM_ (updateStats False) deletedMsg_
                      deliverMessage "ACK" qr entId sub msg_
                _ -> pure $ err NO_MSG
@@ -1246,13 +1265,13 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                      msg_ <- time "SEND" $ do
                        q <- getStoreMsgQueue "SEND" $ recipientId qr
                        expireMessages q
-                        atomically . writeMsg q =<< mkMessage body
+                        liftIO . writeMsg q =<< mkMessage body
                      case msg_ of
                        Nothing -> do
                          incStat $ msgSentQuota stats
                          pure $ err QUOTA
                        Just (msg, wasEmpty) -> time "SEND ok" $ do
-                          when wasEmpty $ tryDeliverMessage msg
+                          when wasEmpty $ liftIO $ tryDeliverMessage msg
                          when (notification msgFlags) $ do
                            mapM_ (`trySendNotification` msg) (notifier qr)
                            incStat $ msgSentNtf stats
@@ -1273,7 +1292,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
            expireMessages q = do
              msgExp <- asks $ messageExpiration . config
              old <- liftIO $ mapM expireBeforeEpoch msgExp
-              deleted <- atomically $ sum <$> mapM (deleteExpiredMsgs q) old
+              deleted <- liftIO $ sum <$> mapM (deleteExpiredMsgs q) old
              when (deleted > 0) $ do
                stats <- asks serverStats
                liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
@@ -1286,12 +1305,21 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
            -- If the queue is not full, then the thread is created where these checks are made:
            -- - it is the same subscribed client (in case it was reconnected it would receive message via SUB command)
            -- - nothing was delivered to this subscription (to avoid race conditions with the recipient).
-            tryDeliverMessage :: Message -> M ()
-            tryDeliverMessage msg = atomically deliverToSub >>= mapM_ forkDeliver
+            tryDeliverMessage :: Message -> IO ()
+            tryDeliverMessage msg =
+              -- the subscription is checked outside of STM to avoid transaction cost
+              -- in case no client is subscribed.
+              whenM (TM.memberIO rId subscribers) $
+                atomically deliverToSub >>= mapM_ forkDeliver
              where
                rId = recipientId qr
+                -- remove tryPeekMsg
                deliverToSub =
-                  TM.lookup rId subscribers
+                  -- lookup has ot be in the same transaction,
+                  -- so that if subscription ends, it re-evalutates
+                  -- and delivery is cancelled -
+                  -- the new client will receive message in response to SUB.
+                  (TM.lookup rId subscribers >>= mapM readTVar)
                    $>>= \rc@Client {subscriptions = subs, sndQ = q} -> TM.lookup rId subs
                    $>>= \s@Sub {subThread, delivered} -> case subThread of
                      ProhibitSub -> pure Nothing
@@ -1318,13 +1346,17 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                  where
                    deliverThread = do
                      labelMyThread $ B.unpack ("client $" <> encode sessionId) <> " deliver/SEND"
-                      time "deliver" . atomically $
-                        whenM (maybe False (sameClientId rc) <$> TM.lookup rId subscribers) $ do
-                          tryTakeTMVar delivered >>= \case
-                            Just _ -> pure () -- if a message was already delivered, should not deliver more
-                            Nothing -> do
-                              deliver q s
-                              writeTVar st NoSub
+                      -- lookup can be outside of STM transaction,
+                      -- as long as the check that it is the same client is inside.
+                      TM.lookupIO rId subscribers >>= mapM_ deliverIfSame
+                    deliverIfSame rc' = time "deliver" . atomically $
+                      whenM (sameClientId rc <$> readTVar rc') $
+                        tryTakeTMVar delivered >>= \case
+                          Just _ -> pure () -- if a message was already delivered, should not deliver more
+                          Nothing -> do
+                            -- a separate thread is needed because it blocks when client sndQ is full.
+                            deliver q s
+                            writeTVar st NoSub

            trySendNotification :: NtfCreds -> Message -> M ()
            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg = do
@@ -1340,12 +1372,13 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                        logWarn "Dropped message notification"
                  writeNtf notifierId msg rcvNtfDhSecret ntfClnt >>= mapM_ updateStats

-            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> Client -> M (Maybe Bool)
-            writeNtf nId msg rcvNtfDhSecret Client {sndQ = q} = case msg of
+            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar Client -> M (Maybe Bool)
+            writeNtf nId msg rcvNtfDhSecret ntfClnt = case msg of
              Message {msgId, msgTs} -> Just <$> do
                (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret
                -- must be in one STM transaction to avoid the queue becoming full between the check and writing
-                atomically $
+                atomically $ do
+                  Client {sndQ = q} <- readTVar ntfClnt
                  ifM
                    (isFullTBQueue q)
                    (pure $ False)
@@ -1424,7 +1457,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
          where
            resp = (corrId, rId, OK)

-        time :: T.Text -> M a -> M a
+        time :: MonadIO m => T.Text -> m a -> m a
        time name = timed name entId

        encryptMsg :: QueueRec -> Message -> RcvMessage
@@ -1450,12 +1483,12 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
        delQueueAndMsgs st = do
          withLog (`logDeleteQueue` entId)
          ms <- asks msgStore
-          atomically (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
+          liftIO (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
            Right q -> do
              -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue subscribedQ (entId, clnt, False)
+              atomically $ writeTQueue deletedQ (entId, clientId)
              forM_ (notifierId <$> notifier q) $ \nId ->
-                atomically $ writeTQueue ntfSubscribedQ (nId, clnt, False)
+                atomically $ writeTQueue ntfDeletedQ (nId, clientId)
              updateDeletedStats q
              pure ok
            Left e -> pure $ err e
@@ -1465,7 +1498,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
          q <- getStoreMsgQueue "getQueueInfo" entId
          qiSub <- liftIO $ TM.lookupIO entId subscriptions >>= mapM mkQSub
          qiSize <- liftIO $ getQueueSize q
-          qiMsg <- atomically $ toMsgInfo <$$> tryPeekMsg q
+          qiMsg <- liftIO $ toMsgInfo <$$> tryPeekMsgIO q
          let info = QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
          pure (corrId, entId, INFO info)
          where
@@ -1507,7 +1540,7 @@ withLog action = do
  env <- ask
  liftIO . mapM_ action $ storeLog (env :: Env)

-timed :: T.Text -> RecipientId -> M a -> M a
+timed :: MonadIO m => T.Text -> RecipientId -> m a -> m a
 timed name (EntityId qId) a = do
  t <- liftIO getSystemTime
  r <- a
@@ -1571,7 +1604,7 @@ restoreServerMessages =
            s = LB.toStrict s'
            addToMsgQueue rId msg = do
              q <- liftIO $ getMsgQueue ms rId quota
-              (isExpired, logFull) <- atomically $ case msg of
+              (isExpired, logFull) <- liftIO $ case msg of
                Message {msgTs}
                  | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg q msg
                  | otherwise -> pure (True, False)
@@ -12,7 +12,6 @@ import Control.Logger.Simple
 import Control.Monad
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
-import Data.IORef
 import Data.Int (Int64)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IM
@@ -137,12 +136,16 @@ data Env = Env
 type Subscribed = Bool

 data Server = Server
-  { subscribedQ :: TQueue (RecipientId, Client, Subscribed),
-    subscribers :: TMap RecipientId Client,
-    ntfSubscribedQ :: TQueue (NotifierId, Client, Subscribed),
-    notifiers :: TMap NotifierId Client,
-    pendingENDs :: IORef (IntMap (NonEmpty RecipientId)),
-    pendingNtfENDs :: IORef (IntMap (NonEmpty NotifierId)),
+  { subscribedQ :: TQueue (RecipientId, ClientId),
+    deletedQ :: TQueue (RecipientId, ClientId),
+    subscribers :: TMap RecipientId (TVar Client),
+    ntfSubscribedQ :: TQueue (NotifierId, ClientId),
+    ntfDeletedQ :: TQueue (NotifierId, ClientId),
+    notifiers :: TMap NotifierId (TVar Client),
+    pendingENDs :: TVar (IntMap (NonEmpty RecipientId)),
+    pendingDELDs :: TVar (IntMap (NonEmpty RecipientId)),
+    pendingNtfENDs :: TVar (IntMap (NonEmpty NotifierId)),
+    pendingNtfDELDs :: TVar (IntMap (NonEmpty NotifierId)),
    savingLock :: Lock
  }

@@ -182,13 +185,17 @@ data Sub = Sub
 newServer :: IO Server
 newServer = do
  subscribedQ <- newTQueueIO
+  deletedQ <- newTQueueIO
  subscribers <- TM.emptyIO
  ntfSubscribedQ <- newTQueueIO
+  ntfDeletedQ <- newTQueueIO
  notifiers <- TM.emptyIO
-  pendingENDs <- newIORef IM.empty
-  pendingNtfENDs <- newIORef IM.empty
+  pendingENDs <- newTVarIO IM.empty
+  pendingDELDs <- newTVarIO IM.empty
+  pendingNtfENDs <- newTVarIO IM.empty
+  pendingNtfDELDs <- newTVarIO IM.empty
  savingLock <- atomically createLock
-  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, pendingENDs, pendingNtfENDs, savingLock}
+  return Server {subscribedQ, deletedQ, subscribers, ntfSubscribedQ, ntfDeletedQ, notifiers, pendingENDs, pendingDELDs, pendingNtfENDs, pendingNtfDELDs, savingLock}

 newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
 newClient clientId qSize thVersion sessionId createdAt = do
@@ -29,7 +29,7 @@ import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
 import Simplex.Messaging.Agent.Protocol (connReqUriP')
-import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
+import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -307,7 +307,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                            defaultNetworkConfig
                              { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini,
                                socksMode = maybe SMOnion (either error id) $! strDecodeIni "PROXY" "socks_mode" ini,
-                                hostMode = either (const HMPublic) textToHostMode $ lookupValue "PROXY" "host_mode" ini,
+                                hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "PROXY" "host_mode" ini,
                                requiredHostMode = fromMaybe False $ iniOnOff "PROXY" "required_host_mode" ini
                              }
                        },
@@ -318,11 +318,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
              serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini,
              information = serverPublicInfo ini
            }
-        textToHostMode :: Text -> HostMode
-        textToHostMode = \case
-          "public" -> HMPublic
-          "onion" -> HMOnionViaSocks
-          s -> error . T.unpack $ "Invalid host_mode: " <> s
        textToOwnServers :: Text -> [ByteString]
        textToOwnServers = map encodeUtf8 . T.words

@@ -16,7 +16,7 @@ module Simplex.Messaging.Server.MsgStore.STM
    delMsgQueueSize,
    writeMsg,
    tryPeekMsg,
-    peekMsg,
+    tryPeekMsgIO,
    tryDelMsg,
    tryDelPeekMsg,
    deleteExpiredMsgs,
@@ -61,14 +61,14 @@ getMsgQueue st rId quota = TM.lookupIO rId st >>= maybe (atomically maybeNewQ) p
      TM.insert rId q st
      pure q

-delMsgQueue :: STMMsgStore -> RecipientId -> STM ()
-delMsgQueue st rId = TM.delete rId st
+delMsgQueue :: STMMsgStore -> RecipientId -> IO ()
+delMsgQueue st rId = atomically $ TM.delete rId st

-delMsgQueueSize :: STMMsgStore -> RecipientId -> STM Int
-delMsgQueueSize st rId = TM.lookupDelete rId st >>= maybe (pure 0) (\MsgQueue {size} -> readTVar size)
+delMsgQueueSize :: STMMsgStore -> RecipientId -> IO Int
+delMsgQueueSize st rId = atomically (TM.lookupDelete rId st) >>= maybe (pure 0) (\MsgQueue {size} -> readTVarIO size)

-writeMsg :: MsgQueue -> Message -> STM (Maybe (Message, Bool))
-writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = do
+writeMsg :: MsgQueue -> Message -> IO (Maybe (Message, Bool))
+writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = atomically $ do
  canWrt <- readTVar canWrite
  empty <- isEmptyTQueue q
  if canWrt || empty
@@ -83,43 +83,44 @@ writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = 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 #-}

-peekMsg :: MsgQueue -> STM Message
-peekMsg = peekTQueue . msgQueue
-{-# INLINE peekMsg #-}
-
-tryDelMsg :: MsgQueue -> MsgId -> STM (Maybe Message)
-tryDelMsg mq msgId' =
+tryDelMsg :: MsgQueue -> MsgId -> IO (Maybe Message)
+tryDelMsg mq msgId' = atomically $
  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 -> STM (Maybe Message, Maybe Message)
-tryDelPeekMsg mq msgId' =
+tryDelPeekMsg :: MsgQueue -> MsgId -> IO (Maybe Message, Maybe Message)
+tryDelPeekMsg mq msgId' = atomically $
  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 -> STM Int
-deleteExpiredMsgs mq old = loop 0
+deleteExpiredMsgs :: MsgQueue -> Int64 -> IO Int
+deleteExpiredMsgs mq old = atomically $ 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 ()
@@ -1,10 +1,13 @@
 {-# 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

@@ -16,7 +19,8 @@ data QueueRec = QueueRec
    senderKey :: !(Maybe SndPublicAuthKey),
    sndSecure :: !SenderCanSecure,
    notifier :: !(Maybe NtfCreds),
-    status :: !ServerQueueStatus
+    status :: !ServerQueueStatus,
+    updatedAt :: !(Maybe RoundedSystemTime)
  }
  deriving (Show)

@@ -34,3 +38,16 @@ 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
@@ -19,6 +19,7 @@ module Simplex.Messaging.Server.QueueStore.STM
    addQueueNotifier,
    deleteQueueNotifier,
    suspendQueue,
+    updateQueueTime,
    deleteQueue,
  )
 where
@@ -45,8 +46,8 @@ newQueueStore = do
  notifiers <- TM.emptyIO
  pure QueueStore {queues, senders, notifiers}

-addQueue :: QueueStore -> QueueRec -> STM (Either ErrorType ())
-addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId = sId} = do
+addQueue :: QueueStore -> QueueRec -> IO (Either ErrorType ())
+addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId = sId} = atomically $ do
  ifM hasId (pure $ Left DUPLICATE_) $ do
    qVar <- newTVar q
    TM.insert rId qVar queues
@@ -55,48 +56,55 @@ 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 -> STM (Either ErrorType QueueRec)
+getQueue :: DirectParty p => QueueStore -> SParty p -> QueueId -> IO (Either ErrorType QueueRec)
 getQueue QueueStore {queues, senders, notifiers} party qId =
-  toResult <$> (mapM readTVar =<< getVar)
+  toResult <$> (mapM readTVarIO =<< getVar)
  where
    getVar = case party of
-      SRecipient -> TM.lookup qId queues
-      SSender -> TM.lookup qId senders $>>= (`TM.lookup` queues)
-      SNotifier -> TM.lookup qId notifiers $>>= (`TM.lookup` queues)
+      SRecipient -> TM.lookupIO qId queues
+      SSender -> TM.lookupIO qId senders $>>= (`TM.lookupIO` queues)
+      SNotifier -> TM.lookupIO qId notifiers $>>= (`TM.lookupIO` queues)

-secureQueue :: QueueStore -> RecipientId -> SndPublicAuthKey -> STM (Either ErrorType QueueRec)
-secureQueue QueueStore {queues} rId sKey =
-  withQueue rId queues $ \qVar ->
+secureQueue :: QueueStore -> RecipientId -> SndPublicAuthKey -> IO (Either ErrorType QueueRec)
+secureQueue QueueStore {queues} rId sKey = toResult <$> do
+  TM.lookupIO rId queues $>>= \qVar -> atomically $ 
    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 -> STM (Either ErrorType QueueRec)
+addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
 addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = do
-  ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $
-    withQueue rId queues $ \qVar -> do
+  TM.lookupIO rId queues >>= \case
+    Just qVar -> atomically $ ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $ do
      q <- readTVar qVar
-      forM_ (notifier q) $ (`TM.delete` notifiers) . notifierId
-      writeTVar qVar $! q {notifier = Just ntfCreds}
+      nId_ <- forM (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers $> notifierId
+      let !q' = q {notifier = Just ntfCreds}
+      writeTVar qVar q'
      TM.insert nId rId notifiers
-      pure $ Just q
+      pure $ Right nId_
+    Nothing -> pure $ Left AUTH

-deleteQueueNotifier :: QueueStore -> RecipientId -> STM (Either ErrorType ())
+deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType (Maybe NotifierId))
 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 ()
+    forM (notifier q) $ \NtfCreds {notifierId} -> do
+      TM.delete notifierId notifiers
+      writeTVar qVar $! q {notifier = Nothing}
+      pure notifierId

-suspendQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ())
+suspendQueue :: QueueStore -> RecipientId -> IO (Either ErrorType ())
 suspendQueue QueueStore {queues} rId =
-  withQueue rId queues $ \qVar -> modifyTVar' qVar (\q -> q {status = QueueOff}) $> Just ()
+  withQueue rId queues (`modifyTVar'` \q -> q {status = QueueOff})

-deleteQueue :: QueueStore -> RecipientId -> STM (Either ErrorType QueueRec)
-deleteQueue QueueStore {queues, senders, notifiers} rId = do
+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
  TM.lookupDelete rId queues >>= \case
    Just qVar ->
      readTVar qVar >>= \q -> do
@@ -108,5 +116,5 @@ deleteQueue QueueStore {queues, senders, notifiers} rId = do
 toResult :: Maybe a -> Either ErrorType a
 toResult = maybe (Left AUTH) Right

-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
+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
@@ -10,8 +10,12 @@ 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)
@@ -19,7 +23,7 @@ import Data.Time.Calendar.OrdinalDate (mondayStartWeek)
 import Data.Time.Clock (UTCTime (..))
 import GHC.IORef (atomicSwapIORef)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (RecipientId)
+import Simplex.Messaging.Protocol (EntityId (..))
 import Simplex.Messaging.Util (atomicModifyIORef'_, unlessM)

 data ServerStats = ServerStats
@@ -57,11 +61,11 @@ data ServerStats = ServerStats
    msgGetDuplicate :: IORef Int,
    msgGetProhibited :: IORef Int,
    msgExpired :: IORef Int,
-    activeQueues :: PeriodStats RecipientId,
-    -- subscribedQueues :: PeriodStats RecipientId, -- this stat uses too much memory
+    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 RecipientId,
+    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
@@ -108,10 +112,10 @@ data ServerStatsData = ServerStatsData
    _msgGetDuplicate :: Int,
    _msgGetProhibited :: Int,
    _msgExpired :: Int,
-    _activeQueues :: PeriodStatsData RecipientId,
+    _activeQueues :: PeriodStatsData,
    _msgSentNtf :: Int,
    _msgRecvNtf :: Int,
-    _activeQueuesNtf :: PeriodStatsData RecipientId,
+    _activeQueuesNtf :: PeriodStatsData,
    _msgNtfs :: Int,
    _msgNtfNoSub :: Int,
    _msgNtfLost :: Int,
@@ -483,7 +487,7 @@ instance StrEncoding ServerStatsData where
          pure PeriodStatsData {_day, _week, _month}
    _subscribedQueues <-
      optional ("subscribedQueues:" <* A.endOfLine) >>= \case
-        Just _ -> newPeriodStatsData <$ (strP @(PeriodStatsData RecipientId) <* optional A.endOfLine)
+        Just _ -> newPeriodStatsData <$ (strP @PeriodStatsData <* optional A.endOfLine)
        _ -> pure newPeriodStatsData
    _activeQueuesNtf <-
      optional ("activeQueuesNtf:" <* A.endOfLine) >>= \case
@@ -552,30 +556,30 @@ instance StrEncoding ServerStatsData where
          Just _ -> strP <* optional A.endOfLine
          _ -> pure newProxyStatsData

-data PeriodStats a = PeriodStats
-  { day :: IORef (Set a),
-    week :: IORef (Set a),
-    month :: IORef (Set a)
+data PeriodStats = PeriodStats
+  { day :: IORef IntSet,
+    week :: IORef IntSet,
+    month :: IORef IntSet
  }

-newPeriodStats :: IO (PeriodStats a)
+newPeriodStats :: IO PeriodStats
 newPeriodStats = do
-  day <- newIORef S.empty
-  week <- newIORef S.empty
-  month <- newIORef S.empty
+  day <- newIORef IS.empty
+  week <- newIORef IS.empty
+  month <- newIORef IS.empty
  pure PeriodStats {day, week, month}

-data PeriodStatsData a = PeriodStatsData
-  { _day :: Set a,
-    _week :: Set a,
-    _month :: Set a
+data PeriodStatsData = PeriodStatsData
+  { _day :: IntSet,
+    _week :: IntSet,
+    _month :: IntSet
  }
  deriving (Show)

-newPeriodStatsData :: PeriodStatsData a
-newPeriodStatsData = PeriodStatsData {_day = S.empty, _week = S.empty, _month = S.empty}
+newPeriodStatsData :: PeriodStatsData
+newPeriodStatsData = PeriodStatsData {_day = IS.empty, _week = IS.empty, _month = IS.empty}

-getPeriodStatsData :: PeriodStats a -> IO (PeriodStatsData a)
+getPeriodStatsData :: PeriodStats -> IO PeriodStatsData
 getPeriodStatsData s = do
  _day <- readIORef $ day s
  _week <- readIORef $ week s
@@ -583,20 +587,22 @@ getPeriodStatsData s = do
  pure PeriodStatsData {_day, _week, _month}

 -- this function is not thread safe, it is used on server start only
-setPeriodStats :: PeriodStats a -> PeriodStatsData a -> IO ()
+setPeriodStats :: PeriodStats -> PeriodStatsData -> IO ()
 setPeriodStats s d = do
  writeIORef (day s) $! _day d
  writeIORef (week s) $! _week d
  writeIORef (month s) $! _month d

-instance (Ord a, StrEncoding a) => StrEncoding (PeriodStatsData a) where
+instance StrEncoding PeriodStatsData where
  strEncode PeriodStatsData {_day, _week, _month} =
-    "day=" <> strEncode _day <> "\nweek=" <> strEncode _week <> "\nmonth=" <> strEncode _month
+    "dayHashes=" <> strEncode _day <> "\nweekHashes=" <> strEncode _week <> "\nmonthHashes=" <> strEncode _month
  strP = do
-    _day <- "day=" *> strP <* A.endOfLine
-    _week <- "week=" *> strP <* A.endOfLine
-    _month <- "month=" *> strP
+    _day <- ("day=" *> bsSetP <|> "dayHashes=" *> strP) <* A.endOfLine
+    _week <- ("week=" *> bsSetP <|> "weekHashes=" *> strP) <* A.endOfLine
+    _month <- "month=" *> bsSetP <|> "monthHashes=" *> 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,
@@ -604,7 +610,7 @@ data PeriodStatCounts = PeriodStatCounts
    monthCount :: String
  }

-periodStatCounts :: forall a. PeriodStats a -> UTCTime -> IO PeriodStatCounts
+periodStatCounts :: PeriodStats -> UTCTime -> IO PeriodStatCounts
 periodStatCounts ps ts = do
  let d = utctDay ts
      (_, wDay) = mondayStartWeek d
@@ -614,17 +620,18 @@ periodStatCounts ps ts = do
  monthCount <- periodCount mDay $ month ps
  pure PeriodStatCounts {dayCount, weekCount, monthCount}
  where
-    periodCount :: Int -> IORef (Set a) -> IO String
-    periodCount 1 ref = show . S.size <$> atomicSwapIORef ref S.empty
+    periodCount :: Int -> IORef IntSet -> IO String
+    periodCount 1 ref = show . IS.size <$> atomicSwapIORef ref IS.empty
    periodCount _ _ = pure ""

-updatePeriodStats :: Ord a => PeriodStats a -> a -> IO ()
-updatePeriodStats ps pId = do
+updatePeriodStats :: PeriodStats -> EntityId -> IO ()
+updatePeriodStats ps (EntityId pId) = do
  updatePeriod $ day ps
  updatePeriod $ week ps
  updatePeriod $ month ps
  where
-    updatePeriod ref = unlessM (S.member pId <$> readIORef ref) $ atomicModifyIORef'_ ref $ S.insert pId
+    ph = hash pId
+    updatePeriod ref = unlessM (IS.member ph <$> readIORef ref) $ atomicModifyIORef'_ ref $ IS.insert ph

 data ProxyStats = ProxyStats
  { pRequests :: IORef Int,
@@ -20,12 +20,14 @@ 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 (($>))
@@ -33,7 +35,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 (NtfCreds (..), QueueRec (..), ServerQueueStatus (..))
+import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Util (ifM)
 import System.Directory (doesFileExist, renameFile)
@@ -52,9 +54,20 @@ data StoreLogRecord
  | SuspendQueue QueueId
  | DeleteQueue QueueId
  | DeleteNotifier QueueId
+  | UpdateTime QueueId RoundedSystemTime
+  deriving (Show)
+
+data SLRTag
+  = CreateQueue_
+  | SecureQueue_
+  | AddNotifier_
+  | SuspendQueue_
+  | DeleteQueue_
+  | DeleteNotifier_
+  | UpdateTime_

 instance StrEncoding QueueRec where
-  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier} =
+  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, updatedAt} =
    B.unwords
      [ "rid=" <> strEncode recipientId,
        "rk=" <> strEncode recipientKey,
@@ -62,10 +75,13 @@ instance StrEncoding QueueRec where
        "sid=" <> strEncode senderId,
        "sk=" <> strEncode senderKey
      ]
-      <> if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
+      <> sndSecureStr
      <> maybe "" notifierStr notifier
+      <> maybe "" updatedAtStr updatedAt
    where
+      sndSecureStr = if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
      notifierStr ntfCreds = " notifier=" <> strEncode ntfCreds
+      updatedAtStr t = " updated_at=" <> strEncode t

  strP = do
    recipientId <- "rid=" *> strP_
@@ -75,24 +91,49 @@ instance StrEncoding QueueRec where
    senderKey <- "sk=" *> strP
    sndSecure <- (" sndSecure=" *> strP) <|> pure False
    notifier <- optional $ " notifier=" *> strP
-    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status = QueueActive}
+    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

 instance StrEncoding StoreLogRecord where
  strEncode = \case
-    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)
+    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)

  strP =
-    "CREATE " *> (CreateQueue <$> strP)
-      <|> "SECURE " *> (SecureQueue <$> strP_ <*> strP)
-      <|> "NOTIFIER " *> (AddNotifier <$> strP_ <*> strP)
-      <|> "SUSPEND " *> (SuspendQueue <$> strP)
-      <|> "DELETE " *> (DeleteQueue <$> strP)
-      <|> "NDELETE " *> (DeleteNotifier <$> 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

 openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
 openWriteStoreLog f = do
@@ -138,6 +179,9 @@ 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)
@@ -169,5 +213,6 @@ 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
@@ -47,6 +47,7 @@ module Simplex.Messaging.Transport
    authCmdsSMPVersion,
    sendingProxySMPVersion,
    sndAuthKeySMPVersion,
+    deletedEventSMPVersion,
    simplexMQVersion,
    smpBlockSize,
    TransportConfig (..),
@@ -130,6 +131,9 @@ 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 - SMP proxy for sender commands
+-- 9 - faster handshake: SKEY command for sender to secure queue
+-- 10 - DELD event to subscriber when queue is deleted via another connnection

 data SMPVersion

@@ -160,14 +164,17 @@ sendingProxySMPVersion = VersionSMP 8
 sndAuthKeySMPVersion :: VersionSMP
 sndAuthKeySMPVersion = VersionSMP 9

+deletedEventSMPVersion :: VersionSMP
+deletedEventSMPVersion = VersionSMP 10
+
 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 9
+currentClientSMPRelayVersion = VersionSMP 10

 legacyServerSMPRelayVersion :: VersionSMP
 legacyServerSMPRelayVersion = VersionSMP 6

 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 9
+currentServerSMPRelayVersion = VersionSMP 10

 -- Max SMP protocol version to be used in e2e encrypted
 -- connection between client and server, as defined by SMP proxy.
@@ -13,9 +13,13 @@ module Simplex.Messaging.Transport.Client
    defaultSMPPort,
    defaultTcpConnectTimeout,
    defaultTransportClientConfig,
+    defaultSocksProxyWithAuth,
    defaultSocksProxy,
+    defaultSocksHost,
    TransportClientConfig (..),
-    SocksProxy,
+    SocksProxy (..),
+    SocksProxyWithAuth (..),
+    SocksAuth (..),
    TransportHost (..),
    TransportHosts (..),
    TransportHosts_ (..),
@@ -23,7 +27,7 @@ module Simplex.Messaging.Transport.Client
  )
 where

-import Control.Applicative (optional)
+import Control.Applicative (optional, (<|>))
 import Control.Logger.Simple (logError)
 import Control.Monad (when)
 import Data.Aeson (FromJSON (..), ToJSON (..))
@@ -79,7 +83,7 @@ instance StrEncoding TransportHost where
  strP =
    A.choice
      [ THIPv4 <$> ((,,,) <$> ipNum <*> ipNum <*> ipNum <*> A.decimal),
-        maybe (Left "bad IPv6") (Right . THIPv6 . fromIPv6w) . readMaybe . B.unpack <$?> A.takeWhile1 (\c -> isHexDigit c || c == ':'),
+        maybe (Left "bad IPv6") (Right . THIPv6 . fromIPv6w) . readMaybe . B.unpack <$?> ipv6StrP,
        THOnionHost <$> ((<>) <$> A.takeWhile (\c -> isAsciiLower c || isDigit c) <*> A.string ".onion"),
        THDomainName . B.unpack <$> (notOnion <$?> A.takeWhile1 (A.notInClass ":#,;/ \n\r\t"))
      ]
@@ -87,6 +91,9 @@ instance StrEncoding TransportHost where
      ipNum = validIP <$?> (A.decimal <* A.char '.')
      validIP :: Int -> Either String Word8
      validIP n = if 0 <= n && n <= 255 then Right $ fromIntegral n else Left "invalid IP address"
+      ipv6StrP =
+        A.char '[' *> A.takeWhile1 (/= ']') <* A.char ']'
+          <|> A.takeWhile1 (\c -> isHexDigit c || c == ':')
      notOnion s = if ".onion" `B.isSuffixOf` s then Left "invalid onion host" else Right s

 instance ToJSON TransportHost where
@@ -134,16 +141,16 @@ clientTransportConfig TransportClientConfig {logTLSErrors} =
  TransportConfig {logTLSErrors, transportTimeout = Nothing}

 -- | Connect to passed TCP host:port and pass handle to the client.
-runTransportClient :: Transport c => TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
+runTransportClient :: Transport c => TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
 runTransportClient = runTLSTransportClient supportedParameters Nothing

-runTLSTransportClient :: Transport c => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
-runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} proxyUsername host port keyHash client = do
+runTLSTransportClient :: Transport c => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
+runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} socksCreds host port keyHash client = do
  serverCert <- newEmptyTMVarIO
  let hostName = B.unpack $ strEncode host
      clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash clientCredentials alpn serverCert
      connectTCP = case socksProxy of
-        Just proxy -> connectSocksClient proxy proxyUsername (hostAddr host)
+        Just proxy -> connectSocksClient proxy socksCreds (hostAddr host)
        _ -> connectTCPClient hostName
  c <- do
    sock <- connectTCP port
@@ -191,40 +198,70 @@ connectTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
 defaultSMPPort :: PortNumber
 defaultSMPPort = 5223

-connectSocksClient :: SocksProxy -> Maybe ByteString -> SocksHostAddress -> ServiceName -> IO Socket
-connectSocksClient (SocksProxy addr) proxyUsername hostAddr _port = do
+connectSocksClient :: SocksProxy -> Maybe SocksCredentials -> SocksHostAddress -> ServiceName -> IO Socket
+connectSocksClient (SocksProxy addr) socksCreds hostAddr _port = do
  let port = if null _port then defaultSMPPort else fromMaybe defaultSMPPort $ readMaybe _port
-  fst <$> case proxyUsername of
-    Just username -> socksConnectAuth (defaultSocksConf addr) (SocksAddress hostAddr port) (SocksCredentials username "")
+  fst <$> case socksCreds of
+    Just creds -> socksConnectAuth (defaultSocksConf addr) (SocksAddress hostAddr port) creds
    _ -> socksConnect (defaultSocksConf addr) (SocksAddress hostAddr port)

-defaultSocksHost :: HostAddress
-defaultSocksHost = tupleToHostAddress (127, 0, 0, 1)
+defaultSocksHost :: (Word8, Word8, Word8, Word8)
+defaultSocksHost = (127, 0, 0, 1)
+
+defaultSocksProxyWithAuth :: SocksProxyWithAuth
+defaultSocksProxyWithAuth = SocksProxyWithAuth SocksIsolateByAuth defaultSocksProxy

 defaultSocksProxy :: SocksProxy
-defaultSocksProxy = SocksProxy $ SockAddrInet 9050 defaultSocksHost
+defaultSocksProxy = SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress defaultSocksHost

 newtype SocksProxy = SocksProxy SockAddr
  deriving (Eq)

+data SocksProxyWithAuth = SocksProxyWithAuth SocksAuth SocksProxy
+  deriving (Eq, Show)
+
+data SocksAuth
+  = SocksAuthUsername {username :: ByteString, password :: ByteString}
+  | SocksAuthNull
+  | SocksIsolateByAuth -- this is default
+  deriving (Eq, Show)
+
 instance Show SocksProxy where show (SocksProxy addr) = show addr

 instance StrEncoding SocksProxy where
  strEncode = B.pack . show
  strP = do
-    host <- maybe defaultSocksHost tupleToHostAddress <$> optional ipv4P
+    host <- fromMaybe (THIPv4 defaultSocksHost) <$> optional strP
    port <- fromMaybe 9050 <$> optional (A.char ':' *> (fromInteger <$> A.decimal))
-    pure . SocksProxy $ SockAddrInet port host
+    SocksProxy <$> socksAddr port host
    where
-      ipv4P = (,,,) <$> ipNum <*> ipNum <*> ipNum <*> A.decimal
-      ipNum = A.decimal <* A.char '.'
+      socksAddr port = \case
+        THIPv4 addr -> pure $ SockAddrInet port $ tupleToHostAddress addr
+        THIPv6 addr -> pure $ SockAddrInet6 port 0 addr 0
+        _ -> fail "SOCKS5 host should be IPv4 or IPv6 address"          

-instance ToJSON SocksProxy where
+instance StrEncoding SocksProxyWithAuth where
+  strEncode (SocksProxyWithAuth auth proxy) = strEncode auth <> strEncode proxy
+  strP = SocksProxyWithAuth <$> strP <*> strP
+
+instance ToJSON SocksProxyWithAuth where
  toJSON = strToJSON
  toEncoding = strToJEncoding

-instance FromJSON SocksProxy where
-  parseJSON = strParseJSON "SocksProxy"
+instance FromJSON SocksProxyWithAuth where
+  parseJSON = strParseJSON "SocksProxyWithAuth"
+
+instance StrEncoding SocksAuth where
+  strEncode = \case
+    SocksAuthUsername {username, password} -> username <> ":" <> password <> "@"
+    SocksAuthNull -> "@"
+    SocksIsolateByAuth -> ""
+  strP = usernameP <|> (SocksAuthNull <$ A.char '@') <|> pure SocksIsolateByAuth
+    where
+      usernameP = do
+        username <- A.takeTill (== ':') <* A.char ':'
+        password <- A.takeTill (== '@') <* A.char '@'
+        pure SocksAuthUsername {username, password}

 mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe (X.CertificateChain, T.PrivKey) -> Maybe [ALPN] -> TMVar X.CertificateChain -> T.ClientParams
 mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ alpn_ serverCerts =
@@ -2,7 +2,6 @@

 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
@@ -11,7 +11,6 @@ import Control.Concurrent.Async
 import Control.Exception (IOException, try)
 import qualified Control.Exception as E
 import Control.Monad
-import Data.ByteString.Char8 (ByteString)
 import Data.Functor (($>))
 import Data.Time (UTCTime, getCurrentTime)
 import qualified Data.X509 as X
@@ -20,6 +19,7 @@ import Network.HPACK (BufferSize)
 import Network.HTTP2.Client (ClientConfig (..), Request, Response)
 import qualified Network.HTTP2.Client as H
 import Network.Socket (HostName, ServiceName)
+import Network.Socks5 (SocksCredentials)
 import qualified Network.TLS as T
 import Numeric.Natural (Natural)
 import qualified Simplex.Messaging.Crypto as C
@@ -91,10 +91,10 @@ data HTTP2ClientError = HCResponseTimeout | HCNetworkError | HCIOError IOExcepti
 getHTTP2Client :: HostName -> ServiceName -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
 getHTTP2Client host port = getVerifiedHTTP2Client Nothing (THDomainName host) port Nothing

-getVerifiedHTTP2Client :: Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
-getVerifiedHTTP2Client proxyUsername host port keyHash caStore config disconnected = getVerifiedHTTP2ClientWith config host port disconnected setup
+getVerifiedHTTP2Client :: Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
+getVerifiedHTTP2Client socksCreds host port keyHash caStore config disconnected = getVerifiedHTTP2ClientWith config host port disconnected setup
  where
-    setup = runHTTP2Client (suportedTLSParams config) caStore (transportConfig config) (bufferSize config) proxyUsername host port keyHash
+    setup = runHTTP2Client (suportedTLSParams config) caStore (transportConfig config) (bufferSize config) socksCreds host port keyHash

 attachHTTP2Client :: HTTP2ClientConfig -> TransportHost -> ServiceName -> IO () -> Int -> TLS -> IO (Either HTTP2ClientError HTTP2Client)
 attachHTTP2Client config host port disconnected bufferSize tls = getVerifiedHTTP2ClientWith config host port disconnected setup
@@ -178,11 +178,11 @@ sendRequestDirect HTTP2Client {client_ = HClient {config, disconnected}, sendReq
 http2RequestTimeout :: HTTP2ClientConfig -> Maybe Int -> Int
 http2RequestTimeout HTTP2ClientConfig {connTimeout} = maybe connTimeout (connTimeout +)

-runHTTP2Client :: forall a. T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> BufferSize -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (TLS -> H.Client a) -> IO a
-runHTTP2Client tlsParams caStore tcConfig bufferSize proxyUsername host port keyHash = runHTTP2ClientWith bufferSize host setup
+runHTTP2Client :: forall a. T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> BufferSize -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (TLS -> H.Client a) -> IO a
+runHTTP2Client tlsParams caStore tcConfig bufferSize socksCreds host port keyHash = runHTTP2ClientWith bufferSize host setup
  where
    setup :: (TLS -> IO a) -> IO a
-    setup = runTLSTransportClient tlsParams caStore tcConfig proxyUsername host port keyHash
+    setup = runTLSTransportClient tlsParams caStore tcConfig socksCreds host port keyHash

 runHTTP2ClientWith :: forall a. BufferSize -> TransportHost -> ((TLS -> IO a) -> IO a) -> (TLS -> H.Client a) -> IO a
 runHTTP2ClientWith bufferSize host setup client = setup $ \tls -> withHTTP2 bufferSize (run tls) (pure ()) tls
@@ -12,7 +12,7 @@ module Simplex.Messaging.Transport.Server
    newSocketState,
    runTransportServer,
    runTransportServerSocket,
-    runTCPServer,
+    runLocalTCPServer,
    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 port) (transportName (TProxy :: TProxy c))
+runTransportServerState ss started port = runTransportServerSocketState ss started (startTCPServer started Nothing 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
-runTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
-runTCPServer started port server = do
+runLocalTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
+runLocalTCPServer started port server = do
  ss <- newSocketState
-  runTCPServerSocket ss started (startTCPServer started port) server
+  runTCPServerSocket ss started (startTCPServer started (Just "127.0.0.1") 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 -> ServiceName -> IO Socket
-startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
+startTCPServer :: TMVar Bool -> Maybe HostName -> ServiceName -> IO Socket
+startTCPServer started host port = withSocketsDo $ resolve >>= open >>= setStarted
  where
    resolve =
      let hints = defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Stream}
-       in select <$> getAddrInfo (Just hints) Nothing (Just port)
+       in select <$> getAddrInfo (Just hints) host (Just port)
    select as = fromJust $ family AF_INET6 <|> family AF_INET
      where
        family f = find ((== f) . addrFamily) as
@@ -178,7 +178,7 @@ 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, ())
+atomicModifyIORef'_ r f = atomicModifyIORef' r (\v -> (f v, ()))

 encodeJSON :: ToJSON a => a -> Text
 encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
@@ -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 $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
+  bracketOnError (startTCPServer started Nothing $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
    ifM
      (atomically $ readTMVar started)
      (runServer started socket)
@@ -49,6 +49,7 @@ 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
@@ -66,6 +67,7 @@ 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 (..))
@@ -164,7 +166,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 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
+    it "prev servers; curr clients" $ runNtfTestCfg t 1 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
@@ -872,8 +874,8 @@ messageNotificationData :: HasCallStack => AgentClient -> TBQueue APNSMockReques
 messageNotificationData c apnsQ = do
  (nonce, message) <- messageNotification apnsQ
  NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
-  Right pnMsgData <- liftEither . first INTERNAL $ Right . strDecode =<< first show (C.cbDecrypt dhSecret nonce message)
-  pure pnMsgData
+  Right pnMsgs <- liftEither . first INTERNAL $ Right . parseAll pnMessagesP =<< first show (C.cbDecrypt dhSecret nonce message)
+  pure $ L.last pnMsgs

 noNotification :: TBQueue APNSMockRequest -> ExceptT AgentErrorType IO ()
 noNotification apnsQ = do
@@ -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` (internalId, internalSndId, expectedPrevHash)
+    `shouldReturn` Right (internalId, internalSndId, expectedPrevHash)
  createSndMsg db connId sndMsgData
    `shouldReturn` ()
  createSndMsgDelivery db connId sq internalId
@@ -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}, _)) <- getNextRcvChunkToDownload db xftpServer1 86400
+    Right (Just (RcvFileChunk {rcvFileEntityId}, _, Nothing)) <- getNextRcvChunkToDownload db xftpServer1 86400
    rcvFileEntityId `shouldBe` fId2

 testGetNextRcvFileToDecrypt :: SQLiteStore -> Expectation
@@ -0,0 +1,127 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
+module CoreTests.SOCKSSettings where
+
+import Network.Socket (SockAddr (..), tupleToHostAddress)
+import Simplex.Messaging.Client
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (ErrorType)
+import Simplex.Messaging.Transport.Client
+import Test.Hspec
+
+socksSettingsTests :: Spec
+socksSettingsTests = do
+  describe "hostMode and requiredHostMode settings" testHostMode
+  describe "socksMode setting, independent of hostMode setting" testSocksMode
+  describe "socks proxy address encoding" testSocksProxyEncoding
+
+testPublicHost :: TransportHost
+testPublicHost = "smp.example.com"
+
+testOnionHost :: TransportHost
+testOnionHost = "abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrst.onion"
+
+testHostMode :: Spec
+testHostMode = do
+  describe "requiredHostMode = False (default)" $ do
+    it "without socks proxy, should choose onion host only with HMOnion" $ do
+      chooseTransportHost @ErrorType defaultNetworkConfig [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost
+      chooseHost HMOnionViaSocks Nothing [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost
+      chooseHost HMOnion Nothing [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMPublic Nothing [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost
+    it "with socks proxy, should choose onion host with HMOnionViaSocks (default) and HMOnion" $ do
+      chooseTransportHost @ErrorType defaultNetworkConfig {socksProxy = Just defaultSocksProxyWithAuth} [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMOnionViaSocks (Just defaultSocksProxyWithAuth) [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMOnion (Just defaultSocksProxyWithAuth) [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMPublic (Just defaultSocksProxyWithAuth) [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost
+    it "should choose any available host, if preferred not available" $ do
+      chooseHost HMOnionViaSocks Nothing [testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMOnion Nothing [testPublicHost] `shouldBe` Right testPublicHost
+      chooseHost HMPublic Nothing [testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMOnionViaSocks (Just defaultSocksProxyWithAuth) [testPublicHost] `shouldBe` Right testPublicHost
+      chooseHost HMOnion (Just defaultSocksProxyWithAuth) [testPublicHost] `shouldBe` Right testPublicHost
+      chooseHost HMPublic (Just defaultSocksProxyWithAuth) [testOnionHost] `shouldBe` Right testOnionHost
+  describe "requiredHostMode = True" $ do
+    it "should fail, if preferred host not available" $ do
+      testOnionHost `incompatible` (HMOnionViaSocks, Nothing)
+      testPublicHost `incompatible` (HMOnion, Nothing)
+      testOnionHost `incompatible` (HMPublic, Nothing)
+      testPublicHost `incompatible` (HMOnionViaSocks, Just defaultSocksProxyWithAuth)
+      testPublicHost `incompatible` (HMOnion, Just defaultSocksProxyWithAuth)
+      testOnionHost `incompatible` (HMPublic, Just defaultSocksProxyWithAuth)
+    it "should choose preferred host, if available" $ do
+      testPublicHost `compatible` (HMOnionViaSocks, Nothing)
+      testOnionHost `compatible` (HMOnion, Nothing)
+      testPublicHost `compatible` (HMPublic, Nothing)
+      testOnionHost `compatible` (HMOnionViaSocks, Just defaultSocksProxyWithAuth)
+      testOnionHost `compatible` (HMOnion, Just defaultSocksProxyWithAuth)
+      testPublicHost `compatible` (HMPublic, Just defaultSocksProxyWithAuth)
+  where
+    chooseHost = chooseHostCfg defaultNetworkConfig
+    host `incompatible` (hostMode, socksProxy) =
+      chooseHostCfg defaultNetworkConfig {requiredHostMode = True} hostMode socksProxy [host] `shouldBe` Left PCEIncompatibleHost
+    host `compatible` (hostMode, socksProxy) = do
+      chooseHostCfg defaultNetworkConfig {requiredHostMode = True} hostMode socksProxy [host] `shouldBe` Right host
+      chooseHostCfg defaultNetworkConfig {requiredHostMode = True} hostMode socksProxy [host, testPublicHost, testOnionHost] `shouldBe` Right host
+    chooseHostCfg cfg hostMode socksProxy =
+      chooseTransportHost @ErrorType cfg {hostMode, socksProxy}
+
+testSocksMode :: Spec
+testSocksMode = do
+  it "should not use SOCKS proxy if not specified" $ do
+    transportSocksCfg defaultNetworkConfig testPublicHost `shouldBe` Nothing
+    transportSocksCfg defaultNetworkConfig testOnionHost `shouldBe` Nothing
+    transportSocks Nothing SMAlways testPublicHost `shouldBe` Nothing
+    transportSocks Nothing SMAlways testOnionHost `shouldBe` Nothing
+    transportSocks Nothing SMOnion testPublicHost `shouldBe` Nothing
+    transportSocks Nothing SMOnion testOnionHost `shouldBe` Nothing
+  it "should always use SOCKS proxy if specified and (socksMode = SMAlways or (socksMode = SMOnion and onion host))" $ do
+    transportSocksCfg defaultNetworkConfig {socksProxy = Just defaultSocksProxyWithAuth} testPublicHost `shouldBe` Just defaultSocksProxy
+    transportSocksCfg defaultNetworkConfig {socksProxy = Just defaultSocksProxyWithAuth} testOnionHost `shouldBe` Just defaultSocksProxy
+    transportSocks (Just defaultSocksProxyWithAuth) SMAlways testPublicHost `shouldBe` Just defaultSocksProxy
+    transportSocks (Just defaultSocksProxyWithAuth) SMAlways testOnionHost `shouldBe` Just defaultSocksProxy
+    transportSocks (Just defaultSocksProxyWithAuth) SMOnion testPublicHost `shouldBe` Nothing
+    transportSocks (Just defaultSocksProxyWithAuth) SMOnion testOnionHost `shouldBe` Just defaultSocksProxy
+  where
+    transportSocks proxy socksMode = transportSocksCfg defaultNetworkConfig {socksProxy = proxy, socksMode}
+    transportSocksCfg cfg host =
+      let TransportClientConfig {socksProxy} = transportClientConfig cfg host
+       in socksProxy
+
+testSocksProxyEncoding :: Spec
+testSocksProxyEncoding = do
+  it "should decode SOCKS proxy with isolate-by-auth mode" $ do
+    let authIsolate proxy = Right $ SocksProxyWithAuth SocksIsolateByAuth proxy
+    strDecode "" `shouldBe` authIsolate defaultSocksProxy
+    strDecode ":9050" `shouldBe` authIsolate defaultSocksProxy
+    strDecode ":8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet 8080 $ tupleToHostAddress defaultSocksHost)
+    strDecode "127.0.0.1" `shouldBe` authIsolate defaultSocksProxy
+    strDecode "1.1.1.1" `shouldBe` authIsolate (SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress (1, 1, 1, 1))
+    strDecode "::1" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0)
+    strDecode "[fd12:3456:789a:1::1]" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+    strDecode "127.0.0.1:9050" `shouldBe` authIsolate defaultSocksProxy
+    strDecode "127.0.0.1:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet 8080 $ tupleToHostAddress defaultSocksHost)
+    strDecode "[::1]:9050" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0)
+    strDecode "[::1]:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 8080 0 (0, 0, 0, 1) 0)
+    strDecode "[fd12:3456:789a:1::1]:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+  it "should decode SOCKS proxy without credentials" $ do
+    let authNull proxy = Right $ SocksProxyWithAuth SocksAuthNull proxy
+    strDecode "@" `shouldBe` authNull defaultSocksProxy
+    strDecode "@:9050" `shouldBe` authNull defaultSocksProxy
+    strDecode "@127.0.0.1" `shouldBe` authNull defaultSocksProxy
+    strDecode "@1.1.1.1" `shouldBe` authNull (SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress (1, 1, 1, 1))
+    strDecode "@127.0.0.1:9050" `shouldBe` authNull defaultSocksProxy
+    strDecode "@[fd12:3456:789a:1::1]:8080" `shouldBe` authNull (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+  it "should decode SOCKS proxy with credentials" $ do
+    let authUser proxy = Right $ SocksProxyWithAuth SocksAuthUsername {username = "user", password = "pass"} proxy
+    strDecode "user:pass@" `shouldBe` authUser defaultSocksProxy
+    strDecode "user:pass@:9050" `shouldBe` authUser defaultSocksProxy
+    strDecode "user:[email protected]" `shouldBe` authUser defaultSocksProxy
+    strDecode "user:[email protected]:9050" `shouldBe` authUser defaultSocksProxy
+    strDecode "user:pass@fd12:3456:789a:1::1" `shouldBe` authUser (SocksProxy $ SockAddrInet6 9050 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+    strDecode "user:pass@[fd12:3456:789a:1::1]:8080" `shouldBe` authUser (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)
@@ -17,6 +17,7 @@ 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
@@ -35,7 +36,6 @@ 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
@@ -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 APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} =
-                parse strP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
+              Right pnMsgs1 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
+              APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} = L.last pnMsgs1
              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 APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} =
-                parse strP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
+              Right pnMsgs2 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
+              APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} = L.last pnMsgs2
          smpServer3 `shouldBe` srv
          notifierId3 `shouldBe` nId
          send3 APNSRespOk
@@ -25,7 +25,8 @@ import Data.Bifunctor (first)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.Set as S
+import Data.Hashable (hash)
+import qualified Data.IntSet as IS
 import Data.Type.Equality
 import GHC.Stack (withFrozenCallStack)
 import SMPClient
@@ -384,6 +385,10 @@ testSwitchSub (ATransport t) =
      Resp "bcda" _ ok3 <- signSendRecv rh2 rKey ("bcda", rId, ACK mId3)
      (ok3, OK) #== "accepts ACK from the 2nd TCP connection"

+      Resp "cdab" _ OK <- signSendRecv rh1 rKey ("cdab", rId, DEL)
+      Resp "" rId' DELD <- tGet1 rh2
+      (rId', rId) #== "connection deleted event delivered to subscribed client"
+
      1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh1 >>= \case
        Nothing -> return ()
        Just _ -> error "nothing else is delivered to the 1st TCP connection"
@@ -675,9 +680,9 @@ checkStats s qs sent received = do
  _msgSentNtf s `shouldBe` 0
  _msgRecvNtf s `shouldBe` 0
  let PeriodStatsData {_day, _week, _month} = _activeQueues s
-  S.toList _day `shouldBe` qs
-  S.toList _week `shouldBe` qs
-  S.toList _month `shouldBe` qs
+  IS.toList _day `shouldBe` map (hash . unEntityId) qs
+  IS.toList _week `shouldBe` map (hash . unEntityId) qs
+  IS.toList _month `shouldBe` map (hash . unEntityId) qs

 testRestoreExpireMessages :: ATransport -> Spec
 testRestoreExpireMessages at@(ATransport t) =
@@ -838,7 +843,8 @@ testMessageNotifications (ATransport t) =
      Resp "3a" _ OK <- signSendRecv rh rKey ("3a", rId, ACK mId1)
      Resp "" _ (NMSG _ _) <- tGet1 nh1
      Resp "4" _ OK <- signSendRecv nh2 nKey ("4", nId, NSUB)
-      Resp "" _ END <- tGet1 nh1
+      Resp "" nId2 END <- tGet1 nh1
+      nId2 `shouldBe` nId
      Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello again")
      Resp "" _ (Msg mId2 msg2) <- tGet1 rh
      Resp "5a" _ OK <- signSendRecv rh rKey ("5a", rId, ACK mId2)
@@ -848,6 +854,8 @@ testMessageNotifications (ATransport t) =
        Nothing -> pure ()
        Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection"
      Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, NDEL)
+      Resp "" nId3 DELD <- tGet1 nh2
+      nId3 `shouldBe` nId
      Resp "7" _ OK <- signSendRecv sh sKey ("7", sId, _SEND' "hello there")
      Resp "" _ (Msg mId3 msg3) <- tGet1 rh
      (dec mId3 msg3, Right "hello there") #== "delivered from queue again"
@@ -12,6 +12,7 @@ import CoreTests.CryptoFileTests
 import CoreTests.CryptoTests
 import CoreTests.EncodingTests
 import CoreTests.RetryIntervalTests
+import CoreTests.SOCKSSettings
 import CoreTests.TRcvQueuesTests
 import CoreTests.UtilTests
 import CoreTests.VersionRangeTests
@@ -52,6 +53,7 @@ main = do
          describe "Encryption tests" cryptoTests
          describe "Encrypted files tests" cryptoFileTests
          describe "Retry interval tests" retryIntervalTests
+          describe "SOCKS settings tests" socksSettingsTests
          describe "TRcvQueues tests" tRcvQueuesTests
          describe "Util tests" utilTests
        describe "SMP server via TLS" $ serverTests (transport @TLS)
@@ -429,7 +429,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
      ("", sfId', SFPROG _ _) <- sfGet sndr'
      liftIO $ sfId' `shouldBe` sfId

-  threadDelay 100000
+  threadDelay 200000

  withXFTPServerStoreLogOn $ \_ -> do
    -- send file - should continue uploading with server up
@@ -443,7 +443,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
      pure rfd1

    -- prefix path should be removed after sending file
-    threadDelay 100000
+    threadDelay 200000
    doesDirectoryExist prefixPath `shouldReturn` False
    doesFileExist encPath `shouldReturn` False
Author	SHA1	Message	Date
Evgeny Poberezkin	7488923fc3	6.0.6.0	2024-10-02 09:24:29 +01:00
Evgeny	cf559ee43f	smp server: fix notifiers lost when compacting store log (#1347 )	2024-10-02 09:24:04 +01:00
Evgeny Poberezkin	4268b90763	6.0.5.0	2024-09-24 12:34:46 +01:00
Evgeny	fa772af6c6	agent: support socks proxy without isolate-by-auth, with and without credentials (#1320 ) * agent: support socks proxy without isolate-by-auth, with and without credentials * add unit tests * make xftp use correct SOCKS credentials * rename * support ipv6 in brackets, test parsing * constant * textToHostMode * space	2024-09-15 21:36:31 +01:00
Evgeny	bec4e5e038	smp: reduce max message sizes (#1318 )	2024-09-14 17:34:29 +01:00
Evgeny Poberezkin	24ded9e5a0	Merge branch 'master' into stable	2024-09-11 19:03:29 +01:00
Evgeny Poberezkin	f5e666ae4f	6.0.4.0	2024-09-11 18:51:26 +01:00
Evgeny Poberezkin	62133ceb24	Revert "xrcp: use SHA3-256 in hybrid key agreement (#1302 )" This reverts commit `67d38090ed`.	2024-09-11 18:45:44 +01:00
Evgeny	3b50e1fb7d	ntf server: only use SOCKS proxy for servers without public address (#1314 )	2024-09-11 18:41:40 +01:00
Evgeny	7c25b3b1e0	smp protocol: send DELD when subscribed queue is deleted (#1312 ) * smp protocol: send DELD when subscribed queue is deleted * fix, test * refactor * send DELD event only if the client supports it (version 10); send END otherwise * fix test * notify on notifier rotation * increase test delays	2024-09-11 13:16:51 +01:00
Evgeny	a70bd02c67	xftp server: round down file creation time to 1 hour (#1310 )	2024-09-10 08:14:05 +01:00
Evgeny	990dcec348	smp server: add created/updated/used date to queues to manage expiration (#1306 ) * smp server: add created/updated/used date to queues to manage expiration, all: make Map updates strict in value * remove strict * remove time precision * diff * style * only update when time changed	2024-09-09 14:53:11 +01:00
Evgeny	75712641ee	rfc: stabilize iOS notifications (#1221 )	2024-09-09 17:07:32 +04:00
spaced4ndy	946e16339e	agent: process last notification from list (#1307 )	2024-09-09 16:42:14 +04:00
spaced4ndy	092ed088ca	ntf: support for multiple messages encoding (#1305 )	2024-09-09 16:03:17 +04:00
sh	7000431249	scripts/servers: update stopscript (#1286 ) * scripts/servers: update stopscript * Major refactoring * archive -> backups * simplify logic * sort files by timestamp	2024-09-09 10:19:17 +01:00
Evgeny	dab1980d79	xftp: report receive file error with redirected file ID, when redirect is present (#1304 ) * xftp: report receive file error with redirected file ID, when redirect is present * fix test	2024-09-09 08:08:16 +01:00
Evgeny	344a295845	agent: error when user record is not in database (#1303 )	2024-09-08 16:50:22 +01:00
Evgeny	67d38090ed	xrcp: use SHA3-256 in hybrid key agreement (#1302 )	2024-09-08 15:45:45 +01:00
Evgeny	a9e8d02593	server: bind control port server only to 127.0.0.1 for better security (in case of firewall misconfuguration) (#1280 )	2024-09-05 13:48:09 +01:00
Evgeny	d859f27999	ntf server: remove debug logging (#1284 )	2024-09-05 13:26:34 +01:00
Evgeny	e86338d555	smp server: fewer map updates on re-subscriptions (#1297 ) * smp server: fewer map updates on re-subscriptions * temp version * replace Client with ClientId in queues * version * version * comments * reduce threads when sending ENDs * revert version	2024-09-05 13:25:41 +01:00
Evgeny	137ebc1cad	servers: reduce memory used for period stats (#1298 )	2024-09-02 23:12:08 +01:00
Evgeny	d84a49b85a	smp server: split and reduce STM transactions (#1294 )	2024-09-02 17:06:31 +01:00
Evgeny	d5efe3406a	agent: fix race when sending a message to the deleted connection (#1296 )	2024-09-02 15:07:16 +01:00