Merge branch 'master' into ab/pclient-disconnected

transport: update PClient.connected on exit
2026-10-12 11:39:56 +00:00 · 2024-07-15 19:24:55 +01:00 · 2024-05-01 15:55:44 +03:00
62 changed files with 1262 additions and 2350 deletions
@@ -1,50 +1,3 @@
-# 6.0.2
-
-SMP agent:
- fix stuck connection commands when a server is not responding.
- store query errors, reduce slow query threshold to 1ms.
-
-Notification server:
- reduce PING interval to 1 minute.
- fix subscriptions disabled on race condition (only mark subscriptions with END status when received via the active connection).
-
-# 6.0.1
-
-SMP agent:
- support changing user of the new connection.
- do not start delivery workers when there are no messages to deliver.
- enable notifications for all connections.
- combine database transactions when subscribing.
-
-SMP server:
- safe compacting of store log.
- fix possible race when creating client that might lead to memory leak.
-
-Dependencies: upgrade tls to 1.9
-
-# 6.0.0
-
-Version 6.0.0.8
-
-Agent:
- enabled fast handshake support.
- batch-send multiple messages in each connection.
- resume subscriptions as soon as agent moves to foreground or as network connection resumes.
- "known" servers to determine whether to use SMP proxy.
- retry on SMP proxy NO_SESSION error.
- fixes to notification subscriptions.
- persistent server statistics.
- better concurrency.
-
-SMP server:
- reduce threads usage.
- additional statistics.
- improve disabling inactive clients.
- additional control port commands for monitoring.
-
-Notification server:
- support onion-only SMP servers.
-
 # 5.8.2

 Agent:
@@ -150,7 +150,7 @@ You can install and setup servers automatically using our script:

 ```sh
 curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh \
-&& if echo 'c90886104cd640b2ed64921dba80e90691db36788e8d6dcc13d8f33f92f0ea54 simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
+&& if echo 'b8cf2be103f21f9461d9a500bcd3db06ab7d01d68871b07f4bd245195cbead1d simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
 ```

 ### Build from source
@@ -3,7 +3,8 @@ set -eu

 # Links to scripts/configs
 bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
-remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
+bin_smp="$bin/smp-server-ubuntu-20_04-x86-64"
+bin_xftp="$bin/xftp-server-ubuntu-20_04-x86-64"

 scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
 scripts_systemd_smp="$scripts/smp-server.service"
@@ -25,8 +26,6 @@ path_conf_var="/var/opt"
 path_conf_smp="$path_conf_etc/simplex $path_conf_var/simplex"
 path_conf_xftp="$path_conf_etc/simplex-xftp $path_conf_var/simplex-xftp /srv/xftp"

-path_conf_info="$path_conf_etc/simplex-info"
-
 path_systemd="/etc/systemd/system"
 path_systemd_smp="$path_systemd/smp-server.service"
 path_systemd_xftp="$path_systemd/xftp-server.service"
@@ -66,13 +65,7 @@ ${GRN}4.${NC} Create systemd services:
 ${GRN}5.${NC} Install stopscript (systemd), update and uninstallation script:
    - all: ${YLW}${path_bin_update}${NC}, ${YLW}${path_bin_uninstall}${NC}, ${YLW}${path_bin_stopscript}${NC}

-Press:
-  - ${GRN}ENTER${NC} to continue installing both xftp and smp servers
-  - ${GRN}1${NC} to install only smp server
-  - ${GRN}2${NC} to install only xftp server
-  - ${RED}Ctrl+C${NC} to cancel installation
-  
-Selection: "
+Press ${GRN}ENTER${NC} to continue or ${RED}Ctrl+C${NC} to cancel installation"

 end="Installtion is complete!

@@ -83,64 +76,27 @@ Please checkout our server guides:
 To uninstall with full clean-up, simply run: ${YLW}sudo /usr/local/bin/simplex-servers-uninstall${NC}
 "

-os_test() {
- . /etc/os-release
-
- case "$VERSION_ID" in
-  20.04|22.04) : ;;
-  24.04) VERSION_ID='22.04' ;;
-  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
- esac
-
- version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
- arch="$(uname -p)"
-
- case "$arch" in
-  x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
-  *)  printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
- esac
-
- bin_smp="$bin/smp-server-ubuntu-${version}-${arch}"
- bin_xftp="$bin/xftp-server-ubuntu-${version}-${arch}"
-}
-
 setup_bins() {
- eval "bin=\$bin_${1}"
- eval "path=\$path_bin_${1}"
-
- curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path" && chmod +x "$path"
-
- unset bin path
+ curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_smp" && chmod +x "$path_bin_smp"
+ curl --proto '=https' --tlsv1.2 -sSf -L "$bin_xftp" -o "$path_bin_xftp" && chmod +x "$path_bin_xftp"
 }

 setup_users() {
- eval "user=\$user_${1}"
-
- useradd -M "$user" 2> /dev/null || true
-
- unset user
+ useradd -M "$user_smp" 2> /dev/null || true
+ useradd -M "$user_xftp" 2> /dev/null || true
 }

 setup_dirs() {
 # Unquoted varibles, so field splitting can occur
- eval "path_conf=\$path_conf_${1}"
- eval "user=\$user_${1}"
-
- mkdir -p $path_conf
- mkdir -p $path_conf_info
- printf "local_version_%s='%s'\n" "$1" "$remote_version" >> "$path_conf_info/release"
- chown -R "$user":"$user" $path_conf
-
- unset path_conf user
+ mkdir -p $path_conf_smp
+ chown "$user_smp":"$user_smp" $path_conf_smp
+ mkdir -p $path_conf_xftp
+ chown "$user_xftp":"$user_xftp" $path_conf_xftp
 }

 setup_systemd() {
- eval "scripts_systemd=\$scripts_systemd_${1}"
- eval "path_systemd=\$path_systemd_${1}"
-
- curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd" -o "$path_systemd"
-
- unset scripts_systemd path_systemd
+ curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_smp" -o "$path_systemd_smp"
+ curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_xftp" -o "$path_systemd_xftp"
 }

 setup_scripts() {
@@ -154,62 +110,32 @@ checks() {
  printf "This script is intended to be run with root privileges. Please re-run script using sudo."
  exit 1
 fi
- 
- os_test
-
- mkdir -p $path_conf_info  
 }

 main() {
 checks
 
- printf "%b\n%b" "${BLU}$logo${NC}" "$welcome"
+ printf "%b\n%b\n" "${BLU}$logo${NC}" "$welcome"
 read ans

- if [ "$ans" = '1' ]; then
-  setup='smp'
- elif [ "$ans" = '2' ]; then
-  setup='xftp'
- else
-  setup='smp xftp'
- fi
-
 printf "Installing binaries..."
- 
- for i in $setup; do
-  setup_bins "$i"
- done
- 
+ setup_bins
 printf "${GRN} Done!${NC}\n"

 printf "Creating users..."
-
- for i in $setup; do
-  setup_users "$i"
- done
-
+ setup_users
 printf "${GRN} Done!${NC}\n"
 
 printf "Creating directories..."
-
- for i in $setup; do
-  setup_dirs "$i"
- done
-
+ setup_dirs
 printf "${GRN} Done!${NC}\n"

 printf "Creating systemd services..."
-
- for i in $setup; do
-  setup_systemd "$i"
- done
-
+ setup_systemd
 printf "${GRN} Done!${NC}\n"

 printf "Installing stopscript, update and uninstallation script..."
-
 setup_scripts
-
 printf "${GRN} Done!${NC}\n"

 printf "%b" "$end"
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.2.0
+version: 6.0.0.1
 synopsis: SimpleXMQ message broker
 description: |
  This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -69,7 +69,7 @@ dependencies:
  - temporary == 1.3.*
  - time == 1.12.*
  - time-manager == 0.0.*
-  - tls >= 1.9.0 && < 1.10
+  - tls >= 1.7.0 && < 1.8
  - transformers == 0.6.*
  - unliftio == 0.2.*
  - unliftio-core == 0.2.*
@@ -13,15 +13,11 @@ fi
 printf "${RED}This action will permanently remove all configs, directories, binaries from Installation Script. Please backup any relevant configs if they are needed.${NC}\n\nPress ${GRN}ENTER${NC} to continue or ${RED}Ctrl+C${NC} to cancel installation"
 read ans

-systemctl disable --now smp-server 2>/dev/null || true
-systemctl revert smp-server 2>/dev/null || true
-systemctl disable --now xftp-server 2>/dev/null || true
-systemctl revert xftp-server 2>/dev/null || true
-systemctl daemon-reload 2>/dev/null || true
+systemctl stop smp-server
+systemctl stop xftp-server

-rm -rf /var/opt/simplex /etc/opt/simplex /etc/opt/simplex-info /var/opt/simplex-xftp /etc/opt/simplex-xftp /srv/xftp /etc/systemd/system/smp-server.service /etc/systemd/system/xftp-server.service /usr/local/bin/smp-server /usr/local/bin/xftp-server /usr/local/bin/simplex-servers-update /usr/local/bin/simplex-servers-uninstall /usr/local/bin/simplex-servers-stopscript
+rm -rf /var/opt/simplex /etc/opt/simplex /var/opt/simplex-xftp /etc/opt/simplex-xftp /srv/xftp /etc/systemd/system/smp-server.service /etc/systemd/system/xftp-server.service /usr/local/bin/smp-server /usr/local/bin/xftp-server /usr/local/bin/simplex-servers-update /usr/local/bin/simplex-servers-uninstall

-userdel smp 2>/dev/null || true
-userdel xftp 2>/dev/null || true
+userdel smp && userdel xftp

 printf "Uninstallation is complete! Thanks for trying out SimpleX!\n"
@@ -3,6 +3,8 @@ set -eu

 # Links to scripts/configs
 bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
+bin_smp="$bin/smp-server-ubuntu-20_04-x86-64"
+bin_xftp="$bin/xftp-server-ubuntu-20_04-x86-64"

 scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
 scripts_systemd_smp="$scripts/smp-server.service"
@@ -31,9 +33,6 @@ path_tmp_bin_stopscript="$path_tmp_bin/simplex-servers-stopscript"
 path_tmp_systemd_smp="$path_tmp_bin/smp-server.service"
 path_tmp_systemd_xftp="$path_tmp_bin/xftp-server.service"

-path_conf_etc='/etc/opt'
-path_conf_info='/etc/opt/simplex-info'
-
 GRN='\033[0;32m'
 BLU='\033[1;36m'
 YLW='\033[1;33m'
@@ -41,40 +40,8 @@ RED='\033[0;31m'
 NC='\033[0m'

 # Currently, XFTP default to v0.1.0, so it doesn't make sense to check its version
-
-os_test() {
- . /etc/os-release
-
- case "$VERSION_ID" in
-  20.04|22.04) : ;;
-  24.04) VERSION_ID='22.04' ;;
-  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
- esac
-
- version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
- arch="$(uname -p)"
-
- case "$arch" in
-  x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
-  *)  printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
- esac
-
- bin_smp="$bin/smp-server-ubuntu-${version}-${arch}"
- bin_xftp="$bin/xftp-server-ubuntu-${version}-${arch}"
-}
-
-installed_test() {
-  set +u
-  for i in $path_conf_etc/*; do
-    if [ -d "$i" ]; then
-      case "$i" in
-        *simplex) apps="smp $apps" ;;
-        *simplex-xftp) apps="xftp $apps" ;;
-      esac
-    fi
-  done
-  set -u
-}
+local_version="$($path_bin_smp -v | awk '{print $3}')"
+remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"

 update_scripts() {
  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_update" -o "$path_tmp_bin_update" && chmod +x "$path_tmp_bin_update"
@@ -89,7 +56,6 @@ update_scripts() {
    mv "$path_tmp_bin_uninstall" "$path_bin_uninstall"
    printf "${GRN}Done!${NC}\n"
  fi
-
  if diff -q "$path_bin_stopscript" "$path_tmp_bin_stopscript" > /dev/null 2>&1; then
    printf -- "- ${YLW}Stopscript script is up-to-date${NC}.\n"
    rm "$path_tmp_bin_stopscript"
@@ -98,7 +64,6 @@ update_scripts() {
    mv "$path_tmp_bin_stopscript" "$path_bin_stopscript"
    printf "${GRN}Done!${NC}\n"
  fi
-
  if diff -q "$path_bin_update" "$path_tmp_bin_update" > /dev/null 2>&1; then
    printf -- "- ${YLW}Update script is up-to-date${NC}.\n"
    rm "$path_tmp_bin_update"
@@ -106,84 +71,75 @@ update_scripts() {
    printf -- "- Updating update script..."
    mv "$path_tmp_bin_update" "$path_bin_update"
    printf "${GRN}Done!${NC}\n"
-    printf -- "- Re-executing Update script with latest updates..."
+    printf "Re-executing Update script with latest updates..."
    exec sh "$path_bin_update" "continue"
  fi
 }

 update_systemd() {
-  service="${1}-server"
-  eval "scripts_systemd=\$scripts_systemd_${1}"
-  eval "path_systemd=\$path_systemd_${1}"
-  eval "path_tmp_systemd=\$path_tmp_systemd_${1}"
-   
-  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd" -o "$path_tmp_systemd"
+  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_smp" -o "$path_tmp_systemd_smp"
+  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_xftp" -o "$path_tmp_systemd_xftp"

-  if diff -q "$path_systemd" "$path_tmp_systemd" > /dev/null 2>&1; then
-    printf -- "- ${YLW}%s service is up-to-date${NC}.\n" "$service"
-    rm "$path_tmp_systemd"
+  if diff -q "$path_systemd_smp" "$path_tmp_systemd_smp" > /dev/null 2>&1; then
+    printf -- "- ${YLW}smp-server service is up-to-date${NC}.\n"
+    rm "$path_tmp_systemd_smp"
  else
-    printf -- "- Updating %s service..." "$service"
-    mv "$path_tmp_systemd" "$path_systemd"
+    printf -- "- Updating smp-server service..."
+    mv "$path_tmp_systemd_smp" "$path_systemd_smp"
+    systemctl daemon-reload
+    printf "${GRN}Done!${NC}\n"
+  fi
+  if diff -q "$path_systemd_xftp" "$path_tmp_systemd_xftp" > /dev/null 2>&1; then
+    printf -- "- ${YLW}xftp-server service is up-to-date${NC}.\n"
+    rm "$path_tmp_systemd_xftp"
+  else
+    printf -- "- Updating xftp-server service..."
+    mv "$path_tmp_systemd_xftp" "$path_systemd_xftp"
    systemctl daemon-reload
    printf "${GRN}Done!${NC}\n"
  fi
-
-  unset service scripts_systemd path_systemd path_tmp_systemd
 }

 update_bins() {
-  service="${1}-server"
-  eval "bin=\$bin_${1}"
-  eval "path_bin=\$path_bin_${1}"
-
-  remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
-
-  set_ver() {
-    local_version='unset'
-    sed -i -- "s/local_version_${1}=.*/local_version_${1}='${remote_version}'/" "$path_conf_info/release"
-  }
-
-  if [ -f "$path_conf_info/release" ]; then
-    . "$path_conf_info/release" 2>/dev/null
-
-    set +u
-    eval "local_version=\$local_version_${1}"
-    set -u
-
-    if [ -z "${local_version}" ]; then
-            set_ver "$1"
-    fi
-  else
-    printf 'local_version_xftp=\nlocal_version_smp=\n' > "$path_conf_info/release"
-    set_ver "$1"
-  fi
-
  if [ "$local_version" != "$remote_version" ]; then
-    if systemctl is-active --quiet "$service"; then
-      printf -- "- Stopping %s service..." "$service"
-      systemctl stop "$service"
+    if systemctl is-active --quiet smp-server; then
+      printf -- "- Stopping smp-server service..."
+      systemctl stop smp-server
      printf "${GRN}Done!${NC}\n"

-      printf -- "- Updating %s to %s..." "$service" "$remote_version"
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
+      printf -- "- Updating smp-server bin to %s..." "$remote_version"
+      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_smp" && chmod +x "$path_bin_smp"
      printf "${GRN}Done!${NC}\n"
      
-      printf -- "- Starting %s service..." "$service"
-      systemctl start "$service"
+      printf -- "- Starting smp-server service..."
+      systemctl start smp-server
      printf "${GRN}Done!${NC}\n"
    else
-      printf -- "- Updating %s to %s..." "$service" "$remote_version"
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
+      printf -- "- Updating smp-server bin..."
+      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_smp" && chmod +x "$path_bin_smp"
+      printf "${GRN}Done!${NC}\n"
+    fi
+
+    if systemctl is-active --quiet xftp-server; then
+      printf -- "- Stopping xftp-server service..."
+      systemctl stop xftp-server
+      printf "${GRN}Done!${NC}\n"
+
+      printf -- "- Updating xftp-server bin to %s..." "$remote_version"
+      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_xftp" -o "$path_bin_xftp" && chmod +x "$path_bin_xftp"
+      printf "${GRN}Done!${NC}\n"
+      
+      printf -- "- Starting xftp-server service..."
+      systemctl start xftp-server
+      printf "${GRN}Done!${NC}\n"
+    else
+      printf -- "- Updating xftp-server bin..."
+      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_xftp" && chmod +x "$path_bin_xftp"
      printf "${GRN}Done!${NC}\n"
    fi
  else
-    printf -- "- ${YLW}%s is up-to-date${NC}.\n" "$service"
+    printf -- "- ${YLW}smp-server and xftp-server binaries is up-to-date${NC}.\n"
  fi
-
-  set_ver "$1"
-
-  unset service bin path_bin local_version
 }

 checks() {
@@ -191,11 +147,6 @@ checks() {
    printf "This script is intended to be run with root privileges. Please re-run script using sudo.\n"
    exit 1
  fi
-
-  os_test
-  installed_test
-
-  mkdir -p $path_conf_info
 }

 main() {
@@ -212,14 +163,10 @@ main() {
  fi

  printf "Updating systemd services...\n"
-  for i in $apps; do
-    update_systemd "$i"
-  done
+  update_systemd
  
-  printf "Updating simplex servers...\n"
-  for i in $apps; do
-    update_bins "$i"
-  done
+  printf "Updating simplex server binaries...\n"
+  update_bins

  rm -rf "$path_tmp_bin"
 }
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack

 name:           simplexmq
-version:        6.0.2.0
+version:        6.0.0.1
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -258,7 +258,7 @@ library
    , temporary ==1.3.*
    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.9.0 && <1.10
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
@@ -333,7 +333,7 @@ executable ntf-server
    , temporary ==1.3.*
    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.9.0 && <1.10
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
@@ -412,7 +412,7 @@ executable smp-server
    , temporary ==1.3.*
    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.9.0 && <1.10
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
@@ -490,7 +490,7 @@ executable xftp
    , temporary ==1.3.*
    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.9.0 && <1.10
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
@@ -565,7 +565,7 @@ executable xftp-server
    , temporary ==1.3.*
    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.9.0 && <1.10
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
@@ -681,7 +681,7 @@ test-suite simplexmq-test
    , time ==1.12.*
    , time-manager ==0.0.*
    , timeit ==2.0.*
-    , tls >=1.9.0 && <1.10
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
@@ -12,7 +12,6 @@

 module Simplex.FileTransfer.Agent
  ( startXFTPWorkers,
-    startXFTPSndWorkers,
    closeXFTPAgent,
    toFSFilePath,
    -- Receiving files
@@ -43,7 +42,7 @@ import Data.Either (partitionEithers, rights)
 import Data.Int (Int64)
 import Data.List (foldl', partition, sortOn)
 import qualified Data.List.NonEmpty as L
-import Data.Map.Strict (Map)
+import Data.Map (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (mapMaybe)
 import qualified Data.Set as S
@@ -83,21 +82,13 @@ import UnliftIO.Directory
 import qualified UnliftIO.Exception as E

 startXFTPWorkers :: AgentClient -> Maybe FilePath -> AM ()
-startXFTPWorkers = startXFTPWorkers_ True
-{-# INLINE startXFTPWorkers #-}
-
-startXFTPSndWorkers :: AgentClient -> Maybe FilePath -> AM ()
-startXFTPSndWorkers = startXFTPWorkers_ False
-{-# INLINE startXFTPSndWorkers #-}
-
-startXFTPWorkers_ :: Bool -> AgentClient -> Maybe FilePath -> AM ()
-startXFTPWorkers_ allWorkers c workDir = do
+startXFTPWorkers c workDir = do
  wd <- asks $ xftpWorkDir . xftpAgent
  atomically $ writeTVar wd workDir
  cfg <- asks config
-  when allWorkers $ startRcvFiles cfg
+  startRcvFiles cfg
  startSndFiles cfg
-  when allWorkers $ startDelFiles cfg
+  startDelFiles cfg
  where
    startRcvFiles :: AgentConfig -> AM ()
    startRcvFiles AgentConfig {rcvFilesTTL} = do
@@ -184,7 +175,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
  cfg <- asks config
  forever $ do
    lift $ waitForWork doWork
-    liftIO $ assertAgentForeground c
+    atomically $ assertAgentForeground c
    runXFTPOperation cfg
  where
    runXFTPOperation :: AgentConfig -> AM ()
@@ -194,7 +185,6 @@ runXFTPRcvWorker c srv Worker {doWork} = do
        (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays) -> do
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
          withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
-            liftIO $ waitWhileSuspended c
            liftIO $ waitForUserNetwork c
            atomically $ incXFTPServerStat c userId srv downloadAttempts
            downloadFileChunk fc replica approvedRelays
@@ -205,7 +195,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
                when (serverHostError e) $ notify c rcvFileEntityId $ RFWARN e
                liftIO $ closeXFTPServerClient c userId server digest
                withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
-              liftIO $ assertAgentForeground c
+              atomically $ assertAgentForeground c
              loop
            retryDone e = do
              atomically . incXFTPServerStat c userId srv $ case e of
@@ -221,7 +211,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
          chunkSpec = XFTPRcvChunkSpec chunkPath chSize (unFileDigest digest)
          relChunkPath = fileTmpPath </> takeFileName chunkPath
      agentXFTPDownloadChunk c userId digest replica chunkSpec
-      liftIO $ waitUntilForeground c
+      atomically $ waitUntilForeground c
      (entityId, complete, progress) <- withStore c $ \db -> runExceptT $ do
        liftIO $ updateRcvFileChunkReceived db (rcvChunkReplicaId replica) rcvChunkId relChunkPath
        RcvFile {size = FileSize currentSize, chunks, redirect} <- ExceptT $ getRcvFile db rcvFileId
@@ -240,7 +230,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
      where
        ipAddressProtected' :: AM Bool
        ipAddressProtected' = do
-          cfg <- liftIO $ getFastNetworkConfig c
+          cfg <- liftIO $ getNetworkConfig' c
          pure $ ipAddressProtected cfg srv
        receivedSize :: [RcvFileChunk] -> Int64
        receivedSize = foldl' (\sz ch -> sz + receivedChunkSize ch) 0
@@ -273,7 +263,7 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
  cfg <- asks config
  forever $ do
    lift $ waitForWork doWork
-    liftIO $ assertAgentForeground c
+    atomically $ assertAgentForeground c
    runXFTPOperation cfg
  where
    runXFTPOperation :: AgentConfig -> AM ()
@@ -299,12 +289,12 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
        Nothing -> do
          notify c rcvFileEntityId $ RFDONE fsSavePath
          lift $ forM_ tmpPath (removePath <=< toFSFilePath)
-          liftIO $ waitUntilForeground c
+          atomically $ waitUntilForeground c
          withStore' c (`updateRcvFileComplete` rcvFileId)
        Just RcvFileRedirect {redirectFileInfo, redirectDbId} -> do
          let RedirectFileInfo {size = redirectSize, digest = redirectDigest} = redirectFileInfo
          lift $ forM_ tmpPath (removePath <=< toFSFilePath)
-          liftIO $ waitUntilForeground c
+          atomically $ waitUntilForeground c
          withStore' c (`updateRcvFileComplete` rcvFileId)
          -- proceed with redirect
          yaml <- liftError (FILE . FILE_IO . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `agentFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
@@ -392,7 +382,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
  cfg <- asks config
  forever $ do
    lift $ waitForWork doWork
-    liftIO $ assertAgentForeground c
+    atomically $ assertAgentForeground c
    runXFTPOperation cfg
  where
    runXFTPOperation :: AgentConfig -> AM ()
@@ -454,7 +444,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
          SndFileChunkReplica {server} : _ -> Right server
        createChunk :: Int -> SndFileChunk -> AM (ProtocolServer 'PXFTP)
        createChunk numRecipients' ch = do
-          liftIO $ assertAgentForeground c
+          atomically $ assertAgentForeground c
          (replica, ProtoServerWithAuth srv _) <- tryCreate
          withStore' c $ \db -> createSndFileReplica db ch replica
          pure srv
@@ -462,9 +452,8 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
            tryCreate = do
              usedSrvs <- newTVarIO ([] :: [XFTPServer])
              let AgentClient {xftpServers} = c
-              userSrvCount <- liftIO $ length <$> TM.lookupIO userId xftpServers
+              userSrvCount <- length <$> atomically (TM.lookup userId xftpServers)
              withRetryIntervalCount (riFast ri) $ \n _ loop -> do
-                liftIO $ waitWhileSuspended c
                liftIO $ waitForUserNetwork c
                let triedAllSrvs = n > userSrvCount
                createWithNextSrv usedSrvs
@@ -474,7 +463,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
                retryLoop loop triedAllSrvs e = do
                  flip catchAgentError (\_ -> pure ()) $ do
                    when (triedAllSrvs && serverHostError e) $ notify c sndFileEntityId $ SFWARN e
-                  liftIO $ assertAgentForeground c
+                  atomically $ assertAgentForeground c
                  loop
            createWithNextSrv usedSrvs = do
              deleted <- withStore' c $ \db -> getSndFileDeleted db sndFileId
@@ -494,7 +483,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
  cfg <- asks config
  forever $ do
    lift $ waitForWork doWork
-    liftIO $ assertAgentForeground c
+    atomically $ assertAgentForeground c
    runXFTPOperation cfg
  where
    runXFTPOperation :: AgentConfig -> AM ()
@@ -504,7 +493,6 @@ runXFTPSndWorker c srv Worker {doWork} = do
        fc@SndFileChunk {userId, sndFileId, sndFileEntityId, filePrefixPath, digest, replicas = replica@SndFileChunkReplica {sndChunkReplicaId, server, delay} : _} -> do
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
          withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
-            liftIO $ waitWhileSuspended c
            liftIO $ waitForUserNetwork c
            atomically $ incXFTPServerStat c userId srv uploadAttempts
            uploadFileChunk cfg fc replica
@@ -515,7 +503,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
                when (serverHostError e) $ notify c sndFileEntityId $ SFWARN e
                liftIO $ closeXFTPServerClient c userId server digest
                withStore' c $ \db -> updateSndChunkReplicaDelay db sndChunkReplicaId replicaDelay
-              liftIO $ assertAgentForeground c
+              atomically $ assertAgentForeground c
              loop
            retryDone e = do
              atomically $ incXFTPServerStat c userId srv uploadErrs
@@ -526,9 +514,9 @@ runXFTPSndWorker c srv Worker {doWork} = do
      fsFilePath <- lift $ toFSFilePath filePath
      unlessM (doesFileExist fsFilePath) $ throwE $ FILE NO_FILE
      let chunkSpec' = chunkSpec {filePath = fsFilePath} :: XFTPChunkSpec
-      liftIO $ assertAgentForeground c
+      atomically $ assertAgentForeground c
      agentXFTPUploadChunk c userId chunkDigest replica' chunkSpec'
-      liftIO $ waitUntilForeground c
+      atomically $ waitUntilForeground c
      sf@SndFile {sndFileEntityId, prefixPath, chunks} <- withStore c $ \db -> do
        updateSndChunkReplicaStatus db sndChunkReplicaId SFRSUploaded
        getSndFile db sndFileId
@@ -666,7 +654,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
  cfg <- asks config
  forever $ do
    lift $ waitForWork doWork
-    liftIO $ assertAgentForeground c
+    atomically $ assertAgentForeground c
    runXFTPOperation cfg
  where
    runXFTPOperation :: AgentConfig -> AM ()
@@ -677,7 +665,6 @@ runXFTPDelWorker c srv Worker {doWork} = do
        processDeletedReplica replica@DeletedSndChunkReplica {deletedSndChunkReplicaId, userId, server, chunkDigest, delay} = do
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
          withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
-            liftIO $ waitWhileSuspended c
            liftIO $ waitForUserNetwork c
            atomically $ incXFTPServerStat c userId srv deleteAttempts
            deleteChunkReplica
@@ -688,7 +675,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
                when (serverHostError e) $ notify c "" $ SFWARN e
                liftIO $ closeXFTPServerClient c userId server chunkDigest
                withStore' c $ \db -> updateDeletedSndChunkReplicaDelay db deletedSndChunkReplicaId replicaDelay
-              liftIO $ assertAgentForeground c
+              atomically $ assertAgentForeground c
              loop
            retryDone e = do
              atomically $ incXFTPServerStat c userId srv deleteErrs
@@ -703,7 +690,7 @@ delWorkerInternalError c deletedSndChunkReplicaId e = do
  withStore' c $ \db -> deleteDeletedSndChunkReplica db deletedSndChunkReplicaId
  notify c "" $ SFERR e

-assertAgentForeground :: AgentClient -> IO ()
+assertAgentForeground :: AgentClient -> STM ()
 assertAgentForeground c = do
  throwWhenInactive c
  waitUntilForeground c
@@ -53,9 +53,9 @@ defaultXFTPClientAgentConfig =
 data XFTPClientAgentError = XFTPClientAgentError XFTPServer XFTPClientError
  deriving (Show, Exception)

-newXFTPAgent :: XFTPClientAgentConfig -> IO XFTPClientAgent
+newXFTPAgent :: XFTPClientAgentConfig -> STM XFTPClientAgent
 newXFTPAgent config = do
-  xftpClients <- TM.emptyIO
+  xftpClients <- TM.empty
  pure XFTPClientAgent {xftpClients, config}

 type ME a = ExceptT XFTPClientAgentError IO a
@@ -43,7 +43,7 @@ import Data.Int (Int64)
 import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
 import qualified Data.List.NonEmpty as L
-import Data.Map.Strict (Map)
+import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, listToMaybe)
 import qualified Data.Text as T
@@ -313,7 +313,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
      pure (encPath, fdRcv, fdSnd, chunkSpecs, encSize)
    uploadFile :: TVar ChaChaDRG -> [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]
    uploadFile g chunks uploadedChunks encSize = do
-      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
+      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
      gen <- newTVarIO =<< liftIO newStdGen
      let xftpSrvs = fromMaybe defaultXFTPServers (nonEmpty xftpServers)
      srvs <- liftIO $ replicateM (length chunks) $ getXFTPServer gen xftpSrvs
@@ -429,7 +429,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
    receive (ValidFileDescription FileDescription {size, digest, key, nonce, chunks}) = do
      encPath <- getEncPath tempPath "xftp"
      createDirectory encPath
-      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
+      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
      liftIO $ printNoNewLine "Downloading file..."
      downloadedChunks <- newTVarIO []
      let srv FileChunk {replicas} = case replicas of
@@ -494,7 +494,7 @@ cliDeleteFile DeleteOptions {fileDescription, retryCount, yes} = do
  where
    deleteFile :: ValidFileDescription 'FSender -> ExceptT CLIError IO ()
    deleteFile (ValidFileDescription FileDescription {chunks}) = do
-      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
+      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
      forM_ chunks $ deleteFileChunk a
      liftIO $ do
        printNoNewLine "File deleted!"
@@ -52,7 +52,7 @@ import Data.Int (Int64)
 import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
-import Data.Map.Strict (Map)
+import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Data.String
@@ -112,7 +112,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
        Right pk' -> pure pk'
        Left e -> putStrLn ("servers has no valid key: " <> show e) >> exitFailure
      env <- ask
-      sessions <- liftIO TM.emptyIO
+      sessions <- atomically TM.empty
      let cleanup sessionId = atomically $ TM.delete sessionId sessions
      liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize serverParams transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
        reqBody <- getHTTP2Body r xftpBlockSize
@@ -576,7 +576,7 @@ incFileStat statSel = do
 saveServerStats :: M ()
 saveServerStats =
  asks (serverStatsBackupFile . config)
-    >>= mapM_ (\f -> asks serverStats >>= liftIO . getFileServerStatsData >>= liftIO . saveStats f)
+    >>= mapM_ (\f -> asks serverStats >>= atomically . getFileServerStatsData >>= liftIO . saveStats f)
  where
    saveStats f stats = do
      logInfo $ "saving server stats to file " <> T.pack f
@@ -11,6 +11,7 @@ module Simplex.FileTransfer.Server.Env where

 import Control.Logger.Simple
 import Control.Monad
+import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
@@ -104,17 +105,17 @@ supportedXFTPhandshakes = ["xftp/1"]

 newXFTPServerEnv :: XFTPServerConfig -> IO XFTPEnv
 newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
-  random <- C.newRandom
-  store <- newFileStore
-  storeLog <- mapM (`readWriteFileStore` store) storeLogFile
+  random <- liftIO C.newRandom
+  store <- atomically newFileStore
+  storeLog <- liftIO $ mapM (`readWriteFileStore` store) storeLogFile
  used <- countUsedStorage <$> readTVarIO (files store)
  atomically $ writeTVar (usedStorage store) used
  forM_ fileSizeQuota $ \quota -> do
    logInfo $ "Total / available storage: " <> tshow quota <> " / " <> tshow (quota - used)
    when (quota < used) $ logInfo "WARNING: storage quota is less than used storage, no files can be uploaded!"
-  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
-  Fingerprint fp <- loadFingerprint caCertificateFile
-  serverStats <- newFileServerStats =<< getCurrentTime
+  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
+  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
+  serverStats <- atomically . newFileServerStats =<< liftIO getCurrentTime
  pure XFTPEnv {config, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}

 countUsedStorage :: M.Map k FileRec -> Int64
@@ -43,34 +43,34 @@ data FileServerStatsData = FileServerStatsData
  }
  deriving (Show)

-newFileServerStats :: UTCTime -> IO FileServerStats
+newFileServerStats :: UTCTime -> STM FileServerStats
 newFileServerStats ts = do
-  fromTime <- newTVarIO ts
-  filesCreated <- newTVarIO 0
-  fileRecipients <- newTVarIO 0
-  filesUploaded <- newTVarIO 0
-  filesExpired <- newTVarIO 0
-  filesDeleted <- newTVarIO 0
+  fromTime <- newTVar ts
+  filesCreated <- newTVar 0
+  fileRecipients <- newTVar 0
+  filesUploaded <- newTVar 0
+  filesExpired <- newTVar 0
+  filesDeleted <- newTVar 0
  filesDownloaded <- newPeriodStats
-  fileDownloads <- newTVarIO 0
-  fileDownloadAcks <- newTVarIO 0
-  filesCount <- newTVarIO 0
-  filesSize <- newTVarIO 0
+  fileDownloads <- newTVar 0
+  fileDownloadAcks <- newTVar 0
+  filesCount <- newTVar 0
+  filesSize <- newTVar 0
  pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}

-getFileServerStatsData :: FileServerStats -> IO FileServerStatsData
+getFileServerStatsData :: FileServerStats -> STM FileServerStatsData
 getFileServerStatsData s = do
-  _fromTime <- readTVarIO $ fromTime (s :: FileServerStats)
-  _filesCreated <- readTVarIO $ filesCreated s
-  _fileRecipients <- readTVarIO $ fileRecipients s
-  _filesUploaded <- readTVarIO $ filesUploaded s
-  _filesExpired <- readTVarIO $ filesExpired s
-  _filesDeleted <- readTVarIO $ filesDeleted s
+  _fromTime <- readTVar $ fromTime (s :: FileServerStats)
+  _filesCreated <- readTVar $ filesCreated s
+  _fileRecipients <- readTVar $ fileRecipients s
+  _filesUploaded <- readTVar $ filesUploaded s
+  _filesExpired <- readTVar $ filesExpired s
+  _filesDeleted <- readTVar $ filesDeleted s
  _filesDownloaded <- getPeriodStatsData $ filesDownloaded s
-  _fileDownloads <- readTVarIO $ fileDownloads s
-  _fileDownloadAcks <- readTVarIO $ fileDownloadAcks s
-  _filesCount <- readTVarIO $ filesCount s
-  _filesSize <- readTVarIO $ filesSize s
+  _fileDownloads <- readTVar $ fileDownloads s
+  _fileDownloadAcks <- readTVar $ fileDownloadAcks s
+  _filesCount <- readTVar $ filesCount s
+  _filesSize <- readTVar $ filesSize s
  pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}

 setFileServerStats :: FileServerStats -> FileServerStatsData -> STM ()
@@ -55,11 +55,11 @@ instance StrEncoding FileRecipient where
  strEncode (FileRecipient rId rKey) = strEncode rId <> ":" <> strEncode rKey
  strP = FileRecipient <$> strP <* A.char ':' <*> strP

-newFileStore :: IO FileStore
+newFileStore :: STM FileStore
 newFileStore = do
-  files <- TM.emptyIO
-  recipients <- TM.emptyIO
-  usedStorage <- newTVarIO 0
+  files <- TM.empty
+  recipients <- TM.empty
+  usedStorage <- newTVar 0
  pure FileStore {files, recipients, usedStorage}

 addFile :: FileStore -> SenderId -> FileInfo -> SystemTime -> STM (Either XFTPErrorType ())
@@ -33,7 +33,6 @@ module Simplex.Messaging.Agent
    AgentClient (..),
    AE,
    SubscriptionsInfo (..),
-    MsgReq,
    getSMPAgentClient,
    getSMPAgentClient_,
    disconnectAgentClient,
@@ -53,7 +52,6 @@ module Simplex.Messaging.Agent
    deleteConnectionAsync,
    deleteConnectionsAsync,
    createConnection,
-    changeConnectionUser,
    prepareConnectionToJoin,
    joinConnection,
    allowConnection,
@@ -94,7 +92,6 @@ module Simplex.Messaging.Agent
    getNtfTokenData,
    toggleConnectionNtfs,
    xftpStartWorkers,
-    xftpStartSndWorkers,
    xftpReceiveFile,
    xftpDeleteRcvFile,
    xftpDeleteRcvFiles,
@@ -108,7 +105,6 @@ module Simplex.Messaging.Agent
    rcConnectHost,
    rcConnectCtrl,
    rcDiscoverCtrl,
-    getAgentSubsTotal,
    getAgentServersSummary,
    resetAgentServersStats,
    foregroundAgent,
@@ -128,7 +124,7 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
-import Data.Bifunctor (bimap, first, second)
+import Data.Bifunctor (bimap, first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.), (.::), (.::.))
@@ -150,7 +146,7 @@ import Data.Time.Clock
 import Data.Time.Clock.System (systemToUTCTime)
 import Data.Traversable (mapAccumL)
 import Data.Word (Word16)
-import Simplex.FileTransfer.Agent (closeXFTPAgent, deleteSndFileInternal, deleteSndFileRemote, deleteSndFilesInternal, deleteSndFilesRemote, startXFTPSndWorkers, startXFTPWorkers, toFSFilePath, xftpDeleteRcvFile', xftpDeleteRcvFiles', xftpReceiveFile', xftpSendDescription', xftpSendFile')
+import Simplex.FileTransfer.Agent (closeXFTPAgent, deleteSndFileInternal, deleteSndFileRemote, deleteSndFilesInternal, deleteSndFilesRemote, startXFTPWorkers, toFSFilePath, xftpDeleteRcvFile', xftpDeleteRcvFiles', xftpReceiveFile', xftpSendDescription', xftpSendFile')
 import Simplex.FileTransfer.Description (ValidFileDescription)
 import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
@@ -208,7 +204,7 @@ getSMPAgentClient_ clientId cfg initServers@InitialAgentServers {smp, xftp} stor
    runAgent = do
      liftIO $ checkServers "SMP" smp >> checkServers "XFTP" xftp
      currentTs <- liftIO getCurrentTime
-      c@AgentClient {acThread} <- liftIO . newAgentClient clientId initServers currentTs =<< ask
+      c@AgentClient {acThread} <- atomically . newAgentClient clientId initServers currentTs =<< ask
      t <- runAgentThreads c `forkFinally` const (liftIO $ disconnectAgentClient c)
      atomically . writeTVar acThread . Just =<< mkWeakThreadId t
      pure c
@@ -236,30 +232,29 @@ logServersStats c = do
  liftIO $ threadDelay' delay
  int <- asks (logStatsInterval . config)
  forever $ do
-    liftIO $ waitUntilActive c
    saveServersStats c
    liftIO $ threadDelay' int

 saveServersStats :: AgentClient -> AM' ()
-saveServersStats c@AgentClient {subQ, smpServersStats, xftpServersStats, ntfServersStats} = do
-  sss <- mapM (liftIO . getAgentSMPServerStats) =<< readTVarIO smpServersStats
-  xss <- mapM (liftIO . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
-  nss <- mapM (liftIO . getAgentNtfServerStats) =<< readTVarIO ntfServersStats
-  let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss, ntfServersStats = OptionalMap nss}
+saveServersStats c@AgentClient {subQ, smpServersStats, xftpServersStats} = do
+  sss <- mapM (lift . getAgentSMPServerStats) =<< readTVarIO smpServersStats
+  xss <- mapM (lift . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
+  let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}
  tryAgentError' (withStore' c (`updateServersStats` stats)) >>= \case
    Left e -> atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
    Right () -> pure ()

 restoreServersStats :: AgentClient -> AM' ()
-restoreServersStats c@AgentClient {smpServersStats, xftpServersStats, ntfServersStats, srvStatsStartedAt} = do
+restoreServersStats c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt} = do
  tryAgentError' (withStore c getServersStats) >>= \case
    Left e -> atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
    Right (startedAt, Nothing) -> atomically $ writeTVar srvStatsStartedAt startedAt
-    Right (startedAt, Just AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss, ntfServersStats = OptionalMap nss}) -> do
+    Right (startedAt, Just AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}) -> do
      atomically $ writeTVar srvStatsStartedAt startedAt
-      atomically . writeTVar smpServersStats =<< mapM (atomically . newAgentSMPServerStats') sss
-      atomically . writeTVar xftpServersStats =<< mapM (atomically . newAgentXFTPServerStats') xss
-      atomically . writeTVar ntfServersStats =<< mapM (atomically . newAgentNtfServerStats') nss
+      sss' <- mapM (atomically . newAgentSMPServerStats') sss
+      atomically $ writeTVar smpServersStats sss'
+      xss' <- mapM (atomically . newAgentXFTPServerStats') xss
+      atomically $ writeTVar xftpServersStats xss'

 disconnectAgentClient :: AgentClient -> IO ()
 disconnectAgentClient c@AgentClient {agentEnv = Env {ntfSupervisor = ns, xftpAgent = xa}} = do
@@ -334,11 +329,6 @@ 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 
-changeConnectionUser :: AgentClient -> UserId -> ConnId -> UserId -> AE ()
-changeConnectionUser c oldUserId connId newUserId = withAgentEnv c $ changeConnectionUser' c oldUserId connId newUserId
-{-# INLINE changeConnectionUser #-}
-
 -- | Create SMP agent connection without queue (to be joined with joinConnection passing connection ID).
 -- This method is required to prevent race condition when confirmation from peer is received before
 -- the caller of joinConnection saves connection ID to the database.
@@ -348,7 +338,7 @@ prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri
 prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs

 -- | Join SMP agent connection (JOIN command).
-joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
+joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
 joinConnection c userId Nothing enableNtfs = withAgentEnv c .:: joinConn c userId "" False enableNtfs
 joinConnection c userId (Just connId) enableNtfs = withAgentEnv c .:: joinConn c userId connId True enableNtfs
 {-# INLINE joinConnection #-}
@@ -359,7 +349,7 @@ allowConnection c = withAgentEnv c .:. allowConnection' c
 {-# INLINE allowConnection #-}

 -- | Accept contact after REQ notification (ACPT command)
-acceptContact :: AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
+acceptContact :: AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
 acceptContact c enableNtfs = withAgentEnv c .:: acceptContact' c "" enableNtfs
 {-# INLINE acceptContact #-}

@@ -384,7 +374,7 @@ getConnectionMessage c = withAgentEnv c . getConnectionMessage' c
 {-# INLINE getConnectionMessage #-}

 -- | Get connection message for received notification
-getNotificationMessage :: AgentClient -> C.CbNonce -> ByteString -> AE (NotificationInfo, Maybe SMPMsgMeta)
+getNotificationMessage :: AgentClient -> C.CbNonce -> ByteString -> AE (NotificationInfo, [SMPMsgMeta])
 getNotificationMessage c = withAgentEnv c .: getNotificationMessage' c
 {-# INLINE getNotificationMessage #-}

@@ -401,10 +391,6 @@ sendMessage :: AgentClient -> ConnId -> PQEncryption -> MsgFlags -> MsgBody -> A
 sendMessage c = withAgentEnv c .:: sendMessage' c
 {-# INLINE sendMessage #-}

-- When sending multiple messages to the same connection,
-- only the first MsgReq for this connection should have non-empty ConnId.
-- All subsequent MsgReq in traversable for this connection must be empty.
-- This is done to optimize processing by grouping all messages to one connection together.
 type MsgReq = (ConnId, PQEncryption, MsgFlags, MsgBody)

 -- | Send multiple messages to different connections (SEND command)
@@ -536,10 +522,6 @@ xftpStartWorkers :: AgentClient -> Maybe FilePath -> AE ()
 xftpStartWorkers c = withAgentEnv c . startXFTPWorkers c
 {-# INLINE xftpStartWorkers #-}

-xftpStartSndWorkers :: AgentClient -> Maybe FilePath -> AE ()
-xftpStartSndWorkers c = withAgentEnv c . startXFTPSndWorkers c
-{-# INLINE xftpStartSndWorkers #-}
-
 -- | Receive XFTP file
 xftpReceiveFile :: AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> Bool -> AE RcvFileId
 xftpReceiveFile c = withAgentEnv c .:: xftpReceiveFile' c
@@ -747,16 +729,6 @@ newConn :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe
 newConn c userId connId enableNtfs cMode clientData pqInitKeys subMode =
  getSMPServer c userId >>= newConnSrv c userId connId False enableNtfs cMode clientData pqInitKeys subMode

-changeConnectionUser' :: AgentClient -> UserId -> ConnId -> UserId -> AM ()
-changeConnectionUser' c oldUserId connId newUserId = do
-  SomeConn _ conn <- withStore c (`getConn` connId)
-  case conn of
-    NewConnection {} -> updateConn
-    RcvConnection {} -> updateConn
-    _ -> throwE $ CMD PROHIBITED "changeConnectionUser: established connection"
-  where
-    updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId
-
 newConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, ConnectionRequestUri c)
 newConnSrv c userId connId hasNewConn enableNtfs cMode clientData pqInitKeys subMode srv = do
  connId' <-
@@ -806,7 +778,7 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of
          cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
      withStore c $ \db -> createNewConn db g cData SCMInvitation

-joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured)
+joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
 joinConn c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode = do
  srv <- case cReq of
    CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ ->
@@ -865,7 +837,7 @@ versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport
 versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_
 {-# INLINE versionPQSupport_ #-}

-joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, SndQueueSecured)
+joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ConnId
 joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv =
  withInvLock c (strEncode inv) "joinConnSrv" $ do
    (cData, q, _, rc, e2eSndParams) <- startJoinInvitation userId connId Nothing enableNtfs inv pqSup
@@ -882,7 +854,7 @@ joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo p
    -- otherwise we would need to manage retries here to avoid SndQueue recreated with a different key,
    -- similar to how joinConnAsync does that.
    tryError (secureConfirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case
-      Right sqSecured -> pure (connId', sqSecured)
+      Right _ -> pure connId'
      Left e -> do
        -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md
        void $ withStore' c $ \db -> deleteConn db Nothing connId'
@@ -892,10 +864,10 @@ joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo
    Just (qInfo, vrsn) -> do
      (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
      void $ sendInvitation c userId qInfo vrsn cReq cInfo
-      pure (connId', False)
+      pure connId'
    Nothing -> throwE $ AGENT A_VERSION

-joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
+joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ()
 joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do
  SomeConn cType conn <- withStore c (`getConn` connId)
  case conn of
@@ -903,7 +875,7 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo
    SndConnection _ sq -> doJoin $ Just sq
    _ -> throwE $ CMD PROHIBITED $ "joinConnSrvAsync: bad connection " <> show cType
  where
-    doJoin :: Maybe SndQueue -> AM SndQueueSecured
+    doJoin :: Maybe SndQueue -> AM ()
    doJoin sq_ = do
      (cData, sq, _, rc, e2eSndParams) <- startJoinInvitation userId connId sq_ enableNtfs inv pqSupport
      sq' <- withStore c $ \db -> runExceptT $ do
@@ -930,14 +902,18 @@ createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVers
 allowConnection' :: AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
 allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConnection" $ do
  withStore c (`getConn` connId) >>= \case
-    SomeConn _ (RcvConnection _ RcvQueue {server, rcvId}) -> do
-      AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <-
-        withStore c $ \db -> acceptConfirmation db confId ownConnInfo
+    SomeConn _ (RcvConnection _ rq@RcvQueue {server, rcvId, e2ePrivKey, smpClientVersion = v}) -> do
+      senderKey <- withStore c $ \db -> runExceptT $ do
+        AcceptedConfirmation {ratchetState, senderConf = SMPConfirmation {senderKey, e2ePubKey, smpClientVersion = v'}} <- ExceptT $ acceptConfirmation db confId ownConnInfo
+        liftIO $ createRatchet db connId ratchetState
+        let dhSecret = C.dh' e2ePubKey e2ePrivKey
+        liftIO $ setRcvQueueConfirmedE2E db rq dhSecret $ min v v'
+        pure senderKey
      enqueueCommand c "" connId (Just server) . AInternalCommand $ ICAllowSecure rcvId senderKey
    _ -> throwE $ CMD PROHIBITED "allowConnection"

 -- | Accept contact (ACPT command) in Reader monad
-acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured)
+acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
 acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do
  Invitation {contactConnId, connReq} <- withStore c (`getInvitation` invId)
  withStore c (`getConn` contactConnId) >>= \case
@@ -974,12 +950,12 @@ subscribeConnections' c connIds = do
  let (errs, cs) = M.mapEither id conns
      errs' = M.map (Left . storeError) errs
      (subRs, rcvQs) = M.mapEither rcvQueueOrResult cs
-  resumeDelivery cs
-  lift $ resumeConnCmds c $ M.keys cs
+  mapM_ (mapM_ (\(cData, sqs) -> mapM_ (lift . resumeMsgDelivery c cData) sqs) . sndQueue) cs
+  mapM_ (resumeConnCmds c) $ M.keys cs
  rcvRs <- lift $ connResults . fst <$> subscribeQueues c (concat $ M.elems rcvQs)
  ns <- asks ntfSupervisor
  tkn <- readTVarIO (ntfTkn ns)
-  lift $ when (instantNotifications tkn) . void . forkIO . void $ sendNtfCreate ns rcvRs cs
+  when (instantNotifications tkn) . void . lift . forkIO . void . runExceptT $ sendNtfCreate ns rcvRs conns
  let rs = M.unions ([errs', subRs, rcvRs] :: [Map ConnId (Either AgentErrorType ())])
  notifyResultError rs
  pure rs
@@ -1011,20 +987,15 @@ subscribeConnections' c connIds = do
        order (Active, _) = 2
        order (_, Right _) = 3
        order _ = 4
-    sendNtfCreate :: NtfSupervisor -> Map ConnId (Either AgentErrorType ()) -> Map ConnId SomeConn -> AM' ()
-    sendNtfCreate ns rcvRs cs = do
-      -- TODO this needs to be batched end to end.
-      -- Currently, the only change is to ignore failed subscriptions.
-      let oks = M.keysSet $ M.filter (either temporaryAgentError $ const True) rcvRs
-      forM_ (M.restrictKeys cs oks) $ \case
-        SomeConn _ conn -> do
-          let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCDelete
-              ConnData {connId} = toConnData conn
-          atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)            
-    resumeDelivery :: Map ConnId SomeConn -> AM ()
-    resumeDelivery conns = do
-      conns' <- M.restrictKeys conns . S.fromList <$> withStore' c getConnectionsForDelivery
-      lift $ mapM_ (mapM_ (\(cData, sqs) -> mapM_ (resumeMsgDelivery c cData) sqs) . sndQueue) conns'
+    sendNtfCreate :: NtfSupervisor -> Map ConnId (Either AgentErrorType ()) -> Map ConnId (Either StoreError SomeConn) -> AM ()
+    sendNtfCreate ns rcvRs conns =
+      forM_ (M.assocs rcvRs) $ \case
+        (connId, Right _) -> forM_ (M.lookup connId conns) $ \case
+          Right (SomeConn _ conn) -> do
+            let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCDelete
+            atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)
+          _ -> pure ()
+        _ -> pure ()
    sndQueue :: SomeConn -> Maybe (ConnData, NonEmpty SndQueue)
    sndQueue (SomeConn _ conn) = case conn of
      DuplexConnection cData _ sqs -> Just (cData, sqs)
@@ -1060,7 +1031,7 @@ getConnectionMessage' c connId = do
    SndConnection _ _ -> throwE $ CONN SIMPLEX
    NewConnection _ -> throwE $ CMD PROHIBITED "getConnectionMessage: NewConnection"

-getNotificationMessage' :: AgentClient -> C.CbNonce -> ByteString -> AM (NotificationInfo, Maybe SMPMsgMeta)
+getNotificationMessage' :: AgentClient -> C.CbNonce -> ByteString -> AM (NotificationInfo, [SMPMsgMeta])
 getNotificationMessage' c nonce encNtfInfo = do
  withStore' c getActiveNtfToken >>= \case
    Just NtfToken {ntfDhSecret = Just dhSecret} -> do
@@ -1068,9 +1039,22 @@ getNotificationMessage' c nonce encNtfInfo = do
      PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} <- liftEither (parse strP (INTERNAL "error parsing PNMessageData") ntfData)
      (ntfConnId, rcvNtfDhSecret) <- withStore c (`getNtfRcvQueue` smpQueue)
      ntfMsgMeta <- (eitherToMaybe . smpDecode <$> agentCbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta) `catchAgentError` \_ -> pure Nothing
-      msgMeta <- getConnectionMessage' c ntfConnId
-      pure (NotificationInfo {ntfConnId, ntfTs, ntfMsgMeta}, msgMeta)
+      maxMsgs <- asks $ ntfMaxMessages . config
+      (NotificationInfo {ntfConnId, ntfTs, ntfMsgMeta},) <$> getNtfMessages ntfConnId ntfMsgMeta maxMsgs
    _ -> throwE $ CMD PROHIBITED "getNotificationMessage"
+  where
+    getNtfMessages ntfConnId nMeta = getMsg
+      where
+        getMsg 0 = pure []
+        getMsg n =
+          getConnectionMessage' c ntfConnId >>= \case
+            Just m
+              | lastMsg m -> pure [m]
+              | otherwise -> (m :) <$> getMsg (n - 1)
+            Nothing -> pure []
+        lastMsg SMP.SMPMsgMeta {msgId, msgTs, msgFlags} = case nMeta of
+          Just SMP.NMsgMeta {msgId = msgId', msgTs = msgTs'} -> msgId == msgId' || msgTs > msgTs'
+          Nothing -> SMP.notification msgFlags

 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: AgentClient -> ConnId -> PQEncryption -> MsgFlags -> MsgBody -> AM (AgentMsgId, PQEncryption)
@@ -1084,88 +1068,78 @@ sendMessages' c = sendMessagesB' c . map Right

 sendMessagesB' :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType MsgReq) -> AM (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
 sendMessagesB' c reqs = do
-  (_, connIds) <- liftEither $ foldl' addConnId (Right ("", S.empty)) reqs
+  connIds <- liftEither $ foldl' addConnId (Right S.empty) reqs
  lift $ sendMessagesB_ c reqs connIds
  where
-    addConnId acc@(Right (prevId, s)) (Right (connId, _, _, _))
-      | B.null connId = if B.null prevId then Left $ INTERNAL "sendMessages: empty first connId" else acc
-      | connId `S.member` s = Left $ INTERNAL "sendMessages: duplicate connId"
-      | otherwise = Right (connId, S.insert connId s)
-    addConnId acc _ = acc
+    addConnId s@(Right s') (Right (connId, _, _, _))
+      | B.null connId = s
+      | connId `S.notMember` s' = Right $ S.insert connId s'
+      | otherwise = Left $ INTERNAL "sendMessages: duplicate connection ID"
+    addConnId s _ = s

 sendMessagesB_ :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType MsgReq) -> Set ConnId -> AM' (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
 sendMessagesB_ c reqs connIds = withConnLocks c connIds "sendMessages" $ do
-  prev <- newTVarIO Nothing
-  reqs' <- withStoreBatch c $ \db -> fmap (bindRight $ getConn_ db prev) reqs
+  reqs' <- withStoreBatch c (\db -> fmap (bindRight $ \req@(connId, _, _, _) -> bimap storeError (req,) <$> getConn db connId) reqs)
  let (toEnable, reqs'') = mapAccumL prepareConn [] reqs'
-  void $ withStoreBatch' c $ \db -> map (\connId -> setConnPQSupport db connId PQSupportOn) $ S.toList toEnable
+  void $ withStoreBatch' c $ \db -> map (\connId -> setConnPQSupport db connId PQSupportOn) toEnable
  enqueueMessagesB c reqs''
  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
-          then fromMaybe (Left $ INTERNAL "sendMessagesB_: empty prev connId") <$> readTVarIO prev
-          else do
-            conn <- first storeError <$> getConn db connId
-            conn <$ atomically (writeTVar prev $ Just conn)
-    prepareConn :: Set ConnId -> Either AgentErrorType (MsgReq, SomeConn) -> (Set ConnId, Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
-    prepareConn s (Left e) = (s, Left e)
-    prepareConn s (Right ((_, pqEnc, msgFlags, msg), SomeConn _ conn)) = case conn of
+    prepareConn :: [ConnId] -> Either AgentErrorType (MsgReq, SomeConn) -> ([ConnId], Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
+    prepareConn acc (Left e) = (acc, Left e)
+    prepareConn acc (Right ((_, pqEnc, msgFlags, msg), SomeConn _ conn)) = case conn of
      DuplexConnection cData _ sqs -> prepareMsg cData sqs
      SndConnection cData sq -> prepareMsg cData [sq]
-      _ -> (s, Left $ CONN SIMPLEX)
+      _ -> (acc, Left $ CONN SIMPLEX)
      where
-        prepareMsg :: ConnData -> NonEmpty SndQueue -> (Set ConnId, Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
+        prepareMsg :: ConnData -> NonEmpty SndQueue -> ([ConnId], Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
        prepareMsg cData@ConnData {connId, pqSupport} sqs
-          | ratchetSyncSendProhibited cData = (s, Left $ CMD PROHIBITED "sendMessagesB: send prohibited")
+          | ratchetSyncSendProhibited cData = (acc, Left $ CMD PROHIBITED "sendMessagesB: send prohibited")
          -- connection is only updated if PQ encryption was disabled, and now it has to be enabled.
          -- support for PQ encryption (small message envelopes) will not be disabled when message is sent.
          | pqEnc == PQEncOn && pqSupport == PQSupportOff =
              let cData' = cData {pqSupport = PQSupportOn} :: ConnData
-               in (S.insert connId s, mkReq cData')
-          | otherwise = (s, mkReq cData)
-          where
-            mkReq cData' = Right (cData', sqs, Just pqEnc, msgFlags, A_MSG msg)
+               in (connId : acc, Right (cData', sqs, Just pqEnc, msgFlags, A_MSG msg))
+          | otherwise = (acc, Right (cData, sqs, Just pqEnc, msgFlags, A_MSG msg))

 -- / async command processing v v v

 enqueueCommand :: AgentClient -> ACorrId -> ConnId -> Maybe SMPServer -> AgentCommand -> AM ()
 enqueueCommand c corrId connId server aCommand = do
  withStore c $ \db -> createCommand db corrId connId server aCommand
-  lift . void $ getAsyncCmdWorker True c connId server
+  lift . void $ getAsyncCmdWorker True c server

-resumeSrvCmds :: AgentClient -> ConnId -> Maybe SMPServer -> AM' ()
-resumeSrvCmds = void .:. getAsyncCmdWorker False
+resumeSrvCmds :: AgentClient -> Maybe SMPServer -> AM' ()
+resumeSrvCmds = void .: getAsyncCmdWorker False
 {-# INLINE resumeSrvCmds #-}

-resumeConnCmds :: AgentClient -> [ConnId] -> AM' ()
-resumeConnCmds c connIds = do
-  connSrvs <- rights . zipWith (second . (,)) connIds <$> withStoreBatch' c (\db -> fmap (getPendingCommandServers db) connIds)
-  mapM_ (\(connId, srvs) -> mapM_ (resumeSrvCmds c connId) srvs) connSrvs
+resumeConnCmds :: AgentClient -> ConnId -> AM ()
+resumeConnCmds c connId =
+  unlessM connQueued $
+    withStore' c (`getPendingCommandServers` connId)
+      >>= mapM_ (lift . resumeSrvCmds c)
+  where
+    connQueued = atomically $ isJust <$> TM.lookupInsert connId True (connCmdsQueued c)

-getAsyncCmdWorker :: Bool -> AgentClient -> ConnId -> Maybe SMPServer -> AM' Worker
-getAsyncCmdWorker hasWork c connId server =
-  getAgentWorker "async_cmd" hasWork c (connId, server) (asyncCmdWorkers c) (runCommandProcessing c connId server)
+getAsyncCmdWorker :: Bool -> AgentClient -> Maybe SMPServer -> AM' Worker
+getAsyncCmdWorker hasWork c server =
+  getAgentWorker "async_cmd" hasWork c server (asyncCmdWorkers c) (runCommandProcessing c server)

-data CommandCompletion = CCMoved | CCCompleted
-
-runCommandProcessing :: AgentClient -> ConnId -> Maybe SMPServer -> Worker -> AM ()
-runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
+runCommandProcessing :: AgentClient -> Maybe SMPServer -> Worker -> AM ()
+runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
  ri <- asks $ messageRetryInterval . config -- different retry interval?
  forever $ do
    atomically $ endAgentOperation c AOSndNetwork
    lift $ waitForWork doWork
-    liftIO $ throwWhenInactive c
+    atomically $ throwWhenInactive c
    atomically $ beginAgentOperation c AOSndNetwork
-    withWork c doWork (\db -> getPendingServerCommand db connId server_) $ runProcessCmd (riFast ri)
+    withWork c doWork (`getPendingServerCommand` server_) $ runProcessCmd (riFast ri)
  where
    runProcessCmd ri cmd = do
      pending <- newTVarIO []
      processCmd ri cmd pending
      mapM_ (atomically . writeTBQueue subQ) . reverse =<< readTVarIO pending
    processCmd :: RetryInterval -> PendingCommand -> TVar [ATransmission] -> AM ()
-    processCmd ri PendingCommand {cmdId, corrId, userId, command} pendingCmds = case command of
+    processCmd ri PendingCommand {cmdId, corrId, userId, connId, command} pendingCmds = case command of
      AClientCommand cmd -> case cmd of
        NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do
          usedSrvs <- newTVarIO ([] :: [SMPServer])
@@ -1176,8 +1150,8 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
          let initUsed = [qServer q]
          usedSrvs <- newTVarIO initUsed
          tryCommand . withNextSrv c userId usedSrvs initUsed $ \srv -> do
-            sqSecured <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
-            notify $ JOINED sqSecured
+            joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
+            notify OK
        LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
        ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK
        SWCH ->
@@ -1191,27 +1165,16 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
      AInternalCommand cmd -> case cmd of
        ICAckDel rId srvMsgId msgId -> withServer $ \srv -> tryWithLock "ICAckDel" $ ack srv rId srvMsgId >> withStore' c (\db -> deleteMsg db connId msgId)
        ICAck rId srvMsgId -> withServer $ \srv -> tryWithLock "ICAck" $ ack srv rId srvMsgId
-        ICAllowSecure _rId senderKey -> withServer' . tryMoveableWithLock "ICAllowSecure" $ do
+        ICAllowSecure _rId senderKey -> withServer' . tryWithLock "ICAllowSecure" $ do
          (SomeConn _ conn, AcceptedConfirmation {senderConf, ownConnInfo}) <-
            withStore c $ \db -> runExceptT $ (,) <$> ExceptT (getConn db connId) <*> ExceptT (getAcceptedConfirmation db connId)
          case conn of
            RcvConnection cData rq -> do
              mapM_ (secure rq) senderKey
              mapM_ (connectReplyQueues c cData ownConnInfo Nothing) (L.nonEmpty $ smpReplyQueues senderConf)
-              pure CCCompleted
            -- duplex connection is matched to handle SKEY retries
-            DuplexConnection cData _ (sq :| _) -> do
-              tryAgentError (mapM_ (connectReplyQueues c cData ownConnInfo (Just sq)) (L.nonEmpty $ smpReplyQueues senderConf)) >>= \case
-                Right () -> pure CCCompleted
-                Left e
-                  | temporaryOrHostError e && Just server /= server_ -> do
-                      -- In case the server is different we update server to remove command from this (connId, srv) queue
-                      withStore c $ \db -> updateCommandServer db cmdId server
-                      lift . void $ getAsyncCmdWorker True c connId (Just server)
-                      pure CCMoved
-                  | otherwise -> throwE e
-              where
-                server = qServer sq
+            DuplexConnection cData _ (sq :| _) ->
+              mapM_ (connectReplyQueues c cData ownConnInfo (Just sq)) (L.nonEmpty $ smpReplyQueues senderConf)
            _ -> throwE $ INTERNAL $ "incorrect connection type " <> show (internalCmdTag cmd)
        ICDuplexSecure _rId senderKey -> withServer' . tryWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do
          secure rq senderKey
@@ -1284,18 +1247,13 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
          withStore c (`getConn` connId) >>= \case
            SomeConn _ conn@DuplexConnection {} -> a conn
            _ -> internalErr "command requires duplex connection"
-        tryCommand action = tryMoveableCommand (action $> CCCompleted)
-        tryMoveableCommand action = withRetryInterval ri $ \_ loop -> do
-          liftIO $ waitWhileSuspended c
-          liftIO $ waitForUserNetwork c
-          tryAgentError action >>= \case
+        tryCommand action = withRetryInterval ri $ \_ loop ->
+          tryError action >>= \case
            Left e
              | temporaryOrHostError e -> retrySndOp c loop
              | otherwise -> cmdError e
-            Right CCCompleted -> withStore' c (`deleteCommand` cmdId)
-            Right CCMoved -> pure () -- command processing moved to another command queue
+            Right () -> withStore' c (`deleteCommand` cmdId)
        tryWithLock name = tryCommand . withConnLock c connId name
-        tryMoveableWithLock name = tryMoveableCommand . withConnLock c connId name
        internalErr s = cmdError $ INTERNAL $ s <> ": " <> show (agentCommandTag command)
        cmdError e = notify (ERR e) >> withStore' c (`deleteCommand` cmdId)
        notify :: forall e. AEntityI e => AEvent e -> AM ()
@@ -1397,8 +1355,8 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
  forever $ do
    atomically $ endAgentOperation c AOSndNetwork
    lift $ waitForWork doWork
-    liftIO $ throwWhenInactive c
-    liftIO $ throwWhenNoDelivery c sq
+    atomically $ throwWhenInactive c
+    atomically $ throwWhenNoDelivery c sq
    atomically $ beginAgentOperation c AOSndNetwork
    withWork c doWork (\db -> getPendingQueueMsg db connId sq) $
      \(rq_, PendingMsgData {msgId, msgType, msgBody, pqEncryption, msgFlags, msgRetryState, internalTs}) -> do
@@ -1406,7 +1364,6 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
        let mId = unId msgId
            ri' = maybe id updateRetryInterval2 msgRetryState ri
        withRetryLock2 ri' qLock $ \riState loop -> do
-          liftIO $ waitWhileSuspended c
          liftIO $ waitForUserNetwork c
          resp <- tryError $ case msgType of
            AM_CONN_INFO -> sendConfirmation c sq msgBody
@@ -1559,7 +1516,7 @@ retrySndOp :: AgentClient -> AM () -> AM ()
 retrySndOp c loop = do
  -- end... is in a separate atomically because if begin... blocks, SUSPENDED won't be sent
  atomically $ endAgentOperation c AOSndNetwork
-  liftIO $ throwWhenInactive c
+  atomically $ throwWhenInactive c
  atomically $ beginAgentOperation c AOSndNetwork
  loop

@@ -2064,7 +2021,7 @@ deleteNtfSubs c deleteCmd = do
 sendNtfConnCommands :: AgentClient -> NtfSupervisorCommand -> AM ()
 sendNtfConnCommands c cmd = do
  ns <- asks ntfSupervisor
-  connIds <- liftIO $ getSubscriptions c
+  connIds <- atomically $ getSubscriptions c
  forM_ connIds $ \connId -> do
    withStore' c (`getConnData` connId) >>= \case
      Just (ConnData {enableNtfs}, _) ->
@@ -2146,7 +2103,7 @@ cleanupManager c@AgentClient {subQ} = do
  liftIO $ threadDelay' delay
  int <- asks (cleanupInterval . config)
  ttl <- asks $ storedMsgDataTTL . config
-  forever $ waitActive $ do
+  forever $ do
    run ERR deleteConns
    run ERR $ withStore' c (`deleteRcvMsgHashesExpired` ttl)
    run ERR $ withStore' c (`deleteSndMsgsExpired` ttl)
@@ -2166,8 +2123,7 @@ cleanupManager c@AgentClient {subQ} = do
      step <- asks $ cleanupStepInterval . config
      liftIO $ threadDelay step
    -- we are catching it to avoid CRITICAL errors in tests when this is the only remaining handle to active
-    waitActive :: ReaderT Env IO a -> AM' ()
-    waitActive a = liftIO (E.tryAny $ waitUntilActive c) >>= either (\_ -> pure ()) (\_ -> void a)
+    waitActive a = liftIO (E.tryAny . atomically $ waitUntilActive c) >>= either (\_ -> pure ()) (\_ -> void a)
    deleteConns =
      withLock (deleteLock c) "cleanupManager" $ do
        void $ withStore' c getDeletedConnIds >>= deleteDeletedConns c
@@ -2257,7 +2213,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
    processSubOk :: RcvQueue -> TVar [ConnId] -> AM ()
    processSubOk rq@RcvQueue {connId} upConnIds =
      atomically . whenM (isPendingSub connId) $ do
-        addSubscription c sessId rq
+        addSubscription c rq
        modifyTVar' upConnIds (connId :)
    processSubErr :: RcvQueue -> SMPClientError -> AM ()
    processSubErr rq@RcvQueue {connId} e = do
@@ -2292,7 +2248,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
              ack' <- handleNotifyAck $ case msg' of
                SMP.ClientRcvMsgBody {msgTs = srvTs, msgFlags, msgBody} -> processClientMsg srvTs msgFlags msgBody
                SMP.ClientRcvMsgQuota {} -> queueDrained >> ack
-              whenM (liftIO $ hasGetLock c rq) $
+              whenM (atomically $ hasGetLock c rq) $
                notify (MSGNTF $ SMP.rcvMessageMeta srvMsgId msg')
              pure ack'
            where
@@ -2531,18 +2487,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                          confId <- withStore c $ \db -> do
                            setConnAgentVersion db connId agentVersion
                            when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport'
-                            -- /
-                            -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion),
-                            -- initiating party initializes ratchet on processing confirmation;
-                            -- previously, it initialized ratchet on allowConnection;
-                            -- this is to support decryption of messages that may be received before allowConnection
-                            liftIO $ do
-                              createRatchet db connId rc'
-                              let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq
-                                  SMPConfirmation {smpClientVersion = v', e2ePubKey = e2ePubKey'} = senderConf
-                                  dhSecret = C.dh' e2ePubKey' e2ePrivKey'
-                              setRcvQueueConfirmedE2E db rq dhSecret $ min v v'
-                            -- /
                            createConfirmation db g newConfirmation
                          let srvs = map qServer $ smpReplyQueues senderConf
                          notify $ CONF confId pqSupport' srvs connInfo
@@ -2826,27 +2770,25 @@ connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _
    Just qInfo' -> do
      -- in case of SKEY retry the connection is already duplex
      sq' <- maybe upgradeConn pure sq_
-      void $ agentSecureSndQueue c cData sq'
+      agentSecureSndQueue c sq'
      enqueueConfirmation c cData sq' ownConnInfo Nothing
      where
        upgradeConn = do
          (sq, _) <- lift $ newSndQueue userId connId qInfo'
          withStore c $ \db -> upgradeRcvConnToDuplex db connId sq

-secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured
+secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
 secureConfirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do
-  sqSecured <- agentSecureSndQueue c cData sq
+  agentSecureSndQueue c sq
  storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation c cData sq srv connInfo subMode
  lift $ submitPendingMsg c cData sq
-  pure sqSecured

-secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured
+secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
 secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do
-  sqSecured <- agentSecureSndQueue c cData sq
+  agentSecureSndQueue c sq
  msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode
  void $ sendConfirmation c sq msg
  withStore' c $ \db -> setSndQueueStatus db sq Confirmed
-  pure sqSecured
  where
    mkConfirmation :: AgentMessage -> AM MsgBody
    mkConfirmation aMessage = do
@@ -2859,17 +2801,11 @@ secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv
        (encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
        pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, encConnInfo}

-agentSecureSndQueue :: AgentClient -> ConnData -> SndQueue -> AM SndQueueSecured
-agentSecureSndQueue c ConnData {connAgentVersion} sq@SndQueue {sndSecure, status}
-  | sndSecure && status == New = do
-      secureSndQueue c sq
-      withStore' c $ \db -> setSndQueueStatus db sq Secured
-      pure initiatorRatchetOnConf
-  -- on repeat JOIN processing (e.g. previous attempt to create reply queue failed)
-  | sndSecure && status == Secured = pure initiatorRatchetOnConf
-  | otherwise = pure False
-  where
-    initiatorRatchetOnConf = connAgentVersion >= ratchetOnConfSMPAgentVersion
+agentSecureSndQueue :: AgentClient -> SndQueue -> AM ()
+agentSecureSndQueue c sq@SndQueue {sndSecure, status} =
+  when (sndSecure && status == New) $ do
+    secureSndQueue c sq
+    withStore' c $ \db -> setSndQueueStatus db sq Secured

 mkAgentConfirmation :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> SubscriptionMode -> AM AgentMessage
 mkAgentConfirmation c cData sq srv connInfo subMode = do
@@ -93,7 +93,6 @@ module Simplex.Messaging.Agent.Client
    AgentServersSummary (..),
    ServerSessions (..),
    SMPServerSubs (..),
-    getAgentSubsTotal,
    getAgentServersSummary,
    getAgentSubscriptions,
    slowNetworkConfig,
@@ -118,7 +117,7 @@ module Simplex.Messaging.Agent.Client
    waitUntilActive,
    UserNetworkInfo (..),
    UserNetworkType (..),
-    getFastNetworkConfig,
+    getNetworkConfig',
    waitForUserNetwork,
    isNetworkOnline,
    isOnline,
@@ -127,7 +126,6 @@ module Simplex.Messaging.Agent.Client
    beginAgentOperation,
    endAgentOperation,
    waitUntilForeground,
-    waitWhileSuspended,
    suspendSendingAndDatabase,
    suspendOperation,
    notifySuspended,
@@ -147,7 +145,6 @@ module Simplex.Messaging.Agent.Client
    incXFTPServerStat,
    incXFTPServerStat',
    incXFTPServerSizeStat,
-    incNtfServerStat,
    AgentWorkersDetails (..),
    getAgentWorkersDetails,
    AgentWorkersSummary (..),
@@ -163,9 +160,9 @@ module Simplex.Messaging.Agent.Client
 where

 import Control.Applicative ((<|>))
-import Control.Concurrent (ThreadId, killThread)
+import Control.Concurrent (ThreadId, forkIO)
 import Control.Concurrent.Async (Async, uninterruptibleCancel)
-import Control.Concurrent.STM (retry)
+import Control.Concurrent.STM (retry, throwSTM)
 import Control.Exception (AsyncException (..), BlockedIndefinitelyOnSTM (..))
 import Control.Logger.Simple
 import Control.Monad
@@ -266,11 +263,10 @@ import Simplex.Messaging.Transport (SMPVersion, SessionId, THandleParams (sessio
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
-import System.Mem.Weak (Weak, deRefWeak)
+import System.Mem.Weak (Weak)
 import System.Random (randomR)
 import UnliftIO (mapConcurrently, timeout)
 import UnliftIO.Async (async)
-import UnliftIO.Concurrent (forkIO, mkWeakThreadId)
 import UnliftIO.Directory (doesFileExist, getTemporaryDirectory, removeFile)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -308,12 +304,13 @@ data AgentClient = AgentClient
    userNetworkInfo :: TVar UserNetworkInfo,
    userNetworkUpdated :: TVar (Maybe UTCTime),
    subscrConns :: TVar (Set ConnId),
-    activeSubs :: TRcvQueues (SessionId, RcvQueue),
-    pendingSubs :: TRcvQueues RcvQueue,
+    activeSubs :: TRcvQueues,
+    pendingSubs :: TRcvQueues,
    removedSubs :: TMap (UserId, SMPServer, SMP.RecipientId) SMPClientError,
    workerSeq :: TVar Int,
    smpDeliveryWorkers :: TMap SndQAddr (Worker, TMVar ()),
-    asyncCmdWorkers :: TMap (ConnId, Maybe SMPServer) Worker,
+    asyncCmdWorkers :: TMap (Maybe SMPServer) Worker,
+    connCmdsQueued :: TMap ConnId Bool,
    ntfNetworkOp :: TVar AgentOpState,
    rcvNetworkOp :: TVar AgentOpState,
    msgDeliveryOp :: TVar AgentOpState,
@@ -333,7 +330,6 @@ data AgentClient = AgentClient
    agentEnv :: Env,
    smpServersStats :: TMap (UserId, SMPServer) AgentSMPServerStats,
    xftpServersStats :: TMap (UserId, XFTPServer) AgentXFTPServerStats,
-    ntfServersStats :: TMap (UserId, NtfServer) AgentNtfServerStats,
    srvStatsStartedAt :: TVar UTCTime
  }

@@ -372,15 +368,13 @@ getAgentWorker' toW fromW name hasWork c key ws work = do
          restart <- atomically $ getWorker >>= maybe (pure False) (shouldRestart e_ (toW w) t maxRestarts)
          when restart runWork
        shouldRestart e_ Worker {workerId = wId, doWork, action, restarts} t maxRestarts w'
-          | wId == workerId (toW w') = do
-              rc <- readTVar restarts
-              isActive <- readTVar $ active c
-              checkRestarts isActive $ updateRestartCount t rc
+          | wId == workerId (toW w') =
+              checkRestarts . updateRestartCount t =<< readTVar restarts
          | otherwise =
              pure False -- there is a new worker in the map, no action
          where
-            checkRestarts isActive rc
-              | isActive && restartCount rc < maxRestarts = do
+            checkRestarts rc
+              | restartCount rc < maxRestarts = do
                  writeTVar restarts rc
                  hasWorkToDo' doWork
                  void $ tryPutTMVar action Nothing
@@ -388,7 +382,7 @@ getAgentWorker' toW fromW name hasWork c key ws work = do
                  pure True
              | otherwise = do
                  TM.delete key ws
-                  when isActive $ notifyErr $ CRITICAL True
+                  notifyErr $ CRITICAL True
                  pure False
              where
                notifyErr err = do
@@ -411,7 +405,7 @@ runWorkerAsync Worker {action} work =
    (atomically . tryPutTMVar action) -- if it was running (or if start crashes), put it back and unlock (don't lock if it was just started)
    (\a -> when (isNothing a) start) -- start worker if it's not running
  where
-    start = atomically . putTMVar action . Just =<< mkWeakThreadId =<< forkIO work
+    start = atomically . putTMVar action . Just =<< async work

 data AgentOperation = AONtfNetwork | AORcvNetwork | AOMsgDelivery | AOSndNetwork | AODatabase
  deriving (Eq, Show)
@@ -455,46 +449,46 @@ data UserNetworkType = UNNone | UNCellular | UNWifi | UNEthernet | UNOther
  deriving (Eq, Show)

 -- | Creates an SMP agent client instance that receives commands and sends responses via 'TBQueue's.
-newAgentClient :: Int -> InitialAgentServers -> UTCTime -> Env -> IO AgentClient
+newAgentClient :: Int -> InitialAgentServers -> UTCTime -> Env -> STM AgentClient
 newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs agentEnv = do
  let cfg = config agentEnv
      qSize = tbqSize cfg
-  acThread <- newTVarIO Nothing
-  active <- newTVarIO True
-  subQ <- newTBQueueIO qSize
-  msgQ <- newTBQueueIO qSize
-  smpServers <- newTVarIO $ M.map mkUserServers smp
-  smpClients <- TM.emptyIO
-  smpProxiedRelays <- TM.emptyIO
-  ntfServers <- newTVarIO ntf
-  ntfClients <- TM.emptyIO
-  xftpServers <- newTVarIO $ M.map mkUserServers xftp
-  xftpClients <- TM.emptyIO
-  useNetworkConfig <- newTVarIO (slowNetworkConfig netCfg, netCfg)
-  userNetworkInfo <- newTVarIO $ UserNetworkInfo UNOther True
-  userNetworkUpdated <- newTVarIO Nothing
-  subscrConns <- newTVarIO S.empty
+  acThread <- newTVar Nothing
+  active <- newTVar True
+  subQ <- newTBQueue qSize
+  msgQ <- newTBQueue qSize
+  smpServers <- newTVar $ M.map mkUserServers smp
+  smpClients <- TM.empty
+  smpProxiedRelays <- TM.empty
+  ntfServers <- newTVar ntf
+  ntfClients <- TM.empty
+  xftpServers <- newTVar $ M.map mkUserServers xftp
+  xftpClients <- TM.empty
+  useNetworkConfig <- newTVar (slowNetworkConfig netCfg, netCfg)
+  userNetworkInfo <- newTVar $ UserNetworkInfo UNOther True
+  userNetworkUpdated <- newTVar Nothing
+  subscrConns <- newTVar S.empty
  activeSubs <- RQ.empty
  pendingSubs <- RQ.empty
-  removedSubs <- TM.emptyIO
-  workerSeq <- newTVarIO 0
-  smpDeliveryWorkers <- TM.emptyIO
-  asyncCmdWorkers <- TM.emptyIO
-  ntfNetworkOp <- newTVarIO $ AgentOpState False 0
-  rcvNetworkOp <- newTVarIO $ AgentOpState False 0
-  msgDeliveryOp <- newTVarIO $ AgentOpState False 0
-  sndNetworkOp <- newTVarIO $ AgentOpState False 0
-  databaseOp <- newTVarIO $ AgentOpState False 0
-  agentState <- newTVarIO ASForeground
-  getMsgLocks <- TM.emptyIO
-  connLocks <- TM.emptyIO
-  invLocks <- TM.emptyIO
-  deleteLock <- atomically createLock
-  smpSubWorkers <- TM.emptyIO
-  smpServersStats <- TM.emptyIO
-  xftpServersStats <- TM.emptyIO
-  ntfServersStats <- TM.emptyIO
-  srvStatsStartedAt <- newTVarIO currentTs
+  removedSubs <- TM.empty
+  workerSeq <- newTVar 0
+  smpDeliveryWorkers <- TM.empty
+  asyncCmdWorkers <- TM.empty
+  connCmdsQueued <- TM.empty
+  ntfNetworkOp <- newTVar $ AgentOpState False 0
+  rcvNetworkOp <- newTVar $ AgentOpState False 0
+  msgDeliveryOp <- newTVar $ AgentOpState False 0
+  sndNetworkOp <- newTVar $ AgentOpState False 0
+  databaseOp <- newTVar $ AgentOpState False 0
+  agentState <- newTVar ASForeground
+  getMsgLocks <- TM.empty
+  connLocks <- TM.empty
+  invLocks <- TM.empty
+  deleteLock <- createLock
+  smpSubWorkers <- TM.empty
+  smpServersStats <- TM.empty
+  xftpServersStats <- TM.empty
+  srvStatsStartedAt <- newTVar currentTs
  return
    AgentClient
      { acThread,
@@ -518,6 +512,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
        workerSeq,
        smpDeliveryWorkers,
        asyncCmdWorkers,
+        connCmdsQueued,
        ntfNetworkOp,
        rcvNetworkOp,
        msgDeliveryOp,
@@ -533,7 +528,6 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
        agentEnv,
        smpServersStats,
        xftpServersStats,
-        ntfServersStats,
        srvStatsStartedAt
      }

@@ -600,7 +594,7 @@ getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
    >>= either newClient (waitForProtocolClient c tSess smpClients)
  where
    newClient v = do
-      prs <- liftIO TM.emptyIO
+      prs <- atomically TM.empty
      smpConnectClient c tSess prs v

 getSMPProxyClient :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
@@ -618,10 +612,11 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
      (tSess,auth,) <$> getSessVar workerSeq tSess smpClients ts
    newProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> UTCTime -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
    newProxyClient tSess auth ts v = do
-      prs <- liftIO TM.emptyIO
-      -- we do not need to check if it is a new proxied relay session,
-      -- as the client is just created and there are no sessions yet
-      rv <- atomically $ either id id <$> getSessVar workerSeq destSrv prs ts
+      (prs, rv) <- atomically $ do
+        prs <- TM.empty
+        -- we do not need to check if it is a new proxied relay session,
+        -- as the client is just created and there are no sessions yet
+        (prs,) . either id id <$> getSessVar workerSeq destSrv prs ts
      clnt <- smpConnectClient c tSess prs v
      (clnt,) <$> newProxiedRelay clnt auth rv
    waitForProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
@@ -647,7 +642,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
            pure $ Left e
    waitForProxiedRelay :: SMPTransportSession -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay)
    waitForProxiedRelay (_, srv, _) rv = do
-      NetworkConfig {tcpConnectTimeout} <- getNetworkConfig c
+      NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
      sess_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar rv)
      pure $ case sess_ of
        Just (Right sess) -> Right sess
@@ -677,13 +672,11 @@ smpClientDisconnected c@AgentClient {active, smpClients, smpProxiedRelays} tSess
    -- because we can have a race condition when a new current client could have already
    -- made subscriptions active, and the old client would be processing diconnection later.
    removeClientAndSubs :: IO ([RcvQueue], [ConnId])
-    removeClientAndSubs = atomically $ do
-      removeSessVar v tSess smpClients
-      ifM (readTVar active) removeSubs (pure ([], []))
+    removeClientAndSubs = atomically $ ifM currentActiveClient removeSubs $ pure ([], [])
      where
-        sessId = sessionId $ thParams client
+        currentActiveClient = (&&) <$> removeSessVar' v tSess smpClients <*> readTVar active
        removeSubs = do
-          (qs, cs) <- RQ.getDelSessQueues tSess sessId $ activeSubs c
+          (qs, cs) <- RQ.getDelSessQueues tSess $ activeSubs c
          RQ.batchAddQueues (pendingSubs c) qs
          -- this removes proxied relays that this client created sessions to
          destSrvs <- M.keys <$> readTVar prs
@@ -708,7 +701,7 @@ resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess = do
  where
    getWorkerVar ts =
      ifM
-        (not <$> RQ.hasSessQueues tSess (pendingSubs c))
+        (null <$> getPending)
        (pure Nothing) -- prevent race with cleanup and adding pending queues in another call
        (Just <$> getSessVar workerSeq tSess smpSubWorkers ts)
    newSubWorker v = do
@@ -716,14 +709,13 @@ resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess = do
      atomically $ putTMVar (sessionVar v) a
    runSubWorker = do
      ri <- asks $ reconnectInterval . config
-      withRetryForeground ri isForeground (isNetworkOnline c) $ \_ loop -> do
-        pending <- liftIO $ RQ.getSessQueues tSess $ pendingSubs c
+      withRetryInterval ri $ \_ loop -> do
+        pending <- atomically getPending
        forM_ (L.nonEmpty pending) $ \qs -> do
-          liftIO $ waitUntilForeground c
          liftIO $ waitForUserNetwork c
          reconnectSMPClient c tSess qs
          loop
-    isForeground = (ASForeground ==) <$> readTVar (agentState c)
+    getPending = RQ.getSessQueues tSess $ pendingSubs c
    cleanup :: SessionVar (Async ()) -> STM ()
    cleanup v = do
      -- Here we wait until TMVar is not empty to prevent worker cleanup happening before worker is added to TMVar.
@@ -788,7 +780,7 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(_, srv
    connectClient :: XFTPClientVar -> AM XFTPClient
    connectClient v = do
      cfg <- asks $ xftpCfg . config
-      xftpNetworkConfig <- getNetworkConfig c
+      xftpNetworkConfig <- atomically $ getNetworkConfig c
      liftError' (protocolClientError XFTP $ B.unpack $ strEncode srv) $
        X.getXFTPClient tSess cfg {xftpNetworkConfig} $
          clientDisconnected v
@@ -807,7 +799,7 @@ waitForProtocolClient ::
  ClientVar msg ->
  AM (Client msg)
 waitForProtocolClient c tSess@(_, srv, _) clients v = do
-  NetworkConfig {tcpConnectTimeout} <- getNetworkConfig c
+  NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
  client_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v)
  case client_ of
    Just (Right smpClient) -> pure smpClient
@@ -858,26 +850,26 @@ hostEvent' event = event (AProtocolType $ protocolTypeI @(ProtoType msg)) . clie
 getClientConfig :: AgentClient -> (AgentConfig -> ProtocolClientConfig v) -> AM' (ProtocolClientConfig v)
 getClientConfig c cfgSel = do
  cfg <- asks $ cfgSel . config
-  networkConfig <- getNetworkConfig c
+  networkConfig <- atomically $ getNetworkConfig c
  pure cfg {networkConfig}

-getNetworkConfig :: MonadIO m => AgentClient -> m NetworkConfig
+getNetworkConfig :: AgentClient -> STM NetworkConfig
 getNetworkConfig c = do
-  (slowCfg, fastCfg) <- readTVarIO $ useNetworkConfig c
-  UserNetworkInfo {networkType} <- readTVarIO $ userNetworkInfo c
+  (slowCfg, fastCfg) <- readTVar (useNetworkConfig c)
+  UserNetworkInfo {networkType} <- readTVar $ userNetworkInfo c
  pure $ case networkType of
    UNCellular -> slowCfg
    UNNone -> slowCfg
    _ -> fastCfg

 -- returns fast network config
-getFastNetworkConfig :: AgentClient -> IO NetworkConfig
-getFastNetworkConfig = fmap snd . readTVarIO . useNetworkConfig
-{-# INLINE getFastNetworkConfig #-}
+getNetworkConfig' :: AgentClient -> IO NetworkConfig
+getNetworkConfig' = fmap snd . readTVarIO . useNetworkConfig
+{-# INLINE getNetworkConfig' #-}

 waitForUserNetwork :: AgentClient -> IO ()
 waitForUserNetwork c =
-  unlessM (isOnline <$> readTVarIO (userNetworkInfo c)) $ do
+  unlessM (atomically $ isNetworkOnline c) $ do
    delay <- registerDelay $ userNetworkInterval $ config $ agentEnv c
    atomically $ unlessM (isNetworkOnline c) $ unlessM (readTVar delay) retry

@@ -891,6 +883,7 @@ closeAgentClient c = do
  atomically (swapTVar (smpSubWorkers c) M.empty) >>= mapM_ cancelReconnect
  clearWorkers smpDeliveryWorkers >>= mapM_ (cancelWorker . fst)
  clearWorkers asyncCmdWorkers >>= mapM_ cancelWorker
+  clear connCmdsQueued
  atomically . RQ.clear $ activeSubs c
  atomically . RQ.clear $ pendingSubs c
  clear subscrConns
@@ -906,20 +899,21 @@ closeAgentClient c = do
 cancelWorker :: Worker -> IO ()
 cancelWorker Worker {doWork, action} = do
  noWorkToDo doWork
-  atomically (tryTakeTMVar action) >>= mapM_ (mapM_ $ deRefWeak >=> mapM_ killThread)
+  atomically (tryTakeTMVar action) >>= mapM_ (mapM_ uninterruptibleCancel)

-waitUntilActive :: AgentClient -> IO ()
-waitUntilActive AgentClient {active} = unlessM (readTVarIO active) $ atomically $ unlessM (readTVar active) retry
+waitUntilActive :: AgentClient -> STM ()
+waitUntilActive c = unlessM (readTVar $ active c) retry
+{-# INLINE waitUntilActive #-}

-throwWhenInactive :: AgentClient -> IO ()
-throwWhenInactive c = unlessM (readTVarIO $ active c) $ E.throwIO ThreadKilled
+throwWhenInactive :: AgentClient -> STM ()
+throwWhenInactive c = unlessM (readTVar $ active c) $ throwSTM ThreadKilled
 {-# INLINE throwWhenInactive #-}

 -- this function is used to remove workers once delivery is complete, not when it is removed from the map
-throwWhenNoDelivery :: AgentClient -> SndQueue -> IO ()
+throwWhenNoDelivery :: AgentClient -> SndQueue -> STM ()
 throwWhenNoDelivery c sq =
-  unlessM (TM.memberIO (qAddress sq) $ smpDeliveryWorkers c) $
-    E.throwIO ThreadKilled
+  unlessM (TM.member (qAddress sq) $ smpDeliveryWorkers c) $
+    throwSTM ThreadKilled

 closeProtocolServerClients :: ProtocolServerClient v err msg => AgentClient -> (AgentClient -> TMap (TransportSession msg) (ClientVar msg)) -> IO ()
 closeProtocolServerClients c clientsSel =
@@ -945,7 +939,7 @@ closeClient c clientSel tSess =

 closeClient_ :: ProtocolServerClient v err msg => AgentClient -> ClientVar msg -> IO ()
 closeClient_ c v = do
-  NetworkConfig {tcpConnectTimeout} <- getNetworkConfig c
+  NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
  E.handle (\BlockedIndefinitelyOnSTM -> pure ()) $
    tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v) >>= \case
      Just (Right client) -> closeProtocolServerClient (protocolClient client) `catchAll_` pure ()
@@ -1033,7 +1027,7 @@ withLogClient c tSess entId cmdStr action = withLogClient_ c tSess entId cmdStr

 withSMPClient :: SMPQueueRec q => AgentClient -> q -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> AM a
 withSMPClient c q cmdStr action = do
-  tSess <- mkSMPTransportSession c q
+  tSess <- liftIO $ mkSMPTransportSession c q
  withLogClient c tSess (queueId q) cmdStr $ action . connectedClient

 sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
@@ -1058,8 +1052,8 @@ sendOrProxySMPCommand ::
  (SMPClient -> ExceptT SMPClientError IO ()) ->
  AM (Maybe SMPServer)
 sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
-  sess <- mkTransportSession c userId destSrv senderId
-  ifM shouldUseProxy (sendViaProxy Nothing sess) (sendDirectly sess $> Nothing)
+  sess <- liftIO $ mkTransportSession c userId destSrv senderId
+  ifM (atomically shouldUseProxy) (sendViaProxy Nothing sess) (sendDirectly sess $> Nothing)
  where
    shouldUseProxy = do
      cfg <- getNetworkConfig c
@@ -1076,7 +1070,7 @@ sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDi
        SPFAllow -> True
        SPFAllowProtected -> ipAddressProtected cfg destSrv
        SPFProhibit -> False
-    unknownServer = liftIO $ maybe True (notElem destSrv . knownSrvs) <$> TM.lookupIO userId (smpServers c)
+    unknownServer = maybe True (notElem destSrv . knownSrvs) <$> TM.lookup userId (smpServers c)
    sendViaProxy :: Maybe SMPServerWithAuth -> SMPTransportSession -> AM (Maybe SMPServer)
    sendViaProxy proxySrv_ destSess@(_, _, qId) = do
      r <- tryAgentError . withProxySession c proxySrv_ destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess@ProxiedRelay {prBasicAuth}) -> do
@@ -1122,7 +1116,7 @@ sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDi
          forM_ r' $ \proxySrv -> atomically $ incSMPServerStat c userId proxySrv sentProxied
          pure r'
        Left e
-          | serverHostError e -> ifM directAllowed (sendDirectly destSess $> Nothing) (throwE e)
+          | serverHostError e -> ifM (atomically directAllowed) (sendDirectly destSess $> Nothing) (throwE e)
          | otherwise -> throwE e
    sendDirectly tSess =
      withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
@@ -1148,7 +1142,7 @@ withXFTPClient ::
  (Client msg -> ExceptT (ProtocolClientError err) IO b) ->
  AM b
 withXFTPClient c (userId, srv, entityId) cmdStr action = do
-  tSess <- mkTransportSession c userId srv entityId
+  tSess <- liftIO $ mkTransportSession c userId srv entityId
  withLogClient c tSess entityId cmdStr action

 liftClient :: (Show err, Encoding err) => (HostName -> err -> AgentErrorType) -> HostName -> ExceptT (ProtocolClientError err) IO a -> AM a
@@ -1220,7 +1214,7 @@ runXFTPServerTest :: AgentClient -> UserId -> XFTPServerWithAuth -> AM' (Maybe P
 runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
  cfg <- asks $ xftpCfg . config
  g <- asks random
-  xftpNetworkConfig <- getNetworkConfig c
+  xftpNetworkConfig <- atomically $ getNetworkConfig c
  workDir <- getXFTPWorkPath
  filePath <- getTempFilePath workDir
  rcvPath <- getTempFilePath workDir
@@ -1291,7 +1285,7 @@ getXFTPWorkPath = do
  workDir <- readTVarIO =<< asks (xftpWorkDir . xftpAgent)
  maybe getTemporaryDirectory pure workDir

-mkTransportSession :: MonadIO m => AgentClient -> UserId -> ProtoServer msg -> EntityId -> m (TransportSession msg)
+mkTransportSession :: AgentClient -> UserId -> ProtoServer msg -> EntityId -> IO (TransportSession msg)
 mkTransportSession c userId srv entityId = mkTSession userId srv entityId <$> getSessionMode c
 {-# INLINE mkTransportSession #-}

@@ -1299,7 +1293,7 @@ mkTSession :: UserId -> ProtoServer msg -> EntityId -> TransportSessionMode -> T
 mkTSession userId srv entityId mode = (userId, srv, if mode == TSMEntity then Just entityId else Nothing)
 {-# INLINE mkTSession #-}

-mkSMPTransportSession :: (SMPQueueRec q, MonadIO m) => AgentClient -> q -> m SMPTransportSession
+mkSMPTransportSession :: SMPQueueRec q => AgentClient -> q -> IO SMPTransportSession
 mkSMPTransportSession c q = mkSMPTSession q <$> getSessionMode c
 {-# INLINE mkSMPTransportSession #-}

@@ -1307,8 +1301,8 @@ mkSMPTSession :: SMPQueueRec q => q -> TransportSessionMode -> SMPTransportSessi
 mkSMPTSession q = mkTSession (qUserId q) (qServer q) (qConnId q)
 {-# INLINE mkSMPTSession #-}

-getSessionMode :: MonadIO m => AgentClient -> m TransportSessionMode
-getSessionMode = fmap sessionMode . getNetworkConfig
+getSessionMode :: AgentClient -> IO TransportSessionMode
+getSessionMode = atomically . fmap sessionMode . getNetworkConfig
 {-# INLINE getSessionMode #-}

 newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SubscriptionMode -> SenderCanSecure -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
@@ -1319,7 +1313,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode sender
  (dhKey, privDhKey) <- atomically $ C.generateKeyPair g
  (e2eDhKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
  logServer "-->" c srv "" "NEW"
-  tSess <- mkTransportSession c userId srv connId
+  tSess <- liftIO $ mkTransportSession c userId srv connId
  (sessId, QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}) <-
    withClient c tSess $ \(SMPConnectedClient smp _) ->
      (sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode senderCanSecure
@@ -1348,8 +1342,8 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode sender
      qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey sndSecure
  pure (rq, qUri, tSess, sessId)

-processSubResult :: AgentClient -> SessionId -> RcvQueue -> Either SMPClientError () -> STM ()
-processSubResult c sessId rq@RcvQueue {userId, server, connId} = \case
+processSubResult :: AgentClient -> RcvQueue -> Either SMPClientError () -> STM ()
+processSubResult c rq@RcvQueue {userId, server, connId} = \case
  Left e ->
    unless (temporaryClientError e) $ do
      incSMPServerStat c userId server connSubErrs
@@ -1357,7 +1351,7 @@ processSubResult c sessId rq@RcvQueue {userId, server, connId} = \case
  Right () ->
    ifM
      (hasPendingSubscription c connId)
-      (incSMPServerStat c userId server connSubscribed >> addSubscription c sessId rq)
+      (incSMPServerStat c userId server connSubscribed >> addSubscription c rq)
      (incSMPServerStat c userId server connSubIgnored)

 temporaryAgentError :: AgentErrorType -> Bool
@@ -1405,7 +1399,7 @@ subscribeQueues c qs = do
  (errs <> rs,) <$> readTVarIO session
  where
    checkQueue rq = do
-      prohibited <- liftIO $ hasGetLock c rq
+      prohibited <- atomically $ hasGetLock c rq
      pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED "subscribeQueues") else Right rq
    subscribeQueues_ :: Env -> TVar (Maybe SessionId) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
    subscribeQueues_ env session smp qs' = do
@@ -1428,7 +1422,7 @@ subscribeQueues c qs = do
        sessId = sessionId $ thParams smp
        hasTempErrors = any (either temporaryClientError (const False) . snd)
        processSubResults :: NonEmpty (RcvQueue, Either SMPClientError ()) -> STM ()
-        processSubResults = mapM_ $ uncurry $ processSubResult c sessId
+        processSubResults = mapM_ $ uncurry $ processSubResult c
        resubscribe = resubscribeSMPSession c tSess `runReaderT` env

 activeClientSession :: AgentClient -> SMPTransportSession -> SessionId -> STM Bool
@@ -1446,7 +1440,7 @@ sendTSessionBatches statCmd toRQ action c qs =
  where
    batchQueues :: AM' [(SMPTransportSession, NonEmpty q)]
    batchQueues = do
-      mode <- getSessionMode c
+      mode <- atomically $ sessionMode <$> getNetworkConfig c
      pure . M.assocs $ foldl' (batch mode) M.empty qs
      where
        batch mode m q =
@@ -1467,10 +1461,10 @@ sendBatch smpCmdFunc smp qs = L.zip qs <$> smpCmdFunc smp (L.map queueCreds qs)
  where
    queueCreds RcvQueue {rcvPrivateKey, rcvId} = (rcvPrivateKey, rcvId)

-addSubscription :: AgentClient -> SessionId -> RcvQueue -> STM ()
-addSubscription c sessId rq@RcvQueue {connId} = do
+addSubscription :: AgentClient -> RcvQueue -> STM ()
+addSubscription c rq@RcvQueue {connId} = do
  modifyTVar' (subscrConns c) $ S.insert connId
-  RQ.addQueue (sessId, rq) $ activeSubs c
+  RQ.addQueue rq $ activeSubs c
  RQ.deleteQueue rq $ pendingSubs c

 failSubscription :: AgentClient -> RcvQueue -> SMPClientError -> STM ()
@@ -1489,7 +1483,7 @@ addNewQueueSubscription c rq tSess sessId = do
    atomically $
      ifM
        (activeClientSession c tSess sessId)
-        (True <$ addSubscription c sessId rq)
+        (True <$ addSubscription c rq)
        (False <$ addPendingSubscription c rq)
  unless same $ resubscribeSMPSession c tSess

@@ -1507,8 +1501,8 @@ removeSubscription c connId = do
  RQ.deleteConn connId $ activeSubs c
  RQ.deleteConn connId $ pendingSubs c

-getSubscriptions :: AgentClient -> IO (Set ConnId)
-getSubscriptions = readTVarIO . subscrConns
+getSubscriptions :: AgentClient -> STM (Set ConnId)
+getSubscriptions = readTVar . subscrConns
 {-# INLINE getSubscriptions #-}

 logServer :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> QueueId -> ByteString -> m ()
@@ -1607,9 +1601,9 @@ sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
    ackSMPMessage smp rcvPrivateKey rcvId msgId
  atomically $ releaseGetLock c rq

-hasGetLock :: AgentClient -> RcvQueue -> IO Bool
+hasGetLock :: AgentClient -> RcvQueue -> STM Bool
 hasGetLock c RcvQueue {server, rcvId} =
-  TM.memberIO (server, rcvId) $ getMsgLocks c
+  TM.member (server, rcvId) $ getMsgLocks c

 releaseGetLock :: AgentClient -> RcvQueue -> STM ()
 releaseGetLock c RcvQueue {server, rcvId} =
@@ -1708,7 +1702,7 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize},
  (sndKey, replicaKey) <- atomically . C.generateAuthKeyPair C.SEd25519 =<< asks random
  let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest}
  logServer "-->" c srv "" "FNEW"
-  tSess <- mkTransportSession c userId srv chunkDigest
+  tSess <- liftIO $ mkTransportSession c userId srv chunkDigest
  (sndId, rIds) <- withClient c tSess $ \xftp -> X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth
  logServer "<--" c srv "" $ B.unwords ["SIDS", logSecret sndId]
  pure NewSndChunkReplica {server = srv, replicaId = ChunkReplicaId sndId, replicaKey, rcvIdsKeys = L.toList $ xftpRcvIdsKeys rIds rKeys}
@@ -1861,28 +1855,16 @@ beginAgentOperation c op = do
  -- unsafeIOToSTM $ putStrLn $ "beginOperation! " <> show op <> " " <> show (opsInProgress s + 1)
  writeTVar opVar $! s {opsInProgress = opsInProgress s + 1}

-agentOperationBracket :: MonadUnliftIO m => AgentClient -> AgentOperation -> (AgentClient -> IO ()) -> m a -> m a
+agentOperationBracket :: MonadUnliftIO m => AgentClient -> AgentOperation -> (AgentClient -> STM ()) -> m a -> m a
 agentOperationBracket c op check action =
  E.bracket
-    (liftIO (check c) >> atomically (beginAgentOperation c op))
+    (atomically (check c) >> atomically (beginAgentOperation c op))
    (\_ -> atomically $ endAgentOperation c op)
    (const action)

-waitUntilForeground :: AgentClient -> IO ()
-waitUntilForeground c =
-  unlessM (foreground readTVarIO) $ atomically $ unlessM (foreground readTVar) retry
-  where
-    foreground :: Monad m => (TVar AgentState -> m AgentState) -> m Bool
-    foreground rd = (ASForeground ==) <$> rd (agentState c)
-
-- This function waits while agent is suspended, but will proceed while it is suspending,
-- to allow completing in-flight operations.
-waitWhileSuspended :: AgentClient -> IO ()
-waitWhileSuspended c =
-  whenM (suspended readTVarIO) $ atomically $ whenM (suspended readTVar) retry
-  where
-    suspended :: Monad m => (TVar AgentState -> m AgentState) -> m Bool
-    suspended rd = (ASSuspended ==) <$> rd (agentState c)
+waitUntilForeground :: AgentClient -> STM ()
+waitUntilForeground c = unlessM ((ASForeground ==) <$> readTVar (agentState c)) retry
+{-# INLINE waitUntilForeground #-}

 withStore' :: AgentClient -> (DB.Connection -> IO a) -> AM a
 withStore' c action = withStore c $ fmap Right . action
@@ -1953,7 +1935,7 @@ getNextServer c userId usedSrvs = withUserServers c userId $ \srvs ->

 withUserServers :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> (NonEmpty (ProtoServerWithAuth p) -> AM a) -> AM a
 withUserServers c userId action =
-  liftIO (TM.lookupIO userId $ userServers c) >>= \case
+  atomically (TM.lookup userId $ userServers c) >>= \case
    Just srvs -> action $ enabledSrvs srvs
    _ -> throwE $ INTERNAL "unknown userId - no user servers"

@@ -1961,17 +1943,24 @@ withNextSrv :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> U
 withNextSrv c userId usedSrvs initUsed action = do
  used <- readTVarIO usedSrvs
  srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId used
-  srvs_ <- liftIO $ TM.lookupIO userId $ userServers c
-  let unused = maybe [] ((\\ used) . map protoServer . L.toList . enabledSrvs) srvs_
-      used' = if null unused then initUsed else srv : used
-  atomically $ writeTVar usedSrvs $! used'
+  atomically $ do
+    srvs_ <- TM.lookup userId $ userServers c
+    let unused = maybe [] ((\\ used) . map protoServer . L.toList . enabledSrvs) srvs_
+        used' = if null unused then initUsed else srv : used
+    writeTVar usedSrvs $! used'
  action srvAuth

 incSMPServerStat :: AgentClient -> UserId -> SMPServer -> (AgentSMPServerStats -> TVar Int) -> STM ()
 incSMPServerStat c userId srv sel = incSMPServerStat' c userId srv sel 1

 incSMPServerStat' :: AgentClient -> UserId -> SMPServer -> (AgentSMPServerStats -> TVar Int) -> Int -> STM ()
-incSMPServerStat' = incServerStat (\AgentClient {smpServersStats = s} -> s) newAgentSMPServerStats
+incSMPServerStat' AgentClient {smpServersStats} userId srv sel n = do
+  TM.lookup (userId, srv) smpServersStats >>= \case
+    Just v -> modifyTVar' (sel v) (+ n)
+    Nothing -> do
+      newStats <- newAgentSMPServerStats
+      modifyTVar' (sel newStats) (+ n)
+      TM.insert (userId, srv) newStats smpServersStats

 incXFTPServerStat :: AgentClient -> UserId -> XFTPServer -> (AgentXFTPServerStats -> TVar Int) -> STM ()
 incXFTPServerStat c userId srv sel = incXFTPServerStat_ c userId srv sel 1
@@ -1986,34 +1975,24 @@ incXFTPServerSizeStat = incXFTPServerStat_
 {-# INLINE incXFTPServerSizeStat #-}

 incXFTPServerStat_ :: Num n => AgentClient -> UserId -> XFTPServer -> (AgentXFTPServerStats -> TVar n) -> n -> STM ()
-incXFTPServerStat_ = incServerStat (\AgentClient {xftpServersStats = s} -> s) newAgentXFTPServerStats
-{-# INLINE incXFTPServerStat_ #-}
-
-incNtfServerStat :: AgentClient -> UserId -> NtfServer -> (AgentNtfServerStats -> TVar Int) -> STM ()
-incNtfServerStat c userId srv sel = incServerStat (\AgentClient {ntfServersStats = s} -> s) newAgentNtfServerStats c userId srv sel 1
-{-# INLINE incNtfServerStat #-}
-
-incServerStat :: Num n => (AgentClient -> TMap (UserId, ProtocolServer p) s) -> STM s -> AgentClient -> UserId -> ProtocolServer p -> (s -> TVar n) -> n -> STM ()
-incServerStat statsSel mkNewStats c userId srv sel n = do
-  TM.lookup (userId, srv) (statsSel c) >>= \case
+incXFTPServerStat_ AgentClient {xftpServersStats} userId srv sel n = do
+  TM.lookup (userId, srv) xftpServersStats >>= \case
    Just v -> modifyTVar' (sel v) (+ n)
    Nothing -> do
-      newStats <- mkNewStats
+      newStats <- newAgentXFTPServerStats
      modifyTVar' (sel newStats) (+ n)
-      TM.insert (userId, srv) newStats (statsSel c)
+      TM.insert (userId, srv) newStats xftpServersStats

 data AgentServersSummary = AgentServersSummary
  { smpServersStats :: Map (UserId, SMPServer) AgentSMPServerStatsData,
    xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData,
-    ntfServersStats :: Map (UserId, NtfServer) AgentNtfServerStatsData,
    statsStartedAt :: UTCTime,
    smpServersSessions :: Map (UserId, SMPServer) ServerSessions,
    smpServersSubs :: Map (UserId, SMPServer) SMPServerSubs,
    xftpServersSessions :: Map (UserId, XFTPServer) ServerSessions,
    xftpRcvInProgress :: [XFTPServer],
    xftpSndInProgress :: [XFTPServer],
-    xftpDelInProgress :: [XFTPServer],
-    ntfServersSessions :: Map (UserId, NtfServer) ServerSessions
+    xftpDelInProgress :: [XFTPServer]
  }
  deriving (Show)

@@ -2030,30 +2009,10 @@ data ServerSessions = ServerSessions
  }
  deriving (Show)

-getAgentSubsTotal :: AgentClient -> [UserId] -> IO (SMPServerSubs, Bool)
-getAgentSubsTotal c userIds = do
-  ssActive <- getSubsCount activeSubs
-  ssPending <- getSubsCount pendingSubs
-  sess <- hasSession . M.toList =<< readTVarIO (smpClients c)
-  pure (SMPServerSubs {ssActive, ssPending}, sess)
-  where
-    getSubsCount :: (AgentClient -> TRcvQueues q) -> IO Int
-    getSubsCount subs = M.foldrWithKey' addSub 0 <$> readTVarIO (getRcvQueues $ subs c)
-    addSub :: (UserId, SMPServer, SMP.RecipientId) -> q -> Int -> Int
-    addSub (userId, _, _) _ cnt = if userId `elem` userIds then cnt + 1 else cnt
-    hasSession :: [(SMPTransportSession, SMPClientVar)] -> IO Bool
-    hasSession = \case
-      [] -> pure False
-      (s : ss) -> ifM (isConnected s) (pure True) (hasSession ss)
-    isConnected ((userId, _, _), SessionVar {sessionVar})
-      | userId `elem` userIds = atomically $ maybe False isRight <$> tryReadTMVar sessionVar
-      | otherwise = pure False
-
 getAgentServersSummary :: AgentClient -> IO AgentServersSummary
-getAgentServersSummary c@AgentClient {smpServersStats, xftpServersStats, ntfServersStats, srvStatsStartedAt, agentEnv} = do
+getAgentServersSummary c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt, agentEnv} = do
  sss <- mapM getAgentSMPServerStats =<< readTVarIO smpServersStats
  xss <- mapM getAgentXFTPServerStats =<< readTVarIO xftpServersStats
-  nss <- mapM getAgentNtfServerStats =<< readTVarIO ntfServersStats
  statsStartedAt <- readTVarIO srvStatsStartedAt
  smpServersSessions <- countSessions =<< readTVarIO (smpClients c)
  smpServersSubs <- getServerSubs
@@ -2061,20 +2020,17 @@ getAgentServersSummary c@AgentClient {smpServersStats, xftpServersStats, ntfServ
  xftpRcvInProgress <- catMaybes <$> getXFTPWorkerSrvs xftpRcvWorkers
  xftpSndInProgress <- catMaybes <$> getXFTPWorkerSrvs xftpSndWorkers
  xftpDelInProgress <- getXFTPWorkerSrvs xftpDelWorkers
-  ntfServersSessions <- countSessions =<< readTVarIO (ntfClients c)
  pure
    AgentServersSummary
      { smpServersStats = sss,
        xftpServersStats = xss,
-        ntfServersStats = nss,
        statsStartedAt,
        smpServersSessions,
        smpServersSubs,
        xftpServersSessions,
        xftpRcvInProgress,
        xftpSndInProgress,
-        xftpDelInProgress,
-        ntfServersSessions
+        xftpDelInProgress
      }
  where
    getServerSubs = do
@@ -2120,7 +2076,6 @@ getAgentSubscriptions c = do
  removedSubscriptions <- getRemovedSubs
  pure $ SubscriptionsInfo {activeSubscriptions, pendingSubscriptions, removedSubscriptions}
  where
-    getSubs :: (AgentClient -> TRcvQueues q) -> IO [SubInfo]
    getSubs sel = map (`subInfo` Nothing) . M.keys <$> readTVarIO (getRcvQueues $ sel c)
    getRemovedSubs = map (uncurry subInfo . second Just) . M.assocs <$> readTVarIO (removedSubs c)
    subInfo :: (UserId, SMPServer, SMP.RecipientId) -> Maybe SMPClientError -> SubInfo
@@ -41,7 +41,6 @@ module Simplex.Messaging.Agent.Env.SQLite
  )
 where

-import Control.Concurrent (ThreadId)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
@@ -52,7 +51,7 @@ import Data.ByteArray (ScrubbedBytes)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
-import Data.Map.Strict (Map)
+import Data.Map (Map)
 import Data.Maybe (fromMaybe)
 import Data.Time.Clock (NominalDiffTime, nominalDay)
 import Data.Time.Clock.System (SystemTime (..))
@@ -77,9 +76,8 @@ import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPVersion, TLS, Transport (..))
 import Simplex.Messaging.Transport.Client (defaultSMPPort)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors')
-import System.Mem.Weak (Weak)
 import System.Random (StdGen, newStdGen)
-import UnliftIO (SomeException)
+import UnliftIO (Async, SomeException)
 import UnliftIO.STM

 type AM' a = ReaderT Env IO a
@@ -150,7 +148,10 @@ data AgentConfig = AgentConfig
    xftpMaxRecipientsPerRequest :: Int,
    deleteErrorCount :: Int,
    ntfCron :: Word16,
+    ntfWorkerDelay :: Int,
+    ntfSMPWorkerDelay :: Int,
    ntfSubCheckInterval :: NominalDiffTime,
+    ntfMaxMessages :: Int,
    caCertificateFile :: FilePath,
    privateKeyFile :: FilePath,
    certificateFile :: FilePath,
@@ -164,7 +165,7 @@ defaultReconnectInterval =
  RetryInterval
    { initialInterval = 2_000000,
      increaseAfter = 10_000000,
-      maxInterval = 180_000000
+      maxInterval = 60_000000
    }

 defaultMessageRetryInterval :: RetryInterval2
@@ -174,7 +175,7 @@ defaultMessageRetryInterval =
        RetryInterval
          { initialInterval = 2_000000,
            increaseAfter = 10_000000,
-            maxInterval = 120_000000
+            maxInterval = 60_000000
          },
      riSlow =
        RetryInterval
@@ -219,7 +220,10 @@ defaultAgentConfig =
      xftpMaxRecipientsPerRequest = 200,
      deleteErrorCount = 10,
      ntfCron = 20, -- minutes
+      ntfWorkerDelay = 100000, -- microseconds
+      ntfSMPWorkerDelay = 500000, -- microseconds
      ntfSubCheckInterval = nominalDay,
+      ntfMaxMessages = 3,
      -- CA certificate private key is not needed for initialization
      -- ! we do not generate these
      caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
@@ -244,8 +248,8 @@ newSMPAgentEnv :: AgentConfig -> SQLiteStore -> IO Env
 newSMPAgentEnv config store = do
  random <- C.newRandom
  randomServer <- newTVarIO =<< liftIO newStdGen
-  ntfSupervisor <- newNtfSubSupervisor $ tbqSize config
-  xftpAgent <- newXFTPAgent
+  ntfSupervisor <- atomically . newNtfSubSupervisor $ tbqSize config
+  xftpAgent <- atomically newXFTPAgent
  multicastSubscribers <- newTMVarIO 0
  pure Env {config, store, random, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}

@@ -262,12 +266,12 @@ data NtfSupervisor = NtfSupervisor
 data NtfSupervisorCommand = NSCCreate | NSCDelete | NSCSmpDelete | NSCNtfWorker NtfServer | NSCNtfSMPWorker SMPServer
  deriving (Show)

-newNtfSubSupervisor :: Natural -> IO NtfSupervisor
+newNtfSubSupervisor :: Natural -> STM NtfSupervisor
 newNtfSubSupervisor qSize = do
-  ntfTkn <- newTVarIO Nothing
-  ntfSubQ <- newTBQueueIO qSize
-  ntfWorkers <- TM.emptyIO
-  ntfSMPWorkers <- TM.emptyIO
+  ntfTkn <- newTVar Nothing
+  ntfSubQ <- newTBQueue qSize
+  ntfWorkers <- TM.empty
+  ntfSMPWorkers <- TM.empty
  pure NtfSupervisor {ntfTkn, ntfSubQ, ntfWorkers, ntfSMPWorkers}

 data XFTPAgent = XFTPAgent
@@ -278,12 +282,12 @@ data XFTPAgent = XFTPAgent
    xftpDelWorkers :: TMap XFTPServer Worker
  }

-newXFTPAgent :: IO XFTPAgent
+newXFTPAgent :: STM XFTPAgent
 newXFTPAgent = do
-  xftpWorkDir <- newTVarIO Nothing
-  xftpRcvWorkers <- TM.emptyIO
-  xftpSndWorkers <- TM.emptyIO
-  xftpDelWorkers <- TM.emptyIO
+  xftpWorkDir <- newTVar Nothing
+  xftpRcvWorkers <- TM.empty
+  xftpSndWorkers <- TM.empty
+  xftpDelWorkers <- TM.empty
  pure XFTPAgent {xftpWorkDir, xftpRcvWorkers, xftpSndWorkers, xftpDelWorkers}

 tryAgentError :: AM a -> AM (Either AgentErrorType a)
@@ -314,7 +318,7 @@ mkInternal = INTERNAL . show
 data Worker = Worker
  { workerId :: Int,
    doWork :: TMVar (),
-    action :: TMVar (Maybe (Weak ThreadId)),
+    action :: TMVar (Maybe (Async ())),
    restarts :: TVar RestartCount
  }

@@ -20,8 +20,8 @@ where

 import Control.Logger.Simple (logError, logInfo)
 import Control.Monad
+import Control.Monad.Except
 import Control.Monad.Reader
-import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
@@ -31,7 +31,6 @@ import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol (AEvent (..), AEvt (..), AgentErrorType (..), BrokerErrorType (..), ConnId, NotificationsMode (..), SAEntity (..))
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Crypto as C
@@ -41,7 +40,7 @@ import Simplex.Messaging.Protocol (NtfServer, SMPServer, sameSrvAddr)
 import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, unlessM)
 import System.Random (randomR)
 import UnliftIO
-import UnliftIO.Concurrent (forkIO)
+import UnliftIO.Concurrent (forkIO, threadDelay)
 import qualified UnliftIO.Exception as E

 runNtfSupervisor :: AgentClient -> AM' ()
@@ -65,7 +64,7 @@ processNtfSub c (connId, cmd) = do
  logInfo $ "processNtfSub - connId = " <> tshow connId <> " - cmd = " <> tshow cmd
  case cmd of
    NSCCreate -> do
-      (a, RcvQueue {userId, server = smpServer, clientNtfCreds}) <- withStore c $ \db -> runExceptT $ do
+      (a, RcvQueue {server = smpServer, clientNtfCreds}) <- withStore c $ \db -> runExceptT $ do
        a <- liftIO $ getNtfSubscription db connId
        q <- ExceptT $ getPrimaryRcvQueue db connId
        pure (a, q)
@@ -75,12 +74,12 @@ processNtfSub c (connId, cmd) = do
          withTokenServer $ \ntfServer -> do
            case clientNtfCreds of
              Just ClientNtfCreds {notifierId} -> do
-                let newSub = newNtfSubscription userId connId smpServer (Just notifierId) ntfServer NASKey
-                withStore c $ \db -> createNtfSubscription db newSub $ NSANtf NSACreate
+                let newSub = newNtfSubscription connId smpServer (Just notifierId) ntfServer NASKey
+                withStore c $ \db -> createNtfSubscription db newSub $ NtfSubNTFAction NSACreate
                lift . void $ getNtfNTFWorker True c ntfServer
              Nothing -> do
-                let newSub = newNtfSubscription userId connId smpServer Nothing ntfServer NASNew
-                withStore c $ \db -> createNtfSubscription db newSub $ NSASMP NSASmpKey
+                let newSub = newNtfSubscription connId smpServer Nothing ntfServer NASNew
+                withStore c $ \db -> createNtfSubscription db newSub $ NtfSubSMPAction NSASmpKey
                lift . void $ getNtfSMPWorker True c smpServer
        (Just (sub@NtfSubscription {ntfSubStatus, ntfServer = subNtfServer, smpServer = smpServer', ntfQueueId}, action_)) -> do
          case (clientNtfCreds, ntfQueueId) of
@@ -100,24 +99,24 @@ processNtfSub c (connId, cmd) = do
                    if ntfSubStatus == NASNew || ntfSubStatus == NASOff || ntfSubStatus == NASDeleted
                      then resetSubscription
                      else withTokenServer $ \ntfServer -> do
-                        withStore' c $ \db -> supervisorUpdateNtfSub db sub {ntfServer} (NSANtf NSACreate)
+                        withStore' c $ \db -> supervisorUpdateNtfSub db sub {ntfServer} (NtfSubNTFAction NSACreate)
                        lift . void $ getNtfNTFWorker True c ntfServer
                | otherwise -> case action of
-                    NSANtf _ -> lift . void $ getNtfNTFWorker True c subNtfServer
-                    NSASMP _ -> lift . void $ getNtfSMPWorker True c smpServer
+                    NtfSubNTFAction _ -> lift . void $ getNtfNTFWorker True c subNtfServer
+                    NtfSubSMPAction _ -> lift . void $ getNtfSMPWorker True c smpServer
            rotate :: AM ()
            rotate = do
-              withStore' c $ \db -> supervisorUpdateNtfSub db sub (NSANtf NSARotate)
+              withStore' c $ \db -> supervisorUpdateNtfSub db sub (NtfSubNTFAction NSARotate)
              lift . void $ getNtfNTFWorker True c subNtfServer
            resetSubscription :: AM ()
            resetSubscription =
              withTokenServer $ \ntfServer -> do
                let sub' = sub {ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
-                withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NSASMP NSASmpKey)
+                withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NtfSubSMPAction NSASmpKey)
                lift . void $ getNtfSMPWorker True c smpServer
    NSCDelete -> do
      sub_ <- withStore' c $ \db -> do
-        supervisorUpdateNtfAction db connId (NSANtf NSADelete)
+        supervisorUpdateNtfAction db connId (NtfSubNTFAction NSADelete)
        getNtfSubscription db connId
      logInfo $ "processNtfSub, NSCDelete - sub_ = " <> tshow sub_
      case sub_ of
@@ -127,7 +126,7 @@ processNtfSub c (connId, cmd) = do
      withStore' c (`getPrimaryRcvQueue` connId) >>= \case
        Right rq@RcvQueue {server = smpServer} -> do
          logInfo $ "processNtfSub, NSCSmpDelete - rq = " <> tshow rq
-          withStore' c $ \db -> supervisorUpdateNtfAction db connId (NSASMP NSASmpDelete)
+          withStore' c $ \db -> supervisorUpdateNtfAction db connId (NtfSubSMPAction NSASmpDelete)
          lift . void $ getNtfSMPWorker True c smpServer
        _ -> notifyInternalError c connId "NSCSmpDelete - no rcv queue"
    NSCNtfWorker ntfServer -> lift . void $ getNtfNTFWorker True c ntfServer
@@ -147,10 +146,12 @@ withTokenServer :: (NtfServer -> AM ()) -> AM ()
 withTokenServer action = lift getNtfToken >>= mapM_ (\NtfToken {ntfServer} -> action ntfServer)

 runNtfWorker :: AgentClient -> NtfServer -> Worker -> AM ()
-runNtfWorker c srv Worker {doWork} =
+runNtfWorker c srv Worker {doWork} = do
+  delay <- asks $ ntfWorkerDelay . config
  forever $ do
    waitForWork doWork
    ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfOperation
+    threadDelay delay
  where
    runNtfOperation :: AM ()
    runNtfOperation =
@@ -159,73 +160,70 @@ runNtfWorker c srv Worker {doWork} =
          logInfo $ "runNtfWorker, nextSub " <> tshow nextSub
          ri <- asks $ reconnectInterval . config
          withRetryInterval ri $ \_ loop -> do
-            liftIO $ waitWhileSuspended c
            liftIO $ waitForUserNetwork c
            processSub nextSub
              `catchAgentError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
    processSub :: (NtfSubscription, NtfSubNTFAction, NtfActionTs) -> AM ()
-    processSub (sub@NtfSubscription {userId, connId, smpServer, ntfSubId}, action, actionTs) = do
+    processSub (sub@NtfSubscription {connId, smpServer, ntfSubId}, action, actionTs) = do
      ts <- liftIO getCurrentTime
      unlessM (lift $ rescheduleAction doWork ts actionTs) $
        case action of
          NSACreate ->
            lift getNtfToken >>= \case
-              Just tkn@NtfToken {ntfServer, ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
+              Just tkn@NtfToken {ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
                RcvQueue {clientNtfCreds} <- withStore c (`getPrimaryRcvQueue` connId)
                case clientNtfCreds of
                  Just ClientNtfCreds {ntfPrivateKey, notifierId} -> do
-                    atomically $ incNtfServerStat c userId ntfServer ntfCreateAttempts
                    nSubId <- agentNtfCreateSubscription c tknId tkn (SMPQueueNtf smpServer notifierId) ntfPrivateKey
-                    atomically $ incNtfServerStat c userId ntfServer ntfCreated
                    -- possible improvement: smaller retry until Active, less frequently (daily?) once Active
                    let actionTs' = addUTCTime 30 ts
                    withStore' c $ \db ->
-                      updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NSANtf NSACheck) actionTs'
+                      updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NtfSubNTFAction NSACheck) actionTs'
                  _ -> workerInternalError c connId "NSACreate - no notifier queue credentials"
              _ -> workerInternalError c connId "NSACreate - no active token"
          NSACheck ->
            lift getNtfToken >>= \case
-              Just tkn@NtfToken {ntfServer} ->
+              Just tkn ->
                case ntfSubId of
-                  Just nSubId -> do
-                    atomically $ incNtfServerStat c userId ntfServer ntfCheckAttempts
+                  Just nSubId ->
                    agentNtfCheckSubscription c nSubId tkn >>= \case
                      NSAuth -> do
-                        withStore' c $ \db ->
-                          updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NSASMP NSASmpKey) ts
-                        ns <- asks ntfSupervisor
-                        atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
+                        lift (getNtfServer c) >>= \case
+                          Just ntfServer -> do
+                            withStore' c $ \db ->
+                              updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NtfSubSMPAction NSASmpKey) ts
+                            ns <- asks ntfSupervisor
+                            atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
+                          _ -> workerInternalError c connId "NSACheck - failed to reset subscription, notification server not configured"
                      status -> updateSubNextCheck ts status
-                    atomically $ incNtfServerStat c userId ntfServer ntfChecked
                  Nothing -> workerInternalError c connId "NSACheck - no subscription ID"
              _ -> workerInternalError c connId "NSACheck - no active token"
-          NSADelete ->
-            deleteNtfSub $ do
-              let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
-              withStore' c $ \db -> updateNtfSubscription db sub' (NSASMP NSASmpDelete) ts
-              ns <- asks ntfSupervisor
-              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
-          NSARotate ->
-            deleteNtfSub $ do
-              withStore' c $ \db -> deleteNtfSubscription db connId
-              ns <- asks ntfSupervisor
-              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCCreate)
+          NSADelete -> case ntfSubId of
+            Just nSubId ->
+              (lift getNtfToken >>= mapM_ (agentNtfDeleteSubscription c nSubId))
+                `agentFinally` continueDeletion
+            _ -> continueDeletion
+            where
+              continueDeletion = do
+                let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
+                withStore' c $ \db -> updateNtfSubscription db sub' (NtfSubSMPAction NSASmpDelete) ts
+                ns <- asks ntfSupervisor
+                atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
+          NSARotate -> case ntfSubId of
+            Just nSubId ->
+              (lift getNtfToken >>= mapM_ (agentNtfDeleteSubscription c nSubId))
+                `agentFinally` deleteCreate
+            _ -> deleteCreate
+            where
+              deleteCreate = do
+                withStore' c $ \db -> deleteNtfSubscription db connId
+                ns <- asks ntfSupervisor
+                atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCCreate)
      where
-        deleteNtfSub continue = case ntfSubId of
-          Just nSubId ->
-            lift getNtfToken >>= \case
-              Just tkn@NtfToken {ntfServer} -> do
-                atomically $ incNtfServerStat c userId ntfServer ntfDelAttempts
-                tryAgentError (agentNtfDeleteSubscription c nSubId tkn) >>= \case
-                  Left e | temporaryOrHostError e -> throwE e
-                  _ -> continue
-                atomically $ incNtfServerStat c userId ntfServer ntfDeleted
-              Nothing -> continue
-          _ -> continue
        updateSubNextCheck ts toStatus = do
          checkInterval <- asks $ ntfSubCheckInterval . config
          let nextCheckTs = addUTCTime checkInterval ts
-          updateSub (NASCreated toStatus) (NSANtf NSACheck) nextCheckTs
+          updateSub (NASCreated toStatus) (NtfSubNTFAction NSACheck) nextCheckTs
        updateSub toStatus toAction actionTs' =
          withStore' c $ \db ->
            updateNtfSubscription db sub {ntfSubStatus = toStatus} toAction actionTs'
@@ -233,10 +231,12 @@ runNtfWorker c srv Worker {doWork} =
 runNtfSMPWorker :: AgentClient -> SMPServer -> Worker -> AM ()
 runNtfSMPWorker c srv Worker {doWork} = do
  env <- ask
+  delay <- asks $ ntfSMPWorkerDelay . config
  forever $ do
    waitForWork doWork
    ExceptT . liftIO . agentOperationBracket c AONtfNetwork throwWhenInactive $
      runReaderT (runExceptT runNtfSMPOperation) env
+    threadDelay delay
  where
    runNtfSMPOperation =
      withWork c doWork (`getNextNtfSubSMPAction` srv) $
@@ -244,7 +244,6 @@ runNtfSMPWorker c srv Worker {doWork} = do
          logInfo $ "runNtfSMPWorker, nextSub " <> tshow nextSub
          ri <- asks $ reconnectInterval . config
          withRetryInterval ri $ \_ loop -> do
-            liftIO $ waitWhileSuspended c
            liftIO $ waitForUserNetwork c
            processSub nextSub
              `catchAgentError` retryOnError c "NtfSMPWorker" loop (workerInternalError c connId . show)
@@ -265,12 +264,11 @@ runNtfSMPWorker c srv Worker {doWork} = do
                let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
                withStore' c $ \db -> do
                  setRcvQueueNtfCreds db connId $ Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
-                  updateNtfSubscription db sub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NSANtf NSACreate) ts
+                  updateNtfSubscription db sub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NtfSubNTFAction NSACreate) ts
                ns <- asks ntfSupervisor
                atomically $ sendNtfSubCommand ns (connId, NSCNtfWorker ntfServer)
              _ -> workerInternalError c connId "NSASmpKey - no active token"
          NSASmpDelete -> do
-            -- TODO should we remove it after successful removal from the server?
            rq_ <- withStore' c $ \db -> do
              setRcvQueueNtfCreds db connId Nothing
              getPrimaryRcvQueue db connId
@@ -297,7 +295,7 @@ retryOnError c name loop done e = do
  where
    retryLoop = do
      atomically $ endAgentOperation c AONtfNetwork
-      liftIO $ throwWhenInactive c
+      atomically $ throwWhenInactive c
      atomically $ beginAgentOperation c AONtfNetwork
      loop

@@ -42,7 +42,6 @@ module Simplex.Messaging.Agent.Protocol
    deliveryRcptsSMPAgentVersion,
    pqdrSMPAgentVersion,
    sndAuthKeySMPAgentVersion,
-    ratchetOnConfSMPAgentVersion,
    currentSMPAgentVersion,
    supportedSMPAgentVRange,
    e2eEncConnInfoLength,
@@ -50,7 +49,6 @@ module Simplex.Messaging.Agent.Protocol

    -- * SMP agent protocol types
    ConnInfo,
-    SndQueueSecured,
    ACommand (..),
    AEvent (..),
    AEvt (..),
@@ -155,8 +153,8 @@ import Data.Int (Int64)
 import Data.Kind (Type)
 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.Map (Map)
+import qualified Data.Map as M
 import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@@ -259,14 +257,11 @@ pqdrSMPAgentVersion = VersionSMPA 5
 sndAuthKeySMPAgentVersion :: VersionSMPA
 sndAuthKeySMPAgentVersion = VersionSMPA 6

-ratchetOnConfSMPAgentVersion :: VersionSMPA
-ratchetOnConfSMPAgentVersion = VersionSMPA 7
-
 minSupportedSMPAgentVersion :: VersionSMPA
 minSupportedSMPAgentVersion = duplexHandshakeSMPAgentVersion

 currentSMPAgentVersion :: VersionSMPA
-currentSMPAgentVersion = VersionSMPA 7
+currentSMPAgentVersion = VersionSMPA 6

 supportedSMPAgentVRange :: VersionRangeSMPA
 supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPAgentVersion
@@ -332,8 +327,6 @@ deriving instance Show AEvt

 type ConnInfo = ByteString

-type SndQueueSecured = Bool
-
 -- | Parameterized type for SMP agent events
 data AEvent (e :: AEntity) where
  INV :: AConnectionRequestUri -> AEvent AEConn
@@ -361,7 +354,6 @@ data AEvent (e :: AEntity) where
  DEL_USER :: Int64 -> AEvent AENone
  STAT :: ConnectionStats -> AEvent AEConn
  OK :: AEvent AEConn
-  JOINED :: SndQueueSecured -> AEvent AEConn
  ERR :: AgentErrorType -> AEvent AEConn
  SUSPENDED :: AEvent AENone
  RFPROG :: Int64 -> Int64 -> AEvent AERcvFile
@@ -430,7 +422,6 @@ data AEventTag (e :: AEntity) where
  DEL_USER_ :: AEventTag AENone
  STAT_ :: AEventTag AEConn
  OK_ :: AEventTag AEConn
-  JOINED_ :: AEventTag AEConn
  ERR_ :: AEventTag AEConn
  SUSPENDED_ :: AEventTag AENone
  -- XFTP commands and responses
@@ -483,7 +474,6 @@ aEventTag = \case
  DEL_USER _ -> DEL_USER_
  STAT _ -> STAT_
  OK -> OK_
-  JOINED _ -> JOINED_
  ERR _ -> ERR_
  SUSPENDED -> SUSPENDED_
  RFPROG {} -> RFPROG_
@@ -9,7 +9,6 @@ module Simplex.Messaging.Agent.RetryInterval
    RI2State (..),
    withRetryInterval,
    withRetryIntervalCount,
-    withRetryForeground,
    withRetryLock2,
    updateRetryInterval2,
    nextRetryDelay,
@@ -17,11 +16,10 @@ module Simplex.Messaging.Agent.RetryInterval
 where

 import Control.Concurrent (forkIO)
-import Control.Concurrent.STM (retry)
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Int (Int64)
-import Simplex.Messaging.Util (threadDelay', unlessM, whenM)
+import Simplex.Messaging.Util (threadDelay', whenM)
 import UnliftIO.STM

 data RetryInterval = RetryInterval
@@ -65,27 +63,6 @@ withRetryIntervalCount ri action = callAction 0 0 $ initialInterval ri
          let elapsed' = elapsed + delay
          callAction (n + 1) elapsed' $ nextRetryDelay elapsed' delay ri

-withRetryForeground :: forall m a. MonadIO m => RetryInterval -> STM Bool -> STM Bool -> (Int64 -> m a -> m a) -> m a
-withRetryForeground ri isForeground isOnline action = callAction 0 $ initialInterval ri
-  where
-    callAction :: Int64 -> Int64 -> m a
-    callAction elapsed delay = action delay loop
-      where
-        loop = do
-          -- limit delay to max Int value (~36 minutes on for 32 bit architectures)
-          d <- registerDelay $ fromIntegral $ min delay (fromIntegral (maxBound :: Int))
-          (wasForeground, wasOnline) <- atomically $ (,) <$> isForeground <*> isOnline
-          reset <- atomically $ do
-            foreground <- isForeground
-            online <- isOnline
-            let reset = (not wasForeground && foreground) || (not wasOnline && online)
-            unlessM ((reset ||) <$> readTVar d) retry
-            pure reset
-          let (elapsed', delay')
-                | reset = (0, initialInterval ri)
-                | otherwise = (elapsed + delay, nextRetryDelay elapsed' delay ri)
-          callAction elapsed' delay'
-
 -- This function allows action to toggle between slow and fast retry intervals.
 withRetryLock2 :: forall m. MonadIO m => RetryInterval2 -> TMVar () -> (RI2State -> (RetryIntervalMode -> m ()) -> m ()) -> m ()
 withRetryLock2 RetryInterval2 {riSlow, riFast} lock action =
@@ -1,20 +1,17 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TemplateHaskell #-}

 module Simplex.Messaging.Agent.Stats where

-import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..))
 import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
+import Data.Map (Map)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.Protocol (UserId)
 import Simplex.Messaging.Parsers (defaultJSON, fromTextField_)
-import Simplex.Messaging.Protocol (SMPServer, XFTPServer, NtfServer)
+import Simplex.Messaging.Protocol (SMPServer, XFTPServer)
 import Simplex.Messaging.Util (decodeJSON, encodeJSON)
 import UnliftIO.STM

@@ -47,12 +44,7 @@ data AgentSMPServerStats = AgentSMPServerStats
    connSubscribed :: TVar Int, -- total successful subscription
    connSubAttempts :: TVar Int, -- subscription attempts
    connSubIgnored :: TVar Int, -- subscription results ignored (client switched to different session or it was not pending)
-    connSubErrs :: TVar Int, -- permanent subscription errors (temporary accounted for in attempts)
-    -- notifications stats
-    ntfKey :: TVar Int,
-    ntfKeyAttempts :: TVar Int,
-    ntfKeyDeleted :: TVar Int,
-    ntfKeyDeleteAttempts :: TVar Int
+    connSubErrs :: TVar Int -- permanent subscription errors (temporary accounted for in attempts)
  }

 data AgentSMPServerStatsData = AgentSMPServerStatsData
@@ -83,17 +75,10 @@ data AgentSMPServerStatsData = AgentSMPServerStatsData
    _connSubscribed :: Int,
    _connSubAttempts :: Int,
    _connSubIgnored :: Int,
-    _connSubErrs :: Int,
-    _ntfKey :: OptionalInt,
-    _ntfKeyAttempts :: OptionalInt,
-    _ntfKeyDeleted :: OptionalInt,
-    _ntfKeyDeleteAttempts :: OptionalInt
+    _connSubErrs :: Int
  }
  deriving (Show)

-newtype OptionalInt = OInt {toInt :: Int}
-  deriving (Num, Show, ToJSON)
-
 newAgentSMPServerStats :: STM AgentSMPServerStats
 newAgentSMPServerStats = do
  sentDirect <- newTVar 0
@@ -124,10 +109,6 @@ newAgentSMPServerStats = do
  connSubAttempts <- newTVar 0
  connSubIgnored <- newTVar 0
  connSubErrs <- newTVar 0
-  ntfKey <- newTVar 0
-  ntfKeyAttempts <- newTVar 0
-  ntfKeyDeleted <- newTVar 0
-  ntfKeyDeleteAttempts <- newTVar 0
  pure
    AgentSMPServerStats
      { sentDirect,
@@ -157,11 +138,7 @@ newAgentSMPServerStats = do
        connSubscribed,
        connSubAttempts,
        connSubIgnored,
-        connSubErrs,
-        ntfKey,
-        ntfKeyAttempts,
-        ntfKeyDeleted,
-        ntfKeyDeleteAttempts
+        connSubErrs
      }

 newAgentSMPServerStatsData :: AgentSMPServerStatsData
@@ -194,11 +171,7 @@ newAgentSMPServerStatsData =
      _connSubscribed = 0,
      _connSubAttempts = 0,
      _connSubIgnored = 0,
-      _connSubErrs = 0,
-      _ntfKey = 0,
-      _ntfKeyAttempts = 0,
-      _ntfKeyDeleted = 0,
-      _ntfKeyDeleteAttempts = 0
+      _connSubErrs = 0
    }

 newAgentSMPServerStats' :: AgentSMPServerStatsData -> STM AgentSMPServerStats
@@ -231,10 +204,6 @@ newAgentSMPServerStats' s = do
  connSubAttempts <- newTVar $ _connSubAttempts s
  connSubIgnored <- newTVar $ _connSubIgnored s
  connSubErrs <- newTVar $ _connSubErrs s
-  ntfKey <- newTVar $ toInt $ _ntfKey s
-  ntfKeyAttempts <- newTVar $ toInt $ _ntfKeyAttempts s
-  ntfKeyDeleted <- newTVar $ toInt $ _ntfKeyDeleted s
-  ntfKeyDeleteAttempts <- newTVar $ toInt $ _ntfKeyDeleteAttempts s
  pure
    AgentSMPServerStats
      { sentDirect,
@@ -264,11 +233,7 @@ newAgentSMPServerStats' s = do
        connSubscribed,
        connSubAttempts,
        connSubIgnored,
-        connSubErrs,
-        ntfKey,
-        ntfKeyAttempts,
-        ntfKeyDeleted,
-        ntfKeyDeleteAttempts
+        connSubErrs
      }

 -- as this is used to periodically update stats in db,
@@ -303,10 +268,6 @@ getAgentSMPServerStats s = do
  _connSubAttempts <- readTVarIO $ connSubAttempts s
  _connSubIgnored <- readTVarIO $ connSubIgnored s
  _connSubErrs <- readTVarIO $ connSubErrs s
-  _ntfKey <- OInt <$> readTVarIO (ntfKey s)
-  _ntfKeyAttempts <- OInt <$> readTVarIO (ntfKeyAttempts s)
-  _ntfKeyDeleted <- OInt <$> readTVarIO (ntfKeyDeleted s)
-  _ntfKeyDeleteAttempts <- OInt <$> readTVarIO (ntfKeyDeleteAttempts s)
  pure
    AgentSMPServerStatsData
      { _sentDirect,
@@ -336,11 +297,7 @@ getAgentSMPServerStats s = do
        _connSubscribed,
        _connSubAttempts,
        _connSubIgnored,
-        _connSubErrs,
-        _ntfKey,
-        _ntfKeyAttempts,
-        _ntfKeyDeleted,
-        _ntfKeyDeleteAttempts
+        _connSubErrs
      }

 addSMPStatsData :: AgentSMPServerStatsData -> AgentSMPServerStatsData -> AgentSMPServerStatsData
@@ -373,11 +330,7 @@ addSMPStatsData sd1 sd2 =
      _connSubscribed = _connSubscribed sd1 + _connSubscribed sd2,
      _connSubAttempts = _connSubAttempts sd1 + _connSubAttempts sd2,
      _connSubIgnored = _connSubIgnored sd1 + _connSubIgnored sd2,
-      _connSubErrs = _connSubErrs sd1 + _connSubErrs sd2,
-      _ntfKey = _ntfKey sd1 + _ntfKey sd2,
-      _ntfKeyAttempts = _ntfKeyAttempts sd1 + _ntfKeyAttempts sd2,
-      _ntfKeyDeleted = _ntfKeyDeleted sd1 + _ntfKeyDeleted sd2,
-      _ntfKeyDeleteAttempts = _ntfKeyDeleteAttempts sd1 + _ntfKeyDeleteAttempts sd2
+      _connSubErrs = _connSubErrs sd1 + _connSubErrs sd2
    }

 data AgentXFTPServerStats = AgentXFTPServerStats
@@ -537,127 +490,18 @@ addXFTPStatsData sd1 sd2 =
      _deleteErrs = _deleteErrs sd1 + _deleteErrs sd2
    }

-data AgentNtfServerStats = AgentNtfServerStats
-  { ntfCreated :: TVar Int,
-    ntfCreateAttempts :: TVar Int,
-    ntfChecked :: TVar Int,
-    ntfCheckAttempts :: TVar Int,
-    ntfDeleted :: TVar Int,
-    ntfDelAttempts :: TVar Int
-  }
-
-data AgentNtfServerStatsData = AgentNtfServerStatsData
-  { _ntfCreated :: Int,
-    _ntfCreateAttempts :: Int,
-    _ntfChecked :: Int,
-    _ntfCheckAttempts :: Int,
-    _ntfDeleted :: Int,
-    _ntfDelAttempts :: Int
-  }
-  deriving (Show)
-
-newAgentNtfServerStats :: STM AgentNtfServerStats
-newAgentNtfServerStats = do
-  ntfCreated <- newTVar 0
-  ntfCreateAttempts <- newTVar 0
-  ntfChecked <- newTVar 0
-  ntfCheckAttempts <- newTVar 0
-  ntfDeleted <- newTVar 0
-  ntfDelAttempts <- newTVar 0
-  pure
-    AgentNtfServerStats
-      { ntfCreated,
-        ntfCreateAttempts,
-        ntfChecked,
-        ntfCheckAttempts,
-        ntfDeleted,
-        ntfDelAttempts
-      }
-
-newAgentNtfServerStatsData :: AgentNtfServerStatsData
-newAgentNtfServerStatsData =
-  AgentNtfServerStatsData
-    { _ntfCreated = 0,
-      _ntfCreateAttempts = 0,
-      _ntfChecked = 0,
-      _ntfCheckAttempts = 0,
-      _ntfDeleted = 0,
-      _ntfDelAttempts = 0
-    }
-
-newAgentNtfServerStats' :: AgentNtfServerStatsData -> STM AgentNtfServerStats
-newAgentNtfServerStats' s = do
-  ntfCreated <- newTVar $ _ntfCreated s
-  ntfCreateAttempts <- newTVar $ _ntfCreateAttempts s
-  ntfChecked <- newTVar $ _ntfChecked s
-  ntfCheckAttempts <- newTVar $ _ntfCheckAttempts s
-  ntfDeleted <- newTVar $ _ntfDeleted s
-  ntfDelAttempts <- newTVar $ _ntfDelAttempts s
-  pure
-    AgentNtfServerStats
-      { ntfCreated,
-        ntfCreateAttempts,
-        ntfChecked,
-        ntfCheckAttempts,
-        ntfDeleted,
-        ntfDelAttempts
-      }
-
-getAgentNtfServerStats :: AgentNtfServerStats -> IO AgentNtfServerStatsData
-getAgentNtfServerStats s = do
-  _ntfCreated <- readTVarIO $ ntfCreated s
-  _ntfCreateAttempts <- readTVarIO $ ntfCreateAttempts s
-  _ntfChecked <- readTVarIO $ ntfChecked s
-  _ntfCheckAttempts <- readTVarIO $ ntfCheckAttempts s
-  _ntfDeleted <- readTVarIO $ ntfDeleted s
-  _ntfDelAttempts <- readTVarIO $ ntfDelAttempts s
-  pure
-    AgentNtfServerStatsData
-      { _ntfCreated,
-        _ntfCreateAttempts,
-        _ntfChecked,
-        _ntfCheckAttempts,
-        _ntfDeleted,
-        _ntfDelAttempts
-      }
-
-addNtfStatsData :: AgentNtfServerStatsData -> AgentNtfServerStatsData -> AgentNtfServerStatsData
-addNtfStatsData sd1 sd2 =
-  AgentNtfServerStatsData
-    { _ntfCreated = _ntfCreated sd1 + _ntfCreated sd2,
-      _ntfCreateAttempts = _ntfCreateAttempts sd1 + _ntfCreateAttempts sd2,
-      _ntfChecked = _ntfChecked sd1 + _ntfChecked sd2,
-      _ntfCheckAttempts = _ntfCheckAttempts sd1 + _ntfCheckAttempts sd2,
-      _ntfDeleted = _ntfDeleted sd1 + _ntfDeleted sd2,
-      _ntfDelAttempts = _ntfDelAttempts sd1 + _ntfDelAttempts sd2
-    }
-
 -- Type for gathering both smp and xftp stats across all users and servers,
 -- to then be persisted to db as a single json.
 data AgentPersistedServerStats = AgentPersistedServerStats
  { smpServersStats :: Map (UserId, SMPServer) AgentSMPServerStatsData,
-    xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData,
-    ntfServersStats :: OptionalMap (UserId, NtfServer) AgentNtfServerStatsData
+    xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData
  }
  deriving (Show)

-instance FromJSON OptionalInt where
-  parseJSON v = OInt <$> parseJSON v
-  omittedField = Just (OInt 0)
-
-newtype OptionalMap k v = OptionalMap (Map k v)
-  deriving (Show, ToJSON)
-
-instance (FromJSONKey k, Ord k, FromJSON v) => FromJSON (OptionalMap k v) where
-  parseJSON v = OptionalMap <$> parseJSON v
-  omittedField = Just (OptionalMap M.empty)
-
 $(J.deriveJSON defaultJSON ''AgentSMPServerStatsData)

 $(J.deriveJSON defaultJSON ''AgentXFTPServerStatsData)

-$(J.deriveJSON defaultJSON ''AgentNtfServerStatsData)
-
 $(J.deriveJSON defaultJSON ''AgentPersistedServerStats)

 instance ToField AgentPersistedServerStats where
@@ -57,7 +57,6 @@ module Simplex.Messaging.Agent.Store.SQLite
    getDeletedConns,
    getConnData,
    setConnDeleted,
-    setConnUserId,
    setConnAgentVersion,
    setConnPQSupport,
    getDeletedConnIds,
@@ -111,7 +110,6 @@ module Simplex.Messaging.Agent.Store.SQLite
    getSndMsgViaRcpt,
    updateSndMsgRcpt,
    getPendingQueueMsg,
-    getConnectionsForDelivery,
    updatePendingMsgRIState,
    deletePendingMsgs,
    getExpiredSndMessages,
@@ -137,7 +135,6 @@ module Simplex.Messaging.Agent.Store.SQLite
    createCommand,
    getPendingCommandServers,
    getPendingServerCommand,
-    updateCommandServer,
    deleteCommand,
    -- Notification device token persistence
    createNtfToken,
@@ -223,7 +220,7 @@ module Simplex.Messaging.Agent.Store.SQLite
    -- * utilities
    withConnection,
    withTransaction,
-    withTransactionPriority,
+    withTransactionCtx,
    firstRow,
    firstRow',
    maybeFirstRow,
@@ -395,10 +392,10 @@ connectSQLiteStore dbFilePath key keepKey = do
  dbNew <- not <$> doesFileExist dbFilePath
  dbConn <- dbBusyLoop (connectDB dbFilePath key)
  dbConnection <- newMVar dbConn
-  dbKey <- newTVarIO $! storeKey key keepKey
-  dbClosed <- newTVarIO False
-  dbSem <- newTVarIO 0
-  pure SQLiteStore {dbFilePath, dbKey, dbSem, dbConnection, dbNew, dbClosed}
+  atomically $ do
+    dbKey <- newTVar $! storeKey key keepKey
+    dbClosed <- newTVar False
+    pure SQLiteStore {dbFilePath, dbKey, dbConnection, dbNew, dbClosed}

 connectDB :: FilePath -> ScrubbedBytes -> IO DB.Connection
 connectDB path key = do
@@ -1011,10 +1008,6 @@ updateSndMsgRcpt db connId sndMsgId MsgReceipt {agentMsgId, msgRcptStatus} =
    "UPDATE snd_messages SET rcpt_internal_id = ?, rcpt_status = ? WHERE conn_id = ? AND internal_snd_id = ?"
    (agentMsgId, msgRcptStatus, connId, sndMsgId)

-getConnectionsForDelivery :: DB.Connection -> IO [ConnId]
-getConnectionsForDelivery db =
-  map fromOnly <$> DB.query_ db "SELECT DISTINCT conn_id FROM snd_message_deliveries WHERE failed = 0"
-
 getPendingQueueMsg :: DB.Connection -> ConnId -> SndQueue -> IO (Either StoreError (Maybe (Maybe RcvQueue, PendingMsgData)))
 getPendingQueueMsg db connId SndQueue {dbQueueId} =
  getWorkItem "message" getMsgId getMsgData markMsgFailed
@@ -1324,39 +1317,38 @@ getPendingCommandServers db connId = do
  where
    smpServer (host, port, keyHash) = SMPServer <$> host <*> port <*> keyHash

-getPendingServerCommand :: DB.Connection -> ConnId -> Maybe SMPServer -> IO (Either StoreError (Maybe PendingCommand))
-getPendingServerCommand db connId srv_ = getWorkItem "command" getCmdId getCommand markCommandFailed
+getPendingServerCommand :: DB.Connection -> Maybe SMPServer -> IO (Either StoreError (Maybe PendingCommand))
+getPendingServerCommand db srv_ = getWorkItem "command" getCmdId getCommand markCommandFailed
  where
    getCmdId :: IO (Maybe Int64)
    getCmdId =
      maybeFirstRow fromOnly $ case srv_ of
        Nothing ->
-          DB.query
+          DB.query_
            db
            [sql|
              SELECT command_id FROM commands
-              WHERE conn_id = ? AND host IS NULL AND port IS NULL AND failed = 0
+              WHERE host IS NULL AND port IS NULL AND failed = 0
              ORDER BY created_at ASC, command_id ASC
              LIMIT 1
            |]
-            (Only connId)
        Just (SMPServer host port _) ->
          DB.query
            db
            [sql|
              SELECT command_id FROM commands
-              WHERE conn_id = ? AND host = ? AND port = ? AND failed = 0
+              WHERE host = ? AND port = ? AND failed = 0
              ORDER BY created_at ASC, command_id ASC
              LIMIT 1
            |]
-            (connId, host, port)
+            (host, port)
    getCommand :: Int64 -> IO (Either StoreError PendingCommand)
    getCommand cmdId =
      firstRow pendingCommand err $
        DB.query
          db
          [sql|
-            SELECT c.corr_id, cs.user_id, c.command
+            SELECT c.corr_id, cs.user_id, c.conn_id, c.command
            FROM commands c
            JOIN connections cs USING (conn_id)
            WHERE c.command_id = ?
@@ -1364,22 +1356,9 @@ getPendingServerCommand db connId srv_ = getWorkItem "command" getCmdId getComma
          (Only cmdId)
      where
        err = SEInternal $ "command  " <> bshow cmdId <> " returned []"
-        pendingCommand (corrId, userId, command) = PendingCommand {cmdId, corrId, userId, connId, command}
+        pendingCommand (corrId, userId, connId, command) = PendingCommand {cmdId, corrId, userId, connId, command}
    markCommandFailed cmdId = DB.execute db "UPDATE commands SET failed = 1 WHERE command_id = ?" (Only cmdId)

-updateCommandServer :: DB.Connection -> AsyncCmdId -> SMPServer -> IO (Either StoreError ())
-updateCommandServer db cmdId srv@(SMPServer host port _) = runExceptT $ do
-  serverKeyHash_ <- ExceptT $ getServerKeyHash_ db srv
-  liftIO $
-    DB.execute
-      db
-      [sql|
-        UPDATE commands
-        SET host = ?, port = ?, server_key_hash = ?
-        WHERE command_id = ?
-      |]
-      (host, port, serverKeyHash_, cmdId)
-
 deleteCommand :: DB.Connection -> AsyncCmdId -> IO ()
 deleteCommand db cmdId =
  DB.execute db "DELETE FROM commands WHERE command_id = ?" (Only cmdId)
@@ -1478,24 +1457,23 @@ getNtfSubscription db connId =
    DB.query
      db
      [sql|
-        SELECT c.user_id, s.host, s.port, COALESCE(nsb.smp_server_key_hash, s.key_hash), ns.ntf_host, ns.ntf_port, ns.ntf_key_hash,
+        SELECT s.host, s.port, COALESCE(nsb.smp_server_key_hash, s.key_hash), ns.ntf_host, ns.ntf_port, ns.ntf_key_hash,
          nsb.smp_ntf_id, nsb.ntf_sub_id, nsb.ntf_sub_status, nsb.ntf_sub_action, nsb.ntf_sub_smp_action, nsb.ntf_sub_action_ts
        FROM ntf_subscriptions nsb
-        JOIN connections c USING (conn_id)
        JOIN servers s ON s.host = nsb.smp_host AND s.port = nsb.smp_port
        JOIN ntf_servers ns USING (ntf_host, ntf_port)
        WHERE nsb.conn_id = ?
      |]
      (Only connId)
  where
-    ntfSubscription ((userId, smpHost, smpPort, smpKeyHash, ntfHost, ntfPort, ntfKeyHash ) :. (ntfQueueId, ntfSubId, ntfSubStatus, ntfAction_, smpAction_, actionTs_)) =
+    ntfSubscription (smpHost, smpPort, smpKeyHash, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, ntfAction_, smpAction_, actionTs_) =
      let smpServer = SMPServer smpHost smpPort smpKeyHash
          ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
          action = case (ntfAction_, smpAction_, actionTs_) of
-            (Just ntfAction, Nothing, Just actionTs) -> Just (NSANtf ntfAction, actionTs)
-            (Nothing, Just smpAction, Just actionTs) -> Just (NSASMP smpAction, actionTs)
+            (Just ntfAction, Nothing, Just actionTs) -> Just (NtfSubNTFAction ntfAction, actionTs)
+            (Nothing, Just smpAction, Just actionTs) -> Just (NtfSubSMPAction smpAction, actionTs)
            _ -> Nothing
-       in (NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}, action)
+       in (NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}, action)

 createNtfSubscription :: DB.Connection -> NtfSubscription -> NtfSubAction -> IO (Either StoreError ())
 createNtfSubscription db ntfSubscription action = runExceptT $ do
@@ -1629,19 +1607,18 @@ getNextNtfSubNTFAction db ntfServer@(NtfServer ntfHost ntfPort _) =
        DB.query
          db
          [sql|
-            SELECT c.user_id, s.host, s.port, COALESCE(ns.smp_server_key_hash, s.key_hash),
+            SELECT s.host, s.port, COALESCE(ns.smp_server_key_hash, s.key_hash),
              ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_action_ts, ns.ntf_sub_action
            FROM ntf_subscriptions ns
-            JOIN connections c USING (conn_id)
            JOIN servers s ON s.host = ns.smp_host AND s.port = ns.smp_port
            WHERE ns.conn_id = ?
          |]
          (Only connId)
      where
        err = SEInternal $ "ntf subscription " <> bshow connId <> " returned []"
-        ntfSubAction (userId, smpHost, smpPort, smpKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
+        ntfSubAction (smpHost, smpPort, smpKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
          let smpServer = SMPServer smpHost smpPort smpKeyHash
-              ntfSubscription = NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
+              ntfSubscription = NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
           in (ntfSubscription, action, actionTs)

 markNtfSubActionNtfFailed_ :: DB.Connection -> ConnId -> IO ()
@@ -1673,19 +1650,18 @@ getNextNtfSubSMPAction db smpServer@(SMPServer smpHost smpPort _) =
        DB.query
          db
          [sql|
-            SELECT c.user_id, s.ntf_host, s.ntf_port, s.ntf_key_hash,
+            SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash,
              ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_action_ts, ns.ntf_sub_smp_action
            FROM ntf_subscriptions ns
-            JOIN connections c USING (conn_id)
            JOIN ntf_servers s USING (ntf_host, ntf_port)
            WHERE ns.conn_id = ?
          |]
          (Only connId)
      where
        err = SEInternal $ "ntf subscription " <> bshow connId <> " returned []"
-        ntfSubAction (userId, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
+        ntfSubAction (ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
          let ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
-              ntfSubscription = NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
+              ntfSubscription = NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
           in (ntfSubscription, action, actionTs)

 markNtfSubActionSMPFailed_ :: DB.Connection -> ConnId -> IO ()
@@ -1930,11 +1906,9 @@ newQueueId_ (Only maxId : _) = DBQueueId (maxId + 1)

 getConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getConn = getAnyConn False
-{-# INLINE getConn #-}

 getDeletedConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getDeletedConn = getAnyConn True
-{-# INLINE getDeletedConn #-}

 getAnyConn :: Bool -> DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getAnyConn deleted' dbConn connId =
@@ -1955,11 +1929,9 @@ getAnyConn deleted' dbConn connId =

 getConns :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
 getConns = getAnyConns_ False
-{-# INLINE getConns #-}

 getDeletedConns :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
 getDeletedConns = getAnyConns_ True
-{-# INLINE getDeletedConns #-}

 getAnyConns_ :: Bool -> DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
 getAnyConns_ deleted' db connIds = forM connIds $ E.handle handleDBError . getAnyConn deleted' db
@@ -1992,10 +1964,6 @@ setConnDeleted db waitDelivery connId
  | otherwise =
      DB.execute db "UPDATE connections SET deleted = ? WHERE conn_id = ?" (True, connId)

-setConnUserId :: DB.Connection -> UserId -> ConnId -> UserId -> IO ()
-setConnUserId db oldUserId connId newUserId = 
-  DB.execute db "UPDATE connections SET user_id = ? WHERE conn_id = ? and user_id = ?" (newUserId, connId, oldUserId)
-
 setConnAgentVersion :: DB.Connection -> ConnId -> VersionSMPA -> IO ()
 setConnAgentVersion db connId aVersion =
  DB.execute db "UPDATE connections SET smp_agent_version = ? WHERE conn_id = ?" (aVersion, connId)
@@ -2304,8 +2272,8 @@ randomId :: TVar ChaChaDRG -> Int -> IO ByteString
 randomId gVar n = atomically $ U.encode <$> C.randomBytes n gVar

 ntfSubAndSMPAction :: NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
-ntfSubAndSMPAction (NSANtf action) = (Just action, Nothing)
-ntfSubAndSMPAction (NSASMP action) = (Nothing, Just action)
+ntfSubAndSMPAction (NtfSubNTFAction action) = (Just action, Nothing)
+ntfSubAndSMPAction (NtfSubSMPAction action) = (Nothing, Just action)

 createXFTPServer_ :: DB.Connection -> XFTPServer -> IO Int64
 createXFTPServer_ db newSrv@ProtocolServer {host, port, keyHash} =
@@ -1,5 +1,4 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}

@@ -9,20 +8,20 @@ module Simplex.Messaging.Agent.Store.SQLite.Common
    withConnection',
    withTransaction,
    withTransaction',
-    withTransactionPriority,
+    withTransactionCtx,
    dbBusyLoop,
    storeKey,
  )
 where

 import Control.Concurrent (threadDelay)
-import Control.Concurrent.STM (retry)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
+import Data.Time.Clock (diffUTCTime, getCurrentTime)
 import Database.SQLite.Simple (SQLError)
 import qualified Database.SQLite.Simple as SQL
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import Simplex.Messaging.Util (ifM, unlessM)
+import Simplex.Messaging.Util (diffToMilliseconds)
 import qualified UnliftIO.Exception as E
 import UnliftIO.MVar
 import UnliftIO.STM
@@ -33,40 +32,35 @@ storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing
 data SQLiteStore = SQLiteStore
  { dbFilePath :: FilePath,
    dbKey :: TVar (Maybe ScrubbedBytes),
-    dbSem :: TVar Int,
    dbConnection :: MVar DB.Connection,
    dbClosed :: TVar Bool,
    dbNew :: Bool
  }

-withConnectionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
-withConnectionPriority SQLiteStore {dbSem, dbConnection} priority action
-  | priority = E.bracket_ signal release $ withMVar dbConnection action
-  | otherwise = lowPriority
-  where
-    lowPriority = wait >> withMVar dbConnection (\db -> ifM free (Just <$> action db) (pure Nothing)) >>= maybe lowPriority pure
-    signal = atomically $ modifyTVar' dbSem (+ 1)
-    release = atomically $ modifyTVar' dbSem $ \sem -> if sem > 0 then sem - 1 else 0
-    wait = unlessM free $ atomically $ unlessM ((0 ==) <$> readTVar dbSem) retry
-    free = (0 ==) <$> readTVarIO dbSem
-
 withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withConnection st = withConnectionPriority st False
+withConnection SQLiteStore {dbConnection} = withMVar dbConnection

 withConnection' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
 withConnection' st action = withConnection st $ action . DB.conn

+withTransaction :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withTransaction = withTransactionCtx Nothing
+
 withTransaction' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
 withTransaction' st action = withTransaction st $ action . DB.conn

-withTransaction :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransaction st = withTransactionPriority st False
-{-# INLINE withTransaction #-}
-
-withTransactionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
-withTransactionPriority st priority action = withConnectionPriority st priority $ dbBusyLoop . transaction
+withTransactionCtx :: Maybe String -> SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withTransactionCtx ctx_ st action = withConnection st $ dbBusyLoop . transactionWithCtx
  where
-    transaction db@DB.Connection {conn} = SQL.withImmediateTransaction conn $ action db
+    transactionWithCtx db@DB.Connection {conn} = case ctx_ of
+      Nothing -> SQL.withImmediateTransaction conn $ action db
+      Just ctx -> do
+        t1 <- getCurrentTime
+        r <- SQL.withImmediateTransaction conn $ action db
+        t2 <- getCurrentTime
+        putStrLn $ "withTransactionCtx start :: " <> show t1 <> " :: " <> ctx
+        putStrLn $ "withTransactionCtx end   :: " <> show t2 <> " :: " <> ctx <> " :: duration=" <> show (diffToMilliseconds $ diffUTCTime t2 t1)
+        pure r

 dbBusyLoop :: forall a. IO a -> IO a
 dbBusyLoop action = loop 500 3000000
@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -21,19 +20,15 @@ where

 import Control.Concurrent.STM
 import Control.Monad (when)
-import Control.Exception
 import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-import Data.Text (Text)
 import Data.Time (diffUTCTime, getCurrentTime)
 import Database.SQLite.Simple (FromRow, NamedParam, Query, ToRow)
 import qualified Database.SQLite.Simple as SQL
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (diffToMilliseconds, tshow)
+import Simplex.Messaging.Util (diffToMilliseconds)

 data Connection = Connection
  { conn :: SQL.Connection,
@@ -43,41 +38,33 @@ data Connection = Connection
 data SlowQueryStats = SlowQueryStats
  { count :: Int64,
    timeMax :: Int64,
-    timeAvg :: Int64,
-    errs :: Map Text Int
+    timeAvg :: Int64
  }
  deriving (Show)

 timeIt :: TMap Query SlowQueryStats -> Query -> IO a -> IO a
 timeIt slow sql a = do
  t <- getCurrentTime
-  r <- a `catch` \e -> do
-    atomically $ TM.alter (Just . updateQueryErrors e) sql slow
-    throwIO e
+  r <- a
  t' <- getCurrentTime
  let diff = diffToMilliseconds $ diffUTCTime t' t
-  when (diff > 1) $ atomically $ TM.alter (updateQueryStats diff) sql slow
+  atomically $ when (diff > 5) $ TM.alter (updateQueryStats diff) sql slow
  pure r
  where
-    updateQueryErrors :: SomeException -> Maybe SlowQueryStats -> SlowQueryStats
-    updateQueryErrors e Nothing = SlowQueryStats 0 0 0 $ M.singleton (tshow e) 1
-    updateQueryErrors e (Just stats@SlowQueryStats {errs}) =
-      stats {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
    updateQueryStats :: Int64 -> Maybe SlowQueryStats -> Maybe SlowQueryStats
-    updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff M.empty
-    updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg, errs}) =
+    updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff
+    updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg}) =
      Just $
        SlowQueryStats
          { count = count + 1,
            timeMax = max timeMax diff,
-            timeAvg = (timeAvg * count + diff) `div` (count + 1),
-            errs
+            timeAvg = (timeAvg * count + diff) `div` (count + 1)
          }

 open :: String -> IO Connection
 open f = do
  conn <- SQL.open f
-  slow <- TM.emptyIO
+  slow <- atomically $ TM.empty
  pure Connection {conn, slow}

 close :: Connection -> IO ()
@@ -1,9 +1,7 @@
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}

 module Simplex.Messaging.Agent.TRcvQueues
  ( TRcvQueues (getRcvQueues, getConnections),
-    Queue (..),
    empty,
    clear,
    deleteConn,
@@ -11,9 +9,9 @@ module Simplex.Messaging.Agent.TRcvQueues
    addQueue,
    batchAddQueues,
    deleteQueue,
-    hasSessQueues,
    getSessQueues,
    getDelSessQueues,
+    qKey,
  )
 where

@@ -27,51 +25,46 @@ import Simplex.Messaging.Agent.Store (RcvQueue, StoredRcvQueue (..))
 import Simplex.Messaging.Protocol (RecipientId, SMPServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport
-
-class Queue q where
-  connId' :: q -> ConnId
-  qKey :: q -> (UserId, SMPServer, ConnId)

 -- the fields in this record have the same data with swapped keys for lookup efficiency,
 -- and all methods must maintain this invariant.
-data TRcvQueues q = TRcvQueues
-  { getRcvQueues :: TMap (UserId, SMPServer, RecipientId) q,
+data TRcvQueues = TRcvQueues
+  { getRcvQueues :: TMap (UserId, SMPServer, RecipientId) RcvQueue,
    getConnections :: TMap ConnId (NonEmpty (UserId, SMPServer, RecipientId))
  }

-empty :: IO (TRcvQueues q)
-empty = TRcvQueues <$> TM.emptyIO <*> TM.emptyIO
+empty :: STM TRcvQueues
+empty = TRcvQueues <$> TM.empty <*> TM.empty

-clear :: TRcvQueues q -> STM ()
+clear :: TRcvQueues -> STM ()
 clear (TRcvQueues qs cs) = TM.clear qs >> TM.clear cs

-deleteConn :: ConnId -> TRcvQueues q -> STM ()
+deleteConn :: ConnId -> TRcvQueues -> STM ()
 deleteConn cId (TRcvQueues qs cs) =
  TM.lookupDelete cId cs >>= \case
    Just ks -> modifyTVar' qs $ \qs' -> foldl' (flip M.delete) qs' ks
    Nothing -> pure ()

-hasConn :: ConnId -> TRcvQueues q -> STM Bool
+hasConn :: ConnId -> TRcvQueues -> STM Bool
 hasConn cId (TRcvQueues _ cs) = TM.member cId cs

-addQueue :: Queue q => q -> TRcvQueues q -> STM ()
+addQueue :: RcvQueue -> TRcvQueues -> STM ()
 addQueue rq (TRcvQueues qs cs) = do
  TM.insert k rq qs
-  TM.alter addQ (connId' rq) cs
+  TM.alter addQ (connId rq) cs
  where
    addQ = Just . maybe (k :| []) (k <|)
    k = qKey rq

 -- Save time by aggregating modifyTVar
-batchAddQueues :: (Foldable t, Queue q) => TRcvQueues q -> t q -> STM ()
+batchAddQueues :: Foldable t => TRcvQueues -> t RcvQueue -> STM ()
 batchAddQueues (TRcvQueues qs cs) rqs = do
  modifyTVar' qs $ \now -> foldl' (\rqs' rq -> M.insert (qKey rq) rq rqs') now rqs
-  modifyTVar' cs $ \now -> foldl' (\cs' rq -> M.alter (addQ $ qKey rq) (connId' rq) cs') now rqs
+  modifyTVar' cs $ \now -> foldl' (\cs' rq -> M.alter (addQ $ qKey rq) (connId rq) cs') now rqs
  where
    addQ k = Just . maybe (k :| []) (k <|)

-deleteQueue :: RcvQueue -> TRcvQueues RcvQueue -> STM ()
+deleteQueue :: RcvQueue -> TRcvQueues -> STM ()
 deleteQueue rq (TRcvQueues qs cs) = do
  TM.delete k qs
  TM.update delQ (connId rq) cs
@@ -79,25 +72,21 @@ deleteQueue rq (TRcvQueues qs cs) = do
    delQ = L.nonEmpty . L.filter (/= k)
    k = qKey rq

-hasSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues RcvQueue -> STM Bool
-hasSessQueues tSess (TRcvQueues qs _) = any (`isSession` tSess) <$> readTVar qs
-
-getSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues RcvQueue -> IO [RcvQueue]
-getSessQueues tSess (TRcvQueues qs _) = M.foldl' addQ [] <$> readTVarIO qs
+getSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues -> STM [RcvQueue]
+getSessQueues tSess (TRcvQueues qs _) = M.foldl' addQ [] <$> readTVar qs
  where
    addQ qs' rq = if rq `isSession` tSess then rq : qs' else qs'

-getDelSessQueues :: (UserId, SMPServer, Maybe ConnId) -> SessionId -> TRcvQueues (SessionId, RcvQueue) -> STM ([RcvQueue], [ConnId])
-getDelSessQueues tSess sessId' (TRcvQueues qs cs) = do
+getDelSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues -> STM ([RcvQueue], [ConnId])
+getDelSessQueues tSess (TRcvQueues qs cs) = do
  (removedQs, qs'') <- (\qs' -> M.foldl' delQ ([], qs') qs') <$> readTVar qs
  writeTVar qs $! qs''
  removedConns <- stateTVar cs $ \cs' -> foldl' delConn ([], cs') removedQs
  pure (removedQs, removedConns)
  where
-    delQ acc@(removed, qs') (sessId, rq)
-      | rq `isSession` tSess && sessId == sessId' = (rq : removed, M.delete (qKey rq) qs')
+    delQ acc@(removed, qs') rq
+      | rq `isSession` tSess = (rq : removed, M.delete (qKey rq) qs')
      | otherwise = acc
-    delConn :: ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, ConnId))) -> RcvQueue -> ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, ConnId)))
    delConn (removed, cs') rq = M.alterF f cId cs'
      where
        cId = connId rq
@@ -111,10 +100,5 @@ isSession :: RcvQueue -> (UserId, SMPServer, Maybe ConnId) -> Bool
 isSession rq (uId, srv, connId_) =
  userId rq == uId && server rq == srv && maybe True (connId rq ==) connId_

-instance Queue RcvQueue where
-  connId' = connId
-  qKey rq = (userId rq, server rq, connId rq)
-
-instance Queue (SessionId, RcvQueue) where
-  connId' = connId . snd
-  qKey = qKey . snd
+qKey :: RcvQueue -> (UserId, SMPServer, ConnId)
+qKey rq = (userId rq, server rq, connId rq)
@@ -170,17 +170,17 @@ data PClient v err msg = PClient
    msgQ :: Maybe (TBQueue (ServerTransmissionBatch v err msg))
  }

-smpClientStub :: TVar ChaChaDRG -> ByteString -> VersionSMP -> Maybe (THandleAuth 'TClient) -> IO SMPClient
+smpClientStub :: TVar ChaChaDRG -> ByteString -> VersionSMP -> Maybe (THandleAuth 'TClient) -> STM SMPClient
 smpClientStub g sessionId thVersion thAuth = do
  let ts = UTCTime (read "2024-03-31") 0
-  connected <- newTVarIO False
-  clientCorrId <- atomically $ C.newRandomDRG g
-  sentCommands <- TM.emptyIO
-  sendPings <- newTVarIO False
-  lastReceived <- newTVarIO ts
-  timeoutErrorCount <- newTVarIO 0
-  sndQ <- newTBQueueIO 100
-  rcvQ <- newTBQueueIO 100
+  connected <- newTVar False
+  clientCorrId <- C.newRandomDRG g
+  sentCommands <- TM.empty
+  sendPings <- newTVar False
+  lastReceived <- newTVar ts
+  timeoutErrorCount <- newTVar 0
+  sndQ <- newTBQueue 100
+  rcvQ <- newTBQueue 100
  return
    ProtocolClient
      { action = Nothing,
@@ -244,16 +244,6 @@ data SocksMode
    SMOnion
  deriving (Eq, Show)

-instance StrEncoding SocksMode where
-  strEncode = \case
-    SMAlways -> "always"
-    SMOnion -> "onion"
-  strP =
-    A.takeTill (== ' ') >>= \case
-      "always" -> pure SMAlways
-      "onion" -> pure SMOnion
-      _ -> fail "Invalid Socks mode"
-
 -- | network configuration for the client
 data NetworkConfig = NetworkConfig
  { -- | use SOCKS5 proxy
@@ -452,21 +442,21 @@ getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> T
 getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret} msgQ disconnected = do
  case chooseTransportHost networkConfig (host srv) of
    Right useHost ->
-      (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
+      (getCurrentTime >>= atomically . mkProtocolClient useHost >>= runClient useTransport useHost)
        `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
    Left e -> pure $ Left e
  where
    NetworkConfig {tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
-    mkProtocolClient :: TransportHost -> UTCTime -> IO (PClient v err msg)
+    mkProtocolClient :: TransportHost -> UTCTime -> STM (PClient v err msg)
    mkProtocolClient transportHost ts = do
-      connected <- newTVarIO False
-      sendPings <- newTVarIO False
-      lastReceived <- newTVarIO ts
-      timeoutErrorCount <- newTVarIO 0
-      clientCorrId <- atomically $ C.newRandomDRG g
-      sentCommands <- TM.emptyIO
-      sndQ <- newTBQueueIO qSize
-      rcvQ <- newTBQueueIO qSize
+      connected <- newTVar False
+      sendPings <- newTVar False
+      lastReceived <- newTVar ts
+      timeoutErrorCount <- newTVar 0
+      clientCorrId <- C.newRandomDRG g
+      sentCommands <- TM.empty
+      sndQ <- newTBQueue qSize
+      rcvQ <- newTBQueue qSize
      return
        PClient
          { connected,
@@ -516,8 +506,9 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
          atomically $ do
            writeTVar (connected c) True
            putTMVar cVar $ Right c'
-          raceAny_ ([send c' th, process c', receive c' th] <> [monitor c' | smpPingInterval > 0])
-            `finally` disconnected c'
+          raceAny_ ([send c' th, process c', receive c' th] <> [monitor c' | smpPingInterval > 0]) `finally` do
+            atomically $ writeTVar (connected c) False
+            disconnected c'

    send :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO ()
    send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= sendPending
@@ -565,7 +556,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
    processMsg ProtocolClient {client_ = PClient {sentCommands}} (_, _, (corrId, entId, respOrErr))
      | B.null $ bs corrId = sendMsg $ STEvent clientResp
      | otherwise =
-          TM.lookupIO corrId sentCommands >>= \case
+          atomically (TM.lookup corrId sentCommands) >>= \case
            Nothing -> sendMsg $ STUnexpectedError unexpected
            Just Request {entityId, command, pending, responseVar} -> do
              wasPending <-
@@ -1089,13 +1080,13 @@ mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentC
  nonce@(C.CbNonce corrId) <- maybe (atomically $ C.randomCbNonce clientCorrId) pure nonce_
  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, entityId, command)
      auth = authTransmission (thAuth thParams) pKey_ nonce tForAuth
-  r <- mkRequest (CorrId corrId)
+  r <- atomically $ mkRequest (CorrId corrId)
  pure ((,tToSend) <$> auth, r)
  where
-    mkRequest :: CorrId -> IO (Request err msg)
+    mkRequest :: CorrId -> STM (Request err msg)
    mkRequest corrId = do
-      pending <- newTVarIO True
-      responseVar <- newEmptyTMVarIO
+      pending <- newTVar True
+      responseVar <- newEmptyTMVar
      let r =
            Request
              { corrId,
@@ -1104,7 +1095,7 @@ mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentC
                pending,
                responseVar
              }
-      atomically $ TM.insert corrId r sentCommands
+      TM.insert corrId r sentCommands
      pure r

 authTransmission :: Maybe (THandleAuth 'TClient) -> Maybe C.APrivateAuthKey -> C.CbNonce -> ByteString -> Either TransportError (Maybe TransmissionAuth)
@@ -100,7 +100,7 @@ data SMPClientAgent = SMPClientAgent
    randomDrg :: TVar ChaChaDRG,
    smpClients :: TMap SMPServer SMPClientVar,
    smpSessions :: TMap SessionId (OwnServer, SMPClient),
-    srvSubs :: TMap SMPServer (TMap SMPSub (SessionId, C.APrivateAuthKey)),
+    srvSubs :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey),
    pendingSrvSubs :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey),
    smpSubWorkers :: TMap SMPServer (SessionVar (Async ())),
    workerSeq :: TVar Int
@@ -108,17 +108,17 @@ data SMPClientAgent = SMPClientAgent

 type OwnServer = Bool

-newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO SMPClientAgent
+newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> STM SMPClientAgent
 newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg = do
-  active <- newTVarIO True
-  msgQ <- newTBQueueIO msgQSize
-  agentQ <- newTBQueueIO agentQSize
-  smpClients <- TM.emptyIO
-  smpSessions <- TM.emptyIO
-  srvSubs <- TM.emptyIO
-  pendingSrvSubs <- TM.emptyIO
-  smpSubWorkers <- TM.emptyIO
-  workerSeq <- newTVarIO 0
+  active <- newTVar True
+  msgQ <- newTBQueue msgQSize
+  agentQ <- newTBQueue agentQSize
+  smpClients <- TM.empty
+  smpSessions <- TM.empty
+  srvSubs <- TM.empty
+  pendingSrvSubs <- TM.empty
+  smpSubWorkers <- TM.empty
+  workerSeq <- newTVar 0
  pure
    SMPClientAgent
      { agentCfg,
@@ -204,17 +204,14 @@ connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, random

    removeClientAndSubs :: SMPClient -> IO (Maybe (Map SMPSub C.APrivateAuthKey))
    removeClientAndSubs smp = atomically $ do
-      TM.delete sessId smpSessions
      removeSessVar v srv smpClients
-      TM.lookup srv (srvSubs ca) >>= mapM updateSubs
+      TM.delete (sessionId $ thParams smp) smpSessions
+      TM.lookupDelete srv (srvSubs ca) >>= mapM updateSubs
      where
-        sessId = sessionId $ thParams smp
        updateSubs sVar = do
-          -- removing subscriptions that have matching sessionId to disconnected client
-          -- and keep the other ones (they can be made by the new client)
-          pending <- M.map snd <$> stateTVar sVar (M.partition ((sessId ==) . fst))
-          addSubs_ (pendingSrvSubs ca) srv pending
-          pure pending
+          ss <- readTVar sVar
+          addSubs_ (pendingSrvSubs ca) srv ss
+          pure ss

    serverDown :: Map SMPSub C.APrivateAuthKey -> IO ()
    serverDown ss = unless (M.null ss) $ do
@@ -229,7 +226,7 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
  where
    getWorkerVar ts =
      ifM
-        (noPending)
+        (null <$> getPending)
        (pure Nothing) -- prevent race with cleanup and adding pending queues in another call
        (Just <$> getSessVar workerSeq srv smpSubWorkers ts)
    newSubWorker :: SessionVar (Async ()) -> IO ()
@@ -238,13 +235,12 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
      atomically $ putTMVar (sessionVar v) a
    runSubWorker =
      withRetryInterval (reconnectInterval agentCfg) $ \_ loop -> do
-        pending <- liftIO getPending
+        pending <- atomically getPending
        unless (null pending) $ whenM (readTVarIO active) $ do
          void $ tcpConnectTimeout `timeout` runExceptT (reconnectSMPClient ca srv pending)
          loop
    ProtocolClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = smpCfg agentCfg
-    noPending = maybe (pure True) (fmap M.null . readTVar) =<< TM.lookup srv (pendingSrvSubs ca)
-    getPending = maybe (pure M.empty) readTVarIO =<< TM.lookupIO srv (pendingSrvSubs ca)
+    getPending = maybe (pure M.empty) readTVar =<< TM.lookup srv (pendingSrvSubs ca)
    cleanup :: SessionVar (Async ()) -> STM ()
    cleanup v = do
      -- Here we wait until TMVar is not empty to prevent worker cleanup happening before worker is added to TMVar.
@@ -255,14 +251,14 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
 reconnectSMPClient :: SMPClientAgent -> SMPServer -> Map SMPSub C.APrivateAuthKey -> ExceptT SMPClientError IO ()
 reconnectSMPClient ca@SMPClientAgent {agentCfg} srv cs =
  withSMP ca srv $ \smp -> liftIO $ do
-    currSubs <- maybe (pure M.empty) readTVarIO =<< TM.lookupIO srv (srvSubs ca)
+    currSubs <- atomically $ maybe (pure M.empty) readTVar =<< TM.lookup srv (srvSubs ca)
    let (nSubs, rSubs) = foldr (groupSub currSubs) ([], []) $ M.assocs cs
    subscribe_ smp SPNotifier nSubs
    subscribe_ smp SPRecipient rSubs
  where
-    groupSub :: Map SMPSub (SessionId, C.APrivateAuthKey) -> (SMPSub, C.APrivateAuthKey) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)]) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)])
-    groupSub currSubs (s@(party, qId), k) acc@(nSubs, rSubs)
-      | M.member s currSubs = acc
+    groupSub :: Map SMPSub C.APrivateAuthKey -> (SMPSub, C.APrivateAuthKey) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)]) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)])
+    groupSub currSubs (s@(party, qId), k) (nSubs, rSubs)
+      | M.member s currSubs = (nSubs, rSubs)
      | otherwise = case party of
          SPNotifier -> (s' : nSubs, rSubs)
          SPRecipient -> (nSubs, s' : rSubs)
@@ -290,8 +286,8 @@ getConnectedSMPServerClient SMPClientAgent {smpClients} srv =
            (Nothing <$ atomically (removeSessVar v srv smpClients)) -- proxy will create a new connection
            (pure $ Just $ Left e) -- not expired, returning error

-lookupSMPServerClient :: SMPClientAgent -> SessionId -> IO (Maybe (OwnServer, SMPClient))
-lookupSMPServerClient SMPClientAgent {smpSessions} sessId = TM.lookupIO sessId smpSessions
+lookupSMPServerClient :: SMPClientAgent -> SessionId -> STM (Maybe (OwnServer, SMPClient))
+lookupSMPServerClient SMPClientAgent {smpSessions} sessId = TM.lookup sessId smpSessions

 closeSMPClientAgent :: SMPClientAgent -> IO ()
 closeSMPClientAgent c = do
@@ -350,18 +346,17 @@ smpSubscribeQueues party ca smp srv subs = do
      when tempErrs $ reconnectClient ca srv
    Nothing -> reconnectClient ca srv
  where
-    processSubscriptions :: NonEmpty (Either SMPClientError ()) -> STM (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId])
+    processSubscriptions :: NonEmpty (Either SMPClientError ()) -> STM (Bool, [(QueueId, SMPClientError)], [(QueueId, C.APrivateAuthKey)], [QueueId])
    processSubscriptions rs = do
      pending <- maybe (pure M.empty) readTVar =<< TM.lookup srv (pendingSrvSubs ca)
      let acc@(_, _, oks, notPending) = foldr (groupSub pending) (False, [], [], []) (L.zip subs rs)
      unless (null oks) $ addSubscriptions ca srv party oks
      unless (null notPending) $ removePendingSubs ca srv party notPending
      pure acc
-    sessId = sessionId $ thParams smp
-    groupSub :: Map SMPSub C.APrivateAuthKey -> ((QueueId, C.APrivateAuthKey), Either SMPClientError ()) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId]) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId])
-    groupSub pending ((qId, pk), r) acc@(!tempErrs, finalErrs, oks, notPending) = case r of
+    groupSub :: Map SMPSub C.APrivateAuthKey -> ((QueueId, C.APrivateAuthKey), Either SMPClientError ()) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, C.APrivateAuthKey)], [QueueId]) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, C.APrivateAuthKey)], [QueueId])
+    groupSub pending (s@(qId, _), r) acc@(!tempErrs, finalErrs, oks, notPending) = case r of
      Right ()
-        | M.member (party, qId) pending -> (tempErrs, finalErrs, (qId, (sessId, pk)) : oks, qId : notPending)
+        | M.member (party, qId) pending -> (tempErrs, finalErrs, s : oks, qId : notPending)
        | otherwise -> acc
      Left e
        | temporaryClientError e -> (True, finalErrs, oks, notPending)
@@ -372,21 +367,19 @@ smpSubscribeQueues party ca smp srv subs = do
    notify_ :: (SMPServer -> SMPSubParty -> NonEmpty a -> SMPClientAgentEvent) -> [a] -> IO ()
    notify_ evt qs = mapM_ (notify ca . evt srv party) $ L.nonEmpty qs

-activeClientSession' :: SMPClientAgent -> SessionId -> SMPServer -> STM Bool
-activeClientSession' ca sessId srv = sameSess <$> tryReadSessVar srv (smpClients ca)
-  where
-    sameSess = \case
-      Just (Right (_, smp')) -> sessId == sessionId (thParams smp')
-      _ -> False
-
 activeClientSession :: SMPClientAgent -> SMPClient -> SMPServer -> STM Bool
-activeClientSession ca = activeClientSession' ca . sessionId . thParams
+activeClientSession ca smp srv = sameSess <$> tryReadSessVar srv (smpClients ca)
+  where
+    sessId = sessionId . thParams
+    sameSess = \case
+      Just (Right (_, smp')) -> sessId smp == sessId smp'
+      _ -> False

 showServer :: SMPServer -> ByteString
 showServer ProtocolServer {host, port} =
  strEncode host <> B.pack (if null port then "" else ':' : port)

-addSubscriptions :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, (SessionId, C.APrivateAuthKey))] -> STM ()
+addSubscriptions :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> STM ()
 addSubscriptions = addSubsList_ . srvSubs
 {-# INLINE addSubscriptions #-}

@@ -394,12 +387,12 @@ addPendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, C.APr
 addPendingSubs = addSubsList_ . pendingSrvSubs
 {-# INLINE addPendingSubs #-}

-addSubsList_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> SMPSubParty -> [(QueueId, s)] -> STM ()
+addSubsList_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> STM ()
 addSubsList_ subs srv party ss = addSubs_ subs srv ss'
  where
    ss' = M.fromList $ map (first (party,)) ss

-addSubs_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> Map SMPSub s -> STM ()
+addSubs_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> Map SMPSub C.APrivateAuthKey -> STM ()
 addSubs_ subs srv ss =
  TM.lookup srv subs >>= \case
    Just m -> TM.union ss m
@@ -409,7 +402,7 @@ removeSubscription :: SMPClientAgent -> SMPServer -> SMPSub -> STM ()
 removeSubscription = removeSub_ . srvSubs
 {-# INLINE removeSubscription #-}

-removeSub_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> SMPSub -> STM ()
+removeSub_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSub -> STM ()
 removeSub_ subs srv s = TM.lookup srv subs >>= mapM_ (TM.delete s)

 removePendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [QueueId] -> STM ()
@@ -176,10 +176,10 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge

    getSMPSubscriber :: SMPServer -> M SMPSubscriber
    getSMPSubscriber smpServer =
-      liftIO (TM.lookupIO smpServer smpSubscribers) >>= maybe createSMPSubscriber pure
+      atomically (TM.lookup smpServer smpSubscribers) >>= maybe createSMPSubscriber pure
      where
        createSMPSubscriber = do
-          sub@SMPSubscriber {subThreadId} <- liftIO newSMPSubscriber
+          sub@SMPSubscriber {subThreadId} <- atomically newSMPSubscriber
          atomically $ TM.insert smpServer sub smpSubscribers
          tId <- mkWeakThreadId =<< forkIO (runSMPSubscriber sub)
          atomically . writeTVar subThreadId $ Just tId
@@ -203,7 +203,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge

    receiveSMP :: M ()
    receiveSMP = forever $ do
-      ((_, srv, _), _thVersion, sessionId, ts) <- atomically $ readTBQueue msgQ
+      ((_, srv, _), _, _, ts) <- atomically $ readTBQueue msgQ
      forM ts $ \(ntfId, t) -> case t of
        STUnexpectedError e -> logError $ "SMP client unexpected error: " <> tshow e -- uncorrelated response, should not happen
        STResponse {} -> pure () -- it was already reported as timeout error
@@ -220,9 +220,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
                findNtfSubscriptionToken st smpQueue
                  >>= 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.END -> updateSubStatus smpQueue NSEnd
            Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e
            Right _ -> logError "SMP server unexpected response"
            Left e -> logError $ "SMP client error: " <> tshow e
@@ -335,7 +333,7 @@ runNtfClientTransport :: Transport c => THandleNTF c 'TServer -> M ()
 runNtfClientTransport th@THandle {params} = do
  qSize <- asks $ clientQSize . config
  ts <- liftIO getSystemTime
-  c <- liftIO $ newNtfServerClient qSize params ts
+  c <- atomically $ newNtfServerClient qSize params ts
  s <- asks subscriber
  ps <- asks pushServer
  expCfg <- asks $ inactiveClientExpiration . config
@@ -509,7 +507,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
            | otherwise -> do
                logDebug "TCRN"
                atomically $ writeTVar tknCronInterval int
-                liftIO (TM.lookupIO tknId intervalNotifiers) >>= \case
+                atomically (TM.lookup tknId intervalNotifiers) >>= \case
                  Nothing -> runIntervalNotifier int
                  Just IntervalNotifier {interval, action} ->
                    unless (interval == int) $ do
@@ -587,7 +585,7 @@ incNtfStat statSel = do
 saveServerStats :: M ()
 saveServerStats =
  asks (serverStatsBackupFile . config)
-    >>= mapM_ (\f -> asks serverStats >>= liftIO . getNtfServerStatsData >>= liftIO . saveStats f)
+    >>= mapM_ (\f -> asks serverStats >>= atomically . getNtfServerStatsData >>= liftIO . saveStats f)
  where
    saveStats f stats = do
      logInfo $ "saving server stats to file " <> T.pack f
@@ -10,6 +10,7 @@ module Simplex.Messaging.Notifications.Server.Env where
 import Control.Concurrent (ThreadId)
 import Control.Concurrent.Async (Async)
 import Control.Logger.Simple
+import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
@@ -84,16 +85,16 @@ data NtfEnv = NtfEnv

 newNtfServerEnv :: NtfServerConfig -> IO NtfEnv
 newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsConfig, storeLogFile, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
-  random <- C.newRandom
-  store <- newNtfStore
+  random <- liftIO C.newRandom
+  store <- atomically newNtfStore
  logInfo "restoring subscriptions..."
-  storeLog <- mapM (`readWriteNtfStore` store) storeLogFile
+  storeLog <- liftIO $ mapM (`readWriteNtfStore` store) storeLogFile
  logInfo "restored subscriptions"
-  subscriber <- newNtfSubscriber subQSize smpAgentCfg random
-  pushServer <- newNtfPushServer pushQSize apnsConfig
-  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
-  Fingerprint fp <- loadFingerprint caCertificateFile
-  serverStats <- newNtfServerStats =<< getCurrentTime
+  subscriber <- atomically $ newNtfSubscriber subQSize smpAgentCfg random
+  pushServer <- atomically $ newNtfPushServer pushQSize apnsConfig
+  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
+  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
+  serverStats <- atomically . newNtfServerStats =<< liftIO getCurrentTime
  pure NtfEnv {config, subscriber, pushServer, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}

 data NtfSubscriber = NtfSubscriber
@@ -102,10 +103,10 @@ data NtfSubscriber = NtfSubscriber
    smpAgent :: SMPClientAgent
  }

-newNtfSubscriber :: Natural -> SMPClientAgentConfig -> TVar ChaChaDRG -> IO NtfSubscriber
+newNtfSubscriber :: Natural -> SMPClientAgentConfig -> TVar ChaChaDRG -> STM NtfSubscriber
 newNtfSubscriber qSize smpAgentCfg random = do
-  smpSubscribers <- TM.emptyIO
-  newSubQ <- newTBQueueIO qSize
+  smpSubscribers <- TM.empty
+  newSubQ <- newTBQueue qSize
  smpAgent <- newSMPClientAgent smpAgentCfg random
  pure NtfSubscriber {smpSubscribers, newSubQ, smpAgent}

@@ -114,10 +115,10 @@ data SMPSubscriber = SMPSubscriber
    subThreadId :: TVar (Maybe (Weak ThreadId))
  }

-newSMPSubscriber :: IO SMPSubscriber
+newSMPSubscriber :: STM SMPSubscriber
 newSMPSubscriber = do
-  newSubQ <- newTQueueIO
-  subThreadId <- newTVarIO Nothing
+  newSubQ <- newTQueue
+  subThreadId <- newTVar Nothing
  pure SMPSubscriber {newSubQ, subThreadId}

 data NtfPushServer = NtfPushServer
@@ -133,11 +134,11 @@ data IntervalNotifier = IntervalNotifier
    interval :: Word16
  }

-newNtfPushServer :: Natural -> APNSPushClientConfig -> IO NtfPushServer
+newNtfPushServer :: Natural -> APNSPushClientConfig -> STM NtfPushServer
 newNtfPushServer qSize apnsConfig = do
-  pushQ <- newTBQueueIO qSize
-  pushClients <- TM.emptyIO
-  intervalNotifiers <- TM.emptyIO
+  pushQ <- newTBQueue qSize
+  pushClients <- TM.empty
+  intervalNotifiers <- TM.empty
  pure NtfPushServer {pushQ, pushClients, intervalNotifiers, apnsConfig}

 newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
@@ -150,7 +151,7 @@ newPushClient NtfPushServer {apnsConfig, pushClients} pp = do

 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 getPushClient s@NtfPushServer {pushClients} pp =
-  TM.lookupIO pp pushClients >>= maybe (newPushClient s pp) pure
+  atomically (TM.lookup pp pushClients) >>= maybe (newPushClient s pp) pure

 data NtfRequest
  = NtfReqNew CorrId ANewNtfEntity
@@ -166,11 +167,11 @@ data NtfServerClient = NtfServerClient
    sndActiveAt :: TVar SystemTime
  }

-newNtfServerClient :: Natural -> THandleParams NTFVersion 'TServer -> SystemTime -> IO NtfServerClient
+newNtfServerClient :: Natural -> THandleParams NTFVersion 'TServer -> SystemTime -> STM NtfServerClient
 newNtfServerClient qSize ntfThParams ts = do
-  rcvQ <- newTBQueueIO qSize
-  sndQ <- newTBQueueIO qSize
-  connected <- newTVarIO True
-  rcvActiveAt <- newTVarIO ts
-  sndActiveAt <- newTVarIO ts
+  rcvQ <- newTBQueue qSize
+  sndQ <- newTBQueue qSize
+  connected <- newTVar True
+  rcvActiveAt <- newTVar ts
+  sndActiveAt <- newTVar ts
  return NtfServerClient {rcvQ, sndQ, ntfThParams, connected, rcvActiveAt, sndActiveAt}
@@ -1,7 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -133,8 +132,7 @@ ntfServerCLI cfgPath logPath =
                        { networkConfig =
                            defaultNetworkConfig
                              { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini,
-                                socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini,
-                                smpPingInterval = 60_000_000 -- 1 minutes
+                                socksMode = either (const SMOnion) textToSocksMode $ lookupValue "SUBSCRIBER" "socks_mode" ini
                              }
                        },
                    persistErrorInterval = 0 -- seconds
@@ -40,30 +40,30 @@ data NtfServerStatsData = NtfServerStatsData
    _activeSubs :: PeriodStatsData NotifierId
  }

-newNtfServerStats :: UTCTime -> IO NtfServerStats
+newNtfServerStats :: UTCTime -> STM NtfServerStats
 newNtfServerStats ts = do
-  fromTime <- newTVarIO ts
-  tknCreated <- newTVarIO 0
-  tknVerified <- newTVarIO 0
-  tknDeleted <- newTVarIO 0
-  subCreated <- newTVarIO 0
-  subDeleted <- newTVarIO 0
-  ntfReceived <- newTVarIO 0
-  ntfDelivered <- newTVarIO 0
+  fromTime <- newTVar ts
+  tknCreated <- newTVar 0
+  tknVerified <- newTVar 0
+  tknDeleted <- newTVar 0
+  subCreated <- newTVar 0
+  subDeleted <- newTVar 0
+  ntfReceived <- newTVar 0
+  ntfDelivered <- newTVar 0
  activeTokens <- newPeriodStats
  activeSubs <- newPeriodStats
  pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}

-getNtfServerStatsData :: NtfServerStats -> IO NtfServerStatsData
+getNtfServerStatsData :: NtfServerStats -> STM NtfServerStatsData
 getNtfServerStatsData s@NtfServerStats {fromTime} = do
-  _fromTime <- readTVarIO fromTime
-  _tknCreated <- readTVarIO $ tknCreated s
-  _tknVerified <- readTVarIO $ tknVerified s
-  _tknDeleted <- readTVarIO $ tknDeleted s
-  _subCreated <- readTVarIO $ subCreated s
-  _subDeleted <- readTVarIO $ subDeleted s
-  _ntfReceived <- readTVarIO $ ntfReceived s
-  _ntfDelivered <- readTVarIO $ ntfDelivered s
+  _fromTime <- readTVar fromTime
+  _tknCreated <- readTVar $ tknCreated s
+  _tknVerified <- readTVar $ tknVerified s
+  _tknDeleted <- readTVar $ tknDeleted s
+  _subCreated <- readTVar $ subCreated s
+  _subDeleted <- readTVar $ subDeleted s
+  _ntfReceived <- readTVar $ ntfReceived s
+  _ntfDelivered <- readTVar $ ntfDelivered s
  _activeTokens <- getPeriodStatsData $ activeTokens s
  _activeSubs <- getPeriodStatsData $ activeSubs s
  pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
@@ -33,13 +33,13 @@ data NtfStore = NtfStore
    subscriptionLookup :: TMap SMPQueueNtf NtfSubscriptionId
  }

-newNtfStore :: IO NtfStore
+newNtfStore :: STM NtfStore
 newNtfStore = do
-  tokens <- TM.emptyIO
-  tokenRegistrations <- TM.emptyIO
-  subscriptions <- TM.emptyIO
-  tokenSubscriptions <- TM.emptyIO
-  subscriptionLookup <- TM.emptyIO
+  tokens <- TM.empty
+  tokenRegistrations <- TM.empty
+  subscriptions <- TM.empty
+  tokenSubscriptions <- TM.empty
+  subscriptionLookup <- TM.empty
  pure NtfStore {tokens, tokenRegistrations, subscriptions, tokenSubscriptions, subscriptionLookup}

 data NtfTknData = NtfTknData
@@ -77,9 +77,6 @@ data NtfEntityRec (e :: NtfEntity) where
 getNtfToken :: NtfStore -> NtfTokenId -> STM (Maybe NtfTknData)
 getNtfToken st tknId = TM.lookup tknId (tokens st)

-getNtfTokenIO :: NtfStore -> NtfTokenId -> IO (Maybe NtfTknData)
-getNtfTokenIO st tknId = TM.lookupIO tknId (tokens st)
-
 addNtfToken :: NtfStore -> NtfTokenId -> NtfTknData -> STM ()
 addNtfToken st tknId tkn@NtfTknData {token, tknVerifyKey} = do
  TM.insert tknId tkn $ tokens st
@@ -11,7 +11,7 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (UTCTime)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..), UserId)
+import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
@@ -48,7 +48,6 @@ data NtfToken = NtfToken
    ntfServer :: NtfServer,
    ntfTokenId :: Maybe NtfTokenId,
    -- TODO combine keys to key pair as the types should match
-
    -- | key used by the ntf server to verify transmissions
    ntfPubKey :: C.APublicAuthKey,
    -- | key used by the ntf client to sign transmissions
@@ -80,17 +79,17 @@ newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys ntfMode =
      ntfMode
    }

-data NtfSubAction = NSANtf NtfSubNTFAction | NSASMP NtfSubSMPAction
+data NtfSubAction = NtfSubNTFAction NtfSubNTFAction | NtfSubSMPAction NtfSubSMPAction
  deriving (Show)

 isDeleteNtfSubAction :: NtfSubAction -> Bool
 isDeleteNtfSubAction = \case
-  NSANtf a -> case a of
+  NtfSubNTFAction a -> case a of
    NSACreate -> False
    NSACheck -> False
    NSADelete -> True
    NSARotate -> True
-  NSASMP a -> case a of
+  NtfSubSMPAction a -> case a of
    NSASmpKey -> False
    NSASmpDelete -> True

@@ -178,8 +177,7 @@ instance FromField NtfAgentSubStatus where fromField = fromTextField_ $ either (
 instance ToField NtfAgentSubStatus where toField = toField . decodeLatin1 . smpEncode

 data NtfSubscription = NtfSubscription
-  { userId :: UserId,
-    connId :: ConnId,
+  { connId :: ConnId,
    smpServer :: SMPServer,
    ntfQueueId :: Maybe NotifierId,
    ntfServer :: NtfServer,
@@ -188,11 +186,10 @@ data NtfSubscription = NtfSubscription
  }
  deriving (Show)

-newNtfSubscription :: UserId -> ConnId -> SMPServer -> Maybe NotifierId -> NtfServer -> NtfAgentSubStatus -> NtfSubscription
-newNtfSubscription userId connId smpServer ntfQueueId ntfServer ntfSubStatus =
+newNtfSubscription :: ConnId -> SMPServer -> Maybe NotifierId -> NtfServer -> NtfAgentSubStatus -> NtfSubscription
+newNtfSubscription connId smpServer ntfQueueId ntfServer ntfSubStatus =
  NtfSubscription
-    { userId,
-      connId,
+    { connId,
      smpServer,
      ntfQueueId,
      ntfServer,
@@ -37,7 +37,6 @@ module Simplex.Messaging.Server
  )
 where

-import Control.Concurrent.STM.TQueue (flushTQueue)
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
@@ -48,7 +47,6 @@ import Crypto.Random
 import Control.Monad.STM (retry)
 import Data.Bifunctor (first)
 import Data.ByteString.Base64 (encode)
-import qualified Data.ByteString.Builder as BLD
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -56,7 +54,6 @@ import Data.Either (fromRight, partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
-import qualified Data.IntSet as IS
 import Data.List (intercalate, mapAccumR)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
@@ -72,7 +69,6 @@ import Data.Type.Equality
 import GHC.Stats (getRTSStats)
 import GHC.TypeLits (KnownNat)
 import Network.Socket (ServiceName, Socket, socketToHandle)
-import Numeric.Natural (Natural)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, forwardSMPTransmission, smpProxyError, temporaryClientError)
 import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient, getConnectedSMPServerClient)
@@ -162,33 +158,28 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
      forall s.
      Server ->
      String ->
-      (Server -> TQueue (QueueId, Client, Subscribed)) ->
+      (Server -> TQueue (QueueId, Client)) ->
      (Server -> TMap QueueId Client) ->
      (Client -> TMap QueueId s) ->
      (s -> IO ()) ->
      M ()
    serverThread s label subQ subs clientSubs unsub = do
      labelMyThread label
-      cls <- asks clients
      forever $
-        atomically (updateSubscribers cls)
+        atomically updateSubscribers
          $>>= endPreviousSubscriptions
          >>= liftIO . mapM_ unsub
      where
-        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> STM (Maybe (QueueId, Client))
-        updateSubscribers cls = do
-          (qId, clnt, subscribed) <- readTQueue $ subQ s
-          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
+        updateSubscribers :: STM (Maybe (QueueId, Client))
+        updateSubscribers = do
+          (qId, clnt) <- readTQueue $ subQ s
+          let clientToBeNotified c' =
+                if sameClientId clnt c'
+                  then pure Nothing
+                  else do
                    yes <- readTVar $ connected c'
                    pure $ if yes then Just (qId, c') else Nothing
-          updateSub qId (subs s) $>>= clientToBeNotified
+          TM.lookupInsert qId clnt (subs s) $>>= clientToBeNotified
        endPreviousSubscriptions :: (QueueId, Client) -> M (Maybe s)
        endPreviousSubscriptions (qId, c) = do
          forkClient c (label <> ".endPreviousSubscriptions") $
@@ -238,9 +229,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
      initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
      liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
      liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubNoMsg, qSubAuth, qSubDuplicate, qSubProhibited, ntfCreated, ntfDeleted, ntfSub, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, subscribedQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
-        <- asks serverStats
-      QueueStore {queues, notifiers} <- asks queueStore
+      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubAuth, qSubDuplicate, qSubProhibited, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv} <- asks serverStats
      let interval = 1000000 * logInterval
      forever $ do
        withFile statsFilePath AppendMode $ \h -> liftIO $ do
@@ -253,29 +242,16 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
          qDeletedNew' <- atomically $ swapTVar qDeletedNew 0
          qDeletedSecured' <- atomically $ swapTVar qDeletedSecured 0
          qSub' <- atomically $ swapTVar qSub 0
-          qSubNoMsg' <- atomically $ swapTVar qSubNoMsg 0
          qSubAuth' <- atomically $ swapTVar qSubAuth 0
          qSubDuplicate' <- atomically $ swapTVar qSubDuplicate 0
          qSubProhibited' <- atomically $ swapTVar qSubProhibited 0
-          ntfCreated' <- atomically $ swapTVar ntfCreated 0
-          ntfDeleted' <- atomically $ swapTVar ntfDeleted 0
-          ntfSub' <- atomically $ swapTVar ntfSub 0
-          ntfSubAuth' <- atomically $ swapTVar ntfSubAuth 0
-          ntfSubDuplicate' <- atomically $ swapTVar ntfSubDuplicate 0
          msgSent' <- atomically $ swapTVar msgSent 0
          msgSentAuth' <- atomically $ swapTVar msgSentAuth 0
          msgSentQuota' <- atomically $ swapTVar msgSentQuota 0
          msgSentLarge' <- atomically $ swapTVar msgSentLarge 0
          msgRecv' <- atomically $ swapTVar msgRecv 0
-          msgRecvGet' <- atomically $ swapTVar msgRecvGet 0
-          msgGet' <- atomically $ swapTVar msgGet 0
-          msgGetNoMsg' <- atomically $ swapTVar msgGetNoMsg 0
-          msgGetAuth' <- atomically $ swapTVar msgGetAuth 0
-          msgGetDuplicate' <- atomically $ swapTVar msgGetDuplicate 0
-          msgGetProhibited' <- atomically $ swapTVar msgGetProhibited 0
          msgExpired' <- atomically $ swapTVar msgExpired 0
          ps <- atomically $ periodStatCounts activeQueues ts
-          psSub <- atomically $ periodStatCounts subscribedQueues ts
          msgSentNtf' <- atomically $ swapTVar msgSentNtf 0
          msgRecvNtf' <- atomically $ swapTVar msgRecvNtf 0
          psNtf <- atomically $ periodStatCounts activeQueuesNtf ts
@@ -288,8 +264,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
          pMsgFwdsOwn' <- atomically $ getResetProxyStatsData pMsgFwdsOwn
          pMsgFwdsRecv' <- atomically $ swapTVar pMsgFwdsRecv 0
          qCount' <- readTVarIO qCount
-          qCount'' <- M.size <$> readTVarIO queues
-          ntfCount' <- M.size <$> readTVarIO notifiers
          msgCount' <- readTVarIO msgCount
          hPutStrLn h $
            intercalate
@@ -328,24 +302,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                       show msgSentLarge',
                       show msgNtfs',
                       show msgNtfNoSub',
-                       show msgNtfLost',
-                       show qSubNoMsg',
-                       show msgRecvGet',
-                       show msgGet',
-                       show msgGetNoMsg',
-                       show msgGetAuth',
-                       show msgGetDuplicate',
-                       show msgGetProhibited',
-                       dayCount psSub,
-                       weekCount psSub,
-                       monthCount psSub,
-                       show qCount'',
-                       show ntfCreated',
-                       show ntfDeleted',
-                       show ntfSub',
-                       show ntfSubAuth',
-                       show ntfSubDuplicate',
-                       show ntfCount'
+                       show msgNtfLost'
                     ]
              )
        liftIO $ threadDelay' interval
@@ -412,7 +369,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
              CPClients -> withAdminRole $ do
                active <- unliftIO u (asks clients) >>= readTVarIO
                hPutStrLn h "clientId,sessionId,connected,createdAt,rcvActiveAt,sndActiveAt,age,subscriptions"
-                forM_ (IM.toList active) $ \(cid, cl) -> forM_ cl $ \Client {sessionId, connected, createdAt, rcvActiveAt, sndActiveAt, subscriptions} -> do
+                forM_ (IM.toList active) $ \(cid, Client {sessionId, connected, createdAt, rcvActiveAt, sndActiveAt, subscriptions}) -> do
                  connected' <- bshow <$> readTVarIO connected
                  rcvActiveAt' <- strEncode <$> readTVarIO rcvActiveAt
                  sndActiveAt' <- strEncode <$> readTVarIO sndActiveAt
@@ -422,33 +379,21 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                  hPutStrLn h . B.unpack $ B.intercalate "," [bshow cid, encode sessionId, connected', strEncode createdAt, rcvActiveAt', sndActiveAt', bshow age, subscriptions']
              CPStats -> withUserRole $ do
                ss <- unliftIO u $ asks serverStats
-                let getStat :: (ServerStats -> TVar a) -> IO a
-                    getStat var = readTVarIO (var ss)
-                    putStat :: Show a => String -> (ServerStats -> TVar a) -> IO ()
-                    putStat label var = getStat var >>= \v -> hPutStrLn h $ label <> ": " <> show v
-                    putProxyStat :: String -> (ServerStats -> ProxyStats) -> IO ()
+                let putStat :: Show a => ByteString -> (ServerStats -> TVar a) -> IO ()
+                    putStat label var = readTVarIO (var ss) >>= \v -> B.hPutStr h $ label <> ": " <> bshow v <> "\n"
+                    putProxyStat :: ByteString -> (ServerStats -> ProxyStats) -> IO ()
                    putProxyStat label var = do
-                      ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther} <- getProxyStatsData $ var ss
-                      hPutStrLn h $ label <> ": requests=" <> show _pRequests <> ", successes=" <> show _pSuccesses <> ", errorsConnect=" <> show _pErrorsConnect <> ", errorsCompat=" <> show _pErrorsCompat <> ", errorsOther=" <> show _pErrorsOther
+                      ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther} <- atomically $ getProxyStatsData $ var ss
+                      B.hPutStr h $ label <> ": requests=" <> bshow _pRequests <> ", successes=" <> bshow _pSuccesses <> ", errorsConnect=" <> bshow _pErrorsConnect <> ", errorsCompat=" <> bshow _pErrorsCompat <> ", errorsOther=" <> bshow _pErrorsOther <> "\n"
                putStat "fromTime" fromTime
                putStat "qCreated" qCreated
                putStat "qSecured" qSecured
                putStat "qDeletedAll" qDeletedAll
                putStat "qDeletedNew" qDeletedNew
                putStat "qDeletedSecured" qDeletedSecured
-                getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "daily active queues: " <> show (S.size v)
-                getStat (day . subscribedQueues) >>= \v -> hPutStrLn h $ "daily subscribed queues: " <> show (S.size v)
-                putStat "qSub" qSub
-                putStat "qSubNoMsg" qSubNoMsg
-                subs <- (,,) <$> getStat qSubAuth <*> getStat qSubDuplicate <*> getStat qSubProhibited
-                hPutStrLn h $ "other SUB events (auth, duplicate, prohibited): " <> show subs
+                readTVarIO (day $ activeQueues ss) >>= \v -> B.hPutStr h $ "dayMsgQueues" <> ": " <> bshow (S.size v) <> "\n"
                putStat "msgSent" msgSent
                putStat "msgRecv" msgRecv
-                putStat "msgRecvGet" msgRecvGet
-                putStat "msgGet" msgGet
-                putStat "msgGetNoMsg" msgGet
-                gets <- (,,) <$> getStat msgGetAuth <*> getStat msgGetDuplicate <*> getStat msgGetProhibited
-                hPutStrLn h $ "other GET events (auth, duplicate, prohibited): " <> show gets
                putStat "msgSentNtf" msgSentNtf
                putStat "msgRecvNtf" msgRecvNtf
                putStat "qCount" qCount
@@ -472,7 +417,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
 #endif
              CPSockets -> withUserRole $ do
                (accepted', closed', active') <- unliftIO u $ asks sockets
-                (accepted, closed, active) <- (,,) <$> readTVarIO accepted' <*> readTVarIO closed' <*> readTVarIO active'
+                (accepted, closed, active) <- atomically $ (,,) <$> readTVar accepted' <*> readTVar closed' <*> readTVar active'
                hPutStrLn h "Sockets: "
                hPutStrLn h $ "accepted: " <> show accepted
                hPutStrLn h $ "closed: " <> show closed
@@ -507,80 +452,28 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                  activeClients <- readTVarIO clients
                  hPutStrLn h $ "Clients: " <> show (IM.size activeClients)
                  when (r == CPRAdmin) $ do
-                    clQs <- clientTBQueueLengths' activeClients
-                    hPutStrLn h $ "Client queues (rcvQ, sndQ, msgQ): " <> show clQs
-                    (smpSubCnt, smpSubCntByGroup, smpClCnt, smpClQs) <- countClientSubs subscriptions (Just countSMPSubs) activeClients
-                    hPutStrLn h $ "SMP subscriptions (via clients): " <> show smpSubCnt
-                    hPutStrLn h $ "SMP subscriptions (by group: NoSub, SubPending, SubThread, ProhibitSub): " <> show smpSubCntByGroup
-                    hPutStrLn h $ "SMP subscribed clients (via clients): " <> show smpClCnt
-                    hPutStrLn h $ "SMP subscribed clients queues (via clients, rcvQ, sndQ, msgQ): " <> show smpClQs
-                    (ntfSubCnt, _, ntfClCnt, ntfClQs) <- countClientSubs ntfSubscriptions Nothing activeClients
-                    hPutStrLn h $ "Ntf subscriptions (via clients): " <> show ntfSubCnt
-                    hPutStrLn h $ "Ntf subscribed clients (via clients): " <> show ntfClCnt
-                    hPutStrLn h $ "Ntf subscribed clients queues (via clients, rcvQ, sndQ, msgQ): " <> show ntfClQs
-                  putActiveClientsInfo "SMP" subscribers
-                  putActiveClientsInfo "Ntf" notifiers
+                    (smpSubCnt, smpClCnt) <- countClientSubs subscriptions activeClients
+                    (ntfSubCnt, ntfClCnt) <- countClientSubs ntfSubscriptions activeClients
+                    hPutStrLn h $ "SMP subscriptions (via clients, slow): " <> show smpSubCnt
+                    hPutStrLn h $ "SMP subscribed clients (via clients, slow): " <> show smpClCnt
+                    hPutStrLn h $ "Ntf subscriptions (via clients, slow): " <> show ntfSubCnt
+                    hPutStrLn h $ "Ntf subscribed clients (via clients, slow): " <> show ntfClCnt
+                  activeSubs <- readTVarIO subscribers
+                  activeNtfSubs <- readTVarIO notifiers
+                  hPutStrLn h $ "SMP subscriptions: " <> show (M.size activeSubs)
+                  hPutStrLn h $ "SMP subscribed clients: " <> show (countSubClients activeSubs)
+                  hPutStrLn h $ "Ntf subscriptions: " <> show (M.size activeNtfSubs)
+                  hPutStrLn h $ "Ntf subscribed clients: " <> show (countSubClients activeNtfSubs)
                  where
-                    putActiveClientsInfo :: String -> TMap QueueId 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
-                      hPutStrLn h $ protoName <> " subscribed clients: " <> show clCnt
+                    countClientSubs :: (Client -> TMap QueueId a) -> IM.IntMap Client -> IO (Int, Int)
+                    countClientSubs subSel = foldM addSubs (0, 0)
                      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
-                    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
-                        addSubs :: (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural)) -> Maybe Client -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
-                        addSubs acc Nothing = pure acc
-                        addSubs (!subCnt, cnts@(!c1, !c2, !c3, !c4), !clCnt, !qs) (Just cl) = do
+                        addSubs :: (Int, Int) -> Client -> IO (Int, Int)
+                        addSubs (subCnt, clCnt) cl = do
                          subs <- readTVarIO $ subSel cl
-                          cnts' <- case countSubs_ of
-                            Nothing -> pure cnts
-                            Just countSubs -> do
-                              (c1', c2', c3', c4') <- countSubs subs
-                              pure (c1 + c1', c2 + c2', c3 + c3', c4 + c4')
                          let cnt = M.size subs
-                              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
-                      (rl', sl', ml') <- queueLengths cl
-                      pure (rl + rl', sl + sl', ml + ml')
-                    queueLengths Client {rcvQ, sndQ, msgQ} = do
-                      rl <- atomically $ lengthTBQueue rcvQ
-                      sl <- atomically $ lengthTBQueue sndQ
-                      ml <- atomically $ lengthTBQueue msgQ
-                      pure (rl, sl, ml)
-                    countSMPSubs :: M.Map QueueId Sub -> IO (Int, Int, Int, Int)
-                    countSMPSubs = foldM countSubs (0, 0, 0, 0)
-                      where
-                        countSubs (c1, c2, c3, c4) Sub {subThread} = case subThread of
-                          ServerSub t -> do
-                            st <- readTVarIO t
-                            pure $ case st of
-                              NoSub -> (c1 + 1, c2, c3, c4)
-                              SubPending -> (c1, c2 + 1, c3, c4)
-                              SubThread _ -> (c1, c2, c3 + 1, c4)
-                          ProhibitSub -> pure (c1, c2, c3, c4 + 1)
+                          pure (subCnt + cnt, clCnt + if cnt == 0 then 0 else 1)
+                    countSubClients = S.size . M.foldr' (S.insert . clientId) S.empty
              CPDelete queueId' -> withUserRole $ unliftIO u $ do
                st <- asks queueStore
                ms <- asks msgStore
@@ -622,40 +515,35 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
  ts <- liftIO getSystemTime
  active <- asks clients
  nextClientId <- asks clientSeq
-  clientId <- atomically $ stateTVar nextClientId $ \next -> (next, next + 1)
-  atomically $ modifyTVar' active $ IM.insert clientId Nothing
-  c <- liftIO $ newClient clientId q thVersion sessionId ts
-  runClientThreads active c clientId `finally` clientDisconnected c
+  c <- atomically $ do
+    new@Client {clientId} <- newClient nextClientId q thVersion sessionId ts
+    modifyTVar' active $ IM.insert clientId new
+    pure new
+  s <- asks server
+  expCfg <- asks $ inactiveClientExpiration . config
+  th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
+  labelMyThread . B.unpack $ "client $" <> encode sessionId
+  raceAny_ ([liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg)
+    `finally` clientDisconnected c
  where
-    runClientThreads active c clientId = do
-      atomically $ modifyTVar' active $ IM.insert clientId $ Just c
-      s <- asks server
-      expCfg <- asks $ inactiveClientExpiration . config
-      th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
-      labelMyThread . B.unpack $ "client $" <> encode sessionId
-      raceAny_ $ [liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg
    disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport h (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c)]
    disconnectThread_ _ _ = []
-    noSubscriptions c = atomically $ (&&) <$> TM.null (ntfSubscriptions c) <*> (not . hasSubs <$> readTVar (subscriptions c))
-    hasSubs = any $ (\case ServerSub _ -> True; ProhibitSub -> False) . subThread
+    noSubscriptions c = atomically $ (&&) <$> TM.null (subscriptions c) <*> TM.null (ntfSubscriptions c)

 clientDisconnected :: Client -> M ()
-clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connected, sessionId, endThreads} = do
+clientDisconnected c@Client {clientId, subscriptions, connected, sessionId, endThreads} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disc"
-  (subs, ntfSubs) <- atomically $ do
+  subs <- atomically $ do
    writeTVar connected False
-    (,) <$> swapTVar subscriptions M.empty <*> swapTVar ntfSubscriptions M.empty
+    swapTVar subscriptions M.empty
  liftIO $ mapM_ cancelSub subs
-  Server {subscribers, notifiers} <- asks server
-  updateSubscribers subs subscribers
-  updateSubscribers ntfSubs notifiers
+  srvSubs <- asks $ subscribers . server
+  atomically $ modifyTVar' srvSubs $ \cs ->
+    M.foldrWithKey (\sub _ -> M.update deleteCurrentClient sub) cs subs
  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
@@ -665,12 +553,10 @@ sameClientId :: Client -> Client -> Bool
 sameClientId Client {clientId} Client {clientId = cId'} = clientId == cId'

 cancelSub :: Sub -> IO ()
-cancelSub s = case subThread s of
-  ServerSub st ->
-    readTVarIO st >>= \case
-      SubThread t -> liftIO $ deRefWeak t >>= mapM_ killThread
-      _ -> pure ()
-  ProhibitSub -> pure ()
+cancelSub s =
+  readTVarIO (subThread s) >>= \case
+    SubThread t -> liftIO $ deRefWeak t >>= mapM_ killThread
+    _ -> pure ()

 receive :: Transport c => THandleSMP c 'TServer -> Client -> M ()
 receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
@@ -693,10 +579,8 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
              VRVerified qr -> pure $ Right (qr, (corrId, entId, cmd))
              VRFailed -> do
                case cmd of
-                  Cmd _ SEND {} -> incStat $ msgSentAuth stats
-                  Cmd _ SUB -> incStat $ qSubAuth stats
-                  Cmd _ NSUB -> incStat $ ntfSubAuth stats
-                  Cmd _ GET -> incStat $ msgGetAuth stats
+                  Cmd _ SEND {} -> atomically $ modifyTVar' (msgSentAuth stats) (+ 1)
+                  Cmd _ SUB -> atomically $ modifyTVar' (qSubAuth stats) (+ 1)
                  _ -> pure ()
                pure $ Left (corrId, entId, ERR AUTH)
    write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
@@ -891,7 +775,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
        ProxyAgent {smpAgent = a} <- asks proxyAgent
        ServerStats {pMsgFwds, pMsgFwdsOwn} <- asks serverStats
        let inc = mkIncProxyStats pMsgFwds pMsgFwdsOwn
-        liftIO (lookupSMPServerClient a sessId) >>= \case
+        atomically (lookupSMPServerClient a sessId) >>= \case
          Just (own, smp) -> do
            inc own pRequests
            if v >= sendingProxySMPVersion
@@ -924,13 +808,13 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
    transportErr = PROXY . BROKER . TRANSPORT
    mkIncProxyStats :: MonadIO m => ProxyStats -> ProxyStats -> OwnServer -> (ProxyStats -> TVar Int) -> m ()
    mkIncProxyStats ps psOwn own sel = do
-      incStat $ sel ps
-      when own $ incStat $ sel psOwn
+      atomically $ modifyTVar' (sel ps) (+ 1)
+      when own $ atomically $ modifyTVar' (sel psOwn) (+ 1)
    processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
-    processCommand (qr_, (corrId, entId, cmd)) = case cmd of
-      Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
+    processCommand (qr_, (corrId, queueId, cmd)) = case cmd of
+      Cmd SProxiedClient command -> processProxiedCmd (corrId, queueId, command)
      Cmd SSender command -> Just <$> case command of
-        SKEY sKey -> (corrId,entId,) <$> case qr_ of
+        SKEY sKey -> (corrId,queueId,) <$> case qr_ of
          Just QueueRec {sndSecure, recipientId}
            | sndSecure -> secureQueue_ "SKEY" recipientId sKey
            | otherwise -> pure $ ERR AUTH
@@ -946,15 +830,15 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
            ifM
              allowNew
              (createQueue st rKey dhKey subMode sndSecure)
-              (pure (corrId, entId, ERR AUTH))
+              (pure (corrId, queueId, ERR AUTH))
            where
              allowNew = do
                ServerConfig {allowNewQueues, newQueueBasicAuth} <- asks config
                pure $ allowNewQueues && maybe True ((== auth) . Just) newQueueBasicAuth
-          SUB -> withQueue (`subscribeQueue` entId)
+          SUB -> withQueue (`subscribeQueue` queueId)
          GET -> withQueue getMessage
          ACK msgId -> withQueue (`acknowledgeMsg` msgId)
-          KEY sKey -> (corrId,entId,) <$> case qr_ of
+          KEY sKey -> (corrId,queueId,) <$> case qr_ of
            Just QueueRec {recipientId} -> secureQueue_ "KEY" recipientId sKey
            Nothing -> pure $ ERR INTERNAL
          NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
@@ -979,7 +863,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                    status = QueueActive,
                    sndSecure
                  }
-          (corrId,entId,) <$> addQueueRetry 3 qik qRec
+          (corrId,queueId,) <$> addQueueRetry 3 qik qRec
          where
            addQueueRetry ::
              Int -> ((RecipientId, SenderId) -> QueueIdsKeys) -> ((RecipientId, SenderId) -> QueueRec) -> M BrokerMsg
@@ -994,8 +878,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                Right _ -> do
                  withLog (`logCreateById` rId)
                  stats <- asks serverStats
-                  incStat $ qCreated stats
-                  incStat $ qCount stats
+                  atomically $ modifyTVar' (qCreated stats) (+ 1)
+                  atomically $ modifyTVar' (qCount stats) (+ 1)
                  case subMode of
                    SMOnlyCreate -> pure ()
                    SMSubscribe -> void $ subscribeQueue qr rId
@@ -1017,178 +901,152 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
          withLog $ \s -> logSecureQueue s rId sKey
          st <- asks queueStore
          stats <- asks serverStats
-          incStat $ qSecured stats
+          atomically $ modifyTVar' (qSecured stats) (+ 1)
          atomically $ either ERR (const OK) <$> secureQueue st rId sKey

        addQueueNotifier_ :: QueueStore -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> M (Transmission BrokerMsg)
        addQueueNotifier_ st notifierKey dhKey = time "NKEY" $ do
          (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
          let rcvNtfDhSecret = C.dh' dhKey privDhKey
-          (corrId,entId,) <$> addNotifierRetry 3 rcvPublicDhKey rcvNtfDhSecret
+          (corrId,queueId,) <$> addNotifierRetry 3 rcvPublicDhKey rcvNtfDhSecret
          where
            addNotifierRetry :: Int -> RcvNtfPublicDhKey -> RcvNtfDhSecret -> M BrokerMsg
            addNotifierRetry 0 _ _ = pure $ ERR INTERNAL
            addNotifierRetry n rcvPublicDhKey rcvNtfDhSecret = do
              notifierId <- randomId =<< asks (queueIdBytes . config)
              let ntfCreds = NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}
-              atomically (addQueueNotifier st entId ntfCreds) >>= \case
+              atomically (addQueueNotifier st queueId ntfCreds) >>= \case
                Left DUPLICATE_ -> addNotifierRetry (n - 1) rcvPublicDhKey rcvNtfDhSecret
                Left e -> pure $ ERR e
                Right _ -> do
-                  withLog $ \s -> logAddNotifier s entId ntfCreds
-                  incStat . ntfCreated =<< asks serverStats
+                  withLog $ \s -> logAddNotifier s queueId ntfCreds
                  pure $ NID notifierId rcvPublicDhKey

        deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
        deleteQueueNotifier_ st = do
-          withLog (`logDeleteNotifier` entId)
-          atomically (deleteQueueNotifier st entId) >>= \case
-            Right () -> 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)
-              incStat . ntfDeleted =<< asks serverStats
-              pure ok
-            Left e -> pure $ err e
+          withLog (`logDeleteNotifier` queueId)
+          okResp <$> atomically (deleteQueueNotifier st queueId)

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

        subscribeQueue :: QueueRec -> RecipientId -> M (Transmission BrokerMsg)
        subscribeQueue qr rId = do
+          stats <- asks serverStats
          atomically (TM.lookup rId subscriptions) >>= \case
-            Nothing -> newSub >>= deliver True
-            Just s@Sub {subThread} -> do
-              stats <- asks serverStats
-              case subThread of
+            Nothing -> do
+              atomically $ modifyTVar' (qSub stats) (+ 1)
+              newSub >>= deliver
+            Just s@Sub {subThread} ->
+              readTVarIO subThread >>= \case
                ProhibitSub -> do
                  -- cannot use SUB in the same connection where GET was used
-                  incStat $ qSubProhibited stats
+                  atomically $ modifyTVar' (qSubProhibited stats) (+ 1)
                  pure (corrId, rId, ERR $ CMD PROHIBITED)
                _ -> do
-                  incStat $ qSubDuplicate stats
-                  atomically (tryTakeTMVar $ delivered s) >> deliver False s
+                  atomically $ modifyTVar' (qSubDuplicate stats) (+ 1)
+                  atomically (tryTakeTMVar $ delivered s) >> deliver s
          where
            newSub :: M Sub
            newSub = time "SUB newSub" . atomically $ do
-              writeTQueue subscribedQ (rId, clnt, True)
+              writeTQueue subscribedQ (rId, clnt)
              sub <- newSubscription NoSub
              TM.insert rId sub subscriptions
              pure sub
-            deliver :: Bool -> Sub -> M (Transmission BrokerMsg)
-            deliver inc sub = do
+            deliver :: Sub -> M (Transmission BrokerMsg)
+            deliver sub = do
              q <- getStoreMsgQueue "SUB" rId
              msg_ <- atomically $ tryPeekMsg q
-              when inc $ do
-                stats <- asks serverStats
-                incStat $ (if isJust msg_ then qSub else qSubNoMsg) stats
-                atomically $ updatePeriodStats (subscribedQueues stats) rId
              deliverMessage "SUB" qr rId sub msg_

        getMessage :: QueueRec -> M (Transmission BrokerMsg)
        getMessage qr = time "GET" $ do
-          atomically (TM.lookup entId subscriptions) >>= \case
+          atomically (TM.lookup queueId subscriptions) >>= \case
            Nothing ->
-              atomically newSub >>= (`getMessage_` Nothing)
+              atomically newSub >>= getMessage_
            Just s@Sub {subThread} ->
-              case subThread of
+              readTVarIO subThread >>= \case
                ProhibitSub ->
                  atomically (tryTakeTMVar $ delivered s)
-                    >>= getMessage_ s
+                    >> getMessage_ s
                -- cannot use GET in the same connection where there is an active subscription
-                _ -> do
-                  stats <- asks serverStats
-                  incStat $ msgGetProhibited stats
-                  pure (corrId, entId, ERR $ CMD PROHIBITED)
+                _ -> pure (corrId, queueId, ERR $ CMD PROHIBITED)
          where
            newSub :: STM Sub
            newSub = do
-              s <- newProhibitedSub
-              TM.insert entId s subscriptions
+              s <- newSubscription ProhibitSub
+              TM.insert queueId s subscriptions
              pure s
-            getMessage_ :: Sub -> Maybe MsgId -> M (Transmission BrokerMsg)
-            getMessage_ s delivered_ = do
-              q <- getStoreMsgQueue "GET" entId
-              stats <- asks serverStats
-              (statCnt, r) <-
-                atomically $
-                  tryPeekMsg q >>= \case
-                    Just msg ->
-                      let encMsg = encryptMsg qr msg
-                          cnt = if isJust delivered_ then msgGetDuplicate else msgGet
-                       in setDelivered s msg $> (cnt, (corrId, entId, MSG encMsg))
-                    _ -> pure (msgGetNoMsg, (corrId, entId, OK))
-              incStat $ statCnt stats
-              pure r
+            getMessage_ :: Sub -> M (Transmission BrokerMsg)
+            getMessage_ s = do
+              q <- getStoreMsgQueue "GET" queueId
+              atomically $
+                tryPeekMsg q >>= \case
+                  Just msg ->
+                    let encMsg = encryptMsg qr msg
+                     in setDelivered s msg $> (corrId, queueId, MSG encMsg)
+                  _ -> pure (corrId, queueId, OK)

        withQueue :: (QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
        withQueue action = maybe (pure $ err AUTH) action qr_

        subscribeNotifications :: M (Transmission BrokerMsg)
-        subscribeNotifications = do
-          statCount <-
-            time "NSUB" . atomically $ do
-              ifM
-                (TM.member entId ntfSubscriptions)
-                (pure ntfSubDuplicate)
-                (newSub $> ntfSub)
-          incStat . statCount =<< asks serverStats
+        subscribeNotifications = time "NSUB" . atomically $ do
+          unlessM (TM.member queueId ntfSubscriptions) $ do
+            writeTQueue ntfSubscribedQ (queueId, clnt)
+            TM.insert queueId () ntfSubscriptions
          pure ok
-          where
-            newSub = do
-              writeTQueue ntfSubscribedQ (entId, clnt, True)
-              TM.insert entId () ntfSubscriptions

        acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
        acknowledgeMsg qr msgId = time "ACK" $ do
-          liftIO (TM.lookupIO entId subscriptions) >>= \case
+          atomically (TM.lookup queueId subscriptions) >>= \case
            Nothing -> pure $ err NO_MSG
            Just sub ->
              atomically (getDelivered sub) >>= \case
                Just st -> do
-                  q <- getStoreMsgQueue "ACK" entId
+                  q <- getStoreMsgQueue "ACK" queueId
                  case st of
                    ProhibitSub -> do
                      deletedMsg_ <- atomically $ tryDelMsg q msgId
-                      mapM_ (updateStats True) deletedMsg_
+                      mapM_ updateStats deletedMsg_
                      pure ok
                    _ -> do
                      (deletedMsg_, msg_) <- atomically $ tryDelPeekMsg q msgId
-                      mapM_ (updateStats False) deletedMsg_
-                      deliverMessage "ACK" qr entId sub msg_
+                      mapM_ updateStats deletedMsg_
+                      deliverMessage "ACK" qr queueId sub msg_
                _ -> pure $ err NO_MSG
          where
-            getDelivered :: Sub -> STM (Maybe ServerSub)
+            getDelivered :: Sub -> STM (Maybe SubscriptionThread)
            getDelivered Sub {delivered, subThread} = do
              tryTakeTMVar delivered $>>= \msgId' ->
                if msgId == msgId' || B.null msgId
-                  then pure $ Just subThread
+                  then Just <$> readTVar subThread
                  else putTMVar delivered msgId' $> Nothing
-            updateStats :: Bool -> Message -> M ()
-            updateStats isGet = \case
+            updateStats :: Message -> M ()
+            updateStats = \case
              MessageQuota {} -> pure ()
              Message {msgFlags} -> do
                stats <- asks serverStats
-                incStat $ msgRecv stats
-                when isGet $ incStat $ msgRecvGet stats
+                atomically $ modifyTVar' (msgRecv stats) (+ 1)
                atomically $ modifyTVar' (msgCount stats) (subtract 1)
-                atomically $ updatePeriodStats (activeQueues stats) entId
+                atomically $ updatePeriodStats (activeQueues stats) queueId
                when (notification msgFlags) $ do
-                  incStat $ msgRecvNtf stats
-                  atomically $ updatePeriodStats (activeQueuesNtf stats) entId
+                  atomically $ modifyTVar' (msgRecvNtf stats) (+ 1)
+                  atomically $ updatePeriodStats (activeQueuesNtf stats) queueId

        sendMessage :: QueueRec -> MsgFlags -> MsgBody -> M (Transmission BrokerMsg)
        sendMessage qr msgFlags msgBody
          | B.length msgBody > maxMessageLength thVersion = do
              stats <- asks serverStats
-              incStat $ msgSentLarge stats
+              atomically $ modifyTVar' (msgSentLarge stats) (+ 1)
              pure $ err LARGE_MSG
          | otherwise = do
              stats <- asks serverStats
              case status qr of
                QueueOff -> do
-                  incStat $ msgSentAuth stats
+                  atomically $ modifyTVar' (msgSentAuth stats) (+ 1)
                  pure $ err AUTH
                QueueActive ->
                  case C.maxLenBS msgBody of
@@ -1200,7 +1058,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                        atomically . writeMsg q =<< mkMessage body
                      case msg_ of
                        Nothing -> do
-                          incStat $ msgSentQuota stats
+                          atomically $ modifyTVar' (msgSentQuota stats) (+ 1)
                          pure $ err QUOTA
                        Just (msg, wasEmpty) -> time "SEND ok" $ do
                          when wasEmpty $ tryDeliverMessage msg
@@ -1208,16 +1066,16 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                            forM_ (notifier qr) $ \ntf -> do
                              asks random >>= atomically . trySendNotification ntf msg >>= \case
                                Nothing -> do
-                                  incStat $ msgNtfNoSub stats
+                                  atomically $ modifyTVar' (msgNtfNoSub stats) (+ 1)
                                  logWarn "No notification subscription"
                                Just False -> do
-                                  incStat $ msgNtfLost stats
+                                  atomically $ modifyTVar' (msgNtfLost stats) (+ 1)
                                  logWarn "Dropped message notification"
-                                Just True -> incStat $ msgNtfs stats
-                            incStat $ msgSentNtf stats
+                                Just True -> atomically $ modifyTVar' (msgNtfs stats) (+ 1)
+                            atomically $ modifyTVar' (msgSentNtf stats) (+ 1)
                            atomically $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
-                          incStat $ msgSent stats
-                          incStat $ msgCount stats
+                          atomically $ modifyTVar' (msgSent stats) (+ 1)
+                          atomically $ modifyTVar' (msgCount stats) (+ 1)
                          atomically $ updatePeriodStats (activeQueues stats) (recipientId qr)
                          pure ok
          where
@@ -1252,28 +1110,26 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                deliverToSub =
                  TM.lookup rId subscribers
                    $>>= \rc@Client {subscriptions = subs, sndQ = q} -> TM.lookup rId subs
-                    $>>= \s@Sub {subThread, delivered} -> case subThread of
-                      ProhibitSub -> pure Nothing
-                      ServerSub st -> readTVar st >>= \case
-                        NoSub ->
-                          tryTakeTMVar delivered >>= \case
-                            Just _ -> pure Nothing -- if a message was already delivered, should not deliver more
-                            Nothing ->
-                              ifM
-                                (isFullTBQueue q)
-                                (writeTVar st SubPending $> Just (rc, s, st))
-                                (deliver q s $> Nothing)
-                        _ -> pure Nothing
+                    $>>= \s@Sub {subThread, delivered} -> readTVar subThread >>= \case
+                      NoSub ->
+                        tryTakeTMVar delivered >>= \case
+                          Just _ -> pure Nothing -- if a message was already delivered, should not deliver more
+                          Nothing ->
+                            ifM
+                              (isFullTBQueue q)
+                              (writeTVar subThread SubPending $> Just (rc, s))
+                              (deliver q s $> Nothing)
+                      _ -> pure Nothing
                deliver q s = do
                  let encMsg = encryptMsg qr msg
                  writeTBQueue q [(CorrId "", rId, MSG encMsg)]
                  void $ setDelivered s msg
-                forkDeliver (rc@Client {sndQ = q}, s@Sub {delivered}, st) = do
+                forkDeliver (rc@Client {sndQ = q}, s@Sub {subThread, delivered}) = do
                  t <- mkWeakThreadId =<< forkIO deliverThread
-                  atomically . modifyTVar' st $ \case
+                  atomically . modifyTVar' subThread $ \case
                    -- this case is needed because deliverThread can exit before it
                    SubPending -> SubThread t
-                    st' -> st'
+                    st -> st
                  where
                    deliverThread = do
                      labelMyThread $ B.unpack ("client $" <> encode sessionId) <> " deliver/SEND"
@@ -1283,7 +1139,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                            Just _ -> pure () -- if a message was already delivered, should not deliver more
                            Nothing -> do
                              deliver q s
-                              writeTVar st NoSub
+                              writeTVar subThread NoSub

            trySendNotification :: NtfCreds -> Message -> TVar ChaChaDRG -> STM (Maybe Bool)
            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg ntfNonceDrg =
@@ -1341,7 +1197,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
          let fr = FwdResponse {fwdCorrId, fwdResponse = r2}
              r3 = EncFwdResponse $ C.cbEncryptNoPad sessSecret (C.reverseNonce proxyNonce) (smpEncode fr)
          stats <- asks serverStats
-          incStat $ pMsgFwdsRecv stats
+          atomically $ modifyTVar' (pMsgFwdsRecv stats) (+ 1)
          pure $ RRES r3
          where
            rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
@@ -1361,7 +1217,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                      VRFailed -> Left (corrId', entId', ERR AUTH)
        deliverMessage :: T.Text -> QueueRec -> RecipientId -> Sub -> Maybe Message -> M (Transmission BrokerMsg)
        deliverMessage name qr rId s@Sub {subThread} msg_ = time (name <> " deliver") . atomically $
-          case subThread of
+          readTVar subThread >>= \case
            ProhibitSub -> pure resp
            _ -> case msg_ of
              Just msg ->
@@ -1372,7 +1228,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
            resp = (corrId, rId, OK)

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

        encryptMsg :: QueueRec -> Message -> RcvMessage
        encryptMsg qr msg = encrypt . encodeRcvMsgBody $ case msg of
@@ -1395,44 +1251,37 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi

        delQueueAndMsgs :: QueueStore -> M (Transmission BrokerMsg)
        delQueueAndMsgs st = do
-          withLog (`logDeleteQueue` entId)
+          withLog (`logDeleteQueue` queueId)
          ms <- asks msgStore
-          atomically (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 ntfSubscribedQ (entId, clnt, False)
-              updateDeletedStats q
-              pure ok
+          atomically (deleteQueue st queueId $>>= \q -> delMsgQueue ms queueId $> Right q) >>= \case
+            Right q -> updateDeletedStats q $> ok
            Left e -> pure $ err e

        getQueueInfo :: QueueRec -> M (Transmission BrokerMsg)
        getQueueInfo QueueRec {senderKey, notifier} = do
-          q@MsgQueue {size} <- getStoreMsgQueue "getQueueInfo" entId
+          q@MsgQueue {size} <- getStoreMsgQueue "getQueueInfo" queueId
          info <- atomically $ do
-            qiSub <- TM.lookup entId subscriptions >>= mapM mkQSub
+            qiSub <- TM.lookup queueId subscriptions >>= mapM mkQSub
            qiSize <- readTVar size
            qiMsg <- toMsgInfo <$$> tryPeekMsg q
            pure QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
-          pure (corrId, entId, INFO info)
+          pure (corrId, queueId, INFO info)
          where
            mkQSub Sub {subThread, delivered} = do
-              qSubThread <- case subThread of
-                ServerSub t -> do
-                  st <- readTVar t
-                  pure $ case st of
+              st <- readTVar subThread
+              let qSubThread = case st of
                    NoSub -> QNoSub
                    SubPending -> QSubPending
                    SubThread _ -> QSubThread
-                ProhibitSub -> pure QProhibitSub
+                    ProhibitSub -> QProhibitSub
              qDelivered <- decodeLatin1 . encode <$$> tryReadTMVar delivered
              pure QSub {qSubThread, qDelivered}

        ok :: Transmission BrokerMsg
-        ok = (corrId, entId, OK)
+        ok = (corrId, queueId, OK)

        err :: ErrorType -> Transmission BrokerMsg
-        err e = (corrId, entId, ERR e)
+        err e = (corrId, queueId, ERR e)

        okResp :: Either ErrorType () -> Transmission BrokerMsg
        okResp = either err $ const ok
@@ -1441,13 +1290,9 @@ updateDeletedStats :: QueueRec -> M ()
 updateDeletedStats q = do
  stats <- asks serverStats
  let delSel = if isNothing (senderKey q) then qDeletedNew else qDeletedSecured
-  incStat $ delSel stats
-  incStat $ qDeletedAll stats
-  incStat $ qCount stats
-
-incStat :: MonadIO m => TVar Int -> m ()
-incStat v = atomically $ modifyTVar' v (+ 1)
-{-# INLINE incStat #-}
+  atomically $ modifyTVar' (delSel stats) (+ 1)
+  atomically $ modifyTVar' (qDeletedAll stats) (+ 1)
+  atomically $ modifyTVar' (qCount stats) (subtract 1)

 withLog :: (StoreLog 'WriteMode -> IO a) -> M ()
 withLog action = do
@@ -1476,16 +1321,13 @@ saveServerMessages keepMsgs = asks (storeMsgsFile . config) >>= mapM_ saveMessag
      logInfo $ "saving messages to file " <> T.pack f
      ms <- asks msgStore
      liftIO . withFile f WriteMode $ \h ->
-        readTVarIO ms >>= mapM_ (saveQueueMsgs h) . M.assocs
+        readTVarIO ms >>= mapM_ (saveQueueMsgs ms h) . M.keys
      logInfo "messages saved"
      where
-        saveQueueMsgs h (rId, q) = BLD.hPutBuilder h . encodeMessages rId =<< atomically (getMessages $ msgQueue q)
-        getMessages = if keepMsgs then snapshotTQueue else flushTQueue
-        snapshotTQueue q = do
-          msgs <- flushTQueue q
-          mapM_ (writeTQueue q) msgs
-          pure msgs
-        encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
+        getMessages = if keepMsgs then snapshotMsgQueue else flushMsgQueue
+        saveQueueMsgs ms h rId =
+          atomically (getMessages ms rId)
+            >>= mapM_ (B.hPutStrLn h . strEncode . MLRv3 rId)

 restoreServerMessages :: M Int
 restoreServerMessages =
@@ -1528,7 +1370,7 @@ restoreServerMessages =
 saveServerStats :: M ()
 saveServerStats =
  asks (serverStatsBackupFile . config)
-    >>= mapM_ (\f -> asks serverStats >>= liftIO . getServerStatsData >>= liftIO . saveStats f)
+    >>= mapM_ (\f -> asks serverStats >>= atomically . getServerStatsData >>= liftIO . saveStats f)
  where
    saveStats f stats = do
      logInfo $ "saving server stats to file " <> T.pack f
@@ -24,6 +24,7 @@ import qualified Data.X509.File as XF
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (HostName, ServiceName)
 import Options.Applicative
+import Simplex.Messaging.Client (SocksMode (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI)
 import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
@@ -301,3 +302,9 @@ clearDirIfExists path = whenM (doesDirectoryExist path) $ listDirectory path >>=

 getEnvPath :: String -> FilePath -> IO FilePath
 getEnvPath name def = maybe def (\case "" -> def; f -> f) <$> lookupEnv name
+
+textToSocksMode :: Text -> SocksMode
+textToSocksMode = \case
+  "always" -> SMAlways
+  "onion" -> SMOnion
+  s -> error . T.unpack $ "Invalid socks_mode: " <> s
@@ -1,15 +1,13 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}

 module Simplex.Messaging.Server.Env.STM where

 import Control.Concurrent (ThreadId)
-import Control.Logger.Simple
-import Control.Monad
+import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
@@ -19,7 +17,6 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (isJust, isNothing)
-import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
 import Data.X509.Validation (Fingerprint (..))
@@ -107,7 +104,7 @@ defaultMessageExpiration =
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
  ExpirationConfig
-    { ttl = 21600, -- seconds, 6 hours
+    { ttl = 43200, -- seconds, 12 hours
      checkInterval = 3600 -- seconds, 1 hours
    }

@@ -127,16 +124,14 @@ data Env = Env
    serverStats :: ServerStats,
    sockets :: SocketState,
    clientSeq :: TVar ClientId,
-    clients :: TVar (IntMap (Maybe Client)),
+    clients :: TVar (IntMap Client),
    proxyAgent :: ProxyAgent -- senders served on this proxy
  }

-type Subscribed = Bool
-
 data Server = Server
-  { subscribedQ :: TQueue (RecipientId, Client, Subscribed),
+  { subscribedQ :: TQueue (RecipientId, Client),
    subscribers :: TMap RecipientId Client,
-    ntfSubscribedQ :: TQueue (NotifierId, Client, Subscribed),
+    ntfSubscribedQ :: TQueue (NotifierId, Client),
    notifiers :: TMap NotifierId Client,
    savingLock :: Lock
  }
@@ -165,76 +160,68 @@ data Client = Client
    sndActiveAt :: TVar SystemTime
  }

-data ServerSub = ServerSub (TVar SubscriptionThread) | ProhibitSub
-
-data SubscriptionThread = NoSub | SubPending | SubThread (Weak ThreadId)
+data SubscriptionThread = NoSub | SubPending | SubThread (Weak ThreadId) | ProhibitSub

 data Sub = Sub
-  { subThread :: ServerSub, -- Nothing value indicates that sub
+  { subThread :: TVar SubscriptionThread,
    delivered :: TMVar MsgId
  }

-newServer :: IO Server
+newServer :: STM Server
 newServer = do
-  subscribedQ <- newTQueueIO
-  subscribers <- TM.emptyIO
-  ntfSubscribedQ <- newTQueueIO
-  notifiers <- TM.emptyIO
-  savingLock <- atomically createLock
+  subscribedQ <- newTQueue
+  subscribers <- TM.empty
+  ntfSubscribedQ <- newTQueue
+  notifiers <- TM.empty
+  savingLock <- createLock
  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, savingLock}

-newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
-newClient clientId qSize thVersion sessionId createdAt = do
-  subscriptions <- TM.emptyIO
-  ntfSubscriptions <- TM.emptyIO
-  rcvQ <- newTBQueueIO qSize
-  sndQ <- newTBQueueIO qSize
-  msgQ <- newTBQueueIO qSize
-  procThreads <- newTVarIO 0
-  endThreads <- newTVarIO IM.empty
-  endThreadSeq <- newTVarIO 0
-  connected <- newTVarIO True
-  rcvActiveAt <- newTVarIO createdAt
-  sndActiveAt <- newTVarIO createdAt
+newClient :: TVar ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> STM Client
+newClient nextClientId qSize thVersion sessionId createdAt = do
+  clientId <- stateTVar nextClientId $ \next -> (next, next + 1)
+  subscriptions <- TM.empty
+  ntfSubscriptions <- TM.empty
+  rcvQ <- newTBQueue qSize
+  sndQ <- newTBQueue qSize
+  msgQ <- newTBQueue qSize
+  procThreads <- newTVar 0
+  endThreads <- newTVar IM.empty
+  endThreadSeq <- newTVar 0
+  connected <- newTVar True
+  rcvActiveAt <- newTVar createdAt
+  sndActiveAt <- newTVar createdAt
  return Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, msgQ, procThreads, endThreads, endThreadSeq, thVersion, sessionId, connected, createdAt, rcvActiveAt, sndActiveAt}

 newSubscription :: SubscriptionThread -> STM Sub
 newSubscription st = do
  delivered <- newEmptyTMVar
-  subThread <- ServerSub <$> newTVar st
+  subThread <- newTVar st
  return Sub {subThread, delivered}

-newProhibitedSub :: STM Sub
-newProhibitedSub = do
-  delivered <- newEmptyTMVar
-  return Sub {subThread = ProhibitSub, delivered}
-
 newEnv :: ServerConfig -> IO Env
 newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, smpAgentCfg, transportConfig, information, messageExpiration} = do
-  server <- newServer
-  queueStore <- newQueueStore
-  msgStore <- newMsgStore
-  random <- C.newRandom
-  storeLog <-
-    forM storeLogFile $ \f -> do
-      logInfo $ "restoring queues from file " <> T.pack f
-      restoreQueues queueStore f
+  server <- atomically newServer
+  queueStore <- atomically newQueueStore
+  msgStore <- atomically newMsgStore
+  random <- liftIO C.newRandom
+  storeLog <- restoreQueues queueStore `mapM` storeLogFile
  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
  Fingerprint fp <- loadFingerprint caCertificateFile
  let serverIdentity = KeyHash fp
-  serverStats <- newServerStats =<< getCurrentTime
-  sockets <- newSocketState
+  serverStats <- atomically . newServerStats =<< getCurrentTime
+  sockets <- atomically newSocketState
  clientSeq <- newTVarIO 0
  clients <- newTVarIO mempty
-  proxyAgent <- newSMPProxyAgent smpAgentCfg random
+  proxyAgent <- atomically $ newSMPProxyAgent smpAgentCfg random
  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
  where
    restoreQueues :: QueueStore -> FilePath -> IO (StoreLog 'WriteMode)
    restoreQueues QueueStore {queues, senders, notifiers} f = do
      (qs, s) <- readWriteStoreLog f
-      atomically . writeTVar queues =<< mapM newTVarIO qs
-      atomically $ writeTVar senders $! M.foldr' addSender M.empty qs
-      atomically $ writeTVar notifiers $! M.foldr' addNotifier M.empty qs
+      atomically $ do
+        writeTVar queues =<< mapM newTVar qs
+        writeTVar senders $! M.foldr' addSender M.empty qs
+        writeTVar notifiers $! M.foldr' addNotifier M.empty qs
      pure s
    addSender :: QueueRec -> Map SenderId RecipientId -> Map SenderId RecipientId
    addSender q = M.insert (senderId q) (recipientId q)
@@ -260,7 +247,7 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
          | isJust (storeMsgsFile config) = SPMMessages
          | otherwise = SPMQueues

-newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO ProxyAgent
+newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> STM ProxyAgent
 newSMPProxyAgent smpAgentCfg random = do
  smpAgent <- newSMPClientAgent smpAgentCfg random
  pure ProxyAgent {smpAgent}
@@ -305,7 +305,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                          networkConfig =
                            defaultNetworkConfig
                              { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini,
-                                socksMode = maybe SMOnion (either error id) $! strDecodeIni "PROXY" "socks_mode" ini,
+                                socksMode = either (const SMOnion) textToSocksMode $ lookupValue "PROXY" "socks_mode" ini,
                                hostMode = either (const HMPublic) textToHostMode $ lookupValue "PROXY" "host_mode" ini,
                                requiredHostMode = fromMaybe False $ iniOnOff "PROXY" "required_host_mode" ini
                              }
@@ -14,6 +14,8 @@ module Simplex.Messaging.Server.MsgStore.STM
    getMsgQueue,
    delMsgQueue,
    delMsgQueueSize,
+    flushMsgQueue,
+    snapshotMsgQueue,
    writeMsg,
    tryPeekMsg,
    peekMsg,
@@ -23,6 +25,7 @@ module Simplex.Messaging.Server.MsgStore.STM
  )
 where

+import Control.Concurrent.STM.TQueue (flushTQueue)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -41,8 +44,8 @@ data MsgQueue = MsgQueue

 type STMMsgStore = TMap RecipientId MsgQueue

-newMsgStore :: IO STMMsgStore
-newMsgStore = TM.emptyIO
+newMsgStore :: STM STMMsgStore
+newMsgStore = TM.empty

 getMsgQueue :: STMMsgStore -> RecipientId -> Int -> STM MsgQueue
 getMsgQueue st rId quota = maybe newQ pure =<< TM.lookup rId st
@@ -61,6 +64,17 @@ delMsgQueue st rId = TM.delete rId st
 delMsgQueueSize :: STMMsgStore -> RecipientId -> STM Int
 delMsgQueueSize st rId = TM.lookupDelete rId st >>= maybe (pure 0) (\MsgQueue {size} -> readTVar size)

+flushMsgQueue :: STMMsgStore -> RecipientId -> STM [Message]
+flushMsgQueue st rId = TM.lookupDelete rId st >>= maybe (pure []) (flushTQueue . msgQueue)
+
+snapshotMsgQueue :: STMMsgStore -> RecipientId -> STM [Message]
+snapshotMsgQueue st rId = TM.lookup rId st >>= maybe (pure []) (snapshotTQueue . msgQueue)
+  where
+    snapshotTQueue q = do
+      msgs <- flushTQueue q
+      mapM_ (writeTQueue q) msgs
+      pure msgs
+
 writeMsg :: MsgQueue -> Message -> STM (Maybe (Message, Bool))
 writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = do
  canWrt <- readTVar canWrite
@@ -38,11 +38,11 @@ data QueueStore = QueueStore
    notifiers :: TMap NotifierId RecipientId
  }

-newQueueStore :: IO QueueStore
+newQueueStore :: STM QueueStore
 newQueueStore = do
-  queues <- TM.emptyIO
-  senders <- TM.emptyIO
-  notifiers <- TM.emptyIO
+  queues <- TM.empty
+  senders <- TM.empty
+  notifiers <- TM.empty
  pure QueueStore {queues, senders, notifiers}

 addQueue :: QueueStore -> QueueRec -> STM (Either ErrorType ())
@@ -27,29 +27,16 @@ data ServerStats = ServerStats
    qDeletedNew :: TVar Int,
    qDeletedSecured :: TVar Int,
    qSub :: TVar Int,
-    qSubNoMsg :: TVar Int,
    qSubAuth :: TVar Int,
    qSubDuplicate :: TVar Int,
    qSubProhibited :: TVar Int,
-    ntfCreated :: TVar Int,
-    ntfDeleted :: TVar Int,
-    ntfSub :: TVar Int,
-    ntfSubAuth :: TVar Int,
-    ntfSubDuplicate :: TVar Int,
    msgSent :: TVar Int,
    msgSentAuth :: TVar Int,
    msgSentQuota :: TVar Int,
    msgSentLarge :: TVar Int,
    msgRecv :: TVar Int,
-    msgRecvGet :: TVar Int,
-    msgGet :: TVar Int,
-    msgGetNoMsg :: TVar Int,
-    msgGetAuth :: TVar Int,
-    msgGetDuplicate :: TVar Int,
-    msgGetProhibited :: TVar Int,
    msgExpired :: TVar Int,
    activeQueues :: PeriodStats RecipientId,
-    subscribedQueues :: PeriodStats RecipientId,
    msgSentNtf :: TVar Int, -- sent messages with NTF flag
    msgRecvNtf :: TVar Int, -- received messages with NTF flag
    activeQueuesNtf :: PeriodStats RecipientId,
@@ -73,29 +60,16 @@ data ServerStatsData = ServerStatsData
    _qDeletedNew :: Int,
    _qDeletedSecured :: Int,
    _qSub :: Int,
-    _qSubNoMsg :: Int,
    _qSubAuth :: Int,
    _qSubDuplicate :: Int,
    _qSubProhibited :: Int,
-    _ntfCreated :: Int,
-    _ntfDeleted :: Int,
-    _ntfSub :: Int,
-    _ntfSubAuth :: Int,
-    _ntfSubDuplicate :: Int,
    _msgSent :: Int,
    _msgSentAuth :: Int,
    _msgSentQuota :: Int,
    _msgSentLarge :: Int,
    _msgRecv :: Int,
-    _msgRecvGet :: Int,
-    _msgGet :: Int,
-    _msgGetNoMsg :: Int,
-    _msgGetAuth :: Int,
-    _msgGetDuplicate :: Int,
-    _msgGetProhibited :: Int,
    _msgExpired :: Int,
    _activeQueues :: PeriodStatsData RecipientId,
-    _subscribedQueues :: PeriodStatsData RecipientId,
    _msgSentNtf :: Int,
    _msgRecvNtf :: Int,
    _activeQueuesNtf :: PeriodStatsData RecipientId,
@@ -112,51 +86,38 @@ data ServerStatsData = ServerStatsData
  }
  deriving (Show)

-newServerStats :: UTCTime -> IO ServerStats
+newServerStats :: UTCTime -> STM ServerStats
 newServerStats ts = do
-  fromTime <- newTVarIO ts
-  qCreated <- newTVarIO 0
-  qSecured <- newTVarIO 0
-  qDeletedAll <- newTVarIO 0
-  qDeletedNew <- newTVarIO 0
-  qDeletedSecured <- newTVarIO 0
-  qSub <- newTVarIO 0
-  qSubNoMsg <- newTVarIO 0
-  qSubAuth <- newTVarIO 0
-  qSubDuplicate <- newTVarIO 0
-  qSubProhibited <- newTVarIO 0
-  ntfCreated <- newTVarIO 0
-  ntfDeleted <- newTVarIO 0
-  ntfSub <- newTVarIO 0
-  ntfSubAuth <- newTVarIO 0
-  ntfSubDuplicate <- newTVarIO 0
-  msgSent <- newTVarIO 0
-  msgSentAuth <- newTVarIO 0
-  msgSentQuota <- newTVarIO 0
-  msgSentLarge <- newTVarIO 0
-  msgRecv <- newTVarIO 0
-  msgRecvGet <- newTVarIO 0
-  msgGet <- newTVarIO 0
-  msgGetNoMsg <- newTVarIO 0
-  msgGetAuth <- newTVarIO 0
-  msgGetDuplicate <- newTVarIO 0
-  msgGetProhibited <- newTVarIO 0
-  msgExpired <- newTVarIO 0
+  fromTime <- newTVar ts
+  qCreated <- newTVar 0
+  qSecured <- newTVar 0
+  qDeletedAll <- newTVar 0
+  qDeletedNew <- newTVar 0
+  qDeletedSecured <- newTVar 0
+  qSub <- newTVar 0
+  qSubAuth <- newTVar 0
+  qSubDuplicate <- newTVar 0
+  qSubProhibited <- newTVar 0
+  msgSent <- newTVar 0
+  msgSentAuth <- newTVar 0
+  msgSentQuota <- newTVar 0
+  msgSentLarge <- newTVar 0
+  msgRecv <- newTVar 0
+  msgExpired <- newTVar 0
  activeQueues <- newPeriodStats
-  subscribedQueues <- newPeriodStats
-  msgSentNtf <- newTVarIO 0
-  msgRecvNtf <- newTVarIO 0
+  msgSentNtf <- newTVar 0
+  msgRecvNtf <- newTVar 0
  activeQueuesNtf <- newPeriodStats
-  msgNtfs <- newTVarIO 0
-  msgNtfNoSub <- newTVarIO 0
-  msgNtfLost <- newTVarIO 0
+  msgNtfs <- newTVar 0
+  msgNtfNoSub <- newTVar 0
+  msgNtfLost <- newTVar 0
  pRelays <- newProxyStats
  pRelaysOwn <- newProxyStats
  pMsgFwds <- newProxyStats
  pMsgFwdsOwn <- newProxyStats
-  pMsgFwdsRecv <- newTVarIO 0
-  qCount <- newTVarIO 0
-  msgCount <- newTVarIO 0
+  pMsgFwdsRecv <- newTVar 0
+  qCount <- newTVar 0
+  msgCount <- newTVar 0
  pure
    ServerStats
      { fromTime,
@@ -166,29 +127,16 @@ newServerStats ts = do
        qDeletedNew,
        qDeletedSecured,
        qSub,
-        qSubNoMsg,
        qSubAuth,
        qSubDuplicate,
        qSubProhibited,
-        ntfCreated,
-        ntfDeleted,
-        ntfSub,
-        ntfSubAuth,
-        ntfSubDuplicate,
        msgSent,
        msgSentAuth,
        msgSentQuota,
        msgSentLarge,
        msgRecv,
-        msgRecvGet,
-        msgGet,
-        msgGetNoMsg,
-        msgGetAuth,
-        msgGetDuplicate,
-        msgGetProhibited,
        msgExpired,
        activeQueues,
-        subscribedQueues,
        msgSentNtf,
        msgRecvNtf,
        activeQueuesNtf,
@@ -204,51 +152,38 @@ newServerStats ts = do
        msgCount
      }

-getServerStatsData :: ServerStats -> IO ServerStatsData
+getServerStatsData :: ServerStats -> STM ServerStatsData
 getServerStatsData s = do
-  _fromTime <- readTVarIO $ fromTime s
-  _qCreated <- readTVarIO $ qCreated s
-  _qSecured <- readTVarIO $ qSecured s
-  _qDeletedAll <- readTVarIO $ qDeletedAll s
-  _qDeletedNew <- readTVarIO $ qDeletedNew s
-  _qDeletedSecured <- readTVarIO $ qDeletedSecured s
-  _qSub <- readTVarIO $ qSub s
-  _qSubNoMsg <- readTVarIO $ qSubNoMsg s
-  _qSubAuth <- readTVarIO $ qSubAuth s
-  _qSubDuplicate <- readTVarIO $ qSubDuplicate s
-  _qSubProhibited <- readTVarIO $ qSubProhibited s
-  _ntfCreated <- readTVarIO $ ntfCreated s
-  _ntfDeleted <- readTVarIO $ ntfDeleted s
-  _ntfSub <- readTVarIO $ ntfSub s
-  _ntfSubAuth <- readTVarIO $ ntfSubAuth s
-  _ntfSubDuplicate <- readTVarIO $ ntfSubDuplicate s
-  _msgSent <- readTVarIO $ msgSent s
-  _msgSentAuth <- readTVarIO $ msgSentAuth s
-  _msgSentQuota <- readTVarIO $ msgSentQuota s
-  _msgSentLarge <- readTVarIO $ msgSentLarge s
-  _msgRecv <- readTVarIO $ msgRecv s
-  _msgRecvGet <- readTVarIO $ msgRecvGet s
-  _msgGet <- readTVarIO $ msgGet s
-  _msgGetNoMsg <- readTVarIO $ msgGetNoMsg s
-  _msgGetAuth <- readTVarIO $ msgGetAuth s
-  _msgGetDuplicate <- readTVarIO $ msgGetDuplicate s
-  _msgGetProhibited <- readTVarIO $ msgGetProhibited s
-  _msgExpired <- readTVarIO $ msgExpired s
+  _fromTime <- readTVar $ fromTime s
+  _qCreated <- readTVar $ qCreated s
+  _qSecured <- readTVar $ qSecured s
+  _qDeletedAll <- readTVar $ qDeletedAll s
+  _qDeletedNew <- readTVar $ qDeletedNew s
+  _qDeletedSecured <- readTVar $ qDeletedSecured s
+  _qSub <- readTVar $ qSub s
+  _qSubAuth <- readTVar $ qSubAuth s
+  _qSubDuplicate <- readTVar $ qSubDuplicate s
+  _qSubProhibited <- readTVar $ qSubProhibited s
+  _msgSent <- readTVar $ msgSent s
+  _msgSentAuth <- readTVar $ msgSentAuth s
+  _msgSentQuota <- readTVar $ msgSentQuota s
+  _msgSentLarge <- readTVar $ msgSentLarge s
+  _msgRecv <- readTVar $ msgRecv s
+  _msgExpired <- readTVar $ msgExpired s
  _activeQueues <- getPeriodStatsData $ activeQueues s
-  _subscribedQueues <- getPeriodStatsData $ subscribedQueues s
-  _msgSentNtf <- readTVarIO $ msgSentNtf s
-  _msgRecvNtf <- readTVarIO $ msgRecvNtf s
+  _msgSentNtf <- readTVar $ msgSentNtf s
+  _msgRecvNtf <- readTVar $ msgRecvNtf s
  _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
-  _msgNtfs <- readTVarIO $ msgNtfs s
-  _msgNtfNoSub <- readTVarIO $ msgNtfNoSub s
-  _msgNtfLost <- readTVarIO $ msgNtfLost s
+  _msgNtfs <- readTVar $ msgNtfs s
+  _msgNtfNoSub <- readTVar $ msgNtfNoSub s
+  _msgNtfLost <- readTVar $ msgNtfLost s
  _pRelays <- getProxyStatsData $ pRelays s
  _pRelaysOwn <- getProxyStatsData $ pRelaysOwn s
  _pMsgFwds <- getProxyStatsData $ pMsgFwds s
  _pMsgFwdsOwn <- getProxyStatsData $ pMsgFwdsOwn s
-  _pMsgFwdsRecv <- readTVarIO $ pMsgFwdsRecv s
-  _qCount <- readTVarIO $ qCount s
-  _msgCount <- readTVarIO $ msgCount s
+  _pMsgFwdsRecv <- readTVar $ pMsgFwdsRecv s
+  _qCount <- readTVar $ qCount s
+  _msgCount <- readTVar $ msgCount s
  pure
    ServerStatsData
      { _fromTime,
@@ -258,29 +193,16 @@ getServerStatsData s = do
        _qDeletedNew,
        _qDeletedSecured,
        _qSub,
-        _qSubNoMsg,
        _qSubAuth,
        _qSubDuplicate,
        _qSubProhibited,
-        _ntfCreated,
-        _ntfDeleted,
-        _ntfSub,
-        _ntfSubAuth,
-        _ntfSubDuplicate,
        _msgSent,
        _msgSentAuth,
        _msgSentQuota,
        _msgSentLarge,
        _msgRecv,
-        _msgRecvGet,
-        _msgGet,
-        _msgGetNoMsg,
-        _msgGetAuth,
-        _msgGetDuplicate,
-        _msgGetProhibited,
        _msgExpired,
        _activeQueues,
-        _subscribedQueues,
        _msgSentNtf,
        _msgRecvNtf,
        _activeQueuesNtf,
@@ -305,29 +227,16 @@ setServerStats s d = do
  writeTVar (qDeletedNew s) $! _qDeletedNew d
  writeTVar (qDeletedSecured s) $! _qDeletedSecured d
  writeTVar (qSub s) $! _qSub d
-  writeTVar (qSubNoMsg s) $! _qSubNoMsg d
  writeTVar (qSubAuth s) $! _qSubAuth d
  writeTVar (qSubDuplicate s) $! _qSubDuplicate d
  writeTVar (qSubProhibited s) $! _qSubProhibited d
-  writeTVar (ntfCreated s) $! _ntfCreated d
-  writeTVar (ntfDeleted s) $! _ntfDeleted d
-  writeTVar (ntfSub s) $! _ntfSub d
-  writeTVar (ntfSubAuth s) $! _ntfSubAuth d
-  writeTVar (ntfSubDuplicate s) $! _ntfSubDuplicate d
  writeTVar (msgSent s) $! _msgSent d
  writeTVar (msgSentAuth s) $! _msgSentAuth d
  writeTVar (msgSentQuota s) $! _msgSentQuota d
  writeTVar (msgSentLarge s) $! _msgSentLarge d
  writeTVar (msgRecv s) $! _msgRecv d
-  writeTVar (msgRecvGet s) $! _msgRecvGet d
-  writeTVar (msgGet s) $! _msgGet d
-  writeTVar (msgGetNoMsg s) $! _msgGetNoMsg d
-  writeTVar (msgGetAuth s) $! _msgGetAuth d
-  writeTVar (msgGetDuplicate s) $! _msgGetDuplicate d
-  writeTVar (msgGetProhibited s) $! _msgGetProhibited d
  writeTVar (msgExpired s) $! _msgExpired d
  setPeriodStats (activeQueues s) (_activeQueues d)
-  setPeriodStats (subscribedQueues s) (_subscribedQueues d)
  writeTVar (msgSentNtf s) $! _msgSentNtf d
  writeTVar (msgRecvNtf s) $! _msgRecvNtf d
  setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d)
@@ -353,26 +262,14 @@ instance StrEncoding ServerStatsData where
        "qDeletedSecured=" <> strEncode (_qDeletedSecured d),
        "qCount=" <> strEncode (_qCount d),
        "qSub=" <> strEncode (_qSub d),
-        "qSubNoMsg=" <> strEncode (_qSubNoMsg d),
        "qSubAuth=" <> strEncode (_qSubAuth d),
        "qSubDuplicate=" <> strEncode (_qSubDuplicate d),
        "qSubProhibited=" <> strEncode (_qSubProhibited d),
-        "ntfCreated=" <> strEncode (_ntfCreated d),
-        "ntfDeleted=" <> strEncode (_ntfDeleted d),
-        "ntfSub=" <> strEncode (_ntfSub d),
-        "ntfSubAuth=" <> strEncode (_ntfSubAuth d),
-        "ntfSubDuplicate=" <> strEncode (_ntfSubDuplicate d),
        "msgSent=" <> strEncode (_msgSent d),
        "msgSentAuth=" <> strEncode (_msgSentAuth d),
        "msgSentQuota=" <> strEncode (_msgSentQuota d),
        "msgSentLarge=" <> strEncode (_msgSentLarge d),
        "msgRecv=" <> strEncode (_msgRecv d),
-        "msgRecvGet=" <> strEncode (_msgRecvGet d),
-        "msgGet=" <> strEncode (_msgGet d),
-        "msgGetNoMsg=" <> strEncode (_msgGetNoMsg d),
-        "msgGetAuth=" <> strEncode (_msgGetAuth d),
-        "msgGetDuplicate=" <> strEncode (_msgGetDuplicate d),
-        "msgGetProhibited=" <> strEncode (_msgGetProhibited d),
        "msgExpired=" <> strEncode (_msgExpired d),
        "msgSentNtf=" <> strEncode (_msgSentNtf d),
        "msgRecvNtf=" <> strEncode (_msgRecvNtf d),
@@ -381,8 +278,6 @@ instance StrEncoding ServerStatsData where
        "msgNtfLost=" <> strEncode (_msgNtfLost d),
        "activeQueues:",
        strEncode (_activeQueues d),
-        "subscribedQueues:",
-        strEncode (_subscribedQueues d),
        "activeQueuesNtf:",
        strEncode (_activeQueuesNtf d),
        "pRelays:",
@@ -404,26 +299,14 @@ instance StrEncoding ServerStatsData where
        <|> ((,,) <$> ("qDeletedAll=" *> strP <* A.endOfLine) <*> ("qDeletedNew=" *> strP <* A.endOfLine) <*> ("qDeletedSecured=" *> strP <* A.endOfLine))
    _qCount <- opt "qCount="
    _qSub <- opt "qSub="
-    _qSubNoMsg <- opt "qSubNoMsg="
    _qSubAuth <- opt "qSubAuth="
    _qSubDuplicate <- opt "qSubDuplicate="
    _qSubProhibited <- opt "qSubProhibited="
-    _ntfCreated <- opt "ntfCreated="
-    _ntfDeleted <- opt "ntfDeleted="
-    _ntfSub <- opt "ntfSub="
-    _ntfSubAuth <- opt "ntfSubAuth="
-    _ntfSubDuplicate <- opt "ntfSubDuplicate="
    _msgSent <- "msgSent=" *> strP <* A.endOfLine
    _msgSentAuth <- opt "msgSentAuth="
    _msgSentQuota <- opt "msgSentQuota="
    _msgSentLarge <- opt "msgSentLarge="
    _msgRecv <- "msgRecv=" *> strP <* A.endOfLine
-    _msgRecvGet <- opt "msgRecvGet="
-    _msgGet <- opt "msgGet="
-    _msgGetNoMsg <- opt "msgGetNoMsg="
-    _msgGetAuth <- opt "msgGetAuth="
-    _msgGetDuplicate <- opt "msgGetDuplicate="
-    _msgGetProhibited <- opt "msgGetProhibited="
    _msgExpired <- opt "msgExpired="
    _msgSentNtf <- opt "msgSentNtf="
    _msgRecvNtf <- opt "msgRecvNtf="
@@ -438,10 +321,6 @@ instance StrEncoding ServerStatsData where
          _week <- "weekMsgQueues=" *> strP <* A.endOfLine
          _month <- "monthMsgQueues=" *> strP <* optional A.endOfLine
          pure PeriodStatsData {_day, _week, _month}
-    _subscribedQueues <-
-      optional ("subscribedQueues:" <* A.endOfLine) >>= \case
-        Just _ -> strP <* optional A.endOfLine
-        _ -> pure newPeriodStatsData
    _activeQueuesNtf <-
      optional ("activeQueuesNtf:" <* A.endOfLine) >>= \case
        Just _ -> strP <* optional A.endOfLine
@@ -460,26 +339,14 @@ instance StrEncoding ServerStatsData where
          _qDeletedNew,
          _qDeletedSecured,
          _qSub,
-          _qSubNoMsg,
          _qSubAuth,
          _qSubDuplicate,
          _qSubProhibited,
-          _ntfCreated,
-          _ntfDeleted,
-          _ntfSub,
-          _ntfSubAuth,
-          _ntfSubDuplicate,
          _msgSent,
          _msgSentAuth,
          _msgSentQuota,
          _msgSentLarge,
          _msgRecv,
-          _msgRecvGet,
-          _msgGet,
-          _msgGetNoMsg,
-          _msgGetAuth,
-          _msgGetDuplicate,
-          _msgGetProhibited,
          _msgExpired,
          _msgSentNtf,
          _msgRecvNtf,
@@ -487,7 +354,6 @@ instance StrEncoding ServerStatsData where
          _msgNtfNoSub,
          _msgNtfLost,
          _activeQueues,
-          _subscribedQueues,
          _activeQueuesNtf,
          _pRelays,
          _pRelaysOwn,
@@ -510,11 +376,11 @@ data PeriodStats a = PeriodStats
    month :: TVar (Set a)
  }

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

 data PeriodStatsData a = PeriodStatsData
@@ -527,11 +393,11 @@ data PeriodStatsData a = PeriodStatsData
 newPeriodStatsData :: PeriodStatsData a
 newPeriodStatsData = PeriodStatsData {_day = S.empty, _week = S.empty, _month = S.empty}

-getPeriodStatsData :: PeriodStats a -> IO (PeriodStatsData a)
+getPeriodStatsData :: PeriodStats a -> STM (PeriodStatsData a)
 getPeriodStatsData s = do
-  _day <- readTVarIO $ day s
-  _week <- readTVarIO $ week s
-  _month <- readTVarIO $ month s
+  _day <- readTVar $ day s
+  _week <- readTVar $ week s
+  _month <- readTVar $ month s
  pure PeriodStatsData {_day, _week, _month}

 setPeriodStats :: PeriodStats a -> PeriodStatsData a -> STM ()
@@ -585,13 +451,13 @@ data ProxyStats = ProxyStats
    pErrorsOther :: TVar Int
  }

-newProxyStats :: IO ProxyStats
+newProxyStats :: STM ProxyStats
 newProxyStats = do
-  pRequests <- newTVarIO 0
-  pSuccesses <- newTVarIO 0
-  pErrorsConnect <- newTVarIO 0
-  pErrorsCompat <- newTVarIO 0
-  pErrorsOther <- newTVarIO 0
+  pRequests <- newTVar 0
+  pSuccesses <- newTVar 0
+  pErrorsConnect <- newTVar 0
+  pErrorsCompat <- newTVar 0
+  pErrorsOther <- newTVar 0
  pure ProxyStats {pRequests, pSuccesses, pErrorsConnect, pErrorsCompat, pErrorsOther}

 data ProxyStatsData = ProxyStatsData
@@ -606,13 +472,13 @@ data ProxyStatsData = ProxyStatsData
 newProxyStatsData :: ProxyStatsData
 newProxyStatsData = ProxyStatsData {_pRequests = 0, _pSuccesses = 0, _pErrorsConnect = 0, _pErrorsCompat = 0, _pErrorsOther = 0}

-getProxyStatsData :: ProxyStats -> IO ProxyStatsData
+getProxyStatsData :: ProxyStats -> STM ProxyStatsData
 getProxyStatsData s = do
-  _pRequests <- readTVarIO $ pRequests s
-  _pSuccesses <- readTVarIO $ pSuccesses s
-  _pErrorsConnect <- readTVarIO $ pErrorsConnect s
-  _pErrorsCompat <- readTVarIO $ pErrorsCompat s
-  _pErrorsOther <- readTVarIO $ pErrorsOther s
+  _pRequests <- readTVar $ pRequests s
+  _pSuccesses <- readTVar $ pSuccesses s
+  _pErrorsConnect <- readTVar $ pErrorsConnect s
+  _pErrorsCompat <- readTVar $ pErrorsCompat s
+  _pErrorsOther <- readTVar $ pErrorsOther s
  pure ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther}

 getResetProxyStatsData :: ProxyStats -> STM ProxyStatsData
@@ -36,7 +36,7 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..), ServerQueueStatus (..))
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Util (ifM)
-import System.Directory (doesFileExist, renameFile)
+import System.Directory (doesFileExist)
 import System.IO

 -- | opaque container for file handle with a type-safe IOMode
@@ -140,12 +140,10 @@ logDeleteNotifier s = writeStoreLogRecord s . DeleteNotifier

 readWriteStoreLog :: FilePath -> IO (Map RecipientId QueueRec, StoreLog 'WriteMode)
 readWriteStoreLog f = do
-  qs <- ifM (doesFileExist f) readQS (pure M.empty)
+  qs <- ifM (doesFileExist f) (readQueues f) (pure M.empty)
  s <- openWriteStoreLog f
  writeQueues s qs
  pure (qs, s)
-  where
-    readQS = readQueues f <* renameFile f (f <> ".bak")

 writeQueues :: StoreLog 'WriteMode -> Map RecipientId QueueRec -> IO ()
 writeQueues s = mapM_ $ \q -> when (active q) $ logCreateQueue s q
@@ -5,6 +5,9 @@
 module Simplex.Messaging.Session where

 import Control.Concurrent.STM
+import Control.Monad
+import Data.Composition ((.:.))
+import Data.Functor (($>))
 import Data.Time (UTCTime)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -28,10 +31,14 @@ getSessVar sessSeq sessKey vs sessionVarTs = maybe (Left <$> newSessionVar) (pur
      pure v

 removeSessVar :: Ord k => SessionVar a -> k -> TMap k (SessionVar a) -> STM ()
-removeSessVar v sessKey vs =
+removeSessVar = void .:. removeSessVar'
+{-# INLINE removeSessVar #-}
+
+removeSessVar' :: Ord k => SessionVar a -> k -> TMap k (SessionVar a) -> STM Bool
+removeSessVar' v sessKey vs =
  TM.lookup sessKey vs >>= \case
-    Just v' | sessionVarId v == sessionVarId v' -> TM.delete sessKey vs
-    _ -> pure ()
+    Just v' | sessionVarId v == sessionVarId v' -> TM.delete sessKey vs $> True
+    _ -> pure False

 tryReadSessVar :: Ord k => k -> TMap k (SessionVar a) -> STM (Maybe a)
 tryReadSessVar sessKey vs = TM.lookup sessKey vs $>>= (tryReadTMVar . sessionVar)
@@ -1,13 +1,11 @@
 module Simplex.Messaging.TMap
  ( TMap,
-    emptyIO,
+    empty,
    singleton,
    clear,
    Simplex.Messaging.TMap.null,
    Simplex.Messaging.TMap.lookup,
-    lookupIO,
    member,
-    memberIO,
    insert,
    delete,
    lookupInsert,
@@ -26,9 +24,9 @@ import qualified Data.Map.Strict as M

 type TMap k a = TVar (Map k a)

-emptyIO :: IO (TMap k a)
-emptyIO = newTVarIO M.empty
-{-# INLINE emptyIO #-}
+empty :: STM (TMap k a)
+empty = newTVar M.empty
+{-# INLINE empty #-}

 singleton :: k -> a -> STM (TMap k a)
 singleton k v = newTVar $ M.singleton k v
@@ -46,18 +44,10 @@ lookup :: Ord k => k -> TMap k a -> STM (Maybe a)
 lookup k m = M.lookup k <$> readTVar m
 {-# INLINE lookup #-}

-lookupIO :: Ord k => k -> TMap k a -> IO (Maybe a)
-lookupIO k m = M.lookup k <$> readTVarIO m
-{-# INLINE lookupIO #-}
-
 member :: Ord k => k -> TMap k a -> STM Bool
 member k m = M.member k <$> readTVar m
 {-# INLINE member #-}

-memberIO :: Ord k => k -> TMap k a -> IO Bool
-memberIO k m = M.member k <$> readTVarIO m
-{-# INLINE memberIO #-}
-
 insert :: Ord k => k -> a -> TMap k a -> STM ()
 insert k v m = modifyTVar' m $ M.insert k v
 {-# INLINE insert #-}
@@ -113,7 +113,6 @@ import Simplex.Messaging.Transport.Buffer
 import Simplex.Messaging.Util (bshow, catchAll, catchAll_, liftEitherWith)
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
-import System.IO.Error (isEOFError)
 import UnliftIO.Exception (Exception)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -286,7 +285,7 @@ getTLS :: TransportPeer -> TransportConfig -> X.CertificateChain -> T.Context ->
 getTLS tlsPeer cfg tlsServerCerts cxt = withTlsUnique tlsPeer cxt newTLS
  where
    newTLS tlsUniq = do
-      tlsBuffer <- newTBuffer
+      tlsBuffer <- atomically newTBuffer
      tlsALPN <- T.getNegotiatedProtocol cxt
      pure TLS {tlsContext = cxt, tlsALPN, tlsTransportConfig = cfg, tlsServerCerts, tlsPeer, tlsUniq, tlsBuffer}

@@ -340,12 +339,11 @@ instance Transport TLS where

  getLn :: TLS -> IO ByteString
  getLn TLS {tlsContext, tlsBuffer} = do
-    getLnBuffered tlsBuffer (T.recvData tlsContext) `E.catches` [E.Handler handleTlsEOF, E.Handler handleEOF]
+    getLnBuffered tlsBuffer (T.recvData tlsContext) `E.catch` handleEOF
    where
-      handleTlsEOF = \case
-        T.PostHandshake T.Error_EOF -> E.throwIO TEBadBlock
+      handleEOF = \case
+        T.Error_EOF -> E.throwIO TEBadBlock
        e -> E.throwIO e
-      handleEOF e = if isEOFError e then E.throwIO TEBadBlock else E.throwIO e

 -- * SMP transport

@@ -17,10 +17,10 @@ data TBuffer = TBuffer
    getLock :: TMVar ()
  }

-newTBuffer :: IO TBuffer
+newTBuffer :: STM TBuffer
 newTBuffer = do
-  buffer <- newTVarIO ""
-  getLock <- newTMVarIO ()
+  buffer <- newTVar ""
+  getLock <- newTMVar ()
  pure TBuffer {buffer, getLock}

 withBufferLock :: TBuffer -> IO a -> IO a
@@ -75,7 +75,7 @@ instance HTTP2BodyChunk HS.Request where

 getHTTP2Body :: HTTP2BodyChunk a => a -> Int -> IO HTTP2Body
 getHTTP2Body r n = do
-  bodyBuffer <- newTBuffer
+  bodyBuffer <- atomically newTBuffer
  let getPart n' = getBuffered bodyBuffer n' Nothing $ getBodyChunk r
  bodyHead <- getPart n
  let bodySize = fromMaybe 0 $ getBodySize r
@@ -104,13 +104,13 @@ attachHTTP2Client config host port disconnected bufferSize tls = getVerifiedHTTP

 getVerifiedHTTP2ClientWith :: HTTP2ClientConfig -> TransportHost -> ServiceName -> IO () -> ((TLS -> H.Client HTTP2Response) -> IO HTTP2Response) -> IO (Either HTTP2ClientError HTTP2Client)
 getVerifiedHTTP2ClientWith config host port disconnected setup =
-  (mkHTTPS2Client >>= runClient)
+  (atomically mkHTTPS2Client >>= runClient)
    `E.catch` \(e :: IOException) -> pure . Left $ HCIOError e
  where
-    mkHTTPS2Client :: IO HClient
+    mkHTTPS2Client :: STM HClient
    mkHTTPS2Client = do
-      connected <- newTVarIO False
-      reqQ <- newTBQueueIO $ qSize config
+      connected <- newTVar False
+      reqQ <- newTBQueue $ qSize config
      pure HClient {connected, disconnected, host, port, config, reqQ}

    runClient :: HClient -> IO (Either HTTP2ClientError HTTP2Client)
@@ -76,7 +76,7 @@ serverTransportConfig TransportServerConfig {logTLSErrors} =
 -- All accepted connections are passed to the passed function.
 runTransportServer :: forall c. Transport c => TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> IO ()) -> IO ()
 runTransportServer started port params cfg server = do
-  ss <- newSocketState
+  ss <- atomically newSocketState
  runTransportServerState ss started port params cfg server

 runTransportServerState :: forall c . Transport c => SocketState -> TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> IO ()) -> IO ()
@@ -85,7 +85,7 @@ runTransportServerState ss started port = runTransportServerSocketState ss start
 -- | Run a transport server with provided connection setup and handler.
 runTransportServerSocket :: Transport a => TMVar Bool -> IO Socket -> String -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
 runTransportServerSocket started getSocket threadLabel serverParams cfg server = do
-  ss <- newSocketState
+  ss <- atomically newSocketState
  runTransportServerSocketState ss started getSocket threadLabel serverParams cfg server

 -- | Run a transport server with provided connection setup and handler.
@@ -109,7 +109,7 @@ tlsServerCredentials serverParams = case T.sharedCredentials $ T.serverShared se
 -- | Run TCP server without TLS
 runTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
 runTCPServer started port server = do
-  ss <- newSocketState
+  ss <- atomically newSocketState
  runTCPServerSocket ss started (startTCPServer started port) server

 -- | Wrap socket provider in a TCP server bracket.
@@ -148,8 +148,8 @@ safeAccept sock =

 type SocketState = (TVar Int, TVar Int, TVar (IntMap (Weak ThreadId)))

-newSocketState :: IO SocketState
-newSocketState = (,,) <$> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO mempty
+newSocketState :: STM SocketState
+newSocketState = (,,) <$> newTVar 0 <*> newTVar 0 <*> newTVar mempty

 closeServer :: TMVar Bool -> TVar (IntMap (Weak ThreadId)) -> Socket -> IO ()
 closeServer started clients sock = do
@@ -25,7 +25,6 @@ import Simplex.Messaging.Transport
    withTlsUnique,
  )
 import Simplex.Messaging.Transport.Buffer (trimCR)
-import System.IO.Error (isEOFError)

 data WS = WS
  { wsPeer :: TransportPeer,
@@ -109,11 +108,9 @@ makeTLSContextStream cxt =
  S.makeStream readStream writeStream
  where
    readStream :: IO (Maybe ByteString)
-    readStream = (Just <$> T.recvData cxt) `E.catches` [E.Handler handleTlsEOF, E.Handler handleEOF]
-      where
-        handleTlsEOF = \case
-          T.PostHandshake T.Error_EOF -> pure Nothing
-          e -> E.throwIO e
-        handleEOF e = if isEOFError e then pure Nothing else E.throwIO e
+    readStream =
+      (Just <$> T.recvData cxt) `E.catch` \case
+        T.Error_EOF -> pure Nothing
+        e -> E.throwIO e
    writeStream :: Maybe LB.ByteString -> IO ()
    writeStream = maybe (closeTLS cxt) (T.sendData cxt)
@@ -166,10 +166,10 @@ threadDelay' = loop
          loop $ time - maxWait

 diffToMicroseconds :: NominalDiffTime -> Int64
-diffToMicroseconds diff = truncate $ diff * 1000000
+diffToMicroseconds diff = fromIntegral ((truncate $ diff * 1000000) :: Integer)

 diffToMilliseconds :: NominalDiffTime -> Int64
-diffToMilliseconds diff = truncate $ diff * 1000
+diffToMilliseconds diff = fromIntegral ((truncate $ diff * 1000) :: Integer)

 labelMyThread :: MonadIO m => String -> m ()
 labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)
@@ -305,7 +305,7 @@ connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca,

 catchRCError :: ExceptT RCErrorType IO a -> (RCErrorType -> ExceptT RCErrorType IO a) -> ExceptT RCErrorType IO a
 catchRCError = catchAllErrors $ \e -> case fromException e of
-  Just (TLS.Terminated _ _ (TLS.Error_Protocol _ TLS.UnknownCa)) -> RCEIdentity
+  Just (TLS.Terminated _ _ (TLS.Error_Protocol (_, _, TLS.UnknownCa))) -> RCEIdentity
  _ -> RCEException $ show e
 {-# INLINE catchRCError #-}

@@ -225,23 +225,23 @@ connectionRequestTests =
      queueV1NoPort #== ("smp://[email protected]/3456-w==#/?v=1-1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
      queueV1NoPort #== ("smp://[email protected],jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr)
    it "should serialize and parse connection invitations and contact addresses" $ do
-      connectionRequest #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequest #== ("https://simplex.chat/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequestSK #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStrSK <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequest1 #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequest2queues #==# ("simplex:/invitation#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequestNew #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest #== ("https://simplex.chat/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestSK #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStrSK <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest2queues #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
      connectionRequestV1 #== ("https://simplex.chat/invitation#/?v=1&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}")
-      contactAddress #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr)
-      contactAddress #== ("https://simplex.chat/contact#/?v=2-7&smp=" <> url queueStr)
-      contactAddress2queues #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr))
-      contactAddressNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueNewStr)
-      contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr))
+      connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}")
+      contactAddress #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr)
+      contactAddress #== ("https://simplex.chat/contact#/?v=2-6&smp=" <> url queueStr)
+      contactAddress2queues #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr))
+      contactAddressNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueNewStr)
+      contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr))
      contactAddressV2 #==# ("simplex:/contact#/?v=2&smp=" <> url queueStr)
      contactAddressV2 #== ("https://simplex.chat/contact#/?v=1&smp=" <> url queueStr) -- adjusted to v2
      contactAddressV2 #== ("https://simplex.chat/contact#/?v=1-2&smp=" <> url queueStr) -- adjusted to v2
      contactAddressV2 #== ("https://simplex.chat/contact#/?v=2-2&smp=" <> url queueStr)
-      contactAddressClientData #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}")
+      contactAddressClientData #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}")
@@ -38,7 +38,6 @@ module AgentTests.FunctionalAPITests
    rfGet,
    sfGet,
    nGet,
-    getInAnyOrder,
    (##>),
    (=##>),
    pattern CON,
@@ -245,7 +244,7 @@ inAnyOrder g rs = withFrozenCallStack $ do
 createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c)
 createConnection c userId enableNtfs cMode clientData = A.createConnection c userId enableNtfs cMode clientData (IKNoPQ PQSupportOn)

-joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
+joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE ConnId
 joinConnection c userId enableNtfs cReq connInfo = A.joinConnection c userId Nothing enableNtfs cReq connInfo PQSupportOn

 sendMessage :: AgentClient -> ConnId -> SMP.MsgFlags -> MsgBody -> AE AgentMsgId
@@ -270,22 +269,19 @@ functionalAPITests t = do
    describe "two way concurrently (50)" $ testMatrix2Stress t $ runAgentClientStressTestConc 25
    xdescribe "two way concurrently (1000)" $ testMatrix2Stress t $ runAgentClientStressTestConc 500
  describe "Establishing duplex connection, different PQ settings" $ do
-    testPQMatrix2 t $ runAgentClientTestPQ False True
+    testPQMatrix2 t $ runAgentClientTestPQ True
  describe "Establishing duplex connection v2, different Ratchet versions" $
    testRatchetMatrix2 t runAgentClientTest
  describe "Establish duplex connection via contact address" $
    testMatrix2 t runAgentClientContactTest
  describe "Establish duplex connection via contact address, different PQ settings" $ do
-    testPQMatrix2NoInv t $ runAgentClientContactTestPQ False True PQSupportOn
+    testPQMatrix2NoInv t $ runAgentClientContactTestPQ True PQSupportOn
  describe "Establish duplex connection via contact address v2, different Ratchet versions" $
    testRatchetMatrix2 t runAgentClientContactTest
  describe "Establish duplex connection via contact address, different PQ settings" $ do
    testPQMatrix3 t $ runAgentClientContactTestPQ3 True
  it "should support rejecting contact request" $
    withSmpServer t testRejectContactRequest
-  describe "Changing connection user id" $ do
-    it "should change user id for new connections" $ do
-      withSmpServer t testUpdateConnectionUserId
  describe "Establishing connection asynchronously" $ do
    it "should connect with initiating client going offline" $
      withSmpServer t testAsyncInitiatingOffline
@@ -360,9 +356,6 @@ functionalAPITests t = do
    it "should subscribe to multiple connections with pending messages" $
      withSmpServer t $
        testBatchedPendingMessages 10 5
-  describe "Batch send messages" $ do
-    it "should send multiple messages to the same connection" $ withSmpServer t testSendMessagesB
-    it "should send messages to the 2 connections" $ withSmpServer t testSendMessagesB2
  describe "Async agent commands" $ do
    describe "connect using async agent commands" $
      testBasicMatrix2 t testAsyncCommands
@@ -417,30 +410,29 @@ functionalAPITests t = do
    let v4 = prevVersion basicAuthSMPVersion
    forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do
      let baseId = if v >= sndAuthKeySMPVersion then 1 else 3
-          sqSecured = if v >= sndAuthKeySMPVersion then True else False
      describe ("v" <> show v <> ": with server auth") $ do
        --                                       allow NEW | server auth, v | clnt1 auth, v  | clnt2 auth, v    |  2 - success, 1 - JOIN fail, 0 - NEW fail
-        it "success                " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2
-        it "disabled               " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
-        it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
-        it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
-        it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
-        it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 1
-        it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) sqSecured baseId `shouldReturn` 1
-        it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) sqSecured baseId `shouldReturn` 1
+        it "success                " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 2
+        it "disabled               " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 0
+        it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) baseId `shouldReturn` 0
+        it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) baseId `shouldReturn` 0
+        it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) baseId `shouldReturn` 0
+        it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) baseId `shouldReturn` 1
+        it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) baseId `shouldReturn` 1
+        it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) baseId `shouldReturn` 1
      describe ("v" <> show v <> ": no server auth") $ do
-        it "success     " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 2
-        it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 0
-        it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) False 3 `shouldReturn` 2
-        it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) False baseId `shouldReturn` 2
-        it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) sqSecured 3 `shouldReturn` 2
-        it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2
-        it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2
-        it "auth fst    " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 2
-        it "auth fst 2  " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) False 3 `shouldReturn` 2
-        it "auth snd    " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2
-        it "auth both   " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2
-        it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
+        it "success     " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) baseId `shouldReturn` 2
+        it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) baseId `shouldReturn` 0
+        it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) 3 `shouldReturn` 2
+        it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) baseId `shouldReturn` 2
+        it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) 3 `shouldReturn` 2
+        it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) 3 `shouldReturn` 2
+        it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) 3 `shouldReturn` 2
+        it "auth fst    " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) baseId `shouldReturn` 2
+        it "auth fst 2  " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) 3 `shouldReturn` 2
+        it "auth snd    " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) baseId `shouldReturn` 2
+        it "auth both   " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 2
+        it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 0
  describe "SMP server test via agent API" $ do
    it "should pass without basic auth" $ testSMPServerConnectionTest t Nothing (noAuthSrv testSMPServer2) `shouldReturn` Nothing
    let srv1 = testSMPServer2 {keyHash = "1234"}
@@ -468,8 +460,8 @@ functionalAPITests t = do
    it "server should respond with queue and subscription information" $
      withSmpServer t testServerQueueInfo

-testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int
-testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 sqSecured baseId = do
+testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
+testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 baseId = do
  let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange batchCmdsSMPVersion srvVersion}
      canCreate1 = canCreateQueue allowNewQueues srv clnt1
      canCreate2 = canCreateQueue allowNewQueues srv clnt2
@@ -477,7 +469,7 @@ testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 sqSecured b
        | canCreate1 && canCreate2 = 2
        | canCreate1 = 1
        | otherwise = 0
-  created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId
+  created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth srvVersion clnt1 clnt2 baseId
  created `shouldBe` expected
  pure created

@@ -486,43 +478,43 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
  let v = basicAuthSMPVersion
   in allowNew && (isNothing srvAuth || (srvVersion >= v && clntVersion >= v && srvAuth == clntAuth))

-testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
-  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True True
-  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn False True
-  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False
-  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff False False
-  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False False
-  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False False
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
+  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
+  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff False
+  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False
+  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False

-testMatrix2Stress :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testMatrix2Stress :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2Stress t runTest = do
-  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aCfg aCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True True
-  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aProxyCfgV8 aProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn False True
-  it "current" $ withSmpServer t $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn True False
-  it "prev" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfgVPrev 3 $ runTest PQSupportOff False False
-  it "prev to current" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfg 3 $ runTest PQSupportOff False False
-  it "current to prev" $ withSmpServer t $ runTestCfg2 aCfg aCfgVPrev 3 $ runTest PQSupportOff False False
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aCfg aCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aProxyCfgV8 aProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
+  it "current" $ withSmpServer t $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn False
+  it "prev" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfgVPrev 3 $ runTest PQSupportOff False
+  it "prev to current" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfg 3 $ runTest PQSupportOff False
+  it "current to prev" $ withSmpServer t $ runTestCfg2 aCfg aCfgVPrev 3 $ runTest PQSupportOff False
  where
    aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
    aProxyCfgV8 = agentProxyCfgV8 {messageRetryInterval = fastMessageRetryInterval}
    aCfgVPrev = agentCfgVPrev {messageRetryInterval = fastMessageRetryInterval}

-testBasicMatrix2 :: HasCallStack => ATransport -> (SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testBasicMatrix2 :: HasCallStack => ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testBasicMatrix2 t runTest = do
-  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest True
-  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 3 $ runTest False
-  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfg 3 $ runTest False
-  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrevPQ 3 $ runTest False
+  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest
+  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 3 $ runTest
+  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfg 3 $ runTest
+  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrevPQ 3 $ runTest

-testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testRatchetMatrix2 t runTest = do
-  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True True
-  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn False True
-  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False
-  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff True False
-  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff True False
-  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff True False
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
+  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
+  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
+  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff False
+  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff False

 testServerMatrix2 :: HasCallStack => ATransport -> (InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 t runTest = do
@@ -597,16 +589,15 @@ withAgentClients3 runTest =
    withAgent 3 agentCfg initAgentServers testDB3 $ \c ->
      runTest a b c

-runAgentClientTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-runAgentClientTest pqSupport sqSecured viaProxy alice bob baseId =
-  runAgentClientTestPQ sqSecured viaProxy (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
+runAgentClientTest :: HasCallStack => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientTest pqSupport viaProxy alice bob baseId =
+  runAgentClientTestPQ viaProxy (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId

-runAgentClientTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
-runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId =
+runAgentClientTestPQ :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId =
  runRight_ $ do
    (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing aPQ SMSubscribe
-    (aliceId, sqSecured') <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" bPQ SMSubscribe
-    liftIO $ sqSecured' `shouldBe` sqSecured
+    aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" bPQ SMSubscribe
    ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
    liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ
    allowConnection alice bobId confId "alice's connInfo"
@@ -643,10 +634,10 @@ runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId =
 pqConnectionMode :: InitialKeys -> PQSupport -> Bool
 pqConnectionMode pqMode1 pqMode2 = supportPQ (CR.connPQEncryption pqMode1) && supportPQ pqMode2

-runAgentClientStressTestOneWay :: HasCallStack => Int64 -> PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-runAgentClientStressTestOneWay n pqSupport sqSecured viaProxy alice bob baseId = runRight_ $ do
+runAgentClientStressTestOneWay :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientStressTestOneWay n pqSupport viaProxy alice bob baseId = runRight_ $ do
  let pqEnc = PQEncryption $ supportPQ pqSupport
-  (aliceId, bobId) <- makeConnection_ pqSupport sqSecured alice bob
+  (aliceId, bobId) <- makeConnection_ pqSupport alice bob
  let proxySrv = if viaProxy then Just testSMPServer else Nothing
      message i = "message " <> bshow i
  concurrently_
@@ -675,10 +666,10 @@ runAgentClientStressTestOneWay n pqSupport sqSecured viaProxy alice bob baseId =
  where
    msgId = subtract baseId . fst

-runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-runAgentClientStressTestConc n pqSupport sqSecured viaProxy alice bob baseId = runRight_ $ do
+runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientStressTestConc n pqSupport viaProxy alice bob baseId = runRight_ $ do
  let pqEnc = PQEncryption $ supportPQ pqSupport
-  (aliceId, bobId) <- makeConnection_ pqSupport sqSecured alice bob
+  (aliceId, bobId) <- makeConnection_ pqSupport alice bob
  let proxySrv = if viaProxy then Just testSMPServer else Nothing
      message i = "message " <> bshow i
      loop a bId mIdVar i = do
@@ -712,7 +703,7 @@ testEnablePQEncryption :: HasCallStack => IO ()
 testEnablePQEncryption =
  withAgentClients2 $ \ca cb -> runRight_ $ do
    g <- liftIO C.newRandom
-    (aId, bId) <- makeConnection_ PQSupportOff True ca cb
+    (aId, bId) <- makeConnection_ PQSupportOff ca cb
    let a = (ca, aId)
        b = (cb, bId)
    (a, 2, "msg 1") \#>\ b
@@ -798,23 +789,20 @@ testAgentClient3 =
    get c =##> \case ("", connId, Msg "c5") -> connId == aIdForC; _ -> False
    ackMessage c aIdForC 3 Nothing

-runAgentClientContactTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId =
-  runAgentClientContactTestPQ sqSecured viaProxy pqSupport (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
+runAgentClientContactTest :: HasCallStack => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientContactTest pqSupport viaProxy alice bob baseId =
+  runAgentClientContactTestPQ viaProxy pqSupport (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId

-runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
-runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId =
+runAgentClientContactTestPQ :: HasCallStack => Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientContactTestPQ viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId =
  runRight_ $ do
    (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing aPQ SMSubscribe
    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
-    (aliceId', sqSecuredJoin) <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" bPQ SMSubscribe
-    liftIO $ do
-      aliceId' `shouldBe` aliceId
-      sqSecuredJoin `shouldBe` False -- joining via contact address connection
+    aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" bPQ SMSubscribe
+    liftIO $ aliceId' `shouldBe` aliceId
    ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
    liftIO $ pqSup' `shouldBe` reqPQSupport
-    (bobId, sqSecured') <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
-    liftIO $ sqSecured' `shouldBe` sqSecured
+    bobId <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
    ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get bob
    liftIO $ pqSup'' `shouldBe` bPQ
    allowConnection bob aliceId confId "bob's connInfo"
@@ -859,14 +847,11 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId
    msgId = subtract baseId . fst
    connectViaContact b pq qInfo = do
      aId <- A.prepareConnectionToJoin b 1 True qInfo pq
-      (aId', sqSecuredJoin) <- A.joinConnection b 1 (Just aId) True qInfo "bob's connInfo" pq SMSubscribe
-      liftIO $ do
-        aId' `shouldBe` aId
-        sqSecuredJoin `shouldBe` False -- joining via contact address connection
+      aId' <- A.joinConnection b 1 (Just aId) True qInfo "bob's connInfo" pq SMSubscribe
+      liftIO $ aId' `shouldBe` aId
      ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
      liftIO $ pqSup' `shouldBe` PQSupportOn
-      (bId, sqSecuredAccept) <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
-      liftIO $ sqSecuredAccept `shouldBe` False -- agent cfg is v8
+      bId <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
      ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b
      liftIO $ pqSup'' `shouldBe` pq
      allowConnection b aId confId "bob's connInfo"
@@ -906,68 +891,28 @@ testRejectContactRequest =
  withAgentClients2 $ \alice bob -> runRight_ $ do
    (addrConnId, qInfo) <- A.createConnection alice 1 True SCMContact Nothing IKPQOn SMSubscribe
    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-    (aliceId', sqSecured) <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-    liftIO $ do
-      aliceId' `shouldBe` aliceId
-      sqSecured `shouldBe` False -- joining via contact address connection
+    aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    liftIO $ aliceId' `shouldBe` aliceId
    ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice
    liftIO $ runExceptT (rejectContact alice "abcd" invId) `shouldReturn` Left (CONN NOT_FOUND)
    rejectContact alice addrConnId invId
    liftIO $ noMessages bob "nothing delivered to bob"

-testUpdateConnectionUserId :: HasCallStack => IO ()
-testUpdateConnectionUserId =
-  withAgentClients2 $ \alice bob -> runRight_ $ do
-    (connId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    newUserId <- createUser alice [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
-    _ <- changeConnectionUser alice 1 connId newUserId
-    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-    (aliceId', sqSecured') <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-    liftIO $ do
-      aliceId' `shouldBe` aliceId
-      sqSecured' `shouldBe` True
-    ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
-    liftIO $ pqSup' `shouldBe` PQSupportOn
-    allowConnection alice connId confId "alice's connInfo"
-    let pqEnc = CR.pqSupportToEnc PQSupportOn
-    get alice ##> ("", connId, A.CON pqEnc)
-    get bob ##> ("", aliceId, A.INFO PQSupportOn "alice's connInfo")
-    get bob ##> ("", aliceId, A.CON pqEnc)
-
 testAsyncInitiatingOffline :: HasCallStack => IO ()
 testAsyncInitiatingOffline =
  withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> runRight_ $ do
    alice <- liftIO $ getSMPAgentClient' 1 agentCfg initAgentServers testDB
    (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    liftIO $ disposeAgentClient alice
-
-    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
-    liftIO $ sqSecured `shouldBe` True
-
-    -- send messages
-    msgId1 <- A.sendMessage bob aliceId PQEncOn SMP.noMsgFlags "can send 1"
-    liftIO $ msgId1 `shouldBe` (2, PQEncOff)
-    get bob ##> ("", aliceId, SENT 2)
-    msgId2 <- A.sendMessage bob aliceId PQEncOn SMP.noMsgFlags "can send 2"
-    liftIO $ msgId2 `shouldBe` (3, PQEncOff)
-    get bob ##> ("", aliceId, SENT 3)
-
+    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    alice' <- liftIO $ getSMPAgentClient' 3 agentCfg initAgentServers testDB
    subscribeConnection alice' bobId
    ("", _, CONF confId _ "bob's connInfo") <- get alice'
-    -- receive messages
-    get alice' =##> \case ("", c, Msg' mId pq "can send 1") -> c == bobId && mId == 1 && pq == PQEncOff; _ -> False
-    ackMessage alice' bobId 1 Nothing
-    get alice' =##> \case ("", c, Msg' mId pq "can send 2") -> c == bobId && mId == 2 && pq == PQEncOff; _ -> False
-    ackMessage alice' bobId 2 Nothing
-    -- for alice msg id 3 is sent confirmation, then they're matched with bob at msg id 4
-
-    -- allow connection
    allowConnection alice' bobId confId "alice's connInfo"
    get alice' ##> ("", bobId, CON)
    get bob ##> ("", aliceId, INFO "alice's connInfo")
    get bob ##> ("", aliceId, CON)
-    exchangeGreetingsMsgId 4 alice' bobId bob aliceId
+    exchangeGreetings alice' bobId bob aliceId
    liftIO $ disposeAgentClient alice'

 testAsyncJoiningOfflineBeforeActivation :: HasCallStack => IO ()
@@ -975,8 +920,7 @@ testAsyncJoiningOfflineBeforeActivation =
  withAgent 1 agentCfg initAgentServers testDB $ \alice -> runRight_ $ do
    bob <- liftIO $ getSMPAgentClient' 2 agentCfg initAgentServers testDB2
    (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
-    liftIO $ sqSecured `shouldBe` True
+    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
    liftIO $ disposeAgentClient bob
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnection alice bobId confId "alice's connInfo"
@@ -995,8 +939,7 @@ testAsyncBothOffline = do
  runRight_ $ do
    (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    liftIO $ disposeAgentClient alice
-    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
-    liftIO $ sqSecured `shouldBe` True
+    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    liftIO $ disposeAgentClient bob
    alice' <- liftIO $ getSMPAgentClient' 3 agentCfg initAgentServers testDB
    subscribeConnection alice' bobId
@@ -1027,8 +970,7 @@ testAsyncServerOffline t = withAgentClients2 $ \alice bob -> do
    liftIO $ do
      srv1 `shouldBe` testSMPServer
      conns1 `shouldBe` [bobId]
-    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
-    liftIO $ sqSecured `shouldBe` True
+    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnection alice bobId confId "alice's connInfo"
    get alice ##> ("", bobId, CON)
@@ -1046,8 +988,7 @@ testAllowConnectionClientRestart t = do
      withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \_ -> do
        runRight $ do
          (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-          (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
-          liftIO $ sqSecured `shouldBe` True
+          aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
          ("", _, CONF confId _ "bob's connInfo") <- get alice
          pure (aliceId, bobId, confId)

@@ -1063,12 +1004,13 @@ testAllowConnectionClientRestart t = do
    threadDelay 250000

    alice2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB
-    runRight_ $ subscribeConnection alice2 bobId
-    threadDelay 500000

    withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \_ -> do
      runRight $ do
        ("", "", UP _ _) <- nGet bob
+
+        subscribeConnection alice2 bobId
+
        get alice2 ##> ("", bobId, CON)
        get bob ##> ("", aliceId, INFO "alice's connInfo")
        get bob ##> ("", aliceId, CON)
@@ -1082,7 +1024,7 @@ testIncreaseConnAgentVersion t = do
  bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aliceId, bobId) <- runRight $ do
-      (aliceId, bobId) <- makeConnection_ PQSupportOff False alice bob
+      (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
      exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
      checkVersion alice bobId 2
      checkVersion bob aliceId 2
@@ -1147,7 +1089,7 @@ testIncreaseConnAgentVersionMaxCompatible t = do
  bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aliceId, bobId) <- runRight $ do
-      (aliceId, bobId) <- makeConnection_ PQSupportOff False alice bob
+      (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
      exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
      checkVersion alice bobId 2
      checkVersion bob aliceId 2
@@ -1177,7 +1119,7 @@ testIncreaseConnAgentVersionStartDifferentVersion t = do
  bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aliceId, bobId) <- runRight $ do
-      (aliceId, bobId) <- makeConnection_ PQSupportOff False alice bob
+      (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
      exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
      checkVersion alice bobId 2
      checkVersion bob aliceId 2
@@ -1678,8 +1620,7 @@ testRatchetSyncSimultaneous t = do
 testOnlyCreatePullSlowHandshake :: IO ()
 testOnlyCreatePullSlowHandshake = withAgentClientsCfg2 agentProxyCfgV8 agentProxyCfgV8 $ \alice bob -> runRight_ $ do
  (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
-  (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
-  liftIO $ sqSecured `shouldBe` False
+  aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
  Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
  allowConnection alice bobId confId "alice's connInfo"
  liftIO $ threadDelay 1_000000
@@ -1713,8 +1654,7 @@ getMsg c cId action = do
 testOnlyCreatePull :: IO ()
 testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
  (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
-  (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
-  liftIO $ sqSecured `shouldBe` True
+  aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
  Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
  allowConnection alice bobId confId "alice's connInfo"
  liftIO $ threadDelay 1_000000
@@ -1736,22 +1676,20 @@ testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
  ackMessage alice bobId 3 Nothing

 makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
-makeConnection = makeConnection_ PQSupportOn True
+makeConnection = makeConnection_ PQSupportOn

-makeConnection_ :: PQSupport -> SndQueueSecured -> AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
-makeConnection_ pqEnc sqSecured alice bob = makeConnectionForUsers_ pqEnc sqSecured alice 1 bob 1
+makeConnection_ :: PQSupport -> AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
+makeConnection_ pqEnc alice bob = makeConnectionForUsers_ pqEnc alice 1 bob 1

 makeConnectionForUsers :: HasCallStack => AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
-makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn True
+makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn

-makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
-makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do
+makeConnectionForUsers_ :: HasCallStack => PQSupport -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
+makeConnectionForUsers_ pqSupport alice aliceUserId bob bobUserId = do
  (bobId, qInfo) <- A.createConnection alice aliceUserId True SCMInvitation Nothing (CR.IKNoPQ pqSupport) SMSubscribe
  aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport
-  (aliceId', sqSecured') <- A.joinConnection bob bobUserId (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe
-  liftIO $ do
-    aliceId' `shouldBe` aliceId
-    sqSecured' `shouldBe` sqSecured
+  aliceId' <- A.joinConnection bob bobUserId (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe
+  liftIO $ aliceId' `shouldBe` aliceId
  ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
  liftIO $ pqSup' `shouldBe` pqSupport
  allowConnection alice bobId confId "alice's connInfo"
@@ -1834,6 +1772,7 @@ testSuspendingAgentCompleteSending t = withAgentClients2 $ \a b -> do
    get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
    ackMessage b aId 2 Nothing
    pure (aId, bId)
+
  runRight_ $ do
    ("", "", DOWN {}) <- nGet a
    ("", "", DOWN {}) <- nGet b
@@ -1841,17 +1780,15 @@ testSuspendingAgentCompleteSending t = withAgentClients2 $ \a b -> do
    4 <- sendMessage b aId SMP.noMsgFlags "how are you?"
    liftIO $ threadDelay 100000
    liftIO $ suspendAgent b 5000000
+
  withSmpServerStoreLogOn t testPort $ \_ -> runRight_ @AgentErrorType $ do
-    -- there will be no UP event for b, because re-subscriptions are suspended until the agent is in foreground
-    get b =##> \case ("", c, SENT 3) -> c == aId; _ -> False
-    get b =##> \case ("", c, SENT 4) -> c == aId; _ -> False
-    nGet b ##> ("", "", SUSPENDED)
-    liftIO $
-      getInAnyOrder
-        a
-        [ \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; _ -> False,
-          \case ("", "", AEvt _ UP {}) -> True; _ -> False
-        ]
+    pGet b =##> \case ("", c, AEvt SAEConn (SENT 3)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    pGet b =##> \case ("", c, AEvt SAEConn (SENT 3)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    pGet b =##> \case ("", c, AEvt SAEConn (SENT 4)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    ("", "", SUSPENDED) <- nGet b
+
+    pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
    ackMessage a bId 3 Nothing
    get a =##> \case ("", c, Msg "how are you?") -> c == bId; _ -> False
    ackMessage a bId 4 Nothing
@@ -1879,7 +1816,7 @@ testBatchedSubscriptions :: Int -> Int -> ATransport -> IO ()
 testBatchedSubscriptions nCreate nDel t =
  withAgentClientsCfgServers2 agentCfg agentCfg initAgentServers2 $ \a b -> do
    conns <- runServers $ do
-      conns <- replicateM nCreate $ makeConnection_ PQSupportOff True a b
+      conns <- replicateM nCreate $ makeConnection_ PQSupportOff a b
      forM_ conns $ \(aId, bId) -> exchangeGreetings_ PQEncOff a bId b aId
      let (aIds', bIds') = unzip $ take nDel conns
      delete a bIds'
@@ -1957,59 +1894,15 @@ testBatchedPendingMessages nCreate nMsgs =
    withA = withAgent 1 agentCfg initAgentServers testDB
    withB = withAgent 2 agentCfg initAgentServers testDB2

-testSendMessagesB :: IO ()
-testSendMessagesB = withAgentClients2 $ \a b -> runRight_ $ do
-  (aId, bId) <- makeConnection a b
-  let msg cId body = Right (cId, PQEncOn, SMP.noMsgFlags, body)
-  [SentB 2, SentB 3, SentB 4] <- sendMessagesB a ([msg bId "msg 1", msg "" "msg 2", msg "" "msg 3"] :: [Either AgentErrorType MsgReq])
-  get a ##> ("", bId, SENT 2)
-  get a ##> ("", bId, SENT 3)
-  get a ##> ("", bId, SENT 4)
-  receiveMsg b aId 2 "msg 1"
-  receiveMsg b aId 3 "msg 2"
-  receiveMsg b aId 4 "msg 3"
-
-testSendMessagesB2 :: IO ()
-testSendMessagesB2 = withAgentClients3 $ \a b c -> runRight_ $ do
-  (abId, bId) <- makeConnection a b
-  (acId, cId) <- makeConnection a c
-  let msg connId body = Right (connId, PQEncOn, SMP.noMsgFlags, body)
-  [SentB 2, SentB 3, SentB 4, SentB 2, SentB 3] <-
-    sendMessagesB a ([msg bId "msg 1", msg "" "msg 2", msg "" "msg 3", msg cId "msg 4", msg "" "msg 5"] :: [Either AgentErrorType MsgReq])
-  liftIO $
-    getInAnyOrder
-      a
-      [ \case ("", cId', AEvt SAEConn (SENT 2)) -> cId' == bId; _ -> False,
-        \case ("", cId', AEvt SAEConn (SENT 3)) -> cId' == bId; _ -> False,
-        \case ("", cId', AEvt SAEConn (SENT 4)) -> cId' == bId; _ -> False,
-        \case ("", cId', AEvt SAEConn (SENT 2)) -> cId' == cId; _ -> False,
-        \case ("", cId', AEvt SAEConn (SENT 3)) -> cId' == cId; _ -> False
-      ]
-  receiveMsg b abId 2 "msg 1"
-  receiveMsg b abId 3 "msg 2"
-  receiveMsg b abId 4 "msg 3"
-  receiveMsg c acId 2 "msg 4"
-  receiveMsg c acId 3 "msg 5"
-
-pattern SentB :: AgentMsgId -> Either AgentErrorType (AgentMsgId, PQEncryption)
-pattern SentB msgId <- Right (msgId, PQEncOn)
-
-receiveMsg :: AgentClient -> ConnId -> AgentMsgId -> MsgBody -> ExceptT AgentErrorType IO ()
-receiveMsg c cId msgId msg  = do
-  get c =##> \case ("", cId', Msg' mId' PQEncOn msg') -> cId' == cId && mId' == msgId && msg' == msg; _ -> False
-  ackMessage c cId msgId Nothing
-
-testAsyncCommands :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-testAsyncCommands sqSecured alice bob baseId =
+testAsyncCommands :: AgentClient -> AgentClient -> AgentMsgId -> IO ()
+testAsyncCommands alice bob baseId =
  runRight_ $ do
    bobId <- createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
    ("1", bobId', INV (ACR _ qInfo)) <- get alice
    liftIO $ bobId' `shouldBe` bobId
    aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-    ("2", aliceId', JOINED sqSecured') <- get bob
-    liftIO $ do
-      aliceId' `shouldBe` aliceId
-      sqSecured' `shouldBe` sqSecured
+    ("2", aliceId', OK) <- get bob
+    liftIO $ aliceId' `shouldBe` aliceId
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnectionAsync alice "3" bobId confId "alice's connInfo"
    get alice =##> \case ("3", _, OK) -> True; _ -> False
@@ -2062,15 +1955,14 @@ testAsyncCommandsRestore t = do
      get alice' =##> \case ("1", _, INV _) -> True; _ -> False
      pure ()

-testAcceptContactAsync :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-testAcceptContactAsync sqSecured alice bob baseId =
+testAcceptContactAsync :: AgentClient -> AgentClient -> AgentMsgId -> IO ()
+testAcceptContactAsync alice bob baseId =
  runRight_ $ do
    (_, qInfo) <- createConnection alice 1 True SCMContact Nothing SMSubscribe
-    (aliceId, sqSecuredJoin) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
-    liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
+    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
    ("", _, REQ invId _ "bob's connInfo") <- get alice
    bobId <- acceptContactAsync alice "1" True invId "alice's connInfo" PQSupportOn SMSubscribe
-    get alice =##> \case ("1", c, JOINED sqSecured') -> c == bobId && sqSecured' == sqSecured; _ -> False
+    get alice =##> \case ("1", c, OK) -> c == bobId; _ -> False
    ("", _, CONF confId _ "alice's connInfo") <- get bob
    allowConnection bob aliceId confId "bob's connInfo"
    get alice ##> ("", bobId, INFO "bob's connInfo")
@@ -2346,7 +2238,7 @@ testJoinConnectionAsyncReplyErrorV8 t = do
        pure (aId, bId)
      nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
      withSmpServerOn t testPort2 $ do
-        get b =##> \case ("2", c, JOINED sqSecured) -> c == aId && not sqSecured; _ -> False
+        get b =##> \case ("2", c, OK) -> c == aId; _ -> False
        confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
          pGet a >>= \case
            ("", "", AEvt _ (UP _ [_])) -> do
@@ -2387,7 +2279,7 @@ testJoinConnectionAsyncReplyError t = do
      withSmpServerOn t testPort2 $ do
        confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
          -- both servers need to be online for connection to progress because of SKEY
-          get b =##> \case ("2", c, JOINED sqSecured) -> c == aId && sqSecured; _ -> False
+          get b =##> \case ("2", c, OK) -> c == aId; _ -> False
          pGet a >>= \case
            ("", "", AEvt _ (UP _ [_])) -> do
              ("", _, CONF confId _ "bob's connInfo") <- get a
@@ -2841,8 +2733,8 @@ testSwitch2ConnectionsAbort1 servers = do
    withB :: (AgentClient -> IO a) -> IO a
    withB = withAgent 2 agentCfg servers testDB2

-testCreateQueueAuth :: HasCallStack => VersionSMP -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int
-testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId = do
+testCreateQueueAuth :: HasCallStack => VersionSMP -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
+testCreateQueueAuth srvVersion clnt1 clnt2 baseId = do
  a <- getClient 1 clnt1 testDB
  b <- getClient 2 clnt2 testDB2
  r <- runRight $ do
@@ -2853,8 +2745,7 @@ testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId = do
        tryError (joinConnection b 1 True qInfo "bob's connInfo" SMSubscribe) >>= \case
          Left (SMP _ AUTH) -> pure 1
          Left e -> throwError e
-          Right (aId, sqSecured') -> do
-            liftIO $ sqSecured' `shouldBe` sqSecured
+          Right aId -> do
            ("", _, CONF confId _ "bob's connInfo") <- get a
            allowConnection a bId confId "alice's connInfo"
            get a ##> ("", bId, CON)
@@ -2914,7 +2805,7 @@ testDeliveryReceiptsVersion t = do
  b <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aId, bId) <- runRight $ do
-      (aId, bId) <- makeConnection_ PQSupportOff False a b
+      (aId, bId) <- makeConnection_ PQSupportOff a b
      checkVersion a bId 3
      checkVersion b aId 3
      (2, _) <- A.sendMessage a bId PQEncOff SMP.noMsgFlags "hello"
@@ -2938,8 +2829,8 @@ testDeliveryReceiptsVersion t = do
      subscribeConnection a' bId
      subscribeConnection b' aId
      exchangeGreetingsMsgId_ PQEncOff 4 a' bId b' aId
-      checkVersion a' bId 7
-      checkVersion b' aId 7
+      checkVersion a' bId 6
+      checkVersion b' aId 6
      (6, PQEncOff) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello"
      get a' ##> ("", bId, SENT 6)
      get b' =##> \case ("", c, Msg' 6 PQEncOff "hello") -> c == aId; _ -> False
@@ -3088,8 +2979,7 @@ testServerMultipleIdentities :: HasCallStack => IO ()
 testServerMultipleIdentities =
  withAgentClients2 $ \alice bob -> runRight_ $ do
    (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
-    liftIO $ sqSecured `shouldBe` True
+    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnection alice bobId confId "alice's connInfo"
    get alice ##> ("", bobId, CON)
@@ -3188,8 +3078,7 @@ testServerQueueInfo = do
    (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    liftIO $ threadDelay 200000
    checkEmptyQ alice bobId False
-    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
-    liftIO $ sqSecured `shouldBe` True
+    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    liftIO $ threadDelay 200000
    checkEmptyQ alice bobId True -- secured by sender
@@ -477,7 +477,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
  (bobId, aliceId, nonce, message) <- runRight $ do
    -- establish connection
    (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    (aliceId, _sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnection alice bobId confId "alice's connInfo"
    get bob ##> ("", aliceId, INFO "alice's connInfo")
@@ -507,16 +507,14 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
  threadDelay 500000
  suspendAgent alice 0
  closeSQLiteStore store
-  threadDelay 1000000
-  putStrLn "before opening the database from another agent"
+  threadDelay 500000

  -- aliceNtf client doesn't have subscription and is allowed to get notification message
  withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
-    (_, Just SMPMsgMeta {msgFlags = MsgFlags True}) <- getNotificationMessage aliceNtf nonce message
+    (_, [SMPMsgMeta {msgFlags = MsgFlags True}]) <- getNotificationMessage aliceNtf nonce message
    pure ()

-  threadDelay 1000000
-  putStrLn "after closing the database in another agent"
+  threadDelay 500000
  reopenSQLiteStore store
  foregroundAgent alice
  threadDelay 500000
@@ -526,7 +524,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
    ackMessage alice bobId (baseId + 1) Nothing
    -- delete notification subscription
    toggleConnectionNtfs alice bobId False
-    liftIO $ threadDelay 500000
+    liftIO $ threadDelay 250000
    -- send message
    2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
    get bob ##> ("", aliceId, SENT $ baseId + 2)
@@ -546,7 +544,7 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} baseId alice bo
    liftIO $ threadDelay 50000
    (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    liftIO $ threadDelay 1000000
-    (aliceId, _sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
    liftIO $ threadDelay 750000
    void $ messageNotificationData alice apnsQ
    ("", _, CONF confId _ "bob's connInfo") <- get alice
@@ -593,8 +591,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
  withAgentClients2 $ \alice bob -> runRight_ $ do
    -- establish connection
    (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
-    liftIO $ sqSecured `shouldBe` True
+    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnection alice bobId confId "alice's connInfo"
    get bob ##> ("", aliceId, INFO "alice's connInfo")
@@ -656,8 +653,7 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
  (aliceId, bobId) <- withAgent 2 agentCfg initAgentServers testDB $ \alice -> runRight $ do
    -- establish connection
    (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
-    liftIO $ sqSecured `shouldBe` True
+    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnection alice bobId confId "alice's connInfo"
    get bob ##> ("", aliceId, INFO "alice's connInfo")
@@ -114,8 +114,6 @@ storeTests = do
          testDeleteRcvConn
          testDeleteSndConn
          testDeleteDuplexConn
-        describe "setConnUserId" $ do
-          testSetConnUserIdNewConn
        describe "upgradeRcvConnToDuplex" $ do
          testUpgradeRcvConnToDuplex
        describe "upgradeSndConnToDuplex" $ do
@@ -338,21 +336,6 @@ testGetRcvConn =
    getRcvConn db smpServer recipientId
      `shouldReturn` Right (rq, SomeConn SCRcv (RcvConnection cData1 rq))

-testSetConnUserIdNewConn :: SpecWith SQLiteStore
-testSetConnUserIdNewConn =
-  it "should set user id for new connection" . withStoreTransaction $ \db -> do
-    g <- C.newRandom
-    Right connId <- createNewConn db g cData1 {connId = ""} SCMInvitation
-    newUserId <- createUserRecord db
-    _ <- setConnUserId db 1 connId newUserId
-    connResult <- getConn db connId
-    case connResult of
-      Right (SomeConn SCNew (NewConnection connData)) -> do
-        let ConnData {userId} = connData
-        userId `shouldBe` newUserId
-      _ -> do
-         expectationFailure "Failed to get connection"
-
 testDeleteRcvConn :: SpecWith SQLiteStore
 testDeleteRcvConn =
  it "should create RcvConnection and delete it" . withStoreTransaction $ \db -> do
@@ -661,30 +644,30 @@ testGetPendingServerCommand :: SQLiteStore -> Expectation
 testGetPendingServerCommand st = do
  g <- C.newRandom
  withTransaction st $ \db -> do
-    Right Nothing <- getPendingServerCommand db "" Nothing
+    Right Nothing <- getPendingServerCommand db Nothing
    Right connId <- createNewConn db g cData1 {connId = ""} SCMInvitation
    Right () <- createCommand db "1" connId Nothing command
    corruptCmd db "1" connId
    Right () <- createCommand db "2" connId Nothing command

-    Left e <- getPendingServerCommand db connId Nothing
+    Left e <- getPendingServerCommand db Nothing
    show e `shouldContain` "bad AgentCmdType"
    DB.query_ db "SELECT conn_id, corr_id FROM commands WHERE failed = 1" `shouldReturn` [(connId, "1" :: ByteString)]

-    Right (Just PendingCommand {corrId}) <- getPendingServerCommand db connId Nothing
+    Right (Just PendingCommand {corrId}) <- getPendingServerCommand db Nothing
    corrId `shouldBe` "2"

    Right _ <- updateNewConnRcv db connId rcvQueue1
-    Right Nothing <- getPendingServerCommand db connId $ Just smpServer1
+    Right Nothing <- getPendingServerCommand db $ Just smpServer1
    Right () <- createCommand db "3" connId (Just smpServer1) command
    corruptCmd db "3" connId
    Right () <- createCommand db "4" connId (Just smpServer1) command

-    Left e' <- getPendingServerCommand db connId (Just smpServer1)
+    Left e' <- getPendingServerCommand db (Just smpServer1)
    show e' `shouldContain` "bad AgentCmdType"
    DB.query_ db "SELECT conn_id, corr_id FROM commands WHERE failed = 1" `shouldReturn` [(connId, "1" :: ByteString), (connId, "3" :: ByteString)]

-    Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db connId (Just smpServer1)
+    Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db (Just smpServer1)
    corrId' `shouldBe` "4"
  where
    command = AClientCommand $ NEW True (ACM SCMInvitation) (IKNoPQ PQSupportOn) SMSubscribe
@@ -261,7 +261,7 @@ testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 testClientStub = do
  g <- C.newRandom
  sessId <- atomically $ C.randomBytes 32 g
-  smpClientStub g sessId subModeSMPVersion Nothing
+  atomically $ smpClientStub g sessId subModeSMPVersion Nothing

 clientStubV7 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 clientStubV7 = do
@@ -269,7 +269,7 @@ clientStubV7 = do
  sessId <- atomically $ C.randomBytes 32 g
  (rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
  thAuth_ <- testTHandleAuth authCmdsSMPVersion g rKey
-  smpClientStub g sessId authCmdsSMPVersion thAuth_
+  atomically $ smpClientStub g sessId authCmdsSMPVersion thAuth_

 randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSUB = randomSUB_ C.SEd25519 subModeSMPVersion
@@ -2,8 +2,6 @@

 module CoreTests.RetryIntervalTests where

-import Control.Concurrent (threadDelay)
-import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.STM
 import Control.Monad (when)
 import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds)
@@ -15,10 +13,6 @@ retryIntervalTests = do
  describe "Retry interval with 2 modes and lock" $ do
    testRetryIntervalSameMode
    testRetryIntervalSwitchMode
-  describe "Foreground retry interval" $ do 
-    testRetryForeground
-    testRetryToBackground
-    testRetrySkipWhenForeground

 testRI :: RetryInterval2
 testRI =
@@ -29,15 +23,12 @@ testRI =
            increaseAfter = 40000,
            maxInterval = 40000
          },
-      riFast = testFastRI
-    }
-
-testFastRI :: RetryInterval
-testFastRI =
-  RetryInterval
-    { initialInterval = 10000,
-      increaseAfter = 20000,
-      maxInterval = 40000
+      riFast =
+        RetryInterval
+          { initialInterval = 10000,
+            increaseAfter = 20000,
+            maxInterval = 40000
+          }
    }

 testRetryIntervalSameMode :: Spec
@@ -90,67 +81,6 @@ testRetryIntervalSwitchMode =
                       (40000, 40000)
                     ]

-testRetryForeground :: Spec
-testRetryForeground =
-  it "should increase elapased time and interval" $ do
-    intervals <- newTVarIO []
-    reportedIntervals <- newTVarIO []
-    ts <- newTVarIO =<< getCurrentTime
-    let isForeground = pure True
-    withRetryForeground testFastRI isForeground (pure True) $ \delay loop -> do
-      ints <- addInterval intervals ts
-      atomically $ modifyTVar' reportedIntervals (delay :)
-      when (length ints < 8) $ loop
-    (reverse <$> readTVarIO intervals) `shouldReturn` [0, 1, 1, 1, 2, 3, 4, 4]
-    (reverse <$> readTVarIO reportedIntervals)
-      `shouldReturn` [ 10000, 10000, 15000, 22500, 33750, 40000, 40000, 40000]
-
-testRetryToBackground :: Spec
-testRetryToBackground =
-  it "should not change interval when moving to background" $ do
-    intervals <- newTVarIO []
-    reportedIntervals <- newTVarIO []
-    ts <- newTVarIO =<< getCurrentTime
-    foreground <- newTVarIO True
-    concurrently_
-      ( do
-          threadDelay 50000
-          atomically $ writeTVar foreground False
-      )
-      ( withRetryForeground testFastRI (readTVar foreground) (pure True) $ \delay loop -> do
-          ints <- addInterval intervals ts
-          atomically $ modifyTVar' reportedIntervals (delay :)
-          when (length ints < 8) $ loop
-      )
-    (reverse <$> readTVarIO intervals) `shouldReturn` [0, 1, 1, 1, 2, 3, 4, 4]
-    (reverse <$> readTVarIO reportedIntervals)
-      `shouldReturn` [ 10000, 10000, 15000, 22500, 33750, 40000, 40000, 40000]
-
-testRetrySkipWhenForeground :: Spec
-testRetrySkipWhenForeground =
-  it "should repeat loop as soon as moving to foreground" $ do
-    intervals <- newTVarIO []
-    reportedIntervals <- newTVarIO []
-    ts <- newTVarIO =<< getCurrentTime
-    foreground <- newTVarIO False
-    concurrently_
-      ( do
-          threadDelay 65000
-          atomically $ writeTVar foreground True
-          threadDelay 10000
-          atomically $ writeTVar foreground False
-          threadDelay 100000
-          atomically $ writeTVar foreground True
-      )
-      ( withRetryForeground testFastRI (readTVar foreground) (pure True) $ \delay loop -> do
-          ints <- addInterval intervals ts
-          atomically $ modifyTVar' reportedIntervals (delay :)
-          when (length ints < 12) $ loop
-      )
-    (reverse <$> readTVarIO intervals) `shouldReturn` [0, 1, 1, 1, 2, 0, 1, 1, 1, 2, 3, 1]
-    (reverse <$> readTVarIO reportedIntervals)
-      `shouldReturn` [ 10000, 10000, 15000, 22500, 33750, 10000, 10000, 15000, 22500, 33750, 40000, 10000]
-
 addInterval :: TVar [Int] -> TVar UTCTime -> IO [Int]
 addInterval intervals ts = do
  ts' <- getCurrentTime
@@ -1,7 +1,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}

 module CoreTests.TRcvQueuesTests where
@@ -31,19 +30,19 @@ tRcvQueuesTests = do
  describe "queue transfer" $ do
    it "getDelSessQueues-batchAddQueues preserves total length" removeSubsTest

-checkDataInvariant :: RQ.Queue q => RQ.TRcvQueues q -> IO Bool
+checkDataInvariant :: RQ.TRcvQueues -> IO Bool
 checkDataInvariant trq = atomically $ do
  conns <- readTVar $ RQ.getConnections trq
  qs <- readTVar $ RQ.getRcvQueues trq
  -- three invariant checks
-  let inv1 = all (\cId -> (S.fromList . L.toList <$> M.lookup cId conns) == Just (M.keysSet (M.filter (\q -> RQ.connId' q == cId) qs))) (M.keys conns)
-      inv2 = all (\(k, q) -> maybe False ((k `elem`) . L.toList) (M.lookup (RQ.connId' q) conns)) (M.assocs qs)
+  let inv1 = all (\cId -> (S.fromList . L.toList <$> M.lookup cId conns) == Just (M.keysSet (M.filter (\q -> connId q == cId) qs))) (M.keys conns)
+      inv2 = all (\(k, q) -> maybe False ((k `elem`) . L.toList) (M.lookup (connId q) conns)) (M.assocs qs)
      inv3 = all (\(k, q) -> RQ.qKey q == k) (M.assocs qs)
  pure $ inv1 && inv2 && inv3

 hasConnTest :: IO ()
 hasConnTest = do
-  trq <- RQ.empty
+  trq <- atomically RQ.empty
  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
  checkDataInvariant trq `shouldReturn` True
  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
@@ -57,7 +56,7 @@ hasConnTest = do

 hasConnTestBatch :: IO ()
 hasConnTestBatch = do
-  trq <- RQ.empty
+  trq <- atomically RQ.empty
  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1", dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@beta" "c3"]
  atomically $ RQ.batchAddQueues trq qs
  checkDataInvariant trq `shouldReturn` True
@@ -68,7 +67,7 @@ hasConnTestBatch = do

 batchIdempotentTest :: IO ()
 batchIdempotentTest = do
-  trq <- RQ.empty
+  trq <- atomically RQ.empty
  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1", dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@beta" "c3"]
  atomically $ RQ.batchAddQueues trq qs
  checkDataInvariant trq `shouldReturn` True
@@ -77,11 +76,11 @@ batchIdempotentTest = do
  atomically $ RQ.batchAddQueues trq qs
  checkDataInvariant trq `shouldReturn` True
  readTVarIO (RQ.getRcvQueues trq) `shouldReturn` qs'
-  fmap L.nub <$> readTVarIO (RQ.getConnections trq) `shouldReturn` cs' -- connections get duplicated, but that doesn't appear to affect anybody
+  fmap L.nub <$> readTVarIO (RQ.getConnections trq) `shouldReturn`cs' -- connections get duplicated, but that doesn't appear to affect anybody

 deleteConnTest :: IO ()
 deleteConnTest = do
-  trq <- RQ.empty
+  trq <- atomically RQ.empty
  atomically $ do
    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
@@ -95,7 +94,7 @@ deleteConnTest = do

 getSessQueuesTest :: IO ()
 getSessQueuesTest = do
-  trq <- RQ.empty
+  trq <- atomically RQ.empty
  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
  checkDataInvariant trq `shouldReturn` True
  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
@@ -104,40 +103,32 @@ getSessQueuesTest = do
  checkDataInvariant trq `shouldReturn` True
  atomically $ RQ.addQueue (dummyRQ 1 "smp://1234-w==@beta" "c4") trq
  checkDataInvariant trq `shouldReturn` True
-  let tSess1 = (0, "smp://1234-w==@alpha", Just "c1")
-  RQ.getSessQueues tSess1 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c1"]
-  atomically (RQ.hasSessQueues tSess1 trq) `shouldReturn` True
-  let tSess2 = (1, "smp://1234-w==@alpha", Just "c1")
-  RQ.getSessQueues tSess2 trq `shouldReturn` []
-  atomically (RQ.hasSessQueues tSess2 trq) `shouldReturn` False
-  let tSess3 = (0, "smp://1234-w==@alpha", Just "nope")
-  RQ.getSessQueues tSess3 trq `shouldReturn` []
-  atomically (RQ.hasSessQueues tSess3 trq) `shouldReturn` False
-  let tSess4 = (0, "smp://1234-w==@alpha", Nothing)
-  RQ.getSessQueues tSess4 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"]
-  atomically (RQ.hasSessQueues tSess4 trq) `shouldReturn`True
+  atomically (RQ.getSessQueues (0, "smp://1234-w==@alpha", Just "c1") trq) `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c1"]
+  atomically (RQ.getSessQueues (1, "smp://1234-w==@alpha", Just "c1") trq) `shouldReturn` []
+  atomically (RQ.getSessQueues (0, "smp://1234-w==@alpha", Just "nope") trq) `shouldReturn` []
+  atomically (RQ.getSessQueues (0, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"]

 getDelSessQueuesTest :: IO ()
 getDelSessQueuesTest = do
-  trq <- RQ.empty
+  trq <- atomically RQ.empty
  let qs =
-        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
-          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
-          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
-          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
+        [ dummyRQ 0 "smp://1234-w==@alpha" "c1",
+          dummyRQ 0 "smp://1234-w==@alpha" "c2",
+          dummyRQ 0 "smp://1234-w==@beta" "c3",
+          dummyRQ 1 "smp://1234-w==@beta" "c4"
        ]
  atomically $ RQ.batchAddQueues trq qs
  checkDataInvariant trq `shouldReturn` True
  -- no user
-  atomically (RQ.getDelSessQueues (2, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([], [])
+  atomically (RQ.getDelSessQueues (2, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` ([], [])
  checkDataInvariant trq `shouldReturn` True
  -- wrong user
-  atomically (RQ.getDelSessQueues (1, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([], [])
+  atomically (RQ.getDelSessQueues (1, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` ([], [])
  checkDataInvariant trq `shouldReturn` True
  -- connections intact
  atomically (RQ.hasConn "c1" trq) `shouldReturn` True
  atomically (RQ.hasConn "c2" trq) `shouldReturn` True
-  atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"], ["c1", "c2"])
+  atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"], ["c1", "c2"])
  checkDataInvariant trq `shouldReturn` True
  -- connections gone
  atomically (RQ.hasConn "c1" trq) `shouldReturn` False
@@ -148,31 +139,31 @@ getDelSessQueuesTest = do

 removeSubsTest :: IO ()
 removeSubsTest = do
-  aq <- RQ.empty
+  aq <- atomically RQ.empty
  let qs =
-        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
-          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
-          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
-          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
+        [ dummyRQ 0 "smp://1234-w==@alpha" "c1",
+          dummyRQ 0 "smp://1234-w==@alpha" "c2",
+          dummyRQ 0 "smp://1234-w==@beta" "c3",
+          dummyRQ 1 "smp://1234-w==@beta" "c4"
        ]
  atomically $ RQ.batchAddQueues aq qs

-  pq <- RQ.empty
+  pq <- atomically RQ.empty
  atomically (totalSize aq pq) `shouldReturn` (4, 4)

-  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
+  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) aq >>= RQ.batchAddQueues pq . fst
  atomically (totalSize aq pq) `shouldReturn` (4, 4)

-  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "non-existent") "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
+  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "non-existent") aq >>= RQ.batchAddQueues pq . fst
  atomically (totalSize aq pq) `shouldReturn` (4, 4)

-  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@localhost", Nothing) "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
+  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@localhost", Nothing) aq >>= RQ.batchAddQueues pq . fst
  atomically (totalSize aq pq) `shouldReturn` (4, 4)

-  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "c3") "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
+  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "c3") aq >>= RQ.batchAddQueues pq . fst
  atomically (totalSize aq pq) `shouldReturn` (4, 4)

-totalSize :: RQ.TRcvQueues q -> RQ.TRcvQueues q -> STM (Int, Int)
+totalSize :: RQ.TRcvQueues -> RQ.TRcvQueues -> STM (Int, Int)
 totalSize a b = do
  qsizeA <- M.size <$> readTVar (RQ.getRcvQueues a)
  qsizeB <- M.size <$> readTVar (RQ.getRcvQueues b)
@@ -72,6 +72,8 @@ agentCfg =
      ntfCfg = defaultNTFClientConfig {qSize = 1, defaultTransport = (ntfTestPort, transport @TLS), networkConfig},
      reconnectInterval = fastRetryInterval,
      persistErrorInterval = 1,
+      ntfWorkerDelay = 100,
+      ntfSMPWorkerDelay = 100,
      caCertificateFile = "tests/fixtures/ca.crt",
      privateKeyFile = "tests/fixtures/server.key",
      certificateFile = "tests/fixtures/server.crt"
@@ -207,8 +207,7 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b
  withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->
    withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do
      (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-      (aliceId, sqSecured) <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-      liftIO $ sqSecured `shouldBe` True
+      aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
      ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
      liftIO $ pqSup' `shouldBe` PQSupportOn
      allowConnection alice bobId confId "alice's connInfo"
@@ -262,8 +261,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
    -- otherwise the CONF messages would get mixed with MSG
    prePair alice bob = do
      (bobId, qInfo) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-      (aliceId, sqSecured) <- runExceptT' $ A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-      liftIO $ sqSecured `shouldBe` True
+      aliceId <- runExceptT' $ A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
      confId <-
        get alice >>= \case
          ("", _, A.CONF confId pqSup' _ "bob's connInfo") -> do
@@ -331,8 +329,7 @@ agentViaProxyRetryOffline = do
      withServer $ \_ -> do
        (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do
          (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-          (aliceId, sqSecured) <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-          liftIO $ sqSecured `shouldBe` True
+          aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
          ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
          liftIO $ pqSup' `shouldBe` PQSupportOn
          allowConnection alice bobId confId "alice's connInfo"
@@ -361,15 +358,11 @@ agentViaProxyRetryOffline = do
          -- proxy relay down
          4 <- msgId <$> A.sendMessage bob aliceId pqEnc noMsgFlags msg2
          bob `down` aliceId
-        withServer2 $ \_ -> do
-          getInAnyOrder
-            bob
-            [ \case ("", "", AEvt SAENone (UP _ [c])) -> c == aliceId; _ -> False,
-              \case ("", c, AEvt SAEConn (A.SENT mId srv)) -> c == aliceId && mId == baseId + 4 && srv == bProxySrv; _ -> False
-            ]
-          runRight_ $ do
-            get alice =##> \case ("", c, Msg' _ pq msg2') -> c == bobId && pq == pqEnc && msg2 == msg2'; _ -> False
-            ackMessage alice bobId (baseId + 4) Nothing
+        withServer2 $ \_ -> runRight_ $ do
+          bob `up` aliceId
+          get bob ##> ("", aliceId, A.SENT (baseId + 4) bProxySrv)
+          get alice =##> \case ("", c, Msg' _ pq msg2') -> c == bobId && pq == pqEnc && msg2 == msg2'; _ -> False
+          ackMessage alice bobId (baseId + 4) Nothing
  where
    withServer :: (ThreadId -> IO a) -> IO a
    withServer = withServer_ testStoreLogFile testStoreMsgsFile testPort
@@ -610,7 +610,7 @@ testRestoreMessages at@(ATransport t) =

    logSize testStoreLogFile `shouldReturn` 2
    logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 71
+    logSize testServerStatsBackupFile `shouldReturn` 55
    Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
    checkStats stats1 [rId] 5 1

@@ -628,7 +628,7 @@ testRestoreMessages at@(ATransport t) =
    logSize testStoreLogFile `shouldReturn` 1
    -- the last message is not removed because it was not ACK'd
    logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 71
+    logSize testServerStatsBackupFile `shouldReturn` 55
    Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
    checkStats stats2 [rId] 5 3

@@ -647,7 +647,7 @@ testRestoreMessages at@(ATransport t) =

    logSize testStoreLogFile `shouldReturn` 1
    logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 71
+    logSize testServerStatsBackupFile `shouldReturn` 55
    Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
    checkStats stats3 [rId] 5 5
Author	SHA1	Message	Date
Evgeny Poberezkin	fd3a78a545	Merge branch 'master' into ab/pclient-disconnected	2024-07-15 19:24:55 +01:00
Alexander Bondarenko	36511d0413	transport: update PClient.connected on exit	2024-05-01 15:55:44 +03:00