5.1.2, ntf server 1.4.1

* return updated ConnectionStats from switchConnectionAsync (#777)

* batch ntf server subscriptions to SMP servers

* refactor

* fix filtering queues in reconnect

* test, remove repeated grouping

* enable all tests

* reduce subscriptions count

---------

Co-authored-by: spaced4ndy <[email protected]>

.github/CODEOWNERS

@@ -1 +1,4 @@
-* @epoberezkin @efim-poberezkin
+* @epoberezkin @spaced4ndy
+/Dockerfile @shumvgolove
+/scripts/docker/ @shumvgolove
+/scripts/main/ @shumvgolove

.github/workflows/docker-image.yml

@@ -0,0 +1,50 @@
+name: Build and push Docker image to Docker Hub
+
+on:
+  push:
+    tags:
+      - "v*"
+
+jobs:
+  build-and-push:
+    name: Build and push Docker image
+    runs-on: ubuntu-latest
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          - app: smp-server
+            app_port: 5223
+          - app: xftp-server
+            app_port: 443 
+    steps:
+      - name: Clone project
+        uses: actions/checkout@v3
+
+      - name: Log in to Docker Hub
+        uses: docker/login-action@v2
+        with:
+          username: ${{ secrets.DOCKERHUB_USERNAME }}
+          password: ${{ secrets.DOCKERHUB_PASSWORD }}
+
+      - name: Extract metadata for Docker image
+        id: meta
+        uses: docker/metadata-action@v4
+        with:
+          images: ${{ secrets.DOCKERHUB_USERNAME }}/${{ matrix.app }}
+          flavor: |
+            latest=auto
+          tags: |
+            type=semver,pattern=v{{version}}
+            type=semver,pattern=v{{major}}.{{minor}}
+            type=semver,pattern=v{{major}}
+
+      - name: Build and push Docker image
+        uses: docker/build-push-action@v4
+        with:
+          push: true
+          build-args: |
+            APP=${{ matrix.app }}
+            APP_PORT=${{ matrix.app_port }}
+          tags: ${{ steps.meta.outputs.tags }}
+          labels: ${{ steps.meta.outputs.labels }}

.gitignore

@@ -7,3 +7,7 @@ dist-newstyle/
 
 cabal.project.local
 cabal.project.local~
+
+.hpc/
+*.tix
+.coverage

Dockerfile

@@ -0,0 +1,62 @@
+ARG TAG=22.04
+
+FROM ubuntu:${TAG} AS build
+
+### Build stage
+
+# Install curl and git and simplexmq dependencies
+RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-12 llvm-12-dev libnuma-dev
+
+# Specify bootstrap Haskell versions
+ENV BOOTSTRAP_HASKELL_GHC_VERSION=8.10.7
+ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.6.2.0
+
+# Install ghcup
+RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+
+# Adjust PATH
+ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
+
+# Set both as default
+RUN ghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" && \
+    ghcup set cabal
+
+COPY . /project
+WORKDIR /project
+
+ARG APP
+ARG APP_PORT
+RUN if [ -z "$APP" ] || [ -z "$APP_PORT" ]; then printf "Please spcify \$APP and \$APP_PORT build-arg.\n"; exit 1; fi
+
+# Compile app
+RUN cabal update
+RUN cabal build exe:$APP
+
+# Create new path containing all files needed
+RUN mkdir /final
+WORKDIR /final
+
+# Strip the binary from debug symbols to reduce size
+RUN bin=$(find /project/dist-newstyle -name "$APP" -type f -executable) && \
+    mv "$bin" ./ && \
+    strip ./"$APP" &&\
+    mv /project/scripts/docker/entrypoint-"$APP" ./entrypoint
+
+### Final stage
+FROM ubuntu:${TAG}
+
+# Install OpenSSL dependency
+RUN apt-get update && apt-get install -y openssl libnuma-dev
+
+# Copy compiled app from build stage
+COPY --from=build /final /usr/local/bin/
+
+# Open app listening port
+ARG APP_PORT
+EXPOSE $APP_PORT
+
+# simplexmq requires using SIGINT to correctly preserve undelivered messages and restore them on restart
+STOPSIGNAL SIGINT
+
+# Finally, execute helper script
+ENTRYPOINT [ "/usr/local/bin/entrypoint" ]

README.md

@@ -90,11 +90,11 @@ You can either run your own SMP server locally or deploy using [Linode StackScri
 
 It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI.
 
-## Deploy SMP server on Linux
+## Deploy SMP/XFTP servers on Linux
 
-You can run your SMP server as a Linux process, optionally using a service manager for booting and restarts.
+You can run your SMP/XFTP server as a Linux process, optionally using a service manager for booting and restarts.
 
-Notice that `smp-server` requires `openssl` as run-time dependency (it is used to generate server certificates during initialization). Install it with your packet manager:
+Notice that `smp-server` and `xftp-server` requires `openssl` as run-time dependency (it is used to generate server certificates during initialization). Install it with your packet manager:
 
 ```sh
 # For Ubuntu
@@ -105,28 +105,53 @@ apt update && apt install openssl
 
 #### Using Docker
 
-On Linux, you can deploy smp server using Docker. This will download image from [Docker Hub](https://hub.docker.com/r/simplexchat/simplexmq).
+On Linux, you can deploy smp and xftp server using Docker. This will download image from [Docker Hub](https://hub.docker.com/r/simplexchat).
 
-1. Create `config` and `logs` directories:
+1. Create directories for persistent Docker configuration:
 
    ```sh
-   mkdir -p ~/simplex/{config,logs}
+   mkdir -p $HOME/simplex/{xftp,smp}/{config,logs} && mkdir -p $HOME/simplex/xftp/files
    ```
 
-2. Run your Docker container. You must change **your_ip_or_domain**. `-e "pass=password"` is optional variable to password-protect your `smp` server:
-   ```sh
-   docker run -d \
-       -e "addr=your_ip_or_domain" \
-       -e "pass=password" \
-       -p 5223:5223 \
-       -v $HOME/simplex/config:/etc/opt/simplex:z \
-       -v $HOME/simplex/logs:/var/opt/simplex:z \
-       simplexchat/simplexmq:latest
-   ```
+2. Run your Docker container.
 
-#### Ubuntu
+   - `smp-server`
+   
+     You must change **your_ip_or_domain**. `-e "pass=password"` is optional variable to password-protect your `smp` server:
+     ```sh
+     docker run -d \
+         -e "ADDR=your_ip_or_domain" \
+         -e "PASS=password" \
+         -p 5223:5223 \
+         -v $HOME/simplex/smp/config:/etc/opt/simplex:z \
+         -v $HOME/simplex/smp/logs:/var/opt/simplex:z \
+         simplexchat/smp-server:latest
+     ```
 
-For Ubuntu you can download a binary from [the latest release](https://github.com/simplex-chat/simplexmq/releases).
+   - `xftp-server`
+   
+     You must change **your_ip_or_domain** and **maximum_storage**.
+     ```sh
+     docker run -d \
+         -e "ADDR=your_ip_or_domain" \
+         -e "QUOTA=maximum_storage" \
+         -p 443:443 \
+         -v $HOME/simplex/xftp/config:/etc/opt/simplex-xftp:z \
+         -v $HOME/simplex/xftp/logs:/var/opt/simplex-xftp:z \
+         -v $HOME/simplex/xftp/files:/srv/xftp:z \
+         simplexchat/xftp-server:latest
+     ```
+
+#### Using installation script
+
+**Please note** that currently, only Ubuntu distribution is supported.
+
+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 '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
 
@@ -136,31 +161,50 @@ For Ubuntu you can download a binary from [the latest release](https://github.co
 
 On Linux, you can build smp server using Docker.
 
-1. Build your `smp-server` image:
+1. Build your images:
 
    ```sh
    git clone https://github.com/simplex-chat/simplexmq
    cd simplexmq
    git checkout stable
-   DOCKER_BUILDKIT=1 docker build -t smp-server -f ./build.Dockerfile .
+   DOCKER_BUILDKIT=1 docker build -t local/smp-server --build-arg APP="smp-server" --build-arg APP_PORT="5223" . # For xmp-server
+   DOCKER_BUILDKIT=1 docker build -t local/xftp-server --build-arg APP="xftp-server" --build-arg APP_PORT="443" . # For xftp-server
    ```
 
-2. Create `config` and `logs` directories:
+2. Create directories for persistent Docker configuration:
 
    ```sh
-   mkdir -p ~/simplex/{config,logs}
+   mkdir -p $HOME/simplex/{xftp,smp}/{config,logs} && mkdir -p $HOME/simplex/xftp/files
    ```
 
-3. Run your Docker container. You must change **your_ip_or_domain**. `-e pass="password"` is optional variable to password-protect your `smp` server::
-   ```sh
-   docker run -d \
-       -e "addr=your_ip_or_domain" \
-       -e "pass=password" \
-       -p 5223:5223 \
-       -v $HOME/simplex/config:/etc/opt/simplex:z \
-       -v $HOME/simplex/logs:/var/opt/simplex:z \
-       smp-server
-   ```
+3. Run your Docker container.
+
+   - `smp-server`
+   
+     You must change **your_ip_or_domain**. `-e "pass=password"` is optional variable to password-protect your `smp` server:
+     ```sh
+     docker run -d \
+         -e "ADDR=your_ip_or_domain" \
+         -e "PASS=password" \
+         -p 5223:5223 \
+         -v $HOME/simplex/smp/config:/etc/opt/simplex:z \
+         -v $HOME/simplex/smp/logs:/var/opt/simplex:z \
+         simplexchat/smp-server:latest
+     ```
+
+   - `xftp-server`
+   
+     You must change **your_ip_or_domain** and **maximum_storage**.
+     ```sh
+     docker run -d \
+         -e "ADDR=your_ip_or_domain" \
+         -e "QUOTA=maximum_storage" \
+         -p 443:443 \
+         -v $HOME/simplex/xftp/config:/etc/opt/simplex-xftp:z \
+         -v $HOME/simplex/xftp/logs:/var/opt/simplex-xftp:z \
+         -v $HOME/simplex/xftp/files:/srv/xftp:z \
+         simplexchat/xftp-server:latest
+     ```
 
 #### Using your distribution
 

build.Dockerfile

@@ -1,46 +0,0 @@
-FROM ubuntu:focal AS final
-FROM ubuntu:focal AS build
-
-### Build stage
-
-# Install curl and git and smp-related dependencies
-RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm llvm-dev libnuma-dev
-
-# Install ghcup
-RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_GHC_VERSION=8.10.7 BOOTSTRAP_HASKELL_CABAL_VERSION=3.6.2.0 sh
-
-# Adjust PATH
-ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
-
-# Set both as default
-RUN ghcup set ghc 8.10.7 && \
-    ghcup set cabal
-
-COPY . /project
-WORKDIR /project
-
-# Compile smp-server
-RUN cabal update
-RUN cabal install
-
-### Final stage
-
-FROM final
-
-# Install OpenSSL dependency
-RUN apt-get update && apt-get install -y openssl libnuma-dev
-
-# Copy compiled smp-server from build stage
-COPY --from=build /root/.cabal/bin/smp-server /usr/bin/smp-server
-
-# Copy our helper script
-COPY ./scripts/docker/entrypoint /usr/bin/entrypoint
-
-# Open smp-server listening port
-EXPOSE 5223
-
-# SimpleX requires using SIGINT to correctly preserve undelivered messages and restore them on restart
-STOPSIGNAL SIGINT
-
-# Finally, execute helper script
-ENTRYPOINT [ "/usr/bin/entrypoint" ]

download.Dockerfile

@@ -1,20 +0,0 @@
-FROM ubuntu:focal
-
-# Install curl
-RUN apt-get update && apt-get install -y curl
-
-# Download latest smp-server release and assign executable permission
-RUN curl -L https://github.com/simplex-chat/simplexmq/releases/latest/download/smp-server-ubuntu-20_04-x86-64 -o /usr/bin/smp-server && \
-	chmod +x /usr/bin/smp-server
-
-# Copy our helper script
-COPY ./scripts/docker/entrypoint /usr/bin/entrypoint
-
-# Open smp-server listening port
-EXPOSE 5223
-
-# SimpleX requires using SIGINT to correctly preserve undelivered messages and restore them on restart
-STOPSIGNAL SIGINT
-
-# Finally, execute helper script
-ENTRYPOINT [ "/usr/bin/entrypoint" ]

install.sh

@@ -0,0 +1,144 @@
+#!/usr/bin/env sh
+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"
+scripts_systemd_xftp="$scripts/xftp-server.service"
+scripts_update="$scripts/simplex-servers-update"
+scripts_uninstall="$scripts/simplex-servers-uninstall"
+scripts_stopscript="$scripts/simplex-servers-stopscript"
+
+# Default installation paths
+path_bin="/usr/local/bin"
+path_bin_smp="$path_bin/smp-server"
+path_bin_xftp="$path_bin/xftp-server"
+path_bin_update="$path_bin/simplex-servers-update"
+path_bin_uninstall="$path_bin/simplex-servers-uninstall"
+path_bin_stopscript="$path_bin/simplex-servers-stopscript"
+
+path_conf_etc="/etc/opt"
+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_systemd="/etc/systemd/system"
+path_systemd_smp="$path_systemd/smp-server.service"
+path_systemd_xftp="$path_systemd/xftp-server.service"
+
+# Defaut users
+user_smp="smp"
+user_xftp="xftp"
+
+GRN='\033[0;32m'
+BLU='\033[1;34m'
+YLW='\033[1;33m'
+RED='\033[0;31m'
+NC='\033[0m'
+
+logo='
+ ____  _                 _     __  __
+/ ___|(_)_ __ ___  _ __ | | ___\ \/ /
+\___ \| | '"'"'_ ` _ \| '"'"'_ \| |/ _ \\  / 
+ ___) | | | | | | | |_) | |  __//  \ 
+|____/|_|_| |_| |_| .__/|_|\___/_/\_\
+                  |_|                            
+'
+
+welcome="Welcome to SMP/XFTP installation script! Here's what we're going to do:
+${GRN}1.${NC} Install latest binaries from GitHub releases:
+    - smp: ${YLW}${path_bin_smp}${NC}
+    - xftp: ${YLW}${path_bin_xftp}${NC}
+${GRN}2.${NC} Create server directories:
+    - smp: ${YLW}${path_conf_smp}${NC}
+    - xftp: ${YLW}${path_conf_xftp}${NC}
+${GRN}3.${NC} Setup user for each server:
+    - xmp: ${YLW}${user_smp}${NC}
+    - xftp: ${YLW}${user_xftp}${NC}
+${GRN}4.${NC} Create systemd services:
+    - smp: ${YLW}${path_systemd_smp}${NC}
+    - xftp: ${YLW}${path_systemd_xftp}${NC}
+${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 or ${RED}Ctrl+C${NC} to cancel installation"
+
+end="Installtion is complete!
+
+Please checkout our server guides:
+- smp: ${GRN}https://simplex.chat/docs/server.html${NC}
+- xftp: ${GRN}https://simplex.chat/docs/xftp-server.html${NC}
+
+To uninstall with full clean-up, simply run: ${YLW}sudo /usr/local/bin/simplex-servers-uninstall${NC}
+"
+
+setup_bins() {
+ 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() {
+ 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
+ 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() {
+ 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() {
+ curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_update" -o "$path_bin_update" && chmod +x "$path_bin_update"
+ curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_uninstall" -o "$path_bin_uninstall" && chmod +x "$path_bin_uninstall"
+ curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_stopscript" -o "$path_bin_stopscript" && chmod +x "$path_bin_stopscript"
+ }
+
+checks() {
+ if [ "$(id -u)" -ne 0 ]; then
+  printf "This script is intended to be run with root privileges. Please re-run script using sudo."
+  exit 1
+ fi
+}
+
+main() {
+ checks
+ 
+ printf "%b\n%b\n" "${BLU}$logo${NC}" "$welcome"
+ read ans
+
+ printf "Installing binaries..."
+ setup_bins
+ printf "${GRN} Done!${NC}\n"
+
+ printf "Creating users..."
+ setup_users
+ printf "${GRN} Done!${NC}\n"
+ 
+ printf "Creating directories..."
+ setup_dirs
+ printf "${GRN} Done!${NC}\n"
+
+ printf "Creating systemd services..."
+ setup_systemd
+ printf "${GRN} Done!${NC}\n"
+
+ printf "Installing stopscript, update and uninstallation script..."
+ setup_scripts
+ printf "${GRN} Done!${NC}\n"
+
+ printf "%b" "$end"
+}
+
+main

package.yaml

@@ -1,5 +1,5 @@
 name: simplexmq
-version: 5.0.0
+version: 5.1.2
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,

scripts/docker/entrypoint

@@ -1,29 +0,0 @@
-#!/usr/bin/env sh
-confd="/etc/opt/simplex"
-logd="/var/opt/simplex/"
-
-# Check if server has been initialized
-if [ ! -f "$confd/smp-server.ini" ]; then
-  # If not, determine ip or domain
-  case $addr in
-    '') printf "Please specify \$addr environment variable.\n"; exit 1 ;;
-    *[a-zA-Z]*) set -- -n $addr ;;
-    *) set -- --ip $addr ;;
-  esac
-
-  case $pass in
-    '') set -- "$@" --no-password ;;
-    *) set -- "$@" --password $pass ;;
-  esac
-
-  smp-server init -y -l "$@"
-fi
-
-# backup store log
-[ -f "$logd/smp-server-store.log" ] && cp "$logd"/smp-server-store.log "$logd"/smp-server-store.log.bak
-# rotate server log
-[ -f "$logd/smp-server.log" ] && mv "$logd"/smp-server.log "$logd"/smp-server-"$(date +'%FT%T')".log
-
-# Finally, run smp-sever. Notice that "exec" here is important:
-# smp-server replaces our helper script, so that it can catch INT signal
-exec smp-server start > "$logd"/smp-server.log 2>&1

scripts/docker/entrypoint-smp-server

@@ -0,0 +1,48 @@
+#!/usr/bin/env sh
+confd='/etc/opt/simplex'
+logd='/var/opt/simplex/'
+
+# Check if server has been initialized
+if [ ! -f "${confd}/smp-server.ini" ]; then
+  # If not, determine ip or domain
+  case "${ADDR}" in
+    '') printf 'Please specify $ADDR environment variable.\n'; exit 1 ;;
+    *[a-zA-Z]*)
+      case "${ADDR}" in
+        *:*) set -- --ip "${ADDR}" ;;
+        *) set -- -n "${ADDR}" ;;
+      esac
+      ;;
+    *) set -- --ip "${ADDR}" ;;
+  esac
+
+  # Optionally, set password
+  case "${PASS}" in
+    '') set -- "$@" --no-password ;;
+    *) set -- "$@" --password "${PASS}" ;;
+  esac
+
+  # And init certificates and configs
+  smp-server init -y -l "$@"
+fi
+
+# Backup store log just in case
+#
+# Uses the UTC (universal) time zone and this
+# format: YYYY-mm-dd'T'HH:MM:SS
+# year, month, day, letter T, hour, minute, second
+#
+# This is the ISO 8601 format without the time zone at the end.
+#
+_file="${logd}/smp-server-store.log"
+if [ -f "${_file}" ]; then
+  _backup_extension="$(date -u '+%Y-%m-%dT%H:%M:%S')"
+  cp -v -p "${_file}" "${_file}.${_backup_extension:-date-failed}"
+  unset -v _backup_extension
+fi
+unset -v _file
+
+# Finally, run smp-sever. Notice that "exec" here is important:
+# smp-server replaces our helper script, so that it can catch INT signal
+exec smp-server start +RTS -N -RTS
+

scripts/docker/entrypoint-xftp-server

@@ -0,0 +1,48 @@
+#!/usr/bin/env sh
+confd='/etc/opt/simplex-xftp'
+logd='/var/opt/simplex-xftp'
+
+# Check if server has been initialized
+if [ ! -f "${confd}/file-server.ini" ]; then
+  # If not, determine ip or domain
+  case "${ADDR}" in
+    '') printf 'Please specify $ADDR environment variable.\n'; exit 1 ;;
+    *[a-zA-Z]*)
+      case "${ADDR}" in
+        *:*) set -- --ip "${ADDR}" ;;
+        *) set -- -n "${ADDR}" ;;
+      esac
+      ;;
+    *) set -- --ip "${ADDR}" ;;
+  esac
+
+  # Set quota
+  case "${QUOTA}" in
+    '') printf 'Please specify $QUOTA environment variable.\n'; exit 1 ;;
+    *) set -- "$@" --quota "${QUOTA}" ;;
+  esac
+
+  # Init the certificates and configs
+  xftp-server init -l -p /srv/xftp "$@"
+fi
+
+# Backup store log just in case
+#
+# Uses the UTC (universal) time zone and this
+# format: YYYY-mm-dd'T'HH:MM:SS
+# year, month, day, letter T, hour, minute, second
+#
+# This is the ISO 8601 format without the time zone at the end.
+#
+_file="${logd}/file-server-store.log"
+if [ -f "${_file}" ]; then
+  _backup_extension="$(date -u '+%Y-%m-%dT%H:%M:%S')"
+  cp -v -p "${_file}" "${_file}.${_backup_extension:-date-failed}"
+  unset -v _backup_extension
+fi
+unset -v _file
+
+# Finally, run xftp-sever. Notice that "exec" here is important:
+# smp-server replaces our helper script, so that it can catch INT signal
+exec xftp-server start +RTS -N -RTS
+

scripts/main/simplex-servers-stopscript

@@ -0,0 +1,30 @@
+#!/usr/bin/env sh
+set -eu
+
+path_conf_var="/var/opt"
+path_conf_smp="$path_conf_var/simplex"
+path_conf_xftp="$path_conf_var/simplex-xftp"
+path_conf_storelog_smp="$path_conf_smp/smp-server-store.log"
+path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log"
+date="$(date -u '+%Y-%m-%dT%H:%M:%S')"
+
+backup_smp() {
+ if [ -e "$path_conf_storelog_smp" ]; then
+  cp "$path_conf_storelog_smp" "${path_conf_storelog_smp}.${date:-date-failed}"
+ fi
+}
+
+backup_xftp() {
+ if [ -e "$path_conf_storelog_xftp" ]; then
+  cp "$path_conf_storelog_xftp" "${path_conf_storelog_xftp}.${date:-date-failed}"
+ fi
+}
+
+if [ "$1" = 'smp-server' ]; then
+ backup_smp
+elif [ "$1" = 'xftp-server' ]; then
+ backup_xftp
+else
+ backup_smp
+ backup_xftp
+fi

scripts/main/simplex-servers-uninstall

@@ -0,0 +1,23 @@
+#!/usr/bin/env sh
+set -eu
+
+GRN='\033[0;32m'
+RED='\033[0;31m'
+NC='\033[0m'
+
+if [ "$(id -u)" -ne 0 ]; then
+  printf "This script is intended to be run with root privileges. Please re-run script using sudo."
+  exit 1
+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 stop smp-server
+systemctl stop xftp-server
+
+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 && userdel xftp
+
+printf "Uninstallation is complete! Thanks for trying out SimpleX!\n"

scripts/main/simplex-servers-update

