Merge branch 'master' into stable

2026-06-03 08:47:32 +00:00 · 2025-03-09 21:53:03 +00:00
parent be81fe1f74 6e505f5c0b
commit aa26a55df4
110 changed files with 8276 additions and 4817 deletions
@@ -11,61 +11,53 @@ on:

 jobs:
  build:
-    name: build-${{ matrix.os }}-${{ matrix.ghc }}
-    runs-on: ${{ matrix.os }}
+    name: "Ubuntu: ${{ matrix.os }}, GHC: ${{ matrix.ghc }}"
+    env:
+      apps: "smp-server xftp-server ntf-server xftp"
+    runs-on: ubuntu-${{ matrix.os }}
    strategy:
      fail-fast: false
      matrix:
        include:
-          - os: ubuntu-20.04
-            platform_name: 20_04-x86-64
+          - os: 22.04
            ghc: "8.10.7"
-          - os: ubuntu-20.04
            platform_name: 20_04-x86-64
+          - os: 20.04
+            ghc: "9.6.3"
+            platform_name: 20_04-x86-64
+          - os: 22.04
            ghc: "9.6.3"
-          - os: ubuntu-22.04
            platform_name: 22_04-x86-64
+          - os: 24.04
            ghc: "9.6.3"
+            platform_name: 24_04-x86-64
    steps:
      - name: Clone project
        uses: actions/checkout@v3

-      - name: Setup Haskell
-        uses: haskell-actions/setup@v2
-        with:
-          ghc-version: ${{ matrix.ghc }}
-          cabal-version: "3.10.1.0"
-
-      - name: Cache dependencies
-        uses: actions/cache@v2
-        with:
-          path: |
-            ~/.cabal/store
-            dist-newstyle
-          key: ${{ matrix.os }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }}
-
-      - name: Build
+      - name: Prepare image
        shell: bash
-        run: cabal build --enable-tests
+        run: docker build -f Dockerfile.build --build-arg TAG=${{ matrix.os }} --build-arg GHC=${{ matrix.ghc }} -t local .

-      - name: Test
-        timeout-minutes: 40
+      - name: Start container
        shell: bash
-        run: cabal test --test-show-details=direct
+        run: docker run -t -d --name builder local

-      - name: Prepare binaries
+      - name: Build binaries
+        shell: bash
+        run: docker exec -t -e apps="$apps" builder sh -c 'cabal build --enable-tests && mkdir /out && for i in $apps; do bin=$(find /project/dist-newstyle -name "$i" -type f -executable); strip "$bin"; chmod +x "$bin"; mv "$bin" /out/; done'
+
+      - name: Copy binaries from container and prepare them
        if: startsWith(github.ref, 'refs/tags/v')
        shell: bash
        run: |
-          mv $(cabal list-bin smp-server) smp-server-ubuntu-${{ matrix.platform_name}}
-          mv $(cabal list-bin ntf-server) ntf-server-ubuntu-${{ matrix.platform_name}}
-          mv $(cabal list-bin xftp-server) xftp-server-ubuntu-${{ matrix.platform_name}}
-          mv $(cabal list-bin xftp) xftp-ubuntu-${{ matrix.platform_name}}
+          docker cp builder:/out .
+          for i in $apps; do mv ./out/$i ./$i-ubuntu-${{ matrix.platform_name }}; done

      - name: Build changelog
        if: startsWith(github.ref, 'refs/tags/v')
        id: build_changelog
-        uses: mikepenz/release-changelog-builder-action@v1
+        uses: mikepenz/release-changelog-builder-action@v5
        with:
          configuration: .github/changelog_conf.json
          failOnError: true
@@ -76,7 +68,7 @@ jobs:

      - name: Create release
        if: startsWith(github.ref, 'refs/tags/v') && matrix.ghc != '8.10.7'
-        uses: softprops/action-gh-release@v1
+        uses: softprops/action-gh-release@v2
        with:
          body: |
            See full changelog [here](https://github.com/simplex-chat/simplexmq/blob/master/CHANGELOG.md).
@@ -86,10 +78,17 @@ jobs:
          prerelease: true
          files: |
            LICENSE
-            smp-server-ubuntu-${{ matrix.platform_name}}
-            ntf-server-ubuntu-${{ matrix.platform_name}}
-            xftp-server-ubuntu-${{ matrix.platform_name}}
-            xftp-ubuntu-${{ matrix.platform_name}}
+            smp-server-ubuntu-${{ matrix.platform_name }}
+            ntf-server-ubuntu-${{ matrix.platform_name }}
+            xftp-server-ubuntu-${{ matrix.platform_name }}
+            xftp-ubuntu-${{ matrix.platform_name }}
          fail_on_unmatched_files: true
        env:
          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+
+      - name: Test
+        shell: bash
+        run: |
+          docker exec -t builder sh -c 'mv $(find /project/dist-newstyle -name "simplexmq-test" -type f -executable) /out/'
+          docker cp builder:/out/simplexmq-test .
+          ./simplexmq-test
@@ -14,22 +14,22 @@ jobs:
      matrix:
        include:
          - app: smp-server
-            app_port: 5223
+            app_port: "443 5223"
          - app: xftp-server
-            app_port: 443 
+            app_port: 443
    steps:
      - name: Clone project
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4

      - name: Log in to Docker Hub
-        uses: docker/login-action@v2
+        uses: docker/login-action@v3
        with:
          username: ${{ secrets.DOCKERHUB_USERNAME }}
          password: ${{ secrets.DOCKERHUB_PASSWORD }}

      - name: Extract metadata for Docker image
        id: meta
-        uses: docker/metadata-action@v4
+        uses: docker/metadata-action@v5
        with:
          images: ${{ secrets.DOCKERHUB_USERNAME }}/${{ matrix.app }}
          flavor: |
@@ -40,7 +40,7 @@ jobs:
            type=semver,pattern=v{{major}}

      - name: Build and push Docker image
-        uses: docker/build-push-action@v4
+        uses: docker/build-push-action@v6
        with:
          push: true
          build-args: |
@@ -1,15 +1,20 @@
-ARG TAG=22.04
+# syntax=docker/dockerfile:1.7.0-labs
+ARG TAG=24.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 libssl-dev
+RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-18 llvm-18-dev libnuma-dev libssl-dev

 # Specify bootstrap Haskell versions
 ENV BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3
-ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.1.0
+ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.12.1.0
+
+# Do not install Stack
+ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK=true
+ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK_HOOK=true

 # Install ghcup
 RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
@@ -21,26 +26,42 @@ ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
 RUN ghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" && \
    ghcup set cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"

-COPY . /project
+# Copy only the source code
+COPY apps /project/apps/
+COPY cbits /project/cbits/
+COPY src /project/src/
+
+COPY cabal.project Setup.hs simplexmq.cabal LICENSE /project
+
 WORKDIR /project

+# Debug
+#ARG CACHEBUST=1
+
+#ADD --chmod=755 https://github.com/MShekow/directory-checksum/releases/download/v1.4.6/directory-checksum_1.4.6_linux_amd64 /usr/local/bin/directory-checksum
+#RUN directory-checksum --max-depth 2 .
+
+# Set build arguments and check if they exist
 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
+RUN if [ -z "$APP" ]; then printf "Please spcify \$APP build-arg.\n"; exit 1; fi

 # Compile app
 RUN cabal update
 RUN cabal build exe:$APP

+# Copy scripts
+COPY scripts /project/scripts/
+
 # 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) && \
+RUN bin="$(find /project/dist-newstyle -name "$APP" -type f -executable)" && \
    mv "$bin" ./ && \
    strip ./"$APP" &&\
-    mv /project/scripts/docker/entrypoint-"$APP" ./entrypoint
+    mv /project/scripts/docker/entrypoint-"$APP" ./entrypoint &&\
+    mv /project/scripts/main/simplex-servers-stopscript ./simplex-servers-stopscript

 ### Final stage
 FROM ubuntu:${TAG}
@@ -53,6 +74,8 @@ COPY --from=build /final /usr/local/bin/

 # Open app listening port
 ARG APP_PORT
+RUN if [ -z "$APP_PORT" ]; then printf "Please spcify \$APP_PORT build-arg.\n"; exit 1; fi
+
 EXPOSE $APP_PORT

 # simplexmq requires using SIGINT to correctly preserve undelivered messages and restore them on restart
@@ -0,0 +1,42 @@
+# syntax=docker/dockerfile:1.7.0-labs
+ARG TAG=24.04
+FROM ubuntu:${TAG} AS build
+
+### Build stage
+
+ARG GHC=9.6.3
+ARG CABAL=3.14.1.1
+
+# Install curl, git and and simplexmq dependencies
+RUN apt-get update && apt-get install -y curl git sqlite3 libsqlite3-dev build-essential libgmp3-dev zlib1g-dev llvm llvm-dev libnuma-dev libssl-dev
+
+# Specify bootstrap Haskell versions
+ENV BOOTSTRAP_HASKELL_GHC_VERSION=${GHC}
+ENV BOOTSTRAP_HASKELL_CABAL_VERSION=${CABAL}
+
+# Do not install Stack
+ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK=true
+ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK_HOOK=true
+
+# 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 "${GHC}" && \
+    ghcup set cabal "${CABAL}"
+
+# Copy only the source code
+COPY apps /project/apps/
+COPY cbits /project/cbits/
+COPY src /project/src/
+COPY tests /project/tests/
+
+COPY cabal.project Setup.hs simplexmq.cabal LICENSE /project
+
+WORKDIR /project
+
+# Compile app
+RUN cabal update
@@ -4,6 +4,7 @@ packages: .
 -- packages: . ../http2
 -- packages: . ../network-transport

+-- uncomment two sections below to run tests with coverage
 -- package *
   -- coverage: True
   -- library-coverage: True
@@ -0,0 +1,67 @@
+name: SimpleX Chat - smp-server
+
+services:
+  oneshot:
+    image: ubuntu:latest
+    environment:
+      CADDYCONF: |
+        ${CADDY_OPTS:-}
+
+        http://{$$ADDR} {
+            redir https://{$$ADDR}{uri} permanent
+        }
+
+        {$$ADDR}:8443 {
+            tls {
+                key_type rsa4096
+            }
+        }
+    command: sh -c 'if [ ! -f /etc/caddy/Caddyfile ]; then printf "$${CADDYCONF}" > /etc/caddy/Caddyfile; fi'
+    volumes:
+      - ./caddy_conf:/etc/caddy
+
+  caddy:
+    image: caddy:latest
+    depends_on:
+      oneshot:
+        condition: service_completed_successfully
+    cap_add:
+      - NET_ADMIN
+    environment:
+      ADDR: ${ADDR?"Please specify the domain."}
+    volumes:
+      - ./caddy_conf:/etc/caddy
+      - caddy_data:/data
+      - caddy_config:/config
+    ports:
+      - 80:80
+    restart: unless-stopped
+    healthcheck:
+      test: "test -d /data/caddy/certificates/${CERT_PATH:-acme-v02.api.letsencrypt.org-directory}/${ADDR} || exit 1"
+      interval: 1s
+      retries: 60
+
+  smp-server:
+    image: ${SIMPLEX_IMAGE:-simplexchat/smp-server:latest}
+    depends_on:
+      caddy:
+        condition: service_healthy
+    environment:
+      ADDR: ${ADDR?"Please specify the domain."}
+      PASS: ${PASS:-}
+    volumes:
+      - ./smp_configs:/etc/opt/simplex
+      - ./smp_state:/var/opt/simplex
+      - type: volume
+        source: caddy_data
+        target: /certificates
+        volume:
+          subpath: "caddy/certificates/${CERT_PATH:-acme-v02.api.letsencrypt.org-directory}/${ADDR}"
+    ports:
+      - 443:443
+      - 5223:5223
+    restart: unless-stopped
+
+volumes:
+  caddy_data:
+  caddy_config:
@@ -0,0 +1,15 @@
+name: SimpleX Chat - smp-server
+
+services:
+  smp-server:
+    image: ${SIMPLEX_IMAGE:-simplexchat/smp-server:latest}
+    environment:
+      WEB_MANUAL: ${WEB_MANUAL:-1}
+      ADDR: ${ADDR?"Please specify the domain."}
+      PASS: ${PASS:-}
+    volumes:
+      - ./smp_configs:/etc/opt/simplex
+      - ./smp_state:/var/opt/simplex
+    ports:
+      - 5223:5223
+    restart: unless-stopped
@@ -0,0 +1,11 @@
+# Mandatory
+ADDR=your_ip_or_addr
+
+# Optional
+#PASS='123123'
+#WEB_MANUAL=1
+
+# Debug
+#SIMPLEX_SMP_IMAGE=smp-server-dev
+#CERT_PATH=acme-staging-v02.api.letsencrypt.org-directory
+#CADDY_OPTS='{\n    acme_ca https://acme-staging-v02.api.letsencrypt.org/directory\n}'
@@ -0,0 +1,9 @@
+# Mandatory
+ADDR=your_ip_or_addr
+QUOTA=120gb
+
+# Optional
+#PASS='123123'
+
+# Debug
+#SIMPLEX_XFTP_IMAGE=xftp-server-dev
@@ -0,0 +1,16 @@
+name: SimpleX Chat - xftp-server
+
+services:
+  xftp-server:
+    image: ${SIMPLEX_XFTP_IMAGE:-simplexchat/xftp-server:latest}
+    environment:
+      ADDR: ${ADDR?"Please specify the domain."}
+      QUOTA: ${QUOTA?"Please specify disk quota."}
+      PASS: ${PASS:-}
+    volumes:
+      - ./xftp_configs:/etc/opt/simplex-xftp
+      - ./xftp_state:/var/opt/simplex-xftp
+      - ./xftp_files:/srv/xftp
+    ports:
+      - 443:443
+    restart: unless-stopped
@@ -1,48 +1,87 @@
 #!/usr/bin/env sh
+set -e
+
 confd='/etc/opt/simplex'
-logd='/var/opt/simplex/'
+cert_path='/certificates'

 # 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 ;;
+    '')
+      printf 'Please specify $ADDR environment variable.\n'
+      exit 1
+      ;;
+
+    # Determine domain or IPv6
    *[a-zA-Z]*)
      case "${ADDR}" in
-        *:*) set -- --ip "${ADDR}" ;;
-        *) set -- -n "${ADDR}" ;;
+        # IPv6
+        *:*)
+          set -- --ip "${ADDR}"
+          ;;
+
+        # Domain
+        *)
+          case "${ADDR}" in
+            # It's in domain format
+            *.*)
+              # Determine the base domain
+              ADDR_BASE="$(printf '%s' "$ADDR" | awk -F. '{print $(NF-1)"."$NF}')"
+              set -- --fqdn "${ADDR}" --own-domains="${ADDR_BASE}"
+              ;;
+
+            # Incorrect domain
+            *)
+              printf 'Incorrect $ADDR environment variable. Please specify the correct one in format: smp1.example.org / example.org \n'
+              exit 1
+              ;;
+          esac
      esac
      ;;
-    *) set -- --ip "${ADDR}" ;;
+
+    # Assume everything else is IPv4
+    *)
+      set -- --ip "${ADDR}" ;;
  esac

  # Optionally, set password
  case "${PASS}" in
-    '') set -- "$@" --no-password ;;
-    *) set -- "$@" --password "${PASS}" ;;
+    # Empty value = no password
+    '')
+      set -- "$@" --no-password
+      ;;
+
+    # Assume that everything else is a password
+    *)
+      set -- "$@" --password "${PASS}"
+      ;;
  esac

  # And init certificates and configs
-  smp-server init -y -l "$@"
+  smp-server init --yes \
+                  --store-log \
+                  --daily-stats \
+                  --source-code \
+                  "$@" > /dev/null 2>&1
+
+  # Fix path to certificates
+  if [ -n "${WEB_MANUAL}" ]; then
+    sed -i -e 's|^[^#]*https: |#&|' \
+           -e 's|^[^#]*cert: |#&|' \
+           -e 's|^[^#]*key: |#&|' \
+           -e 's|^port:.*|port: 5223|' \
+           "${confd}/smp-server.ini"
+  else
+    sed -i -e "s|cert: /etc/opt/simplex/web.crt|cert: $cert_path/$ADDR.crt|" \
+           -e "s|key: /etc/opt/simplex/web.key|key: $cert_path/$ADDR.key|" \
+           "${confd}/smp-server.ini"
+  fi
 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
+DOCKER=true /usr/local/bin/simplex-servers-stopscript smp-server

 # 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
-
@@ -1,50 +1,90 @@
 #!/usr/bin/env sh
+set -eu
+
 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 ;;
+    '')
+      printf 'Please specify $ADDR environment variable.\n'
+      exit 1
+      ;;
+
+    # Determine domain or IPv6
    *[a-zA-Z]*)
      case "${ADDR}" in
-        *:*) set -- --ip "${ADDR}" ;;
-        *) set -- -n "${ADDR}" ;;
+        # IPv6
+        *:*)
+          set -- --ip "${ADDR}"
+          ;;
+
+        # Domain
+        *)
+          case "${ADDR}" in
+            # Check if format is correct
+            *.*)
+              set -- --fqdn "${ADDR}"
+              ;;
+
+            # Incorrect domain
+            *)
+              printf 'Incorrect $ADDR environment variable. Please specify the correct one in format: smp1.example.org / example.org \n'
+              exit 1
+              ;;
+          esac
+          ;;
      esac
      ;;
-    *) set -- --ip "${ADDR}" ;;
+
+    # Assume everything else is IPv4
+    *)
+      set -- --ip "${ADDR}"
+      ;;
  esac

-  # Set quota
+  # Set global disk quota
  case "${QUOTA}" in
-    '') printf 'Please specify $QUOTA environment variable.\n'; exit 1 ;;
-    *GB) QUOTA="$(printf ${QUOTA} | tr '[:upper:]' '[:lower:]')"; set -- "$@" --quota "${QUOTA}" ;;
-    *gb) set -- "$@" --quota "${QUOTA}" ;;
-    *) printf 'Wrong format. Format should be: 1gb, 10gb, 100gb.\n'; exit 1 ;;
+    '')
+      printf 'Please specify $QUOTA environment variable.\n'
+      exit 1
+      ;;
+
+    # Incorrect format in uppercase, but automagically workaround this, replacing characters to lowercase
+    *GB)
+      QUOTA="$(printf '%s' "${QUOTA}" | tr '[:upper:]' '[:lower:]')"
+      set -- "$@" --quota "${QUOTA}"
+      ;;
+
+    # Correct format  
+    *gb)
+      set -- "$@" --quota "${QUOTA}"
+      ;;
+
+    # Incorrect format
+    *)
+      printf 'Wrong format. Format should be: 1gb, 10gb, 100gb.\n'
+      exit 1
+      ;;
  esac

  # Init the certificates and configs
-  xftp-server init -l -p /srv/xftp "$@"
+  xftp-server init --store-log \
+                   --path /srv/xftp \
+                   "$@" > /dev/null 2>&1
+
+  # Optionally, set password
+  if [ -n "${PASS}" ]; then
+    sed -i -e "/^# create_password:/a create_password: $PASS" \
+           "${confd}/file-server.ini"
+  fi
 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
+
+DOCKER=true /usr/local/bin/simplex-servers-stopscript xftp-server

 # 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
-
@@ -148,8 +148,10 @@ xftp_cleanup() {

 main() {
 	type="${1:-}"
-  
-	checks
+
+  if [ -z "${DOCKER+x}" ]; then
+  	checks
+  fi

 	case "$type" in
 		smp-server)
@@ -1,13 +1,8 @@
 #!/usr/bin/env sh
 set -eu

-# Links to scripts/configs
-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"
+# Make sure that PATH variable contains /usr/local/bin
+PATH="/usr/local/bin:$PATH"

 # Default installation paths
 path_bin="/usr/local/bin"
@@ -22,7 +17,9 @@ 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="/tmp/simplex-servers"
+path_tmp_bin_smp="$path_tmp_bin/smp-server"
+path_tmp_bin_xftp="$path_tmp_bin/xftp-server"
 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"
@@ -37,203 +34,549 @@ BLU='\033[1;36m'
 YLW='\033[1;33m'
 RED='\033[0;31m'
 NC='\033[0m'
+BLD='\033[1m'
+UNDRL='\033[4m'
+
+NL='
+'
+
+# Set VER globally and only once
+VER="${VER:-latest}"

 # Currently, XFTP default to v0.1.0, so it doesn't make sense to check its version

-os_test() {
- . /etc/os-release
+######################
+### Misc functions ###
+######################

- case "$VERSION_ID" in
-  20.04|22.04) : ;;
-  24.04) VERSION_ID='22.04' ;;
-  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
- esac
+# Checks "sanity" of downloaded thing, e.g. if it's really a script or binary
+check_sanity() {
+  path="$1"
+  criteria="$2"

- version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
- arch="$(uname -p)"
+  case "$criteria" in
+    string:*)
+      pattern="$(printf '%s' "$criteria" | awk '{print $2}')"
+      
+      if grep -q "$pattern" "$path"; then
+        sane=0
+      else
+        sane=1
+      fi
+      ;;
+    file:*)
+      pattern="$(printf '%s' "$criteria" | awk '{print $2}')"

- case "$arch" in
-  x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
-  *)  printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
- esac
+      if file "$path" | grep -q "$pattern"; then
+        sane=0
+      else
+        sane=1
+      fi
+      ;;
+    *) printf 'Unknown criteria.\n'; sane=1 ;;
+  esac

- bin_smp="$bin/smp-server-ubuntu-${version}-${arch}"
- bin_xftp="$bin/xftp-server-ubuntu-${version}-${arch}"
+  unset path string
+
+  return "$sane"
 }

-installed_test() {
+# Checks if old thing and new thing is different
+change_check() {
+  old="$1"
+  new="$2"
+
+  if [ -x "$new" ] || [ -f "$new" ]; then
+    type="$(file $new)"
+  else
+    type='string'
+  fi
+
+  case "$type" in
+    *script*|*text*)
+      if diff -q "$old" "$new" > /dev/null 2>&1; then
+        changed=1
+      else
+        changed=0
+      fi
+      ;;
+    string)
+      if [ "$old" = "$new" ]; then
+        changed=1
+      else
+        changed=0
+      fi
+      ;;
+  esac
+
+  return "$changed"
+}
+
+##########################
+### Misc functions END ###
+##########################
+
+#########################
+### Support functions ###
+#########################
+
+# Sets local/remote versions and "apps" variables
+check_versions() {
+  # Sets:
+  # - ver
+  # - bin_url
+  # - remote_version
+  # - local_version
+  # - apps
+
+  case "$VER" in 
+    latest)
+      remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest 2>/dev/null | grep -i "tag_name" | awk -F \" '{print $4}')"
+
+      if [ -z "$remote_version" ]; then
+        printf "${RED}Something went wrong when ${YLW}resolving the lastest version${NC}: either you don't have connection to Github or you're rate-limited.\n"
+        exit 1
+      fi
+      ;;
+    *)
+      # Check if this version really exist
+      ver_check="https://github.com/simplex-chat/simplexmq/releases/tag/${VER}"
+      
+      if curl -o /dev/null --proto '=https' --tlsv1.2 -sf -L "${ver_check}"; then
+        remote_version="${VER}"
+      else
+        printf "Provided version ${BLU}%s${NC} ${RED}doesn't exist${NC}! Switching to ${BLU}latest${NC}.\n" "${VER}"
+        VER='latest'
+
+        # Re-execute check
+        check_versions
+
+        # Everything has been done, so return from the function
+        return 0
+      fi
+      ;;
+  esac
+
+  # Links to scripts/configs
+  bin_url="https://github.com/simplex-chat/simplexmq/releases/download/${remote_version}"
+  scripts_url="https://raw.githubusercontent.com/simplex-chat/simplexmq/refs/tags/${remote_version}/scripts/main"
+  scripts_url_systemd_smp="$scripts_url/smp-server.service"
+  scripts_url_systemd_xftp="$scripts_url/xftp-server.service"
+  scripts_url_update="$scripts_url/simplex-servers-update"
+  scripts_url_uninstall="$scripts_url/simplex-servers-uninstall"
+  scripts_url_stopscript="$scripts_url/simplex-servers-stopscript"
+
  set +u
-  for i in $path_conf_etc/*; do
-    if [ -d "$i" ]; then
-      case "$i" in
-        *simplex) apps="smp $apps" ;;
-        *simplex-xftp) apps="xftp $apps" ;;
-      esac
+  for i in smp xftp; do
+    # Only check local directory where binaries are installed by the script
+    if command -v "/usr/local/bin/$i-server" >/dev/null; then
+      apps="$i $apps"
    fi
  done
  set -u
-}

-set_version() {
-  ver="${VER:-latest}"
-
-  case "$ver" in 
-    latest)
-      bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
-      remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
-      ;;
-    *)
-      bin="https://github.com/simplex-chat/simplexmq/releases/download/${ver}"
-      remote_version="${ver}"
-      ;;
-  esac
-}
-
-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"
+  if [ -z "$apps" ]; then
+    printf "${RED}No simplex servers installed! Aborting.${NC}\n"
+    exit 1
  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
+  for server in $apps; do
+    # Check if info file is present
+    if [ -f "$path_conf_info/release" ]; then
+      # If present, source it
+      . "$path_conf_info/release" 2>/dev/null

-  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() {
-  service="${1}-server"
-  eval "scripts_systemd=\$scripts_systemd_${1}"
-  eval "path_systemd=\$path_systemd_${1}"
-  eval "path_tmp_systemd=\$path_tmp_systemd_${1}"
-   
-  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd" -o "$path_tmp_systemd"
-
-  if diff -q "$path_systemd" "$path_tmp_systemd" > /dev/null 2>&1; then
-    printf -- "- ${YLW}%s service is up-to-date${NC}.\n" "$service"
-    rm "$path_tmp_systemd"
-  else
-    printf -- "- Updating %s service..." "$service"
-    mv "$path_tmp_systemd" "$path_systemd"
-    systemctl daemon-reload
-    printf "${GRN}Done!${NC}\n"
-  fi
-
-  unset service scripts_systemd path_systemd path_tmp_systemd
-}
-
-update_bins() {
-  service="${1}-server"
-  eval "bin=\$bin_${1}"
-  eval "path_bin=\$path_bin_${1}"
-
-  set_ver() {
-    local_version='unset'
-    sed -i -- "s/local_version_${1}=.*/local_version_${1}='${remote_version}'/" "$path_conf_info/release"
-  }
-
-  if [ -f "$path_conf_info/release" ]; then
-    . "$path_conf_info/release" 2>/dev/null
-
-    set +u
-    eval "local_version=\$local_version_${1}"
-    set -u
-
-    if [ -z "${local_version}" ]; then
-            set_ver "$1"
-    fi
-  else
-    printf 'local_version_xftp=\nlocal_version_smp=\n' > "$path_conf_info/release"
-    set_ver "$1"
-  fi
-
-  if [ "$local_version" != "$remote_version" ]; then
-    if systemctl is-active --quiet "$service"; then
-      printf -- "- Stopping %s service..." "$service"
-      systemctl stop "$service"
-      printf "${GRN}Done!${NC}\n"
-
-      printf -- "- Updating %s to %s..." "$service" "$remote_version"
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
-      printf "${GRN}Done!${NC}\n"
-      
-      printf -- "- Starting %s service..." "$service"
-      systemctl start "$service"
-      printf "${GRN}Done!${NC}\n"
+      # Check if line containing local version exists in file
+      if grep -q "local_version_${server}" "$path_conf_info/release"; then
+        # if exists, set the var
+        eval "local_version=\$local_version_${server}"
+      else
+        # If it doesn't, append it to file
+        printf "local_version_${server}=unset\n" >> "$path_conf_info/release"
+        # And set it in script (so we don't have to re-source the file)
+        eval "local_version_${server}=unset"
+      fi
    else
-      printf -- "- Updating %s to %s..." "$service" "$remote_version"
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
-      printf "${GRN}Done!${NC}\n"
+      # If there isn't info file, populate it
+      printf "local_version_${server}=unset\n" >> "$path_conf_info/release"
    fi
-  else
-    printf -- "- ${YLW}%s is up-to-date${NC}.\n" "$service"
-  fi
+  done

-  set_ver "$1"
-
-  unset service bin path_bin local_version
+  # Return 
+  return 0
 }

+# Checks the distro and sets the urls variables
+check_distro() {
+  . /etc/os-release
+
+  case "$VERSION_ID" in
+    20.04|22.04) : ;;
+    24.04) VERSION_ID='22.04' ;;
+    *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
+  esac
+
+  version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
+  arch="$(uname -p)"
+
+  case "$arch" in
+    x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
+    *)  printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
+  esac
+
+  bin_url_smp="$bin_url/smp-server-ubuntu-${version}-${arch}"
+  bin_url_xftp="$bin_url/xftp-server-ubuntu-${version}-${arch}"
+
+  return 0
+}
+
+# General checks that must be performed on the initial execution of script
 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

-  set_version
-  os_test
-  installed_test
+  check_versions
+  check_distro

-  mkdir -p $path_conf_info
+  mkdir -p $path_conf_info $path_tmp_bin
+
+  return 0
 }

-main() {
-  checks
+#############################
+### Support functions END ###
+#############################

-  set +u
-  if [ "$1" != "continue" ]; then
-    set -u
-    printf "Updating scripts...\n"
-    update_scripts
-  else
-    set -u
+######################
+### Main functions ###
+######################
+
+# Downloads thing to directory and checks its sanity
+download_thing() {
+  thing="$1"
+  path="$2"
+  check_pattern="$3"
+  err_msg="$4"
+  
+  if ! curl --proto '=https' --tlsv1.2 -sSf -L "$thing" -o "$path"; then
+    printf "${RED}Something went wrong when downloading ${YLW}%s${NC}: either you don't have connection to Github or you're rate-limited.\n" "$err_msg"
+    exit 1
+  fi
+
+  type="$(file "$path")"
+
+  case "$type" in
+    *script*|*executable*) chmod +x "$path" ;;
+  esac
+
+  if ! check_sanity "$path" "$check_pattern"; then
+    printf "${RED}Something went wrong with downloaded ${YLW}%s${NC}: file is corrupted.\n" "$err_msg"
+    exit 1
+  fi
+
+  return 0
+}
+
+# Downloads all necessary files to temp dir and set update messages for the menu
+download_all() {
+  download_thing "$scripts_url_update" "$path_tmp_bin_update" 'string: /usr/bin/env' 'Update script'
+  if change_check "$path_tmp_bin_update" "$path_bin_update"; then
+    msg_scripts="${msg_scripts+$msg_scripts, }${YLW}simplex-servers-update${NC}"
+    msg_scripts_raw="${msg_scripts_raw+$msg_scripts_raw/}update"
+  fi
+
+  download_thing "$scripts_url_stopscript" "$path_tmp_bin_stopscript" 'string: /usr/bin/env' 'Stop script'
+  if change_check "$path_tmp_bin_stopscript" "$path_bin_stopscript"; then
+    msg_scripts="${msg_scripts+$msg_scripts, }${YLW}simplex-servers-stopscript${NC}"
+    msg_scripts_raw="${msg_scripts_raw+$msg_scripts_raw/}stop"
+  fi
+
+  download_thing "$scripts_url_uninstall" "$path_tmp_bin_uninstall" 'string: /usr/bin/env' 'Uninstall script'
+  if change_check "$path_tmp_bin_uninstall" "$path_bin_uninstall"; then
+    msg_scripts="${msg_scripts+$msg_scripts, }${YLW}simplex-servers-uninstall${NC}"
+    msg_scripts_raw="${msg_scripts_raw+$msg_scripts_raw/}uninstall"
+  fi
+
+  for i in $apps; do
+    service="${i}-server"
+    eval "scripts_url_systemd_final=\$scripts_url_systemd_${i}"
+    eval "path_tmp_systemd_final=\$path_tmp_systemd_${i}"
+    eval "path_systemd_final=\$path_systemd_${i}"
+   
+    download_thing "$scripts_url_systemd_final" "$path_tmp_systemd_final" 'string: [Unit]' "$service systemd service"
+    if change_check "$path_tmp_systemd_final" "$path_systemd_final"; then
+      msg_services="${msg_services+$msg_services, }${YLW}$service.service${NC}"
+      msg_services_raw="${msg_services_raw+$msg_services_raw/}$service"
+    fi
+  done
+
+  for i in $apps; do
+    service="${i}-server"
+    eval "local_version=\$local_version_${i}"
+
+    if change_check "$local_version" "$remote_version"; then
+      msg_bins="${msg_bins+$msg_bins$NL}  - ${YLW}$service${NC}: from ${BLU}$local_version${NC} to ${BLU}$remote_version${NC}"
+      msg_bins_alt="${msg_bins_alt+$msg_bins_alt, }${YLW}$service${NC}"
+      msg_bins_raw="${msg_bins_raw+$msg_bins_raw/}$service"
+    fi
+  done
+
+  return 0
+}
+
+# Updates systemd and scripts. This function depends om variables from "download_all"
+update_misc() {
+  OLD_IFS="$IFS"
+
+  IFS='/'
+  for script in ${msg_scripts_raw:-}; do
+    case "$script" in
+      update)
+        printf -- "- Updating update script..."
+        mv "$path_tmp_bin_update" "$path_bin_update"
+        printf "${GRN}Done!${NC}\n"
+        printf -- "- Re-executing Update script..."
+        exec env UPDATE_SCRIPT_DONE=1 VER="$remote_version" "$path_bin_update" "${selection}"
+        ;;
+      stop)
+        printf -- "- Updating stopscript script..."
+        mv "$path_tmp_bin_stopscript" "$path_bin_stopscript"
+        printf "${GRN}Done!${NC}\n"
+        ;;
+      uninstall)
+        printf -- "- Updating uninstall script..."
+        mv "$path_tmp_bin_uninstall" "$path_bin_uninstall"
+        printf "${GRN}Done!${NC}\n"
+        ;;
+    esac
+  done
+
+  for service in ${msg_services_raw:-}; do
+    app="${service%%-*}"
+    eval "path_systemd=\$path_systemd_${app}"
+    eval "path_tmp_systemd=\$path_tmp_systemd_${app}"
+
+    printf -- "- Updating %s service..." "$service"
+    mv "$path_tmp_systemd" "$path_systemd"
+    systemctl daemon-reload
+    printf "${GRN}Done!${NC}\n"
+  done
+
+  IFS="$OLD_IFS"
+  return 0
+}
+
+# Updates binaries. This function depends on variables from "download_all"
+update_bins() {
+  OLD_IFS="$IFS"
+
+  IFS='/'
+  for service in ${msg_bins_raw:-}; do
+    app="${service%%-*}"
+    eval "local_version=\$local_version_${app}"
+    eval "bin_url_final=\$bin_url_${app}"
+    eval "path_tmp_bin_final=\$path_tmp_bin_${app}"
+    eval "path_bin_final=\$path_bin_${app}"
+
+    # If systemd service is active
+    if systemctl is-active --quiet "$service"; then
+      printf -- "- Stopping %s service..." "$service"
+      systemctl stop "$service"
+      printf "${GRN}Done!${NC}\n"
+
+      printf -- "- Updating ${YLW}%s${NC} from ${BLU}%s${NC} to ${BLU}%s${NC}..." "$service" "$local_version" "$remote_version"
+      download_thing "$bin_url_final" "$path_tmp_bin_final" 'file: ELF' "$service"
+      mv "$path_tmp_bin_final" "$path_bin_final"
+      printf "${GRN}Done!${NC}\n"
+      
+      printf -- "- Starting %s service..." "$service"
+      systemctl start "$service"
+      printf "${GRN}Done!${NC}\n"
+    else
+      # If systemd service is NOT active
+      printf -- "- Updating ${YLW}%s${NC} from ${BLU}%s${NC} to ${BLU}%s${NC}..." "$service" "$local_version" "$remote_version"
+      download_thing "$bin_url_final" "$path_tmp_bin_final" 'file: ELF' "$service"
+      mv "$path_tmp_bin_final" "$path_bin_final"
+      printf "${GRN}Done!${NC}\n"
+    fi
+
+    # Don't forget to set version
+    sed -i -- "s|local_version_${app}=.*|local_version_${app}='${remote_version}'|" "$path_conf_info/release"
+  done
+
+  IFS="$OLD_IFS"
+  return 0
+}
+
+# Just download binaries
+download_bins() {
+  OLD_IFS="$IFS"
+
+  IFS='/'
+  for service in ${msg_bins_raw:-}; do
+    app="${service%%-*}"
+    eval "local_version=\$local_version_${app}"
+    eval "bin_url_final=\$bin_url_${app}"
+    eval "path_tmp_bin_final=\$path_tmp_bin_${app}"
+    eval "path_bin_final=\$path_bin_${app}"
+
+    printf -- "- Downloading ${YLW}%s${NC} binary..." "$service"
+    download_thing "$bin_url_final" "$path_tmp_bin_final" 'file: ELF' "$service"
+    printf "${GRN}Done!${NC}\n"
+  done
+
+  IFS="$OLD_IFS"
+  return 0
+}
+
+menu_init_help() {
+  menu_help="Update script for SimpleX servers and scripts.${NL}${NL}"
+  menu_help="${menu_help}${BLD}${UNDRL}Usage:${NC} [<VARIABLE>] ${BLD}simplex-servers-update${NC}${NL}       [<VARIABLE>] ${BLD}simplex-servers-update${NC} [<SUBCOMMAND>]${NL}${NL}"
+  menu_help="${menu_help}${BLD}${UNDRL}Subcommands:${NC}${NL}"
+  menu_help_sub="  ${BLD}[a]ll${NC}		Update everything without confirmation${NL}"
+  menu_help_sub="${menu_help_sub}  ${BLD}[b]inaries${NC}	Update binaries only without confirmation${NL}"
+  menu_help_sub="${menu_help_sub}  ${BLD}[d]ownload${NC}	Download everything without updating${NL}"
+  menu_help_sub="${menu_help_sub}  ${BLD}[h]elp${NC}	Print this message${NL}${NL}"
+  menu_help="${menu_help}${menu_help_sub}"
+  menu_help="${menu_help}${BLD}${UNDRL}Variables:${NC}${NL}"
+  menu_help="${menu_help}  ${BLD}VER=v3.2.1-beta.0${NC}	Update binaries to specified version${NL}"
+
+  return 0
+}
+
+menu_init() {
+  menu_end="${RED}x${NC}) Exit${NL}${NL}Selection: "
+  menu_option_download="${GRN}d${NC}) Download files only${NL}"
+
+  if [ -n "${msg_scripts:-}" ]; then
+    menu_option_misc_raw="${menu_option_misc_raw+${menu_option_misc_raw}${NL}}  - script(s): ${msg_scripts}"
+  fi
+
+  if [ -n "${msg_services:-}" ]; then
+    menu_option_misc_raw="${menu_option_misc_raw+${menu_option_misc_raw}${NL}}  - systemd service file(s): ${msg_services}"
+  fi
+
+  menu_option_all="${GRN}a${NC}) Update all: ${BLU}(recommended)${NC}${NL}${menu_option_misc_raw+${menu_option_misc_raw}${NL}}${msg_bins+${msg_bins}${NL}}"
+
+  if [ -n "${msg_bins:-}" ]; then
+    menu_option_bins="${GRN}b${NC}) Update server binaries: ${msg_bins_alt}${NL}"
+  fi
+
+  # Abort early if there's neither update binaries, nor update scripts options
+  if [ -z "${menu_option_bins:-}" ] && [ -z "${menu_option_misc_raw:-}" ]; then
+    printf "${YLW}Everything is up-to-date${NC}.\n"
+    exit 0
+  fi
+
+  menu="${menu_option_all}${menu_option_bins:-}${menu_option_download}${menu_end}"
+
+  return 0
+}
+
+options_parse() {
+  selection="$1"
+  
+  case "$selection" in
+    a|all)
+      check=0
+      if [ -z "${menu_option_misc_raw:-}" ] && [ -z "${menu_option_bins:-}" ]; then
+        printf "${YLW}Everything is up-to-date${NC}.\n"
+      else
+        if [ -n "${menu_option_misc_raw:-}" ]; then
+          update_misc
+        fi
+        if [ -n "${menu_option_bins:-}" ]; then
+          update_bins
+        fi
+      fi
+      ;;
+    b|binaries)
+      check=0
+      if [ -n "${menu_option_bins:-}" ]; then
+        update_bins
+      else
+        printf "${YLW}Binaries is up-to-date${NC}.\n"
+      fi
+      ;;
+    d|download)
+      check=0
+      if [ -n "${menu_option_bins:-}" ]; then
+        download_bins
+      fi
+
+      printf "\n${YLW}Scripts${NC}/${YLW}services${NC}/${YLW}binaries${NC} has been downloaded to ${BLU}%s${NC}\n" "$path_tmp_bin"
+      ;;
+    x)
+      check=0
+      ;;
+    *)
+      check=1
+      ;;
+  esac
+
+  return "$check"
+}
+
+##########################
+### Main functions END ###
+##########################
+
+############
+### Init ###
+############
+
+main() {
+  # Early hook to print Done after script re-execution
+  if [ -n "${UPDATE_SCRIPT_DONE:-}" ]; then
    printf "${GRN}Done!${NC}\n"
  fi

-  printf "Updating systemd services...\n"
-  for i in $apps; do
-    update_systemd "$i"
-  done
-  
-  printf "Updating simplex servers...\n"
-  for i in $apps; do
-    update_bins "$i"
-  done
+  # Early help menu
+  menu_init_help

-  rm -rf "$path_tmp_bin"
+  case "${1:-}" in
+    h|help)
+      printf '%b' "$menu_help"
+      exit 0
+      ;;
+  esac
+
+  checks
+  download_all
+  menu_init
+
+  onetime=0
+  while true; do
+    if [ "$onetime" = 0 ]; then
+      onetime=1
+
+      if [ -n "${1:-}" ]; then
+        selection="$1"
+      else
+        printf '%b' "$menu"
+        read selection
+      fi
+    else
+      read selection
+    fi
+    
+    if options_parse "$selection"; then
+      break
+    else
+      # Rerender whole menu if the first non-interactive option was bogus
+      if [ -n "${1:-}" ]; then
+        onetime=0
+        shift 1
+      else
+        # Erase last line
+        printf '\e[A\e[K'
+        # Only rerended selection
+        printf 'Selection: '
+      fi
+    fi
+  done
 }

 main "$@"
@@ -0,0 +1,30 @@
+#!/usr/bin/env sh
+set -eu
+
+tag="$1"
+
+git clone https://github.com/simplex-chat/simplexmq && cd simplexmq
+
+git checkout "$tag"
+
+for os in 20.04 22.04 24.04; do
+	mkdir -p out-${os}-github;
+
+	docker build -f Dockerfile.build --build-arg TAG=${os} -t repro-${os} .
+	docker run -t -d --name builder-${os} repro-${os}
+	
+	apps='smp-server xftp-server ntf-server xftp'
+	os_url="$(printf '%s' "$os" | tr '.' '_')"
+	
+	docker exec -t -e apps="$apps" builder-${os} sh -c 'cabal build && mkdir /out && for i in $apps; do bin=$(find /project/dist-newstyle -name "$i" -type f -executable); strip "$bin"; chmod +x "$bin"; mv "$bin" /out/; done'
+
+	docker cp builder-${os}:/out out-${os}
+	
+	for app in $apps; do
+		curl -L "https://github.com/simplex-chat/simplexmq/releases/download/${tag}/${app}-ubuntu-${os_url}-x86-64" -o out-${os}-github/${app}
+	done
+
+	docker stop builder-${os}
+	docker rm builder-${os} 
+	docker image rm repro-${os}
+done
@@ -1,7 +1,7 @@
 cabal-version: 1.12

 name:           simplexmq
-version:        6.2.2.0
+version:        6.3.0.8
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -67,6 +67,11 @@ flag client_library
  manual: True
  default: False

+flag client_postgres
+  description: Build with PostgreSQL instead of SQLite.
+  manual: True
+  default: False
+
 library
  exposed-modules:
      Simplex.FileTransfer.Agent
@@ -90,46 +95,13 @@ library
      Simplex.Messaging.Agent.RetryInterval
      Simplex.Messaging.Agent.Stats
      Simplex.Messaging.Agent.Store
-      Simplex.Messaging.Agent.Store.SQLite
-      Simplex.Messaging.Agent.Store.SQLite.Common
-      Simplex.Messaging.Agent.Store.SQLite.DB
-      Simplex.Messaging.Agent.Store.SQLite.Migrations
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
-      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.Store.SQLite.Migrations.M20230615_ratchet_sync
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
+      Simplex.Messaging.Agent.Store.AgentStore
+      Simplex.Messaging.Agent.Store.Common
+      Simplex.Messaging.Agent.Store.DB
+      Simplex.Messaging.Agent.Store.Interface
+      Simplex.Messaging.Agent.Store.Migrations
+      Simplex.Messaging.Agent.Store.Migrations.App
+      Simplex.Messaging.Agent.Store.Shared
      Simplex.Messaging.Agent.TRcvQueues
      Simplex.Messaging.Client
      Simplex.Messaging.Client.Agent
@@ -174,6 +146,63 @@ library
      Simplex.RemoteControl.Discovery.Multicast
      Simplex.RemoteControl.Invitation
      Simplex.RemoteControl.Types
+  if flag(client_postgres)
+      exposed-modules:
+          Simplex.Messaging.Agent.Store.Postgres
+          Simplex.Messaging.Agent.Store.Postgres.Common
+          Simplex.Messaging.Agent.Store.Postgres.DB
+          Simplex.Messaging.Agent.Store.Postgres.Migrations
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.App
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
+      if !flag(client_library)
+          exposed-modules:
+              Simplex.Messaging.Agent.Store.Postgres.Util
+  else
+      exposed-modules:
+          Simplex.Messaging.Agent.Store.SQLite
+          Simplex.Messaging.Agent.Store.SQLite.Common
+          Simplex.Messaging.Agent.Store.SQLite.DB
+          Simplex.Messaging.Agent.Store.SQLite.Migrations
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.App
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
+          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.Store.SQLite.Migrations.M20230615_ratchet_sync
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
  if !flag(client_library)
      exposed-modules:
          Simplex.FileTransfer.Client.Main
@@ -242,13 +271,11 @@ library
    , crypton-x509-validation ==1.6.*
    , cryptostore ==0.3.*
    , data-default ==0.7.*
-    , direct-sqlcipher ==2.3.*
    , directory ==1.3.*
    , filepath ==1.4.*
    , hourglass ==0.2.*
    , http-types ==0.12.*
    , http2 >=4.2.2 && <4.3
-    , ini ==0.4.1
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
@@ -257,14 +284,10 @@ library
    , network-info ==0.2.*
    , network-transport ==0.5.6
    , network-udp ==0.0.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
    , random >=1.1 && <1.3
    , simple-logger ==0.1.*
    , socks ==0.6.*
-    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
-    , temporary ==1.3.*
    , time ==1.12.*
    , time-manager ==0.0.*
    , tls >=1.9.0 && <1.10
@@ -280,7 +303,21 @@ library
    build-depends:
        case-insensitive ==1.2.*
      , hashable ==1.4.*
+      , ini ==0.4.1
+      , optparse-applicative >=0.15 && <0.17
+      , process ==1.6.*
+      , temporary ==1.3.*
      , websockets ==0.12.*
+  if flag(client_postgres)
+    build-depends:
+        postgresql-libpq >=0.10.0.0
+      , postgresql-simple ==0.7.*
+      , raw-strings-qq ==1.1.*
+    cpp-options: -DdbPostgres
+  else
+    build-depends:
+        direct-sqlcipher ==2.3.*
+      , sqlcipher-simple ==0.4.*
  if impl(ghc >= 9.6.2)
    build-depends:
        bytestring ==0.11.*
@@ -384,9 +421,7 @@ test-suite simplexmq-test
      AgentTests.FunctionalAPITests
      AgentTests.MigrationTests
      AgentTests.NotificationTests
-      AgentTests.SchemaDump
      AgentTests.ServerChoice
-      AgentTests.SQLiteTests
      CLITests
      CoreTests.BatchingTests
      CoreTests.CryptoFileTests
@@ -400,6 +435,7 @@ test-suite simplexmq-test
      CoreTests.UtilTests
      CoreTests.VersionRangeTests
      FileDescriptionTests
+      Fixtures
      NtfClient
      NtfServerTests
      RemoteControl
@@ -415,11 +451,16 @@ test-suite simplexmq-test
      Static
      Static.Embedded
      Paths_simplexmq
+  if !flag(client_postgres)
+      other-modules:
+          AgentTests.SchemaDump
+          AgentTests.SQLiteTests
  hs-source-dirs:
      tests
      apps/smp-server/web
  default-extensions:
      StrictData
+  -- add -fhpc to ghc-options to run tests with coverage
  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
  build-depends:
      base
@@ -455,7 +496,6 @@ test-suite simplexmq-test
    , silently ==1.2.*
    , simple-logger
    , simplexmq
-    , sqlcipher-simple
    , stm
    , text
    , time
@@ -470,3 +510,12 @@ test-suite simplexmq-test
    , warp-tls
    , yaml
  default-language: Haskell2010
+  if flag(client_postgres)
+    build-depends:
+        postgresql-libpq >=0.10.0.0
+      , postgresql-simple ==0.7.*
+      , raw-strings-qq ==1.1.*
+    cpp-options: -DdbPostgres
+  else
+    build-depends:
+        sqlcipher-simple
@@ -65,8 +65,8 @@ import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
-import Simplex.Messaging.Agent.Store.SQLite
-import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import Simplex.Messaging.Agent.Store.AgentStore
+import qualified Simplex.Messaging.Agent.Store.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.File as CF
@@ -9,6 +9,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

@@ -66,11 +67,10 @@ import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word32)
 import qualified Data.Yaml as Y
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Protocol
 import Simplex.Messaging.Agent.QueryString
+import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, parseAll)
@@ -113,6 +113,9 @@ fdSeparator = "################################\n"

 newtype FileDigest = FileDigest {unFileDigest :: ByteString}
  deriving (Eq, Show)
+  deriving newtype (FromField)
+
+instance ToField FileDigest where toField (FileDigest s) = toField $ Binary s

 instance StrEncoding FileDigest where
  strEncode (FileDigest fd) = strEncode fd
@@ -126,10 +129,6 @@ instance ToJSON FileDigest where
  toJSON = strToJSON
  toEncoding = strToJEncoding

-instance FromField FileDigest where fromField f = FileDigest <$> fromField f
-
-instance ToField FileDigest where toField (FileDigest s) = toField s
-
 data FileChunk = FileChunk
  { chunkNo :: Int,
    chunkSize :: FileSize Word32,
@@ -307,9 +306,9 @@ instance (Integral a, Show a) => StrEncoding (FileSize a) where
 instance (Integral a, Show a) => IsString (FileSize a) where
  fromString = either error id . strDecode . B.pack

-instance FromField a => FromField (FileSize a) where fromField f = FileSize <$> fromField f
+deriving newtype instance FromField a => FromField (FileSize a)

-instance ToField a => ToField (FileSize a) where toField (FileSize s) = toField s
+deriving newtype instance ToField a => ToField (FileSize a)

 groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [NonEmpty FileServerReplica]
 groupReplicasByServer defChunkSize =
@@ -25,7 +25,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isNothing)
 import Data.Type.Equality
 import Data.Word (Word32)
-import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPVersion, xftpClientHandshakeStub)
+import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPVersion, blockedFilesXFTPVersion, xftpClientHandshakeStub)
 import Simplex.Messaging.Client (authTransmission)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -276,12 +276,14 @@ data FileResponse

 instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
  type Tag FileResponse = FileResponseTag
-  encodeProtocol _v = \case
+  encodeProtocol v = \case
    FRSndIds fId rIds -> e (FRSndIds_, ' ', fId, rIds)
    FRRcvIds rIds -> e (FRRcvIds_, ' ', rIds)
    FRFile rDhKey nonce -> e (FRFile_, ' ', rDhKey, nonce)
    FROk -> e FROk_
-    FRErr err -> e (FRErr_, ' ', err)
+    FRErr err -> case err of
+      BLOCKED _ | v < blockedFilesXFTPVersion -> e (FRErr_, ' ', AUTH)
+      _ -> e (FRErr_, ' ', err)
    FRPong -> e FRPong_
    where
      e :: Encoding a => a -> ByteString
@@ -53,11 +53,11 @@ import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (CorrId (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
+import Simplex.Messaging.Protocol (CorrId (..), BlockingInfo, EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Control (CPClientRole (..))
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getRoundedSystemTime)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, ServerEntityStatus (..), getRoundedSystemTime)
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -287,11 +287,15 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
              CPDelete fileId -> withUserRole $ unliftIO u $ do
                fs <- asks store
                r <- runExceptT $ do
-                  let asSender = ExceptT . atomically $ getFile fs SFSender fileId
-                  let asRecipient = ExceptT . atomically $ getFile fs SFRecipient fileId
-                  (fr, _) <- asSender `catchError` const asRecipient
+                  (fr, _) <- ExceptT $ atomically $ getFile fs SFRecipient fileId
                  ExceptT $ deleteServerFile_ fr
                liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r
+              CPBlock fileId info -> withUserRole $ unliftIO u $ do
+                fs <- asks store
+                r <- runExceptT $ do
+                  (fr, _) <- ExceptT $ atomically $ getFile fs SFRecipient fileId
+                  ExceptT $ blockServerFile fr info
+                liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r
              CPHelp -> hPutStrLn h "commands: stats-rts, delete, help, quit"
              CPQuit -> pure ()
              CPSkip -> pure ()
@@ -321,7 +325,7 @@ processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHea
              let THandleParams {thAuth} = thParams
              verifyXFTPTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) sig_ signed fId cmd >>= \case
                VRVerified req -> uncurry send =<< processXFTPRequest body req
-                VRFailed -> send (FRErr AUTH) Nothing
+                VRFailed e -> send (FRErr e) Nothing
            Left e -> send (FRErr e) Nothing
          where
            send resp = sendXFTPResponse (corrId, fId, resp)
@@ -355,7 +359,7 @@ randomDelay = do
    threadDelay $ (d * (1000 + pc)) `div` 1000
 #endif

-data VerificationResult = VRVerified XFTPRequest | VRFailed
+data VerificationResult = VRVerified XFTPRequest | VRFailed XFTPErrorType

 verifyXFTPTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> XFTPFileId -> FileCmd -> M VerificationResult
 verifyXFTPTransmission auth_ tAuth authorized fId cmd =
@@ -367,13 +371,19 @@ verifyXFTPTransmission auth_ tAuth authorized fId cmd =
    verifyCmd :: SFileParty p -> M VerificationResult
    verifyCmd party = do
      st <- asks store
-      atomically $ verify <$> getFile st party fId
+      atomically $ verify =<< getFile st party fId
      where
        verify = \case
-          Right (fr, k) -> XFTPReqCmd fId fr cmd `verifyWith` k
-          _ -> maybe False (dummyVerifyCmd Nothing authorized) tAuth `seq` VRFailed
+          Right (fr, k) -> result <$> readTVar (fileStatus fr)
+            where
+              result = \case
+                EntityActive -> XFTPReqCmd fId fr cmd `verifyWith` k
+                EntityBlocked info -> VRFailed $ BLOCKED info
+                EntityOff -> noFileAuth
+          Left _ -> pure noFileAuth
+        noFileAuth = maybe False (dummyVerifyCmd Nothing authorized) tAuth `seq` VRFailed AUTH
    -- TODO verify with DH authorization
-    req `verifyWith` k = if verifyCmdAuthorization auth_ tAuth authorized k then VRVerified req else VRFailed
+    req `verifyWith` k = if verifyCmdAuthorization auth_ tAuth authorized k then VRVerified req else VRFailed AUTH

 processXFTPRequest :: HTTP2Body -> XFTPRequest -> M (FileResponse, Maybe ServerFile)
 processXFTPRequest HTTP2Body {bodyPart} = \case
@@ -390,7 +400,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
    FACK -> noFile =<< ackFileReception fId fr
    -- it should never get to the commands below, they are passed in other constructors of XFTPRequest
    FNEW {} -> noFile $ FRErr INTERNAL
-    PING -> noFile FRPong
+    PING -> noFile $ FRErr INTERNAL
  XFTPReqPing -> noFile FRPong
  where
    noFile resp = pure (resp, Nothing)
@@ -405,7 +415,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
        sId <- ExceptT $ addFileRetry st file 3 ts
        rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks
        lift $ withFileLog $ \sl -> do
-          logAddFile sl sId file ts
+          logAddFile sl sId file ts EntityActive
          logAddRecipients sl sId rcps
        stats <- asks serverStats
        lift $ incFileStat filesCreated
@@ -416,7 +426,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
    addFileRetry :: FileStore -> FileInfo -> Int -> RoundedSystemTime -> M (Either XFTPErrorType XFTPFileId)
    addFileRetry st file n ts =
      retryAdd n $ \sId -> runExceptT $ do
-        ExceptT $ addFile st sId file ts
+        ExceptT $ addFile st sId file ts EntityActive
        pure sId
    addRecipientRetry :: FileStore -> Int -> XFTPFileId -> RcvPublicAuthKey -> M (Either XFTPErrorType FileRecipient)
    addRecipientRetry st n sId rpk =
@@ -518,15 +528,24 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
      pure FROk

 deleteServerFile_ :: FileRec -> M (Either XFTPErrorType ())
-deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do
+deleteServerFile_ fr@FileRec {senderId} = do
  withFileLog (`logDeleteFile` senderId)
-  runExceptT $ do
-    path <- readTVarIO filePath
-    stats <- asks serverStats
-    ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats))
-    st <- asks store
-    void $ atomically $ deleteFile st senderId
-    lift $ incFileStat filesDeleted
+  deleteOrBlockServerFile_ fr filesDeleted (`deleteFile` senderId)
+
+-- this also deletes the file from storage, but doesn't include it in delete statistics
+blockServerFile :: FileRec -> BlockingInfo -> M (Either XFTPErrorType ())
+blockServerFile fr@FileRec {senderId} info = do
+  withFileLog $ \sl -> logBlockFile sl senderId info
+  deleteOrBlockServerFile_ fr filesBlocked $ \st -> blockFile st senderId info True
+
+deleteOrBlockServerFile_ :: FileRec -> (FileServerStats -> IORef Int) -> (FileStore -> STM (Either XFTPErrorType ())) -> M (Either XFTPErrorType ())
+deleteOrBlockServerFile_ FileRec {filePath, fileInfo} stat storeAction = runExceptT $ do
+  path <- readTVarIO filePath
+  stats <- asks serverStats
+  ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats))
+  st <- asks store
+  void $ atomically $ storeAction st
+  lift $ incFileStat stat
  where
    deletedStats stats = do
      liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1)
@@ -6,12 +6,13 @@ module Simplex.FileTransfer.Server.Control where
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Simplex.FileTransfer.Protocol (XFTPFileId)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BasicAuth)
+import Simplex.Messaging.Protocol (BasicAuth, BlockingInfo)

 data ControlProtocol
  = CPAuth BasicAuth
  | CPStatsRTS
  | CPDelete XFTPFileId
+  | CPBlock XFTPFileId BlockingInfo
  | CPHelp
  | CPQuit
  | CPSkip
@@ -21,6 +22,7 @@ instance StrEncoding ControlProtocol where
    CPAuth tok -> "auth " <> strEncode tok
    CPStatsRTS -> "stats-rts"
    CPDelete fId -> strEncode (Str "delete", fId)
+    CPBlock fId info -> strEncode (Str "block", fId, info)
    CPHelp -> "help"
    CPQuit -> "quit"
    CPSkip -> ""
@@ -29,6 +31,7 @@ instance StrEncoding ControlProtocol where
      "auth" -> CPAuth <$> _strP
      "stats-rts" -> pure CPStatsRTS
      "delete" -> CPDelete <$> _strP
+      "block" -> CPBlock <$> _strP <*> _strP
      "help" -> pure CPHelp
      "quit" -> pure CPQuit
      "" -> pure CPSkip
@@ -20,6 +20,7 @@ data FileServerStats = FileServerStats
    filesUploaded :: IORef Int,
    filesExpired :: IORef Int,
    filesDeleted :: IORef Int,
+    filesBlocked :: IORef Int,
    filesDownloaded :: PeriodStats,
    fileDownloads :: IORef Int,
    fileDownloadAcks :: IORef Int,
@@ -34,6 +35,7 @@ data FileServerStatsData = FileServerStatsData
    _filesUploaded :: Int,
    _filesExpired :: Int,
    _filesDeleted :: Int,
+    _filesBlocked :: Int,
    _filesDownloaded :: PeriodStatsData,
    _fileDownloads :: Int,
    _fileDownloadAcks :: Int,
@@ -50,12 +52,13 @@ newFileServerStats ts = do
  filesUploaded <- newIORef 0
  filesExpired <- newIORef 0
  filesDeleted <- newIORef 0
+  filesBlocked <- newIORef 0
  filesDownloaded <- newPeriodStats
  fileDownloads <- newIORef 0
  fileDownloadAcks <- newIORef 0
  filesCount <- newIORef 0
  filesSize <- newIORef 0
-  pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
+  pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesBlocked, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}

 getFileServerStatsData :: FileServerStats -> IO FileServerStatsData
 getFileServerStatsData s = do
@@ -65,12 +68,13 @@ getFileServerStatsData s = do
  _filesUploaded <- readIORef $ filesUploaded s
  _filesExpired <- readIORef $ filesExpired s
  _filesDeleted <- readIORef $ filesDeleted s
+  _filesBlocked <- readIORef $ filesBlocked s
  _filesDownloaded <- getPeriodStatsData $ filesDownloaded s
  _fileDownloads <- readIORef $ fileDownloads s
  _fileDownloadAcks <- readIORef $ fileDownloadAcks s
  _filesCount <- readIORef $ filesCount s
  _filesSize <- readIORef $ filesSize s
-  pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
+  pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesBlocked, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}

 -- this function is not thread safe, it is used on server start only
 setFileServerStats :: FileServerStats -> FileServerStatsData -> IO ()
@@ -81,6 +85,7 @@ setFileServerStats s d = do
  writeIORef (filesUploaded s) $! _filesUploaded d
  writeIORef (filesExpired s) $! _filesExpired d
  writeIORef (filesDeleted s) $! _filesDeleted d
+  writeIORef (filesBlocked s) $! _filesBlocked d
  setPeriodStats (filesDownloaded s) $! _filesDownloaded d
  writeIORef (fileDownloads s) $! _fileDownloads d
  writeIORef (fileDownloadAcks s) $! _fileDownloadAcks d
@@ -88,7 +93,7 @@ setFileServerStats s d = do
  writeIORef (filesSize s) $! _filesSize d

 instance StrEncoding FileServerStatsData where
-  strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =
+  strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesBlocked, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =
    B.unlines
      [ "fromTime=" <> strEncode _fromTime,
        "filesCreated=" <> strEncode _filesCreated,
@@ -96,6 +101,7 @@ instance StrEncoding FileServerStatsData where
        "filesUploaded=" <> strEncode _filesUploaded,
        "filesExpired=" <> strEncode _filesExpired,
        "filesDeleted=" <> strEncode _filesDeleted,
+        "filesBlocked=" <> strEncode _filesBlocked,
        "filesCount=" <> strEncode _filesCount,
        "filesSize=" <> strEncode _filesSize,
        "filesDownloaded:",
@@ -110,9 +116,12 @@ instance StrEncoding FileServerStatsData where
    _filesUploaded <- "filesUploaded=" *> strP <* A.endOfLine
    _filesExpired <- "filesExpired=" *> strP <* A.endOfLine <|> pure 0
    _filesDeleted <- "filesDeleted=" *> strP <* A.endOfLine
+    _filesBlocked <- opt "filesBlocked="
    _filesCount <- "filesCount=" *> strP <* A.endOfLine <|> pure 0
    _filesSize <- "filesSize=" *> strP <* A.endOfLine <|> pure 0
    _filesDownloaded <- "filesDownloaded:" *> A.endOfLine *> strP <* A.endOfLine
    _fileDownloads <- "fileDownloads=" *> strP <* A.endOfLine
    _fileDownloadAcks <- "fileDownloadAcks=" *> strP <* A.endOfLine
-    pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
+    pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesBlocked, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
+    where
+      opt s = A.string s *> strP <* A.endOfLine <|> pure 0
@@ -13,6 +13,7 @@ module Simplex.FileTransfer.Server.Store
    setFilePath,
    addRecipient,
    deleteFile,
+    blockFile,
    deleteRecipient,
    expiredFilePath,
    getFile,
@@ -22,6 +23,7 @@ module Simplex.FileTransfer.Server.Store
 where

 import Control.Concurrent.STM
+import Control.Monad
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Int (Int64)
 import Data.Set (Set)
@@ -30,8 +32,8 @@ import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..), XFTPFileId
 import Simplex.FileTransfer.Transport (XFTPErrorType (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
-import Simplex.Messaging.Server.QueueStore (RoundedSystemTime (..))
+import Simplex.Messaging.Protocol (BlockingInfo, RcvPublicAuthKey, RecipientId, SenderId)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime (..), ServerEntityStatus (..))
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (ifM, ($>>=))
@@ -47,7 +49,8 @@ data FileRec = FileRec
    fileInfo :: FileInfo,
    filePath :: TVar (Maybe FilePath),
    recipientIds :: TVar (Set RecipientId),
-    createdAt :: RoundedSystemTime
+    createdAt :: RoundedSystemTime,
+    fileStatus :: TVar ServerEntityStatus
  }

 fileTimePrecision :: Int64
@@ -67,18 +70,19 @@ newFileStore = do
  usedStorage <- newTVarIO 0
  pure FileStore {files, recipients, usedStorage}

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

-newFileRec :: SenderId -> FileInfo -> RoundedSystemTime -> STM FileRec
-newFileRec senderId fileInfo createdAt = do
+newFileRec :: SenderId -> FileInfo -> RoundedSystemTime -> ServerEntityStatus -> STM FileRec
+newFileRec senderId fileInfo createdAt status = do
  recipientIds <- newTVar S.empty
  filePath <- newTVar Nothing
-  pure FileRec {senderId, fileInfo, filePath, recipientIds, createdAt}
+  fileStatus <- newTVar status
+  pure FileRec {senderId, fileInfo, filePath, recipientIds, createdAt, fileStatus}

 setFilePath :: FileStore -> SenderId -> FilePath -> STM (Either XFTPErrorType ())
 setFilePath st sId fPath =
@@ -109,6 +113,14 @@ deleteFile FileStore {files, recipients, usedStorage} senderId = do
      pure $ Right ()
    _ -> pure $ Left AUTH

+-- this function must be called after the file is deleted from the file system
+blockFile :: FileStore -> SenderId -> BlockingInfo -> Bool -> STM (Either XFTPErrorType ())
+blockFile st@FileStore {usedStorage} senderId info deleted =
+  withFile st senderId $ \FileRec {fileInfo, fileStatus} -> do
+    when deleted $ modifyTVar' usedStorage $ subtract (fromIntegral $ size fileInfo)
+    writeTVar fileStatus $! EntityBlocked info
+    pure $ Right ()
+
 deleteRecipient :: FileStore -> RecipientId -> FileRec -> STM ()
 deleteRecipient FileStore {recipients} rId FileRec {recipientIds} = do
  TM.delete rId recipients
@@ -14,16 +14,18 @@ module Simplex.FileTransfer.Server.StoreLog
    logPutFile,
    logAddRecipients,
    logDeleteFile,
+    logBlockFile,
    logAckFile,
  )
 where

+import Control.Applicative ((<|>))
 import Control.Concurrent.STM
 import Control.Monad.Except
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Composition ((.:), (.:.))
+import Data.Composition ((.:), (.::))
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
@@ -31,41 +33,44 @@ import qualified Data.Map.Strict as M
 import Simplex.FileTransfer.Protocol (FileInfo (..))
 import Simplex.FileTransfer.Server.Store
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
-import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
+import Simplex.Messaging.Protocol (BlockingInfo, RcvPublicAuthKey, RecipientId, SenderId)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, ServerEntityStatus (..))
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Util (bshow)
 import System.IO

 data FileStoreLogRecord
-  = AddFile SenderId FileInfo RoundedSystemTime
+  = AddFile SenderId FileInfo RoundedSystemTime ServerEntityStatus
  | PutFile SenderId FilePath
  | AddRecipients SenderId (NonEmpty FileRecipient)
  | DeleteFile SenderId
-  | AckFile RecipientId
+  | BlockFile SenderId BlockingInfo
+  | AckFile RecipientId -- TODO add senderId as well?
  deriving (Show)

 instance StrEncoding FileStoreLogRecord where
  strEncode = \case
-    AddFile sId file createdAt -> strEncode (Str "FNEW", sId, file, createdAt)
+    AddFile sId file createdAt status -> strEncode (Str "FNEW", sId, file, createdAt, status)
    PutFile sId path -> strEncode (Str "FPUT", sId, path)
    AddRecipients sId rcps -> strEncode (Str "FADD", sId, rcps)
    DeleteFile sId -> strEncode (Str "FDEL", sId)
+    BlockFile sId info -> strEncode (Str "FBLK", sId, info)
    AckFile rId -> strEncode (Str "FACK", rId)
  strP =
    A.choice
-      [ "FNEW " *> (AddFile <$> strP_ <*> strP_ <*> strP),
+      [ "FNEW " *> (AddFile <$> strP_ <*> strP_ <*> strP <*> (_strP <|> pure EntityActive)),
        "FPUT " *> (PutFile <$> strP_ <*> strP),
        "FADD " *> (AddRecipients <$> strP_ <*> strP),
        "FDEL " *> (DeleteFile <$> strP),
+        "FBLK " *> (BlockFile <$> strP_ <*> strP),
        "FACK " *> (AckFile <$> strP)
      ]

 logFileStoreRecord :: StoreLog 'WriteMode -> FileStoreLogRecord -> IO ()
 logFileStoreRecord = writeStoreLogRecord

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

 logPutFile :: StoreLog 'WriteMode -> SenderId -> FilePath -> IO ()
 logPutFile s = logFileStoreRecord s .: PutFile
@@ -76,6 +81,9 @@ logAddRecipients s = logFileStoreRecord s .: AddRecipients
 logDeleteFile :: StoreLog 'WriteMode -> SenderId -> IO ()
 logDeleteFile s = logFileStoreRecord s . DeleteFile

+logBlockFile :: StoreLog 'WriteMode -> SenderId -> BlockingInfo -> IO ()
+logBlockFile s fId = logFileStoreRecord s . BlockFile fId
+
 logAckFile :: StoreLog 'WriteMode -> RecipientId -> IO ()
 logAckFile s = logFileStoreRecord s . AckFile

@@ -92,10 +100,11 @@ readFileStore f st = mapM_ (addFileLogRecord . LB.toStrict) . LB.lines =<< LB.re
          Left e -> B.putStrLn $ "Log processing error (" <> bshow e <> "): " <> B.take 100 s
          _ -> pure ()
    addToStore = \case
-      AddFile sId file createdAt -> addFile st sId file createdAt
+      AddFile sId file createdAt status -> addFile st sId file createdAt status
      PutFile qId path -> setFilePath st qId path
      AddRecipients sId rcps -> runExceptT $ addRecipients sId rcps
      DeleteFile sId -> deleteFile st sId
+      BlockFile sId info -> blockFile st sId info True
      AckFile rId -> ackFile st rId
    addRecipients sId rcps = mapM_ (ExceptT . addRecipient st sId) rcps

@@ -105,8 +114,9 @@ writeFileStore s FileStore {files, recipients} = do
  readTVarIO files >>= mapM_ (logFile allRcps)
  where
    logFile :: Map RecipientId (SenderId, RcvPublicAuthKey) -> FileRec -> IO ()
-    logFile allRcps FileRec {senderId, fileInfo, filePath, recipientIds, createdAt} = do
-      logAddFile s senderId fileInfo createdAt
+    logFile allRcps FileRec {senderId, fileInfo, filePath, recipientIds, createdAt, fileStatus} = do
+      status <- readTVarIO fileStatus
+      logAddFile s senderId fileInfo createdAt status
      (rcpErrs, rcps) <- M.mapEither getRcp . M.fromSet id <$> readTVarIO recipientIds
      mapM_ (logAddRecipients s senderId) $ L.nonEmpty $ M.elems rcps
      mapM_ (B.putStrLn . ("Error storing log: " <>)) rcpErrs
@@ -11,6 +11,7 @@
 module Simplex.FileTransfer.Transport
  ( supportedFileServerVRange,
    authCmdsXFTPVersion,
+    blockedFilesXFTPVersion,
    xftpClientHandshakeStub,
    supportedXFTPhandshakes,
    XFTPClientHandshake (..),
@@ -33,7 +34,6 @@ module Simplex.FileTransfer.Transport
  )
 where

-import Control.Applicative ((<|>))
 import qualified Control.Exception as E
 import Control.Logger.Simple
 import Control.Monad
@@ -57,7 +57,7 @@ import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
-import Simplex.Messaging.Protocol (CommandError)
+import Simplex.Messaging.Protocol (BlockingInfo, CommandError)
 import Simplex.Messaging.Transport (ALPN, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
 import Simplex.Messaging.Transport.HTTP2.File
 import Simplex.Messaging.Util (bshow, tshow)
@@ -92,15 +92,18 @@ initialXFTPVersion = VersionXFTP 1
 authCmdsXFTPVersion :: VersionXFTP
 authCmdsXFTPVersion = VersionXFTP 2

+blockedFilesXFTPVersion :: VersionXFTP
+blockedFilesXFTPVersion = VersionXFTP 3
+
 currentXFTPVersion :: VersionXFTP
-currentXFTPVersion = VersionXFTP 2
+currentXFTPVersion = VersionXFTP 3

 supportedFileServerVRange :: VersionRangeXFTP
 supportedFileServerVRange = mkVersionRange initialXFTPVersion currentXFTPVersion

 -- XFTP protocol does not use this handshake method
-xftpClientHandshakeStub :: c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
-xftpClientHandshakeStub _c _ks _keyHash _xftpVRange = throwE TEVersion
+xftpClientHandshakeStub :: c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> Bool -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
+xftpClientHandshakeStub _c _ks _keyHash _xftpVRange _proxyServer = throwE TEVersion

 supportedXFTPhandshakes :: [ALPN]
 supportedXFTPhandshakes = ["xftp/1"]
@@ -211,6 +214,8 @@ data XFTPErrorType
    CMD {cmdErr :: CommandError}
  | -- | command authorization error - bad signature or non-existing SMP queue
    AUTH
+  | -- | command with the entity that was blocked
+    BLOCKED {blockInfo :: BlockingInfo}
  | -- | incorrent file size
    SIZE
  | -- | storage quota exceeded
@@ -231,15 +236,46 @@ data XFTPErrorType
    INTERNAL
  | -- | used internally, never returned by the server (to be removed)
    DUPLICATE_ -- not part of SMP protocol, used internally
-  deriving (Eq, Read, Show)
+  deriving (Eq, Show)

 instance StrEncoding XFTPErrorType where
  strEncode = \case
+    BLOCK -> "BLOCK"
+    SESSION -> "SESSION"
+    HANDSHAKE -> "HANDSHAKE"
    CMD e -> "CMD " <> bshow e
-    e -> bshow e
+    AUTH -> "AUTH"
+    BLOCKED info -> "BLOCKED " <> strEncode info
+    SIZE -> "SIZE"
+    QUOTA -> "QUOTA"
+    DIGEST -> "DIGEST"
+    CRYPTO -> "CRYPTO"
+    NO_FILE -> "NO_FILE"
+    HAS_FILE -> "HAS_FILE"
+    FILE_IO -> "FILE_IO"
+    TIMEOUT -> "TIMEOUT"
+    INTERNAL -> "INTERNAL"
+    DUPLICATE_ -> "DUPLICATE_"
+
  strP =
-    "CMD " *> (CMD <$> parseRead1)
-      <|> parseRead1
+    A.takeTill (== ' ') >>= \case
+      "BLOCK" -> pure BLOCK
+      "SESSION" -> pure SESSION
+      "HANDSHAKE" -> pure HANDSHAKE
+      "CMD" -> CMD <$> parseRead1
+      "AUTH" -> pure AUTH
+      "BLOCKED" -> BLOCKED <$> _strP
+      "SIZE" -> pure SIZE
+      "QUOTA" -> pure QUOTA
+      "DIGEST" -> pure DIGEST
+      "CRYPTO" -> pure CRYPTO
+      "NO_FILE" -> pure NO_FILE
+      "HAS_FILE" -> pure HAS_FILE
+      "FILE_IO" -> pure FILE_IO
+      "TIMEOUT" -> pure TIMEOUT
+      "INTERNAL" -> pure INTERNAL
+      "DUPLICATE_" -> pure DUPLICATE_
+      _ -> fail "bad error type"

 instance Encoding XFTPErrorType where
  smpEncode = \case
@@ -248,6 +284,7 @@ instance Encoding XFTPErrorType where
    HANDSHAKE -> "HANDSHAKE"
    CMD err -> "CMD " <> smpEncode err
    AUTH -> "AUTH"
+    BLOCKED info -> "BLOCKED " <> smpEncode info
    SIZE -> "SIZE"
    QUOTA -> "QUOTA"
    DIGEST -> "DIGEST"
@@ -266,6 +303,7 @@ instance Encoding XFTPErrorType where
      "HANDSHAKE" -> pure HANDSHAKE
      "CMD" -> CMD <$> _smpP
      "AUTH" -> pure AUTH
+      "BLOCKED" -> BLOCKED <$> _smpP
      "SIZE" -> pure SIZE
      "QUOTA" -> pure QUOTA
      "DIGEST" -> pure DIGEST
@@ -13,8 +13,6 @@ import Data.Int (Int64)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word32)
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
 import Simplex.FileTransfer.Description
 import qualified Simplex.Messaging.Crypto as C
@@ -24,6 +22,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (XFTPServer)
 import System.FilePath ((</>))
+import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))

 type RcvFileId = ByteString -- Agent entity ID

@@ -35,6 +35,8 @@ module Simplex.Messaging.Agent
    AE,
    SubscriptionsInfo (..),
    MsgReq,
+    ValueOrRef (..),
+    vrValue,
    getSMPAgentClient,
    getSMPAgentClient_,
    disconnectAgentClient,
@@ -140,6 +142,9 @@ import Data.Either (isRight, partitionEithers, rights)
 import Data.Foldable (foldl', toList)
 import Data.Functor (($>))
 import Data.Functor.Identity
+import Data.Int (Int64)
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IM
 import Data.List (find)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
@@ -167,9 +172,11 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
-import Simplex.Messaging.Agent.Store.SQLite
-import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
+import Simplex.Messaging.Agent.Store.AgentStore
+import Simplex.Messaging.Agent.Store.Common (DBStore)
+import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Agent.Store.Interface (closeDBStore, execSQL, getCurrentMigrations)
+import Simplex.Messaging.Agent.Store.Shared (UpMigration (..), upMigration)
 import Simplex.Messaging.Client (SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs)
@@ -200,11 +207,11 @@ import UnliftIO.STM
 type AE a = ExceptT AgentErrorType IO a

 -- | Creates an SMP agent client instance
-getSMPAgentClient :: AgentConfig -> InitialAgentServers -> SQLiteStore -> Bool -> IO AgentClient
+getSMPAgentClient :: AgentConfig -> InitialAgentServers -> DBStore -> Bool -> IO AgentClient
 getSMPAgentClient = getSMPAgentClient_ 1
 {-# INLINE getSMPAgentClient #-}

-getSMPAgentClient_ :: Int -> AgentConfig -> InitialAgentServers -> SQLiteStore -> Bool -> IO AgentClient
+getSMPAgentClient_ :: Int -> AgentConfig -> InitialAgentServers -> DBStore -> Bool -> IO AgentClient
 getSMPAgentClient_ clientId cfg initServers@InitialAgentServers {smp, xftp} store backgroundMode =
  newSMPAgentEnv cfg store >>= runReaderT runAgent
  where
@@ -277,7 +284,7 @@ disposeAgentClient c@AgentClient {acThread, agentEnv = Env {store}} = do
  t_ <- atomically (swapTVar acThread Nothing) $>>= (liftIO . deRefWeak)
  disconnectAgentClient c
  mapM_ killThread t_
-  liftIO $ closeSQLiteStore store
+  liftIO $ closeDBStore store

 resumeAgentClient :: AgentClient -> IO ()
 resumeAgentClient c = atomically $ writeTVar (active c) True
@@ -407,11 +414,25 @@ sendMessage :: AgentClient -> ConnId -> PQEncryption -> MsgFlags -> MsgBody -> A
 sendMessage c = withAgentEnv c .:: sendMessage' c
 {-# INLINE sendMessage #-}

+data ValueOrRef a = VRValue (Maybe Int) a | VRRef Int
+
+instance Functor ValueOrRef where
+  fmap f = \case
+    VRValue i_ a -> VRValue i_ (f a)
+    VRRef i -> VRRef i
+
+vrValue :: a -> ValueOrRef a
+vrValue = VRValue Nothing
+
 -- When sending multiple messages to the same connection,
 -- only the first MsgReq for this connection should have non-empty ConnId.
 -- All subsequent MsgReq in traversable for this connection must be empty.
 -- This is done to optimize processing by grouping all messages to one connection together.
-type MsgReq = (ConnId, PQEncryption, MsgFlags, MsgBody)
+-- Also, repeated msg bodies should us MBRef constructor to reference previously used body.
+-- It is an error:
+-- - to use MBBody with the same Int
+-- - to use MBRef with Int that wasn't previously used in MBBody
+type MsgReq = (ConnId, PQEncryption, MsgFlags, ValueOrRef MsgBody)

 -- | Send multiple messages to different connections (SEND command)
 sendMessages :: AgentClient -> [MsgReq] -> AE [Either AgentErrorType (AgentMsgId, PQEncryption)]
@@ -834,26 +855,39 @@ joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do
 startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448)
 startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
  lift (compatibleInvitationUri cReqUri) >>= \case
-    Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_), Compatible connAgentVersion) -> do
-      g <- asks random
+    Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
+      -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out
+      -- e2ePubKey is always present, it's Maybe historically
      let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v)
+      (sq', e2eSndParams) <- case sq_ of
+        Just sq@SndQueue {e2ePubKey = Just _k} -> do
+          e2eSndParams <-
+            withStore' c (\db -> getSndRatchet db connId v) >>= \case
+              Right r -> pure $ snd r
+              Left e -> do
+                atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e))
+                createRatchet_ pqSupport e2eRcvParams
+          pure (sq, e2eSndParams)
+        _ -> do
+          q <- lift $ fst <$> newSndQueue userId "" qInfo
+          e2eSndParams <- createRatchet_ pqSupport e2eRcvParams
+          withStore c $ \db -> runExceptT $ do
+            sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
+            pure (sq', e2eSndParams)
+      let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
+      pure (cData, sq', e2eSndParams)
+    Nothing -> throwE $ AGENT A_VERSION
+  where
+    createRatchet_ pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do
+      g <- asks random
      (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport)
      (_, rcDHRs) <- atomically $ C.generateKeyPair g
      rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams
      maxSupported <- asks $ maxVersion . e2eEncryptVRange . config
      let rcVs = CR.RatchetVersions {current = v, maxSupported}
          rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams
-      -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out
-      -- e2ePubKey is always present, it's Maybe historically
-      q <- case sq_ of
-        Just sq@SndQueue {e2ePubKey = Just _k} -> pure (sq :: SndQueue) {dbQueueId = DBNewQueue}
-        _ -> lift $ fst <$> newSndQueue userId "" qInfo
-      let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
-      sq' <- withStore c $ \db -> runExceptT $ do
-        liftIO $ createRatchet db connId rc
-        maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
-      pure (cData, sq', e2eSndParams)
-    Nothing -> throwE $ AGENT A_VERSION
+      withStore' c $ \db -> createSndRatchet db connId rc e2eSndParams
+      pure e2eSndParams

 connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport))
 connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of
@@ -892,6 +926,7 @@ joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMod
    case conn of
      NewConnection _ -> doJoin Nothing
      SndConnection _ sq -> doJoin $ Just sq
+      DuplexConnection _ (RcvQueue {status = New} :| _) (sq@SndQueue {status = New} :| _) -> doJoin $ Just sq
      _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType
  where
    doJoin :: Maybe SndQueue -> AM SndQueueSecured
@@ -1109,7 +1144,7 @@ getNotificationConns' c nonce encNtfInfo =

 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: AgentClient -> ConnId -> PQEncryption -> MsgFlags -> MsgBody -> AM (AgentMsgId, PQEncryption)
-sendMessage' c connId pqEnc msgFlags msg = ExceptT $ runIdentity <$> sendMessagesB_ c (Identity (Right (connId, pqEnc, msgFlags, msg))) (S.singleton connId)
+sendMessage' c connId pqEnc msgFlags msg = ExceptT $ runIdentity <$> sendMessagesB_ c (Identity (Right (connId, pqEnc, msgFlags, vrValue msg))) (S.singleton connId)
 {-# INLINE sendMessage' #-}

 -- | Send multiple messages to different connections (SEND command) in Reader monad
@@ -1144,14 +1179,14 @@ sendMessagesB_ c reqs connIds = withConnLocks c connIds "sendMessages" $ do
          else do
            conn <- first storeError <$> getConn db connId
            conn <$ atomically (writeTVar prev $ Just conn)
-    prepareConn :: Set ConnId -> Either AgentErrorType (MsgReq, SomeConn) -> (Set ConnId, Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
+    prepareConn :: Set ConnId -> Either AgentErrorType (MsgReq, SomeConn) -> (Set ConnId, Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, ValueOrRef AMessage))
    prepareConn s (Left e) = (s, Left e)
-    prepareConn s (Right ((_, pqEnc, msgFlags, msg), SomeConn _ conn)) = case conn of
+    prepareConn s (Right ((_, pqEnc, msgFlags, msgOrRef), SomeConn _ conn)) = case conn of
      DuplexConnection cData _ sqs -> prepareMsg cData sqs
      SndConnection cData sq -> prepareMsg cData [sq]
      _ -> (s, Left $ CONN SIMPLEX)
      where
-        prepareMsg :: ConnData -> NonEmpty SndQueue -> (Set ConnId, Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
+        prepareMsg :: ConnData -> NonEmpty SndQueue -> (Set ConnId, Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, ValueOrRef AMessage))
        prepareMsg cData@ConnData {connId, pqSupport} sqs
          | ratchetSyncSendProhibited cData = (s, Left $ CMD PROHIBITED "sendMessagesB: send prohibited")
          -- connection is only updated if PQ encryption was disabled, and now it has to be enabled.
@@ -1161,7 +1196,7 @@ sendMessagesB_ c reqs connIds = withConnLocks c connIds "sendMessages" $ do
               in (S.insert connId s, mkReq cData')
          | otherwise = (s, mkReq cData)
          where
-            mkReq cData' = Right (cData', sqs, Just pqEnc, msgFlags, A_MSG msg)
+            mkReq cData' = Right (cData', sqs, Just pqEnc, msgFlags, A_MSG <$> msgOrRef)

 -- / async command processing v v v

@@ -1345,10 +1380,10 @@ enqueueMessages c cData sqs msgFlags aMessage = do

 enqueueMessages' :: AgentClient -> ConnData -> NonEmpty SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, CR.PQEncryption)
 enqueueMessages' c cData sqs msgFlags aMessage =
-  ExceptT $ runIdentity <$> enqueueMessagesB c (Identity (Right (cData, sqs, Nothing, msgFlags, aMessage)))
+  ExceptT $ runIdentity <$> enqueueMessagesB c (Identity (Right (cData, sqs, Nothing, msgFlags, vrValue aMessage)))
 {-# INLINE enqueueMessages' #-}

-enqueueMessagesB :: Traversable t => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage)) -> AM' (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
+enqueueMessagesB :: Traversable t => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, ValueOrRef AMessage)) -> AM' (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
 enqueueMessagesB c reqs = do
  reqs' <- enqueueMessageB c reqs
  enqueueSavedMessageB c $ mapMaybe snd $ rights $ toList reqs'
@@ -1360,37 +1395,62 @@ isActiveSndQ SndQueue {status} = status == Secured || status == Active

 enqueueMessage :: AgentClient -> ConnData -> SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, PQEncryption)
 enqueueMessage c cData sq msgFlags aMessage =
-  ExceptT $ fmap fst . runIdentity <$> enqueueMessageB c (Identity (Right (cData, [sq], Nothing, msgFlags, aMessage)))
+  ExceptT $ fmap fst . runIdentity <$> enqueueMessageB c (Identity (Right (cData, [sq], Nothing, msgFlags, vrValue aMessage)))
 {-# INLINE enqueueMessage #-}

 -- this function is used only for sending messages in batch, it returns the list of successes to enqueue additional deliveries
-enqueueMessageB :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe (ConnData, [SndQueue], AgentMsgId))))
+enqueueMessageB :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, ValueOrRef AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe (ConnData, [SndQueue], AgentMsgId))))
 enqueueMessageB c reqs = do
  cfg <- asks config
-  reqMids <- withStoreBatch c $ \db -> fmap (bindRight $ storeSentMsg db cfg) reqs
+  (_, reqMids) <- unsafeWithStore c $ \db -> do
+    mapAccumLM (\ids r -> storeSentMsg db cfg ids r `E.catchAny` \e -> (ids,) <$> handleInternal e) IM.empty reqs
  forME reqMids $ \((cData, sq :| sqs, _, _, _), InternalId msgId, pqSecr) -> do
    submitPendingMsg c cData sq
    let sqs' = filter isActiveSndQ sqs
    pure $ Right ((msgId, pqSecr), if null sqs' then Nothing else Just (cData, sqs', msgId))
  where
-    storeSentMsg :: DB.Connection -> AgentConfig -> (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage) -> IO (Either AgentErrorType ((ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage), InternalId, PQEncryption))
-    storeSentMsg db cfg req@(cData@ConnData {connId}, sq :| _, pqEnc_, msgFlags, aMessage) = fmap (first storeError) $ runExceptT $ do
-      let AgentConfig {smpAgentVRange, e2eEncryptVRange} = cfg
-      internalTs <- liftIO getCurrentTime
-      (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
-      let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
-          agentMsg = AgentMessage privHeader aMessage
-          agentMsgStr = smpEncode agentMsg
-          internalHash = C.sha256Hash agentMsgStr
-          currentE2EVersion = maxVersion e2eEncryptVRange
-      (encAgentMessage, pqEnc) <- agentRatchetEncrypt db cData agentMsgStr e2eEncAgentMsgLength pqEnc_ currentE2EVersion
-      let agentVersion = maxVersion smpAgentVRange
-          msgBody = smpEncode $ AgentMsgEnvelope {agentVersion, encAgentMessage}
-          msgType = agentMessageType agentMsg
-          msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgFlags, msgBody, pqEncryption = pqEnc, internalHash, prevMsgHash}
-      liftIO $ createSndMsg db connId msgData
-      liftIO $ createSndMsgDelivery db connId sq internalId
-      pure (req, internalId, pqEnc)
+    storeSentMsg :: DB.Connection -> AgentConfig -> IntMap (Int64, AMessage) -> Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, ValueOrRef AMessage) -> IO (IntMap (Int64, AMessage), Either AgentErrorType ((ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, ValueOrRef AMessage), InternalId, PQEncryption))
+    storeSentMsg db cfg aMessageIds = \case
+      Left e -> pure (aMessageIds, Left e)
+      Right req@(cData@ConnData {connId}, sq :| _, pqEnc_, msgFlags, mbr) -> case mbr of
+        VRValue i_ aMessage -> case  i_ >>= (`IM.lookup` aMessageIds) of
+          Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body")
+          Nothing -> do
+            mbId <- createSndMsgBody db aMessage
+            let aMessageIds' = maybe id (`IM.insert` (mbId, aMessage)) i_ aMessageIds
+            (aMessageIds',) <$> storeSentMsg_ mbId aMessage
+        VRRef i -> (aMessageIds,) <$> case IM.lookup i aMessageIds of
+          Just (mbId, aMessage) -> storeSentMsg_ mbId aMessage
+          Nothing -> pure $ Left $ INTERNAL "enqueueMessageB: storeSentMsg missing saved message body id"
+        where
+          storeSentMsg_ sndMsgBodyId aMessage = fmap (first storeError) $ runExceptT $ do
+            let AgentConfig {e2eEncryptVRange} = cfg
+            internalTs <- liftIO getCurrentTime
+            (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
+            -- We need to do pre-flight encoding that is not stored in database
+            -- to calculate its hash and remember it on connection (createSndMsg -> updateSndMsgHash)
+            -- to enable next enqueue.
+            -- (As encoding is different per connection, we can't store shared body, so it's repeated on delivery)
+            let agentMsgStr = encodeAgentMsgStr aMessage internalSndId prevMsgHash
+                internalHash = C.sha256Hash agentMsgStr
+                currentE2EVersion = maxVersion e2eEncryptVRange
+            (mek, paddedLen, pqEnc) <- agentRatchetEncryptHeader db cData e2eEncAgentMsgLength pqEnc_ currentE2EVersion
+            withExceptT (SEAgentError . cryptoError) $ CR.rcCheckCanPad paddedLen agentMsgStr
+            let msgType = aMessageType aMessage
+                -- msgBody is empty, because snd_messages record is linked to snd_message_bodies
+                msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgFlags, msgBody = "", pqEncryption = pqEnc, internalHash, prevMsgHash, sndMsgPrepData_ = Just SndMsgPrepData {encryptKey = mek, paddedLen, sndMsgBodyId}}
+            liftIO $ createSndMsg db connId msgData
+            liftIO $ createSndMsgDelivery db connId sq internalId
+            pure (req, internalId, pqEnc)
+    handleInternal :: E.SomeException -> IO (Either AgentErrorType b)
+    handleInternal = pure . Left . INTERNAL . show
+
+
+encodeAgentMsgStr :: AMessage -> InternalSndId -> PrevSndMsgHash -> ByteString
+encodeAgentMsgStr aMessage internalSndId prevMsgHash = do
+  let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
+      agentMsg = AgentMessage privHeader aMessage
+   in smpEncode agentMsg

 enqueueSavedMessage :: AgentClient -> ConnData -> AgentMsgId -> SndQueue -> AM' ()
 enqueueSavedMessage c cData msgId sq = enqueueSavedMessageB c $ Identity (cData, [sq], msgId)
@@ -1435,7 +1495,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
    liftIO $ throwWhenNoDelivery c sq
    atomically $ beginAgentOperation c AOSndNetwork
    withWork c doWork (\db -> getPendingQueueMsg db connId sq) $
-      \(rq_, PendingMsgData {msgId, msgType, msgBody, pqEncryption, msgFlags, msgRetryState, internalTs}) -> do
+      \(rq_, PendingMsgData {msgId, msgType, msgBody, pqEncryption, msgFlags, msgRetryState, internalTs, internalSndId, prevMsgHash, pendingMsgPrepData_}) -> do
        atomically $ endAgentOperation c AOMsgDelivery -- this operation begins in submitPendingMsg
        let mId = unId msgId
            ri' = maybe id updateRetryInterval2 msgRetryState ri
@@ -1445,7 +1505,15 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
          resp <- tryError $ case msgType of
            AM_CONN_INFO -> sendConfirmation c sq msgBody
            AM_CONN_INFO_REPLY -> sendConfirmation c sq msgBody
-            _ -> sendAgentMessage c sq msgFlags msgBody
+            _ -> case pendingMsgPrepData_ of
+              Nothing -> sendAgentMessage c sq msgFlags msgBody
+              Just PendingMsgPrepData {encryptKey, paddedLen, sndMsgBody} -> do
+                let agentMsgStr = encodeAgentMsgStr sndMsgBody internalSndId prevMsgHash
+                AgentConfig {smpAgentVRange} <- asks config
+                encAgentMessage <- liftError cryptoError $ CR.rcEncryptMsg encryptKey paddedLen agentMsgStr
+                let agentVersion = maxVersion smpAgentVRange
+                    msgBody' = smpEncode $ AgentMsgEnvelope {agentVersion, encAgentMessage}
+                sendAgentMessage c sq msgFlags msgBody'
          case resp of
            Left e -> do
              let err = if msgType == AM_A_MSG_ then MERR mId e else ERR e
@@ -1788,8 +1856,8 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
  -- ! if it was used to notify about the result, it might be necessary to differentiate
  -- ! between completed deletions of connections, and deletions delayed due to wait for delivery (see deleteConn)
  deliveryTimeout <- if waitDelivery then asks (Just . connDeleteDeliveryTimeout . config) else pure Nothing
-  rs' <- lift $ catMaybes . rights <$> withStoreBatch' c (\db -> map (deleteConn db deliveryTimeout) (M.keys delRs))
-  forM_ rs' $ \cId -> notify ("", cId, AEvt SAEConn DEL_CONN)
+  cIds_ <- lift $ L.nonEmpty . catMaybes . rights <$> withStoreBatch' c (\db -> map (deleteConn db deliveryTimeout) (M.keys delRs))
+  forM_ cIds_ $ \cIds -> notify ("", "", AEvt SAEConn $ DEL_CONNS cIds)
  pure (errs' <> delRs, rqs, connIds')
  where
    rcvQueues :: SomeConn -> Either (Either AgentErrorType ()) [RcvQueue]
@@ -1809,32 +1877,33 @@ deleteConnQueues c waitDelivery ntf rqs = do
  rs <- connResults <$> (deleteQueueRecs =<< deleteQueues c rqs)
  let connIds = M.keys $ M.filter isRight rs
  deliveryTimeout <- if waitDelivery then asks (Just . connDeleteDeliveryTimeout . config) else pure Nothing
-  rs' <- catMaybes . rights <$> withStoreBatch' c (\db -> map (deleteConn db deliveryTimeout) connIds)
-  forM_ rs' $ \cId -> notify ("", cId, AEvt SAEConn DEL_CONN)
+  cIds_ <- L.nonEmpty . catMaybes . rights <$> withStoreBatch' c (\db -> map (deleteConn db deliveryTimeout) connIds)
+  forM_ cIds_ $ \cIds -> notify ("", "", AEvt SAEConn $ DEL_CONNS cIds)
  pure rs
  where
    deleteQueueRecs :: [(RcvQueue, Either AgentErrorType ())] -> AM' [(RcvQueue, Either AgentErrorType ())]
    deleteQueueRecs rs = do
      maxErrs <- asks $ deleteErrorCount . config
-      (rs', notifyActions) <- unzip . rights <$> withStoreBatch' c (\db -> map (deleteQueueRec db maxErrs) rs)
-      mapM_ sequence_ notifyActions
-      pure rs'
+      rs' <- rights <$> withStoreBatch' c (\db -> map (deleteQueueRec db maxErrs) rs)
+      let delQ ((rq, _), err_) = (qConnId rq,qServer rq,queueId rq,) <$> err_
+          delQs_ = L.nonEmpty $ mapMaybe delQ rs'
+      forM_ delQs_ $ \delQs -> notify ("", "", AEvt SAEConn $ DEL_RCVQS delQs)
+      pure $ map fst rs'
      where
        deleteQueueRec ::
          DB.Connection ->
          Int ->
          (RcvQueue, Either AgentErrorType ()) ->
-          IO ((RcvQueue, Either AgentErrorType ()), Maybe (AM' ()))
+          IO ((RcvQueue, Either AgentErrorType ()), Maybe (Maybe AgentErrorType)) -- Nothing - no event, Just Nothing - no error
        deleteQueueRec db maxErrs (rq@RcvQueue {userId, server}, r) = case r of
-          Right _ -> deleteConnRcvQueue db rq $> ((rq, r), Just (notifyRQ rq Nothing))
+          Right _ -> deleteConnRcvQueue db rq $> ((rq, r), Just Nothing)
          Left e
            | temporaryOrHostError e && deleteErrors rq + 1 < maxErrs -> incRcvDeleteErrors db rq $> ((rq, r), Nothing)
            | otherwise -> do
                deleteConnRcvQueue db rq
                -- attempts and successes are counted in deleteQueues function
                atomically $ incSMPServerStat c userId server connDeleted
-                pure ((rq, Right ()), Just (notifyRQ rq (Just e)))
-    notifyRQ rq e_ = notify ("", qConnId rq, AEvt SAEConn $ DEL_RCVQ (qServer rq) (queueId rq) e_)
+                pure ((rq, Right ()), Just (Just e))
    notify = when ntf . atomically . writeTBQueue (subQ c)
    connResults :: [(RcvQueue, Either AgentErrorType ())] -> Map ConnId (Either AgentErrorType ())
    connResults = M.map snd . foldl' addResult M.empty
@@ -1928,7 +1997,7 @@ registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
        -- possible improvement: add minimal time before repeat registration
        (Just tknId, Nothing)
          | savedDeviceToken == suppliedDeviceToken ->
-              when (ntfTknStatus == NTRegistered) (registerToken tkn) $> NTRegistered
+              registerToken tkn $> NTRegistered
          | otherwise -> replaceToken tknId
        (Just tknId, Just (NTAVerify code))
          | savedDeviceToken == suppliedDeviceToken ->
@@ -1937,14 +2006,16 @@ registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
        (Just tknId, Just NTACheck)
          | savedDeviceToken == suppliedDeviceToken -> do
              ns <- asks ntfSupervisor
-              atomically $ nsUpdateToken ns tkn {ntfMode = suppliedNtfMode}
-              when (ntfTknStatus == NTActive) $ do
-                cron <- asks $ ntfCron . config
-                agentNtfEnableCron c tknId tkn cron
-                when (suppliedNtfMode == NMInstant) $ initializeNtfSubs c
-                when (suppliedNtfMode == NMPeriodic && savedNtfMode == NMInstant) $ deleteNtfSubs c NSCSmpDelete
-              -- possible improvement: get updated token status from the server, or maybe TCRON could return the current status
-              pure ntfTknStatus
+              let tkn' = tkn {ntfMode = suppliedNtfMode}
+              atomically $ nsUpdateToken ns tkn'
+              agentNtfCheckToken c tknId tkn' >>= \case
+                NTActive -> do
+                  cron <- asks $ ntfCron . config
+                  agentNtfEnableCron c tknId tkn cron
+                  when (suppliedNtfMode == NMInstant) $ initializeNtfSubs c
+                  when (suppliedNtfMode == NMPeriodic && savedNtfMode == NMInstant) $ deleteNtfSubs c NSCSmpDelete
+                  t tkn' (NTActive, Just NTACheck) $ pure ()
+                status -> t tkn' (status, Nothing) $ pure ()
          | otherwise -> replaceToken tknId
        -- deprecated
        (Just _tknId, Just NTADelete) -> deleteToken c tkn $> NTExpired
@@ -2011,9 +2082,15 @@ verifyNtfToken' c deviceToken nonce code =
 checkNtfToken' :: AgentClient -> DeviceToken -> AM NtfTknStatus
 checkNtfToken' c deviceToken =
  withStore' c getSavedNtfToken >>= \case
-    Just tkn@NtfToken {deviceToken = savedDeviceToken, ntfTokenId = Just tknId} -> do
+    Just tkn@NtfToken {deviceToken = savedDeviceToken, ntfTokenId = Just tknId, ntfTknAction} -> do
      when (deviceToken /= savedDeviceToken) . throwE $ CMD PROHIBITED "checkNtfToken: different token"
-      agentNtfCheckToken c tknId tkn
+      status <- agentNtfCheckToken c tknId tkn
+      let action = case status of
+            NTInvalid _ -> Nothing
+            NTExpired -> Nothing
+            _ -> ntfTknAction
+      withStore' c $ \db -> updateNtfToken db tkn status action
+      pure status
    _ -> throwE $ CMD PROHIBITED "checkNtfToken: no token"

 deleteNtfToken' :: AgentClient -> DeviceToken -> AM ()
@@ -2154,7 +2231,7 @@ execAgentStoreSQL :: AgentClient -> Text -> AE [Text]
 execAgentStoreSQL c sql = withAgentEnv c $ withStore' c (`execSQL` sql)

 getAgentMigrations :: AgentClient -> AE [UpMigration]
-getAgentMigrations c = withAgentEnv c $ map upMigration <$> withStore' c (Migrations.getCurrent . DB.conn)
+getAgentMigrations c = withAgentEnv c $ map upMigration <$> withStore' c getCurrentMigrations

 debugAgentLocks :: AgentClient -> IO AgentLocks
 debugAgentLocks AgentClient {connLocks = cs, invLocks = is, deleteLock = d} = do
@@ -2927,7 +3004,7 @@ storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq
    (encConnInfo, pqEncryption) <- agentRatchetEncrypt db cData agentMsgStr e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
    let msgBody = smpEncode $ AgentConfirmation {agentVersion = v, e2eEncryption_, encConnInfo}
        msgType = agentMessageType agentMsg
-        msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash}
+        msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash, sndMsgPrepData_ = Nothing}
    liftIO $ createSndMsg db connId msgData
    liftIO $ createSndMsgDelivery db connId sq internalId

@@ -2953,19 +3030,25 @@ enqueueRatchetKey c cData@ConnData {connId} sq e2eEncryption = do
      let msgBody = smpEncode $ AgentRatchetKey {agentVersion, e2eEncryption, info = agentMsgStr}
          msgType = agentMessageType agentMsg
          -- this message is e2e encrypted with queue key, not with double ratchet
-          msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption = PQEncOff, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash}
+          msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption = PQEncOff, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash, sndMsgPrepData_ = Nothing}
      liftIO $ createSndMsg db connId msgData
      liftIO $ createSndMsgDelivery db connId sq internalId
      pure internalId

 -- encoded AgentMessage -> encoded EncAgentMessage
 agentRatchetEncrypt :: DB.Connection -> ConnData -> ByteString -> (VersionSMPA -> PQSupport -> Int) -> Maybe PQEncryption -> CR.VersionE2E -> ExceptT StoreError IO (ByteString, PQEncryption)
-agentRatchetEncrypt db ConnData {connId, connAgentVersion = v, pqSupport} msg getPaddedLen pqEnc_ currentE2EVersion = do
+agentRatchetEncrypt db cData msg getPaddedLen pqEnc_ currentE2EVersion = do
+  (mek, paddedLen, pqEnc) <- agentRatchetEncryptHeader db cData getPaddedLen pqEnc_ currentE2EVersion
+  encMsg <- withExceptT (SEAgentError . cryptoError) $ CR.rcEncryptMsg mek paddedLen msg
+  pure (encMsg, pqEnc)
+
+agentRatchetEncryptHeader :: DB.Connection -> ConnData -> (VersionSMPA -> PQSupport -> Int) -> Maybe PQEncryption -> CR.VersionE2E -> ExceptT StoreError IO (CR.MsgEncryptKeyX448, Int, PQEncryption)
+agentRatchetEncryptHeader db ConnData {connId, connAgentVersion = v, pqSupport} getPaddedLen pqEnc_ currentE2EVersion = do
  rc <- ExceptT $ getRatchet db connId
  let paddedLen = getPaddedLen v pqSupport
-  (encMsg, rc') <- withExceptT (SEAgentError . cryptoError) $ CR.rcEncrypt rc paddedLen msg pqEnc_ currentE2EVersion
+  (mek, rc') <- withExceptT (SEAgentError . cryptoError) $ CR.rcEncryptHeader rc pqEnc_ currentE2EVersion
  liftIO $ updateRatchet db connId rc' CR.SMDNoChange
-  pure (encMsg, CR.rcSndKEM rc')
+  pure (mek, paddedLen, CR.rcSndKEM rc')

 -- encoded EncAgentMessage -> encoded AgentMessage
 agentRatchetDecrypt :: TVar ChaChaDRG -> DB.Connection -> ConnId -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)
@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
@@ -145,6 +146,7 @@ module Simplex.Messaging.Agent.Client
    withStore',
    withStoreBatch,
    withStoreBatch',
+    unsafeWithStore,
    storeError,
    userServers,
    pickServer,
@@ -205,7 +207,6 @@ import Data.Text.Encoding
 import Data.Time (UTCTime, addUTCTime, defaultTimeLocale, formatTime, getCurrentTime)
 import Data.Time.Clock.System (getSystemTime)
 import Data.Word (Word16)
-import qualified Database.SQLite.Simple as SQL
 import Network.Socket (HostName)
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..), XFTPClient, XFTPClientConfig (..), XFTPClientError)
 import qualified Simplex.FileTransfer.Client as X
@@ -221,8 +222,8 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
-import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), withTransaction)
-import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
+import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.TRcvQueues (TRcvQueues (getRcvQueues))
 import qualified Simplex.Messaging.Agent.TRcvQueues as RQ
 import Simplex.Messaging.Client
@@ -282,6 +283,9 @@ import UnliftIO.Concurrent (forkIO, mkWeakThreadId)
 import UnliftIO.Directory (doesFileExist, getTemporaryDirectory, removeFile)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
+#if !defined(dbPostgres)
+import qualified Database.SQLite.Simple as SQL
+#endif

 type ClientVar msg = SessionVar (Either (AgentErrorType, Maybe UTCTime) (Client msg))

@@ -555,7 +559,7 @@ slowNetworkConfig cfg@NetworkConfig {tcpConnectTimeout, tcpTimeout, tcpTimeoutPe
    slow :: Integral a => a -> a
    slow t = (t * 3) `div` 2

-agentClientStore :: AgentClient -> SQLiteStore
+agentClientStore :: AgentClient -> DBStore
 agentClientStore AgentClient {agentEnv = Env {store}} = store
 {-# INLINE agentClientStore #-}

@@ -1649,7 +1653,7 @@ disableQueuesNtfs = sendTSessionBatches "NDEL" snd disableQueues_
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId =
  withSMPClient c rq ("ACK:" <> logSecret' msgId) $ \smp ->
-    ackSMPMessage smp rcvPrivateKey rcvId msgId      
+    ackSMPMessage smp rcvPrivateKey rcvId msgId

 hasGetLock :: AgentClient -> RcvQueue -> IO Bool
 hasGetLock c RcvQueue {server, rcvId} =
@@ -1989,6 +1993,13 @@ withStore c action = do
  withExceptT storeError . ExceptT . liftIO . agentOperationBracket c AODatabase (\_ -> pure ()) $
    withTransaction st action `E.catches` handleDBErrors
  where
+#if defined(dbPostgres)
+    -- TODO [postgres] postgres specific error handling
+    handleDBErrors :: [E.Handler IO (Either StoreError a)]
+    handleDBErrors =
+      [ E.Handler $ \(E.SomeException e) -> pure . Left $ SEInternal $ bshow e
+      ]
+#else
    handleDBErrors :: [E.Handler IO (Either StoreError a)]
    handleDBErrors =
      [ E.Handler $ \(e :: SQL.SQLError) ->
@@ -1997,6 +2008,12 @@ withStore c action = do
           in pure . Left . (if busy then SEDatabaseBusy else SEInternal) $ bshow se,
        E.Handler $ \(E.SomeException e) -> pure . Left $ SEInternal $ bshow e
      ]
+#endif
+
+unsafeWithStore :: AgentClient -> (DB.Connection -> IO a) -> AM' a
+unsafeWithStore c action = do
+  st <- asks store
+  liftIO $ agentOperationBracket c AODatabase (\_ -> pure ()) $ withTransaction st action

 withStoreBatch :: Traversable t => AgentClient -> (DB.Connection -> t (IO (Either AgentErrorType a))) -> AM' (t (Either AgentErrorType a))
 withStoreBatch c actions = do
@@ -2044,7 +2061,7 @@ pickServer = \case
 getNextServer ::
  (ProtocolTypeI p, UserProtocol p) =>
  AgentClient ->
-  UserId -> 
+  UserId ->
  (UserServers p -> NonEmpty (Maybe OperatorId, ProtoServerWithAuth p)) ->
  [ProtocolServer p] ->
  AM (ProtoServerWithAuth p)
@@ -2097,7 +2114,7 @@ withNextSrv ::
  UserId ->
  (UserServers p -> NonEmpty (Maybe OperatorId, ProtoServerWithAuth p)) ->
  TVar (Set TransportHost) ->
-  [ProtocolServer p] -> 
+  [ProtocolServer p] ->
  (ProtoServerWithAuth p -> AM a) ->
  AM a
 withNextSrv c userId srvsSel triedHosts usedSrvs action = do
@@ -52,7 +52,6 @@ import Control.Monad.Reader
 import Crypto.Random
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as JQ
-import Data.ByteArray (ScrubbedBytes)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -68,8 +67,10 @@ import Numeric.Natural
 import Simplex.FileTransfer.Client (XFTPClientConfig (..), defaultXFTPClientConfig)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Agent.Store.SQLite
-import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
+import Simplex.Messaging.Agent.Store (createStore)
+import Simplex.Messaging.Agent.Store.Common (DBStore)
+import Simplex.Messaging.Agent.Store.Interface (DBOpts)
+import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError (..))
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRange)
@@ -254,7 +255,7 @@ defaultAgentConfig =

 data Env = Env
  { config :: AgentConfig,
-    store :: SQLiteStore,
+    store :: DBStore,
    random :: TVar ChaChaDRG,
    randomServer :: TVar StdGen,
    ntfSupervisor :: NtfSupervisor,
@@ -262,7 +263,7 @@ data Env = Env
    multicastSubscribers :: TMVar Int
  }

-newSMPAgentEnv :: AgentConfig -> SQLiteStore -> IO Env
+newSMPAgentEnv :: AgentConfig -> DBStore -> IO Env
 newSMPAgentEnv config store = do
  random <- C.newRandom
  randomServer <- newTVarIO =<< liftIO newStdGen
@@ -271,8 +272,8 @@ newSMPAgentEnv config store = do
  multicastSubscribers <- newTMVarIO 0
  pure Env {config, store, random, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}

-createAgentStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
-createAgentStore dbFilePath dbKey keepKey = createSQLiteStore dbFilePath dbKey keepKey Migrations.app
+createAgentStore :: DBOpts -> MigrationConfirmation -> IO (Either MigrationError DBStore)
+createAgentStore = createStore

 data NtfSupervisor = NtfSupervisor
  { ntfTkn :: TVar (Maybe NtfToken),
@@ -43,8 +43,8 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
-import Simplex.Messaging.Agent.Store.SQLite
-import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import Simplex.Messaging.Agent.Store.AgentStore
+import qualified Simplex.Messaging.Agent.Store.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Types
@@ -140,6 +140,7 @@ module Simplex.Messaging.Agent.Protocol
    serializeQueueStatus,
    queueStatusT,
    agentMessageType,
+    aMessageType,
    extraSMPServerHosts,
    updateSMPServerHosts,
  )
@@ -167,8 +168,7 @@ import Data.Time.Clock.System (SystemTime)
 import Data.Type.Equality
 import Data.Typeable ()
 import Data.Word (Word16, Word32)
-import Database.SQLite.Simple.FromField
-import Database.SQLite.Simple.ToField
+import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
 import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Transport (XFTPErrorType)
@@ -359,8 +359,8 @@ data AEvent (e :: AEntity) where
  MSGNTF :: MsgId -> Maybe UTCTime -> AEvent AEConn
  RCVD :: MsgMeta -> NonEmpty MsgReceipt -> AEvent AEConn
  QCONT :: AEvent AEConn
-  DEL_RCVQ :: SMPServer -> SMP.RecipientId -> Maybe AgentErrorType -> AEvent AEConn
-  DEL_CONN :: AEvent AEConn
+  DEL_RCVQS :: NonEmpty (ConnId, SMPServer, SMP.RecipientId, Maybe AgentErrorType) -> AEvent AEConn
+  DEL_CONNS :: NonEmpty ConnId -> AEvent AEConn
  DEL_USER :: Int64 -> AEvent AENone
  STAT :: ConnectionStats -> AEvent AEConn
  OK :: AEvent AEConn
@@ -430,8 +430,8 @@ data AEventTag (e :: AEntity) where
  MSGNTF_ :: AEventTag AEConn
  RCVD_ :: AEventTag AEConn
  QCONT_ :: AEventTag AEConn
-  DEL_RCVQ_ :: AEventTag AEConn
-  DEL_CONN_ :: AEventTag AEConn
+  DEL_RCVQS_ :: AEventTag AEConn
+  DEL_CONNS_ :: AEventTag AEConn
  DEL_USER_ :: AEventTag AENone
  STAT_ :: AEventTag AEConn
  OK_ :: AEventTag AEConn
@@ -485,8 +485,8 @@ aEventTag = \case
  MSGNTF {} -> MSGNTF_
  RCVD {} -> RCVD_
  QCONT -> QCONT_
-  DEL_RCVQ {} -> DEL_RCVQ_
-  DEL_CONN -> DEL_CONN_
+  DEL_RCVQS _ -> DEL_RCVQS_
+  DEL_CONNS _ -> DEL_CONNS_
  DEL_USER _ -> DEL_USER_
  STAT _ -> STAT_
  OK -> OK_
@@ -856,20 +856,7 @@ agentMessageType = \case
  AgentConnInfo _ -> AM_CONN_INFO
  AgentConnInfoReply {} -> AM_CONN_INFO_REPLY
  AgentRatchetInfo _ -> AM_RATCHET_INFO
-  AgentMessage _ aMsg -> case aMsg of
-    -- HELLO is used both in v1 and in v2, but differently.
-    -- - in v1 (and, possibly, in v2 for simplex connections) can be sent multiple times,
-    --   until the queue is secured - the OK response from the server instead of initial AUTH errors confirms it.
-    -- - in v2 duplexHandshake it is sent only once, when it is known that the queue was secured.
-    HELLO -> AM_HELLO_
-    A_MSG _ -> AM_A_MSG_
-    A_RCVD {} -> AM_A_RCVD_
-    A_QCONT _ -> AM_QCONT_
-    QADD _ -> AM_QADD_
-    QKEY _ -> AM_QKEY_
-    QUSE _ -> AM_QUSE_
-    QTEST _ -> AM_QTEST_
-    EREADY _ -> AM_EREADY_
+  AgentMessage _ aMsg -> aMessageType aMsg

 data APrivHeader = APrivHeader
  { -- | sequential ID assigned by the sending agent
@@ -947,6 +934,22 @@ data AMessage
    EREADY AgentMsgId
  deriving (Show)

+aMessageType :: AMessage -> AgentMessageType
+aMessageType = \case
+  -- HELLO is used both in v1 and in v2, but differently.
+  -- - in v1 (and, possibly, in v2 for simplex connections) can be sent multiple times,
+  --   until the queue is secured - the OK response from the server instead of initial AUTH errors confirms it.
+  -- - in v2 duplexHandshake it is sent only once, when it is known that the queue was secured.
+  HELLO -> AM_HELLO_
+  A_MSG _ -> AM_A_MSG_
+  A_RCVD {} -> AM_A_RCVD_
+  A_QCONT _ -> AM_QCONT_
+  QADD _ -> AM_QADD_
+  QKEY _ -> AM_QKEY_
+  QUSE _ -> AM_QUSE_
+  QTEST _ -> AM_QTEST_
+  EREADY _ -> AM_EREADY_
+
 -- | this type is used to send as part of the protocol between different clients
 -- TODO possibly, rename fields and types referring to external and internal IDs to make them different
 data AMessageReceipt = AMessageReceipt
@@ -1011,6 +1014,10 @@ instance Encoding AMessage where
        QTEST_ -> QTEST <$> smpP
        EREADY_ -> EREADY <$> smpP

+instance ToField AMessage where toField = toField . Binary . smpEncode
+
+instance FromField AMessage where fromField = blobFieldParser smpP
+
 instance Encoding AMessageReceipt where
  smpEncode AMessageReceipt {agentMsgId, msgHash, rcptInfo} =
    smpEncode (agentMsgId, msgHash, Large rcptInfo)
@@ -10,11 +10,10 @@ import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.Protocol (UserId)
+import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
 import Simplex.Messaging.Parsers (defaultJSON, fromTextField_)
-import Simplex.Messaging.Protocol (SMPServer, XFTPServer, NtfServer)
+import Simplex.Messaging.Protocol (NtfServer, SMPServer, XFTPServer)
 import Simplex.Messaging.Util (decodeJSON, encodeJSON)
 import UnliftIO.STM

@@ -29,8 +29,12 @@ import Data.Time (UTCTime)
 import Data.Type.Equality
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State)
+import Simplex.Messaging.Agent.Store.Common
+import Simplex.Messaging.Agent.Store.Interface (DBOpts, createDBStore)
+import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
+import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError (..))
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport, RatchetX448)
+import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
  ( MsgBody,
@@ -42,13 +46,16 @@ import Simplex.Messaging.Protocol
    RcvDhSecret,
    RcvNtfDhSecret,
    RcvPrivateAuthKey,
+    SenderCanSecure,
    SndPrivateAuthKey,
    SndPublicAuthKey,
-    SenderCanSecure,
    VersionSMPC,
  )
 import qualified Simplex.Messaging.Protocol as SMP

+createStore :: DBOpts -> MigrationConfirmation -> IO (Either MigrationError DBStore)
+createStore dbOpts = createDBStore dbOpts appMigrations
+
 -- * Queue types

 data QueueStored = QSStored | QSNew
@@ -536,9 +543,17 @@ data SndMsgData = SndMsgData
    msgBody :: MsgBody,
    pqEncryption :: PQEncryption,
    internalHash :: MsgHash,
-    prevMsgHash :: MsgHash
+    prevMsgHash :: MsgHash,
+    sndMsgPrepData_ :: Maybe SndMsgPrepData
  }

+data SndMsgPrepData = SndMsgPrepData
+  { encryptKey :: MsgEncryptKeyX448,
+    paddedLen :: Int,
+    sndMsgBodyId :: Int64
+  }
+  deriving (Show)
+
 data SndMsg = SndMsg
  { internalId :: InternalId,
    internalSndId :: InternalSndId,
@@ -554,7 +569,17 @@ data PendingMsgData = PendingMsgData
    msgBody :: MsgBody,
    pqEncryption :: PQEncryption,
    msgRetryState :: Maybe RI2State,
-    internalTs :: InternalTs
+    internalTs :: InternalTs,
+    internalSndId :: InternalSndId,
+    prevMsgHash :: PrevSndMsgHash,
+    pendingMsgPrepData_ :: Maybe PendingMsgPrepData
+  }
+  deriving (Show)
+
+data PendingMsgPrepData = PendingMsgPrepData
+  { encryptKey :: MsgEncryptKeyX448,
+    paddedLen :: Int,
+    sndMsgBody :: AMessage
  }
  deriving (Show)

@@ -0,0 +1,14 @@
+{-# LANGUAGE CPP #-}
+
+module Simplex.Messaging.Agent.Store.Common
+#if defined(dbPostgres)
+  ( module Simplex.Messaging.Agent.Store.Postgres.Common,
+  )
+  where
+import Simplex.Messaging.Agent.Store.Postgres.Common
+#else
+  ( module Simplex.Messaging.Agent.Store.SQLite.Common,
+  )
+  where
+import Simplex.Messaging.Agent.Store.SQLite.Common
+#endif
@@ -0,0 +1,19 @@
+{-# LANGUAGE CPP #-}
+
+module Simplex.Messaging.Agent.Store.DB
+#if defined(dbPostgres)
+  ( module Simplex.Messaging.Agent.Store.Postgres.DB,
+    FromField (..),
+    ToField (..),
+  )
+  where
+import Simplex.Messaging.Agent.Store.Postgres.DB
+#else
+  ( module Simplex.Messaging.Agent.Store.SQLite.DB,
+    FromField (..),
+    ToField (..),
+  )
+  where
+import Simplex.Messaging.Agent.Store.SQLite.DB
+#endif
+
@@ -0,0 +1,14 @@
+{-# LANGUAGE CPP #-}
+
+module Simplex.Messaging.Agent.Store.Interface
+#if defined(dbPostgres)
+  ( module Simplex.Messaging.Agent.Store.Postgres,
+  )
+  where
+import Simplex.Messaging.Agent.Store.Postgres
+#else
+  ( module Simplex.Messaging.Agent.Store.SQLite,
+  )
+  where
+import Simplex.Messaging.Agent.Store.SQLite
+#endif
@@ -0,0 +1,78 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Simplex.Messaging.Agent.Store.Migrations
+  ( Migration (..),
+    MigrationsToRun (..),
+    DownMigration (..),
+    DBMigrate (..),
+    sharedMigrateSchema,
+    -- for tests
+    migrationsToRun,
+    toDownMigration,
+  )
+where
+
+import Control.Monad
+import Data.Char (toLower)
+import Data.Functor (($>))
+import Data.Maybe (isNothing, mapMaybe)
+import Simplex.Messaging.Agent.Store.Shared
+import System.Exit (exitFailure)
+import System.IO (hFlush, stdout)
+
+migrationsToRun :: [Migration] -> [Migration] -> Either MTRError MigrationsToRun
+migrationsToRun [] [] = Right MTRNone
+migrationsToRun appMs [] = Right $ MTRUp appMs
+migrationsToRun [] dbMs
+  | length dms == length dbMs = Right $ MTRDown dms
+  | otherwise = Left $ MTRENoDown $ mapMaybe nameNoDown dbMs
+  where
+    dms = mapMaybe toDownMigration dbMs
+    nameNoDown m = if isNothing (down m) then Just $ name m else Nothing
+migrationsToRun (a : as) (d : ds)
+  | name a == name d = migrationsToRun as ds
+  | otherwise = Left $ MTREDifferent (name a) (name d)
+
+data DBMigrate = DBMigrate
+  { initialize :: IO (),
+    getCurrent :: IO [Migration],
+    run :: MigrationsToRun -> IO (),
+    backup :: IO ()
+  }
+
+sharedMigrateSchema :: DBMigrate -> Bool -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError ())
+sharedMigrateSchema dbm dbNew' migrations confirmMigrations = do
+  initialize dbm
+  currentMs <- getCurrent dbm
+  case migrationsToRun migrations currentMs of
+    Left e -> do
+      when (confirmMigrations == MCConsole) $ confirmOrExit ("Database state error: " <> mtrErrorDescription e)
+      pure . Left $ MigrationError e
+    Right MTRNone -> pure $ Right ()
+    Right ms@(MTRUp ums)
+      | dbNew' -> run dbm ms $> Right ()
+      | otherwise -> case confirmMigrations of
+          MCYesUp -> runWithBackup ms
+          MCYesUpDown -> runWithBackup ms
+          MCConsole -> confirm err >> runWithBackup ms
+          MCError -> pure $ Left err
+      where
+        err = MEUpgrade $ map upMigration ums -- "The app has a newer version than the database.\nConfirm to back up and upgrade using these migrations: " <> intercalate ", " (map name ums)
+    Right ms@(MTRDown dms) -> case confirmMigrations of
+      MCYesUpDown -> runWithBackup ms
+      MCConsole -> confirm err >> runWithBackup ms
+      MCYesUp -> pure $ Left err
+      MCError -> pure $ Left err
+      where
+        err = MEDowngrade $ map downName dms
+  where
+    runWithBackup ms = backup dbm >> run dbm ms $> Right ()
+    confirm err = confirmOrExit $ migrationErrorDescription err
+
+confirmOrExit :: String -> IO ()
+confirmOrExit s = do
+  putStrLn s
+  putStr "Continue (y/N): "
+  hFlush stdout
+  ok <- getLine
+  when (map toLower ok /= "y") exitFailure
@@ -0,0 +1,14 @@
+{-# LANGUAGE CPP #-}
+
+module Simplex.Messaging.Agent.Store.Migrations.App
+#if defined(dbPostgres)
+  ( module Simplex.Messaging.Agent.Store.Postgres.Migrations.App,
+  )
+  where
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.App
+#else
+  ( module Simplex.Messaging.Agent.Store.SQLite.Migrations.App,
+  )
+  where
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.App
+#endif
@@ -0,0 +1,115 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Agent.Store.Postgres
+  ( DBOpts (..),
+    Migrations.getCurrentMigrations,
+    createDBStore,
+    closeDBStore,
+    reopenDBStore,
+    execSQL,
+  )
+where
+
+import Control.Exception (throwIO)
+import Control.Monad (unless, void)
+import Data.ByteString (ByteString)
+import Data.Functor (($>))
+import Data.String (fromString)
+import Data.Text (Text)
+import Database.PostgreSQL.Simple (Only (..))
+import qualified Database.PostgreSQL.Simple as PSQL
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Simplex.Messaging.Agent.Store.Migrations (DBMigrate (..), sharedMigrateSchema)
+import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
+import Simplex.Messaging.Agent.Store.Postgres.Common
+import qualified Simplex.Messaging.Agent.Store.Postgres.DB as DB
+import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationError (..))
+import Simplex.Messaging.Util (ifM)
+import UnliftIO.Exception (bracketOnError, onException)
+import UnliftIO.MVar
+import UnliftIO.STM
+
+data DBOpts = DBOpts
+  { connstr :: ByteString,
+    schema :: String
+  }
+
+-- | Create a new Postgres DBStore with the given connection string, schema name and migrations.
+-- If passed schema does not exist in connectInfo database, it will be created.
+-- Applies necessary migrations to schema.
+-- TODO [postgres] authentication / user password, db encryption (?)
+createDBStore :: DBOpts -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
+createDBStore DBOpts {connstr, schema} migrations confirmMigrations = do
+  st <- connectPostgresStore connstr schema
+  r <- migrateSchema st `onException` closeDBStore st
+  case r of
+    Right () -> pure $ Right st
+    Left e -> closeDBStore st $> Left e
+  where
+    migrateSchema st =
+      let initialize = Migrations.initialize st
+          getCurrent = withTransaction st Migrations.getCurrentMigrations
+          dbm = DBMigrate {initialize, getCurrent, run = Migrations.run st, backup = pure ()}
+       in sharedMigrateSchema dbm (dbNew st) migrations confirmMigrations
+
+connectPostgresStore :: ByteString -> String -> IO DBStore
+connectPostgresStore dbConnstr dbSchema = do
+  (dbConn, dbNew) <- connectDB dbConnstr dbSchema -- TODO [postgres] analogue for dbBusyLoop?
+  dbConnection <- newMVar dbConn
+  dbClosed <- newTVarIO False
+  pure DBStore {dbConnstr, dbSchema, dbConnection, dbNew, dbClosed}
+
+connectDB :: ByteString -> String -> IO (DB.Connection, Bool)
+connectDB connstr schema = do
+  db <- PSQL.connectPostgreSQL connstr
+  schemaExists <- prepare db `onException` PSQL.close db
+  let dbNew = not schemaExists
+  pure (db, dbNew)
+  where
+    prepare db = do
+      void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
+      [Only schemaExists] <-
+        PSQL.query
+          db
+          [sql|
+            SELECT EXISTS (
+              SELECT 1 FROM pg_catalog.pg_namespace
+              WHERE nspname = ?
+            )
+          |]
+          (Only schema)
+      unless schemaExists $ void $ PSQL.execute_ db (fromString $ "CREATE SCHEMA " <> schema)
+      void $ PSQL.execute_ db (fromString $ "SET search_path TO " <> schema)
+      pure schemaExists
+
+-- can share with SQLite
+closeDBStore :: DBStore -> IO ()
+closeDBStore st@DBStore {dbClosed} =
+  ifM (readTVarIO dbClosed) (putStrLn "closeDBStore: already closed") $
+    withConnection st $ \conn -> do
+      DB.close conn
+      atomically $ writeTVar dbClosed True
+
+openPostgresStore_ :: DBStore -> IO ()
+openPostgresStore_ DBStore {dbConnstr, dbSchema, dbConnection, dbClosed} =
+  bracketOnError
+    (takeMVar dbConnection)
+    (tryPutMVar dbConnection)
+    $ \_dbConn -> do
+      (dbConn, _dbNew) <- connectDB dbConnstr dbSchema
+      atomically $ writeTVar dbClosed False
+      putMVar dbConnection dbConn
+
+reopenDBStore :: DBStore -> IO ()
+reopenDBStore st@DBStore {dbClosed} =
+  ifM (readTVarIO dbClosed) open (putStrLn "reopenDBStore: already opened")
+  where
+    open = openPostgresStore_ st
+
+-- TODO [postgres] not necessary for postgres (used for ExecAgentStoreSQL, ExecChatStoreSQL)
+execSQL :: PSQL.Connection -> Text -> IO [Text]
+execSQL _db _query = throwIO (userError "not implemented")
@@ -0,0 +1,49 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Common
+  ( DBStore (..),
+    withConnection,
+    withConnection',
+    withTransaction,
+    withTransaction',
+    withTransactionPriority,
+  )
+where
+
+import Data.ByteString (ByteString)
+import qualified Database.PostgreSQL.Simple as PSQL
+import UnliftIO.MVar
+import UnliftIO.STM
+
+-- TODO [postgres] use log_min_duration_statement instead of custom slow queries (SQLite's Connection type)
+data DBStore = DBStore
+  { dbConnstr :: ByteString,
+    dbSchema :: String,
+    dbConnection :: MVar PSQL.Connection,
+    dbClosed :: TVar Bool,
+    dbNew :: Bool
+  }
+
+-- TODO [postgres] connection pool
+withConnectionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
+withConnectionPriority DBStore {dbConnection} _priority action =
+  withMVar dbConnection action
+
+withConnection :: DBStore -> (PSQL.Connection -> IO a) -> IO a
+withConnection st = withConnectionPriority st False
+
+withConnection' :: DBStore -> (PSQL.Connection -> IO a) -> IO a
+withConnection' = withConnection
+
+withTransaction' :: DBStore -> (PSQL.Connection -> IO a) -> IO a
+withTransaction' = withTransaction
+
+withTransaction :: DBStore -> (PSQL.Connection -> IO a) -> IO a
+withTransaction st = withTransactionPriority st False
+{-# INLINE withTransaction #-}
+
+-- TODO [postgres] analogue for dbBusyLoop?
+withTransactionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
+withTransactionPriority st priority action = withConnectionPriority st priority transaction
+  where
+    transaction conn = PSQL.withTransaction conn $ action conn
@@ -0,0 +1,65 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.DB
+  ( BoolInt (..),
+    PSQL.Binary (..),
+    PSQL.Connection,
+    FromField (..),
+    ToField (..),
+    PSQL.connect,
+    PSQL.close,
+    execute,
+    execute_,
+    executeMany,
+    PSQL.query,
+    PSQL.query_,
+  )
+where
+
+import Control.Monad (void)
+import Data.Int (Int64)
+import Data.Word (Word16, Word32)
+import Database.PostgreSQL.Simple (ResultError (..))
+import qualified Database.PostgreSQL.Simple as PSQL
+import Database.PostgreSQL.Simple.FromField (FromField (..), returnError)
+import Database.PostgreSQL.Simple.ToField (ToField (..))
+
+newtype BoolInt = BI {unBI :: Bool}
+
+instance FromField BoolInt where
+  fromField field dat = BI . (/= (0 :: Int)) <$> fromField field dat
+  {-# INLINE fromField #-}
+
+instance ToField BoolInt where
+  toField (BI b) = toField ((if b then 1 else 0) :: Int)
+  {-# INLINE toField #-}
+
+execute :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> q -> IO ()
+execute db q qs = void $ PSQL.execute db q qs
+{-# INLINE execute #-}
+
+execute_ :: PSQL.Connection -> PSQL.Query -> IO ()
+execute_ db q = void $ PSQL.execute_ db q
+{-# INLINE execute_ #-}
+
+executeMany :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> [q] -> IO ()
+executeMany db q qs = void $ PSQL.executeMany db q qs
+{-# INLINE executeMany #-}
+
+-- orphan instances
+
+-- used in FileSize
+instance FromField Word32 where
+  fromField field dat = do
+    i :: Int64 <- fromField field dat
+    if i >= 0 && i <= fromIntegral (maxBound :: Word32)
+      then pure (fromIntegral i :: Word32)
+      else returnError ConversionFailed field "Negative value can't be converted to Word32"
+
+-- used in Version
+instance FromField Word16 where
+  fromField field dat = do
+    i :: Int64 <- fromField field dat
+    if i >= 0 && i <= fromIntegral (maxBound :: Word16)
+      then pure (fromIntegral i :: Word16)
+      else returnError ConversionFailed field "Negative value can't be converted to Word16"
@@ -0,0 +1,63 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TupleSections #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations
+  ( initialize,
+    run,
+    getCurrentMigrations,
+  )
+where
+
+import Control.Monad (void)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Data.Time.Clock (getCurrentTime)
+import qualified Database.PostgreSQL.LibPQ as LibPQ
+import Database.PostgreSQL.Simple (Only (..))
+import qualified Database.PostgreSQL.Simple as PSQL
+import Database.PostgreSQL.Simple.Internal (Connection (..))
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Simplex.Messaging.Agent.Store.Postgres.Common
+import Simplex.Messaging.Agent.Store.Shared
+import UnliftIO.MVar
+
+initialize :: DBStore -> IO ()
+initialize st = withTransaction' st $ \db ->
+  void $
+    PSQL.execute_
+      db
+      [sql|
+      CREATE TABLE IF NOT EXISTS migrations (
+        name TEXT NOT NULL,
+        ts TIMESTAMP NOT NULL,
+        down TEXT,
+        PRIMARY KEY (name)
+      )
+    |]
+
+run :: DBStore -> MigrationsToRun -> IO ()
+run st = \case
+  MTRUp [] -> pure ()
+  MTRUp ms -> mapM_ runUp ms
+  MTRDown ms -> mapM_ runDown $ reverse ms
+  MTRNone -> pure ()
+  where
+    runUp Migration {name, up, down} = withTransaction' st $ \db -> do
+      insert db
+      execSQL db up
+      where
+        insert db = void $ PSQL.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
+    runDown DownMigration {downName, downQuery} = withTransaction' st $ \db -> do
+      execSQL db downQuery
+      void $ PSQL.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
+    execSQL db query =
+      withMVar (connectionHandle db) $ \pqConn ->
+        void $ LibPQ.exec pqConn (TE.encodeUtf8 query)
+
+getCurrentMigrations :: PSQL.Connection -> IO [Migration]
+getCurrentMigrations db = map toMigration <$> PSQL.query_ db "SELECT name, down FROM migrations ORDER BY name ASC;"
+  where
+    toMigration (name, down) = Migration {name, up = T.pack "", down}
@@ -0,0 +1,21 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.App (appMigrations) where
+
+import Data.List (sortOn)
+import Data.Text (Text)
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
+import Simplex.Messaging.Agent.Store.Shared (Migration (..))
+
+schemaMigrations :: [(String, Text, Maybe Text)]
+schemaMigrations =
+  [ ("20241210_initial", m20241210_initial, Nothing),
+    ("20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies)
+  ]
+
+-- | The list of migrations in ascending order by date
+appMigrations :: [Migration]
+appMigrations = sortOn name $ map migration schemaMigrations
+  where
+    migration (name, up, down) = Migration {name, up, down = down}
@@ -0,0 +1,545 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.RawString.QQ (r)
+
+m20241210_initial :: Text
+m20241210_initial =
+  T.pack
+    [r|
+CREATE TABLE users(
+  user_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  deleted SMALLINT NOT NULL DEFAULT 0
+);
+CREATE TABLE servers(
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  key_hash BYTEA NOT NULL,
+  PRIMARY KEY(host, port)
+);
+CREATE TABLE connections(
+  conn_id BYTEA NOT NULL PRIMARY KEY,
+  conn_mode TEXT NOT NULL,
+  last_internal_msg_id BIGINT NOT NULL DEFAULT 0,
+  last_internal_rcv_msg_id BIGINT NOT NULL DEFAULT 0,
+  last_internal_snd_msg_id BIGINT NOT NULL DEFAULT 0,
+  last_external_snd_msg_id BIGINT NOT NULL DEFAULT 0,
+  last_rcv_msg_hash BYTEA NOT NULL DEFAULT ''::BYTEA,
+  last_snd_msg_hash BYTEA NOT NULL DEFAULT ''::BYTEA,
+  smp_agent_version INTEGER NOT NULL DEFAULT 1,
+  duplex_handshake SMALLINT NULL DEFAULT 0,
+  enable_ntfs SMALLINT,
+  deleted SMALLINT NOT NULL DEFAULT 0,
+  user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
+  ratchet_sync_state TEXT NOT NULL DEFAULT 'ok',
+  deleted_at_wait_delivery TIMESTAMPTZ,
+  pq_support SMALLINT NOT NULL DEFAULT 0
+);
+CREATE TABLE rcv_queues(
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  rcv_id BYTEA NOT NULL,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  rcv_private_key BYTEA NOT NULL,
+  rcv_dh_secret BYTEA NOT NULL,
+  e2e_priv_key BYTEA NOT NULL,
+  e2e_dh_secret BYTEA,
+  snd_id BYTEA NOT NULL,
+  snd_key BYTEA,
+  status TEXT NOT NULL,
+  smp_server_version INTEGER NOT NULL DEFAULT 1,
+  smp_client_version INTEGER,
+  ntf_public_key BYTEA,
+  ntf_private_key BYTEA,
+  ntf_id BYTEA,
+  rcv_ntf_dh_secret BYTEA,
+  rcv_queue_id BIGINT NOT NULL,
+  rcv_primary SMALLINT NOT NULL,
+  replace_rcv_queue_id BIGINT NULL,
+  delete_errors BIGINT NOT NULL DEFAULT 0,
+  server_key_hash BYTEA,
+  switch_status TEXT,
+  deleted SMALLINT NOT NULL DEFAULT 0,
+  snd_secure SMALLINT NOT NULL DEFAULT 0,
+  last_broker_ts TIMESTAMPTZ,
+  PRIMARY KEY(host, port, rcv_id),
+  FOREIGN KEY(host, port) REFERENCES servers
+  ON DELETE RESTRICT ON UPDATE CASCADE,
+  UNIQUE(host, port, snd_id)
+);
+CREATE TABLE snd_queues(
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  snd_id BYTEA NOT NULL,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  snd_private_key BYTEA NOT NULL,
+  e2e_dh_secret BYTEA NOT NULL,
+  status TEXT NOT NULL,
+  smp_server_version INTEGER NOT NULL DEFAULT 1,
+  smp_client_version INTEGER NOT NULL DEFAULT 1,
+  snd_public_key BYTEA,
+  e2e_pub_key BYTEA,
+  snd_queue_id BIGINT NOT NULL,
+  snd_primary SMALLINT NOT NULL,
+  replace_snd_queue_id BIGINT NULL,
+  server_key_hash BYTEA,
+  switch_status TEXT,
+  snd_secure SMALLINT NOT NULL DEFAULT 0,
+  PRIMARY KEY(host, port, snd_id),
+  FOREIGN KEY(host, port) REFERENCES servers
+  ON DELETE RESTRICT ON UPDATE CASCADE
+);
+CREATE TABLE messages(
+  conn_id BYTEA NOT NULL REFERENCES connections(conn_id)
+  ON DELETE CASCADE,
+  internal_id BIGINT NOT NULL,
+  internal_ts TIMESTAMPTZ NOT NULL,
+  internal_rcv_id BIGINT,
+  internal_snd_id BIGINT,
+  msg_type BYTEA NOT NULL,
+  msg_body BYTEA NOT NULL DEFAULT ''::BYTEA,
+  msg_flags TEXT NULL,
+  pq_encryption SMALLINT NOT NULL DEFAULT 0,
+  PRIMARY KEY(conn_id, internal_id)
+);
+CREATE TABLE rcv_messages(
+  conn_id BYTEA NOT NULL,
+  internal_rcv_id BIGINT NOT NULL,
+  internal_id BIGINT NOT NULL,
+  external_snd_id BIGINT NOT NULL,
+  broker_id BYTEA NOT NULL,
+  broker_ts TIMESTAMPTZ NOT NULL,
+  internal_hash BYTEA NOT NULL,
+  external_prev_snd_hash BYTEA NOT NULL,
+  integrity BYTEA NOT NULL,
+  user_ack SMALLINT NULL DEFAULT 0,
+  rcv_queue_id BIGINT NOT NULL,
+  PRIMARY KEY(conn_id, internal_rcv_id),
+  FOREIGN KEY(conn_id, internal_id) REFERENCES messages
+  ON DELETE CASCADE
+);
+ALTER TABLE messages
+ADD CONSTRAINT fk_messages_rcv_messages
+  FOREIGN KEY (conn_id, internal_rcv_id) REFERENCES rcv_messages
+  ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED;
+CREATE TABLE snd_messages(
+  conn_id BYTEA NOT NULL,
+  internal_snd_id BIGINT NOT NULL,
+  internal_id BIGINT NOT NULL,
+  internal_hash BYTEA NOT NULL,
+  previous_msg_hash BYTEA NOT NULL DEFAULT ''::BYTEA,
+  retry_int_slow BIGINT,
+  retry_int_fast BIGINT,
+  rcpt_internal_id BIGINT,
+  rcpt_status TEXT,
+  PRIMARY KEY(conn_id, internal_snd_id),
+  FOREIGN KEY(conn_id, internal_id) REFERENCES messages
+  ON DELETE CASCADE
+);
+ALTER TABLE messages
+ADD CONSTRAINT fk_messages_snd_messages
+  FOREIGN KEY (conn_id, internal_snd_id) REFERENCES snd_messages
+  ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED;
+CREATE TABLE conn_confirmations(
+  confirmation_id BYTEA NOT NULL PRIMARY KEY,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  e2e_snd_pub_key BYTEA NOT NULL,
+  sender_key BYTEA,
+  ratchet_state BYTEA NOT NULL,
+  sender_conn_info BYTEA NOT NULL,
+  accepted SMALLINT NOT NULL,
+  own_conn_info BYTEA,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  smp_reply_queues BYTEA NULL,
+  smp_client_version INTEGER
+);
+CREATE TABLE conn_invitations(
+  invitation_id BYTEA NOT NULL PRIMARY KEY,
+  contact_conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  cr_invitation BYTEA NOT NULL,
+  recipient_conn_info BYTEA NOT NULL,
+  accepted SMALLINT NOT NULL DEFAULT 0,
+  own_conn_info BYTEA,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now())
+);
+CREATE TABLE ratchets(
+  conn_id BYTEA NOT NULL PRIMARY KEY REFERENCES connections
+  ON DELETE CASCADE,
+  x3dh_priv_key_1 BYTEA,
+  x3dh_priv_key_2 BYTEA,
+  ratchet_state BYTEA,
+  e2e_version INTEGER NOT NULL DEFAULT 1,
+  x3dh_pub_key_1 BYTEA,
+  x3dh_pub_key_2 BYTEA,
+  pq_priv_kem BYTEA,
+  pq_pub_kem BYTEA
+);
+CREATE TABLE skipped_messages(
+  skipped_message_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  conn_id BYTEA NOT NULL REFERENCES ratchets
+  ON DELETE CASCADE,
+  header_key BYTEA NOT NULL,
+  msg_n BIGINT NOT NULL,
+  msg_key BYTEA NOT NULL
+);
+CREATE TABLE ntf_servers(
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_key_hash BYTEA NOT NULL,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  PRIMARY KEY(ntf_host, ntf_port)
+);
+CREATE TABLE ntf_tokens(
+  provider TEXT NOT NULL,
+  device_token TEXT NOT NULL,
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  tkn_id BYTEA,
+  tkn_pub_key BYTEA NOT NULL,
+  tkn_priv_key BYTEA NOT NULL,
+  tkn_pub_dh_key BYTEA NOT NULL,
+  tkn_priv_dh_key BYTEA NOT NULL,
+  tkn_dh_secret BYTEA,
+  tkn_status TEXT NOT NULL,
+  tkn_action BYTEA,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  ntf_mode BYTEA NULL,
+  PRIMARY KEY(provider, device_token, ntf_host, ntf_port),
+  FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
+  ON DELETE RESTRICT ON UPDATE CASCADE
+);
+CREATE TABLE ntf_subscriptions(
+  conn_id BYTEA NOT NULL,
+  smp_host TEXT NULL,
+  smp_port TEXT NULL,
+  smp_ntf_id BYTEA,
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_sub_id BYTEA,
+  ntf_sub_status TEXT NOT NULL,
+  ntf_sub_action BYTEA,
+  ntf_sub_smp_action BYTEA,
+  ntf_sub_action_ts TIMESTAMPTZ,
+  updated_by_supervisor SMALLINT NOT NULL DEFAULT 0,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  smp_server_key_hash BYTEA,
+  ntf_failed SMALLINT DEFAULT 0,
+  smp_failed SMALLINT DEFAULT 0,
+  PRIMARY KEY(conn_id),
+  FOREIGN KEY(smp_host, smp_port) REFERENCES servers(host, port)
+  ON DELETE SET NULL ON UPDATE CASCADE,
+  FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
+  ON DELETE RESTRICT ON UPDATE CASCADE
+);
+CREATE TABLE commands(
+  command_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  host TEXT,
+  port TEXT,
+  corr_id BYTEA NOT NULL,
+  command_tag BYTEA NOT NULL,
+  command BYTEA NOT NULL,
+  agent_version INTEGER NOT NULL DEFAULT 1,
+  server_key_hash BYTEA,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT '1970-01-01 00:00:00',
+  failed SMALLINT DEFAULT 0,
+  FOREIGN KEY(host, port) REFERENCES servers
+  ON DELETE RESTRICT ON UPDATE CASCADE
+);
+CREATE TABLE snd_message_deliveries(
+  snd_message_delivery_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  snd_queue_id BIGINT NOT NULL,
+  internal_id BIGINT NOT NULL,
+  failed SMALLINT DEFAULT 0,
+  FOREIGN KEY(conn_id, internal_id) REFERENCES messages ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
+);
+CREATE TABLE xftp_servers(
+  xftp_server_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  xftp_host TEXT NOT NULL,
+  xftp_port TEXT NOT NULL,
+  xftp_key_hash BYTEA NOT NULL,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  UNIQUE(xftp_host, xftp_port, xftp_key_hash)
+);
+CREATE TABLE rcv_files(
+  rcv_file_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  rcv_file_entity_id BYTEA NOT NULL,
+  user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
+  size BIGINT NOT NULL,
+  digest BYTEA NOT NULL,
+  key BYTEA NOT NULL,
+  nonce BYTEA NOT NULL,
+  chunk_size BIGINT NOT NULL,
+  prefix_path TEXT NOT NULL,
+  tmp_path TEXT,
+  save_path TEXT NOT NULL,
+  status TEXT NOT NULL,
+  deleted SMALLINT NOT NULL DEFAULT 0,
+  error TEXT,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  save_file_key BYTEA,
+  save_file_nonce BYTEA,
+  failed SMALLINT DEFAULT 0,
+  redirect_id BIGINT REFERENCES rcv_files ON DELETE SET NULL,
+  redirect_entity_id BYTEA,
+  redirect_size BIGINT,
+  redirect_digest BYTEA,
+  approved_relays SMALLINT NOT NULL DEFAULT 0,
+  UNIQUE(rcv_file_entity_id)
+);
+CREATE TABLE rcv_file_chunks(
+  rcv_file_chunk_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  rcv_file_id BIGINT NOT NULL REFERENCES rcv_files ON DELETE CASCADE,
+  chunk_no BIGINT NOT NULL,
+  chunk_size BIGINT NOT NULL,
+  digest BYTEA NOT NULL,
+  tmp_path TEXT,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
+);
+CREATE TABLE rcv_file_chunk_replicas(
+  rcv_file_chunk_replica_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  rcv_file_chunk_id BIGINT NOT NULL REFERENCES rcv_file_chunks ON DELETE CASCADE,
+  replica_number BIGINT NOT NULL,
+  xftp_server_id BIGINT NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
+  replica_id BYTEA NOT NULL,
+  replica_key BYTEA NOT NULL,
+  received SMALLINT NOT NULL DEFAULT 0,
+  delay BIGINT,
+  retries BIGINT NOT NULL DEFAULT 0,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
+);
+CREATE TABLE snd_files(
+  snd_file_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  snd_file_entity_id BYTEA NOT NULL,
+  user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
+  num_recipients BIGINT NOT NULL,
+  digest BYTEA,
+  key BYTEA NOT NUll,
+  nonce BYTEA NOT NUll,
+  path TEXT NOT NULL,
+  prefix_path TEXT,
+  status TEXT NOT NULL,
+  deleted SMALLINT NOT NULL DEFAULT 0,
+  error TEXT,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  src_file_key BYTEA,
+  src_file_nonce BYTEA,
+  failed SMALLINT DEFAULT 0,
+  redirect_size BIGINT,
+  redirect_digest BYTEA
+);
+CREATE TABLE snd_file_chunks(
+  snd_file_chunk_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  snd_file_id BIGINT NOT NULL REFERENCES snd_files ON DELETE CASCADE,
+  chunk_no BIGINT NOT NULL,
+  chunk_offset BIGINT NOT NULL,
+  chunk_size BIGINT NOT NULL,
+  digest BYTEA NOT NULL,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
+);
+CREATE TABLE snd_file_chunk_replicas(
+  snd_file_chunk_replica_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  snd_file_chunk_id BIGINT NOT NULL REFERENCES snd_file_chunks ON DELETE CASCADE,
+  replica_number BIGINT NOT NULL,
+  xftp_server_id BIGINT NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
+  replica_id BYTEA NOT NULL,
+  replica_key BYTEA NOT NULL,
+  replica_status TEXT NOT NULL,
+  delay BIGINT,
+  retries BIGINT NOT NULL DEFAULT 0,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
+);
+CREATE TABLE snd_file_chunk_replica_recipients(
+  snd_file_chunk_replica_recipient_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  snd_file_chunk_replica_id BIGINT NOT NULL REFERENCES snd_file_chunk_replicas ON DELETE CASCADE,
+  rcv_replica_id BYTEA NOT NULL,
+  rcv_replica_key BYTEA NOT NULL,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
+);
+CREATE TABLE deleted_snd_chunk_replicas(
+  deleted_snd_chunk_replica_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
+  xftp_server_id BIGINT NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
+  replica_id BYTEA NOT NULL,
+  replica_key BYTEA NOT NULL,
+  chunk_digest BYTEA NOT NULL,
+  delay BIGINT,
+  retries BIGINT NOT NULL DEFAULT 0,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  failed SMALLINT DEFAULT 0
+);
+CREATE TABLE encrypted_rcv_message_hashes(
+  encrypted_rcv_message_hash_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  hash BYTEA NOT NULL,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
+);
+CREATE TABLE processed_ratchet_key_hashes(
+  processed_ratchet_key_hash_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
+  hash BYTEA NOT NULL,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
+);
+CREATE TABLE servers_stats(
+  servers_stats_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  servers_stats TEXT,
+  started_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
+  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
+);
+INSERT INTO servers_stats DEFAULT VALUES;
+CREATE TABLE ntf_tokens_to_delete(
+  ntf_token_to_delete_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_key_hash BYTEA NOT NULL,
+  tkn_id BYTEA NOT NULL,
+  tkn_priv_key BYTEA NOT NULL,
+  del_failed SMALLINT DEFAULT 0,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT (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);
+CREATE INDEX idx_conn_confirmations_conn_id ON conn_confirmations(conn_id);
+CREATE INDEX idx_conn_invitations_contact_conn_id ON conn_invitations(
+  contact_conn_id
+);
+CREATE INDEX idx_messages_conn_id_internal_snd_id ON messages(
+  conn_id,
+  internal_snd_id
+);
+CREATE INDEX idx_messages_conn_id_internal_rcv_id ON messages(
+  conn_id,
+  internal_rcv_id
+);
+CREATE INDEX idx_messages_conn_id ON messages(conn_id);
+CREATE INDEX idx_ntf_subscriptions_ntf_host_ntf_port ON ntf_subscriptions(
+  ntf_host,
+  ntf_port
+);
+CREATE INDEX idx_ntf_subscriptions_smp_host_smp_port ON ntf_subscriptions(
+  smp_host,
+  smp_port
+);
+CREATE INDEX idx_ntf_tokens_ntf_host_ntf_port ON ntf_tokens(
+  ntf_host,
+  ntf_port
+);
+CREATE INDEX idx_ratchets_conn_id ON ratchets(conn_id);
+CREATE INDEX idx_rcv_messages_conn_id_internal_id ON rcv_messages(
+  conn_id,
+  internal_id
+);
+CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id);
+CREATE INDEX idx_snd_message_deliveries_conn_id_internal_id ON snd_message_deliveries(
+  conn_id,
+  internal_id
+);
+CREATE INDEX idx_snd_messages_conn_id_internal_id ON snd_messages(
+  conn_id,
+  internal_id
+);
+CREATE INDEX idx_snd_queues_host_port ON snd_queues(host, port);
+CREATE INDEX idx_rcv_files_user_id ON rcv_files(user_id);
+CREATE INDEX idx_rcv_file_chunks_rcv_file_id ON rcv_file_chunks(rcv_file_id);
+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 INDEX idx_snd_files_user_id ON snd_files(user_id);
+CREATE INDEX idx_snd_file_chunks_snd_file_id ON snd_file_chunks(snd_file_id);
+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 INDEX idx_snd_file_chunk_replica_recipients_snd_file_chunk_replica_id ON snd_file_chunk_replica_recipients(
+  snd_file_chunk_replica_id
+);
+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
+);
+CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(
+  conn_id,
+  hash
+);
+CREATE INDEX idx_snd_messages_rcpt_internal_id ON snd_messages(
+  conn_id,
+  rcpt_internal_id
+);
+CREATE INDEX idx_processed_ratchet_key_hashes_created_at ON processed_ratchet_key_hashes(
+  created_at
+);
+CREATE INDEX idx_encrypted_rcv_message_hashes_created_at ON encrypted_rcv_message_hashes(
+  created_at
+);
+CREATE INDEX idx_messages_internal_ts ON messages(internal_ts);
+CREATE INDEX idx_commands_server_commands ON commands(
+  host,
+  port,
+  created_at,
+  command_id
+);
+CREATE INDEX idx_rcv_files_status_created_at ON rcv_files(status, created_at);
+CREATE INDEX idx_snd_files_status_created_at ON snd_files(status, created_at);
+CREATE INDEX idx_snd_files_snd_file_entity_id ON snd_files(snd_file_entity_id);
+CREATE INDEX idx_messages_snd_expired ON messages(
+  conn_id,
+  internal_snd_id,
+  internal_ts
+);
+CREATE INDEX idx_snd_message_deliveries_expired ON snd_message_deliveries(
+  conn_id,
+  snd_queue_id,
+  failed,
+  internal_id
+);
+CREATE INDEX idx_rcv_files_redirect_id on rcv_files(redirect_id);
+|]
@@ -0,0 +1,37 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.RawString.QQ (r)
+
+m20250203_msg_bodies :: Text
+m20250203_msg_bodies =
+  T.pack
+    [r|
+ALTER TABLE snd_messages ADD COLUMN msg_encrypt_key BYTEA;
+ALTER TABLE snd_messages ADD COLUMN padded_msg_len BIGINT;
+
+
+CREATE TABLE snd_message_bodies (
+  snd_message_body_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  agent_msg BYTEA NOT NULL DEFAULT ''::BYTEA
+);
+ALTER TABLE snd_messages ADD COLUMN snd_message_body_id BIGINT REFERENCES snd_message_bodies ON DELETE SET NULL;
+CREATE INDEX idx_snd_messages_snd_message_body_id ON snd_messages(snd_message_body_id);
+|]
+
+
+down_m20250203_msg_bodies :: Text
+down_m20250203_msg_bodies =
+  T.pack
+    [r|
+DROP INDEX idx_snd_messages_snd_message_body_id;
+ALTER TABLE snd_messages DROP COLUMN snd_message_body_id;
+DROP TABLE snd_message_bodies;
+
+
+ALTER TABLE snd_messages DROP COLUMN msg_encrypt_key;
+ALTER TABLE snd_messages DROP COLUMN padded_msg_len;
+|]
@@ -0,0 +1,100 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Util
+  ( createDBAndUserIfNotExists,
+    dropSchema,
+    dropAllSchemasExceptSystem,
+    dropDatabaseAndUser,
+  )
+where
+
+import Control.Exception (bracket)
+import Control.Monad (forM_, unless, void, when)
+import Data.String (fromString)
+import Database.PostgreSQL.Simple (ConnectInfo (..), Only (..), defaultConnectInfo)
+import qualified Database.PostgreSQL.Simple as PSQL
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+
+createDBAndUserIfNotExists :: ConnectInfo -> IO ()
+createDBAndUserIfNotExists ConnectInfo {connectUser = user, connectDatabase = dbName} = do
+  -- connect to the default "postgres" maintenance database
+  bracket (PSQL.connect defaultConnectInfo {connectUser = "postgres", connectDatabase = "postgres"}) PSQL.close $
+    \postgresDB -> do
+      void $ PSQL.execute_ postgresDB "SET client_min_messages TO WARNING"
+      -- check if the user exists, create if not
+      [Only userExists] <-
+        PSQL.query
+          postgresDB
+          [sql|
+            SELECT EXISTS (
+              SELECT 1 FROM pg_catalog.pg_roles
+              WHERE rolname = ?
+            )
+          |]
+          (Only user)
+      unless userExists $ void $ PSQL.execute_ postgresDB (fromString $ "CREATE USER " <> user)
+      -- check if the database exists, create if not
+      dbExists <- checkDBExists postgresDB dbName
+      unless dbExists $ void $ PSQL.execute_ postgresDB (fromString $ "CREATE DATABASE " <> dbName <> " OWNER " <> user)
+
+checkDBExists :: PSQL.Connection -> String -> IO Bool
+checkDBExists postgresDB dbName = do
+  [Only dbExists] <-
+    PSQL.query
+      postgresDB
+      [sql|
+        SELECT EXISTS (
+          SELECT 1 FROM pg_catalog.pg_database
+          WHERE datname = ?
+        )
+      |]
+      (Only dbName)
+  pure dbExists
+
+dropSchema :: ConnectInfo -> String -> IO ()
+dropSchema connectInfo schema =
+  bracket (PSQL.connect connectInfo) PSQL.close $
+    \db -> do
+      void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
+      void $ PSQL.execute_ db (fromString $ "DROP SCHEMA IF EXISTS " <> schema <> " CASCADE")
+
+dropAllSchemasExceptSystem :: ConnectInfo -> IO ()
+dropAllSchemasExceptSystem connectInfo =
+  bracket (PSQL.connect connectInfo) PSQL.close $
+    \db -> do
+      void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
+      schemaNames :: [Only String] <-
+        PSQL.query_
+          db
+          [sql|
+            SELECT schema_name
+            FROM information_schema.schemata
+            WHERE schema_name NOT IN ('public', 'pg_catalog', 'information_schema')
+          |]
+      forM_ schemaNames $ \(Only schema) ->
+        PSQL.execute_ db (fromString $ "DROP SCHEMA " <> schema <> " CASCADE")
+
+dropDatabaseAndUser :: ConnectInfo -> IO ()
+dropDatabaseAndUser ConnectInfo {connectUser = user, connectDatabase = dbName} =
+  bracket (PSQL.connect defaultConnectInfo {connectUser = "postgres", connectDatabase = "postgres"}) PSQL.close $
+    \postgresDB -> do
+      void $ PSQL.execute_ postgresDB "SET client_min_messages TO WARNING"
+      dbExists <- checkDBExists postgresDB dbName
+      when dbExists $ do
+        void $ PSQL.execute_ postgresDB (fromString $ "ALTER DATABASE " <> dbName <> " WITH ALLOW_CONNECTIONS false")
+        -- terminate all connections to the database
+        _r :: [Only Bool] <-
+          PSQL.query
+            postgresDB
+            [sql|
+              SELECT pg_terminate_backend(pg_stat_activity.pid)
+              FROM pg_stat_activity
+              WHERE datname = ?
+                AND pid <> pg_backend_pid()
+            |]
+            (Only dbName)
+        void $ PSQL.execute_ postgresDB (fromString $ "DROP DATABASE " <> dbName)
+      void $ PSQL.execute_ postgresDB (fromString $ "DROP USER IF EXISTS " <> user)
@@ -4,7 +4,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}

 module Simplex.Messaging.Agent.Store.SQLite.Common
-  ( SQLiteStore (..),
+  ( DBStore (..),
    withConnection,
    withConnection',
    withTransaction,
@@ -30,7 +30,7 @@ import UnliftIO.STM
 storeKey :: ScrubbedBytes -> Bool -> Maybe ScrubbedBytes
 storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing

-data SQLiteStore = SQLiteStore
+data DBStore = DBStore
  { dbFilePath :: FilePath,
    dbKey :: TVar (Maybe ScrubbedBytes),
    dbSem :: TVar Int,
@@ -39,8 +39,8 @@ data SQLiteStore = SQLiteStore
    dbNew :: Bool
  }

-withConnectionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
-withConnectionPriority SQLiteStore {dbSem, dbConnection} priority action
+withConnectionPriority :: DBStore -> Bool -> (DB.Connection -> IO a) -> IO a
+withConnectionPriority DBStore {dbSem, dbConnection} priority action
  | priority = E.bracket_ signal release $ withMVar dbConnection action
  | otherwise = lowPriority
  where
@@ -50,20 +50,20 @@ withConnectionPriority SQLiteStore {dbSem, dbConnection} priority action
    wait = unlessM free $ atomically $ unlessM ((0 ==) <$> readTVar dbSem) retry
    free = (0 ==) <$> readTVarIO dbSem

-withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withConnection :: DBStore -> (DB.Connection -> IO a) -> IO a
 withConnection st = withConnectionPriority st False

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

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

-withTransaction :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withTransaction :: DBStore -> (DB.Connection -> IO a) -> IO a
 withTransaction st = withTransactionPriority st False
 {-# INLINE withTransaction #-}

-withTransactionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
+withTransactionPriority :: DBStore -> Bool -> (DB.Connection -> IO a) -> IO a
 withTransactionPriority st priority action = withConnectionPriority st priority $ dbBusyLoop . transaction
  where
    transaction db@DB.Connection {conn} = SQL.withImmediateTransaction conn $ action db
@@ -1,45 +1,63 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

 module Simplex.Messaging.Agent.Store.SQLite.DB
-  ( Connection (..),
+  ( BoolInt (..),
+    Binary (..),
+    Connection (..),
    SlowQueryStats (..),
+    TrackQueries (..),
+    FromField (..),
+    ToField (..),
    open,
    close,
    execute,
    execute_,
-    executeNamed,
    executeMany,
    query,
    query_,
-    queryNamed,
  )
 where

 import Control.Concurrent.STM
-import Control.Monad (when)
 import Control.Exception
+import Control.Monad (when)
 import qualified Data.Aeson.TH as J
+import Data.ByteString (ByteString)
 import Data.Int (Int64)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import Data.Time (diffUTCTime, getCurrentTime)
-import Database.SQLite.Simple (FromRow, NamedParam, Query, ToRow)
+import Database.SQLite.Simple (FromRow, Query, ToRow)
 import qualified Database.SQLite.Simple as SQL
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (diffToMilliseconds, tshow)
+import Simplex.Messaging.Util (diffToMicroseconds, tshow)
+
+newtype BoolInt = BI {unBI :: Bool}
+  deriving newtype (FromField, ToField)
+
+newtype Binary = Binary {fromBinary :: ByteString}
+  deriving newtype (FromField, ToField)

 data Connection = Connection
  { conn :: SQL.Connection,
+    track :: TrackQueries,
    slow :: TMap Query SlowQueryStats
  }

+data TrackQueries = TQAll | TQSlow Int64 | TQOff
+  deriving (Eq)
+
 data SlowQueryStats = SlowQueryStats
  { count :: Int64,
    timeMax :: Int64,
@@ -48,21 +66,29 @@ data SlowQueryStats = SlowQueryStats
  }
  deriving (Show)

-timeIt :: TMap Query SlowQueryStats -> Query -> IO a -> IO a
-timeIt slow sql a = do
-  t <- getCurrentTime
-  r <- a `catch` \e -> do
-    atomically $ TM.alter (Just . updateQueryErrors e) sql slow
-    throwIO e
-  t' <- getCurrentTime
-  let diff = diffToMilliseconds $ diffUTCTime t' t
-  when (diff > 1) $ atomically $ TM.alter (updateQueryStats diff) sql slow
-  pure r
+timeIt :: Connection -> Query -> IO a -> IO a
+timeIt Connection {slow, track} sql a
+  | track == TQOff = makeQuery
+  | otherwise = do
+      t <- getCurrentTime
+      r <- makeQuery
+      t' <- getCurrentTime
+      let diff = diffToMicroseconds $ diffUTCTime t' t
+      when (trackQuery diff) $ atomically $ TM.alter (updateQueryStats diff) sql slow
+      pure r
  where
+    makeQuery =
+      a `catch` \e -> do
+        atomically $ TM.alter (Just . updateQueryErrors e) sql slow
+        throwIO e
+    trackQuery diff = case track of
+      TQOff -> False
+      TQSlow t -> diff > t
+      TQAll -> True
    updateQueryErrors :: SomeException -> Maybe SlowQueryStats -> SlowQueryStats
    updateQueryErrors e Nothing = SlowQueryStats 0 0 0 $ M.singleton (tshow e) 1
-    updateQueryErrors e (Just stats@SlowQueryStats {errs}) =
-      stats {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
+    updateQueryErrors e (Just st@SlowQueryStats {errs}) =
+      st {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
    updateQueryStats :: Int64 -> Maybe SlowQueryStats -> Maybe SlowQueryStats
    updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff M.empty
    updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg, errs}) =
@@ -74,41 +100,33 @@ timeIt slow sql a = do
            errs
          }

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

 close :: Connection -> IO ()
 close = SQL.close . conn

 execute :: ToRow q => Connection -> Query -> q -> IO ()
-execute Connection {conn, slow} sql = timeIt slow sql . SQL.execute conn sql
+execute c sql = timeIt c sql . SQL.execute (conn c) sql
 {-# INLINE execute #-}

 execute_ :: Connection -> Query -> IO ()
-execute_ Connection {conn, slow} sql = timeIt slow sql $ SQL.execute_ conn sql
+execute_ c sql = timeIt c sql $ SQL.execute_ (conn c) sql
 {-# INLINE execute_ #-}

-executeNamed :: Connection -> Query -> [NamedParam] -> IO ()
-executeNamed Connection {conn, slow} sql = timeIt slow sql . SQL.executeNamed conn sql
-{-# INLINE executeNamed #-}
-
 executeMany :: ToRow q => Connection -> Query -> [q] -> IO ()
-executeMany Connection {conn, slow} sql = timeIt slow sql . SQL.executeMany conn sql
+executeMany c sql = timeIt c sql . SQL.executeMany (conn c) sql
 {-# INLINE executeMany #-}

 query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r]
-query Connection {conn, slow} sql = timeIt slow sql . SQL.query conn sql
+query c sql = timeIt c sql . SQL.query (conn c) sql
 {-# INLINE query #-}

 query_ :: FromRow r => Connection -> Query -> IO [r]
-query_ Connection {conn, slow} sql = timeIt slow sql $ SQL.query_ conn sql
+query_ c sql = timeIt c sql $ SQL.query_ (conn c) sql
 {-# INLINE query_ #-}

-queryNamed :: FromRow r => Connection -> Query -> [NamedParam] -> IO [r]
-queryNamed Connection {conn, slow} sql = timeIt slow sql . SQL.queryNamed conn sql
-{-# INLINE queryNamed #-}
-
 $(J.deriveJSON defaultJSON ''SlowQueryStats)
@@ -5,142 +5,44 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}

 module Simplex.Messaging.Agent.Store.SQLite.Migrations
-  ( Migration (..),
-    MigrationsToRun (..),
-    MTRError (..),
-    DownMigration (..),
-    app,
-    initialize,
-    get,
+  ( initialize,
    run,
-    getCurrent,
-    mtrErrorDescription,
-    -- for unit tests
-    migrationsToRun,
-    toDownMigration,
+    getCurrentMigrations,
  )
 where

 import Control.Monad (forM_, when)
-import qualified Data.Aeson.TH as J
-import Data.List (intercalate, sortOn)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map.Strict as M
-import Data.Maybe (isNothing, mapMaybe)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (getCurrentTime)
-import Database.SQLite.Simple (Connection, Only (..), Query (..))
-import qualified Database.SQLite.Simple as DB
+import Database.SQLite.Simple (Only (..), Query (..))
+import qualified Database.SQLite.Simple as SQL
 import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
 import Simplex.Messaging.Agent.Protocol (extraSMPServerHosts)
+import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.SQLite.Common
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
-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.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
+import Simplex.Messaging.Agent.Store.Shared
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)

-data Migration = Migration {name :: String, up :: Text, down :: Maybe Text}
-  deriving (Eq, Show)
-
-schemaMigrations :: [(String, Query, Maybe Query)]
-schemaMigrations =
-  [ ("20220101_initial", m20220101_initial, Nothing),
-    ("20220301_snd_queue_keys", m20220301_snd_queue_keys, Nothing),
-    ("20220322_notifications", m20220322_notifications, Nothing),
-    ("20220607_v2", m20220608_v2, Nothing),
-    ("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode, Nothing),
-    ("m20220811_onion_hosts", m20220811_onion_hosts, Nothing),
-    ("m20220817_connection_ntfs", m20220817_connection_ntfs, Nothing),
-    ("m20220905_commands", m20220905_commands, Nothing),
-    ("m20220915_connection_queues", m20220915_connection_queues, Nothing),
-    ("m20230110_users", m20230110_users, Nothing),
-    ("m20230117_fkey_indexes", m20230117_fkey_indexes, Nothing),
-    ("m20230120_delete_errors", m20230120_delete_errors, Nothing),
-    ("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),
-    ("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),
-    ("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync),
-    ("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
-    ("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
-    ("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
-    ("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
-    ("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files),
-    ("m20231222_command_created_at", m20231222_command_created_at, Just down_m20231222_command_created_at),
-    ("m20231225_failed_work_items", m20231225_failed_work_items, Just down_m20231225_failed_work_items),
-    ("m20240121_message_delivery_indexes", m20240121_message_delivery_indexes, Just down_m20240121_message_delivery_indexes),
-    ("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
-    ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
-    ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
-    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
-    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
-    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats),
-    ("m20240930_ntf_tokens_to_delete", m20240930_ntf_tokens_to_delete, Just down_m20240930_ntf_tokens_to_delete),
-    ("m20241007_rcv_queues_last_broker_ts", m20241007_rcv_queues_last_broker_ts, Just down_m20241007_rcv_queues_last_broker_ts)
-  ]
-
-- | The list of migrations in ascending order by date
-app :: [Migration]
-app = sortOn name $ map migration schemaMigrations
-  where
-    migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}
-
-get :: SQLiteStore -> [Migration] -> IO (Either MTRError MigrationsToRun)
-get st migrations = migrationsToRun migrations <$> withTransaction' st getCurrent
-
-getCurrent :: Connection -> IO [Migration]
-getCurrent db = map toMigration <$> DB.query_ db "SELECT name, down FROM migrations ORDER BY name ASC;"
+getCurrentMigrations :: DB.Connection -> IO [Migration]
+getCurrentMigrations DB.Connection {DB.conn} = map toMigration <$> SQL.query_ conn "SELECT name, down FROM migrations ORDER BY name ASC;"
  where
    toMigration (name, down) = Migration {name, up = "", down}

-run :: SQLiteStore -> MigrationsToRun -> IO ()
-run st = \case
+run :: DBStore -> Bool -> MigrationsToRun -> IO ()
+run st vacuum = \case
  MTRUp [] -> pure ()
-  MTRUp ms -> mapM_ runUp ms >> withConnection' st (`execSQL` "VACUUM;")
+  MTRUp ms -> do
+    mapM_ runUp ms
+    when vacuum $ withConnection' st (`execSQL` "VACUUM;")
  MTRDown ms -> mapM_ runDown $ reverse ms
  MTRNone -> pure ()
  where
@@ -148,27 +50,27 @@ run st = \case
      when (name == "m20220811_onion_hosts") $ updateServers db
      insert db >> execSQL db up'
      where
-        insert db = DB.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
+        insert db = SQL.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
        up'
          | dbNew st && name == "m20230110_users" = fromQuery new_m20230110_users
          | otherwise = up
        updateServers db = forM_ (M.assocs extraSMPServerHosts) $ \(h, h') ->
          let hs = decodeLatin1 . strEncode $ ([h, h'] :: NonEmpty TransportHost)
-           in DB.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
+           in SQL.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
    runDown DownMigration {downName, downQuery} = withTransaction' st $ \db -> do
      execSQL db downQuery
-      DB.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
-    execSQL db = SQLite3.exec $ DB.connectionHandle db
+      SQL.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
+    execSQL db = SQLite3.exec $ SQL.connectionHandle db

-initialize :: SQLiteStore -> IO ()
+initialize :: DBStore -> IO ()
 initialize st = withTransaction' st $ \db -> do
-  cs :: [Text] <- map fromOnly <$> DB.query_ db "SELECT name FROM pragma_table_info('migrations')"
+  cs :: [Text] <- map fromOnly <$> SQL.query_ db "SELECT name FROM pragma_table_info('migrations')"
  case cs of
    [] -> createMigrations db
-    _ -> when ("down" `notElem` cs) $ DB.execute_ db "ALTER TABLE migrations ADD COLUMN down TEXT"
+    _ -> when ("down" `notElem` cs) $ SQL.execute_ db "ALTER TABLE migrations ADD COLUMN down TEXT"
  where
    createMigrations db =
-      DB.execute_
+      SQL.execute_
        db
        [sql|
          CREATE TABLE IF NOT EXISTS migrations (
@@ -178,37 +80,3 @@ initialize st = withTransaction' st $ \db -> do
            PRIMARY KEY (name)
          );
        |]
-
-data DownMigration = DownMigration {downName :: String, downQuery :: Text}
-  deriving (Eq, Show)
-
-toDownMigration :: Migration -> Maybe DownMigration
-toDownMigration Migration {name, down} = DownMigration name <$> down
-
-data MigrationsToRun = MTRUp [Migration] | MTRDown [DownMigration] | MTRNone
-  deriving (Eq, Show)
-
-data MTRError
-  = MTRENoDown {dbMigrations :: [String]}
-  | MTREDifferent {appMigration :: String, dbMigration :: String}
-  deriving (Eq, Show)
-
-mtrErrorDescription :: MTRError -> String
-mtrErrorDescription = \case
-  MTRENoDown ms -> "database version is newer than the app, but no down migration for: " <> intercalate ", " ms
-  MTREDifferent a d -> "different migration in the app/database: " <> a <> " / " <> d
-
-migrationsToRun :: [Migration] -> [Migration] -> Either MTRError MigrationsToRun
-migrationsToRun [] [] = Right MTRNone
-migrationsToRun appMs [] = Right $ MTRUp appMs
-migrationsToRun [] dbMs
-  | length dms == length dbMs = Right $ MTRDown dms
-  | otherwise = Left $ MTRENoDown $ mapMaybe nameNoDown dbMs
-  where
-    dms = mapMaybe toDownMigration dbMs
-    nameNoDown m = if isNothing (down m) then Just $ name m else Nothing
-migrationsToRun (a : as) (d : ds)
-  | name a == name d = migrationsToRun as ds
-  | otherwise = Left $ MTREDifferent (name a) (name d)
-
-$(J.deriveJSON (sumTypeJSON $ dropPrefix "MTRE") ''MTRError)
@@ -0,0 +1,93 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.App (appMigrations) where
+
+import Data.List (sortOn)
+import Database.SQLite.Simple (Query (..))
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
+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.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
+import Simplex.Messaging.Agent.Store.Shared (Migration (..))
+
+schemaMigrations :: [(String, Query, Maybe Query)]
+schemaMigrations =
+  [ ("20220101_initial", m20220101_initial, Nothing),
+    ("20220301_snd_queue_keys", m20220301_snd_queue_keys, Nothing),
+    ("20220322_notifications", m20220322_notifications, Nothing),
+    ("20220607_v2", m20220608_v2, Nothing),
+    ("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode, Nothing),
+    ("m20220811_onion_hosts", m20220811_onion_hosts, Nothing),
+    ("m20220817_connection_ntfs", m20220817_connection_ntfs, Nothing),
+    ("m20220905_commands", m20220905_commands, Nothing),
+    ("m20220915_connection_queues", m20220915_connection_queues, Nothing),
+    ("m20230110_users", m20230110_users, Nothing),
+    ("m20230117_fkey_indexes", m20230117_fkey_indexes, Nothing),
+    ("m20230120_delete_errors", m20230120_delete_errors, Nothing),
+    ("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),
+    ("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),
+    ("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync),
+    ("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
+    ("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
+    ("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
+    ("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
+    ("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files),
+    ("m20231222_command_created_at", m20231222_command_created_at, Just down_m20231222_command_created_at),
+    ("m20231225_failed_work_items", m20231225_failed_work_items, Just down_m20231225_failed_work_items),
+    ("m20240121_message_delivery_indexes", m20240121_message_delivery_indexes, Just down_m20240121_message_delivery_indexes),
+    ("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
+    ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
+    ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
+    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
+    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
+    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats),
+    ("m20240930_ntf_tokens_to_delete", m20240930_ntf_tokens_to_delete, Just down_m20240930_ntf_tokens_to_delete),
+    ("m20241007_rcv_queues_last_broker_ts", m20241007_rcv_queues_last_broker_ts, Just down_m20241007_rcv_queues_last_broker_ts),
+    ("m20241224_ratchet_e2e_snd_params", m20241224_ratchet_e2e_snd_params, Just down_m20241224_ratchet_e2e_snd_params),
+    ("m20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies)
+  ]
+
+-- | The list of migrations in ascending order by date
+appMigrations :: [Migration]
+appMigrations = sortOn name $ map migration schemaMigrations
+  where
+    migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}
@@ -0,0 +1,18 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20241224_ratchet_e2e_snd_params :: Query
+m20241224_ratchet_e2e_snd_params =
+    [sql|
+ALTER TABLE ratchets ADD COLUMN pq_pub_kem BLOB;
+|]
+
+down_m20241224_ratchet_e2e_snd_params :: Query
+down_m20241224_ratchet_e2e_snd_params =
+    [sql|
+ALTER TABLE ratchets DROP COLUMN pq_pub_kem;
+|]
@@ -0,0 +1,33 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20250203_msg_bodies :: Query
+m20250203_msg_bodies =
+    [sql|
+ALTER TABLE snd_messages ADD COLUMN msg_encrypt_key BLOB;
+ALTER TABLE snd_messages ADD COLUMN padded_msg_len INTEGER;
+
+
+CREATE TABLE snd_message_bodies (
+  snd_message_body_id INTEGER PRIMARY KEY,
+  agent_msg BLOB NOT NULL DEFAULT x''
+);
+ALTER TABLE snd_messages ADD COLUMN snd_message_body_id INTEGER REFERENCES snd_message_bodies ON DELETE SET NULL;
+CREATE INDEX idx_snd_messages_snd_message_body_id ON snd_messages(snd_message_body_id);
+|]
+
+down_m20250203_msg_bodies :: Query
+down_m20250203_msg_bodies =
+    [sql|
+DROP INDEX idx_snd_messages_snd_message_body_id;
+ALTER TABLE snd_messages DROP COLUMN snd_message_body_id;
+DROP TABLE snd_message_bodies;
+
+
+ALTER TABLE snd_messages DROP COLUMN msg_encrypt_key;
+ALTER TABLE snd_messages DROP COLUMN padded_msg_len;
+|]
@@ -127,6 +127,9 @@ CREATE TABLE snd_messages(
  retry_int_fast INTEGER,
  rcpt_internal_id INTEGER,
  rcpt_status TEXT,
+  msg_encrypt_key BLOB,
+  padded_msg_len INTEGER,
+  snd_message_body_id INTEGER REFERENCES snd_message_bodies ON DELETE SET NULL,
  PRIMARY KEY(conn_id, internal_snd_id),
  FOREIGN KEY(conn_id, internal_id) REFERENCES messages
  ON DELETE CASCADE
@@ -166,7 +169,8 @@ CREATE TABLE ratchets(
  ,
  x3dh_pub_key_1 BLOB,
  x3dh_pub_key_2 BLOB,
-  pq_priv_kem BLOB
+  pq_priv_kem BLOB,
+  pq_pub_kem BLOB
 ) WITHOUT ROWID;
 CREATE TABLE skipped_messages(
  skipped_message_id INTEGER PRIMARY KEY,
@@ -414,6 +418,10 @@ CREATE TABLE ntf_tokens_to_delete(
 del_failed INTEGER DEFAULT 0,
 created_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
+CREATE TABLE snd_message_bodies(
+  snd_message_body_id INTEGER PRIMARY KEY,
+  agent_msg BLOB NOT NULL DEFAULT x''
+);
 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);
@@ -540,3 +548,6 @@ CREATE INDEX idx_snd_message_deliveries_expired ON snd_message_deliveries(
  internal_id
 );
 CREATE INDEX idx_rcv_files_redirect_id on rcv_files(redirect_id);
+CREATE INDEX idx_snd_messages_snd_message_body_id ON snd_messages(
+  snd_message_body_id
+);
@@ -0,0 +1,93 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Messaging.Agent.Store.Shared
+  ( Migration (..),
+    MigrationsToRun (..),
+    DownMigration (..),
+    MTRError (..),
+    mtrErrorDescription,
+    MigrationConfirmation (..),
+    MigrationError (..),
+    UpMigration (..),
+    migrationErrorDescription,
+    -- for tests
+    toDownMigration,
+    upMigration,
+  )
+where
+
+import qualified Data.Aeson.TH as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.List (intercalate)
+import Data.Maybe (isJust)
+import Data.Text (Text)
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
+
+data Migration = Migration {name :: String, up :: Text, down :: Maybe Text}
+  deriving (Eq, Show)
+
+data DownMigration = DownMigration {downName :: String, downQuery :: Text}
+  deriving (Eq, Show)
+
+toDownMigration :: Migration -> Maybe DownMigration
+toDownMigration Migration {name, down} = DownMigration name <$> down
+
+data MigrationsToRun = MTRUp [Migration] | MTRDown [DownMigration] | MTRNone
+  deriving (Eq, Show)
+
+data MTRError
+  = MTRENoDown {dbMigrations :: [String]}
+  | MTREDifferent {appMigration :: String, dbMigration :: String}
+  deriving (Eq, Show)
+
+mtrErrorDescription :: MTRError -> String
+mtrErrorDescription = \case
+  MTRENoDown ms -> "database version is newer than the app, but no down migration for: " <> intercalate ", " ms
+  MTREDifferent a d -> "different migration in the app/database: " <> a <> " / " <> d
+
+data MigrationError
+  = MEUpgrade {upMigrations :: [UpMigration]}
+  | MEDowngrade {downMigrations :: [String]}
+  | MigrationError {mtrError :: MTRError}
+  deriving (Eq, Show)
+
+migrationErrorDescription :: MigrationError -> String
+migrationErrorDescription = \case
+  MEUpgrade ums ->
+    "The app has a newer version than the database.\nConfirm to back up and upgrade using these migrations: " <> intercalate ", " (map upName ums)
+  MEDowngrade dms ->
+    "Database version is newer than the app.\nConfirm to back up and downgrade using these migrations: " <> intercalate ", " dms
+  MigrationError err -> mtrErrorDescription err
+
+data UpMigration = UpMigration {upName :: String, withDown :: Bool}
+  deriving (Eq, Show)
+
+upMigration :: Migration -> UpMigration
+upMigration Migration {name, down} = UpMigration name $ isJust down
+
+data MigrationConfirmation = MCYesUp | MCYesUpDown | MCConsole | MCError
+  deriving (Eq, Show)
+
+instance StrEncoding MigrationConfirmation where
+  strEncode = \case
+    MCYesUp -> "yesUp"
+    MCYesUpDown -> "yesUpDown"
+    MCConsole -> "console"
+    MCError -> "error"
+  strP =
+    A.takeByteString >>= \case
+      "yesUp" -> pure MCYesUp
+      "yesUpDown" -> pure MCYesUpDown
+      "console" -> pure MCConsole
+      "error" -> pure MCError
+      _ -> fail "invalid MigrationConfirmation"
+
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "MTRE") ''MTRError)
+
+$(J.deriveJSON defaultJSON ''UpMigration)
+
+$(J.deriveToJSON (sumTypeJSON $ dropPrefix "ME") ''MigrationError)
@@ -105,7 +105,7 @@ module Simplex.Messaging.Client
 where

 import Control.Applicative ((<|>))
-import Control.Concurrent (ThreadId, forkFinally, killThread, mkWeakThreadId)
+import Control.Concurrent (ThreadId, forkFinally, forkIO, killThread, mkWeakThreadId)
 import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Exception
@@ -171,7 +171,7 @@ data PClient v err msg = PClient
    timeoutErrorCount :: TVar Int,
    clientCorrId :: TVar ChaChaDRG,
    sentCommands :: TMap CorrId (Request err msg),
-    sndQ :: TBQueue (Maybe (TVar Bool), ByteString),
+    sndQ :: TBQueue (Maybe (Request err msg), ByteString),
    rcvQ :: TBQueue (NonEmpty (SignedTransmission err msg)),
    msgQ :: Maybe (TBQueue (ServerTransmissionBatch v err msg))
  }
@@ -406,6 +406,8 @@ data ProtocolClientConfig v = ProtocolClientConfig
    serverVRange :: VersionRange v,
    -- | agree shared session secret (used in SMP proxy for additional encryption layer)
    agreeSecret :: Bool,
+    -- | Whether connecting client is a proxy server. See comment in ClientHandshake
+    proxyServer :: Bool,
    -- | send SNI to server, False for SMP
    useSNI :: Bool
  }
@@ -420,6 +422,7 @@ defaultClientConfig clientALPN useSNI serverVRange =
      clientALPN,
      serverVRange,
      agreeSecret = False,
+      proxyServer = False,
      useSNI
    }
 {-# INLINE defaultClientConfig #-}
@@ -489,7 +492,7 @@ type TransportSession msg = (UserId, ProtoServer msg, Maybe ByteString)
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
 getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> UTCTime -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
-getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret, useSNI} msgQ proxySessTs disconnected = do
+getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret, proxyServer, useSNI} msgQ proxySessTs disconnected = do
  case chooseTransportHost networkConfig (host srv) of
    Right useHost ->
      (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
@@ -548,7 +551,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
    client :: forall c. Transport c => TProxy c -> PClient v err msg -> TMVar (Either (ProtocolClientError err) (ProtocolClient v err msg)) -> c -> IO ()
    client _ c cVar h = do
      ks <- if agreeSecret then Just <$> atomically (C.generateKeyPair g) else pure Nothing
-      runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange) >>= \case
+      runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange proxyServer) >>= \case
        Left e -> atomically . putTMVar cVar . Left $ PCETransportError e
        Right th@THandle {params} -> do
          sessionTs <- getCurrentTime
@@ -563,9 +566,12 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
    send :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO ()
    send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= sendPending
      where
-        sendPending (Nothing, s) = send_ s
-        sendPending (Just pending, s) = whenM (readTVarIO pending) $ send_ s
-        send_ = void . tPutLog h
+        sendPending (r, s) = case r of
+          Nothing -> void $ tPutLog h s
+          Just Request {pending, responseVar} ->
+            whenM (readTVarIO pending) $ tPutLog h s >>= either responseErr pure
+            where
+              responseErr = atomically . putTMVar responseVar . Left . PCETransportError

    receive :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO ()
    receive ProtocolClient {client_ = PClient {rcvQ, lastReceived, timeoutErrorCount}} h = forever $ do
@@ -1080,11 +1086,11 @@ sendBatch c@ProtocolClient {client_ = PClient {sndQ}} b = do
      pure [Response entityId $ Left $ PCETransportError e]
    TBTransmissions s n rs
      | n > 0 -> do
-          atomically $ writeTBQueue sndQ (Nothing, s) -- do not expire batched responses
+          nonBlockingWriteTBQueue sndQ (Nothing, s) -- do not expire batched responses
          mapConcurrently (getResponse c Nothing) rs
      | otherwise -> pure []
    TBTransmission s r -> do
-      atomically $ writeTBQueue sndQ (Nothing, s)
+      nonBlockingWriteTBQueue sndQ (Nothing, s)
      (: []) <$> getResponse c Nothing r

 -- | Send Protocol command
@@ -1101,18 +1107,23 @@ sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ}, thParams = THan
  where
    -- two separate "atomically" needed to avoid blocking
    sendRecv :: Either TransportError SentRawTransmission -> Request err msg -> IO (Either (ProtocolClientError err) msg)
-    sendRecv t_ r@Request {pending} = case t_ of
+    sendRecv t_ r = case t_ of
      Left e -> pure . Left $ PCETransportError e
      Right t
        | B.length s > blockSize - 2 -> pure . Left $ PCETransportError TELargeMsg
        | otherwise -> do
-            atomically $ writeTBQueue sndQ (Just pending, s)
+            nonBlockingWriteTBQueue sndQ (Just r, s)
            response <$> getResponse c tOut r
        where
          s
            | batch = tEncodeBatch1 t
            | otherwise = tEncode t

+nonBlockingWriteTBQueue :: TBQueue a -> a -> IO ()
+nonBlockingWriteTBQueue q x = do
+  sent <- atomically $ ifM (isFullTBQueue q) (pure False) (writeTBQueue q x $> True)
+  unless sent $ void $ forkIO $ atomically $ writeTBQueue q x
+
 getResponse :: ProtocolClient v err msg -> Maybe Int -> Request err msg -> IO (Response err msg)
 getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount}} tOut Request {entityId, pending, responseVar} = do
  r <- fromMaybe tcpTimeout tOut `timeout` atomically (takeTMVar responseVar)
@@ -1,11 +1,14 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -166,6 +169,7 @@ module Simplex.Messaging.Crypto
    sha512Hash,

    -- * Message padding / un-padding
+    canPad,
    pad,
    unPad,

@@ -233,10 +237,9 @@ import Data.Typeable (Proxy (Proxy), Typeable)
 import Data.Word (Word32)
 import Data.X509
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
 import Network.Transport.Internal (decodeWord16, encodeWord16)
+import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, parseAll, parseString)
@@ -721,23 +724,23 @@ generateKeyPair_ = case sAlgorithm @a of
      let k = X448.toPublic pk
       in pure (PublicKeyX448 k, PrivateKeyX448 pk k)

-instance ToField APrivateSignKey where toField = toField . encodePrivKey
+instance ToField APrivateSignKey where toField = toField . Binary . encodePrivKey

-instance ToField APublicVerifyKey where toField = toField . encodePubKey
+instance ToField APublicVerifyKey where toField = toField . Binary . encodePubKey

-instance ToField APrivateAuthKey where toField = toField . encodePrivKey
+instance ToField APrivateAuthKey where toField = toField . Binary . encodePrivKey

-instance ToField APublicAuthKey where toField = toField . encodePubKey
+instance ToField APublicAuthKey where toField = toField . Binary . encodePubKey

-instance ToField APrivateDhKey where toField = toField . encodePrivKey
+instance ToField APrivateDhKey where toField = toField . Binary . encodePrivKey

-instance ToField APublicDhKey where toField = toField . encodePubKey
+instance ToField APublicDhKey where toField = toField . Binary . encodePubKey

-instance AlgorithmI a => ToField (PrivateKey a) where toField = toField . encodePrivKey
+instance AlgorithmI a => ToField (PrivateKey a) where toField = toField . Binary . encodePrivKey

-instance AlgorithmI a => ToField (PublicKey a) where toField = toField . encodePubKey
+instance AlgorithmI a => ToField (PublicKey a) where toField = toField . Binary . encodePubKey

-instance ToField (DhSecret a) where toField = toField . dhBytes'
+instance ToField (DhSecret a) where toField = toField . Binary . dhBytes'

 instance FromField APrivateSignKey where fromField = blobFieldDecoder decodePrivKey

@@ -888,10 +891,9 @@ validSignatureSize n =
 -- | AES key newtype.
 newtype Key = Key {unKey :: ByteString}
  deriving (Eq, Ord, Show)
+  deriving newtype (FromField)

-instance ToField Key where toField = toField . unKey
-
-instance FromField Key where fromField f = Key <$> fromField f
+instance ToField Key where toField (Key s) = toField $ Binary s

 instance ToJSON Key where
  toJSON = strToJSON . unKey
@@ -952,7 +954,7 @@ instance FromJSON KeyHash where
 instance IsString KeyHash where
  fromString = parseString $ parseAll strP

-instance ToField KeyHash where toField = toField . strEncode
+instance ToField KeyHash where toField = toField . Binary . strEncode

 instance FromField KeyHash where fromField = blobFieldDecoder $ parseAll strP

@@ -1009,6 +1011,11 @@ decryptAEADNoPad aesKey iv ad msg (AuthTag tag) = do
 maxMsgLen :: Int
 maxMsgLen = 2 ^ (16 :: Int) - 3

+canPad :: Int -> Int -> Bool
+canPad msgLen paddedLen = msgLen <= maxMsgLen && padLen >= 0
+  where
+    padLen = paddedLen - msgLen - 2
+
 pad :: ByteString -> Int -> Either CryptoError ByteString
 pad msg paddedLen
  | len <= maxMsgLen && padLen >= 0 = Right $ encodeWord16 (fromIntegral len) <> msg <> B.replicate padLen '#'
@@ -1162,10 +1169,14 @@ instance SignatureAlgorithmX509 pk => SignatureAlgorithmX509 (a, pk) where
 newtype SignedObject a = SignedObject {getSignedExact :: SignedExact a}

 instance (Typeable a, Eq a, Show a, ASN1Object a) => FromField (SignedObject a) where
+#if defined(dbPostgres)
+  fromField f dat = SignedObject <$> blobFieldDecoder decodeSignedObject f dat
+#else
  fromField = fmap SignedObject . blobFieldDecoder decodeSignedObject
+#endif

 instance (Eq a, Show a, ASN1Object a) => ToField (SignedObject a) where
-  toField (SignedObject s) = toField $ encodeSignedObject s
+  toField (SignedObject s) = toField . Binary $ encodeSignedObject s

 instance (Eq a, Show a, ASN1Object a) => Encoding (SignedObject a) where
  smpEncode (SignedObject exact) = smpEncode . Large $ encodeSignedObject exact
@@ -1265,6 +1276,9 @@ cbVerify k pk nonce (CbAuthenticator s) authorized = cbDecryptNoPad (dh' k pk) n

 newtype CbNonce = CryptoBoxNonce {unCbNonce :: ByteString}
  deriving (Eq, Show)
+  deriving newtype (FromField)
+
+instance ToField CbNonce where toField (CryptoBoxNonce s) = toField $ Binary s

 pattern CbNonce :: ByteString -> CbNonce
 pattern CbNonce s <- CryptoBoxNonce s
@@ -1282,10 +1296,6 @@ instance ToJSON CbNonce where
 instance FromJSON CbNonce where
  parseJSON = strParseJSON "CbNonce"

-instance FromField CbNonce where fromField f = CryptoBoxNonce <$> fromField f
-
-instance ToField CbNonce where toField (CryptoBoxNonce s) = toField s
-
 cbNonce :: ByteString -> CbNonce
 cbNonce s
  | len == 24 = CryptoBoxNonce s
@@ -1309,6 +1319,9 @@ instance Encoding CbNonce where

 newtype SbKey = SecretBoxKey {unSbKey :: ByteString}
  deriving (Eq, Show)
+  deriving newtype (FromField)
+
+instance ToField SbKey where toField (SecretBoxKey s) = toField $ Binary s

 pattern SbKey :: ByteString -> SbKey
 pattern SbKey s <- SecretBoxKey s
@@ -1326,10 +1339,6 @@ instance ToJSON SbKey where
 instance FromJSON SbKey where
  parseJSON = strParseJSON "SbKey"

-instance FromField SbKey where fromField f = SecretBoxKey <$> fromField f
-
-instance ToField SbKey where toField (SecretBoxKey s) = toField s
-
 sbKey :: ByteString -> Either String SbKey
 sbKey s
  | B.length s == 32 = Right $ SecretBoxKey s
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -20,6 +21,8 @@
 module Simplex.Messaging.Crypto.Ratchet
  ( Ratchet (..),
    RatchetX448,
+    MsgEncryptKey (..),
+    MsgEncryptKeyX448,
    SkippedMsgDiff (..),
    SkippedMsgKeys,
    InitialKeys (..),
@@ -63,7 +66,9 @@ module Simplex.Messaging.Crypto.Ratchet
    pqX3dhRcv,
    initSndRatchet,
    initRcvRatchet,
-    rcEncrypt,
+    rcCheckCanPad,
+    rcEncryptHeader,
+    rcEncryptMsg,
    rcDecrypt,
    -- used in tests
    MsgHeader (..),
@@ -84,6 +89,7 @@ module Simplex.Messaging.Crypto.Ratchet
 where

 import Control.Applicative ((<|>))
+import Control.Monad (unless)
 import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except
@@ -109,14 +115,13 @@ import Data.Maybe (fromMaybe, isJust)
 import Data.Type.Equality
 import Data.Typeable (Typeable)
 import Data.Word (Word16, Word32)
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.QueryString
+import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), FromField (..), ToField (..))
 import Simplex.Messaging.Crypto
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, parseE, parseE')
+import Simplex.Messaging.Parsers (blobFieldDecoder, blobFieldParser, defaultJSON, parseE, parseE')
 import Simplex.Messaging.Util (($>>=), (<$?>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
@@ -206,6 +211,10 @@ instance Encoding ARKEMParams where
      'A' -> ARKP SRKSAccepted .: RKParamsAccepted <$> smpP <*> smpP
      _ -> fail "bad ratchet KEM params"

+instance ToField ARKEMParams where toField = toField . Binary . smpEncode
+
+instance FromField ARKEMParams where fromField = blobFieldDecoder smpDecode
+
 data E2ERatchetParams (s :: RatchetKEMState) (a :: Algorithm)
  = E2ERatchetParams VersionE2E (PublicKey a) (PublicKey a) (Maybe (RKEMParams s))
  deriving (Show)
@@ -359,7 +368,7 @@ instance Encoding APrivRKEMParams where
      'A' -> APRKP SRKSAccepted .:. PrivateRKParamsAccepted <$> smpP <*> smpP <*> smpP
      _ -> fail "bad APrivRKEMParams"

-instance RatchetKEMStateI s => ToField (PrivRKEMParams s) where toField = toField . smpEncode
+instance RatchetKEMStateI s => ToField (PrivRKEMParams s) where toField = toField . Binary . smpEncode

 instance (Typeable s, RatchetKEMStateI s) => FromField (PrivRKEMParams s) where fromField = blobFieldDecoder smpDecode

@@ -560,6 +569,7 @@ applySMDiff smks = \case
 type HeaderKey = Key

 data MessageKey = MessageKey Key IV
+  deriving (Show)

 instance Encoding MessageKey where
  smpEncode (MessageKey (Key key) (IV iv)) = smpEncode (key, iv)
@@ -576,7 +586,7 @@ instance ToJSON RatchetKey where
 instance FromJSON RatchetKey where
  parseJSON = fmap RatchetKey . strParseJSON "Key"

-instance ToField MessageKey where toField = toField . smpEncode
+instance ToField MessageKey where toField = toField . Binary . smpEncode

 instance FromField MessageKey where fromField = blobFieldDecoder smpDecode

@@ -841,9 +851,13 @@ connPQEncryption = \case
  IKUsePQ -> PQSupportOn
  IKNoPQ pq -> pq -- default for creating connection is IKNoPQ PQEncOn

-rcEncrypt :: AlgorithmI a => Ratchet a -> Int -> ByteString -> Maybe PQEncryption -> VersionE2E -> ExceptT CryptoError IO (ByteString, Ratchet a)
-rcEncrypt Ratchet {rcSnd = Nothing} _ _ _ _ = throwE CERatchetState
-rcEncrypt rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, rcKEM, rcNs, rcPN, rcAD = Str rcAD, rcSupportKEM, rcEnableKEM, rcVersion} paddedMsgLen msg pqEnc_ supportedE2EVersion = do
+rcCheckCanPad :: Int -> ByteString -> ExceptT CryptoError IO ()
+rcCheckCanPad paddedMsgLen msg =
+  unless (canPad (B.length msg) paddedMsgLen) $ throwE CryptoLargeMsgError
+
+rcEncryptHeader :: AlgorithmI a => Ratchet a -> Maybe PQEncryption -> VersionE2E -> ExceptT CryptoError IO (MsgEncryptKey a, Ratchet a)
+rcEncryptHeader Ratchet {rcSnd = Nothing} _ _ = throwE CERatchetState
+rcEncryptHeader rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, rcKEM, rcNs, rcPN, rcAD = Str rcAD, rcSupportKEM, rcEnableKEM, rcVersion} pqEnc_ supportedE2EVersion = do
  -- state.CKs, mk = KDF_CK(state.CKs)
  let (ck', mk, iv, ehIV) = chainKdf rcCKs
      v = current rcVersion
@@ -858,11 +872,15 @@ rcEncrypt rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, rcKEM,
      rcVersion' = rcVersion {maxSupported = maxSupported'}
  -- enc_header = HENCRYPT(state.HKs, header)
  (ehAuthTag, ehBody) <- encryptAEAD rcHKs ehIV (paddedHeaderLen v rcSupportKEM') rcAD (msgHeader v maxSupported')
-  -- return enc_header, ENCRYPT(mk, plaintext, CONCAT(AD, enc_header))
+  -- return enc_header
  let emHeader = smpEncode EncMessageHeader {ehVersion = v, ehBody, ehAuthTag, ehIV}
-  (emAuthTag, emBody) <- encryptAEAD mk iv paddedMsgLen (rcAD <> emHeader) msg
-  let msg' = encodeEncRatchetMessage v EncRatchetMessage {emHeader, emBody, emAuthTag}
-      -- state.Ns += 1
+      msgEncryptKey =
+        MsgEncryptKey
+          { msgRcVersion = v,
+            msgKey = MessageKey mk iv,
+            msgRcAD = rcAD,
+            msgEncHeader = emHeader
+          }
      rc' =
        rc
          { rcSnd = Just sr {rcCKs = ck'},
@@ -872,7 +890,7 @@ rcEncrypt rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, rcKEM,
            rcVersion = rcVersion',
            rcKEM = if pqEnc_ == Just PQEncOff then (\rck -> rck {rcKEMs = Nothing}) <$> rcKEM else rcKEM
          }
-  pure (msg', rc')
+  pure (msgEncryptKey, rc')
  where
    -- header = HEADER_PQ2(
    --   dh = state.DHRs.public,
@@ -895,6 +913,23 @@ rcEncrypt rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, rcKEM,
      Nothing -> ARKP SRKSProposed $ RKParamsProposed k
      Just RatchetKEMAccepted {rcPQRct} -> ARKP SRKSAccepted $ RKParamsAccepted rcPQRct k

+type MsgEncryptKeyX448 = MsgEncryptKey 'X448
+
+data MsgEncryptKey a = MsgEncryptKey
+  { msgRcVersion :: VersionE2E,
+    msgKey :: MessageKey,
+    msgRcAD :: ByteString,
+    msgEncHeader :: ByteString
+  }
+  deriving (Show)
+
+rcEncryptMsg :: AlgorithmI a => MsgEncryptKey a -> Int -> ByteString -> ExceptT CryptoError IO ByteString
+rcEncryptMsg MsgEncryptKey {msgKey = MessageKey mk iv, msgRcAD, msgEncHeader, msgRcVersion = v} paddedMsgLen msg = do
+  -- return ENCRYPT(mk, plaintext, CONCAT(AD, enc_header))
+  (emAuthTag, emBody) <- encryptAEAD mk iv paddedMsgLen (msgRcAD <> msgEncHeader) msg
+  let msg' = encodeEncRatchetMessage v EncRatchetMessage {emHeader = msgEncHeader, emBody, emAuthTag}
+  pure msg'
+
 data SkippedMessage a
  = SMMessage (DecryptResult a)
  | SMHeader (Maybe RatchetStep) (MsgHeader a)
@@ -1120,14 +1155,35 @@ instance AlgorithmI a => ToJSON (Ratchet a) where
 instance AlgorithmI a => FromJSON (Ratchet a) where
  parseJSON = $(JQ.mkParseJSON defaultJSON ''Ratchet)

-instance AlgorithmI a => ToField (Ratchet a) where toField = toField . LB.toStrict . J.encode
+instance AlgorithmI a => ToField (Ratchet a) where toField = toField . Binary . LB.toStrict . J.encode

 instance (AlgorithmI a, Typeable a) => FromField (Ratchet a) where fromField = blobFieldDecoder J.eitherDecodeStrict'

-instance ToField PQEncryption where toField (PQEncryption pqEnc) = toField pqEnc
+instance ToField PQEncryption where toField (PQEncryption pqEnc) = toField (BI pqEnc)

-instance FromField PQEncryption where fromField f = PQEncryption <$> fromField f
+instance FromField PQEncryption where 
+#if defined(dbPostgres)
+  fromField f dat = PQEncryption . unBI <$> fromField f dat
+#else
+  fromField f = PQEncryption . unBI <$> fromField f
+#endif

-instance ToField PQSupport where toField (PQSupport pqEnc) = toField pqEnc
+instance ToField PQSupport where toField (PQSupport pqEnc) = toField (BI pqEnc)

-instance FromField PQSupport where fromField f = PQSupport <$> fromField f
+instance FromField PQSupport where
+#if defined(dbPostgres)
+  fromField f dat = PQSupport . unBI <$> fromField f dat
+#else
+  fromField f = PQSupport . unBI <$> fromField f
+#endif
+
+instance Encoding (MsgEncryptKey a) where
+  smpEncode MsgEncryptKey {msgRcVersion = v, msgKey, msgRcAD, msgEncHeader} =
+    smpEncode (v, msgRcAD, msgKey, Large msgEncHeader)
+  smpP = do
+    (v, msgRcAD, msgKey, Large msgEncHeader) <- smpP
+    pure MsgEncryptKey {msgRcVersion = v, msgRcAD, msgKey, msgEncHeader}
+
+instance AlgorithmI a => ToField (MsgEncryptKey a) where toField = toField . Binary . smpEncode
+
+instance (AlgorithmI a, Typeable a) => FromField (MsgEncryptKey a) where fromField = blobFieldParser smpP
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeApplications #-}

 module Simplex.Messaging.Crypto.SNTRUP761.Bindings where
@@ -9,9 +10,8 @@ import Data.Bifunctor (bimap)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
-import Database.SQLite.Simple.FromField
-import Database.SQLite.Simple.ToField
 import Foreign (nullPtr)
+import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (withDRG)
@@ -121,7 +121,11 @@ instance ToField KEMSharedKey where
  toField (KEMSharedKey k) = toField (BA.convert k :: ByteString)

 instance FromField KEMSharedKey where
+#if defined(dbPostgres)
+  fromField f dat = KEMSharedKey . BA.convert @ByteString <$> fromField f dat
+#else
  fromField f = KEMSharedKey . BA.convert @ByteString <$> fromField f
+#endif

 instance ToJSON KEMSharedKey where
  toJSON = strToJSON
@@ -11,7 +11,7 @@

 module Simplex.Messaging.Notifications.Protocol where

-import Control.Applicative ((<|>))
+import Control.Applicative (optional, (<|>))
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
@@ -27,13 +27,12 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock.System
 import Data.Type.Equality
 import Data.Word (Word16)
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts)
+import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Transport (NTFVersion, ntfClientHandshake)
+import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake)
 import Simplex.Messaging.Parsers (fromTextField_)
 import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
 import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
@@ -297,12 +296,18 @@ data NtfResponse

 instance ProtocolEncoding NTFVersion ErrorType NtfResponse where
  type Tag NtfResponse = NtfResponseTag
-  encodeProtocol _v = \case
+  encodeProtocol v = \case
    NRTknId entId dhKey -> e (NRTknId_, ' ', entId, dhKey)
    NRSubId entId -> e (NRSubId_, ' ', entId)
    NROk -> e NROk_
    NRErr err -> e (NRErr_, ' ', err)
-    NRTkn stat -> e (NRTkn_, ' ', stat)
+    NRTkn stat -> e (NRTkn_, ' ', stat')
+      where
+        stat'
+          | v >= invalidReasonNTFVersion = stat
+          | otherwise = case stat of
+              NTInvalid _ -> NTInvalid Nothing
+              _ -> stat
    NRSub stat -> e (NRSub_, ' ', stat)
    NRPong -> e NRPong_
    where
@@ -521,7 +526,7 @@ data NtfTknStatus
  | -- | state after registration (TNEW)
    NTRegistered
  | -- | if initial notification failed (push provider error) or verification failed
-    NTInvalid
+    NTInvalid (Maybe NTInvalidReason)
  | -- | Token confirmed via notification (accepted by push provider or verification code received by client)
    NTConfirmed
  | -- | after successful verification (TVFY)
@@ -534,7 +539,7 @@ instance Encoding NtfTknStatus where
  smpEncode = \case
    NTNew -> "NEW"
    NTRegistered -> "REGISTERED"
-    NTInvalid -> "INVALID"
+    NTInvalid r_ -> "INVALID" <> maybe "" (\r -> ',' `B.cons` strEncode r) r_
    NTConfirmed -> "CONFIRMED"
    NTActive -> "ACTIVE"
    NTExpired -> "EXPIRED"
@@ -542,12 +547,33 @@ instance Encoding NtfTknStatus where
    A.takeTill (== ' ') >>= \case
      "NEW" -> pure NTNew
      "REGISTERED" -> pure NTRegistered
-      "INVALID" -> pure NTInvalid
+      "INVALID" -> NTInvalid <$> optional (A.char ',' *> strP)
      "CONFIRMED" -> pure NTConfirmed
      "ACTIVE" -> pure NTActive
      "EXPIRED" -> pure NTExpired
      _ -> fail "bad NtfTknStatus"

+instance StrEncoding NTInvalidReason where
+  strEncode = smpEncode
+  strP = smpP
+
+data NTInvalidReason = NTIRBadToken | NTIRTokenNotForTopic | NTIRExpiredToken | NTIRUnregistered
+  deriving (Eq, Show)
+
+instance Encoding NTInvalidReason where
+  smpEncode = \case
+    NTIRBadToken -> "BAD"
+    NTIRTokenNotForTopic -> "TOPIC"
+    NTIRExpiredToken -> "EXPIRED"
+    NTIRUnregistered -> "UNREGISTERED"
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "BAD" -> pure NTIRBadToken
+      "TOPIC" -> pure NTIRTokenNotForTopic
+      "EXPIRED" -> pure NTIRExpiredToken
+      "UNREGISTERED" -> pure NTIRUnregistered
+      _ -> fail "bad NTInvalidReason"
+
 instance StrEncoding NtfTknStatus where
  strEncode = smpEncode
  strP = smpP
@@ -58,6 +58,7 @@ import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), ProtocolServer
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
 import Simplex.Messaging.Server.Control (CPClientRole (..))
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getSystemDate)
 import Simplex.Messaging.Server.Stats (PeriodStats (..), PeriodStatCounts (..), periodStatCounts, updatePeriodStats)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -135,7 +136,8 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
      initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
      logInfo $ "server stats log enabled: " <> T.pack statsFilePath
      liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs} <- asks serverStats
+      NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, tknReplaced, subCreated, subDeleted, ntfReceived, ntfDelivered, ntfFailed, ntfCronDelivered, ntfCronFailed, ntfVrfQueued, ntfVrfDelivered, ntfVrfFailed, ntfVrfInvalidTkn, activeTokens, activeSubs} <-
+        asks serverStats
      let interval = 1000000 * logInterval
      forever $ do
        withFile statsFilePath AppendMode $ \h -> liftIO $ do
@@ -145,10 +147,18 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
          tknCreated' <- atomicSwapIORef tknCreated 0
          tknVerified' <- atomicSwapIORef tknVerified 0
          tknDeleted' <- atomicSwapIORef tknDeleted 0
+          tknReplaced' <- atomicSwapIORef tknReplaced 0
          subCreated' <- atomicSwapIORef subCreated 0
          subDeleted' <- atomicSwapIORef subDeleted 0
          ntfReceived' <- atomicSwapIORef ntfReceived 0
          ntfDelivered' <- atomicSwapIORef ntfDelivered 0
+          ntfFailed' <- atomicSwapIORef ntfFailed 0
+          ntfCronDelivered' <- atomicSwapIORef ntfCronDelivered 0
+          ntfCronFailed' <- atomicSwapIORef ntfCronFailed 0
+          ntfVrfQueued' <- atomicSwapIORef ntfVrfQueued 0
+          ntfVrfDelivered' <- atomicSwapIORef ntfVrfDelivered 0
+          ntfVrfFailed' <- atomicSwapIORef ntfVrfFailed 0
+          ntfVrfInvalidTkn' <- atomicSwapIORef ntfVrfInvalidTkn 0
          tkn <- liftIO $ periodStatCounts activeTokens ts
          sub <- liftIO $ periodStatCounts activeSubs ts
          hPutStrLn h $
@@ -167,7 +177,15 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
                monthCount tkn,
                dayCount sub,
                weekCount sub,
-                monthCount sub
+                monthCount sub,
+                show tknReplaced',
+                show ntfFailed',
+                show ntfCronDelivered',
+                show ntfCronFailed',
+                show ntfVrfQueued',
+                show ntfVrfDelivered',
+                show ntfVrfFailed',
+                show ntfVrfInvalidTkn'
              ]
        liftIO $ threadDelay' interval

@@ -224,9 +242,18 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
                putStat "tknCreated" tknCreated
                putStat "tknVerified" tknVerified
                putStat "tknDeleted" tknDeleted
+                putStat "tknReplaced" tknReplaced
                putStat "subCreated" subCreated
                putStat "subDeleted" subDeleted
                putStat "ntfReceived" ntfReceived
+                putStat "ntfDelivered" ntfDelivered
+                putStat "ntfFailed" ntfFailed
+                putStat "ntfCronDelivered" ntfCronDelivered
+                putStat "ntfCronFailed" ntfCronFailed
+                putStat "ntfVrfQueued" ntfVrfQueued
+                putStat "ntfVrfDelivered" ntfVrfDelivered
+                putStat "ntfVrfFailed" ntfVrfFailed
+                putStat "ntfVrfInvalidTkn" ntfVrfInvalidTkn
                getStat (day . activeTokens) >>= \v -> hPutStrLn h $ "daily active tokens: " <> show (IS.size v)
                getStat (day . activeSubs) >>= \v -> hPutStrLn h $ "daily active subscriptions: " <> show (IS.size v)
              CPStatsRTS -> tryAny getRTSStats >>= either (hPrint h) (hPrint h)
@@ -241,15 +268,19 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
 #else
                  hPutStrLn h "Threads: not available on GHC 8.10"
 #endif
-                  NtfSubscriber {smpSubscribers, smpAgent = a} <- unliftIO u $ asks subscriber
+                  NtfEnv {subscriber, pushServer} <-  unliftIO u ask
+                  let NtfSubscriber {smpSubscribers, smpAgent = a} = subscriber
+                      NtfPushServer {pushQ} = pushServer
+                      SMPClientAgent {smpClients, smpSessions, srvSubs, pendingSrvSubs, smpSubWorkers} = a
                  putSMPWorkers a "SMP subcscribers" smpSubscribers
-                  let SMPClientAgent {smpClients, smpSessions, srvSubs, pendingSrvSubs, smpSubWorkers} = a
                  putSMPWorkers a "SMP clients" smpClients
                  putSMPWorkers a "SMP subscription workers" smpSubWorkers
                  sessions <- readTVarIO smpSessions
                  hPutStrLn h $ "SMP sessions count: " <> show (M.size sessions)
                  putSMPSubs a "SMP subscriptions" srvSubs
                  putSMPSubs a "Pending SMP subscriptions" pendingSrvSubs
+                  sz <- atomically $ lengthTBQueue pushQ
+                  hPutStrLn h $ "Push notifications queue length: " <> show sz
                  where
                    putSMPSubs :: SMPClientAgent -> String -> TMap SMPServer (TMap SMPSub a) -> IO ()
                    putSMPSubs a name v = do
@@ -431,35 +462,35 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge

 ntfPush :: NtfPushServer -> M ()
 ntfPush s@NtfPushServer {pushQ} = forever $ do
-  (tkn@NtfTknData {ntfTknId, token = DeviceToken pp _, tknStatus}, ntf) <- atomically (readTBQueue pushQ)
+  (tkn@NtfTknData {ntfTknId, token = t@(DeviceToken pp _), tknStatus}, ntf) <- atomically (readTBQueue pushQ)
  liftIO $ logDebug $ "sending push notification to " <> T.pack (show pp)
  status <- readTVarIO tknStatus
  case ntf of
-    PNVerification _
-      | status /= NTInvalid && status /= NTExpired ->
-          deliverNotification pp tkn ntf >>= \case
-            Right _ -> do
-              status_ <- atomically $ stateTVar tknStatus $ \case
-                NTActive -> (Nothing, NTActive)
-                NTConfirmed -> (Nothing, NTConfirmed)
-                _ -> (Just NTConfirmed, NTConfirmed)
-              forM_ status_ $ \status' -> withNtfLog $ \sl -> logTokenStatus sl ntfTknId status'
-            _ -> pure ()
-      | otherwise -> logError "bad notification token status"
+    PNVerification _ ->
+      deliverNotification pp tkn ntf >>= \case
+        Right _ -> do
+          status_ <- atomically $ stateTVar tknStatus $ \case
+            NTActive -> (Nothing, NTActive)
+            NTConfirmed -> (Nothing, NTConfirmed)
+            _ -> (Just NTConfirmed, NTConfirmed)
+          forM_ status_ $ \status' -> withNtfLog $ \sl -> logTokenStatus sl ntfTknId status'
+          incNtfStatT t ntfVrfDelivered
+        Left _ -> incNtfStatT t ntfVrfFailed
    PNCheckMessages -> checkActiveTkn status $ do
-      void $ deliverNotification pp tkn ntf
+      deliverNotification pp tkn ntf
+        >>= incNtfStatT t . (\case Left _ -> ntfCronFailed; Right () -> ntfCronDelivered)
    PNMessage {} -> checkActiveTkn status $ do
      stats <- asks serverStats
      liftIO $ updatePeriodStats (activeTokens stats) ntfTknId
-      void $ deliverNotification pp tkn ntf
-      incNtfStat ntfDelivered
+      deliverNotification pp tkn ntf
+        >>= incNtfStatT t . (\case Left _ -> ntfFailed; Right () -> ntfDelivered)
  where
    checkActiveTkn :: NtfTknStatus -> M () -> M ()
    checkActiveTkn status action
      | status == NTActive = action
      | otherwise = liftIO $ logError "bad notification token status"
    deliverNotification :: PushProvider -> NtfTknData -> PushNotification -> M (Either PushProviderError ())
-    deliverNotification pp tkn ntf = do
+    deliverNotification pp tkn@NtfTknData {ntfTknId} ntf = do
      deliver <- liftIO $ getPushClient s pp
      liftIO (runExceptT $ deliver tkn ntf) >>= \case
        Right _ -> pure $ Right ()
@@ -467,15 +498,19 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
          PPConnection _ -> retryDeliver
          PPRetryLater -> retryDeliver
          PPCryptoError _ -> err e
-          PPResponseError _ _ -> err e
-          PPTokenInvalid -> updateTknStatus tkn NTInvalid >> err e
+          PPResponseError {} -> err e
+          PPTokenInvalid r -> updateTknStatus tkn (NTInvalid $ Just r) >> err e
          PPPermanentError -> err e
      where
        retryDeliver :: M (Either PushProviderError ())
        retryDeliver = do
          deliver <- liftIO $ newPushClient s pp
-          liftIO (runExceptT $ deliver tkn ntf) >>= either err (pure . Right)
-        err e = logError (T.pack $ "Push provider error (" <> show pp <> "): " <> show e) $> Left e
+          liftIO (runExceptT $ deliver tkn ntf) >>= \case
+            Right _ -> pure $ Right ()
+            Left e -> case e of
+              PPTokenInvalid r -> updateTknStatus tkn (NTInvalid $ Just r) >> err e
+              _ -> err e
+        err e = logError ("Push provider error (" <> tshow pp <> ", " <> tshow ntfTknId <> "): " <> tshow e) $> Left e

 updateTknStatus :: NtfTknData -> NtfTknStatus -> M ()
 updateTknStatus NtfTknData {ntfTknId, tknStatus} status = do
@@ -509,13 +544,17 @@ receive th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ
  where
    cmdAction t@(_, _, (corrId, entId, cmdOrError)) =
      case cmdOrError of
-        Left e -> pure $ Left (corrId, entId, NRErr e)
+        Left e -> do
+          logError $ "invalid client request: " <> tshow e
+          pure $ Left (corrId, entId, NRErr e)
        Right cmd ->
-          verified <$> verifyNtfTransmission ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd
+          verified =<< verifyNtfTransmission ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd
          where
            verified = \case
-              VRVerified req -> Right req
-              VRFailed -> Left (corrId, entId, NRErr AUTH)
+              VRVerified req -> pure $ Right req
+              VRFailed -> do
+                logError "unauthorized client request"
+                pure $ Left (corrId, entId, NRErr AUTH)
    write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty

 send :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> IO ()
@@ -524,7 +563,7 @@ send h@THandle {params} NtfServerClient {sndQ, sndActiveAt} = forever $ do
  void . liftIO $ tPut h $ L.map (\t -> Right (Nothing, encodeTransmission params t)) ts
  atomically . (writeTVar sndActiveAt $!) =<< liftIO getSystemTime

-data VerificationResult = VRVerified NtfRequest | VRFailed
+data VerificationResult = VRVerified (Maybe NtfTknData, NtfRequest) | VRFailed

 verifyNtfTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> SignedTransmission ErrorType NtfCmd -> NtfCmd -> M VerificationResult
 verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
@@ -538,34 +577,34 @@ verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
            Just t@NtfTknData {tknVerifyKey}
              | k == tknVerifyKey -> verifiedTknCmd t c
              | otherwise -> VRFailed
-            _ -> VRVerified (NtfReqNew corrId (ANE SToken tkn))
+            Nothing -> VRVerified (Nothing, NtfReqNew corrId (ANE SToken tkn))
          else VRFailed
    NtfCmd SToken c -> do
-      t_ <- atomically $ getNtfToken st entId
+      t_ <- liftIO $ getNtfTokenIO st entId
      verifyToken t_ (`verifiedTknCmd` c)
    NtfCmd SSubscription c@(SNEW sub@(NewNtfSub tknId smpQueue _)) -> do
      s_ <- atomically $ findNtfSubscription st smpQueue
      case s_ of
        Nothing -> do
          t_ <- atomically $ getActiveNtfToken st tknId
-          verifyToken' t_ $ VRVerified (NtfReqNew corrId (ANE SSubscription sub))
+          verifyToken' t_ $ VRVerified (t_, NtfReqNew corrId (ANE SSubscription sub))
        Just s@NtfSubData {tokenId = subTknId} ->
          if subTknId == tknId
            then do
              t_ <- atomically $ getActiveNtfToken st subTknId
-              verifyToken' t_ $ verifiedSubCmd s c
+              verifyToken' t_ $ verifiedSubCmd t_ s c
            else pure $ maybe False (dummyVerifyCmd auth_ authorized) tAuth `seq` VRFailed
-    NtfCmd SSubscription PING -> pure $ VRVerified $ NtfReqPing corrId entId
+    NtfCmd SSubscription PING -> pure $ VRVerified (Nothing, NtfReqPing corrId entId)
    NtfCmd SSubscription c -> do
-      s_ <- atomically $ getNtfSubscription st entId
+      s_ <- liftIO $ getNtfSubscriptionIO st entId
      case s_ of
        Just s@NtfSubData {tokenId = subTknId} -> do
          t_ <- atomically $ getActiveNtfToken st subTknId
-          verifyToken' t_ $ verifiedSubCmd s c
+          verifyToken' t_ $ verifiedSubCmd t_ s c
        _ -> pure $ maybe False (dummyVerifyCmd auth_ authorized) tAuth `seq` VRFailed
  where
-    verifiedTknCmd t c = VRVerified (NtfReqCmd SToken (NtfTkn t) (corrId, entId, c))
-    verifiedSubCmd s c = VRVerified (NtfReqCmd SSubscription (NtfSub s) (corrId, entId, c))
+    verifiedTknCmd t c = VRVerified (Just t, NtfReqCmd SToken (NtfTkn t) (corrId, entId, c))
+    verifiedSubCmd t_ s c = VRVerified (t_, NtfReqCmd SSubscription (NtfSub s) (corrId, entId, c))
    verifyToken :: Maybe NtfTknData -> (NtfTknData -> VerificationResult) -> M VerificationResult
    verifyToken t_ positiveVerificationResult =
      pure $ case t_ of
@@ -579,11 +618,17 @@ verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do

 client :: NtfServerClient -> NtfSubscriber -> NtfPushServer -> M ()
 client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPushServer {pushQ, intervalNotifiers} =
-  forever $
+  forever $ do
+    ts <- liftIO getSystemDate
    atomically (readTBQueue rcvQ)
-      >>= mapM processCommand
+      >>= mapM (\(tkn_, req) -> updateTokenDate ts tkn_ >> processCommand req)
      >>= atomically . writeTBQueue sndQ
  where
+    updateTokenDate :: RoundedSystemTime -> Maybe NtfTknData -> M ()
+    updateTokenDate ts' = mapM_ $ \NtfTknData {ntfTknId, tknUpdatedAt} -> do
+      let t' = Just ts'
+      t <- atomically $ swapTVar tknUpdatedAt t'
+      unless (t' == t) $ withNtfLog $ \s -> logUpdateTokenTime s ntfTknId ts'
    processCommand :: NtfRequest -> M (Transmission NtfResponse)
    processCommand = \case
      NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn token _ dhPubKey)) -> do
@@ -593,9 +638,11 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
        let dhSecret = C.dh' dhPubKey srvDhPrivKey
        tknId <- getId
        regCode <- getRegCode
-        tkn <- atomically $ mkNtfTknData tknId newTkn ks dhSecret regCode
+        ts <- liftIO $ getSystemDate
+        tkn <- liftIO $ mkNtfTknData tknId newTkn ks dhSecret regCode ts
        atomically $ addNtfToken st tknId tkn
        atomically $ writeTBQueue pushQ (tkn, PNVerification regCode)
+        incNtfStatT token ntfVrfQueued
        withNtfLog (`logCreateToken` tkn)
        incNtfStatT token tknCreated
        pure (corrId, NoEntity, NRTknId tknId srvDhPubKey)
@@ -609,6 +656,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
            if tknDhSecret == dhSecret
              then do
                atomically $ writeTBQueue pushQ (tkn, PNVerification tknRegCode)
+                incNtfStatT token ntfVrfQueued
                pure $ NRTknId ntfTknId srvDhPubKey
              else pure $ NRErr AUTH
          TVFY code -- this allows repeated verification for cases when client connection dropped before server response
@@ -636,9 +684,9 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
              let tkn' = tkn {token = token', tknRegCode = regCode}
              addNtfToken st tknId tkn'
              writeTBQueue pushQ (tkn', PNVerification regCode)
+            incNtfStatT token ntfVrfQueued
            withNtfLog $ \s -> logUpdateToken s tknId token' regCode
-            incNtfStatT token tknDeleted
-            incNtfStatT token tknCreated
+            incNtfStatT token tknReplaced
            pure NROk
          TDEL -> do
            logDebug "TDEL"
@@ -159,7 +159,7 @@ data NtfRequest
  | NtfReqPing CorrId NtfEntityId

 data NtfServerClient = NtfServerClient
-  { rcvQ :: TBQueue (NonEmpty NtfRequest),
+  { rcvQ :: TBQueue (NonEmpty (Maybe NtfTknData, NtfRequest)),
    sndQ :: TBQueue (NonEmpty (Transmission NtfResponse)),
    ntfThParams :: THandleParams NTFVersion 'TServer,
    connected :: TVar Bool,
@@ -154,7 +154,7 @@ ntfServerCLI cfgPath logPath =
              regCodeBytes = 32,
              clientQSize = 64,
              subQSize = 512,
-              pushQSize = 1048,
+              pushQSize = 16384,
              smpAgentCfg =
                defaultSMPClientAgentConfig
                  { smpCfg =
@@ -308,7 +308,7 @@ data PushProviderError
  = PPConnection HTTP2ClientError
  | PPCryptoError C.CryptoError
  | PPResponseError (Maybe Status) Text
-  | PPTokenInvalid
+  | PPTokenInvalid NTInvalidReason
  | PPRetryLater
  | PPPermanentError
  deriving (Show, Exception)
@@ -337,19 +337,20 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {toke
    result status reason'
      | status == Just N.ok200 = pure ()
      | status == Just N.badRequest400 =
-          case reason' of
-            "BadDeviceToken" -> throwE PPTokenInvalid
-            "DeviceTokenNotForTopic" -> throwE PPTokenInvalid
-            "TopicDisallowed" -> throwE PPPermanentError
-            _ -> err status reason'
-      | status == Just N.forbidden403 = case reason' of
-          "ExpiredProviderToken" -> throwE PPPermanentError -- there should be no point retrying it as the token was refreshed
-          "InvalidProviderToken" -> throwE PPPermanentError
-          _ -> err status reason'
-      | status == Just N.gone410 = throwE PPTokenInvalid
+          throwE $ case reason' of
+            "BadDeviceToken" -> PPTokenInvalid NTIRBadToken
+            "DeviceTokenNotForTopic" -> PPTokenInvalid NTIRTokenNotForTopic
+            "TopicDisallowed" -> PPPermanentError
+            _ -> PPResponseError status reason'
+      | status == Just N.forbidden403 = throwE $ case reason' of
+          "ExpiredProviderToken" -> PPPermanentError -- there should be no point retrying it as the token was refreshed
+          "InvalidProviderToken" -> PPPermanentError
+          _ -> PPResponseError status reason'
+      | status == Just N.gone410 = throwE $ case reason' of
+          "ExpiredToken" -> PPTokenInvalid NTIRExpiredToken
+          "Unregistered" -> PPTokenInvalid NTIRUnregistered
+          _ -> PPRetryLater
      | status == Just N.serviceUnavailable503 = liftIO (disconnectApnsHTTP2Client c) >> throwE PPRetryLater
      -- Just tooManyRequests429 -> TooManyRequests - too many requests for the same token
-      | otherwise = err status reason'
-    err :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
-    err s r = throwE $ PPResponseError s r
+      | otherwise = throwE $ PPResponseError status reason'
    liftHTTPS2 a = ExceptT $ first PPConnection <$> a
@@ -4,7 +4,7 @@

 module Simplex.Messaging.Notifications.Server.Stats where

-import Control.Applicative (optional)
+import Control.Applicative (optional, (<|>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Data.IORef
@@ -17,10 +17,18 @@ data NtfServerStats = NtfServerStats
    tknCreated :: IORef Int,
    tknVerified :: IORef Int,
    tknDeleted :: IORef Int,
+    tknReplaced :: IORef Int,
    subCreated :: IORef Int,
    subDeleted :: IORef Int,
    ntfReceived :: IORef Int,
    ntfDelivered :: IORef Int,
+    ntfFailed :: IORef Int,
+    ntfCronDelivered :: IORef Int,
+    ntfCronFailed :: IORef Int,
+    ntfVrfQueued :: IORef Int,
+    ntfVrfDelivered :: IORef Int,
+    ntfVrfFailed :: IORef Int,
+    ntfVrfInvalidTkn :: IORef Int,
    activeTokens :: PeriodStats,
    activeSubs :: PeriodStats
  }
@@ -30,10 +38,18 @@ data NtfServerStatsData = NtfServerStatsData
    _tknCreated :: Int,
    _tknVerified :: Int,
    _tknDeleted :: Int,
+    _tknReplaced :: Int,
    _subCreated :: Int,
    _subDeleted :: Int,
    _ntfReceived :: Int,
    _ntfDelivered :: Int,
+    _ntfFailed :: Int,
+    _ntfCronDelivered :: Int,
+    _ntfCronFailed :: Int,
+    _ntfVrfQueued :: Int,
+    _ntfVrfDelivered :: Int,
+    _ntfVrfFailed :: Int,
+    _ntfVrfInvalidTkn :: Int,
    _activeTokens :: PeriodStatsData,
    _activeSubs :: PeriodStatsData
  }
@@ -44,13 +60,41 @@ newNtfServerStats ts = do
  tknCreated <- newIORef 0
  tknVerified <- newIORef 0
  tknDeleted <- newIORef 0
+  tknReplaced <- newIORef 0
  subCreated <- newIORef 0
  subDeleted <- newIORef 0
  ntfReceived <- newIORef 0
  ntfDelivered <- newIORef 0
+  ntfFailed <- newIORef 0
+  ntfCronDelivered <- newIORef 0
+  ntfCronFailed <- newIORef 0
+  ntfVrfQueued <- newIORef 0
+  ntfVrfDelivered <- newIORef 0
+  ntfVrfFailed <- newIORef 0
+  ntfVrfInvalidTkn <- newIORef 0
  activeTokens <- newPeriodStats
  activeSubs <- newPeriodStats
-  pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}
+  pure
+    NtfServerStats
+      { fromTime,
+        tknCreated,
+        tknVerified,
+        tknDeleted,
+        tknReplaced,
+        subCreated,
+        subDeleted,
+        ntfReceived,
+        ntfDelivered,
+        ntfFailed,
+        ntfCronDelivered,
+        ntfCronFailed,
+        ntfVrfQueued,
+        ntfVrfDelivered,
+        ntfVrfFailed,
+        ntfVrfInvalidTkn,
+        activeTokens,
+        activeSubs
+      }

 getNtfServerStatsData :: NtfServerStats -> IO NtfServerStatsData
 getNtfServerStatsData s@NtfServerStats {fromTime} = do
@@ -58,13 +102,41 @@ getNtfServerStatsData s@NtfServerStats {fromTime} = do
  _tknCreated <- readIORef $ tknCreated s
  _tknVerified <- readIORef $ tknVerified s
  _tknDeleted <- readIORef $ tknDeleted s
+  _tknReplaced <- readIORef $ tknReplaced s
  _subCreated <- readIORef $ subCreated s
  _subDeleted <- readIORef $ subDeleted s
  _ntfReceived <- readIORef $ ntfReceived s
  _ntfDelivered <- readIORef $ ntfDelivered s
+  _ntfFailed <- readIORef $ ntfFailed s
+  _ntfCronDelivered <- readIORef $ ntfCronDelivered s
+  _ntfCronFailed <- readIORef $ ntfCronFailed s
+  _ntfVrfQueued <- readIORef $ ntfVrfQueued s
+  _ntfVrfDelivered <- readIORef $ ntfVrfDelivered s
+  _ntfVrfFailed <- readIORef $ ntfVrfFailed s
+  _ntfVrfInvalidTkn <- readIORef $ ntfVrfInvalidTkn s
  _activeTokens <- getPeriodStatsData $ activeTokens s
  _activeSubs <- getPeriodStatsData $ activeSubs s
-  pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
+  pure
+    NtfServerStatsData
+      { _fromTime,
+        _tknCreated,
+        _tknVerified,
+        _tknDeleted,
+        _tknReplaced,
+        _subCreated,
+        _subDeleted,
+        _ntfReceived,
+        _ntfDelivered,
+        _ntfFailed,
+        _ntfCronDelivered,
+        _ntfCronFailed,
+        _ntfVrfQueued,
+        _ntfVrfDelivered,
+        _ntfVrfFailed,
+        _ntfVrfInvalidTkn,
+        _activeTokens,
+        _activeSubs
+      }

 -- this function is not thread safe, it is used on server start only
 setNtfServerStats :: NtfServerStats -> NtfServerStatsData -> IO ()
@@ -73,24 +145,60 @@ setNtfServerStats s@NtfServerStats {fromTime} d@NtfServerStatsData {_fromTime} =
  writeIORef (tknCreated s) $! _tknCreated d
  writeIORef (tknVerified s) $! _tknVerified d
  writeIORef (tknDeleted s) $! _tknDeleted d
+  writeIORef (tknReplaced s) $! _tknReplaced d
  writeIORef (subCreated s) $! _subCreated d
  writeIORef (subDeleted s) $! _subDeleted d
  writeIORef (ntfReceived s) $! _ntfReceived d
  writeIORef (ntfDelivered s) $! _ntfDelivered d
+  writeIORef (ntfFailed s) $! _ntfFailed d
+  writeIORef (ntfCronDelivered s) $! _ntfCronDelivered d
+  writeIORef (ntfCronFailed s) $! _ntfCronFailed d
+  writeIORef (ntfVrfQueued s) $! _ntfVrfQueued d
+  writeIORef (ntfVrfDelivered s) $! _ntfVrfDelivered d
+  writeIORef (ntfVrfFailed s) $! _ntfVrfFailed d
+  writeIORef (ntfVrfInvalidTkn s) $! _ntfVrfInvalidTkn d
  setPeriodStats (activeTokens s) (_activeTokens d)
  setPeriodStats (activeSubs s) (_activeSubs d)

 instance StrEncoding NtfServerStatsData where
-  strEncode NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs} =
+  strEncode
+    NtfServerStatsData
+      { _fromTime,
+        _tknCreated,
+        _tknVerified,
+        _tknDeleted,
+        _tknReplaced,
+        _subCreated,
+        _subDeleted,
+        _ntfReceived,
+        _ntfDelivered,
+        _ntfFailed,
+        _ntfCronDelivered,
+        _ntfCronFailed,
+        _ntfVrfQueued,
+        _ntfVrfDelivered,
+        _ntfVrfFailed,
+        _ntfVrfInvalidTkn,
+        _activeTokens,
+        _activeSubs
+      } =
    B.unlines
      [ "fromTime=" <> strEncode _fromTime,
        "tknCreated=" <> strEncode _tknCreated,
        "tknVerified=" <> strEncode _tknVerified,
        "tknDeleted=" <> strEncode _tknDeleted,
+        "tknReplaced=" <> strEncode _tknReplaced,
        "subCreated=" <> strEncode _subCreated,
        "subDeleted=" <> strEncode _subDeleted,
        "ntfReceived=" <> strEncode _ntfReceived,
        "ntfDelivered=" <> strEncode _ntfDelivered,
+        "ntfFailed=" <> strEncode _ntfFailed,
+        "ntfCronDelivered=" <> strEncode _ntfCronDelivered,
+        "ntfCronFailed=" <> strEncode _ntfCronFailed,
+        "ntfVrfQueued=" <> strEncode _ntfVrfQueued,
+        "ntfVrfDelivered=" <> strEncode _ntfVrfDelivered,
+        "ntfVrfFailed=" <> strEncode _ntfVrfFailed,
+        "ntfVrfInvalidTkn=" <> strEncode _ntfVrfInvalidTkn,
        "activeTokens:",
        strEncode _activeTokens,
        "activeSubs:",
@@ -101,12 +209,42 @@ instance StrEncoding NtfServerStatsData where
    _tknCreated <- "tknCreated=" *> strP <* A.endOfLine
    _tknVerified <- "tknVerified=" *> strP <* A.endOfLine
    _tknDeleted <- "tknDeleted=" *> strP <* A.endOfLine
+    _tknReplaced <- opt "tknReplaced="
    _subCreated <- "subCreated=" *> strP <* A.endOfLine
    _subDeleted <- "subDeleted=" *> strP <* A.endOfLine
    _ntfReceived <- "ntfReceived=" *> strP <* A.endOfLine
    _ntfDelivered <- "ntfDelivered=" *> strP <* A.endOfLine
+    _ntfFailed <- opt "ntfFailed="
+    _ntfCronDelivered <- opt "ntfCronDelivered="
+    _ntfCronFailed <- opt "ntfCronFailed="
+    _ntfVrfQueued <- opt "ntfVrfQueued="
+    _ntfVrfDelivered <- opt "ntfVrfDelivered="
+    _ntfVrfFailed <- opt "ntfVrfFailed="
+    _ntfVrfInvalidTkn <- opt "ntfVrfInvalidTkn="
    _ <- "activeTokens:" <* A.endOfLine
    _activeTokens <- strP <* A.endOfLine
    _ <- "activeSubs:" <* A.endOfLine
    _activeSubs <- strP <* optional A.endOfLine
-    pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
+    pure
+      NtfServerStatsData
+        { _fromTime,
+          _tknCreated,
+          _tknVerified,
+          _tknDeleted,
+          _tknReplaced,
+          _subCreated,
+          _subDeleted,
+          _ntfReceived,
+          _ntfDelivered,
+          _ntfFailed,
+          _ntfCronDelivered,
+          _ntfCronFailed,
+          _ntfVrfQueued,
+          _ntfVrfDelivered,
+          _ntfVrfFailed,
+          _ntfVrfInvalidTkn,
+          _activeTokens,
+          _activeSubs
+        }
+    where
+      opt s = A.string s *> strP <* A.endOfLine <|> pure 0
@@ -25,6 +25,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Protocol (NtfPrivateAuthKey, NtfPublicAuthKey, SMPServer)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (whenM, ($>>=))
@@ -57,14 +58,16 @@ data NtfTknData = NtfTknData
    tknDhKeys :: C.KeyPair 'C.X25519,
    tknDhSecret :: C.DhSecretX25519,
    tknRegCode :: NtfRegCode,
-    tknCronInterval :: TVar Word16
+    tknCronInterval :: TVar Word16,
+    tknUpdatedAt :: TVar (Maybe RoundedSystemTime)
  }

-mkNtfTknData :: NtfTokenId -> NewNtfEntity 'Token -> C.KeyPair 'C.X25519 -> C.DhSecretX25519 -> NtfRegCode -> STM NtfTknData
-mkNtfTknData ntfTknId (NewNtfTkn token tknVerifyKey _) tknDhKeys tknDhSecret tknRegCode = do
-  tknStatus <- newTVar NTRegistered
-  tknCronInterval <- newTVar 0
-  pure NtfTknData {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval}
+mkNtfTknData :: NtfTokenId -> NewNtfEntity 'Token -> C.KeyPair 'C.X25519 -> C.DhSecretX25519 -> NtfRegCode -> RoundedSystemTime -> IO NtfTknData
+mkNtfTknData ntfTknId (NewNtfTkn token tknVerifyKey _) tknDhKeys tknDhSecret tknRegCode ts = do
+  tknStatus <- newTVarIO NTRegistered
+  tknCronInterval <- newTVarIO 0
+  tknUpdatedAt <- newTVarIO $ Just ts
+  pure NtfTknData {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}

 data NtfSubData = NtfSubData
  { ntfSubId :: NtfSubscriptionId,
@@ -156,9 +159,8 @@ deleteTokenSubs st tknId = do
        $>>= \NtfSubData {smpQueue} ->
          TM.delete smpQueue (subscriptionLookup st) $> Just smpQueue

-getNtfSubscription :: NtfStore -> NtfSubscriptionId -> STM (Maybe NtfSubData)
-getNtfSubscription st subId =
-  TM.lookup subId (subscriptions st)
+getNtfSubscriptionIO :: NtfStore -> NtfSubscriptionId -> IO (Maybe NtfSubData)
+getNtfSubscriptionIO st subId = TM.lookupIO subId (subscriptions st)

 findNtfSubscription :: NtfStore -> SMPQueueNtf -> STM (Maybe NtfSubData)
 findNtfSubscription st smpQueue = do
@@ -16,6 +16,7 @@ module Simplex.Messaging.Notifications.Server.StoreLog
    logUpdateToken,
    logTokenCron,
    logDeleteToken,
+    logUpdateTokenTime,
    logCreateSubscription,
    logSubscriptionStatus,
    logDeleteSubscription,
@@ -23,6 +24,7 @@ module Simplex.Messaging.Notifications.Server.StoreLog
  )
 where

+import Control.Applicative (optional)
 import Control.Concurrent.STM
 import Control.Logger.Simple
 import Control.Monad
@@ -36,6 +38,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Protocol (NtfPrivateAuthKey)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Util (safeDecodeUtf8)
 import System.IO
@@ -46,6 +49,7 @@ data NtfStoreLogRecord
  | UpdateToken NtfTokenId DeviceToken NtfRegCode
  | TokenCron NtfTokenId Word16
  | DeleteToken NtfTokenId
+  | UpdateTokenTime NtfTokenId RoundedSystemTime
  | CreateSubscription NtfSubRec
  | SubscriptionStatus NtfSubscriptionId NtfSubStatus
  | DeleteSubscription NtfSubscriptionId
@@ -59,21 +63,24 @@ data NtfTknRec = NtfTknRec
    tknDhKeys :: C.KeyPair 'C.X25519,
    tknDhSecret :: C.DhSecretX25519,
    tknRegCode :: NtfRegCode,
-    tknCronInterval :: Word16
+    tknCronInterval :: Word16,
+    tknUpdatedAt :: Maybe RoundedSystemTime
  }
  deriving (Show)

-mkTknData :: NtfTknRec -> STM NtfTknData
-mkTknData NtfTknRec {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval = cronInt} = do
-  tknStatus <- newTVar status
-  tknCronInterval <- newTVar cronInt
-  pure NtfTknData {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval}
+mkTknData :: NtfTknRec -> IO NtfTknData
+mkTknData NtfTknRec {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval = cronInt, tknUpdatedAt = updatedAt} = do
+  tknStatus <- newTVarIO status
+  tknCronInterval <- newTVarIO cronInt
+  tknUpdatedAt <- newTVarIO updatedAt
+  pure NtfTknData {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}

-mkTknRec :: NtfTknData -> STM NtfTknRec
-mkTknRec NtfTknData {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval = cronInt} = do
-  tknStatus <- readTVar status
-  tknCronInterval <- readTVar cronInt
-  pure NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval}
+mkTknRec :: NtfTknData -> IO NtfTknRec
+mkTknRec NtfTknData {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval = cronInt, tknUpdatedAt = updatedAt} = do
+  tknStatus <- readTVarIO status
+  tknCronInterval <- readTVarIO cronInt
+  tknUpdatedAt <- readTVarIO updatedAt
+  pure NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}

 data NtfSubRec = NtfSubRec
  { ntfSubId :: NtfSubscriptionId,
@@ -84,9 +91,9 @@ data NtfSubRec = NtfSubRec
  }
  deriving (Show)

-mkSubData :: NtfSubRec -> STM NtfSubData
+mkSubData :: NtfSubRec -> IO NtfSubData
 mkSubData NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus = status} = do
-  subStatus <- newTVar status
+  subStatus <- newTVarIO status
  pure NtfSubData {ntfSubId, smpQueue, notifierKey, tokenId, subStatus}

 mkSubRec :: NtfSubData -> STM NtfSubRec
@@ -101,6 +108,7 @@ instance StrEncoding NtfStoreLogRecord where
    UpdateToken tknId token regCode -> strEncode (Str "TUPDATE", tknId, token, regCode)
    TokenCron tknId cronInt -> strEncode (Str "TCRON", tknId, cronInt)
    DeleteToken tknId -> strEncode (Str "TDELETE", tknId)
+    UpdateTokenTime tknId ts -> strEncode (Str "TTIME", tknId, ts)
    CreateSubscription subRec -> strEncode (Str "SCREATE", subRec)
    SubscriptionStatus subId subStatus -> strEncode (Str "SSTATUS", subId, subStatus)
    DeleteSubscription subId -> strEncode (Str "SDELETE", subId)
@@ -111,13 +119,14 @@ instance StrEncoding NtfStoreLogRecord where
        "TUPDATE " *> (UpdateToken <$> strP_ <*> strP_ <*> strP),
        "TCRON " *> (TokenCron <$> strP_ <*> strP),
        "TDELETE " *> (DeleteToken <$> strP),
+        "TTIME " *> (UpdateTokenTime <$> strP_ <*> strP),
        "SCREATE " *> (CreateSubscription <$> strP),
        "SSTATUS " *> (SubscriptionStatus <$> strP_ <*> strP),
        "SDELETE " *> (DeleteSubscription <$> strP)
      ]

 instance StrEncoding NtfTknRec where
-  strEncode NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval} =
+  strEncode NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt} =
    B.unwords
      [ "tknId=" <> strEncode ntfTknId,
        "token=" <> strEncode token,
@@ -128,6 +137,9 @@ instance StrEncoding NtfTknRec where
        "regCode=" <> strEncode tknRegCode,
        "cron=" <> strEncode tknCronInterval
      ]
+      <> maybe "" updatedAtStr tknUpdatedAt
+    where
+      updatedAtStr t = " updatedAt=" <> strEncode t
  strP = do
    ntfTknId <- "tknId=" *> strP_
    token <- "token=" *> strP_
@@ -137,7 +149,8 @@ instance StrEncoding NtfTknRec where
    tknDhSecret <- "dhSecret=" *> strP_
    tknRegCode <- "regCode=" *> strP_
    tknCronInterval <- "cron=" *> strP
-    pure NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval}
+    tknUpdatedAt <- optional $ " updatedAt=" *> strP
+    pure NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}

 instance StrEncoding NtfSubRec where
  strEncode NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus} =
@@ -161,7 +174,7 @@ logNtfStoreRecord = writeStoreLogRecord
 {-# INLINE logNtfStoreRecord #-}

 logCreateToken :: StoreLog 'WriteMode -> NtfTknData -> IO ()
-logCreateToken s tkn = logNtfStoreRecord s . CreateToken =<< atomically (mkTknRec tkn)
+logCreateToken s tkn = logNtfStoreRecord s . CreateToken =<< mkTknRec tkn

 logTokenStatus :: StoreLog 'WriteMode -> NtfTokenId -> NtfTknStatus -> IO ()
 logTokenStatus s tknId tknStatus = logNtfStoreRecord s $ TokenStatus tknId tknStatus
@@ -175,6 +188,9 @@ logTokenCron s tknId cronInt = logNtfStoreRecord s $ TokenCron tknId cronInt
 logDeleteToken :: StoreLog 'WriteMode -> NtfTokenId -> IO ()
 logDeleteToken s tknId = logNtfStoreRecord s $ DeleteToken tknId

+logUpdateTokenTime :: StoreLog 'WriteMode -> NtfTokenId -> RoundedSystemTime -> IO ()
+logUpdateTokenTime s tknId t = logNtfStoreRecord s $ UpdateTokenTime tknId t
+
 logCreateSubscription :: StoreLog 'WriteMode -> NtfSubData -> IO ()
 logCreateSubscription s sub = logNtfStoreRecord s . CreateSubscription =<< atomically (mkSubRec sub)

@@ -192,36 +208,39 @@ readNtfStore f st = mapM_ (addNtfLogRecord . LB.toStrict) . LB.lines =<< LB.read
  where
    addNtfLogRecord s = case strDecode s of
      Left e -> logError $ "Log parsing error (" <> T.pack e <> "): " <> safeDecodeUtf8 (B.take 100 s)
-      Right lr -> atomically $ case lr of
+      Right lr -> case lr of
        CreateToken r@NtfTknRec {ntfTknId} -> do
          tkn <- mkTknData r
-          addNtfToken st ntfTknId tkn
+          atomically $ addNtfToken st ntfTknId tkn
        TokenStatus tknId status -> do
-          tkn_ <- getNtfToken st tknId
+          tkn_ <- getNtfTokenIO st tknId
          forM_ tkn_ $ \tkn@NtfTknData {tknStatus} -> do
-            writeTVar tknStatus status
-            when (status == NTActive) $ void $ removeInactiveTokenRegistrations st tkn
-        UpdateToken tknId token' tknRegCode ->
-          getNtfToken st tknId
+            atomically $ writeTVar tknStatus status
+            when (status == NTActive) $ void $ atomically $ removeInactiveTokenRegistrations st tkn
+        UpdateToken tknId token' tknRegCode -> do
+          getNtfTokenIO st tknId
            >>= mapM_
              ( \tkn@NtfTknData {tknStatus} -> do
-                  removeTokenRegistration st tkn
-                  writeTVar tknStatus NTRegistered
-                  addNtfToken st tknId tkn {token = token', tknRegCode}
+                  atomically $ removeTokenRegistration st tkn
+                  atomically $ writeTVar tknStatus NTRegistered
+                  atomically $ addNtfToken st tknId tkn {token = token', tknRegCode}
              )
        TokenCron tknId cronInt ->
-          getNtfToken st tknId
-            >>= mapM_ (\NtfTknData {tknCronInterval} -> writeTVar tknCronInterval cronInt)
+          getNtfTokenIO st tknId
+            >>= mapM_ (\NtfTknData {tknCronInterval} -> atomically $ writeTVar tknCronInterval cronInt)
        DeleteToken tknId ->
-          void $ deleteNtfToken st tknId
+          atomically $ void $ deleteNtfToken st tknId
+        UpdateTokenTime tknId t ->
+          getNtfTokenIO st tknId
+            >>= mapM_ (\NtfTknData {tknUpdatedAt} -> atomically $ writeTVar tknUpdatedAt $ Just t)
        CreateSubscription r@NtfSubRec {ntfSubId} -> do
          sub <- mkSubData r
-          void $ addNtfSubscription st ntfSubId sub
-        SubscriptionStatus subId status ->
-          getNtfSubscription st subId
-            >>= mapM_ (\NtfSubData {subStatus} -> writeTVar subStatus status)
+          void $ atomically $ addNtfSubscription st ntfSubId sub
+        SubscriptionStatus subId status -> do
+          getNtfSubscriptionIO st subId
+            >>= mapM_ (\NtfSubData {subStatus} -> atomically $ writeTVar subStatus status)
        DeleteSubscription subId ->
-          deleteNtfSubscription st subId
+          atomically $ deleteNtfSubscription st subId

 writeNtfStore :: StoreLog 'WriteMode -> NtfStore -> IO ()
 writeNtfStore s NtfStore {tokens, subscriptions} = do
@@ -44,11 +44,14 @@ initialNTFVersion = VersionNTF 1
 authBatchCmdsNTFVersion :: VersionNTF
 authBatchCmdsNTFVersion = VersionNTF 2

+invalidReasonNTFVersion :: VersionNTF
+invalidReasonNTFVersion = VersionNTF 3
+
 currentClientNTFVersion :: VersionNTF
-currentClientNTFVersion = VersionNTF 2
+currentClientNTFVersion = VersionNTF 3

 currentServerNTFVersion :: VersionNTF
-currentServerNTFVersion = VersionNTF 2
+currentServerNTFVersion = VersionNTF 3

 supportedClientNTFVRange :: VersionRangeNTF
 supportedClientNTFVRange = mkVersionRange initialNTFVersion currentClientNTFVersion
@@ -123,8 +126,8 @@ ntfServerHandshake serverSignKey c (k, pk) kh ntfVRange = do
            Nothing -> throwE TEVersion

 -- | Notifcations server client transport handshake.
-ntfClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRangeNTF -> ExceptT TransportError IO (THandleNTF c 'TClient)
-ntfClientHandshake c keyHash ntfVRange = do
+ntfClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRangeNTF -> Bool -> ExceptT TransportError IO (THandleNTF c 'TClient)
+ntfClientHandshake c keyHash ntfVRange _proxyServer = do
  let th@THandle {params = THandleParams {sessionId}} = ntfTHandle c
  NtfServerHandshake {sessionId = sessId, ntfVersionRange, authPubKey = sk'} <- getHandshake th
  if sessionId /= sessId
@@ -9,9 +9,8 @@ module Simplex.Messaging.Notifications.Types where
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (UTCTime)
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..), UserId)
+import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
@@ -41,7 +40,7 @@ instance Encoding NtfTknAction where

 instance FromField NtfTknAction where fromField = blobFieldDecoder smpDecode

-instance ToField NtfTknAction where toField = toField . smpEncode
+instance ToField NtfTknAction where toField = toField . Binary . smpEncode

 data NtfToken = NtfToken
  { deviceToken :: DeviceToken,
@@ -119,7 +118,7 @@ instance Encoding NtfSubNTFAction where

 instance FromField NtfSubNTFAction where fromField = blobFieldDecoder smpDecode

-instance ToField NtfSubNTFAction where toField = toField . smpEncode
+instance ToField NtfSubNTFAction where toField = toField . Binary . smpEncode

 data NtfSubSMPAction
  = NSASmpKey
@@ -138,7 +137,7 @@ instance Encoding NtfSubSMPAction where

 instance FromField NtfSubSMPAction where fromField = blobFieldDecoder smpDecode

-instance ToField NtfSubSMPAction where toField = toField . smpEncode
+instance ToField NtfSubSMPAction where toField = toField . Binary . smpEncode

 data NtfAgentSubStatus
  = -- | subscription started
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}

@@ -20,12 +21,19 @@ import qualified Data.Text as T
 import Data.Time.Clock (UTCTime)
 import Data.Time.ISO8601 (parseISO8601)
 import Data.Typeable (Typeable)
+import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
+import Text.Read (readMaybe)
+#if defined(dbPostgres)
+import Database.PostgreSQL.Simple (ResultError (..))
+import Database.PostgreSQL.Simple.FromField (FromField(..), FieldParser, returnError, Field (..))
+import Database.PostgreSQL.Simple.TypeInfo.Static (textOid, varcharOid)
+import qualified Data.Text.Encoding as TE
+#else
 import Database.SQLite.Simple (ResultError (..), SQLData (..))
 import Database.SQLite.Simple.FromField (FieldParser, returnError)
 import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
-import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
-import Text.Read (readMaybe)
+#endif

 base64P :: Parser ByteString
 base64P = decode <$?> paddedBase64 rawBase64P
@@ -70,6 +78,7 @@ parseRead2 = parseRead $ do

 wordEnd :: Char -> Bool
 wordEnd c = c == ' ' || c == '\n'
+{-# INLINE wordEnd #-}

 parseString :: (ByteString -> Either String a) -> (String -> a)
 parseString p = either error id . p . B.pack
@@ -77,6 +86,14 @@ parseString p = either error id . p . B.pack
 blobFieldParser :: Typeable k => Parser k -> FieldParser k
 blobFieldParser = blobFieldDecoder . parseAll

+#if defined(dbPostgres)
+blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> FieldParser k
+blobFieldDecoder dec f val = do
+  x <- fromField f val
+  case dec x of
+    Right k -> pure k
+    Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
+#else
 blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> FieldParser k
 blobFieldDecoder dec = \case
  f@(Field (SQLBlob b) _) ->
@@ -84,7 +101,20 @@ blobFieldDecoder dec = \case
      Right k -> Ok k
      Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
  f -> returnError ConversionFailed f "expecting SQLBlob column type"
+#endif

+-- TODO [postgres] review
+#if defined(dbPostgres)
+fromTextField_ :: Typeable a => (Text -> Maybe a) -> FieldParser a
+fromTextField_ fromText f val =
+  if typeOid f `elem` [textOid, varcharOid]
+    then case val of
+      Just t -> case fromText (TE.decodeUtf8 t) of
+        Just x -> pure x
+        _ -> returnError ConversionFailed f "invalid text value"
+      Nothing -> returnError UnexpectedNull f "NULL value found for non-NULL field"
+    else returnError Incompatible f "expecting TEXT or VARCHAR column type"
+#else
 fromTextField_ :: Typeable a => (Text -> Maybe a) -> Field -> Ok a
 fromTextField_ fromText = \case
  f@(Field (SQLText t) _) ->
@@ -92,6 +122,7 @@ fromTextField_ fromText = \case
      Just x -> Ok x
      _ -> returnError ConversionFailed f ("invalid text: " <> T.unpack t)
  f -> returnError ConversionFailed f "expecting SQLText column type"
+#endif

 fstToLower :: String -> String
 fstToLower "" = ""
@@ -70,6 +70,8 @@ module Simplex.Messaging.Protocol
    CommandError (..),
    ProxyError (..),
    BrokerErrorType (..),
+    BlockingInfo (..),
+    BlockingReason (..),
    Transmission,
    TransmissionAuth (..),
    SignedTransmission,
@@ -258,7 +260,7 @@ supportedSMPClientVRange = mkVersionRange initialSMPClientVersion currentSMPClie
 -- TODO v6.0 remove dependency on version
 maxMessageLength :: VersionSMP -> Int
 maxMessageLength v
-  | v >= encryptedBlockSMPVersion = 16048 -- max 16051
+  | v >= encryptedBlockSMPVersion = 16048 -- max 16048
  | v >= sendingProxySMPVersion = 16064 -- max 16067
  | otherwise = 16088 -- 16048 - always use this size to determine allowed ranges

@@ -1194,6 +1196,8 @@ data ErrorType
    PROXY {proxyErr :: ProxyError}
  | -- | command authorization error - bad signature or non-existing SMP queue
    AUTH
+  | -- | command with the entity that was blocked
+    BLOCKED {blockInfo :: BlockingInfo}
  | -- | encryption/decryption error in proxy protocol
    CRYPTO
  | -- | SMP queue capacity is exceeded on the server
@@ -1210,17 +1214,41 @@ data ErrorType
    INTERNAL
  | -- | used internally, never returned by the server (to be removed)
    DUPLICATE_ -- not part of SMP protocol, used internally
-  deriving (Eq, Read, Show)
+  deriving (Eq, Show)

 instance StrEncoding ErrorType where
  strEncode = \case
+    BLOCK -> "BLOCK"
+    SESSION -> "SESSION"
    CMD e -> "CMD " <> bshow e
    PROXY e -> "PROXY " <> strEncode e
-    e -> bshow e
+    AUTH -> "AUTH"
+    BLOCKED info -> "BLOCKED " <> strEncode info
+    CRYPTO -> "CRYPTO"
+    QUOTA -> "QUOTA"
+    STORE e -> "STORE " <> encodeUtf8 (T.pack e)
+    NO_MSG -> "NO_MSG"
+    LARGE_MSG -> "LARGE_MSG"
+    EXPIRED -> "EXPIRED"
+    INTERNAL -> "INTERNAL"
+    DUPLICATE_ -> "DUPLICATE_"
  strP =
-    "CMD " *> (CMD <$> parseRead1)
-      <|> "PROXY " *> (PROXY <$> strP)
-      <|> parseRead1
+    A.choice
+      [ "BLOCK" $> BLOCK,
+        "SESSION" $> SESSION,
+        "CMD " *> (CMD <$> parseRead1),
+        "PROXY " *> (PROXY <$> strP),
+        "AUTH" $> AUTH,
+        "BLOCKED " *> strP,
+        "CRYPTO" $> CRYPTO,
+        "QUOTA" $> QUOTA,
+        "STORE " *> (STORE . T.unpack . safeDecodeUtf8 <$> A.takeByteString),
+        "NO_MSG" $> NO_MSG,
+        "LARGE_MSG" $> LARGE_MSG,
+        "EXPIRED" $> EXPIRED,
+        "INTERNAL" $> INTERNAL,
+        "DUPLICATE_" $> DUPLICATE_
+      ]

 -- | SMP command error type.
 data CommandError
@@ -1248,7 +1276,7 @@ data ProxyError
    BASIC_AUTH
  | -- no destination server error
    NO_SESSION
-  deriving (Eq, Read, Show)
+  deriving (Eq, Show)

 -- | SMP server errors.
 data BrokerErrorType
@@ -1266,6 +1294,37 @@ data BrokerErrorType
    TIMEOUT
  deriving (Eq, Read, Show, Exception)

+data BlockingInfo = BlockingInfo
+  { reason :: BlockingReason
+  }
+  deriving (Eq, Show)
+
+data BlockingReason = BRSpam | BRContent
+  deriving (Eq, Show)
+
+instance StrEncoding BlockingInfo where
+  strEncode BlockingInfo {reason} = "reason=" <> strEncode reason
+  strP = do
+    reason <- "reason=" *> strP
+    pure BlockingInfo {reason}
+
+instance Encoding BlockingInfo where
+  smpEncode = strEncode
+  smpP = strP
+
+instance StrEncoding BlockingReason where
+  strEncode = \case
+    BRSpam -> "spam"
+    BRContent -> "content"
+  strP = "spam" $> BRSpam <|> "content" $> BRContent
+
+instance ToJSON BlockingReason where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+instance FromJSON BlockingReason where
+  parseJSON = strParseJSON "BlockingReason"
+
 -- | SMP transmission parser.
 transmissionP :: THandleParams v p -> Parser RawTransmission
 transmissionP THandleParams {sessionId, implySessId} = do
@@ -1284,7 +1343,7 @@ transmissionP THandleParams {sessionId, implySessId} = do
 class (ProtocolTypeI (ProtoType msg), ProtocolEncoding v err msg, ProtocolEncoding v err (ProtoCommand msg), Show err, Show msg) => Protocol v err msg | msg -> v, msg -> err where
  type ProtoCommand msg = cmd | cmd -> msg
  type ProtoType msg = (sch :: ProtocolType) | sch -> msg
-  protocolClientHandshake :: forall c. Transport c => c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRange v -> ExceptT TransportError IO (THandle v c 'TClient)
+  protocolClientHandshake :: forall c. Transport c => c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRange v -> Bool -> ExceptT TransportError IO (THandle v c 'TClient)
  protocolPing :: ProtoCommand msg
  protocolError :: msg -> Maybe err

@@ -1311,9 +1370,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
  encodeProtocol v = \case
    NEW rKey dhKey auth_ subMode sndSecure
      | v >= sndAuthKeySMPVersion -> new <> e (auth_, subMode, sndSecure)
-      | v >= subModeSMPVersion -> new <> auth <> e subMode
-      | v == basicAuthSMPVersion -> new <> auth
-      | otherwise -> new
+      | otherwise -> new <> auth <> e subMode
      where
        new = e (NEW_, ' ', rKey, dhKey)
        auth = maybe "" (e . ('A',)) auth_
@@ -1382,9 +1439,7 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
      Cmd SRecipient <$> case tag of
        NEW_
          | v >= sndAuthKeySMPVersion -> new <*> smpP <*> smpP <*> smpP
-          | v >= subModeSMPVersion -> new <*> auth <*> smpP <*> pure False
-          | v == basicAuthSMPVersion -> new <*> auth <*> pure SMSubscribe <*> pure False
-          | otherwise -> new <*> pure Nothing <*> pure SMSubscribe <*> pure False
+          | otherwise -> new <*> auth <*> smpP <*> pure False
          where
            new = NEW <$> _smpP <*> smpP
            auth = optional (A.char 'A' *> smpP)
@@ -1435,7 +1490,9 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
      | otherwise -> e END_
    INFO info -> e (INFO_, ' ', info)
    OK -> e OK_
-    ERR err -> e (ERR_, ' ', err)
+    ERR err -> case err of
+      BLOCKED _ | v < blockedEntitySMPVersion -> e (ERR_, ' ', AUTH)
+      _ -> e (ERR_, ' ', err)
    PONG -> e PONG_
    where
      e :: Encoding a => a -> ByteString
@@ -1513,6 +1570,7 @@ instance Encoding ErrorType where
    CMD err -> "CMD " <> smpEncode err
    PROXY err -> "PROXY " <> smpEncode err
    AUTH -> "AUTH"
+    BLOCKED info -> "BLOCKED " <> smpEncode info
    CRYPTO -> "CRYPTO"
    QUOTA -> "QUOTA"
    STORE err -> "STORE " <> smpEncode err
@@ -1529,6 +1587,7 @@ instance Encoding ErrorType where
      "CMD" -> CMD <$> _smpP
      "PROXY" -> PROXY <$> _smpP
      "AUTH" -> pure AUTH
+      "BLOCKED" -> BLOCKED <$> _smpP
      "CRYPTO" -> pure CRYPTO
      "QUOTA" -> pure QUOTA
      "STORE" -> STORE <$> _smpP
@@ -1763,5 +1822,7 @@ $(J.deriveJSON (sumTypeJSON id) ''CommandError)

 $(J.deriveJSON (sumTypeJSON id) ''BrokerErrorType)

+$(J.deriveJSON defaultJSON ''BlockingInfo)
+
 -- run deriveJSON in one TH splice to allow mutual instance
 $(concat <$> mapM @[] (J.deriveJSON (sumTypeJSON id)) [''ProxyError, ''ErrorType])
@@ -69,6 +69,7 @@ import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
 import Data.Semigroup (Sum (..))
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import qualified Data.Text.IO as T
@@ -104,6 +105,7 @@ import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.Stats
+import Simplex.Messaging.Server.StoreLog (foldLogLines)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
@@ -111,7 +113,7 @@ import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
-import System.Exit (exitFailure)
+import System.Exit (exitFailure, exitSuccess)
 import System.IO (hPrint, hPutStrLn, hSetNewlineMode, universalNewlineMode)
 import System.Mem.Weak (deRefWeak)
 import UnliftIO (timeout)
@@ -162,14 +164,18 @@ newMessageStats :: MessageStats
 newMessageStats = MessageStats 0 0 0

 smpServer :: TMVar Bool -> ServerConfig -> Maybe AttachHTTP -> M ()
-smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHTTP_ = do
+smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOptions} attachHTTP_ = do
  s <- asks server
  pa <- asks proxyAgent
-  msgStats_ <- processServerMessages
+  msgStats_ <- processServerMessages startOptions
  ntfStats <- restoreServerNtfs
  liftIO $ mapM_ (printMessageStats "messages") msgStats_
  liftIO $ printMessageStats "notifications" ntfStats
  restoreServerStats msgStats_ ntfStats
+  when (maintenance startOptions) $ do
+    liftIO $ putStrLn "Server started in 'maintenance' mode, exiting"
+    stopServer s
+    liftIO $ exitSuccess
  raceAny_
    ( serverThread s "server subscribedQ" subscribedQ subscribers subClients pendingSubEvents subscriptions cancelSub
        : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubClients pendingNtfSubEvents ntfSubscriptions (\_ -> pure ())
@@ -397,8 +403,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
        atomicModifyIORef'_ (msgExpired stats) (+ expired)
        printMessageStats "STORE: messages" msgStats
      where
-        expireQueueMsgs now ms old rId q = fmap (fromRight newMessageStats) . runExceptT $ do
-          (expired_, stored) <- idleDeleteExpiredMsgs now ms rId q old
+        expireQueueMsgs now ms old q = fmap (fromRight newMessageStats) . runExceptT $ do
+          (expired_, stored) <- idleDeleteExpiredMsgs now ms q old
          pure MessageStats {storedMsgsCount = stored, expiredMsgsCount = fromMaybe 0 expired_, storedQueues = 1}

    expireNtfsThread :: ServerConfig -> M ()
@@ -429,8 +435,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedAllB, qDeletedNew, qDeletedSecured, qSub, qSubAllB, qSubAuth, qSubDuplicate, qSubProhibited, qSubEnd, qSubEndB, ntfCreated, ntfDeleted, ntfDeletedB, ntfSub, ntfSubB, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, ntfCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
        <- asks serverStats
      AMS _ st <- asks msgStore
-      let queues = activeMsgQueues st
-          notifiers = notifiers' st
+      let STMQueueStore {queues, notifiers} = stmQueueStore st
          interval = 1000000 * logInterval
      forever $ do
        withFile statsFilePath AppendMode $ \h -> liftIO $ do
@@ -581,13 +586,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
        rtm <- getRealTimeMetrics env
        T.writeFile metricsFile $ prometheusMetrics sm rtm ts

-    getServerMetrics :: STMQueueStore s => s -> ServerStats -> IO ServerMetrics
+    getServerMetrics :: STMStoreClass s => s -> ServerStats -> IO ServerMetrics
    getServerMetrics st ss = do
      d <- getServerStatsData ss
      let ps = periodStatDataCounts $ _activeQueues d
          psNtf = periodStatDataCounts $ _activeQueuesNtf d
-      queueCount <- M.size <$> readTVarIO (activeMsgQueues st)
-      notifierCount <- M.size <$> readTVarIO (notifiers' st)
+          STMQueueStore {queues, notifiers} = stmQueueStore st
+      queueCount <- M.size <$> readTVarIO queues
+      notifierCount <- M.size <$> readTVarIO notifiers
      pure ServerMetrics {statsData = d, activeQueueCounts = ps, activeNtfCounts = psNtf, queueCount, notifierCount}

    getRealTimeMetrics :: Env -> IO RealTimeMetrics
@@ -675,8 +681,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
              CPStats -> withUserRole $ do
                ss <- unliftIO u $ asks serverStats
                AMS _ st <- unliftIO u $ asks msgStore
-                let queues = activeMsgQueues st
-                    notifiers = notifiers' st
+                let STMQueueStore {queues, notifiers} = stmQueueStore st
                    getStat :: (ServerStats -> IORef a) -> IO a
                    getStat var = readIORef (var ss)
                    putStat :: Show a => String -> (ServerStats -> IORef a) -> IO ()
@@ -849,16 +854,41 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                              SubPending -> (c1, c2 + 1, c3, c4)
                              SubThread _ -> (c1, c2, c3 + 1, c4)
                          ProhibitSub -> pure (c1, c2, c3, c4 + 1)
-              CPDelete qId -> withUserRole $ unliftIO u $ do
+              CPDelete sId -> withUserRole $ unliftIO u $ do
                AMS _ st <- asks msgStore
                r <- liftIO $ runExceptT $ do
-                  (q, qr) <- ExceptT (getQueueRec st SSender qId) `catchE` \_ -> ExceptT (getQueueRec st SRecipient qId)
-                  ExceptT $ deleteQueueSize st (recipientId qr) q
+                  q <- ExceptT $ getQueue st SSender sId
+                  ExceptT $ deleteQueueSize st q
                case r of
                  Left e -> liftIO $ hPutStrLn h $ "error: " <> show e
                  Right (qr, numDeleted) -> do
                    updateDeletedStats qr
                    liftIO $ hPutStrLn h $ "ok, " <> show numDeleted <> " messages deleted"
+              CPStatus sId -> withUserRole $ unliftIO u $ do
+                AMS _ st <- asks msgStore
+                q <- liftIO $ getQueueRec st SSender sId
+                liftIO $ hPutStrLn h $ case q of
+                  Left e -> "error: " <> show e
+                  Right (_, QueueRec {sndSecure, status, updatedAt}) ->
+                    "status: " <> show status <> ", updatedAt: " <> show updatedAt <> ", sndSecure: " <> show sndSecure
+              CPBlock sId info -> withUserRole $ unliftIO u $ do
+                AMS _ st <- asks msgStore
+                r <- liftIO $ runExceptT $ do
+                  q <- ExceptT $ getQueue st SSender sId
+                  ExceptT $ blockQueue st q info
+                case r of
+                  Left e -> liftIO $ hPutStrLn h $ "error: " <> show e
+                  Right () -> do
+                    incStat . qBlocked =<< asks serverStats
+                    liftIO $ hPutStrLn h "ok"
+              CPUnblock sId -> withUserRole $ unliftIO u $ do
+                AMS _ st <- asks msgStore
+                r <- liftIO $ runExceptT $ do
+                  q <- ExceptT $ getQueue st SSender sId
+                  ExceptT $ unblockQueue st q
+                liftIO $ hPutStrLn h $ case r of
+                  Left e -> "error: " <> show e
+                  Right () -> "ok"
              CPSave -> withAdminRole $ withLock' (savingLock srv) "control" $ do
                hPutStrLn h "saving server state..."
                unliftIO u $ saveServer False
@@ -891,7 +921,7 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
  c <- liftIO $ newClient msType clientId q thVersion sessionId ts
  runClientThreads msType ms active c clientId `finally` clientDisconnected c
  where
-    runClientThreads :: STMQueueStore (MsgStore s) => SMSType s -> MsgStore s -> TVar (IM.IntMap (Maybe AClient)) -> Client (MsgStore s) -> IS.Key -> M ()
+    runClientThreads :: STMStoreClass (MsgStore s) => SMSType s -> MsgStore s -> TVar (IM.IntMap (Maybe AClient)) -> Client (MsgStore s) -> IS.Key -> M ()
    runClientThreads msType ms active c clientId = do
      atomically $ modifyTVar' active $ IM.insert clientId $ Just (AClient msType c)
      s <- asks server
@@ -947,7 +977,7 @@ cancelSub s = case subThread s of
      _ -> pure ()
  ProhibitSub -> pure ()

-receive :: forall c s. (Transport c, STMQueueStore s) => THandleSMP c 'TServer -> s -> Client s -> M ()
+receive :: forall c s. (Transport c, STMStoreClass s) => THandleSMP c 'TServer -> s -> Client s -> M ()
 receive h@THandle {params = THandleParams {thAuth}} ms Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
  sa <- asks serverActive
@@ -1047,7 +1077,7 @@ data VerificationResult s = VRVerified (Maybe (StoreQueue s, QueueRec)) | VRFail
 -- - the queue or party key do not exist.
 -- In all cases, the time of the verification should depend only on the provided authorization type,
 -- a dummy key is used to run verification in the last two cases, and failure is returned irrespective of the result.
-verifyTransmission :: forall s. STMQueueStore s => s -> Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> QueueId -> Cmd -> M (VerificationResult s)
+verifyTransmission :: forall s. STMStoreClass s => s -> Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> QueueId -> Cmd -> M (VerificationResult s)
 verifyTransmission ms auth_ tAuth authorized queueId cmd =
  case cmd of
    Cmd SRecipient (NEW k _ _ _ _) -> pure $ Nothing `verifiedWith` k
@@ -1124,16 +1154,17 @@ forkClient Client {endThreads, endThreadSeq} label action = do
    action `finally` atomically (modifyTVar' endThreads $ IM.delete tId)
  mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId

-client :: forall s. STMQueueStore s => THandleParams SMPVersion 'TServer -> Server -> s -> Client s -> M ()
+client :: forall s. STMStoreClass s => THandleParams SMPVersion 'TServer -> Server -> s -> Client s -> M ()
 client
  thParams'
  Server {subscribedQ, ntfSubscribedQ, subscribers}
  ms
  clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} = do
    labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
+    let THandleParams {thVersion} = thParams'
    forever $
      atomically (readTBQueue rcvQ)
-        >>= mapM processCommand
+        >>= mapM (processCommand thVersion)
        >>= mapM_ reply . L.nonEmpty . catMaybes . L.toList
  where
    reply :: MonadIO m => NonEmpty (Transmission BrokerMsg) -> m ()
@@ -1218,14 +1249,14 @@ client
    mkIncProxyStats ps psOwn own sel = do
      incStat $ sel ps
      when own $ incStat $ sel psOwn
-    processCommand :: (Maybe (StoreQueue s, QueueRec), Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
-    processCommand (q_, (corrId, entId, cmd)) = case cmd of
+    processCommand :: VersionSMP -> (Maybe (StoreQueue s, QueueRec), Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
+    processCommand clntVersion (q_, (corrId, entId, cmd)) = case cmd of
      Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
      Cmd SSender command -> Just <$> case command of
        SKEY sKey ->
          withQueue $ \q QueueRec {sndSecure} ->
            (corrId,entId,) <$> if sndSecure then secureQueue_ q sKey else pure $ ERR AUTH
-        SEND flags msgBody -> withQueue $ sendMessage flags msgBody
+        SEND flags msgBody -> withQueue_ False $ sendMessage flags msgBody
        PING -> pure (corrId, NoEntity, PONG)
        RFWD encBlock -> (corrId, NoEntity,) <$> processForwardedCommand encBlock
      Cmd SNotifier NSUB -> Just <$> subscribeNotifications
@@ -1247,7 +1278,7 @@ client
          NKEY nKey dhKey -> withQueue $ \q _ -> addQueueNotifier_ q nKey dhKey
          NDEL -> withQueue $ \q _ -> deleteQueueNotifier_ q
          OFF -> maybe (pure $ err INTERNAL) suspendQueue_ q_
-          DEL -> maybe (pure $ err INTERNAL) delQueueAndMsgs q_          
+          DEL -> maybe (pure $ err INTERNAL) delQueueAndMsgs q_
          QUE -> withQueue $ \q qr -> (corrId,entId,) <$> getQueueInfo q qr
      where
        createQueue :: RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
@@ -1256,27 +1287,26 @@ client
          updatedAt <- Just <$> liftIO getSystemDate
          let rcvDhSecret = C.dh' dhKey privDhKey
              qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}
-              qRec (recipientId, senderId) =
+              qRec senderId =
                QueueRec
-                  { recipientId,
-                    senderId,
+                  { senderId,
                    recipientKey,
                    rcvDhSecret,
                    senderKey = Nothing,
                    notifier = Nothing,
-                    status = QueueActive,
+                    status = EntityActive,
                    sndSecure,
                    updatedAt
                  }
          (corrId,entId,) <$> addQueueRetry 3 qik qRec
          where
            addQueueRetry ::
-              Int -> ((RecipientId, SenderId) -> QueueIdsKeys) -> ((RecipientId, SenderId) -> QueueRec) -> M BrokerMsg
+              Int -> ((RecipientId, SenderId) -> QueueIdsKeys) -> (SenderId -> QueueRec) -> M BrokerMsg
            addQueueRetry 0 _ _ = pure $ ERR INTERNAL
            addQueueRetry n qik qRec = do
-              ids <- getIds
-              let qr = qRec ids
-              liftIO (addQueue ms qr) >>= \case
+              ids@(rId, sId) <- getIds
+              let qr = qRec sId
+              liftIO (addQueue ms rId qr) >>= \case
                Left DUPLICATE_ -> addQueueRetry (n - 1) qik qRec
                Left e -> pure $ ERR e
                Right q -> do
@@ -1353,7 +1383,7 @@ client
                  incStat $ qSubDuplicate stats
                  atomically (tryTakeTMVar $ delivered s) >> deliver False s
          where
-            rId = recipientId qr
+            rId = recipientId' q
            newSub :: M Sub
            newSub = time "SUB newSub" . atomically $ do
              writeTQueue subscribedQ (rId, clientId, True)
@@ -1364,7 +1394,7 @@ client
            deliver inc sub = do
              stats <- asks serverStats
              fmap (either (\e -> (corrId, rId, ERR e)) id) $ liftIO $ runExceptT $ do
-                msg_ <- tryPeekMsg ms rId q
+                msg_ <- tryPeekMsg ms q
                liftIO $ when (inc && isJust msg_) $ incStat (qSub stats)
                liftIO $ deliverMessage "SUB" qr rId sub msg_

@@ -1398,7 +1428,7 @@ client
            getMessage_ s delivered_ = do
              stats <- asks serverStats
              fmap (either err id) $ liftIO $ runExceptT $
-                tryPeekMsg ms (recipientId qr) q >>= \case
+                tryPeekMsg ms q >>= \case
                  Just msg -> do
                    let encMsg = encryptMsg qr msg
                    incStat $ (if isJust delivered_ then msgGetDuplicate else msgGet) stats
@@ -1406,13 +1436,18 @@ client
                  Nothing -> incStat (msgGetNoMsg stats) $> ok

        withQueue :: (StoreQueue s -> QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
-        withQueue action = case q_ of
+        withQueue = withQueue_ True
+
+        withQueue_ :: Bool -> (StoreQueue s -> QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
+        withQueue_ queueNotBlocked action = case q_ of
          Nothing -> pure $ err INTERNAL
-          Just (q, qr@QueueRec {updatedAt}) -> do
-            t <- liftIO getSystemDate
-            if updatedAt == Just t
-              then action q qr
-              else liftIO (updateQueueTime ms q t) >>= either (pure . err) (action q)
+          Just (q, qr@QueueRec {status, updatedAt}) -> case status of
+            EntityBlocked info | queueNotBlocked -> pure $ err $ BLOCKED info
+            _ -> do
+              t <- liftIO getSystemDate
+              if updatedAt == Just t
+                then action q qr
+                else liftIO (updateQueueTime ms q t) >>= either (pure . err) (action q)

        subscribeNotifications :: M (Transmission BrokerMsg)
        subscribeNotifications = do
@@ -1440,11 +1475,11 @@ client
                  fmap (either err id) $ liftIO $ runExceptT $ do
                    case st of
                      ProhibitSub -> do
-                        deletedMsg_ <- tryDelMsg ms (recipientId qr) q msgId
+                        deletedMsg_ <- tryDelMsg ms q msgId
                        liftIO $ mapM_ (updateStats stats True) deletedMsg_
                        pure ok
                      _ -> do
-                        (deletedMsg_, msg_) <- tryDelPeekMsg ms (recipientId qr) q msgId
+                        (deletedMsg_, msg_) <- tryDelPeekMsg ms q msgId
                        liftIO $ mapM_ (updateStats stats False) deletedMsg_
                        liftIO $ deliverMessage "ACK" qr entId sub msg_
                _ -> pure $ err NO_MSG
@@ -1476,17 +1511,20 @@ client

        sendMessage :: MsgFlags -> MsgBody -> StoreQueue s -> QueueRec -> M (Transmission BrokerMsg)
        sendMessage msgFlags msgBody q qr
-          | B.length msgBody > maxMessageLength thVersion = do
+          | B.length msgBody > maxMessageLength clntVersion = do
              stats <- asks serverStats
              incStat $ msgSentLarge stats
              pure $ err LARGE_MSG
          | otherwise = do
              stats <- asks serverStats
              case status qr of
-                QueueOff -> do
+                EntityOff -> do
                  incStat $ msgSentAuth stats
                  pure $ err AUTH
-                QueueActive ->
+                EntityBlocked info -> do
+                  incStat $ msgSentBlock stats
+                  pure $ err $ BLOCKED info
+                EntityActive ->
                  case C.maxLenBS msgBody of
                    Left _ -> pure $ err LARGE_MSG
                    Right body -> do
@@ -1495,7 +1533,7 @@ client
                      msg_ <- liftIO $ time "SEND" $ runExceptT $ do
                        expireMessages messageExpiration stats
                        msg <- liftIO $ mkMessage msgId body
-                        writeMsg ms (recipientId qr) q True msg
+                        writeMsg ms q True msg
                      case msg_ of
                        Left e -> pure $ err e
                        Right Nothing -> do
@@ -1506,13 +1544,12 @@ client
                          when (notification msgFlags) $ do
                            mapM_ (`enqueueNotification` msg) (notifier qr)
                            incStat $ msgSentNtf stats
-                            liftIO $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
+                            liftIO $ updatePeriodStats (activeQueuesNtf stats) (recipientId' q)
                          incStat $ msgSent stats
                          incStat $ msgCount stats
-                          liftIO $ updatePeriodStats (activeQueues stats) (recipientId qr)
+                          liftIO $ updatePeriodStats (activeQueues stats) (recipientId' q)
                          pure ok
          where
-            THandleParams {thVersion} = thParams'
            mkMessage :: MsgId -> C.MaxLenBS MaxMessageLen -> IO Message
            mkMessage msgId body = do
              msgTs <- getSystemTime
@@ -1520,7 +1557,7 @@ client

            expireMessages :: Maybe ExpirationConfig -> ServerStats -> ExceptT ErrorType IO ()
            expireMessages msgExp stats = do
-              deleted <- maybe (pure 0) (deleteExpiredMsgs ms (recipientId qr) q <=< liftIO . expireBeforeEpoch) msgExp
+              deleted <- maybe (pure 0) (deleteExpiredMsgs ms q <=< liftIO . expireBeforeEpoch) msgExp
              liftIO $ when (deleted > 0) $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)

            -- The condition for delivery of the message is:
@@ -1538,7 +1575,7 @@ client
              whenM (TM.memberIO rId subscribers) $
                atomically deliverToSub >>= mapM_ forkDeliver
              where
-                rId = recipientId qr
+                rId = recipientId' q
                deliverToSub =
                  -- lookup has ot be in the same transaction,
                  -- so that if subscription ends, it re-evalutates
@@ -1621,7 +1658,7 @@ client
              Left r -> pure r
              -- rejectOrVerify filters allowed commands, no need to repeat it here.
              -- INTERNAL is used because processCommand never returns Nothing for sender commands (could be extracted for better types).
-              Right t''@(_, (corrId', entId', _)) -> fromMaybe (corrId', entId', ERR INTERNAL) <$> lift (processCommand t'')
+              Right t''@(_, (corrId', entId', _)) -> fromMaybe (corrId', entId', ERR INTERNAL) <$> lift (processCommand fwdVersion t'')
          -- encode response
          r' <- case batchTransmissions (batch clntTHParams) (blockSize clntTHParams) [Right (Nothing, encodeTransmission clntTHParams r)] of
            [] -> throwE INTERNAL -- at least 1 item is guaranteed from NonEmpty/Right
@@ -1682,7 +1719,7 @@ client

        delQueueAndMsgs :: (StoreQueue s, QueueRec) -> M (Transmission BrokerMsg)
        delQueueAndMsgs (q, _) = do
-          liftIO (deleteQueue ms entId q) >>= \case
+          liftIO (deleteQueue ms q) >>= \case
            Right qr -> do
              -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
              atomically $ do
@@ -1702,11 +1739,11 @@ client
            Left e -> pure $ err e

        getQueueInfo :: StoreQueue s -> QueueRec -> M BrokerMsg
-        getQueueInfo q QueueRec {recipientId = rId, senderKey, notifier} = do
+        getQueueInfo q QueueRec {senderKey, notifier} = do
          fmap (either ERR id) $ liftIO $ runExceptT $ do
            qiSub <- liftIO $ TM.lookupIO entId subscriptions >>= mapM mkQSub
-            qiSize <- getQueueSize ms rId q
-            qiMsg <- toMsgInfo <$$> tryPeekMsg ms rId q
+            qiSize <- getQueueSize ms q
+            qiMsg <- toMsgInfo <$$> tryPeekMsg ms q
            let info = QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
            pure $ INFO info
          where
@@ -1734,7 +1771,7 @@ updateDeletedStats q = do
  let delSel = if isNothing (senderKey q) then qDeletedNew else qDeletedSecured
  incStat $ delSel stats
  incStat $ qDeletedAll stats
-  incStat $ qCount stats
+  liftIO $ atomicModifyIORef'_ (qCount stats) (subtract 1)

 incStat :: MonadIO m => IORef Int -> m ()
 incStat r = liftIO $ atomicModifyIORef'_ r (+ 1)
@@ -1776,16 +1813,17 @@ exportMessages tty ms f drainMsgs = do
        logError $ "error exporting messages: " <> tshow e
        exitFailure
  where
-    saveQueueMsgs h rId q =
-      runExceptT (getQueueMessages drainMsgs ms rId q) >>= \case
+    saveQueueMsgs h q = do
+      let rId = recipientId' q
+      runExceptT (getQueueMessages drainMsgs ms q) >>= \case
        Right msgs -> Sum (length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
        Left e -> do
          logError $ "STORE: saveQueueMsgs, error exporting messages from queue " <> decodeLatin1 (strEncode rId) <> ", " <> tshow e
          exitFailure
    encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')

-processServerMessages :: M (Maybe MessageStats)
-processServerMessages = do
+processServerMessages :: StartOptions -> M (Maybe MessageStats)
+processServerMessages StartOptions {skipWarnings} = do
  old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch)
  expire <- asks $ expireMessagesOnStart . config
  asks msgStore >>= liftIO . processMessages old_ expire
@@ -1793,7 +1831,7 @@ processServerMessages = do
      processMessages :: Maybe Int64 -> Bool -> AMsgStore -> IO (Maybe MessageStats)
      processMessages old_ expire = \case
        AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-          Just f -> ifM (doesFileExist f) (Just <$> importMessages False ms f old_) (pure Nothing)
+          Just f -> ifM (doesFileExist f) (Just <$> importMessages False ms f old_ skipWarnings) (pure Nothing)
          Nothing -> pure Nothing
        AMS SMSJournal ms
          | expire -> Just <$> case old_ of
@@ -1805,7 +1843,7 @@ processServerMessages = do
                withAllMsgQueues False ms $ processValidateQueue
          | otherwise -> logWarn "skipping message expiration" $> Nothing
          where
-            processExpireQueue old rId q =
+            processExpireQueue old q =
              runExceptT expireQueue >>= \case
                Right (storedMsgsCount, expiredMsgsCount) ->
                  pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
@@ -1814,69 +1852,82 @@ processServerMessages = do
                  exitFailure
              where
                expireQueue = do
-                  expired'' <- deleteExpiredMsgs ms rId q old
-                  stored'' <- getQueueSize ms rId q
+                  expired'' <- deleteExpiredMsgs ms q old
+                  stored'' <- getQueueSize ms q
                  liftIO $ closeMsgQueue q
                  pure (stored'', expired'')
-            processValidateQueue :: RecipientId -> JournalQueue -> IO MessageStats
-            processValidateQueue rId q =
-              runExceptT (getQueueSize ms rId q) >>= \case
+            processValidateQueue :: JournalQueue -> IO MessageStats
+            processValidateQueue q =
+              runExceptT (getQueueSize ms q) >>= \case
                Right storedMsgsCount -> pure newMessageStats {storedMsgsCount, storedQueues = 1}
                Left e -> do
                  logError $ "STORE: processValidateQueue, failed opening message queue, " <> tshow e
                  exitFailure

-- TODO this function should be called after importing queues from store log
-importMessages :: forall s. STMQueueStore s => Bool -> s -> FilePath -> Maybe Int64 -> IO MessageStats
-importMessages tty ms f old_ = do
+importMessages :: forall s. STMStoreClass s => Bool -> s -> FilePath -> Maybe Int64 -> Bool -> IO MessageStats
+importMessages tty ms f old_ skipWarnings  = do
  logInfo $ "restoring messages from file " <> T.pack f
-  LB.readFile f >>= runExceptT . foldM restoreMsg (0, Nothing, (0, 0, M.empty)) . LB.lines >>= \case
-    Left e -> do
-      when tty $ putStrLn ""
-      logError . T.pack $ "error restoring messages: " <> e
-      liftIO exitFailure
-    Right (lineCount, _, (storedMsgsCount, expiredMsgsCount, overQuota)) -> do
-      putStrLn $ progress lineCount
-      renameFile f $ f <> ".bak"
-      mapM_ setOverQuota_ overQuota
-      logQueueStates ms
-      storedQueues <- M.size <$> readTVarIO (activeMsgQueues ms)
-      pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
+  (_, (storedMsgsCount, expiredMsgsCount, overQuota)) <-
+    foldLogLines tty f restoreMsg (Nothing, (0, 0, M.empty))
+  renameFile f $ f <> ".bak"
+  mapM_ setOverQuota_ overQuota
+  logQueueStates ms
+  storedQueues <- M.size <$> readTVarIO (queues $ stmQueueStore ms)
+  pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
  where
-    progress i = "Processed " <> show i <> " lines"
-    restoreMsg :: (Int, Maybe (RecipientId, StoreQueue s), (Int, Int, M.Map RecipientId (StoreQueue s))) -> LB.ByteString -> ExceptT String IO (Int, Maybe (RecipientId, StoreQueue s), (Int, Int, M.Map RecipientId (StoreQueue s)))
-    restoreMsg (!i, q_, (!stored, !expired, !overQuota)) s' = do
-      when (tty && i `mod` 1000 == 0) $ liftIO $ putStr (progress i <> "\r") >> hFlush stdout
-      MLRv3 rId msg <- liftEither . first (msgErr "parsing") $ strDecode s
-      liftError show $ addToMsgQueue rId msg
+    restoreMsg :: (Maybe (RecipientId, StoreQueue s), (Int, Int, M.Map RecipientId (StoreQueue s))) -> Bool -> ByteString -> IO (Maybe (RecipientId, StoreQueue s), (Int, Int, M.Map RecipientId (StoreQueue s)))
+    restoreMsg (q_, counts@(!stored, !expired, !overQuota)) eof s = case strDecode s of
+      Right (MLRv3 rId msg) -> runExceptT (addToMsgQueue rId msg) >>= either (exitErr . tshow) pure
+      Left e
+        | eof -> warnOrExit (parsingErr e) $> (q_, counts)
+        | otherwise -> exitErr $ parsingErr e
      where
-        s = LB.toStrict s'
+        exitErr e = do
+          when tty $ putStrLn ""
+          logError $ "error restoring messages: " <> e
+          liftIO exitFailure
+        parsingErr :: String -> Text
+        parsingErr e = "parsing error (" <> T.pack e <> "): " <> safeDecodeUtf8 (B.take 100 s)
        addToMsgQueue rId msg = do
-          q <- case q_ of
+          qOrErr <- case q_ of
            -- to avoid lookup when restoring the next message to the same queue
-            Just (rId', q') | rId' == rId -> pure q'
-            _ -> ExceptT $ getQueue ms SRecipient rId
-          (i + 1,Just (rId, q),) <$> case msg of
+            Just (rId', q') | rId' == rId -> pure $ Right q'
+            _ -> liftIO $ getQueue ms SRecipient rId
+          case qOrErr of
+            Right q -> addToQueue_ q rId msg
+            Left AUTH -> liftIO $ do
+              when tty $ putStrLn ""
+              warnOrExit $ "queue " <> safeDecodeUtf8 (encode $ unEntityId rId) <> " does not exist"
+              pure (Nothing, counts)
+            Left e -> throwE e
+        addToQueue_ q rId msg =
+          (Just (rId, q),) <$> case msg of
            Message {msgTs}
              | maybe True (systemSeconds msgTs >=) old_ -> do
-                  writeMsg ms rId q False msg >>= \case
+                  writeMsg ms q False msg >>= \case
                    Just _ -> pure (stored + 1, expired, overQuota)
-                    Nothing -> do
+                    Nothing -> liftIO $ do
+                      when tty $ putStrLn ""
                      logError $ decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
-                      pure (stored, expired, overQuota)
+                      pure counts
              | otherwise -> pure (stored, expired + 1, overQuota)
            MessageQuota {} ->
              -- queue was over quota at some point,
              -- it will be set as over quota once fully imported
-              mergeQuotaMsgs >> writeMsg ms rId q False msg $> (stored, expired, M.insert rId q overQuota)
+              mergeQuotaMsgs >> writeMsg ms q False msg $> (stored, expired, M.insert rId q overQuota)
              where
                -- if the first message in queue head is "quota", remove it.
                mergeQuotaMsgs =
-                  withPeekMsgQueue ms rId q "mergeQuotaMsgs" $ maybe (pure ()) $ \case
+                  withPeekMsgQueue ms q "mergeQuotaMsgs" $ maybe (pure ()) $ \case
                    (mq, MessageQuota {}) -> tryDeleteMsg_ q mq False
                    _ -> pure ()
-        msgErr :: Show e => String -> e -> String
-        msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
+        warnOrExit e
+          | skipWarnings = logWarn e'
+          | otherwise = do
+              logWarn $ e' <> ", start with --skip-warnings option to ignore this error"
+              exitFailure
+          where
+            e' = "warning restoring messages: " <> e

 printMessageStats :: T.Text -> MessageStats -> IO ()
 printMessageStats name MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues} =
@@ -1949,7 +2000,7 @@ restoreServerStats msgStats_ ntfStats = asks (serverStatsBackupFile . config) >>
        Right d@ServerStatsData {_qCount = statsQCount, _msgCount = statsMsgCount, _ntfCount = statsNtfCount} -> do
          s <- asks serverStats
          AMS _ st <- asks msgStore
-          _qCount <- M.size <$> readTVarIO (activeMsgQueues st)
+          _qCount <- M.size <$> readTVarIO (queues $ stmQueueStore st)
          let _msgCount = maybe statsMsgCount storedMsgsCount msgStats_
              _ntfCount = storedMsgsCount ntfStats
              _msgExpired' = _msgExpired d + maybe 0 expiredMsgsCount msgStats_
@@ -5,7 +5,7 @@ module Simplex.Messaging.Server.Control where

 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BasicAuth, SenderId)
+import Simplex.Messaging.Protocol (BasicAuth, BlockingInfo, SenderId)

 data CPClientRole = CPRNone | CPRUser | CPRAdmin
  deriving (Eq)
@@ -22,6 +22,9 @@ data ControlProtocol
  | CPSocketThreads
  | CPServerInfo
  | CPDelete SenderId
+  | CPStatus SenderId
+  | CPBlock SenderId BlockingInfo
+  | CPUnblock SenderId
  | CPSave
  | CPHelp
  | CPQuit
@@ -39,14 +42,17 @@ instance StrEncoding ControlProtocol where
    CPSockets -> "sockets"
    CPSocketThreads -> "socket-threads"
    CPServerInfo -> "server-info"
-    CPDelete bs -> "delete " <> strEncode bs
+    CPDelete sId -> "delete " <> strEncode sId
+    CPStatus sId -> "status " <> strEncode sId
+    CPBlock sId info -> "block " <> strEncode sId <> " " <> strEncode info
+    CPUnblock sId -> "unblock " <> strEncode sId
    CPSave -> "save"
    CPHelp -> "help"
    CPQuit -> "quit"
    CPSkip -> ""
  strP =
    A.takeTill (== ' ') >>= \case
-      "auth" -> CPAuth <$> (A.space *> strP)
+      "auth" -> CPAuth <$> _strP
      "suspend" -> pure CPSuspend
      "resume" -> pure CPResume
      "clients" -> pure CPClients
@@ -56,7 +62,10 @@ instance StrEncoding ControlProtocol where
      "sockets" -> pure CPSockets
      "socket-threads" -> pure CPSocketThreads
      "server-info" -> pure CPServerInfo
-      "delete" -> CPDelete <$> (A.space *> strP)
+      "delete" -> CPDelete <$> _strP
+      "status" -> CPStatus <$> _strP
+      "block" -> CPBlock <$> _strP <*> _strP
+      "unblock" -> CPUnblock <$> _strP
      "save" -> pure CPSave
      "help" -> pure CPHelp
      "quit" -> pure CPQuit
@@ -25,7 +25,7 @@ import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Maybe (isJust, isNothing)
 import qualified Data.Text as T
-import Data.Time.Clock (getCurrentTime)
+import Data.Time.Clock (getCurrentTime, nominalDay)
 import Data.Time.Clock.System (SystemTime)
 import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..))
@@ -116,7 +116,13 @@ data ServerConfig = ServerConfig
    allowSMPProxy :: Bool, -- auth is the same with `newQueueBasicAuth`
    serverClientConcurrency :: Int,
    -- | server public information
-    information :: Maybe ServerPublicInfo
+    information :: Maybe ServerPublicInfo,
+    startOptions :: StartOptions
+  }
+
+data StartOptions = StartOptions
+  { maintenance :: Bool,
+    skipWarnings :: Bool
  }

 defMsgExpirationDays :: Int64
@@ -189,7 +195,7 @@ type family MsgStore s where
  MsgStore 'MSMemory = STMMsgStore
  MsgStore 'MSJournal = JournalMsgStore

-data AMsgStore = forall s. (STMQueueStore (MsgStore s), MsgStoreClass (MsgStore s)) => AMS (SMSType s) (MsgStore s)
+data AMsgStore = forall s. (STMStoreClass (MsgStore s), MsgStoreClass (MsgStore s)) => AMS (SMSType s) (MsgStore s)

 data AStoreQueue = forall s. MsgStoreClass (MsgStore s) => ASQ (SMSType s) (StoreQueue (MsgStore s))

@@ -297,8 +303,8 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgSt
  msgStore@(AMS _ store) <- case msgStoreType of
    AMSType SMSMemory -> AMS SMSMemory <$> newMsgStore STMStoreConfig {storePath = storeMsgsFile, quota = msgQueueQuota}
    AMSType SMSJournal -> case storeMsgsFile of
-      Just storePath -> 
-        let cfg = JournalStoreConfig {storePath, quota = msgQueueQuota, pathParts = journalMsgStoreDepth, maxMsgCount = maxJournalMsgCount, maxStateLines = maxJournalStateLines, stateTailSize = defaultStateTailSize, idleInterval = idleQueueInterval}
+      Just storePath ->
+        let cfg = mkJournalStoreConfig storePath msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval
         in AMS SMSJournal <$> newMsgStore cfg
      Nothing -> putStrLn "Error: journal msg store require path in [STORE_LOG], restore_messages" >> exitFailure
  ntfStore <- NtfStore <$> TM.emptyIO
@@ -357,10 +363,24 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgSt
          | isJust storeMsgsFile = SPMMessages
          | otherwise = SPMQueues

+mkJournalStoreConfig :: FilePath -> Int -> Int -> Int -> Int64 -> JournalStoreConfig
+mkJournalStoreConfig storePath msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval =
+  JournalStoreConfig
+    { storePath,
+      quota = msgQueueQuota,
+      pathParts = journalMsgStoreDepth,
+      maxMsgCount = maxJournalMsgCount,
+      maxStateLines = maxJournalStateLines,
+      stateTailSize = defaultStateTailSize,
+      idleInterval = idleQueueInterval,
+      expireBackupsAfter = 14 * nominalDay,
+      keepMinBackups = 2
+    }
+
 newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO ProxyAgent
 newSMPProxyAgent smpAgentCfg random = do
  smpAgent <- newSMPClientAgent smpAgentCfg random
  pure ProxyAgent {smpAgent}

-readWriteQueueStore :: STMQueueStore s => FilePath -> s -> IO (StoreLog 'WriteMode)
+readWriteQueueStore :: STMStoreClass s => FilePath -> s -> IO (StoreLog 'WriteMode)
 readWriteQueueStore = readWriteStoreLog readQueueStore writeQueueStore
@@ -44,14 +44,12 @@ import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
-import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..))
 import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..), newMsgStore)
 import Simplex.Messaging.Server.QueueStore.STM (readQueueStore)
-import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
+import Simplex.Messaging.Transport (simplexMQVersion, supportedProxyClientSMPRelayVRange, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost (..), defaultSocksProxy)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (eitherToMaybe, ifM, safeDecodeUtf8, tshow)
-import Simplex.Messaging.Version (mkVersionRange)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
@@ -75,7 +73,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
        True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `" <> executableName <> " start`."
        _ -> initializeServer opts
    OnlineCert certOpts -> withIniFile $ \_ -> genOnline cfgPath certOpts
-    Start -> withIniFile runServer
+    Start opts -> withIniFile $ runServer opts
    Delete -> do
      confirmOrExit
        "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
@@ -109,7 +107,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                "Messages not imported"
              ms <- newJournalMsgStore
              readQueueStore storeLogFile ms
-              msgStats <- importMessages True ms storeMsgsFilePath Nothing -- no expiration
+              msgStats <- importMessages True ms storeMsgsFilePath Nothing False -- no expiration
              putStrLn "Import completed"
              printMessageStats "Messages" msgStats
              putStrLn $ case readMsgStoreType ini of
@@ -148,7 +146,9 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
      doesFileExist iniFile >>= \case
        True -> readIniFile iniFile >>= either exitError a
        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
-    newJournalMsgStore = newMsgStore JournalStoreConfig {storePath = storeMsgsJournalDir, pathParts = journalMsgStoreDepth, quota = defaultMsgQueueQuota, maxMsgCount = defaultMaxJournalMsgCount, maxStateLines = defaultMaxJournalStateLines, stateTailSize = defaultStateTailSize, idleInterval = checkInterval defaultMessageExpiration}
+    newJournalMsgStore =
+      let cfg = mkJournalStoreConfig storeMsgsJournalDir defaultMsgQueueQuota defaultMaxJournalMsgCount defaultMaxJournalStateLines $ checkInterval defaultMessageExpiration
+       in newMsgStore cfg
    iniFile = combine cfgPath "smp-server.ini"
    serverVersion = "SMP server v" <> simplexMQVersion
    defaultServerPorts = "5223,443"
@@ -322,7 +322,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                <> (webDisabled <> "key: " <> T.pack httpsKeyFile <> "\n")
              where
                webDisabled = if disableWeb then "# " else ""
-    runServer ini = do
+    runServer startOptions ini = do
      hSetBuffering stdout LineBuffering
      hSetBuffering stderr LineBuffering
      fp <- checkSavedFingerprint cfgPath defaultX509Config
@@ -447,8 +447,9 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                defaultSMPClientAgentConfig
                  { smpCfg =
                      (smpCfg defaultSMPClientAgentConfig)
-                        { serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion,
+                        { serverVRange = supportedProxyClientSMPRelayVRange,
                          agreeSecret = True,
+                          proxyServer = True,
                          networkConfig =
                            defaultNetworkConfig
                              { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini,
@@ -462,7 +463,8 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                  },
              allowSMPProxy = True,
              serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini,
-              information = serverPublicInfo ini
+              information = serverPublicInfo ini,
+              startOptions
            }
        textToOwnServers :: Text -> [ByteString]
        textToOwnServers = map encodeUtf8 . T.words
@@ -634,7 +636,7 @@ printSourceCode = \case
 data CliCommand
  = Init InitOptions
  | OnlineCert CertOptions
-  | Start
+  | Start StartOptions
  | Delete
  | Journal JournalCmd

@@ -668,7 +670,7 @@ cliCommandP cfgPath logPath iniFile =
  hsubparser
    ( command "init" (info (Init <$> initP) (progDesc $ "Initialize server - creates " <> cfgPath <> " and " <> logPath <> " directories and configuration files"))
        <> command "cert" (info (OnlineCert <$> certOptionsP) (progDesc $ "Generate new online TLS server credentials (configuration: " <> iniFile <> ")"))
-        <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
+        <> command "start" (info (Start <$> startOptionsP) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
        <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
        <> command "journal" (info (Journal <$> journalCmdP) (progDesc "Import/export messages to/from journal storage"))
    )
@@ -810,6 +812,18 @@ cliCommandP cfgPath logPath iniFile =
            disableWeb,
            scripted
          }
+    startOptionsP = do
+      maintenance <-
+        switch
+          ( long "maintenance"
+              <> help "Do not start the server, only perform start and stop tasks"
+          )
+      skipWarnings <-
+        switch
+          ( long "skip-warnings"
+              <> help "Start the server with non-critical start warnings"
+          )
+      pure StartOptions {maintenance, skipWarnings}
    journalCmdP =
      hsubparser
        ( command "import" (info (pure JCImport) (progDesc "Import message log file into a new journal storage"))
@@ -15,7 +15,7 @@
 {-# LANGUAGE TupleSections #-}

 module Simplex.Messaging.Server.MsgStore.Journal
-  ( JournalMsgStore (queues, senders, notifiers, random),
+  ( JournalMsgStore (queueStore, random, expireBackupsBefore),
    JournalQueue,
    JournalMsgQueue (queue, state),
    JMQueue (queueDirectory, statePath),
@@ -28,7 +28,7 @@ module Simplex.Messaging.Server.MsgStore.Journal
    SJournalType (..),
    msgQueueDirectory,
    msgQueueStatePath,
-    readWriteQueueState,
+    readQueueState,
    newMsgQueueState,
    newJournalId,
    appendState,
@@ -48,12 +48,13 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (intercalate)
-import Data.Maybe (catMaybes, fromMaybe, isNothing)
+import Data.List (intercalate, sort)
+import Data.Maybe (catMaybes, fromMaybe, isNothing, mapMaybe)
+import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Time.Clock (getCurrentTime)
+import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
-import Data.Time.Format.ISO8601 (iso8601Show)
+import Data.Time.Format.ISO8601 (iso8601Show, iso8601ParseM)
 import GHC.IO (catchAny)
 import Simplex.Messaging.Agent.Client (getMapLock, withLockMap)
 import Simplex.Messaging.Agent.Lock
@@ -65,10 +66,10 @@ import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.Util (ifM, tshow, ($>>=), (<$$>))
+import Simplex.Messaging.Util (ifM, tshow, whenM, ($>>=), (<$$>))
 import System.Directory
 import System.Exit
-import System.FilePath ((</>))
+import System.FilePath (takeFileName, (</>))
 import System.IO (BufferMode (..), Handle, IOMode (..), SeekMode (..), stdout)
 import qualified System.IO as IO
 import System.Random (StdGen, genByteString, newStdGen)
@@ -77,10 +78,8 @@ data JournalMsgStore = JournalMsgStore
  { config :: JournalStoreConfig,
    random :: TVar StdGen,
    queueLocks :: TMap RecipientId Lock,
-    queues :: TMap RecipientId JournalQueue,
-    senders :: TMap SenderId RecipientId,
-    notifiers :: TMap NotifierId RecipientId,
-    storeLog :: TVar (Maybe (StoreLog 'WriteMode))
+    queueStore :: STMQueueStore JournalQueue,
+    expireBackupsBefore :: UTCTime
  }

 data JournalStoreConfig = JournalStoreConfig
@@ -94,19 +93,27 @@ data JournalStoreConfig = JournalStoreConfig
    maxStateLines :: Int,
    stateTailSize :: Int,
    -- time in seconds after which the queue will be closed after message expiration
-    idleInterval :: Int64
+    idleInterval :: Int64,
+    -- expire state backup files
+    expireBackupsAfter :: NominalDiffTime,
+    keepMinBackups :: Int
  }

 data JournalQueue = JournalQueue
-  { queueLock :: Lock,
+  { recipientId :: RecipientId,
+    queueLock :: Lock,
    -- To avoid race conditions and errors when restoring queues,
    -- Nothing is written to TVar when queue is deleted.
    queueRec :: TVar (Maybe QueueRec),
    msgQueue_ :: TVar (Maybe JournalMsgQueue),
    -- system time in seconds since epoch
    activeAt :: TVar Int64,
-    -- Just True - empty, Just False - non-empty, Nothing - unknown
-    isEmpty :: TVar (Maybe Bool)
+    queueState :: TVar (Maybe QState) -- Nothing - unknown
+  }
+
+data QState = QState
+  { hasPending :: Bool,
+    hasStored :: Bool
  }

 data JMQueue = JMQueue
@@ -149,6 +156,12 @@ data JournalState t = JournalState
  }
  deriving (Show)

+qState :: MsgQueueState -> QState
+qState MsgQueueState {size, readState = rs, writeState = ws} =
+  let hasPending = size > 0
+   in QState {hasPending, hasStored = hasPending || msgCount rs > 0 || msgCount ws > 0}
+{-# INLINE qState #-}
+
 data JournalType = JTRead | JTWrite

 data SJournalType (t :: JournalType) where
@@ -218,18 +231,23 @@ logFileExt = ".log"
 newtype StoreIO a = StoreIO {unStoreIO :: IO a}
  deriving newtype (Functor, Applicative, Monad)

-instance STMQueueStore JournalMsgStore where
-  queues' = queues
-  senders' = senders
-  notifiers' = notifiers
-  storeLog' = storeLog
-  mkQueue st qr = do
-    lock <- getMapLock (queueLocks st) $ recipientId qr
-    q <- newTVar $ Just qr
-    mq <- newTVar Nothing
+instance STMStoreClass JournalMsgStore where
+  stmQueueStore JournalMsgStore {queueStore} = queueStore
+  mkQueue st rId qr = do
+    queueLock <- getMapLock (queueLocks st) rId
+    queueRec <- newTVar $ Just qr
+    msgQueue_ <- newTVar Nothing
    activeAt <- newTVar 0
-    isEmpty <- newTVar Nothing
-    pure $ JournalQueue lock q mq activeAt isEmpty
+    queueState <- newTVar Nothing
+    pure $
+      JournalQueue
+        { recipientId = rId,
+          queueLock,
+          queueRec,
+          msgQueue_,
+          activeAt,
+          queueState
+        }
  msgQueue_' = msgQueue_

 instance MsgStoreClass JournalMsgStore where
@@ -242,27 +260,22 @@ instance MsgStoreClass JournalMsgStore where
  newMsgStore config = do
    random <- newTVarIO =<< newStdGen
    queueLocks <- TM.emptyIO
-    queues <- TM.emptyIO
-    senders <- TM.emptyIO
-    notifiers <- TM.emptyIO
-    storeLog <- newTVarIO Nothing
-    pure JournalMsgStore {config, random, queueLocks, queues, senders, notifiers, storeLog}
+    queueStore <- newQueueStore
+    expireBackupsBefore <- addUTCTime (- expireBackupsAfter config) <$> getCurrentTime
+    pure JournalMsgStore {config, random, queueLocks, queueStore, expireBackupsBefore}

  setStoreLog :: JournalMsgStore -> StoreLog 'WriteMode -> IO ()
-  setStoreLog st sl = atomically $ writeTVar (storeLog st) (Just sl)
+  setStoreLog st sl = atomically $ writeTVar (storeLog $ queueStore st) (Just sl)

-  closeMsgStore st = do
+  closeMsgStore JournalMsgStore {queueStore = st} = do
    readTVarIO (storeLog st) >>= mapM_ closeStoreLog
    readTVarIO (queues st) >>= mapM_ closeMsgQueue

-  activeMsgQueues = queues
-  {-# INLINE activeMsgQueues #-}
-
  -- This function is a "foldr" that opens and closes all queues, processes them as defined by action and accumulates the result.
  -- It is used to export storage to a single file and also to expire messages and validate all queues when server is started.
  -- TODO this function requires case-sensitive file system, because it uses queue directory as recipient ID.
  -- It can be made to support case-insensite FS by supporting more than one queue per directory, by getting recipient ID from state file name.
-  withAllMsgQueues :: forall a. Monoid a => Bool -> JournalMsgStore -> (RecipientId -> JournalQueue -> IO a) -> IO a
+  withAllMsgQueues :: forall a. Monoid a => Bool -> JournalMsgStore -> (JournalQueue -> IO a) -> IO a
  withAllMsgQueues tty ms@JournalMsgStore {config} action = ifM (doesDirectoryExist storePath) processStore (pure mempty)
    where
      processStore = do
@@ -276,7 +289,7 @@ instance MsgStoreClass JournalMsgStore where
        r' <- case strDecode $ B.pack queueId of
          Right rId ->
            getQueue ms SRecipient rId >>= \case
-              Right q -> unStoreIO (getMsgQueue ms rId q) *> action rId q <* closeMsgQueue q
+              Right q -> unStoreIO (getMsgQueue ms q False) *> action q <* closeMsgQueue q
              Left AUTH -> do
                logWarn $ "STORE: processQueue, queue " <> T.pack queueId <> " was removed, removing " <> T.pack dir
                removeQueueDirectory_ dir
@@ -303,7 +316,7 @@ instance MsgStoreClass JournalMsgStore where
              (Nothing <$ putStrLn ("Error: path " <> path' <> " is not a directory, skipping"))

  logQueueStates :: JournalMsgStore -> IO ()
-  logQueueStates ms = withActiveMsgQueues ms $ \_ -> unStoreIO . logQueueState
+  logQueueStates ms = withActiveMsgQueues ms $ unStoreIO . logQueueState

  logQueueState :: JournalQueue -> StoreIO ()
  logQueueState q =
@@ -312,19 +325,24 @@ instance MsgStoreClass JournalMsgStore where
        $>>= \mq -> readTVarIO (handles mq)
        $>>= (\hs -> (readTVarIO (state mq) >>= appendState (stateHandle hs)) $> Just ())

+  recipientId' = recipientId
+  {-# INLINE recipientId' #-}
+
  queueRec' = queueRec
  {-# INLINE queueRec' #-}

-  getMsgQueue :: JournalMsgStore -> RecipientId -> JournalQueue -> StoreIO JournalMsgQueue
-  getMsgQueue ms@JournalMsgStore {random} rId JournalQueue {msgQueue_} =
+  getMsgQueue :: JournalMsgStore -> JournalQueue -> Bool -> StoreIO JournalMsgQueue
+  getMsgQueue ms@JournalMsgStore {random} q'@JournalQueue {recipientId = rId, msgQueue_} forWrite =
    StoreIO $ readTVarIO msgQueue_ >>= maybe newQ pure
    where
      newQ = do
        let dir = msgQueueDirectory ms rId
            statePath = msgQueueStatePath dir $ B.unpack (strEncode rId)
            queue = JMQueue {queueDirectory = dir, statePath}
-        q <- ifM (doesDirectoryExist dir) (openMsgQueue ms queue) (createQ queue)
+        q <- ifM (doesDirectoryExist dir) (openMsgQueue ms queue forWrite) (createQ queue)
        atomically $ writeTVar msgQueue_ $ Just q
+        st <- readTVarIO $ state q
+        atomically $ writeTVar (queueState q') $ Just $! qState st
        pure q
        where
          createQ :: JMQueue -> IO JournalMsgQueue
@@ -334,11 +352,10 @@ instance MsgStoreClass JournalMsgStore where
            journalId <- newJournalId random
            mkJournalQueue queue (newMsgQueueState journalId) Nothing

-  getPeekMsgQueue :: JournalMsgStore -> RecipientId -> JournalQueue -> StoreIO (Maybe (JournalMsgQueue, Message))
-  getPeekMsgQueue ms rId q@JournalQueue {isEmpty} =
-    StoreIO (readTVarIO isEmpty) >>= \case
-      Just True -> pure Nothing
-      Just False -> peek
+  getPeekMsgQueue :: JournalMsgStore -> JournalQueue -> StoreIO (Maybe (JournalMsgQueue, Message))
+  getPeekMsgQueue ms q@JournalQueue {queueState} =
+    StoreIO (readTVarIO queueState) >>= \case
+      Just QState {hasPending} -> if hasPending then peek else pure Nothing
      Nothing -> do
        -- We only close the queue if we just learnt it's empty.
        -- This is needed to reduce file descriptors and memory usage
@@ -350,20 +367,20 @@ instance MsgStoreClass JournalMsgStore where
        pure r
    where
      peek = do
-        mq <- getMsgQueue ms rId q
+        mq <- getMsgQueue ms q False
        (mq,) <$$> tryPeekMsg_ q mq

  -- only runs action if queue is not empty
-  withIdleMsgQueue :: Int64 -> JournalMsgStore -> RecipientId -> JournalQueue -> (JournalMsgQueue -> StoreIO a) -> StoreIO (Maybe a, Int)
-  withIdleMsgQueue now ms@JournalMsgStore {config} rId q action =
+  withIdleMsgQueue :: Int64 -> JournalMsgStore -> JournalQueue -> (JournalMsgQueue -> StoreIO a) -> StoreIO (Maybe a, Int)
+  withIdleMsgQueue now ms@JournalMsgStore {config} q@JournalQueue {queueState} action =
    StoreIO $ readTVarIO (msgQueue_ q) >>= \case
      Nothing ->
        E.bracket
-          (unStoreIO $ getPeekMsgQueue ms rId q)
+          getNonEmptyMsgQueue
          (mapM_ $ \_ -> closeMsgQueue q)
          (maybe (pure (Nothing, 0)) (unStoreIO . run))
        where
-          run (mq, _) = do
+          run mq = do
            r <- action mq
            sz <- getQueueSize_ mq
            pure (Just r, sz)
@@ -374,38 +391,49 @@ instance MsgStoreClass JournalMsgStore where
          else pure Nothing
        sz <- unStoreIO $ getQueueSize_ mq
        pure (r, sz)
+    where
+      getNonEmptyMsgQueue :: IO (Maybe JournalMsgQueue)
+      getNonEmptyMsgQueue =
+        readTVarIO queueState >>= \case
+          Just QState {hasStored}
+            | hasStored -> Just <$> unStoreIO (getMsgQueue ms q False)
+            | otherwise -> pure Nothing
+          Nothing -> do
+            mq <- unStoreIO $ getMsgQueue ms q False
+            -- queueState was updated in getMsgQueue
+            readTVarIO queueState >>= \case
+              Just QState {hasStored} | not hasStored -> closeMsgQueue q $> Nothing
+              _ -> pure $ Just mq

-  deleteQueue :: JournalMsgStore -> RecipientId -> JournalQueue -> IO (Either ErrorType QueueRec)
-  deleteQueue ms rId q =
-    fst <$$> deleteQueue_ ms rId q
+  deleteQueue :: JournalMsgStore -> JournalQueue -> IO (Either ErrorType QueueRec)
+  deleteQueue ms q = fst <$$> deleteQueue_ ms q

-  deleteQueueSize :: JournalMsgStore -> RecipientId -> JournalQueue -> IO (Either ErrorType (QueueRec, Int))
-  deleteQueueSize ms rId q =
-    deleteQueue_ ms rId q >>= mapM (traverse getSize)
+  deleteQueueSize :: JournalMsgStore -> JournalQueue -> IO (Either ErrorType (QueueRec, Int))
+  deleteQueueSize ms q =
+    deleteQueue_ ms q >>= mapM (traverse getSize)
    -- traverse operates on the second tuple element
    where
      getSize = maybe (pure (-1)) (fmap size . readTVarIO . state)

-  getQueueMessages_ :: Bool -> JournalMsgQueue -> StoreIO [Message]
-  getQueueMessages_ drainMsgs q = StoreIO (run [])
+  getQueueMessages_ :: Bool -> JournalQueue -> JournalMsgQueue -> StoreIO [Message]
+  getQueueMessages_ drainMsgs q' q = StoreIO (run [])
    where
      run msgs = readTVarIO (handles q) >>= maybe (pure []) (getMsg msgs)
-      getMsg msgs hs = chooseReadJournal q drainMsgs hs >>= maybe (pure msgs) readMsg
+      getMsg msgs hs = chooseReadJournal q' q drainMsgs hs >>= maybe (pure msgs) readMsg
        where
          readMsg (rs, h) = do
            (msg, len) <- hGetMsgAt h $ bytePos rs
-            updateReadPos q drainMsgs len hs
+            updateReadPos q' q drainMsgs len hs
            (msg :) <$> run msgs

-  writeMsg :: JournalMsgStore -> RecipientId -> JournalQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg ms rId q' logState msg = isolateQueue rId q' "writeMsg" $ do
-    q <- getMsgQueue ms rId q'
+  writeMsg :: JournalMsgStore -> JournalQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  writeMsg ms q' logState msg = isolateQueue q' "writeMsg" $ do
+    q <- getMsgQueue ms q' True
    StoreIO $ (`E.finally` updateActiveAt q') $ do
      st@MsgQueueState {canWrite, size} <- readTVarIO (state q)
      let empty = size == 0
      if canWrite || empty
        then do
-          atomically $ writeTVar (isEmpty q') (Just False)
          let canWrt' = quota > size
          if canWrt'
            then writeToJournal q st canWrt' msg $> Just (msg, empty)
@@ -427,14 +455,13 @@ instance MsgStoreClass JournalMsgStore where
            rs' = if journalId ws == journalId rs then rs {msgCount = msgPos', byteCount = bytePos'} else rs
            !st' = st {writeState = ws', readState = rs', canWrite = canWrt', size = size + 1}
        hAppend wh (bytePos ws) msgStr
-        updateQueueState q logState hs st' $
+        updateQueueState q' q logState hs st' $
          when (size == 0) $ writeTVar (tipMsg q) $ Just (Just (msg, msgLen))
        where
          JournalMsgQueue {queue = JMQueue {queueDirectory, statePath}, handles} = q
          createQueueDir = do
            createDirectoryIfMissing True queueDirectory
            sh <- openFile statePath AppendMode
-            B.hPutStr sh ""
            rh <- createNewJournal queueDirectory $ journalId rs
            let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = Nothing}
            atomically $ writeTVar handles $ Just hs
@@ -456,7 +483,7 @@ instance MsgStoreClass JournalMsgStore where

  tryPeekMsg_ :: JournalQueue -> JournalMsgQueue -> StoreIO (Maybe Message)
  tryPeekMsg_ q mq@JournalMsgQueue {tipMsg, handles} =
-    StoreIO $ (readTVarIO handles $>>= chooseReadJournal mq True $>>= peekMsg) >>= setEmpty
+    StoreIO $ (readTVarIO handles $>>= chooseReadJournal q mq True $>>= peekMsg)
    where
      peekMsg (rs, h) = readTVarIO tipMsg >>= maybe readMsg (pure . fmap fst)
        where
@@ -464,9 +491,6 @@ instance MsgStoreClass JournalMsgStore where
            ml@(msg, _) <- hGetMsgAt h $ bytePos rs
            atomically $ writeTVar tipMsg $ Just (Just ml)
            pure $ Just msg
-      setEmpty msg = do
-        atomically $ writeTVar (isEmpty q) (Just $ isNothing msg)
-        pure msg

  tryDeleteMsg_ :: JournalQueue -> JournalMsgQueue -> Bool -> StoreIO ()
  tryDeleteMsg_ q mq@JournalMsgQueue {tipMsg, handles} logState = StoreIO $ (`E.finally` when logState (updateActiveAt q)) $
@@ -474,11 +498,11 @@ instance MsgStoreClass JournalMsgStore where
      readTVarIO tipMsg -- if there is no cached tipMsg, do nothing
        $>>= (pure . fmap snd)
        $>>= \len -> readTVarIO handles
-        $>>= \hs -> updateReadPos mq logState len hs $> Just ()
+        $>>= \hs -> updateReadPos q mq logState len hs $> Just ()

-  isolateQueue :: RecipientId -> JournalQueue -> String -> StoreIO a -> ExceptT ErrorType IO a
-  isolateQueue rId JournalQueue {queueLock} op =
-    tryStore' op rId . withLock' queueLock op . unStoreIO
+  isolateQueue :: JournalQueue -> String -> StoreIO a -> ExceptT ErrorType IO a
+  isolateQueue JournalQueue {recipientId, queueLock} op =
+    tryStore' op recipientId . withLock' queueLock op . unStoreIO

 updateActiveAt :: JournalQueue -> IO ()
 updateActiveAt q = atomically . writeTVar (activeAt q) . systemSeconds =<< getSystemTime
@@ -497,12 +521,65 @@ tryStore op rId a = ExceptT $ E.mask_ $ E.try a >>= either storeErr pure
 isolateQueueId :: String -> JournalMsgStore -> RecipientId -> IO (Either ErrorType a) -> ExceptT ErrorType IO a
 isolateQueueId op ms rId = tryStore op rId . withLockMap (queueLocks ms) rId op

-openMsgQueue :: JournalMsgStore -> JMQueue -> IO JournalMsgQueue
-openMsgQueue ms q@JMQueue {queueDirectory = dir, statePath} = do
-  (st, sh) <- readWriteQueueState ms statePath
-  (st', rh, wh_) <- closeOnException sh $ openJournals ms dir st sh
-  let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = wh_}
-  mkJournalQueue q st' (Just hs)
+openMsgQueue :: JournalMsgStore -> JMQueue -> Bool -> IO JournalMsgQueue
+openMsgQueue ms@JournalMsgStore {config} q@JMQueue {queueDirectory = dir, statePath} forWrite = do
+  (st_, shouldBackup) <- readQueueState ms statePath
+  case st_ of
+    Nothing -> do
+      st <- newMsgQueueState <$> newJournalId (random ms)
+      when shouldBackup $ backupQueueState statePath -- rename invalid state file
+      mkJournalQueue q st Nothing
+    Just st
+      | size st == 0 -> do
+          (st', hs_) <- removeJournals st shouldBackup
+          mkJournalQueue q st' hs_
+      | otherwise -> do
+          sh <- openBackupQueueState st shouldBackup
+          (st', rh, wh_) <- closeOnException sh $ openJournals ms dir st sh
+          let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = wh_}
+          mkJournalQueue q st' (Just hs)
+  where
+    -- If the queue is empty, journals are deleted.
+    -- New journal is created if queue is written to.
+    -- canWrite is set to True.
+    removeJournals MsgQueueState {readState = rs, writeState = ws} shouldBackup = E.uninterruptibleMask_ $ do
+      rjId <- newJournalId $ random ms
+      let st = newMsgQueueState rjId
+      hs_ <-
+        if forWrite
+          then Just <$> newJournalHandles st rjId
+          else Nothing <$ backupQueueState statePath
+      removeJournalIfExists dir rs
+      unless (journalId ws == journalId rs) $ removeJournalIfExists dir ws
+      pure (st, hs_)
+      where
+        newJournalHandles st rjId = do
+          sh <- openBackupQueueState st shouldBackup
+          appendState_ sh st
+          rh <- closeOnException sh $ createNewJournal dir rjId
+          pure MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = Nothing}
+    openBackupQueueState st shouldBackup
+      | shouldBackup = do
+          -- State backup is made in two steps to mitigate the crash during the backup.
+          -- Temporary backup file will be used when it is present.
+          let tempBackup = statePath <> ".bak"
+          renameFile statePath tempBackup -- 1) temp backup
+          sh <- openFile statePath AppendMode
+          closeOnException sh $ appendState sh st -- 2) save state to new file
+          backupQueueState tempBackup -- 3) timed backup
+          pure sh
+      | otherwise = openFile statePath AppendMode
+    backupQueueState path = do
+      ts <- getCurrentTime
+      renameFile path $ stateBackupPath statePath ts
+      -- remove old backups
+      times <- sort . mapMaybe backupPathTime <$> listDirectory dir
+      let toDelete = filter (< expireBackupsBefore ms) $ take (length times - keepMinBackups config) times
+      mapM_ (safeRemoveFile "removeBackups" . stateBackupPath statePath) toDelete
+      where
+        backupPathTime :: FilePath -> Maybe UTCTime
+        backupPathTime = iso8601ParseM . T.unpack <=< T.stripSuffix ".bak" <=< T.stripPrefix statePathPfx . T.pack
+        statePathPfx = T.pack $ takeFileName statePath <> "."

 mkJournalQueue :: JMQueue -> MsgQueueState -> Maybe MsgQueueHandles -> IO JournalMsgQueue
 mkJournalQueue queue st hs_ = do
@@ -513,8 +590,8 @@ mkJournalQueue queue st hs_ = do
  -- to avoid map lookup on queue operations
  pure JournalMsgQueue {queue, state, tipMsg, handles}

-chooseReadJournal :: JournalMsgQueue -> Bool -> MsgQueueHandles -> IO (Maybe (JournalState 'JTRead, Handle))
-chooseReadJournal q log' hs = do
+chooseReadJournal :: JournalQueue -> JournalMsgQueue -> Bool -> MsgQueueHandles -> IO (Maybe (JournalState 'JTRead, Handle))
+chooseReadJournal q' q log' hs = do
  st@MsgQueueState {writeState = ws, readState = rs} <- readTVarIO (state q)
  case writeHandle hs of
    Just wh | msgPos rs >= msgCount rs && journalId rs /= journalId ws -> do
@@ -524,28 +601,33 @@ chooseReadJournal q log' hs = do
      when log' $ removeJournal (queueDirectory $ queue q) rs
      let !rs' = (newJournalState $ journalId ws) {msgCount = msgCount ws, byteCount = byteCount ws}
          !st' = st {readState = rs'}
-      updateQueueState q log' hs st' $ pure ()
+      updateQueueState q' q log' hs st' $ pure ()
      pure $ Just (rs', wh)
    _ | msgPos rs >= msgCount rs && journalId rs == journalId ws -> pure Nothing
    _ -> pure $ Just (rs, readHandle hs)

-updateQueueState :: JournalMsgQueue -> Bool -> MsgQueueHandles -> MsgQueueState -> STM () -> IO ()
-updateQueueState q log' hs st a = do
+updateQueueState :: JournalQueue -> JournalMsgQueue -> Bool -> MsgQueueHandles -> MsgQueueState -> STM () -> IO ()
+updateQueueState q' q log' hs st a = do
  unless (validQueueState st) $ E.throwIO $ userError $ "updateQueueState invalid state: " <> show st
  when log' $ appendState (stateHandle hs) st
+  atomically $ writeTVar (queueState q') $ Just $! qState st
  atomically $ writeTVar (state q) st >> a

 appendState :: Handle -> MsgQueueState -> IO ()
-appendState h st = E.uninterruptibleMask_ $ B.hPutStr h $ strEncode st `B.snoc` '\n'
+appendState h = E.uninterruptibleMask_ . appendState_ h
+{-# INLINE appendState #-}

-updateReadPos :: JournalMsgQueue -> Bool -> Int64 -> MsgQueueHandles -> IO ()
-updateReadPos q log' len hs = do
+appendState_ :: Handle -> MsgQueueState -> IO ()
+appendState_ h st = B.hPutStr h $ strEncode st `B.snoc` '\n'
+
+updateReadPos :: JournalQueue -> JournalMsgQueue -> Bool -> Int64 -> MsgQueueHandles -> IO ()
+updateReadPos q' q log' len hs = do
  st@MsgQueueState {readState = rs, size} <- readTVarIO (state q)
  let JournalState {msgPos, bytePos} = rs
  let msgPos' = msgPos + 1
      rs' = rs {msgPos = msgPos', bytePos = bytePos + len}
      st' = st {readState = rs', size = size - 1}
-  updateQueueState q log' hs st' $ writeTVar (tipMsg q) Nothing
+  updateQueueState q' q log' hs st' $ writeTVar (tipMsg q) Nothing

 msgQueueDirectory :: JournalMsgStore -> RecipientId -> FilePath
 msgQueueDirectory JournalMsgStore {config = JournalStoreConfig {storePath, pathParts}} rId =
@@ -637,62 +719,57 @@ fixFileSize h pos = do
    | otherwise -> pure ()

 removeJournal :: FilePath -> JournalState t -> IO ()
-removeJournal dir JournalState {journalId} = do
+removeJournal dir JournalState {journalId} =
+  safeRemoveFile "removeJournal" $ journalFilePath dir journalId
+
+removeJournalIfExists :: FilePath -> JournalState t -> IO ()
+removeJournalIfExists dir JournalState {journalId} = do
  let path = journalFilePath dir journalId
-  removeFile path `catchAny` (\e -> logError $ "STORE: removeJournal, " <> T.pack path <> ", " <> tshow e)
+  handleError "removeJournalIfExists" path $
+    whenM (doesFileExist path) $ removeFile path
+
+safeRemoveFile :: Text -> FilePath -> IO ()
+safeRemoveFile cxt path = handleError cxt path $ removeFile path
+
+handleError :: Text -> FilePath -> IO () -> IO ()
+handleError cxt path a =
+  a `catchAny` \e -> logError $ "STORE: " <> cxt <> ", " <> T.pack path <> ", " <> tshow e

 -- This function is supposed to be resilient to crashes while updating state files,
 -- and also resilient to crashes during its execution.
-readWriteQueueState :: JournalMsgStore -> FilePath -> IO (MsgQueueState, Handle)
-readWriteQueueState JournalMsgStore {random, config} statePath =
+readQueueState :: JournalMsgStore -> FilePath -> IO (Maybe MsgQueueState, Bool)
+readQueueState JournalMsgStore {config} statePath =
  ifM
    (doesFileExist tempBackup)
-    (renameFile tempBackup statePath >> readQueueState)
-    (ifM (doesFileExist statePath) readQueueState writeNewQueueState)
+    (renameFile tempBackup statePath >> readState)
+    (ifM (doesFileExist statePath) readState $ pure (Nothing, False))
  where
    tempBackup = statePath <> ".bak"
-    readQueueState = do
+    readState = do
      ls <- B.lines <$> readFileTail
      case ls of
-        [] -> writeNewQueueState
+        [] -> do
+          logWarn $ "STORE: readWriteQueueState, empty queue state, " <> T.pack statePath
+          pure (Nothing, False)
        _ -> do
-          r@(st, _) <- useLastLine (length ls) True ls
-          unless (validQueueState st) $ E.throwIO $ userError $ "readWriteQueueState inconsistent state: " <> show st
+          r <- useLastLine (length ls) True ls
+          forM_ (fst r) $ \st ->
+            unless (validQueueState st) $ E.throwIO $ userError $ "readWriteQueueState inconsistent state: " <> show st
          pure r
-    writeNewQueueState = do
-      logWarn $ "STORE: readWriteQueueState, empty queue state - initialized, " <> T.pack statePath
-      st <- newMsgQueueState <$> newJournalId random
-      writeQueueState st
    useLastLine len isLastLine ls = case strDecode $ last ls of
-      Right st
-        | len > maxStateLines config || not isLastLine ->
-            backupWriteQueueState st
-        | otherwise -> do
-            -- when state file has fewer than maxStateLines, we don't compact it
-            sh <- openFile statePath AppendMode
-            pure (st, sh)
+      Right st ->
+        -- when state file has fewer than maxStateLines, we don't compact it
+        let shouldBackup = len > maxStateLines config || not isLastLine
+         in pure (Just st, shouldBackup)
      Left e -- if the last line failed to parse
        | isLastLine -> case init ls of -- or use the previous line
            [] -> do
              logWarn $ "STORE: readWriteQueueState, invalid 1-line queue state - initialized, " <> T.pack statePath
-              st <- newMsgQueueState <$> newJournalId random
-              backupWriteQueueState st
+              pure (Nothing, True) -- backup state file, because last line was invalid
            ls' -> do
              logWarn $ "STORE: readWriteQueueState, invalid last line in queue state - using the previous line, " <> T.pack statePath
              useLastLine len False ls'
        | otherwise -> E.throwIO $ userError $ "readWriteQueueState invalid state " <> statePath <> ": " <> show e
-    backupWriteQueueState st = do
-      -- State backup is made in two steps to mitigate the crash during the backup.
-      -- Temporary backup file will be used when it is present.
-      renameFile statePath tempBackup -- 1) temp backup
-      r <- writeQueueState st -- 2) save state
-      ts <- getCurrentTime
-      renameFile tempBackup (statePath <> "." <> iso8601Show ts <> ".bak") -- 3) timed backup
-      pure r
-    writeQueueState st = do
-      sh <- openFile statePath AppendMode
-      closeOnException sh $ appendState sh st
-      pure (st, sh)
    readFileTail =
      IO.withFile statePath ReadMode $ \h -> do
        size <- IO.hFileSize h
@@ -702,6 +779,9 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
          then IO.hSeek h AbsoluteSeek (size - sz') >> B.hGet h sz
          else B.hGet h (fromIntegral size)

+stateBackupPath :: FilePath -> UTCTime -> FilePath
+stateBackupPath statePath ts = statePath <> "." <> iso8601Show ts <> ".bak"
+
 validQueueState :: MsgQueueState -> Bool
 validQueueState MsgQueueState {readState = rs, writeState = ws, size}
  | journalId rs == journalId ws =
@@ -721,11 +801,12 @@ validQueueState MsgQueueState {readState = rs, writeState = ws, size}
        && msgPos ws == msgCount ws
        && bytePos ws == byteCount ws

-deleteQueue_ :: JournalMsgStore -> RecipientId -> JournalQueue -> IO (Either ErrorType (QueueRec, Maybe JournalMsgQueue))
-deleteQueue_ ms rId q =
+deleteQueue_ :: JournalMsgStore -> JournalQueue -> IO (Either ErrorType (QueueRec, Maybe JournalMsgQueue))
+deleteQueue_ ms q =
  runExceptT $ isolateQueueId "deleteQueue_" ms rId $
-    deleteQueue' ms rId q >>= mapM remove
+    deleteQueue' ms q >>= mapM remove
  where
+    rId = recipientId q
    remove r@(_, mq_) = do
      mapM_ closeMsgQueueHandles mq_
      removeQueueDirectory ms rId
@@ -747,8 +828,7 @@ removeQueueDirectory st = removeQueueDirectory_ . msgQueueDirectory st

 removeQueueDirectory_ :: FilePath -> IO ()
 removeQueueDirectory_ dir =
-  removePathForcibly dir `catchAny` \e ->
-    logError $ "STORE: removeQueueDirectory, " <> T.pack dir <> ", " <> tshow e
+  handleError "removeQueueDirectory" dir $ removePathForcibly dir

 hAppend :: Handle -> Int64 -> ByteString -> IO ()
 hAppend h pos s = do
@@ -26,22 +26,18 @@ import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util ((<$$>), ($>>=))
 import System.IO (IOMode (..))

 data STMMsgStore = STMMsgStore
  { storeConfig :: STMStoreConfig,
-    queues :: TMap RecipientId STMQueue,
-    senders :: TMap SenderId RecipientId,
-    notifiers :: TMap NotifierId RecipientId,
-    storeLog :: TVar (Maybe (StoreLog 'WriteMode))
+    queueStore :: STMQueueStore STMQueue
  }

 data STMQueue = STMQueue
  { -- To avoid race conditions and errors when restoring queues,
    -- Nothing is written to TVar when queue is deleted.
+    recipientId :: RecipientId,
    queueRec :: TVar (Maybe QueueRec),
    msgQueue_ :: TVar (Maybe STMMsgQueue)
  }
@@ -57,12 +53,9 @@ data STMStoreConfig = STMStoreConfig
    quota :: Int
  }

-instance STMQueueStore STMMsgStore where
-  queues' = queues
-  senders' = senders
-  notifiers' = notifiers
-  storeLog' = storeLog
-  mkQueue _ qr = STMQueue <$> newTVar (Just qr) <*> newTVar Nothing
+instance STMStoreClass STMMsgStore where
+  stmQueueStore = queueStore
+  mkQueue _ rId qr = STMQueue rId <$> newTVar (Just qr) <*> newTVar Nothing
  msgQueue_' = msgQueue_

 instance MsgStoreClass STMMsgStore where
@@ -73,32 +66,31 @@ instance MsgStoreClass STMMsgStore where

  newMsgStore :: STMStoreConfig -> IO STMMsgStore
  newMsgStore storeConfig = do
-    queues <- TM.emptyIO
-    senders <- TM.emptyIO
-    notifiers <- TM.emptyIO
-    storeLog <- newTVarIO Nothing
-    pure STMMsgStore {storeConfig, queues, senders, notifiers, storeLog}
+    queueStore <- newQueueStore
+    pure STMMsgStore {storeConfig, queueStore}

  setStoreLog :: STMMsgStore -> StoreLog 'WriteMode -> IO ()
-  setStoreLog st sl = atomically $ writeTVar (storeLog st) (Just sl)
+  setStoreLog st sl = atomically $ writeTVar (storeLog $ queueStore st) (Just sl)

-  closeMsgStore st = readTVarIO (storeLog st) >>= mapM_ closeStoreLog
-
-  activeMsgQueues = queues
-  {-# INLINE activeMsgQueues #-}
+  closeMsgStore st = readTVarIO (storeLog $ queueStore st) >>= mapM_ closeStoreLog

  withAllMsgQueues _ = withActiveMsgQueues
  {-# INLINE withAllMsgQueues #-}

  logQueueStates _ = pure ()
+  {-# INLINE logQueueStates #-}

  logQueueState _ = pure ()
+  {-# INLINE logQueueState #-}
+
+  recipientId' = recipientId
+  {-# INLINE recipientId' #-}

  queueRec' = queueRec
  {-# INLINE queueRec' #-}

-  getMsgQueue :: STMMsgStore -> RecipientId -> STMQueue -> STM STMMsgQueue
-  getMsgQueue _ _ STMQueue {msgQueue_} = readTVar msgQueue_ >>= maybe newQ pure
+  getMsgQueue :: STMMsgStore -> STMQueue -> Bool -> STM STMMsgQueue
+  getMsgQueue _ STMQueue {msgQueue_} _ = readTVar msgQueue_ >>= maybe newQ pure
    where
      newQ = do
        msgQueue <- newTQueue
@@ -108,38 +100,38 @@ instance MsgStoreClass STMMsgStore where
        writeTVar msgQueue_ (Just q)
        pure q

-  getPeekMsgQueue :: STMMsgStore -> RecipientId -> STMQueue -> STM (Maybe (STMMsgQueue, Message))
-  getPeekMsgQueue _ _ q@STMQueue {msgQueue_} = readTVar msgQueue_ $>>= \mq -> (mq,) <$$> tryPeekMsg_ q mq
+  getPeekMsgQueue :: STMMsgStore -> STMQueue -> STM (Maybe (STMMsgQueue, Message))
+  getPeekMsgQueue _ q@STMQueue {msgQueue_} = readTVar msgQueue_ $>>= \mq -> (mq,) <$$> tryPeekMsg_ q mq

  -- does not create queue if it does not exist, does not delete it if it does (can't just close in-memory queue)
-  withIdleMsgQueue :: Int64 -> STMMsgStore -> RecipientId -> STMQueue -> (STMMsgQueue -> STM a) -> STM (Maybe a, Int)
-  withIdleMsgQueue _ _ _ STMQueue {msgQueue_} action = readTVar msgQueue_ >>= \case
+  withIdleMsgQueue :: Int64 -> STMMsgStore -> STMQueue -> (STMMsgQueue -> STM a) -> STM (Maybe a, Int)
+  withIdleMsgQueue _ _ STMQueue {msgQueue_} action = readTVar msgQueue_ >>= \case
    Just q -> do
      r <- action q
      sz <- getQueueSize_ q
      pure (Just r, sz)
    Nothing -> pure (Nothing, 0)

-  deleteQueue :: STMMsgStore -> RecipientId -> STMQueue -> IO (Either ErrorType QueueRec)
-  deleteQueue ms rId q = fst <$$> deleteQueue' ms rId q
+  deleteQueue :: STMMsgStore -> STMQueue -> IO (Either ErrorType QueueRec)
+  deleteQueue ms q = fst <$$> deleteQueue' ms q

-  deleteQueueSize :: STMMsgStore -> RecipientId -> STMQueue -> IO (Either ErrorType (QueueRec, Int))
-  deleteQueueSize ms rId q = deleteQueue' ms rId q >>= mapM (traverse getSize)
+  deleteQueueSize :: STMMsgStore -> STMQueue -> IO (Either ErrorType (QueueRec, Int))
+  deleteQueueSize ms q = deleteQueue' ms q >>= mapM (traverse getSize)
    -- traverse operates on the second tuple element
    where
      getSize = maybe (pure 0) (\STMMsgQueue {size} -> readTVarIO size)

-  getQueueMessages_ :: Bool -> STMMsgQueue -> STM [Message]
-  getQueueMessages_ drainMsgs = (if drainMsgs then flushTQueue else snapshotTQueue) . msgQueue
+  getQueueMessages_ :: Bool -> STMQueue -> STMMsgQueue -> STM [Message]
+  getQueueMessages_ drainMsgs _ = (if drainMsgs then flushTQueue else snapshotTQueue) . msgQueue
    where
      snapshotTQueue q = do
        msgs <- flushTQueue q
        mapM_ (writeTQueue q) msgs
        pure msgs

-  writeMsg :: STMMsgStore -> RecipientId -> STMQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg ms rId q' _logState msg = liftIO $ atomically $ do
-    STMMsgQueue {msgQueue = q, canWrite, size} <- getMsgQueue ms rId q'
+  writeMsg :: STMMsgStore -> STMQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  writeMsg ms q' _logState msg = liftIO $ atomically $ do
+    STMMsgQueue {msgQueue = q, canWrite, size} <- getMsgQueue ms q' True
    canWrt <- readTVar canWrite
    empty <- isEmptyTQueue q
    if canWrt || empty
@@ -171,5 +163,5 @@ instance MsgStoreClass STMMsgStore where
      Just _ -> modifyTVar' size (subtract 1)
      _ -> pure ()

-  isolateQueue :: RecipientId -> STMQueue -> String -> STM a -> ExceptT ErrorType IO a
-  isolateQueue _ _ _ = liftIO . atomically
+  isolateQueue :: STMQueue -> String -> STM a -> ExceptT ErrorType IO a
+  isolateQueue _ _ = liftIO . atomically
@@ -20,7 +20,6 @@ import Control.Monad.Trans.Except
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Kind
-import qualified Data.Map.Strict as M
 import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
@@ -29,12 +28,16 @@ import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Util ((<$$>))
 import System.IO (IOMode (..))

-class MsgStoreClass s => STMQueueStore s where
-  queues' :: s -> TMap RecipientId (StoreQueue s)
-  senders' :: s -> TMap SenderId RecipientId
-  notifiers' :: s -> TMap NotifierId RecipientId
-  storeLog' :: s -> TVar (Maybe (StoreLog 'WriteMode))
-  mkQueue :: s -> QueueRec -> STM (StoreQueue s)
+data STMQueueStore q = STMQueueStore
+  { queues :: TMap RecipientId q,
+    senders :: TMap SenderId RecipientId,
+    notifiers :: TMap NotifierId RecipientId,
+    storeLog :: TVar (Maybe (StoreLog 'WriteMode))
+  }
+
+class MsgStoreClass s => STMStoreClass s where
+  stmQueueStore :: s -> STMQueueStore (StoreQueue s)
+  mkQueue :: s -> RecipientId -> QueueRec -> STM (StoreQueue s)
  msgQueue_' :: StoreQueue s -> TVar (Maybe (MsgQueue s))

 class Monad (StoreMonad s) => MsgStoreClass s where
@@ -45,25 +48,25 @@ class Monad (StoreMonad s) => MsgStoreClass s where
  newMsgStore :: MsgStoreConfig s -> IO s
  setStoreLog :: s -> StoreLog 'WriteMode -> IO ()
  closeMsgStore :: s -> IO ()
-  activeMsgQueues :: s -> TMap RecipientId (StoreQueue s)
-  withAllMsgQueues :: Monoid a => Bool -> s -> (RecipientId -> StoreQueue s -> IO a) -> IO a
+  withAllMsgQueues :: Monoid a => Bool -> s -> (StoreQueue s -> IO a) -> IO a
  logQueueStates :: s -> IO ()
  logQueueState :: StoreQueue s -> StoreMonad s ()
+  recipientId' :: StoreQueue s -> RecipientId
  queueRec' :: StoreQueue s -> TVar (Maybe QueueRec)
-  getPeekMsgQueue :: s -> RecipientId -> StoreQueue s -> StoreMonad s (Maybe (MsgQueue s, Message))
-  getMsgQueue :: s -> RecipientId -> StoreQueue s -> StoreMonad s (MsgQueue s)
+  getPeekMsgQueue :: s -> StoreQueue s -> StoreMonad s (Maybe (MsgQueue s, Message))
+  getMsgQueue :: s -> StoreQueue s -> Bool -> StoreMonad s (MsgQueue s)

  -- the journal queue will be closed after action if it was initially closed or idle longer than interval in config
-  withIdleMsgQueue :: Int64 -> s -> RecipientId -> StoreQueue s -> (MsgQueue s -> StoreMonad s a) -> StoreMonad s (Maybe a, Int)
-  deleteQueue :: s -> RecipientId -> StoreQueue s -> IO (Either ErrorType QueueRec)
-  deleteQueueSize :: s -> RecipientId -> StoreQueue s -> IO (Either ErrorType (QueueRec, Int))
-  getQueueMessages_ :: Bool -> MsgQueue s -> StoreMonad s [Message]
-  writeMsg :: s -> RecipientId -> StoreQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  withIdleMsgQueue :: Int64 -> s -> StoreQueue s -> (MsgQueue s -> StoreMonad s a) -> StoreMonad s (Maybe a, Int)
+  deleteQueue :: s -> StoreQueue s -> IO (Either ErrorType QueueRec)
+  deleteQueueSize :: s -> StoreQueue s -> IO (Either ErrorType (QueueRec, Int))
+  getQueueMessages_ :: Bool -> StoreQueue s -> MsgQueue s -> StoreMonad s [Message]
+  writeMsg :: s -> StoreQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
  setOverQuota_ :: StoreQueue s -> IO () -- can ONLY be used while restoring messages, not while server running
  getQueueSize_ :: MsgQueue s -> StoreMonad s Int
  tryPeekMsg_ :: StoreQueue s -> MsgQueue s -> StoreMonad s (Maybe Message)
  tryDeleteMsg_ :: StoreQueue s -> MsgQueue s -> Bool -> StoreMonad s ()
-  isolateQueue :: RecipientId -> StoreQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a
+  isolateQueue :: StoreQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a

 data MSType = MSMemory | MSJournal

@@ -73,28 +76,26 @@ data SMSType :: MSType -> Type where

 data AMSType = forall s. AMSType (SMSType s)

-withActiveMsgQueues :: (MsgStoreClass s, Monoid a) => s -> (RecipientId -> StoreQueue s -> IO a) -> IO a
-withActiveMsgQueues st f = readTVarIO (activeMsgQueues st) >>= foldM run mempty . M.assocs
+withActiveMsgQueues :: (STMStoreClass s, Monoid a) => s -> (StoreQueue s -> IO a) -> IO a
+withActiveMsgQueues st f = readTVarIO (queues $ stmQueueStore st) >>= foldM run mempty
  where
-    run !acc (k, v) = do
-      r <- f k v
-      pure $! acc <> r
+    run !acc = fmap (acc <>) . f

-getQueueMessages :: MsgStoreClass s => Bool -> s -> RecipientId -> StoreQueue s -> ExceptT ErrorType IO [Message]
-getQueueMessages drainMsgs st rId q = withPeekMsgQueue st rId q "getQueueSize" $ maybe (pure []) (getQueueMessages_ drainMsgs . fst)
+getQueueMessages :: MsgStoreClass s => Bool -> s -> StoreQueue s -> ExceptT ErrorType IO [Message]
+getQueueMessages drainMsgs st q = withPeekMsgQueue st q "getQueueSize" $ maybe (pure []) (getQueueMessages_ drainMsgs q . fst)
 {-# INLINE getQueueMessages #-}

-getQueueSize :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> ExceptT ErrorType IO Int
-getQueueSize st rId q = withPeekMsgQueue st rId q "getQueueSize" $ maybe (pure 0) (getQueueSize_ . fst)
+getQueueSize :: MsgStoreClass s => s -> StoreQueue s -> ExceptT ErrorType IO Int
+getQueueSize st q = withPeekMsgQueue st q "getQueueSize" $ maybe (pure 0) (getQueueSize_ . fst)
 {-# INLINE getQueueSize #-}

-tryPeekMsg :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> ExceptT ErrorType IO (Maybe Message)
-tryPeekMsg st rId q = snd <$$> withPeekMsgQueue st rId q "tryPeekMsg" pure
+tryPeekMsg :: MsgStoreClass s => s -> StoreQueue s -> ExceptT ErrorType IO (Maybe Message)
+tryPeekMsg st q = snd <$$> withPeekMsgQueue st q "tryPeekMsg" pure
 {-# INLINE tryPeekMsg #-}

-tryDelMsg :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message)
-tryDelMsg st rId q msgId' =
-  withPeekMsgQueue st rId q "tryDelMsg" $
+tryDelMsg :: MsgStoreClass s => s -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message)
+tryDelMsg st q msgId' =
+  withPeekMsgQueue st q "tryDelMsg" $
    maybe (pure Nothing) $ \(mq, msg) ->
      if
        | messageId msg == msgId' ->
@@ -102,30 +103,30 @@ tryDelMsg st rId q msgId' =
        | otherwise -> pure Nothing

 -- atomic delete (== read) last and peek next message if available
-tryDelPeekMsg :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
-tryDelPeekMsg st rId q msgId' =
-  withPeekMsgQueue st rId q "tryDelPeekMsg" $
+tryDelPeekMsg :: MsgStoreClass s => s -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
+tryDelPeekMsg st q msgId' =
+  withPeekMsgQueue st q "tryDelPeekMsg" $
    maybe (pure (Nothing, Nothing)) $ \(mq, msg) ->
      if
        | messageId msg == msgId' -> (Just msg,) <$> (tryDeleteMsg_ q mq True >> tryPeekMsg_ q mq)
        | otherwise -> pure (Nothing, Just msg)

 -- The action is called with Nothing when it is known that the queue is empty
-withPeekMsgQueue :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> String -> (Maybe (MsgQueue s, Message) -> StoreMonad s a) -> ExceptT ErrorType IO a
-withPeekMsgQueue st rId q op a = isolateQueue rId q op $ getPeekMsgQueue st rId q >>= a
+withPeekMsgQueue :: MsgStoreClass s => s -> StoreQueue s -> String -> (Maybe (MsgQueue s, Message) -> StoreMonad s a) -> ExceptT ErrorType IO a
+withPeekMsgQueue st q op a = isolateQueue q op $ getPeekMsgQueue st q >>= a
 {-# INLINE withPeekMsgQueue #-}

-deleteExpiredMsgs :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
-deleteExpiredMsgs st rId q old =
-  isolateQueue rId q "deleteExpiredMsgs" $
-    getMsgQueue st rId q >>= deleteExpireMsgs_ old q
+deleteExpiredMsgs :: MsgStoreClass s => s -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
+deleteExpiredMsgs st q old =
+  isolateQueue q "deleteExpiredMsgs" $
+    getMsgQueue st q False >>= deleteExpireMsgs_ old q

 -- closed and idle queues will be closed after expiration
 -- returns (expired count, queue size after expiration)
-idleDeleteExpiredMsgs :: MsgStoreClass s => Int64 -> s -> RecipientId -> StoreQueue s -> Int64 -> ExceptT ErrorType IO (Maybe Int, Int)
-idleDeleteExpiredMsgs now st rId q old =
-  isolateQueue rId q "idleDeleteExpiredMsgs" $
-    withIdleMsgQueue now st rId q (deleteExpireMsgs_ old q)
+idleDeleteExpiredMsgs :: MsgStoreClass s => Int64 -> s -> StoreQueue s -> Int64 -> ExceptT ErrorType IO (Maybe Int, Int)
+idleDeleteExpiredMsgs now st q old =
+  isolateQueue q "idleDeleteExpiredMsgs" $
+    withIdleMsgQueue now st q (deleteExpireMsgs_ old q)

 deleteExpireMsgs_ :: MsgStoreClass s => Int64 -> StoreQueue s -> MsgQueue s -> StoreMonad s Int
 deleteExpireMsgs_ old q mq = do
@@ -56,6 +56,7 @@ prometheusMetrics sm rtm ts =
        _qDeletedAllB,
        _qDeletedNew,
        _qDeletedSecured,
+        _qBlocked,
        _qSub,
        _qSubAllB,
        _qSubAuth,
@@ -74,6 +75,7 @@ prometheusMetrics sm rtm ts =
        _msgSentAuth,
        _msgSentQuota,
        _msgSentLarge,
+        _msgSentBlock,
        _msgRecv,
        _msgRecvGet,
        _msgGet,
@@ -122,6 +124,10 @@ prometheusMetrics sm rtm ts =
      \simplex_smp_queues_deleted{type=\"new\"} " <> mshow _qDeletedNew <> "\n# qDeletedNew\n\
      \simplex_smp_queues_deleted{type=\"secured\"} " <> mshow _qDeletedSecured <> "\n# qDeletedSecured\n\
      \\n\
+      \# HELP simplex_smp_queues_blocked Deleted queues\n\
+      \# TYPE simplex_smp_queues_blocked counter\n\
+      \simplex_smp_queues_blocked " <> mshow _qBlocked <> "\n# qBlocked\n\
+      \\n\
      \# HELP simplex_smp_queues_deleted_batch Batched requests to delete queues\n\
      \# TYPE simplex_smp_queues_deleted_batch counter\n\
      \simplex_smp_queues_deleted_batch " <> mshow _qDeletedAllB <> "\n# qDeletedAllB\n\
@@ -197,6 +203,7 @@ prometheusMetrics sm rtm ts =
      \simplex_smp_messages_sent_errors{type=\"auth\"} " <> mshow _msgSentAuth <> "\n# msgSentAuth\n\
      \simplex_smp_messages_sent_errors{type=\"quota\"} " <> mshow _msgSentQuota <> "\n# msgSentQuota\n\
      \simplex_smp_messages_sent_errors{type=\"large\"} " <> mshow _msgSentLarge <> "\n# msgSentLarge\n\
+      \simplex_smp_messages_sent_errors{type=\"block\"} " <> mshow _msgSentBlock <> "\n# msgSentBlock\n\
      \\n\
      \# HELP simplex_smp_messages_received Received messages.\n\
      \# TYPE simplex_smp_messages_received counter\n\
@@ -1,25 +1,28 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}

 module Simplex.Messaging.Server.QueueStore where

+import Control.Applicative ((<|>))
+import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol

 data QueueRec = QueueRec
-  { recipientId :: !RecipientId,
-    recipientKey :: !RcvPublicAuthKey,
+  { recipientKey :: !RcvPublicAuthKey,
    rcvDhSecret :: !RcvDhSecret,
    senderId :: !SenderId,
    senderKey :: !(Maybe SndPublicAuthKey),
    sndSecure :: !SenderCanSecure,
    notifier :: !(Maybe NtfCreds),
-    status :: !ServerQueueStatus,
+    status :: !ServerEntityStatus,
    updatedAt :: !(Maybe RoundedSystemTime)
  }
  deriving (Show)
@@ -37,7 +40,21 @@ instance StrEncoding NtfCreds where
    (notifierId, notifierKey, rcvNtfDhSecret) <- strP
    pure NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}

-data ServerQueueStatus = QueueActive | QueueOff deriving (Eq, Show)
+data ServerEntityStatus
+  = EntityActive
+  | EntityBlocked BlockingInfo
+  | EntityOff
+  deriving (Eq, Show)
+
+instance StrEncoding ServerEntityStatus where
+  strEncode = \case
+    EntityActive -> "active"
+    EntityBlocked info -> "blocked," <> strEncode info
+    EntityOff -> "off"
+  strP =
+    "active" $> EntityActive
+      <|> "blocked," *> (EntityBlocked <$> strP)
+      <|> "off" $> EntityOff

 newtype RoundedSystemTime = RoundedSystemTime Int64
  deriving (Eq, Ord, Show)
@@ -21,8 +21,11 @@ module Simplex.Messaging.Server.QueueStore.STM
    addQueueNotifier,
    deleteQueueNotifier,
    suspendQueue,
+    blockQueue,
+    unblockQueue,
    updateQueueTime,
    deleteQueue',
+    newQueueStore,
    readQueueStore,
    withLog',
  )
@@ -35,7 +38,6 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Data.Bitraversable (bimapM)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
@@ -45,83 +47,111 @@ import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.StoreLog
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (ifM, tshow, ($>>=), (<$$))
+import Simplex.Messaging.Util (ifM, safeDecodeUtf8, tshow, ($>>=), (<$$))
+import System.Exit (exitFailure)
 import System.IO
 import UnliftIO.STM

-addQueue :: STMQueueStore s => s -> QueueRec -> IO (Either ErrorType (StoreQueue s))
-addQueue st qr@QueueRec {recipientId = rId, senderId = sId, notifier}=
-  atomically add
-    $>>= \q -> q <$$ withLog "addQueue" st (`logCreateQueue` qr)
-  where
-    add = ifM hasId (pure $ Left DUPLICATE_) $ do
-      q <- mkQueue st qr -- STMQueue lock <$> (newTVar $! Just qr) <*> newTVar Nothing
-      TM.insert rId q $ queues' st
-      TM.insert sId rId $ senders' st
-      forM_ notifier $ \NtfCreds {notifierId} -> TM.insert notifierId rId $ notifiers' st
-      pure $ Right q
-    hasId = or <$> sequence [TM.member rId $ queues' st, TM.member sId $ senders' st, hasNotifier]
-    hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.member notifierId (notifiers' st)) notifier
+newQueueStore :: IO (STMQueueStore q)
+newQueueStore = do
+  queues <- TM.emptyIO
+  senders <- TM.emptyIO
+  notifiers <- TM.emptyIO
+  storeLog <- newTVarIO Nothing
+  pure STMQueueStore {queues, senders, notifiers, storeLog}

-getQueue :: (STMQueueStore s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
+addQueue :: STMStoreClass s => s -> RecipientId -> QueueRec -> IO (Either ErrorType (StoreQueue s))
+addQueue st rId qr@QueueRec {senderId = sId, notifier}=
+  atomically add
+    $>>= \q -> q <$$ withLog "addQueue" st (\s -> logCreateQueue s rId qr)
+  where
+    STMQueueStore {queues, senders, notifiers} = stmQueueStore st
+    add = ifM hasId (pure $ Left DUPLICATE_) $ do
+      q <- mkQueue st rId qr
+      TM.insert rId q queues
+      TM.insert sId rId senders
+      forM_ notifier $ \NtfCreds {notifierId} -> TM.insert notifierId rId notifiers
+      pure $ Right q
+    hasId = or <$> sequence [TM.member rId queues, TM.member sId senders, hasNotifier]
+    hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.member notifierId notifiers) notifier
+
+getQueue :: (STMStoreClass s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
 getQueue st party qId =
  maybe (Left AUTH) Right <$> case party of
-    SRecipient -> TM.lookupIO qId $ queues' st
-    SSender -> TM.lookupIO qId (senders' st) $>>= (`TM.lookupIO` queues' st)
-    SNotifier -> TM.lookupIO qId (notifiers' st) $>>= (`TM.lookupIO` queues' st)
+    SRecipient -> TM.lookupIO qId queues
+    SSender -> TM.lookupIO qId senders $>>= (`TM.lookupIO` queues)
+    SNotifier -> TM.lookupIO qId notifiers $>>= (`TM.lookupIO` queues)
+  where
+    STMQueueStore {queues, senders, notifiers} = stmQueueStore st

-getQueueRec :: (STMQueueStore s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s, QueueRec))
+getQueueRec :: (STMStoreClass s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s, QueueRec))
 getQueueRec st party qId =
  getQueue st party qId
    $>>= (\q -> maybe (Left AUTH) (Right . (q,)) <$> readTVarIO (queueRec' q))

-secureQueue :: STMQueueStore s => s -> StoreQueue s -> SndPublicAuthKey -> IO (Either ErrorType ())
+secureQueue :: STMStoreClass s => s -> StoreQueue s -> SndPublicAuthKey -> IO (Either ErrorType ())
 secureQueue st sq sKey =
  atomically (readQueueRec qr $>>= secure)
-    $>>= \rId -> withLog "secureQueue" st $ \s -> logSecureQueue s rId sKey
+    $>>= \_ -> withLog "secureQueue" st $ \s -> logSecureQueue s (recipientId' sq) sKey
  where
    qr = queueRec' sq
-    secure q@QueueRec {recipientId = rId} = case senderKey q of
-      Just k -> pure $ if sKey == k then Right rId else Left AUTH
+    secure q = case senderKey q of
+      Just k -> pure $ if sKey == k then Right () else Left AUTH
      Nothing -> do
        writeTVar qr $ Just q {senderKey = Just sKey}
-        pure $ Right rId
+        pure $ Right ()

-addQueueNotifier :: STMQueueStore s => s -> StoreQueue s -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
+addQueueNotifier :: STMStoreClass s => s -> StoreQueue s -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
 addQueueNotifier st sq ntfCreds@NtfCreds {notifierId = nId} =
  atomically (readQueueRec qr $>>= add)
-    $>>= \(rId, nId_) -> nId_ <$$ withLog "addQueueNotifier" st (\s -> logAddNotifier s rId ntfCreds)
+    $>>= \nId_ -> nId_ <$$ withLog "addQueueNotifier" st (\s -> logAddNotifier s rId ntfCreds)
  where
+    rId = recipientId' sq
    qr = queueRec' sq
-    add q@QueueRec {recipientId = rId} = ifM (TM.member nId (notifiers' st)) (pure $ Left DUPLICATE_) $ do
-      nId_ <- forM (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId (notifiers' st) $> notifierId
+    STMQueueStore {notifiers} = stmQueueStore st
+    add q = ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $ do
+      nId_ <- forM (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers $> notifierId
      let !q' = q {notifier = Just ntfCreds}
      writeTVar qr $ Just q'
-      TM.insert nId rId $ notifiers' st
-      pure $ Right (rId, nId_)
+      TM.insert nId rId notifiers
+      pure $ Right nId_

-deleteQueueNotifier :: STMQueueStore s => s -> StoreQueue s -> IO (Either ErrorType (Maybe NotifierId))
+deleteQueueNotifier :: STMStoreClass s => s -> StoreQueue s -> IO (Either ErrorType (Maybe NotifierId))
 deleteQueueNotifier st sq =
  atomically (readQueueRec qr >>= mapM delete)
-    $>>= \(rId, nId_) -> nId_ <$$ withLog "deleteQueueNotifier" st (`logDeleteNotifier` rId)
+    $>>= \nId_ -> nId_ <$$ withLog "deleteQueueNotifier" st (`logDeleteNotifier` recipientId' sq)
  where
    qr = queueRec' sq
-    delete q = fmap (recipientId q,) $ forM (notifier q) $ \NtfCreds {notifierId} -> do
-      TM.delete notifierId $ notifiers' st
+    delete q = forM (notifier q) $ \NtfCreds {notifierId} -> do
+      TM.delete notifierId $ notifiers $ stmQueueStore st
      writeTVar qr $! Just q {notifier = Nothing}
      pure notifierId

-suspendQueue :: STMQueueStore s => s -> StoreQueue s -> IO (Either ErrorType ())
+suspendQueue :: STMStoreClass s => s -> StoreQueue s -> IO (Either ErrorType ())
 suspendQueue st sq =
  atomically (readQueueRec qr >>= mapM suspend)
-    $>>= \rId -> withLog "suspendQueue" st (`logSuspendQueue` rId)
+    $>>= \_ -> withLog "suspendQueue" st (`logSuspendQueue` recipientId' sq)
  where
    qr = queueRec' sq
-    suspend q = do
-      writeTVar qr $! Just q {status = QueueOff}
-      pure $ recipientId q
+    suspend q = writeTVar qr $! Just q {status = EntityOff}

-updateQueueTime :: STMQueueStore s => s -> StoreQueue s -> RoundedSystemTime -> IO (Either ErrorType QueueRec)
+blockQueue :: STMStoreClass s => s -> StoreQueue s -> BlockingInfo -> IO (Either ErrorType ())
+blockQueue st sq info =
+  atomically (readQueueRec qr >>= mapM block)
+    $>>= \_ -> withLog "blockQueue" st (\sl -> logBlockQueue sl (recipientId' sq) info)
+  where
+    qr = queueRec' sq
+    block q = writeTVar qr $ Just q {status = EntityBlocked info}
+
+unblockQueue :: STMStoreClass s => s -> StoreQueue s -> IO (Either ErrorType ())
+unblockQueue st sq =
+  atomically (readQueueRec qr >>= mapM unblock)
+    $>>= \_ -> withLog "unblockQueue" st (`logUnblockQueue` recipientId' sq)
+  where
+    qr = queueRec' sq
+    unblock q = writeTVar qr $ Just q {status = EntityActive}
+
+updateQueueTime :: STMStoreClass s => s -> StoreQueue s -> RoundedSystemTime -> IO (Either ErrorType QueueRec)
 updateQueueTime st sq t = atomically (readQueueRec qr >>= mapM update) $>>= log'
  where
    qr = queueRec' sq
@@ -131,20 +161,21 @@ updateQueueTime st sq t = atomically (readQueueRec qr >>= mapM update) $>>= log'
          let !q' = q {updatedAt = Just t}
           in (writeTVar qr $! Just q') $> (q', True)
    log' (q, changed)
-      | changed = q <$$ withLog "updateQueueTime" st (\sl -> logUpdateQueueTime sl (recipientId q) t)
+      | changed = q <$$ withLog "updateQueueTime" st (\sl -> logUpdateQueueTime sl (recipientId' sq) t)
      | otherwise = pure $ Right q

-deleteQueue' :: STMQueueStore s => s -> RecipientId -> StoreQueue s -> IO (Either ErrorType (QueueRec, Maybe (MsgQueue s)))
-deleteQueue' st rId sq =
+deleteQueue' :: STMStoreClass s => s -> StoreQueue s -> IO (Either ErrorType (QueueRec, Maybe (MsgQueue s)))
+deleteQueue' st sq =
  atomically (readQueueRec qr >>= mapM delete)
-    $>>= \q -> withLog "deleteQueue" st (`logDeleteQueue` rId)
+    $>>= \q -> withLog "deleteQueue" st (`logDeleteQueue` recipientId' sq)
    >>= bimapM pure (\_ -> (q,) <$> atomically (swapTVar (msgQueue_' sq) Nothing))
  where
    qr = queueRec' sq
+    STMQueueStore {senders, notifiers} = stmQueueStore st
    delete q = do
      writeTVar qr Nothing
-      TM.delete (senderId q) $ senders' st
-      forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId $ notifiers' st
+      TM.delete (senderId q) senders
+      forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers
      pure q

 readQueueRec :: TVar (Maybe QueueRec) -> STM (Either ErrorType QueueRec)
@@ -161,27 +192,32 @@ withLog' name sl action =
      where
        err = name <> ", withLog, " <> show e

-withLog :: STMQueueStore s => String -> s -> (StoreLog 'WriteMode -> IO ()) -> IO (Either ErrorType ())
-withLog name = withLog' name . storeLog'
+withLog :: STMStoreClass s => String -> s -> (StoreLog 'WriteMode -> IO ()) -> IO (Either ErrorType ())
+withLog name = withLog' name . storeLog . stmQueueStore

-readQueueStore :: forall s. STMQueueStore s => FilePath -> s -> IO ()
-readQueueStore f st = withFile f ReadMode $ LB.hGetContents >=> mapM_ processLine . LB.lines
+readQueueStore :: forall s. STMStoreClass s => FilePath -> s -> IO ()
+readQueueStore f st = readLogLines False f processLine
  where
-    processLine :: LB.ByteString -> IO ()
-    processLine s' = either printError procLogRecord (strDecode s)
+    processLine :: Bool -> B.ByteString -> IO ()
+    processLine eof s = either printError procLogRecord (strDecode s)
      where
-        s = LB.toStrict s'
        procLogRecord :: StoreLogRecord -> IO ()
        procLogRecord = \case
-          CreateQueue q -> addQueue st q >>= qError (recipientId q) "CreateQueue"
+          CreateQueue rId q -> addQueue st rId q >>= qError rId "CreateQueue"
          SecureQueue qId sKey -> withQueue qId "SecureQueue" $ \q -> secureQueue st q sKey
          AddNotifier qId ntfCreds -> withQueue qId "AddNotifier" $ \q -> addQueueNotifier st q ntfCreds
          SuspendQueue qId -> withQueue qId "SuspendQueue" $ suspendQueue st
-          DeleteQueue qId -> withQueue qId "DeleteQueue" $ deleteQueue st qId
+          BlockQueue qId info -> withQueue qId "BlockQueue" $ \q -> blockQueue st q info
+          UnblockQueue qId -> withQueue qId "UnblockQueue" $ unblockQueue st
+          DeleteQueue qId -> withQueue qId "DeleteQueue" $ deleteQueue st
          DeleteNotifier qId -> withQueue qId "DeleteNotifier" $ deleteQueueNotifier st
          UpdateTime qId t -> withQueue qId "UpdateTime" $ \q -> updateQueueTime st q t
        printError :: String -> IO ()
-        printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s
+        printError e
+          | eof = logWarn err
+          | otherwise = logError err >> exitFailure
+          where
+            err = "Error parsing log: " <> T.pack e <> " - " <> safeDecodeUtf8 s
        withQueue :: forall a. RecipientId -> T.Text -> (StoreQueue s -> IO (Either ErrorType a)) -> IO ()
        withQueue qId op a = runExceptT go >>= qError qId op
          where
@@ -34,6 +34,7 @@ data ServerStats = ServerStats
    qDeletedAllB :: IORef Int,
    qDeletedNew :: IORef Int,
    qDeletedSecured :: IORef Int,
+    qBlocked :: IORef Int,
    qSub :: IORef Int, -- only includes subscriptions when there were pending messages
    -- qSubNoMsg :: IORef Int, -- this stat creates too many STM transactions
    qSubAllB :: IORef Int, -- count of all subscription batches (with and without pending messages)
@@ -53,6 +54,7 @@ data ServerStats = ServerStats
    msgSentAuth :: IORef Int,
    msgSentQuota :: IORef Int,
    msgSentLarge :: IORef Int,
+    msgSentBlock :: IORef Int,
    msgRecv :: IORef Int,
    msgRecvGet :: IORef Int,
    msgGet :: IORef Int,
@@ -89,6 +91,7 @@ data ServerStatsData = ServerStatsData
    _qDeletedAllB :: Int,
    _qDeletedNew :: Int,
    _qDeletedSecured :: Int,
+    _qBlocked :: Int,
    _qSub :: Int,
    _qSubAllB :: Int,
    _qSubAuth :: Int,
@@ -107,6 +110,7 @@ data ServerStatsData = ServerStatsData
    _msgSentAuth :: Int,
    _msgSentQuota :: Int,
    _msgSentLarge :: Int,
+    _msgSentBlock :: Int,
    _msgRecv :: Int,
    _msgRecvGet :: Int,
    _msgGet :: Int,
@@ -144,6 +148,7 @@ newServerStats ts = do
  qDeletedAllB <- newIORef 0
  qDeletedNew <- newIORef 0
  qDeletedSecured <- newIORef 0
+  qBlocked <- newIORef 0
  qSub <- newIORef 0
  qSubAllB <- newIORef 0
  qSubAuth <- newIORef 0
@@ -162,6 +167,7 @@ newServerStats ts = do
  msgSentAuth <- newIORef 0
  msgSentQuota <- newIORef 0
  msgSentLarge <- newIORef 0
+  msgSentBlock <- newIORef 0
  msgRecv <- newIORef 0
  msgRecvGet <- newIORef 0
  msgGet <- newIORef 0
@@ -196,6 +202,7 @@ newServerStats ts = do
        qDeletedAllB,
        qDeletedNew,
        qDeletedSecured,
+        qBlocked,
        qSub,
        qSubAllB,
        qSubAuth,
@@ -214,6 +221,7 @@ newServerStats ts = do
        msgSentAuth,
        msgSentQuota,
        msgSentLarge,
+        msgSentBlock,
        msgRecv,
        msgRecvGet,
        msgGet,
@@ -250,6 +258,7 @@ getServerStatsData s = do
  _qDeletedAllB <- readIORef $ qDeletedAllB s
  _qDeletedNew <- readIORef $ qDeletedNew s
  _qDeletedSecured <- readIORef $ qDeletedSecured s
+  _qBlocked <- readIORef $ qBlocked s
  _qSub <- readIORef $ qSub s
  _qSubAllB <- readIORef $ qSubAllB s
  _qSubAuth <- readIORef $ qSubAuth s
@@ -268,6 +277,7 @@ getServerStatsData s = do
  _msgSentAuth <- readIORef $ msgSentAuth s
  _msgSentQuota <- readIORef $ msgSentQuota s
  _msgSentLarge <- readIORef $ msgSentLarge s
+  _msgSentBlock <- readIORef $ msgSentBlock s
  _msgRecv <- readIORef $ msgRecv s
  _msgRecvGet <- readIORef $ msgRecvGet s
  _msgGet <- readIORef $ msgGet s
@@ -302,6 +312,7 @@ getServerStatsData s = do
        _qDeletedAllB,
        _qDeletedNew,
        _qDeletedSecured,
+        _qBlocked,
        _qSub,
        _qSubAllB,
        _qSubAuth,
@@ -320,6 +331,7 @@ getServerStatsData s = do
        _msgSentAuth,
        _msgSentQuota,
        _msgSentLarge,
+        _msgSentBlock,
        _msgRecv,
        _msgRecvGet,
        _msgGet,
@@ -357,6 +369,7 @@ setServerStats s d = do
  writeIORef (qDeletedAllB s) $! _qDeletedAllB d
  writeIORef (qDeletedNew s) $! _qDeletedNew d
  writeIORef (qDeletedSecured s) $! _qDeletedSecured d
+  writeIORef (qBlocked s) $! _qBlocked d
  writeIORef (qSub s) $! _qSub d
  writeIORef (qSubAllB s) $! _qSubAllB d
  writeIORef (qSubAuth s) $! _qSubAuth d
@@ -375,6 +388,7 @@ setServerStats s d = do
  writeIORef (msgSentAuth s) $! _msgSentAuth d
  writeIORef (msgSentQuota s) $! _msgSentQuota d
  writeIORef (msgSentLarge s) $! _msgSentLarge d
+  writeIORef (msgSentBlock s) $! _msgSentBlock d
  writeIORef (msgRecv s) $! _msgRecv d
  writeIORef (msgRecvGet s) $! _msgRecvGet d
  writeIORef (msgGet s) $! _msgGet d
@@ -411,6 +425,7 @@ instance StrEncoding ServerStatsData where
        "qDeletedNew=" <> strEncode (_qDeletedNew d),
        "qDeletedSecured=" <> strEncode (_qDeletedSecured d),
        "qDeletedAllB=" <> strEncode (_qDeletedAllB d),
+        "qBlocked=" <> strEncode (_qBlocked d),
        "qCount=" <> strEncode (_qCount d),
        "qSub=" <> strEncode (_qSub d),
        "qSubAllB=" <> strEncode (_qSubAllB d),
@@ -430,6 +445,7 @@ instance StrEncoding ServerStatsData where
        "msgSentAuth=" <> strEncode (_msgSentAuth d),
        "msgSentQuota=" <> strEncode (_msgSentQuota d),
        "msgSentLarge=" <> strEncode (_msgSentLarge d),
+        "msgSentBlock=" <> strEncode (_msgSentBlock d),
        "msgRecv=" <> strEncode (_msgRecv d),
        "msgRecvGet=" <> strEncode (_msgRecvGet d),
        "msgGet=" <> strEncode (_msgGet d),
@@ -467,6 +483,7 @@ instance StrEncoding ServerStatsData where
      (,0,0) <$> ("qDeleted=" *> strP <* A.endOfLine)
        <|> ((,,) <$> ("qDeletedAll=" *> strP <* A.endOfLine) <*> ("qDeletedNew=" *> strP <* A.endOfLine) <*> ("qDeletedSecured=" *> strP <* A.endOfLine))
    _qDeletedAllB <- opt "qDeletedAllB="
+    _qBlocked <- opt "qBlocked="
    _qCount <- opt "qCount="
    _qSub <- opt "qSub="
    _qSubNoMsg <- skipInt "qSubNoMsg=" -- skipping it for backward compatibility
@@ -487,6 +504,7 @@ instance StrEncoding ServerStatsData where
    _msgSentAuth <- opt "msgSentAuth="
    _msgSentQuota <- opt "msgSentQuota="
    _msgSentLarge <- opt "msgSentLarge="
+    _msgSentBlock <- opt "msgSentBlock="
    _msgRecv <- "msgRecv=" *> strP <* A.endOfLine
    _msgRecvGet <- opt "msgRecvGet="
    _msgGet <- opt "msgGet="
@@ -532,6 +550,7 @@ instance StrEncoding ServerStatsData where
          _qDeletedAllB,
          _qDeletedNew,
          _qDeletedSecured,
+          _qBlocked,
          _qSub,
          _qSubAllB,
          _qSubAuth,
@@ -550,6 +569,7 @@ instance StrEncoding ServerStatsData where
          _msgSentAuth,
          _msgSentQuota,
          _msgSentLarge,
+          _msgSentBlock,
          _msgRecv,
          _msgRecvGet,
          _msgGet,
@@ -21,11 +21,15 @@ module Simplex.Messaging.Server.StoreLog
    logSecureQueue,
    logAddNotifier,
    logSuspendQueue,
+    logBlockQueue,
+    logUnblockQueue,
    logDeleteQueue,
    logDeleteNotifier,
    logUpdateQueueTime,
    readWriteStoreLog,
    writeQueueStore,
+    readLogLines,
+    foldLogLines,
  )
 where

@@ -36,10 +40,13 @@ import Control.Logger.Simple
 import Control.Monad
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
+import Data.Functor (($>))
+import Data.List (sort, stripPrefix)
 import qualified Data.Map.Strict as M
+import Data.Maybe (mapMaybe)
 import qualified Data.Text as T
-import Data.Time.Clock (getCurrentTime)
-import Data.Time.Format.ISO8601 (iso8601Show)
+import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime, nominalDay)
+import Data.Time.Format.ISO8601 (iso8601Show, iso8601ParseM)
 import GHC.IO (catchAny)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
@@ -48,14 +55,17 @@ import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.StoreLog.Types
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (ifM, tshow, unlessM, whenM)
-import System.Directory (doesFileExist, renameFile)
+import System.Directory (doesFileExist, listDirectory, removeFile, renameFile)
 import System.IO
+import System.FilePath (takeDirectory, takeFileName)

 data StoreLogRecord
-  = CreateQueue QueueRec
+  = CreateQueue RecipientId QueueRec
  | SecureQueue QueueId SndPublicAuthKey
  | AddNotifier QueueId NtfCreds
  | SuspendQueue QueueId
+  | BlockQueue QueueId BlockingInfo
+  | UnblockQueue QueueId
  | DeleteQueue QueueId
  | DeleteNotifier QueueId
  | UpdateTime QueueId RoundedSystemTime
@@ -66,15 +76,16 @@ data SLRTag
  | SecureQueue_
  | AddNotifier_
  | SuspendQueue_
+  | BlockQueue_
+  | UnblockQueue_
  | DeleteQueue_
  | DeleteNotifier_
  | UpdateTime_

 instance StrEncoding QueueRec where
-  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, updatedAt} =
+  strEncode QueueRec {recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status, updatedAt} =
    B.unwords
-      [ "rid=" <> strEncode recipientId,
-        "rk=" <> strEncode recipientKey,
+      [ "rk=" <> strEncode recipientKey,
        "rdh=" <> strEncode rcvDhSecret,
        "sid=" <> strEncode senderId,
        "sk=" <> strEncode senderKey
@@ -82,13 +93,16 @@ instance StrEncoding QueueRec where
      <> sndSecureStr
      <> maybe "" notifierStr notifier
      <> maybe "" updatedAtStr updatedAt
+      <> statusStr
    where
      sndSecureStr = if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
      notifierStr ntfCreds = " notifier=" <> strEncode ntfCreds
      updatedAtStr t = " updated_at=" <> strEncode t
+      statusStr = case status of
+        EntityActive -> ""
+        _ -> " status=" <> strEncode status

  strP = do
-    recipientId <- "rid=" *> strP_
    recipientKey <- "rk=" *> strP_
    rcvDhSecret <- "rdh=" *> strP_
    senderId <- "sid=" *> strP_
@@ -96,7 +110,8 @@ instance StrEncoding QueueRec where
    sndSecure <- (" sndSecure=" *> strP) <|> pure False
    notifier <- optional $ " notifier=" *> strP
    updatedAt <- optional $ " updated_at=" *> strP
-    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status = QueueActive, updatedAt}
+    status <- (" status=" *> strP) <|> pure EntityActive
+    pure QueueRec {recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status, updatedAt}

 instance StrEncoding SLRTag where
  strEncode = \case
@@ -104,37 +119,45 @@ instance StrEncoding SLRTag where
    SecureQueue_ -> "SECURE"
    AddNotifier_ -> "NOTIFIER"
    SuspendQueue_ -> "SUSPEND"
+    BlockQueue_ -> "BLOCK"
+    UnblockQueue_ -> "UNBLOCK"
    DeleteQueue_ -> "DELETE"
    DeleteNotifier_ -> "NDELETE"
    UpdateTime_ -> "TIME"

  strP =
-    A.takeTill (== ' ') >>= \case
-      "CREATE" -> pure CreateQueue_
-      "SECURE" -> pure SecureQueue_
-      "NOTIFIER" -> pure AddNotifier_
-      "SUSPEND" -> pure SuspendQueue_
-      "DELETE" -> pure DeleteQueue_
-      "NDELETE" -> pure DeleteNotifier_
-      "TIME" -> pure UpdateTime_
-      s -> fail $ "invalid log record tag: " <> B.unpack s
+    A.choice
+      [ "CREATE" $> CreateQueue_,
+        "SECURE" $> SecureQueue_,
+        "NOTIFIER" $> AddNotifier_,
+        "SUSPEND" $> SuspendQueue_,
+        "BLOCK" $> BlockQueue_,
+        "UNBLOCK" $> UnblockQueue_,
+        "DELETE" $> DeleteQueue_,
+        "NDELETE" $> DeleteNotifier_,
+        "TIME" $> UpdateTime_
+      ]

 instance StrEncoding StoreLogRecord where
  strEncode = \case
-    CreateQueue q -> strEncode (CreateQueue_, q)
+    CreateQueue rId q -> B.unwords [strEncode CreateQueue_, "rid=" <> strEncode rId, strEncode q]
    SecureQueue rId sKey -> strEncode (SecureQueue_, rId, sKey)
    AddNotifier rId ntfCreds -> strEncode (AddNotifier_, rId, ntfCreds)
    SuspendQueue rId -> strEncode (SuspendQueue_, rId)
+    BlockQueue rId info -> strEncode (BlockQueue_, rId, info)
+    UnblockQueue rId -> strEncode (UnblockQueue_, rId)
    DeleteQueue rId -> strEncode (DeleteQueue_, rId)
    DeleteNotifier rId -> strEncode (DeleteNotifier_, rId)
    UpdateTime rId t ->  strEncode (UpdateTime_, rId, t)

  strP =
    strP_ >>= \case
-      CreateQueue_ -> CreateQueue <$> strP
+      CreateQueue_ -> CreateQueue <$> ("rid=" *> strP_) <*> strP
      SecureQueue_ -> SecureQueue <$> strP_ <*> strP
      AddNotifier_ -> AddNotifier <$> strP_ <*> strP
      SuspendQueue_ -> SuspendQueue <$> strP
+      BlockQueue_ -> BlockQueue <$> strP_ <*> strP
+      UnblockQueue_ -> UnblockQueue <$> strP
      DeleteQueue_ -> DeleteQueue <$> strP
      DeleteNotifier_ -> DeleteNotifier <$> strP
      UpdateTime_ -> UpdateTime <$> strP_ <*> strP
@@ -167,8 +190,8 @@ writeStoreLogRecord (WriteStoreLog _ h) r = E.uninterruptibleMask_ $ do
  B.hPut h $ strEncode r `B.snoc` '\n' -- hPutStrLn makes write non-atomic for length > 1024
  hFlush h

-logCreateQueue :: StoreLog 'WriteMode -> QueueRec -> IO ()
-logCreateQueue s = writeStoreLogRecord s . CreateQueue
+logCreateQueue :: StoreLog 'WriteMode -> RecipientId -> QueueRec -> IO ()
+logCreateQueue s rId q = writeStoreLogRecord s $ CreateQueue rId q

 logSecureQueue :: StoreLog 'WriteMode -> QueueId -> SndPublicAuthKey -> IO ()
 logSecureQueue s qId sKey = writeStoreLogRecord s $ SecureQueue qId sKey
@@ -179,6 +202,12 @@ logAddNotifier s qId ntfCreds = writeStoreLogRecord s $ AddNotifier qId ntfCreds
 logSuspendQueue :: StoreLog 'WriteMode -> QueueId -> IO ()
 logSuspendQueue s = writeStoreLogRecord s . SuspendQueue

+logBlockQueue :: StoreLog 'WriteMode -> QueueId -> BlockingInfo -> IO ()
+logBlockQueue s qId info = writeStoreLogRecord s $ BlockQueue qId info
+
+logUnblockQueue :: StoreLog 'WriteMode -> QueueId -> IO ()
+logUnblockQueue s = writeStoreLogRecord s . UnblockQueue
+
 logDeleteQueue :: StoreLog 'WriteMode -> QueueId -> IO ()
 logDeleteQueue s = writeStoreLogRecord s . DeleteQueue

@@ -211,6 +240,7 @@ readWriteStoreLog readStore writeStore f st =
      renameFile f tempBackup -- 1) make temp backup
      s <- writeLog "compacting store log (do not terminate)..." -- 2) save state
      renameBackup -- 3) timed backup
+      removeStoreLogBackups f
      pure s
    writeLog msg = do
      s <- openWriteStoreLog f
@@ -223,11 +253,50 @@ readWriteStoreLog readStore writeStore f st =
      renameFile tempBackup timedBackup
      logInfo $ "original state preserved as " <> T.pack timedBackup

-writeQueueStore :: STMQueueStore s => StoreLog 'WriteMode -> s -> IO ()
-writeQueueStore s st = readTVarIO (activeMsgQueues st) >>= mapM_ writeQueue . M.assocs
+writeQueueStore :: STMStoreClass s => StoreLog 'WriteMode -> s -> IO ()
+writeQueueStore s st = readTVarIO qs >>= mapM_ writeQueue . M.assocs
  where
+    qs = queues $ stmQueueStore st
    writeQueue (rId, q) =
      readTVarIO (queueRec' q) >>= \case
-        Just q' -> when (active q') $ logCreateQueue s q' -- TODO we should log suspended queues when we use them
-        Nothing -> atomically $ TM.delete rId $ activeMsgQueues st
-    active QueueRec {status} = status == QueueActive
+        Just q' -> logCreateQueue s rId q'
+        Nothing -> atomically $ TM.delete rId qs
+
+removeStoreLogBackups :: FilePath -> IO ()
+removeStoreLogBackups f = do
+  ts <- getCurrentTime
+  times <- sort . mapMaybe backupPathTime <$> listDirectory (takeDirectory f)
+  let new = addUTCTime (- nominalDay) ts
+      old = addUTCTime (- oldBackupTTL) ts
+      times1 = filter (< new) times -- exclude backups newer than 24 hours
+      times2 = take (length times1 - minOldBackups) times1 -- keep 3 backups older than 24 hours
+      toDelete = filter (< old) times2 -- remove all backups older than 21 day
+  mapM_ (removeFile . backupPath) toDelete
+  putStrLn $ "Removed " <> show (length toDelete) <> " backups:"
+  mapM_ (putStrLn . backupPath) toDelete
+  where
+    backupPathTime :: FilePath -> Maybe UTCTime
+    backupPathTime = iso8601ParseM <=< stripPrefix backupPathPfx
+    backupPath :: UTCTime -> FilePath
+    backupPath ts = f <> "." <> iso8601Show ts
+    backupPathPfx = takeFileName f <> "."
+    minOldBackups = 3
+    oldBackupTTL = 21 * nominalDay
+
+readLogLines :: Bool -> FilePath -> (Bool -> B.ByteString -> IO ()) -> IO ()
+readLogLines tty f action = foldLogLines tty f (const action) ()
+
+foldLogLines :: Bool -> FilePath -> (a -> Bool -> B.ByteString -> IO a) -> a -> IO a
+foldLogLines tty f action initValue = do
+  (count :: Int, acc) <- withFile f ReadMode $ \h -> ifM (hIsEOF h) (pure (0, initValue)) (loop h 0 initValue)
+  putStrLn $ progress count
+  pure acc
+  where
+    loop h i acc = do
+      s <- B.hGetLine h
+      eof <- hIsEOF h
+      acc' <- action acc eof s
+      let i' = i + 1
+      when (tty && i' `mod` 100000 == 0) $ putStr (progress i' <> "\r") >> hFlush stdout
+      if eof then pure (i', acc') else loop h i' acc'
+    progress i = "Processed: " <> show i <> " lines"
@@ -3,6 +3,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -14,6 +15,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}

 -- |
 -- Module      : Simplex.Messaging.Transport
@@ -36,19 +38,20 @@ module Simplex.Messaging.Transport
    supportedSMPHandshakes,
    supportedClientSMPRelayVRange,
    supportedServerSMPRelayVRange,
+    supportedProxyClientSMPRelayVRange,
    proxiedSMPRelayVRange,
+    minClientSMPRelayVersion,
+    minServerSMPRelayVersion,
    legacyServerSMPRelayVRange,
    currentClientSMPRelayVersion,
    legacyServerSMPRelayVersion,
    currentServerSMPRelayVersion,
-    batchCmdsSMPVersion,
-    basicAuthSMPVersion,
-    subModeSMPVersion,
    authCmdsSMPVersion,
    sendingProxySMPVersion,
    sndAuthKeySMPVersion,
    deletedEventSMPVersion,
    encryptedBlockSMPVersion,
+    blockedEntitySMPVersion,
    simplexMQVersion,
    smpBlockSize,
    TransportConfig (..),
@@ -89,7 +92,7 @@ where

 import Control.Applicative (optional)
 import Control.Concurrent.STM
-import Control.Monad (forM, (<$!>))
+import Control.Monad (forM, when, (<$!>))
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except (throwE)
@@ -138,10 +141,12 @@ smpBlockSize = 16384
 -- 5 - basic auth for SMP servers (11/12/2022)
 -- 6 - allow creating queues without subscribing (9/10/2023)
 -- 7 - support authenticated encryption to verify senders' commands, imply but do NOT send session ID in signed part (4/30/2024)
-- 8 - SMP proxy for sender commands
-- 9 - faster handshake: SKEY command for sender to secure queue
-- 10 - DELD event to subscriber when queue is deleted via another connnection
-- 11 - additional encryption of transport blocks with forward secrecy (9/14/2024)
+-- 8 - SMP proxy for sender commands (6/03/2024)
+-- 9 - faster handshake: SKEY command for sender to secure queue (6/30/2024)
+-- 10 - DELD event to subscriber when queue is deleted via another connnection (9/11/2024)
+-- 11 - additional encryption of transport blocks with forward secrecy (10/06/2024)
+-- 12 - BLOCKED error for blocked queues (1/11/2025)
+-- 14 - proxyServer handshake property to disable transport encryption between server and proxy (1/19/2025)

 data SMPVersion

@@ -154,14 +159,8 @@ type VersionRangeSMP = VersionRange SMPVersion
 pattern VersionSMP :: Word16 -> VersionSMP
 pattern VersionSMP v = Version v

-batchCmdsSMPVersion :: VersionSMP
-batchCmdsSMPVersion = VersionSMP 4
-
-basicAuthSMPVersion :: VersionSMP
-basicAuthSMPVersion = VersionSMP 5
-
-subModeSMPVersion :: VersionSMP
-subModeSMPVersion = VersionSMP 6
+_subModeSMPVersion :: VersionSMP
+_subModeSMPVersion = VersionSMP 6

 authCmdsSMPVersion :: VersionSMP
 authCmdsSMPVersion = VersionSMP 7
@@ -178,14 +177,26 @@ deletedEventSMPVersion = VersionSMP 10
 encryptedBlockSMPVersion :: VersionSMP
 encryptedBlockSMPVersion = VersionSMP 11

+blockedEntitySMPVersion :: VersionSMP
+blockedEntitySMPVersion = VersionSMP 12
+
+proxyServerHandshakeSMPVersion :: VersionSMP
+proxyServerHandshakeSMPVersion = VersionSMP 14
+
+minClientSMPRelayVersion :: VersionSMP
+minClientSMPRelayVersion = VersionSMP 6
+
+minServerSMPRelayVersion :: VersionSMP
+minServerSMPRelayVersion = VersionSMP 6
+
 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 11
+currentClientSMPRelayVersion = VersionSMP 14

 legacyServerSMPRelayVersion :: VersionSMP
 legacyServerSMPRelayVersion = VersionSMP 6

 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 11
+currentServerSMPRelayVersion = VersionSMP 14

 -- Max SMP protocol version to be used in e2e encrypted
 -- connection between client and server, as defined by SMP proxy.
@@ -193,20 +204,22 @@ currentServerSMPRelayVersion = VersionSMP 11
 -- to prevent client version fingerprinting by the
 -- destination relays when clients upgrade at different times.
 proxiedSMPRelayVersion :: VersionSMP
-proxiedSMPRelayVersion = VersionSMP 9
+proxiedSMPRelayVersion = VersionSMP 14

-- minimal supported protocol version is 4
+-- minimal supported protocol version is 6
 -- TODO remove code that supports sending commands without batching
 supportedClientSMPRelayVRange :: VersionRangeSMP
-supportedClientSMPRelayVRange = mkVersionRange batchCmdsSMPVersion currentClientSMPRelayVersion
+supportedClientSMPRelayVRange = mkVersionRange minClientSMPRelayVersion currentClientSMPRelayVersion

 legacyServerSMPRelayVRange :: VersionRangeSMP
-legacyServerSMPRelayVRange = mkVersionRange batchCmdsSMPVersion legacyServerSMPRelayVersion
+legacyServerSMPRelayVRange = mkVersionRange minServerSMPRelayVersion legacyServerSMPRelayVersion

 supportedServerSMPRelayVRange :: VersionRangeSMP
-supportedServerSMPRelayVRange = mkVersionRange batchCmdsSMPVersion currentServerSMPRelayVersion
+supportedServerSMPRelayVRange = mkVersionRange minServerSMPRelayVersion currentServerSMPRelayVersion
+
+supportedProxyClientSMPRelayVRange :: VersionRangeSMP
+supportedProxyClientSMPRelayVRange = mkVersionRange minServerSMPRelayVersion currentServerSMPRelayVersion

-- This range initially allows only version 8 - see the comment above.
 proxiedSMPRelayVRange :: VersionRangeSMP
 proxiedSMPRelayVRange = mkVersionRange sendingProxySMPVersion proxiedSMPRelayVersion

@@ -407,7 +420,7 @@ data THandleParams v p = THandleParams
    -- | do NOT send session ID in transmission, but include it into signed message
    -- based on protocol version
    implySessId :: Bool,
-    -- -- | additional block encryption
+    -- | keys for additional transport encryption
    encryptBlock :: Maybe TSbChainKeys,
    -- | send multiple transmissions in a single block
    -- based on protocol version
@@ -448,18 +461,28 @@ data ClientHandshake = ClientHandshake
    smpVersion :: VersionSMP,
    -- | server identity - CA certificate fingerprint
    keyHash :: C.KeyHash,
-    -- pub key to agree shared secret for entity ID encryption, shared secret for command authorization is agreed using per-queue keys.
-    authPubKey :: Maybe C.PublicKeyX25519
+    -- | pub key to agree shared secret for entity ID encryption, shared secret for command authorization is agreed using per-queue keys.
+    authPubKey :: Maybe C.PublicKeyX25519,
+    -- | Whether connecting client is a proxy server (send from SMP v12).
+    -- This property, if True, disables additional transport encrytion inside TLS.
+    -- (Proxy server connection already has additional encryption, so this layer is not needed there).
+    proxyServer :: Bool
  }

 instance Encoding ClientHandshake where
-  smpEncode ClientHandshake {smpVersion, keyHash, authPubKey} =
-    smpEncode (smpVersion, keyHash) <> encodeAuthEncryptCmds smpVersion authPubKey
+  smpEncode ClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer} =
+    smpEncode (v, keyHash)
+      <> encodeAuthEncryptCmds v authPubKey
+      <> ifHasProxy v (smpEncode proxyServer) ""
  smpP = do
-    (smpVersion, keyHash) <- smpP
+    (v, keyHash) <- smpP
    -- TODO drop SMP v6: remove special parser and make key non-optional
-    authPubKey <- authEncryptCmdsP smpVersion smpP
-    pure ClientHandshake {smpVersion, keyHash, authPubKey}
+    authPubKey <- authEncryptCmdsP v smpP
+    proxyServer <- ifHasProxy v smpP (pure False)
+    pure ClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer}
+
+ifHasProxy :: VersionSMP -> a -> a -> a
+ifHasProxy v a b = if v >= proxyServerHandshakeSMPVersion then a else b

 instance Encoding ServerHandshake where
  smpEncode ServerHandshake {smpVersionRange, sessionId, authPubKey} =
@@ -567,54 +590,70 @@ smpServerHandshake serverSignKey c (k, pk) kh smpVRange = do
      smpVersionRange = maybe legacyServerSMPRelayVRange (const smpVRange) $ getSessionALPN c
  sendHandshake th $ ServerHandshake {sessionId, smpVersionRange, authPubKey = Just (certChain, sk)}
  getHandshake th >>= \case
-    ClientHandshake {smpVersion = v, keyHash, authPubKey = k'}
+    ClientHandshake {smpVersion = v, keyHash, authPubKey = k', proxyServer}
      | keyHash /= kh ->
          throwE $ TEHandshake IDENTITY
      | otherwise ->
          case compatibleVRange' smpVersionRange v of
-            Just (Compatible vr) -> liftIO $ smpTHandleServer th v vr pk k'
+            Just (Compatible vr) -> liftIO $ smpTHandleServer th v vr pk k' proxyServer
            Nothing -> throwE TEVersion

 -- | Client SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-smpClientHandshake :: forall c. Transport c => c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> ExceptT TransportError IO (THandleSMP c 'TClient)
-smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange = do
+smpClientHandshake :: forall c. Transport c => c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> Bool -> ExceptT TransportError IO (THandleSMP c 'TClient)
+smpClientHandshake c ks_ keyHash@(C.KeyHash kh) vRange proxyServer = do
  let th@THandle {params = THandleParams {sessionId}} = smpTHandle c
  ServerHandshake {sessionId = sessId, smpVersionRange, authPubKey} <- getHandshake th
-  if sessionId /= sessId
-    then throwE TEBadSession
-    else case smpVersionRange `compatibleVRange` smpVRange of
-      Just (Compatible vr) -> do
-        ck_ <- forM authPubKey $ \certKey@(X.CertificateChain cert, exact) ->
-          liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
-            case cert of
-              [_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure ()
-              _ -> throwError "bad certificate"
-            serverKey <- getServerVerifyKey c
-            pubKey <- C.verifyX509 serverKey exact
-            (,certKey) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey)
-        let v = maxVersion vr
-        sendHandshake th $ ClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_}
-        liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_
-      Nothing -> throwE TEVersion
+  when (sessionId /= sessId) $ throwE TEBadSession
+  -- Below logic downgrades version range in case the "client" is SMP proxy server and it is
+  -- connected to the destination server of the version 11 or older.
+  -- It disables transport encryption between SMP proxy and destination relay.
+  --
+  -- Prior to version v6.3 the version between proxy and destination was capped at 8,
+  -- by mistake, which also disables transport encryption and the latest features.
+  --
+  -- Transport encryption between proxy and destination breaks clients with version 10 or earlier,
+  -- because of a larger message size (see maxMessageLength).
+  --
+  -- To summarize:
+  -- - proxy and relay version 12: the agreed version is 12, transport encryption disabled (see blockEncryption with proxyServer == True).
+  -- - proxy is v 12, relay is 11: the agreed version is 10, because of this logic, transport encryption is disabled.
+  let smpVRange =
+        if proxyServer && maxVersion smpVersionRange < proxyServerHandshakeSMPVersion
+          then vRange {maxVersion = max (minVersion vRange) deletedEventSMPVersion}
+          else vRange
+  case smpVersionRange `compatibleVRange` smpVRange of
+    Just (Compatible vr) -> do
+      ck_ <- forM authPubKey $ \certKey@(X.CertificateChain cert, exact) ->
+        liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
+          case cert of
+            [_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure ()
+            _ -> throwError "bad certificate"
+          serverKey <- getServerVerifyKey c
+          pubKey <- C.verifyX509 serverKey exact
+          (,certKey) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey)
+      let v = maxVersion vr
+      sendHandshake th $ ClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_, proxyServer}
+      liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_ proxyServer
+    Nothing -> throwE TEVersion

-smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> IO (THandleSMP c 'TServer)
-smpTHandleServer th v vr pk k_ = do
+smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> Bool -> IO (THandleSMP c 'TServer)
+smpTHandleServer th v vr pk k_ proxyServer = do
  let thAuth = Just THAuthServer {serverPrivKey = pk, sessSecret' = (`C.dh'` pk) <$!> k_}
-  be <- blockEncryption th v thAuth
+  be <- blockEncryption th v proxyServer thAuth
  pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys <$> be

-smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> IO (THandleSMP c 'TClient)
-smpTHandleClient th v vr pk_ ck_ = do
+smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> Bool -> IO (THandleSMP c 'TClient)
+smpTHandleClient th v vr pk_ ck_ proxyServer = do
  let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = forceCertChain ck, sessSecret = C.dh' k <$!> pk_}) <$!> ck_
-  be <- blockEncryption th v thAuth
+  be <- blockEncryption th v proxyServer thAuth
  -- swap is needed to use client's sndKey as server's rcvKey and vice versa
  pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys . swap <$> be

-blockEncryption :: THandleSMP c p -> VersionSMP -> Maybe (THandleAuth p) -> IO (Maybe (TVar C.SbChainKey, TVar C.SbChainKey))
-blockEncryption THandle {params = THandleParams {sessionId}} v = \case
-  Just thAuth | v >= encryptedBlockSMPVersion -> case thAuth of
+blockEncryption :: THandleSMP c p -> VersionSMP -> Bool -> Maybe (THandleAuth p) -> IO (Maybe (TVar C.SbChainKey, TVar C.SbChainKey))
+blockEncryption THandle {params = THandleParams {sessionId}} v proxyServer = \case
+  Just thAuth | not proxyServer && v >= encryptedBlockSMPVersion -> case thAuth of
    THAuthClient {sessSecret} -> be sessSecret
    THAuthServer {sessSecret'} -> be sessSecret'
  _ -> pure Nothing
@@ -159,7 +159,7 @@ safeAccept sock =
      | otherwise -> logError err >> E.throwIO e
      where
        retryAccept = maybe False ((`elem` again) . Errno) errno
-        again = [eAGAIN, eNETDOWN, ePROTO, eNOPROTOOPT, eHOSTDOWN, eNONET, eHOSTUNREACH, eOPNOTSUPP, eNETUNREACH]
+        again = [eCONNABORTED, eAGAIN, eNETDOWN, ePROTO, eNOPROTOOPT, eHOSTDOWN, eNONET, eHOSTUNREACH, eOPNOTSUPP, eNETUNREACH]
        err = "socket accept error: " <> tshow e <> maybe "" ((", errno=" <>) . tshow) errno
        errno = ioe_errno e

@@ -1,3 +1,4 @@
+{-# LANGUAGE MonadComprehensions #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}

@@ -8,6 +9,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except
+import Control.Monad.Trans.State.Strict (StateT (..))
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import Data.Bifunctor (first)
@@ -17,7 +19,7 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.IORef
 import Data.Int (Int64)
 import Data.List (groupBy, sortOn)
-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
@@ -25,6 +27,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
 import Data.Time (NominalDiffTime)
+import Data.Tuple (swap)
 import GHC.Conc (labelThread, myThreadId, threadDelay)
 import UnliftIO hiding (atomicModifyIORef')
 import qualified UnliftIO.Exception as UE
@@ -100,6 +103,47 @@ forME :: (Monad m, Traversable t) => t (Either e a) -> (a -> m (Either e b)) ->
 forME = flip mapME
 {-# INLINE forME #-}

+
+-- | Monadic version of mapAccumL
+-- Copied from ghc-9.6.3 package: https://hackage.haskell.org/package/ghc-9.12.1/docs/GHC-Utils-Monad.html#v:mapAccumLM
+-- for backward compatibility with 8.10.7.
+mapAccumLM :: (Monad m, Traversable t)
+            => (acc -> x -> m (acc, y)) -- ^ combining function
+            -> acc                      -- ^ initial state
+            -> t x                      -- ^ inputs
+            -> m (acc, t y)             -- ^ final state, outputs
+{-# INLINE [1] mapAccumLM #-}
+-- INLINE pragma.  mapAccumLM is called in inner loops.  Like 'map',
+-- we inline it so that we can take advantage of knowing 'f'.
+-- This makes a few percent difference (in compiler allocations)
+-- when compiling perf/compiler/T9675
+mapAccumLM f s = fmap swap . flip runStateT s . traverse f'
+  where
+    f' = StateT . (fmap . fmap) swap . flip f
+{-# RULES "mapAccumLM/List" mapAccumLM = mapAccumLM_List #-}
+{-# RULES "mapAccumLM/NonEmpty" mapAccumLM = mapAccumLM_NonEmpty #-}
+
+mapAccumLM_List
+ :: Monad m
+ => (acc -> x -> m (acc, y))
+ -> acc -> [x] -> m (acc, [y])
+{-# INLINE mapAccumLM_List #-}
+mapAccumLM_List f = go
+  where
+    go s (x : xs) = do
+      (s1, x')  <- f s x
+      (s2, xs') <- go s1 xs
+      return    (s2, x' : xs')
+    go s [] = return (s, [])
+
+mapAccumLM_NonEmpty
+ :: Monad m
+ => (acc -> x -> m (acc, y))
+ -> acc -> NonEmpty x -> m (acc, NonEmpty y)
+{-# INLINE mapAccumLM_NonEmpty #-}
+mapAccumLM_NonEmpty f s (x :| xs) =
+  [(s2, x' :| xs') | (s1, x') <- f s x, (s2, xs') <- mapAccumLM_List f s1 xs]
+
 catchAll :: IO a -> (E.SomeException -> IO a) -> IO a
 catchAll = E.catch
 {-# INLINE catchAll #-}
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -1,12 +1,10 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PostfixOperators #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}

 module AgentTests (agentTests) where

@@ -15,17 +13,29 @@ import AgentTests.DoubleRatchetTests (doubleRatchetTests)
 import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.MigrationTests (migrationTests)
 import AgentTests.NotificationTests (notificationTests)
-import AgentTests.SQLiteTests (storeTests)
 import AgentTests.ServerChoice (serverChoiceTests)
 import Simplex.Messaging.Transport (ATransport (..))
 import Test.Hspec
+#if defined(dbPostgres)
+import Fixtures
+import Simplex.Messaging.Agent.Store.Postgres.Util (dropAllSchemasExceptSystem)
+#else
+import AgentTests.SQLiteTests (storeTests)
+#endif

 agentTests :: ATransport -> Spec
 agentTests (ATransport t) = do
+  describe "Migration tests" migrationTests
  describe "Connection request" connectionRequestTests
  describe "Double ratchet tests" doubleRatchetTests
-  describe "Functional API" $ functionalAPITests (ATransport t)
-  describe "Notification tests" $ notificationTests (ATransport t)
+#if defined(dbPostgres)
+  after_ (dropAllSchemasExceptSystem testDBConnectInfo) $ do
+#else
+  do
+#endif
+    describe "Functional API" $ functionalAPITests (ATransport t)
+    describe "Chosen servers" serverChoiceTests
+    describe "Notification tests" $ notificationTests (ATransport t)
+#if !defined(dbPostgres)
  describe "SQLite store" storeTests
-  describe "Chosen servers" serverChoiceTests
-  describe "Migration tests" migrationTests
+#endif
@@ -585,9 +585,13 @@ testRatchetVersions =
 encrypt_ :: AlgorithmI a => Maybe PQEncryption -> (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (ByteString, Ratchet a, SkippedMsgDiff))
 encrypt_ pqEnc_ (_, rc, _) msg =
  -- print msg >>
-  runExceptT (rcEncrypt rc paddedMsgLen msg pqEnc_ currentE2EEncryptVersion)
+  runExceptT encrypt
    >>= either (pure . Left) checkLength
  where
+    encrypt = do
+      (mek, rc') <- rcEncryptHeader rc pqEnc_ currentE2EEncryptVersion
+      msg' <- rcEncryptMsg mek paddedMsgLen msg
+      pure (msg', rc')
    checkLength (msg', rc') = do
      B.length msg' `shouldBe` fullMsgLen rc'
      pure $ Right (msg', rc', SMDNoChange)
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -74,7 +75,6 @@ import Data.Time.Clock (diffUTCTime, getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Type.Equality (testEquality, (:~:) (Refl))
 import Data.Word (Word16)
-import qualified Database.SQLite.Simple as SQL
 import GHC.Stack (withFrozenCallStack)
 import SMPAgentClient
 import SMPClient (cfg, prevRange, prevVersion, testPort, testPort2, testStoreLogFile2, testStoreMsgsDir2, withSmpServer, withSmpServerConfigOn, withSmpServerProxy, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
@@ -84,8 +84,10 @@ import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestSte
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore)
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, REQ, SENT)
 import qualified Simplex.Messaging.Agent.Protocol as A
-import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), SQLiteStore (dbNew))
-import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction')
+import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction)
+import Simplex.Messaging.Agent.Store.Interface
+import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError (..))
 import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SMPProxyFallback (..), SMPProxyMode (..), TransportSessionMode (..), defaultClientConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
@@ -98,7 +100,7 @@ import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..))
 import Simplex.Messaging.Server.QueueStore.QueueInfo
-import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, basicAuthSMPVersion, batchCmdsSMPVersion, currentServerSMPRelayVersion, sndAuthKeySMPVersion, supportedSMPHandshakes)
+import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, currentServerSMPRelayVersion, minClientSMPRelayVersion, minServerSMPRelayVersion, sndAuthKeySMPVersion, supportedSMPHandshakes)
 import Simplex.Messaging.Util (bshow, diffToMicroseconds)
 import Simplex.Messaging.Version (VersionRange (..))
 import qualified Simplex.Messaging.Version as V
@@ -108,6 +110,9 @@ import Test.Hspec
 import UnliftIO
 import Util
 import XFTPClient (testXFTPServer)
+#if defined(dbPostgres)
+import Fixtures
+#endif

 type AEntityTransmission e = (ACorrId, ConnId, AEvent e)

@@ -325,6 +330,8 @@ functionalAPITests t = do
      it "should expire multiple messages" $ testExpireManyMessages t
      it "should expire one message if quota is exceeded" $ testExpireMessageQuota t
      it "should expire multiple messages if quota is exceeded" $ testExpireManyMessagesQuota t
+#if !defined(dbPostgres)
+    -- TODO [postgres] restore from outdated db backup (we use copyFile/renameFile for sqlite)
    describe "Ratchet synchronization" $ do
      it "should report ratchet de-synchronization, synchronize ratchets" $
        testRatchetSync t
@@ -336,6 +343,7 @@ functionalAPITests t = do
        testRatchetSyncSuspendForeground t
      it "should synchronize ratchets when clients start synchronization simultaneously" $
        testRatchetSyncSimultaneous t
+#endif
    describe "Subscription mode OnlyCreate" $ do
      it "messages delivered only when polled (v8 - slow handshake)" $
        withSmpServer t testOnlyCreatePullSlowHandshake
@@ -356,6 +364,7 @@ functionalAPITests t = do
    it "should suspend agent on timeout, even if pending messages not sent" $
      testSuspendingAgentTimeout t
  describe "Batching SMP commands" $ do
+    -- disable this and enable the following test to run tests with coverage
    it "should subscribe to multiple (200) subscriptions with batching" $
      testBatchedSubscriptions 200 10 t
    skip "faster version of the previous test (200 subscriptions gets very slow with test coverage)" $
@@ -418,7 +427,6 @@ functionalAPITests t = do
    describe "should switch two connections simultaneously, abort one" $
      testServerMatrix2 t testSwitch2ConnectionsAbort1
  describe "SMP basic auth" $ do
-    let v4 = prevVersion basicAuthSMPVersion
    forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do
      let baseId = if v >= sndAuthKeySMPVersion then 1 else 3
          sqSecured = if v >= sndAuthKeySMPVersion then True else False
@@ -428,20 +436,12 @@ functionalAPITests t = do
        it "disabled               " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
        it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
        it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
-        it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
        it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 1
        it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) sqSecured baseId `shouldReturn` 1
-        it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) sqSecured baseId `shouldReturn` 1
      describe ("v" <> show v <> ": no server auth") $ do
        it "success     " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 2
        it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 0
-        it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) False 3 `shouldReturn` 2
-        it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) False baseId `shouldReturn` 2
-        it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) sqSecured 3 `shouldReturn` 2
-        it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2
-        it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2
        it "auth fst    " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 2
-        it "auth fst 2  " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) False 3 `shouldReturn` 2
        it "auth snd    " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2
        it "auth both   " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2
        it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
@@ -474,7 +474,7 @@ functionalAPITests t = do

 testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int
 testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 sqSecured baseId = do
-  let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange batchCmdsSMPVersion srvVersion}
+  let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange minServerSMPRelayVersion srvVersion}
      canCreate1 = canCreateQueue allowNewQueues srv clnt1
      canCreate2 = canCreateQueue allowNewQueues srv clnt2
      expected
@@ -486,9 +486,8 @@ testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 sqSecured b
  pure created

 canCreateQueue :: Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> Bool
-canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
-  let v = basicAuthSMPVersion
-   in allowNew && (isNothing srvAuth || (srvVersion >= v && clntVersion >= v && srvAuth == clntAuth))
+canCreateQueue allowNew (srvAuth, _) (clntAuth, _) =
+  allowNew && (isNothing srvAuth || srvAuth == clntAuth)

 testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
@@ -1973,7 +1972,7 @@ testBatchedPendingMessages nCreate nMsgs =
 testSendMessagesB :: IO ()
 testSendMessagesB = withAgentClients2 $ \a b -> runRight_ $ do
  (aId, bId) <- makeConnection a b
-  let msg cId body = Right (cId, PQEncOn, SMP.noMsgFlags, body)
+  let msg cId body = Right (cId, PQEncOn, SMP.noMsgFlags, vrValue body)
  [SentB 2, SentB 3, SentB 4] <- sendMessagesB a ([msg bId "msg 1", msg "" "msg 2", msg "" "msg 3"] :: [Either AgentErrorType MsgReq])
  get a ##> ("", bId, SENT 2)
  get a ##> ("", bId, SENT 3)
@@ -1986,7 +1985,7 @@ testSendMessagesB2 :: IO ()
 testSendMessagesB2 = withAgentClients3 $ \a b c -> runRight_ $ do
  (abId, bId) <- makeConnection a b
  (acId, cId) <- makeConnection a c
-  let msg connId body = Right (connId, PQEncOn, SMP.noMsgFlags, body)
+  let msg connId body = msgVR connId $ vrValue body
  [SentB 2, SentB 3, SentB 4, SentB 2, SentB 3] <-
    sendMessagesB a ([msg bId "msg 1", msg "" "msg 2", msg "" "msg 3", msg cId "msg 4", msg "" "msg 5"] :: [Either AgentErrorType MsgReq])
  liftIO $
@@ -2003,6 +2002,23 @@ testSendMessagesB2 = withAgentClients3 $ \a b c -> runRight_ $ do
  receiveMsg b abId 4 "msg 3"
  receiveMsg c acId 2 "msg 4"
  receiveMsg c acId 3 "msg 5"
+  let msg' connId i body = msgVR connId $ VRValue (Just i) body
+  [SentB 5, SentB 6, SentB 4, SentB 5] <-
+    sendMessagesB a ([msg' bId 0 "msg 5", msg' "" 1 "msg 6", msgVR cId (VRRef 0), msgVR "" (VRRef 1)] :: [Either AgentErrorType MsgReq])
+  liftIO $
+    getInAnyOrder
+      a
+      [ \case ("", cId', AEvt SAEConn (SENT 5)) -> cId' == bId; _ -> False,
+        \case ("", cId', AEvt SAEConn (SENT 6)) -> cId' == bId; _ -> False,
+        \case ("", cId', AEvt SAEConn (SENT 4)) -> cId' == cId; _ -> False,
+        \case ("", cId', AEvt SAEConn (SENT 5)) -> cId' == cId; _ -> False
+      ]
+  receiveMsg b abId 5 "msg 5"
+  receiveMsg b abId 6 "msg 6"
+  receiveMsg c acId 4 "msg 5"
+  receiveMsg c acId 5 "msg 6"
+  where
+    msgVR connId mbr = Right (connId, PQEncOn, SMP.noMsgFlags, mbr)

 pattern SentB :: AgentMsgId -> Either AgentErrorType (AgentMsgId, PQEncryption)
 pattern SentB msgId <- Right (msgId, PQEncOn)
@@ -2057,8 +2073,8 @@ testAsyncCommands sqSecured alice bob baseId =
    ackMessageAsync alice "7" bobId (baseId + 4) Nothing
    get alice =##> \case ("7", _, OK) -> True; _ -> False
    deleteConnectionAsync alice False bobId
-    get alice =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bobId; _ -> False
-    get alice =##> \case ("", c, DEL_CONN) -> c == bobId; _ -> False
+    get alice =##> \case ("", "", DEL_RCVQS [(c, _, _, Nothing)]) -> c == bobId; _ -> False
+    get alice =##> \case ("", "", DEL_CONNS [c]) -> c == bobId; _ -> False
    liftIO $ noMessages alice "nothing else should be delivered to alice"
  where
    msgId = subtract baseId
@@ -2125,12 +2141,9 @@ testDeleteConnectionAsync t =
    runRight_ $ do
      deleteConnectionsAsync a False connIds
      nGet a =##> \case ("", "", DOWN {}) -> True; _ -> False
-      get a =##> \case ("", c, DEL_RCVQ _ _ (Just (BROKER _ e))) -> c `elem` connIds && (e == TIMEOUT || e == NETWORK); _ -> False
-      get a =##> \case ("", c, DEL_RCVQ _ _ (Just (BROKER _ e))) -> c `elem` connIds && (e == TIMEOUT || e == NETWORK); _ -> False
-      get a =##> \case ("", c, DEL_RCVQ _ _ (Just (BROKER _ e))) -> c `elem` connIds && (e == TIMEOUT || e == NETWORK); _ -> False
-      get a =##> \case ("", c, DEL_CONN) -> c `elem` connIds; _ -> False
-      get a =##> \case ("", c, DEL_CONN) -> c `elem` connIds; _ -> False
-      get a =##> \case ("", c, DEL_CONN) -> c `elem` connIds; _ -> False
+      let delOk = \case (c, _, _, Just (BROKER _ e)) -> c `elem` connIds && (e == TIMEOUT || e == NETWORK); _ -> False
+      get a =##> \case ("", "", DEL_RCVQS rs) -> length rs == 3 && all delOk rs; _ -> False
+      get a =##> \case ("", "", DEL_CONNS cs) -> length cs == 3 && all (`elem` connIds) cs; _ -> False
      liftIO $ noMessages a "nothing else should be delivered to alice"

 testWaitDeliveryNoPending :: ATransport -> IO ()
@@ -2149,8 +2162,8 @@ testWaitDeliveryNoPending t = withAgentClients2 $ \alice bob ->
    ackMessage alice bobId (baseId + 2) Nothing

    deleteConnectionsAsync alice True [bobId]
-    get alice =##> \case ("", cId, DEL_RCVQ _ _ Nothing) -> cId == bobId; _ -> False
-    get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False
+    get alice =##> \case ("", "", DEL_RCVQS [(cId, _, _, Nothing)]) -> cId == bobId; _ -> False
+    get alice =##> \case ("", "", DEL_CONNS [cId]) -> cId == bobId; _ -> False

    3 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "message 2"
    get bob =##> \case ("", cId, MERR mId (SMP _ AUTH)) -> cId == aliceId && mId == (baseId + 3); _ -> False
@@ -2186,14 +2199,14 @@ testWaitDelivery t =
        3 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
        4 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "message 1"
        deleteConnectionsAsync alice True [bobId]
-        get alice =##> \case ("", cId, DEL_RCVQ _ _ (Just (BROKER _ e))) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
+        get alice =##> \case ("", "", DEL_RCVQS [(cId, _, _, Just (BROKER _ e))]) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"

      withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
        get alice ##> ("", bobId, SENT $ baseId + 3)
        get alice ##> ("", bobId, SENT $ baseId + 4)
-        get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False
+        get alice =##> \case ("", "", DEL_CONNS [cId]) -> cId == bobId; _ -> False

        liftIO $
          getInAnyOrder
@@ -2233,8 +2246,8 @@ testWaitDeliveryAUTHErr t =
        ackMessage alice bobId (baseId + 2) Nothing

        deleteConnectionsAsync bob False [aliceId]
-        get bob =##> \case ("", cId, DEL_RCVQ _ _ Nothing) -> cId == aliceId; _ -> False
-        get bob =##> \case ("", cId, DEL_CONN) -> cId == aliceId; _ -> False
+        get bob =##> \case ("", "", DEL_RCVQS [(cId, _, _, Nothing)]) -> cId == aliceId; _ -> False
+        get bob =##> \case ("", "", DEL_CONNS [cId]) -> cId == aliceId; _ -> False

        pure (aliceId, bobId)

@@ -2243,14 +2256,14 @@ testWaitDeliveryAUTHErr t =
        3 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
        4 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "message 1"
        deleteConnectionsAsync alice True [bobId]
-        get alice =##> \case ("", cId, DEL_RCVQ _ _ (Just (BROKER _ e))) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
+        get alice =##> \case ("", "", DEL_RCVQS [(cId, _, _, Just (BROKER _ e))]) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"

      withSmpServerStoreLogOn t testPort $ \_ -> do
        get alice =##> \case ("", cId, MERR mId (SMP _ AUTH)) -> cId == bobId && mId == (baseId + 3); _ -> False
        get alice =##> \case ("", cId, MERR mId (SMP _ AUTH)) -> cId == bobId && mId == (baseId + 4); _ -> False
-        get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False
+        get alice =##> \case ("", "", DEL_CONNS [cId]) -> cId == bobId; _ -> False

        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"
@@ -2283,8 +2296,8 @@ testWaitDeliveryTimeout t =
        3 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
        4 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "message 1"
        deleteConnectionsAsync alice True [bobId]
-        get alice =##> \case ("", cId, DEL_RCVQ _ _ (Just (BROKER _ e))) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
-        get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False
+        get alice =##> \case ("", "", DEL_RCVQS [(cId, _, _, Just (BROKER _ e))]) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
+        get alice =##> \case ("", "", DEL_CONNS [cId]) -> cId == bobId; _ -> False
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"

@@ -2323,8 +2336,8 @@ testWaitDeliveryTimeout2 t =
        3 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
        4 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "message 1"
        deleteConnectionsAsync alice True [bobId]
-        get alice =##> \case ("", cId, DEL_RCVQ _ _ (Just (BROKER _ e))) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
-        get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False
+        get alice =##> \case ("", "", DEL_RCVQS [(cId, _, _, Just (BROKER _ e))]) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
+        get alice =##> \case ("", "", DEL_CONNS [cId]) -> cId == bobId; _ -> False
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"

@@ -2432,8 +2445,8 @@ testUsers =
    (aId', bId') <- makeConnectionForUsers a auId b 1
    exchangeGreetings a bId' b aId'
    deleteUser a auId True
-    get a =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bId'; _ -> False
-    get a =##> \case ("", c, DEL_CONN) -> c == bId'; _ -> False
+    get a =##> \case ("", "", DEL_RCVQS [(c, _, _, Nothing)]) -> c == bId'; _ -> False
+    get a =##> \case ("", "", DEL_CONNS [c]) -> c == bId'; _ -> False
    nGet a =##> \case ("", "", DEL_USER u) -> u == auId; _ -> False
    exchangeGreetingsMsgId 4 a bId b aId
    liftIO $ noMessages a "nothing else should be delivered to alice"
@@ -2464,8 +2477,8 @@ testUsersNoServer t = withAgentClientsCfg2 aCfg agentCfg $ \a b -> do
  nGet b =##> \case ("", "", DOWN _ cs) -> length cs == 2; _ -> False
  runRight_ $ do
    deleteUser a auId True
-    get a =##> \case ("", c, DEL_RCVQ _ _ (Just (BROKER _ e))) -> c == bId' && (e == TIMEOUT || e == NETWORK); _ -> False
-    get a =##> \case ("", c, DEL_CONN) -> c == bId'; _ -> False
+    get a =##> \case ("", "", DEL_RCVQS [(c, _, _, Just (BROKER _ e))]) -> c == bId' && (e == TIMEOUT || e == NETWORK); _ -> False
+    get a =##> \case ("", "", DEL_CONNS [c]) -> c == bId'; _ -> False
    nGet a =##> \case ("", "", DEL_USER u) -> u == auId; _ -> False
    liftIO $ noMessages a "nothing else should be delivered to alice"
  withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
@@ -2561,7 +2574,7 @@ testSwitchAsync servers = do
    withB :: (AgentClient -> IO a) -> IO a
    withB = withAgent 2 agentCfg servers testDB2

-withAgent :: HasCallStack => Int -> AgentConfig -> InitialAgentServers -> FilePath -> (HasCallStack => AgentClient -> IO a) -> IO a
+withAgent :: HasCallStack => Int -> AgentConfig -> InitialAgentServers -> String -> (HasCallStack => AgentClient -> IO a) -> IO a
 withAgent clientId cfg' servers dbPath = bracket (getSMPAgentClient' clientId cfg' servers dbPath) (\a -> disposeAgentClient a >> threadDelay 100000)

 sessionSubscribe :: (forall a. (AgentClient -> IO a) -> IO a) -> [ConnId] -> (AgentClient -> ExceptT AgentErrorType IO ()) -> IO ()
@@ -2583,9 +2596,8 @@ testSwitchDelete servers =
    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
    deleteConnectionAsync a False 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
+    get a =##> \case ("", "", DEL_RCVQS [(c, _, _, Nothing), (c', _, _, Nothing)]) -> c == bId && c' == bId; _ -> False
+    get a =##> \case ("", "", DEL_CONNS [c]) -> c == bId; _ -> False
    liftIO $ noMessages a "nothing else should be delivered to alice"

 testAbortSwitchStarted :: HasCallStack => InitialAgentServers -> IO ()
@@ -2882,7 +2894,7 @@ testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId = do
    getClient clientId (clntAuth, clntVersion) db =
      let servers = initAgentServers {smp = userServers' [ProtoServerWithAuth testSMPServer clntAuth]}
          alpn_ = if clntVersion >= authCmdsSMPVersion then Just supportedSMPHandshakes else Nothing
-          smpCfg = defaultClientConfig alpn_ False $ V.mkVersionRange (prevVersion basicAuthSMPVersion) clntVersion
+          smpCfg = defaultClientConfig alpn_ False $ V.mkVersionRange minClientSMPRelayVersion clntVersion
          sndAuthAlg = if srvVersion >= authCmdsSMPVersion && clntVersion >= authCmdsSMPVersion then C.AuthAlg C.SX25519 else C.AuthAlg C.SEd25519
       in getSMPAgentClient' clientId agentCfg {smpCfg, sndAuthAlg} servers db

@@ -3091,13 +3103,27 @@ testTwoUsers = withAgentClients2 $ \a b -> do
    hasClients :: HasCallStack => AgentClient -> Int -> ExceptT AgentErrorType IO ()
    hasClients c n = liftIO $ M.size <$> readTVarIO (smpClients c) `shouldReturn` n

-getSMPAgentClient' :: Int -> AgentConfig -> InitialAgentServers -> FilePath -> IO AgentClient
+getSMPAgentClient' :: Int -> AgentConfig -> InitialAgentServers -> String -> IO AgentClient
 getSMPAgentClient' clientId cfg' initServers dbPath = do
-  Right st <- liftIO $ createAgentStore dbPath "" False MCError
+  Right st <- liftIO $ createStore dbPath
  c <- getSMPAgentClient_ clientId cfg' initServers st False
-  when (dbNew st) $ withTransaction' st (`SQL.execute_` "INSERT INTO users (user_id) VALUES (1)")
+  when (dbNew st) $ insertUser st
  pure c

+#if defined(dbPostgres)
+createStore :: String -> IO (Either MigrationError DBStore)
+createStore schema = createAgentStore (DBOpts testDBConnstr schema) MCError
+
+insertUser :: DBStore -> IO ()
+insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users DEFAULT VALUES")
+#else
+createStore :: String -> IO (Either MigrationError DBStore)
+createStore dbPath = createAgentStore (DBOpts dbPath "" False True DB.TQOff) MCError
+
+insertUser :: DBStore -> IO ()
+insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) VALUES (1)")
+#endif
+
 testServerMultipleIdentities :: HasCallStack => IO ()
 testServerMultipleIdentities =
  withAgentClients2 $ \alice bob -> runRight_ $ do
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}

 module AgentTests.MigrationTests (migrationTests) where
@@ -5,13 +6,22 @@ module AgentTests.MigrationTests (migrationTests) where
 import Control.Monad
 import Data.Maybe (fromJust)
 import Data.Word (Word32)
-import Database.SQLite.Simple (fromOnly)
-import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError (MEDowngrade, MEUpgrade, MigrationError), SQLiteStore, closeSQLiteStore, createSQLiteStore, upMigration, withTransaction)
-import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import Simplex.Messaging.Agent.Store.SQLite.Migrations
-import System.Directory (removeFile)
+import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
+import Simplex.Messaging.Agent.Store.Interface
+import Simplex.Messaging.Agent.Store.Migrations (migrationsToRun)
+import Simplex.Messaging.Agent.Store.Shared
 import System.Random (randomIO)
 import Test.Hspec
+#if defined(dbPostgres)
+import Database.PostgreSQL.Simple (fromOnly)
+import Fixtures
+import Simplex.Messaging.Agent.Store.Postgres.Util (dropSchema)
+import qualified Simplex.Messaging.Agent.Store.Postgres.DB as DB
+#else
+import Database.SQLite.Simple (fromOnly)
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import System.Directory (removeFile)
+#endif

 migrationTests :: Spec
 migrationTests = do
@@ -95,9 +105,6 @@ migrationTests = do
        ([m1, m2, m3, m4], [t1, t2, t3, t4])
        ([m1, m2, m4], [MCYesUp, MCYesUpDown, MCError], Left . MigrationError $ MTREDifferent (name m4) (name m3))

-testDB :: FilePath
-testDB = "tests/tmp/test_migrations.db"
-
 m1 :: Migration
 m1 = Migration "20230301-migration1" "create table test1 (id1 integer primary key);" Nothing

@@ -177,21 +184,60 @@ testMigration ::
  IO ()
 testMigration (initMs, initTables) (finalMs, confirmModes, tablesOrError) = forM_ confirmModes $ \confirmMode -> do
  r <- randomIO :: IO Word32
-  let dpPath = testDB <> show r
-  Right st <- createSQLiteStore dpPath "" False initMs MCError
+  Right st <- createStore r initMs MCError
  st `shouldHaveTables` initTables
-  closeSQLiteStore st
+  closeDBStore st
  case tablesOrError of
    Right tables -> do
-      Right st' <- createSQLiteStore dpPath "" False finalMs confirmMode
+      Right st' <- createStore r finalMs confirmMode
      st' `shouldHaveTables` tables
-      closeSQLiteStore st'
+      closeDBStore st'
    Left e -> do
-      Left e' <- createSQLiteStore dpPath "" False finalMs confirmMode
+      Left e' <- createStore r finalMs confirmMode
      e `shouldBe` e'
-  removeFile dpPath
-  where
-    shouldHaveTables :: SQLiteStore -> [String] -> IO ()
-    st `shouldHaveTables` expected = do
-      tables <- map fromOnly <$> withTransaction st (`DB.query_` "SELECT name FROM sqlite_schema WHERE type = 'table' AND name NOT LIKE 'sqlite_%' ORDER BY 1;")
-      tables `shouldBe` "migrations" : expected
+  cleanup r
+
+#if defined(dbPostgres)
+testSchema :: Word32 -> String
+testSchema randSuffix = "test_migrations_schema" <> show randSuffix
+
+createStore :: Word32 -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
+createStore randSuffix migrations confirmMigrations = do
+  let dbOpts =
+        DBOpts {
+          connstr = testDBConnstr,
+          schema = testSchema randSuffix
+        }
+  createDBStore dbOpts migrations confirmMigrations
+
+cleanup :: Word32 -> IO ()
+cleanup randSuffix = dropSchema testDBConnectInfo (testSchema randSuffix)
+
+shouldHaveTables :: DBStore -> [String] -> IO ()
+st `shouldHaveTables` expected = do
+  tables <- map fromOnly <$> withTransaction st (`DB.query_` "SELECT table_name FROM information_schema.tables WHERE table_schema = current_schema() AND table_type = 'BASE TABLE' ORDER BY 1")
+  tables `shouldBe` "migrations" : expected
+#else
+testDB :: Word32 -> FilePath
+testDB randSuffix = "tests/tmp/test_migrations.db" <> show randSuffix
+
+createStore :: Word32 -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
+createStore randSuffix migrations confirmMigrations = do
+  let dbOpts =
+        DBOpts {
+          dbFilePath = testDB randSuffix,
+          dbKey = "",
+          keepKey = False,
+          vacuum = True,
+          track = DB.TQOff
+        }
+  createDBStore dbOpts migrations confirmMigrations
+
+cleanup :: Word32 -> IO ()
+cleanup randSuffix = removeFile (testDB randSuffix)
+
+shouldHaveTables :: DBStore -> [String] -> IO ()
+st `shouldHaveTables` expected = do
+  tables <- map fromOnly <$> withTransaction st (`DB.query_` "SELECT name FROM sqlite_schema WHERE type = 'table' AND name NOT LIKE 'sqlite_%' ORDER BY 1")
+  tables `shouldBe` "migrations" : expected
+#endif
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -52,17 +53,21 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
+import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
-import Database.SQLite.Simple.QQ (sql)
+import qualified Data.Text.IO as TIO
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
-import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, testStoreMsgsDir2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
+import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, testStoreMsgsDir2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn, xit'')
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, SENT)
-import Simplex.Messaging.Agent.Store.SQLite (closeSQLiteStore, getSavedNtfToken, reopenSQLiteStore, withTransaction)
-import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import Simplex.Messaging.Agent.Store.AgentStore (getSavedNtfToken)
+import Simplex.Messaging.Agent.Store.Common (withTransaction)
+import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Agent.Store.Interface (closeDBStore, reopenDBStore)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
@@ -74,14 +79,13 @@ import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), NtfSer
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Transport (ATransport)
-import System.Directory (doesFileExist, removeFile)
 import Test.Hspec
 import UnliftIO
-
-removeFileIfExists :: FilePath -> IO ()
-removeFileIfExists filePath = do
-  fileExists <- doesFileExist filePath
-  when fileExists $ removeFile filePath
+#if defined(dbPostgres)
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+#else
+import Database.SQLite.Simple.QQ (sql)
+#endif

 notificationTests :: ATransport -> Spec
 notificationTests t = do
@@ -116,6 +120,12 @@ notificationTests t = do
    it "should keep working with active token until replaced" $
      withAPNSMockServer $ \apns ->
        testNtfTokenChangeServers t apns
+    xit'' "should re-register token in NTInvalid status after register attempt" $
+      withAPNSMockServer $ \apns ->
+        testNtfTokenReRegisterInvalid t apns
+    xit'' "should re-register token in NTInvalid status after checking token" $
+      withAPNSMockServer $ \apns ->
+        testNtfTokenReRegisterInvalidOnCheck t apns
  describe "notification server tests" $ do
    it "should pass" $ testRunNTFServerTests t testNtfServer `shouldReturn` Nothing
    let srv1 = testNtfServer {keyHash = "1234"}
@@ -458,6 +468,58 @@ testNtfTokenChangeServers t apns =
        tkn <- registerTestToken a "qwer" NMInstant apns
        checkNtfToken a tkn >>= \r -> liftIO $ r `shouldBe` NTActive

+testNtfTokenReRegisterInvalid :: ATransport -> APNSMockServer -> IO ()
+testNtfTokenReRegisterInvalid t apns = do
+  tkn <- withNtfServerStoreLog t $ \_ -> do
+    withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ do
+      tkn <- registerTestToken a "abcd" NMInstant apns
+      NTActive <- checkNtfToken a tkn
+      pure tkn
+
+  threadDelay 250000
+  -- start server to compact
+  withNtfServerStoreLog t $ \_ -> pure ()
+
+  threadDelay 250000
+  replaceSubstringInFile ntfTestStoreLogFile "tokenStatus=ACTIVE" "tokenStatus=INVALID"
+
+  threadDelay 250000
+  withNtfServerStoreLog t $ \_ -> do
+    withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
+      NTInvalid Nothing <- registerNtfToken a tkn NMInstant
+      tkn1 <- registerTestToken a "abcd" NMInstant apns
+      NTActive <- checkNtfToken a tkn1
+      pure ()
+
+replaceSubstringInFile :: FilePath -> Text -> Text -> IO ()
+replaceSubstringInFile filePath oldText newText = do
+  content <- TIO.readFile filePath
+  let newContent = T.replace oldText newText content
+  TIO.writeFile filePath newContent
+
+testNtfTokenReRegisterInvalidOnCheck :: ATransport -> APNSMockServer -> IO ()
+testNtfTokenReRegisterInvalidOnCheck t apns = do
+  tkn <- withNtfServerStoreLog t $ \_ -> do
+    withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ do
+      tkn <- registerTestToken a "abcd" NMInstant apns
+      NTActive <- checkNtfToken a tkn
+      pure tkn
+
+  threadDelay 250000
+  -- start server to compact
+  withNtfServerStoreLog t $ \_ -> pure ()
+
+  threadDelay 250000
+  replaceSubstringInFile ntfTestStoreLogFile "tokenStatus=ACTIVE" "tokenStatus=INVALID"
+
+  threadDelay 250000
+  withNtfServerStoreLog t $ \_ -> do
+    withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
+      NTInvalid Nothing <- checkNtfToken a tkn
+      tkn1 <- registerTestToken a "abcd" NMInstant apns
+      NTActive <- checkNtfToken a tkn1
+      pure ()
+
 testRunNTFServerTests :: ATransport -> NtfServer -> IO (Maybe ProtocolTestFailure)
 testRunNTFServerTests t srv =
  withNtfServerOn t ntfTestPort $
@@ -500,7 +562,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag

  threadDelay 500000
  suspendAgent alice 0
-  closeSQLiteStore store
+  closeDBStore store
  threadDelay 1000000
  putStrLn "before opening the database from another agent"

@@ -511,7 +573,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag

  threadDelay 1000000
  putStrLn "after closing the database in another agent"
-  reopenSQLiteStore store
+  reopenDBStore store
  foregroundAgent alice
  threadDelay 500000

@@ -41,10 +41,12 @@ import Simplex.FileTransfer.Types
 import Simplex.Messaging.Agent.Client ()
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store
+import Simplex.Messaging.Agent.Store.AgentStore
+import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
 import Simplex.Messaging.Agent.Store.SQLite
-import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction')
+import Simplex.Messaging.Agent.Store.SQLite.Common (DBStore (..), withTransaction')
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
+import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), pattern PQSupportOn)
@@ -59,36 +61,36 @@ import UnliftIO.Directory (removeFile)
 testDB :: String
 testDB = "tests/tmp/smp-agent.test.db"

-withStore :: SpecWith SQLiteStore -> Spec
-withStore = before createStore . after removeStore
+withStore :: SpecWith DBStore -> Spec
+withStore = before createStore' . after removeStore

-withStore2 :: SpecWith (SQLiteStore, SQLiteStore) -> Spec
+withStore2 :: SpecWith (DBStore, DBStore) -> Spec
 withStore2 = before connect2 . after (removeStore . fst)
  where
-    connect2 :: IO (SQLiteStore, SQLiteStore)
+    connect2 :: IO (DBStore, DBStore)
    connect2 = do
-      s1 <- createStore
-      s2 <- connectSQLiteStore (dbFilePath s1) "" False
+      s1@DBStore {dbFilePath} <- createStore'
+      s2 <- connectSQLiteStore dbFilePath "" False DB.TQOff
      pure (s1, s2)

-createStore :: IO SQLiteStore
-createStore = createEncryptedStore "" False
+createStore' :: IO DBStore
+createStore' = createEncryptedStore "" False

-createEncryptedStore :: ScrubbedBytes -> Bool -> IO SQLiteStore
+createEncryptedStore :: ScrubbedBytes -> Bool -> IO DBStore
 createEncryptedStore key keepKey = do
  -- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous
  -- IO operations on multiple similarly named files; error seems to be environment specific
  r <- randomIO :: IO Word32
-  Right st <- createSQLiteStore (testDB <> show r) key keepKey Migrations.app MCError
+  Right st <- createDBStore (DBOpts (testDB <> show r) key keepKey True DB.TQOff) appMigrations MCError
  withTransaction' st (`SQL.execute_` "INSERT INTO users (user_id) VALUES (1);")
  pure st

-removeStore :: SQLiteStore -> IO ()
-removeStore db = do
+removeStore :: DBStore -> IO ()
+removeStore db@DBStore {dbFilePath} = do
  close db
-  removeFile $ dbFilePath db
+  removeFile dbFilePath
  where
-    close :: SQLiteStore -> IO ()
+    close :: DBStore -> IO ()
    close st = mapM_ DB.close =<< tryTakeMVar (dbConnection st)

 storeTests :: Spec
@@ -147,7 +149,7 @@ storeTests = do
    it "should close and re-open encrypted store" testCloseReopenEncryptedStore
    it "should close and re-open encrypted store (keep key)" testReopenEncryptedStoreKeepKey

-testConcurrentWrites :: SpecWith (SQLiteStore, SQLiteStore)
+testConcurrentWrites :: SpecWith (DBStore, DBStore)
 testConcurrentWrites =
  it "should complete multiple concurrent write transactions w/t sqlite busy errors" $ \(s1, s2) -> do
    g <- C.newRandom
@@ -156,22 +158,22 @@ testConcurrentWrites =
    let ConnData {connId} = cData1
    concurrently_ (runTest s1 connId rq) (runTest s2 connId rq)
  where
-    runTest :: SQLiteStore -> ConnId -> RcvQueue -> IO ()
+    runTest :: DBStore -> ConnId -> RcvQueue -> IO ()
    runTest st connId rq = replicateM_ 100 . withTransaction st $ \db -> do
      (internalId, internalRcvId, _, _) <- updateRcvIds db connId
      let rcvMsgData = mkRcvMsgData internalId internalRcvId 0 "0" "hash_dummy"
      createRcvMsg db connId rq rcvMsgData

-testCompiledThreadsafe :: SpecWith SQLiteStore
+testCompiledThreadsafe :: SpecWith DBStore
 testCompiledThreadsafe =
  it "compiled sqlite library should be threadsafe" . withStoreTransaction $ \db -> do
    compileOptions <- DB.query_ db "pragma COMPILE_OPTIONS;" :: IO [[T.Text]]
    compileOptions `shouldNotContain` [["THREADSAFE=0"]]

-withStoreTransaction :: (DB.Connection -> IO a) -> SQLiteStore -> IO a
+withStoreTransaction :: (DB.Connection -> IO a) -> DBStore -> IO a
 withStoreTransaction = flip withTransaction

-testForeignKeysEnabled :: SpecWith SQLiteStore
+testForeignKeysEnabled :: SpecWith DBStore
 testForeignKeysEnabled =
  it "foreign keys should be enabled" . withStoreTransaction $ \db -> do
    let inconsistentQuery =
@@ -261,7 +263,7 @@ createRcvConn db g cData rq cMode = runExceptT $ do
  rq' <- ExceptT $ updateNewConnRcv db connId rq
  pure (connId, rq')

-testCreateRcvConn :: SpecWith SQLiteStore
+testCreateRcvConn :: SpecWith DBStore
 testCreateRcvConn =
  it "should create RcvConnection and add SndQueue" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -275,7 +277,7 @@ testCreateRcvConn =
    getConn db "conn1"
      `shouldReturn` Right (SomeConn SCDuplex (DuplexConnection cData1 [rq] [sq]))

-testCreateRcvConnRandomId :: SpecWith SQLiteStore
+testCreateRcvConnRandomId :: SpecWith DBStore
 testCreateRcvConnRandomId =
  it "should create RcvConnection and add SndQueue with random ID" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -287,7 +289,7 @@ testCreateRcvConnRandomId =
    getConn db connId
      `shouldReturn` Right (SomeConn SCDuplex (DuplexConnection cData1 {connId} [rq] [sq]))

-testCreateRcvConnDuplicate :: SpecWith SQLiteStore
+testCreateRcvConnDuplicate :: SpecWith DBStore
 testCreateRcvConnDuplicate =
  it "should throw error on attempt to create duplicate RcvConnection" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -295,7 +297,7 @@ testCreateRcvConnDuplicate =
    createRcvConn db g cData1 rcvQueue1 SCMInvitation
      `shouldReturn` Left SEConnDuplicate

-testCreateSndConn :: SpecWith SQLiteStore
+testCreateSndConn :: SpecWith DBStore
 testCreateSndConn =
  it "should create SndConnection and add RcvQueue" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -309,7 +311,7 @@ testCreateSndConn =
    getConn db "conn1"
      `shouldReturn` Right (SomeConn SCDuplex (DuplexConnection cData1 [rq] [sq]))

-testCreateSndConnRandomID :: SpecWith SQLiteStore
+testCreateSndConnRandomID :: SpecWith DBStore
 testCreateSndConnRandomID =
  it "should create SndConnection and add RcvQueue with random ID" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -321,7 +323,7 @@ testCreateSndConnRandomID =
    getConn db connId
      `shouldReturn` Right (SomeConn SCDuplex (DuplexConnection cData1 {connId} [rq] [sq]))

-testCreateSndConnDuplicate :: SpecWith SQLiteStore
+testCreateSndConnDuplicate :: SpecWith DBStore
 testCreateSndConnDuplicate =
  it "should throw error on attempt to create duplicate SndConnection" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -329,7 +331,7 @@ testCreateSndConnDuplicate =
    createSndConn db g cData1 sndQueue1
      `shouldReturn` Left SEConnDuplicate

-testGetRcvConn :: SpecWith SQLiteStore
+testGetRcvConn :: SpecWith DBStore
 testGetRcvConn =
  it "should get connection using rcv queue id and server" . withStoreTransaction $ \db -> do
    let smpServer = SMPServer "smp.simplex.im" "5223" testKeyHash
@@ -339,7 +341,7 @@ testGetRcvConn =
    getRcvConn db smpServer recipientId
      `shouldReturn` Right (rq, SomeConn SCRcv (RcvConnection cData1 rq))

-testSetConnUserIdNewConn :: SpecWith SQLiteStore
+testSetConnUserIdNewConn :: SpecWith DBStore
 testSetConnUserIdNewConn =
  it "should set user id for new connection" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -352,9 +354,9 @@ testSetConnUserIdNewConn =
        let ConnData {userId} = connData
        userId `shouldBe` newUserId
      _ -> do
-         expectationFailure "Failed to get connection"
+        expectationFailure "Failed to get connection"

-testDeleteRcvConn :: SpecWith SQLiteStore
+testDeleteRcvConn :: SpecWith DBStore
 testDeleteRcvConn =
  it "should create RcvConnection and delete it" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -366,7 +368,7 @@ testDeleteRcvConn =
    getConn db "conn1"
      `shouldReturn` Left SEConnNotFound

-testDeleteSndConn :: SpecWith SQLiteStore
+testDeleteSndConn :: SpecWith DBStore
 testDeleteSndConn =
  it "should create SndConnection and delete it" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -378,7 +380,7 @@ testDeleteSndConn =
    getConn db "conn1"
      `shouldReturn` Left SEConnNotFound

-testDeleteDuplexConn :: SpecWith SQLiteStore
+testDeleteDuplexConn :: SpecWith DBStore
 testDeleteDuplexConn =
  it "should create DuplexConnection and delete it" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -391,7 +393,7 @@ testDeleteDuplexConn =
    getConn db "conn1"
      `shouldReturn` Left SEConnNotFound

-testUpgradeRcvConnToDuplex :: SpecWith SQLiteStore
+testUpgradeRcvConnToDuplex :: SpecWith DBStore
 testUpgradeRcvConnToDuplex =
  it "should throw error on attempt to add SndQueue to SndConnection or DuplexConnection" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -420,7 +422,7 @@ testUpgradeRcvConnToDuplex =
    upgradeRcvConnToDuplex db "conn1" anotherSndQueue
      `shouldReturn` Left (SEBadConnType CDuplex)

-testUpgradeSndConnToDuplex :: SpecWith SQLiteStore
+testUpgradeSndConnToDuplex :: SpecWith DBStore
 testUpgradeSndConnToDuplex =
  it "should throw error on attempt to add RcvQueue to RcvConnection or DuplexConnection" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -452,7 +454,7 @@ testUpgradeSndConnToDuplex =
    upgradeSndConnToDuplex db "conn1" anotherRcvQueue
      `shouldReturn` Left (SEBadConnType CDuplex)

-testSetRcvQueueStatus :: SpecWith SQLiteStore
+testSetRcvQueueStatus :: SpecWith DBStore
 testSetRcvQueueStatus =
  it "should update status of RcvQueue" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -464,7 +466,7 @@ testSetRcvQueueStatus =
    getConn db "conn1"
      `shouldReturn` Right (SomeConn SCRcv (RcvConnection cData1 rq {status = Confirmed}))

-testSetSndQueueStatus :: SpecWith SQLiteStore
+testSetSndQueueStatus :: SpecWith DBStore
 testSetSndQueueStatus =
  it "should update status of SndQueue" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -476,7 +478,7 @@ testSetSndQueueStatus =
    getConn db "conn1"
      `shouldReturn` Right (SomeConn SCSnd (SndConnection cData1 sq {status = Confirmed}))

-testSetQueueStatusDuplex :: SpecWith SQLiteStore
+testSetQueueStatusDuplex :: SpecWith DBStore
 testSetQueueStatusDuplex =
  it "should update statuses of RcvQueue and SndQueue in DuplexConnection" . withStoreTransaction $ \db -> do
    g <- C.newRandom
@@ -529,7 +531,7 @@ testCreateRcvMsg_ db expectedPrevSndId expectedPrevHash connId rq rcvMsgData@Rcv
  createRcvMsg db connId rq rcvMsgData
    `shouldReturn` ()

-testCreateRcvMsg :: SpecWith SQLiteStore
+testCreateRcvMsg :: SpecWith DBStore
 testCreateRcvMsg =
  it "should reserve internal ids and create a RcvMsg" $ \st -> do
    g <- C.newRandom
@@ -551,7 +553,8 @@ mkSndMsgData internalId internalSndId internalHash =
      msgBody = hw,
      pqEncryption = CR.PQEncOn,
      internalHash,
-      prevMsgHash = internalHash
+      prevMsgHash = internalHash,
+      sndMsgPrepData_ = Nothing
    }

 testCreateSndMsg_ :: DB.Connection -> PrevSndMsgHash -> ConnId -> SndQueue -> SndMsgData -> Expectation
@@ -563,7 +566,7 @@ testCreateSndMsg_ db expectedPrevHash connId sq sndMsgData@SndMsgData {..} = do
  createSndMsgDelivery db connId sq internalId
    `shouldReturn` ()

-testCreateSndMsg :: SpecWith SQLiteStore
+testCreateSndMsg :: SpecWith DBStore
 testCreateSndMsg =
  it "should create a SndMsg and return InternalId and PrevSndMsgHash" $ \st -> do
    g <- C.newRandom
@@ -574,7 +577,7 @@ testCreateSndMsg =
      testCreateSndMsg_ db "" connId sq $ mkSndMsgData (InternalId 1) (InternalSndId 1) "hash_dummy"
      testCreateSndMsg_ db "hash_dummy" connId sq $ mkSndMsgData (InternalId 2) (InternalSndId 2) "new_hash_dummy"

-testCreateRcvAndSndMsgs :: SpecWith SQLiteStore
+testCreateRcvAndSndMsgs :: SpecWith DBStore
 testCreateRcvAndSndMsgs =
  it "should create multiple RcvMsg and SndMsg, correctly ordering internal Ids and returning previous state" $ \st -> do
    let ConnData {connId} = cData1
@@ -592,17 +595,17 @@ testCreateRcvAndSndMsgs =

 testCloseReopenStore :: IO ()
 testCloseReopenStore = do
-  st <- createStore
+  st <- createStore'
  hasMigrations st
-  closeSQLiteStore st
-  closeSQLiteStore st
+  closeDBStore st
+  closeDBStore st
  errorGettingMigrations st
  openSQLiteStore st "" False
  openSQLiteStore st "" False
  hasMigrations st
-  closeSQLiteStore st
+  closeDBStore st
  errorGettingMigrations st
-  reopenSQLiteStore st
+  reopenDBStore st
  hasMigrations st

 testCloseReopenEncryptedStore :: IO ()
@@ -610,16 +613,16 @@ testCloseReopenEncryptedStore = do
  let key = "test_key"
  st <- createEncryptedStore key False
  hasMigrations st
-  closeSQLiteStore st
-  closeSQLiteStore st
+  closeDBStore st
+  closeDBStore st
  errorGettingMigrations st
-  reopenSQLiteStore st `shouldThrow` \(e :: SomeException) -> "reopenSQLiteStore: no key" `isInfixOf` show e
+  reopenDBStore st `shouldThrow` \(e :: SomeException) -> "reopenDBStore: no key" `isInfixOf` show e
  openSQLiteStore st key True
  openSQLiteStore st key True
  hasMigrations st
-  closeSQLiteStore st
+  closeDBStore st
  errorGettingMigrations st
-  reopenSQLiteStore st
+  reopenDBStore st
  hasMigrations st

 testReopenEncryptedStoreKeepKey :: IO ()
@@ -627,21 +630,21 @@ testReopenEncryptedStoreKeepKey = do
  let key = "test_key"
  st <- createEncryptedStore key True
  hasMigrations st
-  closeSQLiteStore st
+  closeDBStore st
  errorGettingMigrations st
-  reopenSQLiteStore st
+  reopenDBStore st
  hasMigrations st

-getMigrations :: SQLiteStore -> IO Bool
-getMigrations st = not . null <$> withTransaction st (Migrations.getCurrent . DB.conn)
+getMigrations :: DBStore -> IO Bool
+getMigrations st = not . null <$> withTransaction st getCurrentMigrations

-hasMigrations :: SQLiteStore -> Expectation
+hasMigrations :: DBStore -> Expectation
 hasMigrations st = getMigrations st `shouldReturn` True

-errorGettingMigrations :: SQLiteStore -> Expectation
+errorGettingMigrations :: DBStore -> Expectation
 errorGettingMigrations st = getMigrations st `shouldThrow` \(e :: SomeException) -> "ErrorMisuse" `isInfixOf` show e

-testGetPendingQueueMsg :: SQLiteStore -> Expectation
+testGetPendingQueueMsg :: DBStore -> Expectation
 testGetPendingQueueMsg st = do
  g <- C.newRandom
  withTransaction st $ \db -> do
@@ -658,7 +661,7 @@ testGetPendingQueueMsg st = do
    Right (Just (Nothing, PendingMsgData {msgId})) <- getPendingQueueMsg db connId sq
    msgId `shouldBe` InternalId 2

-testGetPendingServerCommand :: SQLiteStore -> Expectation
+testGetPendingServerCommand :: DBStore -> Expectation
 testGetPendingServerCommand st = do
  g <- C.newRandom
  withTransaction st $ \db -> do
@@ -728,7 +731,7 @@ testFileCbNonce = either error id $ strDecode "dPSF-wrQpDiK_K6sYv0BDBZ9S4dg-jmu"
 testFileReplicaKey :: C.APrivateAuthKey
 testFileReplicaKey = C.APrivateAuthKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"

-testGetNextRcvChunkToDownload :: SQLiteStore -> Expectation
+testGetNextRcvChunkToDownload :: DBStore -> Expectation
 testGetNextRcvChunkToDownload st = do
  g <- C.newRandom
  withTransaction st $ \db -> do
@@ -745,7 +748,7 @@ testGetNextRcvChunkToDownload st = do
    Right (Just (RcvFileChunk {rcvFileEntityId}, _, Nothing)) <- getNextRcvChunkToDownload db xftpServer1 86400
    rcvFileEntityId `shouldBe` fId2

-testGetNextRcvFileToDecrypt :: SQLiteStore -> Expectation
+testGetNextRcvFileToDecrypt :: DBStore -> Expectation
 testGetNextRcvFileToDecrypt st = do
  g <- C.newRandom
  withTransaction st $ \db -> do
@@ -764,7 +767,7 @@ testGetNextRcvFileToDecrypt st = do
    Right (Just RcvFile {rcvFileEntityId}) <- getNextRcvFileToDecrypt db 86400
    rcvFileEntityId `shouldBe` fId2

-testGetNextSndFileToPrepare :: SQLiteStore -> Expectation
+testGetNextSndFileToPrepare :: DBStore -> Expectation
 testGetNextSndFileToPrepare st = do
  g <- C.newRandom
  withTransaction st $ \db -> do
@@ -791,7 +794,7 @@ newSndChunkReplica1 =
      rcvIdsKeys = [(ChunkReplicaId $ EntityId "abc", testFileReplicaKey)]
    }

-testGetNextSndChunkToUpload :: SQLiteStore -> Expectation
+testGetNextSndChunkToUpload :: DBStore -> Expectation
 testGetNextSndChunkToUpload st = do
  g <- C.newRandom
  withTransaction st $ \db -> do
@@ -814,7 +817,7 @@ testGetNextSndChunkToUpload st = do
    Right (Just SndFileChunk {sndFileEntityId}) <- getNextSndChunkToUpload db xftpServer1 86400
    sndFileEntityId `shouldBe` fId2

-testGetNextDeletedSndChunkReplica :: SQLiteStore -> Expectation
+testGetNextDeletedSndChunkReplica :: DBStore -> Expectation
 testGetNextDeletedSndChunkReplica st = do
  withTransaction st $ \db -> do
    Right Nothing <- getNextDeletedSndChunkReplica db xftpServer1 86400
@@ -830,17 +833,17 @@ testGetNextDeletedSndChunkReplica st = do
    Right (Just DeletedSndChunkReplica {deletedSndChunkReplicaId}) <- getNextDeletedSndChunkReplica db xftpServer1 86400
    deletedSndChunkReplicaId `shouldBe` 2

-testMarkNtfSubActionNtfFailed :: SQLiteStore -> Expectation
+testMarkNtfSubActionNtfFailed :: DBStore -> Expectation
 testMarkNtfSubActionNtfFailed st = do
  withTransaction st $ \db -> do
    markNtfSubActionNtfFailed_ db "abc"

-testMarkNtfSubActionSMPFailed :: SQLiteStore -> Expectation
+testMarkNtfSubActionSMPFailed :: DBStore -> Expectation
 testMarkNtfSubActionSMPFailed st = do
  withTransaction st $ \db -> do
    markNtfSubActionSMPFailed_ db "abc"

-testMarkNtfTokenToDeleteFailed :: SQLiteStore -> Expectation
+testMarkNtfTokenToDeleteFailed :: DBStore -> Expectation
 testMarkNtfTokenToDeleteFailed st = do
  withTransaction st $ \db -> do
    markNtfTokenToDeleteFailed_ db 1
@@ -10,10 +10,12 @@ import Data.List (dropWhileEnd)
 import Data.Maybe (fromJust, isJust)
 import Database.SQLite.Simple (Only (..))
 import qualified Database.SQLite.Simple as SQL
+import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
 import Simplex.Messaging.Agent.Store.SQLite
 import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction')
-import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..), MigrationsToRun (..), toDownMigration)
+import Simplex.Messaging.Agent.Store.SQLite.DB (TrackQueries (..))
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
+import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
 import Simplex.Messaging.Util (ifM)
 import System.Directory (createDirectoryIfMissing, doesFileExist, removeDirectoryRecursive, removeFile)
 import System.Process (readCreateProcess, shell)
@@ -49,7 +51,7 @@ testVerifySchemaDump :: IO ()
 testVerifySchemaDump = do
  savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
  savedSchema `deepseq` pure ()
-  void $ createSQLiteStore testDB "" False Migrations.app MCConsole
+  void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations MCConsole
  getSchema testDB appSchema `shouldReturn` savedSchema
  removeFile testDB

@@ -57,7 +59,7 @@ testVerifyLintFKeyIndexes :: IO ()
 testVerifyLintFKeyIndexes = do
  savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
  savedLint `deepseq` pure ()
-  void $ createSQLiteStore testDB "" False Migrations.app MCConsole
+  void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations MCConsole
  getLintFKeyIndexes testDB "tests/tmp/agent_lint.sql" `shouldReturn` savedLint
  removeFile testDB

@@ -69,10 +71,10 @@ withTmpFiles =

 testSchemaMigrations :: IO ()
 testSchemaMigrations = do
-  let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Migrations.app
-  Right st <- createSQLiteStore testDB "" False noDownMigrations MCError
-  mapM_ (testDownMigration st) $ drop (length noDownMigrations) Migrations.app
-  closeSQLiteStore st
+  let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) appMigrations
+  Right st <- createDBStore (DBOpts testDB "" False True TQOff) noDownMigrations MCError
+  mapM_ (testDownMigration st) $ drop (length noDownMigrations) appMigrations
+  closeDBStore st
  removeFile testDB
  removeFile testSchema
  where
@@ -80,35 +82,35 @@ testSchemaMigrations = do
      putStrLn $ "down migration " <> name m
      let downMigr = fromJust $ toDownMigration m
      schema <- getSchema testDB testSchema
-      Migrations.run st $ MTRUp [m]
+      Migrations.run st True $ MTRUp [m]
      schema' <- getSchema testDB testSchema
      schema' `shouldNotBe` schema
-      Migrations.run st $ MTRDown [downMigr]
+      Migrations.run st True $ MTRDown [downMigr]
      unless (name m `elem` skipComparisonForDownMigrations) $ do
        schema'' <- getSchema testDB testSchema
        schema'' `shouldBe` schema
-      Migrations.run st $ MTRUp [m]
+      Migrations.run st True $ MTRUp [m]
      schema''' <- getSchema testDB testSchema
      schema''' `shouldBe` schema'

 testUsersMigrationNew :: IO ()
 testUsersMigrationNew = do
-  Right st <- createSQLiteStore testDB "" False Migrations.app MCError
+  Right st <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations MCError
  withTransaction' st (`SQL.query_` "SELECT user_id FROM users;")
    `shouldReturn` ([] :: [Only Int])
-  closeSQLiteStore st
+  closeDBStore st

 testUsersMigrationOld :: IO ()
 testUsersMigrationOld = do
-  let beforeUsers = takeWhile (("m20230110_users" /=) . name) Migrations.app
-  Right st <- createSQLiteStore testDB "" False beforeUsers MCError
+  let beforeUsers = takeWhile (("m20230110_users" /=) . name) appMigrations
+  Right st <- createDBStore (DBOpts testDB "" False True TQOff) beforeUsers MCError
  withTransaction' st (`SQL.query_` "SELECT name FROM sqlite_master WHERE type = 'table' AND name = 'users';")
    `shouldReturn` ([] :: [Only String])
-  closeSQLiteStore st
-  Right st' <- createSQLiteStore testDB "" False Migrations.app MCYesUp
+  closeDBStore st
+  Right st' <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations MCYesUp
  withTransaction' st' (`SQL.query_` "SELECT user_id FROM users;")
    `shouldReturn` ([Only (1 :: Int)])
-  closeSQLiteStore st'
+  closeDBStore st'

 skipComparisonForDownMigrations :: [String]
 skipComparisonForDownMigrations =
@@ -174,7 +174,7 @@ smpServerTestStatic = do
        X.Certificate {X.certPubKey = X.PubKeyEd25519 _k} : _ca -> print _ca -- pure ()
        leaf : _ -> error $ "Unexpected leaf cert: " <> show leaf
        [] -> error "Empty chain"
-      runRight_ . void $ smpClientHandshake tls Nothing caSMP supportedClientSMPRelayVRange
+      runRight_ . void $ smpClientHandshake tls Nothing caSMP supportedClientSMPRelayVRange False
    logDebug "Combined SMP works"
  where
    getCerts :: TLS -> [X.Certificate]
@@ -296,7 +296,7 @@ testClientStubV6 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 testClientStubV6 = do
  g <- C.newRandom
  sessId <- atomically $ C.randomBytes 32 g
-  smpClientStub g sessId subModeSMPVersion Nothing
+  smpClientStub g sessId minServerSMPRelayVersion Nothing

 testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 testClientStub = do
@@ -307,7 +307,7 @@ testClientStub = do
  smpClientStub g sessId currentClientSMPRelayVersion thAuth_

 randomSUBv6 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSUBv6 = randomSUB_ C.SEd25519 subModeSMPVersion
+randomSUBv6 = randomSUB_ C.SEd25519 minServerSMPRelayVersion

 randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSUB = randomSUB_ C.SEd25519 currentClientSMPRelayVersion
@@ -354,7 +354,7 @@ randomNMSGCmd ts = do
  pure (CorrId "", EntityId nId, NMSG nonce encNMsgMeta)

 randomSENDv6 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSENDv6 = randomSEND_ C.SEd25519 subModeSMPVersion
+randomSENDv6 = randomSEND_ C.SEd25519 minServerSMPRelayVersion

 randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSEND = randomSEND_ C.SX25519 currentClientSMPRelayVersion
@@ -15,6 +15,7 @@
 module CoreTests.MsgStoreTests where

 import AgentTests.FunctionalAPITests (runRight, runRight_)
+import Control.Concurrent (threadDelay)
 import Control.Concurrent.STM
 import Control.Exception (bracket)
 import Control.Monad
@@ -24,13 +25,16 @@ import Crypto.Random (ChaChaDRG)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Base64.URL as B64
+import Data.List (isPrefixOf, isSuffixOf)
 import Data.Maybe (fromJust)
-import Data.Time.Clock.System (getSystemTime)
+import Data.Time.Clock (addUTCTime)
+import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (EntityId (..), Message (..), RecipientId, SParty (..), noMsgFlags)
 import Simplex.Messaging.Server (MessageStats (..), exportMessages, importMessages, printMessageStats)
 import Simplex.Messaging.Server.Env.STM (journalMsgStoreDepth, readWriteQueueStore)
+import Simplex.Messaging.Server.Expiration (ExpirationConfig (..), expireBeforeEpoch)
 import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
@@ -40,7 +44,7 @@ import Simplex.Messaging.Server.StoreLog (closeStoreLog, logCreateQueue)
 import SMPClient (testStoreLogFile, testStoreMsgsDir, testStoreMsgsDir2, testStoreMsgsFile, testStoreMsgsFile2)
 import System.Directory (copyFile, createDirectoryIfMissing, listDirectory, removeFile, renameFile)
 import System.FilePath ((</>))
-import System.IO (IOMode (..), hClose, withFile)
+import System.IO (IOMode (..), withFile)
 import Test.Hspec

 msgStoreTests :: Spec
@@ -52,18 +56,22 @@ msgStoreTests = do
    describe "queue state" $ do
      it "should restore queue state from the last line" testQueueState
      it "should recover when message is written and state is not" testMessageState
+      it "should remove journal files when queue is empty" testRemoveJournals
    describe "missing files" $ do
      it "should create read file when missing" testReadFileMissing
      it "should switch to write file when read file missing" testReadFileMissingSwitch
      it "should create write file when missing" testWriteFileMissing
      it "should create read file when read and write files are missing" testReadAndWriteFilesMissing
+  describe "Journal message store: queue state backup expiration" $ do
+    it "should remove old queue state backups" testRemoveQueueStateBackups
+    it "should expire messages in idle queues" testExpireIdleQueues
  where
-    someMsgStoreTests :: STMQueueStore s => SpecWith s
+    someMsgStoreTests :: STMStoreClass s => SpecWith s
    someMsgStoreTests = do
      it "should get queue and store/read messages" testGetQueue
      it "should not fail on EOF when changing read journal" testChangeReadJournal

-withMsgStore :: STMQueueStore s => MsgStoreConfig s -> (s -> IO ()) -> IO ()
+withMsgStore :: STMStoreClass s => MsgStoreConfig s -> (s -> IO ()) -> IO ()
 withMsgStore cfg = bracket (newMsgStore cfg) closeMsgStore

 testSMTStoreConfig :: STMStoreConfig
@@ -78,7 +86,9 @@ testJournalStoreCfg =
      maxMsgCount = 4,
      maxStateLines = 2,
      stateTailSize = 256,
-      idleInterval = 21600
+      idleInterval = 21600,
+      expireBackupsAfter = 0,
+      keepMinBackups = 1
    }

 mkMessage :: MonadIO m => ByteString -> m Message
@@ -105,78 +115,77 @@ testNewQueueRec g sndSecure = do
  (k, pk) <- atomically $ C.generateKeyPair @'C.X25519 g
  let qr =
        QueueRec
-          { recipientId = rId,
-            recipientKey,
+          { recipientKey,
            rcvDhSecret = C.dh' k pk,
            senderId,
            senderKey = Nothing,
            sndSecure,
            notifier = Nothing,
-            status = QueueActive,
+            status = EntityActive,
            updatedAt = Nothing
          }
  pure (rId, qr)

-testGetQueue :: STMQueueStore s => s -> IO ()
+testGetQueue :: STMStoreClass s => s -> IO ()
 testGetQueue ms = do
  g <- C.newRandom
  (rId, qr) <- testNewQueueRec g True
  runRight_ $ do
-    q <- ExceptT $ addQueue ms qr
-    let write s = writeMsg ms rId q True =<< mkMessage s
+    q <- ExceptT $ addQueue ms rId qr
+    let write s = writeMsg ms q True =<< mkMessage s
    Just (Message {msgId = mId1}, True) <- write "message 1"
    Just (Message {msgId = mId2}, False) <- write "message 2"
    Just (Message {msgId = mId3}, False) <- write "message 3"
-    Msg "message 1" <- tryPeekMsg ms rId q
-    Msg "message 1" <- tryPeekMsg ms rId q
-    Nothing <- tryDelMsg ms rId q mId2
-    Msg "message 1" <- tryDelMsg ms rId q mId1
-    Nothing <- tryDelMsg ms rId q mId1
-    Msg "message 2" <- tryPeekMsg ms rId q
-    Nothing <- tryDelMsg ms rId q mId1
-    (Nothing, Msg "message 2") <- tryDelPeekMsg ms rId q mId1
-    (Msg "message 2", Msg "message 3") <- tryDelPeekMsg ms rId q mId2
-    (Nothing, Msg "message 3") <- tryDelPeekMsg ms rId q mId2
-    Msg "message 3" <- tryPeekMsg ms rId q
-    (Msg "message 3", Nothing) <- tryDelPeekMsg ms rId q mId3
-    Nothing <- tryDelMsg ms rId q mId2
-    Nothing <- tryDelMsg ms rId q mId3
-    Nothing <- tryPeekMsg ms rId q
+    Msg "message 1" <- tryPeekMsg ms q
+    Msg "message 1" <- tryPeekMsg ms q
+    Nothing <- tryDelMsg ms q mId2
+    Msg "message 1" <- tryDelMsg ms q mId1
+    Nothing <- tryDelMsg ms q mId1
+    Msg "message 2" <- tryPeekMsg ms q
+    Nothing <- tryDelMsg ms q mId1
+    (Nothing, Msg "message 2") <- tryDelPeekMsg ms q mId1
+    (Msg "message 2", Msg "message 3") <- tryDelPeekMsg ms q mId2
+    (Nothing, Msg "message 3") <- tryDelPeekMsg ms q mId2
+    Msg "message 3" <- tryPeekMsg ms q
+    (Msg "message 3", Nothing) <- tryDelPeekMsg ms q mId3
+    Nothing <- tryDelMsg ms q mId2
+    Nothing <- tryDelMsg ms q mId3
+    Nothing <- tryPeekMsg ms q
    Just (Message {msgId = mId4}, True) <- write "message 4"
-    Msg "message 4" <- tryPeekMsg ms rId q
+    Msg "message 4" <- tryPeekMsg ms q
    Just (Message {msgId = mId5}, False) <- write "message 5"
-    (Nothing, Msg "message 4") <- tryDelPeekMsg ms rId q mId3
-    (Msg "message 4", Msg "message 5") <- tryDelPeekMsg ms rId q mId4
+    (Nothing, Msg "message 4") <- tryDelPeekMsg ms q mId3
+    (Msg "message 4", Msg "message 5") <- tryDelPeekMsg ms q mId4
    Just (Message {msgId = mId6}, False) <- write "message 6"
    Just (Message {msgId = mId7}, False) <- write "message 7"
    Nothing <- write "message 8"
-    Msg "message 5" <- tryPeekMsg ms rId q
-    (Nothing, Msg "message 5") <- tryDelPeekMsg ms rId q mId4
-    (Msg "message 5", Msg "message 6") <- tryDelPeekMsg ms rId q mId5
-    (Msg "message 6", Msg "message 7") <- tryDelPeekMsg ms rId q mId6
-    (Msg "message 7", Just MessageQuota {msgId = mId8}) <- tryDelPeekMsg ms rId q mId7
-    (Just MessageQuota {}, Nothing) <- tryDelPeekMsg ms rId q mId8
-    (Nothing, Nothing) <- tryDelPeekMsg ms rId q mId8
-    void $ ExceptT $ deleteQueue ms rId q
+    Msg "message 5" <- tryPeekMsg ms q
+    (Nothing, Msg "message 5") <- tryDelPeekMsg ms q mId4
+    (Msg "message 5", Msg "message 6") <- tryDelPeekMsg ms q mId5
+    (Msg "message 6", Msg "message 7") <- tryDelPeekMsg ms q mId6
+    (Msg "message 7", Just MessageQuota {msgId = mId8}) <- tryDelPeekMsg ms q mId7
+    (Just MessageQuota {}, Nothing) <- tryDelPeekMsg ms q mId8
+    (Nothing, Nothing) <- tryDelPeekMsg ms q mId8
+    void $ ExceptT $ deleteQueue ms q

-testChangeReadJournal :: STMQueueStore s => s -> IO ()
+testChangeReadJournal :: STMStoreClass s => s -> IO ()
 testChangeReadJournal ms = do
  g <- C.newRandom
  (rId, qr) <- testNewQueueRec g True
  runRight_ $ do
-    q <- ExceptT $ addQueue ms qr
-    let write s = writeMsg ms rId q True =<< mkMessage s
+    q <- ExceptT $ addQueue ms rId qr
+    let write s = writeMsg ms q True =<< mkMessage s
    Just (Message {msgId = mId1}, True) <- write "message 1"
-    (Msg "message 1", Nothing) <- tryDelPeekMsg ms rId q mId1
+    (Msg "message 1", Nothing) <- tryDelPeekMsg ms q mId1
    Just (Message {msgId = mId2}, True) <- write "message 2"
-    (Msg "message 2", Nothing) <- tryDelPeekMsg ms rId q mId2
+    (Msg "message 2", Nothing) <- tryDelPeekMsg ms q mId2
    Just (Message {msgId = mId3}, True) <- write "message 3"
-    (Msg "message 3", Nothing) <- tryDelPeekMsg ms rId q mId3
+    (Msg "message 3", Nothing) <- tryDelPeekMsg ms q mId3
    Just (Message {msgId = mId4}, True) <- write "message 4"
-    (Msg "message 4", Nothing) <- tryDelPeekMsg ms rId q mId4
+    (Msg "message 4", Nothing) <- tryDelPeekMsg ms q mId4
    Just (Message {msgId = mId5}, True) <- write "message 5"
-    (Msg "message 5", Nothing) <- tryDelPeekMsg ms rId q mId5
-    void $ ExceptT $ deleteQueue ms rId q
+    (Msg "message 5", Nothing) <- tryDelPeekMsg ms q mId5
+    void $ ExceptT $ deleteQueue ms q

 testExportImportStore :: JournalMsgStore -> IO ()
 testExportImportStore ms = do
@@ -185,21 +194,21 @@ testExportImportStore ms = do
  (rId2, qr2) <- testNewQueueRec g True
  sl <- readWriteQueueStore testStoreLogFile ms
  runRight_ $ do
-    let write rId q s = writeMsg ms rId q True =<< mkMessage s
-    q1 <- ExceptT $ addQueue ms qr1
-    liftIO $ logCreateQueue sl qr1
-    Just (Message {}, True) <- write rId1 q1 "message 1"
-    Just (Message {}, False) <- write rId1 q1 "message 2"
-    q2 <- ExceptT $ addQueue ms qr2
-    liftIO $ logCreateQueue sl qr2
-    Just (Message {msgId = mId3}, True) <- write rId2 q2 "message 3"
-    Just (Message {msgId = mId4}, False) <- write rId2 q2 "message 4"
-    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg ms rId2 q2 mId3
-    (Msg "message 4", Nothing) <- tryDelPeekMsg ms rId2 q2 mId4
-    Just (Message {}, True) <- write rId2 q2 "message 5"
-    Just (Message {}, False) <- write rId2 q2 "message 6"
-    Just (Message {}, False) <- write rId2 q2 "message 7"
-    Nothing <- write rId2 q2 "message 8"
+    let write q s = writeMsg ms q True =<< mkMessage s
+    q1 <- ExceptT $ addQueue ms rId1 qr1
+    liftIO $ logCreateQueue sl rId1 qr1
+    Just (Message {}, True) <- write q1 "message 1"
+    Just (Message {}, False) <- write q1 "message 2"
+    q2 <- ExceptT $ addQueue ms rId2 qr2
+    liftIO $ logCreateQueue sl rId2 qr2
+    Just (Message {msgId = mId3}, True) <- write q2 "message 3"
+    Just (Message {msgId = mId4}, False) <- write q2 "message 4"
+    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg ms q2 mId3
+    (Msg "message 4", Nothing) <- tryDelPeekMsg ms q2 mId4
+    Just (Message {}, True) <- write q2 "message 5"
+    Just (Message {}, False) <- write q2 "message 6"
+    Just (Message {}, False) <- write q2 "message 7"
+    Nothing <- write q2 "message 8"
    pure ()
  length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3
@@ -213,7 +222,7 @@ testExportImportStore ms = do
  ms' <- newMsgStore cfg
  readWriteQueueStore testStoreLogFile ms' >>= closeStoreLog
  stats@MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
-    importMessages False ms' testStoreMsgsFile Nothing
+    importMessages False ms' testStoreMsgsFile Nothing False
  printMessageStats "Messages" stats
  length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 4 -- state file is backed up, 2 message files
@@ -222,7 +231,7 @@ testExportImportStore ms = do
  stmStore <- newMsgStore testSMTStoreConfig
  readWriteQueueStore testStoreLogFile stmStore >>= closeStoreLog
  MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
-    importMessages False stmStore testStoreMsgsFile2 Nothing
+    importMessages False stmStore testStoreMsgsFile2 Nothing False
  exportMessages False stmStore testStoreMsgsFile False
  (B.sort <$> B.readFile testStoreMsgsFile `shouldReturn`) =<< (B.sort <$> B.readFile (testStoreMsgsFile2 <> ".bak"))

@@ -236,7 +245,7 @@ testQueueState ms = do
  state <- newMsgQueueState <$> newJournalId (random ms)
  withFile statePath WriteMode (`appendState` state)
  length . lines <$> readFile statePath `shouldReturn` 1
-  readQueueState statePath `shouldReturn` state
+  readQueueState ms statePath `shouldReturn` (Just state, False)
  length <$> listDirectory dir `shouldReturn` 1 -- no backup

  let state1 =
@@ -247,7 +256,7 @@ testQueueState ms = do
          }
  withFile statePath AppendMode (`appendState` state1)
  length . lines <$> readFile statePath `shouldReturn` 2
-  readQueueState statePath `shouldReturn` state1
+  readQueueState ms statePath `shouldReturn` (Just state1, False)
  length <$> listDirectory dir `shouldReturn` 1 -- no backup

  let state2 =
@@ -259,28 +268,26 @@ testQueueState ms = do
  withFile statePath AppendMode (`appendState` state2)
  length . lines <$> readFile statePath `shouldReturn` 3
  copyFile statePath (statePath <> ".2")
-  readQueueState statePath `shouldReturn` state2
-  length <$> listDirectory dir `shouldReturn` 3 -- new state, copy + backup
-  length . lines <$> readFile statePath `shouldReturn` 1
+  readQueueState ms statePath `shouldReturn` (Just state2, True)
+  length <$> listDirectory dir `shouldReturn` 2 -- new state + copy
+  ls <- lines <$> readFile statePath
+  length ls `shouldBe` 3
+  -- mock compacting file
+  writeFile statePath $ last ls

  -- corrupt the only line
  corruptFile statePath
-  newState <- readQueueState statePath
-  newState `shouldBe` newMsgQueueState (journalId $ writeState newState)
+  (Nothing, True) <- readQueueState ms statePath

  -- corrupt the last line
  renameFile (statePath <> ".2") statePath
  removeOtherFiles dir statePath
  length . lines <$> readFile statePath `shouldReturn` 3
  corruptFile statePath
-  readQueueState statePath `shouldReturn` state1
-  length <$> listDirectory dir `shouldReturn` 2
-  length . lines <$> readFile statePath `shouldReturn` 1
+  readQueueState ms statePath `shouldReturn` (Just state1, True)
+  length <$> listDirectory dir `shouldReturn` 1
+  length . lines <$> readFile statePath `shouldReturn` 3
  where
-    readQueueState statePath = do
-      (state, h) <- readWriteQueueState ms statePath
-      hClose h
-      pure state
    corruptFile f = do
      s <- readFile f
      removeFile f
@@ -297,10 +304,10 @@ testMessageState ms = do
  (rId, qr) <- testNewQueueRec g True
  let dir = msgQueueDirectory ms rId
      statePath = msgQueueStatePath dir $ B.unpack (B64.encode $ unEntityId rId)
-      write q s = writeMsg ms rId q True =<< mkMessage s
+      write q s = writeMsg ms q True =<< mkMessage s

  mId1 <- runRight $ do
-    q <- ExceptT $ addQueue ms qr
+    q <- ExceptT $ addQueue ms rId qr
    Just (Message {msgId = mId1}, True) <- write q "message 1"
    Just (Message {}, False) <- write q "message 2"
    liftIO $ closeMsgQueue q
@@ -312,19 +319,154 @@ testMessageState ms = do
  runRight_ $ do
    q <- ExceptT $ getQueue ms SRecipient rId
    Just (Message {msgId = mId3}, False) <- write q "message 3"
-    (Msg "message 1", Msg "message 3") <- tryDelPeekMsg ms rId q mId1
-    (Msg "message 3", Nothing) <- tryDelPeekMsg ms rId q mId3
+    (Msg "message 1", Msg "message 3") <- tryDelPeekMsg ms q mId1
+    (Msg "message 3", Nothing) <- tryDelPeekMsg ms q mId3
    liftIO $ closeMsgQueue q

+testRemoveJournals :: JournalMsgStore -> IO ()
+testRemoveJournals ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g True
+  let dir = msgQueueDirectory ms rId
+      statePath = msgQueueStatePath dir $ B.unpack (B64.encode $ unEntityId rId)
+      write q s = writeMsg ms q True =<< mkMessage s
+
+  runRight $ do
+    q <- ExceptT $ addQueue ms rId qr
+    Just (Message {msgId = mId1}, True) <- write q "message 1"
+    Just (Message {msgId = mId2}, False) <- write q "message 2"    
+    (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms q mId1
+    (Msg "message 2", Nothing) <- tryDelPeekMsg ms q mId2
+    liftIO $ closeMsgQueue q
+
+  ls <- B.lines <$> B.readFile statePath
+  length ls `shouldBe` 4
+  journalFilesCount dir `shouldReturn` 1
+  stateBackupCount dir `shouldReturn` 0
+
+  runRight $ do
+    q <- ExceptT $ getQueue ms SRecipient rId
+    -- not removed yet
+    liftIO $ journalFilesCount dir `shouldReturn` 1
+    liftIO $ stateBackupCount dir `shouldReturn` 0
+    Nothing <- tryPeekMsg ms q
+    -- still not removed, queue is empty and not opened
+    liftIO $ journalFilesCount dir `shouldReturn` 1
+    _mq <- isolateQueue q "test" $ getMsgQueue ms q False
+    -- journal is removed
+    liftIO $ journalFilesCount dir `shouldReturn` 0
+    liftIO $ stateBackupCount dir `shouldReturn` 1
+    Just (Message {msgId = mId3}, True) <- write q "message 3"
+    -- journal is created
+    liftIO $ journalFilesCount dir `shouldReturn` 1
+    Just (Message {msgId = mId4}, False) <- write q "message 4"
+    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg ms q mId3
+    (Msg "message 4", Nothing) <- tryDelPeekMsg ms q mId4
+    Just (Message {msgId = mId5}, True) <- write q "message 5"
+    Just (Message {msgId = mId6}, False) <- write q "message 6"
+    liftIO $ journalFilesCount dir `shouldReturn` 1
+    Just (Message {msgId = mId7}, False) <- write q "message 7"
+    -- separate write journal is created
+    liftIO $ journalFilesCount dir `shouldReturn` 2
+    Nothing <- write q "message 8"
+    (Msg "message 5", Msg "message 6") <- tryDelPeekMsg ms q mId5
+    liftIO $ journalFilesCount dir `shouldReturn` 2
+    (Msg "message 6", Msg "message 7") <- tryDelPeekMsg ms q mId6
+    -- read journal is removed
+    liftIO $ journalFilesCount dir `shouldReturn` 1
+    (Msg "message 7", Just MessageQuota {msgId = mId8}) <- tryDelPeekMsg ms q mId7
+    (Just MessageQuota {}, Nothing) <- tryDelPeekMsg ms q mId8
+    liftIO $ closeMsgQueue q
+
+  journalFilesCount dir `shouldReturn` 1
+  runRight $ do
+    q <- ExceptT $ getQueue ms SRecipient rId
+    Just (Message {}, True) <- write q "message 8"
+    liftIO $ journalFilesCount dir `shouldReturn` 1
+    liftIO $ stateBackupCount dir `shouldReturn` 2
+    liftIO $ closeMsgQueue q
+  where
+    journalFilesCount dir = length . filter ("messages." `isPrefixOf`) <$> listDirectory dir
+    stateBackupCount dir = length . filter (".bak" `isSuffixOf`) <$> listDirectory dir
+
+testRemoveQueueStateBackups :: IO ()
+testRemoveQueueStateBackups = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g True
+
+  ms' <- newMsgStore testJournalStoreCfg {maxStateLines = 1, expireBackupsAfter = 0, keepMinBackups = 0}
+  -- set expiration time 1 second ahead
+  let ms = ms' {expireBackupsBefore = addUTCTime 1 $ expireBackupsBefore ms'}
+
+  let dir = msgQueueDirectory ms rId
+      write q s = writeMsg ms q True =<< mkMessage s
+
+  runRight $ do
+    q <- ExceptT $ addQueue ms rId qr
+    Just (Message {msgId = mId1}, True) <- write q "message 1"
+    Just (Message {msgId = mId2}, False) <- write q "message 2"
+    (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms q mId1
+    (Msg "message 2", Nothing) <- tryDelPeekMsg ms q mId2
+    liftIO $ closeMsgQueue q
+    liftIO $ stateBackupCount dir `shouldReturn` 0
+
+    q1 <- ExceptT $ getQueue ms SRecipient rId
+    Just (Message {}, True) <- write q1 "message 3"
+    Just (Message {}, False) <- write q1 "message 4"
+    liftIO $ closeMsgQueue q1
+    liftIO $ stateBackupCount dir `shouldReturn` 0
+
+    liftIO $ threadDelay 1000000
+    q2 <- ExceptT $ getQueue ms SRecipient rId
+    Just (Message {}, False) <- write q2 "message 5"
+    Nothing <- write q2 "message 5"
+    liftIO $ closeMsgQueue q2
+    liftIO $ stateBackupCount dir `shouldReturn` 1
+  where
+    stateBackupCount dir = length . filter (".bak" `isSuffixOf`) <$> listDirectory dir
+
+testExpireIdleQueues :: IO ()
+testExpireIdleQueues = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g True
+
+  ms <- newMsgStore testJournalStoreCfg {idleInterval = 0}
+
+  let dir = msgQueueDirectory ms rId
+      statePath = msgQueueStatePath dir $ B.unpack (B64.encode $ unEntityId rId)
+      write q s = writeMsg ms q True =<< mkMessage s
+
+  q <- runRight $ do
+    q <- ExceptT $ addQueue ms rId qr
+    Just (Message {msgId = mId1}, True) <- write q "message 1"
+    Just (Message {msgId = mId2}, False) <- write q "message 2"
+    (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms q mId1
+    (Msg "message 2", Nothing) <- tryDelPeekMsg ms q mId2
+    liftIO $ closeMsgQueue q
+    pure q
+
+  (Just MsgQueueState {size = 0, readState = rs, writeState = ws}, True) <- readQueueState ms statePath
+  msgCount rs `shouldBe` 2
+  msgCount ws `shouldBe` 2
+
+  old <- expireBeforeEpoch ExpirationConfig {ttl = 1, checkInterval = 1} -- no old messages
+  now <- systemSeconds <$> getSystemTime
+
+  (expired_, stored) <- runRight $ idleDeleteExpiredMsgs now ms q old
+  expired_ `shouldBe` Just 0
+  stored `shouldBe` 0
+  (Nothing, False) <- readQueueState ms statePath
+  pure ()
+
 testReadFileMissing :: JournalMsgStore -> IO ()
 testReadFileMissing ms = do
  g <- C.newRandom
  (rId, qr) <- testNewQueueRec g True
-  let write q s = writeMsg ms rId q True =<< mkMessage s
+  let write q s = writeMsg ms q True =<< mkMessage s
  q <- runRight $ do
-    q <- ExceptT $ addQueue ms qr
+    q <- ExceptT $ addQueue ms rId qr
    Just (Message {}, True) <- write q "message 1"
-    Msg "message 1" <- tryPeekMsg ms rId q
+    Msg "message 1" <- tryPeekMsg ms q
    pure q

  mq <- fromJust <$> readTVarIO (msgQueue_' q)
@@ -335,9 +477,9 @@ testReadFileMissing ms = do

  runRight_ $ do
    q' <- ExceptT $ getQueue ms SRecipient rId
-    Nothing <- tryPeekMsg ms rId q'
+    Nothing <- tryPeekMsg ms q'
    Just (Message {}, True) <- write q' "message 2"
-    Msg "message 2" <- tryPeekMsg ms rId q'
+    Msg "message 2" <- tryPeekMsg ms q'
    pure ()

 testReadFileMissingSwitch :: JournalMsgStore -> IO ()
@@ -354,8 +496,8 @@ testReadFileMissingSwitch ms = do

  runRight_ $ do
    q' <- ExceptT $ getQueue ms SRecipient rId
-    Just (Message {}, False) <- writeMsg ms rId q' True =<< mkMessage "message 6"
-    Msg "message 5" <- tryPeekMsg ms rId q'
+    Just (Message {}, False) <- writeMsg ms q' True =<< mkMessage "message 6"
+    Msg "message 5" <- tryPeekMsg ms q'
    pure ()

 testWriteFileMissing :: JournalMsgStore -> IO ()
@@ -373,12 +515,12 @@ testWriteFileMissing ms = do

  runRight_ $ do
    q' <- ExceptT $ getQueue ms SRecipient rId
-    Just Message {msgId = mId3} <- tryPeekMsg ms rId q'
-    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg ms rId q' mId3
-    Just Message {msgId = mId4} <- tryPeekMsg ms rId q'
-    (Msg "message 4", Nothing) <- tryDelPeekMsg ms rId q' mId4
-    Just (Message {}, True) <- writeMsg ms rId q' True =<< mkMessage "message 6"
-    Msg "message 6" <- tryPeekMsg ms rId q'
+    Just Message {msgId = mId3} <- tryPeekMsg ms q'
+    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg ms q' mId3
+    Just Message {msgId = mId4} <- tryPeekMsg ms q'
+    (Msg "message 4", Nothing) <- tryDelPeekMsg ms q' mId4
+    Just (Message {}, True) <- writeMsg ms q' True =<< mkMessage "message 6"
+    Msg "message 6" <- tryPeekMsg ms q'
    pure ()

 testReadAndWriteFilesMissing :: JournalMsgStore -> IO ()
@@ -395,20 +537,20 @@ testReadAndWriteFilesMissing ms = do

  runRight_ $ do
    q' <- ExceptT $ getQueue ms SRecipient rId
-    Nothing <- tryPeekMsg ms rId q'
-    Just (Message {}, True) <- writeMsg ms rId q' True =<< mkMessage "message 6"
-    Msg "message 6" <- tryPeekMsg ms rId q'
+    Nothing <- tryPeekMsg ms q'
+    Just (Message {}, True) <- writeMsg ms q' True =<< mkMessage "message 6"
+    Msg "message 6" <- tryPeekMsg ms q'
    pure ()

 writeMessages :: JournalMsgStore -> RecipientId -> QueueRec -> IO JournalQueue
 writeMessages ms rId qr = runRight $ do
-  q <- ExceptT $ addQueue ms qr
-  let write s = writeMsg ms rId q True =<< mkMessage s
+  q <- ExceptT $ addQueue ms rId qr
+  let write s = writeMsg ms q True =<< mkMessage s
  Just (Message {msgId = mId1}, True) <- write "message 1"
  Just (Message {msgId = mId2}, False) <- write "message 2"
  Just (Message {}, False) <- write "message 3"
-  (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms rId q mId1
-  (Msg "message 2", Msg "message 3") <- tryDelPeekMsg ms rId q mId2
+  (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms q mId1
+  (Msg "message 2", Msg "message 3") <- tryDelPeekMsg ms q mId2
  Just (Message {}, False) <- write "message 4"
  Just (Message {}, False) <- write "message 5"
  pure q
@@ -10,13 +10,12 @@ module CoreTests.StoreLogTests where

 import Control.Concurrent.STM
 import Control.Monad
+import CoreTests.MsgStoreTests
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (partitionEithers)
 import qualified Data.Map.Strict as M
 import SMPClient
-import AgentTests.SQLiteTests
-import CoreTests.MsgStoreTests
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
@@ -27,6 +26,9 @@ import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.StoreLog
 import Test.Hspec

+testPublicAuthKey :: C.APublicAuthKey
+testPublicAuthKey = C.APublicAuthKey C.SEd25519 (C.publicKey "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe")
+
 testNtfCreds :: TVar ChaChaDRG -> IO NtfCreds
 testNtfCreds g = do
  (notifierKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
@@ -54,43 +56,44 @@ storeLogTests =
    ((rId, qr), ntfCreds, date) <- runIO $ do
      g <- C.newRandom
      (,,) <$> testNewQueueRec g sndSecure <*> testNtfCreds g <*> getSystemDate
-    testSMPStoreLog ("SMP server store log, sndSecure = " <> show sndSecure)
+    testSMPStoreLog
+      ("SMP server store log, sndSecure = " <> show sndSecure)
      [ SLTC
          { name = "create new queue",
-            saved = [CreateQueue qr],
-            compacted = [CreateQueue qr],
+            saved = [CreateQueue rId qr],
+            compacted = [CreateQueue rId qr],
            state = M.fromList [(rId, qr)]
          },
        SLTC
          { name = "secure queue",
-            saved = [CreateQueue qr, SecureQueue rId testPublicAuthKey],
-            compacted = [CreateQueue qr {senderKey = Just testPublicAuthKey}],
+            saved = [CreateQueue rId qr, SecureQueue rId testPublicAuthKey],
+            compacted = [CreateQueue rId qr {senderKey = Just testPublicAuthKey}],
            state = M.fromList [(rId, qr {senderKey = Just testPublicAuthKey})]
-          },          
+          },
        SLTC
          { name = "create and delete queue",
-            saved = [CreateQueue qr, DeleteQueue rId],
+            saved = [CreateQueue rId qr, DeleteQueue rId],
            compacted = [],
            state = M.fromList []
          },
        SLTC
          { name = "create queue and add notifier",
-            saved = [CreateQueue qr, AddNotifier rId ntfCreds],
-            compacted = [CreateQueue $ qr {notifier = Just ntfCreds}],
+            saved = [CreateQueue rId qr, AddNotifier rId ntfCreds],
+            compacted = [CreateQueue rId qr {notifier = Just ntfCreds}],
            state = M.fromList [(rId, qr {notifier = Just ntfCreds})]
          },
        SLTC
          { name = "delete notifier",
-            saved = [CreateQueue qr, AddNotifier rId ntfCreds, DeleteNotifier rId],
-            compacted = [CreateQueue qr],
+            saved = [CreateQueue rId qr, AddNotifier rId ntfCreds, DeleteNotifier rId],
+            compacted = [CreateQueue rId qr],
            state = M.fromList [(rId, qr)]
          },
        SLTC
          { name = "update time",
-            saved = [CreateQueue qr, UpdateTime rId date],
-            compacted = [CreateQueue qr {updatedAt = Just date}],
+            saved = [CreateQueue rId qr, UpdateTime rId date],
+            compacted = [CreateQueue rId qr {updatedAt = Just date}],
            state = M.fromList [(rId, qr {updatedAt = Just date})]
-          }          
+          }
      ]

 testSMPStoreLog :: String -> [SMPStoreLogTestCase] -> Spec
@@ -109,4 +112,4 @@ testSMPStoreLog testSuite tests =
      ([], compacted') <- partitionEithers . map strDecode . B.lines <$> B.readFile testStoreLogFile
      compacted' `shouldBe` compacted
    storeState :: JournalMsgStore -> IO (M.Map RecipientId QueueRec)
-    storeState st = M.mapMaybe id <$> (readTVarIO (queues st) >>= mapM (readTVarIO . queueRec'))
+    storeState st = M.mapMaybe id <$> (readTVarIO (queues $ stmQueueStore st) >>= mapM (readTVarIO . queueRec'))
@@ -0,0 +1,21 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Fixtures where
+
+#if defined(dbPostgres)
+import Data.ByteString (ByteString)
+import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
+#endif
+
+#if defined(dbPostgres)
+testDBConnstr :: ByteString
+testDBConnstr = "postgresql://test_agent_user@/test_agent_db"
+
+testDBConnectInfo :: ConnectInfo
+testDBConnectInfo =
+  defaultConnectInfo {
+    connectUser = "test_agent_user",
+    connectDatabase = "test_agent_db"
+  }
+#endif
--- a/Show More
+++ b/Show More