7.1.0.11

fix tests on ghc 8.10.7 (#1939 )
* fix tests on ghc 8.10.7 * fix test * fix schema dump test --------- Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>
2026-10-12 11:39:56 +00:00 · 2026-10-11 22:33:06 +01:00 · 2026-10-11 20:36:51 +01:00 · 2026-10-11 11:52:24 +01:00 · 2026-10-11 07:37:33 +01:00 · 2026-10-10 23:15:19 +01:00
59 changed files with 3773 additions and 857 deletions
@@ -66,8 +66,19 @@ jobs:
  build:
    name: "ubuntu-${{ matrix.os }}-${{ matrix.arch }}, GHC: ${{ matrix.ghc }}"
    needs: maybe-release
+    permissions:
+      contents: write
+      packages: write
    env:
      apps: "smp-server xftp-server ntf-server xftp"
+      opt: ${{ github.event_name == 'pull_request' && 'O0' || 'O2' }}
+      ghc_options: ${{ github.event_name == 'pull_request' && '--ghc-options=-O0' || '' }}
+      release: ${{ startsWith(github.ref, 'refs/tags/v') }}
+      postgres_dist: ${{ startsWith(github.ref, 'refs/tags/v') && 'dist-newstyle' || 'dist-postgres' }}
+      branch: ${{ github.base_ref || github.ref_name }}
+      cache_o0: ${{ github.event_name == 'push' && (github.ref == 'refs/heads/master' || github.ref == 'refs/heads/stable') }}
+      image_cache: ghcr.io/simplex-chat/simplexmq-build-cache:${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}
+      source_hashes: dist-newstyle/sources.sha256
    runs-on: ${{ matrix.runner }}
    services:
      postgres:
@@ -146,6 +157,18 @@ jobs:
          sudo apt update
          sudo apt -y install postgresql-client-15

+      - name: Log in to GitHub Container Registry
+        if: matrix.should_run == true && env.release != 'true'
+        shell: bash
+        env:
+          GHCR_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+        run: echo "$GHCR_TOKEN" | docker login ghcr.io -u "${{ github.actor }}" --password-stdin
+
+      - name: Compute image cache week
+        id: week
+        if: matrix.should_run == true && env.release != 'true'
+        run: echo "week=$(date -u +%G-W%V)" >> "$GITHUB_OUTPUT"
+
      - name: Build and cache Docker image
        if: matrix.should_run == true
        uses: simplex-chat/docker-build-push-action@v6
@@ -157,20 +180,14 @@ jobs:
          build-args: |
            TAG=${{ matrix.os }}
            GHC=${{ matrix.ghc }}
-
-      - name: Cache dependencies
-        if: matrix.should_run == true
-        uses: actions/cache@v4
-        with:
-          path: |
-            ~/.cabal/store
-            dist-newstyle
-          key: ubuntu-${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }}
+          cache-from: ${{ env.release != 'true' && format('type=registry,ref={0}-{1}', env.image_cache, steps.week.outputs.week) || '' }}
+          cache-to: ${{ github.event_name == 'push' && github.ref == 'refs/heads/master' && format('type=registry,ref={0}-{1},mode=max,ignore-error=true', env.image_cache, steps.week.outputs.week) || '' }}

      - name: Start container
        if: matrix.should_run == true
        shell: bash
        run: |
+          mkdir -p ~/.cabal
          docker run -t -d \
            --device /dev/fuse \
            --cap-add SYS_ADMIN \
@@ -181,21 +198,66 @@ jobs:
            -v ${{ github.workspace }}:/project \
            build/${{ matrix.os }}:latest

+      - name: Compute cache key prefixes
+        id: keys
+        if: matrix.should_run == true && env.release != 'true'
+        run: |
+          toolchain=$(docker exec builder dpkg-query -W -f '${db:Status-Status} ${binary:Package} ${Version}\n' 'binutils*' 'cpp*' 'gcc*' '*-dev' | grep '^installed ' | sha256sum | cut -c1-16)
+          target=${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}-$toolchain
+          echo "deps=deps-$target" >> "$GITHUB_OUTPUT"
+          echo "dist=dist-$target" >> "$GITHUB_OUTPUT"
+
+      - name: Restore dependencies from cache
+        id: restore-deps
+        if: matrix.should_run == true && env.release != 'true'
+        uses: actions/cache/restore@v4
+        with:
+          path: ~/.cabal/store
+          key: ${{ steps.keys.outputs.deps }}-${{ env.branch }}-${{ github.sha }}
+          restore-keys: |
+            ${{ steps.keys.outputs.deps }}-${{ env.branch }}-
+            ${{ steps.keys.outputs.deps }}-
+
+      - name: Warn if dependencies not in cache
+        if: matrix.should_run == true && env.release != 'true' && steps.restore-deps.outputs.cache-matched-key == ''
+        run: echo "::warning title=Cache miss::${{ steps.keys.outputs.deps }}-${{ env.branch }}"
+
+      - name: Restore build directories from cache
+        id: restore-build
+        if: matrix.should_run == true && env.release != 'true'
+        uses: actions/cache/restore@v4
+        with:
+          path: |
+            dist-newstyle
+            dist-postgres
+          key: ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-${{ github.sha }}
+          restore-keys: |
+            ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-
+            ${{ steps.keys.outputs.dist }}-${{ env.opt }}-
+
+      - name: Warn if build directories not in cache
+        if: matrix.should_run == true && env.release != 'true' && steps.restore-build.outputs.cache-matched-key == ''
+        run: echo "::warning title=Cache miss::${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}"
+
+      - name: Set old timestamps on unchanged sources (GHC 8.10.7)
+        if: matrix.ghc == '8.10.7' && steps.restore-build.outputs.cache-matched-key != '' && hashFiles(env.source_hashes) != ''
+        run: scripts/ci/source-timestamps.sh restore ${{ env.source_hashes }}
+
      - name: Build smp-server, xftp-server (postgresql) and tests
        if: matrix.should_run == true
        shell: docker exec -t builder sh -eu {0}
        run: |
-          chmod -fR 777 ~/.cabal ./dist-newstyle || :; git config --global --add safe.directory '*'
-          cabal clean
+          chmod -fR 777 ~/.cabal ./dist-newstyle ./dist-postgres || :; git config --global --add safe.directory '*'
+          scripts/ci/prune-old-builds.sh dist-newstyle dist-postgres
          cabal update
-          cabal build --jobs=$(nproc) --enable-tests -fserver_postgres
+          cabal build --builddir=${{ env.postgres_dist }} --jobs=$(nproc) --enable-tests -fserver_postgres ${{ env.ghc_options }}
          mkdir -p /out
-          for i in smp-server xftp-server simplexmq-test; do
-            bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
+          for i in smp-server xftp-server ntf-server simplexmq-test; do
+            bin=$(find /project/${{ env.postgres_dist }} -name "$i" -type f -executable)
            chmod +x "$bin"
-            mv "$bin" /out/
+            cp "$bin" /out/
          done
-          strip /out/smp-server /out/xftp-server
+          strip /out/smp-server /out/xftp-server /out/ntf-server

      - name: Copy simplexmq-test from container
        if: matrix.should_run == true
@@ -228,16 +290,17 @@ jobs:
          cat hashes.output >> "$GITHUB_OUTPUT"

      - name: Build everything else (standard)
+        id: build-standard
        if: matrix.should_run == true
        shell: docker exec -t builder sh -eu {0}
        run: |
-          cabal build --jobs=$(nproc)
+          cabal build --jobs=$(nproc) ${{ env.ghc_options }}
          mkdir -p /out
-          for i in ${{ env.apps }}; do
+          for i in smp-server xftp-server xftp; do
            bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
            strip "$bin"
            chmod +x "$bin"
-            mv "$bin" /out/
+            cp "$bin" /out/
          done

      - name: Copy binaries from container and prepare them
@@ -282,6 +345,33 @@ jobs:
        env:
          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}

+      - name: Record source hashes (GHC 8.10.7)
+        if: matrix.should_run == true && matrix.ghc == '8.10.7'
+        shell: docker exec -t builder sh -eu {0}
+        run: scripts/ci/source-timestamps.sh record ${{ env.source_hashes }}
+
+      - name: Compute dependency cache key
+        id: hash-deps
+        if: matrix.should_run == true && env.release != 'true'
+        shell: bash
+        run: echo "hash=$(ls ~/.cabal/store/ghc-*/ | sha256sum | cut -c1-16)" >> "$GITHUB_OUTPUT"
+
+      - name: Save dependencies to cache
+        if: matrix.should_run == true && env.release != 'true' && steps.restore-deps.outputs.cache-matched-key != format('{0}-{1}-{2}', steps.keys.outputs.deps, env.branch, steps.hash-deps.outputs.hash)
+        uses: actions/cache/save@v4
+        with:
+          path: ~/.cabal/store
+          key: ${{ steps.keys.outputs.deps }}-${{ env.branch }}-${{ steps.hash-deps.outputs.hash }}
+
+      - name: Save build directories to cache
+        if: matrix.should_run == true && env.release != 'true' && steps.restore-build.outputs.cache-hit != 'true'
+        uses: actions/cache/save@v4
+        with:
+          path: |
+            dist-newstyle
+            dist-postgres
+          key: ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-${{ github.sha }}
+
      - name: Test
        if: matrix.should_run == true && matrix.arch == 'x86-64'
        timeout-minutes: 120
@@ -306,6 +396,52 @@ jobs:
            exit 1
          fi

+      - name: Remove -O2 build directories
+        id: remove-o2
+        if: env.cache_o0 == 'true' && !cancelled() && steps.build-standard.outcome == 'success'
+        shell: docker exec -t builder sh -eu {0}
+        run: rm -rf dist-newstyle dist-postgres
+
+      - name: Restore -O0 build directories from cache
+        id: restore-build-o0
+        if: ${{ !cancelled() && steps.remove-o2.outcome == 'success' }}
+        uses: actions/cache/restore@v4
+        with:
+          path: |
+            dist-newstyle
+            dist-postgres
+          key: ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-${{ github.sha }}
+          restore-keys: |
+            ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-
+            ${{ steps.keys.outputs.dist }}-O0-
+
+      - name: Set old timestamps on unchanged sources for -O0 build (GHC 8.10.7)
+        if: ${{ !cancelled() && matrix.ghc == '8.10.7' && steps.restore-build-o0.outputs.cache-matched-key != '' && hashFiles(env.source_hashes) != '' }}
+        run: scripts/ci/source-timestamps.sh restore ${{ env.source_hashes }}
+
+      - name: Build at -O0 for pull request caches
+        id: build-o0
+        if: ${{ !cancelled() && steps.remove-o2.outcome == 'success' }}
+        shell: docker exec -t builder sh -eu {0}
+        run: |
+          scripts/ci/prune-old-builds.sh dist-newstyle dist-postgres
+          cabal build --builddir=dist-postgres --jobs=$(nproc) --enable-tests -fserver_postgres --ghc-options=-O0
+          cabal build --jobs=$(nproc) --ghc-options=-O0
+
+      - name: Record source hashes for -O0 build (GHC 8.10.7)
+        if: ${{ !cancelled() && matrix.ghc == '8.10.7' && steps.build-o0.outcome == 'success' }}
+        shell: docker exec -t builder sh -eu {0}
+        run: scripts/ci/source-timestamps.sh record ${{ env.source_hashes }}
+
+      - name: Save -O0 build directories to cache
+        if: ${{ !cancelled() && steps.build-o0.outcome == 'success' && steps.restore-build-o0.outputs.cache-hit != 'true' }}
+        uses: actions/cache/save@v4
+        with:
+          path: |
+            dist-newstyle
+            dist-postgres
+          key: ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-${{ github.sha }}
+
 # =============================
 #      Resolver test job
 # =============================
@@ -31,7 +31,7 @@ source-repository-package
 source-repository-package
    type: git
    location: https://github.com/simplex-chat/direct-sqlcipher.git
-    tag: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9
+    tag: 2330df3dc8c4b660674d3c02d76bb86f66c2abee

 source-repository-package
    type: git
@@ -144,7 +144,9 @@ space, so it is workload-dependent; `fillfactor = 80` reached 100% for this frac
 larger share of queues at once would need a lower value. `fillfactor` applies to pages rewritten after
 the change, so the ratio ramps up as the heap turns over, or immediately after `pg_repack`.

-The Postgres message store does not read `updated_at`, so no query depends on the dropped index.
+Dropping the index regresses the deprecated journal message store's expiration (`foldRecentQueueRecs`,
+`Journal.hs:434`) to a sequential scan; this is accepted because that store is being retired. The
+Postgres message store does not read `updated_at`.

 Autovacuum reloptions applied by the migration:

@@ -0,0 +1,62 @@
+# Fast rotation: draining the old receive queue
+
+Recipient only. The sender is unchanged.
+
+## Decisions
+
+- New `RcvSwitchStatus` value:
+
+  | constructor      | encoding        |
+  |------------------|-----------------|
+  | `RSReceivedQEND` | `received_qend` |
+
+  - Stored in `rcv_queues.switch_status`.
+  - `canAbortRcvSwitch` returns `False` for it.
+- `qEndMsg`, by the queue that delivered `QEND`:
+  - the queue named in `QEND`: the named queue is marked deleted, `ICDeleteRcvQueue` is enqueued.
+  - the new queue: the named queue is set to `RSReceivedQEND` and stays subscribed.
+  - `NSCCreate` and `SWITCH QDRcv SPCompleted`: sent when the named queue had no `RSReceivedQEND`.
+- Deletion of an `RSReceivedQEND` queue:
+  - trigger: `OK` response to an `ACK` on that queue, without a `GET` lock on it.
+  - action: the queue is marked deleted, `ICDeleteRcvQueue` is enqueued.
+- Bound, a `cleanupManager` step, for each connection with an `RSReceivedQEND` queue:
+  - condition: another receive queue of the connection has an active subscription.
+  - `delete_errors + 1 < deleteErrorCount`: `delete_errors` is incremented.
+  - otherwise: the queue is deleted as above; the first `DEL` error of `ICDeleteRcvQueue` removes it locally.
+- `ackSMPMessage` result, `type QueueDrained = Bool`:
+  - `OK`: `True`.
+  - `MSG`: `False`; the message is written to `msgQ`.
+- Apps: `received_qend` is added to `RcvSwitchStatus`.
+- Migration `20261008_rcv_switch_status`, SQLite and Postgres:
+  - up: index `idx_rcv_queues_switch_status` on `rcv_queues(switch_status)`.
+  - down: `received_qend` is set to `NULL`, the index is dropped.
+
+## Mechanics
+
+- `Agent/Protocol.hs`: `RSReceivedQEND`.
+- `Agent/Store.hs`: `canAbortRcvSwitch`.
+- `Client.hs`: `QueueDrained`; `ackSMPMessage` returns it.
+- `Agent/Client.hs`: `sendAck` returns `QueueDrained`.
+- `Agent/Store/AgentStore.hs`: `getEndedRcvQueueConnIds`:
+
+  ```sql
+  SELECT conn_id FROM rcv_queues WHERE switch_status = ? AND deleted = 0
+  ```
+
+- `Agent.hs`:
+  - `deleteRcvQueueAsync`: `setRcvQueueDeleted`, then `ICDeleteRcvQueue`.
+  - `qEndMsg`.
+  - `ackQueueMessage`.
+  - `cleanupManager`: `expireEndedRcvQueues`.
+- Apps:
+  - `apps/ios/SimpleXChat/APITypes.swift`
+  - `apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt`
+
+## Tests
+
+- `QEND` on the new queue while a message waits on the old queue:
+  - the message is delivered;
+  - the old queue is deleted after the `ACK` that returns `OK`.
+- The same with a recipient restart before the `ACK`.
+- Old server stopped: the old queue is deleted by the bound.
+- Downgrade: `received_qend` is cleared, other switch statuses are kept.
@@ -0,0 +1,52 @@
+# Delayed AUTH error responses
+
+## Decisions
+
+- Responses that include `ERR AUTH` are sent at the next multiple of the delay after the start time.
+- Delayed response sets:
+
+  | Source | Responses sent together | Start time |
+  |---|---|---|
+  | `receive`, failed verification | verification and parsing errors of one received block | block receipt |
+  | `client`, command processing | responses and messages of one batch | batch read from `rcvQ` |
+  | `RFWD`, forwarded command | the `RRES` of that command | start of forwarded command processing |
+
+- A thread created by `forkClient` writes the responses to the send queue.
+- Delay 0: the responses are written to the send queue directly.
+- `authDelayExceeded`: incremented when processing took longer than the delay.
+  - Prometheus counter `simplex_smp_auth_delay_exceeded`.
+  - Not saved in the stats backup.
+  - Not in the daily stats log.
+- Configuration:
+
+  | Item | Value |
+  |---|---|
+  | INI section | `TRANSPORT` |
+  | INI key | `auth_error_delay_ms` |
+  | default | 50 |
+  | `ServerConfig` field | `authErrorDelay`, microseconds |
+  | test servers | 20 ms |
+
+- AUTH timing test: elapsed time of 5 requests, test servers' delay.
+- Out of scope: NTF and XFTP servers.
+
+## Mechanics
+
+- `Server.hs`:
+  - `isAuthError`: response is `ERR AUTH`.
+  - `sendResponses`: responses with `ERR AUTH` to `sendAfterDelay`, others to the send queue.
+  - `sendAfterDelay`: writes responses to the send queue at the next multiple of the delay.
+  - `receive`: block receipt time from the `rcvActiveAt` reading.
+  - `client`: batch time.
+  - `processForwardedCommand`: start time.
+- `Server/Env/STM.hs`: `authErrorDelay` field, `defaultAuthErrorDelayMs`.
+- `Server/Stats.hs`: `authDelayExceeded` in `ServerStats` and `ServerStatsData`.
+- `Server/Prometheus.hs`: `simplex_smp_auth_delay_exceeded`.
+- `Server/Main.hs`: INI value.
+- `Server/Main/Init.hs`: INI template line.
+- `simplexmq.cabal`: `timeit` removed from the test suite.
+- `tests/SMPClient.hs`: `authErrorDelay = 20000`.
+- `tests/ServerTests.hs`:
+  - delayed AUTH for wrong key, absent queue, absent link and suspended queue; immediate `SOK`.
+  - AUTH timing test measures elapsed time.
+- `tests/SMPProxyTests.hs`: delayed AUTH to forwarded `SEND` and `LGET`.
@@ -0,0 +1,9 @@
+#!/bin/sh
+set -eu
+
+version=$(awk '/^version:/ {print $2}' simplexmq.cabal)
+for dir in "$@"; do
+  if [ -d "$dir/build" ]; then
+    find "$dir/build" -mindepth 3 -maxdepth 3 -type d -name 'simplexmq-*' ! -name "simplexmq-$version" -exec rm -rf {} +
+  fi
+done
@@ -0,0 +1,27 @@
+#!/bin/sh
+set -eu
+
+command=$1
+hashes=$2
+
+sources() {
+  git ls-files -z '*.hs' '*.hsc'
+}
+
+case "$command" in
+  record)
+    sources | xargs -0 sha256sum > "$hashes"
+    ;;
+  restore)
+    sources | xargs -0 touch
+    while read -r hash file; do
+      if [ -f "$file" ] && [ "$(sha256sum "$file" | cut -d' ' -f1)" = "$hash" ]; then
+        touch -d 2000-01-01 "$file"
+      fi
+    done < "$hashes"
+    ;;
+  *)
+    echo "usage: $0 record|restore <hashes file>" >&2
+    exit 1
+    ;;
+esac
@@ -1,7 +1,7 @@
 cabal-version: 3.0

 name:           simplexmq
-version:        7.1.0.10
+version:        7.1.0.11
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -196,6 +196,7 @@ library
          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_ratchet_indexes
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20261008_rcv_switch_status
  else
      exposed-modules:
          Simplex.Messaging.Agent.Store.SQLite
@@ -252,6 +253,8 @@ library
          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261008_rcv_switch_status
          Simplex.Messaging.Agent.Store.SQLite.Util
  if flag(client_postgres) || flag(server_postgres)
      exposed-modules:
@@ -281,6 +284,8 @@ library
          Simplex.Messaging.Server.Main.Init
          Simplex.Messaging.Server.Web
          Simplex.Messaging.Server.MsgStore
+          Simplex.Messaging.Server.MsgStore.Journal
+          Simplex.Messaging.Server.MsgStore.Journal.SharedLock
          Simplex.Messaging.Server.MsgStore.STM
          Simplex.Messaging.Server.MsgStore.Types
          Simplex.Messaging.Server.Names
@@ -597,7 +602,7 @@ test-suite simplexmq-test
  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
+  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 -N1"
  build-depends:
      base
    , aeson
@@ -635,7 +640,6 @@ test-suite simplexmq-test
    , stm
    , text
    , time
-    , timeit ==2.0.*
    , tls >=1.9.0 && <1.10
    , transformers
    , unliftio
@@ -568,9 +568,10 @@ runXFTPSndWorker c srv Worker {doWork} = do
      notify c sndFileEntityId $ SFPROG uploaded total
      when complete $ do
        (sndDescr, rcvDescrs) <- sndFileToDescrs sf
+        flip catchAllErrors (\e -> logError $ "XFTP snd worker error: " <> tshow e) $ do
+          lift . forM_ prefixPath $ removePath <=< toFSFilePath
+          withStore' c $ \db -> updateSndFileComplete db sndFileId
        notify c sndFileEntityId $ SFDONE sndDescr rcvDescrs (sndFileExpiresAt chunks)
-        lift . forM_ prefixPath $ removePath <=< toFSFilePath
-        withStore' c $ \db -> updateSndFileComplete db sndFileId
      where
        addRecipients :: SndFileChunk -> SndFileChunkReplica -> AM SndFileChunkReplica
        addRecipients ch@SndFileChunk {numRecipients} cr@SndFileChunkReplica {sndChunkReplicaId, rcvIdsKeys}
@@ -80,7 +80,7 @@ import Simplex.Messaging.Protocol
    tParse,
  )
 import Simplex.Messaging.Transport (THandleParams (..), TransportError (..), TransportPeer (..))
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (eitherToMaybe, (<$?>))

 xftpBlockSize :: Int
 xftpBlockSize = 16384
@@ -383,7 +383,7 @@ checkParty' c = case testEquality (sFileParty @p) (sFileParty @p') of
 xftpEncodeAuthTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion 'TClient -> C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
 xftpEncodeAuthTransmission thParams@THandleParams {thAuth} pKey t@(corrId, _, _) = do
  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams t
-  xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth False (Just pKey) (C.cbNonce $ bs corrId) tForAuth
+  xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth False (Just pKey) (eitherToMaybe $ C.cbNonce $ bs corrId) tForAuth

 xftpEncodeTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
 xftpEncodeTransmission thParams t = xftpEncodeBatch1 (Nothing, encodeTransmission thParams t)
@@ -63,7 +63,10 @@ module Simplex.Messaging.Agent
    createConnection,
    prepareConnectionLink,
    createConnectionForLink,
+    prepareInvitationLink,
+    createInvitationForLink,
    setConnShortLink,
+    prepareConnShortLink,
    deleteConnShortLink,
    getConnShortLink,
    resolveSimplexName,
@@ -439,22 +442,39 @@ createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::: newCo
 -- Caller provides root signing key pair and link entity ID.
 -- Returns the created link and internal params.
 -- The link address is fully determined at this point.
-prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams)
+prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)))
 prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_ =
  withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_
 {-# INLINE prepareConnectionLink #-}

 -- | Create connection for prepared link (single network call).
 -- Validates that server response matches the prepared link.
-createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> SubscriptionMode -> AE ConnId
+createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) -> UserConnLinkData 'CMContact -> SubscriptionMode -> AE ConnId
 createConnectionForLink c nm userId enableNtfs = withAgentEnv c .:: createConnectionForLink' c nm userId enableNtfs
 {-# INLINE createConnectionForLink #-}

+-- | Prepare one-time invitation link (no network call).
+-- Returns the invitation and internal params with the link key.
+-- The link ID is assigned by the server when the connection is created.
+prepareInvitationLink :: AgentClient -> UserId -> CR.InitialKeys -> Maybe SMPServerWithAuth -> AE (ConnectionRequestUri 'CMInvitation, PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448))
+prepareInvitationLink c userId pqInitKeys srv_ = withAgentEnv c $ prepareInvitationLink' c userId pqInitKeys srv_
+{-# INLINE prepareInvitationLink #-}
+
+-- | Create connection for prepared invitation link (single network call).
+-- Returns the created link with the link ID assigned by the server.
+createInvitationForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> ConnectionRequestUri 'CMInvitation -> PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448) -> UserConnLinkData 'CMInvitation -> SubscriptionMode -> AE (ConnId, CreatedConnLink 'CMInvitation)
+createInvitationForLink c nm userId enableNtfs = withAgentEnv c .:: createInvitationForLink' c nm userId enableNtfs
+{-# INLINE createInvitationForLink #-}
+
 -- | Create or update user's contact connection short link
 setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> Maybe CR.InitialKeys -> AE (ConnShortLink c)
 setConnShortLink c = withAgentEnv c .:::. setConnShortLink' c
 {-# INLINE setConnShortLink #-}

+prepareConnShortLink :: AgentClient -> ConnId -> Maybe CRClientData -> AE (ConnShortLink 'CMContact)
+prepareConnShortLink c = withAgentEnv c .: prepareConnShortLink' c
+{-# INLINE prepareConnShortLink #-}
+
 deleteConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AE ()
 deleteConnShortLink c = withAgentEnv c .:. deleteConnShortLink' c
 {-# INLINE deleteConnShortLink #-}
@@ -506,7 +526,7 @@ joinConnection c nm userId connId enableNtfs = withAgentEnv c .:: joinConn c nm

 -- | Allow connection to continue after CONF notification (LET command)
 allowConnection :: AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> AE ()
-allowConnection c = withAgentEnv c .:. allowConnection' c
+allowConnection c = withAgentEnv c .:. allowConnection' c Nothing
 {-# INLINE allowConnection #-}

 -- | Accept contact after REQ notification (ACPT command)
@@ -636,7 +656,7 @@ sendMessagesB c = withAgentEnv c . sendMessagesB' c
 {-# INLINE sendMessagesB #-}

 ackMessage :: AgentClient -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AE ()
-ackMessage c = withAgentEnv c .:. ackMessage' c
+ackMessage c = withAgentEnv c .:. ackMessage' c Nothing
 {-# INLINE ackMessage #-}

 getConnectionQueueInfo :: AgentClient -> NetworkRequestMode -> ConnId -> AE ServerQueueInfo
@@ -1035,30 +1055,20 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey

 -- | Prepare connection link for contact mode (no network, no database).
 -- Caller provides root signing key pair and link entity ID.
-prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams)
-prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData pqInitKeys useDR srv_ = do
-  g <- asks random
-  plpSrvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_
-  when checkNotices $ checkClientNotices c plpSrvWithAuth
-  AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
-  plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
-  plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g
+prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)))
+prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_ = do
+  srvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_
+  when checkNotices $ checkClientNotices c srvWithAuth
  addrKeys_ <- if useDR then Just <$> generateAddressRatchetKeys pqInitKeys else pure Nothing
-  let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
-      qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just QMContact)
-      connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) (fst <$> addrKeys_)
-      (plpLinkKey, plpSignedFixedData) = SL.encodeSignFixedData rootKey smpAgentVRange connReq (Just linkEntityId)
-      ccLink = CCLink connReq $ Just $ CSLContact SLSServer CCTContact srv plpLinkKey
-      params = PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys = pqInitKeys, plpAddressKeys = snd <$> addrKeys_}
-  pure (ccLink, params)
+  (connReq, params@PreparedLinkParams {plpLinkKey}) <-
+    prepareLinkParams rootKey (Just linkEntityId) clientData pqInitKeys srvWithAuth QMContact (`CRContactUri` (fst <$> addrKeys_)) (snd <$> addrKeys_)
+  pure (CCLink connReq $ Just $ CSLContact SLSServer CCTContact srv plpLinkKey, params)

 -- | Create connection for prepared link (single network call).
-createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> SubscriptionMode -> AM ConnId
-createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys, plpAddressKeys} userLinkData subMode = do
+createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) -> UserConnLinkData 'CMContact -> SubscriptionMode -> AM ConnId
+createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) params@PreparedLinkParams {plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpRatchetKeys} userLinkData subMode = do
  g <- asks random
  AgentConfig {smpAgentVRange} <- asks config
-  connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption plpInitKeys)
-  mapM_ (storeAddressRatchetKeys c connId) plpAddressKeys
  let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} addrKeys_ = connReq
      userLinkData' = case addrKeys_ of
        Just arKeys -> let UserContactLinkData ucd = userLinkData in UserContactLinkData ucd {ratchetKeys = Just arKeys}
@@ -1066,13 +1076,54 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP
      md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData'
      linkData = (plpSignedFixedData, md)
  qd <- encryptContactLinkData g plpRootPrivKey plpLinkKey sndId linkData
-  (_, qUri) <-
-    createRcvQueue c nm userId connId plpSrvWithAuth enableNtfs subMode (Just plpNonce) qd plpQueueE2EKeys
-      `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
+  (connId, _, qUri) <- createLinkQueue c nm userId enableNtfs SCMContact params subMode qd $ \connId -> mapM_ (storeAddressRatchetKeys c connId) plpRatchetKeys
  let SMPQueueUri _ SMPQueueAddress {senderId = actualSndId} = qUri
  unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch"
  pure connId

+-- | Prepare one-time invitation link (no network, no database).
+prepareInvitationLink' :: AgentClient -> UserId -> CR.InitialKeys -> Maybe SMPServerWithAuth -> AM (ConnectionRequestUri 'CMInvitation, PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448))
+prepareInvitationLink' c userId pqInitKeys srv_ = do
+  g <- asks random
+  srvWithAuth <- maybe (getSMPServer c userId) pure srv_
+  e2eVR <- asks $ e2eEncryptVRange . config
+  rootKey <- atomically $ C.generateKeyPair g
+  (pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.initialPQEncryption True pqInitKeys)
+  prepareLinkParams rootKey Nothing Nothing pqInitKeys srvWithAuth QMMessaging (`CRInvitationUri` toVersionRangeT e2eRcvParams e2eVR) pks
+
+-- | Create connection for prepared invitation link (single network call).
+createInvitationForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> ConnectionRequestUri 'CMInvitation -> PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448) -> UserConnLinkData 'CMInvitation -> SubscriptionMode -> AM (ConnId, CreatedConnLink 'CMInvitation)
+createInvitationForLink' c nm userId enableNtfs connReq params@PreparedLinkParams {plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpInitKeys, plpRatchetKeys} userLinkData subMode = do
+  g <- asks random
+  AgentConfig {smpAgentVRange} <- asks config
+  let CRInvitationUri ConnReqUriData {crSmpQueues = qUri@(SMPQueueUri _ SMPQueueAddress {senderId = sndId}) :| _} _ = connReq
+      md = SL.encodeSignUserData SCMInvitation plpRootPrivKey smpAgentVRange userLinkData
+  srvData <- liftError id $ SL.encryptLinkData g (SL.invShortLinkKdf plpLinkKey) (plpSignedFixedData, md)
+  let qd = CQRMessaging $ Just CQRData {linkKey = plpLinkKey, privSigKey = plpRootPrivKey, srvReq = (sndId, srvData)}
+  (connId, rq, qUri') <- createLinkQueue c nm userId enableNtfs SCMInvitation params subMode qd $ \connId -> withStore' c $ \db -> createRatchetX3dhKeys db connId plpRatchetKeys
+  (connId,) <$> connReqWithShortLink plpInitKeys qUri connReq qUri' rq
+
+-- | Generate queue keys and sign fixed link data (no network, no database).
+prepareLinkParams :: ConnectionModeI c => C.KeyPairEd25519 -> Maybe ByteString -> Maybe CRClientData -> CR.InitialKeys -> SMPServerWithAuth -> QueueMode -> (ConnReqUriData -> ConnectionRequestUri c) -> k -> AM (ConnectionRequestUri c, PreparedLinkParams k)
+prepareLinkParams rootKey@(_, plpRootPrivKey) linkEntityId clientData plpInitKeys plpSrvWithAuth@(ProtoServerWithAuth srv _) qm mkConnReq plpRatchetKeys = do
+  g <- asks random
+  AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
+  plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
+  plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g
+  let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
+      qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just qm)
+      connReq = mkConnReq $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData
+      (plpLinkKey, plpSignedFixedData) = SL.encodeSignFixedData rootKey smpAgentVRange connReq linkEntityId
+  pure (connReq, PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys, plpRatchetKeys})
+
+-- | Create connection and its queue with link data; the connection is deleted when either step fails.
+createLinkQueue :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> SConnectionMode c -> PreparedLinkParams k -> SubscriptionMode -> ClntQueueReqData -> (ConnId -> AM ()) -> AM (ConnId, RcvQueue, SMPQueueUri)
+createLinkQueue c nm userId enableNtfs cMode PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpSrvWithAuth, plpInitKeys} subMode qd storeKeys = do
+  connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption plpInitKeys)
+  uncurry (connId,,)
+    <$> (storeKeys connId >> createRcvQueue c nm userId connId plpSrvWithAuth enableNtfs subMode (Just plpNonce) qd plpQueueE2EKeys)
+      `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
+
 generateAddressRatchetKeys :: CR.InitialKeys -> AM (AddressRatchetKeys, (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448))
 generateAddressRatchetKeys pqInitKeys = do
  g <- asks random
@@ -1197,7 +1248,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotateKeys pqKeys_ =
    prepareContactLinkData ConnData {} rq@RcvQueue {shortLink} (UserContactLinkData ucd) = do
      liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink ucd
      g <- asks random
-      AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
+      AgentConfig {smpAgentVRange} <- asks config
      -- rotate makes fresh keys from InitialKeys; otherwise keep current keys or create based on InitialKeys if there are no ratchet keys
      let currKeys = currentAddressRatchetKeys c connId
      ratchetKeys <- case pqKeys_ of
@@ -1207,32 +1258,47 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotateKeys pqKeys_ =
        Nothing -> currKeys
      let ud = UserContactLinkData ucd {ratchetKeys}
          cslContact = CSLContact SLSServer CCTContact (qServer rq)
-      case shortLink of
-        Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
+      (ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData}, k) <- case shortLink of
+        Just creds@ShortLinkCreds {shortLinkId, shortLinkKey} -> do
          let (linkId, k) = SL.contactShortLinkKdf shortLinkKey
          unless (shortLinkId == linkId) $ throwE $ INTERNAL "setConnShortLink: link ID is not derived from link"
-          d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud
-          pure (rq, linkId, cslContact shortLinkKey, (linkEncFixedData, d))
-        Nothing -> do
-          sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
-          let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact}
-              connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) ratchetKeys
-              (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing ud
-              (linkId, k) = SL.contactShortLinkKdf linkKey
-          srvData <- liftError id $ SL.encryptLinkData g k linkData
-          let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing (fst srvData)
-          withStore' c $ \db -> updateShortLinkCreds db rq slCreds
-          pure (rq, linkId, cslContact linkKey, srvData)
-    prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
-    prepareInvLinkData rq@RcvQueue {shortLink} ud = case shortLink of
-      Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
-        g <- asks random
-        AgentConfig {smpAgentVRange} <- asks config
-        let k = SL.invShortLinkKdf shortLinkKey
-        d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMInvitation linkPrivSigKey smpAgentVRange ud
-        let sl = CSLInvitation SLSServer (qServer rq) shortLinkId shortLinkKey
-        pure (rq, shortLinkId, sl, (linkEncFixedData, d))
-      Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation"
+          pure (creds, k)
+        Nothing -> newContactLinkCreds c rq clientData
+      d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud
+      pure (rq, shortLinkId, cslContact shortLinkKey, (linkEncFixedData, d))
+
+newContactLinkCreds :: AgentClient -> RcvQueue -> Maybe CRClientData -> AM (ShortLinkCreds, C.SbKey)
+newContactLinkCreds c rq clientData = do
+  g <- asks random
+  AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
+  sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
+  let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact}
+      connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) Nothing
+      (linkKey, fixedData) = SL.encodeSignFixedData sigKeys smpAgentVRange connReq Nothing
+      (linkId, k) = SL.contactShortLinkKdf linkKey
+  encFixedData <- liftError id $ SL.encryptFixedData g k fixedData
+  let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing encFixedData
+  withStore' c $ \db -> updateShortLinkCreds db rq slCreds
+  pure (slCreds, k)
+
+prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
+prepareInvLinkData rq@RcvQueue {shortLink} ud = case shortLink of
+  Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
+    g <- asks random
+    AgentConfig {smpAgentVRange} <- asks config
+    let k = SL.invShortLinkKdf shortLinkKey
+    d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMInvitation linkPrivSigKey smpAgentVRange ud
+    let sl = CSLInvitation SLSServer (qServer rq) shortLinkId shortLinkKey
+    pure (rq, shortLinkId, sl, (linkEncFixedData, d))
+  Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation"
+
+prepareConnShortLink' :: AgentClient -> ConnId -> Maybe CRClientData -> AM (ConnShortLink 'CMContact)
+prepareConnShortLink' c connId clientData =
+  withConnLock c connId "prepareConnShortLink" $
+    withStore c (`getConn` connId) >>= \case
+      SomeConn _ (ContactConnection _ rq@RcvQueue {shortLink}) ->
+        CSLContact SLSServer CCTContact (qServer rq) . shortLinkKey <$> maybe (fst <$> newContactLinkCreds c rq clientData) pure shortLink
+      _ -> throwE $ CMD PROHIBITED "prepareConnShortLink: not contact address"

 deleteConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AM ()
 deleteConnShortLink' c nm connId cMode =
@@ -1443,11 +1509,11 @@ newConnToAccept c userId connId enableNtfs invId pqSup = do
      pure (connId', CRBRatchet $ ratchetVerifyCodes ratchetState)

 newConnToAcceptDR :: AgentClient -> UserId -> ConnId -> DRInvitation -> Bool -> AM ConnData
-newConnToAcceptDR c userId connId DRInvitation {agentVersion, pqSupport} enableNtfs = do
+newConnToAcceptDR c userId connId DRInvitation {ratchetState, agentVersion, pqSupport} enableNtfs = do
  g <- asks random
  let cData = ConnData {userId, connId, connAgentVersion = agentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport, serviceRequestExpiresAt = Nothing}
-  connId' <- withStore c $ \db -> createNewConn db g cData SCMInvitation
-  pure (cData {connId = connId'} :: ConnData)
+  withStore c $ \db ->
+    createNewConn db g cData SCMInvitation $>>= \connId' -> Right (cData {connId = connId'} :: ConnData) <$ createRatchet db connId' ratchetState

 joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured
 joinConn c nm userId connId enableNtfs cReq cInfo pqSupport subMode = do
@@ -1505,9 +1571,8 @@ startJoinInvitationDR c userId ConnData {connId} DRInvitation {ratchetState, rep
  qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange
  (q, _) <- lift $ newSndQueue userId connId qInfo Nothing
  withStore c $ \db -> runExceptT $ do
-    liftIO $ lockConnForUpdate db connId
-    liftIO $ createRatchet db connId ratchetState
-    ExceptT $ updateNewConnSnd db connId q
+    sq <- ExceptT $ updateNewConnSnd db connId q
+    sq <$ liftIO (createRatchet db connId ratchetState)

 connRequestAgentVersion :: AgentClient -> ConnectionRequestUri c -> IO (Maybe VersionSMPA)
 connRequestAgentVersion c cReq = withAgentEnv' c $ case cReq of
@@ -1621,8 +1686,8 @@ delInvSL c connId srv lnkId =
  withStore' c (\db -> deleteInvShortLink db (protoServer srv) lnkId) `catchE` \e ->
    liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e))

-joinConnSrvAsync :: AgentClient -> ConnId -> (ConnData -> Maybe SndQueue -> AM (SndQueue, (Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId))) -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
-joinConnSrvAsync c connId startJoin cInfo subMode srv = do
+joinConnSrvAsync :: AgentClient -> AsyncCmdId -> ConnId -> (ConnData -> Maybe SndQueue -> AM (SndQueue, (Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId))) -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
+joinConnSrvAsync c cmdId connId startJoin cInfo subMode srv = do
  SomeConn cType conn <- withStore c (`getConn` connId)
  let cData = toConnData conn
  case conn of
@@ -1637,7 +1702,7 @@ joinConnSrvAsync c connId startJoin cInfo subMode srv = do
    doJoin :: ConnData -> Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured
    doJoin cData rq_ sq_ = do
      (sq, (e2eSndParams, lnkId_)) <- startJoin cData sq_
-      secureConfirmQueueAsync c cData rq_ sq srv cInfo e2eSndParams subMode
+      secureConfirmQueueAsync c cmdId cData rq_ sq srv cInfo e2eSndParams subMode
        >>= (mapM_ (delInvSL c connId srv) lnkId_ $>)

 createReplyQueue :: AgentClient -> NetworkRequestMode -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo
@@ -1652,13 +1717,15 @@ createReplyQueue c nm ConnData {userId, connId, enableNtfs} SndQueue {smpClientV
  pure qInfo

 -- | Approve confirmation (LET command) in Reader monad
-allowConnection' :: AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
-allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConnection" $ do
+allowConnection' :: AgentClient -> Maybe AsyncCmdId -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
+allowConnection' c cmdId_ connId confId ownConnInfo = withConnLock c connId "allowConnection" $ do
  withStore c (`getConn` connId) >>= \case
    SomeConn _ (RcvConnection _ RcvQueue {server, rcvId}) -> do
-      AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <-
-        withStore c $ \db -> acceptConfirmation db confId ownConnInfo
-      enqueueCommand c "" connId (Just server) . AInternalCommand $ ICAllowSecure rcvId senderKey
+      withStore c $ \db -> runExceptT $ do
+        AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <- ExceptT $ acceptConfirmation db confId ownConnInfo
+        ExceptT $ createCommand db "" connId (Just server) $ AInternalCommand $ ICAllowSecure rcvId senderKey
+        liftIO $ mapM_ (deleteCommand db) cmdId_
+      lift . void $ getAsyncCmdWorker True c connId (Just server)
    _ -> throwE $ CMD PROHIBITED "allowConnection"

 -- | Accept contact (ACPT command) in Reader monad
@@ -1744,7 +1811,7 @@ prepareReply c userId Invitation {invitationId, connReq, serviceRequest, created
    CRInvitationDR dr -> do
      cData <- newConnToAcceptDR c userId "" dr False
      sq <- startJoinInvitationDR c userId cData dr
-      storeConfirmation c cData sq Nothing innerMsg
+      storeConfirmation c Nothing cData sq Nothing innerMsg
      pure (cData, sq)

 serviceReqBinding :: CR.Ratchet a -> ByteString
@@ -2160,7 +2227,7 @@ getAsyncCmdWorker :: Bool -> AgentClient -> ConnId -> Maybe SMPServer -> AM' Wor
 getAsyncCmdWorker hasWork c connId server =
  getAgentWorker "async_cmd" hasWork c (connId, server) (asyncCmdWorkers c) (runCommandProcessing c connId server)

-data CommandCompletion = CCMoved | CCCompleted
+data CommandCompletion = CCMoved | CCCompleted | CCDeleted

 runCommandProcessing :: AgentClient -> ConnId -> Maybe SMPServer -> Worker -> AM ()
 runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
@@ -2195,15 +2262,15 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
            notify $ LDATA fixedData linkData connReq
        JOIN (JRInvitationDR dr@DRInvitation {replyQueue}) subMode ownCInfo -> noServer $ do
          triedHosts <- newTVarIO S.empty
-          tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do
+          tryAtomicCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do
            let startJoin cData sq_ = (,(Nothing, Nothing)) <$> maybe (startJoinInvitationDR c userId cData dr) pure sq_
-            sqSecured <- joinConnSrvAsync c connId startJoin ownCInfo subMode srv
+            sqSecured <- joinConnSrvAsync c cmdId connId startJoin ownCInfo subMode srv
            notify $ JOINED sqSecured
        JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do
          triedHosts <- newTVarIO S.empty
-          tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
+          tryAtomicCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
            let startJoin _ sq_ = first snd <$> startJoinInvitation c userId connId sq_ enableNtfs cReq pqEnc
-            sqSecured <- joinConnSrvAsync c connId startJoin connInfo subMode srv
+            sqSecured <- joinConnSrvAsync c cmdId connId startJoin connInfo subMode srv
            notify $ JOINED sqSecured
        -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously.
        -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously.
@@ -2225,35 +2292,37 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
                      if temporaryOrHostError e
                        then throwE e
                        else atomically $ void $ tryPutTMVar v $ Left e -- will not overwrite existing result
-        LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
-        ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK
+        LET confId ownCInfo -> withServer' . tryAtomicCommand $ allowConnection' c (Just cmdId) connId confId ownCInfo >> notify OK
+        ACK msgId rcptInfo_ -> withServer' . tryAtomicCommand $ ackMessage' c (Just cmdId) connId msgId rcptInfo_ >> notify OK
        SWCH ->
-          noServer . tryWithLock "switchConnection" $
+          noServer . tryAtomicWithLock "switchConnection" $
            withStore c (`getConn` connId) >>= \case
              SomeConn _ conn@(DuplexConnection _ (replaced :| _rqs) _) ->
-                switchDuplexConnection c NRMBackground conn replaced >>= notify . SWITCH QDRcv SPStarted
+                switchDuplexConnection c NRMBackground (Just cmdId) conn replaced >>= notify . SWITCH QDRcv SPStarted
              _ -> throwE $ CMD PROHIBITED "SWCH: not duplex"
-        DEL -> withServer' . tryCommand $ deleteConnection' c NRMBackground connId >> notify OK
+        DEL -> withServer' . tryAtomicCommand $ deleteConnection' c NRMBackground connId >> notify OK
      AInternalCommand cmd -> case cmd of
        ICAckDel rId srvMsgId msgId -> withServer $ \srv ->
-          tryCommand $ withConnLockNotify c connId "ICAckDel" $ do
+          tryAtomicCommand $ withConnLockNotify c connId "ICAckDel" $ do
            t_ <- ack srv rId srvMsgId
-            withStore' c (\db -> deleteMsg db connId msgId)
+            withStore' c (\db -> deleteMsg db connId msgId >> deleteCommand db cmdId)
            pure t_
        ICAck rId srvMsgId -> withServer $ \srv ->
          tryCommand $ withConnLockNotify c connId "ICAck" $ ack srv rId srvMsgId
        ICAllowSecure _rId senderKey -> withServer' . tryMoveableWithLock "ICAllowSecure" $ do
          (SomeConn _ conn, AcceptedConfirmation {senderConf, ownConnInfo}) <-
            withStore c $ \db -> runExceptT $ (,) <$> ExceptT (getConn db connId) <*> ExceptT (getAcceptedConfirmation db connId)
+          let connectReplyQueues_ cData sq_ = case L.nonEmpty $ smpReplyQueues senderConf of
+                Just qs -> connectReplyQueues c cmdId cData ownConnInfo sq_ qs $> CCDeleted
+                Nothing -> pure CCCompleted
          case conn of
            RcvConnection cData rq -> do
              mapM_ (secure rq) senderKey
-              mapM_ (connectReplyQueues c cData ownConnInfo Nothing) (L.nonEmpty $ smpReplyQueues senderConf)
-              pure CCCompleted
+              connectReplyQueues_ cData Nothing
            -- duplex connection is matched to handle SKEY retries
            DuplexConnection cData _ (sq :| _) -> do
-              tryAllErrors (mapM_ (connectReplyQueues c cData ownConnInfo (Just sq)) (L.nonEmpty $ smpReplyQueues senderConf)) >>= \case
-                Right () -> pure CCCompleted
+              tryAllErrors (connectReplyQueues_ cData (Just sq)) >>= \case
+                Right cc -> pure cc
                Left e
                  | temporaryOrHostError e && Just server /= server_ -> do
                      -- In case the server is different we update server to remove command from this (connId, srv) queue
@@ -2264,36 +2333,36 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
              where
                server = qServer sq
            _ -> throwE $ INTERNAL $ "incorrect connection type " <> show (internalCmdTag cmd)
-        ICDuplexSecure _rId senderKey -> withServer' . tryWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do
+        ICDuplexSecure _rId senderKey -> withServer' . tryAtomicWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do
          secure rq senderKey
-          void $ enqueueMessage c cData sq SMP.MsgFlags {notification = True} HELLO
+          void $ enqueueMessage c (Just cmdId) cData sq SMP.MsgFlags {notification = True} HELLO
        ICReplyDel -> withServer' . tryWithLock "ICReplyDel" $
          withStore c (`getConn` connId) >>= \case
            SomeConn _ (SndConnection cData sq) -> sendReplySync c NRMBackground (cData, sq)
            _ -> throwE $ INTERNAL "ICReplyDel: incorrect connection type"
        -- ICDeleteConn is no longer used, but it can be present in old client databases
        ICDeleteConn -> withStore' c (`deleteCommand` cmdId)
-        ICDeleteRcvQueue rId -> withServer $ \srv -> tryWithLock "ICDeleteRcvQueue" $ do
+        ICDeleteRcvQueue rId -> withServer $ \srv -> tryAtomicWithLock "ICDeleteRcvQueue" $ do
          rq <- withStore c (\db -> getDeletedRcvQueue db connId srv rId)
          maxErrs <- asks $ deleteErrorCount . config
          tryAllErrors (deleteQueue c NRMBackground rq) >>= \case
            Left e | temporaryOrHostError e && deleteErrors rq + 1 < maxErrs -> do
              withStore' c (`incRcvDeleteErrors` rq)
              throwE e
-            _ -> withStore' c (`deleteConnRcvQueue` rq)
+            _ -> withStore' c $ \db -> deleteConnRcvQueue db rq >> deleteCommand db cmdId
        ICQSecure rId senderKey ->
-          withServer $ \srv -> tryWithLock "ICQSecure" . withDuplexConn $ \(DuplexConnection cData rqs sqs) ->
+          withServer $ \srv -> tryAtomicWithLock "ICQSecure" . withDuplexConn $ \(DuplexConnection cData rqs sqs) ->
            case find (sameQueue (srv, rId)) rqs of
              Just rq'@RcvQueue {server, sndId, status, dbReplaceQueueId = Just replaceQId} ->
                case find ((replaceQId ==) . dbQId) rqs of
-                  Just rq1 -> when (status == Confirmed) $ do
+                  Just rq1 -> if status /= Confirmed then withStore' c (`deleteCommand` cmdId) else do
                    secureQueue c NRMBackground rq' senderKey
                    -- we may add more statistics special to queue rotation later on,
                    -- not accounting secure during rotation for now:
                    -- atomically $ incSMPServerStat c userId server connSecured
                    withStore' c $ \db -> setRcvQueueStatus db rq' Secured
                    void . enqueueMessages c cData sqs SMP.noMsgFlags $ QUSE [((server, sndId), True)]
-                    rq1' <- withStore' c $ \db -> setRcvSwitchStatus db rq1 $ Just RSSendingQUSE
+                    rq1' <- withStore' c $ \db -> setRcvSwitchStatus db rq1 (Just RSSendingQUSE) <* deleteCommand db cmdId
                    let rqs' = updatedQs rq1' rqs
                        conn' = DuplexConnection cData rqs' sqs
                    cStats <- connectionStats c conn'
@@ -2326,7 +2395,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
                    forM_ (find (\q -> sndSwchStatus q == Just SSSendingQEND) sqs) $ \oldSq ->
                      void $ enqueueMessages c cData [oldSq, sq'] SMP.noMsgFlags $ QEND [qAddress oldSq]
        ICQDelete rId -> do
-          withServer $ \srv -> tryWithLock "ICQDelete" . withDuplexConn $ \(DuplexConnection cData@ConnData {enableNtfs} rqs sqs) -> do
+          withServer $ \srv -> tryAtomicWithLock "ICQDelete" . withDuplexConn $ \(DuplexConnection cData@ConnData {enableNtfs} rqs sqs) -> do
            case removeQ (srv, rId) rqs of
              Nothing -> internalErr "ICQDelete: queue address not found in connection"
              Just (rq'@RcvQueue {primary}, rq'' : rqs')
@@ -2337,10 +2406,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
                      Right () -> finalizeSwitch
                      Left e
                        | temporaryOrHostError e -> throwE e
-                        | otherwise -> finalizeSwitch >> throwE e
+                        | otherwise -> finalizeSwitch >> notify (ERR e)
                where
                  finalizeSwitch = do
-                    withStore' c $ \db -> deleteConnRcvQueue db rq'
+                    withStore' c $ \db -> deleteConnRcvQueue db rq' >> deleteCommand db cmdId
                    when enableNtfs $ do
                      ns <- asks ntfSupervisor
                      liftIO $ sendNtfSubCommand ns (NSCCreate, [connId])
@@ -2373,6 +2442,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
            SomeConn _ conn@DuplexConnection {} -> a conn
            _ -> internalErr "command requires duplex connection"
        tryCommand action = tryMoveableCommand (action $> CCCompleted)
+        tryAtomicCommand action = tryMoveableCommand (action $> CCDeleted)
        tryMoveableCommand action = withRetryInterval2 ri $ \_ loop -> do
          liftIO $ waitWhileSuspended c
          liftIO $ waitForUserNetwork c
@@ -2388,7 +2458,9 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
              | otherwise -> cmdError e
            Right CCCompleted -> withStore' c (`deleteCommand` cmdId)
            Right CCMoved -> pure () -- command processing moved to another command queue
+            Right CCDeleted -> pure ()
        tryWithLock name = tryCommand . withConnLock c connId name
+        tryAtomicWithLock name = tryAtomicCommand . withConnLock c connId name
        tryMoveableWithLock name = tryMoveableCommand . withConnLock c connId name
        internalErr s = cmdError $ INTERNAL $ s <> ": " <> show (agentCommandTag command)
        cmdError e = notify (ERR e) >> withStore' c (`deleteCommand` cmdId)
@@ -2410,7 +2482,7 @@ enqueueMessages' c cData sqs msgFlags aMessage =

 enqueueMessagesB :: Traversable t => AgentClient -> t (Either AgentErrorType (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage)) -> AM' (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
 enqueueMessagesB c reqs = do
-  reqs' <- enqueueMessageB c reqs
+  reqs' <- enqueueMessageB c Nothing reqs
  enqueueSavedMessageB c $ mapMaybe snd $ rights $ toList reqs'
  pure $ fst <$$> reqs'

@@ -2420,17 +2492,19 @@ isActiveSndQ ConnData {connAgentVersion} sq@SndQueue {status, sndSwchStatus} =
    && (status == Secured || status == Active || (connAgentVersion >= rpcAddressSMPAgentVersion && securingSndQueue sq))
 {-# INLINE isActiveSndQ #-}

-enqueueMessage :: AgentClient -> ConnData -> SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, PQEncryption)
-enqueueMessage c cData sq msgFlags aMessage =
-  ExceptT $ fmap fst . runIdentity <$> enqueueMessageB c (Identity (Right (Right (cData, [sq]), Nothing, msgFlags, vrValue aMessage)))
+enqueueMessage :: AgentClient -> Maybe AsyncCmdId -> ConnData -> SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, PQEncryption)
+enqueueMessage c cmdId_ cData sq msgFlags aMessage =
+  ExceptT $ fmap fst . runIdentity <$> enqueueMessageB c cmdId_ (Identity (Right (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 (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe ([SndQueue], AgentMsgId))))
-enqueueMessageB c reqs = do
+enqueueMessageB :: forall t. Traversable t => AgentClient -> Maybe AsyncCmdId -> t (Either AgentErrorType (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe ([SndQueue], AgentMsgId))))
+enqueueMessageB c cmdId_ reqs = do
  cfg <- asks config
  (_, reqMids) <- unsafeWithStore c $ \db -> do
-    mapAccumLM (\ids r -> storeSentMsg db cfg ids r `E.catchAny` \e -> (ids,) <$> handleInternal e) IM.empty reqs
+    res@(_, rs) <- mapAccumLM (\ids r -> storeSentMsg db cfg ids r `E.catchAny` \e -> (ids,) <$> handleInternal e) IM.empty reqs
+    when (all isRight rs) $ mapM_ (deleteCommand db) cmdId_
+    pure res
  forME reqMids $ submitSentMsg c
  where
    handleInternal :: E.SomeException -> IO (Either AgentErrorType b)
@@ -2756,8 +2830,8 @@ withConnLockNotify c connId name action = do
  t_ <- withConnLock c connId name action
  forM_ t_ $ atomically . writeTBQueue (subQ c)

-ackMessage' :: AgentClient -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM ()
-ackMessage' c connId msgId rcptInfo_ = withConnLockNotify c connId "ackMessage" $ do
+ackMessage' :: AgentClient -> Maybe AsyncCmdId -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM ()
+ackMessage' c cmdId_ connId msgId rcptInfo_ = withConnLockNotify c connId "ackMessage" $ do
  SomeConn _ conn <- withStore c (`getConn` connId)
  case conn of
    DuplexConnection {} -> do
@@ -2779,7 +2853,7 @@ ackMessage' c connId msgId rcptInfo_ = withConnLockNotify c connId "ackMessage"
      (rq, srvMsgId) <- withStore c $ \db -> setMsgUserAck db connId $ InternalId msgId
      ackQueueMessage c rq srvMsgId
    del :: AM ()
-    del = withStore' c $ \db -> deleteMsg db connId $ InternalId msgId
+    del = withStore' c $ \db -> deleteMsg db connId (InternalId msgId) >> mapM_ (deleteCommand db) cmdId_
    sendRcpt :: Connection 'CDuplex -> AM ()
    sendRcpt (DuplexConnection cData _ sqs) = do
      msg@RcvMsg {msgType, msgReceipt} <- withStore c $ \db -> getRcvMsg db connId $ InternalId msgId
@@ -2814,11 +2888,11 @@ switchConnection' c nm connId =
        | otherwise -> do
            when (ratchetSyncSendProhibited cData) $ throwE $ CMD PROHIBITED "switchConnection: send prohibited"
            rq' <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSwitchStarted
-            switchDuplexConnection c nm conn rq'
+            switchDuplexConnection c nm Nothing conn rq'
      _ -> throwE $ CMD PROHIBITED "switchConnection: not duplex"

-switchDuplexConnection :: AgentClient -> NetworkRequestMode -> Connection 'CDuplex -> RcvQueue -> AM ConnectionStats
-switchDuplexConnection c nm (DuplexConnection cData@ConnData {connId, userId} rqs sqs) rq@RcvQueue {server, dbQueueId = DBEntityId dbQueueId, sndId} = do
+switchDuplexConnection :: AgentClient -> NetworkRequestMode -> Maybe AsyncCmdId -> Connection 'CDuplex -> RcvQueue -> AM ConnectionStats
+switchDuplexConnection c nm cmdId_ (DuplexConnection cData@ConnData {connId, userId} rqs sqs) rq@RcvQueue {server, dbQueueId = DBEntityId dbQueueId, sndId} = do
  checkRQSwchStatus rq RSSwitchStarted
  clientVRange <- asks $ smpClientVRange . config
  -- try to get the server that is different from all queues, or at least from the primary rcv queue
@@ -2831,7 +2905,7 @@ switchDuplexConnection c nm (DuplexConnection cData@ConnData {connId, userId} rq
  rq'' <- withStore c $ \db -> addConnRcvQueue db connId rq' SMSubscribe
  lift $ addNewQueueSubscription c rq'' tSess sessId serviceId_
  void . enqueueMessages c cData sqs SMP.noMsgFlags $ QADD [(qUri, Just (server, sndId))]
-  rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSendingQADD
+  rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq (Just RSSendingQADD) <* mapM_ (deleteCommand db) cmdId_
  let rqs' = updatedQs rq1 rqs <> [rq'']
  connectionStats c $ DuplexConnection cData rqs' sqs

@@ -2884,22 +2958,27 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
    _ -> throwE $ CMD PROHIBITED "synchronizeRatchet: not duplex"

 ackQueueMessage :: AgentClient -> RcvQueue -> SMP.MsgId -> AM (Maybe ATransmission)
-ackQueueMessage c rq@RcvQueue {userId, connId, server} srvMsgId = do
+ackQueueMessage c rq@RcvQueue {userId, connId, server, rcvSwchStatus} srvMsgId = do
  atomically $ incSMPServerStat c userId server ackAttempts
  tryAllErrors (sendAck c rq srvMsgId) >>= \case
-    Right _ -> sendMsgNtf ackMsgs
-    Left (SMP _ SMP.NO_MSG) -> sendMsgNtf ackNoMsgErrs
+    Right drained -> sendMsgNtf ackMsgs $ drained && rcvSwchStatus == Just RSReceivedQEND
+    Left (SMP _ SMP.NO_MSG) -> sendMsgNtf ackNoMsgErrs False
    Left e -> do
      unless (temporaryOrHostError e) $ atomically $ incSMPServerStat c userId server ackOtherErrs
      throwE e
  where
-    sendMsgNtf stat = do
+    sendMsgNtf stat ended = do
      atomically $ incSMPServerStat c userId server stat
      ifM (liftIO $ hasGetLock c rq)
        (do atomically $ releaseGetLock c rq
            brokerTs_ <- eitherToMaybe <$> tryAllErrors (withStore c $ \db -> getRcvMsgBrokerTs db connId srvMsgId)
            pure $ Just ("", connId, AEvt SAEConn $ MSGNTF srvMsgId brokerTs_))
-        (pure Nothing)
+        (Nothing <$ when ended (deleteRcvQueueAsync c rq))
+
+deleteRcvQueueAsync :: AgentClient -> RcvQueue -> AM ()
+deleteRcvQueueAsync c rq@RcvQueue {connId, server, rcvId} = do
+  withStore' c (`setRcvQueueDeleted` rq)
+  enqueueCommand c "" connId (Just server) $ AInternalCommand $ ICDeleteRcvQueue rcvId

 -- | Suspend SMP agent connection (OFF command) in Reader monad
 suspendConnection' :: AgentClient -> NetworkRequestMode -> ConnId -> AM ()
@@ -3429,6 +3508,7 @@ cleanupManager c@AgentClient {subQ} = do
    run SFERR deleteSndFilesPrefixPaths
    run SFERR deleteExpiredReplicasForDeletion
    run ERR deleteExpiredServiceReqs
+    run ERR expireEndedRcvQueues
    liftIO $ threadDelay' int
  where
    run :: forall e. AEntityI e => (AgentErrorType -> AEvent e) -> AM () -> AM' ()
@@ -3486,6 +3566,20 @@ cleanupManager c@AgentClient {subQ} = do
        deleteExpiredServiceRequests db $ addUTCTime (negate serviceResponseTimeout) now
        getExpiredServiceConns db now
      deleteConnectionsAsync' c False expiredConns
+    expireEndedRcvQueues = do
+      maxErrs <- asks $ deleteErrorCount . config
+      connIds <- withStore' c getEndedRcvQueueConnIds
+      forM_ connIds $ \connId -> flip catchAllErrors (notify connId . ERR) $
+        withConnLock c connId "cleanupManager" $
+          withStore c (`getConn` connId) >>= \case
+            SomeConn _ (DuplexConnection _ rqs _) -> do
+              let (ended, current) = L.partition ((Just RSReceivedQEND ==) . rcvSwchStatus) rqs
+              whenM (anyM $ map (atomically . hasActiveSubscription c) current) $
+                forM_ ended $ \rq ->
+                  if deleteErrors rq + 1 < maxErrs
+                    then withStore' c (`incRcvDeleteErrors` rq)
+                    else deleteRcvQueueAsync c rq
+            _ -> pure ()
    notify :: forall e. AEntityI e => AEntityId -> AEvent e -> AM ()
    notify entId cmd = atomically $ writeTBQueue subQ ("", entId, AEvt (sAEntity @e) cmd)

@@ -3643,7 +3737,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                              HELLO -> helloMsg srvMsgId msgMeta conn'' >> ackDel msgId
                              -- note that there is no ACK sent for A_MSG, it is sent with agent's user ACK command
                              A_MSG body -> do
-                                logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' srvMsgId
+                                logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' (SMP.unMsgId srvMsgId)
                                notify $ MSG msgMeta msgFlags body
                                pure ACKPending
                              A_RCVD rcpts -> qDuplex conn'' "RCVD" $ messagesRcvd rcpts msgMeta
@@ -3653,7 +3747,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                              QUSE qs -> qDuplexAckDel conn'' "QUSE" $ qUseMsg srvMsgId qs
                              -- no action needed for QTEST
                              -- any message in the new queue will mark it active and trigger deletion of the old queue
-                              QTEST _ -> logServer "<--" c srv rId ("MSG <QTEST>:" <> logSecret' srvMsgId) >> ackDel msgId
+                              QTEST _ -> logServer "<--" c srv rId ("MSG <QTEST>:" <> logSecret' (SMP.unMsgId srvMsgId)) >> ackDel msgId
                              QEND addrs -> qDuplexAckDel conn'' "QEND" $ qEndMsg srvMsgId addrs
                              EREADY _ -> qDuplexAckDel conn'' "EREADY" $ ereadyMsg rcPrev
                            where
@@ -3688,7 +3782,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                                      else
                                        liftEither (parse smpP (AGENT $ A_MESSAGE "parse msg body 1") agentMsgBody) >>= \case
                                          AgentMessage _ (A_MSG body) -> do
-                                            logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' srvMsgId
+                                            logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' (SMP.unMsgId srvMsgId)
                                            notify $ MSG msgMeta msgFlags body
                                            pure ACKPending
                                          _ -> ack
@@ -3834,7 +3928,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar

          smpConfirmation :: SMP.MsgId -> Connection c -> Maybe C.APublicAuthKey -> C.PublicKeyX25519 -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> ByteString -> VersionSMPC -> VersionSMPA -> AM ()
          smpConfirmation srvMsgId conn' senderKey e2ePubKey e2eEncryption encConnInfo phVer agentVersion = do
-            logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret' (SMP.unMsgId srvMsgId)
            checkConfVersions agentVersion phVer
            let ConnData {pqSupport, serviceRequestExpiresAt} = toConnData conn'
            case status of
@@ -3943,7 +4037,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar

          helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM ()
          helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do
-            logServer "<--" c srv rId $ "MSG <HELLO>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <HELLO>:" <> logSecret' (SMP.unMsgId srvMsgId)
            case status of
              Active -> prohibited "hello: active"
              _ ->
@@ -3961,13 +4055,13 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
              enqueueDuplexHello :: SndQueue -> AM ()
              enqueueDuplexHello sq = do
                let cData' = toConnData conn'
-                void $ enqueueMessage c cData' sq SMP.MsgFlags {notification = True} HELLO
+                void $ enqueueMessage c Nothing cData' sq SMP.MsgFlags {notification = True} HELLO

          continueSending :: SMP.MsgId -> (SMPServer, SMP.SenderId) -> Connection 'CDuplex -> AM ()
          continueSending srvMsgId addr (DuplexConnection _ _ sqs) =
            case findQ addr sqs of
              Just sq -> do
-                logServer "<--" c srv rId $ "MSG <QCONT>:" <> logSecret' srvMsgId
+                logServer "<--" c srv rId $ "MSG <QCONT>:" <> logSecret' (SMP.unMsgId srvMsgId)
                atomically $
                  TM.lookup (qAddress sq) (smpDeliveryWorkers c)
                    >>= mapM_ (\(_, retryLock) -> tryPutTMVar retryLock ())
@@ -3976,7 +4070,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar

          messagesRcvd :: NonEmpty AMessageReceipt -> MsgMeta -> Connection 'CDuplex -> AM ACKd
          messagesRcvd rcpts msgMeta@MsgMeta {broker = (srvMsgId, _)} _ = do
-            logServer "<--" c srv rId $ "MSG <RCPT>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <RCPT>:" <> logSecret' (SMP.unMsgId srvMsgId)
            rs <- forM rcpts $ \rcpt -> clientReceipt rcpt `catchAllErrors` \e -> notify (ERR e) $> Nothing
            case L.nonEmpty . catMaybes $ L.toList rs of
              Just rs' -> notify (RCVD msgMeta rs') $> ACKPending
@@ -4017,7 +4111,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                          lockConnForUpdate db connId
                          liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
                          addConnSndQueue db connId (sq_ :: NewSndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
-                        logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret' srvMsgId <> " " <> logSecret (senderId queueAddress)
+                        logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret' (SMP.unMsgId srvMsgId) <> " " <> logSecret (senderId queueAddress)
                        swchStatus <-
                          if connAgentVersion >= rpcAddressSMPAgentVersion
                            then do
@@ -4047,7 +4141,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
              Just rq'@RcvQueue {rcvId, e2ePrivKey = dhPrivKey, smpClientVersion = cVer, status = status'}
                | status' == New || status' == Confirmed -> do
                    checkRQSwchStatus rq RSSendingQADD
-                    logServer "<--" c srv rId $ "MSG <QKEY>:" <> logSecret' srvMsgId <> " " <> logSecret senderId
+                    logServer "<--" c srv rId $ "MSG <QKEY>:" <> logSecret' (SMP.unMsgId srvMsgId) <> " " <> logSecret senderId
                    let dhSecret = C.dh' dhPublicKey dhPrivKey
                    withStore' c $ \db -> setRcvQueueConfirmedE2E db rq' dhSecret $ min cVer cVer'
                    enqueueCommand c "" connId (Just smpServer) $ AInternalCommand $ ICQSecure rcvId senderKey
@@ -4069,7 +4163,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                case find ((replaceQId ==) . dbQId) sqs of
                  Just sq1 -> do
                    checkSQSwchStatus sq1 SSSendingQKEY
-                    logServer "<--" c srv rId $ "MSG <QUSE>:" <> logSecret' srvMsgId <> " " <> logSecret (snd addr)
+                    logServer "<--" c srv rId $ "MSG <QUSE>:" <> logSecret' (SMP.unMsgId srvMsgId) <> " " <> logSecret (snd addr)
                    withStore' c $ \db -> setSndQueueStatus db sq' Secured
                    let sq'' = (sq' :: SndQueue) {status = Secured}
                    -- sending QTEST to the new queue only, the old one will be removed if sent successfully
@@ -4085,19 +4179,23 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
          -- processed by queue recipient
          qEndMsg :: SMP.MsgId -> NonEmpty SndQAddr -> Connection 'CDuplex -> AM ()
          qEndMsg srvMsgId addrs (DuplexConnection cData'@ConnData {enableNtfs} rqs sqs) =
-            case L.partition (\rq' -> any (`sameQAddress` sndAddress rq') addrs) rqs of
+            case L.partition isRemoved rqs of
              (removed@(_ : _), keptRq : keptRqs) -> do
-                logServer "<--" c srv rId $ "MSG <QEND>:" <> logSecret' srvMsgId
-                forM_ removed $ \rq'@RcvQueue {server = rmServer, rcvId} -> do
-                  withStore' c $ \db -> setRcvQueueDeleted db rq'
-                  enqueueCommand c "" connId (Just rmServer) $ AInternalCommand $ ICDeleteRcvQueue rcvId
-                when enableNtfs $ do
-                  ns <- asks ntfSupervisor
-                  liftIO $ sendNtfSubCommand ns (NSCCreate, [connId])
-                let conn' = DuplexConnection cData' (keptRq :| keptRqs) sqs
-                cStats <- connectionStats c conn'
-                notify $ SWITCH QDRcv SPCompleted cStats
+                logServer "<--" c srv rId $ "MSG <QEND>:" <> logSecret' (SMP.unMsgId srvMsgId)
+                let completed = any ((Just RSReceivedQEND ==) . rcvSwchStatus) removed
+                if isRemoved rq
+                  then mapM_ (deleteRcvQueueAsync c) removed
+                  else withStore' c $ \db -> forM_ removed $ \rq' -> setRcvSwitchStatus db rq' $ Just RSReceivedQEND
+                unless completed $ do
+                  when enableNtfs $ do
+                    ns <- asks ntfSupervisor
+                    liftIO $ sendNtfSubCommand ns (NSCCreate, [connId])
+                  let conn' = DuplexConnection cData' (keptRq :| keptRqs) sqs
+                  cStats <- connectionStats c conn'
+                  notify $ SWITCH QDRcv SPCompleted cStats
              _ -> pure ()
+            where
+              isRemoved rq' = any (`sameQAddress` sndAddress rq') addrs

          qError :: String -> AM a
          qError = throwE . AGENT . A_QUEUE
@@ -4111,7 +4209,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar

          smpInvitation :: SMP.MsgId -> Connection c -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM ()
          smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData (CR.E2ERatchetParamsUri _ k1 k2 kem_)) cInfo = do
-            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' (SMP.unMsgId srvMsgId)
            case conn' of
              ContactConnection _ RcvQueue {sndId} -> do
                -- show connection request even if invitaion via contact address is not compatible.
@@ -4128,7 +4226,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar

          smpContactRequest :: SMP.MsgId -> Connection c -> VersionSMPA -> CR.SndE2ERatchetParams 'C.X448 -> RatchetKeyId -> ByteString -> VersionSMPC -> AM ()
          smpContactRequest srvMsgId conn' agentVersion e2eSndParams ratchetKeyId encConnInfo phVer = do
-            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' (SMP.unMsgId srvMsgId)
            case conn' of
              ContactConnection {} -> do
                checkConfVersions agentVersion phVer
@@ -4276,8 +4374,8 @@ switchStatusError q expected actual =
      <> (", actual=" <> show actual)

 -- used only in background
-connectReplyQueues :: AgentClient -> ConnData -> ConnInfo -> Maybe SndQueue -> NonEmpty SMPQueueInfo -> AM ()
-connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _) = do
+connectReplyQueues :: AgentClient -> AsyncCmdId -> ConnData -> ConnInfo -> Maybe SndQueue -> NonEmpty SMPQueueInfo -> AM ()
+connectReplyQueues c cmdId cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _) = do
  clientVRange <- asks $ smpClientVRange . config
  case qInfo `proveCompatible` clientVRange of
    Nothing -> throwE $ AGENT A_VERSION
@@ -4285,17 +4383,17 @@ connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _
      -- in case of SKEY retry the connection is already duplex
      sq' <- maybe upgradeConn pure sq_
      void $ agentSecureSndQueue c NRMBackground cData sq'
-      enqueueConfirmation c cData sq' ownConnInfo Nothing
+      enqueueConfirmation c cmdId cData sq' ownConnInfo Nothing
      where
        upgradeConn = do
          (sq, _) <- lift $ newSndQueue userId connId qInfo' Nothing
          withStore c $ \db -> upgradeRcvConnToDuplex db connId sq

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

@@ -4339,13 +4437,13 @@ mkAgentConfirmation c nm cData rq_ sq srv connInfo subMode = do
    Just rq@RcvQueue {smpClientVersion = v} -> pure $ SMPQueueInfo v $ rcvSMPQueueAddress rq
  pure $ AgentConnInfoReply (qInfo :| []) connInfo

-enqueueConfirmation :: AgentClient -> ConnData -> SndQueue -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AM ()
-enqueueConfirmation c cData sq connInfo e2eEncryption_ = do
-  storeConfirmation c cData sq e2eEncryption_ $ AgentConnInfo connInfo
+enqueueConfirmation :: AgentClient -> AsyncCmdId -> ConnData -> SndQueue -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AM ()
+enqueueConfirmation c cmdId cData sq connInfo e2eEncryption_ = do
+  storeConfirmation c (Just cmdId) cData sq e2eEncryption_ $ AgentConnInfo connInfo
  lift $ submitPendingMsg c sq

-storeConfirmation :: AgentClient -> ConnData -> SndQueue -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AgentMessage -> AM ()
-storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq e2eEncryption_ agentMsg = do
+storeConfirmation :: AgentClient -> Maybe AsyncCmdId -> ConnData -> SndQueue -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AgentMessage -> AM ()
+storeConfirmation c cmdId_ cData@ConnData {connId, pqSupport, connAgentVersion = v} sq e2eEncryption_ agentMsg = do
  currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
  withStore c $ \db -> runExceptT $ do
    internalTs <- liftIO getCurrentTime
@@ -4359,6 +4457,7 @@ storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq
        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 sq internalId
+    liftIO $ mapM_ (deleteCommand db) cmdId_

 enqueueRatchetKeyMsgs :: AgentClient -> ConnData -> NonEmpty SndQueue -> InternalId -> AM' ()
 enqueueRatchetKeyMsgs c cData (sq :| sqs) (InternalId msgId) = do
@@ -34,6 +34,7 @@ module Simplex.Messaging.Agent.Client
    withInvLock,
    withLockMap,
    withLocksMap,
+    getMapLock,
    ipAddressProtected,
    closeAgentClient,
    closeProtocolServerClients,
@@ -1981,7 +1982,7 @@ decryptSMPMessage :: RcvQueue -> SMP.RcvMessage -> AM SMP.ClientRcvMsgBody
 decryptSMPMessage rq SMP.RcvMessage {msgId, msgBody = SMP.EncRcvMsgBody body} =
  liftEither $ parse SMP.clientRcvMsgBodyP (AGENT $ A_MESSAGE "decrypt message") =<< decrypt body
  where
-    decrypt = agentCbDecrypt (rcvDhSecret rq) (C.cbNonce msgId)
+    decrypt = agentCbDecrypt (rcvDhSecret rq) msgId

 secureQueue :: AgentClient -> NetworkRequestMode -> RcvQueue -> SndPublicAuthKey -> AM ()
 secureQueue c nm rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
@@ -2079,9 +2080,9 @@ disableQueuesNtfs c = sendTSessionBatches "NDEL" (mkSMPTSession . snd) disableQu
    queueCreds :: DisableQueueNtfReq -> (SMP.RecipientId, SMP.RcvPrivateAuthKey)
    queueCreds (_, RcvQueue {rcvPrivateKey, rcvId}) = (rcvId, rcvPrivateKey)

-sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
+sendAck :: AgentClient -> RcvQueue -> MsgId -> AM QueueDrained
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId =
-  withSMPClient c NRMBackground rq ("ACK:" <> logSecret' msgId) $ \smp ->
+  withSMPClient c NRMBackground rq ("ACK:" <> logSecret' (SMP.unMsgId msgId)) $ \smp ->
    ackSMPMessage smp rcvPrivateKey rcvId msgId

 hasGetLock :: SomeRcvQueue q => AgentClient -> q -> IO Bool
@@ -2276,7 +2277,7 @@ agentCbEncryptOnce clientVersion dhRcvPubKey msg = do

 -- | NaCl crypto-box decrypt - both for messages received from the server
 -- and per-queue E2E encrypted messages from the sender that were inside.
-agentCbDecrypt :: C.DhSecretX25519 -> C.CbNonce -> ByteString -> Either AgentErrorType ByteString
+agentCbDecrypt :: C.CbNonceI n => C.DhSecretX25519 -> n -> ByteString -> Either AgentErrorType ByteString
 agentCbDecrypt dhSecret nonce msg =
  first cryptoError $
    C.cbDecrypt dhSecret nonce msg
@@ -6,6 +6,7 @@ module Simplex.Messaging.Agent.Lock
    withLock',
    withGetLock,
    withGetLocks,
+    getPutLock,
  )
 where

@@ -246,7 +246,6 @@ import Simplex.Messaging.Crypto.Ratchet
    RcvE2ERatchetParams,
    RcvE2ERatchetParamsUri,
    SndE2ERatchetParams,
-    RcvE2EPrivRatchetParams,
    pattern PQSupportOff,
    pattern PQSupportOn,
  )
@@ -612,6 +611,7 @@ data RcvSwitchStatus
  | RSSendingQADD
  | RSSendingQUSE
  | RSReceivedMessage
+  | RSReceivedQEND
  deriving (Eq, Show)

 instance StrEncoding RcvSwitchStatus where
@@ -620,12 +620,14 @@ instance StrEncoding RcvSwitchStatus where
    RSSendingQADD -> "sending_qadd"
    RSSendingQUSE -> "sending_quse"
    RSReceivedMessage -> "received_message"
+    RSReceivedQEND -> "received_qend"
  strP =
    A.takeTill (== ' ') >>= \case
      "switch_started" -> pure RSSwitchStarted
      "sending_qadd" -> pure RSSendingQADD
      "sending_quse" -> pure RSSendingQUSE
      "received_message" -> pure RSReceivedMessage
+      "received_qend" -> pure RSReceivedQEND
      _ -> fail "bad RcvSwitchStatus"

 instance ToField RcvSwitchStatus where toField = toField . decodeLatin1 . strEncode
@@ -1624,7 +1626,7 @@ newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
 instance ToField LinkKey where toField (LinkKey s) = toField $ Binary s

 -- | Parameters for creating a connection with a prepared link.
-data PreparedLinkParams = PreparedLinkParams
+data PreparedLinkParams k = PreparedLinkParams
  { -- | Correlation ID / determines sender ID
    plpNonce :: C.CbNonce,
    -- | Queue E2EE DH key pair
@@ -1639,8 +1641,8 @@ data PreparedLinkParams = PreparedLinkParams
    plpSrvWithAuth :: SMPServerWithAuth,
    -- | Initial PQ keys
    plpInitKeys :: InitialKeys,
-    -- | Contact address double ratchet keys
-    plpAddressKeys :: Maybe (RatchetKeyId, RcvE2EPrivRatchetParams 'C.X448)
+    -- | Contact address double ratchet keys or invitation X3DH keys
+    plpRatchetKeys :: k
  }

 instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode
@@ -219,6 +219,7 @@ canAbortRcvSwitch ConnData {connAgentVersion} = maybe False canAbort . rcvSwchSt
      -- if switch is in RSReceivedMessage status, aborting switch (deleting new queue)
      -- will break the connection because the sender would have original queue deleted
      RSReceivedMessage -> False
+      RSReceivedQEND -> False

 data ClientNtfCreds = ClientNtfCreds
  { -- | key pair to be used by the notification server to authorize transmissions
@@ -100,6 +100,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
    setSndQueuePrimary,
    deleteConnRcvQueue,
    incRcvDeleteErrors,
+    getEndedRcvQueueConnIds,
    deleteConnSndQueue,
    getPrimaryRcvQueue,
    getRcvQueue,
@@ -763,6 +764,10 @@ incRcvDeleteErrors :: DB.Connection -> RcvQueue -> IO ()
 incRcvDeleteErrors db RcvQueue {connId, dbQueueId} =
  DB.execute db "UPDATE rcv_queues SET delete_errors = delete_errors + 1 WHERE conn_id = ? AND rcv_queue_id = ?" (connId, dbQueueId)

+getEndedRcvQueueConnIds :: DB.Connection -> IO [ConnId]
+getEndedRcvQueueConnIds db =
+  map fromOnly <$> DB.query db "SELECT conn_id FROM rcv_queues WHERE switch_status = ? AND deleted = 0" (Only RSReceivedQEND)
+
 deleteConnRcvQueue :: DB.Connection -> RcvQueue -> IO ()
 deleteConnRcvQueue db RcvQueue {connId, dbQueueId} =
  DB.execute db "DELETE FROM rcv_queues WHERE conn_id = ? AND rcv_queue_id = ?" (connId, dbQueueId)
@@ -1255,7 +1260,7 @@ getLastMsg db connId msgId =
        LEFT JOIN snd_messages s ON s.conn_id = r.conn_id AND s.rcpt_internal_id = r.internal_id
        WHERE r.conn_id = ? AND r.broker_id = ?
      |]
-      (connId, Binary msgId)
+      (connId, msgId)

 toRcvMsg :: (Int64, InternalTs, BrokerId, BrokerTs) :. (AgentMsgId, MsgIntegrity, MsgHash, AgentMessageType, MsgBody, PQEncryption, Maybe AgentMsgId, Maybe MsgReceiptStatus, BoolInt) -> RcvMsg
 toRcvMsg ((agentMsgId, internalTs, brokerId, brokerTs) :. (sndMsgId, integrity, internalHash, msgType, msgBody, pqEncryption, rcptInternalId_, rcptStatus_, BI userAck)) =
@@ -1287,7 +1292,7 @@ checkRcvMsgHashExists db connId hash =
 getRcvMsgBrokerTs :: DB.Connection -> ConnId -> SMP.MsgId -> IO (Either StoreError BrokerTs)
 getRcvMsgBrokerTs db connId msgId =
  firstRow fromOnly (SEMsgNotFound "getRcvMsgBrokerTs") $
-    DB.query db "SELECT broker_ts FROM rcv_messages WHERE conn_id = ? AND broker_id = ?" (connId, Binary msgId)
+    DB.query db "SELECT broker_ts FROM rcv_messages WHERE conn_id = ? AND broker_id = ?" (connId, msgId)

 deleteMsg :: DB.Connection -> ConnId -> InternalId -> IO ()
 deleteMsg db connId msgId =
@@ -3035,7 +3040,7 @@ insertRcvMsgDetails_ db connId RcvQueue {dbQueueId} RcvMsgData {msgMeta, interna
      VALUES
        (?,?,?,?,?,?,?,?,?,?)
    |]
-    (connId, dbQueueId, internalRcvId, fst recipient, sndMsgId, Binary (fst broker), snd broker, Binary internalHash, Binary externalPrevSndHash, integrity)
+    (connId, dbQueueId, internalRcvId, fst recipient, sndMsgId, fst broker, snd broker, Binary internalHash, Binary externalPrevSndHash, integrity)
  DB.execute db "INSERT INTO encrypted_rcv_message_hashes (conn_id, hash) VALUES (?,?)" (connId, Binary encryptedMsgHash)

 updateRcvMsgHash :: DB.Connection -> ConnId -> AgentMsgId -> InternalRcvId -> MsgHash -> IO ()
@@ -3183,7 +3188,8 @@ createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath file
 createRcvFileRedirect :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
 createRcvFileRedirect _ _ _ FileDescription {redirect = Nothing} _ _ _ _ _ _ = pure $ Left $ SEInternal "createRcvFileRedirect called without redirect"
 createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redirectChunks, redirect = Just RedirectFileInfo {size, digest}} prefixPath redirectPath redirectFile dstPath dstFile approvedRelays = runExceptT $ do
-  (dstEntityId, dstId) <- ExceptT $ insertRcvFile db gVar userId dummyDst prefixPath dstPath dstFile Nothing Nothing approvedRelays
+  nonce <- atomically $ C.randomCbNonce gVar
+  (dstEntityId, dstId) <- ExceptT $ insertRcvFile db gVar userId (dummyDst nonce) prefixPath dstPath dstFile Nothing Nothing approvedRelays
  (_, redirectId) <- ExceptT $ insertRcvFile db gVar userId redirectFd prefixPath redirectPath redirectFile (Just dstId) (Just dstEntityId) approvedRelays
  liftIO $
    forM_ redirectChunks $ \fc@FileChunk {replicas} -> do
@@ -3191,7 +3197,7 @@ createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redire
      forM_ (zip [1 ..] replicas) $ \(rno, replica) -> insertRcvFileChunkReplica db rno replica chunkId
  pure dstEntityId
  where
-    dummyDst =
+    dummyDst nonce =
      FileDescription
        { party = SFRecipient,
          size,
@@ -3199,7 +3205,7 @@ createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redire
          redirect = Nothing,
          -- updated later with updateRcvFileRedirect
          key = C.unsafeSbKey $ B.replicate 32 '#',
-          nonce = C.cbNonce "",
+          nonce,
          chunkSize = FileSize 0,
          chunks = []
        }
@@ -17,6 +17,7 @@ import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rp
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_ratchet_indexes
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20261008_rcv_switch_status
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))

 schemaMigrations :: [(String, Text, Maybe Text)]
@@ -33,7 +34,8 @@ schemaMigrations =
    ("20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
    ("20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
    ("20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
-    ("20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes)
+    ("20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes),
+    ("20261008_rcv_switch_status", m20261008_rcv_switch_status, Just down_m20261008_rcv_switch_status)
  ]

 -- | The list of migrations in ascending order by date
@@ -0,0 +1,20 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20261008_rcv_switch_status where
+
+import Data.Text (Text)
+import Text.RawString.QQ (r)
+
+m20261008_rcv_switch_status :: Text
+m20261008_rcv_switch_status =
+  [r|
+CREATE INDEX idx_rcv_queues_switch_status ON rcv_queues(switch_status);
+|]
+
+down_m20261008_rcv_switch_status :: Text
+down_m20261008_rcv_switch_status =
+  [r|
+UPDATE rcv_queues SET switch_status = NULL WHERE switch_status = 'received_qend';
+DROP INDEX idx_rcv_queues_switch_status;
+|]
@@ -1233,6 +1233,10 @@ CREATE UNIQUE INDEX idx_rcv_queues_ntf ON smp_agent_test_protocol_schema.rcv_que



+CREATE INDEX idx_rcv_queues_switch_status ON smp_agent_test_protocol_schema.rcv_queues USING btree (switch_status);
+
+
+
 CREATE INDEX idx_rcv_queues_to_subscribe ON smp_agent_test_protocol_schema.rcv_queues USING btree (to_subscribe);


@@ -100,7 +100,8 @@ withTransaction st = withTransactionPriority st False
 {-# INLINE withTransaction #-}

 withTransactionPriority :: DBStore -> Bool -> (DB.Connection -> IO a) -> IO a
-withTransactionPriority st priority action = withConnectionPriority st priority $ dbBusyLoop . transaction
+withTransactionPriority st@DBStore {dbClosed} priority action = withConnectionPriority st priority $ \db ->
+  ifM (readTVarIO dbClosed) (fail "withTransaction: database closed") (dbBusyLoop $ transaction db)
  where
    transaction db@DB.Connection {conn} = SQL.withImmediateTransaction conn $ action db

@@ -53,6 +53,8 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr_rpc
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261008_rcv_switch_status
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))

 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -105,7 +107,9 @@ schemaMigrations =
    ("m20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
    ("m20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
    ("m20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
-    ("m20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes)
+    ("m20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes),
+    ("m20261005_commands_autoincrement", m20261005_commands_autoincrement, Just down_m20261005_commands_autoincrement),
+    ("m20261008_rcv_switch_status", m20261008_rcv_switch_status, Just down_m20261008_rcv_switch_status)
  ]

 -- | The list of migrations in ascending order by date
@@ -0,0 +1,33 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20261005_commands_autoincrement :: Query
+m20261005_commands_autoincrement =
+  [sql|
+INSERT INTO sqlite_sequence (name, seq)
+SELECT 'commands', MAX(ROWID) FROM commands;
+
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master SET sql = replace(sql, 'command_id INTEGER PRIMARY KEY,', 'command_id INTEGER PRIMARY KEY AUTOINCREMENT,')
+WHERE name = 'commands' AND type = 'table';
+
+PRAGMA writable_schema=RESET;
+  |]
+
+down_m20261005_commands_autoincrement :: Query
+down_m20261005_commands_autoincrement =
+  [sql|
+DELETE FROM sqlite_sequence WHERE name = 'commands';
+
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master SET sql = replace(sql, 'command_id INTEGER PRIMARY KEY AUTOINCREMENT,', 'command_id INTEGER PRIMARY KEY,')
+WHERE name = 'commands' AND type = 'table';
+
+PRAGMA writable_schema=RESET;
+  |]
@@ -0,0 +1,19 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261008_rcv_switch_status where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20261008_rcv_switch_status :: Query
+m20261008_rcv_switch_status =
+  [sql|
+CREATE INDEX idx_rcv_queues_switch_status ON rcv_queues(switch_status);
+|]
+
+down_m20261008_rcv_switch_status :: Query
+down_m20261008_rcv_switch_status =
+  [sql|
+UPDATE rcv_queues SET switch_status = NULL WHERE switch_status = 'received_qend';
+DROP INDEX idx_rcv_queues_switch_status;
+|]
@@ -247,7 +247,7 @@ CREATE TABLE ntf_subscriptions(
  ON DELETE RESTRICT ON UPDATE CASCADE
 ) WITHOUT ROWID, STRICT;
 CREATE TABLE commands(
-  command_id INTEGER PRIMARY KEY,
+  command_id INTEGER PRIMARY KEY AUTOINCREMENT,
  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
  host TEXT,
  port TEXT,
@@ -261,6 +261,7 @@ CREATE TABLE commands(
  FOREIGN KEY(host, port) REFERENCES servers
  ON DELETE RESTRICT ON UPDATE CASCADE
 ) STRICT;
+CREATE TABLE sqlite_sequence(name,seq);
 CREATE TABLE snd_message_deliveries(
  snd_message_delivery_id INTEGER PRIMARY KEY AUTOINCREMENT,
  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
@@ -269,7 +270,6 @@ CREATE TABLE snd_message_deliveries(
  failed INTEGER DEFAULT 0,
  FOREIGN KEY(conn_id, internal_id) REFERENCES messages ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
 ) STRICT;
-CREATE TABLE sqlite_sequence(name,seq);
 CREATE TABLE users(
  user_id INTEGER PRIMARY KEY AUTOINCREMENT
  ,
@@ -645,6 +645,7 @@ CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_h
  conn_id,
  processed_ratchet_key_hash_id
 );
+CREATE INDEX idx_rcv_queues_switch_status ON rcv_queues(switch_status);
 CREATE TRIGGER tr_rcv_queue_insert
 AFTER INSERT ON rcv_queues
 FOR EACH ROW
@@ -67,6 +67,7 @@ module Simplex.Messaging.Client
    enableSMPQueuesNtfs,
    disableSMPQueuesNtfs,
    sendSMPMessage,
+    QueueDrained,
    ackSMPMessage,
    suspendSMPQueue,
    deleteSMPQueue,
@@ -1087,15 +1088,17 @@ resolvedNameOrNotFound d NameResponse {registration} = case registration of
  NRRegistered {nameRecord} -> T.toLower (nrName nameRecord) == fullDomainName d
  _ -> True

+type QueueDrained = Bool
+
 -- | Acknowledge message delivery (server deletes the message).
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
 -- This command is always sent in background request mode
-ackSMPMessage :: SMPClient -> RcvPrivateAuthKey -> QueueId -> MsgId -> ExceptT SMPClientError IO ()
+ackSMPMessage :: SMPClient -> RcvPrivateAuthKey -> QueueId -> MsgId -> ExceptT SMPClientError IO QueueDrained
 ackSMPMessage c rpKey rId msgId =
  sendSMPCommand c NRMBackground (Just rpKey) rId (ACK msgId) >>= \case
-    OK -> return ()
-    cmd@MSG {} -> liftIO $ writeSMPMessage c rId cmd
+    OK -> pure True
+    cmd@MSG {} -> liftIO (writeSMPMessage c rId cmd) $> False
    r -> throwE $ unexpectedResponse r

 -- | Irreversibly suspend SMP queue.
@@ -1228,7 +1231,7 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
  -- encode
  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd (sParty @p) command)
  -- serviceAuth is False here – proxied commands are not used with service certificates
-  auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth False spKey nonce tForAuth
+  auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth False spKey (Just nonce) tForAuth
  b <- case batchTransmissions serverThParams [Right (auth, tToSend)] of
    [] -> throwE $ PCETransportError TELargeMsg
    TBError e _ : _ -> throwE $ PCETransportError e
@@ -1262,7 +1265,7 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
 -- receives RRES :: Maybe C.CbNonce -> EncFwdResponse -> BrokerMsg
 -- proxy should send PRES to the client with EncResponse
 -- Always uses background timeout mode
-forwardSMPTransmission :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO (Maybe C.CbNonce, EncResponse)
+forwardSMPTransmission :: SMPClient -> C.CorrCbNonce -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO (Maybe C.CbNonce, EncResponse)
 forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
  -- prepare params
  sessSecret <- case thAuth thParams of
@@ -1400,7 +1403,7 @@ mkTransmission_ :: forall v err msg. Protocol v err msg => ProtocolClient v err
 mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentCommands}} nonce_ (entityId, pKey_, command) = do
  nonce@(C.CbNonce corrId) <- maybe (atomically $ C.randomCbNonce clientCorrId) pure nonce_
  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, entityId, command)
-      auth = authTransmission (thAuth thParams) (useServiceAuth command) pKey_ nonce tForAuth
+      auth = authTransmission (thAuth thParams) (useServiceAuth command) pKey_ (Just nonce) tForAuth
  r <- mkRequest (CorrId corrId)
  pure ((,tToSend) <$> auth, r)
  where
@@ -1419,14 +1422,14 @@ mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentC
      atomically $ TM.insert corrId r sentCommands
      pure r

-authTransmission :: Maybe (THandleAuth 'TClient) -> Bool -> Maybe C.APrivateAuthKey -> C.CbNonce -> ByteString -> Either TransportError (Maybe TAuthorizations)
-authTransmission thAuth serviceAuth pKey_ nonce t = traverse authenticate pKey_
+authTransmission :: Maybe (THandleAuth 'TClient) -> Bool -> Maybe C.APrivateAuthKey -> Maybe C.CbNonce -> ByteString -> Either TransportError (Maybe TAuthorizations)
+authTransmission thAuth serviceAuth pKey_ nonce_ t = traverse authenticate pKey_
  where
    authenticate :: C.APrivateAuthKey -> Either TransportError TAuthorizations
    authenticate (C.APrivateAuthKey a pk) = (,serviceSig) <$> case a of
-      C.SX25519 -> case thAuth of
-        Just THAuthClient {peerServerPubKey = k} -> Right $ TAAuthenticator $ C.cbAuthenticate k pk nonce t'
-        Nothing -> Left TENoServerAuth
+      C.SX25519 -> case (thAuth, nonce_) of
+        (Just THAuthClient {peerServerPubKey = k}, Just nonce) -> Right $ TAAuthenticator $ C.cbAuthenticate k pk nonce t'
+        _ -> Left TENoServerAuth
      C.SEd25519 -> sign pk
      C.SEd448 -> sign pk
    -- When command is signed by both entity key and service key,
@@ -140,8 +140,10 @@ module Simplex.Messaging.Crypto
    gcmIV,

    -- * NaCl crypto_box
-    CbNonce (unCbNonce),
+    CbNonceI (..),
+    CbNonce,
    pattern CbNonce,
+    CorrCbNonce,
    cbEncrypt,
    cbEncryptNoPad,
    cbEncryptMaxLenBS,
@@ -152,8 +154,12 @@ module Simplex.Messaging.Crypto
    sbEncryptNoPad,
    sbDecryptNoPad,
    cbNonce,
+    unsafeCbNonce,
+    corrCbNonce,
    randomCbNonce,
    reverseNonce,
+    xorNonce,
+    toCbNonce,

    -- * NaCl crypto_secretbox
    SbKey (unSbKey),
@@ -232,6 +238,7 @@ import Data.ASN1.Types
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
+import Data.Bits (xor)
 import Data.ByteArray (ByteArrayAccess)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Base64 (decode)
@@ -254,7 +261,7 @@ import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (.
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll, parseString)
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (packZipWith, (<$?>))

 -- | Cryptographic algorithms.
 data Algorithm = Ed25519 | Ed448 | X25519 | X448
@@ -1324,8 +1331,8 @@ sbEncryptNoPad (SbKey key) (CbNonce nonce) = cryptoBox key nonce
 {-# INLINE sbEncryptNoPad #-}

 -- | NaCl @crypto_box@ encrypt with a shared DH secret and 192-bit nonce.
-cbEncryptMaxLenBS :: KnownNat i => DhSecret X25519 -> CbNonce -> MaxLenBS i -> ByteString
-cbEncryptMaxLenBS (DhSecretX25519 secret) (CbNonce nonce) = cryptoBox secret nonce . unMaxLenBS . padMaxLenBS
+cbEncryptMaxLenBS :: (KnownNat i, CbNonceI n) => DhSecret X25519 -> n -> MaxLenBS i -> ByteString
+cbEncryptMaxLenBS (DhSecretX25519 secret) nonce = cryptoBox secret (unCbNonce nonce) . unMaxLenBS . padMaxLenBS
 {-# INLINE cbEncryptMaxLenBS #-}

 cryptoBox :: ByteArrayAccess key => key -> ByteString -> ByteString -> ByteString
@@ -1335,8 +1342,8 @@ cryptoBox secret nonce s = BA.convert tag <> c
    tag = Poly1305.auth rs c

 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
-cbDecrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
-cbDecrypt (DhSecretX25519 secret) = sbDecrypt_ secret
+cbDecrypt :: CbNonceI n => DhSecret X25519 -> n -> ByteString -> Either CryptoError ByteString
+cbDecrypt (DhSecretX25519 secret) = sbDecrypt_ secret . toCbNonce
 {-# INLINE cbDecrypt #-}

 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
@@ -1383,9 +1390,16 @@ cbAuthenticate k pk nonce msg = CbAuthenticator $ cbEncryptNoPad (dh' k pk) nonc
 cbVerify :: PublicKeyX25519 -> PrivateKeyX25519 -> CbNonce -> CbAuthenticator -> ByteString -> Bool
 cbVerify k pk nonce (CbAuthenticator s) authorized = cbDecryptNoPad (dh' k pk) nonce s == Right (sha512Hash authorized)

-newtype CbNonce = CryptoBoxNonce {unCbNonce :: ByteString}
+class CbNonceI n where
+  unCbNonce :: n -> ByteString
+
+newtype CbNonce = CryptoBoxNonce ByteString
  deriving (Eq, Show)
-  deriving newtype (FromField)
+
+instance CbNonceI CbNonce where
+  unCbNonce (CryptoBoxNonce s) = s
+
+instance FromField CbNonce where fromField = blobFieldDecoder cbNonce

 instance ToField CbNonce where toField (CryptoBoxNonce s) = toField $ Binary s

@@ -1396,7 +1410,7 @@ pattern CbNonce s <- CryptoBoxNonce s

 instance StrEncoding CbNonce where
  strEncode (CbNonce s) = strEncode s
-  strP = cbNonce <$> strP
+  strP = cbNonce <$?> strP

 instance ToJSON CbNonce where
  toJSON = strToJSON
@@ -1405,13 +1419,16 @@ instance ToJSON CbNonce where
 instance FromJSON CbNonce where
  parseJSON = strParseJSON "CbNonce"

-cbNonce :: ByteString -> CbNonce
+cbNonce :: ByteString -> Either String CbNonce
 cbNonce s
-  | len == 24 = CryptoBoxNonce s
-  | len > 24 = CryptoBoxNonce . fst $ B.splitAt 24 s
-  | otherwise = CryptoBoxNonce $ s <> B.replicate (24 - len) (toEnum 0)
-  where
-    len = B.length s
+  | B.length s == 24 = Right $ CryptoBoxNonce s
+  | otherwise = Left "CbNonce: invalid length"
+
+unsafeCbNonce :: ByteString -> CbNonce
+unsafeCbNonce s = either error id $ cbNonce s
+
+corrCbNonce :: ByteString -> Either String CorrCbNonce
+corrCbNonce s = CorrCbNonce . unCbNonce <$> cbNonce s

 randomCbNonce :: TVar ChaChaDRG -> STM CbNonce
 randomCbNonce = fmap CryptoBoxNonce . randomBytes 24
@@ -1419,13 +1436,30 @@ randomCbNonce = fmap CryptoBoxNonce . randomBytes 24
 randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
 randomBytes n gVar = stateTVar gVar $ randomBytesGenerate n

-reverseNonce :: CbNonce -> CbNonce
-reverseNonce (CryptoBoxNonce s) = CryptoBoxNonce (B.reverse s)
+reverseNonce :: CbNonceI n => n -> CbNonce
+reverseNonce = CryptoBoxNonce . B.reverse . unCbNonce
+
+xorNonce :: CbNonceI n => ByteString -> n -> CbNonce
+xorNonce s nonce = CryptoBoxNonce $ packZipWith xor s n <> B.drop (B.length s) n
+  where
+    n = unCbNonce nonce
+
+toCbNonce :: CbNonceI n => n -> CbNonce
+toCbNonce = CryptoBoxNonce . unCbNonce

 instance Encoding CbNonce where
  smpEncode = unCbNonce
  smpP = CryptoBoxNonce <$> A.take 24

+newtype CorrCbNonce = CorrCbNonce ByteString
+
+instance CbNonceI CorrCbNonce where
+  unCbNonce (CorrCbNonce s) = s
+
+instance Encoding CorrCbNonce where
+  smpEncode = smpEncode . unCbNonce
+  smpP = corrCbNonce <$?> smpP
+
 newtype SbKey = SecretBoxKey {unSbKey :: ByteString}
  deriving (Eq, Show)
  deriving newtype (FromField)
@@ -17,6 +17,7 @@ module Simplex.Messaging.Crypto.ShortLink
    encodeSignUserData,
    newOwnerAuth,
    encryptLinkData,
+    encryptFixedData,
    encryptUserData,
    decryptLinkData,
  )
@@ -84,9 +85,10 @@ newOwnerAuth g ownerId signingKey = do
  pure (ownerPrivKey, OwnerAuth {ownerId, ownerKey, authOwnerSig})

 encryptLinkData :: TVar ChaChaDRG -> C.SbKey -> (ByteString, ByteString) -> ExceptT AgentErrorType IO QueueLinkData
-encryptLinkData g k = bimapM (encrypt fixedDataPaddedLength) (encrypt userDataPaddedLength)
-  where
-    encrypt len = encryptData g k len
+encryptLinkData g k = bimapM (encryptFixedData g k) (encryptUserData g k)
+
+encryptFixedData :: TVar ChaChaDRG -> C.SbKey -> ByteString -> ExceptT AgentErrorType IO EncDataBytes
+encryptFixedData g k s = encryptData g k fixedDataPaddedLength s

 encryptUserData :: TVar ChaChaDRG -> C.SbKey -> ByteString -> ExceptT AgentErrorType IO EncDataBytes
 encryptUserData g k s = encryptData g k userDataPaddedLength s
@@ -1,5 +1,6 @@


+
 SET statement_timeout = 0;
 SET lock_timeout = 0;
 SET idle_in_transaction_session_timeout = 0;
@@ -312,3 +313,4 @@ ALTER TABLE ONLY ntf_server.subscriptions



+
@@ -145,7 +145,10 @@ module Simplex.Messaging.Protocol
    RcvNtfDhSecret,
    Message (..),
    RcvMessage (..),
-    MsgId,
+    MsgId (unMsgId),
+    mkMsgId,
+    unsafeMsgId,
+    randomMsgId,
    MsgBody,
    IdsHash (..),
    ServiceSub (..),
@@ -233,8 +236,10 @@ module Simplex.Messaging.Protocol
 where

 import Control.Applicative (optional, (<|>))
+import Control.Concurrent.STM (STM, TVar)
 import Control.Exception (Exception, SomeException, displayException, fromException)
 import Control.Monad.Except
+import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as J
@@ -269,7 +274,7 @@ import qualified GHC.TypeLits as TE
 import qualified GHC.TypeLits as Type
 import Network.Socket (ServiceName)
 import qualified Network.TLS as TLS
-import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
+import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -281,7 +286,7 @@ import Simplex.Messaging.ServiceScheme
 import Simplex.Messaging.SimplexName (LabelHash, SimplexDomain (..), SimplexTLD (..), fullDomainName, labelHash)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts (..))
-import Simplex.Messaging.Util (bshow, eitherToMaybe, packZipWith, safeDecodeUtf8, (<$?>))
+import Simplex.Messaging.Util (bshow, eitherToMaybe, safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal

@@ -703,24 +708,24 @@ instance Encoding NewNtfCreds where
 newtype EncTransmission = EncTransmission ByteString
  deriving (Show)

-encTransmissionNonce :: VersionSMP -> C.CbNonce -> C.CbNonce
-encTransmissionNonce v nonce@(C.CbNonce s)
-  | v >= fwdNoncesSMPVersion = C.cbNonce $ packZipWith xor (smpEncode v) s <> BS.drop 2 s
-  | otherwise = nonce
+encTransmissionNonce :: C.CbNonceI n => VersionSMP -> n -> C.CbNonce
+encTransmissionNonce v nonce
+  | v >= fwdNoncesSMPVersion = C.xorNonce (smpEncode v) nonce
+  | otherwise = C.toCbNonce nonce

 data FwdTransmission = FwdTransmission
-  { fwdCorrId :: CorrId,
+  { fwdCorrId :: C.CorrCbNonce,
    fwdVersion :: VersionSMP,
    fwdKey :: C.PublicKeyX25519,
    fwdTransmission :: EncTransmission
  }

 instance Encoding FwdTransmission where
-  smpEncode FwdTransmission {fwdCorrId = CorrId corrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t} =
-    smpEncode (corrId, fwdVersion, fwdKey, Tail t)
+  smpEncode FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t} =
+    smpEncode (fwdCorrId, fwdVersion, fwdKey, Tail t)
  smpP = do
-    (corrId, fwdVersion, fwdKey, Tail t) <- smpP
-    pure FwdTransmission {fwdCorrId = CorrId corrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t}
+    (fwdCorrId, fwdVersion, fwdKey, Tail t) <- smpP
+    pure FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t}

 newtype EncFwdTransmission = EncFwdTransmission ByteString
  deriving (Show)
@@ -766,16 +771,16 @@ newtype EncFwdResponse = EncFwdResponse ByteString
  deriving (Eq, Show)

 data FwdResponse = FwdResponse
-  { fwdCorrId :: CorrId,
+  { fwdCorrId :: C.CorrCbNonce,
    fwdResponse :: EncResponse
  }

 instance Encoding FwdResponse where
-  smpEncode FwdResponse {fwdCorrId = CorrId corrId, fwdResponse = EncResponse t} =
-    smpEncode (corrId, Tail t)
+  smpEncode FwdResponse {fwdCorrId, fwdResponse = EncResponse t} =
+    smpEncode (fwdCorrId, Tail t)
  smpP = do
-    (corrId, Tail t) <- smpP
-    pure FwdResponse {fwdCorrId = CorrId corrId, fwdResponse = EncResponse t}
+    (fwdCorrId, Tail t) <- smpP
+    pure FwdResponse {fwdCorrId, fwdResponse = EncResponse t}

 newtype EncResponse = EncResponse ByteString
  deriving (Eq, Show)
@@ -798,7 +803,7 @@ toMsgInfo = \case
  Message {msgId, msgTs} -> msgInfo msgId msgTs MTMessage
  MessageQuota {msgId, msgTs} -> msgInfo msgId msgTs MTQuota
  where
-    msgInfo msgId msgTs msgType = MsgInfo {msgId = decodeLatin1 $ B64.encode msgId, msgTs = systemToUTCTime msgTs, msgType}
+    msgInfo msgId msgTs msgType = MsgInfo {msgId = decodeLatin1 $ B64.encode $ unMsgId msgId, msgTs = systemToUTCTime msgTs, msgType}

 messageId :: Message -> MsgId
 messageId = \case
@@ -1499,7 +1504,34 @@ type RcvNtfPublicDhKey = C.PublicKeyX25519
 type RcvNtfDhSecret = C.DhSecretX25519

 -- | SMP message server ID.
-type MsgId = ByteString
+newtype MsgId = MsgId {unMsgId :: ByteString}
+  deriving (Eq, Show)
+
+instance C.CbNonceI MsgId where
+  unCbNonce (MsgId s) = B.take 24 s
+
+instance Encoding MsgId where
+  smpEncode (MsgId s) = smpEncode s
+  smpP = mkMsgId <$?> smpP
+
+instance StrEncoding MsgId where
+  strEncode (MsgId s) = strEncode s
+  strP = mkMsgId <$?> strP
+
+instance FromField MsgId where fromField = blobFieldDecoder mkMsgId
+
+instance ToField MsgId where toField (MsgId s) = toField $ Binary s
+
+mkMsgId :: ByteString -> Either String MsgId
+mkMsgId s
+  | B.length s >= 24 = Right $ MsgId s
+  | otherwise = Left "MsgId: invalid length"
+
+unsafeMsgId :: ByteString -> MsgId
+unsafeMsgId s = either error id $ mkMsgId s
+
+randomMsgId :: Int -> TVar ChaChaDRG -> STM MsgId
+randomMsgId n = fmap MsgId . C.randomBytes (max 24 n)

 -- | SMP message body.
 type MsgBody = ByteString
@@ -2417,7 +2449,9 @@ tDecodeServer THandleParams {sessionId, thVersion = v, implySessId} = \case
          where
            cmdOrErr = parseProtocol @v @err @cmd v command >>= checkCredentials tAuth entityId
            t :: a -> (CorrId, EntityId, a)
-            t = (corrId,entityId,)
+            -- IDs are slices of the ~16 KB received block and are kept as subscription keys,
+            -- so without a copy one live key retains the whole block
+            t = (CorrId $ B.copy $ bs corrId,EntityId $ B.copy $ unEntityId entityId,)
        Left _ -> tError corrId PEBlock
    | otherwise -> tError corrId PESession
  Left _ -> tError "" PEBlock
@@ -33,6 +33,9 @@ module Simplex.Messaging.Server
  ( runSMPServer,
    runSMPServerBlocking,
    controlPortAuth,
+    importMessages,
+    exportMessages,
+    printMessageStats,
    disconnectTransport,
    verifyCmdAuthorization,
    dummyVerifyCmd,
@@ -105,6 +108,7 @@ import Simplex.Messaging.Server.Control
 import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
+import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore, JournalQueue (..), getJournalQueueMessages)
 import Simplex.Messaging.Server.Names (NamesEnv, closeNamesEnv, resolveName)
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
@@ -112,7 +116,6 @@ import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.Prometheus
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
-import Simplex.Messaging.Server.QueueStore.STM (withLoadedQueues)
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Server.StoreLog (foldLogLines)
@@ -142,7 +145,7 @@ import GHC.Conc.Sync (threadLabel)
 #endif

 #if defined(dbServerPostgres)
-import Simplex.Messaging.Server.MsgStore.Postgres (getDbMessageStats)
+import Simplex.Messaging.Server.MsgStore.Postgres (exportDbMessages, getDbMessageStats)
 #endif

 -- | Runs an SMP server using passed configuration.
@@ -707,11 +710,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
      (deliveredSubs, deliveredTimes) <- getDeliveredMetrics =<< getSystemSeconds
      smpSubs <- getSubscribersMetrics subscribers
      ntfSubs <- getSubscribersMetrics ntfSubscribers
-      loadedCounts <- case ms of
-        StoreMemory st -> Just <$> loadedQueueCounts st
-#if defined(dbServerPostgres)
-        StoreDatabase _ -> pure Nothing
-#endif
+      loadedCounts <- loadedQueueCounts $ fromMsgStore ms
      pure RealTimeMetrics {socketStats, threadsCount, clientsCount, deliveredSubs, deliveredTimes, smpSubs, ntfSubs, loadedCounts}
      where
        getSubscribersMetrics ServerSubscribers {queueSubscribers, serviceSubscribers, totalServiceSubs, subClients} = do
@@ -1146,14 +1145,16 @@ cancelSub s = case subThread s of
 type VerifiedTransmissionOrError s = Either (Transmission BrokerMsg) (VerifiedTransmission s)

 receive :: forall c s. (Transport c, MsgStoreClass s) => THandleSMP c 'TServer -> s -> Client s -> M s ()
-receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ, sndQ, rcvActiveAt} = do
+receive h@THandle {params = THandleParams {thAuth, sessionId}} ms c@Client {rcvQ, rcvActiveAt} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
  sa <- asks serverActive
  stats <- asks serverStats
+  authDelay <- asks $ authErrorDelay . config
  liftIO $ forever $ do
    ts <- tGetServer h
    unlessM (readTVarIO sa) $ throwIO $ userError "server stopped"
-    atomically . (writeTVar rcvActiveAt $!) =<< getSystemTime
+    receivedAt <- getSystemTime
+    atomically $ writeTVar rcvActiveAt $! receivedAt
    let (es, ts') = partitionEithers $ L.toList ts
        errs = map (second ERR) es
    errs' <- case ts' of
@@ -1169,7 +1170,7 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ,
        mapM_ (atomically . writeTBQueue rcvQ) $ L.nonEmpty cmds
        pure $ errs ++ errs'
      [] -> pure errs
-    mapM_ (atomically . writeTBQueue sndQ . (,[])) $ L.nonEmpty errs'
+    mapM_ (sendResponses c stats authDelay receivedAt . (,[])) $ L.nonEmpty errs'
  where
    sameParty :: SParty p -> SignedTransmission Cmd -> Bool
    sameParty p (_, _, (_, _, Cmd p' _)) = isJust $ testEquality p p'
@@ -1192,6 +1193,27 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ,
            GET -> incStat $ msgGetAuth stats
            _ -> pure ()

+isAuthError :: Transmission BrokerMsg -> Bool
+isAuthError (_, _, r) = case r of
+  ERR AUTH -> True
+  _ -> False
+
+sendResponses :: Client s -> ServerStats -> Int64 -> SystemTime -> (NonEmpty (Transmission BrokerMsg), [Transmission BrokerMsg]) -> IO ()
+sendResponses c@Client {sndQ} stats authDelay since rs@(ts, _)
+  | any isAuthError ts = sendAfterDelay c stats authDelay since rs
+  | otherwise = atomically $ writeTBQueue sndQ rs
+
+sendAfterDelay :: Client s -> ServerStats -> Int64 -> SystemTime -> (NonEmpty (Transmission BrokerMsg), [Transmission BrokerMsg]) -> IO ()
+sendAfterDelay c@Client {sndQ, clientTHParams = THandleParams {sessionId}} stats delay since rs
+  | delay > 0 = do
+      elapsed <- subtract (microseconds since) . microseconds <$> getSystemTime
+      when (elapsed >= delay) $ incStat $ authDelayExceeded stats
+      forkClient c (B.unpack $ "client $" <> encode sessionId <> " auth") $ threadDelay' (delay - elapsed `mod` delay) >> write
+  | otherwise = write
+  where
+    write = atomically $ writeTBQueue sndQ rs
+    microseconds (MkSystemTime s ns) = s * 1000000 + fromIntegral (ns `div` 1000)
+
 send :: Transport c => MVar (THandleSMP c 'TServer) -> Client s -> IO ()
 send th c@Client {sndQ, msgQ, clientTHParams = THandleParams {sessionId}} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send"
@@ -1335,7 +1357,7 @@ verifyCmdAuthorization thAuth tAuth authorized corrId key = maybe False (verify

 verifyCmdAuth :: Maybe (THandleAuth 'TServer) -> C.PublicKeyX25519 -> C.CbAuthenticator -> ByteString -> CorrId -> Bool
 verifyCmdAuth thAuth k authenticator authorized (CorrId corrId) = case thAuth of
-  Just THAuthServer {serverPrivKey = pk} -> C.cbVerify k pk (C.cbNonce corrId) authenticator authorized
+  Just THAuthServer {serverPrivKey = pk} -> either (const False) (\nonce -> C.cbVerify k pk nonce authenticator authorized) $ C.cbNonce corrId
  Nothing -> False

 dummyVerifyCmd :: Maybe (THandleAuth 'TServer) -> Maybe TAuthorizations -> ByteString -> CorrId -> Bool
@@ -1375,15 +1397,18 @@ client
  ms
  clnt@Client {clientId, rcvQ, sndQ, msgQ, clientTHParams = thParams'@THandleParams {sessionId}, procThreads} = do
    labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
+    stats <- asks serverStats
+    authDelay <- asks $ authErrorDelay . config
    let clntServiceId = (\THClientService {serviceId} -> serviceId) <$> (peerClientService =<< thAuth thParams')
        process batchSubs t acc@(rs, msgs) =
          (maybe acc (\(!r, !msg_) -> (r : rs, maybe msgs (: msgs) msg_)))
            <$> processCommand clntServiceId batchSubs t
    forever $ do
      batch <- atomically (readTBQueue rcvQ)
+      processedAt <- liftIO getSystemTime
      batchSubs <- prepareBatchSubs clntServiceId batch
      foldrM (process batchSubs) ([], []) batch
-        >>= \(rs_, msgs) -> mapM_ (atomically . writeTBQueue sndQ . (,msgs)) (L.nonEmpty rs_)
+        >>= \(rs_, msgs) -> mapM_ (liftIO . sendResponses clnt stats authDelay processedAt . (,msgs)) (L.nonEmpty rs_)
  where
    prepareBatchSubs ::
      Maybe ServiceId ->
@@ -1454,14 +1479,15 @@ client
        ServerStats {pMsgFwds, pMsgFwdsOwn} <- asks serverStats
        let inc = mkIncProxyStats pMsgFwds pMsgFwdsOwn
        liftIO (lookupSMPServerClient a sessId) >>= \case
-          Just (own, smp) -> do
+          Just (own, smp) | Right fwdCorrId <- C.corrCbNonce (bs corrId) -> do
            inc own pRequests
            forkProxiedCmd $ do
-              liftIO (runExceptT (forwardSMPTransmission smp corrId fwdV pubKey encBlock) `E.catches` clientHandlers)  >>= \case
+              liftIO (runExceptT (forwardSMPTransmission smp fwdCorrId fwdV pubKey encBlock) `E.catches` clientHandlers)  >>= \case
                Right (nonce_, r) -> PRES nonce_ r <$ inc own pSuccesses
                Left e -> ERR (smpProxyError e) <$ case e of
                  PCEProtocolError {} -> inc own pSuccesses
                  _ -> inc own pErrorsOther
+          Just _ -> pure $ Just $ ERR $ CMD SYNTAX
          Nothing -> inc False pRequests >> inc False pErrorsConnect $> Just (ERR $ PROXY NO_SESSION)
      where
        forkProxiedCmd :: M s BrokerMsg -> M s (Maybe BrokerMsg)
@@ -1951,7 +1977,7 @@ client
            getDelivered :: Sub -> STM (Maybe (ServerSub, SystemSeconds))
            getDelivered Sub {delivered, subThread} = do
              readTVar delivered $>>= \(msgId', ts) ->
-                if msgId == msgId' || B.null msgId
+                if msgId == msgId'
                  then writeTVar delivered Nothing $> Just (subThread, ts)
                  else pure Nothing
            updateStats :: ServerStats -> Bool -> SystemSeconds -> Message -> IO ()
@@ -1997,7 +2023,7 @@ client
                      when (isJust (queueData qr) && isSecuredMsgQueue qr) $ void $ liftIO $
                        deleteQueueLinkData (queueStore ms) q
                      ServerConfig {messageExpiration, expireMessagesOnSend, msgIdBytes} <- asks config
-                      msgId <- randomId' msgIdBytes
+                      msgId <- atomically . randomMsgId msgIdBytes =<< asks random
                      msg_ <- liftIO $ runExceptT $ do
                        when expireMessagesOnSend $ mapM_ (expireMessages stats) messageExpiration
                        msg <- liftIO $ mkMessage msgId body
@@ -2110,7 +2136,7 @@ client
              liftIO $ storeNtf ns nId ntf
              incStat . ntfCount =<< asks serverStats

-            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M s MsgNtf
+            mkMessageNotification :: MsgId -> SystemTime -> RcvNtfDhSecret -> M s MsgNtf
            mkMessageNotification msgId msgTs rcvNtfDhSecret = do
              ntfNonce <- atomically . C.randomCbNonce =<< asks random
              let msgMeta = NMsgMeta {msgId, msgTs}
@@ -2119,14 +2145,15 @@ client

        processForwardedCommand :: EncFwdTransmission -> M s (Maybe BrokerMsg)
        processForwardedCommand (EncFwdTransmission s) = fmap (either (Just . ERR) id) . runExceptT $ do
+          startedAt <- liftIO getSystemTime
          THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE $ transportErr TENoServerAuth) pure (thAuth thParams')
          sessSecret <- maybe (throwE $ transportErr TENoServerAuth) pure sessSecret'
-          let proxyNonce = C.cbNonce $ bs corrId
+          proxyNonce <- liftEitherWith (const CRYPTO) $ C.cbNonce $ bs corrId
          s' <- liftEitherWith (const CRYPTO) $ C.cbDecryptNoPad sessSecret proxyNonce s
          FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission et} <- liftEitherWith (const $ CMD SYNTAX) $ smpDecode s'
          unless (fwdVersion `isCompatible` thServerVRange thParams') $ throwE $ transportErr TEVersion
          let clientSecret = C.dh' fwdKey serverPrivKey
-              clientNonce = C.cbNonce $ bs fwdCorrId
+              clientNonce = fwdCorrId
          b <- liftEitherWith (const CRYPTO) $ C.cbDecrypt clientSecret (encTransmissionNonce fwdVersion clientNonce) et
          let clntTHParams = smpTHParamsSetVersion fwdVersion thParams'
          -- only allowing single forwarded transactions
@@ -2162,7 +2189,11 @@ client
              _ -> Just . maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing (Right (M.empty, M.empty, M.empty)) t'')
          stats <- asks serverStats
          incStat $ pMsgFwdsRecv stats
-          traverse encodeResp r_
+          traverse encodeResp r_ >>= \case
+            Just rres | any isAuthError r_ -> do
+              authDelay <- asks $ authErrorDelay . config
+              Nothing <$ liftIO (sendAfterDelay clnt stats authDelay startedAt ([(corrId, NoEntity, rres)], []))
+            rres_ -> pure rres_
          where
            rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmissionOrError ErrorType Cmd -> M s (VerifiedTransmissionOrError s)
            rejectOrVerify clntThAuth = \case
@@ -2188,7 +2219,7 @@ client
          MessageQuota {} -> RcvMsgQuota msgTs'
          where
            encrypt :: KnownNat i => C.MaxLenBS i -> RcvMessage
-            encrypt body = RcvMessage msgId' . EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) (C.cbNonce msgId') body
+            encrypt body = RcvMessage msgId' . EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) msgId' body
            msgId' = messageId msg
            msgTs' = messageTs msg

@@ -2237,7 +2268,7 @@ client
                    SubPending -> QSubPending
                    SubThread _ -> QSubThread
                ProhibitSub -> pure QProhibitSub
-              qDelivered <- decodeLatin1 . encode . fst <$$> readTVarIO delivered
+              qDelivered <- decodeLatin1 . encode . unMsgId . fst <$$> readTVarIO delivered
              pure QSub {qSubThread, qDelivered}

        ok :: Transmission BrokerMsg
@@ -2273,27 +2304,40 @@ randomId = fmap EntityId . randomId'

 saveServerMessages :: Bool -> MsgStore s -> IO ()
 saveServerMessages drainMsgs ms = case ms of
-  StoreMemory ms'@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-    Just f -> exportMessages ms' f drainMsgs
+  StoreMemory STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
+    Just f -> exportMessages False ms f drainMsgs
    Nothing -> logNote "undelivered messages are not saved"
+  StoreJournal _ -> logNote "closed journal message storage"
 #if defined(dbServerPostgres)
  StoreDatabase _ -> logNote "closed postgres message storage"
 #endif

-exportMessages :: STMMsgStore -> FilePath -> Bool -> IO ()
-exportMessages ms f drainMsgs = do
+exportMessages :: forall s. MsgStoreClass s => Bool -> MsgStore s -> FilePath -> Bool -> IO ()
+exportMessages tty st f drainMsgs = do
  logNote $ "saving messages to file " <> T.pack f
-  run $ fmap (\(Sum n) -> n) . withLoadedQueues (queueStore ms) . saveQueueMsgs
+  run $ case st of
+    StoreMemory ms -> exportMessages_ ms $ getMsgs ms
+    StoreJournal ms -> exportMessages_ ms $ getJournalMsgs ms
+#if defined(dbServerPostgres)
+    StoreDatabase ms -> exportDbMessages tty ms
+#endif
  where
+    exportMessages_ ms get = fmap (\(Sum n) -> n) . unsafeWithAllMsgQueues tty ms . saveQueueMsgs get
    run :: (Handle -> IO Int) -> IO ()
    run a = liftIO $ withFile f WriteMode $ tryAny . a >=> \case
      Right n -> logNote $ "messages saved: " <> tshow n
      Left e -> do
        logError $ "error exporting messages: " <> tshow e
        exitFailure
-    saveQueueMsgs :: Handle -> STMQueue -> IO (Sum Int)
-    saveQueueMsgs h q = do
-      msgs <- getQueueMessages drainMsgs q
+    getJournalMsgs ms q =
+      readTVarIO (msgQueue' q) >>= \case
+        Just _ -> getMsgs ms q
+        Nothing -> getJournalQueueMessages ms q
+    getMsgs :: MsgStoreClass s' => s' -> StoreQueue s' -> IO [Message]
+    getMsgs ms q = unsafeRunStore q "saveQueueMsgs" $ getQueueMessages_ drainMsgs q =<< getMsgQueue ms q False
+    saveQueueMsgs :: (StoreQueue s -> IO [Message]) -> Handle -> StoreQueue s -> IO (Sum Int)
+    saveQueueMsgs get h q = do
+      msgs <- get q
      unless (null msgs) $ BLD.hPutBuilder h $ encodeMessages (recipientId q) msgs
      pure $ Sum $ length msgs
    encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
@@ -2305,16 +2349,37 @@ processServerMessages StartOptions {skipWarnings} = do
  asks msgStore_ >>= liftIO . processMessages old_ expire
    where
      processMessages :: Maybe Int64 -> Bool -> MsgStore s' -> IO (Maybe MessageStats)
-#if defined(dbServerPostgres)
      processMessages old_ expire = \case
-#else
-      processMessages old_ _ = \case
-#endif
        StoreMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-          Just f -> ifM (doesFileExist f) (Just <$> importMessages ms f old_ skipWarnings) (pure Nothing)
+          Just f -> ifM (doesFileExist f) (Just <$> importMessages False ms f old_ skipWarnings) (pure Nothing)
          Nothing -> pure Nothing
+        StoreJournal ms -> processJournalMessages old_ expire ms
 #if defined(dbServerPostgres)
        StoreDatabase ms -> processDbMessages old_ expire ms
+#endif
+      processJournalMessages :: forall s. Maybe Int64 -> Bool -> JournalMsgStore s -> IO (Maybe MessageStats)
+      processJournalMessages old_ expire ms
+        | expire = Just <$> case old_ of
+            Just old -> do
+              logNote "expiring journal store messages..."
+              run $ processExpireQueue old
+            Nothing -> do
+              logNote "validating journal store messages..."
+              run processValidateQueue
+        | otherwise = logWarn "skipping message expiration" $> Nothing
+        where
+          run a = unsafeWithAllMsgQueues False ms a `catchAny` \_ -> exitFailure
+          processExpireQueue :: Int64 -> JournalQueue s -> IO MessageStats
+          processExpireQueue old q = unsafeRunStore q "processExpireQueue" $ do
+            mq <- getMsgQueue ms q False
+            expiredMsgsCount <- deleteExpireMsgs_ old q mq
+            storedMsgsCount <- getQueueSize_ mq
+            pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
+          processValidateQueue :: JournalQueue s -> IO MessageStats
+          processValidateQueue q = unsafeRunStore q "processValidateQueue" $ do
+            storedMsgsCount <- getQueueSize_ =<< getMsgQueue ms q False
+            pure newMessageStats {storedMsgsCount, storedQueues = 1}
+#if defined(dbServerPostgres)
      processDbMessages old_ expire ms
        | expire = Just <$> case old_ of
            Just old -> do
@@ -2326,17 +2391,18 @@ processServerMessages StartOptions {skipWarnings} = do
        | otherwise = logWarn "skipping message expiration" $> Nothing
 #endif

-importMessages :: STMMsgStore -> FilePath -> Maybe Int64 -> Bool -> IO MessageStats
-importMessages ms f old_ skipWarnings  = do
+importMessages :: forall s. MsgStoreClass s => Bool -> s -> FilePath -> Maybe Int64 -> Bool -> IO MessageStats
+importMessages tty ms f old_ skipWarnings  = do
  logNote $ "restoring messages from file " <> T.pack f
  (_, (storedMsgsCount, expiredMsgsCount, overQuota)) <-
-    foldLogLines False f restoreMsg (Nothing, (0, 0, M.empty))
+    foldLogLines tty f restoreMsg (Nothing, (0, 0, M.empty))
  renameFile f $ f <> ".bak"
  mapM_ setOverQuota_ overQuota
-  EntityCounts {queueCount} <- liftIO $ getEntityCounts @STMQueue $ queueStore ms
+  logQueueStates ms
+  EntityCounts {queueCount} <- liftIO $ getEntityCounts @(StoreQueue s) $ queueStore ms
  pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = queueCount}
  where
-    restoreMsg :: (Maybe (RecipientId, STMQueue), (Int, Int, Map RecipientId STMQueue)) -> Bool -> ByteString -> IO (Maybe (RecipientId, STMQueue), (Int, Int, Map RecipientId STMQueue))
+    restoreMsg :: (Maybe (RecipientId, StoreQueue s), (Int, Int, Map RecipientId (StoreQueue s))) -> Bool -> ByteString -> IO (Maybe (RecipientId, StoreQueue s), (Int, Int, 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
@@ -2344,6 +2410,7 @@ importMessages ms f old_ skipWarnings  = do
        | otherwise -> exitErr $ parsingErr e
      where
        exitErr e = do
+          when tty $ putStrLn ""
          logError $ "error restoring messages: " <> e
          liftIO exitFailure
        parsingErr :: String -> Text
@@ -2356,6 +2423,7 @@ importMessages ms f old_ skipWarnings  = do
          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
@@ -2366,13 +2434,20 @@ importMessages ms f old_ skipWarnings  = do
                  writeMsg ms q False msg >>= \case
                    Just _ -> pure (stored + 1, expired, overQuota)
                    Nothing -> liftIO $ do
+                      when tty $ putStrLn ""
                      logError $ decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
                      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
-              deleteQuotaMsg q >> writeMsg ms 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 q "mergeQuotaMsgs" $ maybe (pure ()) $ \case
+                    (mq, MessageQuota {}) -> tryDeleteMsg_ q mq False
+                    _ -> pure ()
        warnOrExit e
          | skipWarnings = logWarn e'
          | otherwise = do
@@ -42,6 +42,7 @@ module Simplex.Messaging.Server.Env.STM
    VerifiedTransmission,
    ResponseAndMessage,
    newEnv,
+    mkJournalStoreConfig,
    msgStore,
    fromMsgStore,
    newClient,
@@ -67,6 +68,11 @@ module Simplex.Messaging.Server.Env.STM
    defaultInactiveClientExpiration,
    defaultProxyClientConcurrency,
    defaultNameResolverConcurrency,
+    defaultAuthErrorDelayMs,
+    defaultMaxJournalMsgCount,
+    defaultMaxJournalStateLines,
+    defaultIdleQueueInterval,
+    journalMsgStoreDepth,
    readWriteQueueStore,
    noPostgresExitStr,
    noPostgresExit,
@@ -91,7 +97,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import Data.Maybe (isJust)
 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 (..))
@@ -108,6 +114,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
+import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.Names (NamesConfig (..), NamesEnv, newNamesEnv, pingEndpoint)
@@ -140,6 +147,8 @@ data ServerConfig s = ServerConfig
    smpHandshakeTimeout :: Int,
    tbqSize :: Natural,
    msgQueueQuota :: Int,
+    maxJournalMsgCount :: Int,
+    maxJournalStateLines :: Int,
    queueIdBytes :: Int,
    msgIdBytes :: Int,
    serverStoreCfg :: ServerStoreCfg s,
@@ -156,6 +165,8 @@ data ServerConfig s = ServerConfig
    messageExpiration :: Maybe ExpirationConfig,
    expireMessagesOnStart :: Bool,
    expireMessagesOnSend :: Bool,
+    -- | interval of inactivity after which journal queue is closed
+    idleQueueInterval :: Int64,
    -- | notification expiration interval (seconds)
    notificationExpiration :: ExpirationConfig,
    -- | time after which the socket with inactive client can be disconnected (without any messages or commands, incl. PING),
@@ -177,6 +188,7 @@ data ServerConfig s = ServerConfig
    ntfDeliveryInterval :: Int,
    -- | interval between sending pending END events to unsubscribed clients, seconds
    pendingENDInterval :: Int,
+    authErrorDelay :: Int64,
    smpCredentials :: ServerCredentials,
    httpCredentials :: Maybe ServerCredentials,
    -- | SMP client-server protocol version range
@@ -219,6 +231,9 @@ defaultMessageExpiration =
      checkInterval = 7200 -- seconds, 2 hours
    }

+defaultIdleQueueInterval :: Int64
+defaultIdleQueueInterval = 14400 -- seconds, 4 hours
+
 defNtfExpirationHours :: Int64
 defNtfExpirationHours = 24

@@ -242,9 +257,24 @@ defaultProxyClientConcurrency = 32
 defaultNameResolverConcurrency :: Int
 defaultNameResolverConcurrency = 1000

+defaultAuthErrorDelayMs :: Int64
+defaultAuthErrorDelayMs = 50
+
+journalMsgStoreDepth :: Int
+journalMsgStoreDepth = 5
+
+defaultMaxJournalStateLines :: Int
+defaultMaxJournalStateLines = 16
+
+defaultMaxJournalMsgCount :: Int
+defaultMaxJournalMsgCount = 256
+
 defaultMsgQueueQuota :: Int
 defaultMsgQueueQuota = 128

+defaultStateTailSize :: Int
+defaultStateTailSize = 512
+
 data Env s = Env
  { config :: ServerConfig s,
    serverActive :: TVar Bool,
@@ -270,6 +300,7 @@ msgStore = fromMsgStore . msgStore_
 fromMsgStore :: MsgStore s -> s
 fromMsgStore = \case
  StoreMemory s -> s
+  StoreJournal s -> s
 #if defined(dbServerPostgres)
  StoreDatabase s -> s
 #endif
@@ -277,10 +308,12 @@ fromMsgStore = \case

 type family SupportedStore (qs :: QSType) (ms :: MSType) :: Constraint where
  SupportedStore 'QSMemory 'MSMemory = ()
+  SupportedStore 'QSMemory 'MSJournal = ()
  SupportedStore 'QSMemory 'MSPostgres =
    (Int ~ Bool, TypeError ('TE.Text "Storing messages in Postgres DB with queues in memory is not supported"))
  SupportedStore 'QSPostgres 'MSMemory =
    (Int ~ Bool, TypeError ('TE.Text "Storing messages in memory with queues in Postgres DB is not supported"))
+  SupportedStore 'QSPostgres 'MSJournal = ()
 #if defined(dbServerPostgres)
  SupportedStore 'QSPostgres 'MSPostgres = ()
 #else
@@ -294,6 +327,8 @@ data AStoreType =

 data ServerStoreCfg s where
  SSCMemory :: Maybe StorePaths -> ServerStoreCfg STMMsgStore
+  SSCMemoryJournal :: {storeLogFile :: FilePath, storeMsgsPath :: FilePath} -> ServerStoreCfg (JournalMsgStore 'QSMemory)
+  SSCDatabaseJournal :: {storeCfg :: PostgresStoreCfg, storeMsgsPath' :: FilePath} -> ServerStoreCfg (JournalMsgStore 'QSPostgres)
 #if defined(dbServerPostgres)
  SSCDatabase :: PostgresStoreCfg -> ServerStoreCfg PostgresMsgStore
 #endif
@@ -301,6 +336,8 @@ data ServerStoreCfg s where
 dbStoreCfg :: ServerStoreCfg s -> Maybe PostgresStoreCfg
 dbStoreCfg = \case
  SSCMemory _ -> Nothing
+  SSCMemoryJournal {} -> Nothing
+  SSCDatabaseJournal {storeCfg} -> Just storeCfg
 #if defined(dbServerPostgres)
  SSCDatabase cfg -> Just cfg
 #endif
@@ -308,6 +345,8 @@ dbStoreCfg = \case
 storeLogFile' :: ServerStoreCfg s -> Maybe FilePath
 storeLogFile' = \case
  SSCMemory sp_ -> (\StorePaths {storeLogFile} -> storeLogFile) <$> sp_
+  SSCMemoryJournal {storeLogFile} -> Just storeLogFile
+  SSCDatabaseJournal {storeCfg = PostgresStoreCfg {dbStoreLogPath}} -> dbStoreLogPath
 #if defined(dbServerPostgres)
  SSCDatabase (PostgresStoreCfg {dbStoreLogPath}) -> dbStoreLogPath
 #endif
@@ -316,12 +355,14 @@ data StorePaths = StorePaths {storeLogFile :: FilePath, storeMsgsFile :: Maybe F

 type family MsgStoreType (qs :: QSType) (ms :: MSType) where
  MsgStoreType 'QSMemory 'MSMemory = STMMsgStore
+  MsgStoreType qs 'MSJournal = JournalMsgStore qs
 #if defined(dbServerPostgres)
  MsgStoreType 'QSPostgres 'MSPostgres = PostgresMsgStore
 #endif

 data MsgStore s where
  StoreMemory :: STMMsgStore -> MsgStore STMMsgStore
+  StoreJournal :: JournalMsgStore qs -> MsgStore (JournalMsgStore qs)
 #if defined(dbServerPostgres)
  StoreDatabase :: PostgresMsgStore -> MsgStore PostgresMsgStore
 #endif
@@ -535,21 +576,42 @@ newProhibitedSub = do
  return Sub {subThread = ProhibitSub, delivered}

 newEnv :: ServerConfig s -> IO (Env s)
-newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, msgQueueQuota, namesConfig} = do
+newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines, namesConfig, msgIdBytes} = do
+  when (msgIdBytes < 24) $ do
+    logError "Error: msgIdBytes must be at least 24"
+    exitFailure
  serverActive <- newTVarIO True
  server <- newServer
  msgStore_ <- case serverStoreCfg of
    SSCMemory storePaths_ -> do
      let storePath = storeMsgsFile =<< storePaths_
      ms <- newMsgStore STMStoreConfig {storePath, quota = msgQueueQuota}
-      forM_ storePaths_ $ \StorePaths {storeLogFile = f} -> loadStoreLog (mkQueue ms) f $ queueStore ms
+      forM_ storePaths_ $ \StorePaths {storeLogFile = f} -> loadStoreLog (mkQueue ms True) f $ queueStore ms
      pure $ StoreMemory ms
+    SSCMemoryJournal {storeLogFile, storeMsgsPath} -> do
+      logWarn $
+        "Journal message store is deprecated and will be removed soon.\n"
+          <> "Please migrate to in-memory storage using `journal export` command.\n"
+          <> "After that you can migrate to PostgreSQL using `database import` command."
+      let qsCfg = MQStoreCfg
+          cfg = mkJournalStoreConfig qsCfg storeMsgsPath msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval
+      ms <- newMsgStore cfg
+      loadStoreLog (mkQueue ms True) storeLogFile $ stmQueueStore ms
+      pure $ StoreJournal ms
 #if defined(dbServerPostgres)
+    SSCDatabaseJournal {storeCfg, storeMsgsPath'} -> do
+      let StartOptions {compactLog, confirmMigrations} = startOptions config
+          qsCfg = PQStoreCfg (storeCfg {confirmMigrations} :: PostgresStoreCfg)
+          cfg = mkJournalStoreConfig qsCfg storeMsgsPath' msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval
+      when compactLog $ compactDbStoreLog $ dbStoreLogPath storeCfg
+      StoreJournal <$> newMsgStore cfg
    SSCDatabase storeCfg -> do
      let StartOptions {compactLog, confirmMigrations} = startOptions config
          cfg = PostgresMsgStoreCfg storeCfg {confirmMigrations} msgQueueQuota
      when compactLog $ compactDbStoreLog $ dbStoreLogPath storeCfg
      StoreDatabase <$> newMsgStore cfg
+#else
+    SSCDatabaseJournal {} -> noPostgresExit
 #endif
  ntfStore <- NtfStore <$> TM.emptyIO
  random <- C.newRandom
@@ -601,7 +663,8 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
      Just f -> do
        logNote $ "compacting queues in file " <> T.pack f
        st <- newMsgStore STMStoreConfig {storePath = Nothing, quota = msgQueueQuota}
-        sl <- readWriteQueueStore False (mkQueue st) f (queueStore st)
+        -- we don't need to have locks in the map
+        sl <- readWriteQueueStore False (mkQueue st False) f (queueStore st)
        setStoreLog (queueStore st) sl
        closeMsgStore st
      Nothing -> do
@@ -648,9 +711,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
            Nothing -> SPMMemoryOnly
            Just StorePaths {storeMsgsFile = Just _} -> SPMMessages
            _ -> SPMQueues
-#if defined(dbServerPostgres)
-          SSCDatabase _ -> SPMMessages
-#endif
+          _ -> SPMMessages

 noPostgresExit :: IO a
 noPostgresExit = putStrLn noPostgresExitStr >> exitFailure
@@ -660,6 +721,21 @@ noPostgresExitStr =
  "Error: server binary is compiled without support for PostgreSQL database.\n"
    <> "Please download `smp-server-postgres` or re-compile with `cabal build -fserver_postgres`."

+mkJournalStoreConfig :: QStoreCfg s -> FilePath -> Int -> Int -> Int -> Int64 -> JournalStoreConfig s
+mkJournalStoreConfig queueStoreCfg storePath msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval =
+  JournalStoreConfig
+    { storePath,
+      quota = msgQueueQuota,
+      pathParts = journalMsgStoreDepth,
+      queueStoreCfg,
+      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 SSender smpAgentCfg Nothing random
@@ -28,6 +28,8 @@ module Simplex.Messaging.Server.Main
    importMessagesToDatabase,
    exportDatabaseToStoreLog,
 #endif
+    newJournalMsgStore,
+    storeMsgsJournalDir',
    getServerSourceCode,
    simplexmqSource,
    serverPublicInfo,
@@ -59,6 +61,7 @@ import qualified Data.Text.IO as T
 import Options.Applicative
 import Simplex.Messaging.Agent.Protocol (ConnectionLink (..), ConnectionMode (..), connReqUriP')
 import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
+import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SMPWebPortServers (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
@@ -66,20 +69,23 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Network.URI (URI (..), URIAuth (..), parseAbsoluteURI)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
-import Simplex.Messaging.Server (AttachHTTP, runSMPServer)
+import Simplex.Messaging.Server (AttachHTTP, exportMessages, importMessages, printMessageStats, runSMPServer)
 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.Main.Init
 import Simplex.Messaging.Server.Web (EmbeddedWebParams (..), WebHttpsParams (..))
-import Simplex.Messaging.Server.MsgStore.Types (SQSType (..), SMSType (..))
+import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore (..), QStoreCfg (..), stmQueueStore)
+import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SQSType (..), SMSType (..), newMsgStore)
 import Simplex.Messaging.Server.Names (NamesConfig (..), RpcAuth (..))
+import Simplex.Messaging.Server.QueueStore.Postgres.Config
+import Simplex.Messaging.Server.StoreLog.ReadWrite (readQueueStore)
 import Simplex.Messaging.Transport (supportedProxyClientSMPRelayVRange, alpnSupportedSMPHandshakes, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (TransportHost (..), defaultSocksProxy)
 import Simplex.Messaging.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
-import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, whenM)
+import Simplex.Messaging.Util (eitherToMaybe, ifM, safeDecodeUtf8)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
@@ -92,16 +98,15 @@ import Data.Int (Int64)
 import qualified Data.Map.Strict as M
 import Data.Semigroup (Sum (..))
 import Simplex.Messaging.Agent.Store.Postgres (checkSchemaExists)
-import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
+import Simplex.Messaging.Server.MsgStore.Journal (JournalQueue)
+import Simplex.Messaging.Server.MsgStore.Types (QSType (..))
+import Simplex.Messaging.Server.MsgStore.Journal (postgresQueueStore)
 import Simplex.Messaging.Server.MsgStore.Postgres
-import Simplex.Messaging.Server.MsgStore.STM (STMStoreConfig (..))
-import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), newMsgStore)
-import Simplex.Messaging.Server.QueueStore.Postgres.Config
-import Simplex.Messaging.Server.QueueStore.Postgres (PostgresQueueStore, batchInsertQueues, batchInsertServices, foldQueueRecs, foldServiceRecs)
+import Simplex.Messaging.Server.QueueStore.Postgres (batchInsertQueues, batchInsertServices, foldQueueRecs, foldServiceRecs)
 import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..))
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog (closeStoreLog, logNewService, logCreateQueue, openWriteStoreLog)
-import Simplex.Messaging.Util (ifM)
+import Simplex.Messaging.Util (unlessM)
 import System.Directory (renameFile)
 import System.IO (IOMode (..), withFile)
 #endif
@@ -131,6 +136,79 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
      deleteDirIfExists cfgPath
      deleteDirIfExists logPath
      putStrLn "Deleted configuration and log files"
+    Journal cmd -> withIniFile $ \ini -> do
+      msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
+      msgsFileExists <- doesFileExist storeMsgsFilePath
+      storeLogFile <- getRequiredStoreLogFile ini
+      case cmd of
+        SCImport
+          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
+          | msgsDirExists -> do
+              putStrLn $ storeMsgsJournalDir <> " directory already exists."
+              exitFailure
+          | not msgsFileExists -> do
+              putStrLn $ storeMsgsFilePath <> " file does not exist."
+              exitFailure
+          | otherwise -> do
+              confirmOrExit
+                ("WARNING: message log file " <> storeMsgsFilePath <> " will be imported to journal directory " <> storeMsgsJournalDir)
+                "Messages not imported"
+              ms <- newJournalMsgStore logPath MQStoreCfg
+              readQueueStore True (mkQueue ms False) storeLogFile $ stmQueueStore ms
+              msgStats <- importMessages True ms storeMsgsFilePath Nothing False -- no expiration
+              putStrLn "Import completed"
+              printMessageStats "Messages" msgStats
+              putStrLn $ case readStoreType ini of
+                Right (ASType SQSMemory SMSMemory) -> "store_messages set to `memory`, update it to `journal` in INI file"
+                Right (ASType SQSPostgres SMSPostgres) -> "store_messages set to `database`, update it to `journal` in INI file"
+                Right (ASType _ SMSJournal) -> "store_messages set to `journal`"
+                Left e -> e <> ", configure storage correctly"
+        SCExport
+          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
+          | msgsFileExists -> do
+              putStrLn $ storeMsgsFilePath <> " file already exists."
+              exitFailure
+          | otherwise -> do
+              confirmOrExit
+                ("WARNING: journal directory " <> storeMsgsJournalDir <> " will be exported to message log file " <> storeMsgsFilePath)
+                "Journal not exported"
+              case readStoreType ini of
+                Right (ASType SQSMemory msType) -> do
+                  ms <- newJournalMsgStore logPath MQStoreCfg
+                  readQueueStore True (mkQueue ms False) storeLogFile $ stmQueueStore ms
+                  exportMessages True (StoreJournal ms) storeMsgsFilePath False
+                  putStrLn "Export completed"
+                  putStrLn $ case msType of
+                    SMSMemory -> "store_messages set to `memory`, start the server."
+                    SMSJournal -> "store_messages set to `journal`, update it to `memory` in INI file"
+#if defined(dbServerPostgres)
+                Right (ASType SQSPostgres SMSJournal) -> do
+                  let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
+                      dbOpts@DBOpts {connstr, schema} = iniDBOptions ini defaultDBOpts
+                  unlessM (checkSchemaExists connstr schema) $ do
+                    putStrLn $ "Schema " <> B.unpack schema <> " does not exist in PostrgreSQL database: " <> B.unpack connstr
+                    exitFailure
+                  ms <- newJournalMsgStore logPath $ PQStoreCfg PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
+                  exportMessages True (StoreJournal ms) storeMsgsFilePath False
+                  putStrLn "Export completed"
+                  putStrLn "store_messages set to `journal`, store_queues is set to `database`.\nExport queues to store log to use memory storage for messages (`smp-server database export`)."
+                Right (ASType SQSPostgres SMSPostgres) -> do
+                  putStrLn $ "Messages can be exported with `dabatase export --table messages`."
+                  exitFailure
+#else
+                Right (ASType SQSPostgres SMSJournal) -> noPostgresExit
+#endif
+                Left e -> putStrLn $ e <> ", configure storage correctly"
+        SCDelete
+          | not msgsDirExists -> do
+              putStrLn $ storeMsgsJournalDir <> " directory does not exists."
+              exitFailure
+          | otherwise -> do
+              confirmOrExit
+                ("WARNING: journal directory " <> storeMsgsJournalDir <> " will be permanently deleted.\nTHIS CANNOT BE UNDONE!")
+                "Messages NOT deleted"
+              deleteDirIfExists storeMsgsJournalDir
+              putStrLn $ "Deleted all messages in journal " <> storeMsgsJournalDir
 #if defined(dbServerPostgres)
    Database cmd tables dbOpts@DBOpts {connstr, schema} -> withIniFile $ \ini -> do
      schemaExists <- checkSchemaExists connstr schema
@@ -143,7 +221,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
              confirmOrExit
                ("WARNING: store log file " <> storeLogFile <> " and message log file " <> storeMsgsFilePath <> " will be imported to PostrgreSQL database: " <> B.unpack connstr <> ", schema: " <> B.unpack schema)
                "Store logs not imported"
-              (sCnt, qCnt) <- importStoreLogToDatabase storeLogFile dbOpts
+              (sCnt, qCnt) <- importStoreLogToDatabase logPath storeLogFile dbOpts
              putStrLn $ "Imported: " <> show sCnt <> " services, " <> show qCnt <> " queues"
              putStrLn "Importing messages..."
              mCnt <- importMessagesToDatabase storeMsgsFilePath dbOpts
@@ -170,10 +248,11 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
              confirmOrExit
                ("WARNING: store log file " <> storeLogFile <> " will be compacted and imported to PostrgreSQL database: " <> B.unpack connstr <> ", schema: " <> B.unpack schema)
                "Queue records not imported"
-              (sCnt, qCnt) <- importStoreLogToDatabase storeLogFile dbOpts
+              (sCnt, qCnt) <- importStoreLogToDatabase logPath storeLogFile dbOpts
              putStrLn $ "Import completed: " <> show sCnt <> " services, " <> show qCnt <> " queues"
              putStrLn $ case readStoreType ini of
-                Right (ASType SQSMemory SMSMemory) -> setToDbStr <> "\nstore_messages set to `memory`, update it to `database` and import messages (`smp-server database import --table messages`)"
+                Right (ASType SQSMemory SMSMemory) -> setToDbStr <> "\nstore_messages set to `memory`, import messages to journal to use PostgreSQL database for queues (`smp-server journal import`)"
+                Right (ASType SQSMemory SMSJournal) -> setToDbStr
                Right (ASType SQSPostgres _) -> "store_queues set to `database`, start the server."
                Left e -> e <> ", configure storage correctly"
          where
@@ -201,7 +280,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
              confirmOrExit
                ("WARNING: PostrgreSQL schema " <> B.unpack schema <> " (database: " <> B.unpack connstr <> ") will be exported to store log file " <> storeLogFilePath <> " and to message log file " <> storeMsgsFilePath)
                "Database store not exported"
-              (sCnt, qCnt) <- exportDatabaseToStoreLog dbOpts storeLogFilePath
+              (sCnt, qCnt) <- exportDatabaseToStoreLog logPath dbOpts storeLogFilePath
              putStrLn $ "Exported: " <> show sCnt <> " services, " <> show qCnt <> " queues"
              putStrLn "Exporting messages..."
              let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
@@ -227,7 +306,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
              confirmOrExit
                ("WARNING: PostrgreSQL schema " <> B.unpack schema <> " (database: " <> B.unpack connstr <> ") will be exported to store log file " <> storeLogFilePath)
                "Queue records not exported"
-              (sCnt, qCnt) <- exportDatabaseToStoreLog dbOpts storeLogFilePath
+              (sCnt, qCnt) <- exportDatabaseToStoreLog logPath dbOpts storeLogFilePath
              putStrLn $ "Export completed: " <> show sCnt <> " services, " <> show qCnt <> " queues"
              putStrLn $ case readStoreType ini of
                Right (ASType SQSPostgres _) -> "store_queues or store_messages set to `database`, update it to `memory` in INI file."
@@ -267,7 +346,6 @@ 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`."
-#if defined(dbServerPostgres)
    getRequiredStoreLogFile ini = do
      case enableStoreLog' ini $> storeLogFilePath of
        Just storeLogFile -> do
@@ -276,21 +354,20 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
            (pure storeLogFile)
            (putStrLn ("Store log file " <> storeLogFile <> " not found") >> exitFailure)
        Nothing -> putStrLn "Store log disabled, see `[STORE_LOG] enable`" >> exitFailure
-#endif
    iniFile = combine cfgPath "smp-server.ini"
    serverVersion = "SMP server v" <> simplexmqVersionCommit
    executableName = "smp-server"
    storeLogFilePath = combine logPath "smp-server-store.log"
    storeMsgsFilePath = combine logPath "smp-server-messages.log"
-    storeMsgsJournalDir = combine logPath "messages"
+    storeMsgsJournalDir = storeMsgsJournalDir' logPath
    storeNtfsFilePath = combine logPath "smp-server-ntfs.log"
    readStoreType :: Ini -> Either String AStoreType
    readStoreType ini = case (iniStoreQueues, iniStoreMessage) of
      ("memory", "memory") -> Right $ ASType SQSMemory SMSMemory
-      ("memory", "journal") -> Left journalRemovedStr
+      ("memory", "journal") -> Right $ ASType SQSMemory SMSJournal
      ("memory", "database") -> Left "Database and memory storage are not compatible."
      ("database", "memory") -> Left "Database and memory storage are not compatible."
-      ("database", "journal") -> Left journalRemovedStr
+      ("database", "journal") -> Right $ ASType SQSPostgres SMSJournal
 #if defined(dbServerPostgres)
      ("database", "database") -> Right $ ASType SQSPostgres SMSPostgres
 #else
@@ -300,12 +377,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
      where
        iniStoreQueues = fromRight "memory" $ lookupValue "STORE_LOG" "store_queues" ini
        iniStoreMessage = fromRight "memory" $ lookupValue "STORE_LOG" "store_messages" ini
-#if defined(dbServerPostgres)
    iniDeletedTTL ini = readIniDefault (86400 * defaultDeletedTTL) "STORE_LOG" "db_deleted_ttl" ini
-    enableDbStoreLog' = settingIsOn "STORE_LOG" "db_store_log"
-#endif
    defaultStaticPath = combine logPath "www"
    enableStoreLog' = settingIsOn "STORE_LOG" "enable"
+    enableDbStoreLog' = settingIsOn "STORE_LOG" "db_store_log"
    initializeServer opts
      | scripted opts = initialize opts
      | otherwise = do
@@ -442,13 +517,16 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
        iniStoreType = either error id $! readStoreType ini
        iniStoreCfg :: SupportedStore qs ms => SQSType qs -> SMSType ms -> ServerStoreCfg (MsgStoreType qs ms)
        iniStoreCfg SQSMemory SMSMemory = SSCMemory $ enableStoreLog' ini $> StorePaths {storeLogFile = storeLogFilePath, storeMsgsFile = restoreMessagesFile storeMsgsFilePath}
+        iniStoreCfg SQSMemory SMSJournal = SSCMemoryJournal {storeLogFile = storeLogFilePath, storeMsgsPath = storeMsgsJournalDir}
+        iniStoreCfg SQSPostgres SMSJournal =
+          let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
+              storeCfg = PostgresStoreCfg {dbOpts = iniDBOptions ini defaultDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
+           in SSCDatabaseJournal {storeCfg, storeMsgsPath' = storeMsgsJournalDir}
 #if defined(dbServerPostgres)
        iniStoreCfg SQSPostgres SMSPostgres =
          let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
              storeCfg = PostgresStoreCfg {dbOpts = iniDBOptions ini defaultDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
           in SSCDatabase storeCfg
-#else
-        iniStoreCfg SQSPostgres _ = error noPostgresExitStr
 #endif
        serverConfig :: ServerStoreCfg s -> ServerConfig s
        serverConfig serverStoreCfg =
@@ -457,6 +535,8 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
              smpHandshakeTimeout = 120000000,
              tbqSize = 128,
              msgQueueQuota = defaultMsgQueueQuota,
+              maxJournalMsgCount = defaultMaxJournalMsgCount,
+              maxJournalStateLines = defaultMaxJournalStateLines,
              queueIdBytes = 24,
              msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
              smpCredentials =
@@ -481,6 +561,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                    },
              expireMessagesOnStart = fromMaybe True $ iniOnOff "STORE_LOG" "expire_messages_on_start" ini,
              expireMessagesOnSend = fromMaybe True $ iniOnOff "STORE_LOG" "expire_messages_on_send" ini,
+              idleQueueInterval = defaultIdleQueueInterval,
              notificationExpiration =
                defaultNtfExpiration
                  { ttl = 3600 * readIniDefault defNtfExpirationHours "STORE_LOG" "expire_ntfs_hours" ini
@@ -499,6 +580,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
              prometheusMetricsFile = combine logPath "smp-server-metrics.txt",
              pendingENDInterval = 15000000, -- 15 seconds
              ntfDeliveryInterval = 1500000, -- 1.5 second
+              authErrorDelay = 1000 * readIniDefault defaultAuthErrorDelayMs "TRANSPORT" "auth_error_delay_ms" ini,
              smpServerVRange = supportedServerSMPRelayVRange,
              transportConfig =
                mkTransportServerConfig
@@ -553,26 +635,47 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
        webStaticPath' = eitherToMaybe $ T.unpack <$> lookupValue "WEB" "static_path" ini

    checkMsgStoreMode :: Ini -> AStoreType -> IO ()
-#if defined(dbServerPostgres)
    checkMsgStoreMode ini mode = do
-#else
-    checkMsgStoreMode _ mode = do
-#endif
-      whenM (doesDirectoryExist storeMsgsJournalDir) $ do
-        putStrLn $ "Error: " <> storeMsgsJournalDir <> " directory is present.\n" <> journalRemovedStr
-        exitFailure
+      msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
+      msgsFileExists <- doesFileExist storeMsgsFilePath
+      storeLogExists <- doesFileExist storeLogFilePath
      case mode of
 #if defined(dbServerPostgres)
-        ASType SQSPostgres SMSPostgres -> do
-          whenM (doesFileExist storeMsgsFilePath) $ do
-            putStrLn $ "Error: " <> storeMsgsFilePath <> " file is present."
-            putStrLn "Configure memory storage."
-            exitFailure
-          checkDbStorage ini =<< doesFileExist storeLogFilePath
-#else
-        ASType SQSPostgres _ -> noPostgresExit
+        ASType SQSPostgres SMSPostgres
+          | msgsFileExists || msgsDirExists -> do
+              putStrLn $ "Error: " <> storeMsgsFilePath <> " file or " <> storeMsgsJournalDir <> " directory are present."
+              putStrLn "Configure memory storage."
+              exitFailure
+          | otherwise -> checkDbStorage ini storeLogExists
 #endif
-        ASType SQSMemory SMSMemory -> pure ()
+        ASType qs SMSJournal
+          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
+          | msgsFileExists -> do
+              putStrLn $ "Error: store_messages is `journal` with " <> storeMsgsFilePath <> " file present."
+              putStrLn "Set store_messages to `memory` or use `smp-server journal export` to migrate."
+              exitFailure
+          | not msgsDirExists ->
+              putStrLn $ "store_messages is `journal`, " <> storeMsgsJournalDir <> " directory will be created."
+          | otherwise -> case qs of
+              SQSMemory ->
+                unless (storeLogExists) $ putStrLn $ "store_queues is `memory`, " <> storeLogFilePath <> " file will be created."
+#if defined(dbServerPostgres)
+              SQSPostgres -> checkDbStorage ini storeLogExists
+#else
+              SQSPostgres -> noPostgresExit
+#endif
+        ASType SQSMemory SMSMemory
+          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
+          | msgsDirExists -> do
+              putStrLn $ "Error: store_messages is `memory` with " <> storeMsgsJournalDir <> " directory present."
+              putStrLn "Set store_messages to `journal` or use `smp-server journal import` to migrate."
+              exitFailure
+          | otherwise -> pure ()
+
+    exitConfigureMsgStorage = do
+      putStrLn $ "Error: both " <> storeMsgsFilePath <> " file and " <> storeMsgsJournalDir <> " directory are present."
+      putStrLn "Configure memory storage."
+      exitFailure

 #if defined(dbServerPostgres)
    checkDbStorage ini storeLogExists = do
@@ -603,18 +706,18 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
      putStrLn "Configure queue storage."
      exitFailure

-importStoreLogToDatabase :: FilePath -> DBOpts -> IO (Int64, Int64)
-importStoreLogToDatabase storeLogFile dbOpts = do
-  ms <- newMsgStore STMStoreConfig {storePath = Nothing, quota = defaultMsgQueueQuota}
-  let st = queueStore ms
-  sl <- readWriteQueueStore True (mkQueue ms) storeLogFile st
+importStoreLogToDatabase :: FilePath -> FilePath -> DBOpts -> IO (Int64, Int64)
+importStoreLogToDatabase logPath storeLogFile dbOpts = do
+  ms <- newJournalMsgStore logPath MQStoreCfg
+  let st = stmQueueStore ms
+  sl <- readWriteQueueStore True (mkQueue ms False) storeLogFile st
  closeStoreLog sl
-  qs <- readTVarIO $ queues st
+  queues <- readTVarIO $ loadedQueues st
  services' <- M.elems <$> readTVarIO (services st)
  let storeCfg = PostgresStoreCfg {dbOpts = dbOpts {createSchema = True}, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
-  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue storeCfg
-  sCnt <- batchInsertServices services' ps
-  qCnt <- batchInsertQueues True qs ps
+  ps <- newJournalMsgStore logPath $ PQStoreCfg storeCfg
+  sCnt <- batchInsertServices services' $ postgresQueueStore ps
+  qCnt <- batchInsertQueues @(JournalQueue 'QSMemory) True queues $ postgresQueueStore ps
  renameFile storeLogFile $ storeLogFile <> ".bak"
  pure (sCnt, qCnt)

@@ -633,22 +736,24 @@ importMessagesToDatabase msgsLogFile dbOpts = do
  renameFile msgsLogFile $ msgsLogFile <> ".bak"
  pure mCnt'

-exportDatabaseToStoreLog :: DBOpts -> FilePath -> IO (Int, Int)
-exportDatabaseToStoreLog dbOpts storeLogFilePath = do
+exportDatabaseToStoreLog :: FilePath -> DBOpts -> FilePath -> IO (Int, Int)
+exportDatabaseToStoreLog logPath dbOpts storeLogFilePath = do
  let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
-  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue storeCfg
+  ps <- newJournalMsgStore logPath $ PQStoreCfg storeCfg
  sl <- openWriteStoreLog False storeLogFilePath
-  Sum sCnt <- foldServiceRecs ps $ \sr -> logNewService sl sr $> Sum (1 :: Int)
-  Sum qCnt <- foldQueueRecs True True ps $ \(rId, qr) -> logCreateQueue sl rId qr $> Sum (1 :: Int)
+  Sum sCnt <- foldServiceRecs (postgresQueueStore ps) $ \sr -> logNewService sl sr $> Sum (1 :: Int)
+  Sum qCnt <- foldQueueRecs True True (postgresQueueStore ps) $ \(rId, qr) -> logCreateQueue sl rId qr $> Sum (1 :: Int)
  closeStoreLog sl
  pure (sCnt, qCnt)
 #endif

-journalRemovedStr :: String
-journalRemovedStr =
-  "Journal message storage is removed.\n"
-    <> "Export messages with `smp-server journal export` using smp-server v7.1.0.10 or earlier,\n"
-    <> "then set store_messages to `memory`, or to `database` and run `smp-server database import --table messages`."
+newJournalMsgStore :: FilePath -> QStoreCfg s -> IO (JournalMsgStore s)
+newJournalMsgStore logPath qsCfg =
+  let cfg = mkJournalStoreConfig qsCfg (storeMsgsJournalDir' logPath) defaultMsgQueueQuota defaultMaxJournalMsgCount defaultMaxJournalStateLines $ checkInterval defaultMessageExpiration
+   in newMsgStore cfg
+
+storeMsgsJournalDir' :: FilePath -> FilePath
+storeMsgsJournalDir' logPath = combine logPath "messages"

 getServerSourceCode :: IO (Maybe String)
 getServerSourceCode =
@@ -769,6 +874,7 @@ data CliCommand
  | OnlineCert CertOptions
  | Start StartOptions
  | Delete
+  | Journal StoreCmd
  | Database StoreCmd DatabaseTable DBOpts

 data StoreCmd = SCImport | SCExport | SCDelete
@@ -794,6 +900,7 @@ cliCommandP cfgPath logPath iniFile =
        <> command "cert" (info (OnlineCert <$> certOptionsP) (progDesc $ "Generate new online TLS server credentials (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"))
        <> command "database" (info (Database <$> databaseCmdP <*> dbTableP <*> dbOptsP defaultDBOpts) (progDesc "Import/export queues to/from PostgreSQL database storage"))
    )
  where
@@ -940,6 +1047,7 @@ cliCommandP cfgPath logPath iniFile =
            disableWeb,
            scripted
          }
+    journalCmdP = storeCmdP "message log file" "journal storage"
    databaseCmdP = storeCmdP "queue store log file" "PostgreSQL database schema"
    storeCmdP src dest =
      hsubparser
@@ -83,7 +83,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
    <> ("enable = " <> onOff enableStoreLog <> "\n\n")
    <> "# Queue storage mode: `memory` or `database` (to store queue records in PostgreSQL database).\n\
        \# `memory` - in-memory persistence, with optional append-only log (`enable = on`).\n\
-        \# `database`- PostgreSQL databass (requires `store_messages = database`).\n\
+        \# `database`- PostgreSQL databass (requires `store_messages = journal`).\n\
        \store_queues = memory\n\n\
        \# Database connection settings for PostgreSQL database (`store_queues = database`).\n"
    <> iniDbOpts dbOptions defaultDBOpts
@@ -91,7 +91,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
        \# db_store_log = off\n\n\
        \# Time to retain deleted queues in the database, days.\n"
    <> ("# db_deleted_ttl = " <> tshow defaultDeletedTTL <> "\n\n")
-    <> "# Message storage mode: `memory` or `database` (requires `store_queues = database`).\n\
+    <> "# Message storage mode: `memory` or `journal`.\n\
        \store_messages = memory\n\n\
        \# When store_messages is `memory`, undelivered messages are optionally saved and restored\n\
        \# when the server restarts, they are preserved in the .bak file until the next restart.\n"
@@ -130,7 +130,9 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
    <> ("host = " <> T.pack host <> "\n")
    <> ("port = " <> defaultServerPorts <> "\n")
    <> "log_tls_errors = off\n\n\
-        \# Use `websockets = 443` to run websockets server in addition to plain TLS.\n\
+        \# Minimum time to respond with AUTH error, milliseconds.\n"
+    <> ("# auth_error_delay_ms = " <> tshow defaultAuthErrorDelayMs <> "\n\n")
+    <> "# Use `websockets = 443` to run websockets server in addition to plain TLS.\n\
        \# This option is deprecated and should be used for testing only.\n\
        \# , port 443 should be specified in port above\n\
        \websockets = off\n"
@@ -0,0 +1,44 @@
+module Simplex.Messaging.Server.MsgStore.Journal.SharedLock
+  ( withLockWaitShared,
+    withLockMapWaitShared,
+    withSharedWaitLock,
+  )
+where
+
+import Control.Concurrent.STM
+import qualified Control.Exception as E
+import Control.Monad
+import Data.Text (Text)
+import Simplex.Messaging.Agent.Lock
+import Simplex.Messaging.Agent.Client (getMapLock)
+import Simplex.Messaging.Protocol (RecipientId)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (($>>), ($>>=))
+
+-- wait until shared lock with passed ID is released and take lock
+withLockWaitShared :: RecipientId -> Lock -> TMVar RecipientId -> Text -> IO a -> IO a
+withLockWaitShared rId lock shared name =
+  E.bracket_
+    (atomically $ waitShared rId shared >> putTMVar lock name)
+    (void $ atomically $ takeTMVar lock)
+
+-- wait until shared lock with passed ID is released and take lock from Map for this ID
+withLockMapWaitShared :: RecipientId -> TMap RecipientId Lock -> TMVar RecipientId -> Text -> IO a -> IO a
+withLockMapWaitShared rId locks shared name a =
+  E.bracket
+    (atomically $ waitShared rId shared >> getPutLock (getMapLock locks) rId name)
+    (atomically . takeTMVar)
+    (const a)
+
+waitShared :: RecipientId -> TMVar RecipientId -> STM ()
+waitShared rId shared = tryReadTMVar shared >>= mapM_ (\rId' -> when (rId == rId') retry)
+
+-- wait until lock with passed ID in Map is released and take shared lock for this ID
+withSharedWaitLock :: RecipientId -> TMap RecipientId Lock -> TMVar RecipientId -> IO a -> IO a
+withSharedWaitLock rId locks shared =
+  E.bracket_
+    (atomically $ waitLock >> putTMVar shared rId)
+    (atomically $ takeTMVar shared)
+  where
+    waitLock = TM.lookup rId locks $>>= tryReadTMVar $>> retry
@@ -29,6 +29,7 @@ where
 import Control.Concurrent.STM
 import qualified Control.Exception as E
 import Control.Monad
+import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as BB
@@ -38,6 +39,7 @@ import Data.IORef
 import Data.Int (Int64)
 import Data.List (intersperse)
 import qualified Data.Map.Strict as M
+import Data.Text (Text)
 import Data.Time.Clock.System (SystemTime (..))
 import Database.PostgreSQL.Simple (Binary (..), In (..), Only (..), (:.) (..))
 import qualified Database.PostgreSQL.Simple as DB
@@ -54,7 +56,7 @@ import Simplex.Messaging.Server.QueueStore.Postgres
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog (foldLogLines)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Util (maybeFirstRow, maybeFirstRow')
+import Simplex.Messaging.Util (maybeFirstRow, maybeFirstRow', (<$$>))
 import System.IO (Handle, hFlush, stdout)

 data PostgresMsgStore = PostgresMsgStore
@@ -79,20 +81,32 @@ instance StoreQueueClass PostgresQueue where
  {-# INLINE recipientId #-}
  queueRec = queueRec'
  {-# INLINE queueRec #-}
+  withQueueLock PostgresQueue {} _ = id -- TODO [messages] maybe it's just transaction?
+  {-# INLINE withQueueLock #-}
+
+newtype DBTransaction = DBTransaction {dbConn :: DB.Connection}
+
+type DBStoreIO a = ReaderT DBTransaction IO a

 instance MsgStoreClass PostgresMsgStore where
+  type StoreMonad PostgresMsgStore = ReaderT DBTransaction IO
+  type MsgQueue PostgresMsgStore = ()
  type QueueStore PostgresMsgStore = PostgresQueueStore'
  type StoreQueue PostgresMsgStore = PostgresQueue
  type MsgStoreConfig PostgresMsgStore = PostgresMsgStoreCfg

  newMsgStore :: PostgresMsgStoreCfg -> IO PostgresMsgStore
  newMsgStore config = do
-    queueStore_ <- newQueueStore @PostgresQueue (queueStoreCfg config)
+    queueStore_ <- newQueueStore @PostgresQueue (queueStoreCfg config, False)
    pure PostgresMsgStore {config, queueStore_}

  closeMsgStore :: PostgresMsgStore -> IO ()
  closeMsgStore = closeQueueStore @PostgresQueue . queueStore_

+  withActiveMsgQueues _ _ = error "withActiveMsgQueues not used"
+
+  unsafeWithAllMsgQueues _ _ _ = error "unsafeWithAllMsgQueues not used"
+
  expireOldMessages :: Bool -> PostgresMsgStore -> Int64 -> Int64 -> IO MessageStats
  expireOldMessages _tty ms now ttl =
    maybeFirstRow' newMessageStats toMessageStats $ withConnection st $ \db ->
@@ -136,13 +150,35 @@ instance MsgStoreClass PostgresMsgStore where
            msg_ = toMaybeMessage mRow
         in f a rId $ Right ((qr,) <$> msg_)

+  logQueueStates _ = error "logQueueStates not used"
+
+  logQueueState _ = error "logQueueState not used"
+
  queueStore = queueStore_
  {-# INLINE queueStore #-}

-  mkQueue :: PostgresMsgStore -> RecipientId -> QueueRec -> IO PostgresQueue
-  mkQueue _ rId qr = PostgresQueue rId <$> newTVarIO (Just qr)
+  loadedQueueCounts :: PostgresMsgStore -> IO LoadedQueueCounts
+  loadedQueueCounts ms = do
+    loadedQueueCount <- M.size <$> readTVarIO queues
+    loadedNotifierCount <- M.size <$> readTVarIO notifiers
+    notifierLockCount <- M.size <$> readTVarIO notifierLocks
+    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, openJournalCount = 0, queueLockCount = 0, notifierLockCount}
+    where
+      PostgresQueueStore {queues, notifiers, notifierLocks} = queueStore_ ms
+
+  mkQueue :: PostgresMsgStore -> Bool -> RecipientId -> QueueRec -> IO PostgresQueue
+  mkQueue _ _keepLock rId qr = PostgresQueue rId <$> newTVarIO (Just qr)
  {-# INLINE mkQueue #-}

+  getMsgQueue _ _ _ = pure ()
+  {-# INLINE getMsgQueue #-}
+
+  getPeekMsgQueue :: PostgresMsgStore -> PostgresQueue -> DBStoreIO (Maybe ((), Message))
+  getPeekMsgQueue _ q = ((),) <$$> tryPeekMsg_ q ()
+
+  withIdleMsgQueue :: Int64 -> PostgresMsgStore -> PostgresQueue -> (() -> DBStoreIO a) -> DBStoreIO (Maybe a, Int)
+  withIdleMsgQueue _ _ _ _ = error "withIdleMsgQueue not used"
+
  deleteQueue :: PostgresMsgStore -> PostgresQueue -> IO (Either ErrorType QueueRec)
  deleteQueue ms q = deleteStoreQueue (queueStore_ ms) q
  {-# INLINE deleteQueue #-}
@@ -153,6 +189,8 @@ instance MsgStoreClass PostgresMsgStore where
    qr <- ExceptT $ deleteStoreQueue (queueStore_ ms) q
    pure (qr, size)

+  getQueueMessages_ _ _ _ = error "getQueueMessages_ not used"
+
  writeMsg :: PostgresMsgStore -> PostgresQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
  writeMsg ms q _ msg =
    uninterruptibleMask_ $
@@ -164,33 +202,50 @@ instance MsgStoreClass PostgresMsgStore where
          DB.query
            db
            "SELECT quota_written, was_empty FROM write_message(?,?,?,?,?,?,?)"
-            (recipientId' q, Binary (messageId msg), systemSeconds (messageTs msg), msgQuota, ntf, Binary body, quota)
+            (recipientId' q, messageId msg, systemSeconds (messageTs msg), msgQuota, ntf, Binary body, quota)
    where
      toResult = \case
        ((msgQuota, wasEmpty) : _) -> if msgQuota then Nothing else Just (msg, wasEmpty)
        [] -> Nothing
      PostgresMsgStore {config = PostgresMsgStoreCfg {quota}} = ms

+  setOverQuota_ :: PostgresQueue -> IO () -- can ONLY be used while restoring messages, not while server running
+  setOverQuota_ _ = error "TODO setOverQuota_" -- TODO [messages]
+
+  getQueueSize_ :: () -> DBStoreIO Int
+  getQueueSize_ _ = error "getQueueSize_ not used"
+
  getQueueSize :: PostgresMsgStore -> PostgresQueue -> ExceptT ErrorType IO Int
  getQueueSize ms q =
    withDB' "getQueueSize" (queueStore_ ms) $ \db ->
      maybeFirstRow' 0 fromOnly $
        DB.query db "SELECT msg_queue_size FROM msg_queues WHERE recipient_id = ? AND deleted_at IS NULL" (Only (recipientId' q))

+  tryPeekMsg_ :: PostgresQueue -> () -> DBStoreIO (Maybe Message)
+  tryPeekMsg_ q _ = do
+    db <- asks dbConn
+    liftIO $ maybeFirstRow toMessage $
+      DB.query
+        db
+        [sql|
+          SELECT msg_id, msg_ts, msg_quota, msg_ntf_flag, msg_body
+          FROM messages
+          WHERE recipient_id = ?
+          ORDER BY message_id ASC LIMIT 1
+        |]
+        (Only (recipientId' q))
+
+  tryDeleteMsg_ :: PostgresQueue -> () -> Bool -> DBStoreIO ()
+  tryDeleteMsg_ _q _ _ = error "tryDeleteMsg_ not used" -- do
+
+  isolateQueue :: PostgresMsgStore -> PostgresQueue -> Text -> DBStoreIO a -> ExceptT ErrorType IO a
+  isolateQueue ms _q op a = uninterruptibleMask_ $ withDB' op (queueStore_ ms) $ runReaderT a . DBTransaction
+
+  unsafeRunStore _ _ _ = error "unsafeRunStore not used"
+
  tryPeekMsg :: PostgresMsgStore -> PostgresQueue -> ExceptT ErrorType IO (Maybe Message)
-  tryPeekMsg ms q =
-    uninterruptibleMask_ $
-      withDB' "tryPeekMsg" (queueStore_ ms) $ \db ->
-        maybeFirstRow toMessage $
-          DB.query
-            db
-            [sql|
-              SELECT msg_id, msg_ts, msg_quota, msg_ntf_flag, msg_body
-              FROM messages
-              WHERE recipient_id = ?
-              ORDER BY message_id ASC LIMIT 1
-            |]
-            (Only (recipientId' q))
+  tryPeekMsg ms q = isolateQueue ms q "tryPeekMsg" $ tryPeekMsg_ q ()
+  {-# INLINE tryPeekMsg #-}

  tryPeekMsgs :: PostgresMsgStore -> [PostgresQueue] -> ExceptT ErrorType IO (M.Map RecipientId Message)
  tryPeekMsgs _ms [] = pure M.empty
@@ -216,14 +271,14 @@ instance MsgStoreClass PostgresMsgStore where
    uninterruptibleMask_ $
      withDB' "tryDelMsg" (queueStore_ ms) $ \db ->
        maybeFirstRow toMessage $
-          DB.query db "SELECT r_msg_id, r_msg_ts, r_msg_quota, r_msg_ntf_flag, r_msg_body FROM try_del_msg(?, ?)" (recipientId' q, Binary msgId)
+          DB.query db "SELECT r_msg_id, r_msg_ts, r_msg_quota, r_msg_ntf_flag, r_msg_body FROM try_del_msg(?, ?)" (recipientId' q, msgId)

  tryDelPeekMsg :: PostgresMsgStore -> PostgresQueue -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
  tryDelPeekMsg ms q msgId =
    uninterruptibleMask_ $
      withDB' "tryDelPeekMsg" (queueStore_ ms) $ \db ->
        toResult . map toMessage
-          <$> DB.query db "SELECT r_msg_id, r_msg_ts, r_msg_quota, r_msg_ntf_flag, r_msg_body FROM try_del_peek_msg(?, ?)" (recipientId' q, Binary msgId)
+          <$> DB.query db "SELECT r_msg_id, r_msg_ts, r_msg_quota, r_msg_ntf_flag, r_msg_body FROM try_del_peek_msg(?, ?)" (recipientId' q, msgId)
    where
      toResult = \case
        [] -> (Nothing, Nothing)
@@ -242,13 +297,13 @@ uninterruptibleMask_ :: ExceptT ErrorType IO a -> ExceptT ErrorType IO a
 uninterruptibleMask_ = ExceptT . E.uninterruptibleMask_ . runExceptT
 {-# INLINE uninterruptibleMask_ #-}

-toMaybeMessage :: (Maybe (Binary MsgId), Maybe Int64, Maybe Bool, Maybe Bool, Maybe (Binary MsgBody)) -> Maybe Message
+toMaybeMessage :: (Maybe MsgId, Maybe Int64, Maybe Bool, Maybe Bool, Maybe (Binary MsgBody)) -> Maybe Message
 toMaybeMessage = \case
  (Just msgId, Just ts, Just msgQuota, Just ntf, Just body) -> Just $ toMessage (msgId, ts, msgQuota, ntf, body)
  _ -> Nothing

-toMessage :: (Binary MsgId, Int64, Bool, Bool, Binary MsgBody) -> Message
-toMessage (Binary msgId, ts, msgQuota, ntf, Binary body)
+toMessage :: (MsgId, Int64, Bool, Bool, Binary MsgBody) -> Message
+toMessage (msgId, ts, msgQuota, ntf, Binary body)
  | msgQuota = MessageQuota {msgId, msgTs}
  | otherwise = Message {msgId, msgTs, msgFlags = MsgFlags ntf, msgBody = C.unsafeMaxLenBS body} -- TODO [messages] unsafeMaxLenBS?
  where
@@ -374,7 +429,7 @@ messageRecToText rId msg =
    tabFields = BB.char7 ',' `intersperse` fields
    fields =
      [ renderField (toField rId),
-        renderField (toField $ Binary (messageId msg)),
+        renderField (toField $ messageId msg),
        renderField (toField $ systemSeconds (messageTs msg)),
        renderField (toField msgQuota),
        renderField (toField ntf),
@@ -15,10 +15,6 @@ module Simplex.Messaging.Server.MsgStore.STM
  ( STMMsgStore (..),
    STMStoreConfig (..),
    STMQueue,
-    loadedQueueCounts,
-    getQueueMessages,
-    setOverQuota_,
-    deleteQuotaMsg,
  )
 where

@@ -28,8 +24,7 @@ import Control.Monad.Trans.Except
 import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes)
-import Data.Time.Clock.System (SystemTime (systemSeconds))
+import Data.Text (Text)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
@@ -66,8 +61,12 @@ instance StoreQueueClass STMQueue where
  {-# INLINE recipientId #-}
  queueRec = queueRec'
  {-# INLINE queueRec #-}
+  withQueueLock _ _ = id
+  {-# INLINE withQueueLock #-}

 instance MsgStoreClass STMMsgStore where
+  type StoreMonad STMMsgStore = STM
+  type MsgQueue STMMsgStore = STMMsgQueue
  type QueueStore STMMsgStore = STMQueueStore STMQueue
  type StoreQueue STMMsgStore = STMQueue
  type MsgStoreConfig STMMsgStore = STMStoreConfig
@@ -79,22 +78,59 @@ instance MsgStoreClass STMMsgStore where

  closeMsgStore = closeQueueStore @STMQueue . queueStore_
  {-# INLINE closeMsgStore #-}
+  withActiveMsgQueues = withLoadedQueues . queueStore_
+  {-# INLINE withActiveMsgQueues #-}
+  unsafeWithAllMsgQueues _ = withLoadedQueues . queueStore_
+  {-# INLINE unsafeWithAllMsgQueues #-}

  expireOldMessages :: Bool -> STMMsgStore -> Int64 -> Int64 -> IO MessageStats
  expireOldMessages _tty ms now ttl =
-    withLoadedQueues (queueStore_ ms) $ atomically . expireQueueMsgs (now - ttl)
+    withLoadedQueues (queueStore_ ms) $ atomically . expireQueueMsgs ms now (now - ttl)

  foldRcvServiceMessages :: STMMsgStore -> ServiceId -> (a -> RecipientId -> Either ErrorType (Maybe (QueueRec, Message)) -> IO a) -> a -> IO (Either ErrorType a)
  foldRcvServiceMessages ms serviceId f = fmap Right . foldRcvServiceQueues (queueStore_ ms) serviceId f'
    where
      f' a (q, qr) = runExceptT (tryPeekMsg ms q) >>= f a (recipientId q) . ((qr,) <$$>)

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

-  mkQueue _ rId qr = STMQueue rId <$> newTVarIO (Just qr) <*> newTVarIO Nothing
+  loadedQueueCounts :: STMMsgStore -> IO LoadedQueueCounts
+  loadedQueueCounts STMMsgStore {queueStore_ = st} = do
+    loadedQueueCount <- M.size <$> readTVarIO (queues st)
+    loadedNotifierCount <- M.size <$> readTVarIO (notifiers st)
+    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, openJournalCount = 0, queueLockCount = 0, notifierLockCount = 0}
+
+  mkQueue _ _ rId qr = STMQueue rId <$> newTVarIO (Just qr) <*> newTVarIO Nothing
  {-# INLINE mkQueue #-}

+  getMsgQueue :: STMMsgStore -> STMQueue -> Bool -> STM STMMsgQueue
+  getMsgQueue _ STMQueue {msgQueue'} _ = readTVar msgQueue' >>= maybe newQ pure
+    where
+      newQ = do
+        msgTQueue <- newTQueue
+        canWrite <- newTVar True
+        size <- newTVar 0
+        let q = STMMsgQueue {msgTQueue, canWrite, size}
+        writeTVar msgQueue' (Just q)
+        pure q
+
+  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 -> 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 -> STMQueue -> IO (Either ErrorType QueueRec)
  deleteQueue ms q = fst <$$> deleteQueue_ ms q

@@ -104,9 +140,17 @@ instance MsgStoreClass STMMsgStore where
    where
      getSize = maybe (pure 0) (\STMMsgQueue {size} -> readTVarIO size)

+  getQueueMessages_ :: Bool -> STMQueue -> STMMsgQueue -> STM [Message]
+  getQueueMessages_ drainMsgs _ = (if drainMsgs then flushTQueue else snapshotTQueue) . msgTQueue
+    where
+      snapshotTQueue q = do
+        msgs <- flushTQueue q
+        mapM_ (writeTQueue q) msgs
+        pure msgs
+
  writeMsg :: STMMsgStore -> STMQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
  writeMsg ms q' _logState msg = liftIO $ atomically $ do
-    STMMsgQueue {msgTQueue = q, canWrite, size} <- getMsgQueue q'
+    STMMsgQueue {msgTQueue = q, canWrite, size} <- getMsgQueue ms q' True
    canWrt <- readTVar canWrite
    empty <- isEmptyTQueue q
    if canWrt || empty
@@ -122,109 +166,29 @@ instance MsgStoreClass STMMsgStore where
      STMMsgStore {storeConfig = STMStoreConfig {quota}} = ms
      msgQuota = MessageQuota {msgId = messageId msg, msgTs = messageTs msg}

-  tryPeekMsg :: STMMsgStore -> STMQueue -> ExceptT ErrorType IO (Maybe Message)
-  tryPeekMsg _ q = snd <$$> withPeekMsgQueue q pure
-  {-# INLINE tryPeekMsg #-}
+  setOverQuota_ :: STMQueue -> IO ()
+  setOverQuota_ q = readTVarIO (msgQueue' q) >>= mapM_ (\mq -> atomically $ writeTVar (canWrite mq) False)

-  tryPeekMsgs :: STMMsgStore -> [STMQueue] -> ExceptT ErrorType IO (M.Map RecipientId Message)
-  tryPeekMsgs st qs = M.fromList . catMaybes <$> mapM (\q -> (recipientId q,) <$$> tryPeekMsg st q) qs
+  getQueueSize_ :: STMMsgQueue -> STM Int
+  getQueueSize_ STMMsgQueue {size} = readTVar size

-  tryDelMsg :: STMMsgStore -> STMQueue -> MsgId -> ExceptT ErrorType IO (Maybe Message)
-  tryDelMsg _ q msgId' =
-    withPeekMsgQueue q $
-      maybe (pure Nothing) $ \(mq, msg) ->
-        if messageId msg == msgId'
-          then tryDeleteMsg_ mq $> Just msg
-          else pure Nothing
+  tryPeekMsg_ :: STMQueue -> STMMsgQueue -> STM (Maybe Message)
+  tryPeekMsg_ _ = tryPeekTQueue . msgTQueue
+  {-# INLINE tryPeekMsg_ #-}

-  tryDelPeekMsg :: STMMsgStore -> STMQueue -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
-  tryDelPeekMsg _ q msgId' =
-    withPeekMsgQueue q $
-      maybe (pure (Nothing, Nothing)) $ \(mq, msg) ->
-        if messageId msg == msgId'
-          then (Just msg,) <$> (tryDeleteMsg_ mq >> tryPeekMsg_ mq)
-          else pure (Nothing, Just msg)
+  tryDeleteMsg_ :: STMQueue -> STMMsgQueue -> Bool -> STM ()
+  tryDeleteMsg_ _ STMMsgQueue {msgTQueue = q, size} _logState =
+    tryReadTQueue q >>= \case
+      Just _ -> modifyTVar' size (subtract 1)
+      _ -> pure ()

-  deleteExpiredMsgs :: STMMsgStore -> STMQueue -> Int64 -> ExceptT ErrorType IO Int
-  deleteExpiredMsgs _ q old = liftIO $ atomically $ getMsgQueue q >>= deleteExpireMsgs_ old
+  isolateQueue :: STMMsgStore -> STMQueue -> Text -> STM a -> ExceptT ErrorType IO a
+  isolateQueue _ _ _ = liftIO . atomically
+  {-# INLINE isolateQueue #-}

-  getQueueSize :: STMMsgStore -> STMQueue -> ExceptT ErrorType IO Int
-  getQueueSize _ q = withPeekMsgQueue q $ maybe (pure 0) (getQueueSize_ . fst)
-  {-# INLINE getQueueSize #-}
-
-loadedQueueCounts :: STMMsgStore -> IO LoadedQueueCounts
-loadedQueueCounts STMMsgStore {queueStore_ = st} = do
-  loadedQueueCount <- M.size <$> readTVarIO (queues st)
-  loadedNotifierCount <- M.size <$> readTVarIO (notifiers st)
-  pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount}
-
-getMsgQueue :: STMQueue -> STM STMMsgQueue
-getMsgQueue STMQueue {msgQueue'} = readTVar msgQueue' >>= maybe newQ pure
-  where
-    newQ = do
-      msgTQueue <- newTQueue
-      canWrite <- newTVar True
-      size <- newTVar 0
-      let q = STMMsgQueue {msgTQueue, canWrite, size}
-      writeTVar msgQueue' (Just q)
-      pure q
-
-- The action is called with Nothing when it is known that the queue is empty
-withPeekMsgQueue :: STMQueue -> (Maybe (STMMsgQueue, Message) -> STM a) -> ExceptT ErrorType IO a
-withPeekMsgQueue STMQueue {msgQueue'} a =
-  liftIO $ atomically $ (readTVar msgQueue' $>>= \mq -> (mq,) <$$> tryPeekMsg_ mq) >>= a
-
-getQueueMessages :: Bool -> STMQueue -> IO [Message]
-getQueueMessages drainMsgs q = atomically $ (if drainMsgs then flushTQueue else snapshotTQueue) . msgTQueue =<< getMsgQueue q
-  where
-    snapshotTQueue mq = do
-      msgs <- flushTQueue mq
-      mapM_ (writeTQueue mq) msgs
-      pure msgs
-
-- can ONLY be used while restoring messages, not while server running
-setOverQuota_ :: STMQueue -> IO ()
-setOverQuota_ q = readTVarIO (msgQueue' q) >>= mapM_ (\mq -> atomically $ writeTVar (canWrite mq) False)
-
-- if the first message in queue head is "quota", remove it
-deleteQuotaMsg :: STMQueue -> ExceptT ErrorType IO ()
-deleteQuotaMsg q =
-  withPeekMsgQueue q $ \case
-    Just (mq, MessageQuota {}) -> tryDeleteMsg_ mq
-    _ -> pure ()
-
-expireQueueMsgs :: Int64 -> STMQueue -> STM MessageStats
-expireQueueMsgs old STMQueue {msgQueue'} =
-  readTVar msgQueue' >>= \case
-    Just mq -> do
-      expiredMsgsCount <- deleteExpireMsgs_ old mq
-      storedMsgsCount <- getQueueSize_ mq
-      pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
-    -- does not create queue if it does not exist
-    Nothing -> pure newMessageStats {storedQueues = 1}
-
-deleteExpireMsgs_ :: Int64 -> STMMsgQueue -> STM Int
-deleteExpireMsgs_ old mq = loop 0
-  where
-    loop dc =
-      tryPeekMsg_ mq >>= \case
-        Just Message {msgTs}
-          | systemSeconds msgTs < old ->
-              tryDeleteMsg_ mq >> loop (dc + 1)
-        _ -> pure dc
-
-getQueueSize_ :: STMMsgQueue -> STM Int
-getQueueSize_ STMMsgQueue {size} = readTVar size
-
-tryPeekMsg_ :: STMMsgQueue -> STM (Maybe Message)
-tryPeekMsg_ = tryPeekTQueue . msgTQueue
-{-# INLINE tryPeekMsg_ #-}
-
-tryDeleteMsg_ :: STMMsgQueue -> STM ()
-tryDeleteMsg_ STMMsgQueue {msgTQueue = q, size} =
-  tryReadTQueue q >>= \case
-    Just _ -> modifyTVar' size (subtract 1)
-    _ -> pure ()
+  unsafeRunStore :: STMQueue -> Text -> STM a -> IO a
+  unsafeRunStore _ _ = atomically
+  {-# INLINE unsafeRunStore #-}

 deleteQueue_ :: STMMsgStore -> STMQueue -> IO (Either ErrorType (QueueRec, Maybe STMMsgQueue))
 deleteQueue_ ms q = deleteStoreQueue (queueStore_ ms) q >>= mapM remove
@@ -4,12 +4,17 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Redundant multi-way if" #-}
+
 module Simplex.Messaging.Server.MsgStore.Types
  ( MsgStoreClass (..),
    MSType (..),
@@ -25,49 +30,107 @@ module Simplex.Messaging.Server.MsgStore.Types
    getQueues,
    getQueueRecs,
    readQueueRec,
+    withPeekMsgQueue,
+    expireQueueMsgs,
+    deleteExpireMsgs_,
  ) where

 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Trans.Except
+import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Kind
 import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Maybe (catMaybes, fromMaybe)
+import Data.Text (Text)
+import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.Types
-import Simplex.Messaging.Util (($>>=))
+import Simplex.Messaging.Util ((<$$>), ($>>=))

-class QueueStoreClass (StoreQueue s) (QueueStore s) => MsgStoreClass s where
+class (Monad (StoreMonad s), QueueStoreClass (StoreQueue s) (QueueStore s)) => MsgStoreClass s where
+  type StoreMonad s = (m :: Type -> Type) | m -> s
  type MsgStoreConfig s = c | c -> s
+  type MsgQueue s = q | q -> s
  type StoreQueue s = q | q -> s
  type QueueStore s = qs | qs -> s
  newMsgStore :: MsgStoreConfig s -> IO s
  closeMsgStore :: s -> IO ()
+  withActiveMsgQueues :: Monoid a => s -> (StoreQueue s -> IO a) -> IO a
+  -- This function can only be used in server CLI commands or before server is started.
+  -- tty, store
+  unsafeWithAllMsgQueues :: Monoid a => Bool -> s -> (StoreQueue s -> IO a) -> IO a
  -- tty, store, now, ttl
  expireOldMessages :: Bool -> s -> Int64 -> Int64 -> IO MessageStats
  foldRcvServiceMessages :: s -> ServiceId -> (a -> RecipientId -> Either ErrorType (Maybe (QueueRec, Message)) -> IO a) -> a -> IO (Either ErrorType a)
+  logQueueStates :: s -> IO ()
+  logQueueState :: StoreQueue s -> StoreMonad s ()
  queueStore :: s -> QueueStore s
+  loadedQueueCounts :: s -> IO LoadedQueueCounts

  -- message store methods
-  mkQueue :: s -> RecipientId -> QueueRec -> IO (StoreQueue s)
+  mkQueue :: s -> Bool -> RecipientId -> QueueRec -> IO (StoreQueue s)
+  getMsgQueue :: s -> StoreQueue s -> Bool -> StoreMonad s (MsgQueue s)
+  getPeekMsgQueue :: s -> StoreQueue s -> StoreMonad s (Maybe (MsgQueue s, Message))
+
+  -- the journal queue will be closed after action if it was initially closed or idle longer than interval in config
+  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 :: s -> StoreQueue s -> Text -> StoreMonad s a -> ExceptT ErrorType IO a
+  unsafeRunStore :: StoreQueue s -> Text -> StoreMonad s a -> IO a
+
+  -- default implementations are overridden for PostgreSQL storage of messages
  tryPeekMsg :: s -> StoreQueue s -> ExceptT ErrorType IO (Maybe Message)
+  tryPeekMsg st q = snd <$$> withPeekMsgQueue st q "tryPeekMsg" pure
+  {-# INLINE tryPeekMsg #-}
+  
  tryPeekMsgs :: s -> [StoreQueue s] -> ExceptT ErrorType IO (Map RecipientId Message)
+  tryPeekMsgs st qs = M.fromList . catMaybes <$> mapM (\q -> (recipientId q,) <$$> tryPeekMsg st q) qs
+
  tryDelMsg :: 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' ->
+              tryDeleteMsg_ q mq True $> Just msg
+          | otherwise -> pure Nothing
+
  -- atomic delete (== read) last and peek next message if available
  tryDelPeekMsg :: s -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
-  deleteExpiredMsgs :: s -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
-  getQueueSize :: s -> StoreQueue s -> ExceptT ErrorType IO Int
+  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)

-data MSType = MSMemory | MSPostgres
+  deleteExpiredMsgs :: s -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
+  deleteExpiredMsgs st q old =
+    isolateQueue st q "deleteExpiredMsgs" $
+      getMsgQueue st q False >>= deleteExpireMsgs_ old q
+
+  getQueueSize :: s -> StoreQueue s -> ExceptT ErrorType IO Int
+  getQueueSize st q = withPeekMsgQueue st q "getQueueSize" $ maybe (pure 0) (getQueueSize_ . fst)
+  {-# INLINE getQueueSize #-}
+
+data MSType = MSMemory | MSJournal | MSPostgres

 data QSType = QSMemory | QSPostgres

 data SMSType :: MSType -> Type where
  SMSMemory :: SMSType 'MSMemory
+  SMSJournal :: SMSType 'MSJournal
  SMSPostgres :: SMSType 'MSPostgres

 data SQSType :: QSType -> Type where
@@ -91,14 +154,17 @@ instance Semigroup MessageStats where

 data LoadedQueueCounts = LoadedQueueCounts
  { loadedQueueCount :: Int,
-    loadedNotifierCount :: Int
+    loadedNotifierCount :: Int,
+    openJournalCount :: Int,
+    queueLockCount :: Int,
+    notifierLockCount :: Int
  }

 newMessageStats :: MessageStats
 newMessageStats = MessageStats 0 0 0

 addQueue :: MsgStoreClass s => s -> RecipientId -> QueueRec -> IO (Either ErrorType (StoreQueue s))
-addQueue st = addQueue_ (queueStore st) (mkQueue st)
+addQueue st = addQueue_ (queueStore st) (mkQueue st True)
 {-# INLINE addQueue #-}

 getQueue :: (MsgStoreClass s, QueueParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
@@ -118,3 +184,28 @@ getQueueRecs st party qIds = getQueues st party qIds >>= mapM (fmap join . mapM
 readQueueRec :: StoreQueueClass q => q -> IO (Either ErrorType (q, QueueRec))
 readQueueRec q = maybe (Left AUTH) (Right . (q,)) <$> readTVarIO (queueRec q)
 {-# INLINE readQueueRec #-}
+
+-- The action is called with Nothing when it is known that the queue is empty
+withPeekMsgQueue :: MsgStoreClass s => s -> StoreQueue s -> Text -> (Maybe (MsgQueue s, Message) -> StoreMonad s a) -> ExceptT ErrorType IO a
+withPeekMsgQueue st q op a = isolateQueue st q op $ getPeekMsgQueue st q >>= a
+{-# INLINE withPeekMsgQueue #-}
+
+-- not used with PostgreSQL message store
+expireQueueMsgs :: MsgStoreClass s => s -> Int64 -> Int64 -> StoreQueue s -> StoreMonad s MessageStats
+expireQueueMsgs st now old q = do
+  (expired_, stored) <- withIdleMsgQueue now st q $ deleteExpireMsgs_ old q
+  pure MessageStats {storedMsgsCount = stored, expiredMsgsCount = fromMaybe 0 expired_, storedQueues = 1}
+
+-- not used with PostgreSQL message store
+deleteExpireMsgs_ :: MsgStoreClass s => Int64 -> StoreQueue s -> MsgQueue s -> StoreMonad s Int
+deleteExpireMsgs_ old q mq = do
+  n <- loop 0
+  logQueueState q
+  pure n
+  where
+    loop dc =
+      tryPeekMsg_ q mq >>= \case
+        Just Message {msgTs}
+          | systemSeconds msgTs < old ->
+              tryDeleteMsg_ q mq False >> loop (dc + 1)
+        _ -> pure dc
@@ -46,7 +46,7 @@ data RealTimeMetrics = RealTimeMetrics
    deliveredTimes :: TimeBuckets,
    smpSubs :: RTSubscriberMetrics,
    ntfSubs :: RTSubscriberMetrics,
-    loadedCounts :: Maybe LoadedQueueCounts
+    loadedCounts :: LoadedQueueCounts
  }

 data RTSubscriberMetrics = RTSubscriberMetrics
@@ -126,6 +126,7 @@ prometheusMetrics sm rtm ts =
        _ntfServices,
        _rcvServicesSubMsg,
        _rcvServicesSubDuplicate,
+        _authDelayExceeded,
        _qCount,
        _msgCount,
        _ntfCount,
@@ -192,6 +193,10 @@ prometheusMetrics sm rtm ts =
      \# HELP simplex_smp_queues_notify_monthly Monthly active queues with notifications.\n\
      \# TYPE simplex_smp_queues_notify_monthly gauge\n\
      \simplex_smp_queues_notify_monthly " <> mstr (monthCount psNtf) <> "\n# monthCountNtf\n\
+      \\n\
+      \# HELP simplex_smp_auth_delay_exceeded Responses with AUTH errors sent without delay, as processing took longer than the delay.\n\
+      \# TYPE simplex_smp_auth_delay_exceeded counter\n\
+      \simplex_smp_auth_delay_exceeded " <> mshow _authDelayExceeded <> "\n# authDelayExceeded\n\
      \\n"
    subscriptions =
      "# Subscriptions\n\
@@ -562,17 +567,27 @@ prometheusMetrics sm rtm ts =
      \\n\
      \# HELP simplex_smp_subscription_ntf_service_subs_total Total queues subscribed via NTF services\n\
      \# TYPE simplex_smp_subscription_ntf_service_subs_total gauge\n\
-      \simplex_smp_subscription_ntf_service_subs_total " <> mshow (subServiceSubsCount ntfSubs) <> "\n# ntf.subServiceSubsCount\n"
-      <> maybe "" loadedQueues loadedCounts
-    loadedQueues LoadedQueueCounts {loadedQueueCount, loadedNotifierCount} =
-      "\n\
-      \# HELP simplex_smp_loaded_queues_queue_count Total loaded queues count (all queues for memory storage)\n\
-      \# TYPE simplex_smp_loaded_queues_queue_count gauge\n\
-      \simplex_smp_loaded_queues_queue_count " <> mshow loadedQueueCount <> "\n# loadedCounts.loadedQueueCount\n\
+      \simplex_smp_subscription_ntf_service_subs_total " <> mshow (subServiceSubsCount ntfSubs) <> "\n# ntf.subServiceSubsCount\n\
      \\n\
-      \# HELP simplex_smp_loaded_queues_ntf_count Total loaded ntf credential references (all ntf credentials for memory storage)\n\
+      \# HELP simplex_smp_loaded_queues_queue_count Total loaded queues count (all queues for memory/journal storage)\n\
+      \# TYPE simplex_smp_loaded_queues_queue_count gauge\n\
+      \simplex_smp_loaded_queues_queue_count " <> mshow (loadedQueueCount loadedCounts) <> "\n# loadedCounts.loadedQueueCount\n\
+      \\n\
+      \# HELP simplex_smp_loaded_queues_ntf_count Total loaded ntf credential references (all ntf credentials for memory/journal storage)\n\
      \# TYPE simplex_smp_loaded_queues_ntf_count gauge\n\
-      \simplex_smp_loaded_queues_ntf_count " <> mshow loadedNotifierCount <> "\n# loadedCounts.loadedNotifierCount\n"
+      \simplex_smp_loaded_queues_ntf_count " <> mshow (loadedNotifierCount loadedCounts) <> "\n# loadedCounts.loadedNotifierCount\n\
+      \\n\
+      \# HELP simplex_smp_loaded_queues_open_journal_count Total opened queue journals (0 for memory storage)\n\
+      \# TYPE simplex_smp_loaded_queues_open_journal_count gauge\n\
+      \simplex_smp_loaded_queues_open_journal_count " <> mshow (openJournalCount loadedCounts) <> "\n# loadedCounts.openJournalCount\n\
+      \\n\
+      \# HELP simplex_smp_loaded_queues_queue_lock_count Total queue locks (0 for memory storage)\n\
+      \# TYPE simplex_smp_loaded_queues_queue_lock_count gauge\n\
+      \simplex_smp_loaded_queues_queue_lock_count " <> mshow (queueLockCount loadedCounts) <> "\n# loadedCounts.queueLockCount\n\
+      \\n\
+      \# HELP simplex_smp_loaded_queues_ntf_lock_count Total notifier locks (0 for memory/journal storage)\n\
+      \# TYPE simplex_smp_loaded_queues_ntf_lock_count gauge\n\
+      \simplex_smp_loaded_queues_ntf_lock_count " <> mshow (notifierLockCount loadedCounts) <> "\n# loadedCounts.notifierLockCount\n"

    showTimeBuckets :: Text -> IM.IntMap Int -> Text
    showTimeBuckets metric = T.concat . snd . mapAccumL accumBucket (0, 0) . IM.assocs
@@ -24,7 +24,9 @@ module Simplex.Messaging.Server.QueueStore.Postgres
    batchInsertServices,
    batchInsertQueues,
    foldServiceRecs,
+    foldRcvServiceQueueRecs,
    foldQueueRecs,
+    foldRecentQueueRecs,
    handleDuplicate,
    rowToQueueRec,
    withLog_,
@@ -41,12 +43,13 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
+import Data.Bifunctor (first)
 import Data.ByteString.Builder (Builder)
 import qualified Data.ByteString.Builder as BB
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy as LB
 import Data.Bitraversable (bimapM)
-import Data.Either (fromRight)
+import Data.Either (fromRight, lefts)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (foldl', intersperse, partition)
@@ -88,7 +91,7 @@ import Simplex.Messaging.SystemTime
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPServiceRole (..))
-import Simplex.Messaging.Util (eitherToMaybe, firstRow, maybeFirstRow, maybeFirstRow', tshow, (<$$>), ($>>=))
+import Simplex.Messaging.Util (eitherToMaybe, firstRow, ifM, maybeFirstRow, maybeFirstRow', tshow, (<$$>), ($>>=))
 import System.Exit (exitFailure)
 import System.IO (IOMode (..), hFlush, stdout)
 import UnliftIO.STM
@@ -100,19 +103,35 @@ import Simplex.Messaging.Encoding.String
 data PostgresQueueStore q = PostgresQueueStore
  { dbStore :: DBStore,
    dbStoreLog :: Maybe (StoreLog 'WriteMode),
+    -- this map caches all created and opened queues
+    queues :: TMap RecipientId q,
+    -- this map only cashes the queues that were attempted to send messages to,
+    senders :: TMap SenderId RecipientId,
+    links :: TMap LinkId RecipientId,
+    -- this map only cashes the queues that were attempted to be subscribed to,
+    notifiers :: TMap NotifierId RecipientId,
+    notifierLocks :: TMap NotifierId Lock,
    serviceLocks :: TMap CertFingerprint Lock,
-    deletedTTL :: Int64
+    deletedTTL :: Int64,
+    useCache :: Bool
  }

-instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
-  type QueueStoreCfg (PostgresQueueStore q) = PostgresStoreCfg
+type UseQueueCache = Bool

-  newQueueStore :: PostgresStoreCfg -> IO (PostgresQueueStore q)
-  newQueueStore PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations, deletedTTL} = do
+instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
+  type QueueStoreCfg (PostgresQueueStore q) = (PostgresStoreCfg, UseQueueCache)
+
+  newQueueStore :: (PostgresStoreCfg, UseQueueCache)  -> IO (PostgresQueueStore q)
+  newQueueStore (PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations, deletedTTL}, useCache) = do
    dbStore <- either err pure =<< createDBStore dbOpts serverMigrations (MigrationConfig confirmMigrations Nothing)
    dbStoreLog <- mapM (openWriteStoreLog True) dbStoreLogPath
+    queues <- TM.emptyIO
+    senders <- TM.emptyIO
+    links <- TM.emptyIO
+    notifiers <- TM.emptyIO
+    notifierLocks <- TM.emptyIO
    serviceLocks <- TM.emptyIO
-    pure PostgresQueueStore {dbStore, dbStoreLog, serviceLocks, deletedTTL}
+    pure PostgresQueueStore {dbStore, dbStoreLog, queues, senders, links, notifiers, notifierLocks, serviceLocks, deletedTTL, useCache}
    where
      err e = do
        logError $ "STORE: newQueueStore, error opening PostgreSQL database, " <> tshow e
@@ -123,6 +142,9 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
    closeDBStore dbStore
    mapM_ closeStoreLog dbStoreLog

+  loadedQueues = queues
+  {-# INLINE loadedQueues #-}
+
  compactQueues :: PostgresQueueStore q -> IO Int64
  compactQueues st@PostgresQueueStore {deletedTTL} = do
    old <- subtract deletedTTL . systemSeconds <$> liftIO getSystemTime
@@ -148,45 +170,136 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
          (SRMessaging, SRNotifier)
      pure EntityCounts {queueCount, notifierCount, rcvServiceCount, ntfServiceCount, rcvServiceQueuesCount, ntfServiceQueuesCount}

-  -- this implementation relies on unique constraints in the database to prevent duplicate IDs.
+  -- this implementation assumes that the lock is already taken by addQueue
+  -- and relies on unique constraints in the database to prevent duplicate IDs.
  addQueue_ :: PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> RecipientId -> QueueRec -> IO (Either ErrorType q)
  addQueue_ st mkQ rId qr = do
    sq <- mkQ rId qr
-    E.uninterruptibleMask_ $ runExceptT $ do
+    withQueueLock sq "addQueue_" $ E.uninterruptibleMask_ $ runExceptT $ do
      void $ withDB "addQueue_" st $ \db ->
        E.try (DB.execute db insertQueueQuery $ queueRecToRow (rId, qr))
          >>= bimapM handleDuplicate pure
+      when useCache $ do
+        atomically $ TM.insert rId sq queues
+        atomically $ TM.insert (senderId qr) rId senders
+        forM_ (notifier qr) $ \NtfCreds {notifierId = nId} -> atomically $ TM.insert nId rId notifiers
+        forM_ (queueData qr) $ \(lnkId, _) -> atomically $ TM.insert lnkId rId links
      withLog "addStoreQueue" st $ \s -> logCreateQueue s rId qr
      pure sq
-
-  getQueue_ :: QueueParty p => PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
-  getQueue_ st mkQ party qId = case party of
-    SRecipient -> loadQueue " WHERE recipient_id = ?"
-    SSender -> loadQueue " WHERE sender_id = ?"
-    SSenderLink -> loadQueue " WHERE link_id = ?"
-    SNotifier -> loadQueue " WHERE notifier_id = ?"
    where
-      loadQueue condition = E.uninterruptibleMask_ $ runExceptT $ do
-        (rId, qRec) <- withDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
-          DB.query db (queueRecQuery <> condition <> " AND deleted_at IS NULL") (Only qId)
-        liftIO $ mkQ rId qRec
+      PostgresQueueStore {queues, senders, links, notifiers, useCache} = st
+      -- Not doing duplicate checks in maps as the probability of duplicates is very low.
+      -- It needs to be reconsidered when IDs are supplied by the users.
+      -- hasId = anyM [TM.memberIO rId queues, TM.memberIO senderId senders, hasNotifier]
+      -- hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.memberIO notifierId notifiers) notifier

-  getQueues_ :: forall p. BatchParty p => PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueue_ :: QueueParty p => PostgresQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueue_ st mkQ party qId
+    | useCache = case party of
+        SRecipient -> getRcvQueue qId
+        SSender -> TM.lookupIO qId senders >>= maybe (mask loadSndQueue) getRcvQueue
+        SSenderLink -> TM.lookupIO qId links >>= maybe (mask loadLinkQueue) getRcvQueue
+        -- loaded queue is deleted from notifiers map to reduce cache size after queue was subscribed to by ntf server
+        SNotifier -> TM.lookupIO qId notifiers >>= maybe (mask loadNtfQueue) (getRcvQueue >=> (atomically (TM.delete qId notifiers) $>))
+    | otherwise = case party of
+        SRecipient -> loadQueueNoCache " WHERE recipient_id = ?"
+        SSender -> loadQueueNoCache " WHERE sender_id = ?"
+        SSenderLink -> loadQueueNoCache " WHERE link_id = ?"
+        SNotifier -> loadQueueNoCache " WHERE notifier_id = ?"
+    where
+      PostgresQueueStore {queues, senders, links, notifiers, useCache} = st
+      getRcvQueue rId = TM.lookupIO rId queues >>= maybe (mask loadRcvQueue) (pure . Right)
+      loadRcvQueue = do
+        (rId, qRec) <- loadQueue " WHERE recipient_id = ?"
+        liftIO $ cacheQueue rId qRec $ \_ -> pure () -- recipient map already checked, not caching sender ref
+      loadSndQueue = loadSndQueue_ " WHERE sender_id = ?"
+      loadLinkQueue = loadSndQueue_ " WHERE link_id = ?"
+      loadNtfQueue = do
+        (rId, qRec) <- loadQueue " WHERE notifier_id = ?"
+        liftIO $
+          TM.lookupIO rId queues -- checking recipient map first, not creating lock in map, not caching queue
+            >>= maybe (mkQ False rId qRec) pure
+      loadSndQueue_ condition = do
+        (rId, qRec) <- loadQueue condition
+        liftIO $
+          TM.lookupIO rId queues -- checking recipient map first
+            >>= maybe (cacheQueue rId qRec cacheSender) (atomically (cacheSender rId) $>)
+      loadQueueNoCache cond = mask $ loadQueue cond >>= liftIO . uncurry (mkQ True)
+      mask = E.uninterruptibleMask_ . runExceptT
+      cacheSender rId = TM.insert qId rId senders
+      loadQueue condition =
+        withDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
+          DB.query db (queueRecQuery <> condition <> " AND deleted_at IS NULL") (Only qId)
+      cacheQueue rId qRec insertRef = do
+        sq <- mkQ True rId qRec -- loaded queue
+        -- This lock prevents the scenario when the queue is added to cache,
+        -- while another thread is proccessing the same queue in withAllMsgQueues
+        -- without adding it to cache, possibly trying to open the same files twice.
+        -- Alse see comment in idleDeleteExpiredMsgs.
+        withQueueLock sq "getQueue_" $ atomically $
+          -- checking the cache again for concurrent reads,
+          -- use previously loaded queue if exists.
+          TM.lookup rId queues >>= \case
+            Just sq' -> pure sq'
+            Nothing -> do
+              insertRef rId
+              TM.insert rId sq queues
+              pure sq
+
+  getQueues_ :: forall p. BatchParty p => PostgresQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
  getQueues_ st mkQ party qIds
    | null qIds = pure []
+    | useCache = case party of
+        SRecipient -> do
+          qs <- readTVarIO queues
+          let qs' = map (\qId -> get qs qId qId) qIds
+          E.uninterruptibleMask_ $ loadQueues qs' " WHERE recipient_id IN ?" cacheRcvQueue
+        SNotifier -> do
+          ns <- readTVarIO notifiers
+          qs <- readTVarIO queues
+          let qs' = map (\qId -> get ns qId qId >>= get qs qId) qIds
+          E.uninterruptibleMask_ $ loadQueues qs' " WHERE notifier_id IN ?" $ \(rId, qRec) ->
+            forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> -- it is always Just with this query
+              (nId,) <$> maybe (mkQ False rId qRec) pure (M.lookup rId qs)
    | otherwise = E.uninterruptibleMask_ $ case party of
-        SRecipient -> loadQueues " WHERE recipient_id IN ?" $ \(rId, qRec) ->
-          Just . (rId,) <$> mkQ rId qRec
-        SNotifier -> loadQueues " WHERE notifier_id IN ?" $ \(rId, qRec) ->
-          forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> (nId,) <$> mkQ rId qRec
+        SRecipient -> loadQueuesNoCache " WHERE recipient_id IN ?" $ \(rId, qRec) ->
+          Just . (rId,) <$> mkQ False rId qRec
+        SNotifier -> loadQueuesNoCache " WHERE notifier_id IN ?" $ \(rId, qRec) ->
+          forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> (nId,) <$> mkQ False rId qRec
    where
-      loadQueues :: Query -> ((RecipientId, QueueRec) -> IO (Maybe (QueueId, q))) -> IO [Either ErrorType q]
-      loadQueues cond mkQueue' = do
-        qs_ <-
-          runExceptT $ fmap M.fromList $
-            withDB' "getQueues_" st (\db -> DB.query db (queueRecQuery <> cond <> " AND deleted_at IS NULL") (Only (In qIds)))
-              >>= liftIO . fmap catMaybes . mapM (mkQueue' . rowToQueueRec)
-        pure $ map (\qId -> maybe (Left AUTH) Right . M.lookup qId =<< qs_) qIds
+      PostgresQueueStore {queues, notifiers, useCache} = st
+      get :: M.Map QueueId a -> QueueId -> QueueId -> Either QueueId a
+      get m qId = maybe (Left qId) Right . (`M.lookup` m)
+      loadQueues :: [Either QueueId q] -> Query -> ((RecipientId, QueueRec) -> IO (Maybe (QueueId, q))) -> IO [Either ErrorType q]
+      loadQueues qs' cond mkCacheQueue = do
+        let qIds' = lefts qs'
+        if null qIds'
+          then pure $ map (first (const INTERNAL)) qs'
+          else do
+            qs_ <- dbLoadQueues qIds' cond mkCacheQueue
+            pure $ map (result qs_) qs'
+        where
+          result :: Either ErrorType (M.Map QueueId q) -> Either QueueId q -> Either ErrorType q
+          result _ (Right q) = Right q
+          result qs_ (Left qId) = maybe (Left AUTH) Right . M.lookup qId =<< qs_
+      dbLoadQueues qIds' cond mkQueue' =
+        runExceptT $ fmap M.fromList $
+          withDB' "getQueues_" st (\db -> DB.query db (queueRecQuery <> cond <> " AND deleted_at IS NULL") (Only (In qIds')))
+            >>= liftIO . fmap catMaybes . mapM (mkQueue' . rowToQueueRec)
+      cacheRcvQueue (rId, qRec) = do
+        sq <- mkQ True rId qRec
+        sq' <- withQueueLock sq "getQueue_" $ atomically $
+          -- checking the cache again for concurrent reads, use previously loaded queue if exists.
+          TM.lookup rId queues >>= \case
+            Just sq' -> pure sq'
+            Nothing -> sq <$ TM.insert rId sq queues
+        pure $ Just (rId, sq')
+      loadQueuesNoCache cond mkQueue' = do
+        qs_ <- dbLoadQueues qIds cond mkQueue'
+        pure $ map (result qs_) qIds
+        where
+          result :: Either ErrorType (M.Map QueueId q) -> QueueId -> Either ErrorType q
+          result qs_ qId = maybe (Left AUTH) Right . M.lookup qId =<< qs_

  getQueueLinkData :: PostgresQueueStore q -> q -> LinkId -> IO (Either ErrorType QueueLinkData)
  getQueueLinkData st sq lnkId = runExceptT $ do
@@ -199,7 +312,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where

  addQueueLinkData :: PostgresQueueStore q -> q -> LinkId -> QueueLinkData -> IO (Either ErrorType ())
  addQueueLinkData st sq lnkId d =
-    withQueueRec sq $ \q -> case queueData q of
+    withQueueRec sq "addQueueLinkData" $ \q -> case queueData q of
      Nothing ->
        addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId, QMContact))
      Just (lnkId', _) | lnkId' == lnkId ->
@@ -216,7 +329,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where

  deleteQueueLinkData :: PostgresQueueStore q -> q -> IO (Either ErrorType ())
  deleteQueueLinkData st sq =
-    withQueueRec sq $ \q -> case queueData q of
+    withQueueRec sq "deleteQueueLinkData" $ \q -> case queueData q of
      Just _ -> do
        assertUpdated $ withDB' "deleteQueueLinkData" st $ \db ->
          DB.execute db "UPDATE msg_queues SET link_id = NULL, fixed_data = NULL, user_data = NULL WHERE recipient_id = ? AND deleted_at IS NULL" (Only rId)
@@ -228,7 +341,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where

  secureQueue :: PostgresQueueStore q -> q -> SndPublicAuthKey -> IO (Either ErrorType ())
  secureQueue st sq sKey =
-    withQueueRec sq $ \q -> do
+    withQueueRec sq "secureQueue" $ \q -> do
      verify q
      assertUpdated $ withDB' "secureQueue" st $ \db ->
        DB.execute db "UPDATE msg_queues SET sender_key = ? WHERE recipient_id = ? AND deleted_at IS NULL AND (sender_key IS NULL OR sender_key = ?)" (sKey, rId, sKey)
@@ -242,7 +355,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where

  updateKeys :: PostgresQueueStore q -> q -> NonEmpty RcvPublicAuthKey -> IO (Either ErrorType ())
  updateKeys st sq rKeys =
-    withQueueRec sq $ \q -> do
+    withQueueRec sq "updateKeys" $ \q -> do
      assertUpdated $ withDB' "updateKeys" st $ \db ->
        DB.execute db "UPDATE msg_queues SET recipient_keys = ? WHERE recipient_id = ? AND deleted_at IS NULL" (rKeys, rId)
      atomically $ writeTVar (queueRec sq) $ Just q {recipientKeys = rKeys}
@@ -252,14 +365,24 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where

  addQueueNotifier :: PostgresQueueStore q -> q -> NtfCreds -> IO (Either ErrorType (Maybe NtfCreds))
  addQueueNotifier st sq ntfCreds@NtfCreds {notifierId = nId, notifierKey, rcvNtfDhSecret} =
-    withQueueRec sq $ \q -> do
-      assertUpdated $ withDB "addQueueNotifier" st $ \db ->
-        E.try (update db) >>= bimapM handleDuplicate pure
-      let !q' = q {notifier = Just ntfCreds}
-      atomically $ writeTVar (queueRec sq) $ Just q'
-      withLog "addQueueNotifier" st $ \s -> logAddNotifier s rId ntfCreds
-      pure $ notifier q
+    withQueueRec sq "addQueueNotifier" $ \q ->
+      checkCachedNotifier $ do
+        assertUpdated $ withDB "addQueueNotifier" st $ \db ->
+          E.try (update db) >>= bimapM handleDuplicate pure
+        nc_ <- forM (notifier q) $ \nc@NtfCreds {notifierId} -> atomically (TM.delete notifierId notifiers) $> nc
+        let !q' = q {notifier = Just ntfCreds}
+        atomically $ writeTVar (queueRec sq) $ Just q'
+        when useCache $ do
+          atomically $ TM.insert nId rId notifiers
+        withLog "addQueueNotifier" st $ \s -> logAddNotifier s rId ntfCreds
+        pure nc_
    where
+      checkCachedNotifier add
+        | useCache =
+            ExceptT $ withLockMap (notifierLocks st) nId "addQueueNotifier" $
+              ifM (TM.memberIO nId notifiers) (pure $ Left DUPLICATE_) $ runExceptT add
+        | otherwise = add
+      PostgresQueueStore {notifiers, useCache} = st
      rId = recipientId sq
      update db =
        DB.execute
@@ -273,13 +396,18 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where

  deleteQueueNotifier :: PostgresQueueStore q -> q -> IO (Either ErrorType (Maybe NtfCreds))
  deleteQueueNotifier st sq =
-    withQueueRec sq $ \q ->
-      forM (notifier q) $ \nc -> do
-        assertUpdated $ withDB' "deleteQueueNotifier" st update
-        atomically $ writeTVar (queueRec sq) $ Just q {notifier = Nothing}
-        withLog "deleteQueueNotifier" st (`logDeleteNotifier` rId)
-        pure nc
+    withQueueRec sq "deleteQueueNotifier" $ \q ->
+      ExceptT $ fmap sequence $ forM (notifier q) $ \nc@NtfCreds {notifierId = nId} ->
+        withNotifierLock nId $ runExceptT $ do
+          assertUpdated $ withDB' "deleteQueueNotifier" st update
+          when (useCache st) $ atomically $ TM.delete nId $ notifiers st
+          atomically $ writeTVar (queueRec sq) $ Just q {notifier = Nothing}
+          withLog "deleteQueueNotifier" st (`logDeleteNotifier` rId)
+          pure nc
    where
+      withNotifierLock nId
+        | useCache st = withLockMap (notifierLocks st) nId "deleteQueueNotifier"
+        | otherwise = id
      rId = recipientId sq
      update db =
        DB.execute
@@ -308,7 +436,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where

  updateQueueTime :: PostgresQueueStore q -> q -> SystemDate -> IO (Either ErrorType QueueRec)
  updateQueueTime st sq t =
-    withQueueRec sq $ \q@QueueRec {updatedAt} ->
+    withQueueRec sq "updateQueueTime" $ \q@QueueRec {updatedAt} ->
      if updatedAt == Just t
        then pure q
        else do
@@ -321,6 +449,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
    where
      rId = recipientId sq

+  -- this method is called from JournalMsgStore deleteQueue that already locks the queue
  deleteStoreQueue :: PostgresQueueStore q -> q -> IO (Either ErrorType QueueRec)
  deleteStoreQueue st sq = E.uninterruptibleMask_ $ runExceptT $ do
    q <- ExceptT $ readQueueRecIO qr
@@ -328,6 +457,11 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
    assertUpdated $ withDB' "deleteStoreQueue" st $ \db ->
      DB.execute db "UPDATE msg_queues SET deleted_at = ? WHERE recipient_id = ? AND deleted_at IS NULL" (ts, rId)
    atomically $ writeTVar qr Nothing
+    when (useCache st) $ do
+      atomically $ TM.delete (senderId q) $ senders st
+      forM_ (notifier q) $ \NtfCreds {notifierId} -> do
+        atomically $ TM.delete notifierId $ notifiers st
+        atomically $ TM.delete notifierId $ notifierLocks st
    withLog "deleteStoreQueue" st (`logDeleteQueue` rId)
    pure q
    where
@@ -350,7 +484,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
      pure serviceId

  setQueueService :: (PartyI p, ServiceParty p) => PostgresQueueStore q -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
-  setQueueService st sq party serviceId = withQueueRec sq $ \q -> case party of
+  setQueueService st sq party serviceId = withQueueRec sq "setQueueService" $ \q -> case party of
    SRecipientService
      | rcvServiceId q == serviceId -> pure ()
      | otherwise -> do
@@ -475,8 +609,33 @@ foldServiceRecs st f =
    DB.fold_ db "SELECT service_id, service_role, service_cert, service_cert_hash, created_at FROM services" mempty $
      \ !acc -> fmap (acc <>) . f . rowToServiceRec

+foldRcvServiceQueueRecs :: PostgresQueueStore q -> ServiceId -> (a -> (RecipientId, QueueRec) -> IO a) -> a -> IO (Either ErrorType a)
+foldRcvServiceQueueRecs st serviceId f acc =
+  runExceptT $ withDB' "foldRcvServiceQueueRecs" st $ \db ->
+    DB.fold db (queueRecQuery <> " WHERE rcv_service_id = ? AND deleted_at IS NULL") (Only serviceId) acc $ \a -> f a . rowToQueueRec
+
 foldQueueRecs :: Monoid a => Bool -> Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
-foldQueueRecs withData tty st f = do
+foldQueueRecs withData = foldQueueRecs_ foldRecs
+  where
+    foldRecs db acc f'
+      | withData = DB.fold_ db (queueRecQueryWithData <> cond) acc $ \acc' -> f' acc' . rowToQueueRecWithData
+      | otherwise = DB.fold_ db (queueRecQuery <> cond) acc $ \acc' -> f' acc' . rowToQueueRec
+    cond = " WHERE deleted_at IS NULL ORDER BY recipient_id ASC"
+
+foldRecentQueueRecs :: Monoid a => Int64 -> Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
+foldRecentQueueRecs old = foldQueueRecs_ foldRecs
+  where
+    foldRecs db acc f' = DB.fold db (queueRecQuery <> cond) (Only old) acc $ \acc' -> f' acc' . rowToQueueRec
+    cond = " WHERE deleted_at IS NULL AND updated_at > ? ORDER BY recipient_id ASC"
+
+foldQueueRecs_ ::
+  Monoid a =>
+  (DB.Connection -> (Int, a) -> ((Int, a) -> (RecipientId, QueueRec) -> IO (Int, a)) -> IO (Int, a)) ->
+  Bool ->
+  PostgresQueueStore q ->
+  ((RecipientId, QueueRec) -> IO a) ->
+  IO a
+foldQueueRecs_ foldRecs tty st f = do
  (n, r) <- withTransaction (dbStore st) $ \db ->
    foldRecs db (0 :: Int, mempty) $ \(i, acc) qr -> do
      r <- f qr
@@ -487,10 +646,6 @@ foldQueueRecs withData tty st f = do
  when tty $ putStrLn $ progress n
  pure r
  where
-    foldRecs db acc f'
-      | withData = DB.fold_ db (queueRecQueryWithData <> cond) acc $ \acc' -> f' acc' . rowToQueueRecWithData
-      | otherwise = DB.fold_ db (queueRecQuery <> cond) acc $ \acc' -> f' acc' . rowToQueueRec
-    cond = " WHERE deleted_at IS NULL ORDER BY recipient_id ASC"
    progress i = "Processed: " <> show i <> " records"

 queueRecQuery :: Query
@@ -596,15 +751,15 @@ rowToServiceRec (serviceId, serviceRole, serviceCert, Binary fp, serviceCreatedA

 setStatusDB :: StoreQueueClass q => Text -> PostgresQueueStore q -> q -> ServerEntityStatus -> ExceptT ErrorType IO () -> IO (Either ErrorType ())
 setStatusDB op st sq status writeLog =
-  withQueueRec sq $ \q -> do
+  withQueueRec sq op $ \q -> do
    assertUpdated $ withDB' op st $ \db ->
      DB.execute db "UPDATE msg_queues SET status = ? WHERE recipient_id = ? AND deleted_at IS NULL" (status, recipientId sq)
    atomically $ writeTVar (queueRec sq) $ Just q {status}
    writeLog

-withQueueRec :: StoreQueueClass q => q -> (QueueRec -> ExceptT ErrorType IO a) -> IO (Either ErrorType a)
-withQueueRec sq action =
-  E.uninterruptibleMask_ $ runExceptT $ ExceptT (readQueueRecIO $ queueRec sq) >>= action
+withQueueRec :: StoreQueueClass q => q -> Text -> (QueueRec -> ExceptT ErrorType IO a) -> IO (Either ErrorType a)
+withQueueRec sq op action =
+  withQueueLock sq op $ E.uninterruptibleMask_ $ runExceptT $ ExceptT (readQueueRecIO $ queueRec sq) >>= action

 assertUpdated :: ExceptT ErrorType IO Int64 -> ExceptT ErrorType IO ()
 assertUpdated = (>>= \n -> when (n == 0) (throwE AUTH))
@@ -670,6 +825,10 @@ instance ToField EncDataBytes where toField (EncDataBytes s) = toField (Binary s

 deriving newtype instance FromField EncDataBytes

+instance ToField MsgId where toField = toField . Binary . unMsgId
+
+instance FromField MsgId where fromField = blobFieldDecoder mkMsgId
+
 deriving newtype instance ToField (RoundedSystemTime t)

 deriving newtype instance FromField (RoundedSystemTime t)
@@ -18,7 +18,6 @@ module Simplex.Messaging.Server.QueueStore.STM
  ( STMQueueStore (..),
    STMService (..),
    foldRcvServiceQueues,
-    withLoadedQueues,
    setStoreLog,
    withLog',
    readQueueRecIO,
@@ -92,6 +91,8 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
    atomically $ TM.clear senders
    atomically $ TM.clear notifiers

+  loadedQueues = queues
+  {-# INLINE loadedQueues #-}
  compactQueues _ = pure 0
  {-# INLINE compactQueues #-}

@@ -133,7 +134,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
      hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.member notifierId notifiers) notifier
      hasLink = maybe (pure False) (\(lnkId, _) -> TM.member lnkId links) queueData

-  getQueue_ :: QueueParty p => STMQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueue_ :: QueueParty p => STMQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
  getQueue_ st _ party qId =
    maybe (Left AUTH) Right <$> case party of
      SRecipient -> TM.lookupIO qId queues
@@ -143,7 +144,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
    where
      STMQueueStore {queues, senders, notifiers, links} = st

-  getQueues_ :: BatchParty p => STMQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueues_ :: BatchParty p => STMQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
  getQueues_ st _ party qIds = case party of
    SRecipient -> do
      qs <- readTVarIO queues
@@ -277,11 +278,9 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
    where
      rId = recipientId sq
      qr = queueRec sq
-      delete q@QueueRec {senderId, queueData, rcvServiceId} = do
+      delete q@QueueRec {senderId, rcvServiceId} = do
        writeTVar qr Nothing
-        TM.delete rId $ queues st
        TM.delete senderId $ senders st
-        forM_ queueData $ \(lnkId, _) -> TM.delete lnkId $ links st
        mapM_ (removeServiceQueue st serviceRcvQueues rId) rcvServiceId
        mapM_ (removeNotifier st) $ notifier q
        pure q
@@ -380,11 +379,6 @@ foldRcvServiceQueues st serviceId f acc =
  where
    get rId = TM.lookupIO rId (queues st) $>>= \q -> (q,) <$$> readTVarIO (queueRec q)

-withLoadedQueues :: Monoid a => STMQueueStore q -> (q -> IO a) -> IO a
-withLoadedQueues st f = readTVarIO (queues st) >>= foldM run mempty
-  where
-    run !acc = fmap (acc <>) . f
-
 withQueueRec :: TVar (Maybe QueueRec) -> (QueueRec -> STM a) -> IO (Either ErrorType a)
 withQueueRec qr a = atomically $ readQueueRec qr >>= mapM a

@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -8,29 +9,35 @@ module Simplex.Messaging.Server.QueueStore.Types
  ( StoreQueueClass (..),
    QueueStoreClass (..),
    EntityCounts (..),
+    withLoadedQueues,
  ) where

 import Control.Concurrent.STM
+import Control.Monad
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
+import Data.Text (Text)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.SystemTime
+import Simplex.Messaging.TMap (TMap)

 class StoreQueueClass q where
  recipientId :: q -> RecipientId
  queueRec :: q -> TVar (Maybe QueueRec)
+  withQueueLock :: q -> Text -> IO a -> IO a

 class StoreQueueClass q => QueueStoreClass q s where
  type QueueStoreCfg s
  newQueueStore :: QueueStoreCfg s -> IO s
  closeQueueStore :: s -> IO ()
  getEntityCounts :: s -> IO EntityCounts
+  loadedQueues :: s -> TMap RecipientId q
  compactQueues :: s -> IO Int64
  addQueue_ :: s -> (RecipientId -> QueueRec -> IO q) -> RecipientId -> QueueRec -> IO (Either ErrorType q)
-  getQueue_ :: QueueParty p => s -> (RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
-  getQueues_ :: BatchParty p => s -> (RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueue_ :: QueueParty p => s -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueues_ :: BatchParty p => s -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
  getQueueLinkData :: s -> q -> LinkId -> IO (Either ErrorType QueueLinkData)
  addQueueLinkData :: s -> q -> LinkId -> QueueLinkData -> IO (Either ErrorType ())
  deleteQueueLinkData :: s -> q -> IO (Either ErrorType ())
@@ -57,3 +64,8 @@ data EntityCounts = EntityCounts
    rcvServiceQueuesCount :: Int,
    ntfServiceQueuesCount :: Int
  }
+
+withLoadedQueues :: (Monoid a, QueueStoreClass q s) => s -> (q -> IO a) -> IO a
+withLoadedQueues st f = readTVarIO (loadedQueues st) >>= foldM run mempty
+  where
+    run !acc = fmap (acc <>) . f
@@ -128,6 +128,7 @@ data ServerStats = ServerStats
    ntfServices :: ServiceStats,
    rcvServicesSubMsg :: IORef Int,
    rcvServicesSubDuplicate :: IORef Int,
+    authDelayExceeded :: IORef Int,
    qCount :: IORef Int,
    msgCount :: IORef Int,
    ntfCount :: IORef Int,
@@ -190,6 +191,7 @@ data ServerStatsData = ServerStatsData
    _rcvServices :: ServiceStatsData,
    _rcvServicesSubMsg :: Int,
    _rcvServicesSubDuplicate :: Int,
+    _authDelayExceeded :: Int,
    _qCount :: Int,
    _msgCount :: Int,
    _ntfCount :: Int,
@@ -254,6 +256,7 @@ newServerStats ts = do
  ntfServices <- newServiceStats
  rcvServicesSubMsg <- newIORef 0
  rcvServicesSubDuplicate <- newIORef 0
+  authDelayExceeded <- newIORef 0
  qCount <- newIORef 0
  msgCount <- newIORef 0
  ntfCount <- newIORef 0
@@ -315,6 +318,7 @@ newServerStats ts = do
        ntfServices,
        rcvServicesSubMsg,
        rcvServicesSubDuplicate,
+        authDelayExceeded,
        qCount,
        msgCount,
        ntfCount,
@@ -378,6 +382,7 @@ getServerStatsData s = do
  _ntfServices <- getServiceStatsData $ ntfServices s
  _rcvServicesSubMsg <- readIORef $ rcvServicesSubMsg s
  _rcvServicesSubDuplicate <- readIORef $ rcvServicesSubDuplicate s
+  _authDelayExceeded <- readIORef $ authDelayExceeded s
  _qCount <- readIORef $ qCount s
  _msgCount <- readIORef $ msgCount s
  _ntfCount <- readIORef $ ntfCount s
@@ -439,6 +444,7 @@ getServerStatsData s = do
        _ntfServices,
        _rcvServicesSubMsg,
        _rcvServicesSubDuplicate,
+        _authDelayExceeded,
        _qCount,
        _msgCount,
        _ntfCount,
@@ -503,6 +509,7 @@ setServerStats s d = do
  setServiceStats (ntfServices s) $! _ntfServices d
  writeIORef (rcvServicesSubMsg s) $! _rcvServicesSubMsg d
  writeIORef (rcvServicesSubDuplicate s) $! _rcvServicesSubDuplicate d
+  writeIORef (authDelayExceeded s) $! _authDelayExceeded d
  writeIORef (qCount s) $! _qCount d
  writeIORef (msgCount s) $! _msgCount d
  writeIORef (ntfCount s) $! _ntfCount d
@@ -705,6 +712,7 @@ instance StrEncoding ServerStatsData where
          _ntfServices,
          _rcvServicesSubMsg = 0,
          _rcvServicesSubDuplicate = 0,
+          _authDelayExceeded = 0,
          _qCount,
          _msgCount = 0,
          _ntfCount = 0,
@@ -14,16 +14,19 @@ module Simplex.Messaging.Server.StoreLog.ReadWrite

 import Control.Concurrent.STM
 import Control.Logger.Simple
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
 import qualified Data.ByteString.Char8 as B
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ASubscriberParty (..), ErrorType, RecipientId, SParty (..))
 import Simplex.Messaging.Server.QueueStore (QueueRec, ServiceRec (..))
-import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..), STMService (..), withLoadedQueues)
+import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..), STMService (..))
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.Util (tshow, ($>>=))
+import Simplex.Messaging.Util (tshow)
 import System.IO

 writeQueueStore :: forall q. StoreQueueClass q => StoreLog 'WriteMode -> STMQueueStore q -> IO ()
@@ -65,7 +68,13 @@ readQueueStore tty mkQ f st = readLogLines tty f $ \_ -> processLine
        printError :: String -> IO ()
        printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s
        withQueue :: forall a. RecipientId -> T.Text -> (q -> IO (Either ErrorType a)) -> IO ()
-        withQueue qId op a = (getQueue_ st mkQ SRecipient qId $>>= a) >>= qError qId op
+        withQueue qId op a = runExceptT go >>= qError qId op
+          where
+            go = do
+              q <- ExceptT $ getQueue_ st (\_ -> mkQ) SRecipient qId
+              liftIO (readTVarIO $ queueRec q) >>= \case
+                Nothing -> logWarn $ logPfx qId op <> "already deleted"
+                Just _ -> void $ ExceptT $ a q
        qError qId op = \case
          Left e -> logError $ logPfx qId op <> tshow e
          Right _ -> pure ()
@@ -92,7 +92,7 @@ import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), Env (..), InitialAg
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, REQ, SENT)
 import qualified Simplex.Messaging.Agent.Protocol as A
 import Simplex.Messaging.Agent.Store (Connection' (..), SomeConn' (..), StoredRcvQueue (..))
-import Simplex.Messaging.Agent.Store.AgentStore (deleteRatchetKeyHashesExpired, getConn, getRatchetX3dhKeys)
+import Simplex.Messaging.Agent.Store.AgentStore (deleteRatchetKeyHashesExpired, getConn, getConnIds, getRatchetX3dhKeys)
 import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction)
 import Simplex.Messaging.Agent.Store.Interface
 import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -133,7 +133,9 @@ import Simplex.Messaging.Agent.Store.AgentStore (deleteClientService, getSubscri
 import qualified Database.PostgreSQL.Simple as PSQL
 import qualified Simplex.Messaging.Agent.Store.Postgres as Postgres
 import qualified Simplex.Messaging.Agent.Store.Postgres.Common as Postgres
+import Simplex.Messaging.Server.MsgStore.Journal (JournalQueue)
 import Simplex.Messaging.Server.MsgStore.Postgres (PostgresQueue)
+import Simplex.Messaging.Server.MsgStore.Types (QSType (..))
 import Simplex.Messaging.Server.QueueStore.Postgres
 import Simplex.Messaging.Server.QueueStore.Postgres.Migrations
 import Simplex.Messaging.Server.QueueStore.Types (QueueStoreClass (..))
@@ -369,6 +371,10 @@ functionalAPITests ps = do
      testAddDRViaSetConnShortLink ps
    it "should resume DR accept after a transient failure (reuse the send queue and ratchet)" $
      testAcceptContactDRResumeAfterOffline ps
+    it "should store the ratchet when DR accept is prepared" $
+      withSmpServer ps $ testAcceptContactDRPrepared False
+    it "should create the ratchet at DR accept when the prepared connection has none" $
+      withSmpServer ps $ testAcceptContactDRPrepared True
    it "should support rejecting contact request" $
      withSmpServer ps testRejectContactRequest
    it "should communicate rejection reason via double ratchet" $
@@ -419,6 +425,10 @@ functionalAPITests ps = do
      it "should connect via added contact short link after restart" $ testAddContactShortLinkRestart ps
    it "should create and get short links with the old contact queues" $ testOldContactQueueShortLink ps
    it "should connect via prepared connection link" $ testPrepareCreateConnectionLink ps
+    it "should connect via prepared invitation link" $ testPrepareCreateInvitationLink ps
+    it "should not create connection for prepared invitation link with too large data" $ testPrepareInvitationLinkTooLarge ps
+    it "should not create connection for prepared contact link with too large data" $ testPrepareContactLinkTooLarge ps
+    it "should connect via short link prepared for existing contact connection" $ testPrepareConnShortLink ps
  describe "Message delivery" $ do
    describe "update connection agent version on received messages" $ do
      it "should increase if compatible, shouldn'ps decrease" $
@@ -548,6 +558,10 @@ functionalAPITests ps = do
      testServerMatrix2 ps testFastSwitchConnection
    it "should switch delivery to the new queue when the old server is down" $
      testFastSwitchDeadOldServer ps
+    it "should drain the old queue after QEND on the new queue" $
+      testFastSwitchDrainOldQueue ps
+    it "should drain the old queue after QEND on the new queue and restart" $
+      testFastSwitchDrainOldQueueRestart ps
    describe "should switch delivery to the new queue" $
      testServerMatrix2 ps testSwitchConnection
    describe "should switch to new queue asynchronously" $
@@ -1235,6 +1249,30 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do
    ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
    allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc

+testAcceptContactDRPrepared :: HasCallStack => Bool -> IO ()
+testAcceptContactDRPrepared ratchetDeleted =
+  withAgentClients2 $ \alice bob -> runRight_ $ do
+    let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
+        pqEnc = PQEncryption $ pqConnectionMode IKPQOn PQSupportOn
+    (_, CCLink connReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing IKPQOn True SMSubscribe
+    (aliceId, CRBRatchet codes) <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn
+    void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe
+    ("", _, A.REQ invId _ _ "bob's connInfo" (CRBRatchet reqCodes) _) <- get alice
+    (bobId, CRBRatchet acceptCodes) <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
+    liftIO $ do
+      reqCodes `shouldBe` codes
+      acceptCodes `shouldBe` codes
+    if ratchetDeleted
+      then do
+        liftIO $ withTransaction (store $ agentEnv alice) (`DB.execute_` "DELETE FROM ratchets")
+        Left (CONN NOT_FOUND _) <- tryError $ getConnectionVerifyCodes alice bobId
+        pure ()
+      else getConnectionVerifyCodes alice bobId >>= liftIO . (`shouldBe` codes)
+    void $ acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
+    ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
+    allowConfirmGreet alice bobId bob aliceId confId IKPQOn pqEnc
+    getConnectionVerifyCodes alice bobId >>= liftIO . (`shouldBe` codes)
+
 runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
 runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do
  (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe
@@ -1552,7 +1590,7 @@ testAllowConnectionClientRestart ps@(t, ASType qsType _) = do
  bob <- getSMPAgentClient' 2 agentCfg initAgentServersSrv2 testDB2
  withSmpServerStoreLogOn ps testPort $ \_ -> do
    (aliceId, bobId, confId) <-
-      withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \_ -> do
+      withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ -> do
        runRight $ do
          (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
          (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
@@ -1574,7 +1612,7 @@ testAllowConnectionClientRestart ps@(t, ASType qsType _) = do
    alice2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB
    runRight_ $ subscribeConnection alice2 bobId
    threadDelay 500000
-    withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \_ -> do
+    withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ -> do
      runRight $ do
        ("", "", UP _ _) <- nGet bob
        get alice2 ##> ("", bobId, CON)
@@ -1737,7 +1775,7 @@ withServer1 :: (ASrvTransport, AStoreType) -> IO a -> IO a
 withServer1 ps = withSmpServerStoreLogOn ps testPort . const

 withServer2 :: (ASrvTransport, AStoreType) -> IO a -> IO a
-withServer2 (t, ASType qsType _) = withSmpServerConfigOn t (cfgS2QS qsType) testPort2 . const
+withServer2 (t, ASType qsType _) = withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 . const

 testInvitationShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
 testInvitationShortLink viaProxy a b =
@@ -1977,11 +2015,18 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
 #endif
  () <- case testServerStoreConfig msType of
    ASSCfg _ _ (SSCMemory sp_) -> mapM_ (\StorePaths {storeLogFile} -> updateStoreLog storeLogFile) sp_
+    ASSCfg _ _ SSCMemoryJournal {storeLogFile} -> updateStoreLog storeLogFile
 #if defined(dbServerPostgres)
+    ASSCfg _ _ SSCDatabaseJournal {storeCfg} -> do
+      st :: PostgresQueueStore (JournalQueue 'QSPostgres) <- newQueueStore @(JournalQueue 'QSPostgres) (storeCfg, True)
+      updateDbStore st
+      closeQueueStore @(JournalQueue 'QSPostgres) st
    ASSCfg _ _ (SSCDatabase storeCfg) -> do
-      st :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue storeCfg
+      st :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue (storeCfg, False)
      updateDbStore st
      closeQueueStore @PostgresQueue st
+#else
+    ASSCfg _ _ SSCDatabaseJournal {} -> error "no dbServerPostgres flag"
 #endif

  withSmpServer ps $ do
@@ -2042,6 +2087,64 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b
    get b ##> ("", bId, CON)
    exchangeGreetings a aId b bId

+testPrepareCreateInvitationLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareCreateInvitationLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
+  let userData = UserLinkData "test user data"
+  runRight_ $ do
+    (preparedReq, preparedParams@PreparedLinkParams {plpLinkKey}) <- A.prepareInvitationLink a 1 CR.IKPQOn Nothing
+    (bId, CCLink connReq (Just shortLink@(CSLInvitation _ _ _ linkKey))) <- A.createInvitationForLink a NRMInteractive 1 True preparedReq preparedParams (UserInvLinkData userData) SMSubscribe
+    liftIO $ linkKey `shouldBe` plpLinkKey
+    (_, connData', connReq') <- getConnShortLink b 1 shortLink
+    liftIO $ connReq' `shouldBe` preparedReq
+    liftIO $ connReq `shouldNotBe` preparedReq
+    liftIO $ linkUserData connData' `shouldBe` userData
+    testJoinConn_ False True a bId b connReq
+
+testPrepareInvitationLinkTooLarge :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareInvitationLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg initAgentServers testDB $ \a -> do
+  runRight_ $ do
+    (preparedReq, preparedParams) <- A.prepareInvitationLink a 1 CR.IKPQOn Nothing
+    Left (A.CMD LARGE _) <- tryError $ A.createInvitationForLink a NRMInteractive 1 True preparedReq preparedParams (UserInvLinkData $ UserLinkData $ B.replicate 14000 'a') SMSubscribe
+    pure ()
+  withTransaction (store $ agentEnv a) getConnIds `shouldReturn` []
+
+testPrepareContactLinkTooLarge :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareContactLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg initAgentServers testDB $ \a -> do
+  let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData $ B.replicate 14000 'a', ratchetKeys = Nothing}
+  g <- C.newRandom
+  rootKey <- atomically $ C.generateKeyPair g
+  linkEntId <- atomically $ C.randomBytes 32 g
+  runRight_ $ do
+    (ccLink, preparedParams) <- A.prepareConnectionLink a 1 rootKey linkEntId True Nothing CR.IKPQOn True Nothing
+    Left (A.CMD LARGE _) <- tryError $ A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) SMSubscribe
+    pure ()
+  withTransaction (store $ agentEnv a) getConnIds `shouldReturn` []
+
+testPrepareConnShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
+  let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
+  runRight_ $ do
+    (contactId, CCLink _ Nothing) <- A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMSubscribe
+    shortLink <- A.prepareConnShortLink a contactId Nothing
+    shortLink' <- A.prepareConnShortLink a contactId Nothing
+    liftIO $ shortLink' `shouldBe` shortLink
+    shortLink'' <- A.setConnShortLink a NRMInteractive contactId SCMContact (UserContactLinkData userCtData) Nothing False Nothing
+    liftIO $ shortLink'' `shouldBe` shortLink
+    (_, ContactLinkData _ userCtData', connReq) <- getConnShortLink b 1 shortLink
+    liftIO $ userCtData' `shouldBe` userCtData
+    (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
+    liftIO $ sndSecure `shouldBe` False
+    ("", _, REQ invId _ "bob's connInfo") <- get a
+    (bId, _) <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
+    sndSecure' <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe
+    liftIO $ sndSecure' `shouldBe` True
+    ("", _, CONF confId _ "alice's connInfo") <- get b
+    allowConnection b aId confId "bob's connInfo"
+    get a ##> ("", bId, INFO "bob's connInfo")
+    get a ##> ("", bId, CON)
+    get b ##> ("", aId, CON)
+    exchangeGreetings a bId b aId
+
 connReqWithKeys :: BinaryConnectionRequestUri m -> Maybe AddressRatchetKeys -> ConnectionRequestUri m
 connReqWithKeys cr rk = case cr of
  BCRInvitationUri crData e2eParams -> CRInvitationUri crData e2eParams
@@ -2429,7 +2532,7 @@ testExpireMessageQuota (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_
    ackMessage b' aId 4 Nothing
  disposeAgentClient a
  where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}

 testExpireManyMessagesQuota :: (ASrvTransport, AStoreType) -> IO ()
 testExpireManyMessagesQuota (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
@@ -2468,7 +2571,7 @@ testExpireManyMessagesQuota (t, msType) = withSmpServerConfigOn t cfg' testPort
    ackMessage b' aId 4 Nothing
  disposeAgentClient a
  where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}

 testJoinFullContactAsync :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
 testJoinFullContactAsync (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
@@ -2487,7 +2590,7 @@ testJoinFullContactAsync (t, msType) = withSmpServerConfigOn t cfg' testPort $ \
      ("", _, A.REQ _ _ _ "bob's connInfo" _ _) <- get alice
      pure ()
  where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}

 testJoinFullContactAsyncExpire :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
 testJoinFullContactAsyncExpire (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
@@ -2501,7 +2604,7 @@ testJoinFullContactAsyncExpire (t, msType) = withSmpServerConfigOn t cfg' testPo
    noMessages bob "joining should be retried until quota exceeded timeout"
    get bob =##> \case ("2", c, ERR (SMP _ QUOTA)) -> c == aliceId; _ -> False
  where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}

 fillContactAddress :: HasCallStack => IO (ConnId, ConnectionRequestUri 'CMContact)
 fillContactAddress = do
@@ -3079,7 +3182,7 @@ testBatchedSubscriptions nCreate nDel ps@(t, ASType qsType _) = do
    runServers :: ExceptT AgentErrorType IO a -> IO a
    runServers a = do
      withSmpServerStoreLogOn ps testPort $ \t1 -> do
-        res <- withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \t2 ->
+        res <- withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \t2 ->
          runRight a `finally` killThread t2
        killThread t1
        pure res
@@ -3586,7 +3689,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
        ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
        pure (aId, bId)
      nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
-      withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \_ -> do
+      withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ -> do
        confId <- withSmpServerStoreLogOn ps testPort $ \_ -> do
          -- both servers need to be online for connection to progress because of SKEY
          get b =##> \case ("2", c, JOINED sqSecured) -> c == aId && sqSecured; _ -> False
@@ -3719,8 +3822,8 @@ fastSwitchComplete a bId b aId = do
 testFastSwitchDeadOldServer :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
 testFastSwitchDeadOldServer ps@(t, ASType qsType _) = do
  let bServers = initAgentServers {smp = userServers [testSMPServer2]}
-  withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \_ ->
-    withAgent 1 agentCfg initAgentServers testDB $ \a ->
+  withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ ->
+    withAgent 1 aCfg initAgentServers testDB $ \a ->
      withAgent 2 agentCfg bServers testDB2 $ \b -> do
        (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
          (aId, bId) <- makeConnection a b
@@ -3736,7 +3839,10 @@ testFastSwitchDeadOldServer ps@(t, ASType qsType _) = do
          queuedReceived <- drainSwitchCompletedRcvMsg a bId "queued while down"
          liftIO $ queuedReceived `shouldBe` True
          drainSwitchCompleted b aId QDSnd
+          waitOneRcvQueue a bId
          exchangeGreetingsMsgId 7 a bId b aId
+  where
+    aCfg = agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3}

 -- drains switch and network events until the connection reports SPCompleted in the given direction,
 -- tolerating DOWN/UP and intermediate phases (the old server is stopped mid-rotation)
@@ -3756,6 +3862,69 @@ drainSwitchCompletedRcvMsg c connId body = go False
        (_, connId', AEvt SAEConn (Msg' mId _ body')) | connId' == connId && body' == body -> ackMessage c connId' mId Nothing >> go True
        _ -> go seen

+testFastSwitchDrainOldQueue :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testFastSwitchDrainOldQueue ps =
+  withSmpServers2 ps $ withAgentClients2 $ \a b -> runRight_ $ do
+    (aId, bId, aM1Id) <- endSwitchOnNewQueue a b
+    ackMessage a bId aM1Id Nothing
+    drainOldQueue a bId b aId
+
+testFastSwitchDrainOldQueueRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testFastSwitchDrainOldQueueRestart ps =
+  withSmpServers2 ps $
+    withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
+      (aId, bId, _) <- withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ endSwitchOnNewQueue a b
+      withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
+        subscribeConnection a bId
+        drainOldQueue a bId b aId
+
+endSwitchOnNewQueue :: HasCallStack => AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId, AgentMsgId)
+endSwitchOnNewQueue a b = do
+  (aId, bId) <- makeConnection a b
+  exchangeGreetings a bId b aId
+  liftIO $ setProtocolServers a 1 [noAuthSrvCfg testSMPServer2]
+  m1Id <- sendMessage b aId SMP.noMsgFlags "m1"
+  get b ##> ("", aId, SENT m1Id)
+  ("", c, Msg' aM1Id _ "m1") <- get a
+  liftIO $ c `shouldBe` bId
+  m2Id <- sendMessage b aId SMP.noMsgFlags "m2"
+  get b ##> ("", aId, SENT m2Id)
+  _ <- switchConnectionAsync a "" bId
+  fastSwitchComplete a bId b aId
+  stats <- getConnectionServers a bId
+  liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Nothing, Just RSReceivedQEND]
+  pure (aId, bId, aM1Id)
+
+drainOldQueue :: HasCallStack => AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
+drainOldQueue a bId b aId = do
+  ("", c, MSG MsgMeta {recipient = (aM2Id, _)} _ "m2") <- get a
+  liftIO $ c `shouldBe` bId
+  ackMessage a bId aM2Id Nothing
+  waitOneRcvQueue a bId
+  bMsgId <- sendMessage b aId SMP.noMsgFlags "hello"
+  get b ##> ("", aId, SENT bMsgId)
+  ("", c', MSG MsgMeta {recipient = (aMsgId, _)} _ "hello") <- get a
+  liftIO $ c' `shouldBe` bId
+  ackMessage a bId aMsgId Nothing
+  aMsgId' <- sendMessage a bId SMP.noMsgFlags "hello too"
+  get a ##> ("", bId, SENT aMsgId')
+  ("", c'', MSG MsgMeta {recipient = (bMsgId', _)} _ "hello too") <- get b
+  liftIO $ c'' `shouldBe` aId
+  ackMessage b aId bMsgId' Nothing
+  liftIO $ noMessages a "nothing else should be delivered to alice"
+  liftIO $ noMessages b "nothing else should be delivered to bob"
+
+waitOneRcvQueue :: HasCallStack => AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
+waitOneRcvQueue c connId = go (300 :: Int)
+  where
+    go n = do
+      stats <- getConnectionServers c connId
+      case rcvSwchStatuses' stats of
+        [Nothing] -> pure ()
+        statuses
+          | n > 0 -> liftIO (threadDelay 100000) >> go (n - 1)
+          | otherwise -> liftIO $ expectationFailure $ "old receive queue was not deleted: " <> show statuses
+
 phaseRcv :: AgentClient -> ByteString -> SwitchPhase -> [Maybe RcvSwitchStatus] -> ExceptT AgentErrorType IO ()
 phaseRcv c connId p swchStatuses = phase c connId QDRcv p (\stats -> rcvSwchStatuses' stats `shouldMatchList` swchStatuses)

@@ -4213,7 +4382,7 @@ testDeliveryReceiptsConcurrent (t, msType) =
      liftIO $ noMessages a "nothing else should be delivered to alice"
      liftIO $ noMessages b "nothing else should be delivered to bob"
  where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 256}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 256, maxJournalMsgCount = 512}
    runClient :: String -> AgentClient -> ConnId -> IO ()
    runClient _cName client connId = do
      concurrently_ send receive
@@ -4852,7 +5021,7 @@ testServerQueueInfo = do
    Just srvMsgId <- checkMsgQ bob aliceId 1
    get bob =##> \case
      ("", c, MSG MsgMeta {integrity = MsgOk, broker = (smId, _), recipient = (mId, _), pqEncryption = PQEncOn} _ "hello") ->
-        c == aliceId && decodeLatin1 (B64.encode smId) == srvMsgId && mId == msgId
+        c == aliceId && decodeLatin1 (B64.encode $ SMP.unMsgId smId) == srvMsgId && mId == msgId
      _ -> False
    ackMessage bob aliceId msgId Nothing
    liftIO $ threadDelay 200000
@@ -4883,9 +5052,9 @@ testServerQueueInfo = do
    get bob =##> \case ("", c, Msg' mId PQEncOn "hello 4") -> c == aliceId && mId == msgId4; _ -> False
    ackMessage bob aliceId msgId4 Nothing
    liftIO $ threadDelay 200000
-    Just _ <- checkMsgQ bob aliceId 1 -- the one that did not fit now accepted
    get alice ##> ("", bobId, QCONT)
    get alice ##> ("", bobId, SENT msgId5)
+    Just _ <- checkMsgQ bob aliceId 1 -- the one that did not fit now accepted
    liftIO $ threadDelay 200000
    Just _srvMsgId <- checkQ bob aliceId True (Just QNoSub) 1 (Just MTMessage)
    get bob =##> \case ("", c, Msg' mId PQEncOn "hello: quota exceeded") -> c == aliceId && mId == msgId5 + 1; _ -> False
@@ -230,7 +230,7 @@ testNotificationToken apns = do
    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
      getMockNotification apns tkn
    verification <- ntfData .-> "verification"
-    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
    verifyNtfToken a tkn nonce verification
    NTActive <- checkNtfToken a tkn
    deleteNtfToken a tkn
@@ -254,7 +254,7 @@ testNtfTokenRepeatRegistration apns = do
    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
      getMockNotification apns tkn
    verification <- ntfData .-> "verification"
-    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
    NTRegistered <- registerNtfToken a tkn NMPeriodic
    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
      getMockNotification apns tkn
@@ -273,14 +273,14 @@ testNtfTokenSecondRegistration apns =
    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
      getMockNotification apns tkn
    verification <- ntfData .-> "verification"
-    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
    verifyNtfToken a tkn nonce verification

    NTRegistered <- registerNtfToken a' tkn NMPeriodic
    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
      getMockNotification apns tkn
    verification' <- ntfData' .-> "verification"
-    nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
+    nonce' <- C.unsafeCbNonce <$> ntfData' .-> "nonce"

    -- at this point the first token is still active
    NTActive <- checkNtfToken a tkn
@@ -311,7 +311,7 @@ testNtfTokenServerRestart t apns = do
    -- so that repeat verification happens without restarting the clients, when notification arrives
    withNtfServer t $ runRight_ $ do
      verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
      verifyNtfToken a' tkn nonce verification
      NTActive <- checkNtfToken a' tkn
      pure ()
@@ -327,7 +327,7 @@ testNtfTokenServerRestartReverify t apns = do
      pure ntfData
    runRight_ $ do
      verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
      Left (BROKER _ (NETWORK _)) <- tryE $ verifyNtfToken a tkn nonce verification
      pure ()
  threadDelay 1500000
@@ -348,7 +348,7 @@ testNtfTokenServerRestartReverifyTimeout t apns = do
      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
        getMockNotification apns tkn
      verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
      verifyNtfToken a tkn nonce verification
      pure (nonce, verification)
    -- this emulates the situation when server verified token but the client did not receive the response
@@ -393,7 +393,7 @@ testNtfTokenServerRestartReregister t apns = do
      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
        getMockNotification apns tkn
      verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
      verifyNtfToken a' tkn nonce verification
      NTActive <- checkNtfToken a' tkn
      pure ()
@@ -428,7 +428,7 @@ testNtfTokenServerRestartReregisterTimeout t apns = do
      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
        getMockNotification apns tkn
      verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
      verifyNtfToken a' tkn nonce verification
      NTActive <- checkNtfToken a' tkn
      pure ()
@@ -450,7 +450,7 @@ testNtfTokenMultipleServers t apns = do
        APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
          getMockNotification apns tkn
        verification <- ntfData .-> "verification"
-        nonce <- C.cbNonce <$> ntfData .-> "nonce"
+        nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
        verifyNtfToken a tkn nonce verification
        NTActive <- checkNtfToken a tkn
        -- shut down the "other" server
@@ -566,7 +566,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
      getMockNotification apns tkn
    verification <- ntfData .-> "verification"
-    vNonce <- C.cbNonce <$> ntfData .-> "nonce"
+    vNonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
    verifyNtfToken alice tkn vNonce verification
    NTActive <- checkNtfToken alice tkn
    -- send message
@@ -657,7 +657,7 @@ registerTestToken a token mode apns = do
  Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
    timeout 1000000 $ getMockNotification apns tkn
  verification' <- ntfData' .-> "verification"
-  nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
+  nonce' <- C.unsafeCbNonce <$> ntfData' .-> "nonce"
  verifyNtfToken a tkn nonce' verification'
  NTActive <- checkNtfToken a tkn
  pure tkn
@@ -869,7 +869,7 @@ testNotificationsSMPRestartBatch n ps@(t, ASType qsType _) apns =
    runServers :: ExceptT AgentErrorType IO a -> IO a
    runServers a = do
      withSmpServerStoreLogOn ps testPort $ \t1 -> do
-        res <- withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \t2 ->
+        res <- withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \t2 ->
          runRight a `finally` killThread t2
        killThread t1
        pure res
@@ -1035,7 +1035,7 @@ messageNotification apns tkn = do
  500000 `timeout` getMockNotification apns tkn >>= \case
    Nothing -> error "no notification"
    Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
      message <- ntfData .-> "message"
      pure (nonce, message)
    _ -> error "bad notification"
@@ -513,7 +513,7 @@ hw = encodeUtf8 "Hello world!"
 ts :: UTCTime
 ts = UTCTime (fromGregorian 2021 02 24) (secondsToDiffTime 0)

-mkRcvMsgData :: InternalId -> InternalRcvId -> ExternalSndId -> BrokerId -> MsgHash -> RcvMsgData
+mkRcvMsgData :: InternalId -> InternalRcvId -> ExternalSndId -> ByteString -> MsgHash -> RcvMsgData
 mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
  RcvMsgData
    { internalRcvId,
@@ -522,7 +522,7 @@ mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
          { integrity = MsgOk,
            recipient = (unId internalId, ts),
            sndMsgId = externalSndId,
-            broker = (brokerId, ts),
+            broker = (SMP.unsafeMsgId $ mconcat (replicate 24 brokerId), ts),
            pqEncryption = CR.PQEncOn
          },
      msgType = AM_A_MSG_,
@@ -688,7 +688,7 @@ hasMigrations :: DBStore -> Expectation
 hasMigrations st = getMigrations st `shouldReturn` True

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

 testGetPendingQueueMsg :: DBStore -> Expectation
 testGetPendingQueueMsg st = do
@@ -49,6 +49,7 @@ schemaDumpTest = do
  it "should NOT create user record for new database" testUsersMigrationNew
  it "should create user record for old database" testUsersMigrationOld
  it "should remove duplicate ratchet key hashes before adding unique index" testRatchetKeyHashesUniqueMigration
+  it "should clear received_qend switch status on downgrade" testRcvSwitchStatusDowngrade

 testVerifySchemaDump :: IO ()
 testVerifySchemaDump = do
@@ -129,6 +130,21 @@ testRatchetKeyHashesUniqueMigration = do
    `shouldReturn` [Only (1 :: Int), Only 3, Only 4]
  closeDBStore st'

+testRcvSwitchStatusDowngrade :: IO ()
+testRcvSwitchStatusDowngrade = do
+  Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCError Nothing)
+  withTransaction' st $ \db -> do
+    SQL.execute_ db "INSERT INTO users (user_id) VALUES (1)"
+    SQL.execute_ db "INSERT INTO connections (conn_id, conn_mode, user_id) VALUES (x'01', 'INV', 1)"
+    SQL.execute_ db "INSERT INTO servers (host, port, key_hash) VALUES ('localhost', '5001', x'00')"
+    SQL.execute_ db "INSERT INTO rcv_queues (host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, snd_id, status, rcv_queue_id, rcv_primary, switch_status) VALUES ('localhost', '5001', x'01', x'01', x'00', x'00', x'00', x'01', 'active', 1, 0, 'received_qend'), ('localhost', '5001', x'02', x'01', x'00', x'00', x'00', x'02', 'active', 2, 1, 'sending_qadd')"
+  closeDBStore st
+  let beforeRcvSwitchStatus = takeWhile (("m20261008_rcv_switch_status" /=) . name) appMigrations
+  Right st' <- createDBStore (DBOpts testDB [] "" False True TQOff) beforeRcvSwitchStatus (MigrationConfig MCYesUpDown Nothing)
+  withTransaction' st' (`SQL.query_` "SELECT switch_status FROM rcv_queues ORDER BY rcv_queue_id")
+    `shouldReturn` [Only (Nothing :: Maybe Text), Only (Just "sending_qadd")]
+  closeDBStore st'
+
 skipComparisonForDownMigrations :: [String]
 skipComparisonForDownMigrations =
  [ -- on down migration idx_messages_internal_snd_id_ts index moves down to the end of the file
@@ -136,7 +152,9 @@ skipComparisonForDownMigrations =
    -- snd_secure and last_broker_ts columns swap order on down migration
    "m20250322_short_links",
    -- on down migration idx_processed_ratchet_key_hashes_hash index moves down to the end of the file
-    "m20260929_ratchet_indexes"
+    "m20260929_ratchet_indexes",
+    -- sqlite_sequence moves after commands table after VACUUM
+    "m20261005_commands_autoincrement"
  ]

 getSchema :: FilePath -> FilePath -> IO String
@@ -14,11 +14,13 @@ import Control.Monad
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString as B
 import Data.ByteString.Char8 (ByteString)
+import Data.ByteString.Unsafe (unsafeUseAsCString)
 import qualified Data.List.NonEmpty as L
 import Data.Time.Clock.System (SystemTime, getSystemTime)
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import qualified Data.X509.File as XF
+import Foreign.Ptr (plusPtr)
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -40,6 +42,8 @@ batchingTests = do
    it "should batch subscription responses with message" testBatchSubResponses
    it "should break on message that does not fit" testClientBatchWithMessage
    it "should break on large message" testClientBatchWithLargeMessage
+  describe "tDecodeServer" $
+    it "should copy IDs out of received block" testDecodeServerCopiesIds

 testBatchSubscriptions :: IO ()
 testBatchSubscriptions = do
@@ -166,6 +170,26 @@ testClientBatchWithLargeMessage = do
  (length rs1', length rs2') `shouldBe` (75, 135)
  all lenOk [s1', s2'] `shouldBe` True

+testDecodeServerCopiesIds :: IO ()
+testDecodeServerCopiesIds = do
+  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  subs <- replicateM 2 $ randomSUB sessId
+  let thParams = testTHandleParams sessId
+  [TBTransmissions s 2 _] <- pure $ batchTransmissions thParams $ L.fromList subs
+  forM_ (tParse thParams s) $ \t -> do
+    let (corrId, entId, _) = tDecodeClient @SMPVersion @ErrorType @Cmd thParams t
+    Right (_, _, (corrId', entId', _)) <- pure $ tDecodeServer @SMPVersion @ErrorType @Cmd (testTHandleParams sessId) t
+    (corrId', entId') `shouldBe` (corrId, entId)
+    sharesBuffer s (bs corrId) `shouldReturn` True
+    sharesBuffer s (unEntityId entId) `shouldReturn` True
+    sharesBuffer s (bs corrId') `shouldReturn` False
+    sharesBuffer s (unEntityId entId') `shouldReturn` False
+
+sharesBuffer :: ByteString -> ByteString -> IO Bool
+sharesBuffer block s =
+  unsafeUseAsCString block $ \blockPtr -> unsafeUseAsCString s $ \ptr ->
+    pure $ ptr >= blockPtr && ptr < blockPtr `plusPtr` B.length block
+
 testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 testClientStub = do
  g <- C.newRandom
@@ -183,7 +207,7 @@ randomSUB sessId = do
  thAuth_ <- testTHandleAuth g rKey
  let thParams = testTHandleParams sessId
      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId rId, Cmd SRecipient SUB)
-  pure $ (,tToSend) <$> authTransmission thAuth_ True (Just rpKey) nonce tForAuth
+  pure $ (,tToSend) <$> authTransmission thAuth_ True (Just rpKey) (Just nonce) tForAuth

 randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
 randomSUBCmd c = do
@@ -202,7 +226,7 @@ randomNMSGCmd :: SystemTime -> IO (Transmission BrokerMsg)
 randomNMSGCmd ts = do
  g <- C.newRandom
  nId <- atomically $ C.randomBytes 24 g
-  msgId <- atomically $ C.randomBytes 24 g
+  msgId <- atomically $ randomMsgId 24 g
  (k, pk) <- atomically $ C.generateKeyPair g
  nonce <- atomically $ C.randomCbNonce g
  let msgMeta = NMsgMeta {msgId, msgTs = ts}
@@ -221,7 +245,7 @@ randomMSG = do
  g <- C.newRandom
  corrId <- atomically $ C.randomBytes 24 g
  rId <- atomically $ C.randomBytes 24 g
-  msgId <- atomically $ C.randomBytes 24 g
+  msgId <- atomically $ randomMsgId 24 g
  msg <- atomically $ C.randomBytes maxMessageLength g
  pure (CorrId corrId, EntityId rId, MSG RcvMessage {msgId, msgBody = EncRcvMsgBody msg})

@@ -235,9 +259,9 @@ randomSEND sessId len = do
  msg <- atomically $ C.randomBytes len g
  let thParams = testTHandleParams sessId
      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId sId, Cmd SSender $ SEND noMsgFlags msg)
-  pure $ (,tToSend) <$> authTransmission thAuth_ False (Just spKey) nonce tForAuth
+  pure $ (,tToSend) <$> authTransmission thAuth_ False (Just spKey) (Just nonce) tForAuth

-testTHandleParams :: ByteString -> THandleParams SMPVersion 'TClient
+testTHandleParams :: ByteString -> THandleParams SMPVersion p
 testTHandleParams sessionId =
  THandleParams
    { sessionId,
@@ -16,7 +16,8 @@

 module CoreTests.MsgStoreTests where

-import AgentTests.FunctionalAPITests (runRight_)
+import AgentTests.FunctionalAPITests (runRight, runRight_)
+import Control.Concurrent (threadDelay)
 import Control.Concurrent.STM
 import Control.Exception (bracket)
 import Control.Monad
@@ -24,26 +25,33 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.Map.Strict as M
-import Data.Time.Clock.System (getSystemTime)
+import qualified Data.ByteString.Char8 as B
+import Data.Int (Int64)
+import Data.List (isPrefixOf, isSuffixOf)
+import Data.Maybe (fromJust)
+import Data.Time.Clock (addUTCTime)
+import Data.Time.Clock.System (SystemTime (..), getSystemTime)
+import SMPClient (testStoreLogFile, testStoreMsgsDir, testStoreMsgsDir2, testStoreMsgsFile, testStoreMsgsFile2)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), ErrorType (..), LinkId, Message (..), QueueLinkData, RecipientId, SParty (..), noMsgFlags)
+import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), ErrorType (..), LinkId, Message (..), QueueLinkData, RecipientId, SParty (..), noMsgFlags, randomMsgId)
+import Simplex.Messaging.Server (exportMessages, importMessages, printMessageStats)
+import Simplex.Messaging.Server.Env.STM (MsgStore (..), 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
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
-import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..))
 import Simplex.Messaging.Server.QueueStore.Types
-import Simplex.Messaging.TMap (TMap)
+import Simplex.Messaging.Server.StoreLog (closeStoreLog, logCreateQueue)
+import System.Directory (copyFile, createDirectoryIfMissing, listDirectory, removeFile, renameFile)
+import System.FilePath ((</>))
+import System.IO (IOMode (..), withFile)
 import Test.Hspec hiding (fit, it)
 import Util

 #if defined(dbServerPostgres)
-import AgentTests.FunctionalAPITests (runRight)
-import Control.Concurrent (threadDelay)
-import Data.Int (Int64)
-import Data.Time.Clock.System (SystemTime (..))
 import Database.PostgreSQL.Simple (Only (..))
 import qualified Database.PostgreSQL.Simple as DB
 import Simplex.Messaging.Agent.Store.Postgres.Common
@@ -55,11 +63,17 @@ import SMPClient (postgressBracket, testServerDBConnectInfo, testStoreDBOpts)

 msgStoreTests :: Spec
 msgStoreTests = do
-  around (withMsgStore testSMTStoreConfig) $ describe "STM message store" $ do
+  around (withMsgStore testSMTStoreConfig) $ describe "STM message store" someMsgStoreTests
+  around (withMsgStore $ testJournalStoreCfg MQStoreCfg) $ describe "Journal message store" $ do
    someMsgStoreTests
-    it "should remove deleted queues from queue store maps" testDeleteQueueMaps
+    journalMsgStoreTests
+    it "should export and import journal store" testExportImportStore
 #if defined(dbServerPostgres)
  around_ (postgressBracket testServerDBConnectInfo) $ do
+    around (withMsgStore $ testJournalStoreCfg $ PQStoreCfg testPostgresStoreCfg) $
+      describe "Postgres+journal message store" $ do
+        someMsgStoreTests
+        journalMsgStoreTests
    around (withMsgStore testPostgresStoreConfig) $
      describe "Postgres-only message store" $ do
        someMsgStoreTests
@@ -67,12 +81,26 @@ msgStoreTests = do
        it "tryDelPeekMsg (ACK not from NSE) should reset message counts when queue is empty" testResetMessageCounts
        it "should expire messages across commit batches" testExpireMessagesInBatches
 #endif
+  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
+    journalMsgStoreTests :: SpecWith (JournalMsgStore s)
+    journalMsgStoreTests = 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
    someMsgStoreTests :: MsgStoreClass s => SpecWith s
    someMsgStoreTests = do
      it "should get queue and store/read messages" testGetQueue
      it "should write/ack messages" testWriteAckMessages
-      it "should resolve sender ID equal to link ID of another queue" testLinkIdSenderIdCollision
+      it "should not fail on EOF when changing read journal" testChangeReadJournal
      it "should not add link data to secured messaging queue" testLinkDataSecuredQueue

 -- TODO constrain to STM stores?
@@ -82,6 +110,21 @@ withMsgStore cfg = bracket (newMsgStore cfg) closeMsgStore
 testSMTStoreConfig :: STMStoreConfig
 testSMTStoreConfig = STMStoreConfig {storePath = Nothing, quota = 3}

+testJournalStoreCfg :: QStoreCfg s -> JournalStoreConfig s
+testJournalStoreCfg queueStoreCfg =
+  JournalStoreConfig
+    { storePath = testStoreMsgsDir,
+      pathParts = journalMsgStoreDepth,
+      queueStoreCfg,
+      quota = 3,
+      maxMsgCount = 4,
+      maxStateLines = 2,
+      stateTailSize = 256,
+      idleInterval = 21600,
+      expireBackupsAfter = 0,
+      keepMinBackups = 1
+    }
+
 #if defined(dbServerPostgres)
 testPostgresStoreConfig :: PostgresMsgStoreCfg
 testPostgresStoreConfig =
@@ -104,12 +147,18 @@ mkMessage :: MonadIO m => ByteString -> m Message
 mkMessage body = liftIO $ do
  g <- C.newRandom
  msgTs <- getSystemTime
-  msgId <- atomically $ C.randomBytes 24 g
+  msgId <- atomically $ randomMsgId 24 g
  pure Message {msgId, msgTs, msgFlags = noMsgFlags, msgBody = C.unsafeMaxLenBS body}

 pattern Msg :: ByteString -> Maybe Message
 pattern Msg s <- Just Message {msgBody = MaxLenBS s}

+deriving instance Eq MsgQueueState
+
+deriving instance Eq (JournalState t)
+
+deriving instance Eq (SJournalType t)
+
 testNewQueueRec :: TVar ChaChaDRG -> QueueMode -> IO (RecipientId, QueueRec)
 testNewQueueRec g qm = testNewQueueRecData g qm Nothing

@@ -136,18 +185,6 @@ testNewQueueRecData g qm queueData = do
  where
    rndId = atomically $ EntityId <$> C.randomBytes 24 g

-testNtfCreds :: TVar ChaChaDRG -> IO NtfCreds
-testNtfCreds g = do
-  (notifierKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
-  (k, pk) <- atomically $ C.generateKeyPair @'C.X25519 g
-  pure
-    NtfCreds
-      { notifierId = EntityId "ijkl",
-        notifierKey,
-        rcvNtfDhSecret = C.dh' k pk,
-        ntfServiceId = Nothing
-      }
-
 testGetQueue :: MsgStoreClass s => s -> IO ()
 testGetQueue ms = do
  g <- C.newRandom
@@ -212,6 +249,25 @@ testWriteAckMessages ms = do
    void $ ExceptT $ deleteQueue ms q1
    void $ ExceptT $ deleteQueue ms q2

+testChangeReadJournal :: MsgStoreClass s => s -> IO ()
+testChangeReadJournal ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g QMMessaging
+  runRight_ $ do
+    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 q mId1
+    Just (Message {msgId = mId2}, True) <- write "message 2"
+    (Msg "message 2", Nothing) <- tryDelPeekMsg ms q mId2
+    Just (Message {msgId = mId3}, True) <- write "message 3"
+    (Msg "message 3", Nothing) <- tryDelPeekMsg ms q mId3
+    Just (Message {msgId = mId4}, True) <- write "message 4"
+    (Msg "message 4", Nothing) <- tryDelPeekMsg ms q mId4
+    Just (Message {msgId = mId5}, True) <- write "message 5"
+    (Msg "message 5", Nothing) <- tryDelPeekMsg ms q mId5
+    void $ ExceptT $ deleteQueue ms q
+
 testLinkDataSecuredQueue :: MsgStoreClass s => s -> IO ()
 testLinkDataSecuredQueue ms = do
  g <- C.newRandom
@@ -239,70 +295,57 @@ testLinkDataSecuredQueue ms = do
    void $ ExceptT $ deleteQueue ms q
    void $ ExceptT $ deleteQueue ms cq

-- sizes of queues, senders, links and notifiers maps
-type QueueMapSizes = (Int, Int, Int, Int)
-
-queueMapSizes :: STMMsgStore -> IO QueueMapSizes
-queueMapSizes ms = (,,,) <$> size queues <*> size senders <*> size links <*> size notifiers
-  where
-    STMQueueStore {queues, senders, links, notifiers} = queueStore ms
-    size :: TMap k v -> IO Int
-    size = fmap M.size . readTVarIO
-
-testDeleteQueueMaps :: STMMsgStore -> IO ()
-testDeleteQueueMaps ms = do
+testExportImportStore :: JournalMsgStore 'QSMemory -> IO ()
+testExportImportStore ms = do
  g <- C.newRandom
-  ntfCreds <- testNtfCreds g
-  let newLinkId = atomically $ EntityId <$> C.randomBytes 24 g
-  lnkId1 <- newLinkId
-  lnkId2 <- newLinkId
-  lnkId3 <- newLinkId
  (rId1, qr1) <- testNewQueueRec g QMMessaging
-  (rId2, qr2) <- testNewQueueRecData g QMContact (Just (lnkId1, testLinkData))
-  (rId3, qr3) <- testNewQueueRec g QMMessaging
-  (rId4, qr4) <- testNewQueueRec g QMMessaging
-  let rIds = [rId1, rId2, rId3, rId4] :: [RecipientId]
-      sIds = map senderId [qr1, qr2, qr3, qr4]
-      lnkIds = [lnkId1, lnkId2, lnkId3] :: [LinkId]
-  queueMapSizes ms `shouldReturn` (0, 0, 0, 0)
+  (rId2, qr2) <- testNewQueueRec g QMMessaging
+  sl <- readWriteQueueStore True (mkQueue ms True) testStoreLogFile $ stmQueueStore ms
  runRight_ $ do
-    q1 <- ExceptT $ addQueue ms rId1 qr1 {notifier = Just ntfCreds}
+    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
-    q3 <- ExceptT $ addQueue ms rId3 qr3
-    q4 <- ExceptT $ addQueue ms rId4 qr4
-    ExceptT $ addQueueLinkData (queueStore ms) q3 lnkId2 testLinkData
-    ExceptT $ addQueueLinkData (queueStore ms) q4 lnkId3 testLinkData
-    forM_ sIds $ void . ExceptT . getQueue ms SSender
-    forM_ lnkIds $ void . ExceptT . getQueue ms SSenderLink
-    liftIO $ queueMapSizes ms `shouldReturn` (4, 4, 3, 1)
-    ExceptT $ deleteQueueLinkData (queueStore ms) q3
-    liftIO $ queueMapSizes ms `shouldReturn` (4, 4, 2, 1)
-    forM_ ([q1, q2, q3, q4] :: [STMQueue]) $ void . ExceptT . deleteQueue ms
-  queueMapSizes ms `shouldReturn` (0, 0, 0, 0)
-  forM_ rIds $ \rId -> getQueue ms SRecipient rId >>= expectAuth
-  forM_ sIds $ \sId -> getQueue ms SSender sId >>= expectAuth
-  forM_ lnkIds $ \lnkId -> getQueue ms SSenderLink lnkId >>= expectAuth
-  queueMapSizes ms `shouldReturn` (0, 0, 0, 0)
-  where
-    expectAuth = either (`shouldBe` AUTH) (\_ -> expectationFailure "deleted queue is still found")
+    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
+  exportMessages False (StoreJournal ms) testStoreMsgsFile False
+  closeMsgStore ms
+  closeStoreLog sl
+  -- export with closed queues and compare
+  ms2 <- newMsgStore $ testJournalStoreCfg MQStoreCfg
+  readWriteQueueStore True (mkQueue ms2 True) testStoreLogFile (stmQueueStore ms2) >>= closeStoreLog
+  exportMessages False (StoreJournal ms2) (testStoreMsgsFile <> ".copy") False
+  s <- B.readFile testStoreMsgsFile
+  B.readFile (testStoreMsgsFile <> ".copy") `shouldReturn` s

-testLinkData :: QueueLinkData
-testLinkData = (EncDataBytes "fixed data", EncDataBytes "user data")
-
-testLinkIdSenderIdCollision :: MsgStoreClass s => s -> IO ()
-testLinkIdSenderIdCollision ms = do
-  g <- C.newRandom
-  (rIdV, qrV) <- testNewQueueRec g QMContact
-  (rIdA, qrA) <- testNewQueueRec g QMContact
-  let sIdV = senderId qrV
-  runRight_ $ do
-    void $ ExceptT $ addQueue ms rIdV qrV
-    qA <- ExceptT $ addQueue ms rIdA qrA
-    ExceptT $ addQueueLinkData (queueStore ms) qA sIdV testLinkData
-    qA' <- ExceptT $ getQueue ms SSenderLink sIdV
-    liftIO $ recipientId qA' `shouldBe` rIdA
-    qV <- ExceptT $ getQueue ms SSender sIdV
-    liftIO $ recipientId qV `shouldBe` rIdV
+  let cfg = (testJournalStoreCfg MQStoreCfg :: JournalStoreConfig 'QSMemory) {storePath = testStoreMsgsDir2}
+  ms' <- newMsgStore cfg
+  readWriteQueueStore True (mkQueue ms' True) testStoreLogFile (stmQueueStore ms') >>= closeStoreLog
+  stats@MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
+    importMessages False ms' testStoreMsgsFile Nothing False
+  printMessageStats "Messages" stats
+  length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
+  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3 -- 2 message files
+  exportMessages False (StoreJournal ms') testStoreMsgsFile2 False
+  (B.readFile testStoreMsgsFile2 `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".bak")
+  stmStore <- newMsgStore testSMTStoreConfig
+  readWriteQueueStore True (mkQueue stmStore True) testStoreLogFile (queueStore stmStore) >>= closeStoreLog
+  MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
+    importMessages False stmStore testStoreMsgsFile2 Nothing False
+  exportMessages False (StoreMemory stmStore) testStoreMsgsFile False
+  (B.sort <$> B.readFile testStoreMsgsFile `shouldReturn`) =<< (B.sort <$> B.readFile (testStoreMsgsFile2 <> ".bak"))

 #if defined(dbServerPostgres)
 testUpdateMessageCounts :: PostgresMsgStore -> IO ()
@@ -413,3 +456,320 @@ testExpireMessagesInBatches ms = do
        go n = write q "fill" >>= maybe (pure n) (const $ go (n + 1))
 #endif

+testQueueState :: JournalMsgStore s -> IO ()
+testQueueState ms = do
+  g <- C.newRandom
+  rId <- EntityId <$> atomically (C.randomBytes 24 g)
+  let dir = msgQueueDirectory ms rId
+      statePath = msgQueueStatePath dir rId
+  createDirectoryIfMissing True dir
+  state <- newMsgQueueState <$> newJournalId (random ms)
+  withFile statePath WriteMode (`appendState` state)
+  length . lines <$> readFile statePath `shouldReturn` 1
+  readQueueState ms statePath `shouldReturn` (Just state, False)
+  length <$> listDirectory dir `shouldReturn` 1 -- no backup
+  let state1 =
+        state
+          { size = 1,
+            readState = (readState state) {msgCount = 1, byteCount = 100},
+            writeState = (writeState state) {msgPos = 1, msgCount = 1, bytePos = 100, byteCount = 100}
+          }
+  withFile statePath AppendMode (`appendState` state1)
+  length . lines <$> readFile statePath `shouldReturn` 2
+  readQueueState ms statePath `shouldReturn` (Just state1, False)
+  length <$> listDirectory dir `shouldReturn` 1 -- no backup
+  let state2 =
+        state
+          { size = 2,
+            readState = (readState state) {msgCount = 2, byteCount = 200},
+            writeState = (writeState state) {msgPos = 2, msgCount = 2, bytePos = 200, byteCount = 200}
+          }
+  withFile statePath AppendMode (`appendState` state2)
+  length . lines <$> readFile statePath `shouldReturn` 3
+  copyFile statePath (statePath <> ".2")
+  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
+  (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 ms statePath `shouldReturn` (Just state1, True)
+  length <$> listDirectory dir `shouldReturn` 1
+  length . lines <$> readFile statePath `shouldReturn` 3
+  where
+    corruptFile f = do
+      s <- readFile f
+      removeFile f
+      writeFile f $ take (length s - 4) s
+    removeOtherFiles dir keep = do
+      names <- listDirectory dir
+      forM_ names $ \name ->
+        let f = dir </> name
+         in unless (f == keep) $ removeFile f
+
+testMessageState :: JournalMsgStore s -> IO ()
+testMessageState ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g QMMessaging
+  let dir = msgQueueDirectory ms rId
+      statePath = msgQueueStatePath dir rId
+      write q s = writeMsg ms q True =<< mkMessage s
+
+  mId1 <- runRight $ do
+    q <- ExceptT $ addQueue ms rId qr
+    Just (Message {msgId = mId1}, True) <- write q "message 1"
+    Just (Message {}, False) <- write q "message 2"
+    liftIO $ closeMsgQueue ms q
+    pure mId1
+
+  ls <- B.lines <$> B.readFile statePath
+  B.writeFile statePath $ B.unlines $ take (length ls - 1) ls
+
+  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 q mId1
+    (Msg "message 3", Nothing) <- tryDelPeekMsg ms q mId3
+    liftIO $ closeMsgQueue ms q
+
+testRemoveJournals :: JournalMsgStore s -> IO ()
+testRemoveJournals ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g QMMessaging
+  let dir = msgQueueDirectory ms rId
+      statePath = msgQueueStatePath dir 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 ms 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 ms 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 ms 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 ms 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 QMMessaging
+
+  ms' <- newMsgStore (testJournalStoreCfg MQStoreCfg) {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 ms 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 ms 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 ms 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 QMMessaging
+
+  ms <- newMsgStore (testJournalStoreCfg MQStoreCfg) {idleInterval = 0}
+
+  let dir = msgQueueDirectory ms rId
+      statePath = msgQueueStatePath dir 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 ms 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 $ isolateQueue ms q "" $ withIdleMsgQueue now ms q $ deleteExpireMsgs_ old q
+  expired_ `shouldBe` Just 0
+  stored `shouldBe` 0
+  (Nothing, False) <- readQueueState ms statePath
+  pure ()
+
+testReadFileMissing :: JournalMsgStore s -> IO ()
+testReadFileMissing ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g QMMessaging
+  let write q s = writeMsg ms q True =<< mkMessage s
+  q <- runRight $ do
+    q <- ExceptT $ addQueue ms rId qr
+    Just (Message {}, True) <- write q "message 1"
+    Msg "message 1" <- tryPeekMsg ms q
+    pure q
+
+  mq <- fromJust <$> readTVarIO (msgQueue' q)
+  MsgQueueState {readState = rs} <- readTVarIO $ state mq
+  closeMsgQueue ms q
+  let path = journalFilePath (queueDirectory $ queue mq) $ journalId rs
+  removeFile path
+
+  runRight_ $ do
+    q' <- ExceptT $ getQueue ms SRecipient rId
+    Nothing <- tryPeekMsg ms q'
+    Just (Message {}, True) <- write q' "message 2"
+    Msg "message 2" <- tryPeekMsg ms q'
+    pure ()
+
+testReadFileMissingSwitch :: JournalMsgStore s -> IO ()
+testReadFileMissingSwitch ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g QMMessaging
+  q <- writeMessages ms rId qr
+
+  mq <- fromJust <$> readTVarIO (msgQueue' q)
+  MsgQueueState {readState = rs} <- readTVarIO $ state mq
+  closeMsgQueue ms q
+  let path = journalFilePath (queueDirectory $ queue mq) $ journalId rs
+  removeFile path
+
+  runRight_ $ do
+    q' <- ExceptT $ getQueue ms SRecipient rId
+    Just (Message {}, False) <- writeMsg ms q' True =<< mkMessage "message 6"
+    Msg "message 5" <- tryPeekMsg ms q'
+    pure ()
+
+testWriteFileMissing :: JournalMsgStore s -> IO ()
+testWriteFileMissing ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g QMMessaging
+  q <- writeMessages ms rId qr
+
+  mq <- fromJust <$> readTVarIO (msgQueue' q)
+  MsgQueueState {writeState = ws} <- readTVarIO $ state mq
+  closeMsgQueue ms q
+  let path = journalFilePath (queueDirectory $ queue mq) $ journalId ws
+  print path
+  removeFile path
+
+  runRight_ $ do
+    q' <- ExceptT $ getQueue ms SRecipient rId
+    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 s -> IO ()
+testReadAndWriteFilesMissing ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g QMMessaging
+  q <- writeMessages ms rId qr
+
+  mq <- fromJust <$> readTVarIO (msgQueue' q)
+  MsgQueueState {readState = rs, writeState = ws} <- readTVarIO $ state mq
+  closeMsgQueue ms q
+  removeFile $ journalFilePath (queueDirectory $ queue mq) $ journalId rs
+  removeFile $ journalFilePath (queueDirectory $ queue mq) $ journalId ws
+
+  runRight_ $ do
+    q' <- ExceptT $ getQueue ms SRecipient rId
+    Nothing <- tryPeekMsg ms q'
+    Just (Message {}, True) <- writeMsg ms q' True =<< mkMessage "message 6"
+    Msg "message 6" <- tryPeekMsg ms q'
+    pure ()
+
+writeMessages :: JournalMsgStore s -> RecipientId -> QueueRec -> IO (JournalQueue s)
+writeMessages ms rId qr = runRight $ do
+  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 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
@@ -28,7 +28,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Protocol.Types (ClientNotice (..))
 import Simplex.Messaging.Server.Env.STM (readWriteQueueStore)
-import Simplex.Messaging.Server.MsgStore.STM (STMMsgStore (..), STMStoreConfig (..))
+import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..))
@@ -48,6 +48,18 @@ import Simplex.Messaging.Server.Main
 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
+  (k, pk) <- atomically $ C.generateKeyPair @'C.X25519 g
+  pure
+    NtfCreds
+      { notifierId = EntityId "ijkl",
+        notifierKey,
+        rcvNtfDhSecret = C.dh' k pk,
+        ntfServiceId = Nothing
+      }
+
 data StoreLogTestCase r s = SLTC {name :: String, saved :: [r], state :: s, compacted :: [r]}

 type SMPStoreLogTestCase = StoreLogTestCase StoreLogRecord (M.Map RecipientId QueueRec)
@@ -165,10 +177,10 @@ testSMPStoreLog testSuite tests =
    closeStoreLog l
    replicateM_ 3 $ testReadWrite t
 #if defined(dbServerPostgres)
-    (sCnt, qCnt) <- importStoreLogToDatabase testStoreLogFile testStoreDBOpts
+    (sCnt, qCnt) <- importStoreLogToDatabase "tests/tmp/" testStoreLogFile testStoreDBOpts
    fromIntegral (sCnt + qCnt) `shouldBe` length (compacted t)
    imported <- B.readFile $ testStoreLogFile <> ".bak"
-    (sCnt', qCnt') <- exportDatabaseToStoreLog testStoreDBOpts testStoreLogFile
+    (sCnt', qCnt') <- exportDatabaseToStoreLog "tests/tmp/" testStoreDBOpts testStoreLogFile
    sCnt' `shouldBe` fromIntegral sCnt
    qCnt' `shouldBe` fromIntegral qCnt
    exported <- B.readFile testStoreLogFile
@@ -176,14 +188,14 @@ testSMPStoreLog testSuite tests =
 #endif
  where
    testReadWrite SLTC {compacted, state} = do
-      st <- newMsgStore STMStoreConfig {storePath = Nothing, quota = 3}
-      l <- readWriteQueueStore True (mkQueue st) testStoreLogFile $ queueStore st
+      st <- newMsgStore $ testJournalStoreCfg MQStoreCfg
+      l <- readWriteQueueStore True (mkQueue st True) testStoreLogFile $ stmQueueStore st
      storeState st `shouldReturn` state
      closeStoreLog l
      ([], compacted') <- partitionEithers . map strDecode . B.lines <$> B.readFile testStoreLogFile
      compacted' `shouldBe` compacted
-    storeState :: STMMsgStore -> IO (M.Map RecipientId QueueRec)
-    storeState st = M.mapMaybe id <$> (readTVarIO (queues $ queueStore st) >>= mapM (readTVarIO . queueRec))
+    storeState :: JournalMsgStore 'QSMemory -> IO (M.Map RecipientId QueueRec)
+    storeState st = M.mapMaybe id <$> (readTVarIO (queues $ stmQueueStore st) >>= mapM (readTVarIO . queueRec))

 type FileRecState = (FileInfo, RoundedFileTime, Maybe RoundedFileTime, ServerEntityStatus)

@@ -136,7 +136,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
          let dhSecret = C.dh' ntfDh dhPriv
              decryptCode nd =
                let Right verification = nd .-> "verification"
-                    Right nonce = C.cbNonce <$> nd .-> "nonce"
+                    Right nonce = C.cbNonce =<< nd .-> "nonce"
                    Right pt = C.cbDecrypt dhSecret nonce verification
                 in NtfRegCode pt
          let code = decryptCode ntfData
@@ -160,7 +160,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
          -- receive notification
          APNSMockRequest {notification} <- getMockNotification apns tkn
          let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData'} = notification
-              Right nonce' = C.cbNonce <$> ntfData' .-> "nonce"
+              Right nonce' = C.cbNonce =<< ntfData' .-> "nonce"
              Right message = ntfData' .-> "message"
              Right ntfDataDecrypted = C.cbDecrypt dhSecret nonce' message
              Right pnMsgs1 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
@@ -171,7 +171,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
          notifierId `shouldBe` nId
          -- receive message
          Resp "" _ (MSG RcvMessage {msgId = mId1, msgBody = EncRcvMsgBody body}) <- tGet1 rh
-          Right ClientRcvMsgBody {msgTs = mTs, msgBody} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId1) body)
+          Right ClientRcvMsgBody {msgTs = mTs, msgBody} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret mId1 body)
          mId1 `shouldBe` msgId
          mTs `shouldBe` msgTs
          (msgBody, "hello") #== "delivered from queue"
@@ -183,7 +183,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <-
            getMockNotification apns tkn'
          let Right verification2 = ntfData2 .-> "verification"
-              Right nonce2 = C.cbNonce <$> ntfData2 .-> "nonce"
+              Right nonce2 = C.cbNonce =<< ntfData2 .-> "nonce"
              Right code2 = NtfRegCode <$> C.cbDecrypt dhSecret nonce2 verification2
          RespNtf "8" _ NROk <- signSendRecvNtf nh tknKey ("8", tId, TVFY code2)
          RespNtf "8a" _ (NRTkn NTActive) <- signSendRecvNtf nh tknKey ("8a", tId, TCHK)
@@ -191,7 +191,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
          Resp "9" _ OK <- signSendRecv sh sKey ("9", sId, _SEND' "hello 2")
          APNSMockRequest {notification = notification3} <- getMockNotification apns tkn'
          let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData3} = notification3
-              Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce"
+              Right nonce3 = C.cbNonce =<< ntfData3 .-> "nonce"
              Right message3 = ntfData3 .-> "message"
              Right ntfDataDecrypted3 = C.cbDecrypt dhSecret nonce3 message3
              Right pnMsgs2 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
@@ -199,7 +199,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
          smpServer3 `shouldBe` srv
          notifierId3 `shouldBe` nId
          Resp "" _ (MSG RcvMessage {msgId = mId2, msgBody = EncRcvMsgBody body2}) <- tGet1 rh
-          Right ClientRcvMsgBody {msgBody = "hello 2"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId2) body2)
+          Right ClientRcvMsgBody {msgBody = "hello 2"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret mId2 body2)
          Resp "10" _ OK <- signSendRecv rh rKey ("10", rId, ACK mId2)

          q2 <- createQueue rh sPub nPub
@@ -218,7 +218,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
          Resp "14" _ OK <- signSendRecv sh sKey ("14", sId, _SEND' "hello 3")
          APNSMockRequest {notification = notification4} <- getMockNotification apns tkn'
          let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData4} = notification4
-              Right nonce4 = C.cbNonce <$> ntfData4 .-> "nonce"
+              Right nonce4 = C.cbNonce =<< ntfData4 .-> "nonce"
              Right message4 = ntfData4 .-> "message"
              Right ntfDataDecrypted4 = C.cbDecrypt dhSecret nonce4 message4
              Right pnMsgs4 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted4
@@ -226,14 +226,14 @@ testNotificationSubscription (ATransport t, msType) createQueue =
          smpServer4 `shouldBe` srv
          notifierId4 `shouldBe` nId
          Resp "" _ (MSG RcvMessage {msgId = mId3, msgBody = EncRcvMsgBody body3}) <- tGet1 rh
-          Right ClientRcvMsgBody {msgBody = "hello 3"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId3) body3)
+          Right ClientRcvMsgBody {msgBody = "hello 3"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret mId3 body3)
          Resp "15" _ OK <- signSendRecv rh rKey ("15", rId, ACK mId3)

          -- deliver to queue with ntf sub created while SMP was offline
          Resp "16" _ OK <- signSendRecv sh sKey ("16", sId', _SEND' "hello 4")
          APNSMockRequest {notification = notification5} <- getMockNotification apns tkn'
          let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData5} = notification5
-              Right nonce5 = C.cbNonce <$> ntfData5 .-> "nonce"
+              Right nonce5 = C.cbNonce =<< ntfData5 .-> "nonce"
              Right message5 = ntfData5 .-> "message"
              Right ntfDataDecrypted5 = C.cbDecrypt dhSecret nonce5 message5
              Right pnMsgs5 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted5
@@ -241,7 +241,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
          smpServer5 `shouldBe` srv
          notifierId5 `shouldBe` nId'
          Resp "" _ (MSG RcvMessage {msgId = mId4, msgBody = EncRcvMsgBody body4}) <- tGet1 rh
-          Right ClientRcvMsgBody {msgBody = "hello 4"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret' (C.cbNonce mId4) body4)
+          Right ClientRcvMsgBody {msgBody = "hello 4"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret' mId4 body4)
          Resp "17" _ OK <- signSendRecv rh rKey' ("17", rId', ACK mId4)
          pure ()

@@ -307,7 +307,7 @@ registerToken nh apns token = do
  let dhSecret = C.dh' ntfDh dhPriv
      decryptCode nd =
        let Right verification = nd .-> "verification"
-            Right nonce = C.cbNonce <$> nd .-> "nonce"
+            Right nonce = C.cbNonce =<< nd .-> "nonce"
            Right pt = C.cbDecrypt dhSecret nonce verification
         in NtfRegCode pt
  let code = decryptCode ntfData
@@ -15,6 +15,7 @@ import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
 import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
 import Simplex.Messaging.Util (ifM, whenM)
 import System.Directory (doesFileExist, removeFile)
+import System.Info (os)
 import System.Process (readCreateProcess, shell)
 import Test.Hspec hiding (fit, it)
 import Util
@@ -57,14 +58,13 @@ postgresSchemaDumpTest migrations skipComparisonForDownMigrations testDBOpts@DBO

    getSchema :: FilePath -> IO String
    getSchema schemaPath = do
-      ci <- envCI
      let cmd =
            ("pg_dump " <> B.unpack connstr <> " --schema " <> B.unpack testDBSchema)
              <> " --schema-only --no-owner --no-privileges --no-acl --no-subscriptions --no-tablespaces > "
              <> schemaPath
      void $ readCreateProcess (shell cmd) ""
      threadDelay 20000
-      let sed = (if ci then "sed -i" else "sed -i ''")
+      let sed = (if os == "linux" then "sed -i" else "sed -i ''")
      void $ readCreateProcess (shell $ sed <> " '/^--/d; /^\\\\restrict/d; /^\\\\unrestrict/d' " <> schemaPath) ""
      sch <- readFile schemaPath
      sch `deepseq` pure sch
@@ -33,6 +33,7 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server (runSMPServerBlocking)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SMSType (..), SQSType (..))
+import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.Server
@@ -50,7 +51,6 @@ import Util

 #if defined(dbServerPostgres)
 import Database.PostgreSQL.Simple (defaultConnectInfo)
-import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
 #endif

 #if defined(dbPostgres) || defined(dbServerPostgres)
@@ -123,6 +123,12 @@ testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
 testStoreMsgsFile2 :: FilePath
 testStoreMsgsFile2 = "tests/tmp/smp-server-messages.log.2"

+testStoreMsgsDir :: FilePath
+testStoreMsgsDir = "tests/tmp/messages"
+
+testStoreMsgsDir2 :: FilePath
+testStoreMsgsDir2 = "tests/tmp/messages.2"
+
 testStoreNtfsFile :: FilePath
 testStoreNtfsFile = "tests/tmp/smp-server-ntfs.log"

@@ -206,35 +212,24 @@ ntfTestServerCredentials =
    }

 cfg :: AServerConfig
-cfg = cfgMS (ASType SQSMemory SMSMemory)
+cfg = cfgMS (ASType SQSMemory SMSJournal)

-cfgS2 :: AServerConfig
-cfgS2 = memoryCfg cfg testStoreLogFile2 testStoreMsgsFile2
+cfgJ2 :: AServerConfig
+cfgJ2 = journalCfg cfg testStoreLogFile2 testStoreMsgsDir2

-cfgS2QS :: SQSType s -> AServerConfig
-cfgS2QS = \case
-  SQSMemory -> memoryCfg (cfgMS $ ASType SQSMemory SMSMemory) testStoreLogFile2 testStoreMsgsFile2
-  SQSPostgres -> databaseCfg (cfgMS postgresStoreType) testStoreDBOpts2
+cfgJ2QS :: SQSType s -> AServerConfig
+cfgJ2QS = \case
+  SQSMemory -> journalCfg (cfgMS $ ASType SQSMemory SMSJournal) testStoreLogFile2 testStoreMsgsDir2
+  SQSPostgres -> journalCfgDB (cfgMS $ ASType SQSPostgres SMSJournal) testStoreDBOpts2 testStoreMsgsDir2

-memoryCfg :: AServerConfig -> FilePath -> FilePath -> AServerConfig
-memoryCfg (ASrvCfg _ _ cfg') storeLogFile storeMsgsFile =
-  ASrvCfg SQSMemory SMSMemory cfg' {serverStoreCfg = SSCMemory $ Just StorePaths {storeLogFile, storeMsgsFile = Just storeMsgsFile}}
+journalCfg :: AServerConfig -> FilePath -> FilePath -> AServerConfig
+journalCfg (ASrvCfg _ _ cfg') storeLogFile storeMsgsPath =
+  ASrvCfg SQSMemory SMSJournal cfg' {serverStoreCfg = SSCMemoryJournal {storeLogFile, storeMsgsPath}}

-databaseCfg :: AServerConfig -> DBOpts -> AServerConfig
-#if defined(dbServerPostgres)
-databaseCfg (ASrvCfg _ _ cfg') dbOpts =
+journalCfgDB :: AServerConfig -> DBOpts -> FilePath -> AServerConfig
+journalCfgDB (ASrvCfg _ _ cfg') dbOpts storeMsgsPath' =
  let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCYesUp, deletedTTL = 86400}
-   in ASrvCfg SQSPostgres SMSPostgres cfg' {serverStoreCfg = SSCDatabase storeCfg}
-#else
-databaseCfg _ _ = error "no dbServerPostgres flag"
-#endif
-
-postgresStoreType :: AStoreType
-#if defined(dbServerPostgres)
-postgresStoreType = ASType SQSPostgres SMSPostgres
-#else
-postgresStoreType = error "no dbServerPostgres flag"
-#endif
+   in ASrvCfg SQSPostgres SMSJournal cfg' {serverStoreCfg = SSCDatabaseJournal {storeCfg, storeMsgsPath'}}

 cfgMS :: AStoreType -> AServerConfig
 cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
@@ -243,6 +238,8 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
      smpHandshakeTimeout = 60000000,
      tbqSize = 4,
      msgQueueQuota = 4,
+      maxJournalMsgCount = 5,
+      maxJournalStateLines = 2,
      queueIdBytes = 24,
      msgIdBytes = 24,
      serverStoreCfg,
@@ -255,6 +252,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
      messageExpiration = Just defaultMessageExpiration,
      expireMessagesOnStart = True,
      expireMessagesOnSend = False,
+      idleQueueInterval = defaultIdleQueueInterval,
      notificationExpiration = defaultNtfExpiration,
      inactiveClientExpiration = Just defaultInactiveClientExpiration,
      logStatsInterval = Nothing,
@@ -265,6 +263,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
      prometheusMetricsFile = testPrometheusMetricsFile,
      pendingENDInterval = 500000,
      ntfDeliveryInterval = 200000,
+      authErrorDelay = 20000,
      smpCredentials =
        ServerCredentials
          { caCertificateFile = Just "tests/fixtures/ca.crt",
@@ -294,21 +293,20 @@ testServerStoreConfig :: AStoreType -> AServerStoreCfg
 testServerStoreConfig = serverStoreConfig_ False

 serverStoreConfig_ :: Bool -> AStoreType -> AServerStoreCfg
-#if defined(dbServerPostgres)
 serverStoreConfig_ useDbStoreLog = \case
-#else
-serverStoreConfig_ _ = \case
-#endif
  ASType SQSMemory SMSMemory ->
    ASSCfg SQSMemory SMSMemory $ SSCMemory $ Just StorePaths {storeLogFile = testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile}
+  ASType SQSMemory SMSJournal ->
+    ASSCfg SQSMemory SMSJournal $ SSCMemoryJournal {storeLogFile = testStoreLogFile, storeMsgsPath = testStoreMsgsDir}
+  ASType SQSPostgres SMSJournal ->
+    ASSCfg SQSPostgres SMSJournal SSCDatabaseJournal {storeCfg, storeMsgsPath' = testStoreMsgsDir}
 #if defined(dbServerPostgres)
  ASType SQSPostgres SMSPostgres ->
-    let dbStoreLogPath = if useDbStoreLog then Just testStoreLogFile else Nothing
-        storeCfg = PostgresStoreCfg {dbOpts = testStoreDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = 86400}
-     in ASSCfg SQSPostgres SMSPostgres $ SSCDatabase storeCfg
-#else
-  ASType SQSPostgres _ -> error "no dbServerPostgres flag"
+    ASSCfg SQSPostgres SMSPostgres $ SSCDatabase storeCfg
 #endif
+  where
+    dbStoreLogPath = if useDbStoreLog then Just testStoreLogFile else Nothing
+    storeCfg = PostgresStoreCfg {dbOpts = testStoreDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = 86400}

 cfgVPrev :: AStoreType -> AServerConfig
 cfgVPrev msType = updateCfg (cfgMS msType) $ \cfg' -> cfg' {smpServerVRange = prevRange $ smpServerVRange cfg'}
@@ -323,7 +321,7 @@ nextVersion :: Version v -> Version v
 nextVersion (Version v) = Version (v + 1)

 proxyCfg :: AServerConfig
-proxyCfg = proxyCfgMS (ASType SQSMemory SMSMemory)
+proxyCfg = proxyCfgMS (ASType SQSMemory SMSJournal)

 proxyCfgMS :: AStoreType -> AServerConfig
 proxyCfgMS msType =
@@ -334,13 +332,13 @@ proxyCfgMS msType =
            smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {agreeSecret = True, proxyServer = True, serverVRange = supportedProxyClientSMPRelayVRange}}
          }

-proxyCfgS2 :: AServerConfig
-proxyCfgS2 = memoryCfg proxyCfg testStoreLogFile2 testStoreMsgsFile2
+proxyCfgJ2 :: AServerConfig
+proxyCfgJ2 = journalCfg proxyCfg testStoreLogFile2 testStoreMsgsDir2

-proxyCfgS2QS :: SQSType qs -> AServerConfig
-proxyCfgS2QS = \case
-  SQSMemory -> memoryCfg (proxyCfgMS $ ASType SQSMemory SMSMemory) testStoreLogFile2 testStoreMsgsFile2
-  SQSPostgres -> databaseCfg (proxyCfgMS postgresStoreType) testStoreDBOpts2
+proxyCfgJ2QS :: SQSType qs -> AServerConfig
+proxyCfgJ2QS = \case
+  SQSMemory -> journalCfg (proxyCfgMS $ ASType SQSMemory SMSJournal) testStoreLogFile2 testStoreMsgsDir2
+  SQSPostgres -> journalCfgDB (proxyCfgMS $ ASType SQSPostgres SMSJournal) testStoreDBOpts2 testStoreMsgsDir2

 -- Proxy config with a short relay-connection timeout, to bound how long a failing
 -- proxy->relay connection attempt blocks in the relay reconnection tests.
@@ -422,10 +420,10 @@ withSmpServerProxy :: HasCallStack => (ASrvTransport, AStoreType) -> IO a -> IO
 withSmpServerProxy (t, msType) = withSmpServerConfigOn t (proxyCfgMS msType) testPort . const

 withSmpServers2 :: HasCallStack => (ASrvTransport, AStoreType) -> IO a -> IO a
-withSmpServers2 ps@(t, ASType qs _ms) = withSmpServer ps . withSmpServerConfigOn t (cfgS2QS qs) testPort2 . const
+withSmpServers2 ps@(t, ASType qs _ms) = withSmpServer ps . withSmpServerConfigOn t (cfgJ2QS qs) testPort2 . const

 withSmpServersProxy2 :: HasCallStack => (ASrvTransport, AStoreType) -> IO a -> IO a
-withSmpServersProxy2 ps@(t, ASType qs _ms) = withSmpServerProxy ps . withSmpServerConfigOn t (proxyCfgS2QS qs) testPort2 . const
+withSmpServersProxy2 ps@(t, ASType qs _ms) = withSmpServerProxy ps . withSmpServerConfigOn t (proxyCfgJ2QS qs) testPort2 . const

 runSmpTest :: forall c a. (HasCallStack, Transport c) => AStoreType -> (HasCallStack => THandleSMP c 'TClient -> IO a) -> IO a
 runSmpTest msType test = withSmpServerConfigOn (transport @c) (cfgMS msType) testPort $ \_ -> testSMPClient test
@@ -446,7 +444,7 @@ smpServerTest ::
  TProxy c 'TServer ->
  (Maybe TAuthorizations, ByteString, ByteString, smp) ->
  IO (Maybe TAuthorizations, ByteString, ByteString, BrokerMsg)
-smpServerTest _ t = runSmpTest (ASType SQSMemory SMSMemory) $ \h -> tPut' h t >> tGet' h
+smpServerTest _ t = runSmpTest (ASType SQSMemory SMSJournal) $ \h -> tPut' h t >> tGet' h
  where
    tPut' :: THandleSMP c 'TClient -> (Maybe TAuthorizations, ByteString, ByteString, smp) -> IO ()
    tPut' h@THandle {params = THandleParams {sessionId, implySessId}} (sig, corrId, queueId, smp) = do
@@ -26,7 +26,7 @@ import qualified Data.List.NonEmpty as L
 import Data.Time.Clock (getCurrentTime)
 import SMPAgentClient
 import SMPClient
-import ServerTests (decryptMsgV3, sendRecv)
+import ServerTests (decryptMsgV3, responseTime, sendRecv)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import qualified Simplex.Messaging.Agent as A
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..))
@@ -75,6 +75,10 @@ smpProxyTests = do
    xit "batching proxy requests" todo
    it "relay rejects forwarded command with changed version" $ \_ ->
      testChangedFwdVersion
+    it "proxy rejects forwarded correlation ID that is not 24 bytes" $ \_ ->
+      testFwdCorrIdSize
+    it "relay delays AUTH errors to forwarded commands" $ \_ ->
+      testForwardedAuthErrorDelay
  describe "deliver message via SMP proxy" $ do
    let srv1 = SMPServer testHost testPort testKeyHash
        srv2 = SMPServer testHost2 testPort2 testKeyHash
@@ -157,11 +161,11 @@ smpProxyTests = do
        let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs])
        it "25 agents, 300 pairs, 17 messages" . oneServer . withNumCapabilities 4 $ deliver 25 17
  where
-    oneServer test msType = withSmpServerConfigOn (transport @TLS) (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128}) testPort $ const test
+    oneServer test msType = withSmpServerConfigOn (transport @TLS) (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) testPort $ const test
    twoServers test msType = twoServers_ (proxyCfgMS msType) (proxyCfgMS msType) test msType
-    twoServersFirstProxy test msType = twoServers_ (proxyCfgMS msType) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128}) test msType
-    twoServersMoreConc test msType = twoServers_ (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {serverClientConcurrency = 128}) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128}) test msType
-    twoServersNoConc test msType = twoServers_ (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {serverClientConcurrency = 1}) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128}) test msType
+    twoServersFirstProxy test msType = twoServers_ (proxyCfgMS msType) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) test msType
+    twoServersMoreConc test msType = twoServers_ (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {serverClientConcurrency = 128}) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) test msType
+    twoServersNoConc test msType = twoServers_ (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {serverClientConcurrency = 1}) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) test msType
    twoServersPrevProxy test msType = twoServers_ (proxyCfgVPrev msType) (cfgMS msType) test msType
    twoServersPrevRelay test msType = twoServers_ (proxyCfgMS msType) (prevServerVRange $ cfgMS msType) test msType
    prevServerVRange cfg' = updateCfg cfg' $ \cfg_ -> cfg_ {smpServerVRange = prevRange $ smpServerVRange cfg_}
@@ -169,8 +173,8 @@ smpProxyTests = do
    twoServers_ cfg1 cfg2 runTest (ASType qsType _) =
      withSmpServerConfigOn (transport @TLS) cfg1 testPort $ \_ ->
        let cfg2' = case qsType of
-              SQSMemory -> memoryCfg cfg2 testStoreLogFile2 testStoreMsgsFile2
-              SQSPostgres -> databaseCfg cfg2 testStoreDBOpts2
+              SQSMemory -> journalCfg cfg2 testStoreLogFile2 testStoreMsgsDir2
+              SQSPostgres -> journalCfgDB cfg2 testStoreDBOpts2 testStoreMsgsDir2
         in withSmpServerConfigOn (transport @TLS) cfg2' testPort2 $ const runTest

 deliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => SMPServer -> SMPServer -> C.SAlgorithm a -> ByteString -> ByteString -> IO ()
@@ -401,15 +405,15 @@ agentViaProxyRetryOffline = do
            ackMessage alice bobId (baseId + 4) Nothing
  where
    withServer :: (ThreadId -> IO a) -> IO a
-    withServer = withServer_ testStoreLogFile testStoreMsgsFile testStoreNtfsFile testPort
+    withServer = withServer_ testStoreLogFile testStoreMsgsDir testStoreNtfsFile testPort
    -- TODO [postgres]
-    -- withServer = withServer_ testStoreDBOpts testStoreNtfsFile testPort
+    -- withServer = withServer_ testStoreDBOpts testStoreMsgsDir testStoreNtfsFile testPort
    withServer2 :: (ThreadId -> IO a) -> IO a
-    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testStoreNtfsFile2 testPort2
+    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsDir2 testStoreNtfsFile2 testPort2
    -- TODO [postgres]
-    -- withServer2 = withServer_ testStoreDBOpts2 testStoreNtfsFile2 testPort2
+    -- withServer2 = withServer_ testStoreDBOpts2 testStoreMsgsDir2 testStoreNtfsFile2 testPort2
    withServer_ storeLog storeMsgs storeNtfs =
-      let cfg' = updateCfg (memoryCfg proxyCfg storeLog storeMsgs) $ \cfg_ -> cfg_ {storeNtfsFile = Just storeNtfs}
+      let cfg' = updateCfg (journalCfg proxyCfg storeLog storeMsgs) $ \cfg_ -> cfg_ {storeNtfsFile = Just storeNtfs}
       in withSmpServerConfigOn (transport @TLS) cfg'
    a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
    a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
@@ -435,7 +439,7 @@ agentViaProxyRetryNoSession = do
          _ <- runRight $ makeConnection b a
          pure ()
  where
-    withServer2 = withSmpServerConfigOn (transport @TLS) proxyCfgS2 testPort2
+    withServer2 = withSmpServerConfigOn (transport @TLS) proxyCfgJ2 testPort2
    servers srv = initAgentServersProxy {smp = userServers [srv]}

 testNoProxy :: AStoreType -> IO ()
@@ -472,16 +476,41 @@ testChangedFwdVersion =
    nonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
    let v = currentClientSMPRelayVersion
    et <- either (fail . show) (pure . SMP.EncTransmission) $ C.cbEncrypt (C.dh' peerServerPubKey cmdPrivKey) (SMP.encTransmissionNonce v nonce) "" SMP.paddedProxiedTLength
-    let forward fwdVersion = forwardSMPTransmission rc (SMP.CorrId corrId) fwdVersion cmdPubKey et
+    let forward fwdVersion = forwardSMPTransmission rc (either error id $ C.corrCbNonce corrId) fwdVersion cmdPubKey et
    _ <- runExceptT' $ forward v
    runExceptT (forward $ prevVersion v) `shouldReturn` Left (PCEProtocolError SMP.CRYPTO)

+testFwdCorrIdSize :: IO ()
+testFwdCorrIdSize =
+  withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ ->
+    withSmpServerConfigOn (transport @TLS) cfgJ2 testPort2 $ \_ ->
+      testSMPClient_ "localhost" testPort supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
+        (_, _, Right (SMP.PKEY sessId _ _)) <- sendRecv th (Nothing, "1", NoEntity, SMP.PRXY testSMPServer2 Nothing)
+        g <- C.newRandom
+        (cmdPubKey, _) <- atomically $ C.generateKeyPair g
+        forM_ (["", "2", "3333333333333333333333333"] :: [ByteString]) $ \corrId -> do
+          (_, _, reply) <- sendRecv th (Nothing, corrId, SMP.EntityId sessId, SMP.PFWD currentClientSMPRelayVersion cmdPubKey (SMP.EncTransmission ""))
+          reply `shouldBe` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX)
+
+testForwardedAuthErrorDelay :: IO ()
+testForwardedAuthErrorDelay =
+  withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ ->
+    withSmpServerConfigOn (transport @TLS) (updateCfg cfgJ2 $ \cfg_ -> cfg_ {authErrorDelay = 500000}) testPort2 $ \_ -> do
+      g <- C.newRandom
+      ts <- getCurrentTime
+      pc <- either (fail . show) pure =<< getProtocolClient g NRMInteractive (1, testSMPServer, Nothing) defaultSMPClientConfig [] Nothing ts (\_ -> pure ())
+      sess <- runExceptT' $ connectSMPProxiedRelay pc NRMInteractive testSMPServer2 Nothing
+      (sendTime, Left (PCEProtocolError SMP.AUTH)) <- responseTime $ runExceptT $ proxySMPMessage pc NRMInteractive sess Nothing (SMP.EntityId "1234") noMsgFlags "hello"
+      (getLinkTime, Left (PCEProtocolError SMP.AUTH)) <- responseTime $ runExceptT $ proxyGetSMPQueueLink pc NRMInteractive sess (SMP.EntityId "1234")
+      sendTime `shouldSatisfy` (>= 0.5)
+      getLinkTime `shouldSatisfy` (>= 0.5)
+
 -- Shared "phase 2" of the reconnection tests: start a healthy relay, confirm it is reachable
 -- directly (PING, not via the proxy) so a proxy failure can only mean the proxy didn't reconnect,
 -- let any stored connection error expire, then require the proxy to establish the session (PKEY).
 requireProxyReconnect :: IO ()
 requireProxyReconnect =
-  withSmpServerConfigOn (transport @TLS) proxyCfgS2 testPort2 $ \_ -> do
+  withSmpServerConfigOn (transport @TLS) proxyCfgJ2 testPort2 $ \_ -> do
    testSMPClient_ "127.0.0.1" testPort2 supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
      (_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PING)
      reply `shouldBe` Right SMP.PONG
@@ -537,7 +566,7 @@ testAgentClientReconnectAfterCancel =
      t <- async $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
      threadDelay 1000000 -- let the connect to the stalling relay start, then kill it mid-flight
      cancel t
-    withSmpServerConfigOn (transport @TLS) cfgS2 testPort2 $ \_ -> do
+    withSmpServerConfigOn (transport @TLS) cfgJ2 testPort2 $ \_ -> do
      testSMPClient_ "127.0.0.1" testPort2 supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
        (_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PING)
        reply `shouldBe` Right SMP.PONG -- the relay is up and reachable, so a timeout can only be the poisoned var
@@ -24,6 +24,7 @@ import Control.Concurrent.STM
 import Control.Exception (SomeException, throwIO, try)
 import Control.Monad
 import Control.Monad.IO.Class
+import CoreTests.MsgStoreTests (testJournalStoreCfg)
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
@@ -35,6 +36,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.List (isPrefixOf)
 import Data.Maybe (catMaybes)
 import Data.String (IsString (..))
+import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)
 import Text.Read (readMaybe)
 import Data.Type.Equality
 import qualified Data.X509.Validation as XV
@@ -45,16 +47,18 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll, parseString)
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Server.Env.STM (AStoreType (..), ServerConfig (..), ServerStoreCfg (..))
+import Simplex.Messaging.Server (exportMessages)
+import Simplex.Messaging.Server.Env.STM (AStoreType (..), MsgStore (..), ServerConfig (..), ServerStoreCfg (..), readWriteQueueStore)
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Server.MsgStore.Types (SMSType (..), SQSType (..))
+import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..), QStoreCfg (..), stmQueueStore)
+import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), QSType (..), SMSType (..), SQSType (..), newMsgStore)
 import Simplex.Messaging.Server.Stats (PeriodStatsData (..), ServerStatsData (..))
-import Simplex.Messaging.Server.StoreLog (StoreLogRecord (..))
+import Simplex.Messaging.Server.StoreLog (StoreLogRecord (..), closeStoreLog)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Credentials
-import System.Directory (doesFileExist, removeFile)
+import Simplex.Messaging.Util (whenM)
+import System.Directory (doesDirectoryExist, doesFileExist, removeDirectoryRecursive, removeFile)
 import System.IO (IOMode (..), withFile)
-import System.TimeIt (timeItT)
 import System.Timeout
 import Test.HUnit
 import Test.Hspec hiding (fit, it)
@@ -62,11 +66,7 @@ import Util

 #if defined(dbServerPostgres)
 import CoreTests.MsgStoreTests (testPostgresStoreConfig)
-import Simplex.Messaging.Server.Env.STM (readWriteQueueStore)
 import Simplex.Messaging.Server.MsgStore.Postgres (PostgresMsgStoreCfg (..), exportDbMessages)
-import Simplex.Messaging.Server.MsgStore.STM (STMStoreConfig (..))
-import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), newMsgStore)
-import Simplex.Messaging.Server.StoreLog (closeStoreLog)
 #endif

 serverTests :: SpecWith (ASrvTransport, AStoreType)
@@ -97,6 +97,7 @@ serverTests = do
  describe "Restore messages (old / v2)" testRestoreExpireMessages
  describe "Save prometheus metrics" testPrometheusMetrics
  describe "Timing of AUTH error" testTiming
+  describe "Delay of AUTH error" testAuthErrorDelay
  describe "Message notifications" $ do
    testMessageNotifications
    testMessageServiceNotifications
@@ -166,7 +167,7 @@ signSend_ h@THandle {params} (C.APrivateAuthKey a pk) serviceKey_ (corrId, qId,
    authorize t = (,(`C.sign'` t) <$> serviceKey_) <$> case a of
      C.SEd25519 -> Just . TASignature . C.ASignature C.SEd25519 $ C.sign' pk t'
      C.SEd448 -> Just . TASignature . C.ASignature C.SEd448 $ C.sign' pk t'
-      C.SX25519 -> (\THAuthClient {peerServerPubKey = k} -> TAAuthenticator $ C.cbAuthenticate k pk (C.cbNonce corrId) t') <$> thAuth params
+      C.SX25519 -> (\THAuthClient {peerServerPubKey = k} -> TAAuthenticator $ C.cbAuthenticate k pk (C.unsafeCbNonce corrId) t') <$> thAuth params
 #if !MIN_VERSION_base(4,18,0)
      _sx448 -> undefined -- ghc8107 fails to the branch excluded by types
 #endif
@@ -194,12 +195,12 @@ _SEND = SEND noMsgFlags
 _SEND' :: MsgBody -> Command 'Sender
 _SEND' = SEND MsgFlags {notification = True}

-decryptMsgV2 :: C.DhSecret 'C.X25519 -> ByteString -> ByteString -> Either C.CryptoError ByteString
-decryptMsgV2 dhShared = C.cbDecrypt dhShared . C.cbNonce
+decryptMsgV2 :: C.DhSecret 'C.X25519 -> MsgId -> ByteString -> Either C.CryptoError ByteString
+decryptMsgV2 = C.cbDecrypt

-decryptMsgV3 :: C.DhSecret 'C.X25519 -> ByteString -> ByteString -> Either String MsgBody
+decryptMsgV3 :: C.DhSecret 'C.X25519 -> MsgId -> ByteString -> Either String MsgBody
 decryptMsgV3 dhShared nonce body =
-  case parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt dhShared (C.cbNonce nonce) body) of
+  case parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt dhShared nonce body) of
    Right ClientRcvMsgBody {msgBody} -> Right msgBody
    Right ClientRcvMsgQuota {} -> Left "ClientRcvMsgQuota"
    Left e -> Left e
@@ -425,7 +426,7 @@ testCreateDelete =
      Resp "dabc" _ err8 <- sendRecv sh ("", "dabc", sId, _SEND "hello")
      (err8, ERR AUTH) #== "rejects unsigned SEND too when deleted"

-      Resp "abcd" _ err11 <- signSendRecv rh rKey ("abcd", rId, ACK "")
+      Resp "abcd" _ err11 <- signSendRecv rh rKey ("abcd", rId, ACK mId2)
      (err11, ERR AUTH) #== "rejects ACK when conn deleted - the second message is deleted"

      Resp "bcda" _ err9 <- signSendRecv rh rKey ("bcda", rId, OFF)
@@ -609,7 +610,7 @@ testGetSubCommands =
      Resp "4" _ (Msg mId2 msg2) <- signSendRecv rh1 rKey ("4", rId, ACK mId1)
      (dec mId2 msg2, Right "hello 2") #== "received from queue via SUB"
      -- bad msgId returns error
-      Resp "5" _ (ERR NO_MSG) <- signSendRecv rh2 rKey ("5", rId, ACK "1234")
+      Resp "5" _ (ERR NO_MSG) <- signSendRecv rh2 rKey ("5", rId, ACK mId2)
      -- already ACK'd by subscriber, but still returns OK when msgId matches
      Resp "5a" _ OK <- signSendRecv rh2 rKey ("5a", rId, ACK mId1)
      -- msg2 is not lost - even if subscriber does not ACK it, it is delivered to getter
@@ -904,7 +905,7 @@ testServiceSubsTotalCount =
                _ -> pure Nothing
            ]
        threadDelay 1500000
-        readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric m `shouldBe` Just 2
+        B.readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric (B.unpack m) `shouldBe` Just 2

      -- Phase 2: associate 1 more queue via SUB, reconnect with SUBS 3, check metric = 3
      (rPub3, rKey3) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -934,7 +935,7 @@ testServiceSubsTotalCount =
                _ -> pure Nothing
            ]
        threadDelay 1500000
-        readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric m `shouldBe` Just 3
+        B.readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric (B.unpack m) `shouldBe` Just 3

 readServiceSubsMetric :: String -> Maybe Int
 readServiceSubsMetric content =
@@ -1068,6 +1069,7 @@ testRestoreMessages =
  it "should store messages on exit and restore on start" $ \(at@(ATransport t), msType) -> do
    removeFileIfExists testStoreLogFile
    removeFileIfExists testStoreMsgsFile
+    whenM (doesDirectoryExist testStoreMsgsDir) $ removeDirectoryRecursive testStoreMsgsDir
    removeFileIfExists testServerStatsBackupFile

    g <- C.newRandom
@@ -1137,6 +1139,7 @@ testRestoreMessages =
    Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
    checkStats stats3 [rId] 5 5
    removeFileIfExists testStoreMsgsFile
+    whenM (doesDirectoryExist testStoreMsgsDir) $ removeDirectoryRecursive testStoreMsgsDir
    removeFile testServerStatsBackupFile
  where
    runTest :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
@@ -1216,21 +1219,28 @@ testRestoreExpireMessages =
  where
    exportStoreMessages :: AStoreType -> IO ()
    exportStoreMessages = \case
+      ASType _ SMSJournal -> export
      ASType _ SMSPostgres -> exportDB
      ASType _ SMSMemory -> pure ()
      where
+        export = do
+          ms <- readWriteQueues
+          exportMessages False (StoreJournal ms) testStoreMsgsFile False
+          closeMsgStore ms
 #if defined(dbServerPostgres)
        exportDB = do
-          ms <- newMsgStore STMStoreConfig {storePath = Nothing, quota = 4}
-          readWriteQueueStore True (mkQueue ms) testStoreLogFile (queueStore ms) >>= closeStoreLog
-          removeFileIfExists testStoreMsgsFile
-          closeMsgStore ms
+          readWriteQueues >>= closeMsgStore
          ms' <- newMsgStore (testPostgresStoreConfig {quota = 4} :: PostgresMsgStoreCfg)
          _n <- withFile testStoreMsgsFile WriteMode $ exportDbMessages False ms'
          closeMsgStore ms'
 #else
        exportDB = error "compiled without server_postgres flag"
 #endif
+        readWriteQueues = do
+          ms <- newMsgStore ((testJournalStoreCfg MQStoreCfg) {quota = 4} :: JournalStoreConfig 'QSMemory)
+          readWriteQueueStore True (mkQueue ms True) testStoreLogFile (stmQueueStore ms) >>= closeStoreLog
+          removeFileIfExists testStoreMsgsFile
+          pure ms
    runTest :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
    runTest _ test' server = do
      testSMPClient test' `shouldReturn` ()
@@ -1265,21 +1275,21 @@ testTiming =
        smpTest2Cfg (cfgMS msType) supportedServerSMPRelayVRange t $ \rh sh ->
          testSameTiming rh sh tst msType
  where
-    testName :: (C.AuthAlg, C.AuthAlg, Int) -> String
-    testName (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, _) = unwords ["queue key:", show goodKeyAlg, "/ used key:", show badKeyAlg]
-    timingTests :: [(C.AuthAlg, C.AuthAlg, Int)]
+    testName :: (C.AuthAlg, C.AuthAlg) -> String
+    testName (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg) = unwords ["queue key:", show goodKeyAlg, "/ used key:", show badKeyAlg]
+    timingTests :: [(C.AuthAlg, C.AuthAlg)]
    timingTests =
-      [ (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd25519, 200), -- correct key type
-      -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd448, 150),
-      -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SX25519, 200),
-        (C.AuthAlg C.SEd448, C.AuthAlg C.SEd25519, 200),
-        (C.AuthAlg C.SEd448, C.AuthAlg C.SEd448, 150), -- correct key type
-        (C.AuthAlg C.SEd448, C.AuthAlg C.SX25519, 200),
-        (C.AuthAlg C.SX25519, C.AuthAlg C.SEd25519, 200),
-        (C.AuthAlg C.SX25519, C.AuthAlg C.SEd448, 150),
-        (C.AuthAlg C.SX25519, C.AuthAlg C.SX25519, 200) -- correct key type
+      [ (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd25519), -- correct key type
+      -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd448),
+      -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SX25519),
+        (C.AuthAlg C.SEd448, C.AuthAlg C.SEd25519),
+        (C.AuthAlg C.SEd448, C.AuthAlg C.SEd448), -- correct key type
+        (C.AuthAlg C.SEd448, C.AuthAlg C.SX25519),
+        (C.AuthAlg C.SX25519, C.AuthAlg C.SEd25519),
+        (C.AuthAlg C.SX25519, C.AuthAlg C.SEd448),
+        (C.AuthAlg C.SX25519, C.AuthAlg C.SX25519) -- correct key type
      ]
-    timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
+    timeRepeat = fmap fst . responseTime . replicateM_ 5
    similarTime t1 t2 msType
      | t1 <= t2 = abs (1 - t1 / t2) < diff
      | otherwise = similarTime t2 t1 msType
@@ -1288,14 +1298,14 @@ testTiming =
        diff = case msType of
          ASType SQSPostgres _ -> 0.45
          _ -> 0.3
-    testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg, Int) -> AStoreType -> Expectation
-    testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, n) msType = do
+    testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg) -> AStoreType -> Expectation
+    testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg) msType = do
      g <- C.newRandom
      (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", NoEntity, New rPub dhPub)
+      Resp "abcdabcdabcdabcdabcdabcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcdabcdabcdabcdabcdabcd", NoEntity, New rPub dhPub)
      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
-      Resp "cdab" _ resp <- signSendRecv rh rKey ("cdab", rId, SUB)
+      Resp "cdabcdabcdabcdabcdabcdab" _ resp <- signSendRecv rh rKey ("cdabcdabcdabcdabcdabcdab", rId, SUB)
      case resp of
        OK -> pure ()
        SOK Nothing -> pure ()
@@ -1305,9 +1315,9 @@ testTiming =
      runTimingTest rh badKey rId SUB

      (sPub, sKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
-      Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, KEY sPub)
+      Resp "dabcdabcdabcdabcdabcdabc" _ OK <- signSendRecv rh rKey ("dabcdabcdabcdabcdabcdabc", rId, KEY sPub)

-      Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, _SEND "hello")
+      Resp "bcdabcdabcdabcdabcdabcda" _ OK <- signSendRecv sh sKey ("bcdabcdabcdabcdabcdabcda", sId, _SEND "hello")
      Resp "" _ (Msg mId msg) <- tGet1 rh
      (dec mId msg, Right "hello") #== "delivered from queue"

@@ -1316,17 +1326,17 @@ testTiming =
        runTimingTest :: PartyI p => THandleSMP c 'TClient -> C.APrivateAuthKey -> EntityId -> Command p -> IO ()
        runTimingTest h badKey qId cmd = do
          threadDelay 100000
-          _ <- timeRepeat n $ do
+          _ <- timeRepeat $ do
            -- "warm up" the server
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
+            Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
            return ()
          threadDelay 100000
-          timeWrongKey <- timeRepeat n $ do
-            Resp "cdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdab", qId, cmd)
+          timeWrongKey <- timeRepeat $ do
+            Resp "cdabcdabcdabcdabcdabcdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdabcdabcdabcdabcdabcdab", qId, cmd)
            return ()
          threadDelay 100000
-          timeNoQueue <- timeRepeat n $ do
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
+          timeNoQueue <- timeRepeat $ do
+            Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
            return ()
          let ok = similarTime timeNoQueue timeWrongKey msType
          unless ok . putStrLn . unwords $
@@ -1338,6 +1348,33 @@ testTiming =
            ]
          ok `shouldBe` True

+testAuthErrorDelay :: SpecWith (ASrvTransport, AStoreType)
+testAuthErrorDelay =
+  it "should send AUTH errors after the delay and other responses without it" $ \(ATransport t, msType) ->
+    smpTest2Cfg (updateCfg (cfgMS msType) $ \cfg' -> cfg' {authErrorDelay = 500000}) supportedClientSMPRelayVRange t $ \rh sh -> do
+      g <- C.newRandom
+      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      Resp "1" NoEntity (Ids rId sId _) <- signSendRecv rh rKey ("1", NoEntity, New rPub dhPub)
+      (_, badKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      (wrongKeyTime, Resp "2" _ (ERR AUTH)) <- responseTime $ signSendRecv rh badKey ("2", rId, SUB)
+      (noQueueTime, Resp "3" _ (ERR AUTH)) <- responseTime $ signSendRecv rh badKey ("3", EntityId "1234", SUB)
+      (noLinkTime, Resp "4" _ (ERR AUTH)) <- responseTime $ sendRecv sh ("", "4", EntityId "1234", LGET)
+      (subTime, Resp "5" _ (SOK Nothing)) <- responseTime $ signSendRecv rh rKey ("5", rId, SUB)
+      Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, OFF)
+      (suspendedTime, Resp "7" _ (ERR AUTH)) <- responseTime $ sendRecv sh ("", "7", sId, _SEND "hello")
+      wrongKeyTime `shouldSatisfy` (>= 0.5)
+      noQueueTime `shouldSatisfy` (>= 0.5)
+      suspendedTime `shouldSatisfy` (>= 0.5)
+      noLinkTime `shouldSatisfy` (>= 0.5)
+      subTime `shouldSatisfy` (< 0.5)
+
+responseTime :: IO a -> IO (NominalDiffTime, a)
+responseTime action = do
+  t <- getCurrentTime
+  r <- action
+  (,r) . (`diffUTCTime` t) <$> getCurrentTime
+
 testMessageNotifications :: SpecWith (ASrvTransport, AStoreType)
 testMessageNotifications =
  it "should create simplex connection, subscribe notifier and deliver notifications" $ \(ATransport t, msType) -> do
@@ -1540,7 +1577,7 @@ testMsgExpireOnInterval =
  it "should expire messages that are not received before messageTTL after expiry interval" $ \(ATransport (t :: TProxy c 'TServer), msType) -> do
    g <- C.newRandom
    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
+    let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}, idleQueueInterval = 1}
    withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
      testSMPClient @c $ \sh -> do
        (sId, rId, rKey, _) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
@@ -1805,10 +1842,10 @@ serverSyntaxTests (ATransport t) = do
    it "no parameters" $ (sampleSig, "abcd", "12345678", SEND_) >#> ("", "abcd", "12345678", ERR $ CMD SYNTAX)
    it "no queue ID" $ (sampleSig, "bcda", "", (SEND_, ' ', noMsgFlags, ' ', "hello" :: ByteString)) >#> ("", "bcda", "", ERR $ CMD NO_ENTITY)
  describe "ACK" $ do
-    it "valid syntax" $ (sampleSig, "cdab", "12345678", (ACK_, ' ', "1234" :: ByteString)) >#> ("", "cdab", "12345678", ERR AUTH)
+    it "valid syntax" $ (sampleSig, "cdab", "12345678", (ACK_, ' ', "123456789012345678901234" :: ByteString)) >#> ("", "cdab", "12345678", ERR AUTH)
    it "no parameters" $ (sampleSig, "abcd", "12345678", ACK_) >#> ("", "abcd", "12345678", ERR $ CMD SYNTAX)
-    it "no queue ID" $ (sampleSig, "bcda", "", (ACK_, ' ', "1234" :: ByteString)) >#> ("", "bcda", "", ERR $ CMD NO_AUTH)
-    it "no signature" $ ("", "cdab", "12345678", (ACK_, ' ', "1234" :: ByteString)) >#> ("", "cdab", "12345678", ERR $ CMD NO_AUTH)
+    it "no queue ID" $ (sampleSig, "bcda", "", (ACK_, ' ', "123456789012345678901234" :: ByteString)) >#> ("", "bcda", "", ERR $ CMD NO_AUTH)
+    it "no signature" $ ("", "cdab", "12345678", (ACK_, ' ', "123456789012345678901234" :: ByteString)) >#> ("", "cdab", "12345678", ERR $ CMD NO_AUTH)
  describe "PING" $ do
    it "valid syntax" $ ("", "abcd", "", PING_) >#> ("", "abcd", "", PONG)
  describe "broker response not allowed" $ do
@@ -115,15 +115,19 @@ main = do
              testStoreDBOpts
              "src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql"
        around_ (postgressBracket testServerDBConnectInfo) $ do
+          -- xdescribe "SMP server via TLS, postgres+jornal message store" $
+          --   before (pure (transport @TLS, ASType SQSPostgres SMSJournal)) serverTests
          describe "SMP server via TLS, postgres-only message store" $
            before (pure (transport @TLS, ASType SQSPostgres SMSPostgres)) serverTests
 #endif
-        describe "SMP server via TLS, memory message store" $ do
+        describe "SMP server via TLS, jornal message store" $ do
          describe "SMP syntax" $ serverSyntaxTests (transport @TLS)
+          before (pure (transport @TLS, ASType SQSMemory SMSJournal)) serverTests
+        describe "SMP server via TLS, memory message store" $
          before (pure (transport @TLS, ASType SQSMemory SMSMemory)) serverTests
        -- xdescribe "SMP server via WebSockets" $ do
        --   describe "SMP syntax" $ serverSyntaxTests (transport @WS)
-        --   before (pure (transport @WS, ASType SQSMemory SMSMemory)) serverTests
+        --   before (pure (transport @WS, ASType SQSMemory SMSJournal)) serverTests
 #if defined(dbServerPostgres)
        around_ (postgressBracket ntfTestServerDBConnectInfo) $
          describe "Ntf server schema dump" $
@@ -136,16 +140,22 @@ main = do
          describe "Notifications server (SMP server: memory store)" $
            ntfServerTests (transport @TLS, ASType SQSMemory SMSMemory)
          around_ (postgressBracket testServerDBConnectInfo) $ do
+            -- xdescribe "Notifications server (SMP server: postgres+jornal store)" $
+            --   ntfServerTests (transport @TLS, ASType SQSPostgres SMSJournal)
            describe "Notifications server (SMP server: postgres-only store)" $
              ntfServerTests (transport @TLS, ASType SQSPostgres SMSPostgres)
        around_ (postgressBracket testServerDBConnectInfo) $ do
+          -- xdescribe "SMP client agent, postgres+jornal message store" $ agentTests (transport @TLS, ASType SQSPostgres SMSJournal)
          describe "SMP client agent, server postgres-only message store" $ agentTests (transport @TLS, ASType SQSPostgres SMSPostgres)
+          -- xdescribe "SMP proxy, postgres+jornal message store" $
+          --   before (pure $ ASType SQSPostgres SMSJournal) smpProxyTests
          describe "SMP proxy, postgres-only message store" $
            before (pure $ ASType SQSPostgres SMSPostgres) smpProxyTests
 #endif
+        -- xdescribe "SMP client agent, server jornal message store" $ agentTests (transport @TLS, ASType SQSMemory SMSJournal)
        describe "SMP client agent, server memory message store" $ agentTests (transport @TLS, ASType SQSMemory SMSMemory)
-        describe "SMP proxy, memory message store" $
-          before (pure $ ASType SQSMemory SMSMemory) smpProxyTests
+        describe "SMP proxy, jornal message store" $
+          before (pure $ ASType SQSMemory SMSJournal) smpProxyTests
        describe "XFTP" $ do
          describe "XFTP server" $
            before (pure $ AFSType SFSMemory) xftpServerTests
@@ -56,7 +56,7 @@ instance Example a => Example (TestWrapper a) where
    ci <- envCI
    runTest `E.catches` [E.Handler (onTestFailure ci), E.Handler (onTestException ci)]
    where
-      tt = 120
+      tt = 300
      runTest =
        timeout (tt * 1000000) (evaluateExample action params hooks state) `finally` callCommand "sync" >>= \case
          Just r -> pure r
@@ -768,7 +768,7 @@ tsSecretboxTests :: Spec
 tsSecretboxTests = describe "crypto/secretbox" $ do
  let key32 = B.pack [1 .. 32]
      nonce24 = B.pack [1 .. 24]
-      cbNonceVal = C.cbNonce nonce24
+      cbNonceVal = C.unsafeCbNonce nonce24
      sbKeyVal = C.unsafeSbKey key32

  describe "NaCl secretbox (tag prepended)" $ do
@@ -979,7 +979,7 @@ tsFileCryptoTests :: Spec
 tsFileCryptoTests = describe "crypto/file" $ do
  let key32 = B.pack [1 .. 32]
      nonce24 = B.pack [1 .. 24]
-      cbNonceVal = C.cbNonce nonce24
+      cbNonceVal = C.unsafeCbNonce nonce24
      sbKeyVal = C.unsafeSbKey key32

  describe "FileHeader encoding" $ do
@@ -2329,7 +2329,7 @@ tsClientTests = describe "protocol/client" $ do
            C.cbAuthenticate
              (C.PublicKeyX25519 pubA)
              (C.PrivateKeyX25519 privB)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
              msg
      tsResult <-
        callNode $
@@ -2352,7 +2352,7 @@ tsClientTests = describe "protocol/client" $ do
            C.cbAuthenticate
              (C.PublicKeyX25519 pubA)
              (C.PrivateKeyX25519 privB)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
              msg
      B.length expected `shouldBe` 80

@@ -2363,7 +2363,7 @@ tsClientTests = describe "protocol/client" $ do
            C.cbAuthenticate
              (C.PublicKeyX25519 pubA)
              (C.PrivateKeyX25519 privB)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
              msg
      tsResult <-
        callNode $
@@ -2389,7 +2389,7 @@ tsClientTests = describe "protocol/client" $ do
            C.cbAuthenticate
              (C.PublicKeyX25519 pubA)
              (C.PrivateKeyX25519 privB)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
              msg
      tsResult <-
        callNode $
@@ -2427,7 +2427,7 @@ tsClientTests = describe "protocol/client" $ do
            C.cbVerify
              (C.PublicKeyX25519 pubB)
              (C.PrivateKeyX25519 privA)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
              (C.CbAuthenticator tsAuth)
              msg
      hsValid `shouldBe` True
@@ -2438,7 +2438,7 @@ tsClientTests = describe "protocol/client" $ do

    it "encryptTransportChunk matches Haskell" $ do
      let plaintext = B.pack [100 .. 199]
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
          (cipher, state1) = LC.sbEncryptChunk state0 plaintext
          tag = BA.convert $ LC.sbAuth state1 :: B.ByteString
          expected = cipher <> tag
@@ -2457,7 +2457,7 @@ tsClientTests = describe "protocol/client" $ do

    it "decryptTransportChunk decrypts Haskell-encrypted data" $ do
      let plaintext = B.pack ([200 .. 255] <> [0 .. 99])
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
          (cipher, state1) = LC.sbEncryptChunk state0 plaintext
          tag = BA.convert $ LC.sbAuth state1 :: B.ByteString
          encData = cipher <> tag
@@ -2542,7 +2542,7 @@ tsDownloadTests = describe "download" $ do
      -- File-level key/nonce (different from transport)
      fileKey32 = B.pack [1 .. 32]
      fileNonce24 = B.pack [1 .. 24]
-      fileCbNonce = C.cbNonce fileNonce24
+      fileCbNonce = C.unsafeCbNonce fileNonce24
      fileSbKey = C.unsafeSbKey fileKey32

  describe "processFileResponse" $ do
@@ -2568,7 +2568,7 @@ tsDownloadTests = describe "download" $ do
          dhSecretBytes = case dhSecret of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
          chunkData = B.pack [50 .. 149]
          chunkDigest = C.sha256Hash chunkData
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
          (cipher, state1) = LC.sbEncryptChunk state0 chunkData
          tag = BA.convert (LC.sbAuth state1) :: B.ByteString
          encData = cipher <> tag
@@ -2592,7 +2592,7 @@ tsDownloadTests = describe "download" $ do
          dhSecretBytes = case dhSecret of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
          chunkData = B.pack [50 .. 149]
          wrongDigest = B.replicate 32 0xff
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
          (cipher, state1) = LC.sbEncryptChunk state0 chunkData
          tag = BA.convert (LC.sbAuth state1) :: B.ByteString
          encData = cipher <> tag
@@ -2615,7 +2615,7 @@ tsDownloadTests = describe "download" $ do
      let dhSecret = C.dh' (C.PublicKeyX25519 pubA) (C.PrivateKeyX25519 privB)
          dhSecretBytes = case dhSecret of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
          chunkData = B.pack [10 .. 50]
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
          (cipher, state1) = LC.sbEncryptChunk state0 chunkData
          tag = BA.convert (LC.sbAuth state1) :: B.ByteString
          encData = cipher <> tag
@@ -2652,7 +2652,7 @@ tsDownloadTests = describe "download" $ do
      -- Step 2: transport-level encryption (simulates server sending chunk)
      let dhSecret = C.dh' (C.PublicKeyX25519 pubA) (C.PrivateKeyX25519 privB)
          dhSecretBytes = case dhSecret of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
-          ts0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          ts0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
          (transportCipher, ts1) = LC.sbEncryptChunk ts0 fileEncrypted
          transportTag = BA.convert (LC.sbAuth ts1) :: B.ByteString
          transportEncData = transportCipher <> transportTag
@@ -2702,7 +2702,7 @@ tsDownloadTests = describe "download" $ do
          dhSecret1 = C.dh' (C.PublicKeyX25519 pubA) (C.PrivateKeyX25519 privB)
          dhSecret1Bytes = case dhSecret1 of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
          nonce1 = nonce24
-          t1s0 = either (error . show) id $ LC.cbInit dhSecret1 (C.cbNonce nonce1)
+          t1s0 = either (error . show) id $ LC.cbInit dhSecret1 (C.unsafeCbNonce nonce1)
          (t1cipher, t1s1) = LC.sbEncryptChunk t1s0 fileChunk1
          t1tag = BA.convert (LC.sbAuth t1s1) :: B.ByteString
          transportEnc1 = t1cipher <> t1tag
@@ -2710,7 +2710,7 @@ tsDownloadTests = describe "download" $ do
          nonce2 = B.pack [24 .. 47]
          dhSecret2 = C.dh' (C.PublicKeyX25519 pubB) (C.PrivateKeyX25519 privA)
          dhSecret2Bytes = case dhSecret2 of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
-          t2s0 = either (error . show) id $ LC.cbInit dhSecret2 (C.cbNonce nonce2)
+          t2s0 = either (error . show) id $ LC.cbInit dhSecret2 (C.unsafeCbNonce nonce2)
          (t2cipher, t2s1) = LC.sbEncryptChunk t2s0 fileChunk2
          t2tag = BA.convert (LC.sbAuth t2s1) :: B.ByteString
          transportEnc2 = t2cipher <> t2tag
@@ -2748,7 +2748,7 @@ tsDownloadTests = describe "download" $ do
      -- Client side: generate FGET command
      let dhSecret = C.dh' (C.PublicKeyX25519 pubA) (C.PrivateKeyX25519 privB)
          chunkData = "FGET round-trip test data" :: B.ByteString
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
          (cipher, state1) = LC.sbEncryptChunk state0 chunkData
          tag = BA.convert (LC.sbAuth state1) :: B.ByteString
          encData = cipher <> tag
Author	SHA1	Message	Date
Evgeny Poberezkin	cba1382356	7.1.0.11	2026-10-11 22:33:06 +01:00
EvgenyandEvgeny @ SimpleX Chat	b5e8a4b8cc	fix tests on ghc 8.10.7 (#1939 ) * fix tests on ghc 8.10.7 * fix test * fix schema dump test --------- Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>	2026-10-11 20:36:51 +01:00
EvgenyandEvgeny @ SimpleX Chat	3db4029bb9	ci: build cache (#1938 ) * ci: build cache * update build job * rename steps, cache all builds, patch timestamps for ghc 8.10.7 * refactor, save O0 caches in master and stable builds * update build to include toolchain fingerprint * do not save cache on exact match * remove caching docker from prs --------- Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>	2026-10-11 11:52:24 +01:00
EvgenyandEvgeny @ SimpleX Chat	8a80727fa5	smp server: delayed AUTH responses (#1937 ) * smp server: delayed AUTH responses * plan * update * simplify * simplify * stat when sent without delay * update schema * round up response time to the nearest delay multiple --------- Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>	2026-10-11 07:37:33 +01:00
EvgenyandEvgeny @ SimpleX Chat	a2f985dc68	agent: prepare invitation link, create ratchet when connection is prepared (#1880 ) * agent: prepare invitation link * simplify * refactor * fix * change min SMP version to 15 * remove dead code for SMP version <= 15 * update * diff * create ratchet when connection is prepared * createRatchetIfNotExists * clean up, only check client notices for contacts, fix orphan record * simplify * refactor --------- Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>	2026-10-10 23:15:19 +01:00
EvgenyandEvgeny @ SimpleX Chat	c18e0297c4	agent: migration to add index to read queues (#1934 ) * agent: migration to add index to read queues * update postgres schema --------- Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>	2026-10-08 17:07:55 +01:00
EvgenyandEvgeny @ SimpleX Chat	e24d537eaa	agent: fix race when switching reception to the new queue (#1933 ) * agent: fix race when switching reception to the new queue * return bool --------- Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>	2026-10-08 16:03:06 +01:00
sh	7754f8624e	smp-server: copy entity IDs out of received block (#1906 )	2026-10-08 15:28:38 +01:00
EvgenyandEvgeny @ SimpleX Chat	8d81f775b1	smp protocol: require fixed size corr ID when used as nonce, and min size msg ID to use as nonce (#1925 ) * smp protocol: require fixed size corr ID when used as nonce, and min size msg ID to use as nonce * simpler * fixes * randomMsgId --------- Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>	2026-10-08 09:32:11 +01:00
EvgenyandEvgeny @ SimpleX Chat	c0a1b7bd2d	agent: fail database transaction instantly when database is closed, prevent race conditions in command processing, fix race when uploading files (#1885 ) * agent: fail database transaction instantly when database is closed * update direct-sqlcipher * update direct-sqlcipher, fixes * autoincrement command ID --------- Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>	2026-10-06 13:01:55 +01:00