@@ -0,0 +1,174 @@
+#!/usr/bin/env sh
+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"
+scripts_systemd_xftp="$scripts/xftp-server.service"
+scripts_update="$scripts/simplex-servers-update"
+scripts_uninstall="$scripts/simplex-servers-uninstall"
+scripts_stopscript="$scripts/simplex-servers-stopscript"
+
+# Default installation paths
+path_bin="/usr/local/bin"
+path_bin_smp="$path_bin/smp-server"
+path_bin_xftp="$path_bin/xftp-server"
+path_bin_update="$path_bin/simplex-servers-update"
+path_bin_uninstall="$path_bin/simplex-servers-uninstall"
+path_bin_stopscript="$path_bin/simplex-servers-stopscript"
+
+path_systemd="/etc/systemd/system"
+path_systemd_smp="$path_systemd/smp-server.service"
+path_systemd_xftp="$path_systemd/xftp-server.service"
+
+# Temporary paths
+path_tmp_bin="$(mktemp -d)"
+path_tmp_bin_update="$path_tmp_bin/simplex-servers-update"
+path_tmp_bin_uninstall="$path_tmp_bin/simplex-servers-uninstall"
+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"
+
+GRN='\033[0;32m'
+BLU='\033[1;36m'
+YLW='\033[1;33m'
+RED='\033[0;31m'
+NC='\033[0m'
+
+# Currently, XFTP default to v0.1.0, so it doesn't make sense to check its version
+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"
+  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_uninstall" -o "$path_tmp_bin_uninstall" && chmod +x "$path_tmp_bin_uninstall"
+  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_stopscript" -o "$path_tmp_bin_stopscript" && chmod +x "$path_tmp_bin_stopscript"
+
+  if diff -q "$path_bin_uninstall" "$path_tmp_bin_uninstall" > /dev/null 2>&1; then
+    printf -- "- ${YLW}Uninstall script is up-to-date${NC}.\n"
+    rm "$path_tmp_bin_uninstall"
+  else
+    printf -- "- Updating uninstall script..."
+    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"
+  else
+    printf -- "- Updating stopscript script..."
+    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"
+  else
+    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..."
+    exec sh "$path_bin_update" "continue"
+  fi
+}
+
+update_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_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 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
+}
+
+update_bins() {
+  if [ "$local_version" != "$remote_version" ]; then
+    if systemctl is-active --quiet smp-server; then
+      printf -- "- Stopping smp-server service..."
+      systemctl stop smp-server
+      printf "${GRN}Done!${NC}\n"
+
+      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 smp-server service..."
+      systemctl start smp-server
+      printf "${GRN}Done!${NC}\n"
+    else
+      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}smp-server and xftp-server binaries is up-to-date${NC}.\n"
+  fi
+}
+
+checks() {
+  if [ "$(id -u)" -ne 0 ]; then
+    printf "This script is intended to be run with root privileges. Please re-run script using sudo.\n"
+    exit 1
+  fi
+}
+
+main() {
+  checks
+
+  set +u
+  if [ "$1" != "continue" ]; then
+    set -u
+    printf "Updating scripts...\n"
+    update_scripts
+  else
+    set -u
+    printf "${GRN}Done!${NC}\n"
+  fi
+
+  printf "Updating systemd services...\n"
+  update_systemd
+  
+  printf "Updating simplex server binaries...\n"
+  update_bins
+
+  rm -rf "$path_tmp_bin"
+}
+
+main "$@"

scripts/main/smp-server.service

@@ -0,0 +1,15 @@
+[Unit]
+Description=SMP server
+
+[Service]
+User=smp
+Group=smp
+Type=simple
+ExecStart=/usr/local/bin/smp-server start +RTS -N -RTS 
+ExecStopPost=/usr/local/bin/simplex-servers-stopscript smp-server
+LimitNOFILE=65535
+KillSignal=SIGINT
+TimeoutStopSec=infinity
+
+[Install]
+WantedBy=multi-user.target

scripts/main/xftp-server.service

@@ -0,0 +1,16 @@
+[Unit]
+Description=XFTP server
+
+[Service]
+User=xftp
+Group=xftp
+Type=simple
+ExecStart=/usr/local/bin/xftp-server start +RTS -N -RTS
+ExecStopPost=/usr/local/bin/simplex-servers-stopscript xftp-server
+LimitNOFILE=65535
+KillSignal=SIGINT
+TimeoutStopSec=infinity
+AmbientCapabilities=CAP_NET_BIND_SERVICE
+   
+[Install]
+WantedBy=multi-user.target

simplexmq.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        5.0.0
+version:        5.1.2
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -80,6 +80,9 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
       Simplex.Messaging.Agent.TAsyncs
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client

src/Simplex/FileTransfer/Agent.hs

@@ -66,7 +66,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (EntityId, XFTPServer, XFTPServerWithAuth)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (liftError, liftIOEither, tshow, whenM)
+import Simplex.Messaging.Util (liftError, liftIOEither, tshow, unlessM, whenM)
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
 import UnliftIO.Concurrent
@@ -273,9 +273,9 @@ runXFTPRcvLocalWorker c doWork = do
         getChunkPaths (RcvFileChunk {chunkTmpPath = Nothing} : _cs) =
           throwError $ INTERNAL "no chunk path"
 
-deleteRcvFile :: AgentMonad m => AgentClient -> UserId -> RcvFileId -> m ()
-deleteRcvFile c userId rcvFileEntityId = do
-  RcvFile {rcvFileId, prefixPath, status} <- withStore c $ \db -> getRcvFileByEntityId db userId rcvFileEntityId
+deleteRcvFile :: AgentMonad m => AgentClient -> RcvFileId -> m ()
+deleteRcvFile c rcvFileEntityId = do
+  RcvFile {rcvFileId, prefixPath, status} <- withStore c $ \db -> getRcvFileByEntityId db rcvFileEntityId
   if status == RFSComplete || status == RFSError
     then do
       removePath prefixPath
@@ -415,7 +415,7 @@ runXFTPSndPrepareWorker c doWork = do
         createChunk :: Int -> SndFileChunk -> m ()
         createChunk numRecipients' ch = do
           atomically $ assertAgentForeground c
-          (replica, ProtoServerWithAuth srv _) <- agentOperationBracket c AOSndNetwork throwWhenInactive tryCreate
+          (replica, ProtoServerWithAuth srv _) <- tryCreate
           withStore' c $ \db -> createSndFileReplica db ch replica
           addXFTPSndWorker c $ Just srv
           where
@@ -445,7 +445,7 @@ runXFTPSndWorker c srv doWork = do
   forever $ do
     void . atomically $ readTMVar doWork
     atomically $ assertAgentForeground c
-    agentOperationBracket c AOSndNetwork throwWhenInactive runXFTPOperation
+    runXFTPOperation
   where
     noWorkToDo = void . atomically $ tryTakeTMVar doWork
     runXFTPOperation :: m ()
@@ -475,6 +475,7 @@ runXFTPSndWorker c srv doWork = do
     uploadFileChunk sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath}, digest = chunkDigest} replica = do
       replica'@SndFileChunkReplica {sndChunkReplicaId} <- addRecipients sndFileChunk replica
       fsFilePath <- toFSFilePath filePath
+      unlessM (doesFileExist fsFilePath) $ throwError $ INTERNAL "encrypted file doesn't exist on upload"
       let chunkSpec' = chunkSpec {filePath = fsFilePath} :: XFTPChunkSpec
       atomically $ assertAgentForeground c
       agentXFTPUploadChunk c userId chunkDigest replica' chunkSpec'
@@ -567,9 +568,9 @@ runXFTPSndWorker c srv doWork = do
         chunkUploaded SndFileChunk {replicas} =
           any (\SndFileChunkReplica {replicaStatus} -> replicaStatus == SFRSUploaded) replicas
 
-deleteSndFileInternal :: AgentMonad m => AgentClient -> UserId -> SndFileId -> m ()
-deleteSndFileInternal c userId sndFileEntityId = do
-  SndFile {sndFileId, prefixPath, status} <- withStore c $ \db -> getSndFileByEntityId db userId sndFileEntityId
+deleteSndFileInternal :: AgentMonad m => AgentClient -> SndFileId -> m ()
+deleteSndFileInternal c sndFileEntityId = do
+  SndFile {sndFileId, prefixPath, status} <- withStore c $ \db -> getSndFileByEntityId db sndFileEntityId
   if status == SFSComplete || status == SFSError
     then do
       forM_ prefixPath $ removePath <=< toFSFilePath
@@ -578,7 +579,7 @@ deleteSndFileInternal c userId sndFileEntityId = do
 
 deleteSndFileRemote :: forall m. AgentMonad m => AgentClient -> UserId -> SndFileId -> ValidFileDescription 'FSender -> m ()
 deleteSndFileRemote c userId sndFileEntityId (ValidFileDescription FileDescription {chunks}) = do
-  deleteSndFileInternal c userId sndFileEntityId `catchError` (notify c sndFileEntityId . SFERR)
+  deleteSndFileInternal c sndFileEntityId `catchError` (notify c sndFileEntityId . SFERR)
   forM_ chunks $ \ch -> deleteFileChunk ch `catchError` (notify c sndFileEntityId . SFERR)
   where
     deleteFileChunk :: FileChunk -> m ()

src/Simplex/FileTransfer/Server/Env.hs

@@ -68,10 +68,13 @@ data XFTPEnv = XFTPEnv
     serverStats :: FileServerStats
   }
 
+defFileExpirationHours :: Int64
+defFileExpirationHours = 48
+
 defaultFileExpiration :: ExpirationConfig
 defaultFileExpiration =
   ExpirationConfig
-    { ttl = 48 * 3600, -- seconds, 48 hours
+    { ttl = defFileExpirationHours * 3600, -- seconds
       checkInterval = 2 * 3600 -- seconds, 2 hours
     }
 

src/Simplex/FileTransfer/Server/Main.hs

@@ -18,11 +18,12 @@ import Network.Socket (HostName)
 import Options.Applicative
 import Simplex.FileTransfer.Description (FileSize (..), kb, mb)
 import Simplex.FileTransfer.Server (runXFTPServer)
-import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration)
+import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration, defFileExpirationHours)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
 import Simplex.Messaging.Server.CLI
+import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
@@ -30,7 +31,7 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)
 
 xftpServerVersion :: String
-xftpServerVersion = "0.1.0"
+xftpServerVersion = "1.0.0"
 
 xftpServerCLI :: FilePath -> FilePath -> IO ()
 xftpServerCLI cfgPath logPath = do
@@ -76,6 +77,8 @@ xftpServerCLI cfgPath logPath = do
           \# and restoring it when the server is started.\n\
           \# Log is compacted on start (deleted objects are removed).\n"
             <> ("enable: " <> onOff enableStoreLog <> "\n\n")
+            <> "# Expire files after the specified number of hours.\n"
+            <> ("expire_files_hours: " <> show defFileExpirationHours <> "\n\n")
             <> "log_stats: off\n\
                \\n\
                \[AUTH]\n\
@@ -113,10 +116,13 @@ xftpServerCLI cfgPath logPath = do
         enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
         logStats = settingIsOn "STORE_LOG" "log_stats" ini
         c = combine cfgPath . ($ defaultX509Config)
-        printXFTPConfig XFTPServerConfig {allowNewFiles, newFileBasicAuth, xftpPort, storeLogFile} = do
+        printXFTPConfig XFTPServerConfig {allowNewFiles, newFileBasicAuth, xftpPort, storeLogFile, fileExpiration} = do
           putStrLn $ case storeLogFile of
             Just f -> "Store log: " <> f
             _ -> "Store log disabled."
+          putStrLn $ case fileExpiration of
+            Just ExpirationConfig {ttl} -> "expiring files after " <> showTTL ttl
+            _ -> "not expiring files"
           putStrLn $
             "Uploading new files "
               <> if allowNewFiles
@@ -134,7 +140,10 @@ xftpServerCLI cfgPath logPath = do
               allowedChunkSizes = [kb 256, mb 1, mb 4],
               allowNewFiles = fromMaybe True $ iniOnOff "AUTH" "new_files" ini,
               newFileBasicAuth = either error id <$> strDecodeIni "AUTH" "create_password" ini,
-              fileExpiration = Just defaultFileExpiration,
+              fileExpiration =
+                Just defaultFileExpiration
+                  { ttl = 3600 * readIniDefault defFileExpirationHours "STORE_LOG" "expire_files_hours" ini
+                  },
               caCertificateFile = c caCrtFile,
               privateKeyFile = c serverKeyFile,
               certificateFile = c serverCrtFile,

src/Simplex/Messaging/Agent.hs

@@ -63,6 +63,7 @@ module Simplex.Messaging.Agent
     sendMessage,
     ackMessage,
     switchConnection,
+    abortConnectionSwitch,
     suspendConnection,
     deleteConnection,
     deleteConnections,
@@ -110,7 +111,7 @@ import Data.Composition ((.:), (.:.), (.::))
 import Data.Foldable (foldl')
 import Data.Functor (($>))
 import Data.List (find)
-import Data.List.NonEmpty (NonEmpty (..), (<|))
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -204,7 +205,7 @@ ackMessageAsync :: forall m. AgentErrorMonad m => AgentClient -> ACorrId -> Conn
 ackMessageAsync c = withAgentEnv c .:. ackMessageAsync' c
 
 -- | Switch connection to the new receive queue
-switchConnectionAsync :: AgentErrorMonad m => AgentClient -> ACorrId -> ConnId -> m ()
+switchConnectionAsync :: AgentErrorMonad m => AgentClient -> ACorrId -> ConnId -> m ConnectionStats
 switchConnectionAsync c = withAgentEnv c .: switchConnectionAsync' c
 
 -- | Delete SMP agent connection (DEL command) asynchronously, no synchronous response
@@ -268,6 +269,10 @@ ackMessage c = withAgentEnv c .: ackMessage' c
 switchConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ConnectionStats
 switchConnection c = withAgentEnv c . switchConnection' c
 
+-- | Abort switching connection to the new receive queue
+abortConnectionSwitch :: AgentErrorMonad m => AgentClient -> ConnId -> m ConnectionStats
+abortConnectionSwitch c = withAgentEnv c . abortConnectionSwitch' c
+
 -- | Suspend SMP agent connection (OFF command)
 suspendConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
 suspendConnection c = withAgentEnv c . suspendConnection' c
@@ -345,16 +350,16 @@ xftpReceiveFile :: AgentErrorMonad m => AgentClient -> UserId -> ValidFileDescri
 xftpReceiveFile c = withAgentEnv c .: receiveFile c
 
 -- | Delete XFTP rcv file (deletes work files from file system and db records)
-xftpDeleteRcvFile :: AgentErrorMonad m => AgentClient -> UserId -> RcvFileId -> m ()
-xftpDeleteRcvFile c = withAgentEnv c .: deleteRcvFile c
+xftpDeleteRcvFile :: AgentErrorMonad m => AgentClient -> RcvFileId -> m ()
+xftpDeleteRcvFile c = withAgentEnv c . deleteRcvFile c
 
 -- | Send XFTP file
 xftpSendFile :: AgentErrorMonad m => AgentClient -> UserId -> FilePath -> Int -> m SndFileId
 xftpSendFile c = withAgentEnv c .:. sendFile c
 
 -- | Delete XFTP snd file internally (deletes work files from file system and db records)
-xftpDeleteSndFileInternal :: AgentErrorMonad m => AgentClient -> UserId -> SndFileId -> m ()
-xftpDeleteSndFileInternal c = withAgentEnv c .: deleteSndFileInternal c
+xftpDeleteSndFileInternal :: AgentErrorMonad m => AgentClient -> SndFileId -> m ()
+xftpDeleteSndFileInternal c = withAgentEnv c . deleteSndFileInternal c
 
 -- | Delete XFTP snd file chunks on servers
 xftpDeleteSndFileRemote :: AgentErrorMonad m => AgentClient -> UserId -> SndFileId -> ValidFileDescription 'FSender -> m ()
@@ -524,11 +529,18 @@ deleteConnectionsAsync_ onSuccess c connIds = case connIds of
         deleteConnQueues c True rqs >> onSuccess
 
 -- | Add connection to the new receive queue
-switchConnectionAsync' :: AgentMonad m => AgentClient -> ACorrId -> ConnId -> m ()
+switchConnectionAsync' :: AgentMonad m => AgentClient -> ACorrId -> ConnId -> m ConnectionStats
 switchConnectionAsync' c corrId connId =
-  withStore c (`getConn` connId) >>= \case
-    SomeConn _ DuplexConnection {} -> enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn SWCH
-    _ -> throwError $ CMD PROHIBITED
+  withConnLock c connId "switchConnectionAsync" $
+    withStore c (`getConn` connId) >>= \case
+      SomeConn _ (DuplexConnection cData rqs@(rq :| _rqs) sqs)
+        | isJust (switchingRQ rqs) -> throwError $ CMD PROHIBITED
+        | otherwise -> do
+          rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSwitchStarted
+          enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn SWCH
+          let rqs' = updatedQs rq1 rqs
+          pure . connectionStats $ DuplexConnection cData rqs' sqs
+      _ -> throwError $ CMD PROHIBITED
 
 newConn :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> m (ConnId, ConnectionRequestUri c)
 newConn c userId connId enableNtfs cMode clientData =
@@ -867,7 +879,12 @@ runCommandProcessing c@AgentClient {subQ} server_ = do
             notify OK
         LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
         ACK msgId -> withServer' . tryCommand $ ackMessage' c connId msgId >> notify OK
-        SWCH -> noServer $ tryCommand $ switchConnection' c connId >>= notify . SWITCH QDRcv SPStarted
+        SWCH ->
+          noServer . tryCommand . withConnLock c connId "switchConnection" $
+            withStore c (`getConn` connId) >>= \case
+              SomeConn _ conn@(DuplexConnection _ (replaced :| _rqs) _) ->
+                switchDuplexConnection c conn replaced >>= notify . SWITCH QDRcv SPStarted
+              _ -> throwError $ CMD PROHIBITED
         DEL -> withServer' . tryCommand $ deleteConnection' c connId >> notify OK
         _ -> notify $ ERR $ INTERNAL $ "unsupported async command " <> show (aCommandTag cmd)
       AInternalCommand cmd -> case cmd of
@@ -887,13 +904,24 @@ runCommandProcessing c@AgentClient {subQ} server_ = do
             enqueueMessage c cData sq SMP.MsgFlags {notification = True} HELLO
         -- ICDeleteConn is no longer used, but it can be present in old client databases
         ICDeleteConn -> withStore' c (`deleteCommand` cmdId)
+        ICDeleteRcvQueue rId -> withServer $ \srv -> tryWithLock "ICDeleteRcvQueue" $ do
+          rq <- withStore c (\db -> getDeletedRcvQueue db connId srv rId)
+          deleteQueue c rq
+          withStore' c (`deleteConnRcvQueue` rq)
         ICQSecure rId senderKey ->
           withServer $ \srv -> tryWithLock "ICQSecure" . withDuplexConn $ \(DuplexConnection cData rqs sqs) ->
             case find (sameQueue (srv, rId)) rqs of
-              Just rq'@RcvQueue {server, sndId, status} -> when (status == Confirmed) $ do
-                secureQueue c rq' senderKey
-                withStore' c $ \db -> setRcvQueueStatus db rq' Secured
-                void . enqueueMessages c cData sqs SMP.noMsgFlags $ QUSE [((server, sndId), True)]
+              Just rq'@RcvQueue {server, sndId, status, dbReplaceQueueId = Just replaceQId} ->
+                case find ((replaceQId ==) . dbQId) rqs of
+                  Just rq1 -> when (status == Confirmed) $ do
+                    secureQueue c rq' senderKey
+                    withStore' c $ \db -> setRcvQueueStatus db rq' Secured
+                    void . enqueueMessages c cData sqs SMP.noMsgFlags $ QUSE [((server, sndId), True)]
+                    rq1' <- withStore' c $ \db -> setRcvSwitchStatus db rq1 $ Just RSSendingQUSE
+                    let rqs' = updatedQs rq1' rqs
+                        conn' = DuplexConnection cData rqs' sqs
+                    notify . SWITCH QDRcv SPSecured $ connectionStats conn'
+                  _ -> internalErr "ICQSecure: no switching queue found"
               _ -> internalErr "ICQSecure: queue address not found in connection"
         ICQDelete rId -> do
           withServer $ \srv -> tryWithLock "ICQDelete" . withDuplexConn $ \(DuplexConnection cData rqs sqs) -> do
@@ -902,13 +930,20 @@ runCommandProcessing c@AgentClient {subQ} server_ = do
               Just (rq'@RcvQueue {primary}, rq'' : rqs')
                 | primary -> internalErr "ICQDelete: cannot delete primary rcv queue"
                 | otherwise -> do
-                  deleteQueue c rq'
-                  withStore' c $ \db -> deleteConnRcvQueue db rq'
-                  when (enableNtfs cData) $ do
-                    ns <- asks ntfSupervisor
-                    atomically $ sendNtfSubCommand ns (connId, NSCCreate)
-                  let conn' = DuplexConnection cData (rq'' :| rqs') sqs
-                  notify $ SWITCH QDRcv SPCompleted $ connectionStats conn'
+                  checkRQSwchStatus rq' RSReceivedMessage
+                  tryError (deleteQueue c rq') >>= \case
+                    Right () -> finalizeSwitch
+                    Left e
+                      | temporaryOrHostError e -> throwError e
+                      | otherwise -> finalizeSwitch >> throwError e
+                where
+                  finalizeSwitch = do
+                    withStore' c $ \db -> deleteConnRcvQueue db rq'
+                    when (enableNtfs cData) $ do
+                      ns <- asks ntfSupervisor
+                      atomically $ sendNtfSubCommand ns (connId, NSCCreate)
+                    let conn' = DuplexConnection cData (rq'' :| rqs') sqs
+                    notify $ SWITCH QDRcv SPCompleted $ connectionStats conn'
               _ -> internalErr "ICQDelete: cannot delete the only queue in connection"
         where
           ack srv rId srvMsgId = do
@@ -1112,9 +1147,11 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {userId, connId, dupl
                 AM_A_MSG_ -> notify $ SENT mId
                 AM_QCONT_ -> pure ()
                 AM_QADD_ -> pure ()
-                AM_QKEY_ -> pure ()
+                AM_QKEY_ -> do
+                  SomeConn _ conn <- withStore c (`getConn` connId)
+                  notify . SWITCH QDSnd SPConfirmed $ connectionStats conn
                 AM_QUSE_ -> pure ()
-                AM_QTEST_ -> do
+                AM_QTEST_ -> withConnLock c connId "runSmpQueueMsgDelivery AM_QTEST_" $ do
                   withStore' c $ \db -> setSndQueueStatus db sq Active
                   SomeConn _ conn <- withStore c (`getConn` connId)
                   case conn of
@@ -1125,9 +1162,10 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {userId, connId, dupl
                         -- this is the same queue where this loop delivers messages to but with updated state
                         Just SndQueue {dbReplaceQueueId = Just replacedId, primary} ->
                           -- second part of this condition is a sanity check because dbReplaceQueueId cannot point to the same queue, see switchConnection'
-                          case removeQP (\sq'@SndQueue {dbQueueId} -> dbQueueId == replacedId && not (sameQueue addr sq')) sqs of
+                          case removeQP (\sq' -> dbQId sq' == replacedId && not (sameQueue addr sq')) sqs of
                             Nothing -> internalErr msgId "sent QTEST: queue not found in connection"
                             Just (sq', sq'' : sqs') -> do
+                              checkSQSwchStatus sq' SSSendingQTEST
                               -- remove the delivery from the map to stop the thread when the delivery loop is complete
                               atomically $ TM.delete (qAddress sq') $ smpQueueMsgQueues c
                               withStore' c $ \db -> do
@@ -1178,21 +1216,54 @@ ackMessage' c connId msgId = withConnLock c connId "ackMessage" $ do
       withStore' c $ \db -> deleteMsg db connId mId
 
 switchConnection' :: AgentMonad m => AgentClient -> ConnId -> m ConnectionStats
-switchConnection' c connId = withConnLock c connId "switchConnection" $ do
-  SomeConn _ conn <- withStore c (`getConn` connId)
-  case conn of
-    DuplexConnection cData@ConnData {userId} rqs@(rq@RcvQueue {server, dbQueueId, sndId} :| rqs_) sqs -> do
-      clientVRange <- asks $ smpClientVRange . config
-      -- try to get the server that is different from all queues, or at least from the primary rcv queue
-      srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
-      srv' <- if srv == server then getNextServer c userId [server] else pure srvAuth
-      (q, qUri) <- newRcvQueue c userId connId srv' clientVRange
-      let rq' = (q :: RcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
-      void . withStore c $ \db -> addConnRcvQueue db connId rq'
-      addSubscription c rq'
-      void . enqueueMessages c cData sqs SMP.noMsgFlags $ QADD [(qUri, Just (server, sndId))]
-      pure . connectionStats $ DuplexConnection cData (rq <| rq' :| rqs_) sqs
-    _ -> throwError $ CMD PROHIBITED
+switchConnection' c connId =
+  withConnLock c connId "switchConnection" $
+    withStore c (`getConn` connId) >>= \case
+      SomeConn _ conn@(DuplexConnection _ rqs@(rq :| _rqs) _)
+        | isJust (switchingRQ rqs) -> throwError $ CMD PROHIBITED
+        | otherwise -> do
+          rq' <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSwitchStarted
+          switchDuplexConnection c conn rq'
+      _ -> throwError $ CMD PROHIBITED
+
+switchDuplexConnection :: AgentMonad m => AgentClient -> Connection 'CDuplex -> RcvQueue -> m ConnectionStats
+switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId} rqs sqs) rq@RcvQueue {server, dbQueueId, sndId} = do
+  checkRQSwchStatus rq RSSwitchStarted
+  clientVRange <- asks $ smpClientVRange . config
+  -- try to get the server that is different from all queues, or at least from the primary rcv queue
+  srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
+  srv' <- if srv == server then getNextServer c userId [server] else pure srvAuth
+  (q, qUri) <- newRcvQueue c userId connId srv' clientVRange
+  let rq' = (q :: RcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
+  void . withStore c $ \db -> addConnRcvQueue db connId rq'
+  addSubscription c rq'
+  void . enqueueMessages c cData sqs SMP.noMsgFlags $ QADD [(qUri, Just (server, sndId))]
+  rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSendingQADD
+  let rqs' = updatedQs rq1 rqs <> [rq']
+  pure . connectionStats $ DuplexConnection cData rqs' sqs
+
+abortConnectionSwitch' :: AgentMonad m => AgentClient -> ConnId -> m ConnectionStats
+abortConnectionSwitch' c connId =
+  withConnLock c connId "abortConnectionSwitch" $
+    withStore c (`getConn` connId) >>= \case
+      SomeConn _ (DuplexConnection cData rqs sqs) -> case switchingRQ rqs of
+        Just rq
+          | canAbortRcvSwitch rq -> do
+            -- multiple queues to which the connections switches were possible when repeating switch was allowed
+            let (delRqs, keepRqs) = L.partition ((Just (dbQId rq) ==) . dbReplaceQId) rqs
+            case L.nonEmpty keepRqs of
+              Just rqs' -> do
+                rq' <- withStore' c $ \db -> do
+                  mapM_ (setRcvQueueDeleted db) delRqs
+                  setRcvSwitchStatus db rq Nothing
+                forM_ delRqs $ \RcvQueue {server, rcvId} -> enqueueCommand c "" connId (Just server) $ AInternalCommand $ ICDeleteRcvQueue rcvId
+                let rqs'' = updatedQs rq' rqs'
+                    conn' = DuplexConnection cData rqs'' sqs
+                pure $ connectionStats conn'
+              _ -> throwError $ INTERNAL "won't delete all rcv queues in connection"
+          | otherwise -> throwError $ CMD PROHIBITED
+        _ -> throwError $ CMD PROHIBITED
+      _ -> throwError $ CMD PROHIBITED
 
 ackQueueMessage :: AgentMonad m => AgentClient -> RcvQueue -> SMP.MsgId -> m ()
 ackQueueMessage c rq srvMsgId =
@@ -1331,11 +1402,11 @@ getConnectionRatchetAdHash' c connId = do
 
 connectionStats :: Connection c -> ConnectionStats
 connectionStats = \case
-  RcvConnection _ rq -> ConnectionStats {rcvServers = [qServer rq], sndServers = []}
-  SndConnection _ sq -> ConnectionStats {rcvServers = [], sndServers = [qServer sq]}
-  DuplexConnection _ rqs sqs -> ConnectionStats {rcvServers = map qServer $ L.toList rqs, sndServers = map qServer $ L.toList sqs}
-  ContactConnection _ rq -> ConnectionStats {rcvServers = [qServer rq], sndServers = []}
-  NewConnection _ -> ConnectionStats {rcvServers = [], sndServers = []}
+  RcvConnection _ rq -> ConnectionStats {rcvQueuesInfo = [rcvQueueInfo rq], sndQueuesInfo = []}
+  SndConnection _ sq -> ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [sndQueueInfo sq]}
+  DuplexConnection _ rqs sqs -> ConnectionStats {rcvQueuesInfo = map rcvQueueInfo $ L.toList rqs, sndQueuesInfo = map sndQueueInfo $ L.toList sqs}
+  ContactConnection _ rq -> ConnectionStats {rcvQueuesInfo = [rcvQueueInfo rq], sndQueuesInfo = []}
+  NewConnection _ -> ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = []}
 
 -- | Change servers to be used for creating new queues, in Reader monad
 setProtocolServers' :: forall p m. (ProtocolTypeI p, UserProtocol p, AgentMonad m) => AgentClient -> UserId -> NonEmpty (ProtoServerWithAuth p) -> m ()
@@ -1601,6 +1672,7 @@ cleanupManager c@AgentClient {subQ} = do
   forever $ do
     void . runExceptT $ do
       deleteConns `catchError` (notify "" . ERR)
+      deleteRcvMsgHashes `catchError` (notify "" . ERR)
       deleteRcvFilesExpired `catchError` (notify "" . RFERR)
       deleteRcvFilesDeleted `catchError` (notify "" . RFERR)
       deleteRcvFilesTmpPaths `catchError` (notify "" . RFERR)
@@ -1614,6 +1686,9 @@ cleanupManager c@AgentClient {subQ} = do
       withLock (deleteLock c) "cleanupManager" $ do
         void $ withStore' c getDeletedConnIds >>= deleteDeletedConns c
         withStore' c deleteUsersWithoutConns >>= mapM_ (notify "" . DEL_USER)
+    deleteRcvMsgHashes = do
+      rcvMsgHashesTTL <- asks $ rcvMsgHashesTTL . config
+      withStore' c (`deleteRcvMsgHashesExpired` rcvMsgHashesTTL)
     deleteRcvFilesExpired = do
       rcvFilesTTL <- asks $ rcvFilesTTL . config
       rcvExpired <- withStore' c (`getRcvFilesExpired` rcvFilesTTL)
@@ -1652,6 +1727,8 @@ cleanupManager c@AgentClient {subQ} = do
     notify :: forall e. AEntityI e => EntityId -> ACommand 'Agent e -> ExceptT AgentErrorType m ()
     notify entId cmd = atomically $ writeTBQueue subQ ("", entId, APC (sAEntity @e) cmd)
 
+-- | make sure to ACK or throw in each message processing branch
+-- it cannot be finally, unfortunately, as sometimes it needs to be ACK+DEL
 processSMPTransmission :: forall m. AgentMonad m => AgentClient -> ServerTransmission BrokerMsg -> m ()
 processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, sessId, rId, cmd) = do
   (rq, SomeConn _ conn) <- withStore c (\db -> getRcvConn db srv rId)
@@ -1692,12 +1769,15 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
                       case (conn, dbReplaceQueueId) of
                         (DuplexConnection _ rqs _, Just replacedId) -> do
                           when primary . withStore' c $ \db -> setRcvQueuePrimary db connId rq
-                          case find (\RcvQueue {dbQueueId} -> dbQueueId == replacedId) rqs of
-                            Just RcvQueue {server, rcvId} -> do
+                          case find ((replacedId ==) . dbQId) rqs of
+                            Just rq'@RcvQueue {server, rcvId} -> do
+                              checkRQSwchStatus rq' RSSendingQUSE
+                              void $ withStore' c $ \db -> setRcvSwitchStatus db rq' $ Just RSReceivedMessage
                               enqueueCommand c "" connId (Just server) $ AInternalCommand $ ICQDelete rcvId
                             _ -> notify . ERR . AGENT $ A_QUEUE "replaced RcvQueue not found in connection"
                         _ -> pure ()
-                      tryError agentClientMsg >>= \case
+                      let encryptedMsgHash = C.sha256Hash encAgentMsg
+                      tryError (agentClientMsg encryptedMsgHash) >>= \case
                         Right (Just (msgId, msgMeta, aMessage)) -> case aMessage of
                           HELLO -> helloMsg >> ackDel msgId
                           REPLY cReq -> replyMsg cReq >> ackDel msgId
@@ -1728,11 +1808,15 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
                                     logServer "<--" c srv rId "MSG <MSG>"
                                     notify $ MSG msgMeta msgFlags body
                                   _ -> pure ()
-                            _ -> throwError e
-                        Left e -> throwError e
+                            _ -> checkDuplicateHash e encryptedMsgHash >> ack
+                        Left e -> checkDuplicateHash e encryptedMsgHash >> ack
                       where
-                        agentClientMsg :: m (Maybe (InternalId, MsgMeta, AMessage))
-                        agentClientMsg = withStore c $ \db -> runExceptT $ do
+                        checkDuplicateHash :: AgentErrorType -> ByteString -> m ()
+                        checkDuplicateHash e encryptedMsgHash =
+                          unlessM (withStore' c $ \db -> checkRcvMsgHashExists db connId encryptedMsgHash) $
+                            throwError e
+                        agentClientMsg :: ByteString -> m (Maybe (InternalId, MsgMeta, AMessage))
+                        agentClientMsg encryptedMsgHash = withStore c $ \db -> runExceptT $ do
                           agentMsgBody <- agentRatchetDecrypt db connId encAgentMsg
                           liftEither (parse smpP (SEAgentError $ AGENT A_MESSAGE) agentMsgBody) >>= \case
                             agentMsg@(AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage) -> do
@@ -1744,7 +1828,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
                                   recipient = (unId internalId, internalTs)
                                   broker = (srvMsgId, systemToUTCTime srvTs)
                                   msgMeta = MsgMeta {integrity, recipient, broker, sndMsgId}
-                                  rcvMsg = RcvMsgData {msgMeta, msgType, msgFlags, msgBody = agentMsgBody, internalRcvId, internalHash, externalPrevSndHash = prevMsgHash}
+                                  rcvMsg = RcvMsgData {msgMeta, msgType, msgFlags, msgBody = agentMsgBody, internalRcvId, internalHash, externalPrevSndHash = prevMsgHash, encryptedMsgHash}
                               liftIO $ createRcvMsg db connId rq rcvMsg
                               pure $ Just (internalId, msgMeta, aMessage)
                             _ -> pure Nothing
@@ -1890,24 +1974,33 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
         -- processed by queue sender
         qAddMsg :: NonEmpty (SMPQueueUri, Maybe SndQAddr) -> Connection 'CDuplex -> m ()
         qAddMsg ((_, Nothing) :| _) _ = qError "adding queue without switching is not supported"
-        qAddMsg ((qUri, Just addr) :| _) (DuplexConnection _ rqs sqs@(sq :| sqs_)) = do
+        qAddMsg ((qUri, Just addr) :| _) (DuplexConnection _ rqs sqs) = do
           clientVRange <- asks $ smpClientVRange . config
           case qUri `compatibleVersion` clientVRange of
             Just qInfo@(Compatible sqInfo@SMPQueueInfo {queueAddress}) ->
               case (findQ (qAddress sqInfo) sqs, findQ addr sqs) of
                 (Just _, _) -> qError "QADD: queue address is already used in connection"
-                (_, Just _replaced@SndQueue {dbQueueId}) -> do
-                  sq_@SndQueue {sndPublicKey, e2ePubKey} <- newSndQueue userId connId qInfo
-                  let sq' = (sq_ :: SndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
-                  void . withStore c $ \db -> addConnSndQueue db connId sq'
-                  case (sndPublicKey, e2ePubKey) of
-                    (Just sndPubKey, Just dhPublicKey) -> do
-                      logServer "<--" c srv rId $ "MSG <QADD> " <> logSecret (senderId queueAddress)
-                      let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
-                      void . enqueueMessages c cData sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPubKey)]
-                      let conn' = DuplexConnection cData rqs (sq <| sq' :| sqs_)
-                      notify . SWITCH QDSnd SPStarted $ connectionStats conn'
-                    _ -> qError "absent sender keys"
+                (_, Just sq@SndQueue {dbQueueId}) -> do
+                  let (delSqs, keepSqs) = L.partition ((Just dbQueueId ==) . dbReplaceQId) sqs
+                  case L.nonEmpty keepSqs of
+                    Just sqs' -> do
+                      -- move inside case?
+                      withStore' c $ \db -> mapM_ (deleteConnSndQueue db connId) delSqs
+                      sq_@SndQueue {sndPublicKey, e2ePubKey} <- newSndQueue userId connId qInfo
+                      let sq'' = (sq_ :: SndQueue) {primary = True, dbQueueId, dbReplaceQueueId = Just dbQueueId}
+                      dbId <- withStore c $ \db -> addConnSndQueue db connId sq''
+                      let sq2 = (sq'' :: SndQueue) {dbQueueId = dbId}
+                      case (sndPublicKey, e2ePubKey) of
+                        (Just sndPubKey, Just dhPublicKey) -> do
+                          logServer "<--" c srv rId $ "MSG <QADD> " <> logSecret (senderId queueAddress)
+                          let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
+                          void . enqueueMessages c cData sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPubKey)]
+                          sq1 <- withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
+                          let sqs'' = updatedQs sq1 sqs' <> [sq2]
+                              conn' = DuplexConnection cData rqs sqs''
+                          notify . SWITCH QDSnd SPStarted $ connectionStats conn'
+                        _ -> qError "absent sender keys"
+                    _ -> qError "QADD: won't delete all snd queues in connection"
                 _ -> qError "QADD: replaced queue address is not found in connection"
             _ -> throwError $ AGENT A_VERSION
 
@@ -1919,6 +2012,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
           case findRQ (smpServer, senderId) rqs of
             Just rq'@RcvQueue {rcvId, e2ePrivKey = dhPrivKey, smpClientVersion = cVer, status = status'}
               | status' == New || status' == Confirmed -> do
+                checkRQSwchStatus rq RSSendingQADD
                 logServer "<--" c srv rId $ "MSG <QKEY> " <> logSecret senderId
                 let dhSecret = C.dh' dhPublicKey dhPrivKey
                 withStore' c $ \db -> setRcvQueueConfirmedE2E db rq' dhSecret $ min cVer cVer'
@@ -1933,16 +2027,23 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
         -- mark queue as Secured and to start sending messages to it
         qUseMsg :: NonEmpty ((SMPServer, SMP.SenderId), Bool) -> Connection 'CDuplex -> m ()
         -- NOTE: does not yet support the change of the primary status during the rotation
-        qUseMsg ((addr, _primary) :| _) (DuplexConnection _ _ sqs) =
+        qUseMsg ((addr, _primary) :| _) (DuplexConnection _ rqs sqs) =
           case findQ addr sqs of
-            Just sq' -> do
-              logServer "<--" c srv rId $ "MSG <QUSE> " <> logSecret (snd addr)
-              withStore' c $ \db -> setSndQueueStatus db sq' Secured
-              let sq'' = (sq' :: SndQueue) {status = Secured}
-              -- sending QTEST to the new queue only, the old one will be removed if sent successfully
-              void $ enqueueMessages c cData [sq''] SMP.noMsgFlags $ QTEST [addr]
-              notify . SWITCH QDSnd SPConfirmed $ connectionStats conn
-            _ -> qError "QUSE: queue address not found in connection"
+            Just sq'@SndQueue {dbReplaceQueueId = Just replaceQId} -> do
+              case find ((replaceQId ==) . dbQId) sqs of
+                Just sq1 -> do
+                  checkSQSwchStatus sq1 SSSendingQKEY
+                  logServer "<--" c srv rId $ "MSG <QUSE> " <> logSecret (snd addr)
+                  withStore' c $ \db -> setSndQueueStatus db sq' Secured
+                  let sq'' = (sq' :: SndQueue) {status = Secured}
+                  -- sending QTEST to the new queue only, the old one will be removed if sent successfully
+                  void $ enqueueMessages c cData [sq''] SMP.noMsgFlags $ QTEST [addr]
+                  sq1' <- withStore' c $ \db -> setSndSwitchStatus db sq1 $ Just SSSendingQTEST
+                  let sqs' = updatedQs sq1' sqs
+                      conn' = DuplexConnection cData rqs sqs'
+                  notify . SWITCH QDSnd SPSecured $ connectionStats conn'
+                _ -> qError "QUSE: switching SndQueue not found in connection"
+            _ -> qError "QUSE: switched queue address not found in connection"
 
         qError :: String -> m ()
         qError = throwError . AGENT . A_QUEUE
@@ -1968,6 +2069,21 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
           | internalPrevMsgHash /= receivedPrevMsgHash = MsgError MsgBadHash
           | otherwise = MsgError MsgDuplicate -- this case is not possible
 
+checkRQSwchStatus :: AgentMonad m => RcvQueue -> RcvSwitchStatus -> m ()
+checkRQSwchStatus rq@RcvQueue {rcvSwchStatus} expected =
+  unless (rcvSwchStatus == Just expected) $ switchStatusError rq expected rcvSwchStatus
+
+checkSQSwchStatus :: AgentMonad m => SndQueue -> SndSwitchStatus -> m ()
+checkSQSwchStatus sq@SndQueue {sndSwchStatus} expected =
+  unless (sndSwchStatus == Just expected) $ switchStatusError sq expected sndSwchStatus
+
+switchStatusError :: (SMPQueueRec q, AgentMonad m, Show a) => q -> a -> Maybe a -> m ()
+switchStatusError q expected actual =
+  throwError . INTERNAL $
+    ("unexpected switch status, queueId=" <> show (queueId q))
+      <> (", expected=" <> show expected)
+      <> (", actual=" <> show actual)
+
 connectReplyQueues :: AgentMonad m => AgentClient -> ConnData -> ConnInfo -> NonEmpty SMPQueueInfo -> m ()
 connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo (qInfo :| _) = do
   clientVRange <- asks $ smpClientVRange . config
@@ -2052,5 +2168,6 @@ newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAdd
         dbQueueId = 0,
         primary = True,
         dbReplaceQueueId = Nothing,
+        sndSwchStatus = Nothing,
         smpClientVersion
       }

src/Simplex/Messaging/Agent/Client.hs

@@ -115,7 +115,6 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (lefts, partitionEithers)
 import Data.Functor (($>))
-import Data.Int (Int64)
 import Data.List (deleteFirstsBy, foldl', partition, (\\))
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
@@ -842,6 +841,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange = do
             dbQueueId = 0,
             primary = True,
             dbReplaceQueueId = Nothing,
+            rcvSwchStatus = Nothing,
             smpClientVersion = maxVersion vRange,
             clientNtfCreds = Nothing,
             deleteErrors = 0

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

@@ -82,6 +82,7 @@ data AgentConfig = AgentConfig
     helloTimeout :: NominalDiffTime,
     initialCleanupDelay :: Int64,
     cleanupInterval :: Int64,
+    rcvMsgHashesTTL :: NominalDiffTime,
     rcvFilesTTL :: NominalDiffTime,
     sndFilesTTL :: NominalDiffTime,
     xftpNotifyErrsOnRetry :: Bool,
@@ -145,6 +146,7 @@ defaultAgentConfig =
       helloTimeout = 2 * nominalDay,
       initialCleanupDelay = 30 * 1000000, -- 30 seconds
       cleanupInterval = 30 * 60 * 1000000, -- 30 minutes
+      rcvMsgHashesTTL = 30 * nominalDay,
       rcvFilesTTL = 2 * nominalDay,
       sndFilesTTL = nominalDay,
       xftpNotifyErrsOnRetry = True,

src/Simplex/Messaging/Agent/NtfSubSupervisor.hs

@@ -26,6 +26,7 @@ import Data.Bifunctor (first)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import Data.Time (UTCTime, addUTCTime, getCurrentTime)
+import Data.Time.Clock (diffUTCTime)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol (ACommand (..), APartyCmd (..), AgentErrorType (..), BrokerErrorType (..), ConnId, NotificationsMode (..), SAEntity (..))
@@ -39,7 +40,7 @@ import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Protocol (NtfServer, ProtocolServer, SMPServer, sameSrvAddr)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (diffInMicros, threadDelay', tshow, unlessM)
+import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, unlessM)
 import System.Random (randomR)
 import UnliftIO
 import UnliftIO.Concurrent (forkIO, threadDelay)
@@ -291,7 +292,7 @@ rescheduleAction doWork ts actionTs
   | otherwise = do
     void . atomically $ tryTakeTMVar doWork
     void . forkIO $ do
-      liftIO $ threadDelay' $ diffInMicros actionTs ts
+      liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime actionTs ts
       void . atomically $ tryPutTMVar doWork ()
     pure True
 

src/Simplex/Messaging/Agent/Protocol.hs

@@ -55,8 +55,12 @@ module Simplex.Messaging.Agent.Protocol
     AEntityI (..),
     MsgHash,
     MsgMeta (..),
+    RcvQueueInfo (..),
+    SndQueueInfo (..),
     ConnectionStats (..),
     SwitchPhase (..),
+    RcvSwitchStatus (..),
+    SndSwitchStatus (..),
     QueueDirection (..),
     SMPConfirmation (..),
     AgentMsgEnvelope (..),
@@ -473,18 +477,20 @@ instance ToJSON QueueDirection where
 instance FromJSON QueueDirection where
   parseJSON = strParseJSON "QueueDirection"
 
-data SwitchPhase = SPStarted | SPConfirmed | SPCompleted
+data SwitchPhase = SPStarted | SPConfirmed | SPSecured | SPCompleted
   deriving (Eq, Show)
 
 instance StrEncoding SwitchPhase where
   strEncode = \case
     SPStarted -> "started"
     SPConfirmed -> "confirmed"
+    SPSecured -> "secured"
     SPCompleted -> "completed"
   strP =
     A.takeTill (== ' ') >>= \case
       "started" -> pure SPStarted
       "confirmed" -> pure SPConfirmed
+      "secured" -> pure SPSecured
       "completed" -> pure SPCompleted
       _ -> fail "bad SwitchPhase"
 
@@ -495,19 +501,113 @@ instance ToJSON SwitchPhase where
 instance FromJSON SwitchPhase where
   parseJSON = strParseJSON "SwitchPhase"
 
+data RcvSwitchStatus
+  = RSSwitchStarted
+  | RSSendingQADD
+  | RSSendingQUSE
+  | RSReceivedMessage
+  deriving (Eq, Show)
+
+instance StrEncoding RcvSwitchStatus where
+  strEncode = \case
+    RSSwitchStarted -> "switch_started"
+    RSSendingQADD -> "sending_qadd"
+    RSSendingQUSE -> "sending_quse"
+    RSReceivedMessage -> "received_message"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "switch_started" -> pure RSSwitchStarted
+      "sending_qadd" -> pure RSSendingQADD
+      "sending_quse" -> pure RSSendingQUSE
+      "received_message" -> pure RSReceivedMessage
+      _ -> fail "bad RcvSwitchStatus"
+
+instance ToField RcvSwitchStatus where toField = toField . strEncode
+
+instance FromField RcvSwitchStatus where fromField = blobFieldDecoder $ parseAll strP
+
+instance ToJSON RcvSwitchStatus where
+  toEncoding = strToJEncoding
+  toJSON = strToJSON
+
+instance FromJSON RcvSwitchStatus where
+  parseJSON = strParseJSON "RcvSwitchStatus"
+
+data SndSwitchStatus
+  = SSSendingQKEY
+  | SSSendingQTEST
+  deriving (Eq, Show)
+
+instance StrEncoding SndSwitchStatus where
+  strEncode = \case
+    SSSendingQKEY -> "sending_qkey"
+    SSSendingQTEST -> "sending_qtest"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "sending_qkey" -> pure SSSendingQKEY
+      "sending_qtest" -> pure SSSendingQTEST
+      _ -> fail "bad SndSwitchStatus"
+
+instance ToField SndSwitchStatus where toField = toField . strEncode
+
+instance FromField SndSwitchStatus where fromField = blobFieldDecoder $ parseAll strP
+
+instance ToJSON SndSwitchStatus where
+  toEncoding = strToJEncoding
+  toJSON = strToJSON
+
+instance FromJSON SndSwitchStatus where
+  parseJSON = strParseJSON "SndSwitchStatus"
+
+data RcvQueueInfo = RcvQueueInfo
+  { rcvServer :: SMPServer,
+    rcvSwitchStatus :: Maybe RcvSwitchStatus,
+    canAbortSwitch :: Bool
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON RcvQueueInfo where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+instance StrEncoding RcvQueueInfo where
+  strEncode RcvQueueInfo {rcvServer, rcvSwitchStatus, canAbortSwitch} =
+    "srv=" <> strEncode rcvServer
+      <> maybe "" (\switch -> ";switch=" <> strEncode switch) rcvSwitchStatus
+      <> (";can_abort_switch=" <> strEncode canAbortSwitch)
+  strP = do
+    rcvServer <- "srv=" *> strP
+    rcvSwitchStatus <- optional $ ";switch=" *> strP
+    canAbortSwitch <- ";can_abort_switch=" *> strP
+    pure RcvQueueInfo {rcvServer, rcvSwitchStatus, canAbortSwitch}
+
+data SndQueueInfo = SndQueueInfo
+  { sndServer :: SMPServer,
+    sndSwitchStatus :: Maybe SndSwitchStatus
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON SndQueueInfo where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+instance StrEncoding SndQueueInfo where
+  strEncode SndQueueInfo {sndServer, sndSwitchStatus} =
+    "srv=" <> strEncode sndServer <> maybe "" (\switch -> ";switch=" <> strEncode switch) sndSwitchStatus
+  strP = do
+    sndServer <- "srv=" *> strP
+    sndSwitchStatus <- optional $ ";switch=" *> strP
+    pure SndQueueInfo {sndServer, sndSwitchStatus}
+
 data ConnectionStats = ConnectionStats
-  { rcvServers :: [SMPServer],
-    sndServers :: [SMPServer]
+  { rcvQueuesInfo :: [RcvQueueInfo],
+    sndQueuesInfo :: [SndQueueInfo]
   }
   deriving (Eq, Show, Generic)
 
 instance StrEncoding ConnectionStats where
-  strEncode ConnectionStats {rcvServers, sndServers} =
-    "rcv=" <> strEncodeList rcvServers <> " snd=" <> strEncodeList sndServers
+  strEncode ConnectionStats {rcvQueuesInfo, sndQueuesInfo} =
+    "rcv=" <> strEncodeList rcvQueuesInfo <> " snd=" <> strEncodeList sndQueuesInfo
   strP = do
-    rcvServers <- "rcv=" *> strListP
-    sndServers <- " snd=" *> strListP
-    pure ConnectionStats {rcvServers, sndServers}
+    rcvQueuesInfo <- "rcv=" *> strListP
+    sndQueuesInfo <- " snd=" *> strListP
+    pure ConnectionStats {rcvQueuesInfo, sndQueuesInfo}
 
 instance ToJSON ConnectionStats where toEncoding = J.genericToEncoding J.defaultOptions
 

src/Simplex/Messaging/Agent/Store.hs

@@ -21,6 +21,7 @@ import Data.Kind (Type)
 import Data.List (find)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
+import Data.Maybe (isJust)
 import Data.Time (UTCTime)
 import Data.Type.Equality
 import Simplex.Messaging.Agent.Protocol
@@ -66,12 +67,13 @@ data RcvQueue = RcvQueue
     sndId :: SMP.SenderId,
     -- | queue status
     status :: QueueStatus,
-    -- | database queue ID (within connection), can be Nothing for old queues
+    -- | database queue ID (within connection)
     dbQueueId :: Int64,
     -- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
     primary :: Bool,
     -- | database queue ID to replace, Nothing if this queue is not replacing another, `Just Nothing` is used for replacing old queues
     dbReplaceQueueId :: Maybe Int64,
+    rcvSwchStatus :: Maybe RcvSwitchStatus,
     -- | SMP client version
     smpClientVersion :: Version,
     -- | credentials used in context of notifications
@@ -80,6 +82,22 @@ data RcvQueue = RcvQueue
   }
   deriving (Eq, Show)
 
+rcvQueueInfo :: RcvQueue -> RcvQueueInfo
+rcvQueueInfo rq@RcvQueue {server, rcvSwchStatus} =
+  RcvQueueInfo {rcvServer = server, rcvSwitchStatus = rcvSwchStatus, canAbortSwitch = canAbortRcvSwitch rq}
+
+canAbortRcvSwitch :: RcvQueue -> Bool
+canAbortRcvSwitch = maybe False canAbort . rcvSwchStatus
+  where
+    canAbort = \case
+      RSSwitchStarted -> True
+      RSSendingQADD -> True
+      -- if switch is in RSSendingQUSE, a race condition with sender deleting the original queue is possible
+      RSSendingQUSE -> False
+      -- if switch is in RSReceivedMessage status, aborting switch (deleting new queue)
+      -- will break the connection because the sender would have original queue deleted
+      RSReceivedMessage -> False
+
 data ClientNtfCreds = ClientNtfCreds
   { -- | key pair to be used by the notification server to sign transmissions
     ntfPublicKey :: NtfPublicVerifyKey,
@@ -107,17 +125,22 @@ data SndQueue = SndQueue
     e2eDhSecret :: C.DhSecretX25519,
     -- | queue status
     status :: QueueStatus,
-    -- | database queue ID (within connection), can be Nothing for old queues
+    -- | database queue ID (within connection)
     dbQueueId :: Int64,
     -- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
     primary :: Bool,
     -- | ID of the queue this one is replacing
     dbReplaceQueueId :: Maybe Int64,
+    sndSwchStatus :: Maybe SndSwitchStatus,
     -- | SMP client version
     smpClientVersion :: Version
   }
   deriving (Eq, Show)
 
+sndQueueInfo :: SndQueue -> SndQueueInfo
+sndQueueInfo SndQueue {server, sndSwchStatus} =
+  SndQueueInfo {sndServer = server, sndSwitchStatus = sndSwchStatus}
+
 instance SMPQueue RcvQueue where
   qServer RcvQueue {server} = server
   {-# INLINE qServer #-}
@@ -155,10 +178,20 @@ findRQ :: (SMPServer, SMP.SenderId) -> NonEmpty RcvQueue -> Maybe RcvQueue
 findRQ sAddr = find $ sameQAddress sAddr . sndAddress
 {-# INLINE findRQ #-}
 
+switchingRQ :: NonEmpty RcvQueue -> Maybe RcvQueue
+switchingRQ = find $ isJust . rcvSwchStatus
+{-# INLINE switchingRQ #-}
+
+updatedQs :: SMPQueueRec q => q -> NonEmpty q -> NonEmpty q
+updatedQs q = L.map $ \q' -> if dbQId q == dbQId q' then q else q'
+{-# INLINE updatedQs #-}
+
 class SMPQueue q => SMPQueueRec q where
   qUserId :: q -> UserId
   qConnId :: q -> ConnId
   queueId :: q -> QueueId
+  dbQId :: q -> Int64
+  dbReplaceQId :: q -> Maybe Int64
 
 instance SMPQueueRec RcvQueue where
   qUserId = userId
@@ -167,6 +200,10 @@ instance SMPQueueRec RcvQueue where
   {-# INLINE qConnId #-}
   queueId = rcvId
   {-# INLINE queueId #-}
+  dbQId = dbQueueId
+  {-# INLINE dbQId #-}
+  dbReplaceQId = dbReplaceQueueId
+  {-# INLINE dbReplaceQId #-}
 
 instance SMPQueueRec SndQueue where
   qUserId = userId
@@ -175,6 +212,10 @@ instance SMPQueueRec SndQueue where
   {-# INLINE qConnId #-}
   queueId = sndId
   {-# INLINE queueId #-}
+  dbQId = dbQueueId
+  {-# INLINE dbQId #-}
+  dbReplaceQId = dbReplaceQueueId
+  {-# INLINE dbReplaceQId #-}
 
 -- * Connection types
 
@@ -308,6 +349,7 @@ data InternalCommand
   | ICAllowSecure SMP.RecipientId SMP.SndPublicVerifyKey
   | ICDuplexSecure SMP.RecipientId SMP.SndPublicVerifyKey
   | ICDeleteConn
+  | ICDeleteRcvQueue SMP.RecipientId
   | ICQSecure SMP.RecipientId SMP.SndPublicVerifyKey
   | ICQDelete SMP.RecipientId
 
@@ -317,6 +359,7 @@ data InternalCommandTag
   | ICAllowSecure_
   | ICDuplexSecure_
   | ICDeleteConn_
+  | ICDeleteRcvQueue_
   | ICQSecure_
   | ICQDelete_
   deriving (Show)
@@ -328,6 +371,7 @@ instance StrEncoding InternalCommand where
     ICAllowSecure rId sndKey -> strEncode (ICAllowSecure_, rId, sndKey)
     ICDuplexSecure rId sndKey -> strEncode (ICDuplexSecure_, rId, sndKey)
     ICDeleteConn -> strEncode ICDeleteConn_
+    ICDeleteRcvQueue rId -> strEncode (ICDeleteRcvQueue_, rId)
     ICQSecure rId senderKey -> strEncode (ICQSecure_, rId, senderKey)
     ICQDelete rId -> strEncode (ICQDelete_, rId)
   strP =
@@ -337,6 +381,7 @@ instance StrEncoding InternalCommand where
       ICAllowSecure_ -> ICAllowSecure <$> _strP <*> _strP
       ICDuplexSecure_ -> ICDuplexSecure <$> _strP <*> _strP
       ICDeleteConn_ -> pure ICDeleteConn
+      ICDeleteRcvQueue_ -> ICDeleteRcvQueue <$> _strP
       ICQSecure_ -> ICQSecure <$> _strP <*> _strP
       ICQDelete_ -> ICQDelete <$> _strP
 
@@ -347,6 +392,7 @@ instance StrEncoding InternalCommandTag where
     ICAllowSecure_ -> "ALLOW_SECURE"
     ICDuplexSecure_ -> "DUPLEX_SECURE"
     ICDeleteConn_ -> "DELETE_CONN"
+    ICDeleteRcvQueue_ -> "DELETE_RCV_QUEUE"
     ICQSecure_ -> "QSECURE"
     ICQDelete_ -> "QDELETE"
   strP =
@@ -356,6 +402,7 @@ instance StrEncoding InternalCommandTag where
       "ALLOW_SECURE" -> pure ICAllowSecure_
       "DUPLEX_SECURE" -> pure ICDuplexSecure_
       "DELETE_CONN" -> pure ICDeleteConn_
+      "DELETE_RCV_QUEUE" -> pure ICDeleteRcvQueue_
       "QSECURE" -> pure ICQSecure_
       "QDELETE" -> pure ICQDelete_
       _ -> fail "bad InternalCommandTag"
@@ -372,6 +419,7 @@ internalCmdTag = \case
   ICAllowSecure {} -> ICAllowSecure_
   ICDuplexSecure {} -> ICDuplexSecure_
   ICDeleteConn -> ICDeleteConn_
+  ICDeleteRcvQueue {} -> ICDeleteRcvQueue_
   ICQSecure {} -> ICQSecure_
   ICQDelete _ -> ICQDelete_
 
@@ -428,7 +476,8 @@ data RcvMsgData = RcvMsgData
     msgBody :: MsgBody,
     internalRcvId :: InternalRcvId,
     internalHash :: MsgHash,
-    externalPrevSndHash :: MsgHash
+    externalPrevSndHash :: MsgHash,
+    encryptedMsgHash :: MsgHash
   }
 
 data RcvMsg = RcvMsg

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

@@ -54,14 +54,19 @@ module Simplex.Messaging.Agent.Store.SQLite
     setConnDeleted,
     getDeletedConnIds,
     getRcvConn,
+    getRcvQueueById,
+    getSndQueueById,
     deleteConn,
     upgradeRcvConnToDuplex,
     upgradeSndConnToDuplex,
     addConnRcvQueue,
     addConnSndQueue,
     setRcvQueueStatus,
+    setRcvSwitchStatus,
+    setRcvQueueDeleted,
     setRcvQueueConfirmedE2E,
     setSndQueueStatus,
+    setSndSwitchStatus,
     setRcvQueuePrimary,
     setSndQueuePrimary,
     deleteConnRcvQueue,
@@ -69,6 +74,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     deleteConnSndQueue,
     getPrimaryRcvQueue,
     getRcvQueue,
+    getDeletedRcvQueue,
     setRcvQueueNtfCreds,
     -- Confirmations
     createConfirmation,
@@ -94,8 +100,10 @@ module Simplex.Messaging.Agent.Store.SQLite
     deletePendingMsgs,
     setMsgUserAck,
     getLastMsg,
+    checkRcvMsgHashExists,
     deleteMsg,
     deleteSndMsgDelivery,
+    deleteRcvMsgHashesExpired,
     -- Double ratchet persistence
     createRatchetX3dhKeys,
     getRatchetX3dhKeys,
@@ -182,6 +190,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     -- * utilities
     withConnection,
     withTransaction,
+    withTransactionCtx,
     firstRow,
     firstRow',
     maybeFirstRow,
@@ -212,7 +221,7 @@ import Data.Ord (Down (..))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
-import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
+import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime)
 import Data.Word (Word32)
 import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), Query (..), SQLError, ToRow, field, (:.) (..))
 import qualified Database.SQLite.Simple as DB
@@ -241,7 +250,7 @@ import Simplex.Messaging.Parsers (blobFieldParser, dropPrefix, fromTextField_, s
 import Simplex.Messaging.Protocol
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (bshow, eitherToMaybe, ($>>=), (<$$>))
+import Simplex.Messaging.Util (bshow, diffToMilliseconds, eitherToMaybe, ($>>=), (<$$>))
 import Simplex.Messaging.Version
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
 import System.Exit (exitFailure)
@@ -428,16 +437,29 @@ withConnection SQLiteStore {dbConnection} =
     (atomically . putTMVar dbConnection)
 
 withTransaction :: forall a. SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransaction st action = withConnection st $ loop 500 3_000_000
+withTransaction = withTransactionCtx Nothing
+
+withTransactionCtx :: forall a. Maybe String -> SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withTransactionCtx ctx_ st action = withConnection st $ loop 500 3_000_000
   where
     loop :: Int -> Int -> DB.Connection -> IO a
     loop t tLim db =
-      DB.withImmediateTransaction db (action db) `E.catch` \(e :: SQLError) ->
+      transactionWithCtx `E.catch` \(e :: SQLError) ->
         if tLim > t && DB.sqlError e == DB.ErrorBusy
           then do
             threadDelay t
             loop (t * 9 `div` 8) (tLim - t) db
           else E.throwIO e
+      where
+        transactionWithCtx = case ctx_ of
+          Nothing -> DB.withImmediateTransaction db (action db)
+          Just ctx -> do
+            t1 <- getCurrentTime
+            r <- DB.withImmediateTransaction db (action db)
+            t2 <- getCurrentTime
+            putStrLn $ "withTransactionCtx start :: " <> show t1 <> " :: " <> ctx
+            putStrLn $ "withTransactionCtx end   :: " <> show t2 <> " :: " <> ctx <> " :: duration=" <> show (diffToMilliseconds $ diffUTCTime t2 t1)
+            pure r
 
 createUserRecord :: DB.Connection -> IO UserId
 createUserRecord db = do
@@ -545,7 +567,7 @@ getRcvConn :: DB.Connection -> SMPServer -> SMP.RecipientId -> IO (Either StoreE
 getRcvConn db ProtocolServer {host, port} rcvId = runExceptT $ do
   rq@RcvQueue {connId} <-
     ExceptT . firstRow toRcvQueue SEConnNotFound $
-      DB.query db (rcvQueueQuery <> " WHERE q.host = ? AND q.port = ? AND q.rcv_id = ?") (host, port, rcvId)
+      DB.query db (rcvQueueQuery <> " WHERE q.host = ? AND q.port = ? AND q.rcv_id = ? AND q.deleted = 0") (host, port, rcvId)
   (rq,) <$> ExceptT (getConn db connId)
 
 deleteConn :: DB.Connection -> ConnId -> IO ()
@@ -604,6 +626,29 @@ setRcvQueueStatus db RcvQueue {rcvId, server = ProtocolServer {host, port}} stat
     |]
     [":status" := status, ":host" := host, ":port" := port, ":rcv_id" := rcvId]
 
+setRcvSwitchStatus :: DB.Connection -> RcvQueue -> Maybe RcvSwitchStatus -> IO RcvQueue
+setRcvSwitchStatus db rq@RcvQueue {rcvId, server = ProtocolServer {host, port}} rcvSwchStatus = do
+  DB.execute
+    db
+    [sql|
+      UPDATE rcv_queues
+      SET switch_status = ?
+      WHERE host = ? AND port = ? AND rcv_id = ?
+    |]
+    (rcvSwchStatus, host, port, rcvId)
+  pure rq {rcvSwchStatus}
+
+setRcvQueueDeleted :: DB.Connection -> RcvQueue -> IO ()
+setRcvQueueDeleted db RcvQueue {rcvId, server = ProtocolServer {host, port}} = do
+  DB.execute
+    db
+    [sql|
+      UPDATE rcv_queues
+      SET deleted = 1
+      WHERE host = ? AND port = ? AND rcv_id = ?
+    |]
+    (host, port, rcvId)
+
 setRcvQueueConfirmedE2E :: DB.Connection -> RcvQueue -> C.DhSecretX25519 -> Version -> IO ()
 setRcvQueueConfirmedE2E db RcvQueue {rcvId, server = ProtocolServer {host, port}} e2eDhSecret smpClientVersion =
   DB.executeNamed
@@ -635,6 +680,18 @@ setSndQueueStatus db SndQueue {sndId, server = ProtocolServer {host, port}} stat
     |]
     [":status" := status, ":host" := host, ":port" := port, ":snd_id" := sndId]
 
+setSndSwitchStatus :: DB.Connection -> SndQueue -> Maybe SndSwitchStatus -> IO SndQueue
+setSndSwitchStatus db sq@SndQueue {sndId, server = ProtocolServer {host, port}} sndSwchStatus = do
+  DB.execute
+    db
+    [sql|
+      UPDATE snd_queues
+      SET switch_status = ?
+      WHERE host = ? AND port = ? AND snd_id = ?
+    |]
+    (sndSwchStatus, host, port, sndId)
+  pure sq {sndSwchStatus}
+
 setRcvQueuePrimary :: DB.Connection -> ConnId -> RcvQueue -> IO ()
 setRcvQueuePrimary db connId RcvQueue {dbQueueId} = do
   DB.execute db "UPDATE rcv_queues SET rcv_primary = ? WHERE conn_id = ?" (False, connId)
@@ -671,7 +728,12 @@ getPrimaryRcvQueue db connId =
 getRcvQueue :: DB.Connection -> ConnId -> SMPServer -> SMP.RecipientId -> IO (Either StoreError RcvQueue)
 getRcvQueue db connId (SMPServer host port _) rcvId =
   firstRow toRcvQueue SEConnNotFound $
-    DB.query db (rcvQueueQuery <> "WHERE q.conn_id = ? AND q.host = ? AND q.port = ? AND q.rcv_id = ?") (connId, host, port, rcvId)
+    DB.query db (rcvQueueQuery <> "WHERE q.conn_id = ? AND q.host = ? AND q.port = ? AND q.rcv_id = ? AND q.deleted = 0") (connId, host, port, rcvId)
+
+getDeletedRcvQueue :: DB.Connection -> ConnId -> SMPServer -> SMP.RecipientId -> IO (Either StoreError RcvQueue)
+getDeletedRcvQueue db connId (SMPServer host port _) rcvId =
+  firstRow toRcvQueue SEConnNotFound $
+    DB.query db (rcvQueueQuery <> "WHERE q.conn_id = ? AND q.host = ? AND q.port = ? AND q.rcv_id = ? AND q.deleted = 1") (connId, host, port, rcvId)
 
 setRcvQueueNtfCreds :: DB.Connection -> ConnId -> Maybe ClientNtfCreds -> IO ()
 setRcvQueueNtfCreds db connId clientNtfCreds =
@@ -902,7 +964,7 @@ setMsgUserAck db connId agentMsgId = runExceptT $ do
   (dbRcvId, srvMsgId) <-
     ExceptT . firstRow id SEMsgNotFound $
       DB.query db "SELECT rcv_queue_id, broker_id FROM rcv_messages WHERE conn_id = ? AND internal_id = ?" (connId, agentMsgId)
-  rq <- ExceptT $ getRcvQueueById_ db connId dbRcvId
+  rq <- ExceptT $ getRcvQueueById db connId dbRcvId
   pure (rq, srvMsgId)
 
 getLastMsg :: DB.Connection -> ConnId -> SMP.MsgId -> IO (Maybe RcvMsg)
@@ -925,6 +987,17 @@ getLastMsg db connId msgId =
       let msgMeta = MsgMeta {recipient = (agentMsgId, internalTs), broker = (brokerId, brokerTs), sndMsgId, integrity}
        in RcvMsg {internalId = InternalId agentMsgId, msgMeta, msgBody, userAck}
 
+checkRcvMsgHashExists :: DB.Connection -> ConnId -> ByteString -> IO Bool
+checkRcvMsgHashExists db connId hash = do
+  fromMaybe False
+    <$> maybeFirstRow
+      fromOnly
+      ( DB.query
+          db
+          "SELECT 1 FROM encrypted_rcv_message_hashes WHERE conn_id = ? AND hash = ? LIMIT 1"
+          (connId, hash)
+      )
+
 deleteMsg :: DB.Connection -> ConnId -> InternalId -> IO ()
 deleteMsg db connId msgId =
   DB.execute db "DELETE FROM messages WHERE conn_id = ? AND internal_id = ?;" (connId, msgId)
@@ -938,6 +1011,11 @@ deleteSndMsgDelivery db connId SndQueue {dbQueueId} msgId = do
   (Only (cnt :: Int) : _) <- DB.query db "SELECT count(*) FROM snd_message_deliveries WHERE conn_id = ? AND internal_id = ?" (connId, msgId)
   when (cnt == 0) $ deleteMsg db connId msgId
 
+deleteRcvMsgHashesExpired :: DB.Connection -> NominalDiffTime -> IO ()
+deleteRcvMsgHashesExpired db ttl = do
+  cutoffTs <- addUTCTime (- ttl) <$> getCurrentTime
+  DB.execute db "DELETE FROM encrypted_rcv_message_hashes WHERE created_at < ?" (Only cutoffTs)
+
 createRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> IO ()
 createRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 =
   DB.execute db "INSERT INTO ratchets (conn_id, x3dh_priv_key_1, x3dh_priv_key_2) VALUES (?, ?, ?)" (connId, x3dhPrivKey1, x3dhPrivKey2)
@@ -1343,7 +1421,7 @@ getNtfRcvQueue db SMPQueueNtf {smpServer = (SMPServer host port _), notifierId}
       [sql|
         SELECT conn_id, rcv_ntf_dh_secret
         FROM rcv_queues
-        WHERE host = ? AND port = ? AND ntf_id = ?
+        WHERE host = ? AND port = ? AND ntf_id = ? AND deleted = 0
       |]
       (host, port, notifierId)
   where
@@ -1579,7 +1657,7 @@ getDeletedConnIds db = map fromOnly <$> DB.query db "SELECT conn_id FROM connect
 getRcvQueuesByConnId_ :: DB.Connection -> ConnId -> IO (Maybe (NonEmpty RcvQueue))
 getRcvQueuesByConnId_ db connId =
   L.nonEmpty . sortBy primaryFirst . map toRcvQueue
-    <$> DB.query db (rcvQueueQuery <> "WHERE q.conn_id = ?") (Only connId)
+    <$> DB.query db (rcvQueueQuery <> "WHERE q.conn_id = ? AND q.deleted = 0") (Only connId)
   where
     primaryFirst RcvQueue {primary = p, dbReplaceQueueId = i} RcvQueue {primary = p', dbReplaceQueueId = i'} =
       -- the current primary queue is ordered first, the next primary - second
@@ -1590,7 +1668,7 @@ rcvQueueQuery =
   [sql|
     SELECT c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret,
       q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.status,
-      q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id, q.smp_client_version, q.delete_errors,
+      q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id, q.switch_status, q.smp_client_version, q.delete_errors,
       q.ntf_public_key, q.ntf_private_key, q.ntf_id, q.rcv_ntf_dh_secret
     FROM rcv_queues q
     JOIN servers s ON q.host = s.host AND q.port = s.port
@@ -1599,44 +1677,62 @@ rcvQueueQuery =
 
 toRcvQueue ::
   (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateSignKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, QueueStatus)
-    :. (Int64, Bool, Maybe Int64, Maybe Version, Int)
+    :. (Int64, Bool, Maybe Int64, Maybe RcvSwitchStatus, Maybe Version, Int)
     :. (Maybe SMP.NtfPublicVerifyKey, Maybe SMP.NtfPrivateSignKey, Maybe SMP.NotifierId, Maybe RcvNtfDhSecret) ->
   RcvQueue
-toRcvQueue ((userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status) :. (dbQueueId, primary, dbReplaceQueueId, smpClientVersion_, deleteErrors) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
+toRcvQueue ((userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status) :. (dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion_, deleteErrors) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
   let server = SMPServer host port keyHash
       smpClientVersion = fromMaybe 1 smpClientVersion_
       clientNtfCreds = case (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_) of
         (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just $ ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
         _ -> Nothing
-   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status, dbQueueId, primary, dbReplaceQueueId, smpClientVersion, clientNtfCreds, deleteErrors}
+   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
 
-getRcvQueueById_ :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError RcvQueue)
-getRcvQueueById_ db connId dbRcvId =
+getRcvQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError RcvQueue)
+getRcvQueueById db connId dbRcvId =
   firstRow toRcvQueue SEConnNotFound $
-    DB.query db (rcvQueueQuery <> " WHERE q.conn_id = ? AND q.rcv_queue_id = ?") (connId, dbRcvId)
+    DB.query db (rcvQueueQuery <> " WHERE q.conn_id = ? AND q.rcv_queue_id = ? AND q.deleted = 0") (connId, dbRcvId)
 
 -- | returns all connection queues, the first queue is the primary one
 getSndQueuesByConnId_ :: DB.Connection -> ConnId -> IO (Maybe (NonEmpty SndQueue))
 getSndQueuesByConnId_ dbConn connId =
-  L.nonEmpty . sortBy primaryFirst . map sndQueue
-    <$> DB.query
-      dbConn
-      [sql|
-        SELECT c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.host, q.port, q.snd_id, q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status, q.snd_queue_id, q.snd_primary, q.replace_snd_queue_id, q.smp_client_version
-        FROM snd_queues q
-        JOIN servers s ON q.host = s.host AND q.port = s.port
-        JOIN connections c ON q.conn_id = c.conn_id
-        WHERE q.conn_id = ?;
-      |]
-      (Only connId)
+  L.nonEmpty . sortBy primaryFirst . map toSndQueue
+    <$> DB.query dbConn (sndQueueQuery <> "WHERE q.conn_id = ?") (Only connId)
   where
-    sndQueue ((userId, keyHash, host, port, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status) :. (dbQueueId, primary, dbReplaceQueueId, smpClientVersion)) =
-      let server = SMPServer host port keyHash
-       in SndQueue {userId, connId, server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, smpClientVersion}
     primaryFirst SndQueue {primary = p, dbReplaceQueueId = i} SndQueue {primary = p', dbReplaceQueueId = i'} =
       -- the current primary queue is ordered first, the next primary - second
       compare (Down p) (Down p') <> compare i i'
 
+sndQueueQuery :: Query
+sndQueueQuery =
+  [sql|
+    SELECT
+      c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id,
+      q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status,
+      q.snd_queue_id, q.snd_primary, q.replace_snd_queue_id, q.switch_status, q.smp_client_version
+    FROM snd_queues q
+    JOIN servers s ON q.host = s.host AND q.port = s.port
+    JOIN connections c ON q.conn_id = c.conn_id
+  |]
+
+toSndQueue ::
+  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId)
+    :. (Maybe C.APublicVerifyKey, SndPrivateSignKey, Maybe C.PublicKeyX25519, C.DhSecretX25519, QueueStatus)
+    :. (Int64, Bool, Maybe Int64, Maybe SndSwitchStatus, Version) ->
+  SndQueue
+toSndQueue
+  ( (userId, keyHash, connId, host, port, sndId)
+      :. (sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)
+      :. (dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion)
+    ) =
+    let server = SMPServer host port keyHash
+     in SndQueue {userId, connId, server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion}
+
+getSndQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError SndQueue)
+getSndQueueById db connId dbSndId =
+  firstRow toSndQueue SEConnNotFound $
+    DB.query db (sndQueueQuery <> " WHERE q.conn_id = ? AND q.snd_queue_id = ?") (connId, dbSndId)
+
 -- * updateRcvIds helpers
 
 retrieveLastIdsAndHashRcv_ :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
@@ -1690,10 +1786,10 @@ insertRcvMsgBase_ dbConn connId RcvMsgData {msgMeta, msgType, msgFlags, msgBody,
     ]
 
 insertRcvMsgDetails_ :: DB.Connection -> ConnId -> RcvQueue -> RcvMsgData -> IO ()
-insertRcvMsgDetails_ dbConn connId RcvQueue {dbQueueId} RcvMsgData {msgMeta, internalRcvId, internalHash, externalPrevSndHash} = do
+insertRcvMsgDetails_ db connId RcvQueue {dbQueueId} RcvMsgData {msgMeta, internalRcvId, internalHash, externalPrevSndHash, encryptedMsgHash} = do
   let MsgMeta {integrity, recipient, broker, sndMsgId} = msgMeta
   DB.executeNamed
-    dbConn
+    db
     [sql|
       INSERT INTO rcv_messages
         ( conn_id, rcv_queue_id, internal_rcv_id, internal_id, external_snd_id,
@@ -1715,6 +1811,7 @@ insertRcvMsgDetails_ dbConn connId RcvQueue {dbQueueId} RcvMsgData {msgMeta, int
       ":external_prev_snd_hash" := externalPrevSndHash,
       ":integrity" := integrity
     ]
+  DB.execute db "INSERT INTO encrypted_rcv_message_hashes (conn_id, hash) VALUES (?,?)" (connId, encryptedMsgHash)
 
 updateHashRcv_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
 updateHashRcv_ dbConn connId RcvMsgData {msgMeta, internalHash, internalRcvId} =
@@ -1888,15 +1985,15 @@ createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath save
         "INSERT INTO rcv_file_chunk_replicas (replica_number, rcv_file_chunk_id, xftp_server_id, replica_id, replica_key) VALUES (?,?,?,?,?)"
         (replicaNo, chunkId, srvId, replicaId, replicaKey)
 
-getRcvFileByEntityId :: DB.Connection -> UserId -> RcvFileId -> IO (Either StoreError RcvFile)
-getRcvFileByEntityId db userId rcvFileEntityId = runExceptT $ do
-  rcvFileId <- ExceptT $ getRcvFileIdByEntityId_ db userId rcvFileEntityId
+getRcvFileByEntityId :: DB.Connection -> RcvFileId -> IO (Either StoreError RcvFile)
+getRcvFileByEntityId db rcvFileEntityId = runExceptT $ do
+  rcvFileId <- ExceptT $ getRcvFileIdByEntityId_ db rcvFileEntityId
   ExceptT $ getRcvFile db rcvFileId
 
-getRcvFileIdByEntityId_ :: DB.Connection -> UserId -> RcvFileId -> IO (Either StoreError DBRcvFileId)
-getRcvFileIdByEntityId_ db userId rcvFileEntityId =
+getRcvFileIdByEntityId_ :: DB.Connection -> RcvFileId -> IO (Either StoreError DBRcvFileId)
+getRcvFileIdByEntityId_ db rcvFileEntityId =
   firstRow fromOnly SEFileNotFound $
-    DB.query db "SELECT rcv_file_id FROM rcv_files WHERE user_id = ? AND rcv_file_entity_id = ?" (userId, rcvFileEntityId)
+    DB.query db "SELECT rcv_file_id FROM rcv_files WHERE rcv_file_entity_id = ?" (Only rcvFileEntityId)
 
 getRcvFile :: DB.Connection -> DBRcvFileId -> IO (Either StoreError RcvFile)
 getRcvFile db rcvFileId = runExceptT $ do
@@ -2115,15 +2212,15 @@ createSndFile db gVar userId numRecipients path prefixPath key nonce =
       "INSERT INTO snd_files (snd_file_entity_id, user_id, num_recipients, key, nonce, path, prefix_path, status) VALUES (?,?,?,?,?,?,?,?)"
       (sndFileEntityId, userId, numRecipients, key, nonce, path, prefixPath, SFSNew)
 
-getSndFileByEntityId :: DB.Connection -> UserId -> SndFileId -> IO (Either StoreError SndFile)
-getSndFileByEntityId db userId sndFileEntityId = runExceptT $ do
-  sndFileId <- ExceptT $ getSndFileIdByEntityId_ db userId sndFileEntityId
+getSndFileByEntityId :: DB.Connection -> SndFileId -> IO (Either StoreError SndFile)
+getSndFileByEntityId db sndFileEntityId = runExceptT $ do
+  sndFileId <- ExceptT $ getSndFileIdByEntityId_ db sndFileEntityId
   ExceptT $ getSndFile db sndFileId
 
-getSndFileIdByEntityId_ :: DB.Connection -> UserId -> SndFileId -> IO (Either StoreError DBSndFileId)
-getSndFileIdByEntityId_ db userId sndFileEntityId =
+getSndFileIdByEntityId_ :: DB.Connection -> SndFileId -> IO (Either StoreError DBSndFileId)
+getSndFileIdByEntityId_ db sndFileEntityId =
   firstRow fromOnly SEFileNotFound $
-    DB.query db "SELECT snd_file_id FROM snd_files WHERE user_id = ? AND snd_file_entity_id = ?" (userId, sndFileEntityId)
+    DB.query db "SELECT snd_file_id FROM snd_files WHERE snd_file_entity_id = ?" (Only sndFileEntityId)
 
 getSndFile :: DB.Connection -> DBSndFileId -> IO (Either StoreError SndFile)
 getSndFile db sndFileId = runExceptT $ do

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

@@ -58,6 +58,9 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -82,7 +85,10 @@ schemaMigrations =
     ("m20230217_server_key_hash", m20230217_server_key_hash, Nothing),
     ("m20230223_files", m20230223_files, Just down_m20230223_files),
     ("m20230320_retry_state", m20230320_retry_state, Just down_m20230320_retry_state),
-    ("m20230401_snd_files", m20230401_snd_files, Just down_m20230401_snd_files)
+    ("m20230401_snd_files", m20230401_snd_files, Just down_m20230401_snd_files),
+    ("m20230510_files_pending_replicas_indexes", m20230510_files_pending_replicas_indexes, Just down_m20230510_files_pending_replicas_indexes),
+    ("m20230516_encrypted_rcv_message_hashes", m20230516_encrypted_rcv_message_hashes, Just down_m20230516_encrypted_rcv_message_hashes),
+    ("m20230531_switch_status", m20230531_switch_status, Just down_m20230531_switch_status)
   ]
 
 -- | The list of migrations in ascending order by date
@@ -101,7 +107,8 @@ getCurrent db = map toMigration <$> DB.query_ db "SELECT name, down FROM migrati
 
 run :: Connection -> MigrationsToRun -> IO ()
 run db = \case
-  MTRUp ms -> mapM_ runUp ms
+  MTRUp [] -> pure ()
+  MTRUp ms -> mapM_ runUp ms >> execSQL "VACUUM;"
   MTRDown ms -> mapM_ runDown $ reverse ms
   MTRNone -> pure ()
   where

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

@@ -0,0 +1,22 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230510_files_pending_replicas_indexes :: Query
+m20230510_files_pending_replicas_indexes =
+  [sql|
+CREATE INDEX idx_rcv_file_chunk_replicas_pending ON rcv_file_chunk_replicas(received, replica_number);
+CREATE INDEX idx_snd_file_chunk_replicas_pending ON snd_file_chunk_replicas(replica_status, replica_number);
+CREATE INDEX idx_deleted_snd_chunk_replicas_pending ON deleted_snd_chunk_replicas(created_at);
+|]
+
+down_m20230510_files_pending_replicas_indexes :: Query
+down_m20230510_files_pending_replicas_indexes =
+  [sql|
+DROP INDEX idx_deleted_snd_chunk_replicas_pending;
+DROP INDEX idx_snd_file_chunk_replicas_pending;
+DROP INDEX idx_rcv_file_chunk_replicas_pending;
+|]

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

@@ -0,0 +1,28 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230516_encrypted_rcv_message_hashes :: Query
+m20230516_encrypted_rcv_message_hashes =
+  [sql|
+CREATE TABLE encrypted_rcv_message_hashes(
+  encrypted_rcv_message_hash_id INTEGER PRIMARY KEY,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  hash BLOB NOT NULL,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+CREATE INDEX idx_encrypted_rcv_message_hashes_hash ON encrypted_rcv_message_hashes(conn_id, hash);
+|]
+
+down_m20230516_encrypted_rcv_message_hashes :: Query
+down_m20230516_encrypted_rcv_message_hashes =
+  [sql|
+DROP INDEX idx_encrypted_rcv_message_hashes_hash;
+
+DROP TABLE encrypted_rcv_message_hashes;
+|]

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

@@ -0,0 +1,22 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230531_switch_status :: Query
+m20230531_switch_status =
+  [sql|
+ALTER TABLE rcv_queues ADD COLUMN switch_status TEXT;
+ALTER TABLE rcv_queues ADD COLUMN deleted INTEGER NOT NULL DEFAULT 0;
+ALTER TABLE snd_queues ADD COLUMN switch_status TEXT;
+|]
+
+down_m20230531_switch_status :: Query
+down_m20230531_switch_status =
+  [sql|
+ALTER TABLE snd_queues DROP COLUMN switch_status;
+ALTER TABLE rcv_queues DROP COLUMN deleted;
+ALTER TABLE rcv_queues DROP COLUMN switch_status;
+|]

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

@@ -50,6 +50,8 @@ CREATE TABLE rcv_queues(
   replace_rcv_queue_id INTEGER NULL,
   delete_errors INTEGER DEFAULT 0 CHECK(delete_errors NOT NULL),
   server_key_hash BLOB,
+  switch_status TEXT,
+  deleted INTEGER NOT NULL DEFAULT 0,
   PRIMARY KEY(host, port, rcv_id),
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE,
@@ -71,6 +73,7 @@ CREATE TABLE snd_queues(
   snd_primary INTEGER CHECK(snd_primary NOT NULL),
   replace_snd_queue_id INTEGER NULL,
   server_key_hash BLOB,
+  switch_status TEXT,
   PRIMARY KEY(host, port, snd_id),
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE
@@ -188,7 +191,6 @@ tkn_dh_secret BLOB, -- DH secret for e2e encryption of notifications
   FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
   ON DELETE RESTRICT ON UPDATE CASCADE
 ) WITHOUT ROWID;
-CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
 CREATE TABLE ntf_subscriptions(
   conn_id BLOB NOT NULL,
   smp_host TEXT NULL,
@@ -224,8 +226,6 @@ CREATE TABLE commands(
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE
 );
-CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id);
-CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id);
 CREATE TABLE snd_message_deliveries(
   snd_message_delivery_id INTEGER PRIMARY KEY AUTOINCREMENT,
   conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
@@ -234,15 +234,135 @@ CREATE TABLE snd_message_deliveries(
   FOREIGN KEY(conn_id, internal_id) REFERENCES messages ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
 );
 CREATE TABLE sqlite_sequence(name,seq);
-CREATE INDEX idx_snd_message_deliveries ON snd_message_deliveries(
-  conn_id,
-  snd_queue_id
-);
 CREATE TABLE users(
   user_id INTEGER PRIMARY KEY AUTOINCREMENT
   ,
   deleted INTEGER DEFAULT 0 CHECK(deleted NOT NULL)
 );
+CREATE TABLE xftp_servers(
+  xftp_server_id INTEGER PRIMARY KEY,
+  xftp_host TEXT NOT NULL,
+  xftp_port TEXT NOT NULL,
+  xftp_key_hash BLOB NOT NULL,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
+  UNIQUE(xftp_host, xftp_port, xftp_key_hash)
+);
+CREATE TABLE rcv_files(
+  rcv_file_id INTEGER PRIMARY KEY,
+  rcv_file_entity_id BLOB NOT NULL,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  size INTEGER NOT NULL,
+  digest BLOB NOT NULL,
+  key BLOB NOT NULL,
+  nonce BLOB NOT NULL,
+  chunk_size INTEGER NOT NULL,
+  prefix_path TEXT NOT NULL,
+  tmp_path TEXT,
+  save_path TEXT NOT NULL,
+  status TEXT NOT NULL,
+  deleted INTEGER NOT NULL DEFAULT 0,
+  error TEXT,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
+  UNIQUE(rcv_file_entity_id)
+);
+CREATE TABLE rcv_file_chunks(
+  rcv_file_chunk_id INTEGER PRIMARY KEY,
+  rcv_file_id INTEGER NOT NULL REFERENCES rcv_files ON DELETE CASCADE,
+  chunk_no INTEGER NOT NULL,
+  chunk_size INTEGER NOT NULL,
+  digest BLOB NOT NULL,
+  tmp_path TEXT,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE rcv_file_chunk_replicas(
+  rcv_file_chunk_replica_id INTEGER PRIMARY KEY,
+  rcv_file_chunk_id INTEGER NOT NULL REFERENCES rcv_file_chunks ON DELETE CASCADE,
+  replica_number INTEGER NOT NULL,
+  xftp_server_id INTEGER NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
+  replica_id BLOB NOT NULL,
+  replica_key BLOB NOT NULL,
+  received INTEGER NOT NULL DEFAULT 0,
+  delay INTEGER,
+  retries INTEGER NOT NULL DEFAULT 0,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE snd_files(
+  snd_file_id INTEGER PRIMARY KEY,
+  snd_file_entity_id BLOB NOT NULL,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  num_recipients INTEGER NOT NULL,
+  digest BLOB,
+  key BLOB NOT NUll,
+  nonce BLOB NOT NUll,
+  path TEXT NOT NULL,
+  prefix_path TEXT,
+  status TEXT NOT NULL,
+  deleted INTEGER NOT NULL DEFAULT 0,
+  error TEXT,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE snd_file_chunks(
+  snd_file_chunk_id INTEGER PRIMARY KEY,
+  snd_file_id INTEGER NOT NULL REFERENCES snd_files ON DELETE CASCADE,
+  chunk_no INTEGER NOT NULL,
+  chunk_offset INTEGER NOT NULL,
+  chunk_size INTEGER NOT NULL,
+  digest BLOB NOT NULL,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE snd_file_chunk_replicas(
+  snd_file_chunk_replica_id INTEGER PRIMARY KEY,
+  snd_file_chunk_id INTEGER NOT NULL REFERENCES snd_file_chunks ON DELETE CASCADE,
+  replica_number INTEGER NOT NULL,
+  xftp_server_id INTEGER NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
+  replica_id BLOB NOT NULL,
+  replica_key BLOB NOT NULL,
+  replica_status TEXT NOT NULL,
+  delay INTEGER,
+  retries INTEGER NOT NULL DEFAULT 0,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE snd_file_chunk_replica_recipients(
+  snd_file_chunk_replica_recipient_id INTEGER PRIMARY KEY,
+  snd_file_chunk_replica_id INTEGER NOT NULL REFERENCES snd_file_chunk_replicas ON DELETE CASCADE,
+  rcv_replica_id BLOB NOT NULL,
+  rcv_replica_key BLOB NOT NULL,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE deleted_snd_chunk_replicas(
+  deleted_snd_chunk_replica_id INTEGER PRIMARY KEY,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  xftp_server_id INTEGER NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
+  replica_id BLOB NOT NULL,
+  replica_key BLOB NOT NULL,
+  chunk_digest BLOB NOT NULL,
+  delay INTEGER,
+  retries INTEGER NOT NULL DEFAULT 0,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE encrypted_rcv_message_hashes(
+  encrypted_rcv_message_hash_id INTEGER PRIMARY KEY,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  hash BLOB NOT NULL,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
+CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id);
+CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id);
+CREATE INDEX idx_snd_message_deliveries ON snd_message_deliveries(
+  conn_id,
+  snd_queue_id
+);
 CREATE INDEX idx_connections_user ON connections(user_id);
 CREATE INDEX idx_commands_conn_id ON commands(conn_id);
 CREATE INDEX idx_commands_host_port ON commands(host, port);
@@ -286,138 +406,43 @@ CREATE INDEX idx_snd_messages_conn_id_internal_id ON snd_messages(
   internal_id
 );
 CREATE INDEX idx_snd_queues_host_port ON snd_queues(host, port);
-CREATE TABLE xftp_servers(
-  xftp_server_id INTEGER PRIMARY KEY,
-  xftp_host TEXT NOT NULL,
-  xftp_port TEXT NOT NULL,
-  xftp_key_hash BLOB NOT NULL,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
-  UNIQUE(xftp_host, xftp_port, xftp_key_hash)
-);
-CREATE TABLE rcv_files(
-  rcv_file_id INTEGER PRIMARY KEY,
-  rcv_file_entity_id BLOB NOT NULL,
-  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
-  size INTEGER NOT NULL,
-  digest BLOB NOT NULL,
-  key BLOB NOT NULL,
-  nonce BLOB NOT NULL,
-  chunk_size INTEGER NOT NULL,
-  prefix_path TEXT NOT NULL,
-  tmp_path TEXT,
-  save_path TEXT NOT NULL,
-  status TEXT NOT NULL,
-  deleted INTEGER NOT NULL DEFAULT 0,
-  error TEXT,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
-  UNIQUE(rcv_file_entity_id)
-);
 CREATE INDEX idx_rcv_files_user_id ON rcv_files(user_id);
-CREATE TABLE rcv_file_chunks(
-  rcv_file_chunk_id INTEGER PRIMARY KEY,
-  rcv_file_id INTEGER NOT NULL REFERENCES rcv_files ON DELETE CASCADE,
-  chunk_no INTEGER NOT NULL,
-  chunk_size INTEGER NOT NULL,
-  digest BLOB NOT NULL,
-  tmp_path TEXT,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
-);
 CREATE INDEX idx_rcv_file_chunks_rcv_file_id ON rcv_file_chunks(rcv_file_id);
-CREATE TABLE rcv_file_chunk_replicas(
-  rcv_file_chunk_replica_id INTEGER PRIMARY KEY,
-  rcv_file_chunk_id INTEGER NOT NULL REFERENCES rcv_file_chunks ON DELETE CASCADE,
-  replica_number INTEGER NOT NULL,
-  xftp_server_id INTEGER NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
-  replica_id BLOB NOT NULL,
-  replica_key BLOB NOT NULL,
-  received INTEGER NOT NULL DEFAULT 0,
-  delay INTEGER,
-  retries INTEGER NOT NULL DEFAULT 0,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
-);
 CREATE INDEX idx_rcv_file_chunk_replicas_rcv_file_chunk_id ON rcv_file_chunk_replicas(
   rcv_file_chunk_id
 );
 CREATE INDEX idx_rcv_file_chunk_replicas_xftp_server_id ON rcv_file_chunk_replicas(
   xftp_server_id
 );
-CREATE TABLE snd_files(
-  snd_file_id INTEGER PRIMARY KEY,
-  snd_file_entity_id BLOB NOT NULL,
-  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
-  num_recipients INTEGER NOT NULL,
-  digest BLOB,
-  key BLOB NOT NUll,
-  nonce BLOB NOT NUll,
-  path TEXT NOT NULL,
-  prefix_path TEXT,
-  status TEXT NOT NULL,
-  deleted INTEGER NOT NULL DEFAULT 0,
-  error TEXT,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
-);
 CREATE INDEX idx_snd_files_user_id ON snd_files(user_id);
-CREATE TABLE snd_file_chunks(
-  snd_file_chunk_id INTEGER PRIMARY KEY,
-  snd_file_id INTEGER NOT NULL REFERENCES snd_files ON DELETE CASCADE,
-  chunk_no INTEGER NOT NULL,
-  chunk_offset INTEGER NOT NULL,
-  chunk_size INTEGER NOT NULL,
-  digest BLOB NOT NULL,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
-);
 CREATE INDEX idx_snd_file_chunks_snd_file_id ON snd_file_chunks(snd_file_id);
-CREATE TABLE snd_file_chunk_replicas(
-  snd_file_chunk_replica_id INTEGER PRIMARY KEY,
-  snd_file_chunk_id INTEGER NOT NULL REFERENCES snd_file_chunks ON DELETE CASCADE,
-  replica_number INTEGER NOT NULL,
-  xftp_server_id INTEGER NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
-  replica_id BLOB NOT NULL,
-  replica_key BLOB NOT NULL,
-  replica_status TEXT NOT NULL,
-  delay INTEGER,
-  retries INTEGER NOT NULL DEFAULT 0,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
-);
 CREATE INDEX idx_snd_file_chunk_replicas_snd_file_chunk_id ON snd_file_chunk_replicas(
   snd_file_chunk_id
 );
 CREATE INDEX idx_snd_file_chunk_replicas_xftp_server_id ON snd_file_chunk_replicas(
   xftp_server_id
 );
-CREATE TABLE snd_file_chunk_replica_recipients(
-  snd_file_chunk_replica_recipient_id INTEGER PRIMARY KEY,
-  snd_file_chunk_replica_id INTEGER NOT NULL REFERENCES snd_file_chunk_replicas ON DELETE CASCADE,
-  rcv_replica_id BLOB NOT NULL,
-  rcv_replica_key BLOB NOT NULL,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
-);
 CREATE INDEX idx_snd_file_chunk_replica_recipients_snd_file_chunk_replica_id ON snd_file_chunk_replica_recipients(
   snd_file_chunk_replica_id
 );
-CREATE TABLE deleted_snd_chunk_replicas(
-  deleted_snd_chunk_replica_id INTEGER PRIMARY KEY,
-  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
-  xftp_server_id INTEGER NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
-  replica_id BLOB NOT NULL,
-  replica_key BLOB NOT NULL,
-  chunk_digest BLOB NOT NULL,
-  delay INTEGER,
-  retries INTEGER NOT NULL DEFAULT 0,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
-);
 CREATE INDEX idx_deleted_snd_chunk_replicas_user_id ON deleted_snd_chunk_replicas(
   user_id
 );
 CREATE INDEX idx_deleted_snd_chunk_replicas_xftp_server_id ON deleted_snd_chunk_replicas(
   xftp_server_id
 );
+CREATE INDEX idx_rcv_file_chunk_replicas_pending ON rcv_file_chunk_replicas(
+  received,
+  replica_number
+);
+CREATE INDEX idx_snd_file_chunk_replicas_pending ON snd_file_chunk_replicas(
+  replica_status,
+  replica_number
+);
+CREATE INDEX idx_deleted_snd_chunk_replicas_pending ON deleted_snd_chunk_replicas(
+  created_at
+);
+CREATE INDEX idx_encrypted_rcv_message_hashes_hash ON encrypted_rcv_message_hashes(
+  conn_id,
+  hash
+);

src/Simplex/Messaging/Client.hs

@@ -41,6 +41,7 @@ module Simplex.Messaging.Client
     subscribeSMPQueues,
     getSMPMessage,
     subscribeSMPQueueNotifications,
+    subscribeSMPQueuesNtfs,
     secureSMPQueue,
     enableSMPQueueNotifications,
     disableSMPQueueNotifications,
@@ -487,6 +488,16 @@ getSMPMessage c rpKey rId =
 subscribeSMPQueueNotifications :: SMPClient -> NtfPrivateSignKey -> NotifierId -> ExceptT SMPClientError IO ()
 subscribeSMPQueueNotifications = okSMPCommand NSUB
 
+-- | Subscribe to multiple SMP queues notifications batching commands if supported.
+subscribeSMPQueuesNtfs :: SMPClient -> NonEmpty (NtfPrivateSignKey, NotifierId) -> IO (NonEmpty (Either SMPClientError ()))
+subscribeSMPQueuesNtfs c qs = sendProtocolCommands c cs >>= mapM response
+  where
+    cs = L.map (\(npKey, nId) -> (Just npKey, nId, Cmd SNotifier NSUB)) qs
+    response r = pure $ case r of
+      Right OK -> Right ()
+      Right r' -> Left . PCEUnexpectedResponse $ bshow r'
+      Left e -> Left e
+
 -- | Secure the SMP queue by adding a sender public key.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#secure-queue-command

src/Simplex/Messaging/Client/Agent.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -16,27 +17,33 @@ import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except
+import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.List (find, partition)
+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.Set (Set)
 import Data.Text.Encoding
+import Data.Tuple (swap)
 import Numeric.Natural
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, SMPServer)
+import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, SMPServer, NtfPrivateSignKey, NotifierId, RcvPrivateSignKey, RecipientId)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Util (catchAll_, tryE, unlessM, ($>>=))
+import Simplex.Messaging.Util (catchAll_, tryE, ($>>=))
 import System.Timeout (timeout)
-import UnliftIO (async, forConcurrently_)
+import UnliftIO (async)
 import UnliftIO.Exception (Exception)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
+import Data.Either (isLeft)
 
 type SMPClientVar = TMVar (Either SMPClientError SMPClient)
 
@@ -184,9 +191,9 @@ getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ} srv =
             _ -> TM.insert srv sVar ps
 
     serverDown :: Map SMPSub C.APrivateSignKey -> IO ()
-    serverDown ss = unless (M.null ss) . void . runExceptT $ do
+    serverDown ss = unless (M.null ss) $ do
       notify . CADisconnected srv $ M.keysSet ss
-      reconnectServer
+      void $ runExceptT reconnectServer
 
     reconnectServer :: ExceptT SMPClientError IO ()
     reconnectServer = do
@@ -201,27 +208,47 @@ getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ} srv =
     reconnectClient :: ExceptT SMPClientError IO ()
     reconnectClient = do
       withSMP ca srv $ \smp -> do
-        notify $ CAReconnected srv
-        cs <- atomically $ mapM readTVar =<< TM.lookup srv (pendingSrvSubs ca)
-        forConcurrently_ (maybe [] M.assocs cs) $ \sub@(s, _) ->
-          unlessM (atomically $ hasSub (srvSubs ca) srv s) $
-            subscribe_ smp sub `catchE` handleError s
+        liftIO . notify $ CAReconnected srv
+        cs_ <- atomically $ mapM readTVar =<< TM.lookup srv (pendingSrvSubs ca)
+        forM_ cs_ $ \cs -> do
+          subs' <- filterM (fmap not . atomically . hasSub (srvSubs ca) srv . fst) $ M.assocs cs
+          let (nSubs, rSubs) = partition (isNotifier . fst . fst) subs'
+          nRs <- liftIO $ subscribe_ smp SPNotifier nSubs
+          rRs <- liftIO $ subscribe_ smp SPRecipient rSubs
+          case find isLeft $ nRs <> rRs of
+            Just (Left e) -> throwE e
+            _ -> pure ()
       where
-        subscribe_ :: SMPClient -> (SMPSub, C.APrivateSignKey) -> ExceptT SMPClientError IO ()
-        subscribe_ smp sub@(s, _) = do
-          smpSubscribe smp sub
-          atomically $ addSubscription ca srv sub
-          notify $ CAResubscribed srv s
+        isNotifier = \case
+          SPNotifier -> True
+          SPRecipient -> False
 
-        handleError :: SMPSub -> SMPClientError -> ExceptT SMPClientError IO ()
-        handleError s = \case
-          e@PCEResponseTimeout -> throwE e
-          e@PCENetworkError -> throwE e
-          e -> do
-            notify $ CASubError srv s e
-            atomically $ removePendingSubscription ca srv s
+        subscribe_ :: SMPClient -> SMPSubParty -> [(SMPSub, C.APrivateSignKey)] -> IO [Either SMPClientError ()]
+        subscribe_ smp party subs =
+          case L.nonEmpty subs of
+            Just subs' -> do
+              let subs'' = L.map (first snd) subs'
+              rs <- L.zip subs'' <$> smpSubscribeQueues party ca smp srv subs''
+              rs' <- forM rs $ \(sub, r) -> do
+                let sub' = first (party,) sub
+                    s = fst sub'
+                case snd r of
+                  Right () -> do
+                    atomically $ addSubscription ca srv sub'
+                    notify $ CAResubscribed srv s
+                    pure $ Right ()
+                  Left e -> do
+                    case e of
+                      PCEResponseTimeout -> pure $ Left e
+                      PCENetworkError -> pure $ Left e
+                      _ -> do
+                        notify $ CASubError srv s e
+                        atomically $ removePendingSubscription ca srv s
+                        pure $ Right ()
+              pure $ L.toList rs'
+            Nothing -> pure []
 
-    notify :: SMPClientAgentEvent -> ExceptT SMPClientError IO ()
+    notify :: SMPClientAgentEvent -> IO ()
     notify evt = atomically $ writeTBQueue (agentQ ca) evt
 
 closeSMPClientAgent :: MonadUnliftIO m => SMPClientAgent -> m ()
@@ -263,6 +290,35 @@ subscribeQueue ca srv sub = do
         removePendingSubscription ca srv $ fst sub
       throwE e
 
+subscribeQueuesSMP :: SMPClientAgent -> SMPServer -> NonEmpty (RecipientId, RcvPrivateSignKey) -> IO (NonEmpty (RecipientId, Either SMPClientError ()))
+subscribeQueuesSMP = subscribeQueues_ SPRecipient
+
+subscribeQueuesNtfs :: SMPClientAgent -> SMPServer -> NonEmpty (NotifierId, NtfPrivateSignKey) -> IO (NonEmpty (NotifierId, Either SMPClientError ()))
+subscribeQueuesNtfs = subscribeQueues_ SPNotifier
+
+subscribeQueues_ :: SMPSubParty -> SMPClientAgent -> SMPServer -> NonEmpty (QueueId, C.APrivateSignKey) -> IO (NonEmpty (QueueId, Either SMPClientError ()))
+subscribeQueues_ party ca srv subs = do
+  atomically $ forM_ subs $ addPendingSubscription ca srv . first (party,)
+  runExceptT (getSMPServerClient' ca srv) >>= \case
+    Left e -> pure $ L.map ((,Left e) . fst) subs
+    Right smp -> smpSubscribeQueues party ca smp srv subs
+
+smpSubscribeQueues :: SMPSubParty -> SMPClientAgent -> SMPClient -> SMPServer -> NonEmpty (QueueId, C.APrivateSignKey) -> IO (NonEmpty (QueueId, Either SMPClientError ()))
+smpSubscribeQueues party ca smp srv subs = do
+  rs <- L.zip subs <$> subscribe smp (L.map swap subs)
+  atomically $ forM rs $ \(sub, r) -> (fst sub,) <$> case r of
+    Right () -> do
+      addSubscription ca srv $ first (party,) sub
+      pure $ Right ()
+    Left e -> do
+      when (e /= PCENetworkError && e /= PCEResponseTimeout) $
+        removePendingSubscription ca srv $ (party,) $ fst sub
+      pure $ Left e
+  where
+    subscribe = case party of
+      SPRecipient -> subscribeSMPQueues
+      SPNotifier -> subscribeSMPQueuesNtfs
+
 showServer :: SMPServer -> ByteString
 showServer ProtocolServer {host, port} =
   strEncode host <> B.pack (if null port then "" else ':' : port)

src/Simplex/Messaging/Notifications/Server.hs

@@ -18,10 +18,14 @@ import Control.Monad.Except
 import Control.Monad.Reader
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Function (on)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (intercalate)
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
@@ -55,6 +59,7 @@ import UnliftIO.Concurrent (forkIO, killThread, mkWeakThreadId, threadDelay)
 import UnliftIO.Directory (doesFileExist, renameFile)
 import UnliftIO.Exception
 import UnliftIO.STM
+import Data.Bifunctor (second)
 
 runNtfServer :: NtfServerConfig -> IO ()
 runNtfServer cfg = do
@@ -141,11 +146,8 @@ ntfServer cfg@NtfServerConfig {transports, logTLSErrors} started = do
 
 resubscribe :: NtfSubscriber -> Map NtfSubscriptionId NtfSubData -> M ()
 resubscribe NtfSubscriber {newSubQ} subs = do
-  d <- asks $ resubscribeDelay . config
-  forM_ subs $ \sub@NtfSubData {} ->
-    whenM (ntfShouldSubscribe <$> readTVarIO (subStatus sub)) $ do
-      atomically $ writeTBQueue newSubQ $ NtfSub sub
-      threadDelay d
+  subs' <- atomically $ filterM (fmap ntfShouldSubscribe . readTVar . subStatus) $ M.elems subs
+  mapM_ (atomically . writeTBQueue newSubQ . L.map NtfSub) $ L.nonEmpty subs'
   liftIO $ logInfo "SMP connections resubscribed"
 
 ntfSubscriber :: NtfSubscriber -> M ()
@@ -153,12 +155,18 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
   raceAny_ [subscribe, receiveSMP, receiveAgent]
   where
     subscribe :: M ()
-    subscribe =
-      forever $
-        atomically (readTBQueue newSubQ) >>= \case
-          sub@(NtfSub NtfSubData {smpQueue = SMPQueueNtf {smpServer}}) -> do
-            SMPSubscriber {newSubQ = subscriberSubQ} <- getSMPSubscriber smpServer
-            atomically $ writeTQueue subscriberSubQ sub
+    subscribe = do
+      d <- asks $ resubscribeDelay . config
+      forever $ do
+        subs <- atomically (readTBQueue newSubQ)
+        let ss = L.groupBy ((==) `on` server) subs
+        forM_ ss $ \serverSubs -> do
+          SMPSubscriber {newSubQ = subscriberSubQ} <- getSMPSubscriber $ server $ L.head serverSubs
+          atomically $ writeTQueue subscriberSubQ serverSubs
+          when (length serverSubs > 10) $ threadDelay d
+
+    server :: NtfEntityRec 'Subscription -> SMPServer
+    server (NtfSub sub) = ntfSubServer sub
 
     getSMPSubscriber :: SMPServer -> M SMPSubscriber
     getSMPSubscriber smpServer =
@@ -173,21 +181,31 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
 
     runSMPSubscriber :: SMPSubscriber -> M ()
     runSMPSubscriber SMPSubscriber {newSubQ = subscriberSubQ} =
-      forever $
-        atomically (peekTQueue subscriberSubQ)
-          >>= \(NtfSub NtfSubData {smpQueue, notifierKey}) -> do
-            updateSubStatus smpQueue NSPending
-            let SMPQueueNtf {smpServer, notifierId} = smpQueue
-            liftIO (runExceptT $ subscribeQueue ca smpServer ((SPNotifier, notifierId), notifierKey)) >>= \case
-              Right _ -> do
-                updateSubStatus smpQueue NSActive
-                void . atomically $ readTQueue subscriberSubQ
-              Left err -> do
-                handleSubError smpQueue err
-                case err of
-                  PCEResponseTimeout -> pure ()
-                  PCENetworkError -> pure ()
-                  _ -> void . atomically $ readTQueue subscriberSubQ
+      forever $ do
+        subs <- atomically (peekTQueue subscriberSubQ)
+        let subs' = L.map (\(NtfSub sub) -> sub) subs
+        mapM_ (\NtfSubData {smpQueue} -> updateSubStatus smpQueue NSPending) subs'
+        rs <- liftIO $ subscribeQueues (server $ L.head subs) subs'
+        subs_ <- L.nonEmpty <$> foldM process [] rs
+        atomically $ do
+          void $ readTQueue subscriberSubQ
+          mapM_ (writeTQueue subscriberSubQ . L.map NtfSub) subs_
+      where
+        process subs (sub@NtfSubData {smpQueue}, r) = case r of
+          Right _ -> updateSubStatus smpQueue NSActive $> subs
+          Left err -> do
+            handleSubError smpQueue err
+            pure $ case err of
+              PCEResponseTimeout -> sub : subs
+              PCENetworkError -> sub : subs
+              _ -> subs
+
+    -- | Subscribe to queues. The list of results can have a different order.
+    subscribeQueues :: SMPServer -> NonEmpty NtfSubData -> IO (NonEmpty (NtfSubData, Either SMPClientError ()))
+    subscribeQueues srv subs =
+      L.map (second snd) . L.zip subs <$> subscribeQueuesNtfs ca srv (L.map sub subs)
+      where
+        sub NtfSubData {smpQueue = SMPQueueNtf {notifierId}, notifierKey} = (notifierId, notifierKey)
 
     receiveSMP :: M ()
     receiveSMP = forever $ do
@@ -504,7 +522,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
         sub <- atomically $ mkNtfSubData subId newSub
         resp <-
           atomically (addNtfSubscription st subId sub) >>= \case
-            Just _ -> atomically (writeTBQueue newSubQ $ NtfSub sub) $> NRSubId subId
+            Just _ -> atomically (writeTBQueue newSubQ [NtfSub sub]) $> NRSubId subId
             _ -> pure $ NRErr AUTH
         withNtfLog (`logCreateSubscription` sub)
         incNtfStat subCreated

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

@@ -12,6 +12,7 @@ import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
+import Data.List.NonEmpty (NonEmpty)
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
 import Data.Word (Word16)
@@ -93,7 +94,7 @@ newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsCo
 
 data NtfSubscriber = NtfSubscriber
   { smpSubscribers :: TMap SMPServer SMPSubscriber,
-    newSubQ :: TBQueue (NtfEntityRec 'Subscription),
+    newSubQ :: TBQueue (NonEmpty (NtfEntityRec 'Subscription)),
     smpAgent :: SMPClientAgent
   }
 
@@ -105,7 +106,7 @@ newNtfSubscriber qSize smpAgentCfg = do
   pure NtfSubscriber {smpSubscribers, newSubQ, smpAgent}
 
 data SMPSubscriber = SMPSubscriber
-  { newSubQ :: TQueue (NtfEntityRec 'Subscription),
+  { newSubQ :: TQueue (NonEmpty (NtfEntityRec 'Subscription)),
     subThreadId :: TVar (Maybe (Weak ThreadId))
   }
 

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

@@ -28,7 +28,7 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)
 
 ntfServerVersion :: String
-ntfServerVersion = "1.3.0"
+ntfServerVersion = "1.4.1"
 
 ntfServerCLI :: FilePath -> FilePath -> IO ()
 ntfServerCLI cfgPath logPath =

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

@@ -20,7 +20,7 @@ import qualified Data.Set as S
 import Data.Word (Word16)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Protocol (NtfPrivateSignKey)
+import Simplex.Messaging.Protocol (NtfPrivateSignKey, SMPServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (whenM, ($>>=))
@@ -68,6 +68,9 @@ data NtfSubData = NtfSubData
     subStatus :: TVar NtfSubStatus
   }
 
+ntfSubServer :: NtfSubData -> SMPServer
+ntfSubServer NtfSubData {smpQueue = SMPQueueNtf {smpServer}} = smpServer
+
 data NtfEntityRec (e :: NtfEntity) where
   NtfTkn :: NtfTknData -> NtfEntityRec 'Token
   NtfSub :: NtfSubData -> NtfEntityRec 'Subscription

src/Simplex/Messaging/Server.hs

@@ -741,7 +741,8 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= mapM_ restoreMessages
       st <- asks queueStore
       ms <- asks msgStore
       quota <- asks $ msgQueueQuota . config
-      runExceptT (liftIO (B.readFile f) >>= mapM_ (restoreMsg st ms quota) . B.lines) >>= \case
+      old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch)
+      runExceptT (liftIO (B.readFile f) >>= mapM_ (restoreMsg st ms quota old_) . B.lines) >>= \case
         Left e -> do
           logError . T.pack $ "error restoring messages: " <> e
           liftIO exitFailure
@@ -749,7 +750,7 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= mapM_ restoreMessages
           renameFile f $ f <> ".bak"
           logInfo "messages restored"
       where
-        restoreMsg st ms quota s = do
+        restoreMsg st ms quota old_ s = do
           r <- liftEither . first (msgErr "parsing") $ strDecode s
           case r of
             MLRv3 rId msg -> addToMsgQueue rId msg
@@ -759,13 +760,14 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= mapM_ restoreMessages
               addToMsgQueue rId msg'
           where
             addToMsgQueue rId msg = do
-              full <- atomically $ do
+              logFull <- atomically $ do
                 q <- getMsgQueue ms rId quota
-                isNothing <$> writeMsg q msg
-              case msg of
-                Message {} ->
-                  when full . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (msgId (msg :: Message))
-                MessageQuota {} -> pure ()
+                case msg of
+                  Message {msgTs}
+                    | maybe True (systemSeconds msgTs >=) old_ -> isNothing <$> writeMsg q msg
+                    | otherwise -> pure False
+                  MessageQuota {} -> writeMsg q msg $> False
+              when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (msgId (msg :: Message))
             updateMsgV1toV3 QueueRec {rcvDhSecret} RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} = do
               let nonce = C.cbNonce msgId
               msgBody <- liftEither . first (msgErr "v1 message decryption") $ C.maxLenBS =<< C.cbDecrypt rcvDhSecret nonce body

src/Simplex/Messaging/Server/CLI.hs

@@ -164,6 +164,9 @@ strictIni section key ini =
 readStrictIni :: Read a => Text -> Text -> Ini -> a
 readStrictIni section key = read . T.unpack . strictIni section key
 
+readIniDefault :: Read a => a -> Text -> Text -> Ini -> a
+readIniDefault def section key = either (const def) (read . T.unpack) . lookupValue section key
+
 iniOnOff :: Text -> Text -> Ini -> Maybe Bool
 iniOnOff section name ini = case lookupValue section name ini of
   Right "on" -> Just True

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

@@ -72,10 +72,13 @@ data ServerConfig = ServerConfig
     logTLSErrors :: Bool
   }
 
+defMsgExpirationDays :: Int64
+defMsgExpirationDays = 21
+
 defaultMessageExpiration :: ExpirationConfig
 defaultMessageExpiration =
   ExpirationConfig
-    { ttl = 30 * 86400, -- seconds, 30 days
+    { ttl = defMsgExpirationDays * 86400, -- seconds
       checkInterval = 43200 -- seconds, 12 hours
     }
 

src/Simplex/Messaging/Server/Expiration.hs

@@ -15,3 +15,14 @@ data ExpirationConfig = ExpirationConfig
 
 expireBeforeEpoch :: ExpirationConfig -> IO Int64
 expireBeforeEpoch ExpirationConfig {ttl} = subtract ttl . systemSeconds <$> liftIO getSystemTime
+
+showTTL :: Int64 -> String
+showTTL s
+  | s' /= 0 = show s <> " seconds"
+  | ms' /= 0 = show ms <> " minutes"
+  | hs' /= 0 = show hs <> " hours"
+  | otherwise = show ds <> " days"
+  where
+    (ms, s') = s `divMod` 60
+    (hs, ms') = ms `divMod` 60
+    (ds, hs') = hs `divMod` 24

src/Simplex/Messaging/Server/Main.hs

@@ -24,7 +24,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.CLI
-import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defaultInactiveClientExpiration, defaultMessageExpiration)
+import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defaultInactiveClientExpiration, defaultMessageExpiration, defMsgExpirationDays)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (simplexMQVersion, supportedSMPServerVRange)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
@@ -106,7 +106,8 @@ smpServerCLI cfgPath logPath =
                 <> ("enable: " <> onOff enableStoreLog <> "\n\n")
                 <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
                    \# they are preserved in the .bak file until the next restart.\n"
-                <> ("restore_messages: " <> onOff enableStoreLog <> "\n\n")
+                <> ("restore_messages: " <> onOff enableStoreLog <> "\n")
+                <> ("expire_messages_days: " <> show defMsgExpirationDays <> "\n\n")
                 <> "# Log daily server statistics to CSV file\n"
                 <> ("log_stats: " <> onOff logStats <> "\n\n")
                 <> "[AUTH]\n\
@@ -140,10 +141,13 @@ smpServerCLI cfgPath logPath =
       fp <- checkSavedFingerprint cfgPath defaultX509Config
       let host = fromRight "<hostnames>" $ T.unpack <$> lookupValue "TRANSPORT" "host" ini
           port = T.unpack $ strictIni "TRANSPORT" "port" ini
-          cfg@ServerConfig {transports, storeLogFile, newQueueBasicAuth, inactiveClientExpiration} = serverConfig
+          cfg@ServerConfig {transports, storeLogFile, newQueueBasicAuth, messageExpiration, inactiveClientExpiration} = serverConfig
           srv = ProtoServerWithAuth (SMPServer [THDomainName host] (if port == "5223" then "" else port) (C.KeyHash fp)) newQueueBasicAuth
       printServiceInfo serverVersion srv
       printServerConfig transports storeLogFile
+      putStrLn $ case messageExpiration of
+        Just ExpirationConfig {ttl} -> "expiring messages after " <> showTTL ttl
+        _ -> "not expiring messages"
       putStrLn $ case inactiveClientExpiration of
         Just ExpirationConfig {ttl, checkInterval} -> "expiring clients inactive for " <> show ttl <> " seconds every " <> show checkInterval <> " seconds"
         _ -> "not expiring inactive clients"
@@ -161,7 +165,7 @@ smpServerCLI cfgPath logPath =
           ServerConfig
             { transports = iniTransports ini,
               tbqSize = 32,
-              serverTbqSize = 128,
+              serverTbqSize = 1024,
               msgQueueQuota = 128,
               queueIdBytes = 24,
               msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
@@ -179,7 +183,10 @@ smpServerCLI cfgPath logPath =
               -- allow creating new queues by default
               allowNewQueues = fromMaybe True $ iniOnOff "AUTH" "new_queues" ini,
               newQueueBasicAuth = either error id <$> strDecodeIni "AUTH" "create_password" ini,
-              messageExpiration = Just defaultMessageExpiration,
+              messageExpiration =
+                Just defaultMessageExpiration
+                  { ttl = 86400 * readIniDefault defMsgExpirationDays "STORE_LOG" "expire_messages_days" ini
+                  },
               inactiveClientExpiration =
                 settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
                   $> ExpirationConfig

src/Simplex/Messaging/Util.hs

@@ -12,13 +12,11 @@ import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Fixed (Fixed (MkFixed), Pico)
 import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With)
-import Data.Time (nominalDiffTimeToSeconds)
-import Data.Time.Clock (UTCTime, diffUTCTime)
+import Data.Time (NominalDiffTime)
 import UnliftIO.Async
 
 raceAny_ :: MonadUnliftIO m => [m a] -> m ()
@@ -117,14 +115,8 @@ threadDelay' time = do
   threadDelay $ fromIntegral maxWait
   when (maxWait /= time) $ threadDelay' (time - maxWait)
 
-diffInSeconds :: UTCTime -> UTCTime -> Int64
-diffInSeconds a b = (`div` 1000000_000000) $ diffInPicos a b
+diffToMicroseconds :: NominalDiffTime -> Int64
+diffToMicroseconds diff = fromIntegral ((truncate $ diff * 1000000) :: Integer)
 
-diffInMicros :: UTCTime -> UTCTime -> Int64
-diffInMicros a b = (`div` 1000000) $ diffInPicos a b
-
-diffInPicos :: UTCTime -> UTCTime -> Int64
-diffInPicos a b = fromInteger . fromPico . nominalDiffTimeToSeconds $ diffUTCTime a b
-
-fromPico :: Pico -> Integer
-fromPico (MkFixed i) = i
+diffToMilliseconds :: NominalDiffTime -> Int64
+diffToMilliseconds diff = fromIntegral ((truncate $ diff * 1000) :: Integer)

tests/AgentTests/FunctionalAPITests.hs

@@ -61,6 +61,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (ATransport (..))
 import Simplex.Messaging.Util (tryError)
 import Simplex.Messaging.Version
+import System.Directory (copyFile, renameFile)
 import Test.Hspec
 import UnliftIO
 import XFTPClient (testXFTPServer)
@@ -124,6 +125,18 @@ runRight action =
     Right x -> pure x
     Left e -> error $ "Unexpected error: " <> show e
 
+getInAnyOrder :: HasCallStack => AgentClient -> [AEntityTransmission 'AEConn -> Bool] -> Expectation
+getInAnyOrder _ [] = pure ()
+getInAnyOrder c rs = do
+  r <- get c
+  let rest = filter (not . expected r) rs
+  if length rest < length rs
+    then getInAnyOrder c rest
+    else error $ "unexpected event: " <> show r
+  where
+    expected :: AEntityTransmission 'AEConn -> (AEntityTransmission 'AEConn -> Bool) -> Bool
+    expected r rp = rp r
+
 functionalAPITests :: ATransport -> Spec
 functionalAPITests t = do
   describe "Establishing duplex connection" $ do
@@ -147,9 +160,13 @@ functionalAPITests t = do
       testAsyncServerOffline t
     it "should notify after HELLO timeout" $
       withSmpServer t testAsyncHelloTimeout
-  describe "Duplicate message delivery" $
+  describe "Message delivery" $ do
     it "should deliver messages to the user once, even if repeat delivery is made by the server (no ACK)" $
       testDuplicateMessage t
+    it "should report error via msg integrity on skipped messages" $
+      testSkippedMessages t
+    it "should report decryption error on ratchet becoming out of sync" $
+      testDecryptionError t
   describe "Inactive client disconnection" $ do
     it "should disconnect clients if it was inactive longer than TTL" $
       testInactiveClientDisconnected t
@@ -163,8 +180,11 @@ functionalAPITests t = do
     it "should suspend agent on timeout, even if pending messages not sent" $
       testSuspendingAgentTimeout t
   describe "Batching SMP commands" $ do
-    it "should subscribe to multiple subscriptions with batching" $
-      testBatchedSubscriptions t
+    it "should subscribe to multiple (200) subscriptions with batching" $
+      testBatchedSubscriptions 200 10 t
+    -- 200 subscriptions gets very slow with test coverage, use below test instead
+    xit "should subscribe to multiple (6) subscriptions with batching" $
+      testBatchedSubscriptions 6 3 t
   describe "Async agent commands" $ do
     it "should connect using async agent commands" $
       withSmpServer t testAsyncCommands
@@ -183,13 +203,23 @@ functionalAPITests t = do
       testUsersNoServer t
     it "should connect two users and switch session mode" $
       withSmpServer t testTwoUsers
-  describe "Queue rotation" $ do
+  describe "Connection switch" $ do
     describe "should switch delivery to the new queue" $
       testServerMatrix2 t testSwitchConnection
     describe "should switch to new queue asynchronously" $
       testServerMatrix2 t testSwitchAsync
-    describe "should delete connection during rotation" $
+    describe "should delete connection during switch" $
       testServerMatrix2 t testSwitchDelete
+    describe "should abort switch in Started phase" $
+      testServerMatrix2 t testAbortSwitchStarted
+    describe "should abort switch in Started phase, reinitiate immediately" $
+      testServerMatrix2 t testAbortSwitchStartedReinitiate
+    describe "should prohibit to abort switch in Secured phase" $
+      testServerMatrix2 t testCannotAbortSwitchSecured
+    describe "should switch two connections simultaneously" $
+      testServerMatrix2 t testSwitch2Connections
+    describe "should switch two connections simultaneously, abort one" $
+      testServerMatrix2 t testSwitch2ConnectionsAbort1
   describe "SMP basic auth" $ do
     describe "with server auth" $ do
       --                                       allow NEW | server auth, v | clnt1 auth, v  | clnt2 auth, v    |  2 - success, 1 - JOIN fail, 0 - NEW fail
@@ -491,6 +521,101 @@ testDuplicateMessage t = do
       get alice2 ##> ("", bobId, SENT 6)
       get bob2 =##> \case ("", c, Msg "hello 3") -> c == aliceId; _ -> False
 
+testSkippedMessages :: HasCallStack => ATransport -> IO ()
+testSkippedMessages t = do
+  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg initAgentServers testDB2
+  (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \_ -> do
+    (aliceId, bobId) <- runRight $ makeConnection alice bob
+    runRight_ $ do
+      4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
+      get alice ##> ("", bobId, SENT 4)
+      get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+      ackMessage bob aliceId 4
+
+    disconnectAgentClient bob
+
+    runRight_ $ do
+      5 <- sendMessage alice bobId SMP.noMsgFlags "hello 2"
+      get alice ##> ("", bobId, SENT 5)
+      6 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
+      get alice ##> ("", bobId, SENT 6)
+      7 <- sendMessage alice bobId SMP.noMsgFlags "hello 4"
+      get alice ##> ("", bobId, SENT 7)
+
+    pure (aliceId, bobId)
+
+  nGet alice =##> \case ("", "", DOWN _ [c]) -> c == bobId; _ -> False
+  threadDelay 200000
+
+  disconnectAgentClient alice
+
+  alice2 <- getSMPAgentClient' agentCfg initAgentServers testDB
+  bob2 <- getSMPAgentClient' agentCfg initAgentServers testDB2
+
+  withSmpServerStoreLogOn t testPort $ \_ -> do
+    runRight_ $ do
+      subscribeConnection bob2 aliceId
+      subscribeConnection alice2 bobId
+
+      8 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 5"
+      get alice2 ##> ("", bobId, SENT 8)
+      get bob2 =##> \case ("", c, MSG MsgMeta {integrity = MsgError {errorInfo = MsgSkipped {fromMsgId = 4, toMsgId = 6}}} _ "hello 5") -> c == aliceId; _ -> False
+      ackMessage bob2 aliceId 5
+
+      9 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 6"
+      get alice2 ##> ("", bobId, SENT 9)
+      get bob2 =##> \case ("", c, Msg "hello 6") -> c == aliceId; _ -> False
+      ackMessage bob2 aliceId 6
+
+testDecryptionError :: HasCallStack => ATransport -> IO ()
+testDecryptionError t = do
+  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg initAgentServers testDB2
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    (aliceId, bobId) <- runRight $ makeConnection alice bob
+    runRight_ $ do
+      4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
+      get alice ##> ("", bobId, SENT 4)
+      get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+      ackMessage bob aliceId 4
+
+      5 <- sendMessage bob aliceId SMP.noMsgFlags "hello 2"
+      get bob ##> ("", aliceId, SENT 5)
+      get alice =##> \case ("", c, Msg "hello 2") -> c == bobId; _ -> False
+      ackMessage alice bobId 5
+
+      liftIO $ copyFile testDB2 (testDB2 <> ".bak")
+
+      6 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
+      get alice ##> ("", bobId, SENT 6)
+      get bob =##> \case ("", c, Msg "hello 3") -> c == aliceId; _ -> False
+      ackMessage bob aliceId 6
+
+      7 <- sendMessage bob aliceId SMP.noMsgFlags "hello 4"
+      get bob ##> ("", aliceId, SENT 7)
+      get alice =##> \case ("", c, Msg "hello 4") -> c == bobId; _ -> False
+      ackMessage alice bobId 7
+
+    disconnectAgentClient bob
+
+    -- importing database backup after progressing ratchet de-synchronizes ratchet,
+    -- this will be fixed by ratchet re-negotiation
+    liftIO $ renameFile (testDB2 <> ".bak") testDB2
+
+    bob2 <- getSMPAgentClient' agentCfg initAgentServers testDB2
+
+    runRight_ $ do
+      subscribeConnection bob2 aliceId
+
+      8 <- sendMessage alice bobId SMP.noMsgFlags "hello 5"
+      get alice ##> ("", bobId, SENT 8)
+      get bob2 =##> \case ("", c, ERR AGENT {agentErr = A_CRYPTO {cryptoErr = RATCHET_HEADER}}) -> c == aliceId; _ -> False
+
+      6 <- sendMessage bob2 aliceId SMP.noMsgFlags "hello 6"
+      get bob2 ##> ("", aliceId, SENT 6)
+      get alice =##> \case ("", c, ERR AGENT {agentErr = A_CRYPTO {cryptoErr = RATCHET_HEADER}}) -> c == bobId; _ -> False
+
 makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
 makeConnection alice bob = makeConnectionForUsers alice 1 bob 1
 
@@ -612,14 +737,14 @@ testSuspendingAgentTimeout t = do
     ("", "", SUSPENDED) <- nGet b
     pure ()
 
-testBatchedSubscriptions :: ATransport -> IO ()
-testBatchedSubscriptions t = do
+testBatchedSubscriptions :: Int -> Int -> ATransport -> IO ()
+testBatchedSubscriptions nCreate nDel t = do
   a <- getSMPAgentClient' agentCfg initAgentServers2 testDB
   b <- getSMPAgentClient' agentCfg initAgentServers2 testDB2
   conns <- runServers $ do
-    conns <- forM [1 .. 200 :: Int] . const $ makeConnection a b
+    conns <- forM [1 .. nCreate :: Int] . const $ makeConnection a b
     forM_ conns $ \(aId, bId) -> exchangeGreetings a bId b aId
-    let (aIds', bIds') = unzip $ take 10 conns
+    let (aIds', bIds') = unzip $ take nDel conns
     delete a bIds'
     delete b aIds'
     liftIO $ threadDelay 1000000
@@ -635,11 +760,14 @@ testBatchedSubscriptions t = do
     ("", "", UP {}) <- nGet b
     liftIO $ threadDelay 1000000
     let (aIds, bIds) = unzip conns
-        conns' = drop 10 conns
+        conns' = drop nDel conns
         (aIds', bIds') = unzip conns'
     subscribe a bIds
     subscribe b aIds
     forM_ conns' $ \(aId, bId) -> exchangeGreetingsMsgId 6 a bId b aId
+    void $ resubscribeConnections a bIds
+    void $ resubscribeConnections b aIds
+    forM_ conns' $ \(aId, bId) -> exchangeGreetingsMsgId 8 a bId b aId
     delete a bIds'
     delete b aIds'
     deleteFail a bIds'
@@ -649,7 +777,7 @@ testBatchedSubscriptions t = do
     subscribe c cs = do
       r <- subscribeConnections c cs
       liftIO $ do
-        let dc = S.fromList $ take 10 cs
+        let dc = S.fromList $ take nDel cs
         all isRight (M.withoutKeys r dc) `shouldBe` True
         all (== Left (CONN NOT_FOUND)) (M.restrictKeys r dc) `shouldBe` True
         M.keys r `shouldMatchList` cs
@@ -855,28 +983,49 @@ testSwitchConnection servers = do
   runRight_ $ do
     (aId, bId) <- makeConnection a b
     exchangeGreetingsMsgId 4 a bId b aId
-    switchConnectionAsync a "" bId
-    switchComplete a bId b aId
-    exchangeGreetingsMsgId 10 a bId b aId
+    testFullSwitch a bId b aId 10
+    testFullSwitch a bId b aId 16
+
+testFullSwitch :: AgentClient -> ByteString -> AgentClient -> ByteString -> Int64 -> ExceptT AgentErrorType IO ()
+testFullSwitch a bId b aId msgId = do
+  stats <- switchConnectionAsync a "" bId
+  liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
+  switchComplete a bId b aId
+  exchangeGreetingsMsgId msgId a bId b aId
 
 switchComplete :: AgentClient -> ByteString -> AgentClient -> ByteString -> ExceptT AgentErrorType IO ()
 switchComplete a bId b aId = do
-  phase a bId QDRcv SPStarted
-  phase b aId QDSnd SPStarted
-  phase a bId QDRcv SPConfirmed
-  phase b aId QDSnd SPConfirmed
-  phase b aId QDSnd SPCompleted
-  phase a bId QDRcv SPCompleted
+  phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
+  phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
+  phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
+  phaseRcv a bId SPConfirmed [Just RSSendingQADD, Nothing]
+  phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]
+  phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
+  phaseSnd b aId SPCompleted [Nothing]
+  phaseRcv a bId SPCompleted [Nothing]
 
-phase :: AgentClient -> ByteString -> QueueDirection -> SwitchPhase -> ExceptT AgentErrorType IO ()
-phase c connId d p =
+phaseRcv :: AgentClient -> ByteString -> SwitchPhase -> [Maybe RcvSwitchStatus] -> ExceptT AgentErrorType IO ()
+phaseRcv c connId p swchStatuses = phase c connId QDRcv p (\stats -> rcvSwchStatuses' stats `shouldMatchList` swchStatuses)
+
+rcvSwchStatuses' :: ConnectionStats -> [Maybe RcvSwitchStatus]
+rcvSwchStatuses' ConnectionStats {rcvQueuesInfo} = map (\RcvQueueInfo {rcvSwitchStatus} -> rcvSwitchStatus) rcvQueuesInfo
+
+phaseSnd :: AgentClient -> ByteString -> SwitchPhase -> [Maybe SndSwitchStatus] -> ExceptT AgentErrorType IO ()
+phaseSnd c connId p swchStatuses = phase c connId QDSnd p (\stats -> sndSwchStatuses' stats `shouldMatchList` swchStatuses)
+
+sndSwchStatuses' :: ConnectionStats -> [Maybe SndSwitchStatus]
+sndSwchStatuses' ConnectionStats {sndQueuesInfo} = map (\SndQueueInfo {sndSwitchStatus} -> sndSwitchStatus) sndQueuesInfo
+
+phase :: AgentClient -> ByteString -> QueueDirection -> SwitchPhase -> (ConnectionStats -> Expectation) -> ExceptT AgentErrorType IO ()
+phase c connId d p statsExpectation =
   get c >>= \(_, connId', msg) -> do
     liftIO $ connId `shouldBe` connId'
     case msg of
-      SWITCH d' p' _ -> liftIO $ do
+      SWITCH d' p' stats -> liftIO $ do
         d `shouldBe` d'
         p `shouldBe` p'
-      ERR (AGENT A_DUPLICATE) -> phase c connId d p
+        statsExpectation stats
+      ERR (AGENT A_DUPLICATE) -> phase c connId d p statsExpectation
       r -> do
         liftIO . putStrLn $ "expected: " <> show p <> ", received: " <> show r
         SWITCH {} <- pure r
@@ -888,33 +1037,44 @@ testSwitchAsync servers = do
     (aId, bId) <- makeConnection a b
     exchangeGreetingsMsgId 4 a bId b aId
     pure (aId, bId)
-  let withA' = session withA bId
-      withB' = session withB aId
+  let withA' = sessionSubscribe withA [bId]
+      withB' = sessionSubscribe withB [aId]
   withA' $ \a -> do
-    switchConnectionAsync a "" bId
-    phase a bId QDRcv SPStarted
-  withB' $ \b -> phase b aId QDSnd SPStarted
-  withA' $ \a -> phase a bId QDRcv SPConfirmed
+    stats <- switchConnectionAsync a "" bId
+    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
   withB' $ \b -> do
-    phase b aId QDSnd SPConfirmed
-    phase b aId QDSnd SPCompleted
-  withA' $ \a -> phase a bId QDRcv SPCompleted
+    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
+    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
+  withA' $ \a -> do
+    phaseRcv a bId SPConfirmed [Just RSSendingQADD, Nothing]
+    phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]
+  withB' $ \b -> do
+    phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
+    phaseSnd b aId SPCompleted [Nothing]
+  withA' $ \a -> phaseRcv a bId SPCompleted [Nothing]
   withA $ \a -> withB $ \b -> runRight_ $ do
     subscribeConnection a bId
     subscribeConnection b aId
     exchangeGreetingsMsgId 10 a bId b aId
+    testFullSwitch a bId b aId 16
   where
-    withAgent :: AgentConfig -> FilePath -> (AgentClient -> IO a) -> IO a
-    withAgent cfg' dbPath = bracket (getSMPAgentClient' cfg' servers dbPath) disconnectAgentClient
-    session :: (forall a. (AgentClient -> IO a) -> IO a) -> ConnId -> (AgentClient -> ExceptT AgentErrorType IO ()) -> IO ()
-    session withC connId a =
-      withC $ \c -> runRight_ $ do
-        subscribeConnection c connId
-        r <- a c
-        liftIO $ threadDelay 500000
-        pure r
-    withA = withAgent agentCfg testDB
-    withB = withAgent agentCfg {initialClientId = 1} testDB2
+    withA :: (AgentClient -> IO a) -> IO a
+    withA = withAgent agentCfg servers testDB
+    withB :: (AgentClient -> IO a) -> IO a
+    withB = withAgent agentCfg {initialClientId = 1} servers testDB2
+
+withAgent :: AgentConfig -> InitialAgentServers -> FilePath -> (AgentClient -> IO a) -> IO a
+withAgent cfg' servers dbPath = bracket (getSMPAgentClient' cfg' servers dbPath) disconnectAgentClient
+
+sessionSubscribe :: (forall a. (AgentClient -> IO a) -> IO a) -> [ConnId] -> (AgentClient -> ExceptT AgentErrorType IO ()) -> IO ()
+sessionSubscribe withC connIds a =
+  withC $ \c -> runRight_ $ do
+    void $ subscribeConnections c connIds
+    r <- a c
+    liftIO $ threadDelay 500000
+    liftIO $ noMessages c "nothing else should be delivered"
+    pure r
 
 testSwitchDelete :: InitialAgentServers -> IO ()
 testSwitchDelete servers = do
@@ -924,14 +1084,280 @@ testSwitchDelete servers = do
     (aId, bId) <- makeConnection a b
     exchangeGreetingsMsgId 4 a bId b aId
     disconnectAgentClient b
-    switchConnectionAsync a "" bId
-    phase a bId QDRcv SPStarted
+    stats <- switchConnectionAsync a "" bId
+    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
     deleteConnectionAsync a bId
     get a =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bId; _ -> False
     get a =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bId; _ -> False
     get a =##> \case ("", c, DEL_CONN) -> c == bId; _ -> False
     liftIO $ noMessages a "nothing else should be delivered to alice"
 
+testAbortSwitchStarted :: HasCallStack => InitialAgentServers -> IO ()
+testAbortSwitchStarted servers = do
+  (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
+    (aId, bId) <- makeConnection a b
+    exchangeGreetingsMsgId 4 a bId b aId
+    pure (aId, bId)
+  let withA' = sessionSubscribe withA [bId]
+      withB' = sessionSubscribe withB [aId]
+  withA' $ \a -> do
+    stats <- switchConnectionAsync a "" bId
+    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
+    -- repeat switch is prohibited
+    Left Agent.CMD {cmdErr = PROHIBITED} <- runExceptT $ switchConnectionAsync a "" bId
+    -- abort current switch
+    stats' <- abortConnectionSwitch a bId
+    liftIO $ rcvSwchStatuses' stats' `shouldMatchList` [Nothing]
+  withB' $ \b -> do
+    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
+    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
+  withA' $ \a -> do
+    get a ##> ("", bId, ERR (AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}}))
+    -- repeat switch
+    stats <- switchConnectionAsync a "" bId
+    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
+  withA $ \a -> withB $ \b -> runRight_ $ do
+    subscribeConnection a bId
+    subscribeConnection b aId
+
+    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
+    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
+
+    phaseRcv a bId SPConfirmed [Just RSSendingQADD, Nothing]
+    phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]
+
+    phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
+    phaseSnd b aId SPCompleted [Nothing]
+
+    phaseRcv a bId SPCompleted [Nothing]
+
+    exchangeGreetingsMsgId 12 a bId b aId
+
+    testFullSwitch a bId b aId 18
+  where
+    withA :: (AgentClient -> IO a) -> IO a
+    withA = withAgent agentCfg servers testDB
+    withB :: (AgentClient -> IO a) -> IO a
+    withB = withAgent agentCfg {initialClientId = 1} servers testDB2
+
+testAbortSwitchStartedReinitiate :: HasCallStack => InitialAgentServers -> IO ()
+testAbortSwitchStartedReinitiate servers = do
+  (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
+    (aId, bId) <- makeConnection a b
+    exchangeGreetingsMsgId 4 a bId b aId
+    pure (aId, bId)
+  let withA' = sessionSubscribe withA [bId]
+      withB' = sessionSubscribe withB [aId]
+  withA' $ \a -> do
+    stats <- switchConnectionAsync a "" bId
+    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
+    -- abort current switch
+    stats' <- abortConnectionSwitch a bId
+    liftIO $ rcvSwchStatuses' stats' `shouldMatchList` [Nothing]
+    -- repeat switch
+    stats'' <- switchConnectionAsync a "" bId
+    liftIO $ rcvSwchStatuses' stats'' `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
+  withB' $ \b -> do
+    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
+    liftIO . getInAnyOrder b $
+      [ switchPhaseSndP aId SPStarted [Just SSSendingQKEY, Nothing],
+        switchPhaseSndP aId SPConfirmed [Just SSSendingQKEY, Nothing]
+      ]
+    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
+  withA $ \a -> withB $ \b -> runRight_ $ do
+    subscribeConnection a bId
+    subscribeConnection b aId
+
+    liftIO . getInAnyOrder a $
+      [ errQueueNotFoundP bId,
+        switchPhaseRcvP bId SPConfirmed [Just RSSendingQADD, Nothing]
+      ]
+
+    phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]
+
+    phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
+    phaseSnd b aId SPCompleted [Nothing]
+
+    phaseRcv a bId SPCompleted [Nothing]
+
+    exchangeGreetingsMsgId 12 a bId b aId
+
+    testFullSwitch a bId b aId 18
+  where
+    withA :: (AgentClient -> IO a) -> IO a
+    withA = withAgent agentCfg servers testDB
+    withB :: (AgentClient -> IO a) -> IO a
+    withB = withAgent agentCfg {initialClientId = 1} servers testDB2
+
+switchPhaseRcvP :: ConnId -> SwitchPhase -> [Maybe RcvSwitchStatus] -> AEntityTransmission 'AEConn -> Bool
+switchPhaseRcvP cId sphase swchStatuses = switchPhaseP cId QDRcv sphase (\stats -> rcvSwchStatuses' stats == swchStatuses)
+
+switchPhaseSndP :: ConnId -> SwitchPhase -> [Maybe SndSwitchStatus] -> AEntityTransmission 'AEConn -> Bool
+switchPhaseSndP cId sphase swchStatuses = switchPhaseP cId QDSnd sphase (\stats -> sndSwchStatuses' stats == swchStatuses)
+
+switchPhaseP :: ConnId -> QueueDirection -> SwitchPhase -> (ConnectionStats -> Bool) -> AEntityTransmission 'AEConn -> Bool
+switchPhaseP cId qd sphase statsP = \case
+  (_, cId', SWITCH qd' sphase' stats) -> cId' == cId && qd' == qd && sphase' == sphase && statsP stats
+  _ -> False
+
+errQueueNotFoundP :: ConnId -> AEntityTransmission 'AEConn -> Bool
+errQueueNotFoundP cId = \case
+  (_, cId', ERR AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}}) -> cId' == cId
+  _ -> False
+
+testCannotAbortSwitchSecured :: HasCallStack => InitialAgentServers -> IO ()
+testCannotAbortSwitchSecured servers = do
+  (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
+    (aId, bId) <- makeConnection a b
+    exchangeGreetingsMsgId 4 a bId b aId
+    pure (aId, bId)
+  let withA' = sessionSubscribe withA [bId]
+      withB' = sessionSubscribe withB [aId]
+  withA' $ \a -> do
+    stats <- switchConnectionAsync a "" bId
+    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
+  withB' $ \b -> do
+    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
+    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
+  withA' $ \a -> do
+    phaseRcv a bId SPConfirmed [Just RSSendingQADD, Nothing]
+    phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]
+    Left Agent.CMD {cmdErr = PROHIBITED} <- runExceptT $ abortConnectionSwitch a bId
+    pure ()
+  withA $ \a -> withB $ \b -> runRight_ $ do
+    subscribeConnection a bId
+    subscribeConnection b aId
+
+    phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
+    phaseSnd b aId SPCompleted [Nothing]
+
+    phaseRcv a bId SPCompleted [Nothing]
+
+    exchangeGreetingsMsgId 10 a bId b aId
+
+    testFullSwitch a bId b aId 16
+  where
+    withA :: (AgentClient -> IO a) -> IO a
+    withA = withAgent agentCfg servers testDB
+    withB :: (AgentClient -> IO a) -> IO a
+    withB = withAgent agentCfg {initialClientId = 1} servers testDB2
+
+testSwitch2Connections :: HasCallStack => InitialAgentServers -> IO ()
+testSwitch2Connections servers = do
+  (aId1, bId1, aId2, bId2) <- withA $ \a -> withB $ \b -> runRight $ do
+    (aId1, bId1) <- makeConnection a b
+    exchangeGreetingsMsgId 4 a bId1 b aId1
+    (aId2, bId2) <- makeConnection a b
+    exchangeGreetingsMsgId 4 a bId2 b aId2
+    pure (aId1, bId1, aId2, bId2)
+  withA $ \a -> runRight_ $ do
+    void $ subscribeConnections a [bId1, bId2]
+    stats1 <- switchConnectionAsync a "" bId1
+    liftIO $ rcvSwchStatuses' stats1 `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId1 SPStarted [Just RSSendingQADD, Nothing]
+    stats2 <- switchConnectionAsync a "" bId2
+    liftIO $ rcvSwchStatuses' stats2 `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId2 SPStarted [Just RSSendingQADD, Nothing]
+  withA $ \a -> withB $ \b -> runRight_ $ do
+    void $ subscribeConnections a [bId1, bId2]
+    void $ subscribeConnections b [aId1, aId2]
+
+    liftIO . getInAnyOrder b $
+      [ switchPhaseSndP aId1 SPStarted [Just SSSendingQKEY, Nothing],
+        switchPhaseSndP aId1 SPConfirmed [Just SSSendingQKEY, Nothing],
+        switchPhaseSndP aId2 SPStarted [Just SSSendingQKEY, Nothing],
+        switchPhaseSndP aId2 SPConfirmed [Just SSSendingQKEY, Nothing]
+      ]
+
+    liftIO . getInAnyOrder a $
+      [ switchPhaseRcvP bId1 SPConfirmed [Just RSSendingQADD, Nothing],
+        switchPhaseRcvP bId1 SPSecured [Just RSSendingQUSE, Nothing],
+        switchPhaseRcvP bId2 SPConfirmed [Just RSSendingQADD, Nothing],
+        switchPhaseRcvP bId2 SPSecured [Just RSSendingQUSE, Nothing]
+      ]
+
+    liftIO . getInAnyOrder b $
+      [ switchPhaseSndP aId1 SPSecured [Just SSSendingQTEST, Nothing],
+        switchPhaseSndP aId1 SPCompleted [Nothing],
+        switchPhaseSndP aId2 SPSecured [Just SSSendingQTEST, Nothing],
+        switchPhaseSndP aId2 SPCompleted [Nothing]
+      ]
+
+    liftIO . getInAnyOrder a $
+      [ switchPhaseRcvP bId1 SPCompleted [Nothing],
+        switchPhaseRcvP bId2 SPCompleted [Nothing]
+      ]
+
+    exchangeGreetingsMsgId 10 a bId1 b aId1
+    exchangeGreetingsMsgId 10 a bId2 b aId2
+
+    testFullSwitch a bId1 b aId1 16
+    testFullSwitch a bId2 b aId2 16
+  where
+    withA :: (AgentClient -> IO a) -> IO a
+    withA = withAgent agentCfg servers testDB
+    withB :: (AgentClient -> IO a) -> IO a
+    withB = withAgent agentCfg {initialClientId = 1} servers testDB2
+
+testSwitch2ConnectionsAbort1 :: HasCallStack => InitialAgentServers -> IO ()
+testSwitch2ConnectionsAbort1 servers = do
+  (aId1, bId1, aId2, bId2) <- withA $ \a -> withB $ \b -> runRight $ do
+    (aId1, bId1) <- makeConnection a b
+    exchangeGreetingsMsgId 4 a bId1 b aId1
+    (aId2, bId2) <- makeConnection a b
+    exchangeGreetingsMsgId 4 a bId2 b aId2
+    pure (aId1, bId1, aId2, bId2)
+  let withA' = sessionSubscribe withA [bId1, bId2]
+      withB' = sessionSubscribe withB [aId1, aId2]
+  withA' $ \a -> do
+    stats1 <- switchConnectionAsync a "" bId1
+    liftIO $ rcvSwchStatuses' stats1 `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId1 SPStarted [Just RSSendingQADD, Nothing]
+    stats2 <- switchConnectionAsync a "" bId2
+    liftIO $ rcvSwchStatuses' stats2 `shouldMatchList` [Just RSSwitchStarted]
+    phaseRcv a bId2 SPStarted [Just RSSendingQADD, Nothing]
+    -- abort switch of second connection
+    stats2' <- abortConnectionSwitch a bId2
+    liftIO $ rcvSwchStatuses' stats2' `shouldMatchList` [Nothing]
+  withB' $ \b -> do
+    liftIO . getInAnyOrder b $
+      [ switchPhaseSndP aId1 SPStarted [Just SSSendingQKEY, Nothing],
+        switchPhaseSndP aId1 SPConfirmed [Just SSSendingQKEY, Nothing],
+        switchPhaseSndP aId2 SPStarted [Just SSSendingQKEY, Nothing],
+        switchPhaseSndP aId2 SPConfirmed [Just SSSendingQKEY, Nothing]
+      ]
+  withA' $ \a -> do
+    liftIO . getInAnyOrder a $
+      [ switchPhaseRcvP bId1 SPConfirmed [Just RSSendingQADD, Nothing],
+        switchPhaseRcvP bId1 SPSecured [Just RSSendingQUSE, Nothing],
+        errQueueNotFoundP bId2
+      ]
+  withA $ \a -> withB $ \b -> runRight_ $ do
+    void $ subscribeConnections a [bId1, bId2]
+    void $ subscribeConnections b [aId1, aId2]
+
+    phaseSnd b aId1 SPSecured [Just SSSendingQTEST, Nothing]
+    phaseSnd b aId1 SPCompleted [Nothing]
+
+    phaseRcv a bId1 SPCompleted [Nothing]
+
+    exchangeGreetingsMsgId 10 a bId1 b aId1
+    exchangeGreetingsMsgId 8 a bId2 b aId2
+
+    testFullSwitch a bId1 b aId1 16
+    testFullSwitch a bId2 b aId2 14
+  where
+    withA :: (AgentClient -> IO a) -> IO a
+    withA = withAgent agentCfg servers testDB
+    withB :: (AgentClient -> IO a) -> IO a
+    withB = withAgent agentCfg {initialClientId = 1} servers testDB2
+
 testCreateQueueAuth :: (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> IO Int
 testCreateQueueAuth clnt1 clnt2 = do
   a <- getClient clnt1

tests/AgentTests/NotificationTests.hs

@@ -19,8 +19,8 @@ import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import Data.Text.Encoding (encodeUtf8)
 import NtfClient
-import SMPAgentClient (agentCfg, initAgentServers, testDB, testDB2)
-import SMPClient (testPort, withSmpServer, withSmpServerStoreLogOn, xit')
+import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2)
+import SMPClient (cfg, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, xit')
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers)
 import Simplex.Messaging.Agent.Protocol
@@ -31,6 +31,7 @@ import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Types (NtfToken (..))
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), SMPMsgMeta (..))
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Transport (ATransport)
 import Simplex.Messaging.Util (tryE)
 import System.Directory (doesFileExist, removeFile)
@@ -85,6 +86,10 @@ notificationTests t =
       it "should resume subscriptions after SMP server is restarted" $ \_ ->
         withAPNSMockServer $ \apns ->
           withNtfServer t $ testNotificationsSMPRestart t apns
+    describe "Notifications after SMP server restart" $
+      it "should resume batched subscriptions after SMP server is restarted" $ \_ ->
+        withAPNSMockServer $ \apns ->
+          withNtfServer t $ testNotificationsSMPRestartBatch 100 t apns
     describe "should switch notifications to the new queue" $
       testServerMatrix2 t $ \servers ->
         withAPNSMockServer $ \apns ->
@@ -480,6 +485,52 @@ testNotificationsSMPRestart t APNSMockServer {apnsQ} = do
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     liftIO $ killThread threadId
 
+testNotificationsSMPRestartBatch :: Int -> ATransport -> APNSMockServer -> IO ()
+testNotificationsSMPRestartBatch n t APNSMockServer {apnsQ} = do
+  a <- getSMPAgentClient' agentCfg initAgentServers2 testDB
+  b <- getSMPAgentClient' agentCfg initAgentServers2 testDB2
+  conns <- runServers $ do
+    conns <- forM [1 .. n :: Int] . const $ makeConnection a b
+    _ <- registerTestToken a "abcd" NMInstant apnsQ
+    liftIO $ threadDelay 1500000
+    forM_ conns $ \(aliceId, bobId) -> do
+      msgId <- sendMessage b aliceId (SMP.MsgFlags True) "hello"
+      get b ##> ("", aliceId, SENT msgId)
+      void $ messageNotification apnsQ
+      get a =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
+      ackMessage a bobId msgId
+    pure conns
+
+  runRight_ @AgentErrorType $ do
+    ("", "", DOWN _ bcs1) <- nGet a
+    ("", "", DOWN _ bcs2) <- nGet a
+    liftIO $ length (bcs1 <> bcs2) `shouldBe` length conns
+    ("", "", DOWN _ acs1) <- nGet b
+    ("", "", DOWN _ acs2) <- nGet b
+    liftIO $ length (acs1 <> acs2) `shouldBe` length conns
+
+  runServers $ do
+    ("", "", UP _ bcs1) <- nGet a
+    ("", "", UP _ bcs2) <- nGet a
+    liftIO $ length (bcs1 <> bcs2) `shouldBe` length conns
+    ("", "", UP _ acs1) <- nGet b
+    ("", "", UP _ acs2) <- nGet b
+    liftIO $ length (acs1 <> acs2) `shouldBe` length conns
+    liftIO $ threadDelay 1500000
+    forM_ conns $ \(aliceId, bobId) -> do
+      msgId <- sendMessage b aliceId (SMP.MsgFlags True) "hello again"
+      get b ##> ("", aliceId, SENT msgId)
+      _ <- messageNotificationData a apnsQ
+      get a =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
+  where
+    runServers :: ExceptT AgentErrorType IO a -> IO a
+    runServers a = do
+      withSmpServerStoreLogOn t testPort $ \t1 -> do
+        res <- withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \t2 ->
+          runRight a `finally` killThread t2
+        killThread t1
+        pure res
+
 testSwitchNotifications :: InitialAgentServers -> APNSMockServer -> IO ()
 testSwitchNotifications servers APNSMockServer {apnsQ} = do
   a <- getSMPAgentClient' agentCfg servers testDB
@@ -496,7 +547,7 @@ testSwitchNotifications servers APNSMockServer {apnsQ} = do
           get a =##> \case ("", c, Msg msg') -> c == bId && msg == msg'; _ -> False
           ackMessage a bId msgId
     testMessage "hello"
-    switchConnectionAsync a "" bId
+    _ <- switchConnectionAsync a "" bId
     switchComplete a bId b aId
     liftIO $ threadDelay 500000
     testMessage "hello again"

tests/AgentTests/SQLiteTests.hs

@@ -167,6 +167,7 @@ rcvQueue1 =
       dbQueueId = 1,
       primary = True,
       dbReplaceQueueId = Nothing,
+      rcvSwchStatus = Nothing,
       smpClientVersion = 1,
       clientNtfCreds = Nothing,
       deleteErrors = 0
@@ -187,6 +188,7 @@ sndQueue1 =
       dbQueueId = 1,
       primary = True,
       dbReplaceQueueId = Nothing,
+      sndSwchStatus = Nothing,
       smpClientVersion = 1
     }
 
@@ -324,6 +326,7 @@ testUpgradeRcvConnToDuplex =
               e2eDhSecret = testDhSecret,
               status = New,
               dbQueueId = 1,
+              sndSwchStatus = Nothing,
               primary = True,
               dbReplaceQueueId = Nothing,
               smpClientVersion = 1
@@ -352,6 +355,7 @@ testUpgradeSndConnToDuplex =
               sndId = "4567",
               status = New,
               dbQueueId = 1,
+              rcvSwchStatus = Nothing,
               primary = True,
               dbReplaceQueueId = Nothing,
               smpClientVersion = 1,
@@ -428,7 +432,8 @@ mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
       msgFlags = SMP.noMsgFlags,
       msgBody = hw,
       internalHash,
-      externalPrevSndHash = "hash_from_sender"
+      externalPrevSndHash = "hash_from_sender",
+      encryptedMsgHash = "encrypted_msg_hash"
     }
 
 testCreateRcvMsg_ :: DB.Connection -> PrevExternalSndId -> PrevRcvMsgHash -> ConnId -> RcvQueue -> RcvMsgData -> Expectation

tests/AgentTests/SchemaDump.hs

@@ -57,6 +57,8 @@ testSchemaMigrations = do
       schema'' <- getSchema testDB testSchema
       schema'' `shouldBe` schema
       withConnection st (`Migrations.run` MTRUp [m])
+      schema''' <- getSchema testDB testSchema
+      schema''' `shouldBe` schema'
 
 getSchema :: FilePath -> FilePath -> IO String
 getSchema dpPath schemaPath = do

tests/ServerTests.hs

@@ -55,7 +55,9 @@ serverTests t@(ATransport t') = do
     describe "Exceeding queue quota" $ testExceedQueueQuota t'
   describe "Store log" $ testWithStoreLog t
   describe "Restore messages" $ testRestoreMessages t
-  describe "Restore messages (old / v2)" $ testRestoreMessagesV2 t
+  describe "Restore messages (old / v2)" $ do
+    testRestoreMessagesV2 t
+    testRestoreExpireMessages t
   describe "Timing of AUTH error" $ testTiming t
   describe "Message notifications" $ testMessageNotifications t
   describe "Message expiration" $ do
@@ -779,6 +781,62 @@ testRestoreMessagesV2 at@(ATransport t) =
     runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
     runClient _ test' = testSMPClient test' `shouldReturn` ()
 
+testRestoreExpireMessages :: ATransport -> Spec
+testRestoreExpireMessages at@(ATransport t) =
+  it "should store messages on exit and restore on start" $ do
+    (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519
+    recipientId <- newTVarIO ""
+    recipientKey <- newTVarIO Nothing
+    dhShared <- newTVarIO Nothing
+    senderId <- newTVarIO ""
+
+    withSmpServerStoreMsgLogOnV2 at testPort . runTest t $ \h -> do
+      runClient t $ \h1 -> do
+        (sId, rId, rKey, dh) <- createAndSecureQueue h1 sPub
+        atomically $ do
+          writeTVar recipientId rId
+          writeTVar recipientKey $ Just rKey
+          writeTVar dhShared $ Just dh
+          writeTVar senderId sId
+      sId <- readTVarIO senderId
+      Resp "1" _ OK <- signSendRecv h sKey ("1", sId, _SEND "hello 1")
+      Resp "2" _ OK <- signSendRecv h sKey ("2", sId, _SEND "hello 2")
+      threadDelay 3000000
+      Resp "3" _ OK <- signSendRecv h sKey ("3", sId, _SEND "hello 3")
+      Resp "4" _ OK <- signSendRecv h sKey ("4", sId, _SEND "hello 4")
+      pure ()
+
+    logSize testStoreLogFile `shouldReturn` 2
+    msgs <- B.readFile testStoreMsgsFile
+    length (B.lines msgs) `shouldBe` 4
+
+    let expCfg1 = Just ExpirationConfig {ttl = 86400, checkInterval = 43200}
+        cfg1 = cfgV2 {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, messageExpiration = expCfg1}
+    withSmpServerConfigOn at cfg1 testPort . runTest t $ \_ -> pure ()
+
+    logSize testStoreLogFile `shouldReturn` 1
+    msgs' <- B.readFile testStoreMsgsFile
+    msgs' `shouldBe` msgs
+
+    let expCfg2 = Just ExpirationConfig {ttl = 2, checkInterval = 43200}
+        cfg2 = cfgV2 {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, messageExpiration = expCfg2}
+    withSmpServerConfigOn at cfg2 testPort . runTest t $ \_ -> pure ()
+
+    logSize testStoreLogFile `shouldReturn` 1
+    -- two messages expired
+    msgs'' <- B.readFile testStoreMsgsFile
+    length (B.lines msgs'') `shouldBe` 2
+    B.lines msgs'' `shouldBe` drop 2 (B.lines msgs)
+
+  where
+    runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
+    runTest _ test' server = do
+      testSMPClient test' `shouldReturn` ()
+      killThread server
+
+    runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
+    runClient _ test' = testSMPClient test' `shouldReturn` ()
+
 createAndSecureQueue :: Transport c => THandle c -> SndPublicVerifyKey -> IO (SenderId, RecipientId, RcvPrivateSignKey, RcvDhSecret)
 createAndSecureQueue h sPub = do
   (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448

tests/XFTPAgent.hs

@@ -86,7 +86,7 @@ testXFTPAgentSendReceive = withXFTPServer $ do
   sndr <- getSMPAgentClient' agentCfg initAgentServers testDB
   (rfd1, rfd2) <- runRight $ do
     (sfId, _, rfd1, rfd2) <- testSend sndr filePath
-    xftpDeleteSndFileInternal sndr 1 sfId
+    xftpDeleteSndFileInternal sndr sfId
     pure (rfd1, rfd2)
 
   -- receive file, delete rcv file
@@ -97,7 +97,7 @@ testXFTPAgentSendReceive = withXFTPServer $ do
       rcp <- getSMPAgentClient' agentCfg initAgentServers testDB
       runRight_ $ do
         rfId <- testReceive rcp rfd originalFilePath
-        xftpDeleteRcvFile rcp 1 rfId
+        xftpDeleteRcvFile rcp rfId
 
 createRandomFile :: IO FilePath
 createRandomFile = do