6.4.5.1

servers: better socket leak prevention during TLS handshake, add NetworkError type to better diagnose connection errors (#1619 )
* servers: better socket leak prevention during TLS handshake * log tcp connection errors * more detailed network error * log full address * rename error * add encodings for NetworkError * refactor * comment * bind * style * remove parameters of NETWORK error from encoding
2026-08-30 07:38:44 +00:00 · 2025-09-03 11:12:20 +01:00 · 2025-09-02 16:07:37 +01:00 · 2025-09-01 18:57:09 +01:00 · 2025-09-01 17:45:31 +01:00 · 2025-08-29 08:33:55 +01:00
179 changed files with 19216 additions and 6466 deletions
@@ -0,0 +1,44 @@
+name: 'Set Swap Space'
+description: 'Add moar swap'
+branding:
+  icon: 'crop'
+  color: 'orange'
+inputs:
+  swap-size-gb:
+    description: 'Swap space to create, in Gigabytes.'
+    required: false
+    default: '10'
+runs:
+  using: "composite"
+  steps:
+    - name: Swap space report before modification
+      shell: bash
+      run: |
+        echo "Memory and swap:"
+        free -h
+        echo
+        swapon --show
+        echo
+    - name: Set Swap
+      shell: bash
+      run: |
+          export SWAP_FILE=$(swapon --show=NAME | tail -n 1)
+          echo "Swap file: $SWAP_FILE"
+          if [ -z "$SWAP_FILE" ]; then
+            SWAP_FILE=/opt/swapfile
+          else
+            sudo swapoff $SWAP_FILE
+            sudo rm $SWAP_FILE
+          fi
+          sudo fallocate -l ${{ inputs.swap-size-gb }}G $SWAP_FILE
+          sudo chmod 600 $SWAP_FILE
+          sudo mkswap $SWAP_FILE
+          sudo swapon $SWAP_FILE
+    - name: Swap space report after modification
+      shell: bash
+      run: |
+        echo "Memory and swap:"
+        free -h
+        echo
+        swapon --show
+        echo
@@ -10,62 +10,25 @@ on:
  pull_request:

 jobs:
-  build:
-    name: build-${{ matrix.os }}-${{ matrix.ghc }}
-    runs-on: ${{ matrix.os }}
-    strategy:
-      fail-fast: false
-      matrix:
-        include:
-          - os: ubuntu-20.04
-            platform_name: 20_04-x86-64
-            ghc: "8.10.7"
-          - os: ubuntu-20.04
-            platform_name: 20_04-x86-64
-            ghc: "9.6.3"
-          - os: ubuntu-22.04
-            platform_name: 22_04-x86-64
-            ghc: "9.6.3"
+
+# =============================
+#       Create release
+# =============================
+
+# Create release, but only if it's triggered by tag push.
+# On pull requests/commits push, this job will always complete.
+
+  maybe-release:
+    runs-on: ubuntu-latest
    steps:
      - name: Clone project
+        if: startsWith(github.ref, 'refs/tags/v')
        uses: actions/checkout@v3

-      - name: Setup Haskell
-        uses: haskell-actions/setup@v2
-        with:
-          ghc-version: ${{ matrix.ghc }}
-          cabal-version: "3.10.1.0"
-
-      - name: Cache dependencies
-        uses: actions/cache@v2
-        with:
-          path: |
-            ~/.cabal/store
-            dist-newstyle
-          key: ${{ matrix.os }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }}
-
-      - name: Build
-        shell: bash
-        run: cabal build --enable-tests
-
-      - name: Test
-        timeout-minutes: 40
-        shell: bash
-        run: cabal test --test-show-details=direct
-
-      - name: Prepare binaries
-        if: startsWith(github.ref, 'refs/tags/v')
-        shell: bash
-        run: |
-          mv $(cabal list-bin smp-server) smp-server-ubuntu-${{ matrix.platform_name}}
-          mv $(cabal list-bin ntf-server) ntf-server-ubuntu-${{ matrix.platform_name}}
-          mv $(cabal list-bin xftp-server) xftp-server-ubuntu-${{ matrix.platform_name}}
-          mv $(cabal list-bin xftp) xftp-ubuntu-${{ matrix.platform_name}}
-
      - name: Build changelog
-        if: startsWith(github.ref, 'refs/tags/v')
        id: build_changelog
-        uses: mikepenz/release-changelog-builder-action@v1
+        if: startsWith(github.ref, 'refs/tags/v')
+        uses: simplex-chat/release-changelog-builder-action@v5
        with:
          configuration: .github/changelog_conf.json
          failOnError: true
@@ -75,8 +38,8 @@ jobs:
          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}

      - name: Create release
-        if: startsWith(github.ref, 'refs/tags/v') && matrix.ghc != '8.10.7'
-        uses: softprops/action-gh-release@v1
+        if: startsWith(github.ref, 'refs/tags/v')
+        uses: simplex-chat/action-gh-release@v2
        with:
          body: |
            See full changelog [here](https://github.com/simplex-chat/simplexmq/blob/master/CHANGELOG.md).
@@ -86,10 +49,222 @@ jobs:
          prerelease: true
          files: |
            LICENSE
-            smp-server-ubuntu-${{ matrix.platform_name}}
-            ntf-server-ubuntu-${{ matrix.platform_name}}
-            xftp-server-ubuntu-${{ matrix.platform_name}}
-            xftp-ubuntu-${{ matrix.platform_name}}
          fail_on_unmatched_files: true
        env:
          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+
+# =============================
+#        Main build job
+# =============================
+
+  build:
+    name: "ubuntu-${{ matrix.os }}, GHC: ${{ matrix.ghc }}"
+    needs: maybe-release
+    env:
+      apps: "smp-server xftp-server ntf-server xftp"
+    runs-on: ubuntu-${{ matrix.os }}
+    services:
+      postgres:
+        image: postgres:15
+        env:
+          POSTGRES_HOST_AUTH_METHOD: trust # Allows passwordless access
+        options: >-
+          --health-cmd pg_isready
+          --health-interval 10s
+          --health-timeout 5s
+          --health-retries 5
+        ports:
+          # Maps tcp port 5432 on service container to the host
+          - 5432:5432
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          - os: 22.04
+            ghc: "8.10.7"
+            platform_name: 22_04-8.10.7
+            should_run: ${{ !(github.ref == 'refs/heads/stable' || startsWith(github.ref, 'refs/tags/v')) }}
+          - os: 22.04
+            ghc: "9.6.3"
+            platform_name: 22_04-x86-64
+            should_run: true
+          - os: 24.04
+            ghc: "9.6.3"
+            platform_name: 24_04-x86-64
+            should_run: true
+    steps:
+      - name: Clone project
+        if: matrix.should_run == true
+        uses: actions/checkout@v3
+
+      - name: Set up Docker Buildx
+        if: matrix.should_run == true
+        uses: simplex-chat/docker-setup-buildx-action@v3
+
+      - name: Setup swap
+        if: matrix.ghc == '8.10.7' && matrix.should_run == true
+        uses: ./.github/actions/swap
+        with:
+          swap-size-gb: 20
+
+      - name: Install PostgreSQL 15 client tools
+        if: matrix.os == '22.04' && matrix.should_run == true
+        shell: bash
+        run: |
+          # Import the repository signing key
+          sudo install -d /usr/share/postgresql-common/pgdg
+          sudo curl -o /usr/share/postgresql-common/pgdg/apt.postgresql.org.asc --fail https://www.postgresql.org/media/keys/ACCC4CF8.asc
+          # Add the PostgreSQL APT repository
+          sudo sh -c 'echo "deb [signed-by=/usr/share/postgresql-common/pgdg/apt.postgresql.org.asc] https://apt.postgresql.org/pub/repos/apt $(lsb_release -cs)-pgdg main" > /etc/apt/sources.list.d/pgdg.list'
+          # Update repository and install postgresql tools
+          sudo apt update
+          sudo apt -y install postgresql-client-15
+
+      - name: Build and cache Docker image
+        if: matrix.should_run == true
+        uses: simplex-chat/docker-build-push-action@v6
+        with:
+          context: .
+          load: true
+          file: Dockerfile.build
+          tags: build/${{ matrix.platform_name }}:latest
+          cache-from: |
+            type=gha
+            type=gha,scope=master
+          cache-to: type=gha,mode=max
+          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: ${{ matrix.os }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }}
+
+      - name: Start container
+        if: matrix.should_run == true
+        shell: bash
+        run: |
+          docker run -t -d \
+            --name builder \
+            -v ~/.cabal:/root/.cabal \
+            -v /home/runner/work/_temp:/home/runner/work/_temp \
+            -v ${{ github.workspace }}:/project \
+            build/${{ matrix.platform_name }}:latest
+
+      - name: Build smp-server (postgresql) and tests
+        if: matrix.should_run == true
+        shell: docker exec -t builder sh -eu {0}
+        run: |
+          cabal update
+          cabal build --jobs=$(nproc) --enable-tests -fserver_postgres
+          mkdir -p /out
+          for i in smp-server simplexmq-test; do
+            bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
+            chmod +x "$bin"
+            mv "$bin" /out/
+          done
+          strip /out/smp-server
+
+      - name: Copy simplexmq-test from container
+        if: matrix.should_run == true
+        shell: bash
+        run: |
+          docker cp builder:/out/simplexmq-test .
+
+      - name: Copy smp-server (postgresql) from container and prepare it
+        if: startsWith(github.ref, 'refs/tags/v') && matrix.should_run == true
+        id: prepare-postgres
+        shell: bash
+        run: |
+          name="smp-server-postgres-ubuntu-${{ matrix.platform_name }}"
+          docker cp builder:/out/smp-server $name
+
+          path="${{ github.workspace }}/$name"
+          echo "bin=$path" >> $GITHUB_OUTPUT
+
+          hash="SHA2-256($name)= $(openssl sha256 $path | cut -d' ' -f 2)"
+          printf 'hash=%s' "$hash" >> $GITHUB_OUTPUT
+
+      - name: Build everything else (standard)
+        if: matrix.should_run == true
+        shell: docker exec -t builder sh -eu {0}
+        run: |
+          cabal build --jobs=$(nproc)
+          mkdir -p /out
+          for i in ${{ env.apps }}; do
+            bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
+            strip "$bin"
+            chmod +x "$bin"
+            mv "$bin" /out/
+          done
+
+      - name: Copy binaries from container and prepare them
+        id: prepare-regular
+        if: startsWith(github.ref, 'refs/tags/v') && matrix.should_run == true
+        shell: bash
+        run: |
+          docker cp builder:/out .
+
+          printf 'bins<<EOF\n' > bins.output
+          printf 'hashes<<EOF\n' > hashes.output
+          for i in ${{ env.apps }}; do
+            mv ./out/$i ./$i-ubuntu-${{ matrix.platform_name }}
+
+            name="$i-ubuntu-${{ matrix.platform_name }}"
+
+            path="${{ github.workspace }}/$name"
+            hash="SHA2-256($name)= $(openssl sha256 $path | cut -d' ' -f 2)"
+
+            printf '%s\n' "$path" >> bins.output
+            printf '%s\n\n' "$hash" >> hashes.output
+          done
+          printf 'EOF\n' >> bins.output
+          printf 'EOF\n' >> hashes.output
+
+          cat bins.output >> "$GITHUB_OUTPUT"
+          cat hashes.output >> "$GITHUB_OUTPUT"
+
+      - name: Upload binaries
+        if: startsWith(github.ref, 'refs/tags/v') && matrix.should_run == true
+        uses: simplex-chat/action-gh-release@v2
+        with:
+          append_body: true
+          prerelease: true
+          fail_on_unmatched_files: true
+          body: |
+            ${{ steps.prepare-regular.outputs.hashes }}
+            ${{ steps.prepare-postgres.outputs.hash }}
+          files: |
+            ${{ steps.prepare-regular.outputs.bins }}
+            ${{ steps.prepare-postgres.outputs.bin }}
+        env:
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+
+      - name: Test
+        if: matrix.should_run == true
+        timeout-minutes: 120
+        shell: bash
+        env:
+          PGHOST: localhost
+        run: |
+          i=1
+          attempts=1
+          ${{ (github.ref == 'refs/heads/stable' || startsWith(github.ref, 'refs/tags/v')) }} && attempts=3
+          while [ "$i" -le "$attempts" ]; do
+            if ./simplexmq-test; then
+              break
+            else
+              echo "Attempt $i failed, retrying..."
+              i=$((i + 1))
+              sleep 1
+            fi
+          done
+          if [ "$i" -gt "$attempts" ]; then
+            echo "All "$attempts" attempts failed."
+            exit 1
+          fi
@@ -22,14 +22,14 @@ jobs:
        uses: actions/checkout@v4

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

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

      - name: Build and push Docker image
-        uses: docker/build-push-action@v6
+        uses: simplex-chat/docker-build-push-action@v6
        with:
          push: true
          build-args: |
@@ -0,0 +1,45 @@
+name: Reproduce latest release
+
+on:
+  workflow_dispatch:
+  schedule:
+    - cron: '0 2 * * *' # every day at 02:00 night
+
+jobs:
+  reproduce:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+
+      - name: Get latest release
+        shell: bash
+        run: |
+          curl --proto '=https' \
+               --tlsv1.2 \
+               -sSf -L \
+               'https://api.github.com/repos/simplex-chat/simplexmq/releases/latest' \
+               2>/dev/null | \
+          grep -i "tag_name" | \
+          awk -F \" '{print "TAG="$4}' >> $GITHUB_ENV
+
+      - name: Execute reproduce script
+        run: |
+          ${GITHUB_WORKSPACE}/scripts/simplexmq-reproduce-builds.sh "$TAG" || :
+
+      - name: Check if build has been reproduced
+        env:
+          url: ${{ secrets.STATUS_SIMPLEX_WEBHOOK_URL }}
+          user: ${{ secrets.STATUS_SIMPLEX_WEBHOOK_USER }}
+          pass: ${{ secrets.STATUS_SIMPLEX_WEBHOOK_PASS }}
+        run: |
+          if [ -f "${GITHUB_WORKSPACE}/${TAG}-simplexmq/_sha256sums" ]; then
+            exit 0
+          else
+            curl --proto '=https' --tlsv1.2 -sSf \
+              -u "${user}:${pass}" \
+              -H 'Content-Type: application/json' \
+              -d '{"title": "👾 GitHub: Runner", "description": "⛔️ '"$TAG"' did not reproduce."}' \
+              "$url"
+            exit 1
+          fi
@@ -1,3 +1,103 @@
+# 6.4.4
+
+Servers:
+- fix server pages when source code is not specified.
+- include commit SHA in printed version and in web page (#1608).
+
+SMP server:
+- support short SimpleX addresses in server information page (#1600).
+- wrap all queries in transactions (#1603).
+
+SMP agent:
+- chat relay address type for short links (#1602).
+- extend xrcp certificate validity 1 hour in the past, to allow out of sync clocks (#1601).
+
+# 6.4.3
+
+SMP agent:
+- fix some connection errors by updating contact request server hosts to match server in short link (#1597).
+
+SMP server:
+- support short link URI as queue identifier in control port commands (#1596).
+
+# 6.4.2
+
+SMP server:
+- fix memory leak when connection interrupts straight after client connects.
+- do not include repeated queue blocking into stats/quota.
+
+XFTP server:
+- prometheus metrics
+
+# 6.4.1
+
+SMP protocol:
+- create notification credentials via NEW command that creates the queue (#1586)
+
+SMP server:
+- control port session improvements (#1591)
+- additional stat counter for ntf credentials created together with the queue (#1589)
+
+# 6.4.0
+
+SMP protocol (server/client):
+- support associated queue data and short connection links (see [RFC](./rfcs/2025-03-16-smp-queues.md)).
+- service certificates to optimize subscriptions.
+
+SMP agent:
+- support retries for interactive connection handshakes.
+- use web port 443 by default for preset servers.
+- use static RNG function to avoid creating dynamic C stubs when generating sntrup keys (it was detected as Dynamic Code Loading in GrapheneOS).
+- different timeouts for interactive and background operations.
+
+Ntf server:
+- PostgreSQL storage.
+- Prometheus metrics.
+- use service certificates.
+- fix repeat token registration.
+
+# 6.3.2
+
+Servers:
+- enable store log by default (#1501).
+
+SMP server:
+- reduce memory usage (#1498)
+
+SMP agent:
+- handle client/agent version downgrades after connection was established (#1508).
+
+# 6.3.1
+
+Servers:
+- handle ECONNABORTED error on client connections.
+- reproducible builds.
+- blocking records for content moderation.
+- update script (simplex-servers-update) downloads scripts from the specified or the latest stable tag.
+
+SMP server:
+- support for PostgreSQL database for queue records for higher traffic servers.
+- fix old clients sending messages to new servers (#1443)
+- remove empty journals when opening message queues and expiring idle queues (#1456, #1458).
+- additional start options (#1465):
+  - `maintenance` to run all start/stop operations without starting server.
+  - `skip-warnings` to ignore the last corrupted line in store log (can happen on abnormal termination).
+
+Ntf server:
+- record date of last token activity, to allow expiring inactive tokens.
+- additional token invalidation reasons in logs.
+
+SMP agent:
+- store message sent to multiple connections only once, to reduce storage when sending to groups (#1453).
+- encrypt messages on delivery, to reduce database writes (#1446).
+- don't block method calls on congested sockets for better concurrency (#1454).
+- check notification token status on client connection.
+- option to skip SQLite vacuum on migrations.
+
+# 6.3.0
+
+SMP agent: fix joining connection after failure by using the same ratchet.
+
 # 6.2.2

 SMP server:
@@ -32,7 +132,7 @@ Servers: more reliable restoring of state.

 SMP server: reduced memory usage and faster start.

-Notifications: compensate for iOS notifications being droppted by Apple while device is offline (#1378):
+Notifications: compensate for iOS notifications being dropped by Apple while device is offline (#1378):
 - Ntf server: send multiple SMP notifications in one iOS notification.
 - Agent: get multiple messages for one iOS notification.

@@ -0,0 +1,31 @@
+# syntax=docker/dockerfile:1.7.0-labs
+ARG TAG=24.04
+FROM ubuntu:${TAG} AS build
+
+### Build stage
+
+ARG GHC=9.6.3
+ARG CABAL=3.14.1.1
+
+# Install curl, git and and simplexmq dependencies
+RUN apt-get update && apt-get install -y curl libpq-dev git sqlite3 libsqlite3-dev build-essential libgmp3-dev zlib1g-dev llvm llvm-dev libnuma-dev libssl-dev
+
+# Specify bootstrap Haskell versions
+ENV BOOTSTRAP_HASKELL_GHC_VERSION=${GHC}
+ENV BOOTSTRAP_HASKELL_CABAL_VERSION=${CABAL}
+
+# Do not install Stack
+ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK=true
+ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK_HOOK=true
+
+# Install ghcup
+RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+
+# Adjust PATH
+ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
+
+# Set both as default
+RUN ghcup set ghc "${GHC}" && \
+    ghcup set cabal "${CABAL}"
+
+WORKDIR /project
@@ -1,6 +1,6 @@
 # SimpleXMQ

-[![GitHub build](https://github.com/simplex-chat/simplexmq/workflows/build/badge.svg)](https://github.com/simplex-chat/simplexmq/actions?query=workflow%3Abuild)
+[![GitHub build](https://github.com/simplex-chat/simplexmq/actions/workflows/build.yml/badge.svg)](https://github.com/simplex-chat/simplexmq/actions/workflows/build.yml)
 [![GitHub release](https://img.shields.io/github/v/release/simplex-chat/simplexmq)](https://github.com/simplex-chat/simplexmq/releases)

 📢 SimpleXMQ v1 is released - with many security, privacy and efficiency improvements, new functionality - see [release notes](https://github.com/simplex-chat/simplexmq/releases/tag/v1.0.0).
@@ -116,7 +116,7 @@ On Linux, you can deploy smp and xftp server using Docker. This will download im
 2. Run your Docker container.

   - `smp-server`
-   
+
     You must change **your_ip_or_domain**. `-e "pass=password"` is optional variable to password-protect your `smp` server:
     ```sh
     docker run -d \
@@ -129,7 +129,7 @@ On Linux, you can deploy smp and xftp server using Docker. This will download im
     ```

   - `xftp-server`
-   
+
     You must change **your_ip_or_domain** and **maximum_storage**.
     ```sh
     docker run -d \
@@ -187,7 +187,7 @@ On Linux, you can build smp server using Docker.
 3. Run your Docker container.

   - `smp-server`
-   
+
     You must change **your_ip_or_domain**. `-e "pass=password"` is optional variable to password-protect your `smp` server:
     ```sh
     docker run -d \
@@ -200,7 +200,7 @@ On Linux, you can build smp server using Docker.
     ```

   - `xftp-server`
-   
+
     You must change **your_ip_or_domain** and **maximum_storage**.
     ```sh
     docker run -d \
@@ -247,7 +247,7 @@ On Linux, you can build smp server using Docker.

   `xftp-server`
   ```sh
-   cabal list-bin exe:xftp-server 
+   cabal list-bin exe:xftp-server
   ```

 - Initialize SMP server with `smp-server init [-l] -n <fqdn>` or `smp-server init [-l] --ip <ip>` - depending on how you initialize it, either FQDN or IP will be used for server's address.
@@ -15,7 +15,6 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}

 main :: IO ()
 main = do
-  setLogLevel LogInfo
  cfgPath <- getEnvPath "NTF_SERVER_CFG_PATH" defaultCfgPath
  logPath <- getEnvPath "NTF_SERVER_LOG_PATH" defaultLogPath
  withGlobalLogging logCfg $ ntfServerCLI cfgPath logPath
@@ -16,7 +16,6 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}

 main :: IO ()
 main = do
-  setLogLevel LogDebug
  cfgPath <- getEnvPath "SMP_SERVER_CFG_PATH" defaultCfgPath
  logPath <- getEnvPath "SMP_SERVER_LOG_PATH" defaultLogPath
  withGlobalLogging logCfg $ smpServerCLI_ Static.generateSite Static.serveStaticFiles Static.attachStaticFiles cfgPath logPath
@@ -0,0 +1,49 @@
+{
+  "applinks": {
+    "details": [
+      {
+        "appIDs": [
+          "5NN7GUYB6T.chat.simplex.app"
+        ],
+        "components": [
+          {
+            "/": "/contact/*"
+          },
+          {
+            "/": "/contact"
+          },
+          {
+            "/": "/invitation/*"
+          },
+          {
+            "/": "/invitation"
+          },
+          {
+            "/": "/a/*"
+          },
+          {
+            "/": "/a"
+          },
+          {
+            "/": "/c/*"
+          },
+          {
+            "/": "/c"
+          },
+          {
+            "/": "/g/*"
+          },
+          {
+            "/": "/g"
+          },
+          {
+            "/": "/i/*"
+          },
+          {
+            "/": "/i"
+          }
+        ]
+      }
+    ]
+  }
+}
@@ -0,0 +1,16 @@
+[
+    {
+        "relation": [
+            "delegate_permission/common.handle_all_urls"
+        ],
+        "target": {
+            "namespace": "android_app",
+            "package_name": "chat.simplex.app",
+            "sha256_cert_fingerprints": [
+                "5E:3E:DC:C2:00:FB:A8:D5:F4:88:F3:CA:4C:32:5B:05:78:C5:6A:9C:03:A1:CC:B5:92:9C:D7:5C:7E:57:E2:4D",
+                "3C:52:C4:FD:3C:AD:1C:07:C9:B0:0A:70:80:E3:58:FA:B9:FE:FC:B8:AF:5A:EC:14:77:65:F1:6D:0F:21:AD:85",
+                "AE:C1:95:DC:FD:46:14:BD:3A:91:EC:26:D1:D5:14:C8:75:71:C5:CC:8D:CF:48:08:3F:92:83:14:3C:A2:B9:A6"
+            ]
+        }
+    }
+]
@@ -0,0 +1 @@
+../link.html
@@ -0,0 +1 @@
+../link.html
@@ -0,0 +1 @@
+../link.html
@@ -223,11 +223,14 @@
            <table id="public-info">
              <tr class="text-grey-black dark:text-white text-base">
                <td>Server version:</td>
-                <td>${version}</td>
+                <td>${version}<x-commit> / <a href="${commitSourceCode}/commit/${commit}" target="_blank">${shortCommit}</a></x-commit></td>
              </tr>
              <tr class="text-grey-black dark:text-white text-base">
                <td>Source code:</td>
-                <td><a href="${sourceCode}" target="_blank">${sourceCode}</a></td>
+                <td>
+                  <x-sourceCode><a href="${sourceCode}" target="_blank">${sourceCode}</a></x-sourceCode>
+                  <x-noSourceCode>add to smp-server.ini (required by <a href="https://github.com/simplex-chat/simplexmq/blob/stable/LICENSE" target="_blank">AGPLv3</a>)</x-noSourceCode>
+                </td>
              </tr>
              <x-website>
                <tr class="text-grey-black dark:text-white text-base">
@@ -142,8 +142,7 @@
    class="hidden xl:block h-screen pt-[66px] bg-white dark:bg-gradient-radial-mobile dark:lg:bg-gradient-radial">
    <div class="container m-auto h-full flex items-center justify-between px-5">
      <div class="flex flex-col items-start justify-center w-full">
-        <h1 class="text-[38px] leading-[43px] font-bold max-w-[500px] mb-[30px] primary-header-contact">You received a
-          1-time link to connect on SimpleX Chat</h1>
+        <h1 class="text-[38px] leading-[43px] font-bold max-w-[500px] mb-[30px] primary-header-contact">This is a one-time link of the SimpleX&nbsp;network user</h1>
        <h2
          class="text-[20px] leading-[28px] text-[#606C71] dark:text-white font-bold max-w-[475px] mb-[80px] secondary-header-contact">
          Scan the QR code with the SimpleX Chat app on your phone or tablet.</h2>
@@ -184,10 +183,8 @@
    class="block xl:hidden pt-[106px] py-[90px] bg-white dark:bg-gradient-radial-mobile dark:lg:bg-gradient-radial">
    <div class="container m-auto px-5">
      <div class="flex flex-col items-center">
-        <h1 class="text-[28px] font-bold text-center max-w-[602px] mb-[40px] primary-header-contact">You received a
-          1-time link to connect on SimpleX Chat</h1>
-        <p class="text-[20px] leading-[28px] text-grey-black dark:text-white font-medium mb-[30px]">To make a
-          connection:</p>
+        <h1 class="text-[28px] font-bold text-center max-w-[602px] mb-[40px] primary-header-contact">This is a one-time link of the SimpleX&nbsp;network user</h1>
+        <p class="text-[20px] leading-[28px] text-grey-black dark:text-white font-medium mb-[30px]">To make a connection:</p>
        <div
          class="flex flex-col justify-center items-center p-4 w-full max-w-[468px] min-h-[131px] rounded-[30px] border-[1px] border-[#A8B0B4] dark:border-white border-opacity-60 mb-6 relative">
          <p class="text-xl font-medium text-grey-black dark:text-white mb-4">Install SimpleX app</p>
@@ -506,13 +503,17 @@
    const url = window.location.href
    const messageElements = document.getElementsByClassName('primary-header-contact')

-    if (url.includes('/invitation')) {
-      for (let element of messageElements) {
-        element.textContent = 'You received a 1-time link to connect on SimpleX Chat'
-      }
-    } else {
-      for (let element of messageElements) {
-        element.textContent = 'You received an address to connect on SimpleX Chat'
+    for (let element of messageElements) {
+      if (url.includes('/g') || url.includes('&data=%7B%22groupLinkId%22%3A')) {
+        element.innerHTML = 'This is a public group address on SimpleX&nbsp;network'
+      } else if (url.includes('/a') || url.includes('/contact')) {
+        element.innerHTML = 'This is a public address of the SimpleX&nbsp;network user'
+      } else if (url.includes('/i') || url.includes('/invitation')) {
+        element.innerHTML = 'This is a one-time link of the SimpleX&nbsp;network user'
+      } else if (url.includes('/c')) {
+        element.innerHTML = 'This is a public channel address on SimpleX&nbsp;network'
+      } else if (url.includes('/r')) {
+        element.innerHTML = 'This is a chat relay address on SimpleX&nbsp;network'
      }
    }
  </script>
@@ -20,7 +20,18 @@
    parsedURI.pathname = "/" + action
    connURI = parsedURI.toString()
    console.log("connection URI: ", connURI)
-    mobileConnURIanchor.href = "simplex:" + parsedURI.pathname + parsedURI.hash
+    const hash = parsedURI.hash
+    const hostname = parsedURI.hostname
+    let appURI = "simplex:" + parsedURI.pathname
+    appURI += action.length > 1 // not short link
+              ? hash
+              : !hash.includes("?") // otherwise add server hostname
+              ? hash + "?h=" + hostname // no parameters
+              : !hash.includes("?h=") && !hash.includes("&h=")
+              ? hash + "&h=" + hostname // no "h" parameter
+              : hash.replace(/([?&])h=([^&]+)/, `$1h=${hostname},$2`) // add as the first hostname to "h" parameter
+    mobileConnURIanchor.href = appURI
+    console.log("app URI: ", appURI)
    connURIel.innerText = "/c " + connURI
    for (const connQRCode of connQRCodes) {
      try {
@@ -12,17 +12,20 @@ import Data.Char (toUpper)
 import Data.IORef (readIORef)
 import Data.Maybe (fromMaybe)
 import Data.String (fromString)
+import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Network.Socket (getPeerName)
-import Network.Wai (Application)
+import Network.Wai (Application, Request (..))
+import Network.Wai.Application.Static (StaticSettings (..))
 import qualified Network.Wai.Application.Static as S
 import qualified Network.Wai.Handler.Warp as W
 import qualified Network.Wai.Handler.Warp.Internal as WI
 import qualified Network.Wai.Handler.WarpTLS as WT
 import Simplex.Messaging.Encoding.String (strEncode)
 import Simplex.Messaging.Server (AttachHTTP)
+import Simplex.Messaging.Server.CLI (simplexmqCommit)
 import Simplex.Messaging.Server.Information
-import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..))
+import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..), simplexmqSource)
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (tshow)
@@ -31,12 +34,13 @@ import System.Directory (createDirectoryIfMissing)
 import System.FilePath
 import UnliftIO.Concurrent (forkFinally)
 import UnliftIO.Exception (bracket, finally)
+import qualified WaiAppStatic.Types as WAT

 serveStaticFiles :: EmbeddedWebParams -> IO ()
 serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams} = do
  forM_ webHttpPort $ \port -> flip forkFinally (\e -> logError $ "HTTP server crashed: " <> tshow e) $ do
    logInfo $ "Serving static site on port " <> tshow port
-    W.runSettings (mkSettings port) (S.staticApp $ S.defaultFileServerSettings webStaticPath)
+    W.runSettings (mkSettings port) app
  forM_ webHttpsParams $ \WebHttpsParams {port, cert, key} -> flip forkFinally (\e -> logError $ "HTTPS server crashed: " <> tshow e) $ do
    logInfo $ "Serving static site on port " <> tshow port <> " (TLS)"
    WT.runTLS (WT.tlsSettings cert key) (mkSettings port) app
@@ -72,28 +76,50 @@ warpSettings :: W.Settings
 warpSettings = W.setGracefulShutdownTimeout (Just 1) W.defaultSettings

 staticFiles :: FilePath -> Application
-staticFiles root = S.staticApp settings
+staticFiles root = S.staticApp settings . changeWellKnownPath
  where
-    settings = (S.defaultFileServerSettings root)
-      { S.ssListing = Nothing
-      }
+    settings = defSettings {ssListing = Nothing, ssGetMimeType = getMimeType}
+    defSettings = S.defaultFileServerSettings root
+    getMimeType f
+      | WAT.fromPiece (WAT.fileName f) == "apple-app-site-association" = pure "application/json"
+      | otherwise = (ssGetMimeType defSettings) f
+    changeWellKnownPath req = case pathInfo req of
+      ".well-known" : rest ->
+        req
+          { pathInfo = "well-known" : rest,
+            rawPathInfo = "/well-known/" <> B.drop pfxLen (rawPathInfo req)
+          }
+      _ -> req
+    pfxLen = B.length "/.well-known/"

 generateSite :: ServerInformation -> Maybe TransportHost -> FilePath -> IO ()
 generateSite si onionHost sitePath = do
  createDirectoryIfMissing True sitePath
  B.writeFile (sitePath </> "index.html") $ serverInformation si onionHost
-  createDirectoryIfMissing True $ sitePath </> "media"
-  forM_ E.mediaContent $ \(path, bs) -> B.writeFile (sitePath </> "media" </> path) bs
-  createDirectoryIfMissing True $ sitePath </> "contact"
-  B.writeFile (sitePath </> "contact" </> "index.html") E.linkHtml
-  createDirectoryIfMissing True $ sitePath </> "invitation"
-  B.writeFile (sitePath </> "invitation" </> "index.html") E.linkHtml
+  copyDir "media" E.mediaContent
+  -- `.well-known` path is re-written in changeWellKnownPath,
+  -- staticApp does not allow hidden folders.
+  copyDir "well-known" E.wellKnown
+  createLinkPage "contact"
+  createLinkPage "invitation"
+  createLinkPage "a"
+  createLinkPage "c"
+  createLinkPage "g"
+  createLinkPage "r"
+  createLinkPage "i"
  logInfo $ "Generated static site contents at " <> tshow sitePath
+  where
+    copyDir dir content = do
+      createDirectoryIfMissing True $ sitePath </> dir
+      forM_ content $ \(path, s) -> B.writeFile (sitePath </> dir </> path) s
+    createLinkPage path = do
+      createDirectoryIfMissing True $ sitePath </> path
+      B.writeFile (sitePath </> path </> "index.html") E.linkHtml

 serverInformation :: ServerInformation -> Maybe TransportHost -> ByteString
 serverInformation ServerInformation {config, information} onionHost = render E.indexHtml substs
  where
-    substs = substConfig <> maybe [] substInfo information <> [("onionHost", strEncode <$> onionHost)]
+    substs = substConfig <> substInfo <> [("onionHost", strEncode <$> onionHost)]
    substConfig =
      [ ( "persistence",
          Just $ case persistence config of
@@ -108,7 +134,7 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
      ]
    yesNo True = "Yes"
    yesNo False = "No"
-    substInfo spi =
+    substInfo =
      concat
        [ basic,
          maybe [("usageConditions", Nothing), ("usageAmendments", Nothing)] conds (usageConditions spi),
@@ -120,10 +146,16 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
        ]
      where
        basic =
-          [ ("sourceCode", Just . encodeUtf8 $ sourceCode spi),
+          [ ("sourceCode", if T.null sc then Nothing else Just (encodeUtf8 sc)),
+            ("noSourceCode", if T.null sc then Just "none" else Nothing),
            ("version", Just $ B.pack simplexMQVersion),
+            ("commitSourceCode", Just $ encodeUtf8 $ maybe (T.pack simplexmqSource) sourceCode information),
+            ("shortCommit", Just $ B.pack $ take 7 simplexmqCommit),
+            ("commit", Just $ B.pack simplexmqCommit),
            ("website", encodeUtf8 <$> website spi)
          ]
+        spi = fromMaybe (emptyServerInfo "") information
+        sc = sourceCode spi
        conds ServerConditions {conditions, amendments} =
          [ ("usageConditions", Just $ encodeUtf8 conditions),
            ("usageAmendments", encodeUtf8 <$> amendments)
@@ -205,8 +237,8 @@ section_ label content' src =
        (inside, next') ->
          let next = B.drop (B.length endMarker) next'
           in case content' of
-                Nothing -> before <> next -- collapse section
-                Just content -> before <> item_ label content inside <> section_ label content' next
+                Just content | not (B.null content) -> before <> item_ label content inside <> section_ label content' next
+                _ -> before <> next -- collapse section
  where
    startMarker = "<x-" <> label <> ">"
    endMarker = "</x-" <> label <> ">"
@@ -13,3 +13,6 @@ linkHtml = $(embedFile "apps/smp-server/static/link.html")

 mediaContent :: [(FilePath, ByteString)]
 mediaContent = $(embedDir "apps/smp-server/static/media/")
+
+wellKnown :: [(FilePath, ByteString)]
+wellKnown = $(embedDir "apps/smp-server/static/.well-known/")
@@ -4,6 +4,7 @@ packages: .
 -- packages: . ../http2
 -- packages: . ../network-transport

+-- uncomment two sections below to run tests with coverage
 -- package *
   -- coverage: True
   -- library-coverage: True
@@ -0,0 +1,290 @@
+# Protocol changes for creating and connecting to SMP queues
+
+## Problems
+
+This change is related to these problems:
+- differentiating queue retention time,
+- supporting MITM-resistant short connection links,
+
+This RFC is based on the previous discussions about short links, blob storage and notifications ([1](./2024-06-21-short-links.md), [2](./2024-09-09-smp-blobs.md), [3](./2024-11-25-queue-blobs-2.md), [4](./2024-09-25-ios-notifications-2.md)).
+
+SMP protocol supports two types of queues - queues to send messages (messaging queues) and queues to send invitations to connect (contact queues). While SMP protocol was originally "unaware" of these queue types, it could differentiate it by message flow, and with the recent addition of SKEY command to allow securing the queue by the sender this difference became persistent.
+
+Simply designating queue types would allow to use this information to decide for how long to retain queues, and potentially extending it:
+- unsecured 1-time invitation queues with sndSecure (support of securing by sender) - e.g., 3 months.
+- contact address queues without sndSecure - e.g., 3 years without activity.
+- Possibly, "queues" that prohibit messages and used only as blob storage - they would be used to store group profiles and super-peer addresses for the group.
+
+## Design objectives
+
+We want to achieve these objectives for short links and associated queue data:
+1. no possibility to provide incorrect SenderId inside link data (e.g. from another queue).
+2. link data cannot be accessed by the server unless it has the link.
+3. prevent MITM attack by the server, including the server that obtained the link.
+4. prevent changing of connection request by the user (to prevent MITM via break-in attack in the originating client).
+5. for one-time links, prevent accessing link data by link observers who did not compromise the server.
+6. allow changing the user-defined part of link data.
+7. avoid changing the link when user-defined part of link data changes, while preventing MITM attack by the server on user-defined part, even if it has the link.
+8. retain the quality that it is impossible to check the existence of secured queue from having any of its temporary visible IDs (sender ID and link ID in 1-time invitations) - it requires that these IDs remain server-generated (contrary to the previous RFCs).
+
+To achieve these objectives the queue data will include fixed (immutable) and user-defined (mutable) parts.
+
+Fixed part would include:
+- full connection request (the current long link with all keys, including PQ keys). This includes SenderId that must match server response.
+- public signature key to verify mutable part of link data.
+
+Signed mutable part would include:
+- any links to chat relays that should be contacted instead of this queue (not in this RFC), to allow delegating group connections and contact request connections to prevent spam, hiding online presence, etc.
+- and user-defined data - user profile or group profile, chat preferences, welcome message, etc.
+
+The link itself should include both the key and auth tag from the encryption of immutable part. Accessing one-time link data should require providing sender key and signing the command (`LKEY`).
+
+## Solution
+
+Current NEW and NKEY commands:
+
+```haskell
+NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Command Recipient
+
+-- | Queue IDs and keys, returned in IDS response
+data QueueIdsKeys = QIK
+  { rcvId :: RecipientId,
+    sndId :: SenderId,
+    rcvPublicDhKey :: RcvPublicDhKey,
+    sndSecure :: SenderCanSecure
+  }
+```
+
+Proposed NEW command replaces SenderCanSecure with QueueMode, adds link data, and combines NKEY command:
+
+```haskell
+NEW :: NewQueueRequest -> Command Recipient
+
+data NewQueueReq = NewQueueReq
+  { rcvAuthKey :: RcvPublicAuthKey,
+    rcvDhKey :: RcvPublicDhKey,
+    auth_ :: Maybe BasicAuth,
+    subMode :: SubscriptionMode,
+    queueReqData :: Maybe QueueReqData,
+  }
+
+-- QRMessaging implies that sender can secure the queue.
+-- LinkId is not used with QRMessaging, to prevent the possibility of checking when connection is established by re-using the same link ID when creating another queue – the creating would have to fail if it is used.
+-- LinkId is required with QRContact, to have shorter link - it will be derived from the link_uri. And in this case we do not need to prevent checks that this queue exists.
+data QueueReqData
+  = QRMessaging (Maybe (SenderId, QueueLinkData))
+  | QRContact (Maybe (LinkId, (SenderId, QueueLinkData)))
+
+-- SenderId should be computed client-side as the first 24 bytes of sha3-384(correlation_id),
+-- The server must verify it and reject if it is not.
+-- It allows to include sender ID inside encrypted associated link data as part of full connection URI without requesting it from the server, but prevents checking if a given sender ID exists (queue creation would fail for a duplicate sender ID), as sha3-384 derivation is not reversible.
+type QueueLinkData = (EncFixedLinkData, EncUserDataBytes)
+
+type EncFixedLinkData = ByteString
+
+type EncUserDataBytes = ByteString
+
+-- We need to use binary encoding for ConnectionRequestUri to reduce its size
+-- The clients would reject changed immutable data and
+-- ConnectionRequestUri where server or SenderId of the queue do not match.
+data FixedLinkData c = FixedLinkData
+  { agentVRange :: VersionRangeSMPA,
+    rootKey :: C.PublicKeyEd25519,
+    connReq :: ConnectionRequestUri c
+  }
+
+data ConnLinkData c where
+  InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
+  ContactLinkData ::
+    { agentVRange :: VersionRangeSMPA,
+      -- direct connection via connReq in fixed data is allowed.
+      direct :: Bool,
+      -- additional owner keys to sign changes of mutable data.
+      owners :: [OwnerAuth],
+      -- alternative addresses of chat relays that receive requests for this contact address.
+      relays :: [ConnShortLink 'CMContact],
+      userData :: UserLinkData
+    } -> ConnLinkData 'CMContact
+
+newtype UserLinkData = UserLinkData ByteString
+
+-- | Updated queue IDs and keys, returned in IDS response
+data QueueIdsKeys = QIK
+  { rcvId :: RecipientId, -- server-generated
+    sndId :: SenderId, -- server-generated
+    rcvPublicDhKey :: RcvPublicDhKey,
+    sndSecure :: SenderCanSecure, -- possibly, can be removed? or implied?
+    linkId :: Maybe LinkId -- server-generated
+  }
+```
+
+In addition to that we add the command allowing to update and also to retrieve and secure the queue and get link data in one request, to have only one request:
+
+```haskell
+-- This command allows to set all data or to update mutable part of contact address queue.
+-- This command should fail on queues that support sndSecure and also on new queues created with QRMessaging.
+-- This should fail if LinkId or immutable part of data is changed with the update, but will succeed if only mutable part is updated, so it can be retried.
+-- Entity ID is RecipientId.
+-- The response to this command is `OK`.
+LSET :: LinkId -> QueueLinkData -> Command Recipient
+
+-- Delete should link and associated data
+-- Entity ID is RecipientId
+LDEL :: Command Recipient
+
+-- To be used with 1-time links.
+-- Sender's key provided on the first request prevents observers from undetectably accessing 1-time link data.
+-- If queue mode is QRContact (and queue does NOT allow sndSecure) the command will fail, same as SKEY.
+-- Once queue is secured, the key must be the same in subsequent requests - to allow retries in case of network failures, and to prevent passive attacks.
+-- The difference with securing queues is that queues allow sending unsecured messages to queues that allow sndSecure (for backwards compatibility), and 1-time links will NOT allow retrieving link data without securing the queue at the same time, preventing undetected access by observers.
+-- Entity ID is LinkId
+LKEY :: SndPublicAuthKey -> Command Sender
+
+-- If queue mode is QRMessaging the command will fail.
+-- Entity ID is LinkId
+LGET :: Command Sender
+
+-- Response to LGET and LSET
+-- Entity ID is the same as in the command
+LNK :: SenderId -> QueueLinkData -> BrokerMsg
+```
+
+To both include sender_id into the full link before the server response, and to prevent "oracle attack" when a failure to create the queue with the supplied `sender_id` can be used as a proof of queue existence, it is proposed that `sender_id` is computed client-side as the first 24 bytes of 48 in `sha3-384(correlation_id)` and validated server-side, where `corelation_id` is the transmission correlation ID.
+
+To allow retries, every time the command is sent a new random `correlation_id` and new `sender_id` (and for contact queue, also `link_id`, which would be random as it is derived from hash of fixed link data that includes a random signature key) should be used on each attempt, because other IDs would be generated randomly on the server, and in case the previous command succeeded on the server but failed to be communicated to the client, the retry will fail if the same ID is used.
+
+Alternative solutions that would allow retries that were considered and rejected:
+- additional request to save queue data, after `sender_id` is returned by the server. The scenarios that require short links are interactive - creating user addresses and 1-time invitations - so making two requests instead of one would make the UX worse.
+- include empty sender_id in the immutable data and have it replaced by the accepting party with `sender_id` received in `LINK` response - both a weird design, and might create possibility for some attacks via server, especially for contact addresses.
+- making NEW commands idempotent. Doing it would require generating all IDs client-side, not only `sender_id`. It increases complexity, and it is not really necessary as the only scenarios when retries are needed are async NEW commands, that do not require short links. For future short links of chat relays the retries are much less likely, as chat relays will have good network connections.
+
+## Algorithm to prepare and to interpret queue link data.
+
+For contact addresses this approach follows the design proposed in [Short links](./2024-06-21-short-links.md) RFC - when link id is derived from the same random binary as key. For 1-time invitations link ID is independent and server-generated, to prevent existence checks (oracle attack).
+
+This scheme results in 32 byte binary size for contact addresses and 56 bytes for 1-time invitation links.
+
+For fixed link data.
+
+1. Generate random `nonce` (also used as a correlation ID for server command) and signature key (public `rootKey` included in fixed data).
+2. Compute sender ID from `nonce` as the first 24 bytes of sha3-384 of `nonce`.
+3. Generate other keys for queue address, including queue e2e encryption keys and double ratchet connection e2e encryption keys.
+4. Construct the full connection address to be included in fixed data.
+5. `link_key = SHA3-256(fixed_data)` - used as part of the link, and to derive the key to encrypt content.
+6. HKDF:
+  1) contact address: `(link_id, key) = HKDF(link_key, 56 bytes)`.
+  2) 1-time invitation: `key = HKDF(link_key, 32 bytes)`, `link-id` - server-generated.
+7. Encrypt: `(ct1, tag1) = secret_box(fixed_data, key, nonce1)`, where `nonce1` is a random nonce
+5. Store: `(nonce1, ct1, tag1)` stored as fixed link data.
+
+For mutable user data:
+
+1. Random `nonce2` and the same key are used.
+2. Sign `user_data` with key included in `fixed_data`.
+3. Encrypt: `(ct2, tag2) = secret_box(signed_used_data, key, nonce2)`.
+4. Store: `(nonce2, ct2, tag2)`
+
+Link recipient:
+
+1. Receives `link_key` in the link, for 1-time invitations also `link_id`.
+2. HKDF:
+  1) contact address: `(link_id, key) = HKDF(link_key, 56 bytes)`.
+  2) 1-time invitation: `key = HKDF(link_key, 32 bytes)`.
+3. Retrieves via `link_id`: `(nonce1, ct1, tag1)` and `(nonce2, ct2, tag2)`:
+  1) contact address: `LGET` command, that allows retrieving link data multiple times.
+  2) 1-time invitation: `LKEY` command, that non-optionally secures the queue, and only allows repeated link data retrievals if the same sender's key is provided and signs the transmission. This prevents link data retrieval by link observers.
+4. Decrypt: `(signature1, fixed_data) = decrypt (nonce1, ct1, tag1)`.
+5. Verify: `SHA3-256(fixed_data) == link_key`, abort if not.
+6. Decrypt: `(signature2, used_data) = decrypt(nonce2, ct2, tag2)`.
+7. Verify signatures using key in the fixed data, abort if they don't match.
+
+While using content hash as encryption key is unconventional, it is not completely unusual - e.g., it is used in convergent encryption (although in our case using random nonce makes it not convergent, but other use cases suggest that this approach preserves encryption security). It is particularly acceptable for our use case, as `fixed_data` contains mostly random keys.
+
+## Threat model
+
+**Compromised SMP server**
+
+can:
+- delete link data.
+- hide link data selectively for some or for all requests.
+
+cannot:
+- undetectably replace link data, even if it has the link (objective 3).
+- access unencrypted link data, whether it was or was not accessed by the accepting party, provided it has no link (objective 2).
+- observe IP addresses of the users accessing link data, if private routing is used.
+
+**Passive observer who observed short link**:
+
+can:
+- access original unencrypted link data for contact address links.
+
+cannot:
+- undetectably access observed 1-time link data, accessing the link would make the link inaccessible to the sender (objective 5).
+- undetectably check the existence of messaging queue or 1-time link (objective 8).
+- replace or delete the link data.
+
+**Queue owner who did not compromise the server**:
+
+cannot:
+- redirect connecting user to another queue, on the same or on another server (objective 1).
+- replace connection request in the link (objective 4).
+
+## Correlation of design objectives with design elements
+
+1. The presence of `SenderId` in `LNK` response from the server.
+2. Encryption of link data with crypto_box.
+3. Deriving encryption key from the hash of fixed data prevents it being modified by the server - any change would be detected and rejected by the client, as the hash of fixed data won't match the link. Signature verification with the key from fixed data, and signing of mutable data prevents server modification of mutable data.
+4. No server command to change fixed data once it's set. Also, changing fixed data would require changing the link.
+5. 1-time link data can only be accessed with `LKEY` command, that while allows retries to mitigate network failures, will require the same key for retries.
+6. `LSET` command.
+7. The link is derived from fixed data only, so it does not change when mutable link data changes. Mutable part is signed preventing server MITM attacks.
+8. SenderId is derived from request correlation ID, so it cannot be arbitrary defined to check existence of some known queue. LinkId for 1-time invitation is generated server-side, so it cannot be provided by the client when creating the queues to check if these IDs are used.
+
+## Syntax for short links
+
+The syntax:
+
+```abnf
+shortConnectionLink = uriAuthority "/" linkUri [ "?" param *( "&" param ) ]
+uriAuthority = %s"https://" smpServerHost / "simplex:" ; using simplex: scheme requires including host in the parameter hostParam
+smpServerHost = <hostname> ; RFC1123, RFC5891
+linkUri = %s"i#" oneTimeLink / contactType "#" contactLink
+contactType = %s"a" / %s"g" / %s"c" ; contact / group / channel address, respectively
+oneTimeLink = <base64url(linkId)> "/" <base64url(linkKey)> ; 56 bytes / 75 base64 encoded characters
+contactLink = <base64url(linkKey)> ; 32 bytes / 43 base64 encoded characters
+; linkId - 192 bits/24 bytes
+; linkKey - 256 bits/32 bytes
+
+param = hostsParam / portParam / certHashParam
+hostsParam = %s"h=" host *("," host) ; additional hostnames, e.g. onion
+portParam = %s"p=" 1*DIGIT ; server port
+certHashParam = %s"c=" <base64url(server offline certificate fingerprint)>
+```
+
+To have shorter links fingerprint and additional server hostnames do not need to be specified for pre-configured servers, even if they are disabled - they can be used from the client code. Any user defined servers will require including additional hosts and server fingerprint.
+
+Example one-time link for preset server (104 characters):
+
+```
+https://smp12.simplex.im/i#abcdefghij0123456789abcdefghij01/23456789abcdefghij0123456789abcdefghij01234
+```
+
+Example contact link for preset server (71 characters):
+
+```
+https://smp12.simplex.im/c#abcdefghij0123456789abcdefghij0123456789abc
+```
+
+Example contact link for user-defined server (with fingerprint, but without onion hostname - 117 characters):
+
+```
+https://smp1.example.com/c#abcdefghij0123456789abcdefghij0123456789abc?c=0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU
+```
+
+Example contact link for user-defined server (with fingerprint ant onion hostname - 182 characters):
+
+```
+https://smp1.example.com/c#abcdefghij0123456789abcdefghij0123456789abc?c=0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU&h=beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion
+```
+
+For the links to work in the browser the servers must provide server pages.
@@ -0,0 +1,93 @@
+# New notifications protocol
+
+## Problem
+
+iOS notifications have these problems:
+- iOS notification service crashes exceeding memory limit. This is being addressed by changes in GHC RTS.
+- there is a large number of connections, because each member in a group requires individual connection. This will improve with chat relays when each group would require 2-3 connections.
+- some notification may be not shown if notification with reply/mention is skipped, and instead some other message is delivered, which may be muted. This would not improve without some changes, as notifications may be skipped anyway.
+- client devices delay communication with ntf server because it is done in background, and by that time the app may be suspended.
+- notification server represents a bottleneck, as it has to be owned by the app vendor, and the current design when ntf server subscribes to notifications scales very badly.
+
+This RFC is based on the previous [RFC related to notifications](./2024-09-25-ios-notifications-2.md).
+
+## Solution
+
+As notification server has to know client token and currently it associates subscriptions with this token anyway, we are not gaining any privacy and security by using per-subscription keys - both authorization and encryption keys of notification subscription can be dropped.
+
+We still need to store the list of queue IDs associated with the token on the notification server, but we do not need any per-queue keys on the notification server, and we don't need subscriptions - it's effectively a simple set of IDs, with no other information.
+
+In this case, when queue is created the client would supply notifier ID - it has to be derived from correlation ID, to prevent existense check (see previous RFC). As we also supply sender ID, instead of deriving it as sha3-192 of correlation ID, they both can be derived as sha3-384 and split to two IDs - 24 bytes each.
+
+The notification server will maintain a rotating list of server keys with the latest key communicated to the client every time the token is registered and checked. The keys would expire after, say, 1 week or 1 month, and removed from notification server on expiration.
+
+The packet containing association between notifier queue ID and token will be crypto_box encrypted using key agreement between identified notification server master key and an ephemeral per packet (effectively, per-queue) client-key.
+
+Deleting the queue may also include encrypted packet that would verify that the client deleted the queue.
+
+Instead of notification server subscribing to the notifications creating a lot of traffic for the queues without messages, the SMP server would push notifications via NTF server connection (whether via NTF or via SMP protocol). This could be used as a mechanism to migrate existing queues when with the next subscription the notification server would communicate it's address to SMP server and this association would be stored together with the queue.
+
+## Protocol design
+
+Additional/changed SMP commands:
+
+```haskell
+-- register notification server
+-- should be signed with server key
+NSRV :: NtfServerCreds -> Command NtfServer
+
+-- response
+NSID :: NtfServerId -> BrokerMsg
+
+-- to communicate which server is responsible for the queue
+-- should be signed with queue key
+NSUB :: Maybe NtfServerId -> Command Notifier
+
+-- subscribe to notificaions from all queues associated with the server
+-- should be signed with server key
+-- entity ID - NtfServerId
+NSSUB :: Command NtfServer
+
+data NtfServerCreds = NtfServerCreds
+  { server :: NtfServer,
+    -- NTF server certificate chain that should match fingerpring in address
+    cert :: X.CertificateChain,
+    -- server autorizatio key to sign server subscription requests
+    authKey :: X.SignedExact X.PubKey
+  }
+
+-- entity ID is recipient ID
+NSKEY :: NtfSubscription -> Command Recipient 
+
+data NtfSubscription = NtfSubscription
+  -- key to encrypt notifications e2e with the client
+  { ntfPubDbKey :: RcvNtfPublicDhKey,
+    ntfServer :: NtfServer,
+    -- should be linked to correlation ID to prevent existense check
+    -- the ID sent to notification server could be its hash?
+    ntfId :: NotifierId,
+    encNtfTokenAssoc :: EncDataBytes
+  }
+
+-- before the encryption - equivalent to NSUB command, but without key to authorize requests to specific queue
+data NtfTokenAssoc = NtfTokenAssoc
+  { signature :: SignatureEd25519,
+    tknId :: NtfTokenId,
+    ntfQueue :: SMPQueueNtf
+  }
+```
+
+SMP server will need to maintain the list of Ntf servers and their credentials, and when NSSUB arrives to make only one subscription. When message arrives it would deliver notification to the correct connection via queue / ntf server association.
+
+Ntf server needs to maintain three indices to the same data:
+- `(smpServer, queueId) -> tokenId` - to deliver notification to the correct token
+- `tokenId -> [smpServer -> [queueId]]` - to remove all queues when token is removed, and to store/update these associations effficiently - store log may have one compact line per token (after compacting), or per token/server combination.
+- `[smpServer]` - array of SMP servers to subscribe to.
+
+## Mention notifications
+
+Currently we are marking messages with T (true) for messages that require notifications and F (false) for messages that don't require. Sender does not know whether the recipient has notifications disabled, enabled or in mentions-only mode.
+
+The proposal is to:
+- add additional values to this metadata, e.g. 2 (priority) and 3 (high priority) (and T/F could be sent as 0/1 respectively) - that is, to deliver notifications even if notifications are generally disabled (they can still be further filtered by the client).
+- instead of deleting notification credentials when notifications are disabled - which is costly - communicate to SMP server the change of notificaion priority level, e.g. the client could set minimal notification priority to deliver notifications, where 0 would mean disabling it completely, 1 enable for all, 2 for priority 2+, 3 for priority 3. The downside here is that it could be used for timing correlation of queues in the group, but it already can be used on bulk deletions of ntf credentials for these queues and when sending messages.
@@ -0,0 +1,159 @@
+# Using short links as group links
+
+## Problem
+
+To use the short links for groups these problems has to be / can be solved:
+1. recognizing link as a group link.
+2. permanent link with the ability to change chat relays.
+3. binding owners signatures to the link.
+4. allowing to add/remove owners, both to share ownership and for reliability in case of one owner losing keys/access.
+
+While current short links solve problems 1-3 (via contact type, and via extension of user data in the link), the problem 4 is solved only partially.
+
+We could include the current list of root owners in the user data, and we could send any history of ownership changes from this baseline as a short blockchain on joining the group, we still requrie one master owner to retain access to the queue associated with the group.
+
+## Possible solution approaches
+
+1. "Kick this can down the road" - ignore this problem until there is a namespace, and a group name can be associated with multiple queues.
+
+Pros: simple and reasonable, and it suggests postponing multisig for owners too. The users can still see the list of owners and their keys in user data of the link, and receive admin roster signed by owners on joining.
+
+Cons: if this "master owner" loses the access to the device, no further changes to group profile will be possible.
+
+2. The queue access can be shared by sharing the key and recipient IDs with all owners.
+
+The problems:
+- preventing MITM attack between owners (this protect exists for other solutions too).
+- protecting these credentials from chat relays. So somehow there should be direct key agreement between members allowing to send e2e encrypted message inaccessible to chat relays.
+
+Pros: simpler than alternatives, and still provides protection against losing the key.
+Cons:
+- quite clunky, and requires the new primitive anyway (e2e encryption).
+- no multisig
+
+This could possibly be evolved into the requirement to have a direct connection with other owners, and verifying the security code before they have access to group.
+
+3. Allow "joint management" of SMP queues.
+
+SMP servers can support multiple recipients for contact queues:\
+- subscription would be possible to the "subscriber recipient".
+- all other changes (update data, change subscriber recipient, add or remove recipients) would require multiple recipient signatures on SMP command in line with n-of-m multisig rules, that the command sender would have to collect out-of-band (from SMP protocol point of view).
+
+Pros: allows joint ownership, and protects from losing access to master owner device.
+Cons:
+- complicates queue abstraction with approach that is not needed for most queues.
+- still retains the server as a single point of failure.
+
+4. Introduce "group" as a new type of entity managed by SMP servers.
+
+SMP servers would provide a separate set of commands for managing group records that would include in an encrypted container:
+- the group profile
+- the list of chat relay links
+- the list of owner member IDs with their public keys
+- multisig rules
+- alternative group entity locations
+- possibly, a globally unique group identity (as the hash of the initial/seed group data).
+
+While the server domain would be used as the hostname in group link, it may contain alternative hosts (not just hostnames of the same server), both in the link and in the group record data.
+
+Pros: separates additional complexity to where it is needed, allowing reliability and redundancy for group ownership.
+Cons: complexity, coupling between SMP and chat protocol.
+
+## Design for channel/group as a separate queue mode
+
+Option 1.
+
+A queue mode "channel" when owners are represented by their individual queues (either a separate mode, or a submode of "channel", or just normal contact address queues). In this case sending message to channel queue would broadcast message to queue owners, without exposing even the number of owners.
+
+Pros:
+- allows chat relays to send messages to all owners (e.g., channel can be secured with the list of snd keys, one per relay).
+- quite easy to evolve from the current design.
+- extensible.
+Cons:
+- close to "solution in search of a problem".
+- does not require data model changes - channel queue would simply have a list of owner "recipient IDs", and each owner queue would also point to channel.
+
+Option 2.
+
+Also a separate queue mode "channel", but instead of having a linked owner queues, it would simply maintain a list of owner keys to maintain the data. In this case, messages cannot be sent to this "queue" at all.
+
+Pros:
+- simpler design.
+- we could allow sending messages to it too, with the "main" owner receiving them. This could be negotiated in the protocol.
+- it may be easier to migrate the current groups, as the admin link would be this queue (although for public groups in directory it would have to be recreated anyway).
+- Possibly, when queue is created there should be a flag whether it should accept unsigned messages - then contact addresses would be created with unsigned messages ON, messages queues, once SKEY is universally supported, with unsigned messages OFF, and channel queues with unsigned messages OFF too for new public queues.
+Cons:
+- if no messages are accepted, this is not even a queue.
+- no way to directly contact owners (maybe it is not a downside, as for relays there would be a communication channel anyway as part of the group).
+
+Option 2 looks more simple and attractive, implementing server broadcast for SMP seems unnecessary, as while it could have been used for simple groups, it does not solve such problems as spam and pre-moderation anyway - it requires a higher level protocol.
+
+The command to update owner keys would be `RKEY` with the list of keys, and we can make `NEW` accept multiple keys too, although the use case here is less clear.
+
+## Multiple owners managing queue data.
+
+Option 1: Use the same keys in SMP as when signing queue data.
+
+Option 2: Use different keys.
+
+The value here could be that the server could validate these signatures too, and also maintain the chain of key changes. While tempting, it is probably unnecessary, and this chain of ownership is better to be maintained on chat relay level, as there are no size constraints on the size of this chain. Also, it is better for metadata privacy to not couple transport and chat protocol keys.
+
+We still need to bind the mutable data updates to the "genesis" signature key (the one included in the immutable data).
+
+The proposed design:
+
+- when mutable data is signed by genesis key, then it is bound, and no changes is needed.
+- mutable data may be signed by the key of the new owner, in which case mutable part itself must contain the binding. We could also use ring signature to sign the mutable data, concealing which owner signed the data - that would increase the signature size from 64 bytes to `32 * (n + 1)` bytes.
+
+Current mutable data:
+
+```haskell
+data UserLinkData = UserLinkData
+  { agentVRange :: VersionRangeSMPA,
+    userData :: ConnInfo
+  }
+```
+
+Proposed mutable data:
+
+```haskell
+data UserLinkData = UserLinkData
+  { agentVRange :: VersionRangeSMPA,
+    owners :: [OwnerInfo]
+    userData :: ConnInfo
+  }
+
+type OwnerId = ByteString
+
+data OwnerInfo = OwnerInfo
+  { ownerId :: OwnerId, -- unique in the list, application specific - e.g., MemberId
+    ownerKey :: PublicKeyEd25519,
+    -- owner signature of sender ID,
+    -- confirms that the owner agreed with being the owner,
+    -- prevents a member being added as an owner without consent.
+    ownerSig :: SignatureEd25519,
+    -- owner authorization, sig(ownerId || ownerKey, prevKey), where prevKey is either a "genesis key" or some other key previously signed by the genesis key.
+    authOwnerId :: OwnerId, -- null for "genesis"
+    authOwnerSig :: SignatureEd25519
+  }
+```
+
+The size of the OwnerInfo record encoding is:
+- ownerId: 1 + 12
+- ownerKey: 1 + 32
+- ownerSig: 1 + 64
+- ownerAuthId: 1 + 12
+- ownerAuthSig: 1 + 64
+
+~189 bytes, so we should practically limit the number of owners to say 8 - 1 original + 7 addiitonal. Original creator could use a different key as a "genesis" key, to conceal creator identity from other members, and it needs to include the record with memberId anyway.
+
+The structure is simplified, and it does not allow arbitrary ownership changes. Its purpose is not to comprehensively manage ownership changes - while it is possible with a generic blockchain, it seems not appropriate at this stage, - but rather to ensure access continuity and that the server cannot modify the data (although nothing prevents the server from removing the data completely or from serving the previous version of the data).
+
+For example it would only allow any given owner to remove subsequenty added owners, preserving the group link and identity, but it won't allow removing owners that signed this owner authorization. So owners are not equal, with the creator having the highest rank and being able to remove all additional owners, and owners authorise by creator can remove all other owners but themselves and creator, and so on - they have to maintain the chain that authorized themselves, at least. We could explicitely include owner rank into OwnerInfo, or we could require that they are sorted by rank, or the rank can be simply derived from signatures.
+
+When additional owners want to be added to the group, they would have to provide any of the current owners:
+- the key for SMP commands authorization - this will be passed to SMP server together with other keys. There could be either RKEY to pass all keys (some risk to miss some, or of race conditions), or RADD/RGET/RDEL to add and remove recipient keys, which has no risk of race conditions.
+- the signature of the immutable data by their member key included in their profile.
+- the current owner would then include their member key into the queue data, and update it with LSET command. In any case there should be some simple consensus protocol between owners for owner changes, and it has to be maintained as a blockchain by owners and by chat relays, as otherwise it may lead to race conditions with LSET command.
+
+Potentially, there could be one command to update keys and link data, so that they are consistent.
@@ -0,0 +1,142 @@
+# Service certificates for high volume servers and services connecting to SMP servers
+
+## Problem
+
+The absense of user and client identification benefits privacy, but it requires separately authorizing subscription for each messaging queue, that doesn't scale when a high volume server or service acts as a client for SMP server even for the current traffic and network size.
+
+These servers/services include:
+- operators' chat relays (aka super-peers),
+- notification servers,
+- high-traffic service chat bots,
+- high-traffic business support clients.
+
+The future chat relays would reduce the number of subscriptions required for the usual clients, by replacing connections with each group member to 1-3 connections with chat relays per group/community, it would shift the burden to the chat relays, that are also clients.
+
+Self-hosted chat relays may want to retain privacy, so they will not use client certificates, but this privacy is not needed (and counter-productive) for the chat relays provided by network operators.
+
+Even today, directory service subscribing to all queues may take 15-20 minutes, which is experienced as downtime by the end users.
+
+Notification servers also acting as clients to messaging servers also take 15-20 minutes to subscribe to all notifications, during which time notifications are not delivered.
+
+Not only these subscription take a lot of time, they also consume a large amount of memory both in the clients and in the servers, as association between clients and queues is currently session-scoped and not persisted anywhere (and it should not be, because end-users' clients do need privacy).
+
+## Solution
+
+High volume "clients" (operators' chat relays, directory service, SimpleX Chat team support client, SimpleX Status bot, etc.) that don't need privacy will identify themselves to the messaging servers at a point of connection by providing client sertificate, both in TLS handshake and in SMP handshake (the same certificate must be provided).
+
+All the new queues and subscriptions made in this session will be creating a permanent association of the messaging queue with the client, and on subsequent reconnections the client can "subscribe" to all their queues with a single client subscription command.
+
+This will save a lot of time subscribing and resubscribing on server and client restarts, servers' bandwidth, servers' traffic spikes, and memory of both clients and servers.
+
+## Protocol
+
+An ephemeral per-session signature key signed by long-term client certificate is used for client authorization – this session signature key will be passed in SMP handshake.
+
+To transition existing queues, the subscription command will have to be double-signed - by the queue key, and then by client key.
+
+When server receives such "hand-over" subscription it would create a permanent association between the client certificate and the queue, and on subsequent re-connections the client can subscribe to all the existing queues still associated with the client with one command.
+
+The server will respond to the client with the number of queues it was subscribed to - it would both inform the client that it has to re-connect in case of interruption, and can be used for client and server statistics.
+
+When client creates a new queue, it would also sign the request with both keys, per-queue and client's. Other queue operations (e.g., deletion, or changing associated queue data for short links) would still require two signatures, both the queue key and the client key.
+
+The open question is whether there is any value in allowing to remove the association between the client and the queue. Probably not, as threat model should assume that the server would retain this information, and the use-case for users controlling their servers is narrow.
+
+## Protocol connection handshake
+
+Currently, the types for handshakes are:
+
+```haskell
+data ServerHandshake = ServerHandshake
+  { smpVersionRange :: VersionRangeSMP,
+    sessionId :: SessionId,
+    -- pub key to agree shared secrets for command authorization and entity ID encryption.
+    -- todo C.PublicKeyX25519
+    authPubKey :: Maybe (X.CertificateChain, X.SignedExact X.PubKey)
+  }
+
+data ClientHandshake = ClientHandshake
+  { -- | agreed SMP server protocol version
+    smpVersion :: VersionSMP,
+    -- | server identity - CA certificate fingerprint
+    keyHash :: C.KeyHash,
+    -- | pub key to agree shared secret for entity ID encryption, shared secret for command authorization is agreed using per-queue keys.
+    authPubKey :: Maybe C.PublicKeyX25519,
+    -- | Whether connecting client is a proxy server (send from SMP v12).
+    -- This property, if True, disables additional transport encrytion inside TLS.
+    -- (Proxy server connection already has additional encryption, so this layer is not needed there).
+    proxyServer :: Bool
+  }
+```
+
+`ServerHandshake` already contains `authPubKey` with the server certificate chain and the signed key for connection encryption and creating a shared secret for denable authorization (with client entity key) and session encryption layer.
+
+`ClientHandshake` contains only ephemeral `authPubKey` to compute a shared secret for session encryption layer, so we need an additional field for an optional client certificate:
+
+```haskell
+serviceCertKey :: Maybe (X.CertificateChain, X.SignedExact X.PubKey)
+```
+
+Certificate here defines client identity. The actual key to be used to sign commands is session-scoped, and is signed by the certificate key. In case of notification server it MUST be the same certificate that is used for server TLS connections.
+
+For operators' clients we may optionally include operators' certificate in the chain, and that would allow servers to identify operators if either wants to. This would improve end-user security, as not only the server would validate that its certificate matches the address, but it would also validate that it is operated by SimpleX Chat or by Flux, preventing any server impersonation (e.g., via DNS manipulations) - the client could then report that the files are hosted on SimpleX Chat servers, but then can stop and show additional warning in case certificate does not match the domain - same as the browsers do with CA stores in the client.
+
+## Protocol transmissions
+
+Each transport block can contain one or several protocol transmissions.
+
+Each transmission has this structure:
+
+```abnf
+transmission = authenticator authorized
+; authenticator - Ed25519 signature for recipients or X25519 authenticator for senders, to provide repudiation.
+; authenticator authorizes the rest of the transmission.
+authorized = sessId corrId entityId command.
+; sessId is tls-unique channel binding, its presense in the transmission prevents replay attacks.
+```
+
+The proposed change would replace authenticator with exactly one or two authenticators, where the first one will remain resource-level authorization (queue key), and the optional second one will be client authorization with the client key.
+
+```abnf
+authenticator = queue_authenticator ("0" / "1" service_authenticator)
+; "0" and "1" characters (digit characters, not x00 or x01) are conventionally used for Maybe types in the protocol.
+```
+
+In case service_authenticator is present, queue_authenticator should authorize over `fingerprint authorized` (concatenation of service identity certificate fingerprint and the rest of the transmission).
+
+All queues created with client key will have to be double-authorized with both the queue key and the client key - both the client and the server would have to maintain this knowledge, whether the queue is associated with the client or not.
+
+Asymmetric retries have to be supported - the first request creating this association may succeed on the server and timeout on the client.
+
+## Subscription
+
+To subscribe to all associated queues the client has to send a single command authorized with the client key passed in handshake.
+
+The command and response:
+
+```haskell
+SUBS :: Command Recipient -- to enable all client subscriptions, empty entity ID in the transmission, signed by client key - it must be the same as was used in handover subscription signature.
+NSUBS :: Command Recipient -- notification subscription
+SOK :: Maybe ServiceId -- new subscription response
+SOKS :: Int64 -> BrokerMsg -- response from the server, includes the number of subscribed queues
+ENDS :: Int64 -> BrokerMsg -- when another session subscribes with the same certificate
+```
+
+Open questions:
+- What should used as an entity ID for `SUBS` transmission - certificate fingerprint or an empty string?
+- Should there be a command to get the list of all associated queues? It is likely to be useful for debugging?
+- What should happen when `SUB` is sent for a single already associated queue? What if it is signed with the correct session key, but that is different from existing association? The current approach is that once associated, this associaiton would require authorization for single subscriptions, with the same certificate as already associated.
+
+## Ephemeral client-session association
+
+This was considered to reduce costs for the usual clients to re-subscribe. Currently it's a big problem, because of groups, and with transition to chat relays it won't be.
+
+For some very busy end-user clients it may help.
+
+Given that server has access to an ephemeral association between recipient client session and queues anyway (even with clients connecting via Tor, unless per-connection transport isolation is used), introducing `sessionPubKey` to allow resubscription to the previously subscribed queues may reduce the traffic. This won't change threat model as the server would only keep this association in memory, and not persist it. Clients on another hand may safely persist this association for fast resubscription on client restarts.
+
+This is not planned for the forseable future, as migrating to chat relays would solve most of the problem.
+
+Assuming an average active user has 20 contacts and 20 groups, and they would need ~3 subscriptions for each (for redundancy), so about 120 subscription to reconnect. The single 16kb transport block allows to send ~136 subscriptions. Which means that ephemeral sessions would create no value for clients at all, unless they are super active.
+
+Further, improving transport efficiency for super-active non-identified clients may help network abuse, so ephemeral sessions may have negative value.
@@ -0,0 +1,104 @@
+# Using the same profile from multiple devices
+
+## Problem
+
+Double Ratchet algorithm makes it hard to send/receive messages sent to the user from different devices, as each message changes the state of Double Ratchet keys, and these state changes must be strictly sequential and they cannot be reversed (although skipping is possible).
+
+Traditional approach for multi-device converts each direct conversation into a group, where each device participates as a member. Likewise, for group conversations each device also participates as a member. While these members *look* as if they are the same user to others, a very simple client app modification may show device ID for each message, and the communication peers, both in direct chats and in groups would know how many devices a user has and which device the user sent the message from. In addition to that, with this approach communication peers can send different messages to different devices (it can be prevented by provider who would request that only message key is encrypted with DR, while the encrypted message is the same) or withheld from some devices (it cannot be prevented by provider, as it cannot add key to the communication in case it is missing, and cannot withhold the message completely too). These opens various vectors for targeted attacks, e.g.:
+- tracking movements of the user: once each devices is identified as "desk" and "phone" it would allow to know where the user is at a given time.
+- manipulating information by sending messages to one device (to have proof it was sent) and withholding from others, or sending different messages if the protocol allows it.
+
+In addition to that, the specific implementation of this approach in Signal compromises break-in recovery property (aka post-compromise security) of Double-Ratchet algorithm, making its design ineffective - the only reason to have the second ratchet in DR algorithm is to provide break-in recovery, without it a much simpler design with a single ratchet is sufficient. See [this paper](https://eprint.iacr.org/2021/626.pdf) for details.
+
+While this limitation can be addressed with notifications when a new device is added and per-device keys, we still find the remaining attack vectors on user security and privacy to be unacceptable, and opening unsuspecting users to various criminal actions - and it is wrong to say that would only affect security conscious users, and most people would not be affected by these risks. Allowing potential criminals in groups to know which device you are currently using is a real risk for all users.
+
+Another approach was offered by Threema that is ["mediator" server](https://threema.com/en/blog/md-architectural-overview) where the state of encryption ratchets is stored server-side. While it protects the user from their communication peers, it increases required level of trust to the servers, and in case of SimpleX network it would expose the knowledge of who communicates to whom. So while the idea of server-side storage of encryption state is promising, it has to be per-connection, to retain "no-accounts" property of SimpleX messaging network.
+
+Also see [FAQ](https://simplex.chat/faq/#why-cant-i-use-the-same-profile-on-different-devices) and [this issue](https://github.com/simplex-chat/simplex-chat/issues/444#issuecomment-3066968358).
+
+## Proposed solution
+
+One of the ideas presented in FAQ - to store the state of Double Ratchet algorithm in the encrypted container on the server seems promising. The RFC develops this idea.
+
+### Considerations for the design
+
+1. The largest ratchet state size with the current implementation is less than 8kb (which is achieved when both sides shared PQ keys and ciphertexts), so while it cannot fit in the same transport blocks together with sent and received messages, it would fit in one transport block.
+
+2. Protocol commands and events may be changed (even if at the cost of slightly reducing message size) can fit the hash of the ratchet state (32 bytes sha256 would be sufficient), so that the client can determine whether it has the most recent ratchet state or if it needs to retrieve the latest copy. Message size reduction won't affect the users because we use compression, and there is a substantial reserve.
+
+3. Client commands that modify ratchet state would include the hash of the previous ratchet state so that the server can reject or ignore the command in case the previous ratchet state is different or in case command is repeated in case of lost response).
+
+4. The client does not need to retrieve message state for each encryption and decryption operation - it can "speculatively" use the ratchet state it has, and receive correct ratchet state in the "error" response after attempting encryption based on incorrect ratchet state.
+
+## Proposed protocol design
+
+Ratchet state will be stored on the same server that stores message queue, as part of message queue record. 8kb is a sufficient size for this blob (the actual max size is 7800 bytes). The server would also store the hashes of the current and, possibly, the previous ratchet states (TBC).
+
+While ratchet is used for duplex connection, the connection still has primary queue, and with redundancy the same ratchet state can be stored on all secondary queues.
+
+Ratchet state will be encrypted using secret_box - a symmetric encryption scheme, so PQ-resistant. If ratchet state is stored on more than one server, it has to be encrypted with a different key for each server.
+
+Questions: how to rotate the key used to store ratchet? Should key used to encrypt ratchet rotate at the same time when queue is rotated? The latter is a logical option, as it prevents additional complexity and solves the problem anyway. A possible option is to have "ratchet version" that will be used to advance the key used to encrypt ratchet via HKDF.
+
+Security considerations: the scheme may reduce break-in recovery to the points queues are rotated, unless there is some randomness mixed-in into the key derivation (the key used to encrypt ratchet state). But including randomness would defeat the purpose, as other devices wouldn't be able to access the ratchets. Another approach would be to have each device use its own key for encryption, and encrypt to all keys of all devices (or to encrypt key, to avoid size increase). Having multiple encryptions would show how many devices use the queue, but servers already can observe it, so it is a better tradeoff. Another idea would be to rotate the key used to authorize queue commands - we already support multiple recipient keys, and it can be used for multi-device scenario. That would partially mitigate break-in attacks as the attacker who obtained the key from ratchet state would be able to decrypt it, but won't be able to decrypt it (the attacker collusion with the server is not mitigated). Yet another idea would be for each party (device) to share its private (or encapsulation) key and to have a symmetric key (used to encrypt the ratchet state) encrypted (encapsulated) separately for each device. This would reduce the size of the stored data to `ratchet size` + `encrypted key size` * N, so even in case of PQ encryption (e.g. sntrup) the size required to store the ratchet would be under transport block size, while limiting it to say 4-8 devices, which is sufficient.
+
+To participate in multi-device scheme the devices would join the usual group that will be used to share public (encapsulation) device keys and to communicate updates to conversations that were received by the currently "active" device. "Active" means the device that received or sent and processed the message, and while only one device can receive messages from a given queue, device "active" state may be determined per queue, allowing concurrent usage.
+
+The scheme must be resilient to state updates being lost, and in case of direct messages it would result in some messages not being shown (or shown as skipped), while conversation preference and profile updates can be re-requested from peers, while the current profile of the user would become the latest. Likewise, for groups state updates ca be requested from super-peers or for decentralized groups - from owners. Maintaining chat state consistency is an important consideration, but is not a focus of this RFC - the focus is managing message delivery and DR encryption for multiple devices. Other multi-device schemes have the same issues with state consistency. Partially, the profile state consistency can be improved by using a single shared queue (or set of queues) to store user's profile and chat preferences to synchronize profile updates asynchronously between the devices.
+
+## The protocol to send the message
+
+`rsi` - ratchet state on device `i`.
+
+`enc(rs)` - current authoritative ratchet state on the server.
+
+`pt` and `ct` - plaintext and ciphertext messages.
+
+Encryption is a state transition function ratchetEnc: `(ct, rs') = ratchetEnc(pt, rs)`.
+
+1. Device encrypts the message using the stored ratchet state: `(ct, rsi') = ratchetEnc(pt, rsi)`
+
+2. Device sends modified encrypted ratchet state and the hash of the previous encrypted state to the server that stores the queue: `RSET (hash(enc(rsi)), enc(rsi'))`.
+
+3. If the hash of the previous state matches state stored on the server (`hash(enc(rsi)) == hash(enc(rs))`), the server updates the state and responds with `ratchet_ok` (that may include the current state or it's hash, for validation). If the hash is different, the server responds with `bad_ratchet(enc(rs))` message that includes the correct ratchet state. These updates must be atomic. In this case device has to update the local ratchet state (provided it can decrypt it), and repeat encryption attempt. If device cannot decrypt the provided ratchet state, it means that the connection is disrupted (possibly, device is removed from device group, but missed the notifications).
+
+4. After successful state update in primary receiving queue, the device would update it in secondary receiving queues.
+
+5. Device sends encrypted message as usual, via proxy that must be different both from the server that stores the ratchet and from the destination server.
+
+6. Device broadcasts sent message and new ratchet state to other devices in the device group.
+
+This protocol is simple, and it minimizes requests when sending the message to one additional request to update ratchet state in most cases, only requiring two requests when device state was not updated via device group prior to message sending attempt.
+
+## The protocol to receive the message
+
+Decryption is also a state transition function: `(pt, rs') = ratchetDec(ct, rs)`
+
+1. Server sends the message to the device (can be in response to SUB or ACK commands, or with active subscription). Pushed message would include the hash of the currently stored ratchet state: `hash(enc(rs))`.
+
+2. If device has the ratchet state with the same hash (`hash(enc(rs)) == hash(enc(rsi))`), it decrypts the message: `(pt, rsi') = ratchetDec(ct, rsi)`.
+
+3. If device has ratchet state with a different hash, it requests ratchet from the server with additional protocol command `RGET` with response `RCHT (enc(rs))` and updates the local state.
+
+4. Device decrypts the message `(pt, rsi') = ratchetDec(ct, rsi)` and processes it as usual.
+
+5. Device sends acknowledgement to the server as usual, but now it includes the new ratchet state and the hash of the previous state: `ACK msgId (hash(enc(rsi)), enc(rsi'))`
+
+6. The server compares ratchet state with stored state hash, and in case it matches it processes `ACK` and responds with `OK` as usual (or `NO_MSG` in case msgId is incorrect, also as usual - it would happen in repeated ACK requests). If ratchet state hash does not match, the server would respond with `bad_ratchet(enc(rs))` - which means that the message was already processed by another device and ratchet was advanced. This is a complex scenario, as the client has to either revert the change from message processing or somehow combine the change with the updates communicated via device group (as a side note, device group can simply re-broadcast messages, not state updates, but it will result in state divergence between devices when different messages are lost).
+
+Unlike sending messages, this flow does not require any additional requests in most cases, only requiring requesting message state reconciliation when the same message was received and processed by more than one client, but it does not require re-acknowledgement.
+
+## Challenges
+
+This is an idea of the design rather than the actual design, as it requires more thinking about:
+- how to handle concurrent ratchet state updates,
+- "active" status transitions per queue,
+- avoiding concurrent subscriptions to queues from multiple devices,
+- state updates and synchronization between devices,
+- handling skipped messages,
+- costs to update ratchets in bulk send scenario - this scheme would substantially increase costs of preparing large broadcasts, and it makes this scheme not acceptable for chat relays. Which means that "profile" on desktop used as chat relay won't be synched to other devices.
+- etc.
+
+## Advantages
+
+The communication peers won't know how many devices the user has, and which device was used to send the message. Also, the communication peers won't be able to send different messages to different user's devices, or to withhold messages from some devices.
@@ -1,13 +1,8 @@
 #!/usr/bin/env sh
 set -eu

-# Links to scripts/configs
-scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
-scripts_systemd_smp="$scripts/smp-server.service"
-scripts_systemd_xftp="$scripts/xftp-server.service"
-scripts_update="$scripts/simplex-servers-update"
-scripts_uninstall="$scripts/simplex-servers-uninstall"
-scripts_stopscript="$scripts/simplex-servers-stopscript"
+# Make sure that PATH variable contains /usr/local/bin
+PATH="/usr/local/bin:$PATH"

 # Default installation paths
 path_bin="/usr/local/bin"
@@ -22,7 +17,9 @@ path_systemd_smp="$path_systemd/smp-server.service"
 path_systemd_xftp="$path_systemd/xftp-server.service"

 # Temporary paths
-path_tmp_bin="$(mktemp -d)"
+path_tmp_bin="/tmp/simplex-servers"
+path_tmp_bin_smp="$path_tmp_bin/smp-server"
+path_tmp_bin_xftp="$path_tmp_bin/xftp-server"
 path_tmp_bin_update="$path_tmp_bin/simplex-servers-update"
 path_tmp_bin_uninstall="$path_tmp_bin/simplex-servers-uninstall"
 path_tmp_bin_stopscript="$path_tmp_bin/simplex-servers-stopscript"
@@ -37,203 +34,549 @@ BLU='\033[1;36m'
 YLW='\033[1;33m'
 RED='\033[0;31m'
 NC='\033[0m'
+BLD='\033[1m'
+UNDRL='\033[4m'
+
+NL='
+'
+
+# Set VER globally and only once
+VER="${VER:-latest}"

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

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

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

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

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

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

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

-set_version() {
-  ver="${VER:-latest}"
-
-  case "$ver" in 
-    latest)
-      bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
-      remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
-      ;;
-    *)
-      bin="https://github.com/simplex-chat/simplexmq/releases/download/${ver}"
-      remote_version="${ver}"
-      ;;
-  esac
-}
-
-update_scripts() {
-  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_update" -o "$path_tmp_bin_update" && chmod +x "$path_tmp_bin_update"
-  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_uninstall" -o "$path_tmp_bin_uninstall" && chmod +x "$path_tmp_bin_uninstall"
-  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_stopscript" -o "$path_tmp_bin_stopscript" && chmod +x "$path_tmp_bin_stopscript"
-
-  if diff -q "$path_bin_uninstall" "$path_tmp_bin_uninstall" > /dev/null 2>&1; then
-    printf -- "- ${YLW}Uninstall script is up-to-date${NC}.\n"
-    rm "$path_tmp_bin_uninstall"
-  else
-    printf -- "- Updating uninstall script..."
-    mv "$path_tmp_bin_uninstall" "$path_bin_uninstall"
-    printf "${GRN}Done!${NC}\n"
+  if [ -z "$apps" ]; then
+    printf "${RED}No simplex servers installed! Aborting.${NC}\n"
+    exit 1
  fi

-  if diff -q "$path_bin_stopscript" "$path_tmp_bin_stopscript" > /dev/null 2>&1; then
-    printf -- "- ${YLW}Stopscript script is up-to-date${NC}.\n"
-    rm "$path_tmp_bin_stopscript"
-  else
-    printf -- "- Updating stopscript script..."
-    mv "$path_tmp_bin_stopscript" "$path_bin_stopscript"
-    printf "${GRN}Done!${NC}\n"
-  fi
+  for server in $apps; do
+    # Check if info file is present
+    if [ -f "$path_conf_info/release" ]; then
+      # If present, source it
+      . "$path_conf_info/release" 2>/dev/null

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

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

+# Checks the distro and sets the urls variables
+check_distro() {
+  . /etc/os-release
+
+  case "$VERSION_ID" in
+    20.04|22.04) : ;;
+    24.04) VERSION_ID='22.04' ;;
+    *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
+  esac
+
+  version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
+  arch="$(uname -p)"
+
+  case "$arch" in
+    x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
+    *)  printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
+  esac
+
+  bin_url_smp="$bin_url/smp-server-ubuntu-${version}-${arch}"
+  bin_url_xftp="$bin_url/xftp-server-ubuntu-${version}-${arch}"
+
+  return 0
+}
+
+# General checks that must be performed on the initial execution of script
 checks() {
  if [ "$(id -u)" -ne 0 ]; then
    printf "This script is intended to be run with root privileges. Please re-run script using sudo.\n"
    exit 1
  fi

-  set_version
-  os_test
-  installed_test
+  check_versions
+  check_distro

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

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

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

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

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

 main "$@"
@@ -0,0 +1,139 @@
+#!/usr/bin/env sh
+set -eu
+
+TAG="$1"
+
+tempdir="$(mktemp -d)"
+init_dir="$PWD"
+
+repo_name="simplexmq"
+repo="https://github.com/simplex-chat/${repo_name}"
+export DOCKER_BUILDKIT=1
+
+cleanup() {
+	docker exec -t builder sh -c 'rm -rf ./dist-newstyle' 2>/dev/null || :
+	rm -rf -- "$tempdir"
+	docker rm --force builder 2>/dev/null || :
+	docker image rm local 2>/dev/null || :
+	cd "$init_dir"
+}
+trap 'cleanup' EXIT INT
+
+mkdir -p "$init_dir/$TAG-$repo_name/from-source" "$init_dir/$TAG-$repo_name/prebuilt"
+
+git -C "$tempdir" clone "$repo.git" &&\
+	cd "$tempdir/${repo_name}" &&\
+	git checkout "$TAG"
+
+for os in 22.04 24.04; do
+	os_url="$(printf '%s' "$os" | tr '.' '_')"
+
+	# Build image
+	docker build \
+		--no-cache \
+		--build-arg TAG=${os} \
+		--build-arg GHC=9.6.3 \
+		-f "$tempdir/simplexmq/Dockerfile.build" \
+		-t local \
+		.
+
+	# Run container in background
+	docker run -t -d \
+		--name builder \
+		-v "$tempdir/${repo_name}:/project" \
+		local
+
+	# PostgreSQL build (only smp-server)
+	docker exec \
+		-t \
+		builder \
+		sh -c 'cabal update && cabal build --jobs=$(nproc) --enable-tests -fserver_postgres && mkdir -p /out && for i in smp-server simplexmq-test; do bin=$(find /project/dist-newstyle -name "$i" -type f -executable) && chmod +x "$bin" && mv "$bin" /out/; done && strip /out/smp-server'
+
+	# Copy smp-server postgresql binary and prepare it
+	docker cp \
+		builder:/out/smp-server \
+		"$init_dir/$TAG-$repo_name/from-source/smp-server-postgres-ubuntu-${os_url}-x86-64"
+
+	# Download prebuilt postgresql binary
+	curl -L \
+		--output-dir "$init_dir/$TAG-$repo_name/prebuilt/" \
+		-O \
+		"$repo/releases/download/${TAG}/smp-server-postgres-ubuntu-${os_url}-x86-64"
+	
+	# Regular build (all)
+	apps='smp-server xftp-server ntf-server xftp'
+
+	docker exec \
+		-t \
+		-e apps="$apps" \
+		builder \
+		sh -c 'cabal build --jobs=$(nproc) && mkdir -p /out && for i in $apps; do bin=$(find /project/dist-newstyle -name "$i" -type f -executable) && strip "$bin" && chmod +x "$bin" && mv "$bin" /out/; done'
+
+	# Copy regular binaries
+	docker cp \
+		builder:/out \
+		out-${os}
+	
+	# Prepare regular binaries and download the prebuilt ones
+	for app in $apps; do
+		curl -L \
+			--output-dir "$init_dir/$TAG-$repo_name/prebuilt/" \
+			-O \
+		       	"$repo/releases/download/${TAG}/${app}-ubuntu-${os_url}-x86-64"
+
+		mv "./out-${os}/$app" "$init_dir/$TAG-$repo_name/from-source/${app}-ubuntu-${os_url}-x86-64"
+	done
+
+	# Important! Remove dist-newstyle for the next interation
+	docker exec \
+		-t \
+		builder \
+		sh -c 'rm -rf ./dist-newstyle'
+
+	# Also restore git to previous state 
+	git reset --hard && git clean -dfx
+
+	# Stop containers, delete images
+	docker stop builder
+	docker rm --force builder
+	docker image rm local
+done
+
+# Cleanup
+rm -rf -- "$tempdir"
+cd "$init_dir"
+
+# Final stage: compare hashes
+
+# Path to binaries
+path_bin="$init_dir/$TAG-$repo_name"
+
+# Assume everything is okay for now
+bad=0
+
+# Check hashes for all binaries
+for file in "$path_bin"/from-source/*; do
+	# Extract binary name
+	app="$(basename $file)"
+
+	# Compute hash for compiled binary
+	compiled=$(sha256sum "$path_bin/from-source/$app" | awk '{print $1}')
+	# Compute hash for prebuilt binary
+	prebuilt=$(sha256sum "$path_bin/prebuilt/$app" | awk '{print $1}')
+
+	# Compare
+	if [ "$compiled" != "$prebuilt" ]; then
+		# If hashes doesn't match, set bad...
+		bad=1
+
+		# ... and print affected binary
+		printf "%s - sha256sum hash doesn't match\n" "$app"
+	fi
+done
+
+# If everything is still okay, compute checksums file
+if [ "$bad" = 0 ]; then
+	sha256sum "$path_bin"/from-source/* | sed -e "s|$PWD/||g" -e 's|from-source/||g' -e "s|-$repo_name||g" > "$path_bin/_sha256sums"
+
+	printf 'Checksums computed - %s\n' "$path_bin/_sha256sums"
+fi
@@ -1,7 +1,7 @@
 cabal-version: 1.12

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

+flag server_postgres
+  description: Build server with support of PostgreSQL.
+  manual: True
+  default: False
+
 library
  exposed-modules:
      Simplex.FileTransfer.Agent
@@ -100,6 +105,8 @@ library
      Simplex.Messaging.Agent.Store.DB
      Simplex.Messaging.Agent.Store.Interface
      Simplex.Messaging.Agent.Store.Migrations
+      Simplex.Messaging.Agent.Store.Migrations.App
+      Simplex.Messaging.Agent.Store.Postgres.Options
      Simplex.Messaging.Agent.Store.Shared
      Simplex.Messaging.Agent.TRcvQueues
      Simplex.Messaging.Client
@@ -114,6 +121,7 @@ library
      Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
      Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
      Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
+      Simplex.Messaging.Crypto.ShortLink
      Simplex.Messaging.Encoding
      Simplex.Messaging.Encoding.String
      Simplex.Messaging.Notifications.Client
@@ -123,9 +131,11 @@ library
      Simplex.Messaging.Parsers
      Simplex.Messaging.Protocol
      Simplex.Messaging.Server.Expiration
+      Simplex.Messaging.Server.QueueStore.Postgres.Config
      Simplex.Messaging.Server.QueueStore.QueueInfo
      Simplex.Messaging.ServiceScheme
      Simplex.Messaging.Session
+      Simplex.Messaging.Agent.Store.Entity
      Simplex.Messaging.TMap
      Simplex.Messaging.Transport
      Simplex.Messaging.Transport.Buffer
@@ -137,6 +147,7 @@ library
      Simplex.Messaging.Transport.HTTP2.Server
      Simplex.Messaging.Transport.KeepAlive
      Simplex.Messaging.Transport.Server
+      Simplex.Messaging.Transport.Shared
      Simplex.Messaging.Util
      Simplex.Messaging.Version
      Simplex.Messaging.Version.Internal
@@ -147,20 +158,18 @@ library
      Simplex.RemoteControl.Types
  if flag(client_postgres)
      exposed-modules:
-          Simplex.Messaging.Agent.Store.Postgres
-          Simplex.Messaging.Agent.Store.Postgres.Common
-          Simplex.Messaging.Agent.Store.Postgres.DB
-          Simplex.Messaging.Agent.Store.Postgres.Migrations
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.App
          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
-      if !flag(client_library)
-          exposed-modules:
-              Simplex.Messaging.Agent.Store.Postgres.Util
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete
  else
      exposed-modules:
          Simplex.Messaging.Agent.Store.SQLite
          Simplex.Messaging.Agent.Store.SQLite.Common
          Simplex.Messaging.Agent.Store.SQLite.DB
          Simplex.Messaging.Agent.Store.SQLite.Migrations
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.App
          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
@@ -198,6 +207,16 @@ library
          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
+  if flag(client_postgres) || flag(server_postgres)
+      exposed-modules:
+          Simplex.Messaging.Agent.Store.Postgres
+          Simplex.Messaging.Agent.Store.Postgres.Common
+          Simplex.Messaging.Agent.Store.Postgres.DB
+          Simplex.Messaging.Agent.Store.Postgres.Migrations
+          Simplex.Messaging.Agent.Store.Postgres.Util
  if !flag(client_library)
      exposed-modules:
          Simplex.FileTransfer.Client.Main
@@ -205,36 +224,50 @@ library
          Simplex.FileTransfer.Server.Control
          Simplex.FileTransfer.Server.Env
          Simplex.FileTransfer.Server.Main
+          Simplex.FileTransfer.Server.Prometheus
          Simplex.FileTransfer.Server.Stats
          Simplex.FileTransfer.Server.Store
          Simplex.FileTransfer.Server.StoreLog
-          Simplex.Messaging.Notifications.Server
-          Simplex.Messaging.Notifications.Server.Control
-          Simplex.Messaging.Notifications.Server.Env
-          Simplex.Messaging.Notifications.Server.Main
-          Simplex.Messaging.Notifications.Server.Push.APNS
-          Simplex.Messaging.Notifications.Server.Push.APNS.Internal
-          Simplex.Messaging.Notifications.Server.Stats
-          Simplex.Messaging.Notifications.Server.Store
-          Simplex.Messaging.Notifications.Server.StoreLog
          Simplex.Messaging.Server
          Simplex.Messaging.Server.CLI
          Simplex.Messaging.Server.Control
          Simplex.Messaging.Server.Env.STM
          Simplex.Messaging.Server.Information
          Simplex.Messaging.Server.Main
+          Simplex.Messaging.Server.Main.GitCommit
+          Simplex.Messaging.Server.Main.Init
          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.NtfStore
          Simplex.Messaging.Server.Prometheus
          Simplex.Messaging.Server.QueueStore
          Simplex.Messaging.Server.QueueStore.STM
+          Simplex.Messaging.Server.QueueStore.Types
          Simplex.Messaging.Server.Stats
          Simplex.Messaging.Server.StoreLog
+          Simplex.Messaging.Server.StoreLog.ReadWrite
          Simplex.Messaging.Server.StoreLog.Types
          Simplex.Messaging.Transport.WebSockets
+      if flag(server_postgres)
+          exposed-modules:
+              Simplex.Messaging.Notifications.Server
+              Simplex.Messaging.Notifications.Server.Control
+              Simplex.Messaging.Notifications.Server.Env
+              Simplex.Messaging.Notifications.Server.Main
+              Simplex.Messaging.Notifications.Server.Prometheus
+              Simplex.Messaging.Notifications.Server.Push.APNS
+              Simplex.Messaging.Notifications.Server.Push.APNS.Internal
+              Simplex.Messaging.Notifications.Server.Stats
+              Simplex.Messaging.Notifications.Server.Store
+              Simplex.Messaging.Notifications.Server.Store.Migrations
+              Simplex.Messaging.Notifications.Server.Store.Postgres
+              Simplex.Messaging.Notifications.Server.Store.Types
+              Simplex.Messaging.Notifications.Server.StoreLog
+              Simplex.Messaging.Server.QueueStore.Postgres
+              Simplex.Messaging.Server.QueueStore.Postgres.Migrations
  other-modules:
      Paths_simplexmq
  hs-source-dirs:
@@ -271,7 +304,6 @@ library
    , hourglass ==0.2.*
    , http-types ==0.12.*
    , http2 >=4.2.2 && <4.3
-    , ini ==0.4.1
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
@@ -280,13 +312,11 @@ library
    , network-info ==0.2.*
    , network-transport ==0.5.6
    , network-udp ==0.0.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
    , random >=1.1 && <1.3
+    , scientific ==0.3.7.*
    , simple-logger ==0.1.*
    , socks ==0.6.*
    , stm ==2.5.*
-    , temporary ==1.3.*
    , time ==1.12.*
    , time-manager ==0.0.*
    , tls >=1.9.0 && <1.10
@@ -302,29 +332,44 @@ library
    build-depends:
        case-insensitive ==1.2.*
      , hashable ==1.4.*
+      , ini ==0.4.1
+      , optparse-applicative >=0.15 && <0.17
+      , process ==1.6.*
+      , temporary ==1.3.*
      , websockets ==0.12.*
-  if flag(client_postgres)
+  if flag(client_postgres) || flag(server_postgres)
    build-depends:
        postgresql-libpq >=0.10.0.0
      , postgresql-simple ==0.7.*
      , raw-strings-qq ==1.1.*
+  if flag(client_postgres)
    cpp-options: -DdbPostgres
  else
    build-depends:
        direct-sqlcipher ==2.3.*
      , sqlcipher-simple ==0.4.*
+  if flag(server_postgres)
+    cpp-options: -DdbServerPostgres
+    build-depends:
+        hex-text ==0.1.*
  if impl(ghc >= 9.6.2)
    build-depends:
        bytestring ==0.11.*
+      , template-haskell ==2.20.*
      , text >=2.0.1 && <2.2
  if impl(ghc < 9.6.2)
    build-depends:
        bytestring ==0.10.*
+      , template-haskell ==2.16.*
      , text >=1.2.3.0 && <1.3

 executable ntf-server
  if flag(client_library)
      buildable: False
+  if flag(server_postgres)
+    cpp-options: -DdbServerPostgres
+  else
+    buildable: False
  main-is: Main.hs
  other-modules:
      Paths_simplexmq
@@ -342,6 +387,8 @@ executable ntf-server
 executable smp-server
  if flag(client_library)
      buildable: False
+  if flag(server_postgres)
+    cpp-options: -DdbServerPostgres
  main-is: Main.hs
  other-modules:
      Static
@@ -415,8 +462,8 @@ test-suite simplexmq-test
      AgentTests.EqInstances
      AgentTests.FunctionalAPITests
      AgentTests.MigrationTests
-      AgentTests.NotificationTests
      AgentTests.ServerChoice
+      AgentTests.ShortLinkTests
      CLITests
      CoreTests.BatchingTests
      CoreTests.CryptoFileTests
@@ -430,9 +477,6 @@ test-suite simplexmq-test
      CoreTests.UtilTests
      CoreTests.VersionRangeTests
      FileDescriptionTests
-      Fixtures
-      NtfClient
-      NtfServerTests
      RemoteControl
      ServerTests
      SMPAgentClient
@@ -446,15 +490,25 @@ test-suite simplexmq-test
      Static
      Static.Embedded
      Paths_simplexmq
-  if !flag(client_postgres)
+  if flag(client_postgres)
+      other-modules:
+          Fixtures
+  else
      other-modules:
          AgentTests.SchemaDump
          AgentTests.SQLiteTests
+  if flag(server_postgres)
+      other-modules:
+          AgentTests.NotificationTests
+          NtfClient
+          NtfServerTests
+          PostgresSchemaDump
  hs-source-dirs:
      tests
      apps/smp-server/web
  default-extensions:
      StrictData
+  -- add -fhpc to ghc-options to run tests with coverage
  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
  build-depends:
      base
@@ -467,13 +521,13 @@ test-suite simplexmq-test
    , crypton-x509
    , crypton-x509-store
    , crypton-x509-validation
-    , deepseq ==1.4.*
    , directory
    , file-embed
    , filepath
    , generic-random ==1.5.*
    , hashable
    , hspec ==2.11.*
+    , hspec-core ==2.11.*
    , http-client
    , http-types
    , http2
@@ -481,10 +535,8 @@ test-suite simplexmq-test
    , ini
    , iso8601-time
    , main-tester ==0.2.*
-    , memory
    , mtl
    , network
-    , process
    , QuickCheck ==2.14.*
    , random
    , silently ==1.2.*
@@ -504,12 +556,18 @@ test-suite simplexmq-test
    , warp-tls
    , yaml
  default-language: Haskell2010
+  if flag(server_postgres)
+    cpp-options: -DdbServerPostgres
  if flag(client_postgres)
-    build-depends:
-        postgresql-libpq >=0.10.0.0
-      , postgresql-simple ==0.7.*
-      , raw-strings-qq ==1.1.*
    cpp-options: -DdbPostgres
  else
    build-depends:
-        sqlcipher-simple
+        memory
+      , sqlcipher-simple
+  if !flag(client_postgres) || flag(client_postgres) || flag(server_postgres)
+    build-depends:
+        deepseq ==1.4.*
+      , process
+  if flag(client_postgres) || flag(server_postgres)
+    build-depends:
+        postgresql-simple ==0.7.*
@@ -75,7 +75,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (strDecode, strEncode)
 import Simplex.Messaging.Protocol (ProtocolServer, ProtocolType (..), XFTPServer)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (catchAll_, liftError, tshow, unlessM, whenM)
+import Simplex.Messaging.Util (allFinally, catchAll_, catchAllErrors, liftError, tshow, unlessM, whenM)
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
 import UnliftIO.Directory
@@ -198,10 +198,10 @@ runXFTPRcvWorker c srv Worker {doWork} = do
            liftIO $ waitForUserNetwork c
            atomically $ incXFTPServerStat c userId srv downloadAttempts
            downloadFileChunk fc replica approvedRelays
-              `catchAgentError` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
+              `catchAllErrors` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
          where
            retryLoop loop e replicaDelay = do
-              flip catchAgentError (\_ -> pure ()) $ do
+              flip catchAllErrors (\_ -> pure ()) $ do
                when (serverHostError e) $ notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFWARN e)
                liftIO $ closeXFTPServerClient c userId server digest
                withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
@@ -280,7 +280,7 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
    runXFTPOperation AgentConfig {rcvFilesTTL} =
      withWork c doWork (`getNextRcvFileToDecrypt` rcvFilesTTL) $
        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath, redirect} ->
-          decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId (redirectEntityId <$> redirect) tmpPath
+          decryptFile f `catchAllErrors` rcvWorkerInternalError c rcvFileId rcvFileEntityId (redirectEntityId <$> redirect) tmpPath
    decryptFile :: RcvFile -> AM ()
    decryptFile RcvFile {rcvFileId, rcvFileEntityId, size, digest, key, nonce, tmpPath, saveFile, status, chunks, redirect} = do
      let CryptoFile savePath cfArgs = saveFile
@@ -307,7 +307,7 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
          liftIO $ waitUntilForeground c
          withStore' c (`updateRcvFileComplete` rcvFileId)
          -- proceed with redirect
-          yaml <- liftError (FILE . FILE_IO . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `agentFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
+          yaml <- liftError (FILE . FILE_IO . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `allFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
          next@FileDescription {chunks = nextChunks} <- case strDecode (LB.toStrict yaml) of
            -- TODO switch to another error constructor
            Left _ -> throwE . FILE $ REDIRECT "decode error"
@@ -399,7 +399,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
    runXFTPOperation cfg@AgentConfig {sndFilesTTL} =
      withWork c doWork (`getNextSndFileToPrepare` sndFilesTTL) $
        \f@SndFile {sndFileId, sndFileEntityId, prefixPath} ->
-          prepareFile cfg f `catchAgentError` sndWorkerInternalError c sndFileId sndFileEntityId prefixPath
+          prepareFile cfg f `catchAllErrors` sndWorkerInternalError c sndFileId sndFileEntityId prefixPath
    prepareFile :: AgentConfig -> SndFile -> AM ()
    prepareFile _ SndFile {prefixPath = Nothing} =
      throwE $ INTERNAL "no prefix path"
@@ -468,11 +468,11 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
                liftIO $ waitForUserNetwork c
                let triedAllSrvs = n > userSrvCount
                createWithNextSrv triedHosts
-                  `catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop triedAllSrvs e) (throwE e) e
+                  `catchAllErrors` \e -> retryOnError "XFTP prepare worker" (retryLoop loop triedAllSrvs e) (throwE e) e
              where
                -- we don't do closeXFTPServerClient here to not risk closing connection for concurrent chunk upload
                retryLoop loop triedAllSrvs e = do
-                  flip catchAgentError (\_ -> pure ()) $ do
+                  flip catchAllErrors (\_ -> pure ()) $ do
                    when (triedAllSrvs && serverHostError e) $ notify c sndFileEntityId $ SFWARN e
                  liftIO $ assertAgentForeground c
                  loop
@@ -508,10 +508,10 @@ runXFTPSndWorker c srv Worker {doWork} = do
            liftIO $ waitForUserNetwork c
            atomically $ incXFTPServerStat c userId srv uploadAttempts
            uploadFileChunk cfg fc replica
-              `catchAgentError` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
+              `catchAllErrors` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
          where
            retryLoop loop e replicaDelay = do
-              flip catchAgentError (\_ -> pure ()) $ do
+              flip catchAllErrors (\_ -> pure ()) $ do
                when (serverHostError e) $ notify c sndFileEntityId $ SFWARN e
                liftIO $ closeXFTPServerClient c userId server digest
                withStore' c $ \db -> updateSndChunkReplicaDelay db sndChunkReplicaId replicaDelay
@@ -681,10 +681,10 @@ runXFTPDelWorker c srv Worker {doWork} = do
            liftIO $ waitForUserNetwork c
            atomically $ incXFTPServerStat c userId srv deleteAttempts
            deleteChunkReplica
-              `catchAgentError` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
+              `catchAllErrors` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
          where
            retryLoop loop e replicaDelay = do
-              flip catchAgentError (\_ -> pure ()) $ do
+              flip catchAllErrors (\_ -> pure ()) $ do
                when (serverHostError e) $ notify c "" $ SFWARN e
                liftIO $ closeXFTPServerClient c userId server chunkDigest
                withStore' c $ \db -> updateDeletedSndChunkReplicaDelay db deletedSndChunkReplicaId replicaDelay
@@ -31,18 +31,22 @@ import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Client as H
+import Network.Socket (HostName)
 import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Protocol
 import Simplex.FileTransfer.Transport
 import Simplex.Messaging.Client
  ( NetworkConfig (..),
+    NetworkRequestMode (..),
    ProtocolClientError (..),
    TransportSession,
+    netTimeoutInt,
    chooseTransportHost,
    defaultNetworkConfig,
    transportClientConfig,
    clientSocksCredentials,
    unexpectedResponse,
+    useWebPort,
  )
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
@@ -55,9 +59,11 @@ import Simplex.Messaging.Protocol
    RecipientId,
    SenderId,
    pattern NoEntity,
+    NetworkError (..),
+    toNetworkError,
  )
-import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
-import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
+import Simplex.Messaging.Transport (ALPN, CertChainPubKey (..), HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
+import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.Client
 import Simplex.Messaging.Transport.HTTP2.File
@@ -99,15 +105,16 @@ defaultXFTPClientConfig =
  XFTPClientConfig
    { xftpNetworkConfig = defaultNetworkConfig,
      serverVRange = supportedFileServerVRange,
-      clientALPN = Just supportedXFTPhandshakes
+      clientALPN = Just alpnSupportedXFTPhandshakes
    }

-getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
-getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} proxySessTs disconnected = runExceptT $ do
+getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> [HostName] -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
+getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} presetDomains proxySessTs disconnected = runExceptT $ do
  let socksCreds = clientSocksCredentials xftpNetworkConfig proxySessTs transportSession
      ProtocolServer _ host port keyHash = srv
+      useALPN = if useWebPort xftpNetworkConfig presetDomains srv then Just [httpALPN11] else clientALPN
  useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
-  let tcConfig = (transportClientConfig xftpNetworkConfig useHost False) {alpn = clientALPN}
+  let tcConfig = transportClientConfig xftpNetworkConfig NRMBackground useHost False useALPN
      http2Config = xftpHTTP2Config tcConfig config
  clientVar <- newTVarIO Nothing
  let usePort = if null port then "443" else port
@@ -116,10 +123,11 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
  let HTTP2Client {sessionId, sessionALPN} = http2Client
      v = VersionXFTP 1
      thServerVRange = versionToRange v
-      thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True}
+      thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
  logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
  thParams@THandleParams {thVersion} <- case sessionALPN of
-    Just "xftp/1" -> xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
+    Just alpn | alpn == xftpALPNv1 || alpn == httpALPN11 ->
+      xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
    _ -> pure thParams0
  logDebug $ "Client negotiated protocol: " <> tshow thVersion
  let c = XFTPClient {http2Client, thParams, transportSession, config}
@@ -132,7 +140,8 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
  (vr, sk) <- processServerHandshake shs
  let v = maxVersion vr
  sendClientHandshake XFTPClientHandshake {xftpVersion = v, keyHash}
-  pure thParams0 {thAuth = Just THAuthClient {serverPeerPubKey = sk, serverCertKey = ck, sessSecret = Nothing}, thVersion = v, thServerVRange = vr}
+  let thAuth = Just THAuthClient {peerServerPubKey = sk, peerServerCertKey = ck, clientService = Nothing, sessSecret = Nothing}
+  pure thParams0 {thAuth, thVersion = v, thServerVRange = vr}
  where
    getServerHandshake :: ExceptT XFTPClientError IO XFTPServerHandshake
    getServerHandshake = do
@@ -147,12 +156,12 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
        Nothing -> throwE $ PCETransportError TEVersion
        Just (Compatible vr) ->
          fmap (vr,) . liftTransportErr (TEHandshake BAD_AUTH) $ do
-            let (X.CertificateChain cert, exact) = serverAuth
+            let CertChainPubKey (X.CertificateChain cert) exact = serverAuth
            case cert of
              [_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure ()
              _ -> throwError "bad certificate"
            pubKey <- maybe (throwError "bad server key type") (`C.verifyX509` exact) serverKey
-            C.x509ToPublic (pubKey, []) >>= C.pubKey
+            C.x509ToPublic' pubKey
    sendClientHandshake :: XFTPClientHandshake -> ExceptT XFTPClientError IO ()
    sendClientHandshake chs = do
      chs' <- liftTransportErr TELargeMsg $ C.pad (smpEncode chs) xftpBlockSize
@@ -177,14 +186,14 @@ xftpHTTP2Config transportConfig XFTPClientConfig {xftpNetworkConfig = NetworkCon
  defaultHTTP2ClientConfig
    { bodyHeadSize = xftpBlockSize,
      suportedTLSParams = defaultSupportedParams,
-      connTimeout = tcpConnectTimeout,
+      connTimeout = netTimeoutInt tcpConnectTimeout NRMBackground,
      transportConfig
    }

 xftpClientError :: HTTP2ClientError -> XFTPClientError
 xftpClientError = \case
  HCResponseTimeout -> PCEResponseTimeout
-  HCNetworkError -> PCENetworkError
+  HCNetworkError e -> PCENetworkError e
  HCIOError e -> PCEIOError e

 sendXFTPCommand :: forall p. FilePartyI p => XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> FileCommand p -> Maybe XFTPChunkSpec -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
@@ -203,7 +212,7 @@ sendXFTPTransmission XFTPClient {config, thParams, http2Client} t chunkSpec_ = d
  HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- withExceptT xftpClientError . ExceptT $ sendRequest http2Client req (Just reqTimeout)
  when (B.length bodyHead /= xftpBlockSize) $ throwE $ PCEResponseError BLOCK
  -- TODO validate that the file ID is the same as in the request?
-  (_, _, (_, _fId, respOrErr)) <- liftEither . first PCEResponseError $ xftpDecodeTransmission thParams bodyHead
+  (_, _fId, respOrErr) <-liftEither $ first PCEResponseError $ xftpDecodeTClient thParams bodyHead
  case respOrErr of
    Right r -> case protocolError r of
      Just e -> throwE $ PCEProtocolError e
@@ -254,9 +263,9 @@ downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {
        ExceptT (sequence <$> (t `timeout` (download cbState `catches` errors))) >>= maybe (throwE PCEResponseTimeout) pure
        where
          errors =
-            [ Handler $ \(_e :: H.HTTP2Error) -> pure $ Left PCENetworkError,
-              Handler $ \(e :: IOException) -> pure $ Left (PCEIOError e),
-              Handler $ \(_e :: SomeException) -> pure $ Left PCENetworkError
+            [ Handler $ \(e :: H.HTTP2Error) -> pure $ Left $ PCENetworkError $ NEConnectError $ displayException e,
+              Handler $ \(e :: IOException) -> pure $ Left $ PCEIOError e,
+              Handler $ \(e :: SomeException) -> pure $ Left $ PCENetworkError $ toNetworkError e
            ]
          download cbState =
            runExceptT . withExceptT PCEResponseError $
@@ -267,11 +276,11 @@ downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {

 xftpReqTimeout :: XFTPClientConfig -> Maybe Word32 -> Int
 xftpReqTimeout cfg@XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpTimeout}} chunkSize_ =
-  maybe tcpTimeout (chunkTimeout cfg) chunkSize_
+  maybe (netTimeoutInt tcpTimeout NRMBackground) (chunkTimeout cfg) chunkSize_

 chunkTimeout :: XFTPClientConfig -> Word32 -> Int
 chunkTimeout XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpTimeout, tcpTimeoutPerKb}} sz =
-  tcpTimeout + fromIntegral (min ((fromIntegral sz `div` 1024) * tcpTimeoutPerKb) (fromIntegral (maxBound :: Int)))
+  netTimeoutInt tcpTimeout NRMBackground + fromIntegral (min ((fromIntegral sz `div` 1024) * tcpTimeoutPerKb) (fromIntegral (maxBound :: Int)))

 deleteXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> SenderId -> ExceptT XFTPClientError IO ()
 deleteXFTPChunk c spKey sId = sendXFTPCommand c spKey sId FDEL Nothing >>= okResponse
@@ -19,7 +19,7 @@ import Data.Text.Encoding (decodeUtf8)
 import Data.Time.Clock (UTCTime, getCurrentTime)
 import Simplex.FileTransfer.Client
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientError (..), temporaryClientError)
+import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), ProtocolClientError (..), netTimeoutInt, temporaryClientError)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtocolServer (..), XFTPServer)
 import Simplex.Messaging.TMap (TMap)
@@ -71,7 +71,7 @@ getXFTPServerClient XFTPClientAgent {xftpClients, startedAt, config} srv = do
    connectClient =
      ExceptT $
        first (XFTPClientAgentError srv)
-          <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) startedAt clientDisconnected
+          <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) [] startedAt clientDisconnected

    clientDisconnected :: XFTPClient -> IO ()
    clientDisconnected _ = do
@@ -90,7 +90,7 @@ getXFTPServerClient XFTPClientAgent {xftpClients, startedAt, config} srv = do
    waitForXFTPClient :: XFTPClientVar -> ME XFTPClient
    waitForXFTPClient clientVar = do
      let XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpConnectTimeout}} = xftpConfig config
-      client_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar clientVar)
+      client_ <- liftIO $ netTimeoutInt tcpConnectTimeout NRMBackground `timeout` atomically (readTMVar clientVar)
      liftEither $ case client_ of
        Just (Right c) -> Right c
        Just (Left e) -> Left e
@@ -127,6 +127,6 @@ closeXFTPServerClient XFTPClientAgent {xftpClients, config} srv =
  where
    closeClient cVar = do
      let NetworkConfig {tcpConnectTimeout} = xftpNetworkConfig $ xftpConfig config
-      tcpConnectTimeout `timeout` atomically (readTMVar cVar) >>= \case
+      netTimeoutInt tcpConnectTimeout NRMBackground `timeout` atomically (readTMVar cVar) >>= \case
        Just (Right client) -> closeXFTPClient client `catchAll_` pure ()
        _ -> pure ()
@@ -280,7 +280,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
      let chunkSpecs = prepareChunkSpecs encPath chunkSizes
          fdRcv = FileDescription {party = SFRecipient, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = [], redirect = Nothing}
          fdSnd = FileDescription {party = SFSender, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = [], redirect = Nothing}
-      logInfo $ "encrypted file to " <> tshow encPath
+      logDebug $ "encrypted file to " <> tshow encPath
      pure (encPath, fdRcv, fdSnd, chunkSpecs, encSize)
    uploadFile :: TVar ChaChaDRG -> [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]
    uploadFile g chunks uploadedChunks encSize = do
@@ -293,14 +293,14 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
      -- TODO shuffle/unshuffle chunks
      -- the reason we don't do pooled downloads here within one server is that http2 library doesn't handle cleint concurrency, even though
      -- upload doesn't allow other requests within the same client until complete (but download does allow).
-      logInfo $ "uploading " <> tshow (length chunks) <> " chunks..."
+      logDebug $ "uploading " <> tshow (length chunks) <> " chunks..."
      (errs, rs) <- partitionEithers . concat <$> liftIO (pooledForConcurrentlyN 16 chunks' . mapM $ runExceptT . uploadFileChunk a)
      mapM_ throwE errs
      pure $ map snd (sortOn fst rs)
      where
        uploadFileChunk :: XFTPClientAgent -> (Int, XFTPChunkSpec, XFTPServerWithAuth) -> ExceptT CLIError IO (Int, SentFileChunk)
        uploadFileChunk a (chunkNo, chunkSpec@XFTPChunkSpec {chunkSize}, ProtoServerWithAuth xftpServer auth) = do
-          logInfo $ "uploading chunk " <> tshow chunkNo <> " to " <> showServer xftpServer <> "..."
+          logDebug $ "uploading chunk " <> tshow chunkNo <> " to " <> showServer xftpServer <> "..."
          (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
          rKeys <- atomically $ L.fromList <$> replicateM numRecipients (C.generateAuthKeyPair C.SEd25519 g)
          digest <- liftIO $ getChunkDigest chunkSpec
@@ -308,7 +308,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
          c <- withRetry retryCount $ getXFTPServerClient a xftpServer
          (sndId, rIds) <- withRetry retryCount $ createXFTPChunk c spKey ch (L.map fst rKeys) auth
          withReconnect a xftpServer retryCount $ \c' -> uploadXFTPChunk c' spKey sndId chunkSpec
-          logInfo $ "uploaded chunk " <> tshow chunkNo
+          logDebug $ "uploaded chunk " <> tshow chunkNo
          uploaded <- atomically . stateTVar uploadedChunks $ \cs ->
            let cs' = fromIntegral chunkSize : cs in (sum cs', cs')
          liftIO $ do
@@ -418,11 +418,11 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
    downloadFileChunk :: TVar ChaChaDRG -> XFTPClientAgent -> FilePath -> FileSize Int64 -> TVar [Int64] -> FileChunk -> ExceptT CLIError IO (Int, FilePath)
    downloadFileChunk g a encPath (FileSize encSize) downloadedChunks FileChunk {chunkNo, chunkSize, digest, replicas = replica : _} = do
      let FileChunkReplica {server, replicaId, replicaKey} = replica
-      logInfo $ "downloading chunk " <> tshow chunkNo <> " from " <> showServer server <> "..."
+      logDebug $ "downloading chunk " <> tshow chunkNo <> " from " <> showServer server <> "..."
      chunkPath <- uniqueCombine encPath $ show chunkNo
      let chunkSpec = XFTPRcvChunkSpec chunkPath (unFileSize chunkSize) (unFileDigest digest)
      withReconnect a server retryCount $ \c -> downloadXFTPChunk g c replicaKey (unChunkReplicaId replicaId) chunkSpec
-      logInfo $ "downloaded chunk " <> tshow chunkNo <> " to " <> T.pack chunkPath
+      logDebug $ "downloaded chunk " <> tshow chunkNo <> " to " <> T.pack chunkPath
      downloaded <- atomically . stateTVar downloadedChunks $ \cs ->
        let cs' = fromIntegral (unFileSize chunkSize) : cs in (sum cs', cs')
      liftIO $ do
@@ -467,7 +467,7 @@ cliDeleteFile DeleteOptions {fileDescription, retryCount, yes} = do
    deleteFileChunk a FileChunk {chunkNo, replicas = replica : _} = do
      let FileChunkReplica {server, replicaId, replicaKey} = replica
      withReconnect a server retryCount $ \c -> deleteXFTPChunk c replicaKey (unChunkReplicaId replicaId)
-      logInfo $ "deleted chunk " <> tshow chunkNo <> " from " <> showServer server
+      logDebug $ "deleted chunk " <> tshow chunkNo <> " from " <> showServer server
    deleteFileChunk _ _ = throwE $ CLIError "chunk has no replicas"

 cliFileDescrInfo :: InfoOptions -> ExceptT CLIError IO ()
@@ -44,8 +44,9 @@ import Simplex.Messaging.Protocol
    EntityId (..),
    RecipientId,
    SenderId,
+    RawTransmission,
    SentRawTransmission,
-    SignedTransmission,
+    SignedTransmissionOrError,
    SndPublicAuthKey,
    Transmission,
    TransmissionForAuth (..),
@@ -53,7 +54,8 @@ import Simplex.Messaging.Protocol
    encodeTransmission,
    encodeTransmissionForAuth,
    messageTagP,
-    tDecodeParseValidate,
+    tDecodeServer,
+    tDecodeClient,
    tEncodeBatch1,
    tParse,
  )
@@ -144,10 +146,15 @@ instance Protocol XFTPVersion XFTPErrorType FileResponse where
  type ProtoCommand FileResponse = FileCmd
  type ProtoType FileResponse = 'PXFTP
  protocolClientHandshake = xftpClientHandshakeStub
+  {-# INLINE protocolClientHandshake #-}
+  useServiceAuth _ = False
+  {-# INLINE useServiceAuth #-}
  protocolPing = FileCmd SFRecipient PING
+  {-# INLINE protocolPing #-}
  protocolError = \case
    FRErr e -> Just e
    _ -> Nothing
+  {-# INLINE protocolError #-}

 data FileCommand (p :: FileParty) where
  FNEW :: FileInfo -> NonEmpty RcvPublicAuthKey -> Maybe BasicAuth -> FileCommand FSender
@@ -192,7 +199,7 @@ instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand
  fromProtocolError = fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
  {-# INLINE fromProtocolError #-}

-  checkCredentials (auth, _, EntityId fileId, _) cmd = case cmd of
+  checkCredentials auth (EntityId fileId) cmd = case cmd of
    -- FNEW must not have signature and chunk ID
    FNEW {}
      | isNothing auth -> Left $ CMD NO_AUTH
@@ -226,7 +233,8 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileCmd where
  fromProtocolError = fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
  {-# INLINE fromProtocolError #-}

-  checkCredentials t (FileCmd p c) = FileCmd p <$> checkCredentials t c
+  checkCredentials tAuth entId (FileCmd p c) = FileCmd p <$> checkCredentials tAuth entId c
+  {-# INLINE checkCredentials #-}

 instance Encoding FileInfo where
  smpEncode FileInfo {sndKey, size, digest} = smpEncode (sndKey, size, digest)
@@ -304,7 +312,7 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
    PEBlock -> BLOCK
  {-# INLINE fromProtocolError #-}

-  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials _ (EntityId entId) cmd = case cmd of
    FRSndIds {} -> noEntity
    -- ERR response does not always have entity ID
    FRErr _ -> Right cmd
@@ -329,25 +337,35 @@ checkParty' c = case testEquality (sFileParty @p) (sFileParty @p') of
  Just Refl -> Just c
  _ -> Nothing

-xftpEncodeAuthTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion 'TClient -> C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
-xftpEncodeAuthTransmission thParams@THandleParams {thAuth} pKey (corrId, fId, msg) = do
-  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (corrId, fId, msg)
-  xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth (Just pKey) (C.cbNonce $ bs corrId) tForAuth
+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

-xftpEncodeTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
-xftpEncodeTransmission thParams (corrId, fId, msg) = do
-  let t = encodeTransmission thParams (corrId, fId, msg)
-  xftpEncodeBatch1 (Nothing, t)
+xftpEncodeTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
+xftpEncodeTransmission thParams t = xftpEncodeBatch1 (Nothing, encodeTransmission thParams t)

 -- this function uses batch syntax but puts only one transmission in the batch
 xftpEncodeBatch1 :: SentRawTransmission -> Either TransportError ByteString
-xftpEncodeBatch1 t = first (const TELargeMsg) $ C.pad (tEncodeBatch1 t) xftpBlockSize
+xftpEncodeBatch1 t = first (const TELargeMsg) $ C.pad (tEncodeBatch1 False t) xftpBlockSize

-xftpDecodeTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion p -> ByteString -> Either XFTPErrorType (SignedTransmission e c)
-xftpDecodeTransmission thParams t = do
+xftpDecodeTServer :: THandleParams XFTPVersion 'TServer -> ByteString -> Either XFTPErrorType (SignedTransmissionOrError XFTPErrorType FileCmd)
+xftpDecodeTServer = xftpDecodeTransmission tDecodeServer
+{-# INLINE xftpDecodeTServer #-}
+
+xftpDecodeTClient :: THandleParams XFTPVersion 'TClient -> ByteString -> Either XFTPErrorType (Transmission (Either XFTPErrorType FileResponse))
+xftpDecodeTClient = xftpDecodeTransmission tDecodeClient
+{-# INLINE xftpDecodeTClient #-}
+
+xftpDecodeTransmission ::
+  (THandleParams XFTPVersion p -> Either TransportError RawTransmission -> r) ->
+  THandleParams XFTPVersion p ->
+  ByteString ->
+  Either XFTPErrorType r
+xftpDecodeTransmission tDecode thParams t = do
  t' <- first (const BLOCK) $ C.unPad t
  case tParse thParams t' of
-    t'' :| [] -> Right $ tDecodeParseValidate thParams t''
+    t'' :| [] -> Right $ tDecode thParams t''
    _ -> Left BLOCK

 $(J.deriveJSON (enumJSON $ dropPrefix "F") ''FileParty)
@@ -26,12 +26,12 @@ import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
-import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust)
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Word (Word32)
@@ -45,6 +45,7 @@ import Network.Socket
 import Simplex.FileTransfer.Protocol
 import Simplex.FileTransfer.Server.Control
 import Simplex.FileTransfer.Server.Env
+import Simplex.FileTransfer.Server.Prometheus
 import Simplex.FileTransfer.Server.Stats
 import Simplex.FileTransfer.Server.Store
 import Simplex.FileTransfer.Server.StoreLog
@@ -53,15 +54,15 @@ import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (CorrId (..), BlockingInfo, EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
-import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
+import Simplex.Messaging.Protocol (BlockingInfo, EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, SignedTransmission, pattern NoEntity)
+import Simplex.Messaging.Server (controlPortAuth, dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Control (CPClientRole (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, ServerEntityStatus (..), getRoundedSystemTime)
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (ALPN, SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
+import Simplex.Messaging.Transport (CertChainPubKey (..), SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
@@ -69,6 +70,7 @@ import Simplex.Messaging.Transport.HTTP2.Server
 import Simplex.Messaging.Transport.Server (runLocalTCPServer)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
+import System.Environment (lookupEnv)
 import System.Exit (exitFailure)
 import System.FilePath ((</>))
 import System.IO (hPrint, hPutStrLn, universalNewlineMode)
@@ -92,39 +94,46 @@ data XFTPTransportRequest = XFTPTransportRequest
 runXFTPServer :: XFTPServerConfig -> IO ()
 runXFTPServer cfg = do
  started <- newEmptyTMVarIO
-  runXFTPServerBlocking started cfg $ Just supportedXFTPhandshakes
+  runXFTPServerBlocking started cfg

-runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> Maybe [ALPN] -> IO ()
-runXFTPServerBlocking started cfg alpn_ = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started alpn_)
+runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> IO ()
+runXFTPServerBlocking started cfg = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started)

 data Handshake
  = HandshakeSent C.PrivateKeyX25519
  | HandshakeAccepted (THandleParams XFTPVersion 'TServer)

-xftpServer :: XFTPServerConfig -> TMVar Bool -> Maybe [ALPN] -> M ()
-xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started alpn_ = do
+xftpServer :: XFTPServerConfig -> TMVar Bool -> M ()
+xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started = do
  mapM_ (expireServerFiles Nothing) fileExpiration
  restoreServerStats
-  raceAny_ (runServer : expireFilesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg) `finally` stopServer
+  raceAny_
+    ( runServer
+        : expireFilesThread_ cfg
+          <> serverStatsThread_ cfg
+          <> prometheusMetricsThread_ cfg
+          <> controlPortThread_ cfg
+    )
+    `finally` stopServer
  where
    runServer :: M ()
    runServer = do
      srvCreds@(chain, pk) <- asks tlsServerCreds
-      signKey <- liftIO $ case C.x509ToPrivate (pk, []) >>= C.privKey of
+      signKey <- liftIO $ case C.x509ToPrivate' pk of
        Right pk' -> pure pk'
-        Left e -> putStrLn ("servers has no valid key: " <> show e) >> exitFailure
+        Left e -> putStrLn ("Server has no valid key: " <> show e) >> exitFailure
      env <- ask
      sessions <- liftIO TM.emptyIO
      let cleanup sessionId = atomically $ TM.delete sessionId sessions
-      liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize defaultSupportedParams srvCreds alpn_ transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
+      liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize defaultSupportedParams srvCreds transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
        reqBody <- getHTTP2Body r xftpBlockSize
        let v = VersionXFTP 1
            thServerVRange = versionToRange v
-            thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True}
+            thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
            req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse}
        flip runReaderT env $ case sessionALPN of
          Nothing -> processRequest req0
-          Just "xftp/1" ->
+          Just alpn | alpn == xftpALPNv1 || alpn == httpALPN11 ->
            xftpServerHandshakeV1 chain signKey sessions req0 >>= \case
              Nothing -> pure () -- handshake response sent
              Just thParams -> processRequest req0 {thParams} -- proceed with new version (XXX: may as well switch the request handler here)
@@ -142,7 +151,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
          unless (B.null bodyHead) $ throwE HANDSHAKE
          (k, pk) <- atomically . C.generateKeyPair =<< asks random
          atomically $ TM.insert sessionId (HandshakeSent pk) sessions
-          let authPubKey = (chain, C.signX509 serverSignKey $ C.publicToX509 k)
+          let authPubKey = CertChainPubKey chain (C.signX509 serverSignKey $ C.publicToX509 k)
          let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey}
          shs <- encodeXftp hs
 #ifdef slow_servers
@@ -158,7 +167,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
          unless (keyHash == kh) $ throwE HANDSHAKE
          case compatibleVRange' xftpServerVRange v of
            Just (Compatible vr) -> do
-              let auth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
+              let auth = THAuthServer {serverPrivKey = pk, peerClientService = Nothing, sessSecret' = Nothing}
                  thParams = thParams0 {thAuth = Just auth, thVersion = v, thServerVRange = vr}
              atomically $ TM.insert sessionId (HandshakeAccepted thParams) sessions
 #ifdef slow_servers
@@ -181,7 +190,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
    stopServer = do
      withFileLog closeStoreLog
      saveServerStats
-      logInfo "Server stopped"
+      logNote "Server stopped"

    expireFilesThread_ :: XFTPServerConfig -> [M ()]
    expireFilesThread_ XFTPServerConfig {fileExpiration = Just fileExp} = [expireFiles fileExp]
@@ -221,25 +230,49 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
          fileDownloadAcks' <- atomicSwapIORef fileDownloadAcks 0
          filesCount' <- readIORef filesCount
          filesSize' <- readIORef filesSize
-          hPutStrLn h $
-            intercalate
+          T.hPutStrLn h $
+            T.intercalate
              ","
-              [ iso8601Show $ utctDay fromTime',
-                show filesCreated',
-                show fileRecipients',
-                show filesUploaded',
-                show filesDeleted',
+              [ T.pack $ iso8601Show $ utctDay fromTime',
+                tshow filesCreated',
+                tshow fileRecipients',
+                tshow filesUploaded',
+                tshow filesDeleted',
                dayCount files,
                weekCount files,
                monthCount files,
-                show fileDownloads',
-                show fileDownloadAcks',
-                show filesCount',
-                show filesSize',
-                show filesExpired'
+                tshow fileDownloads',
+                tshow fileDownloadAcks',
+                tshow filesCount',
+                tshow filesSize',
+                tshow filesExpired'
              ]
        liftIO $ threadDelay' interval

+    prometheusMetricsThread_ :: XFTPServerConfig -> [M ()]
+    prometheusMetricsThread_ XFTPServerConfig {prometheusInterval = Just interval, prometheusMetricsFile} =
+      [savePrometheusMetrics interval prometheusMetricsFile]
+    prometheusMetricsThread_ _ = []
+
+    savePrometheusMetrics :: Int -> FilePath -> M ()
+    savePrometheusMetrics saveInterval metricsFile = do
+      labelMyThread "savePrometheusMetrics"
+      liftIO $ putStrLn $ "Prometheus metrics saved every " <> show saveInterval <> " seconds to " <> metricsFile
+      ss <- asks serverStats
+      rtsOpts <- liftIO $ maybe ("set " <> rtsOptionsEnv) T.pack <$> lookupEnv (T.unpack rtsOptionsEnv)
+      let interval = 1000000 * saveInterval
+      liftIO $ forever $ do
+        threadDelay interval
+        ts <- getCurrentTime
+        sm <- getFileServerMetrics ss rtsOpts
+        T.writeFile metricsFile $ xftpPrometheusMetrics sm ts
+
+    getFileServerMetrics :: FileServerStats -> T.Text -> IO FileServerMetrics
+    getFileServerMetrics ss rtsOptions = do
+      d <- getFileServerStatsData ss
+      let fd = periodStatDataCounts $ _filesDownloaded d
+      pure FileServerMetrics {statsData = d, filesDownloadedPeriods = fd, rtsOptions}
+
    controlPortThread_ :: XFTPServerConfig -> [M ()]
    controlPortThread_ XFTPServerConfig {controlPort = Just port} = [runCPServer port]
    controlPortThread_ _ = []
@@ -277,12 +310,9 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
                  CPSkip -> False
                  _ -> True
            processCP h role = \case
-              CPAuth auth -> atomically $ writeTVar role $! newRole cfg
+              CPAuth auth -> controlPortAuth h user admin role auth
                where
-                  newRole XFTPServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin}
-                    | Just auth == admin = CPRAdmin
-                    | Just auth == user = CPRUser
-                    | otherwise = CPRNone
+                  XFTPServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin} = cfg
              CPStatsRTS -> E.tryAny getRTSStats >>= either (hPrint h) (hPrint h)
              CPDelete fileId -> withUserRole $ unliftIO u $ do
                fs <- asks store
@@ -317,22 +347,20 @@ data ServerFile = ServerFile
 processRequest :: XFTPTransportRequest -> M ()
 processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse}
  | B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", NoEntity, FRErr BLOCK) Nothing
-  | otherwise = do
-      case xftpDecodeTransmission thParams bodyHead of
-        Right (sig_, signed, (corrId, fId, cmdOrErr)) ->
-          case cmdOrErr of
-            Right cmd -> do
-              let THandleParams {thAuth} = thParams
-              verifyXFTPTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) sig_ signed fId cmd >>= \case
-                VRVerified req -> uncurry send =<< processXFTPRequest body req
-                VRFailed e -> send (FRErr e) Nothing
-            Left e -> send (FRErr e) Nothing
+  | otherwise =
+      case xftpDecodeTServer thParams bodyHead of
+        Right (Right t@(_, _, (corrId, fId, _))) -> do
+          let THandleParams {thAuth} = thParams
+          verifyXFTPTransmission thAuth t >>= \case
+            VRVerified req -> uncurry send =<< processXFTPRequest body req
+            VRFailed e -> send (FRErr e) Nothing
          where
            send resp = sendXFTPResponse (corrId, fId, resp)
+        Right (Left (corrId, fId, e)) -> sendXFTPResponse (corrId, fId, FRErr e) Nothing
        Left e -> sendXFTPResponse ("", NoEntity, FRErr e) Nothing
  where
-    sendXFTPResponse (corrId, fId, resp) serverFile_ = do
-      let t_ = xftpEncodeTransmission thParams (corrId, fId, resp)
+    sendXFTPResponse t' serverFile_ = do
+      let t_ = xftpEncodeTransmission thParams t'
 #ifdef slow_servers
      randomDelay
 #endif
@@ -361,8 +389,8 @@ randomDelay = do

 data VerificationResult = VRVerified XFTPRequest | VRFailed XFTPErrorType

-verifyXFTPTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> XFTPFileId -> FileCmd -> M VerificationResult
-verifyXFTPTransmission auth_ tAuth authorized fId cmd =
+verifyXFTPTransmission :: Maybe (THandleAuth 'TServer) -> SignedTransmission FileCmd -> M VerificationResult
+verifyXFTPTransmission thAuth (tAuth, authorized, (corrId, fId, cmd)) =
  case cmd of
    FileCmd SFSender (FNEW file rcps auth') -> pure $ XFTPReqNew file rcps auth' `verifyWith` sndKey file
    FileCmd SFRecipient PING -> pure $ VRVerified XFTPReqPing
@@ -381,9 +409,9 @@ verifyXFTPTransmission auth_ tAuth authorized fId cmd =
                EntityBlocked info -> VRFailed $ BLOCKED info
                EntityOff -> noFileAuth
          Left _ -> pure noFileAuth
-        noFileAuth = maybe False (dummyVerifyCmd Nothing authorized) tAuth `seq` VRFailed AUTH
+        noFileAuth = dummyVerifyCmd thAuth tAuth authorized corrId `seq` VRFailed AUTH
    -- TODO verify with DH authorization
-    req `verifyWith` k = if verifyCmdAuthorization auth_ tAuth authorized k then VRVerified req else VRFailed AUTH
+    req `verifyWith` k = if verifyCmdAuthorization thAuth tAuth authorized corrId k then VRVerified req else VRFailed AUTH

 processXFTPRequest :: HTTP2Body -> XFTPRequest -> M (FileResponse, Maybe ServerFile)
 processXFTPRequest HTTP2Body {bodyPart} = \case
@@ -415,7 +443,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
        sId <- ExceptT $ addFileRetry st file 3 ts
        rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks
        lift $ withFileLog $ \sl -> do
-          logAddFile sl sId file ts
+          logAddFile sl sId file ts EntityActive
          logAddRecipients sl sId rcps
        stats <- asks serverStats
        lift $ incFileStat filesCreated
@@ -426,7 +454,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
    addFileRetry :: FileStore -> FileInfo -> Int -> RoundedSystemTime -> M (Either XFTPErrorType XFTPFileId)
    addFileRetry st file n ts =
      retryAdd n $ \sId -> runExceptT $ do
-        ExceptT $ addFile st sId file ts
+        ExceptT $ addFile st sId file ts EntityActive
        pure sId
    addRecipientRetry :: FileStore -> Int -> XFTPFileId -> RcvPublicAuthKey -> M (Either XFTPErrorType FileRecipient)
    addRecipientRetry st n sId rpk =
@@ -560,13 +588,13 @@ expireServerFiles itemDelay expCfg = do
  usedStart <- readTVarIO $ usedStorage st
  old <- liftIO $ expireBeforeEpoch expCfg
  files' <- readTVarIO (files st)
-  logInfo $ "Expiration check: " <> tshow (M.size files') <> " files"
+  logNote $ "Expiration check: " <> tshow (M.size files') <> " files"
  forM_ (M.keys files') $ \sId -> do
    mapM_ threadDelay itemDelay
    atomically (expiredFilePath st sId old)
      >>= mapM_ (maybeRemove $ delete st sId)
  usedEnd <- readTVarIO $ usedStorage st
-  logInfo $ "Used " <> mbs usedStart <> " -> " <> mbs usedEnd <> ", " <> mbs (usedStart - usedEnd) <> " reclaimed."
+  logNote $ "Used " <> mbs usedStart <> " -> " <> mbs usedEnd <> ", " <> mbs (usedStart - usedEnd) <> " reclaimed."
  where
    mbs bs = tshow (bs `div` 1048576) <> "mb"
    maybeRemove del = maybe del (remove del)
@@ -600,15 +628,15 @@ saveServerStats =
    >>= mapM_ (\f -> asks serverStats >>= liftIO . getFileServerStatsData >>= liftIO . saveStats f)
  where
    saveStats f stats = do
-      logInfo $ "saving server stats to file " <> T.pack f
+      logNote $ "saving server stats to file " <> T.pack f
      B.writeFile f $ strEncode stats
-      logInfo "server stats saved"
+      logNote "server stats saved"

 restoreServerStats :: M ()
 restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
  where
    restoreStats f = whenM (doesFileExist f) $ do
-      logInfo $ "restoring server stats from file " <> T.pack f
+      logNote $ "restoring server stats from file " <> T.pack f
      liftIO (strDecode <$> B.readFile f) >>= \case
        Right d@FileServerStatsData {_filesCount = statsFilesCount, _filesSize = statsFilesSize} -> do
          s <- asks serverStats
@@ -617,10 +645,10 @@ restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStat
          _filesSize <- readTVarIO usedStorage
          liftIO $ setFileServerStats s d {_filesCount, _filesSize}
          renameFile f $ f <> ".bak"
-          logInfo "server stats restored"
+          logNote "server stats restored"
          when (statsFilesCount /= _filesCount) $ logWarn $ "Files count differs: stats: " <> tshow statsFilesCount <> ", store: " <> tshow _filesCount
          when (statsFilesSize /= _filesSize) $ logWarn $ "Files size differs: stats: " <> tshow statsFilesSize <> ", store: " <> tshow _filesSize
-          logInfo $ "Restored " <> tshow (_filesSize `div` 1048576) <> " MBs in " <> tshow _filesCount <> " files"
+          logNote $ "Restored " <> tshow (_filesSize `div` 1048576) <> " MBs in " <> tshow _filesCount <> " files"
        Left e -> do
-          logInfo $ "error restoring server stats: " <> T.pack e
+          logNote $ "error restoring server stats: " <> T.pack e
          liftIO exitFailure
@@ -64,6 +64,8 @@ data XFTPServerConfig = XFTPServerConfig
    logStatsStartTime :: Int64,
    serverStatsLogFile :: FilePath,
    serverStatsBackupFile :: Maybe FilePath,
+    prometheusInterval :: Maybe Int,
+    prometheusMetricsFile :: FilePath,
    transportConfig :: TransportServerConfig,
    responseDelay :: Int
  }
@@ -103,8 +105,8 @@ newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCrede
  used <- countUsedStorage <$> readTVarIO (files store)
  atomically $ writeTVar (usedStorage store) used
  forM_ fileSizeQuota $ \quota -> do
-    logInfo $ "Total / available storage: " <> tshow quota <> " / " <> tshow (quota - used)
-    when (quota < used) $ logInfo "WARNING: storage quota is less than used storage, no files can be uploaded!"
+    logNote $ "Total / available storage: " <> tshow quota <> " / " <> tshow (quota - used)
+    when (quota < used) $ logWarn "WARNING: storage quota is less than used storage, no files can be uploaded!"
  tlsServerCreds <- loadServerCredential xftpCredentials
  Fingerprint fp <- loadFingerprint xftpCredentials
  serverStats <- newFileServerStats =<< getCurrentTime
@@ -1,3 +1,4 @@
+{-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -20,16 +21,16 @@ import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Description (FileSize (..))
 import Simplex.FileTransfer.Server (runXFTPServer)
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration)
-import Simplex.FileTransfer.Transport (supportedFileServerVRange)
+import Simplex.FileTransfer.Transport (supportedFileServerVRange, alpnSupportedXFTPhandshakes)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
-import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
+import Simplex.Messaging.Transport.HTTP2 (httpALPN)
+import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
+import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
@@ -59,7 +60,7 @@ xftpServerCLI cfgPath logPath = do
      putStrLn "Deleted configuration and log files"
  where
    iniFile = combine cfgPath "file-server.ini"
-    serverVersion = "SimpleX XFTP server v" <> simplexMQVersion
+    serverVersion = "SimpleX XFTP server v" <> simplexmqVersionCommit
    defaultServerPort = "443"
    executableName = "file-server"
    storeLogFilePath = combine logPath "file-server-store.log"
@@ -88,6 +89,9 @@ xftpServerCLI cfgPath logPath = do
            <> "# Expire files after the specified number of hours.\n"
            <> ("expire_files_hours: " <> tshow defFileExpirationHours <> "\n\n")
            <> "log_stats: off\n\
+               \\n\
+               \# Log interval for real-time Prometheus metrics\n\
+               \# prometheus_interval: 60\n\
               \\n\
               \[AUTH]\n\
               \# Set new_files option to off to completely prohibit uploading new files.\n\
@@ -187,10 +191,13 @@ xftpServerCLI cfgPath logPath = do
              logStatsStartTime = 0, -- seconds from 00:00 UTC
              serverStatsLogFile = combine logPath "file-server-stats.daily.log",
              serverStatsBackupFile = logStats $> combine logPath "file-server-stats.log",
+              prometheusInterval = eitherToMaybe $ read . T.unpack <$> lookupValue "STORE_LOG" "prometheus_interval" ini,
+              prometheusMetricsFile = combine logPath "xftp-server-metrics.txt",
              transportConfig =
-                defaultTransportServerConfig
-                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
-                  },
+                mkTransportServerConfig
+                  (fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
+                  (Just $ alpnSupportedXFTPhandshakes <> httpALPN)
+                  False,
              responseDelay = 0
            }

@@ -220,14 +227,19 @@ cliCommandP cfgPath logPath iniFile =
    )
  where
    initP :: Parser InitOptions
-    initP =
-      InitOptions
-        <$> switch
-          ( long "store-log"
-              <> short 'l'
-              <> help "Enable store log for persistence"
+    initP = do
+      enableStoreLog <-
+        flag' False
+          ( long "disable-store-log"
+              <> help "Disable store log for persistence (enabled by default)"
          )
-        <*> option
+          <|> flag True True
+            ( long "store-log"
+                <> short 'l'
+                <> help "Enable store log for persistence (DEPRECATED, enabled by default)"
+            )
+      signAlgorithm <-
+        option
          (maybeReader readMaybe)
          ( long "sign-algorithm"
              <> short 'a'
@@ -236,7 +248,8 @@ cliCommandP cfgPath logPath iniFile =
              <> showDefault
              <> metavar "ALG"
          )
-        <*> strOption
+      ip <-
+        strOption
          ( long "ip"
              <> help
                "Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
@@ -244,22 +257,26 @@ cliCommandP cfgPath logPath iniFile =
              <> showDefault
              <> metavar "IP"
          )
-        <*> (optional . strOption)
+      fqdn <-
+        (optional . strOption)
          ( long "fqdn"
              <> short 'n'
              <> help "Server FQDN used as Common Name for TLS online certificate"
              <> showDefault
              <> metavar "FQDN"
          )
-        <*> strOption
+      filesPath <-
+        strOption
          ( long "path"
              <> short 'p'
              <> help "Path to the directory to store files"
              <> metavar "PATH"
          )
-        <*> strOption
+      fileSizeQuota <-
+        strOption
          ( long "quota"
              <> short 'q'
              <> help "File storage quota (e.g. 100gb)"
              <> metavar "QUOTA"
          )
+      pure InitOptions {enableStoreLog, signAlgorithm, ip, fqdn, filesPath, fileSizeQuota}
@@ -0,0 +1,134 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
+
+module Simplex.FileTransfer.Server.Prometheus where
+
+import Data.Int (Int64)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Clock (UTCTime (..), diffUTCTime)
+import Data.Time.Clock.System (systemEpochDay)
+import Data.Time.Format.ISO8601 (iso8601Show)
+import Simplex.FileTransfer.Server.Stats
+import Simplex.Messaging.Server.Stats (PeriodStatCounts (..))
+import Simplex.Messaging.Transport (simplexMQVersion)
+import Simplex.Messaging.Util (tshow)
+
+data FileServerMetrics = FileServerMetrics
+  { statsData :: FileServerStatsData,
+    filesDownloadedPeriods :: PeriodStatCounts,
+    rtsOptions :: Text
+  }
+
+rtsOptionsEnv :: Text
+rtsOptionsEnv = "XFTP_RTS_OPTIONS"
+
+{-# FOURMOLU_DISABLE\n#-}
+xftpPrometheusMetrics :: FileServerMetrics -> UTCTime -> Text
+xftpPrometheusMetrics sm ts =
+  time <> files <> info
+  where
+    FileServerMetrics {statsData, filesDownloadedPeriods, rtsOptions} = sm
+    FileServerStatsData
+      { _fromTime,
+        _filesCreated,
+        _fileRecipients,
+        _filesUploaded,
+        _filesExpired,
+        _filesDeleted,
+        _filesBlocked,
+        _fileDownloads,
+        _fileDownloadAcks,
+        _filesCount,
+        _filesSize
+      } = statsData
+    time =
+      "# Recorded at: " <> T.pack (iso8601Show ts) <> "\n\
+      \# Stats from: " <> T.pack (iso8601Show _fromTime) <> "\n\
+      \\n"
+    files =
+      "# Files\n\
+      \# -----\n\
+      \\n\
+      \# HELP simplex_xftp_files_created Created files\n\
+      \# TYPE simplex_xftp_files_created counter\n\
+      \simplex_xftp_files_created " <> mshow _filesCreated <> "\n\
+      \# filesCreated\n\
+      \\n\
+      \# HELP simplex_xftp_files_recipients Files recipients\n\
+      \# TYPE simplex_xftp_files_recipients counter\n\
+      \simplex_xftp_files_recipients " <> mshow _fileRecipients <> "\n\
+      \# fileRecipients\n\
+      \\n\
+      \# HELP simplex_xftp_files_uploaded Uploaded files\n\
+      \# TYPE simplex_xftp_files_uploaded counter\n\
+      \simplex_xftp_files_uploaded " <> mshow _filesUploaded <> "\n\
+      \# filesUploaded\n\
+      \\n\
+      \# HELP simplex_xftp_files_expired Expired files\n\
+      \# TYPE simplex_xftp_files_expired counter\n\
+      \simplex_xftp_files_expired " <> mshow _filesExpired <> "\n\
+      \# filesExpired\n\
+      \\n\
+      \# HELP simplex_xftp_files_deleted Deleted files\n\
+      \# TYPE simplex_xftp_files_deleted counter\n\
+      \simplex_xftp_files_deleted " <> mshow _filesDeleted <> "\n\
+      \# filesDeleted\n\
+      \\n\
+      \# HELP simplex_xftp_files_blocked Blocked files\n\
+      \# TYPE simplex_xftp_files_blocked counter\n\
+      \simplex_xftp_files_blocked " <> mshow _filesBlocked <> "\n\
+      \# filesBlocked\n\
+      \\n\
+      \# HELP simplex_xftp_file_downloads File downloads\n\
+      \# TYPE simplex_xftp_file_downloads counter\n\
+      \simplex_xftp_file_downloads " <> mshow _fileDownloads <> "\n\
+      \# fileDownloads\n\
+      \\n\
+      \# HELP simplex_xftp_file_download_acks File download ACKs\n\
+      \# TYPE simplex_xftp_file_download_acks counter\n\
+      \simplex_xftp_file_download_acks " <> mshow _fileDownloadAcks <> "\n\
+      \# fileDownloadAcks\n\
+      \\n\
+      \# HELP simplex_xftp_files_count_total Total files count \n\
+      \# TYPE simplex_xftp_files_count_total gauge\n\
+      \simplex_xftp_files_count_total " <> mshow _filesCount <> "\n\
+      \# filesCount\n\
+      \\n\
+      \# HELP simplex_xftp_files_size Size of files \n\
+      \# TYPE simplex_xftp_files_size gauge\n\
+      \simplex_xftp_files_size " <> mshow _filesSize <> "\n\
+      \# filesSize \n\
+      \\n\
+      \# HELP simplex_xftp_files_count_daily Daily files count\n\
+      \# TYPE simplex_xftp_files_count_daily gauge\n\
+      \simplex_xftp_files_count_daily " <> mstr (dayCount filesDownloadedPeriods) <> "\n\
+      \# filesDownloaded.dayCount\n\
+      \\n\
+      \# HELP simplex_xftp_files_count_weekly Weekly files count\n\
+      \# TYPE simplex_xftp_files_count_weekly gauge\n\
+      \simplex_xftp_files_count_weekly " <> mstr (weekCount filesDownloadedPeriods) <> "\n\
+      \# filesDownloaded.weekCount\n\
+      \\n\
+      \# HELP simplex_xftp_files_count_monthly Monthly files count\n\
+      \# TYPE simplex_xftp_files_count_monthly gauge\n\
+      \simplex_xftp_files_count_monthly " <> mstr (monthCount filesDownloadedPeriods) <> "\n\
+      \# filesDownloaded.monthCount\n\
+      \\n"
+    info =
+      "# Info\n\
+      \# ----\n\
+      \\n\
+      \# HELP simplex_xftp_info Server information. RTS options have to be passed via " <> rtsOptionsEnv <> " env var\n\
+      \# TYPE simplex_xftp_info gauge\n\
+      \simplex_xftp_info{version=\"" <> T.pack simplexMQVersion <> "\",rts_options=\"" <> rtsOptions <> "\"} 1\n\
+      \\n"
+    mstr a = a <> " " <> tsEpoch
+    mshow :: Show a => a -> Text
+    mshow = mstr . tshow
+    tsEpoch = tshow @Int64 $ floor @Double $ realToFrac (ts `diffUTCTime` epoch) * 1000
+    epoch = UTCTime systemEpochDay 0
+{-# FOURMOLU_ENABLE\n#-}
@@ -70,18 +70,18 @@ newFileStore = do
  usedStorage <- newTVarIO 0
  pure FileStore {files, recipients, usedStorage}

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

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

 setFilePath :: FileStore -> SenderId -> FilePath -> STM (Either XFTPErrorType ())
@@ -19,12 +19,13 @@ module Simplex.FileTransfer.Server.StoreLog
  )
 where

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

 data FileStoreLogRecord
-  = AddFile SenderId FileInfo RoundedSystemTime
+  = AddFile SenderId FileInfo RoundedSystemTime ServerEntityStatus
  | PutFile SenderId FilePath
  | AddRecipients SenderId (NonEmpty FileRecipient)
  | DeleteFile SenderId
@@ -49,7 +50,7 @@ data FileStoreLogRecord

 instance StrEncoding FileStoreLogRecord where
  strEncode = \case
-    AddFile sId file createdAt -> strEncode (Str "FNEW", sId, file, createdAt)
+    AddFile sId file createdAt status -> strEncode (Str "FNEW", sId, file, createdAt, status)
    PutFile sId path -> strEncode (Str "FPUT", sId, path)
    AddRecipients sId rcps -> strEncode (Str "FADD", sId, rcps)
    DeleteFile sId -> strEncode (Str "FDEL", sId)
@@ -57,7 +58,7 @@ instance StrEncoding FileStoreLogRecord where
    AckFile rId -> strEncode (Str "FACK", rId)
  strP =
    A.choice
-      [ "FNEW " *> (AddFile <$> strP_ <*> strP_ <*> strP),
+      [ "FNEW " *> (AddFile <$> strP_ <*> strP_ <*> strP <*> (_strP <|> pure EntityActive)),
        "FPUT " *> (PutFile <$> strP_ <*> strP),
        "FADD " *> (AddRecipients <$> strP_ <*> strP),
        "FDEL " *> (DeleteFile <$> strP),
@@ -68,8 +69,8 @@ instance StrEncoding FileStoreLogRecord where
 logFileStoreRecord :: StoreLog 'WriteMode -> FileStoreLogRecord -> IO ()
 logFileStoreRecord = writeStoreLogRecord

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

 logPutFile :: StoreLog 'WriteMode -> SenderId -> FilePath -> IO ()
 logPutFile s = logFileStoreRecord s .: PutFile
@@ -99,7 +100,7 @@ readFileStore f st = mapM_ (addFileLogRecord . LB.toStrict) . LB.lines =<< LB.re
          Left e -> B.putStrLn $ "Log processing error (" <> bshow e <> "): " <> B.take 100 s
          _ -> pure ()
    addToStore = \case
-      AddFile sId file createdAt -> addFile st sId file createdAt
+      AddFile sId file createdAt status -> addFile st sId file createdAt status
      PutFile qId path -> setFilePath st qId path
      AddRecipients sId rcps -> runExceptT $ addRecipients sId rcps
      DeleteFile sId -> deleteFile st sId
@@ -113,8 +114,9 @@ writeFileStore s FileStore {files, recipients} = do
  readTVarIO files >>= mapM_ (logFile allRcps)
  where
    logFile :: Map RecipientId (SenderId, RcvPublicAuthKey) -> FileRec -> IO ()
-    logFile allRcps FileRec {senderId, fileInfo, filePath, recipientIds, createdAt} = do
-      logAddFile s senderId fileInfo createdAt
+    logFile allRcps FileRec {senderId, fileInfo, filePath, recipientIds, createdAt, fileStatus} = do
+      status <- readTVarIO fileStatus
+      logAddFile s senderId fileInfo createdAt status
      (rcpErrs, rcps) <- M.mapEither getRcp . M.fromSet id <$> readTVarIO recipientIds
      mapM_ (logAddRecipients s senderId) $ L.nonEmpty $ M.elems rcps
      mapM_ (B.putStrLn . ("Error storing log: " <>)) rcpErrs
@@ -13,7 +13,8 @@ module Simplex.FileTransfer.Transport
    authCmdsXFTPVersion,
    blockedFilesXFTPVersion,
    xftpClientHandshakeStub,
-    supportedXFTPhandshakes,
+    alpnSupportedXFTPhandshakes,
+    xftpALPNv1,
    XFTPClientHandshake (..),
    -- xftpClientHandshake,
    XFTPServerHandshake (..),
@@ -42,7 +43,7 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.Bifunctor (bimap, first)
+import Data.Bifunctor (first)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
@@ -50,7 +51,6 @@ import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
 import Data.Word (Word16, Word32)
-import qualified Data.X509 as X
 import Network.HTTP2.Client (HTTP2Error)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
@@ -58,7 +58,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (BlockingInfo, CommandError)
-import Simplex.Messaging.Transport (ALPN, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
+import Simplex.Messaging.Transport (ALPN, CertChainPubKey, ServiceCredentials, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
 import Simplex.Messaging.Transport.HTTP2.File
 import Simplex.Messaging.Util (bshow, tshow)
 import Simplex.Messaging.Version
@@ -102,17 +102,20 @@ supportedFileServerVRange :: VersionRangeXFTP
 supportedFileServerVRange = mkVersionRange initialXFTPVersion currentXFTPVersion

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

-supportedXFTPhandshakes :: [ALPN]
-supportedXFTPhandshakes = ["xftp/1"]
+alpnSupportedXFTPhandshakes :: [ALPN]
+alpnSupportedXFTPhandshakes = [xftpALPNv1]
+
+xftpALPNv1 :: ALPN
+xftpALPNv1 = "xftp/1"

 data XFTPServerHandshake = XFTPServerHandshake
  { xftpVersionRange :: VersionRangeXFTP,
    sessionId :: SessionId,
    -- | pub key to agree shared secrets for command authorization and entity ID encryption.
-    authPubKey :: (X.CertificateChain, X.SignedExact X.PubKey)
+    authPubKey :: CertChainPubKey
  }

 data XFTPClientHandshake = XFTPClientHandshake
@@ -132,15 +135,12 @@ instance Encoding XFTPClientHandshake where

 instance Encoding XFTPServerHandshake where
  smpEncode XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey} =
-    smpEncode (xftpVersionRange, sessionId, auth)
-    where
-      auth = bimap C.encodeCertChain C.SignedObject authPubKey
+    smpEncode (xftpVersionRange, sessionId, authPubKey)
  smpP = do
    (xftpVersionRange, sessionId) <- smpP
-    cert <- C.certChainP
-    C.SignedObject key <- smpP
+    authPubKey <- smpP
    Tail _compat <- smpP
-    pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey = (cert, key)}
+    pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey}

 sendEncFile :: Handle -> (Builder -> IO ()) -> LC.SbState -> Word32 -> IO ()
 sendEncFile h send = go
@@ -22,7 +22,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (XFTPServer)
 import System.FilePath ((</>))
-import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
+import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)

 type RcvFileId = ByteString -- Agent entity ID

@@ -27,11 +27,6 @@ module Simplex.Messaging.Agent.Env.SQLite
    serverHosts,
    defaultAgentConfig,
    defaultReconnectInterval,
-    tryAgentError,
-    tryAgentError',
-    catchAgentError,
-    catchAgentError',
-    agentFinally,
    Env (..),
    newSMPAgentEnv,
    createAgentStore,
@@ -45,7 +40,6 @@ module Simplex.Messaging.Agent.Env.SQLite
 where

 import Control.Concurrent (ThreadId)
-import Control.Exception (BlockedIndefinitelyOnSTM (..), SomeException, fromException)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
@@ -83,7 +77,6 @@ import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors')
 import System.Mem.Weak (Weak)
 import System.Random (StdGen, newStdGen)
 import UnliftIO.STM
@@ -96,7 +89,8 @@ data InitialAgentServers = InitialAgentServers
  { smp :: Map UserId (NonEmpty (ServerCfg 'PSMP)),
    ntf :: [NtfServer],
    xftp :: Map UserId (NonEmpty (ServerCfg 'PXFTP)),
-    netCfg :: NetworkConfig
+    netCfg :: NetworkConfig,
+    presetDomains :: [HostName]
  }

 data ServerCfg p = ServerCfg
@@ -311,33 +305,6 @@ newXFTPAgent = do
  xftpDelWorkers <- TM.emptyIO
  pure XFTPAgent {xftpWorkDir, xftpRcvWorkers, xftpSndWorkers, xftpDelWorkers}

-tryAgentError :: AM a -> AM (Either AgentErrorType a)
-tryAgentError = tryAllErrors mkInternal
-{-# INLINE tryAgentError #-}
-
-- unlike runExceptT, this ensures we catch IO exceptions as well
-tryAgentError' :: AM a -> AM' (Either AgentErrorType a)
-tryAgentError' = tryAllErrors' mkInternal
-{-# INLINE tryAgentError' #-}
-
-catchAgentError :: AM a -> (AgentErrorType -> AM a) -> AM a
-catchAgentError = catchAllErrors mkInternal
-{-# INLINE catchAgentError #-}
-
-catchAgentError' :: AM a -> (AgentErrorType -> AM' a) -> AM' a
-catchAgentError' = catchAllErrors' mkInternal
-{-# INLINE catchAgentError' #-}
-
-agentFinally :: AM a -> AM b -> AM a
-agentFinally = allFinally mkInternal
-{-# INLINE agentFinally #-}
-
-mkInternal :: SomeException -> AgentErrorType
-mkInternal e = case fromException e of
-  Just BlockedIndefinitelyOnSTM -> CRITICAL True "Thread blocked indefinitely in STM transaction"
-  _ -> INTERNAL $ show e
-{-# INLINE mkInternal #-}
-
 data Worker = Worker
  { workerId :: Int,
    doWork :: TMVar (),
@@ -6,6 +6,7 @@ module Simplex.Messaging.Agent.Lock
    withLock',
    withGetLock,
    withGetLocks,
+    getPutLock,
  )
 where

@@ -15,11 +16,12 @@ import Control.Monad.IO.Unlift
 import Data.Functor (($>))
 import Data.Set (Set)
 import qualified Data.Set as S
+import Data.Text (Text)
 import UnliftIO.Async (forConcurrently)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM

-type Lock = TMVar String
+type Lock = TMVar Text

 createLock :: STM Lock
 createLock = newEmptyTMVar
@@ -29,24 +31,24 @@ createLockIO :: IO Lock
 createLockIO = newEmptyTMVarIO
 {-# INLINE createLockIO #-}

-withLock :: MonadUnliftIO m => Lock -> String -> ExceptT e m a -> ExceptT e m a
+withLock :: MonadUnliftIO m => Lock -> Text -> ExceptT e m a -> ExceptT e m a
 withLock lock name = ExceptT . withLock' lock name . runExceptT
 {-# INLINE withLock #-}

-withLock' :: MonadUnliftIO m => Lock -> String -> m a -> m a
+withLock' :: MonadUnliftIO m => Lock -> Text -> m a -> m a
 withLock' lock name =
  E.bracket_
    (atomically $ putTMVar lock name)
    (void . atomically $ takeTMVar lock)

-withGetLock :: MonadUnliftIO m => (k -> STM Lock) -> k -> String -> m a -> m a
+withGetLock :: MonadUnliftIO m => (k -> STM Lock) -> k -> Text -> m a -> m a
 withGetLock getLock key name a =
  E.bracket
    (atomically $ getPutLock getLock key name)
    (atomically . takeTMVar)
    (const a)

-withGetLocks :: MonadUnliftIO m => (k -> STM Lock) -> Set k -> String -> m a -> m a
+withGetLocks :: MonadUnliftIO m => (k -> STM Lock) -> Set k -> Text -> m a -> m a
 withGetLocks getLock keys name = E.bracket holdLocks releaseLocks . const
  where
    holdLocks = forConcurrently (S.toList keys) $ \key -> atomically $ getPutLock getLock key name
@@ -54,5 +56,5 @@ withGetLocks getLock keys name = E.bracket holdLocks releaseLocks . const

 -- getLock and putTMVar can be in one transaction on the assumption that getLock doesn't write in case the lock already exists,
 -- and in case it is created and added to some shared resource (we use TMap) it also helps avoid contention for the newly created lock.
-getPutLock :: (k -> STM Lock) -> k -> String -> STM Lock
+getPutLock :: (k -> STM Lock) -> k -> Text -> STM Lock
 getPutLock getLock key name = getLock key >>= \l -> putTMVar l name $> l
@@ -14,6 +14,7 @@ module Simplex.Messaging.Agent.NtfSubSupervisor
    nsUpdateToken,
    nsRemoveNtfToken,
    sendNtfSubCommand,
+    hasInstantNotifications,
    instantNotifications,
    deleteToken,
    closeNtfSupervisor,
@@ -45,12 +46,13 @@ import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.AgentStore
 import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Client (NetworkRequestMode (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Protocol (NtfServer, sameSrvAddr)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow)
+import Simplex.Messaging.Util (catchAllErrors, diffToMicroseconds, threadDelay', tryAllErrors, tshow, whenM)
 import System.Random (randomR)
 import UnliftIO
 import UnliftIO.Concurrent (forkIO)
@@ -215,7 +217,7 @@ runNtfWorker c srv Worker {doWork} =
    runNtfOperation :: AM ()
    runNtfOperation = do
      ntfBatchSize <- asks $ ntfBatchSize . config
-      withWorkItems c doWork (\db -> getNextNtfSubNTFActions db srv ntfBatchSize) $ \nextSubs -> do
+      withWorkItems c doWork (withStore' c $ \db -> getNextNtfSubNTFActions db srv ntfBatchSize) $ \nextSubs -> do
        logInfo $ "runNtfWorker - length nextSubs = " <> tshow (length nextSubs)
        currTs <- liftIO getCurrentTime
        let (creates, checks, deletes, rotates) = splitActions currTs nextSubs
@@ -355,7 +357,7 @@ runNtfWorker c srv Worker {doWork} =
    runCatching :: (NtfSubscription -> AM (Maybe NtfSubscription)) -> NtfSubscription -> AM' (Maybe NtfSubscription)
    runCatching action sub@NtfSubscription {connId} =
      fromRight Nothing
-        <$> runExceptT (action sub `catchAgentError` \e -> workerInternalError c connId (show e) $> Nothing)
+        <$> runExceptT (action sub `catchAllErrors` \e -> workerInternalError c connId (show e) $> Nothing)
    -- deleteNtfSub is only used in NSADelete and NSARotate, so also deprecated
    deleteNtfSub :: NtfSubscription -> AM () -> AM (Maybe NtfSubscription)
    deleteNtfSub sub@NtfSubscription {userId, ntfSubId} continue = case ntfSubId of
@@ -363,7 +365,7 @@ runNtfWorker c srv Worker {doWork} =
        lift getNtfToken >>= \case
          Just tkn@NtfToken {ntfServer} -> do
            atomically $ incNtfServerStat c userId ntfServer ntfDelAttempts
-            tryAgentError (agentNtfDeleteSubscription c nSubId tkn) >>= \case
+            tryAllErrors (agentNtfDeleteSubscription c nSubId tkn) >>= \case
              Right _ -> do
                atomically $ incNtfServerStat c userId ntfServer ntfDeleted
                continue'
@@ -383,7 +385,7 @@ runNtfSMPWorker c srv Worker {doWork} = forever $ do
    runNtfSMPOperation :: AM ()
    runNtfSMPOperation = do
      ntfBatchSize <- asks $ ntfBatchSize . config
-      withWorkItems c doWork (\db -> getNextNtfSubSMPActions db srv ntfBatchSize) $ \nextSubs -> do
+      withWorkItems c doWork (withStore' c $ \db -> getNextNtfSubSMPActions db srv ntfBatchSize) $ \nextSubs -> do
        logInfo $ "runNtfSMPWorker - length nextSubs = " <> tshow (length nextSubs)
        let (creates, deletes) = splitActions nextSubs
        retrySubActions c creates createNotifierKeys
@@ -525,15 +527,19 @@ nsUpdateToken ns tkn = writeTVar (ntfTkn ns) $ Just tkn
 nsRemoveNtfToken :: NtfSupervisor -> STM ()
 nsRemoveNtfToken ns = writeTVar (ntfTkn ns) Nothing

-sendNtfSubCommand :: NtfSupervisor -> (NtfSupervisorCommand, NonEmpty ConnId) -> STM ()
-sendNtfSubCommand ns cmd = do
-  tkn <- readTVar (ntfTkn ns)
-  when (instantNotifications tkn) $ writeTBQueue (ntfSubQ ns) cmd
+sendNtfSubCommand :: NtfSupervisor -> (NtfSupervisorCommand, NonEmpty ConnId) -> IO ()
+sendNtfSubCommand ns cmd =
+  whenM (hasInstantNotifications ns) $ atomically $ writeTBQueue (ntfSubQ ns) cmd

-instantNotifications :: Maybe NtfToken -> Bool
-instantNotifications = \case
-  Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> True
-  _ -> False
+hasInstantNotifications :: NtfSupervisor -> IO Bool
+hasInstantNotifications ns = do
+  tkn <- readTVarIO $ ntfTkn ns
+  pure $ maybe False instantNotifications tkn
+
+instantNotifications :: NtfToken -> Bool
+instantNotifications NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} = True
+instantNotifications _ = False
+{-# INLINE instantNotifications #-}

 deleteToken :: AgentClient -> NtfToken -> AM ()
 deleteToken c tkn@NtfToken {ntfServer, ntfTokenId, ntfPrivKey} = do
@@ -561,7 +567,7 @@ runNtfTknDelWorker c srv Worker {doWork} =
          withRetryInterval ri $ \_ loop -> do
            liftIO $ waitWhileSuspended c
            liftIO $ waitForUserNetwork c
-            processTknToDelete nextTknToDelete `catchAgentError` retryTmpError loop nextTknToDelete
+            processTknToDelete nextTknToDelete `catchAllErrors` retryTmpError loop nextTknToDelete
    retryTmpError :: AM () -> NtfTokenToDelete -> AgentErrorType -> AM ()
    retryTmpError loop (tknDbId, _, _) e = do
      logError $ "ntf tkn del error: " <> tshow e
@@ -572,7 +578,7 @@ runNtfTknDelWorker c srv Worker {doWork} =
          notifyInternalError' c (show e)
    processTknToDelete :: NtfTokenToDelete -> AM ()
    processTknToDelete (tknDbId, ntfPrivKey, tknId) = do
-      agentNtfDeleteToken c srv ntfPrivKey tknId
+      agentNtfDeleteToken c NRMBackground srv ntfPrivKey tknId
      withStore' c $ \db -> deleteNtfTokenToDelete db tknDbId

 closeNtfSupervisor :: NtfSupervisor -> IO ()
@@ -1,8 +1,10 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -19,6 +21,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

 -- |
 -- Module      : Simplex.Messaging.Agent.Protocol
@@ -100,17 +103,35 @@ module Simplex.Messaging.Agent.Protocol
    ConnectionMode (..),
    SConnectionMode (..),
    AConnectionMode (..),
-    cmInvitation,
-    cmContact,
    ConnectionModeI (..),
    ConnectionRequestUri (..),
    AConnectionRequestUri (..),
    ConnReqUriData (..),
    CRClientData,
    ServiceScheme,
+    FixedLinkData (..),
+    ConnLinkData (..),
+    UserLinkData (..),
+    OwnerAuth (..),
+    OwnerId,
+    ConnectionLink (..),
+    AConnectionLink (..),
+    ConnShortLink (..),
+    AConnShortLink (..),
+    CreatedConnLink (..),
+    ACreatedConnLink (..),
+    ContactConnType (..),
+    ShortLinkScheme (..),
+    LinkKey (..),
+    StoredClientService (..),
+    ClientService,
+    ClientServiceId,
    sameConnReqContact,
+    sameShortLinkContact,
    simplexChat,
    connReqUriP',
+    simplexConnReqUri,
+    simplexShortLink,
    AgentErrorType (..),
    CommandErrorType (..),
    ConnectionErrorType (..),
@@ -130,6 +151,7 @@ module Simplex.Messaging.Agent.Protocol
    AgentMsgId,
    NotificationsMode (..),
    NotificationInfo (..),
+    ConnMsgReq (..),

    -- * Encode/decode
    serializeCommand,
@@ -140,18 +162,30 @@ module Simplex.Messaging.Agent.Protocol
    serializeQueueStatus,
    queueStatusT,
    agentMessageType,
+    aMessageType,
    extraSMPServerHosts,
    updateSMPServerHosts,
+    shortenShortLink,
+    restoreShortLink,
+    linkUserData,
+    linkUserData',
  )
 where

 import Control.Applicative (optional, (<|>))
-import Data.Aeson (FromJSON (..), ToJSON (..))
+import Control.Exception (BlockedIndefinitelyOnSTM (..), fromException)
+import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.:), (.:?))
+import qualified Data.Aeson as J'
+import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.TH as J
+import qualified Data.Aeson.Types as JT
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Char (toLower, toUpper)
+import Data.Foldable (find)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Kind (Type)
@@ -161,18 +195,20 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.System (SystemTime)
 import Data.Type.Equality
-import Data.Typeable ()
+import Data.Typeable (Typeable)
 import Data.Word (Word16, Word32)
-import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
 import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Transport (XFTPErrorType)
 import Simplex.FileTransfer.Types (FileErrorType)
 import Simplex.Messaging.Agent.QueryString
+import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
+import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Client (ProxyClientError)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
@@ -197,6 +233,7 @@ import Simplex.Messaging.Protocol
    MsgId,
    NMsgMeta,
    ProtocolServer (..),
+    QueueMode (..),
    SMPClientVersion,
    SMPServer,
    SMPServerWithAuth,
@@ -212,6 +249,8 @@ import Simplex.Messaging.Protocol
    sameSrvAddr,
    sndAuthKeySMPClientVersion,
    srvHostnamesSMPClientVersion,
+    shortLinksSMPClientVersion,
+    senderCanSecure,
    pattern ProtoServerWithAuth,
    pattern SMPServer,
  )
@@ -231,6 +270,7 @@ import UnliftIO.Exception (Exception)
 -- 4 - delivery receipts (7/13/2023)
 -- 5 - post-quantum double ratchet (3/14/2024)
 -- 6 - secure reply queues with provided keys (6/14/2024)
+-- 7 - initialize ratchet on processing confirmation (7/18/2024)

 data SMPAgentVersion

@@ -337,7 +377,7 @@ type SndQueueSecured = Bool

 -- | Parameterized type for SMP agent events
 data AEvent (e :: AEntity) where
-  INV :: AConnectionRequestUri -> AEvent AEConn
+  INV :: AConnectionRequestUri -> Maybe ClientServiceId -> AEvent AEConn
  CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
  REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender
  INFO :: PQSupport -> ConnInfo -> AEvent AEConn
@@ -363,7 +403,7 @@ data AEvent (e :: AEntity) where
  DEL_USER :: Int64 -> AEvent AENone
  STAT :: ConnectionStats -> AEvent AEConn
  OK :: AEvent AEConn
-  JOINED :: SndQueueSecured -> AEvent AEConn
+  JOINED :: SndQueueSecured -> Maybe ClientServiceId -> AEvent AEConn
  ERR :: AgentErrorType -> AEvent AEConn
  ERRS :: [(ConnId, AgentErrorType)] -> AEvent AENone
  SUSPENDED :: AEvent AENone
@@ -463,7 +503,7 @@ aCommandTag = \case

 aEventTag :: AEvent e -> AEventTag e
 aEventTag = \case
-  INV _ -> INV_
+  INV {} -> INV_
  CONF {} -> CONF_
  REQ {} -> REQ_
  INFO {} -> INFO_
@@ -489,7 +529,7 @@ aEventTag = \case
  DEL_USER _ -> DEL_USER_
  STAT _ -> STAT_
  OK -> OK_
-  JOINED _ -> JOINED_
+  JOINED {} -> JOINED_
  ERR _ -> ERR_
  ERRS _ -> ERRS_
  SUSPENDED -> SUSPENDED_
@@ -649,11 +689,21 @@ instance FromField NotificationsMode where fromField = blobFieldDecoder $ parseA

 data NotificationInfo = NotificationInfo
  { ntfConnId :: ConnId,
+    ntfDbQueueId :: Int64,
    ntfTs :: SystemTime,
+    -- Nothing means that the message failed to decrypt or to decode,
+    -- we can still show event notification
    ntfMsgMeta :: Maybe NMsgMeta
  }
  deriving (Show)

+data ConnMsgReq = ConnMsgReq
+  { msgConnId :: ConnId,
+    msgDbQueueId :: Int64,
+    msgTs :: Maybe UTCTime
+  }
+  deriving (Show)
+
 data ConnectionMode = CMInvitation | CMContact
  deriving (Eq, Show)

@@ -675,21 +725,17 @@ data AConnectionMode = forall m. ConnectionModeI m => ACM (SConnectionMode m)
 instance Eq AConnectionMode where
  ACM m == ACM m' = isJust $ testEquality m m'

-cmInvitation :: AConnectionMode
-cmInvitation = ACM SCMInvitation
-
-cmContact :: AConnectionMode
-cmContact = ACM SCMContact
-
 deriving instance Show AConnectionMode

 connMode :: SConnectionMode m -> ConnectionMode
 connMode SCMInvitation = CMInvitation
 connMode SCMContact = CMContact
+{-# INLINE connMode #-}

 connMode' :: ConnectionMode -> AConnectionMode
-connMode' CMInvitation = cmInvitation
-connMode' CMContact = cmContact
+connMode' CMInvitation = ACM SCMInvitation
+connMode' CMContact = ACM SCMContact
+{-# INLINE connMode' #-}

 class ConnectionModeI (m :: ConnectionMode) where sConnectionMode :: SConnectionMode m

@@ -855,20 +901,7 @@ agentMessageType = \case
  AgentConnInfo _ -> AM_CONN_INFO
  AgentConnInfoReply {} -> AM_CONN_INFO_REPLY
  AgentRatchetInfo _ -> AM_RATCHET_INFO
-  AgentMessage _ aMsg -> case aMsg of
-    -- HELLO is used both in v1 and in v2, but differently.
-    -- - in v1 (and, possibly, in v2 for simplex connections) can be sent multiple times,
-    --   until the queue is secured - the OK response from the server instead of initial AUTH errors confirms it.
-    -- - in v2 duplexHandshake it is sent only once, when it is known that the queue was secured.
-    HELLO -> AM_HELLO_
-    A_MSG _ -> AM_A_MSG_
-    A_RCVD {} -> AM_A_RCVD_
-    A_QCONT _ -> AM_QCONT_
-    QADD _ -> AM_QADD_
-    QKEY _ -> AM_QKEY_
-    QUSE _ -> AM_QUSE_
-    QTEST _ -> AM_QTEST_
-    EREADY _ -> AM_EREADY_
+  AgentMessage _ aMsg -> aMessageType aMsg

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

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

+instance ToField AMessage where toField = toField . Binary . smpEncode
+
+instance FromField AMessage where fromField = blobFieldDecoder smpDecode
+
 instance Encoding AMessageReceipt where
  smpEncode AMessageReceipt {agentMsgId, msgHash, rcptInfo} =
    smpEncode (agentMsgId, msgHash, Large rcptInfo)
@@ -1034,6 +1087,36 @@ instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
                <> maybe [] (\cd -> [("data", encodeUtf8 cd)]) crClientData
  strP = connReqUriP' (Just SSSimplex)

+instance ConnectionModeI m => Encoding (ConnectionRequestUri m) where
+  smpEncode = \case
+    CRInvitationUri crData e2eParams -> smpEncode (CMInvitation, crData, e2eParams)
+    CRContactUri crData -> smpEncode (CMContact, crData)
+  smpP = (\(ACR _ cr) -> checkConnMode cr) <$?> smpP
+  {-# INLINE smpP #-}
+
+instance Encoding AConnectionRequestUri where
+  smpEncode (ACR _ cr) = smpEncode cr
+  {-# INLINE smpEncode #-}
+  smpP =
+    smpP >>= \case
+      CMInvitation -> ACR SCMInvitation <$> (CRInvitationUri <$> smpP <*> smpP)
+      CMContact -> ACR SCMContact . CRContactUri <$> smpP
+
+instance Encoding ConnReqUriData where
+  smpEncode ConnReqUriData {crAgentVRange, crSmpQueues, crClientData} =
+    smpEncode (crAgentVRange, crSmpQueues, Large . encodeUtf8 <$> crClientData)
+  smpP = do
+    (crAgentVRange, smpQueues, clientData) <- smpP
+    -- This patch to compensate for the fact that queueMode QMContact won't be included in queue encoding,
+    -- until min SMP client version is >= 3 (sndAuthKeySMPClientVersion).
+    -- This is possible because SMP encoding of ConnReqUriData was not used prior to SMP client version 4.
+    let crSmpQueues = L.map patchQueueMode smpQueues
+    pure ConnReqUriData {crScheme = SSSimplex, crAgentVRange, crSmpQueues, crClientData = safeDecodeUtf8 . unLarge <$> clientData}
+    where
+      patchQueueMode q@SMPQueueUri {queueAddress = a} = case a of
+        SMPQueueAddress {queueMode = Nothing} -> q {queueAddress = a {queueMode = Just QMContact}} :: SMPQueueUri
+        _ -> q
+
 connReqUriP' :: forall m. ConnectionModeI m => Maybe ServiceScheme -> Parser (ConnectionRequestUri m)
 connReqUriP' overrideScheme = do
  ACR m cr <- connReqUriP overrideScheme
@@ -1047,7 +1130,7 @@ instance StrEncoding AConnectionRequestUri where

 connReqUriP :: Maybe ServiceScheme -> Parser AConnectionRequestUri
 connReqUriP overrideScheme = do
-  crScheme <- (`fromMaybe` overrideScheme) <$> strP
+  crScheme <- (`fromMaybe` overrideScheme) <$> strP -- always parse, but use the passed one if any
  crMode <- A.char '/' *> crModeP <* optional (A.char '/') <* "#/?"
  query <- strP
  aVRange <- queryParam "v" query
@@ -1071,15 +1154,39 @@ connReqUriP overrideScheme = do

 instance ConnectionModeI m => FromJSON (ConnectionRequestUri m) where
  parseJSON = strParseJSON "ConnectionRequestUri"
+  {-# INLINE parseJSON #-}

 instance ConnectionModeI m => ToJSON (ConnectionRequestUri m) where
  toJSON = strToJSON
+  {-# INLINE toJSON #-}
  toEncoding = strToJEncoding
+  {-# INLINE toEncoding #-}

 instance FromJSON AConnectionRequestUri where
  parseJSON = strParseJSON "ConnectionRequestUri"
+  {-# INLINE parseJSON #-}

 instance ToJSON AConnectionRequestUri where
+  toJSON = strToJSON
+  {-# INLINE toJSON #-}
+  toEncoding = strToJEncoding
+  {-# INLINE toEncoding #-}
+
+instance ConnectionModeI m => FromJSON (ConnShortLink m) where
+  parseJSON = strParseJSON "ConnShortLink"
+  {-# INLINE parseJSON #-}
+
+instance ConnectionModeI m => ToJSON (ConnShortLink m) where
+  toJSON = strToJSON
+  {-# INLINE toJSON #-}
+  toEncoding = strToJEncoding
+  {-# INLINE toEncoding #-}
+
+instance FromJSON AConnShortLink where
+  parseJSON = strParseJSON "AConnShortLink"
+  {-# INLINE parseJSON #-}
+
+instance ToJSON AConnShortLink where
  toJSON = strToJSON
  toEncoding = strToJEncoding

@@ -1097,6 +1204,26 @@ instance StrEncoding AConnectionMode where
  strEncode (ACM cMode) = strEncode $ connMode cMode
  strP = connMode' <$> strP

+instance Encoding ConnectionMode where
+  smpEncode = \case
+    CMInvitation -> "I"
+    CMContact -> "C"
+  smpP =
+    A.anyChar >>= \case
+      'I' -> pure CMInvitation
+      'C' -> pure CMContact
+      _ -> fail "bad connection mode"
+
+instance ToJSON ConnectionMode where
+  toJSON = J'.String . T.toLower . decodeLatin1 . strEncode
+  {-# INLINE toJSON #-}
+  toEncoding = JE.text . T.toLower . decodeLatin1 . strEncode
+  {-# INLINE toEncoding #-}
+
+instance FromJSON ConnectionMode where
+  parseJSON = J'.withText "ConnectionMode" $ either fail pure . parseAll strP . encodeUtf8 . T.toUpper
+  {-# INLINE parseJSON #-}
+
 connModeT :: Text -> Maybe ConnectionMode
 connModeT = \case
  "INV" -> Just CMInvitation
@@ -1144,16 +1271,20 @@ data SMPQueueInfo = SMPQueueInfo {clientVersion :: VersionSMPC, queueAddress ::
  deriving (Eq, Show)

 instance Encoding SMPQueueInfo where
-  smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure})
-    | clientVersion >= sndAuthKeySMPClientVersion && sndSecure = smpEncode (clientVersion, smpServer, senderId, dhPublicKey, sndSecure)
-    | clientVersion > initialSMPClientVersion = smpEncode (clientVersion, smpServer, senderId, dhPublicKey)
+  smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode})
+    | clientVersion >= shortLinksSMPClientVersion = addrEnc <> maybe "" smpEncode queueMode
+    | clientVersion >= sndAuthKeySMPClientVersion && sndSecure = addrEnc <> smpEncode sndSecure
+    | clientVersion > initialSMPClientVersion = addrEnc
    | otherwise = smpEncode clientVersion <> legacyEncodeServer smpServer <> smpEncode (senderId, dhPublicKey)
+    where
+      addrEnc = smpEncode (clientVersion, smpServer, senderId, dhPublicKey)
+      sndSecure = senderCanSecure queueMode
  smpP = do
    clientVersion <- smpP
    smpServer <- if clientVersion > initialSMPClientVersion then smpP else updateSMPServerHosts <$> legacyServerP
    (senderId, dhPublicKey) <- smpP
-    sndSecure <- fromMaybe False <$> optional smpP
-    pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure}
+    queueMode <- queueModeP
+    pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}

 -- This instance seems contrived and there was a temptation to split a common part of both types.
 -- But this is created to allow backward and forward compatibility where SMPQueueUri
@@ -1180,7 +1311,7 @@ data SMPQueueAddress = SMPQueueAddress
  { smpServer :: SMPServer,
    senderId :: SMP.SenderId,
    dhPublicKey :: C.PublicKeyX25519,
-    sndSecure :: Bool
+    queueMode :: Maybe QueueMode
  }
  deriving (Eq, Show)

@@ -1207,42 +1338,60 @@ sameQAddress (srv, qId) (srv', qId') = sameSrvAddr srv srv' && qId == qId'
 {-# INLINE sameQAddress #-}

 instance StrEncoding SMPQueueUri where
-  strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey, sndSecure})
+  strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey, queueMode})
    | minVersion vr >= srvHostnamesSMPClientVersion = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams
    | otherwise = legacyStrEncodeServer srv <> "/" <> strEncode qId <> "#/?" <> query (queryParams <> srvParam)
    where
      query = strEncode . QSP QEscape
-      queryParams = [("v", strEncode vr), ("dh", strEncode dhPublicKey)] <> [("k", "s") | sndSecure]
+      queryParams = [("v", strEncode vr), ("dh", strEncode dhPublicKey)] <> queueModeParam <> sndSecureParam
+        where
+          queueModeParam = case queueMode of
+            Just QMMessaging -> [("q", "m")]
+            Just QMContact -> [("q", "c")]
+            Nothing -> []
+          sndSecureParam = [("k", "s") | senderCanSecure queueMode && minVersion vr < shortLinksSMPClientVersion]
      srvParam = [("srv", strEncode $ TransportHosts_ hs) | not (null hs)]
      hs = L.tail $ host srv
  strP = do
    srv@ProtocolServer {host = h :| host} <- strP <* A.char '/'
    senderId <- strP <* optional (A.char '/') <* A.char '#'
-    (vr, hs, dhPublicKey, sndSecure) <- versioned <|> unversioned
+    (vr, hs, dhPublicKey, queueMode) <- versioned <|> unversioned
    let srv' = srv {host = h :| host <> hs}
        smpServer = if maxVersion vr < srvHostnamesSMPClientVersion then updateSMPServerHosts srv' else srv'
-    pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure}
+    pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}
    where
-      unversioned = (versionToRange initialSMPClientVersion,[],,False) <$> strP <* A.endOfInput
+      unversioned = (versionToRange initialSMPClientVersion,[],,Nothing) <$> strP <* A.endOfInput
      versioned = do
        dhKey_ <- optional strP
        query <- optional (A.char '/') *> A.char '?' *> strP
        vr <- queryParam "v" query
        dhKey <- maybe (queryParam "dh" query) pure dhKey_
        hs_ <- queryParam_ "srv" query
-        let sndSecure = queryParamStr "k" query == Just "s"
-        pure (vr, maybe [] thList_ hs_, dhKey, sndSecure)
+        let queueMode = case queryParamStr "q" query of
+              Just "m" -> Just QMMessaging
+              Just "c" -> Just QMContact
+              _ | queryParamStr "k" query == Just "s" -> Just QMMessaging
+              _ -> Nothing
+        pure (vr, maybe [] thList_ hs_, dhKey, queueMode)

 instance Encoding SMPQueueUri where
-  smpEncode (SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure})
-    | maxVersion clientVRange >= sndAuthKeySMPClientVersion && sndSecure =
-        smpEncode (clientVRange, smpServer, senderId, dhPublicKey, sndSecure)
-    | otherwise =
-        smpEncode (clientVRange, smpServer, senderId, dhPublicKey)
+  smpEncode (SMPQueueUri clientVRange@(VersionRange minV maxV) SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode})
+    -- The condition is for minVersion as earlier clients won't be able to support it.
+    -- The alternative would be to encode both queueMode and sndSecure
+    | minV >= shortLinksSMPClientVersion = addrEnc <> maybe "" smpEncode queueMode
+    -- Earlier versions won't be able to ignore sndSecure, so we don't include it when it is False
+    | minV >= sndAuthKeySMPClientVersion || (maxV >= sndAuthKeySMPClientVersion && sndSecure) = addrEnc <> smpEncode sndSecure
+    | otherwise = addrEnc
+    where
+      addrEnc = smpEncode (clientVRange, smpServer, senderId, dhPublicKey)
+      sndSecure = senderCanSecure queueMode
  smpP = do
    (clientVRange, smpServer, senderId, dhPublicKey) <- smpP
-    sndSecure <- fromMaybe False <$> optional smpP
-    pure $ SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure}
+    queueMode <- queueModeP
+    pure $ SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}
+
+queueModeP :: Parser (Maybe QueueMode)
+queueModeP = Just <$> smpP <|> optional ((\case True -> QMMessaging; _ -> QMContact) <$> smpP)

 data ConnectionRequestUri (m :: ConnectionMode) where
  CRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation
@@ -1250,6 +1399,11 @@ data ConnectionRequestUri (m :: ConnectionMode) where
  -- they are passed in AgentInvitation message
  CRContactUri :: ConnReqUriData -> ConnectionRequestUri CMContact

+simplexConnReqUri :: ConnectionRequestUri m -> ConnectionRequestUri m
+simplexConnReqUri = \case
+  CRInvitationUri crData e2eParams -> CRInvitationUri crData {crScheme = SSSimplex} e2eParams
+  CRContactUri crData -> CRContactUri crData {crScheme = SSSimplex}
+
 deriving instance Eq (ConnectionRequestUri m)

 deriving instance Show (ConnectionRequestUri m)
@@ -1263,12 +1417,247 @@ instance Eq AConnectionRequestUri where

 deriving instance Show AConnectionRequestUri

+data ShortLinkScheme = SLSSimplex | SLSServer deriving (Eq, Show)
+
+data ConnShortLink (m :: ConnectionMode) where
+  CSLInvitation :: ShortLinkScheme -> SMPServer -> SMP.LinkId -> LinkKey -> ConnShortLink 'CMInvitation
+  CSLContact :: ShortLinkScheme -> ContactConnType -> SMPServer -> LinkKey -> ConnShortLink 'CMContact
+
+deriving instance Eq (ConnShortLink m)
+
+deriving instance Show (ConnShortLink m)
+
+simplexShortLink :: ConnShortLink m -> ConnShortLink m
+simplexShortLink = \case
+  CSLInvitation _ srv lnkId k -> CSLInvitation SLSSimplex srv lnkId k
+  CSLContact _ ct srv k -> CSLContact SLSSimplex ct srv k
+
+newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
+  deriving (Eq, Show)
+  deriving newtype (FromField, StrEncoding)
+
+instance ToField LinkKey where toField (LinkKey s) = toField $ Binary s
+
+instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode
+
+instance (Typeable c, ConnectionModeI c) => FromField (ConnectionLink c) where fromField = blobFieldDecoder strDecode
+
+instance ConnectionModeI c => ToField (ConnShortLink c) where toField = toField . Binary . strEncode
+
+instance (Typeable c, ConnectionModeI c) => FromField (ConnShortLink c) where fromField = blobFieldDecoder strDecode
+
+data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay deriving (Eq, Show)
+
+data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
+
+instance Eq AConnShortLink where
+  ACSL m sl == ACSL m' sl' = case testEquality m m' of
+    Just Refl -> sl == sl'
+    Nothing -> False
+
+deriving instance Show AConnShortLink
+
+instance ToField AConnShortLink where toField = toField . Binary . strEncode
+
+instance FromField AConnShortLink where fromField = blobFieldDecoder strDecode
+
+data ConnectionLink m = CLFull (ConnectionRequestUri m) | CLShort (ConnShortLink m)
+  deriving (Eq, Show)
+
+data CreatedConnLink m = CCLink {connFullLink :: ConnectionRequestUri m, connShortLink :: Maybe (ConnShortLink m)}
+  deriving (Eq, Show)
+
+data ACreatedConnLink = forall m. ConnectionModeI m => ACCL (SConnectionMode m) (CreatedConnLink m)
+
+instance Eq ACreatedConnLink where
+  ACCL m l == ACCL m' l' = case testEquality m m' of
+    Just Refl -> l == l'
+    _ -> False
+
+deriving instance Show ACreatedConnLink
+
+data AConnectionLink = forall m. ConnectionModeI m => ACL (SConnectionMode m) (ConnectionLink m)
+
+instance Eq AConnectionLink where
+  ACL m cl == ACL m' cl' = case testEquality m m' of
+    Just Refl -> cl == cl'
+    _ -> False
+
+deriving instance Show AConnectionLink
+
+instance ConnectionModeI m => StrEncoding (ConnectionLink m) where
+  strEncode = \case
+    CLFull cr -> strEncode cr
+    CLShort sl -> strEncode sl
+  strP = (\(ACL _ cl) -> checkConnMode cl) <$?> strP
+  {-# INLINE strP #-}
+
+instance StrEncoding AConnectionLink where
+  strEncode (ACL _ cl) = strEncode cl
+  {-# INLINE strEncode #-}
+  strP =
+    (\(ACR m cr) -> ACL m (CLFull cr)) <$> strP
+      <|> (\(ACSL m sl) -> ACL m (CLShort sl)) <$> strP
+
+instance ConnectionModeI m => ToJSON (ConnectionLink m) where
+  toEncoding = strToJEncoding
+  toJSON = strToJSON
+
+instance ConnectionModeI m => FromJSON (ConnectionLink m) where
+  parseJSON = strParseJSON "ConnectionLink"
+
+instance ToJSON AConnectionLink where
+  toEncoding = strToJEncoding
+  toJSON = strToJSON
+
+instance FromJSON AConnectionLink where
+  parseJSON = strParseJSON "AConnectionLink"
+
+instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
+  strEncode = \case
+    CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k) -> slEncode sch srv 'i' lnkId k
+    CSLContact sch ct srv (LinkKey k) -> slEncode sch srv (toLower $ ctTypeChar ct) "" k
+    where
+      slEncode sch (SMPServer (h :| hs) port (C.KeyHash kh)) linkType lnkId k =
+        B.concat [authority, "/", B.singleton linkType, "#", lnkIdStr, B64.encodeUnpadded k, queryStr]
+        where
+          (authority, paramHosts) = case sch of
+            SLSSimplex -> ("simplex:", h : hs)
+            SLSServer -> ("https://" <> strEncode h, hs)
+          lnkIdStr = if B.null lnkId then "" else B64.encodeUnpadded lnkId <> "/"
+          queryStr = if B.null query then "" else "?" <> query
+          query =
+            strEncode . QSP QEscape $
+              [("h", strEncode (TransportHosts_ paramHosts)) | not (null paramHosts)]
+                <> [("p", B.pack port) | not (null port)]
+                <> [("c", B64.encodeUnpadded kh) | not (B.null kh)]
+  strP = (\(ACSL _ l) -> checkConnMode l) <$?> strP
+  {-# INLINE strP #-}
+
+instance StrEncoding AConnShortLink where
+  strEncode (ACSL _ l) = strEncode l
+  {-# INLINE strEncode #-}
+  strP = do
+    (sch, h_) <- authorityP <* A.char '/'
+    ct_ <- contactTypeP <* optional (A.char '/') <* A.char '#'
+    case ct_ of
+      Nothing -> do
+        lnkId <- strP <* A.char '/'
+        k <- strP
+        srv <- serverQueryP h_
+        pure $ ACSL SCMInvitation $ CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k)
+      Just ct -> do
+        k <- strP
+        srv <- serverQueryP h_
+        pure $ ACSL SCMContact $ CSLContact sch ct srv (LinkKey k)
+    where
+      authorityP =
+        "simplex:" $> (SLSSimplex, Nothing)
+          <|> "https://" *> ((SLSServer,) . Just <$> strP)
+          <|> fail "bad short link scheme"
+      contactTypeP = do
+        Just <$> (A.anyChar >>= ctTypeP . toUpper)
+          <|> A.char 'i' $> Nothing
+          <|> fail "unknown short link type"
+      serverQueryP h_ =
+        optional (A.char '?' *> strP) >>= \case
+          Nothing -> maybe noServer (pure . SMPServerOnlyHost) h_
+          Just query -> do
+            hs <- maybe noServer pure . L.nonEmpty . maybe id (:) h_ . maybe [] thList_ =<< queryParam_ "h" query
+            p <- maybe "" show <$> queryParam_ @Word16 "p" query
+            kh <- fromMaybe (C.KeyHash "") <$> queryParam_ "c" query
+            pure $ SMPServer hs p kh
+      noServer = fail "short link without server"
+
+instance ConnectionModeI m => Encoding (ConnShortLink m) where
+  smpEncode = \case
+    CSLInvitation _ srv lnkId (LinkKey k) -> smpEncode (CMInvitation, srv, lnkId, k)
+    CSLContact _ ct srv (LinkKey k) -> smpEncode (CMContact, ctTypeChar ct, srv, k)
+  smpP = (\(ACSL _ l) -> checkConnMode l) <$?> smpP
+  {-# INLINE smpP #-}
+
+instance Encoding AConnShortLink where
+  smpEncode (ACSL _ l) = smpEncode l
+  {-# INLINE smpEncode #-}
+  smpP =
+    smpP >>= \case
+      CMInvitation -> do
+        (srv, lnkId, k) <- smpP
+        pure $ ACSL SCMInvitation $ CSLInvitation SLSServer srv lnkId (LinkKey k)
+      CMContact -> do
+        ct <- ctTypeP =<< A.anyChar
+        (srv, k) <- smpP
+        pure $ ACSL SCMContact $ CSLContact SLSServer ct srv (LinkKey k)
+
+ctTypeP :: Char -> Parser ContactConnType
+ctTypeP = \case
+  'A' -> pure CCTContact
+  'C' -> pure CCTChannel
+  'G' -> pure CCTGroup
+  'R' -> pure CCTRelay
+  _ -> fail "unknown contact address type"
+{-# INLINE ctTypeP #-}
+
+ctTypeChar :: ContactConnType -> Char
+ctTypeChar = \case
+  CCTContact -> 'A'
+  CCTChannel -> 'C'
+  CCTGroup -> 'G'
+  CCTRelay -> 'R'
+{-# INLINE ctTypeChar #-}
+
+-- the servers passed to this function should be all preset servers, not servers configured by the user.
+shortenShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
+shortenShortLink presetSrvs = \case
+  CSLInvitation sch srv lnkId linkKey -> CSLInvitation sch (shortServer srv) lnkId linkKey
+  CSLContact sch ct srv linkKey -> CSLContact sch ct (shortServer srv) linkKey
+  where
+    shortServer srv@(SMPServer hs@(h :| _) p kh) =
+      if isPresetServer then SMPServerOnlyHost h else srv
+      where
+        isPresetServer = case findPresetServer srv presetSrvs of
+          Just (SMPServer hs' p' kh') ->
+            all (`elem` hs') hs
+              && (p == p' || (null p' && (p == "443" || p == "5223")))
+              && kh == kh'
+          Nothing -> False
+
+-- explicit bidirectional is used for ghc 8.10.7 compatibility, [h]/[] patterns are not reversible.
+pattern SMPServerOnlyHost :: TransportHost -> SMPServer
+pattern SMPServerOnlyHost h <- SMPServer [h] "" (C.KeyHash "")
+  where
+    SMPServerOnlyHost h = SMPServer [h] "" (C.KeyHash "")
+
+-- the servers passed to this function should be all preset servers, not servers configured by the user.
+restoreShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
+restoreShortLink presetSrvs = \case
+  CSLInvitation sch srv lnkId linkKey -> CSLInvitation sch (fullServer srv) lnkId linkKey
+  CSLContact sch ct srv linkKey -> CSLContact sch ct (fullServer srv) linkKey
+  where
+    fullServer = \case
+      s@(SMPServerOnlyHost _) -> fromMaybe s $ findPresetServer s presetSrvs
+      s -> s
+
+findPresetServer :: SMPServer -> NonEmpty SMPServer -> Maybe SMPServer
+findPresetServer ProtocolServer {host = h :| _} = find (\ProtocolServer {host = h' :| _} -> h == h')
+{-# INLINE findPresetServer #-}
+
 sameConnReqContact :: ConnectionRequestUri 'CMContact -> ConnectionRequestUri 'CMContact -> Bool
 sameConnReqContact (CRContactUri ConnReqUriData {crSmpQueues = qs}) (CRContactUri ConnReqUriData {crSmpQueues = qs'}) =
  L.length qs == L.length qs' && all same (L.zip qs qs')
  where
    same (q, q') = sameQAddress (qAddress q) (qAddress q')

+sameShortLinkContact :: ConnShortLink 'CMContact -> ConnShortLink 'CMContact -> Bool
+sameShortLinkContact (CSLContact _ ct srv k) (CSLContact _ ct' srv' k') =
+  ct == ct' && sameSrvAddr srv srv' && k == k'
+
+checkConnMode :: forall t m m'. (ConnectionModeI m, ConnectionModeI m') => t m' -> Either String (t m)
+checkConnMode c = case testEquality (sConnectionMode @m) (sConnectionMode @m') of
+  Just Refl -> Right c
+  Nothing -> Left "bad connection mode"
+{-# INLINE checkConnMode #-}
+
 data ConnReqUriData = ConnReqUriData
  { crScheme :: ServiceScheme,
    crAgentVRange :: VersionRangeSMPA,
@@ -1279,6 +1668,109 @@ data ConnReqUriData = ConnReqUriData

 type CRClientData = Text

+data FixedLinkData c = FixedLinkData
+  { agentVRange :: VersionRangeSMPA,
+    rootKey :: C.PublicKeyEd25519,
+    connReq :: ConnectionRequestUri c
+  }
+
+data ConnLinkData c where
+  InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
+  ContactLinkData ::
+    { agentVRange :: VersionRangeSMPA,
+      -- direct connection via connReq in fixed data is allowed.
+      direct :: Bool,
+      -- additional owner keys to sign changes of mutable data.
+      owners :: [OwnerAuth],
+      -- alternative addresses of chat relays that receive requests for this contact address.
+      relays :: [ConnShortLink 'CMContact],
+      userData :: UserLinkData
+    } -> ConnLinkData 'CMContact
+
+newtype UserLinkData = UserLinkData ByteString
+
+data AConnLinkData = forall m. ConnectionModeI m => ACLD (SConnectionMode m) (ConnLinkData m)
+
+linkUserData :: ConnLinkData c -> UserLinkData
+linkUserData = \case
+  InvitationLinkData _ d -> d
+  ContactLinkData {userData} -> userData
+{-# INLINE linkUserData #-}
+
+linkUserData' :: ConnLinkData c -> ByteString
+linkUserData' d = let UserLinkData s = linkUserData d in s
+{-# INLINE linkUserData' #-}
+
+type OwnerId = ByteString
+
+data OwnerAuth = OwnerAuth
+  { ownerId :: OwnerId, -- unique in the list, application specific - e.g., MemberId
+    ownerKey :: C.PublicKeyEd25519,
+    -- sender ID signed with ownerKey,
+    -- confirms that the owner accepts being the owner.
+    -- sender ID is used here as it is immutable for the queue, link data can be removed.
+    ownerSig :: C.Signature 'C.Ed25519,
+    -- null for root key authorization
+    authOwnerId :: OwnerId,
+    -- owner authorization, sig(ownerId || ownerKey, key(authOwnerId)),
+    -- where authOwnerId is either null for a root key or some other owner authorized by root key, etc.
+    -- Owner validation should detect and reject loops.
+    authOwnerSig :: C.Signature 'C.Ed25519
+  }
+
+instance Encoding OwnerAuth where
+  smpEncode OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig} =
+    smpEncode (ownerId, ownerKey, C.signatureBytes ownerSig, authOwnerId, C.signatureBytes authOwnerSig)
+  smpP = do
+    (ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig) <- smpP
+    pure OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig}
+
+instance ConnectionModeI c => Encoding (FixedLinkData c) where
+  smpEncode FixedLinkData {agentVRange, rootKey, connReq} =
+    smpEncode (agentVRange, rootKey, connReq)
+  smpP = do
+    (agentVRange, rootKey, connReq) <- smpP
+    pure FixedLinkData {agentVRange, rootKey, connReq}
+
+instance ConnectionModeI c => Encoding (ConnLinkData c) where
+  smpEncode = \case
+    InvitationLinkData vr userData -> smpEncode (CMInvitation, vr, userData)
+    ContactLinkData {agentVRange, direct, owners, relays, userData} ->
+      B.concat [smpEncode (CMContact, agentVRange, direct), smpEncodeList owners, smpEncodeList relays, smpEncode userData]
+  smpP = (\(ACLD _ d) -> checkConnMode d) <$?> smpP
+  {-# INLINE smpP #-}
+
+instance Encoding AConnLinkData where
+  smpEncode (ACLD _ d) = smpEncode d
+  {-# INLINE smpEncode #-}
+  smpP =
+    smpP >>= \case
+      CMInvitation -> do
+        (vr, userData) <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
+        pure $ ACLD SCMInvitation $ InvitationLinkData vr userData
+      CMContact -> do
+        (agentVRange, direct) <- smpP
+        owners <- smpListP
+        relays <- smpListP
+        userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
+        pure $ ACLD SCMContact ContactLinkData {agentVRange, direct, owners, relays, userData}
+
+instance Encoding UserLinkData where
+  smpEncode (UserLinkData s) = if B.length s <= 254 then smpEncode s else smpEncode ('\255', Large s)
+  {-# INLINE smpEncode #-}
+  smpP = UserLinkData <$> ((A.char '\255' *> (unLarge <$> smpP)) <|> smpP)
+  {-# INLINE smpP #-}
+
+data StoredClientService (s :: DBStored) = ClientService
+  { dbServiceId :: DBEntityId' s,
+    serviceId :: SMP.ServiceId
+  }
+  deriving (Eq, Show)
+
+type ClientService = StoredClientService 'DBStored
+
+type ClientServiceId = DBEntityId
+
 -- | SMP queue status.
 data QueueStatus
  = -- | queue is created
@@ -1348,7 +1840,7 @@ data AgentErrorType
  = -- | command or response error
    CMD {cmdErr :: CommandErrorType, errContext :: String}
  | -- | connection errors
-    CONN {connErr :: ConnectionErrorType}
+    CONN {connErr :: ConnectionErrorType, errContext :: String}
  | -- | user not found in database
    NO_USER
  | -- | SMP protocol errors forwarded to agent clients
@@ -1375,6 +1867,12 @@ data AgentErrorType
    INACTIVE
  deriving (Eq, Show, Exception)

+instance AnyError AgentErrorType where
+  fromSomeException e = case fromException e of
+    Just BlockedIndefinitelyOnSTM -> CRITICAL True "Thread blocked indefinitely in STM transaction"
+    _ -> INTERNAL $ show e
+  {-# INLINE fromSomeException #-}
+
 -- | SMP agent protocol command or response error.
 data CommandErrorType
  = -- | command is prohibited in this context
@@ -1411,6 +1909,8 @@ data SMPAgentError
    A_PROHIBITED {prohibitedErr :: String}
  | -- | incompatible version of SMP client, agent or encryption protocols
    A_VERSION
+  | -- | failed signature, hash or senderId verification of retrieved link data
+    A_LINK {linkErr :: String}
  | -- | cannot decrypt message
    A_CRYPTO {cryptoErr :: AgentCryptoError}
  | -- | duplicate message - this error is detected by ratchet decryption - this message will be ignored and not shown
@@ -1480,7 +1980,7 @@ commandP binaryP =
    s :: Parser a -> Parser a
    s p = A.space *> p
    pqIKP :: Parser InitialKeys
-    pqIKP = strP_ <|> pure (IKNoPQ PQSupportOff)
+    pqIKP = strP_ <|> pure (IKLinkPQ PQSupportOff)
    pqSupP :: Parser PQSupport
    pqSupP = strP_ <|> pure PQSupportOff

@@ -1523,3 +2023,22 @@ $(J.deriveJSON (sumTypeJSON id) ''AgentErrorType)
 $(J.deriveJSON (enumJSON $ dropPrefix "QD") ''QueueDirection)

 $(J.deriveJSON (enumJSON $ dropPrefix "SP") ''SwitchPhase)
+
+instance ConnectionModeI m => FromJSON (CreatedConnLink m) where
+  parseJSON = $(J.mkParseJSON defaultJSON ''CreatedConnLink)
+
+instance ConnectionModeI m => ToJSON (CreatedConnLink m) where
+  toEncoding = $(J.mkToEncoding defaultJSON ''CreatedConnLink)
+  toJSON = $(J.mkToJSON defaultJSON ''CreatedConnLink)
+
+instance FromJSON ACreatedConnLink where
+  parseJSON (Object v) = do
+    ACR m cReq <- v .: "connFullLink"
+    shortLink <- v .:? "connShortLink"
+    pure $ ACCL m $ CCLink cReq shortLink
+  parseJSON invalid =
+    JT.prependFailure "bad ACreatedConnLink, " (JT.typeMismatch "Object" invalid)
+
+instance ToJSON ACreatedConnLink where
+  toEncoding (ACCL _ ccLink) = toEncoding ccLink
+  toJSON (ACCL _ ccLink) = toJSON ccLink
@@ -11,8 +11,8 @@ import Data.Int (Int64)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Simplex.Messaging.Agent.Protocol (UserId)
-import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
-import Simplex.Messaging.Parsers (defaultJSON, fromTextField_)
+import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
+import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Protocol (NtfServer, SMPServer, XFTPServer)
 import Simplex.Messaging.Util (decodeJSON, encodeJSON)
 import UnliftIO.STM
@@ -29,12 +29,13 @@ import Data.Time (UTCTime)
 import Data.Type.Equality
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State)
+import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Agent.Store.Common
-import Simplex.Messaging.Agent.Store.Interface (DBOpts, createDBStore)
-import qualified Simplex.Messaging.Agent.Store.Migrations as Migrations
+import Simplex.Messaging.Agent.Store.Interface (createDBStore)
+import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError (..))
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport, RatchetX448)
+import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
  ( MsgBody,
@@ -43,39 +44,28 @@ import Simplex.Messaging.Protocol
    NotifierId,
    NtfPrivateAuthKey,
    NtfPublicAuthKey,
+    QueueMode,
    RcvDhSecret,
    RcvNtfDhSecret,
    RcvPrivateAuthKey,
-    SenderCanSecure,
    SndPrivateAuthKey,
    SndPublicAuthKey,
    VersionSMPC,
  )
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Util (AnyError (..), bshow)

 createStore :: DBOpts -> MigrationConfirmation -> IO (Either MigrationError DBStore)
-createStore dbOpts = createDBStore dbOpts Migrations.app
+createStore dbOpts = createDBStore dbOpts appMigrations

 -- * Queue types

-data QueueStored = QSStored | QSNew
+type RcvQueue = StoredRcvQueue 'DBStored

-data SQueueStored (q :: QueueStored) where
-  SQSStored :: SQueueStored 'QSStored
-  SQSNew :: SQueueStored 'QSNew
-
-data DBQueueId (q :: QueueStored) where
-  DBQueueId :: Int64 -> DBQueueId 'QSStored
-  DBNewQueue :: DBQueueId 'QSNew
-
-deriving instance Show (DBQueueId q)
-
-type RcvQueue = StoredRcvQueue 'QSStored
-
-type NewRcvQueue = StoredRcvQueue 'QSNew
+type NewRcvQueue = StoredRcvQueue 'DBNew

 -- | A receive queue. SMP queue through which the agent receives messages from a sender.
-data StoredRcvQueue (q :: QueueStored) = RcvQueue
+data StoredRcvQueue (q :: DBStored) = RcvQueue
  { userId :: UserId,
    connId :: ConnId,
    server :: SMPServer,
@@ -92,11 +82,15 @@ data StoredRcvQueue (q :: QueueStored) = RcvQueue
    -- | sender queue ID
    sndId :: SMP.SenderId,
    -- | sender can secure the queue
-    sndSecure :: SenderCanSecure,
+    queueMode :: Maybe QueueMode,
+    -- | short link ID and credentials
+    shortLink :: Maybe ShortLinkCreds,
+    -- | associated client service
+    clientService :: Maybe (StoredClientService q),
    -- | queue status
    status :: QueueStatus,
    -- | database queue ID (within connection)
-    dbQueueId :: DBQueueId q,
+    dbQueueId :: DBEntityId' q,
    -- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
    primary :: Bool,
    -- | database queue ID to replace, Nothing if this queue is not replacing another, `Just Nothing` is used for replacing old queues
@@ -110,10 +104,26 @@ data StoredRcvQueue (q :: QueueStored) = RcvQueue
  }
  deriving (Show)

+data ShortLinkCreds = ShortLinkCreds
+  { shortLinkId :: SMP.LinkId,
+    shortLinkKey :: LinkKey,
+    linkPrivSigKey :: C.PrivateKeyEd25519,
+    linkEncFixedData :: SMP.EncFixedDataBytes
+  }
+  deriving (Show)
+
+clientServiceId :: RcvQueue -> Maybe ClientServiceId
+clientServiceId = fmap dbServiceId . clientService
+{-# INLINE clientServiceId #-}
+
 rcvQueueInfo :: RcvQueue -> RcvQueueInfo
 rcvQueueInfo rq@RcvQueue {server, rcvSwchStatus} =
  RcvQueueInfo {rcvServer = server, rcvSwitchStatus = rcvSwchStatus, canAbortSwitch = canAbortRcvSwitch rq}

+rcvSMPQueueAddress :: RcvQueue -> SMPQueueAddress
+rcvSMPQueueAddress RcvQueue {server, sndId, e2ePrivKey, queueMode} =
+  SMPQueueAddress server sndId (C.publicKey e2ePrivKey) queueMode
+
 canAbortRcvSwitch :: RcvQueue -> Bool
 canAbortRcvSwitch = maybe False canAbort . rcvSwchStatus
  where
@@ -137,19 +147,32 @@ data ClientNtfCreds = ClientNtfCreds
  }
  deriving (Show)

-type SndQueue = StoredSndQueue 'QSStored
+-- This record is stored in inv_short_links table.
+-- It is needed only for 1-time invitation links because of "secure-on-read" property of link data,
+-- that prevents undetected access to link data from link observers.
+data InvShortLink = InvShortLink
+  { server :: SMPServer,
+    linkId :: SMP.LinkId,
+    linkKey :: LinkKey,
+    sndPrivateKey :: SndPrivateAuthKey, -- stored to allow retries
+    sndPublicKey :: SndPublicAuthKey,
+    sndId :: Maybe SMP.SenderId
+  }
+  deriving (Show)

-type NewSndQueue = StoredSndQueue 'QSNew
+type SndQueue = StoredSndQueue 'DBStored
+
+type NewSndQueue = StoredSndQueue 'DBNew

 -- | A send queue. SMP queue through which the agent sends messages to a recipient.
-data StoredSndQueue (q :: QueueStored) = SndQueue
+data StoredSndQueue (q :: DBStored) = SndQueue
  { userId :: UserId,
    connId :: ConnId,
    server :: SMPServer,
    -- | sender queue ID
    sndId :: SMP.SenderId,
    -- | sender can secure the queue
-    sndSecure :: SenderCanSecure,
+    queueMode :: Maybe QueueMode,
    -- | key pair used by the sender to authorize transmissions
    -- TODO combine keys to key pair so that types match
    sndPublicKey :: SndPublicAuthKey,
@@ -161,7 +184,7 @@ data StoredSndQueue (q :: QueueStored) = SndQueue
    -- | queue status
    status :: QueueStatus,
    -- | database queue ID (within connection)
-    dbQueueId :: DBQueueId q,
+    dbQueueId :: DBEntityId' q,
    -- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
    primary :: Bool,
    -- | ID of the queue this one is replacing
@@ -234,7 +257,7 @@ instance SMPQueueRec RcvQueue where
  {-# INLINE qUserId #-}
  qConnId RcvQueue {connId} = connId
  {-# INLINE qConnId #-}
-  dbQId RcvQueue {dbQueueId = DBQueueId qId} = qId
+  dbQId RcvQueue {dbQueueId = DBEntityId qId} = qId
  {-# INLINE dbQId #-}
  dbReplaceQId RcvQueue {dbReplaceQueueId} = dbReplaceQueueId
  {-# INLINE dbReplaceQId #-}
@@ -244,7 +267,7 @@ instance SMPQueueRec SndQueue where
  {-# INLINE qUserId #-}
  qConnId SndQueue {connId} = connId
  {-# INLINE qConnId #-}
-  dbQId SndQueue {dbQueueId = DBQueueId qId} = qId
+  dbQId SndQueue {dbQueueId = DBEntityId qId} = qId
  {-# INLINE dbQId #-}
  dbReplaceQId SndQueue {dbReplaceQueueId} = dbReplaceQueueId
  {-# INLINE dbReplaceQId #-}
@@ -493,7 +516,7 @@ data NewInvitation = NewInvitation

 data Invitation = Invitation
  { invitationId :: InvitationId,
-    contactConnId :: ConnId,
+    contactConnId_ :: Maybe ConnId,
    connReq :: ConnectionRequestUri 'CMInvitation,
    recipientConnInfo :: ConnInfo,
    ownConnInfo :: Maybe ConnInfo,
@@ -543,9 +566,17 @@ data SndMsgData = SndMsgData
    msgBody :: MsgBody,
    pqEncryption :: PQEncryption,
    internalHash :: MsgHash,
-    prevMsgHash :: MsgHash
+    prevMsgHash :: MsgHash,
+    sndMsgPrepData_ :: Maybe SndMsgPrepData
  }

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

@@ -626,13 +667,13 @@ data StoreError
    SESndQueueExists
  | -- | Wrong connection type, e.g. "send" connection when "receive" or "duplex" is expected, or vice versa.
    -- 'upgradeRcvConnToDuplex' and 'upgradeSndConnToDuplex' do not allow duplex connections - they would also return this error.
-    SEBadConnType ConnType
+    SEBadConnType String ConnType
  | -- | Confirmation not found.
    SEConfirmationNotFound
  | -- | Invitation not found
    SEInvitationNotFound String InvitationId
  | -- | Message not found
-    SEMsgNotFound
+    SEMsgNotFound String
  | -- | Command not found
    SECmdNotFound
  | -- | Currently not used. The intention was to pass current expected queue status in methods,
@@ -656,3 +697,6 @@ data StoreError
  | -- | Servers stats not found.
    SEServersStatsNotFound
  deriving (Eq, Show, Exception)
+
+instance AnyError StoreError where
+  fromSomeException = SEInternal . bshow
@@ -58,6 +58,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
    getRcvQueueById,
    getSndQueueById,
    deleteConn,
+    deleteConnRecord,
    upgradeRcvConnToDuplex,
    upgradeSndConnToDuplex,
    addConnRcvQueue,
@@ -88,10 +89,18 @@ module Simplex.Messaging.Agent.Store.AgentStore
    acceptInvitation,
    unacceptInvitation,
    deleteInvitation,
+    getInvShortLink,
+    getInvShortLinkKeys,
+    deleteInvShortLink,
+    createInvShortLink,
+    setInvShortLinkSndId,
+    updateShortLinkCreds,
    -- Messages
    updateRcvIds,
    createRcvMsg,
+    setLastBrokerTs,
    updateRcvMsgHash,
+    createSndMsgBody,
    updateSndIds,
    createSndMsg,
    updateSndMsgHash,
@@ -236,7 +245,7 @@ import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
-import Data.Bifunctor (first, second)
+import Data.Bifunctor (first)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as U
 import qualified Data.ByteString.Char8 as B
@@ -246,7 +255,7 @@ import Data.List (foldl', sortBy)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
 import Data.Ord (Down (..))
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
@@ -262,7 +271,7 @@ import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.Common
 import qualified Simplex.Messaging.Agent.Store.DB as DB
-import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), FromField (..), ToField (..))
+import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
 import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys)
@@ -271,11 +280,12 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..))
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Parsers (blobFieldParser, fromTextField_)
+import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (bshow, catchAllErrors, eitherToMaybe, ifM, tshow, ($>>=), (<$$>))
+import Simplex.Messaging.Util (bshow, catchAllErrors, eitherToMaybe, firstRow, firstRow', ifM, maybeFirstRow, tshow, ($>>=), (<$$>))
 import Simplex.Messaging.Version.Internal
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -371,12 +381,13 @@ createNewConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> SConnectionMode
 createNewConn db gVar cData cMode = do
  fst <$$> createConn_ gVar cData (\connId -> createConnRecord db connId cData cMode)

+-- TODO [certs rcv] store clientServiceId from NewRcvQueue
 updateNewConnRcv :: DB.Connection -> ConnId -> NewRcvQueue -> IO (Either StoreError RcvQueue)
 updateNewConnRcv db connId rq =
  getConn db connId $>>= \case
    (SomeConn _ NewConnection {}) -> updateConn
    (SomeConn _ RcvConnection {}) -> updateConn -- to allow retries
-    (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    (SomeConn c _) -> pure . Left . SEBadConnType "updateNewConnRcv" $ connType c
  where
    updateConn :: IO (Either StoreError RcvQueue)
    updateConn = Right <$> addConnRcvQueue_ db connId rq
@@ -385,7 +396,7 @@ updateNewConnSnd :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreEr
 updateNewConnSnd db connId sq =
  getConn db connId $>>= \case
    (SomeConn _ NewConnection {}) -> updateConn
-    (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    (SomeConn c _) -> pure . Left . SEBadConnType "updateNewConnSnd" $ connType c
  where
    updateConn :: IO (Either StoreError SndQueue)
    updateConn = Right <$> addConnSndQueue_ db connId sq
@@ -409,6 +420,9 @@ createConnRecord db connId ConnData {userId, connAgentVersion, enableNtfs, pqSup
    |]
    (userId, connId, cMode, connAgentVersion, BI enableNtfs, pqSupport, BI True)

+deleteConnRecord :: DB.Connection -> ConnId -> IO ()
+deleteConnRecord db connId = DB.execute db "DELETE FROM connections WHERE conn_id = ?" (Only connId)
+
 checkConfirmedSndQueueExists_ :: DB.Connection -> NewSndQueue -> IO Bool
 checkConfirmedSndQueueExists_ db SndQueue {server, sndId} = do
  fromMaybe False
@@ -441,7 +455,7 @@ deleteConn db waitDeliveryTimeout_ connId = case waitDeliveryTimeout_ of
          (pure Nothing)
      )
  where
-    delete = DB.execute db "DELETE FROM connections WHERE conn_id = ?" (Only connId) $> Just connId
+    delete = deleteConnRecord db connId $> Just connId
    checkNoPendingDeliveries_ = do
      r :: (Maybe Int64) <-
        maybeFirstRow fromOnly $
@@ -458,20 +472,22 @@ upgradeRcvConnToDuplex :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either S
 upgradeRcvConnToDuplex db connId sq =
  getConn db connId $>>= \case
    (SomeConn _ RcvConnection {}) -> Right <$> addConnSndQueue_ db connId sq
-    (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    (SomeConn c _) -> pure . Left . SEBadConnType "upgradeRcvConnToDuplex" $ connType c

+-- TODO [certs rcv] store clientServiceId from NewRcvQueue
 upgradeSndConnToDuplex :: DB.Connection -> ConnId -> NewRcvQueue -> IO (Either StoreError RcvQueue)
 upgradeSndConnToDuplex db connId rq =
  getConn db connId >>= \case
    Right (SomeConn _ SndConnection {}) -> Right <$> addConnRcvQueue_ db connId rq
-    Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    Right (SomeConn c _) -> pure . Left . SEBadConnType "upgradeSndConnToDuplex" $ connType c
    _ -> pure $ Left SEConnNotFound

+-- TODO [certs rcv] store clientServiceId from NewRcvQueue
 addConnRcvQueue :: DB.Connection -> ConnId -> NewRcvQueue -> IO (Either StoreError RcvQueue)
 addConnRcvQueue db connId rq =
  getConn db connId >>= \case
    Right (SomeConn _ DuplexConnection {}) -> Right <$> addConnRcvQueue_ db connId rq
-    Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    Right (SomeConn c _) -> pure . Left . SEBadConnType "addConnRcvQueue" $ connType c
    _ -> pure $ Left SEConnNotFound

 addConnRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> IO RcvQueue
@@ -483,7 +499,7 @@ addConnSndQueue :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreErr
 addConnSndQueue db connId sq =
  getConn db connId >>= \case
    Right (SomeConn _ DuplexConnection {}) -> Right <$> addConnSndQueue_ db connId sq
-    Right (SomeConn c _) -> pure . Left . SEBadConnType $ connType c
+    Right (SomeConn c _) -> pure . Left . SEBadConnType "addConnSndQueue" $ connType c
    _ -> pure $ Left SEConnNotFound

 addConnSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> IO SndQueue
@@ -712,7 +728,7 @@ createInvitation db gVar NewInvitation {contactConnId, connReq, recipientConnInf
      db
      [sql|
        INSERT INTO conn_invitations
-        (invitation_id,  contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
+        (invitation_id, contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
      |]
      (Binary invitationId, contactConnId, connReq, Binary recipientConnInfo)

@@ -729,8 +745,8 @@ getInvitation db cxt invitationId =
      |]
      (Only (Binary invitationId))
  where
-    invitation (contactConnId, connReq, recipientConnInfo, ownConnInfo, BI accepted) =
-      Invitation {invitationId, contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted}
+    invitation (contactConnId_, connReq, recipientConnInfo, ownConnInfo, BI accepted) =
+      Invitation {invitationId, contactConnId_, connReq, recipientConnInfo, ownConnInfo, accepted}

 acceptInvitation :: DB.Connection -> InvitationId -> ConnInfo -> IO ()
 acceptInvitation db invitationId ownConnInfo =
@@ -748,12 +764,85 @@ unacceptInvitation :: DB.Connection -> InvitationId -> IO ()
 unacceptInvitation db invitationId =
  DB.execute db "UPDATE conn_invitations SET accepted = 0, own_conn_info = NULL WHERE invitation_id = ?" (Only (Binary invitationId))

-deleteInvitation :: DB.Connection -> ConnId -> InvitationId -> IO (Either StoreError ())
-deleteInvitation db contactConnId invId =
-  getConn db contactConnId $>>= \case
-    SomeConn SCContact _ ->
-      Right <$> DB.execute db "DELETE FROM conn_invitations WHERE contact_conn_id = ? AND invitation_id = ?" (contactConnId, Binary invId)
-    _ -> pure $ Left SEConnNotFound
+deleteInvitation :: DB.Connection -> InvitationId -> IO ()
+deleteInvitation db invId =
+  DB.execute db "DELETE FROM conn_invitations WHERE invitation_id = ?" (Only (Binary invId))
+
+getInvShortLink :: DB.Connection -> SMPServer -> LinkId -> IO (Maybe InvShortLink)
+getInvShortLink db server linkId =
+  maybeFirstRow toInvShortLink $
+    DB.query
+      db
+      [sql|
+        SELECT link_key, snd_private_key, snd_id
+        FROM inv_short_links
+        WHERE host = ? AND port = ? AND link_id = ?
+      |]
+      (host server, port server, linkId)
+  where
+    toInvShortLink :: (LinkKey, C.APrivateAuthKey, Maybe SenderId) -> InvShortLink
+    toInvShortLink (linkKey, sndPrivateKey@(C.APrivateAuthKey a pk), sndId) =
+      let sndPublicKey = C.APublicAuthKey a $ C.publicKey pk
+       in InvShortLink {server, linkId, linkKey, sndPrivateKey, sndPublicKey, sndId}
+
+getInvShortLinkKeys :: DB.Connection -> SMPServer -> SenderId -> IO (Maybe (LinkId, C.AAuthKeyPair))
+getInvShortLinkKeys db srv sndId =
+  maybeFirstRow toSndKeys $
+    DB.query
+      db
+      [sql|
+        SELECT link_id, snd_private_key
+        FROM inv_short_links
+        WHERE host = ? AND port = ? AND snd_id = ?
+      |]
+      (host srv, port srv, sndId)
+  where
+    toSndKeys :: (LinkId, C.APrivateAuthKey) -> (LinkId, C.AAuthKeyPair)
+    toSndKeys (linkId, privKey@(C.APrivateAuthKey a pk)) = (linkId, (C.APublicAuthKey a $ C.publicKey pk, privKey))
+
+deleteInvShortLink :: DB.Connection -> SMPServer -> LinkId -> IO ()
+deleteInvShortLink db srv lnkId =
+  DB.execute db "DELETE FROM inv_short_links WHERE host = ? AND port = ? AND link_id = ?" (host srv, port srv, lnkId)
+
+createInvShortLink :: DB.Connection -> InvShortLink -> IO ()
+createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do
+  serverKeyHash_ <- createServer_ db server
+  DB.execute
+    db
+    [sql|
+      INSERT INTO inv_short_links
+        (host, port, server_key_hash, link_id, link_key, snd_private_key, snd_id)
+      VALUES (?,?,?,?,?,?,?)
+      ON CONFLICT (host, port, link_id)
+      DO UPDATE SET
+        server_key_hash = EXCLUDED.server_key_hash,
+        link_key = EXCLUDED.link_key,
+        snd_private_key = EXCLUDED.snd_private_key,
+        snd_id = EXCLUDED.snd_id
+    |]
+    (host server, port server, serverKeyHash_, linkId, linkKey, sndPrivateKey, sndId)
+
+setInvShortLinkSndId :: DB.Connection -> InvShortLink -> SenderId -> IO ()
+setInvShortLinkSndId db InvShortLink {server, linkId} sndId =
+  DB.execute
+    db
+    [sql|
+      UPDATE inv_short_links
+      SET snd_id = ?
+      WHERE host = ? AND port = ? AND link_id = ?
+    |]
+    (sndId, host server, port server, linkId)
+
+updateShortLinkCreds :: DB.Connection -> RcvQueue -> ShortLinkCreds -> IO ()
+updateShortLinkCreds db RcvQueue {server, rcvId} ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} =
+  DB.execute
+    db
+    [sql|
+      UPDATE rcv_queues
+      SET link_id = ?, link_key = ?, link_priv_sig_key = ?, link_enc_fixed_data = ?
+      WHERE host = ? AND port = ? AND rcv_id = ?
+    |]
+    (shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData, host server, port server, rcvId)

 updateRcvIds :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
 updateRcvIds db connId = do
@@ -768,7 +857,19 @@ createRcvMsg db connId rq@RcvQueue {dbQueueId} rcvMsgData@RcvMsgData {msgMeta =
  insertRcvMsgBase_ db connId rcvMsgData
  insertRcvMsgDetails_ db connId rq rcvMsgData
  updateRcvMsgHash db connId sndMsgId internalRcvId internalHash
-  DB.execute db "UPDATE rcv_queues SET last_broker_ts = ? WHERE conn_id = ? AND rcv_queue_id = ?" (brokerTs, connId, dbQueueId)
+  setLastBrokerTs db connId dbQueueId brokerTs
+
+setLastBrokerTs :: DB.Connection -> ConnId -> DBEntityId -> UTCTime -> IO ()
+setLastBrokerTs db connId dbQueueId brokerTs =
+  DB.execute db "UPDATE rcv_queues SET last_broker_ts = ? WHERE conn_id = ? AND rcv_queue_id = ? AND (last_broker_ts IS NULL OR last_broker_ts < ?)" (brokerTs, connId, dbQueueId, brokerTs)
+
+createSndMsgBody :: DB.Connection -> AMessage -> IO Int64
+createSndMsgBody db aMessage =
+  fromOnly . head <$>
+    DB.query
+      db
+      "INSERT INTO snd_message_bodies (agent_msg) VALUES (?) RETURNING snd_message_body_id"
+      (Only aMessage)

 updateSndIds :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
 updateSndIds db connId = runExceptT $ do
@@ -790,7 +891,7 @@ createSndMsgDelivery db connId SndQueue {dbQueueId} msgId =

 getSndMsgViaRcpt :: DB.Connection -> ConnId -> InternalSndId -> IO (Either StoreError SndMsg)
 getSndMsgViaRcpt db connId sndMsgId =
-  firstRow toSndMsg SEMsgNotFound $
+  firstRow toSndMsg (SEMsgNotFound "getSndMsgViaRcpt") $
    DB.query
      db
      [sql|
@@ -836,7 +937,7 @@ getPendingQueueMsg db connId SndQueue {dbQueueId} =
          (connId, dbQueueId)
    getMsgData :: InternalId -> IO (Either StoreError (Maybe RcvQueue, PendingMsgData))
    getMsgData msgId = runExceptT $ do
-      msg <- ExceptT $ firstRow pendingMsgData err getMsgData_
+      msg <- ExceptT $ firstRow' pendingMsgData err getMsgData_
      rq_ <- liftIO $ L.head <$$> getRcvQueuesByConnId_ db connId
      pure (rq_, msg)
      where
@@ -844,18 +945,25 @@ getPendingQueueMsg db connId SndQueue {dbQueueId} =
          DB.query
            db
            [sql|
-              SELECT m.msg_type, m.msg_flags, m.msg_body, m.pq_encryption, m.internal_ts, s.retry_int_slow, s.retry_int_fast
+              SELECT
+                m.msg_type, m.msg_flags, m.msg_body, m.pq_encryption, m.internal_ts, m.internal_snd_id, s.previous_msg_hash,
+                s.retry_int_slow, s.retry_int_fast, s.msg_encrypt_key, s.padded_msg_len, sb.agent_msg
              FROM messages m
              JOIN snd_messages s ON s.conn_id = m.conn_id AND s.internal_id = m.internal_id
+              LEFT JOIN snd_message_bodies sb ON sb.snd_message_body_id = s.snd_message_body_id
              WHERE m.conn_id = ? AND m.internal_id = ?
            |]
            (connId, msgId)
        err = SEInternal $ "msg delivery " <> bshow msgId <> " returned []"
-        pendingMsgData :: (AgentMessageType, Maybe MsgFlags, MsgBody, PQEncryption, InternalTs, Maybe Int64, Maybe Int64) -> PendingMsgData
-        pendingMsgData (msgType, msgFlags_, msgBody, pqEncryption, internalTs, riSlow_, riFast_) =
+        pendingMsgData :: (AgentMessageType, Maybe MsgFlags, MsgBody, PQEncryption, InternalTs, InternalSndId, PrevSndMsgHash, Maybe Int64, Maybe Int64, Maybe CR.MsgEncryptKeyX448, Maybe Int, Maybe AMessage) -> Either StoreError PendingMsgData
+        pendingMsgData (msgType, msgFlags_, msgBody, pqEncryption, internalTs, internalSndId, prevMsgHash, riSlow_, riFast_, encryptKey_, paddedLen_, sndMsgBody_) = do
          let msgFlags = fromMaybe SMP.noMsgFlags msgFlags_
              msgRetryState = RI2State <$> riSlow_ <*> riFast_
-           in PendingMsgData {msgId, msgType, msgFlags, msgBody, pqEncryption, msgRetryState, internalTs}
+              result pendingMsgPrepData_ = PendingMsgData {msgId, msgType, msgFlags, msgBody, pqEncryption, msgRetryState, internalTs, internalSndId, prevMsgHash, pendingMsgPrepData_}
+           in result <$> case (encryptKey_, paddedLen_, sndMsgBody_) of
+                (Nothing, Nothing, Nothing) -> Right Nothing
+                (Just encryptKey, Just paddedLen, Just sndMsgBody) -> Right $ Just PendingMsgPrepData {encryptKey, paddedLen, sndMsgBody}
+                _ -> Left $ SEInternal "unexpected snd msg data"
    markMsgFailed msgId = DB.execute db "UPDATE snd_message_deliveries SET failed = 1 WHERE conn_id = ? AND internal_id = ?" (connId, msgId)

 getWorkItem :: Show i => ByteString -> IO (Maybe i) -> (i -> IO (Either StoreError a)) -> (i -> IO ()) -> IO (Either StoreError (Maybe a))
@@ -867,13 +975,10 @@ getWorkItems itemName getIds getItem markFailed =
  runExceptT $ handleWrkErr itemName "getIds" getIds >>= mapM (tryE . tryGetItem itemName getItem markFailed)

 tryGetItem :: Show i => ByteString -> (i -> IO (Either StoreError a)) -> (i -> IO ()) -> i -> ExceptT StoreError IO a
-tryGetItem itemName getItem markFailed itemId = ExceptT (getItem itemId) `catchStoreError` \e -> mark >> throwE e
+tryGetItem itemName getItem markFailed itemId = ExceptT (getItem itemId) `catchAllErrors` \e -> mark >> throwE e
  where
    mark = handleWrkErr itemName ("markFailed ID " <> bshow itemId) $ markFailed itemId

-catchStoreError :: ExceptT StoreError IO a -> (StoreError -> ExceptT StoreError IO a) -> ExceptT StoreError IO a
-catchStoreError = catchAllErrors (SEInternal . bshow)
-
 -- Errors caught by this function will suspend worker as if there is no more work,
 handleWrkErr :: ByteString -> ByteString -> IO a -> ExceptT StoreError IO a
 handleWrkErr itemName opName action = ExceptT $ first mkError <$> E.try action
@@ -919,7 +1024,7 @@ getExpiredSndMessages db connId SndQueue {dbQueueId} expireTs = do
 setMsgUserAck :: DB.Connection -> ConnId -> InternalId -> IO (Either StoreError (RcvQueue, SMP.MsgId))
 setMsgUserAck db connId agentMsgId = runExceptT $ do
  (dbRcvId, srvMsgId) <-
-    ExceptT . firstRow id SEMsgNotFound $
+    ExceptT . firstRow id (SEMsgNotFound "setMsgUserAck") $
      DB.query db "SELECT rcv_queue_id, broker_id FROM rcv_messages WHERE conn_id = ? AND internal_id = ?" (connId, agentMsgId)
  rq <- ExceptT $ getRcvQueueById db connId dbRcvId
  liftIO $ DB.execute db "UPDATE rcv_messages SET user_ack = ? WHERE conn_id = ? AND internal_id = ?" (BI True, connId, agentMsgId)
@@ -927,7 +1032,7 @@ setMsgUserAck db connId agentMsgId = runExceptT $ do

 getRcvMsg :: DB.Connection -> ConnId -> InternalId -> IO (Either StoreError RcvMsg)
 getRcvMsg db connId agentMsgId =
-  firstRow toRcvMsg SEMsgNotFound $
+  firstRow toRcvMsg (SEMsgNotFound "getRcvMsg") $
    DB.query
      db
      [sql|
@@ -977,7 +1082,7 @@ checkRcvMsgHashExists db connId hash = do

 getRcvMsgBrokerTs :: DB.Connection -> ConnId -> SMP.MsgId -> IO (Either StoreError BrokerTs)
 getRcvMsgBrokerTs db connId msgId =
-  firstRow fromOnly SEMsgNotFound $
+  firstRow fromOnly (SEMsgNotFound "getRcvMsgBrokerTs") $
    DB.query db "SELECT broker_ts FROM rcv_messages WHERE conn_id = ? AND broker_id = ?" (connId, Binary msgId)

 deleteMsg :: DB.Connection -> ConnId -> InternalId -> IO ()
@@ -985,12 +1090,13 @@ deleteMsg db connId msgId =
  DB.execute db "DELETE FROM messages WHERE conn_id = ? AND internal_id = ?;" (connId, msgId)

 deleteMsgContent :: DB.Connection -> ConnId -> InternalId -> IO ()
-deleteMsgContent db connId msgId =
+deleteMsgContent db connId msgId = do
 #if defined(dbPostgres)
  DB.execute db "UPDATE messages SET msg_body = ''::BYTEA WHERE conn_id = ? AND internal_id = ?" (connId, msgId)
 #else
  DB.execute db "UPDATE messages SET msg_body = x'' WHERE conn_id = ? AND internal_id = ?" (connId, msgId)
 #endif
+  DB.execute db "UPDATE snd_messages SET snd_message_body_id = NULL WHERE conn_id = ? AND internal_id = ?" (connId, msgId)

 deleteDeliveredSndMsg :: DB.Connection -> ConnId -> InternalId -> IO ()
 deleteDeliveredSndMsg db connId msgId = do
@@ -1003,13 +1109,39 @@ deleteSndMsgDelivery db connId SndQueue {dbQueueId} msgId keepForReceipt = do
    db
    "DELETE FROM snd_message_deliveries WHERE conn_id = ? AND snd_queue_id = ? AND internal_id = ?"
    (connId, dbQueueId, msgId)
-  cnt <- countPendingSndDeliveries_ db connId msgId
-  when (cnt == 0) $ do
-    del <-
-      maybeFirstRow id (DB.query db "SELECT rcpt_internal_id, rcpt_status FROM snd_messages WHERE conn_id = ? AND internal_id = ?" (connId, msgId)) >>= \case
-        Just (Just (_ :: Int64), Just MROk) -> pure deleteMsg
-        _ -> pure $ if keepForReceipt then deleteMsgContent else deleteMsg
-    del db connId msgId
+  getRcptAndBodyId >>= mapM_ deleteMsgAndBody
+  where
+    getRcptAndBodyId :: IO (Maybe (Maybe MsgReceiptStatus, Maybe Int64))
+    getRcptAndBodyId =
+      -- Get receipt status and message body ID if there are no pending deliveries.
+      -- The current delivery is deleted above.
+      maybeFirstRow id $
+        DB.query
+          db
+          [sql|
+            SELECT rcpt_status, snd_message_body_id FROM snd_messages
+            WHERE NOT EXISTS (SELECT 1 FROM snd_message_deliveries WHERE conn_id = ? AND internal_id = ? AND failed = 0)
+              AND conn_id = ? AND internal_id = ?
+          |]
+          (connId, msgId, connId, msgId)
+    deleteMsgAndBody :: (Maybe MsgReceiptStatus, Maybe Int64) -> IO ()
+    deleteMsgAndBody (rcptStatus_, sndMsgBodyId_) = do
+      let del = case rcptStatus_ of
+            -- we are not deleting message if receipt is not received or had incorrect hash (for debugging).
+            Just MROk -> deleteMsg
+            _ -> if keepForReceipt then deleteMsgContent else deleteMsg
+      del db connId msgId
+      forM_ sndMsgBodyId_ $ \bodyId ->
+        -- Delete message body if it is not used by any snd message.
+        -- The current snd message is already deleted by deleteMsg or cleared by deleteMsgContent.
+        DB.execute
+          db
+          [sql|
+            DELETE FROM snd_message_bodies
+            WHERE NOT EXISTS (SELECT 1 FROM snd_messages WHERE snd_message_body_id = ?)
+              AND snd_message_body_id = ?
+          |]
+          (bodyId, bodyId)

 countPendingSndDeliveries_ :: DB.Connection -> ConnId -> InternalId -> IO Int
 countPendingSndDeliveries_ db connId msgId = do
@@ -1078,7 +1210,7 @@ getSndRatchet db connId v =
    DB.query db "SELECT ratchet_state, x3dh_pub_key_1, x3dh_pub_key_2, pq_pub_kem FROM ratchets WHERE conn_id = ?" (Only connId)
  where
    result = \case
-      (Just ratchetState, Just k1, Just k2, pKem_) -> 
+      (Just ratchetState, Just k1, Just k2, pKem_) ->
        let params = case pKem_ of
              Nothing -> CR.AE2ERatchetParams CR.SRKSProposed (CR.E2ERatchetParams v k1 k2 Nothing)
              Just (CR.ARKP s pKem) -> CR.AE2ERatchetParams s (CR.E2ERatchetParams v k1 k2 (Just pKem))
@@ -1652,19 +1784,19 @@ getActiveNtfToken db =
          ntfMode = fromMaybe NMPeriodic ntfMode_
       in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}

-getNtfRcvQueue :: DB.Connection -> SMPQueueNtf -> IO (Either StoreError (ConnId, RcvNtfDhSecret, Maybe UTCTime))
+getNtfRcvQueue :: DB.Connection -> SMPQueueNtf -> IO (Either StoreError (ConnId, Int64, RcvNtfDhSecret, Maybe UTCTime))
 getNtfRcvQueue db SMPQueueNtf {smpServer = (SMPServer host port _), notifierId} =
  firstRow' res SEConnNotFound $
    DB.query
      db
      [sql|
-        SELECT conn_id, rcv_ntf_dh_secret, last_broker_ts
+        SELECT conn_id, rcv_queue_id, rcv_ntf_dh_secret, last_broker_ts
        FROM rcv_queues
        WHERE host = ? AND port = ? AND ntf_id = ? AND deleted = 0
      |]
      (host, port, notifierId)
  where
-    res (connId, Just rcvNtfDhSecret, lastBrokerTs_) = Right (connId, rcvNtfDhSecret, lastBrokerTs_)
+    res (connId, dbQueueId, Just rcvNtfDhSecret, lastBrokerTs_) = Right (connId, dbQueueId, rcvNtfDhSecret, lastBrokerTs_)
    res _ = Left SEConnNotFound

 setConnectionNtfs :: DB.Connection -> ConnId -> Bool -> IO ()
@@ -1677,15 +1809,6 @@ instance ToField QueueStatus where toField = toField . serializeQueueStatus

 instance FromField QueueStatus where fromField = fromTextField_ queueStatusT

-instance ToField (DBQueueId 'QSStored) where toField (DBQueueId qId) = toField qId
-
-instance FromField (DBQueueId 'QSStored) where 
-#if defined(dbPostgres)
-  fromField x dat = DBQueueId <$> fromField x dat
-#else
-  fromField x = DBQueueId <$> fromField x
-#endif
-
 instance ToField InternalRcvId where toField (InternalRcvId x) = toField x

 deriving newtype instance FromField InternalRcvId
@@ -1700,23 +1823,23 @@ deriving newtype instance FromField InternalId

 instance ToField AgentMessageType where toField = toField . Binary . smpEncode

-instance FromField AgentMessageType where fromField = blobFieldParser smpP
+instance FromField AgentMessageType where fromField = blobFieldDecoder smpDecode

 instance ToField MsgIntegrity where toField = toField . Binary . strEncode

-instance FromField MsgIntegrity where fromField = blobFieldParser strP
+instance FromField MsgIntegrity where fromField = blobFieldDecoder strDecode

 instance ToField SMPQueueUri where toField = toField . Binary . strEncode

-instance FromField SMPQueueUri where fromField = blobFieldParser strP
+instance FromField SMPQueueUri where fromField = blobFieldDecoder strDecode

 instance ToField AConnectionRequestUri where toField = toField . Binary . strEncode

-instance FromField AConnectionRequestUri where fromField = blobFieldParser strP
+instance FromField AConnectionRequestUri where fromField = blobFieldDecoder strDecode

 instance ConnectionModeI c => ToField (ConnectionRequestUri c) where toField = toField . Binary . strEncode

-instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequestUri c) where fromField = blobFieldParser strP
+instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequestUri c) where fromField = blobFieldDecoder strDecode

 instance ToField ConnectionMode where toField = toField . decodeLatin1 . strEncode

@@ -1732,7 +1855,7 @@ instance FromField MsgFlags where fromField = fromTextField_ $ eitherToMaybe . s

 instance ToField [SMPQueueInfo] where toField = toField . Binary . smpEncodeList

-instance FromField [SMPQueueInfo] where fromField = blobFieldParser smpListP
+instance FromField [SMPQueueInfo] where fromField = blobFieldDecoder $ parseAll smpListP

 instance ToField (NonEmpty TransportHost) where toField = toField . decodeLatin1 . strEncode

@@ -1740,11 +1863,11 @@ instance FromField (NonEmpty TransportHost) where fromField = fromTextField_ $ e

 instance ToField AgentCommand where toField = toField . Binary . strEncode

-instance FromField AgentCommand where fromField = blobFieldParser strP
+instance FromField AgentCommand where fromField = blobFieldDecoder strDecode

 instance ToField AgentCommandTag where toField = toField . Binary . strEncode

-instance FromField AgentCommandTag where fromField = blobFieldParser strP
+instance FromField AgentCommandTag where fromField = blobFieldDecoder strDecode

 instance ToField MsgReceiptStatus where toField = toField . decodeLatin1 . strEncode

@@ -1762,23 +1885,10 @@ deriving newtype instance ToField ChunkReplicaId

 deriving newtype instance FromField ChunkReplicaId

-listToEither :: e -> [a] -> Either e a
-listToEither _ (x : _) = Right x
-listToEither e _ = Left e
-
-firstRow :: (a -> b) -> e -> IO [a] -> IO (Either e b)
-firstRow f e a = second f . listToEither e <$> a
-
-maybeFirstRow :: Functor f => (a -> b) -> f [a] -> f (Maybe b)
-maybeFirstRow f q = fmap f . listToMaybe <$> q
-
 fromOnlyBI :: Only BoolInt -> Bool
 fromOnlyBI (Only (BI b)) = b
 {-# INLINE fromOnlyBI #-}

-firstRow' :: (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
-firstRow' f e a = (f <=< listToEither e) <$> a
-
 #if !defined(dbPostgres)
 {- ORMOLU_DISABLE -}
 -- SQLite.Simple only has these up to 10 fields, which is insufficient for some of our queries
@@ -1854,10 +1964,24 @@ insertRcvQueue_ db connId' rq@RcvQueue {..} serverKeyHash_ = do
    db
    [sql|
      INSERT INTO rcv_queues
-        (host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, snd_secure, status, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
+        ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret,
+          snd_id, queue_mode, status, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash,
+          link_id, link_key, link_priv_sig_key, link_enc_fixed_data,
+          ntf_public_key, ntf_private_key, ntf_id, rcv_ntf_dh_secret
+        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
    |]
-    ((host server, port server, rcvId, connId', rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret) :. (sndId, BI sndSecure, status, qId, BI primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
-  pure (rq :: NewRcvQueue) {connId = connId', dbQueueId = qId}
+    ( (host server, port server, rcvId, connId', rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret)
+        :. (sndId, queueMode, status, qId, BI primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_)
+        :. (shortLinkId <$> shortLink, shortLinkKey <$> shortLink, linkPrivSigKey <$> shortLink, linkEncFixedData <$> shortLink)
+        :. ntfCredsFields
+    )
+  -- TODO [certs rcv] save client service
+  pure (rq :: NewRcvQueue) {connId = connId', dbQueueId = qId, clientService = Nothing}
+  where
+    ntfCredsFields = case clientNtfCreds of
+      Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret} ->
+        (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret)
+      Nothing -> (Nothing, Nothing, Nothing, Nothing)

 -- * createSndConn helpers

@@ -1871,14 +1995,14 @@ insertSndQueue_ db connId' sq@SndQueue {..} serverKeyHash_ = do
    db
    [sql|
      INSERT INTO snd_queues
-        (host, port, snd_id, snd_secure, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret,
+        (host, port, snd_id, queue_mode, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret,
         status, snd_queue_id, snd_primary, replace_snd_queue_id, smp_client_version, server_key_hash)
      VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
      ON CONFLICT (host, port, snd_id) DO UPDATE SET
        host=EXCLUDED.host,
        port=EXCLUDED.port,
        snd_id=EXCLUDED.snd_id,
-        snd_secure=EXCLUDED.snd_secure,
+        queue_mode=EXCLUDED.queue_mode,
        conn_id=EXCLUDED.conn_id,
        snd_public_key=EXCLUDED.snd_public_key,
        snd_private_key=EXCLUDED.snd_private_key,
@@ -1891,13 +2015,13 @@ insertSndQueue_ db connId' sq@SndQueue {..} serverKeyHash_ = do
        smp_client_version=EXCLUDED.smp_client_version,
        server_key_hash=EXCLUDED.server_key_hash
    |]
-    ((host server, port server, sndId, BI sndSecure, connId', sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret) 
+    ((host server, port server, sndId, queueMode, connId', sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret)
    :. (status, qId, BI primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
  pure (sq :: NewSndQueue) {connId = connId', dbQueueId = qId}

-newQueueId_ :: [Only Int64] -> DBQueueId 'QSStored
-newQueueId_ [] = DBQueueId 1
-newQueueId_ (Only maxId : _) = DBQueueId (maxId + 1)
+newQueueId_ :: [Only Int64] -> DBEntityId
+newQueueId_ [] = DBEntityId 1
+newQueueId_ (Only maxId : _) = DBEntityId (maxId + 1)

 -- * getConn helpers

@@ -2022,26 +2146,37 @@ rcvQueueQuery :: Query
 rcvQueueQuery =
  [sql|
    SELECT c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret,
-      q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.snd_secure, q.status,
+      q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.queue_mode, q.status,
      q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id, q.switch_status, q.smp_client_version, q.delete_errors,
-      q.ntf_public_key, q.ntf_private_key, q.ntf_id, q.rcv_ntf_dh_secret
+      q.ntf_public_key, q.ntf_private_key, q.ntf_id, q.rcv_ntf_dh_secret,
+      q.link_id, q.link_key, q.link_priv_sig_key, q.link_enc_fixed_data
    FROM rcv_queues q
    JOIN servers s ON q.host = s.host AND q.port = s.port
    JOIN connections c ON q.conn_id = c.conn_id
  |]

 toRcvQueue ::
-  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateAuthKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, BoolInt)
-    :. (QueueStatus, DBQueueId 'QSStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus, Maybe VersionSMPC, Int)
-    :. (Maybe SMP.NtfPublicAuthKey, Maybe SMP.NtfPrivateAuthKey, Maybe SMP.NotifierId, Maybe RcvNtfDhSecret) ->
+  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateAuthKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, Maybe QueueMode)
+    :. (QueueStatus, DBEntityId, BoolInt, Maybe Int64, Maybe RcvSwitchStatus, Maybe VersionSMPC, Int)
+    :. (Maybe SMP.NtfPublicAuthKey, Maybe SMP.NtfPrivateAuthKey, Maybe SMP.NotifierId, Maybe RcvNtfDhSecret)
+    :. (Maybe SMP.LinkId, Maybe LinkKey, Maybe C.PrivateKeyEd25519, Maybe EncDataBytes) ->
  RcvQueue
-toRcvQueue ((userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, BI sndSecure) :. (status, dbQueueId, BI primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion_, deleteErrors) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
+toRcvQueue
+  ( (userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, queueMode)
+      :. (status, dbQueueId, BI primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion_, deleteErrors)
+      :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)
+      :. (shortLinkId_, shortLinkKey_, linkPrivSigKey_, linkEncFixedData_)
+  ) =
  let server = SMPServer host port keyHash
      smpClientVersion = fromMaybe initialSMPClientVersion smpClientVersion_
      clientNtfCreds = case (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_) of
-        (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just $ ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
+        (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
        _ -> Nothing
-   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, sndSecure, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
+      shortLink = case (shortLinkId_, shortLinkKey_, linkPrivSigKey_, linkEncFixedData_) of
+        (Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData}
+        _ -> Nothing
+      -- TODO [certs rcv] read client service
+   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, queueMode, shortLink, clientService = Nothing, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}

 getRcvQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError RcvQueue)
 getRcvQueueById db connId dbRcvId =
@@ -2062,7 +2197,7 @@ sndQueueQuery :: Query
 sndQueueQuery =
  [sql|
    SELECT
-      c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id, q.snd_secure,
+      c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id, q.queue_mode,
      q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status,
      q.snd_queue_id, q.snd_primary, q.replace_snd_queue_id, q.switch_status, q.smp_client_version
    FROM snd_queues q
@@ -2071,18 +2206,18 @@ sndQueueQuery =
  |]

 toSndQueue ::
-  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId, BoolInt)
+  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId, Maybe QueueMode)
    :. (Maybe SndPublicAuthKey, SndPrivateAuthKey, Maybe C.PublicKeyX25519, C.DhSecretX25519, QueueStatus)
-    :. (DBQueueId 'QSStored, BoolInt, Maybe Int64, Maybe SndSwitchStatus, VersionSMPC) ->
+    :. (DBEntityId, BoolInt, Maybe Int64, Maybe SndSwitchStatus, VersionSMPC) ->
  SndQueue
 toSndQueue
-  ( (userId, keyHash, connId, host, port, sndId, BI sndSecure)
+  ( (userId, keyHash, connId, host, port, sndId, queueMode)
      :. (sndPubKey, sndPrivateKey@(C.APrivateAuthKey a pk), e2ePubKey, e2eDhSecret, status)
      :. (dbQueueId, BI primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion)
    ) =
    let server = SMPServer host port keyHash
        sndPublicKey = fromMaybe (C.APublicAuthKey a (C.publicKey pk)) sndPubKey
-     in SndQueue {userId, connId, server, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion}
+     in SndQueue {userId, connId, server, sndId, queueMode, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion}

 getSndQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError SndQueue)
 getSndQueueById db connId dbSndId =
@@ -2206,11 +2341,15 @@ insertSndMsgDetails_ dbConn connId SndMsgData {..} =
    dbConn
    [sql|
      INSERT INTO snd_messages
-        ( conn_id, internal_snd_id, internal_id, internal_hash, previous_msg_hash)
+        ( conn_id, internal_snd_id, internal_id, internal_hash, previous_msg_hash, msg_encrypt_key, padded_msg_len, snd_message_body_id)
      VALUES
-        (?,?,?,?,?)
+        (?,?,?,?,?,?,?,?)
    |]
-    (connId, internalSndId, internalId, Binary internalHash, Binary prevMsgHash)
+    (connId, internalSndId, internalId, Binary internalHash, Binary prevMsgHash, encryptKey_, paddedLen_, sndMsgBodyId_)
+  where
+    (encryptKey_, paddedLen_, sndMsgBodyId_) = case sndMsgPrepData_ of
+      Nothing -> (Nothing, Nothing, Nothing)
+      Just SndMsgPrepData {encryptKey, paddedLen, sndMsgBodyId} -> (Just encryptKey, Just paddedLen, Just sndMsgBodyId)

 updateSndMsgHash :: DB.Connection -> ConnId -> InternalSndId -> MsgHash -> IO ()
 updateSndMsgHash db connId internalSndId internalHash =
@@ -16,4 +16,3 @@ import Simplex.Messaging.Agent.Store.Postgres.DB
  where
 import Simplex.Messaging.Agent.Store.SQLite.DB
 #endif
-
@@ -0,0 +1,72 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Simplex.Messaging.Agent.Store.Entity where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Encoding as JE
+import Data.Int (Int64)
+import Data.Scientific (floatingOrInteger)
+import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
+
+data DBStored = DBStored | DBNew
+
+data SDBStored (s :: DBStored) where
+  SDBStored :: SDBStored 'DBStored
+  SDBNew :: SDBStored 'DBNew
+
+deriving instance Show (SDBStored s)
+
+class DBStoredI s where sdbStored :: SDBStored s
+
+instance DBStoredI 'DBStored where sdbStored = SDBStored
+
+instance DBStoredI 'DBNew where sdbStored = SDBNew
+
+data DBEntityId' (s :: DBStored) where
+  DBEntityId :: Int64 -> DBEntityId' 'DBStored
+  DBNewEntity :: DBEntityId' 'DBNew
+
+deriving instance Show (DBEntityId' s)
+
+deriving instance Eq (DBEntityId' s)
+
+type DBEntityId = DBEntityId' 'DBStored
+
+type DBNewEntity = DBEntityId' 'DBNew
+
+instance ToJSON (DBEntityId' s) where
+  toEncoding = \case
+    DBEntityId i -> toEncoding i
+    DBNewEntity -> JE.null_
+  toJSON = \case
+    DBEntityId i -> toJSON i
+    DBNewEntity -> J.Null
+
+instance DBStoredI s => FromJSON (DBEntityId' s) where
+  parseJSON v = case (v, sdbStored @s) of
+    (J.Null, SDBNew) -> pure DBNewEntity
+    (J.Number n, SDBStored) -> case floatingOrInteger n of
+      Left (_ :: Double) -> fail "bad DBEntityId"
+      Right i -> pure $ DBEntityId (fromInteger i)
+    _ -> fail "bad DBEntityId"
+  omittedField = case sdbStored @s of
+    SDBStored -> Nothing
+    SDBNew -> Just DBNewEntity
+
+instance FromField DBEntityId where
+#if defined(dbPostgres)
+  fromField x dat = DBEntityId <$> fromField x dat
+#else
+  fromField x = DBEntityId <$> fromField x
+#endif
+
+instance ToField DBEntityId where toField (DBEntityId i) = toField i
@@ -1,16 +1,11 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}

 module Simplex.Messaging.Agent.Store.Migrations
  ( Migration (..),
    MigrationsToRun (..),
    DownMigration (..),
-    Migrations.app,
-    Migrations.getCurrent,
-    get,
-    Migrations.initialize,
-    Migrations.run,
-    migrateSchema,
+    DBMigrate (..),
+    sharedMigrateSchema,
    -- for tests
    migrationsToRun,
    toDownMigration,
@@ -21,19 +16,9 @@ import Control.Monad
 import Data.Char (toLower)
 import Data.Functor (($>))
 import Data.Maybe (isNothing, mapMaybe)
-import Simplex.Messaging.Agent.Store.Common
 import Simplex.Messaging.Agent.Store.Shared
 import System.Exit (exitFailure)
 import System.IO (hFlush, stdout)
-#if defined(dbPostgres)
-import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
-#else
-import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
-import System.Directory (copyFile)
-#endif
-
-get :: DBStore -> [Migration] -> IO (Either MTRError MigrationsToRun)
-get st migrations = migrationsToRun migrations <$> withTransaction st Migrations.getCurrent

 migrationsToRun :: [Migration] -> [Migration] -> Either MTRError MigrationsToRun
 migrationsToRun [] [] = Right MTRNone
@@ -48,44 +33,42 @@ migrationsToRun (a : as) (d : ds)
  | name a == name d = migrationsToRun as ds
  | otherwise = Left $ MTREDifferent (name a) (name d)

-migrateSchema :: DBStore -> [Migration] -> MigrationConfirmation -> Bool -> IO (Either MigrationError ())
-migrateSchema st migrations confirmMigrations vacuum = do
-  Migrations.initialize st
-  get st migrations >>= \case
+data DBMigrate = DBMigrate
+  { initialize :: IO (),
+    getCurrent :: IO [Migration],
+    run :: MigrationsToRun -> IO (),
+    backup :: IO ()
+  }
+
+sharedMigrateSchema :: DBMigrate -> Bool -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError ())
+sharedMigrateSchema dbm dbNew' migrations confirmMigrations = do
+  initialize dbm
+  currentMs <- getCurrent dbm
+  case migrationsToRun migrations currentMs of
    Left e -> do
      when (confirmMigrations == MCConsole) $ confirmOrExit ("Database state error: " <> mtrErrorDescription e)
      pure . Left $ MigrationError e
    Right MTRNone -> pure $ Right ()
    Right ms@(MTRUp ums)
-      | dbNew st -> Migrations.run st vacuum ms $> Right ()
+      | dbNew' -> run dbm ms $> Right ()
      | otherwise -> case confirmMigrations of
-          MCYesUp -> runWithBackup st vacuum ms
-          MCYesUpDown -> runWithBackup st vacuum ms
-          MCConsole -> confirm err >> runWithBackup st vacuum ms
+          MCYesUp -> runWithBackup ms
+          MCYesUpDown -> runWithBackup ms
+          MCConsole -> confirm err >> runWithBackup ms
          MCError -> pure $ Left err
      where
        err = MEUpgrade $ map upMigration ums -- "The app has a newer version than the database.\nConfirm to back up and upgrade using these migrations: " <> intercalate ", " (map name ums)
    Right ms@(MTRDown dms) -> case confirmMigrations of
-      MCYesUpDown -> runWithBackup st vacuum ms
-      MCConsole -> confirm err >> runWithBackup st vacuum ms
+      MCYesUpDown -> runWithBackup ms
+      MCConsole -> confirm err >> runWithBackup ms
      MCYesUp -> pure $ Left err
      MCError -> pure $ Left err
      where
        err = MEDowngrade $ map downName dms
  where
+    runWithBackup ms = backup dbm >> run dbm ms $> Right ()
    confirm err = confirmOrExit $ migrationErrorDescription err

-runWithBackup :: DBStore -> Bool -> MigrationsToRun -> IO (Either a ())
-#if defined(dbPostgres)
-runWithBackup st vacuum ms = Migrations.run st vacuum ms $> Right ()
-#else
-runWithBackup st vacuum ms = do
-  let f = dbFilePath st
-  copyFile f (f <> ".bak")
-  Migrations.run st vacuum ms
-  pure $ Right ()
-#endif
-
 confirmOrExit :: String -> IO ()
 confirmOrExit s = do
  putStrLn s
@@ -0,0 +1,14 @@
+{-# LANGUAGE CPP #-}
+
+module Simplex.Messaging.Agent.Store.Migrations.App
+#if defined(dbPostgres)
+  ( module Simplex.Messaging.Agent.Store.Postgres.Migrations.App,
+  )
+  where
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.App
+#else
+  ( module Simplex.Messaging.Agent.Store.SQLite.Migrations.App,
+  )
+  where
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.App
+#endif
@@ -6,6 +6,8 @@

 module Simplex.Messaging.Agent.Store.Postgres
  ( DBOpts (..),
+    Migrations.getCurrentMigrations,
+    checkSchemaExists,
    createDBStore,
    closeDBStore,
    reopenDBStore,
@@ -13,95 +15,119 @@ module Simplex.Messaging.Agent.Store.Postgres
  )
 where

-import Control.Exception (throwIO)
-import Control.Monad (unless, void)
+import Control.Concurrent.STM
+import Control.Exception (finally, onException, throwIO, uninterruptibleMask_)
+import Control.Logger.Simple (logError)
+import Control.Monad
 import Data.ByteString (ByteString)
 import Data.Functor (($>))
-import Data.String (fromString)
 import Data.Text (Text)
 import Database.PostgreSQL.Simple (Only (..))
+import Database.PostgreSQL.Simple.Types (Query (..))
 import qualified Database.PostgreSQL.Simple as PSQL
 import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Simplex.Messaging.Agent.Store.Migrations (migrateSchema)
+import Simplex.Messaging.Agent.Store.Migrations (DBMigrate (..), sharedMigrateSchema)
+import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
 import Simplex.Messaging.Agent.Store.Postgres.Common
 import qualified Simplex.Messaging.Agent.Store.Postgres.DB as DB
 import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationError (..))
-import Simplex.Messaging.Util (ifM)
-import UnliftIO.Exception (bracketOnError, onException)
-import UnliftIO.MVar
-import UnliftIO.STM
-
-data DBOpts = DBOpts
-  { connstr :: ByteString,
-    schema :: String
-  }
+import Simplex.Messaging.Util (ifM, safeDecodeUtf8)
+import System.Exit (exitFailure)

 -- | Create a new Postgres DBStore with the given connection string, schema name and migrations.
 -- If passed schema does not exist in connectInfo database, it will be created.
 -- Applies necessary migrations to schema.
-- TODO [postgres] authentication / user password, db encryption (?)
 createDBStore :: DBOpts -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
-createDBStore DBOpts {connstr, schema} migrations confirmMigrations = do
-  st <- connectPostgresStore connstr schema
-  r <- migrateSchema st migrations confirmMigrations True `onException` closeDBStore st
+createDBStore opts migrations confirmMigrations = do
+  st <- connectPostgresStore opts
+  r <- migrateSchema st `onException` closeDBStore st
  case r of
    Right () -> pure $ Right st
    Left e -> closeDBStore st $> Left e
+  where
+    migrateSchema st =
+      let initialize = Migrations.initialize st
+          getCurrent = withTransaction st Migrations.getCurrentMigrations
+          dbm = DBMigrate {initialize, getCurrent, run = Migrations.run st, backup = pure ()}
+       in sharedMigrateSchema dbm (dbNew st) migrations confirmMigrations

-connectPostgresStore :: ByteString -> String -> IO DBStore
-connectPostgresStore dbConnstr dbSchema = do
-  (dbConn, dbNew) <- connectDB dbConnstr dbSchema -- TODO [postgres] analogue for dbBusyLoop?
-  dbConnection <- newMVar dbConn
-  dbClosed <- newTVarIO False
-  pure DBStore {dbConnstr, dbSchema, dbConnection, dbNew, dbClosed}
+connectPostgresStore :: DBOpts -> IO DBStore
+connectPostgresStore DBOpts {connstr, schema, poolSize, createSchema} = do
+  dbPriorityPool <- newDBStorePool poolSize
+  dbPool <- newDBStorePool poolSize
+  dbClosed <- newTVarIO True
+  let st = DBStore {dbConnstr = connstr, dbSchema = schema, dbPoolSize = fromIntegral poolSize, dbPriorityPool, dbPool, dbNew = False, dbClosed}
+  dbNew <- connectStore st createSchema
+  pure st {dbNew}

-connectDB :: ByteString -> String -> IO (DB.Connection, Bool)
-connectDB connstr schema = do
+-- uninterruptibleMask_ here and below is used here so that it is not interrupted half-way,
+-- it relies on the assumption that when dbClosed = True, the queue is empty,
+-- and when it is False, the queue is full (or will have connections returned to it by the threads that use them).
+connectStore :: DBStore -> Bool -> IO Bool
+connectStore DBStore {dbConnstr, dbSchema, dbPoolSize, dbPriorityPool, dbPool, dbClosed} createSchema = uninterruptibleMask_ $ do
+  (conn, dbNew) <- connectDB dbConnstr dbSchema createSchema -- TODO [postgres] analogue for dbBusyLoop?
+  writeConns dbPriorityPool . (conn :) =<< mkConns (dbPoolSize - 1)
+  writeConns dbPool =<< mkConns dbPoolSize
+  atomically $ writeTVar dbClosed False
+  pure dbNew
+  where
+    writeConns pool conns = mapM_ (atomically . writeTBQueue (dbPoolConns pool)) conns
+    mkConns n = replicateM n $ fst <$> connectDB dbConnstr dbSchema False
+
+connectDB :: ByteString -> ByteString -> Bool -> IO (DB.Connection, Bool)
+connectDB connstr schema createSchema = do
  db <- PSQL.connectPostgreSQL connstr
-  schemaExists <- prepare db `onException` PSQL.close db
-  let dbNew = not schemaExists
+  dbNew <- prepare db `onException` PSQL.close db
  pure (db, dbNew)
  where
    prepare db = do
      void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
-      [Only schemaExists] <-
-        PSQL.query
-          db
-          [sql|
-            SELECT EXISTS (
-              SELECT 1 FROM pg_catalog.pg_namespace
-              WHERE nspname = ?
-            )
-          |]
-          (Only schema)
-      unless schemaExists $ void $ PSQL.execute_ db (fromString $ "CREATE SCHEMA " <> schema)
-      void $ PSQL.execute_ db (fromString $ "SET search_path TO " <> schema)
-      pure schemaExists
+      dbNew <- not <$> doesSchemaExist db schema
+      when dbNew $
+        if createSchema
+          then void $ PSQL.execute_ db $ Query $ "CREATE SCHEMA " <> schema
+          else do
+            logError $ "connectPostgresStore, schema " <> safeDecodeUtf8 schema <> " does not exist, exiting."
+            PSQL.close db
+            exitFailure
+      void $ PSQL.execute_ db $ Query $ "SET search_path TO " <> schema
+      pure dbNew
+
+checkSchemaExists :: ByteString -> ByteString -> IO Bool
+checkSchemaExists connstr schema = do
+  db <- PSQL.connectPostgreSQL connstr
+  doesSchemaExist db schema `finally` DB.close db
+
+doesSchemaExist :: DB.Connection -> ByteString -> IO Bool
+doesSchemaExist db schema = do
+  [Only schemaExists] <-
+    PSQL.query
+      db
+      [sql|
+        SELECT EXISTS (
+          SELECT 1 FROM pg_catalog.pg_namespace
+          WHERE nspname = ?
+        )
+      |]
+      (Only schema)
+  pure schemaExists

-- can share with SQLite
 closeDBStore :: DBStore -> IO ()
-closeDBStore st@DBStore {dbClosed} =
-  ifM (readTVarIO dbClosed) (putStrLn "closeDBStore: already closed") $
-    withConnection st $ \conn -> do
-      DB.close conn
-      atomically $ writeTVar dbClosed True
-
-openPostgresStore_ :: DBStore -> IO ()
-openPostgresStore_ DBStore {dbConnstr, dbSchema, dbConnection, dbClosed} =
-  bracketOnError
-    (takeMVar dbConnection)
-    (tryPutMVar dbConnection)
-    $ \_dbConn -> do
-      (dbConn, _dbNew) <- connectDB dbConnstr dbSchema
-      atomically $ writeTVar dbClosed False
-      putMVar dbConnection dbConn
+closeDBStore DBStore {dbPoolSize, dbPriorityPool, dbPool, dbClosed} =
+  ifM (readTVarIO dbClosed) (putStrLn "closeDBStore: already closed") $ uninterruptibleMask_ $ do
+    closePool dbPriorityPool
+    closePool dbPool
+    atomically $ writeTVar dbClosed True
+  where
+    closePool pool = replicateM_ dbPoolSize $ atomically (readTBQueue $ dbPoolConns pool) >>= DB.close

 reopenDBStore :: DBStore -> IO ()
-reopenDBStore st@DBStore {dbClosed} =
-  ifM (readTVarIO dbClosed) open (putStrLn "reopenDBStore: already opened")
-  where
-    open = openPostgresStore_ st
+reopenDBStore st =
+  ifM
+    (readTVarIO $ dbClosed st)
+    (void $ connectStore st False)
+    (putStrLn "reopenDBStore: already opened")

-- TODO [postgres] not necessary for postgres (used for ExecAgentStoreSQL, ExecChatStoreSQL)
+-- not used with postgres client (used for ExecAgentStoreSQL, ExecChatStoreSQL)
 execSQL :: PSQL.Connection -> Text -> IO [Text]
 execSQL _db _query = throwIO (userError "not implemented")
@@ -1,7 +1,14 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TupleSections #-}

 module Simplex.Messaging.Agent.Store.Postgres.Common
  ( DBStore (..),
+    DBStorePool (..),
+    DBOpts (..),
+    newDBStorePool,
    withConnection,
    withConnection',
    withTransaction,
@@ -10,33 +17,65 @@ module Simplex.Messaging.Agent.Store.Postgres.Common
  )
 where

+import Control.Concurrent.MVar
+import Control.Concurrent.STM
+import Control.Exception (bracket)
 import Data.ByteString (ByteString)
 import qualified Database.PostgreSQL.Simple as PSQL
-import UnliftIO.MVar
-import UnliftIO.STM
+import Numeric.Natural (Natural)
+import Simplex.Messaging.Agent.Store.Postgres.Options

 -- TODO [postgres] use log_min_duration_statement instead of custom slow queries (SQLite's Connection type)
 data DBStore = DBStore
  { dbConnstr :: ByteString,
-    dbSchema :: String,
-    dbConnection :: MVar PSQL.Connection,
+    dbSchema :: ByteString,
+    dbPoolSize :: Int,
+    dbPriorityPool :: DBStorePool,
+    dbPool :: DBStorePool,
+    -- dbPoolSize :: Int,
+    -- dbPool :: TBQueue PSQL.Connection,
+    -- -- MVar is needed for fair pool distribution, without STM retry contention.
+    -- -- Only one thread can be blocked on STM read.
+    -- dbSem :: MVar (),
    dbClosed :: TVar Bool,
    dbNew :: Bool
  }

-- TODO [postgres] connection pool
+newDBStorePool :: Natural -> IO DBStorePool
+newDBStorePool poolSize = do
+  dbSem <- newMVar ()
+  dbPoolConns <- newTBQueueIO poolSize
+  pure DBStorePool {dbSem, dbPoolConns}
+
+data DBStorePool = DBStorePool
+  { dbPoolConns :: TBQueue PSQL.Connection,
+    -- MVar is needed for fair pool distribution, without STM retry contention.
+    -- Only one thread can be blocked on STM read.
+    dbSem :: MVar ()
+  }
+
 withConnectionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
-withConnectionPriority DBStore {dbConnection} _priority action =
-  withMVar dbConnection action
+withConnectionPriority DBStore {dbPriorityPool, dbPool} priority =
+  withConnectionPool $ if priority then dbPriorityPool else dbPool
+{-# INLINE withConnectionPriority #-}
+
+withConnectionPool :: DBStorePool -> (PSQL.Connection -> IO a) -> IO a
+withConnectionPool DBStorePool {dbPoolConns, dbSem} =
+  bracket
+    (withMVar dbSem $ \_ -> atomically $ readTBQueue dbPoolConns)
+    (atomically . writeTBQueue dbPoolConns)

 withConnection :: DBStore -> (PSQL.Connection -> IO a) -> IO a
 withConnection st = withConnectionPriority st False
+{-# INLINE withConnection #-}

 withConnection' :: DBStore -> (PSQL.Connection -> IO a) -> IO a
 withConnection' = withConnection
+{-# INLINE withConnection' #-}

 withTransaction' :: DBStore -> (PSQL.Connection -> IO a) -> IO a
 withTransaction' = withTransaction
+{-# INLINE withTransaction' #-}

 withTransaction :: DBStore -> (PSQL.Connection -> IO a) -> IO a
 withTransaction st = withTransactionPriority st False
@@ -13,16 +13,23 @@ module Simplex.Messaging.Agent.Store.Postgres.DB
    executeMany,
    PSQL.query,
    PSQL.query_,
+    blobFieldDecoder,
+    fromTextField_,
  )
 where

 import Control.Monad (void)
-import Data.Int (Int32, Int64)
+import Data.ByteString.Char8 (ByteString)
+import Data.Int (Int64)
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8)
+import Data.Typeable (Typeable)
 import Data.Word (Word16, Word32)
 import Database.PostgreSQL.Simple (ResultError (..))
 import qualified Database.PostgreSQL.Simple as PSQL
-import Database.PostgreSQL.Simple.FromField (FromField (..), returnError)
+import Database.PostgreSQL.Simple.FromField (Field (..), FieldParser, FromField (..), returnError)
 import Database.PostgreSQL.Simple.ToField (ToField (..))
+import Database.PostgreSQL.Simple.TypeInfo.Static (textOid, varcharOid)

 newtype BoolInt = BI {unBI :: Bool}

@@ -63,3 +70,20 @@ instance FromField Word16 where
    if i >= 0 && i <= fromIntegral (maxBound :: Word16)
      then pure (fromIntegral i :: Word16)
      else returnError ConversionFailed field "Negative value can't be converted to Word16"
+
+blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> FieldParser k
+blobFieldDecoder dec f val = do
+  x <- fromField f val
+  case dec x of
+    Right k -> pure k
+    Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
+
+fromTextField_ :: Typeable a => (Text -> Maybe a) -> FieldParser a
+fromTextField_ fromText f val =
+  if typeOid f `elem` [textOid, varcharOid]
+    then case val of
+      Just t -> case fromText $ decodeUtf8 t of
+        Just x -> pure x
+        _ -> returnError ConversionFailed f "invalid text value"
+      Nothing -> returnError UnexpectedNull f "NULL value found for non-NULL field"
+    else returnError Incompatible f "expecting TEXT or VARCHAR column type"
@@ -5,16 +5,15 @@
 {-# LANGUAGE TupleSections #-}

 module Simplex.Messaging.Agent.Store.Postgres.Migrations
-  ( app,
-    initialize,
+  ( initialize,
    run,
-    getCurrent,
+    getCurrentMigrations,
  )
 where

+import Control.Exception (throwIO)
 import Control.Monad (void)
-import Data.List (sortOn)
-import Data.Text (Text)
+import qualified Data.ByteString.Char8 as B
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import Data.Time.Clock (getCurrentTime)
@@ -24,21 +23,10 @@ import qualified Database.PostgreSQL.Simple as PSQL
 import Database.PostgreSQL.Simple.Internal (Connection (..))
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Simplex.Messaging.Agent.Store.Postgres.Common
-import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
 import Simplex.Messaging.Agent.Store.Shared
+import Simplex.Messaging.Util (($>>=))
 import UnliftIO.MVar

-schemaMigrations :: [(String, Text, Maybe Text)]
-schemaMigrations =
-  [ ("20241210_initial", m20241210_initial, Nothing)
-  ]
-
-- | The list of migrations in ascending order by date
-app :: [Migration]
-app = sortOn name $ map migration schemaMigrations
-  where
-    migration (name, up, down) = Migration {name, up, down = down}
-
 initialize :: DBStore -> IO ()
 initialize st = withTransaction' st $ \db ->
  void $
@@ -53,8 +41,8 @@ initialize st = withTransaction' st $ \db ->
      )
    |]

-run :: DBStore -> Bool -> MigrationsToRun -> IO ()
-run st _vacuum = \case
+run :: DBStore -> MigrationsToRun -> IO ()
+run st = \case
  MTRUp [] -> pure ()
  MTRUp ms -> mapM_ runUp ms
  MTRDown ms -> mapM_ runDown $ reverse ms
@@ -70,9 +58,11 @@ run st _vacuum = \case
      void $ PSQL.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
    execSQL db query =
      withMVar (connectionHandle db) $ \pqConn ->
-        void $ LibPQ.exec pqConn (TE.encodeUtf8 query)
+        LibPQ.exec pqConn (TE.encodeUtf8 query) $>>= LibPQ.resultErrorMessage >>= \case
+          Just e | not (B.null e) -> throwIO $ userError $ B.unpack e
+          _ -> pure ()

-getCurrent :: PSQL.Connection -> IO [Migration]
-getCurrent db = map toMigration <$> PSQL.query_ db "SELECT name, down FROM migrations ORDER BY name ASC;"
+getCurrentMigrations :: PSQL.Connection -> IO [Migration]
+getCurrentMigrations db = map toMigration <$> PSQL.query_ db "SELECT name, down FROM migrations ORDER BY name ASC;"
  where
    toMigration (name, down) = Migration {name, up = T.pack "", down}
@@ -0,0 +1,25 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.App (appMigrations) where
+
+import Data.List (sortOn)
+import Data.Text (Text)
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete
+import Simplex.Messaging.Agent.Store.Shared (Migration (..))
+
+schemaMigrations :: [(String, Text, Maybe Text)]
+schemaMigrations =
+  [ ("20241210_initial", m20241210_initial, Nothing),
+    ("20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies),
+    ("20250322_short_links", m20250322_short_links, Just down_m20250322_short_links),
+    ("20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete)
+  ]
+
+-- | The list of migrations in ascending order by date
+appMigrations :: [Migration]
+appMigrations = sortOn name $ map migration schemaMigrations
+  where
+    migration (name, up, down) = Migration {name, up, down = down}
@@ -0,0 +1,37 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.RawString.QQ (r)
+
+m20250203_msg_bodies :: Text
+m20250203_msg_bodies =
+  T.pack
+    [r|
+ALTER TABLE snd_messages ADD COLUMN msg_encrypt_key BYTEA;
+ALTER TABLE snd_messages ADD COLUMN padded_msg_len BIGINT;
+
+
+CREATE TABLE snd_message_bodies (
+  snd_message_body_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  agent_msg BYTEA NOT NULL DEFAULT ''::BYTEA
+);
+ALTER TABLE snd_messages ADD COLUMN snd_message_body_id BIGINT REFERENCES snd_message_bodies ON DELETE SET NULL;
+CREATE INDEX idx_snd_messages_snd_message_body_id ON snd_messages(snd_message_body_id);
+|]
+
+
+down_m20250203_msg_bodies :: Text
+down_m20250203_msg_bodies =
+  T.pack
+    [r|
+DROP INDEX idx_snd_messages_snd_message_body_id;
+ALTER TABLE snd_messages DROP COLUMN snd_message_body_id;
+DROP TABLE snd_message_bodies;
+
+
+ALTER TABLE snd_messages DROP COLUMN msg_encrypt_key;
+ALTER TABLE snd_messages DROP COLUMN padded_msg_len;
+|]
@@ -0,0 +1,63 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.RawString.QQ (r)
+
+m20250322_short_links :: Text
+m20250322_short_links =
+  T.pack    
+    [r|
+ALTER TABLE rcv_queues ADD COLUMN link_id BYTEA;
+ALTER TABLE rcv_queues ADD COLUMN link_key BYTEA;
+ALTER TABLE rcv_queues ADD COLUMN link_priv_sig_key BYTEA;
+ALTER TABLE rcv_queues ADD COLUMN link_enc_fixed_data BYTEA;
+
+CREATE UNIQUE INDEX idx_rcv_queues_link_id ON rcv_queues(host, port, link_id);
+
+ALTER TABLE rcv_queues ADD COLUMN queue_mode TEXT;
+UPDATE rcv_queues SET queue_mode = 'M' WHERE snd_secure = 1;
+ALTER TABLE rcv_queues DROP COLUMN snd_secure;
+
+ALTER TABLE snd_queues ADD COLUMN queue_mode TEXT;
+UPDATE snd_queues SET queue_mode = 'M' WHERE snd_secure = 1;
+ALTER TABLE snd_queues DROP COLUMN snd_secure;
+
+CREATE TABLE inv_short_links(
+  inv_short_link_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  server_key_hash BYTEA,
+  link_id BYTEA NOT NULL,
+  link_key BYTEA NOT NULL,
+  snd_private_key BYTEA NOT NULL,
+  snd_id BYTEA,
+  FOREIGN KEY(host, port) REFERENCES servers ON DELETE RESTRICT ON UPDATE CASCADE
+);
+
+CREATE UNIQUE INDEX idx_inv_short_links_link_id ON inv_short_links(host, port, link_id);
+|]
+
+down_m20250322_short_links :: Text
+down_m20250322_short_links =
+  T.pack
+    [r|
+DROP INDEX idx_rcv_queues_link_id;
+ALTER TABLE rcv_queues DROP COLUMN link_id;
+ALTER TABLE rcv_queues DROP COLUMN link_key;
+ALTER TABLE rcv_queues DROP COLUMN link_priv_sig_key;
+ALTER TABLE rcv_queues DROP COLUMN link_enc_fixed_data;
+
+DROP INDEX idx_inv_short_links_link_id;
+DROP TABLE inv_short_links;
+
+ALTER TABLE rcv_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
+UPDATE rcv_queues SET snd_secure = 1 WHERE queue_mode = 'M';
+ALTER TABLE rcv_queues DROP COLUMN queue_mode;
+
+ALTER TABLE snd_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
+UPDATE snd_queues SET snd_secure = 1 WHERE queue_mode = 'M';
+ALTER TABLE snd_queues DROP COLUMN queue_mode;
+|]
@@ -0,0 +1,37 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.RawString.QQ (r)
+
+m20250702_conn_invitations_remove_cascade_delete :: Text
+m20250702_conn_invitations_remove_cascade_delete =
+  T.pack
+    [r|
+ALTER TABLE conn_invitations DROP CONSTRAINT conn_invitations_contact_conn_id_fkey;
+
+ALTER TABLE conn_invitations ALTER COLUMN contact_conn_id DROP NOT NULL;
+
+ALTER TABLE conn_invitations
+  ADD CONSTRAINT conn_invitations_contact_conn_id_fkey
+  FOREIGN KEY (contact_conn_id)
+  REFERENCES connections(conn_id)
+  ON DELETE SET NULL;
+|]
+
+down_m20250702_conn_invitations_remove_cascade_delete :: Text
+down_m20250702_conn_invitations_remove_cascade_delete =
+  T.pack
+    [r|
+ALTER TABLE conn_invitations DROP CONSTRAINT conn_invitations_contact_conn_id_fkey;
+
+ALTER TABLE conn_invitations ALTER COLUMN contact_conn_id SET NOT NULL;
+
+ALTER TABLE conn_invitations
+  ADD CONSTRAINT conn_invitations_contact_conn_id_fkey
+  FOREIGN KEY (contact_conn_id)
+  REFERENCES connections(conn_id)
+  ON DELETE CASCADE;
+|]
@@ -0,0 +1,12 @@
+module Simplex.Messaging.Agent.Store.Postgres.Options where
+
+import Data.ByteString (ByteString)
+import Numeric.Natural
+
+data DBOpts = DBOpts
+  { connstr :: ByteString,
+    schema :: ByteString,
+    poolSize :: Natural,
+    createSchema :: Bool
+  }
+  deriving (Show)
@@ -26,6 +26,7 @@

 module Simplex.Messaging.Agent.Store.SQLite
  ( DBOpts (..),
+    Migrations.getCurrentMigrations,
    createDBStore,
    closeDBStore,
    reopenDBStore,
@@ -52,12 +53,13 @@ import Database.SQLite.Simple (Query (..))
 import qualified Database.SQLite.Simple as SQL
 import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
-import Simplex.Messaging.Agent.Store.Migrations (migrateSchema)
+import Simplex.Messaging.Agent.Store.Migrations (DBMigrate (..), sharedMigrateSchema)
+import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Agent.Store.SQLite.Common
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationError (..))
 import Simplex.Messaging.Util (ifM, safeDecodeUtf8)
-import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
 import System.FilePath (takeDirectory)
 import UnliftIO.Exception (bracketOnError, onException)
 import UnliftIO.MVar
@@ -65,23 +67,23 @@ import UnliftIO.STM

 -- * SQLite Store implementation

-data DBOpts = DBOpts
-  { dbFilePath :: FilePath,
-    dbKey :: ScrubbedBytes,
-    keepKey :: Bool,
-    vacuum :: Bool,
-    track :: DB.TrackQueries
-  }
-
 createDBStore :: DBOpts -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
 createDBStore DBOpts {dbFilePath, dbKey, keepKey, track, vacuum} migrations confirmMigrations = do
  let dbDir = takeDirectory dbFilePath
  createDirectoryIfMissing True dbDir
  st <- connectSQLiteStore dbFilePath dbKey keepKey track
-  r <- migrateSchema st migrations confirmMigrations vacuum `onException` closeDBStore st
+  r <- migrateSchema st `onException` closeDBStore st
  case r of
    Right () -> pure $ Right st
    Left e -> closeDBStore st $> Left e
+  where
+    migrateSchema st =
+      let initialize = Migrations.initialize st
+          getCurrent = withTransaction st Migrations.getCurrentMigrations
+          run = Migrations.run st vacuum
+          backup = copyFile dbFilePath (dbFilePath <> ".bak")
+          dbm = DBMigrate {initialize, getCurrent, run, backup}
+       in sharedMigrateSchema dbm (dbNew st) migrations confirmMigrations

 connectSQLiteStore :: FilePath -> ScrubbedBytes -> Bool -> DB.TrackQueries -> IO DBStore
 connectSQLiteStore dbFilePath key keepKey track = do
@@ -5,6 +5,7 @@

 module Simplex.Messaging.Agent.Store.SQLite.Common
  ( DBStore (..),
+    DBOpts (..),
    withConnection,
    withConnection',
    withTransaction,
@@ -39,6 +40,14 @@ data DBStore = DBStore
    dbNew :: Bool
  }

+data DBOpts = DBOpts
+  { dbFilePath :: FilePath,
+    dbKey :: ScrubbedBytes,
+    keepKey :: Bool,
+    vacuum :: Bool,
+    track :: DB.TrackQueries
+  }
+
 withConnectionPriority :: DBStore -> Bool -> (DB.Connection -> IO a) -> IO a
 withConnectionPriority DBStore {dbSem, dbConnection} priority action
  | priority = E.bracket_ signal release $ withMVar dbConnection action
@@ -21,6 +21,8 @@ module Simplex.Messaging.Agent.Store.SQLite.DB
    executeMany,
    query,
    query_,
+    blobFieldDecoder,
+    fromTextField_,
  )
 where

@@ -33,10 +35,14 @@ import Data.Int (Int64)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time (diffUTCTime, getCurrentTime)
-import Database.SQLite.Simple (FromRow, Query, ToRow)
+import Data.Typeable (Typeable)
+import Database.SQLite.Simple (FromRow, ResultError (..), Query, SQLData (..), ToRow)
 import qualified Database.SQLite.Simple as SQL
-import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.FromField (FieldParser, FromField (..), returnError)
+import Database.SQLite.Simple.Internal (Field (..))
+import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.TMap (TMap)
@@ -129,4 +135,20 @@ query_ :: FromRow r => Connection -> Query -> IO [r]
 query_ c sql = timeIt c sql $ SQL.query_ (conn c) sql
 {-# INLINE query_ #-}

+blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> FieldParser k
+blobFieldDecoder dec = \case
+  f@(Field (SQLBlob b) _) ->
+    case dec b of
+      Right k -> Ok k
+      Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
+  f -> returnError ConversionFailed f "expecting SQLBlob column type"
+
+fromTextField_ :: Typeable a => (Text -> Maybe a) -> Field -> Ok a
+fromTextField_ fromText = \case
+  f@(Field (SQLText t) _) ->
+    case fromText t of
+      Just x -> Ok x
+      _ -> returnError ConversionFailed f ("invalid text: " <> T.unpack t)
+  f -> returnError ConversionFailed f "expecting SQLText column type"
+
 $(J.deriveJSON defaultJSON ''SlowQueryStats)
@@ -8,15 +8,13 @@
 {-# LANGUAGE TupleSections #-}

 module Simplex.Messaging.Agent.Store.SQLite.Migrations
-  ( app,
-    initialize,
+  ( initialize,
    run,
-    getCurrent,
+    getCurrentMigrations,
  )
 where

 import Control.Monad (forM_, when)
-import Data.List (sortOn)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
@@ -29,96 +27,13 @@ import qualified Database.SQLite3 as SQLite3
 import Simplex.Messaging.Agent.Protocol (extraSMPServerHosts)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.SQLite.Common
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
 import Simplex.Messaging.Agent.Store.Shared
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Transport.Client (TransportHost)

-schemaMigrations :: [(String, Query, Maybe Query)]
-schemaMigrations =
-  [ ("20220101_initial", m20220101_initial, Nothing),
-    ("20220301_snd_queue_keys", m20220301_snd_queue_keys, Nothing),
-    ("20220322_notifications", m20220322_notifications, Nothing),
-    ("20220607_v2", m20220608_v2, Nothing),
-    ("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode, Nothing),
-    ("m20220811_onion_hosts", m20220811_onion_hosts, Nothing),
-    ("m20220817_connection_ntfs", m20220817_connection_ntfs, Nothing),
-    ("m20220905_commands", m20220905_commands, Nothing),
-    ("m20220915_connection_queues", m20220915_connection_queues, Nothing),
-    ("m20230110_users", m20230110_users, Nothing),
-    ("m20230117_fkey_indexes", m20230117_fkey_indexes, Nothing),
-    ("m20230120_delete_errors", m20230120_delete_errors, Nothing),
-    ("m20230217_server_key_hash", m20230217_server_key_hash, Nothing),
-    ("m20230223_files", m20230223_files, Just down_m20230223_files),
-    ("m20230320_retry_state", m20230320_retry_state, Just down_m20230320_retry_state),
-    ("m20230401_snd_files", m20230401_snd_files, Just down_m20230401_snd_files),
-    ("m20230510_files_pending_replicas_indexes", m20230510_files_pending_replicas_indexes, Just down_m20230510_files_pending_replicas_indexes),
-    ("m20230516_encrypted_rcv_message_hashes", m20230516_encrypted_rcv_message_hashes, Just down_m20230516_encrypted_rcv_message_hashes),
-    ("m20230531_switch_status", m20230531_switch_status, Just down_m20230531_switch_status),
-    ("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync),
-    ("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
-    ("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
-    ("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
-    ("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
-    ("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files),
-    ("m20231222_command_created_at", m20231222_command_created_at, Just down_m20231222_command_created_at),
-    ("m20231225_failed_work_items", m20231225_failed_work_items, Just down_m20231225_failed_work_items),
-    ("m20240121_message_delivery_indexes", m20240121_message_delivery_indexes, Just down_m20240121_message_delivery_indexes),
-    ("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
-    ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
-    ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
-    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
-    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
-    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats),
-    ("m20240930_ntf_tokens_to_delete", m20240930_ntf_tokens_to_delete, Just down_m20240930_ntf_tokens_to_delete),
-    ("m20241007_rcv_queues_last_broker_ts", m20241007_rcv_queues_last_broker_ts, Just down_m20241007_rcv_queues_last_broker_ts),
-    ("m20241224_ratchet_e2e_snd_params", m20241224_ratchet_e2e_snd_params, Just down_m20241224_ratchet_e2e_snd_params)
-  ]
-
-- | The list of migrations in ascending order by date
-app :: [Migration]
-app = sortOn name $ map migration schemaMigrations
-  where
-    migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}
-
-getCurrent :: DB.Connection -> IO [Migration]
-getCurrent DB.Connection {DB.conn} = map toMigration <$> SQL.query_ conn "SELECT name, down FROM migrations ORDER BY name ASC;"
+getCurrentMigrations :: DB.Connection -> IO [Migration]
+getCurrentMigrations DB.Connection {DB.conn} = map toMigration <$> SQL.query_ conn "SELECT name, down FROM migrations ORDER BY name ASC;"
  where
    toMigration (name, down) = Migration {name, up = "", down}

@@ -0,0 +1,97 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.App (appMigrations) where
+
+import Data.List (sortOn)
+import Database.SQLite.Simple (Query (..))
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
+import Simplex.Messaging.Agent.Store.Shared (Migration (..))
+
+schemaMigrations :: [(String, Query, Maybe Query)]
+schemaMigrations =
+  [ ("20220101_initial", m20220101_initial, Nothing),
+    ("20220301_snd_queue_keys", m20220301_snd_queue_keys, Nothing),
+    ("20220322_notifications", m20220322_notifications, Nothing),
+    ("20220607_v2", m20220608_v2, Nothing),
+    ("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode, Nothing),
+    ("m20220811_onion_hosts", m20220811_onion_hosts, Nothing),
+    ("m20220817_connection_ntfs", m20220817_connection_ntfs, Nothing),
+    ("m20220905_commands", m20220905_commands, Nothing),
+    ("m20220915_connection_queues", m20220915_connection_queues, Nothing),
+    ("m20230110_users", m20230110_users, Nothing),
+    ("m20230117_fkey_indexes", m20230117_fkey_indexes, Nothing),
+    ("m20230120_delete_errors", m20230120_delete_errors, Nothing),
+    ("m20230217_server_key_hash", m20230217_server_key_hash, Nothing),
+    ("m20230223_files", m20230223_files, Just down_m20230223_files),
+    ("m20230320_retry_state", m20230320_retry_state, Just down_m20230320_retry_state),
+    ("m20230401_snd_files", m20230401_snd_files, Just down_m20230401_snd_files),
+    ("m20230510_files_pending_replicas_indexes", m20230510_files_pending_replicas_indexes, Just down_m20230510_files_pending_replicas_indexes),
+    ("m20230516_encrypted_rcv_message_hashes", m20230516_encrypted_rcv_message_hashes, Just down_m20230516_encrypted_rcv_message_hashes),
+    ("m20230531_switch_status", m20230531_switch_status, Just down_m20230531_switch_status),
+    ("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync),
+    ("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
+    ("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
+    ("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
+    ("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
+    ("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files),
+    ("m20231222_command_created_at", m20231222_command_created_at, Just down_m20231222_command_created_at),
+    ("m20231225_failed_work_items", m20231225_failed_work_items, Just down_m20231225_failed_work_items),
+    ("m20240121_message_delivery_indexes", m20240121_message_delivery_indexes, Just down_m20240121_message_delivery_indexes),
+    ("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
+    ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
+    ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
+    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
+    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
+    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats),
+    ("m20240930_ntf_tokens_to_delete", m20240930_ntf_tokens_to_delete, Just down_m20240930_ntf_tokens_to_delete),
+    ("m20241007_rcv_queues_last_broker_ts", m20241007_rcv_queues_last_broker_ts, Just down_m20241007_rcv_queues_last_broker_ts),
+    ("m20241224_ratchet_e2e_snd_params", m20241224_ratchet_e2e_snd_params, Just down_m20241224_ratchet_e2e_snd_params),
+    ("m20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies),
+    ("m20250322_short_links", m20250322_short_links, Just down_m20250322_short_links),
+    ("m20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete)
+  ]
+
+-- | The list of migrations in ascending order by date
+appMigrations :: [Migration]
+appMigrations = sortOn name $ map migration schemaMigrations
+  where
+    migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}
@@ -0,0 +1,33 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20250203_msg_bodies :: Query
+m20250203_msg_bodies =
+    [sql|
+ALTER TABLE snd_messages ADD COLUMN msg_encrypt_key BLOB;
+ALTER TABLE snd_messages ADD COLUMN padded_msg_len INTEGER;
+
+
+CREATE TABLE snd_message_bodies (
+  snd_message_body_id INTEGER PRIMARY KEY,
+  agent_msg BLOB NOT NULL DEFAULT x''
+);
+ALTER TABLE snd_messages ADD COLUMN snd_message_body_id INTEGER REFERENCES snd_message_bodies ON DELETE SET NULL;
+CREATE INDEX idx_snd_messages_snd_message_body_id ON snd_messages(snd_message_body_id);
+|]
+
+down_m20250203_msg_bodies :: Query
+down_m20250203_msg_bodies =
+    [sql|
+DROP INDEX idx_snd_messages_snd_message_body_id;
+ALTER TABLE snd_messages DROP COLUMN snd_message_body_id;
+DROP TABLE snd_message_bodies;
+
+
+ALTER TABLE snd_messages DROP COLUMN msg_encrypt_key;
+ALTER TABLE snd_messages DROP COLUMN padded_msg_len;
+|]
@@ -0,0 +1,60 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20250322_short_links :: Query
+m20250322_short_links =
+  [sql|
+ALTER TABLE rcv_queues ADD COLUMN link_id BLOB;
+ALTER TABLE rcv_queues ADD COLUMN link_key BLOB;
+ALTER TABLE rcv_queues ADD COLUMN link_priv_sig_key BLOB;
+ALTER TABLE rcv_queues ADD COLUMN link_enc_fixed_data BLOB;
+
+CREATE UNIQUE INDEX idx_rcv_queues_link_id ON rcv_queues(host, port, link_id);
+
+ALTER TABLE rcv_queues ADD COLUMN queue_mode TEXT;
+UPDATE rcv_queues SET queue_mode = 'M' WHERE snd_secure = 1;
+ALTER TABLE rcv_queues DROP COLUMN snd_secure;
+
+ALTER TABLE snd_queues ADD COLUMN queue_mode TEXT;
+UPDATE snd_queues SET queue_mode = 'M' WHERE snd_secure = 1;
+ALTER TABLE snd_queues DROP COLUMN snd_secure;
+
+CREATE TABLE inv_short_links(
+  inv_short_link_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  server_key_hash BLOB,
+  link_id BLOB NOT NULL,
+  link_key BLOB NOT NULL,
+  snd_private_key BLOB NOT NULL,
+  snd_id BLOB,
+  FOREIGN KEY(host, port) REFERENCES servers ON DELETE RESTRICT ON UPDATE CASCADE
+);
+
+CREATE UNIQUE INDEX idx_inv_short_links_link_id ON inv_short_links(host, port, link_id);
+  |]
+
+down_m20250322_short_links :: Query
+down_m20250322_short_links =
+  [sql|
+DROP INDEX idx_rcv_queues_link_id;
+ALTER TABLE rcv_queues DROP COLUMN link_id;
+ALTER TABLE rcv_queues DROP COLUMN link_key;
+ALTER TABLE rcv_queues DROP COLUMN link_priv_sig_key;
+ALTER TABLE rcv_queues DROP COLUMN link_enc_fixed_data;
+
+DROP INDEX idx_inv_short_links_link_id;
+DROP TABLE inv_short_links;
+
+ALTER TABLE rcv_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
+UPDATE rcv_queues SET snd_secure = 1 WHERE queue_mode = 'M';
+ALTER TABLE rcv_queues DROP COLUMN queue_mode;
+
+ALTER TABLE snd_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
+UPDATE snd_queues SET snd_secure = 1 WHERE queue_mode = 'M';
+ALTER TABLE snd_queues DROP COLUMN queue_mode;
+  |]
@@ -0,0 +1,40 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250517_service_certs where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+-- TODO move date forward, create migration for postgres
+m20250517_service_certs :: Query
+m20250517_service_certs =
+  [sql|
+CREATE TABLE server_certs(
+  server_cert_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  user_id INTEGER NOT NULL REFERENCES users ON UPDATE RESTRICT ON DELETE CASCADE,
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  certificate BLOB NOT NULL,
+  priv_key BLOB NOT NULL,
+  service_id BLOB,
+  FOREIGN KEY(host, port) REFERENCES servers ON UPDATE CASCADE ON DELETE RESTRICT,
+);
+
+CREATE UNIQUE INDEX idx_server_certs_user_id_host_port ON server_certs(user_id, host, port);
+
+CREATE INDEX idx_server_certs_host_port ON server_certs(host, port);
+
+ALTER TABLE rcv_queues ADD COLUMN rcv_service_id BLOB;
+  |]
+
+down_m20250517_service_certs :: Query
+down_m20250517_service_certs =
+  [sql|
+ALTER TABLE rcv_queues DROP COLUMN rcv_service_id;
+
+DROP INDEX idx_server_certs_host_port;
+
+DROP INDEX idx_server_certs_user_id_host_port;
+
+DROP TABLE server_certs;
+  |]
@@ -0,0 +1,38 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20250702_conn_invitations_remove_cascade_delete :: Query
+m20250702_conn_invitations_remove_cascade_delete =
+  [sql|
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master
+SET sql = replace(
+            sql,
+            'contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE',
+            'contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL'
+          )
+WHERE name = 'conn_invitations' AND type = 'table';
+
+PRAGMA writable_schema=0;
+|]
+
+down_m20250702_conn_invitations_remove_cascade_delete :: Query
+down_m20250702_conn_invitations_remove_cascade_delete =
+  [sql|
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master
+SET sql = replace(
+            sql,
+            'contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL',
+            'contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE'
+          )
+WHERE name = 'conn_invitations' AND type = 'table';
+
+PRAGMA writable_schema=0;
+|]
@@ -55,8 +55,12 @@ CREATE TABLE rcv_queues(
  server_key_hash BLOB,
  switch_status TEXT,
  deleted INTEGER NOT NULL DEFAULT 0,
-  snd_secure INTEGER NOT NULL DEFAULT 0,
  last_broker_ts TEXT,
+  link_id BLOB,
+  link_key BLOB,
+  link_priv_sig_key BLOB,
+  link_enc_fixed_data BLOB,
+  queue_mode TEXT,
  PRIMARY KEY(host, port, rcv_id),
  FOREIGN KEY(host, port) REFERENCES servers
  ON DELETE RESTRICT ON UPDATE CASCADE,
@@ -79,7 +83,7 @@ CREATE TABLE snd_queues(
  replace_snd_queue_id INTEGER NULL,
  server_key_hash BLOB,
  switch_status TEXT,
-  snd_secure INTEGER NOT NULL DEFAULT 0,
+  queue_mode TEXT,
  PRIMARY KEY(host, port, snd_id),
  FOREIGN KEY(host, port) REFERENCES servers
  ON DELETE RESTRICT ON UPDATE CASCADE
@@ -127,6 +131,9 @@ CREATE TABLE snd_messages(
  retry_int_fast INTEGER,
  rcpt_internal_id INTEGER,
  rcpt_status TEXT,
+  msg_encrypt_key BLOB,
+  padded_msg_len INTEGER,
+  snd_message_body_id INTEGER REFERENCES snd_message_bodies ON DELETE SET NULL,
  PRIMARY KEY(conn_id, internal_snd_id),
  FOREIGN KEY(conn_id, internal_id) REFERENCES messages
  ON DELETE CASCADE
@@ -147,7 +154,7 @@ CREATE TABLE conn_confirmations(
 ) WITHOUT ROWID;
 CREATE TABLE conn_invitations(
  invitation_id BLOB NOT NULL PRIMARY KEY,
-  contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL,
  cr_invitation BLOB NOT NULL,
  recipient_conn_info BLOB NOT NULL,
  accepted INTEGER NOT NULL DEFAULT 0,
@@ -415,6 +422,21 @@ CREATE TABLE ntf_tokens_to_delete(
 del_failed INTEGER DEFAULT 0,
 created_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
+CREATE TABLE snd_message_bodies(
+  snd_message_body_id INTEGER PRIMARY KEY,
+  agent_msg BLOB NOT NULL DEFAULT x''
+);
+CREATE TABLE inv_short_links(
+  inv_short_link_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  server_key_hash BLOB,
+  link_id BLOB NOT NULL,
+  link_key BLOB NOT NULL,
+  snd_private_key BLOB NOT NULL,
+  snd_id BLOB,
+  FOREIGN KEY(host, port) REFERENCES servers ON DELETE RESTRICT ON UPDATE CASCADE
+);
 CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
 CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id);
 CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id);
@@ -541,3 +563,12 @@ CREATE INDEX idx_snd_message_deliveries_expired ON snd_message_deliveries(
  internal_id
 );
 CREATE INDEX idx_rcv_files_redirect_id on rcv_files(redirect_id);
+CREATE INDEX idx_snd_messages_snd_message_body_id ON snd_messages(
+  snd_message_body_id
+);
+CREATE UNIQUE INDEX idx_rcv_queues_link_id ON rcv_queues(host, port, link_id);
+CREATE UNIQUE INDEX idx_inv_short_links_link_id ON inv_short_links(
+  host,
+  port,
+  link_id
+);
@@ -1,6 +1,8 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -9,7 +11,27 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}

-module Simplex.Messaging.Client.Agent where
+module Simplex.Messaging.Client.Agent
+  ( SMPClientAgent (..),
+    SMPClientAgentConfig (..),
+    SMPClientAgentEvent (..),
+    OwnServer,
+    defaultSMPClientAgentConfig,
+    newSMPClientAgent,
+    getSMPServerClient'',
+    getConnectedSMPServerClient,
+    closeSMPClientAgent,
+    lookupSMPServerClient,
+    isOwnServer,
+    subscribeServiceNtfs,
+    subscribeQueuesNtfs,
+    activeClientSession',
+    removeActiveSub,
+    removeActiveSubs,
+    removePendingSub,
+    removePendingSubs,
+  )
+where

 import Control.Concurrent (forkIO)
 import Control.Concurrent.Async (Async, uninterruptibleCancel)
@@ -20,29 +42,43 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
-import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Constraint (Dict (..))
+import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Set (Set)
+import Data.Maybe (isJust, isNothing)
 import qualified Data.Set as S
 import Data.Text.Encoding
 import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
-import Data.Tuple (swap)
 import Numeric.Natural
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BrokerMsg, ErrorType, NotifierId, NtfPrivateAuthKey, ProtocolServer (..), QueueId, RcvPrivateAuthKey, RecipientId, SMPServer)
+import Simplex.Messaging.Protocol
+  ( BrokerMsg,
+    ErrorType,
+    NotifierId,
+    NtfPrivateAuthKey,
+    Party (..),
+    PartyI,
+    ProtocolServer (..),
+    QueueId,
+    SMPServer,
+    SParty (..),
+    ServiceParty,
+    serviceParty,
+    partyServiceRole
+  )
 import Simplex.Messaging.Session
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Util (catchAll_, ifM, toChunks, whenM, ($>>=), (<$$>))
+import Simplex.Messaging.Util (catchAll_, ifM, safeDecodeUtf8, toChunks, tshow, whenM, ($>>=), (<$$>))
 import System.Timeout (timeout)
 import UnliftIO (async)
 import qualified UnliftIO.Exception as E
@@ -51,17 +87,18 @@ import UnliftIO.STM
 type SMPClientVar = SessionVar (Either (SMPClientError, Maybe UTCTime) (OwnServer, SMPClient))

 data SMPClientAgentEvent
-  = CAConnected SMPServer
-  | CADisconnected SMPServer (Set SMPSub)
-  | CASubscribed SMPServer SMPSubParty (NonEmpty QueueId)
-  | CASubError SMPServer SMPSubParty (NonEmpty (QueueId, SMPClientError))
-
-data SMPSubParty = SPRecipient | SPNotifier
-  deriving (Eq, Ord, Show)
-
-type SMPSub = (SMPSubParty, QueueId)
-
-- type SMPServerSub = (SMPServer, SMPSub)
+  = CAConnected SMPServer (Maybe ServiceId)
+  | CADisconnected SMPServer (NonEmpty QueueId)
+  | CASubscribed SMPServer (Maybe ServiceId) (NonEmpty QueueId)
+  | CASubError SMPServer (NonEmpty (QueueId, SMPClientError))
+  | CAServiceDisconnected SMPServer (ServiceId, Int64)
+  | CAServiceSubscribed SMPServer (ServiceId, Int64) Int64
+  | CAServiceSubError SMPServer (ServiceId, Int64) SMPClientError
+  -- CAServiceUnavailable is used when service ID in pending subscription is different from the current service in connection.
+  -- This will require resubscribing to all queues associated with this service ID individually, creating new associations.
+  -- It may happen if, for example, SMP server deletes service information (e.g. via downgrade and upgrade)
+  -- and assigns different service ID to the service certificate.
+  | CAServiceUnavailable SMPServer (ServiceId, Int64)

 data SMPClientAgentConfig = SMPClientAgentConfig
  { smpCfg :: ProtocolClientConfig SMPVersion,
@@ -92,8 +129,9 @@ defaultSMPClientAgentConfig =
  where
    second = 1000000

-data SMPClientAgent = SMPClientAgent
+data SMPClientAgent p = SMPClientAgent
  { agentCfg :: SMPClientAgentConfig,
+    agentParty :: SParty p,
    active :: TVar Bool,
    startedAt :: UTCTime,
    msgQ :: TBQueue (ServerTransmissionBatch SMPVersion ErrorType BrokerMsg),
@@ -101,29 +139,39 @@ data SMPClientAgent = SMPClientAgent
    randomDrg :: TVar ChaChaDRG,
    smpClients :: TMap SMPServer SMPClientVar,
    smpSessions :: TMap SessionId (OwnServer, SMPClient),
-    srvSubs :: TMap SMPServer (TMap SMPSub (SessionId, C.APrivateAuthKey)),
-    pendingSrvSubs :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey),
+    -- Only one service subscription can exist per server with this agent.
+    -- With correctly functioning SMP server, queue and service subscriptions can't be
+    -- active at the same time.
+    activeServiceSubs :: TMap SMPServer (TVar (Maybe ((ServiceId, Int64), SessionId))),
+    activeQueueSubs :: TMap SMPServer (TMap QueueId (SessionId, C.APrivateAuthKey)),
+    -- Pending service subscriptions can co-exist with pending queue subscriptions
+    -- on the same SMP server during subscriptions being transitioned from per-queue to service.
+    pendingServiceSubs :: TMap SMPServer (TVar (Maybe (ServiceId, Int64))),
+    pendingQueueSubs :: TMap SMPServer (TMap QueueId C.APrivateAuthKey),
    smpSubWorkers :: TMap SMPServer (SessionVar (Async ())),
    workerSeq :: TVar Int
  }

 type OwnServer = Bool

-newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO SMPClientAgent
-newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg = do
+newSMPClientAgent :: SParty p -> SMPClientAgentConfig -> TVar ChaChaDRG -> IO (SMPClientAgent p)
+newSMPClientAgent agentParty agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg = do
  active <- newTVarIO True
  startedAt <- getCurrentTime
  msgQ <- newTBQueueIO msgQSize
  agentQ <- newTBQueueIO agentQSize
  smpClients <- TM.emptyIO
  smpSessions <- TM.emptyIO
-  srvSubs <- TM.emptyIO
-  pendingSrvSubs <- TM.emptyIO
+  activeServiceSubs <- TM.emptyIO
+  activeQueueSubs <- TM.emptyIO
+  pendingServiceSubs <- TM.emptyIO
+  pendingQueueSubs <- TM.emptyIO
  smpSubWorkers <- TM.emptyIO
  workerSeq <- newTVarIO 0
  pure
    SMPClientAgent
      { agentCfg,
+        agentParty,
        active,
        startedAt,
        msgQ,
@@ -131,18 +179,20 @@ newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg
        randomDrg,
        smpClients,
        smpSessions,
-        srvSubs,
-        pendingSrvSubs,
+        activeServiceSubs,
+        activeQueueSubs,
+        pendingServiceSubs,
+        pendingQueueSubs,
        smpSubWorkers,
        workerSeq
      }

 -- | Get or create SMP client for SMPServer
-getSMPServerClient' :: SMPClientAgent -> SMPServer -> ExceptT SMPClientError IO SMPClient
+getSMPServerClient' :: SMPClientAgent p -> SMPServer -> ExceptT SMPClientError IO SMPClient
 getSMPServerClient' ca srv = snd <$> getSMPServerClient'' ca srv
 {-# INLINE getSMPServerClient' #-}

-getSMPServerClient'' :: SMPClientAgent -> SMPServer -> ExceptT SMPClientError IO (OwnServer, SMPClient)
+getSMPServerClient'' :: SMPClientAgent p -> SMPServer -> ExceptT SMPClientError IO (OwnServer, SMPClient)
 getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, workerSeq} srv = do
  ts <- liftIO getCurrentTime
  atomically (getClientVar ts) >>= either (ExceptT . newSMPClient) waitForSMPClient
@@ -153,7 +203,7 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
    waitForSMPClient :: SMPClientVar -> ExceptT SMPClientError IO (OwnServer, SMPClient)
    waitForSMPClient v = do
      let ProtocolClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = smpCfg agentCfg
-      smpClient_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v)
+      smpClient_ <- liftIO $ netTimeoutInt tcpConnectTimeout NRMBackground `timeout` atomically (readTMVar $ sessionVar v)
      case smpClient_ of
        Just (Right smpClient) -> pure smpClient
        Just (Left (e, ts_)) -> case ts_ of
@@ -176,7 +226,8 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
          atomically $ do
            putTMVar (sessionVar v) (Right c)
            TM.insert (sessionId $ thParams smp) c smpSessions
-          notify ca $ CAConnected srv
+          let serviceId_ = (\THClientService {serviceId} -> serviceId) <$> smpClientService smp
+          notify ca $ CAConnected srv serviceId_
          pure $ Right c
        Left e -> do
          let ei = persistErrorInterval agentCfg
@@ -190,49 +241,68 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
          reconnectClient ca srv
          pure $ Left e

-isOwnServer :: SMPClientAgent -> SMPServer -> OwnServer
+isOwnServer :: SMPClientAgent p -> SMPServer -> OwnServer
 isOwnServer SMPClientAgent {agentCfg} ProtocolServer {host} =
  let srv = strEncode $ L.head host
   in any (\s -> s == srv || B.cons '.' s `B.isSuffixOf` srv) (ownServerDomains agentCfg)

 -- | Run an SMP client for SMPClientVar
-connectClient :: SMPClientAgent -> SMPServer -> SMPClientVar -> IO (Either SMPClientError SMPClient)
+connectClient :: SMPClientAgent p -> SMPServer -> SMPClientVar -> IO (Either SMPClientError SMPClient)
 connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, randomDrg, startedAt} srv v =
-  getProtocolClient randomDrg (1, srv, Nothing) (smpCfg agentCfg) (Just msgQ) startedAt clientDisconnected
+  getProtocolClient randomDrg NRMBackground (1, srv, Nothing) (smpCfg agentCfg) [] (Just msgQ) startedAt clientDisconnected
  where
    clientDisconnected :: SMPClient -> IO ()
    clientDisconnected smp = do
-      removeClientAndSubs smp >>= (`forM_` serverDown)
+      removeClientAndSubs smp >>= serverDown
      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv

-    removeClientAndSubs :: SMPClient -> IO (Maybe (Map SMPSub C.APrivateAuthKey))
-    removeClientAndSubs smp = atomically $ do
-      TM.delete sessId smpSessions
-      removeSessVar v srv smpClients
-      TM.lookup srv (srvSubs ca) >>= mapM updateSubs
+    removeClientAndSubs :: SMPClient -> IO (Maybe (ServiceId, Int64), Maybe (Map QueueId C.APrivateAuthKey))
+    removeClientAndSubs smp = do
+      -- Looking up subscription vars outside of STM transaction to reduce re-evaluation.
+      -- It is possible because these vars are never removed, they are only added.
+      sVar_ <- TM.lookupIO srv $ activeServiceSubs ca
+      qVar_ <- TM.lookupIO srv $ activeQueueSubs ca
+      atomically $ do
+        TM.delete sessId smpSessions
+        removeSessVar v srv smpClients
+        sSub <- pure sVar_ $>>= updateServiceSub
+        qSubs <- pure qVar_ $>>= updateQueueSubs
+        pure (sSub, qSubs)
      where
        sessId = sessionId $ thParams smp
-        updateSubs sVar = do
+        updateServiceSub sVar = do -- (sub, sessId')
+          -- We don't change active subscription in case session ID is different from disconnected client
+          serviceSub_ <- stateTVar sVar $ \case
+            Just (serviceSub, sessId') | sessId == sessId' -> (Just serviceSub, Nothing)
+            s -> (Nothing, s)
+          -- We don't reset pending subscription to Nothing here to avoid any race conditions
+          -- with subsequent client sessions that might have set pending already.
+          when (isJust serviceSub_) $ setPendingServiceSub ca srv serviceSub_
+          pure serviceSub_
+        updateQueueSubs qVar = do
          -- removing subscriptions that have matching sessionId to disconnected client
          -- and keep the other ones (they can be made by the new client)
-          pending <- M.map snd <$> stateTVar sVar (M.partition ((sessId ==) . fst))
-          addSubs_ (pendingSrvSubs ca) srv pending
-          pure pending
+          subs <- M.map snd <$> stateTVar qVar (M.partition ((sessId ==) . fst))
+          if M.null subs
+            then pure Nothing
+            else Just subs <$ addSubs_ (pendingQueueSubs ca) srv subs

-    serverDown :: Map SMPSub C.APrivateAuthKey -> IO ()
-    serverDown ss = unless (M.null ss) $ do
-      notify ca . CADisconnected srv $ M.keysSet ss
-      reconnectClient ca srv
+    serverDown :: (Maybe (ServiceId, Int64), Maybe (Map QueueId C.APrivateAuthKey)) -> IO ()
+    serverDown (sSub, qSubs) = do
+      mapM_ (notify ca . CAServiceDisconnected srv) sSub
+      let qIds = L.nonEmpty . M.keys =<< qSubs
+      mapM_ (notify ca . CADisconnected srv) qIds
+      when (isJust sSub || isJust qIds) $ reconnectClient ca srv

 -- | Spawn reconnect worker if needed
-reconnectClient :: SMPClientAgent -> SMPServer -> IO ()
+reconnectClient :: SMPClientAgent p -> SMPServer -> IO ()
 reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} srv = do
  ts <- getCurrentTime
  whenM (readTVarIO active) $ atomically (getWorkerVar ts) >>= mapM_ (either newSubWorker (\_ -> pure ()))
  where
    getWorkerVar ts =
      ifM
-        (noPending)
+        (noPending <$> getPending TM.lookup readTVar)
        (pure Nothing) -- prevent race with cleanup and adding pending queues in another call
        (Just <$> getSessVar workerSeq srv smpSubWorkers ts)
    newSubWorker :: SessionVar (Async ()) -> IO ()
@@ -241,13 +311,17 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
      atomically $ putTMVar (sessionVar v) a
    runSubWorker =
      withRetryInterval (reconnectInterval agentCfg) $ \_ loop -> do
-        pending <- liftIO getPending
-        unless (null pending) $ whenM (readTVarIO active) $ do
-          void $ tcpConnectTimeout `timeout` runExceptT (reconnectSMPClient ca srv pending)
+        subs <- getPending TM.lookupIO readTVarIO
+        unless (noPending subs) $ whenM (readTVarIO active) $ do
+          void $ netTimeoutInt tcpConnectTimeout NRMBackground `timeout` runExceptT (reconnectSMPClient ca srv subs)
          loop
    ProtocolClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = smpCfg agentCfg
-    noPending = maybe (pure True) (fmap M.null . readTVar) =<< TM.lookup srv (pendingSrvSubs ca)
-    getPending = maybe (pure M.empty) readTVarIO =<< TM.lookupIO srv (pendingSrvSubs ca)
+    noPending (sSub, qSubs) = isNothing sSub && maybe True M.null qSubs
+    getPending :: Monad m => (forall a. SMPServer -> TMap SMPServer a -> m (Maybe a)) -> (forall a. TVar a -> m a) -> m (Maybe (ServiceId, Int64), Maybe (Map QueueId C.APrivateAuthKey))
+    getPending lkup rd = do
+      sSub <- lkup srv (pendingServiceSubs ca) $>>= rd
+      qSubs <- lkup srv (pendingQueueSubs ca) >>= mapM rd
+      pure (sSub, qSubs)
    cleanup :: SessionVar (Async ()) -> STM ()
    cleanup v = do
      -- Here we wait until TMVar is not empty to prevent worker cleanup happening before worker is added to TMVar.
@@ -255,32 +329,28 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
      whenM (isEmptyTMVar $ sessionVar v) retry
      removeSessVar v srv smpSubWorkers

-reconnectSMPClient :: SMPClientAgent -> SMPServer -> Map SMPSub C.APrivateAuthKey -> ExceptT SMPClientError IO ()
-reconnectSMPClient ca@SMPClientAgent {agentCfg} srv cs =
-  withSMP ca srv $ \smp -> liftIO $ do
-    currSubs <- maybe (pure M.empty) readTVarIO =<< TM.lookupIO srv (srvSubs ca)
-    let (nSubs, rSubs) = foldr (groupSub currSubs) ([], []) $ M.assocs cs
-    subscribe_ smp SPNotifier nSubs
-    subscribe_ smp SPRecipient rSubs
+reconnectSMPClient :: forall p. SMPClientAgent p -> SMPServer -> (Maybe (ServiceId, Int64), Maybe (Map QueueId C.APrivateAuthKey)) -> ExceptT SMPClientError IO ()
+reconnectSMPClient ca@SMPClientAgent {agentCfg, agentParty} srv (sSub_, qSubs_) =
+  withSMP ca srv $ \smp -> liftIO $ case serviceParty agentParty of
+    Just Dict -> resubscribe smp
+    Nothing -> pure ()
  where
-    groupSub :: Map SMPSub (SessionId, C.APrivateAuthKey) -> (SMPSub, C.APrivateAuthKey) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)]) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)])
-    groupSub currSubs (s@(party, qId), k) acc@(nSubs, rSubs)
-      | M.member s currSubs = acc
-      | otherwise = case party of
-          SPNotifier -> (s' : nSubs, rSubs)
-          SPRecipient -> (nSubs, s' : rSubs)
-      where
-        s' = (qId, k)
-    subscribe_ :: SMPClient -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> IO ()
-    subscribe_ smp party = mapM_ (smpSubscribeQueues party ca smp srv) . toChunks (agentSubsBatchSize agentCfg)
+    resubscribe :: (PartyI p, ServiceParty p) => SMPClient -> IO ()
+    resubscribe smp = do
+      mapM_ (smpSubscribeService ca smp srv) sSub_
+      forM_ qSubs_ $ \qSubs -> do
+        currSubs_ <- mapM readTVarIO =<< TM.lookupIO srv (activeQueueSubs ca)
+        let qSubs' :: [(QueueId, C.APrivateAuthKey)] =
+              maybe id (\currSubs -> filter ((`M.notMember` currSubs) . fst)) currSubs_ $ M.assocs qSubs
+        mapM_ (smpSubscribeQueues @p ca smp srv) $ toChunks (agentSubsBatchSize agentCfg) qSubs'

-notify :: MonadIO m => SMPClientAgent -> SMPClientAgentEvent -> m ()
+notify :: MonadIO m => SMPClientAgent p -> SMPClientAgentEvent -> m ()
 notify ca evt = atomically $ writeTBQueue (agentQ ca) evt
 {-# INLINE notify #-}

 -- Returns already connected client for proxying messages or Nothing if client is absent, not connected yet or stores expired error.
 -- If Nothing is return proxy will spawn a new thread to wait or to create another client connection to destination relay.
-getConnectedSMPServerClient :: SMPClientAgent -> SMPServer -> IO (Maybe (Either SMPClientError (OwnServer, SMPClient)))
+getConnectedSMPServerClient :: SMPClientAgent p -> SMPServer -> IO (Maybe (Either SMPClientError (OwnServer, SMPClient)))
 getConnectedSMPServerClient SMPClientAgent {smpClients} srv =
  atomically (TM.lookup srv smpClients $>>= \v -> (v,) <$$> tryReadTMVar (sessionVar v)) -- Nothing: client is absent or not connected yet
    $>>= \case
@@ -293,10 +363,10 @@ getConnectedSMPServerClient SMPClientAgent {smpClients} srv =
            (Nothing <$ atomically (removeSessVar v srv smpClients)) -- proxy will create a new connection
            (pure $ Just $ Left e) -- not expired, returning error

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

-closeSMPClientAgent :: SMPClientAgent -> IO ()
+closeSMPClientAgent :: SMPClientAgent p -> IO ()
 closeSMPClientAgent c = do
  atomically $ writeTVar (active c) False
  closeSMPServerClients c
@@ -305,7 +375,7 @@ closeSMPClientAgent c = do
    cancelReconnect :: SessionVar (Async ()) -> IO ()
    cancelReconnect v = void . forkIO $ atomically (readTMVar $ sessionVar v) >>= uninterruptibleCancel

-closeSMPServerClients :: SMPClientAgent -> IO ()
+closeSMPServerClients :: SMPClientAgent p -> IO ()
 closeSMPServerClients c = atomically (smpClients c `swapTVar` M.empty) >>= mapM_ (forkIO . closeClient)
  where
    closeClient v =
@@ -316,30 +386,30 @@ closeSMPServerClients c = atomically (smpClients c `swapTVar` M.empty) >>= mapM_
 cancelActions :: Foldable f => TVar (f (Async ())) -> IO ()
 cancelActions as = readTVarIO as >>= mapM_ uninterruptibleCancel

-withSMP :: SMPClientAgent -> SMPServer -> (SMPClient -> ExceptT SMPClientError IO a) -> ExceptT SMPClientError IO a
+withSMP :: SMPClientAgent p -> SMPServer -> (SMPClient -> ExceptT SMPClientError IO a) -> ExceptT SMPClientError IO a
 withSMP ca srv action = (getSMPServerClient' ca srv >>= action) `catchE` logSMPError
  where
    logSMPError :: SMPClientError -> ExceptT SMPClientError IO a
    logSMPError e = do
-      liftIO $ putStrLn $ "SMP error (" <> show srv <> "): " <> show e
+      logInfo $ "SMP error (" <> safeDecodeUtf8 (strEncode srv) <> "): " <> tshow e
      throwE e

-subscribeQueuesSMP :: SMPClientAgent -> SMPServer -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> IO ()
-subscribeQueuesSMP = subscribeQueues_ SPRecipient
+subscribeQueuesNtfs :: SMPClientAgent 'NotifierService -> SMPServer -> NonEmpty (NotifierId, NtfPrivateAuthKey) -> IO ()
+subscribeQueuesNtfs = subscribeQueues_
+{-# INLINE subscribeQueuesNtfs #-}

-subscribeQueuesNtfs :: SMPClientAgent -> SMPServer -> NonEmpty (NotifierId, NtfPrivateAuthKey) -> IO ()
-subscribeQueuesNtfs = subscribeQueues_ SPNotifier
-
-subscribeQueues_ :: SMPSubParty -> SMPClientAgent -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
-subscribeQueues_ party ca srv subs = do
-  atomically $ addPendingSubs ca srv party $ L.toList subs
+subscribeQueues_ :: ServiceParty p => SMPClientAgent p -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
+subscribeQueues_ ca srv subs = do
+  atomically $ addPendingSubs ca srv $ L.toList subs
  runExceptT (getSMPServerClient' ca srv) >>= \case
-    Right smp -> smpSubscribeQueues party ca smp srv subs
+    Right smp -> smpSubscribeQueues ca smp srv subs
    Left _ -> pure () -- no call to reconnectClient - failing getSMPServerClient' does that

-smpSubscribeQueues :: SMPSubParty -> SMPClientAgent -> SMPClient -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
-smpSubscribeQueues party ca smp srv subs = do
-  rs <- subscribe smp $ L.map swap subs
+smpSubscribeQueues :: ServiceParty p => SMPClientAgent p -> SMPClient -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
+smpSubscribeQueues ca smp srv subs = do
+  rs <- case agentParty ca of
+    SRecipientService -> subscribeSMPQueues smp subs
+    SNotifierService -> subscribeSMPQueuesNtfs smp subs
  rs' <-
    atomically $
      ifM
@@ -347,79 +417,164 @@ smpSubscribeQueues party ca smp srv subs = do
        (Just <$> processSubscriptions rs)
        (pure Nothing)
  case rs' of
-    Just (tempErrs, finalErrs, oks, _) -> do
-      notify_ CASubscribed $ map fst oks
+    Just (tempErrs, finalErrs, (qOks, sQs), _) -> do
+      notify_ (`CASubscribed` Nothing) $ map fst qOks
+      when (isJust smpServiceId) $ notify_ (`CASubscribed` smpServiceId) sQs
      notify_ CASubError finalErrs
      when tempErrs $ reconnectClient ca srv
    Nothing -> reconnectClient ca srv
  where
-    processSubscriptions :: NonEmpty (Either SMPClientError ()) -> STM (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId])
+    processSubscriptions :: NonEmpty (Either SMPClientError (Maybe ServiceId)) -> STM (Bool, [(QueueId, SMPClientError)], ([(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId]), [QueueId])
    processSubscriptions rs = do
-      pending <- maybe (pure M.empty) readTVar =<< TM.lookup srv (pendingSrvSubs ca)
-      let acc@(_, _, oks, notPending) = foldr (groupSub pending) (False, [], [], []) (L.zip subs rs)
-      unless (null oks) $ addSubscriptions ca srv party oks
-      unless (null notPending) $ removePendingSubs ca srv party notPending
+      pending <- maybe (pure M.empty) readTVar =<< TM.lookup srv (pendingQueueSubs ca)
+      let acc@(_, _, (qOks, sQs), notPending) = foldr (groupSub pending) (False, [], ([], []), []) (L.zip subs rs)
+      unless (null qOks) $ addActiveSubs ca srv qOks
+      unless (null sQs) $ forM_ smpServiceId $ \serviceId ->
+        updateActiveServiceSub ca srv ((serviceId, fromIntegral $ length sQs), sessId)
+      unless (null notPending) $ removePendingSubs ca srv notPending
      pure acc
    sessId = sessionId $ thParams smp
-    groupSub :: Map SMPSub C.APrivateAuthKey -> ((QueueId, C.APrivateAuthKey), Either SMPClientError ()) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId]) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId])
-    groupSub pending ((qId, pk), r) acc@(!tempErrs, finalErrs, oks, notPending) = case r of
-      Right ()
-        | M.member (party, qId) pending -> (tempErrs, finalErrs, (qId, (sessId, pk)) : oks, qId : notPending)
+    smpServiceId = (\THClientService {serviceId} -> serviceId) <$> smpClientService smp
+    groupSub ::
+      Map QueueId C.APrivateAuthKey ->
+      ((QueueId, C.APrivateAuthKey), Either SMPClientError (Maybe ServiceId)) ->
+      (Bool, [(QueueId, SMPClientError)], ([(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId]), [QueueId]) ->
+      (Bool, [(QueueId, SMPClientError)], ([(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId]), [QueueId])
+    groupSub pending ((qId, pk), r) acc@(!tempErrs, finalErrs, oks@(qOks, sQs), notPending) = case r of
+      Right serviceId_
+        | M.member qId pending ->
+            let oks' = case (smpServiceId, serviceId_) of
+                  (Just sId, Just sId') | sId == sId' -> (qOks, qId : sQs)
+                  _ -> ((qId, (sessId, pk)) : qOks, sQs)
+             in (tempErrs, finalErrs, oks', qId : notPending)
        | otherwise -> acc
      Left e
        | temporaryClientError e -> (True, finalErrs, oks, notPending)
        | otherwise -> (tempErrs, (qId, e) : finalErrs, oks, qId : notPending)
-    subscribe = case party of
-      SPRecipient -> subscribeSMPQueues
-      SPNotifier -> subscribeSMPQueuesNtfs
-    notify_ :: (SMPServer -> SMPSubParty -> NonEmpty a -> SMPClientAgentEvent) -> [a] -> IO ()
-    notify_ evt qs = mapM_ (notify ca . evt srv party) $ L.nonEmpty qs
+    notify_ :: (SMPServer -> NonEmpty a -> SMPClientAgentEvent) -> [a] -> IO ()
+    notify_ evt qs = mapM_ (notify ca . evt srv) $ L.nonEmpty qs

-activeClientSession' :: SMPClientAgent -> SessionId -> SMPServer -> STM Bool
+subscribeServiceNtfs :: SMPClientAgent 'NotifierService -> SMPServer -> (ServiceId, Int64) -> IO ()
+subscribeServiceNtfs = subscribeService_
+{-# INLINE subscribeServiceNtfs #-}
+
+subscribeService_ :: (PartyI p, ServiceParty p) => SMPClientAgent p -> SMPServer -> (ServiceId, Int64) -> IO ()
+subscribeService_ ca srv serviceSub = do
+  atomically $ setPendingServiceSub ca srv $ Just serviceSub
+  runExceptT (getSMPServerClient' ca srv) >>= \case
+    Right smp -> smpSubscribeService ca smp srv serviceSub
+    Left _ -> pure () -- no call to reconnectClient - failing getSMPServerClient' does that
+
+smpSubscribeService :: (PartyI p, ServiceParty p) => SMPClientAgent p -> SMPClient -> SMPServer -> (ServiceId, Int64) -> IO ()
+smpSubscribeService ca smp srv serviceSub@(serviceId, _) = case smpClientService smp of
+  Just service | serviceAvailable service -> subscribe
+  _ -> notifyUnavailable
+  where
+    subscribe = do
+      r <- runExceptT $ subscribeService smp $ agentParty ca
+      ok <-
+        atomically $
+          ifM
+            (activeClientSession ca smp srv)
+            (True <$ processSubscription r)
+            (pure False)
+      if ok
+        then case r of
+          Right n -> notify ca $ CAServiceSubscribed srv serviceSub n
+          Left e
+            | smpClientServiceError e -> notifyUnavailable
+            | temporaryClientError e -> reconnectClient ca srv
+            | otherwise -> notify ca $ CAServiceSubError srv serviceSub e
+        else reconnectClient ca srv
+    processSubscription = mapM_ $ \n -> do
+      setActiveServiceSub ca srv $ Just ((serviceId, n), sessId)
+      setPendingServiceSub ca srv Nothing
+    serviceAvailable THClientService {serviceRole, serviceId = serviceId'} =
+      serviceId == serviceId' && partyServiceRole (agentParty ca) == serviceRole
+    notifyUnavailable = do
+      atomically $ setPendingServiceSub ca srv Nothing
+      notify ca $ CAServiceUnavailable srv serviceSub -- this will resubscribe all queues directly
+    sessId = sessionId $ thParams smp
+
+activeClientSession' :: SMPClientAgent p -> SessionId -> SMPServer -> STM Bool
 activeClientSession' ca sessId srv = sameSess <$> tryReadSessVar srv (smpClients ca)
  where
    sameSess = \case
      Just (Right (_, smp')) -> sessId == sessionId (thParams smp')
      _ -> False

-activeClientSession :: SMPClientAgent -> SMPClient -> SMPServer -> STM Bool
+activeClientSession :: SMPClientAgent p -> SMPClient -> SMPServer -> STM Bool
 activeClientSession ca = activeClientSession' ca . sessionId . thParams

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

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

-addPendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> STM ()
-addPendingSubs = addSubsList_ . pendingSrvSubs
+addPendingSubs :: SMPClientAgent p -> SMPServer -> [(QueueId, C.APrivateAuthKey)] -> STM ()
+addPendingSubs = addSubsList_ . pendingQueueSubs
 {-# INLINE addPendingSubs #-}

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

-addSubs_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> Map SMPSub s -> STM ()
+addSubs_ :: TMap SMPServer (TMap QueueId s) -> SMPServer -> Map QueueId s -> STM ()
 addSubs_ subs srv ss =
  TM.lookup srv subs >>= \case
    Just m -> TM.union ss m
-    _ -> newTVar ss >>= \v -> TM.insert srv v subs
+    _ -> TM.insertM srv (newTVar ss) subs

-removeSubscription :: SMPClientAgent -> SMPServer -> SMPSub -> STM ()
-removeSubscription = removeSub_ . srvSubs
-{-# INLINE removeSubscription #-}
+setActiveServiceSub :: SMPClientAgent p -> SMPServer -> Maybe ((ServiceId, Int64), SessionId) -> STM ()
+setActiveServiceSub = setServiceSub_ activeServiceSubs
+{-# INLINE setActiveServiceSub #-}

-removeSub_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> SMPSub -> STM ()
+setPendingServiceSub :: SMPClientAgent p -> SMPServer -> Maybe (ServiceId, Int64) -> STM ()
+setPendingServiceSub = setServiceSub_ pendingServiceSubs
+{-# INLINE setPendingServiceSub #-}
+
+setServiceSub_ ::
+  (SMPClientAgent p -> TMap SMPServer (TVar (Maybe sub))) ->
+  SMPClientAgent p ->
+  SMPServer ->
+  Maybe sub ->
+  STM ()
+setServiceSub_ subsSel ca srv sub =
+  TM.lookup srv (subsSel ca) >>= \case
+    Just v -> writeTVar v sub
+    Nothing -> TM.insertM srv (newTVar sub) (subsSel ca)
+
+updateActiveServiceSub :: SMPClientAgent p -> SMPServer -> ((ServiceId, Int64), SessionId) -> STM ()
+updateActiveServiceSub ca srv sub@((serviceId', n'), sessId') =
+  TM.lookup srv (activeServiceSubs ca) >>= \case
+    Just v -> modifyTVar' v $ \case
+      Just ((serviceId, n), sessId) | serviceId == serviceId' && sessId == sessId' ->
+        Just ((serviceId, n + n'), sessId)
+      _ -> Just sub
+    Nothing -> TM.insertM srv (newTVar $ Just sub) (activeServiceSubs ca)
+
+removeActiveSub :: SMPClientAgent p -> SMPServer -> QueueId -> STM ()
+removeActiveSub = removeSub_ . activeQueueSubs
+{-# INLINE removeActiveSub #-}
+
+removePendingSub :: SMPClientAgent p -> SMPServer -> QueueId -> STM ()
+removePendingSub = removeSub_ . pendingQueueSubs
+{-# INLINE removePendingSub #-}
+
+removeSub_ :: TMap SMPServer (TMap QueueId s) -> SMPServer -> QueueId -> STM ()
 removeSub_ subs srv s = TM.lookup srv subs >>= mapM_ (TM.delete s)

-removePendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [QueueId] -> STM ()
-removePendingSubs = removeSubs_ . pendingSrvSubs
+removeActiveSubs :: SMPClientAgent p -> SMPServer -> [QueueId] -> STM ()
+removeActiveSubs = removeSubs_ . activeQueueSubs
+{-# INLINE removeActiveSubs #-}
+
+removePendingSubs :: SMPClientAgent p -> SMPServer -> [QueueId] -> STM ()
+removePendingSubs = removeSubs_ . pendingQueueSubs
 {-# INLINE removePendingSubs #-}

-removeSubs_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSubParty -> [QueueId] -> STM ()
-removeSubs_ subs srv party qs = TM.lookup srv subs >>= mapM_ (`modifyTVar'` (`M.withoutKeys` ss))
-  where
-    ss = S.fromList $ map (party,) qs
+removeSubs_ :: TMap SMPServer (TMap QueueId s) -> SMPServer -> [QueueId] -> STM ()
+removeSubs_ subs srv qs = TM.lookup srv subs >>= mapM_ (`modifyTVar'` (`M.withoutKeys` S.fromList qs))
@@ -64,6 +64,7 @@ module Simplex.Messaging.Crypto
    AAuthKeyPair,
    KeyPair,
    KeyPairX25519,
+    KeyPairEd25519,
    ASignatureKeyPair,
    DhSecret (..),
    DhSecretX25519,
@@ -78,7 +79,9 @@ module Simplex.Messaging.Crypto
    generateDhKeyPair,
    privateToX509,
    x509ToPublic,
+    x509ToPublic',
    x509ToPrivate,
+    x509ToPrivate',
    publicKey,
    signatureKeyPair,
    publicToX509,
@@ -142,6 +145,8 @@ module Simplex.Messaging.Crypto
    cbDecryptNoPad,
    sbDecrypt_,
    sbEncrypt_,
+    sbEncryptNoPad,
+    sbDecryptNoPad,
    cbNonce,
    randomCbNonce,
    reverseNonce,
@@ -160,6 +165,7 @@ module Simplex.Messaging.Crypto
    SbKeyNonce,
    sbcInit,
    sbcHkdf,
+    hkdf,

    -- * pseudo-random bytes
    randomBytes,
@@ -167,14 +173,15 @@ module Simplex.Messaging.Crypto
    -- * digests
    sha256Hash,
    sha512Hash,
+    sha3_256,
+    sha3_384,

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

    -- * X509 Certificates
-    SignedCertificate,
-    Certificate,
    signCertificate,
    signX509,
    verifyX509,
@@ -206,7 +213,7 @@ import Crypto.Cipher.AES (AES256)
 import qualified Crypto.Cipher.Types as AES
 import qualified Crypto.Cipher.XSalsa as XSalsa
 import qualified Crypto.Error as CE
-import Crypto.Hash (Digest, SHA256 (..), SHA512 (..), hash, hashDigestSize)
+import Crypto.Hash (Digest, SHA3_256, SHA3_384, SHA256 (..), SHA512 (..), hash, hashDigestSize)
 import qualified Crypto.KDF.HKDF as H
 import qualified Crypto.MAC.Poly1305 as Poly1305
 import qualified Crypto.PubKey.Curve25519 as X25519
@@ -234,14 +241,14 @@ import Data.String
 import Data.Type.Equality
 import Data.Typeable (Proxy (Proxy), Typeable)
 import Data.Word (Word32)
-import Data.X509
+import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
 import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
 import Network.Transport.Internal (decodeWord16, encodeWord16)
-import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
+import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (blobFieldDecoder, parseAll, parseString)
+import Simplex.Messaging.Parsers (parseAll, parseString)
 import Simplex.Messaging.Util ((<$?>))

 -- | Cryptographic algorithms.
@@ -674,6 +681,8 @@ type KeyPair a = KeyPairType (PrivateKey a)

 type KeyPairX25519 = KeyPair X25519

+type KeyPairEd25519 = KeyPair Ed25519
+
 -- TODO narrow key pair types to have the same algorithm in both keys
 type AKeyPair = KeyPairType APrivateKey

@@ -785,10 +794,19 @@ class CryptoSignature s where

 instance CryptoSignature (Signature s) => StrEncoding (Signature s) where
  strEncode = serializeSignature
+  {-# INLINE strEncode #-}
  strDecode = decodeSignature
+  {-# INLINE strDecode #-}
+
+instance CryptoSignature (Signature s) => Encoding (Signature s) where
+  smpEncode = smpEncode . signatureBytes
+  {-# INLINE smpEncode #-}
+  smpP = decodeSignature <$?> smpP
+  {-# INLINE smpP #-}

 instance CryptoSignature ASignature where
  signatureBytes (ASignature _ sig) = signatureBytes sig
+  {-# INLINE signatureBytes #-}
  decodeSignature s
    | B.length s == Ed25519.signatureSize =
        ASignature SEd25519 . SignatureEd25519 <$> ed Ed25519.signature s
@@ -800,6 +818,7 @@ instance CryptoSignature ASignature where

 instance CryptoSignature (Maybe ASignature) where
  signatureBytes = maybe "" signatureBytes
+  {-# INLINE signatureBytes #-}
  decodeSignature s
    | B.null s = Right Nothing
    | otherwise = Just <$> decodeSignature s
@@ -808,6 +827,7 @@ instance AlgorithmI a => CryptoSignature (Signature a) where
  signatureBytes = \case
    SignatureEd25519 s -> BA.convert s
    SignatureEd448 s -> BA.convert s
+  {-# INLINE signatureBytes #-}
  decodeSignature s = do
    ASignature _ sig <- decodeSignature s
    checkAlgorithm sig
@@ -818,25 +838,31 @@ instance SignatureSize (Signature a) where
  signatureSize = \case
    SignatureEd25519 _ -> Ed25519.signatureSize
    SignatureEd448 _ -> Ed448.signatureSize
+  {-# INLINE signatureSize #-}

 instance SignatureSize ASignature where
  signatureSize (ASignature _ s) = signatureSize s
+  {-# INLINE signatureSize #-}

 instance SignatureSize APrivateSignKey where
  signatureSize (APrivateSignKey _ k) = signatureSize k
+  {-# INLINE signatureSize #-}

 instance SignatureSize APublicVerifyKey where
  signatureSize (APublicVerifyKey _ k) = signatureSize k
+  {-# INLINE signatureSize #-}

 instance SignatureAlgorithm a => SignatureSize (PrivateKey a) where
  signatureSize = \case
    PrivateKeyEd25519 _ _ -> Ed25519.signatureSize
    PrivateKeyEd448 _ _ -> Ed448.signatureSize
+  {-# INLINE signatureSize #-}

 instance SignatureAlgorithm a => SignatureSize (PublicKey a) where
  signatureSize = \case
    PublicKeyEd25519 _ -> Ed25519.signatureSize
    PublicKeyEd448 _ -> Ed448.signatureSize
+  {-# INLINE signatureSize #-}

 -- | Various cryptographic or related errors.
 data CryptoError
@@ -886,6 +912,7 @@ x448_size = 448 `quot` 8
 validSignatureSize :: Int -> Bool
 validSignatureSize n =
  n == Ed25519.signatureSize || n == Ed448.signatureSize
+{-# INLINE validSignatureSize #-}

 -- | AES key newtype.
 newtype Key = Key {unKey :: ByteString}
@@ -960,10 +987,22 @@ instance FromField KeyHash where fromField = blobFieldDecoder $ parseAll strP
 -- | SHA256 digest.
 sha256Hash :: ByteString -> ByteString
 sha256Hash = BA.convert . (hash :: ByteString -> Digest SHA256)
+{-# INLINE sha256Hash #-}

 -- | SHA512 digest.
 sha512Hash :: ByteString -> ByteString
 sha512Hash = BA.convert . (hash :: ByteString -> Digest SHA512)
+{-# INLINE sha512Hash #-}
+
+-- | SHA3-256 digest.
+sha3_256 :: ByteString -> ByteString
+sha3_256 = BA.convert . (hash :: ByteString -> Digest SHA3_256)
+{-# INLINE sha3_256 #-}
+
+-- | SHA3-384 digest.
+sha3_384 :: ByteString -> ByteString
+sha3_384 = BA.convert . (hash :: ByteString -> Digest SHA3_384)
+{-# INLINE sha3_384 #-}

 -- | AEAD-GCM encryption with associated data.
 --
@@ -980,6 +1019,7 @@ encryptAEAD aesKey ivBytes paddedLen ad msg = do
 -- This function requires 12 bytes IV, it does not transform IV.
 encryptAESNoPad :: Key -> GCMIV -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
 encryptAESNoPad key iv = encryptAEADNoPad key iv ""
+{-# INLINE encryptAESNoPad #-}

 encryptAEADNoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
 encryptAEADNoPad aesKey ivBytes ad msg = do
@@ -1001,6 +1041,7 @@ decryptAEAD aesKey ivBytes ad msg (AuthTag authTag) = do
 -- This function requires 12 bytes IV, it does not transform IV.
 decryptAESNoPad :: Key -> GCMIV -> ByteString -> AuthTag -> ExceptT CryptoError IO ByteString
 decryptAESNoPad key iv = decryptAEADNoPad key iv ""
+{-# INLINE decryptAESNoPad #-}

 decryptAEADNoPad :: Key -> GCMIV -> ByteString -> ByteString -> AuthTag -> ExceptT CryptoError IO ByteString
 decryptAEADNoPad aesKey iv ad msg (AuthTag tag) = do
@@ -1010,6 +1051,11 @@ decryptAEADNoPad aesKey iv ad msg (AuthTag tag) = do
 maxMsgLen :: Int
 maxMsgLen = 2 ^ (16 :: Int) - 3

+canPad :: Int -> Int -> Bool
+canPad msgLen paddedLen = msgLen <= maxMsgLen && padLen >= 0
+  where
+    padLen = paddedLen - msgLen - 2
+
 pad :: ByteString -> Int -> Either CryptoError ByteString
 pad msg paddedLen
  | len <= maxMsgLen && padLen >= 0 = Right $ encodeWord16 (fromIntegral len) <> msg <> B.replicate padLen '#'
@@ -1048,6 +1094,7 @@ maxLenBS s

 unsafeMaxLenBS :: forall i. KnownNat i => ByteString -> MaxLenBS i
 unsafeMaxLenBS = MLBS
+{-# INLINE unsafeMaxLenBS #-}

 padMaxLenBS :: forall i. KnownNat i => MaxLenBS i -> MaxLenBS (i + 2)
 padMaxLenBS (MLBS msg) = MLBS $ encodeWord16 (fromIntegral len) <> msg <> B.replicate padLen '#'
@@ -1060,6 +1107,7 @@ appendMaxLenBS (MLBS s1) (MLBS s2) = MLBS $ s1 <> s2

 maxLength :: forall i. KnownNat i => Int
 maxLength = fromIntegral (natVal $ Proxy @i)
+{-# INLINE maxLength #-}

 -- this function requires 16 bytes IV, it transforms IV in cryptonite_aes_gcm_init here:
 -- https://github.com/haskell-crypto/cryptonite/blob/master/cbits/cryptonite_aes.c
@@ -1080,12 +1128,15 @@ initAEADGCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do
 -- | Random AES256 key.
 randomAesKey :: TVar ChaChaDRG -> STM Key
 randomAesKey = fmap Key . randomBytes aesKeySize
+{-# INLINE randomAesKey #-}

 randomGCMIV :: TVar ChaChaDRG -> STM GCMIV
 randomGCMIV = fmap GCMIV . randomBytes gcmIVSize
+{-# INLINE randomGCMIV #-}

 ivSize :: forall c. AES.BlockCipher c => Int
 ivSize = AES.blockSize (undefined :: c)
+{-# INLINE ivSize #-}

 gcmIVSize :: Int
 gcmIVSize = 12
@@ -1095,6 +1146,7 @@ makeIV bs = maybeError CryptoIVError $ AES.makeIV bs

 maybeError :: CryptoError -> Maybe a -> ExceptT CryptoError IO a
 maybeError e = maybe (throwE e) return
+{-# INLINE maybeError #-}

 cryptoFailable :: CE.CryptoFailable a -> ExceptT CryptoError IO a
 cryptoFailable = liftEither . first AESCipherError . CE.eitherCryptoError
@@ -1105,15 +1157,18 @@ cryptoFailable = liftEither . first AESCipherError . CE.eitherCryptoError
 sign' :: SignatureAlgorithm a => PrivateKey a -> ByteString -> Signature a
 sign' (PrivateKeyEd25519 pk k) msg = SignatureEd25519 $ Ed25519.sign pk k msg
 sign' (PrivateKeyEd448 pk k) msg = SignatureEd448 $ Ed448.sign pk k msg
+{-# INLINE sign' #-}

 sign :: APrivateSignKey -> ByteString -> ASignature
 sign (APrivateSignKey a k) = ASignature a . sign' k
+{-# INLINE sign #-}

-signCertificate :: APrivateSignKey -> Certificate -> SignedCertificate
+signCertificate :: APrivateSignKey -> X.Certificate -> X.SignedCertificate
 signCertificate = signX509
+{-# INLINE signCertificate #-}

-signX509 :: (ASN1Object o, Eq o, Show o) => APrivateSignKey -> o -> SignedExact o
-signX509 key = fst . objectToSignedExact f
+signX509 :: (ASN1Object o, Eq o, Show o) => APrivateSignKey -> o -> X.SignedExact o
+signX509 key = fst . X.objectToSignedExact f
  where
    f bytes =
      ( signatureBytes $ sign key bytes,
@@ -1122,69 +1177,74 @@ signX509 key = fst . objectToSignedExact f
      )
 {-# INLINE signX509 #-}

-verifyX509 :: (ASN1Object o, Eq o, Show o) => APublicVerifyKey -> SignedExact o -> Either String o
+verifyX509 :: (ASN1Object o, Eq o, Show o) => APublicVerifyKey -> X.SignedExact o -> Either String o
 verifyX509 key exact = do
  signature <- case signedAlg of
-    SignatureALG_IntrinsicHash PubKeyALG_Ed25519 -> ASignature SEd25519 <$> decodeSignature signedSignature
-    SignatureALG_IntrinsicHash PubKeyALG_Ed448 -> ASignature SEd448 <$> decodeSignature signedSignature
+    X.SignatureALG_IntrinsicHash X.PubKeyALG_Ed25519 -> ASignature SEd25519 <$> decodeSignature signedSignature
+    X.SignatureALG_IntrinsicHash X.PubKeyALG_Ed448 -> ASignature SEd448 <$> decodeSignature signedSignature
    _ -> Left "unknown x509 signature algorithm"
-  if verify key signature $ getSignedData exact then Right signedObject else Left "bad signature"
+  if verify key signature $ X.getSignedData exact then Right signedObject else Left "bad signature"
  where
-    Signed {signedObject, signedAlg, signedSignature} = getSigned exact
+    X.Signed {signedObject, signedAlg, signedSignature} = X.getSigned exact
 {-# INLINE verifyX509 #-}

-certificateFingerprint :: SignedCertificate -> KeyHash
+certificateFingerprint :: X.SignedCertificate -> KeyHash
 certificateFingerprint = signedFingerprint
+{-# INLINE certificateFingerprint #-}

-signedFingerprint :: (ASN1Object o, Eq o, Show o) => SignedExact o -> KeyHash
+signedFingerprint :: (ASN1Object o, Eq o, Show o) => X.SignedExact o -> KeyHash
 signedFingerprint o = KeyHash fp
  where
-    Fingerprint fp = getFingerprint o HashSHA256
+    Fingerprint fp = getFingerprint o X.HashSHA256

 class SignatureAlgorithmX509 a where
-  signatureAlgorithmX509 :: a -> SignatureALG
+  signatureAlgorithmX509 :: a -> X.SignatureALG

 instance SignatureAlgorithm a => SignatureAlgorithmX509 (SAlgorithm a) where
  signatureAlgorithmX509 = \case
-    SEd25519 -> SignatureALG_IntrinsicHash PubKeyALG_Ed25519
-    SEd448 -> SignatureALG_IntrinsicHash PubKeyALG_Ed448
+    SEd25519 -> X.SignatureALG_IntrinsicHash X.PubKeyALG_Ed25519
+    SEd448 -> X.SignatureALG_IntrinsicHash X.PubKeyALG_Ed448
+  {-# INLINE signatureAlgorithmX509 #-}

 instance SignatureAlgorithmX509 APrivateSignKey where
  signatureAlgorithmX509 (APrivateSignKey a _) = signatureAlgorithmX509 a
+  {-# INLINE signatureAlgorithmX509 #-}

 instance SignatureAlgorithmX509 APublicVerifyKey where
  signatureAlgorithmX509 (APublicVerifyKey a _) = signatureAlgorithmX509 a
+  {-# INLINE signatureAlgorithmX509 #-}

 -- | An instance for 'ASignatureKeyPair' / ('PublicKeyType' pk, pk), without touching its type family.
 instance SignatureAlgorithmX509 pk => SignatureAlgorithmX509 (a, pk) where
  signatureAlgorithmX509 = signatureAlgorithmX509 . snd
+  {-# INLINE signatureAlgorithmX509 #-}

 -- | A wrapper to marshall signed ASN1 objects, like certificates.
-newtype SignedObject a = SignedObject {getSignedExact :: SignedExact a}
+newtype SignedObject a = SignedObject {getSignedExact :: X.SignedExact a}

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

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

 instance (Eq a, Show a, ASN1Object a) => Encoding (SignedObject a) where
-  smpEncode (SignedObject exact) = smpEncode . Large $ encodeSignedObject exact
-  smpP = fmap SignedObject . decodeSignedObject . unLarge <$?> smpP
+  smpEncode (SignedObject exact) = smpEncode . Large $ X.encodeSignedObject exact
+  smpP = fmap SignedObject . X.decodeSignedObject . unLarge <$?> smpP

-encodeCertChain :: CertificateChain -> L.NonEmpty Large
+encodeCertChain :: X.CertificateChain -> L.NonEmpty Large
 encodeCertChain cc = L.fromList $ map Large blobs
  where
-    CertificateChainRaw blobs = encodeCertificateChain cc
+    X.CertificateChainRaw blobs = X.encodeCertificateChain cc

-certChainP :: A.Parser CertificateChain
+certChainP :: A.Parser X.CertificateChain
 certChainP = do
-  rawChain <- CertificateChainRaw . map unLarge . L.toList <$> smpP
-  either (fail . show) pure $ decodeCertificateChain rawChain
+  rawChain <- X.CertificateChainRaw . map unLarge . L.toList <$> smpP
+  either (fail . show) pure $ X.decodeCertificateChain rawChain

 -- | Signature verification.
 --
@@ -1192,6 +1252,7 @@ certChainP = do
 verify' :: SignatureAlgorithm a => PublicKey a -> Signature a -> ByteString -> Bool
 verify' (PublicKeyEd25519 k) (SignatureEd25519 sig) msg = Ed25519.verify k msg sig
 verify' (PublicKeyEd448 k) (SignatureEd448 sig) msg = Ed448.verify k msg sig
+{-# INLINE verify' #-}

 verify :: APublicVerifyKey -> ASignature -> ByteString -> Bool
 verify (APublicVerifyKey a k) (ASignature a' sig) msg = case testEquality a a' of
@@ -1201,25 +1262,35 @@ verify (APublicVerifyKey a k) (ASignature a' sig) msg = case testEquality a a' o
 dh' :: DhAlgorithm a => PublicKey a -> PrivateKey a -> DhSecret a
 dh' (PublicKeyX25519 k) (PrivateKeyX25519 pk _) = DhSecretX25519 $ X25519.dh k pk
 dh' (PublicKeyX448 k) (PrivateKeyX448 pk _) = DhSecretX448 $ X448.dh k pk
+{-# INLINE dh' #-}

 -- | NaCl @crypto_box@ encrypt with padding with a shared DH secret and 192-bit nonce.
 cbEncrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
 cbEncrypt (DhSecretX25519 secret) = sbEncrypt_ secret
+{-# INLINE cbEncrypt #-}

 -- | NaCl @crypto_box@ encrypt with a shared DH secret and 192-bit nonce (without padding).
 cbEncryptNoPad :: DhSecret X25519 -> CbNonce -> ByteString -> ByteString
 cbEncryptNoPad (DhSecretX25519 secret) (CbNonce nonce) = cryptoBox secret nonce
+{-# INLINE cbEncryptNoPad #-}

 -- | NaCl @secret_box@ encrypt with a symmetric 256-bit key and 192-bit nonce.
 sbEncrypt :: SbKey -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
 sbEncrypt (SbKey key) = sbEncrypt_ key
+{-# INLINE sbEncrypt #-}

 sbEncrypt_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
 sbEncrypt_ secret (CbNonce nonce) msg paddedLen = cryptoBox secret nonce <$> pad msg paddedLen
+{-# INLINE sbEncrypt_ #-}
+
+sbEncryptNoPad :: SbKey -> CbNonce -> ByteString -> ByteString
+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
+{-# INLINE cbEncryptMaxLenBS #-}

 cryptoBox :: ByteArrayAccess key => key -> ByteString -> ByteString -> ByteString
 cryptoBox secret nonce s = BA.convert tag <> c
@@ -1230,18 +1301,26 @@ cryptoBox secret nonce s = BA.convert tag <> 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
+{-# INLINE cbDecrypt #-}

 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
 cbDecryptNoPad :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
 cbDecryptNoPad (DhSecretX25519 secret) = sbDecryptNoPad_ secret
+{-# INLINE cbDecryptNoPad #-}

 -- | NaCl @secret_box@ decrypt with a symmetric 256-bit key and 192-bit nonce.
 sbDecrypt :: SbKey -> CbNonce -> ByteString -> Either CryptoError ByteString
 sbDecrypt (SbKey key) = sbDecrypt_ key
+{-# INLINE sbDecrypt #-}

 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
 sbDecrypt_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Either CryptoError ByteString
 sbDecrypt_ secret nonce = unPad <=< sbDecryptNoPad_ secret nonce
+{-# INLINE sbDecrypt_ #-}
+
+sbDecryptNoPad :: SbKey -> CbNonce -> ByteString -> Either CryptoError ByteString
+sbDecryptNoPad (SbKey key) = sbDecryptNoPad_ key
+{-# INLINE sbDecryptNoPad #-}

 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
 sbDecryptNoPad_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Either CryptoError ByteString
@@ -1350,20 +1429,23 @@ newtype SbChainKey = SecretBoxChainKey {unSbChainKey :: ByteString}
 sbcInit :: ByteArrayAccess secret => ByteString -> secret -> (SbChainKey, SbChainKey)
 sbcInit salt secret = (SecretBoxChainKey ck1, SecretBoxChainKey ck2)
  where
-    prk = H.extract salt secret :: H.PRK SHA512
-    out = H.expand prk ("SimpleXSbChainInit" :: ByteString) 64
-    (ck1, ck2) = B.splitAt 32 out
+    (ck1, ck2) = B.splitAt 32 $ hkdf salt secret "SimpleXSbChainInit" 64

 type SbKeyNonce = (SbKey, CbNonce)

 sbcHkdf :: SbChainKey -> (SbKeyNonce, SbChainKey)
 sbcHkdf (SecretBoxChainKey ck) = ((SecretBoxKey sk, CryptoBoxNonce nonce), SecretBoxChainKey ck')
  where
-    prk = H.extract B.empty ck :: H.PRK SHA512
-    out = H.expand prk ("SimpleXSbChain" :: ByteString) 88 -- = 32 (new chain key) + 32 (secret_box key) + 24 (nonce)
+    out = hkdf "" ck "SimpleXSbChain" 88 -- = 32 (new chain key) + 32 (secret_box key) + 24 (nonce)
    (ck', rest) = B.splitAt 32 out
    (sk, nonce) = B.splitAt 32 rest

+hkdf :: ByteArrayAccess secret => ByteString -> secret -> ByteString -> Int -> ByteString
+hkdf salt ikm info n =
+  let prk = H.extract salt ikm :: H.PRK SHA512
+   in H.expand prk info n
+{-# INLINE hkdf #-}
+
 xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString)
 xSalsa20 secret nonce msg = (rs, msg')
  where
@@ -1374,19 +1456,19 @@ xSalsa20 secret nonce msg = (rs, msg')
    (rs, state2) = XSalsa.generate state1 32
    (msg', _) = XSalsa.combine state2 msg

-publicToX509 :: PublicKey a -> PubKey
+publicToX509 :: PublicKey a -> X.PubKey
 publicToX509 = \case
-  PublicKeyEd25519 k -> PubKeyEd25519 k
-  PublicKeyEd448 k -> PubKeyEd448 k
-  PublicKeyX25519 k -> PubKeyX25519 k
-  PublicKeyX448 k -> PubKeyX448 k
+  PublicKeyEd25519 k -> X.PubKeyEd25519 k
+  PublicKeyEd448 k -> X.PubKeyEd448 k
+  PublicKeyX25519 k -> X.PubKeyX25519 k
+  PublicKeyX448 k -> X.PubKeyX448 k

-privateToX509 :: PrivateKey a -> PrivKey
+privateToX509 :: PrivateKey a -> X.PrivKey
 privateToX509 = \case
-  PrivateKeyEd25519 k _ -> PrivKeyEd25519 k
-  PrivateKeyEd448 k _ -> PrivKeyEd448 k
-  PrivateKeyX25519 k _ -> PrivKeyX25519 k
-  PrivateKeyX448 k _ -> PrivKeyX448 k
+  PrivateKeyEd25519 k _ -> X.PrivKeyEd25519 k
+  PrivateKeyEd448 k _ -> X.PrivKeyEd448 k
+  PrivateKeyX25519 k _ -> X.PrivKeyX25519 k
+  PrivateKeyX448 k _ -> X.PrivKeyX448 k

 encodeASNObj :: ASN1Object a => a -> ByteString
 encodeASNObj k = toStrict . encodeASN1 DER $ toASN1 k []
@@ -1399,22 +1481,30 @@ decodePubKey = decodeKey >=> x509ToPublic >=> pubKey
 decodePrivKey :: CryptoPrivateKey k => ByteString -> Either String k
 decodePrivKey = decodeKey >=> x509ToPrivate >=> privKey

-x509ToPublic :: (PubKey, [ASN1]) -> Either String APublicKey
+x509ToPublic :: (X.PubKey, [ASN1]) -> Either String APublicKey
 x509ToPublic = \case
-  (PubKeyEd25519 k, []) -> Right . APublicKey SEd25519 $ PublicKeyEd25519 k
-  (PubKeyEd448 k, []) -> Right . APublicKey SEd448 $ PublicKeyEd448 k
-  (PubKeyX25519 k, []) -> Right . APublicKey SX25519 $ PublicKeyX25519 k
-  (PubKeyX448 k, []) -> Right . APublicKey SX448 $ PublicKeyX448 k
+  (X.PubKeyEd25519 k, []) -> Right . APublicKey SEd25519 $ PublicKeyEd25519 k
+  (X.PubKeyEd448 k, []) -> Right . APublicKey SEd448 $ PublicKeyEd448 k
+  (X.PubKeyX25519 k, []) -> Right . APublicKey SX25519 $ PublicKeyX25519 k
+  (X.PubKeyX448 k, []) -> Right . APublicKey SX448 $ PublicKeyX448 k
  r -> keyError r

-x509ToPrivate :: (PrivKey, [ASN1]) -> Either String APrivateKey
+x509ToPublic' :: CryptoPublicKey k => X.PubKey -> Either String k
+x509ToPublic' k = x509ToPublic (k, []) >>= pubKey
+{-# INLINE x509ToPublic' #-}
+
+x509ToPrivate :: (X.PrivKey, [ASN1]) -> Either String APrivateKey
 x509ToPrivate = \case
-  (PrivKeyEd25519 k, []) -> Right . APrivateKey SEd25519 . PrivateKeyEd25519 k $ Ed25519.toPublic k
-  (PrivKeyEd448 k, []) -> Right . APrivateKey SEd448 . PrivateKeyEd448 k $ Ed448.toPublic k
-  (PrivKeyX25519 k, []) -> Right . APrivateKey SX25519 . PrivateKeyX25519 k $ X25519.toPublic k
-  (PrivKeyX448 k, []) -> Right . APrivateKey SX448 . PrivateKeyX448 k $ X448.toPublic k
+  (X.PrivKeyEd25519 k, []) -> Right . APrivateKey SEd25519 . PrivateKeyEd25519 k $ Ed25519.toPublic k
+  (X.PrivKeyEd448 k, []) -> Right . APrivateKey SEd448 . PrivateKeyEd448 k $ Ed448.toPublic k
+  (X.PrivKeyX25519 k, []) -> Right . APrivateKey SX25519 . PrivateKeyX25519 k $ X25519.toPublic k
+  (X.PrivKeyX448 k, []) -> Right . APrivateKey SX448 . PrivateKeyX448 k $ X448.toPublic k
  r -> keyError r

+x509ToPrivate' :: CryptoPrivateKey k => X.PrivKey -> Either String k
+x509ToPrivate' pk = x509ToPrivate (pk, []) >>= privKey
+{-# INLINE x509ToPrivate' #-}
+
 decodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1])
 decodeKey = fromASN1 <=< first show . decodeASN1 DER . fromStrict

@@ -21,6 +21,8 @@
 module Simplex.Messaging.Crypto.Ratchet
  ( Ratchet (..),
    RatchetX448,
+    MsgEncryptKey (..),
+    MsgEncryptKeyX448,
    SkippedMsgDiff (..),
    SkippedMsgKeys,
    InitialKeys (..),
@@ -53,8 +55,10 @@ module Simplex.Messaging.Crypto.Ratchet
    supportedE2EEncryptVRange,
    generateRcvE2EParams,
    generateSndE2EParams,
+    mkRcvE2ERatchetParams,
    initialPQEncryption,
    connPQEncryption,
+    joinContactInitialKeys,
    replyKEM_,
    pqSupportToEnc,
    pqEncToSupport,
@@ -64,7 +68,9 @@ module Simplex.Messaging.Crypto.Ratchet
    pqX3dhRcv,
    initSndRatchet,
    initRcvRatchet,
-    rcEncrypt,
+    rcCheckCanPad,
+    rcEncryptHeader,
+    rcEncryptMsg,
    rcDecrypt,
    -- used in tests
    MsgHeader (..),
@@ -85,12 +91,11 @@ module Simplex.Messaging.Crypto.Ratchet
 where

 import Control.Applicative ((<|>))
+import Control.Monad (unless)
 import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except
 import Crypto.Cipher.AES (AES256)
-import Crypto.Hash (SHA512)
-import qualified Crypto.KDF.HKDF as H
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as J
@@ -111,12 +116,12 @@ import Data.Type.Equality
 import Data.Typeable (Typeable)
 import Data.Word (Word16, Word32)
 import Simplex.Messaging.Agent.QueryString
-import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), FromField (..), ToField (..))
+import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), FromField (..), ToField (..), blobFieldDecoder)
 import Simplex.Messaging.Crypto
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, parseE, parseE')
+import Simplex.Messaging.Parsers (defaultJSON, parseE, parseE')
 import Simplex.Messaging.Util (($>>=), (<$?>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
@@ -192,6 +197,8 @@ data ARKEMParams = forall s. RatchetKEMStateI s => ARKP (SRatchetKEMState s) (RK

 deriving instance Show ARKEMParams

+type RcvRKEMParams = RKEMParams 'RKSProposed
+
 instance RatchetKEMStateI s => Encoding (RKEMParams s) where
  smpEncode = \case
    RKParamsProposed k -> smpEncode ('P', k)
@@ -303,11 +310,13 @@ instance (RatchetKEMStateI s, AlgorithmI a) => StrEncoding (E2ERatchetParamsUri
        | otherwise = case kem of
            RKParamsProposed k -> [("kem_key", strEncode k)]
            RKParamsAccepted ct k -> [("kem_ct", strEncode ct), ("kem_key", strEncode k)]
-  strP = toParamsURI <$?> strP
-    where
-      toParamsURI = \case
-        AE2ERatchetParamsUri _ (E2ERatchetParamsUri vr k1 k2 Nothing) -> Right $ E2ERatchetParamsUri vr k1 k2 Nothing
-        AE2ERatchetParamsUri _ ps -> checkRatchetKEMState ps
+  strP = toE2ERatchetParamsUri <$?> strP
+  {-# INLINE strP #-}
+
+toE2ERatchetParamsUri :: RatchetKEMStateI s => AE2ERatchetParamsUri a -> Either String (E2ERatchetParamsUri s a)
+toE2ERatchetParamsUri = \case
+  AE2ERatchetParamsUri _ (E2ERatchetParamsUri vr k1 k2 Nothing) -> Right $ E2ERatchetParamsUri vr k1 k2 Nothing
+  AE2ERatchetParamsUri _ ps -> checkRatchetKEMState ps

 instance AlgorithmI a => StrEncoding (AE2ERatchetParamsUri a) where
  strEncode (AE2ERatchetParamsUri _ ps) = strEncode ps
@@ -337,6 +346,33 @@ instance StrEncoding AnyE2ERatchetParamsUri where
        Nothing -> ARKP SRKSProposed $ RKParamsProposed k
        Just ct -> ARKP SRKSAccepted $ RKParamsAccepted ct k

+instance (RatchetKEMStateI s, AlgorithmI a) => Encoding (E2ERatchetParamsUri s a) where
+  smpEncode (E2ERatchetParamsUri vr k1 k2 kem_) = smpEncode (vr, k1, k2, kem_)
+  {-# INLINE smpEncode #-}
+  smpP = toE2ERatchetParamsUri <$?> smpP
+  {-# INLINE smpP #-}
+
+instance AlgorithmI a => Encoding (AE2ERatchetParamsUri a) where
+  smpEncode (AE2ERatchetParamsUri _ ps) = smpEncode ps
+  {-# INLINE smpEncode #-}
+  smpP = (\(AnyE2ERatchetParamsUri s _ ps) -> AE2ERatchetParamsUri s <$> checkAlgorithm ps) <$?> smpP
+  {-# INLINE smpP #-}
+
+instance Encoding AnyE2ERatchetParamsUri where
+  smpEncode (AnyE2ERatchetParamsUri _ _ ps) = smpEncode ps
+  {-# INLINE smpEncode #-}
+  smpP = do
+    vr <- smpP @VersionRangeE2E
+    APublicDhKey a k1 <- smpP
+    APublicDhKey a' k2 <- smpP
+    case testEquality a a' of
+      Nothing -> fail "bad e2e params: different key algorithms"
+      Just Refl ->
+        let result = \case
+              Just (ARKP s kem) -> AnyE2ERatchetParamsUri s a $ E2ERatchetParamsUri vr k1 k2 (Just kem)
+              Nothing -> AnyE2ERatchetParamsUri SRKSProposed a $ E2ERatchetParamsUri vr k1 k2 Nothing
+         in result <$> smpP
+
 type RcvE2ERatchetParams a = E2ERatchetParams 'RKSProposed a

 type SndE2ERatchetParams a = AE2ERatchetParams a
@@ -373,6 +409,12 @@ data UseKEM (s :: RatchetKEMState) where

 data AUseKEM = forall s. RatchetKEMStateI s => AUseKEM (SRatchetKEMState s) (UseKEM s)

+mkRcvE2ERatchetParams :: VersionE2E -> (PrivateKey a, PrivateKey a, Maybe RcvPrivRKEMParams) -> RcvE2ERatchetParams a
+mkRcvE2ERatchetParams v (pk1, pk2, pKem) = E2ERatchetParams v (publicKey pk1) (publicKey pk2) (mkKem <$> pKem)
+  where
+    mkKem :: RcvPrivRKEMParams -> RcvRKEMParams
+    mkKem (PrivateRKParamsProposed (k, _)) = RKParamsProposed k
+
 generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s), E2ERatchetParams s a)
 generateE2EParams g v useKEM_ = do
  (k1, pk1) <- atomically $ generateKeyPair g
@@ -564,6 +606,7 @@ applySMDiff smks = \case
 type HeaderKey = Key

 data MessageKey = MessageKey Key IV
+  deriving (Show)

 instance Encoding MessageKey where
  smpEncode (MessageKey (Key key) (IV iv)) = smpEncode (key, iv)
@@ -818,36 +861,47 @@ instance StrEncoding PQSupport where
  strP = pqEncToSupport <$> strP
  {-# INLINE strP #-}

-data InitialKeys = IKUsePQ | IKNoPQ PQSupport
+data InitialKeys
+  = IKUsePQ -- use PQ keys in contact request and short link data
+  | IKLinkPQ PQSupport -- use PQ keys in short link data only, if PQSupport enabled
  deriving (Eq, Show)

 pattern IKPQOn :: InitialKeys
-pattern IKPQOn = IKNoPQ PQSupportOn
+pattern IKPQOn = IKLinkPQ PQSupportOn

 pattern IKPQOff :: InitialKeys
-pattern IKPQOff = IKNoPQ PQSupportOff
+pattern IKPQOff = IKLinkPQ PQSupportOff

 instance StrEncoding InitialKeys where
  strEncode = \case
    IKUsePQ -> "pq=invitation"
-    IKNoPQ pq -> strEncode pq
-  strP = IKNoPQ <$> strP <|> "pq=invitation" $> IKUsePQ
+    IKLinkPQ pq -> strEncode pq
+  strP = IKLinkPQ <$> strP <|> "pq=invitation" $> IKUsePQ

 -- determines whether PQ key should be included in invitation link
-initialPQEncryption :: InitialKeys -> PQSupport
-initialPQEncryption = \case
+initialPQEncryption :: Bool -> InitialKeys -> PQSupport
+initialPQEncryption shortLink = \case
  IKUsePQ -> PQSupportOn
-  IKNoPQ _ -> PQSupportOff -- default
+  IKLinkPQ (PQSupport enable) -> PQSupport $ enable && shortLink

 -- determines whether PQ encryption should be used in connection
 connPQEncryption :: InitialKeys -> PQSupport
 connPQEncryption = \case
  IKUsePQ -> PQSupportOn
-  IKNoPQ pq -> pq -- default for creating connection is IKNoPQ PQEncOn
+  IKLinkPQ pq -> pq -- default for creating connection is IKLinkPQ PQEncOn

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

+type MsgEncryptKeyX448 = MsgEncryptKey 'X448
+
+data MsgEncryptKey a = MsgEncryptKey
+  { msgRcVersion :: VersionE2E,
+    msgKey :: MessageKey,
+    msgRcAD :: ByteString,
+    msgEncHeader :: ByteString
+  }
+  deriving (Show)
+
+rcEncryptMsg :: AlgorithmI a => MsgEncryptKey a -> Int -> ByteString -> ExceptT CryptoError IO ByteString
+rcEncryptMsg MsgEncryptKey {msgKey = MessageKey mk iv, msgRcAD, msgEncHeader, msgRcVersion = v} paddedMsgLen msg = do
+  -- return ENCRYPT(mk, plaintext, CONCAT(AD, enc_header))
+  (emAuthTag, emBody) <- encryptAEAD mk iv paddedMsgLen (msgRcAD <> msgEncHeader) msg
+  let msg' = encodeEncRatchetMessage v EncRatchetMessage {emHeader = msgEncHeader, emBody, emAuthTag}
+  pure msg'
+
 data SkippedMessage a
  = SMMessage (DecryptResult a)
  | SMHeader (Maybe RatchetStep) (MsgHeader a)
@@ -1099,8 +1174,7 @@ chainKdf (RatchetKey ck) =
 hkdf3 :: ByteString -> ByteString -> ByteString -> (ByteString, ByteString, ByteString)
 hkdf3 salt ikm info = (s1, s2, s3)
  where
-    prk = H.extract salt ikm :: H.PRK SHA512
-    out = H.expand prk info 96
+    out = hkdf salt ikm info 96
    (s1, rest) = B.splitAt 32 out
    (s2, s3) = B.splitAt 32 rest

@@ -1130,7 +1204,7 @@ instance (AlgorithmI a, Typeable a) => FromField (Ratchet a) where fromField = b

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

-instance FromField PQEncryption where 
+instance FromField PQEncryption where
 #if defined(dbPostgres)
  fromField f dat = PQEncryption . unBI <$> fromField f dat
 #else
@@ -1145,3 +1219,14 @@ instance FromField PQSupport where
 #else
  fromField f = PQSupport . unBI <$> fromField f
 #endif
+
+instance Encoding (MsgEncryptKey a) where
+  smpEncode MsgEncryptKey {msgRcVersion = v, msgKey, msgRcAD, msgEncHeader} =
+    smpEncode (v, msgRcAD, msgKey, Large msgEncHeader)
+  smpP = do
+    (v, msgRcAD, msgKey, Large msgEncHeader) <- smpP
+    pure MsgEncryptKey {msgRcVersion = v, msgRcAD, msgKey, msgEncHeader}
+
+instance AlgorithmI a => ToField (MsgEncryptKey a) where toField = toField . Binary . smpEncode
+
+instance (AlgorithmI a, Typeable a) => FromField (MsgEncryptKey a) where fromField = blobFieldDecoder smpDecode
@@ -10,11 +10,10 @@ import Data.Bifunctor (bimap)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
-import Foreign (nullPtr)
 import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
-import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (withDRG)
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (rngFuncPtr, withDRG)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String

@@ -43,7 +42,7 @@ sntrup761Keypair drg =
      c_SNTRUP761_SECRETKEY_SIZE
      ( \skPtr ->
          BA.alloc c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
-            withDRG drg $ c_sntrup761_keypair pkPtr skPtr nullPtr
+            withDRG drg $ \cxtPtr -> c_sntrup761_keypair pkPtr skPtr cxtPtr rngFuncPtr
      )

 sntrup761Enc :: TVar ChaChaDRG -> KEMPublicKey -> IO (KEMCiphertext, KEMSharedKey)
@@ -54,7 +53,7 @@ sntrup761Enc drg (KEMPublicKey pk) =
        c_SNTRUP761_SIZE
        ( \kPtr ->
            BA.alloc c_SNTRUP761_CIPHERTEXT_SIZE $ \cPtr ->
-              withDRG drg $ c_sntrup761_enc cPtr kPtr pkPtr nullPtr
+              withDRG drg $ \cxtPtr -> c_sntrup761_enc cPtr kPtr pkPtr cxtPtr rngFuncPtr
        )

 sntrup761Dec :: KEMCiphertext -> KEMSecretKey -> IO KEMSharedKey
@@ -1,5 +1,6 @@
 module Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
  ( withDRG,
+    rngFuncPtr,
    RNGContext,
    RNGFunc,
  ) where
@@ -12,19 +13,20 @@ import Foreign
 import Foreign.C
 import qualified Simplex.Messaging.Crypto as C

-withDRG :: TVar ChaChaDRG -> (FunPtr RNGFunc -> IO a) -> IO a
-withDRG drg = bracket (createRNGFunc drg) freeHaskellFunPtr
+withDRG :: TVar ChaChaDRG -> (Ptr RNGContext -> IO a) -> IO a
+withDRG drg = bracket (castStablePtrToPtr <$> newStablePtr drg) (freeStablePtr . castPtrToStablePtr)

-createRNGFunc :: TVar ChaChaDRG -> IO (FunPtr RNGFunc)
-createRNGFunc drg =
-  mkRNGFunc $ \_ctx sz buf -> do
-    bs <- atomically $ C.randomBytes (fromIntegral sz) drg
-    copyByteArrayToPtr bs buf
+rngFunc :: RNGFunc
+rngFunc cxt sz buf = do
+  drg <- deRefStablePtr $ castPtrToStablePtr cxt
+  bs <- atomically $ C.randomBytes (fromIntegral sz) drg
+  copyByteArrayToPtr bs buf

 type RNGContext = ()

 -- typedef void random_func (void *ctx, size_t length, uint8_t *dst);
 type RNGFunc = Ptr RNGContext -> CSize -> Ptr Word8 -> IO ()

-foreign import ccall "wrapper"
-  mkRNGFunc :: RNGFunc -> IO (FunPtr RNGFunc)
+foreign export ccall "haskell_rng_func" rngFunc :: RNGFunc
+
+foreign import ccall "&haskell_rng_func" rngFuncPtr :: FunPtr RNGFunc
@@ -0,0 +1,102 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Simplex.Messaging.Crypto.ShortLink
+  ( contactShortLinkKdf,
+    invShortLinkKdf,
+    encodeSignLinkData,
+    encodeSignUserData,
+    encryptLinkData,
+    encryptUserData,
+    decryptLinkData,
+  )
+where
+
+import Control.Concurrent.STM
+import Control.Monad.Except
+import Control.Monad.IO.Class
+import Crypto.Random (ChaChaDRG)
+import Data.Bifunctor (first)
+import Data.Bitraversable (bimapM)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import Simplex.Messaging.Agent.Client (cryptoError)
+import Simplex.Messaging.Agent.Protocol
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Protocol (EntityId (..), LinkId, EncDataBytes (..), QueueLinkData)
+import Simplex.Messaging.Util (liftEitherWith)
+
+fixedDataPaddedLength :: Int
+fixedDataPaddedLength = 2008 -- 2048 - 24 (nonce) - 16 (auth tag)
+
+userDataPaddedLength :: Int
+userDataPaddedLength = 13784 -- 13824 - 24 - 16
+
+contactShortLinkKdf :: LinkKey -> (LinkId, C.SbKey)
+contactShortLinkKdf (LinkKey k) =
+  let (lnkId, sbKey) = B.splitAt 24 $ C.hkdf "" k "SimpleXContactLink" 56
+   in (EntityId lnkId, C.unsafeSbKey sbKey)
+
+invShortLinkKdf :: LinkKey -> C.SbKey
+invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
+
+encodeSignLinkData :: forall c. ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserLinkData -> (LinkKey, (ByteString, ByteString))
+encodeSignLinkData (rootKey, pk) agentVRange connReq userData =
+  let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq}
+      md = smpEncode $ connLinkData @c agentVRange userData
+   in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md))
+
+encodeSignUserData :: forall c. ConnectionModeI c => SConnectionMode c -> C.PrivateKeyEd25519 -> VersionRangeSMPA -> UserLinkData -> ByteString
+encodeSignUserData _ pk agentVRange userData =
+  encodeSign pk $ smpEncode $ connLinkData @c agentVRange userData
+
+connLinkData :: forall c. ConnectionModeI c => VersionRangeSMPA -> UserLinkData -> ConnLinkData c
+connLinkData agentVRange userData = case sConnectionMode @c of
+  SCMInvitation -> InvitationLinkData agentVRange userData
+  SCMContact -> ContactLinkData {agentVRange, direct = True, owners = [], relays = [], userData}
+
+encodeSign :: C.PrivateKeyEd25519 -> ByteString -> ByteString
+encodeSign pk s = smpEncode (C.sign' pk s) <> s
+
+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
+
+encryptUserData :: TVar ChaChaDRG -> C.SbKey -> ByteString -> ExceptT AgentErrorType IO EncDataBytes
+encryptUserData g k s = encryptData g k userDataPaddedLength s
+
+encryptData :: TVar ChaChaDRG -> C.SbKey -> Int -> ByteString -> ExceptT AgentErrorType IO EncDataBytes
+encryptData g k len s = do
+  nonce <- liftIO $ atomically $ C.randomCbNonce g
+  ct <- liftEitherWith cryptoError $ C.sbEncrypt k nonce s len
+  pure $ EncDataBytes $ smpEncode nonce <> ct
+
+decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnLinkData c)
+decryptLinkData linkKey k (encFD, encMD) = do
+  (sig1, fd) <- decrypt encFD
+  (sig2, md) <- decrypt encMD
+  FixedLinkData {rootKey, connReq} <- decode fd
+  md' <- decode @(ConnLinkData c) md
+  if
+    | LinkKey (C.sha3_256 fd) /= linkKey -> linkErr "link data hash"
+    | not (C.verify' rootKey sig1 fd) -> linkErr "link data signature"
+    | not (C.verify' rootKey sig2 md) -> linkErr "user data signature"
+    | otherwise -> Right (connReq, md')
+  where
+    decrypt (EncDataBytes d) = do
+      (nonce, Tail ct) <- decode d
+      (sig, Tail s) <- decode =<< first cryptoError (C.sbDecrypt k nonce ct)
+      pure (sig, s)
+    decode :: Encoding a => ByteString -> Either AgentErrorType a
+    decode = msgErr . smpDecode
+    msgErr = first (const $ AGENT A_MESSAGE)
+    linkErr = Left . AGENT . A_LINK
@@ -143,7 +143,7 @@ instance Encoding Large where
 instance Encoding SystemTime where
  smpEncode = smpEncode . systemSeconds
  {-# INLINE smpEncode #-}
-  smpP = MkSystemTime <$> smpP <*> pure 0
+  smpP = (`MkSystemTime` 0) <$> smpP
  {-# INLINE smpP #-}

 _smpP :: Encoding a => Parser a
@@ -39,9 +39,11 @@ import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Time.Format.ISO8601
 import Data.Word (Word16, Word32)
+import qualified Data.X509 as X
+import qualified Data.X509.Validation as XV
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Util (bshow, (<$?>))
+import Simplex.Messaging.Util (bshow, safeDecodeUtf8, (<$?>))

 class TextEncoding a where
  textEncode :: a -> Text
@@ -89,6 +91,10 @@ instance StrEncoding String where
  strEncode = strEncode . B.pack
  strP = B.unpack <$> strP

+instance StrEncoding Text where
+  strEncode = encodeUtf8
+  strP = safeDecodeUtf8 <$> A.takeTill (\c -> c == ' ' || c == '\n')
+
 instance ToJSON Str where
  toJSON (Str s) = strToJSON s
  toEncoding (Str s) = strToJEncoding s
@@ -140,11 +146,23 @@ instance StrEncoding Int64 where

 instance StrEncoding SystemTime where
  strEncode = strEncode . systemSeconds
-  strP = MkSystemTime <$> strP <*> pure 0
+  strP = (`MkSystemTime` 0) <$> strP

 instance StrEncoding UTCTime where
  strEncode = B.pack . iso8601Show
-  strP = maybe (Left "bad UTCTime") Right . iso8601ParseM . B.unpack <$?> A.takeTill (\c -> c == ' ' || c == '\n')
+  strP = maybe (Left "bad UTCTime") Right . iso8601ParseM . B.unpack <$?> A.takeTill (\c -> c == ' ' || c == '\n' || c == ',' || c == ';')
+
+instance StrEncoding X.CertificateChain where
+  strEncode = (\(X.CertificateChainRaw blobs) -> strEncodeList blobs) . X.encodeCertificateChain
+  {-# INLINE strEncode #-}
+  strP = either (fail . show) pure . X.decodeCertificateChain . X.CertificateChainRaw =<< strListP
+  {-# INLINE strP #-}
+
+instance StrEncoding XV.Fingerprint where
+  strEncode (XV.Fingerprint s) = strEncode s
+  {-# INLINE strEncode #-}
+  strP = XV.Fingerprint <$> strP
+  {-# INLINE strP #-}

 -- lists encode/parse as comma-separated strings
 strEncodeList :: StrEncoding a => [a] -> ByteString
@@ -14,7 +14,7 @@ import Data.Word (Word16)
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Notifications.Transport (NTFVersion, supportedClientNTFVRange, supportedNTFHandshakes)
+import Simplex.Messaging.Notifications.Transport (NTFVersion, supportedClientNTFVRange, alpnSupportedNTFHandshakes)
 import Simplex.Messaging.Protocol (ErrorType, pattern NoEntity)
 import Simplex.Messaging.Transport (TLS, Transport (..))

@@ -24,44 +24,45 @@ type NtfClientError = ProtocolClientError ErrorType

 defaultNTFClientConfig :: ProtocolClientConfig NTFVersion
 defaultNTFClientConfig =
-  (defaultClientConfig (Just supportedNTFHandshakes) False supportedClientNTFVRange)
+  (defaultClientConfig (Just alpnSupportedNTFHandshakes) False supportedClientNTFVRange)
    {defaultTransport = ("443", transport @TLS)}
 {-# INLINE defaultNTFClientConfig #-}

-ntfRegisterToken :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Token -> ExceptT NtfClientError IO (NtfTokenId, C.PublicKeyX25519)
-ntfRegisterToken c pKey newTkn =
-  sendNtfCommand c (Just pKey) NoEntity (TNEW newTkn) >>= \case
+ntfRegisterToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NewNtfEntity 'Token -> ExceptT NtfClientError IO (NtfTokenId, C.PublicKeyX25519)
+ntfRegisterToken c nm pKey newTkn =
+  sendNtfCommand c nm (Just pKey) NoEntity (TNEW newTkn) >>= \case
    NRTknId tknId dhKey -> pure (tknId, dhKey)
    r -> throwE $ unexpectedResponse r

-ntfVerifyToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> NtfRegCode -> ExceptT NtfClientError IO ()
-ntfVerifyToken c pKey tknId code = okNtfCommand (TVFY code) c pKey tknId
+ntfVerifyToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> NtfRegCode -> ExceptT NtfClientError IO ()
+ntfVerifyToken c nm pKey tknId code = okNtfCommand (TVFY code) c nm pKey tknId

-ntfCheckToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClientError IO NtfTknStatus
-ntfCheckToken c pKey tknId =
-  sendNtfCommand c (Just pKey) tknId TCHK >>= \case
+ntfCheckToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClientError IO NtfTknStatus
+ntfCheckToken c nm pKey tknId =
+  sendNtfCommand c nm (Just pKey) tknId TCHK >>= \case
    NRTkn stat -> pure stat
    r -> throwE $ unexpectedResponse r

-ntfReplaceToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> DeviceToken -> ExceptT NtfClientError IO ()
-ntfReplaceToken c pKey tknId token = okNtfCommand (TRPL token) c pKey tknId
+ntfReplaceToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> DeviceToken -> ExceptT NtfClientError IO ()
+ntfReplaceToken c nm pKey tknId token = okNtfCommand (TRPL token) c nm pKey tknId

-ntfDeleteToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClientError IO ()
+ntfDeleteToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClientError IO ()
 ntfDeleteToken = okNtfCommand TDEL

-ntfEnableCron :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> Word16 -> ExceptT NtfClientError IO ()
-ntfEnableCron c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId
+-- set to 0 to disable
+ntfSetCronInterval :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> Word16 -> ExceptT NtfClientError IO ()
+ntfSetCronInterval c nm pKey tknId int = okNtfCommand (TCRN int) c nm pKey tknId

 ntfCreateSubscription :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Subscription -> ExceptT NtfClientError IO NtfSubscriptionId
 ntfCreateSubscription c pKey newSub =
-  sendNtfCommand c (Just pKey) NoEntity (SNEW newSub) >>= \case
+  sendNtfCommand c NRMBackground (Just pKey) NoEntity (SNEW newSub) >>= \case
    NRSubId subId -> pure subId
    r -> throwE $ unexpectedResponse r

 ntfCreateSubscriptions :: NtfClient -> C.APrivateAuthKey -> NonEmpty (NewNtfEntity 'Subscription) -> IO (NonEmpty (Either NtfClientError NtfSubscriptionId))
-ntfCreateSubscriptions c pKey newSubs = L.map process <$> sendProtocolCommands c cs
+ntfCreateSubscriptions c pKey newSubs = L.map process <$> sendProtocolCommands c NRMBackground cs
  where
-    cs = L.map (\newSub -> (Just pKey, NoEntity, NtfCmd SSubscription $ SNEW newSub)) newSubs
+    cs = L.map (\newSub -> (NoEntity, Just pKey, NtfCmd SSubscription $ SNEW newSub)) newSubs
    process (Response _ r) = case r of
      Right (NRSubId subId) -> Right subId
      Right r' -> Left $ unexpectedResponse r'
@@ -69,28 +70,28 @@ ntfCreateSubscriptions c pKey newSubs = L.map process <$> sendProtocolCommands c

 ntfCheckSubscription :: NtfClient -> C.APrivateAuthKey -> NtfSubscriptionId -> ExceptT NtfClientError IO NtfSubStatus
 ntfCheckSubscription c pKey subId =
-  sendNtfCommand c (Just pKey) subId SCHK >>= \case
+  sendNtfCommand c NRMBackground (Just pKey) subId SCHK >>= \case
    NRSub stat -> pure stat
    r -> throwE $ unexpectedResponse r

 ntfCheckSubscriptions :: NtfClient -> C.APrivateAuthKey -> NonEmpty NtfSubscriptionId -> IO (NonEmpty (Either NtfClientError NtfSubStatus))
-ntfCheckSubscriptions c pKey subIds = L.map process <$> sendProtocolCommands c cs
+ntfCheckSubscriptions c pKey subIds = L.map process <$> sendProtocolCommands c NRMBackground cs
  where
-    cs = L.map (\subId -> (Just pKey, subId, NtfCmd SSubscription SCHK)) subIds
+    cs = L.map (\subId -> (subId, Just pKey, NtfCmd SSubscription SCHK)) subIds
    process (Response _ r) = case r of
      Right (NRSub stat) -> Right stat
      Right r' -> Left $ unexpectedResponse r'
      Left e -> Left e

 ntfDeleteSubscription :: NtfClient -> C.APrivateAuthKey -> NtfSubscriptionId -> ExceptT NtfClientError IO ()
-ntfDeleteSubscription = okNtfCommand SDEL
+ntfDeleteSubscription c = okNtfCommand SDEL c NRMBackground

 -- | Send notification server command
-sendNtfCommand :: NtfEntityI e => NtfClient -> Maybe C.APrivateAuthKey -> NtfEntityId -> NtfCommand e -> ExceptT NtfClientError IO NtfResponse
-sendNtfCommand c pKey entId cmd = sendProtocolCommand c pKey entId (NtfCmd sNtfEntity cmd)
+sendNtfCommand :: NtfEntityI e => NtfClient -> NetworkRequestMode -> Maybe C.APrivateAuthKey -> NtfEntityId -> NtfCommand e -> ExceptT NtfClientError IO NtfResponse
+sendNtfCommand c nm pKey entId cmd = sendProtocolCommand c nm pKey entId (NtfCmd sNtfEntity cmd)

-okNtfCommand :: NtfEntityI e => NtfCommand e -> NtfClient -> C.APrivateAuthKey -> NtfEntityId -> ExceptT NtfClientError IO ()
-okNtfCommand cmd c pKey entId =
-  sendNtfCommand c (Just pKey) entId cmd >>= \case
+okNtfCommand :: NtfEntityI e => NtfCommand e -> NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfEntityId -> ExceptT NtfClientError IO ()
+okNtfCommand cmd c nm pKey entId =
+  sendNtfCommand c nm (Just pKey) entId cmd >>= \case
    NROk -> return ()
    r -> throwE $ unexpectedResponse r
@@ -11,7 +11,7 @@

 module Simplex.Messaging.Notifications.Protocol where

-import Control.Applicative ((<|>))
+import Control.Applicative (optional, (<|>))
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
@@ -28,12 +28,11 @@ import Data.Time.Clock.System
 import Data.Type.Equality
 import Data.Word (Word16)
 import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts)
-import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
+import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Transport (NTFVersion, ntfClientHandshake)
-import Simplex.Messaging.Parsers (fromTextField_)
+import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake)
 import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
 import Simplex.Messaging.Util (eitherToMaybe, (<$?>))

@@ -155,10 +154,15 @@ instance Protocol NTFVersion ErrorType NtfResponse where
  type ProtoCommand NtfResponse = NtfCmd
  type ProtoType NtfResponse = 'PNTF
  protocolClientHandshake c _ks = ntfClientHandshake c
+  {-# INLINE protocolClientHandshake #-}
+  useServiceAuth _ = False
+  {-# INLINE useServiceAuth #-}
  protocolPing = NtfCmd SSubscription PING
+  {-# INLINE protocolPing #-}
  protocolError = \case
    NRErr e -> Just e
    _ -> Nothing
+  {-# INLINE protocolError #-}

 data NtfCommand (e :: NtfEntity) where
  -- | register new device token for notifications
@@ -210,7 +214,7 @@ instance NtfEntityI e => ProtocolEncoding NTFVersion ErrorType (NtfCommand e) wh
  fromProtocolError = fromProtocolError @NTFVersion @ErrorType @NtfResponse
  {-# INLINE fromProtocolError #-}

-  checkCredentials (auth, _, EntityId entityId, _) cmd = case cmd of
+  checkCredentials auth (EntityId entityId) cmd = case cmd of
    -- TNEW and SNEW must have signature but NOT token/subscription IDs
    TNEW {} -> sigNoEntity
    SNEW {} -> sigNoEntity
@@ -250,7 +254,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfCmd where
  fromProtocolError = fromProtocolError @NTFVersion @ErrorType @NtfResponse
  {-# INLINE fromProtocolError #-}

-  checkCredentials t (NtfCmd e c) = NtfCmd e <$> checkCredentials t c
+  checkCredentials tAuth entId (NtfCmd e c) = NtfCmd e <$> checkCredentials tAuth entId c

 data NtfResponseTag
  = NRTknId_
@@ -296,12 +300,18 @@ data NtfResponse

 instance ProtocolEncoding NTFVersion ErrorType NtfResponse where
  type Tag NtfResponse = NtfResponseTag
-  encodeProtocol _v = \case
+  encodeProtocol v = \case
    NRTknId entId dhKey -> e (NRTknId_, ' ', entId, dhKey)
    NRSubId entId -> e (NRSubId_, ' ', entId)
    NROk -> e NROk_
    NRErr err -> e (NRErr_, ' ', err)
-    NRTkn stat -> e (NRTkn_, ' ', stat)
+    NRTkn stat -> e (NRTkn_, ' ', stat')
+      where
+        stat'
+          | v >= invalidReasonNTFVersion = stat
+          | otherwise = case stat of
+              NTInvalid _ -> NTInvalid Nothing
+              _ -> stat
    NRSub stat -> e (NRSub_, ' ', stat)
    NRPong -> e NRPong_
    where
@@ -324,7 +334,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfResponse where
    PEBlock -> BLOCK
  {-# INLINE fromProtocolError #-}

-  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials _ (EntityId entId) cmd = case cmd of
    -- IDTKN response must not have queue ID
    NRTknId {} -> noEntity
    -- IDSUB response must not have queue ID
@@ -473,6 +483,8 @@ data NtfSubStatus
    NSDeleted
  | -- | SMP AUTH error
    NSAuth
+  | -- | SMP SERVICE error - rejected service signature on individual subscriptions
+    NSService
  | -- | SMP error other than AUTH
    NSErr ByteString
  deriving (Eq, Ord, Show)
@@ -486,6 +498,7 @@ ntfShouldSubscribe = \case
  NSEnd -> False
  NSDeleted -> False
  NSAuth -> False
+  NSService -> True
  NSErr _ -> False

 instance Encoding NtfSubStatus where
@@ -497,6 +510,7 @@ instance Encoding NtfSubStatus where
    NSEnd -> "END"
    NSDeleted -> "DELETED"
    NSAuth -> "AUTH"
+    NSService -> "SERVICE"
    NSErr err -> "ERR " <> err
  smpP =
    A.takeTill (== ' ') >>= \case
@@ -507,12 +521,15 @@ instance Encoding NtfSubStatus where
      "END" -> pure NSEnd
      "DELETED" -> pure NSDeleted
      "AUTH" -> pure NSAuth
+      "SERVICE" -> pure NSService
      "ERR" -> NSErr <$> (A.space *> A.takeByteString)
      _ -> fail "bad NtfSubStatus"

 instance StrEncoding NtfSubStatus where
  strEncode = smpEncode
+  {-# INLINE strEncode #-}
  strP = smpP
+  {-# INLINE strP #-}

 data NtfTknStatus
  = -- | Token created in DB
@@ -520,7 +537,7 @@ data NtfTknStatus
  | -- | state after registration (TNEW)
    NTRegistered
  | -- | if initial notification failed (push provider error) or verification failed
-    NTInvalid
+    NTInvalid (Maybe NTInvalidReason)
  | -- | Token confirmed via notification (accepted by push provider or verification code received by client)
    NTConfirmed
  | -- | after successful verification (TVFY)
@@ -529,24 +546,65 @@ data NtfTknStatus
    NTExpired
  deriving (Eq, Show)

+allowTokenVerification :: NtfTknStatus -> Bool
+allowTokenVerification = \case
+  NTNew -> False
+  NTRegistered -> True
+  NTInvalid _ -> False
+  NTConfirmed -> True
+  NTActive -> True
+  NTExpired -> False
+
+allowNtfSubCommands :: NtfTknStatus -> Bool
+allowNtfSubCommands = \case
+  NTNew -> False
+  NTRegistered -> False
+  -- TODO we could have separate statuses to show whether it became invalid
+  -- after verification (allow commands) or before (do not allow)
+  NTInvalid _ -> True
+  NTConfirmed -> False
+  NTActive -> True
+  NTExpired -> True
+
 instance Encoding NtfTknStatus where
  smpEncode = \case
    NTNew -> "NEW"
    NTRegistered -> "REGISTERED"
-    NTInvalid -> "INVALID"
+    NTInvalid r_ -> "INVALID" <> maybe "" (\r -> ',' `B.cons` strEncode r) r_
    NTConfirmed -> "CONFIRMED"
    NTActive -> "ACTIVE"
    NTExpired -> "EXPIRED"
  smpP =
-    A.takeTill (== ' ') >>= \case
+    A.takeTill (\c -> c == ' ' || c == ',') >>= \case
      "NEW" -> pure NTNew
      "REGISTERED" -> pure NTRegistered
-      "INVALID" -> pure NTInvalid
+      "INVALID" -> NTInvalid <$> optional (A.char ',' *> strP)
      "CONFIRMED" -> pure NTConfirmed
      "ACTIVE" -> pure NTActive
      "EXPIRED" -> pure NTExpired
      _ -> fail "bad NtfTknStatus"

+instance StrEncoding NTInvalidReason where
+  strEncode = smpEncode
+  strP = smpP
+
+data NTInvalidReason = NTIRBadToken | NTIRTokenNotForTopic | NTIRExpiredToken | NTIRUnregistered
+  deriving (Eq, Show)
+
+instance Encoding NTInvalidReason where
+  smpEncode = \case
+    NTIRBadToken -> "BAD"
+    NTIRTokenNotForTopic -> "TOPIC"
+    NTIRExpiredToken -> "EXPIRED"
+    NTIRUnregistered -> "UNREGISTERED"
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "BAD" -> pure NTIRBadToken
+      "TOPIC" -> pure NTIRTokenNotForTopic
+      "EXPIRED" -> pure NTIRExpiredToken
+      "UNREGISTERED" -> pure NTIRUnregistered
+      _ -> fail "bad NTInvalidReason"
+
 instance StrEncoding NtfTknStatus where
  strEncode = smpEncode
  strP = smpP
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -8,60 +9,72 @@
 module Simplex.Messaging.Notifications.Server.Env where

 import Control.Concurrent (ThreadId)
-import Control.Concurrent.Async (Async)
 import Control.Logger.Simple
+import Control.Monad
 import Crypto.Random
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
+import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
-import Data.Word (Word16)
-import Data.X509.Validation (Fingerprint (..))
+import qualified Data.X509.Validation as XV
 import Network.Socket
-import qualified Network.TLS as T
+import qualified Network.TLS as TLS
 import Numeric.Natural
+import Simplex.Messaging.Client (ProtocolClientConfig (..))
 import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Stats
-import Simplex.Messaging.Notifications.Server.Store
-import Simplex.Messaging.Notifications.Server.StoreLog
+import Simplex.Messaging.Notifications.Server.Store (newNtfSTMStore)
+import Simplex.Messaging.Notifications.Server.Store.Postgres
+import Simplex.Messaging.Notifications.Server.Store.Types
+import Simplex.Messaging.Notifications.Server.StoreLog (readWriteNtfSTMStore)
 import Simplex.Messaging.Notifications.Transport (NTFVersion, VersionRangeNTF)
-import Simplex.Messaging.Protocol (BasicAuth, CorrId, SMPServer, Transmission)
+import Simplex.Messaging.Protocol (BasicAuth, CorrId, Party (..), SMPServer, SParty (..), Transmission)
+import Simplex.Messaging.Server.Env.STM (StartOptions (..))
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
+import Simplex.Messaging.Server.StoreLog (closeStoreLog)
+import Simplex.Messaging.Session
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (ATransport, THandleParams, TransportPeer (..))
+import Simplex.Messaging.Transport (ASrvTransport, SMPServiceRole (..), ServiceCredentials (..), THandleParams, TransportPeer (..))
 import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, TransportServerConfig, loadFingerprint, loadServerCredential)
-import System.IO (IOMode (..))
+import System.Exit (exitFailure)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM

 data NtfServerConfig = NtfServerConfig
-  { transports :: [(ServiceName, ATransport, AddHTTP)],
+  { transports :: [(ServiceName, ASrvTransport, AddHTTP)],
    controlPort :: Maybe ServiceName,
    controlPortUserAuth :: Maybe BasicAuth,
    controlPortAdminAuth :: Maybe BasicAuth,
    subIdBytes :: Int,
    regCodeBytes :: Int,
    clientQSize :: Natural,
-    subQSize :: Natural,
    pushQSize :: Natural,
    smpAgentCfg :: SMPClientAgentConfig,
    apnsConfig :: APNSPushClientConfig,
    subsBatchSize :: Int,
    inactiveClientExpiration :: Maybe ExpirationConfig,
-    storeLogFile :: Maybe FilePath,
-    storeLastNtfsFile :: Maybe FilePath,
+    dbStoreConfig :: PostgresStoreCfg,
    ntfCredentials :: ServerCredentials,
+    -- send service credentials and use service subscriptions when SMP server supports them
+    useServiceCreds :: Bool,
+    periodicNtfsInterval :: Int, -- seconds
    -- stats config - see SMP server config
    logStatsInterval :: Maybe Int64,
    logStatsStartTime :: Int64,
    serverStatsLogFile :: FilePath,
    serverStatsBackupFile :: Maybe FilePath,
+    -- | interval and file to save prometheus metrics
+    prometheusInterval :: Maybe Int,
+    prometheusMetricsFile :: FilePath,
    ntfServerVRange :: VersionRangeNTF,
-    transportConfig :: TransportServerConfig
+    transportConfig :: TransportServerConfig,
+    startOptions :: StartOptions
  }

 defaultInactiveClientExpiration :: ExpirationConfig
@@ -75,71 +88,75 @@ data NtfEnv = NtfEnv
  { config :: NtfServerConfig,
    subscriber :: NtfSubscriber,
    pushServer :: NtfPushServer,
-    store :: NtfStore,
-    storeLog :: Maybe (StoreLog 'WriteMode),
+    store :: NtfPostgresStore,
    random :: TVar ChaChaDRG,
-    tlsServerCreds :: T.Credential,
+    tlsServerCreds :: TLS.Credential,
    serverIdentity :: C.KeyHash,
    serverStats :: NtfServerStats
  }

 newNtfServerEnv :: NtfServerConfig -> IO NtfEnv
-newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsConfig, storeLogFile, ntfCredentials} = do
+newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, dbStoreConfig, ntfCredentials, useServiceCreds, startOptions} = do
+  when (compactLog startOptions) $ compactDbStoreLog $ dbStoreLogPath dbStoreConfig
  random <- C.newRandom
-  store <- newNtfStore
-  logInfo "restoring subscriptions..."
-  storeLog <- mapM (`readWriteNtfStore` store) storeLogFile
-  logInfo "restored subscriptions"
-  subscriber <- newNtfSubscriber subQSize smpAgentCfg random
-  pushServer <- newNtfPushServer pushQSize apnsConfig
+  store <- newNtfDbStore dbStoreConfig
  tlsServerCreds <- loadServerCredential ntfCredentials
-  Fingerprint fp <- loadFingerprint ntfCredentials
+  serviceCertHash@(XV.Fingerprint fp) <- loadFingerprint ntfCredentials
+  smpAgentCfg' <-
+    if useServiceCreds
+      then do
+        serviceSignKey <- case C.x509ToPrivate' $ snd tlsServerCreds of
+          Right pk -> pure pk
+          Left e -> putStrLn ("Server has no valid key: " <> show e) >> exitFailure
+        let service = ServiceCredentials {serviceRole = SRNotifier, serviceCreds = tlsServerCreds, serviceCertHash, serviceSignKey}
+        pure smpAgentCfg {smpCfg = (smpCfg smpAgentCfg) {serviceCredentials = Just service}}
+      else pure smpAgentCfg
+  subscriber <- newNtfSubscriber smpAgentCfg' random
+  pushServer <- newNtfPushServer pushQSize apnsConfig
  serverStats <- newNtfServerStats =<< getCurrentTime
-  pure NtfEnv {config, subscriber, pushServer, store, storeLog, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats}
+  pure NtfEnv {config, subscriber, pushServer, store, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats}
+  where
+    compactDbStoreLog = \case
+      Just f -> do
+        logNote $ "compacting store log " <> T.pack f
+        newNtfSTMStore >>= readWriteNtfSTMStore False f >>= closeStoreLog
+      Nothing -> do
+        logError "Error: `--compact-log` used without `enable: on` option in STORE_LOG section of INI file"
+        exitFailure

 data NtfSubscriber = NtfSubscriber
-  { smpSubscribers :: TMap SMPServer SMPSubscriber,
-    newSubQ :: TBQueue [NtfEntityRec 'Subscription],
-    smpAgent :: SMPClientAgent
+  { smpSubscribers :: TMap SMPServer SMPSubscriberVar,
+    subscriberSeq :: TVar Int,
+    smpAgent :: SMPClientAgent 'NotifierService
  }

-newNtfSubscriber :: Natural -> SMPClientAgentConfig -> TVar ChaChaDRG -> IO NtfSubscriber
-newNtfSubscriber qSize smpAgentCfg random = do
+type SMPSubscriberVar = SessionVar SMPSubscriber
+
+newNtfSubscriber :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO NtfSubscriber
+newNtfSubscriber smpAgentCfg random = do
  smpSubscribers <- TM.emptyIO
-  newSubQ <- newTBQueueIO qSize
-  smpAgent <- newSMPClientAgent smpAgentCfg random
-  pure NtfSubscriber {smpSubscribers, newSubQ, smpAgent}
+  subscriberSeq <- newTVarIO 0
+  smpAgent <- newSMPClientAgent SNotifierService smpAgentCfg random
+  pure NtfSubscriber {smpSubscribers, subscriberSeq, smpAgent}

 data SMPSubscriber = SMPSubscriber
-  { newSubQ :: TQueue (NonEmpty (NtfEntityRec 'Subscription)),
-    subThreadId :: TVar (Maybe (Weak ThreadId))
+  { smpServer :: SMPServer,
+    smpServerId :: Int64,
+    subscriberSubQ :: TQueue ServerNtfSub,
+    subThreadId :: Weak ThreadId
  }

-newSMPSubscriber :: IO SMPSubscriber
-newSMPSubscriber = do
-  newSubQ <- newTQueueIO
-  subThreadId <- newTVarIO Nothing
-  pure SMPSubscriber {newSubQ, subThreadId}
-
 data NtfPushServer = NtfPushServer
-  { pushQ :: TBQueue (NtfTknData, PushNotification),
+  { pushQ :: TBQueue (Maybe T.Text, NtfTknRec, PushNotification), -- Maybe Text is a hostname of "own" server
    pushClients :: TMap PushProvider PushProviderClient,
-    intervalNotifiers :: TMap NtfTokenId IntervalNotifier,
    apnsConfig :: APNSPushClientConfig
  }

-data IntervalNotifier = IntervalNotifier
-  { action :: Async (),
-    token :: NtfTknData,
-    interval :: Word16
-  }
-
 newNtfPushServer :: Natural -> APNSPushClientConfig -> IO NtfPushServer
 newNtfPushServer qSize apnsConfig = do
  pushQ <- newTBQueueIO qSize
  pushClients <- TM.emptyIO
-  intervalNotifiers <- TM.emptyIO
-  pure NtfPushServer {pushQ, pushClients, intervalNotifiers, apnsConfig}
+  pure NtfPushServer {pushQ, pushClients, apnsConfig}

 newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 newPushClient NtfPushServer {apnsConfig, pushClients} pp = do
@@ -1,3 +1,4 @@
+{-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -9,30 +10,49 @@

 module Simplex.Messaging.Notifications.Server.Main where

+import Control.Logger.Simple (setLogLevel)
 import Control.Monad ((<$!>))
+import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
+import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
+import Data.Set (Set)
+import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import qualified Data.Text.IO as T
-import Network.Socket (HostName)
+import Network.Socket (HostName, ServiceName)
 import Options.Applicative
-import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
+import Simplex.Messaging.Agent.Store.Postgres (checkSchemaExists)
+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
-import Simplex.Messaging.Notifications.Server (runNtfServer)
+import Simplex.Messaging.Notifications.Protocol (NtfTokenId)
+import Simplex.Messaging.Notifications.Server (runNtfServer, restoreServerLastNtfs)
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..), defaultInactiveClientExpiration)
 import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
-import Simplex.Messaging.Notifications.Transport (supportedServerNTFVRange)
+import Simplex.Messaging.Notifications.Server.Store (newNtfSTMStore)
+import Simplex.Messaging.Notifications.Server.Store.Postgres (exportNtfDbStore, importNtfSTMStore, newNtfDbStore)
+import Simplex.Messaging.Notifications.Server.StoreLog (readWriteNtfSTMStore)
+import Simplex.Messaging.Notifications.Transport (alpnSupportedNTFHandshakes, supportedServerNTFVRange)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
 import Simplex.Messaging.Server.CLI
+import Simplex.Messaging.Server.Env.STM (StartOptions (..))
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Transport (simplexMQVersion)
+import Simplex.Messaging.Server.Main (strParse)
+import Simplex.Messaging.Server.Main.Init (iniDbOpts)
+import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
+import Simplex.Messaging.Server.StoreLog (closeStoreLog)
+import Simplex.Messaging.Transport (ASrvTransport)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
-import Simplex.Messaging.Util (tshow)
-import System.Directory (createDirectoryIfMissing, doesFileExist)
+import Simplex.Messaging.Transport.HTTP2 (httpALPN)
+import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials (..), mkTransportServerConfig)
+import Simplex.Messaging.Util (eitherToMaybe, ifM, tshow)
+import System.Directory (createDirectoryIfMissing, doesFileExist, renameFile)
+import System.Exit (exitFailure)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)
@@ -44,14 +64,8 @@ ntfServerCLI cfgPath logPath =
      doesFileExist iniFile >>= \case
        True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `" <> executableName <> " start`."
        _ -> initializeServer opts
-    OnlineCert certOpts ->
-      doesFileExist iniFile >>= \case
-        True -> genOnline cfgPath certOpts
-        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
-    Start ->
-      doesFileExist iniFile >>= \case
-        True -> readIniFile iniFile >>= either exitError runServer
-        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
+    OnlineCert certOpts -> withIniFile $ \_ -> genOnline cfgPath certOpts
+    Start opts -> withIniFile $ runServer opts
    Delete -> do
      confirmOrExit
        "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
@@ -59,13 +73,75 @@ ntfServerCLI cfgPath logPath =
      deleteDirIfExists cfgPath
      deleteDirIfExists logPath
      putStrLn "Deleted configuration and log files"
+    Database cmd dbOpts@DBOpts {connstr, schema} -> withIniFile $ \ini -> do
+      schemaExists <- checkSchemaExists connstr schema
+      storeLogExists <- doesFileExist storeLogFilePath
+      lastNtfsExists <- doesFileExist defaultLastNtfsFile
+      case cmd of
+        SCImport skipTokens
+          | schemaExists && (storeLogExists || lastNtfsExists) -> exitConfigureNtfStore connstr schema
+          | schemaExists -> do
+              putStrLn $ "Schema " <> B.unpack schema <> " already exists in PostrgreSQL database: " <> B.unpack connstr
+              exitFailure
+          | not storeLogExists -> do
+              putStrLn $ storeLogFilePath <> " file does not exist."
+              exitFailure
+          | not lastNtfsExists -> do
+              putStrLn $ defaultLastNtfsFile <> " file does not exist."
+              exitFailure
+          | otherwise -> do
+              storeLogFile <- getRequiredStoreLogFile ini
+              confirmOrExit
+                ("WARNING: store log file " <> storeLogFile <> " will be compacted and imported to PostrgreSQL database: " <> B.unpack connstr <> ", schema: " <> B.unpack schema)
+                "Notification server store not imported"
+              stmStore <- newNtfSTMStore
+              sl <- readWriteNtfSTMStore True storeLogFile stmStore
+              closeStoreLog sl
+              restoreServerLastNtfs stmStore defaultLastNtfsFile
+              let storeCfg = PostgresStoreCfg {dbOpts = dbOpts {createSchema = True}, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = iniDeletedTTL ini}
+              ps <- newNtfDbStore storeCfg
+              (tCnt, sCnt, nCnt, serviceCnt) <- importNtfSTMStore ps stmStore skipTokens
+              renameFile storeLogFile $ storeLogFile <> ".bak"
+              putStrLn $ "Import completed: " <> show tCnt <> " tokens, " <> show sCnt <> " subscriptions, " <> show serviceCnt <> " service associations, " <> show nCnt <> " last token notifications."
+              putStrLn "Configure database options in INI file."
+        SCExport
+          | schemaExists && storeLogExists -> exitConfigureNtfStore connstr schema
+          | not schemaExists -> do
+              putStrLn $ "Schema " <> B.unpack schema <> " does not exist in PostrgreSQL database: " <> B.unpack connstr
+              exitFailure
+          | storeLogExists -> do
+              putStrLn $ storeLogFilePath <> " file already exists."
+              exitFailure
+          | lastNtfsExists -> do
+              putStrLn $ defaultLastNtfsFile <> " file already exists."
+              exitFailure
+          | otherwise -> do
+              confirmOrExit
+                ("WARNING: PostrgreSQL database schema " <> B.unpack schema <> " (database: " <> B.unpack connstr <> ") will be exported to store log file " <> storeLogFilePath)
+                "Notification server store not imported"
+              let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Just storeLogFilePath, confirmMigrations = MCConsole, deletedTTL = iniDeletedTTL ini}
+              st <- newNtfDbStore storeCfg
+              (tCnt, sCnt, nCnt) <- exportNtfDbStore st defaultLastNtfsFile
+              putStrLn $ "Export completed: " <> show tCnt <> " tokens, " <> show sCnt <> " subscriptions, " <> show nCnt <> " last token notifications."
  where
+    withIniFile a =
+      doesFileExist iniFile >>= \case
+        True -> readIniFile iniFile >>= either exitError a
+        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
+    getRequiredStoreLogFile ini = do
+      case enableStoreLog' ini $> storeLogFilePath of
+        Just storeLogFile -> do
+          ifM
+            (doesFileExist storeLogFile)
+            (pure storeLogFile)
+            (putStrLn ("Store log file " <> storeLogFile <> " not found") >> exitFailure)
+        Nothing -> putStrLn "Store log disabled, see `[STORE_LOG] enable`" >> exitFailure
    iniFile = combine cfgPath "ntf-server.ini"
-    serverVersion = "SMP notifications server v" <> simplexMQVersion
+    serverVersion = "SMP notifications server v" <> simplexmqVersionCommit
    defaultServerPort = "443"
    executableName = "ntf-server"
    storeLogFilePath = combine logPath "ntf-server-store.log"
-    initializeServer InitOptions {enableStoreLog, signAlgorithm, ip, fqdn} = do
+    initializeServer InitOptions {enableStoreLog, dbOptions, signAlgorithm, ip, fqdn} = do
      clearDirIfExists cfgPath
      clearDirIfExists logPath
      createDirectoryIfMissing True cfgPath
@@ -87,10 +163,14 @@ ntfServerCLI cfgPath logPath =
          \# and restoring it when the server is started.\n\
          \# Log is compacted on start (deleted objects are removed).\n"
            <> ("enable: " <> onOff enableStoreLog <> "\n\n")
-            <> "# Last notifications are optionally saved and restored when the server restarts,\n\
-               \# they are preserved in the .bak file until the next restart.\n"
-            <> ("restore_last_notifications: " <> onOff enableStoreLog <> "\n\n")
+            <> "# Database connection settings for PostgreSQL database.\n"
+            <> iniDbOpts dbOptions defaultNtfDBOpts
+            <> "Time to retain deleted entities in the database, days.\n"
+            <> ("# db_deleted_ttl: " <> tshow defaultDeletedTTL <> "\n\n")
            <> "log_stats: off\n\n\
+               \# Log interval for real-time Prometheus metrics\n\
+               \# prometheus_interval: 60\n\
+               \\n\
               \[AUTH]\n\
               \# control_port_admin_password:\n\
               \# control_port_user_password:\n\
@@ -119,31 +199,37 @@ ntfServerCLI cfgPath logPath =
               \# socks_mode: onion\n\n\
               \# The domain suffixes of the relays you operate (space-separated) to count as separate proxy statistics.\n\
               \# own_server_domains: \n\n\
+               \# User service subscriptions with server certificate\n\n\
+               \# use_service_credentials: off\n\n\
               \[INACTIVE_CLIENTS]\n\
               \# TTL and interval to check inactive clients\n\
               \disconnect: off\n"
            <> ("# ttl: " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
            <> ("# check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n")
-    runServer ini = do
+    enableStoreLog' = settingIsOn "STORE_LOG" "enable"
+    runServer startOptions ini = do
+      setLogLevel $ logLevel startOptions
      hSetBuffering stdout LineBuffering
      hSetBuffering stderr LineBuffering
      fp <- checkSavedFingerprint cfgPath defaultX509Config
      let host = either (const "<hostnames>") T.unpack $ lookupValue "TRANSPORT" "host" ini
          port = T.unpack $ strictIni "TRANSPORT" "port" ini
-          cfg@NtfServerConfig {transports, storeLogFile} = serverConfig
+          cfg@NtfServerConfig {transports} = serverConfig
          srv = ProtoServerWithAuth (NtfServer [THDomainName host] (if port == "443" then "" else port) (C.KeyHash fp)) Nothing
      printServiceInfo serverVersion srv
-      printServerConfig transports storeLogFile
+      printNtfServerConfig transports dbStoreConfig
      runNtfServer cfg
      where
-        enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
        logStats = settingIsOn "STORE_LOG" "log_stats" ini
        c = combine cfgPath . ($ defaultX509Config)
-        restoreLastNtfsFile path = case iniOnOff "STORE_LOG" "restore_last_notifications" ini of
-          Just True -> Just path
-          Just False -> Nothing
-          -- if the setting is not set, it is enabled when store log is enabled
-          _ -> enableStoreLog $> path
+        dbStoreLogPath = enableStoreLog' ini $> storeLogFilePath
+        dbStoreConfig =
+          PostgresStoreCfg
+            { dbOpts = iniDBOptions ini defaultNtfDBOpts,
+              dbStoreLogPath,
+              confirmMigrations = MCYesUp,
+              deletedTTL = iniDeletedTTL ini
+            }
        serverConfig =
          NtfServerConfig
            { transports = iniTransports ini,
@@ -153,8 +239,7 @@ ntfServerCLI cfgPath logPath =
              subIdBytes = 24,
              regCodeBytes = 32,
              clientQSize = 64,
-              subQSize = 512,
-              pushQSize = 1048,
+              pushQSize = 32768,
              smpAgentCfg =
                defaultSMPClientAgentConfig
                  { smpCfg =
@@ -165,6 +250,7 @@ ntfServerCLI cfgPath logPath =
                                socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini,
                                hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "SUBSCRIBER" "host_mode" ini,
                                requiredHostMode = fromMaybe False $ iniOnOff "SUBSCRIBER" "required_host_mode" ini,
+                                smpWebPortServers = SWPOff,
                                smpPingInterval = 60_000_000 -- 1 minute
                              }
                        },
@@ -179,57 +265,110 @@ ntfServerCLI cfgPath logPath =
                    { ttl = readStrictIni "INACTIVE_CLIENTS" "ttl" ini,
                      checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
                    },
-              storeLogFile = enableStoreLog $> storeLogFilePath,
-              storeLastNtfsFile = restoreLastNtfsFile $ combine logPath "ntf-server-last-notifications.log",
+              dbStoreConfig,
              ntfCredentials =
                ServerCredentials
                  { caCertificateFile = Just $ c caCrtFile,
                    privateKeyFile = c serverKeyFile,
                    certificateFile = c serverCrtFile
                  },
+              useServiceCreds = fromMaybe False $ iniOnOff "SUBSCRIBER" "use_service_credentials" ini,
+              periodicNtfsInterval = 5 * 60, -- 5 minutes
              logStatsInterval = logStats $> 86400, -- seconds
              logStatsStartTime = 0, -- seconds from 00:00 UTC
              serverStatsLogFile = combine logPath "ntf-server-stats.daily.log",
              serverStatsBackupFile = logStats $> combine logPath "ntf-server-stats.log",
+              prometheusInterval = eitherToMaybe $ read . T.unpack <$> lookupValue "STORE_LOG" "prometheus_interval" ini,
+              prometheusMetricsFile = combine logPath "ntf-server-metrics.txt",
              ntfServerVRange = supportedServerNTFVRange,
              transportConfig =
-                defaultTransportServerConfig
-                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
-                  }
+                mkTransportServerConfig
+                  (fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
+                  (Just $ alpnSupportedNTFHandshakes <> httpALPN)
+                  False,
+              startOptions
            }
+    iniDeletedTTL ini = readIniDefault (86400 * defaultDeletedTTL) "STORE_LOG" "db_deleted_ttl" ini
+    defaultLastNtfsFile = combine logPath "ntf-server-last-notifications.log"
+    exitConfigureNtfStore connstr schema = do
+      putStrLn $ "Error: both " <> storeLogFilePath <> " file and " <> B.unpack schema <> " schema are present (database: " <> B.unpack connstr <> ")."
+      putStrLn "Configure notification server storage."
+      exitFailure
+
+printNtfServerConfig :: [(ServiceName, ASrvTransport, AddHTTP)] -> PostgresStoreCfg -> IO ()
+printNtfServerConfig transports PostgresStoreCfg {dbOpts = DBOpts {connstr, schema}, dbStoreLogPath} = do
+  B.putStrLn $ "PostgreSQL database: " <> connstr <> ", schema: " <> schema
+  printServerConfig "NTF" transports dbStoreLogPath

 data CliCommand
  = Init InitOptions
  | OnlineCert CertOptions
-  | Start
+  | Start StartOptions
  | Delete
+  | Database StoreCmd DBOpts
+
+data StoreCmd = SCImport (Set NtfTokenId) | SCExport

 data InitOptions = InitOptions
  { enableStoreLog :: Bool,
+    dbOptions :: DBOpts,
    signAlgorithm :: SignAlgorithm,
    ip :: HostName,
    fqdn :: Maybe HostName
  }
  deriving (Show)

+defaultNtfDBOpts :: DBOpts
+defaultNtfDBOpts =
+  DBOpts
+    { connstr = "postgresql://ntf@/ntf_server_store",
+      schema = "ntf_server",
+      poolSize = 10,
+      createSchema = False
+    }
+
+-- time to retain deleted tokens and subscriptions in the database (days), for debugging
+defaultDeletedTTL :: Int64
+defaultDeletedTTL = 21
+
 cliCommandP :: FilePath -> FilePath -> FilePath -> Parser CliCommand
 cliCommandP cfgPath logPath iniFile =
  hsubparser
    ( command "init" (info (Init <$> initP) (progDesc $ "Initialize server - creates " <> cfgPath <> " and " <> logPath <> " directories and configuration files"))
        <> command "cert" (info (OnlineCert <$> certOptionsP) (progDesc $ "Generate new online TLS server credentials (configuration: " <> iniFile <> ")"))
-        <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
+        <> command "start" (info (Start <$> startOptionsP) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
        <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
+        <> command "database" (info (Database <$> databaseCmdP <*> dbOptsP defaultNtfDBOpts) (progDesc "Import/export notifications server store to/from PostgreSQL database"))
    )
  where
-    initP :: Parser InitOptions
-    initP =
-      InitOptions
-        <$> switch
-          ( long "store-log"
-              <> short 'l'
-              <> help "Enable store log for persistence"
+    databaseCmdP =
+      hsubparser
+        ( command "import" (info (SCImport <$> skipTokensP) (progDesc $ "Import store logs into a new PostgreSQL database schema"))
+            <> command "export" (info (pure SCExport) (progDesc $ "Export PostgreSQL database schema to store logs"))
+        )
+    skipTokensP :: Parser (Set NtfTokenId)
+    skipTokensP =
+      option
+        strParse
+          ( long "skip-tokens"
+              <> help "Skip tokens during import"
+              <> value S.empty
          )
-        <*> option
+    initP :: Parser InitOptions
+    initP = do
+      enableStoreLog <-
+        flag' False
+          ( long "disable-store-log"
+              <> help "Disable store log for persistence (enabled by default)"
+          )
+          <|> flag True True
+            ( long "store-log"
+                <> short 'l'
+                <> help "Enable store log for persistence (DEPRECATED, enabled by default)"
+            )
+      dbOptions <- dbOptsP defaultNtfDBOpts
+      signAlgorithm <-
+        option
          (maybeReader readMaybe)
          ( long "sign-algorithm"
              <> short 'a'
@@ -238,7 +377,8 @@ cliCommandP cfgPath logPath iniFile =
              <> showDefault
              <> metavar "ALG"
          )
-        <*> strOption
+      ip <-
+        strOption
          ( long "ip"
              <> help
                "Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
@@ -246,10 +386,12 @@ cliCommandP cfgPath logPath iniFile =
              <> showDefault
              <> metavar "IP"
          )
-        <*> (optional . strOption)
+      fqdn <-
+        (optional . strOption)
          ( long "fqdn"
              <> short 'n'
              <> help "Server FQDN used as Common Name for TLS online certificate"
              <> showDefault
              <> metavar "FQDN"
          )
+      pure InitOptions {enableStoreLog, dbOptions, signAlgorithm, ip, fqdn}
@@ -0,0 +1,285 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
+
+module Simplex.Messaging.Notifications.Server.Prometheus where
+
+import Data.Int (Int64)
+import qualified Data.Map.Strict as M
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Clock (UTCTime (..), diffUTCTime)
+import Data.Time.Clock.System (systemEpochDay)
+import Data.Time.Format.ISO8601 (iso8601Show)
+import Numeric.Natural (Natural)
+import Simplex.Messaging.Notifications.Server.Stats
+import Simplex.Messaging.Server.Stats (PeriodStatCounts (..))
+import Simplex.Messaging.Transport (simplexMQVersion)
+import Simplex.Messaging.Util (tshow)
+
+data NtfServerMetrics = NtfServerMetrics
+  { statsData :: NtfServerStatsData,
+    activeTokensCounts :: PeriodStatCounts,
+    activeSubsCounts :: PeriodStatCounts,
+    tokenCount :: Int64,
+    approxSubCount :: Int64,
+    lastNtfCount :: Int64,
+    rtsOptions :: Text
+  }
+
+rtsOptionsEnv :: Text
+rtsOptionsEnv = "NTF_RTS_OPTIONS"
+
+data NtfRealTimeMetrics = NtfRealTimeMetrics
+  { threadsCount :: Int,
+    srvSubscribers :: NtfSMPWorkerMetrics,
+    srvClients :: NtfSMPWorkerMetrics,
+    srvSubWorkers :: NtfSMPWorkerMetrics,
+    ntfActiveServiceSubs :: NtfSMPSubMetrics,
+    ntfActiveQueueSubs :: NtfSMPSubMetrics,
+    ntfPendingServiceSubs :: NtfSMPSubMetrics,
+    ntfPendingQueueSubs :: NtfSMPSubMetrics,
+    smpSessionCount :: Int,
+    apnsPushQLength :: Natural
+  }
+
+data NtfSMPWorkerMetrics = NtfSMPWorkerMetrics {ownServers :: [Text], otherServers :: Int}
+
+data NtfSMPSubMetrics = NtfSMPSubMetrics {ownSrvSubs :: M.Map Text Int, otherServers :: Int, otherSrvSubCount :: Int}
+
+{-# FOURMOLU_DISABLE\n#-}
+ntfPrometheusMetrics :: NtfServerMetrics -> NtfRealTimeMetrics -> UTCTime -> Text
+ntfPrometheusMetrics sm rtm ts =
+  time <> tokens <> subscriptions <> notifications <> info
+  where
+    NtfServerMetrics {statsData, activeTokensCounts = psTkns, activeSubsCounts = psSubs, tokenCount, approxSubCount, lastNtfCount, rtsOptions} = sm
+    NtfRealTimeMetrics
+      { threadsCount,
+        srvSubscribers,
+        srvClients,
+        srvSubWorkers,
+        ntfActiveServiceSubs,
+        ntfActiveQueueSubs,
+        ntfPendingServiceSubs,
+        ntfPendingQueueSubs,
+        smpSessionCount,
+        apnsPushQLength
+      } = rtm
+    NtfServerStatsData
+      { _fromTime,
+        _tknCreated,
+        _tknVerified,
+        _tknDeleted,
+        _tknReplaced,
+        _subCreated,
+        _subDeleted,
+        _ntfReceived,
+        _ntfReceivedAuth,
+        _ntfDelivered,
+        _ntfFailed,
+        _ntfReceivedOwn,
+        _ntfReceivedAuthOwn,
+        _ntfDeliveredOwn,
+        _ntfFailedOwn,
+        _ntfCronDelivered,
+        _ntfCronFailed,
+        _ntfVrfQueued,
+        _ntfVrfDelivered,
+        _ntfVrfFailed,
+        _ntfVrfInvalidTkn
+      } = statsData
+    time =
+      "# Recorded at: " <> T.pack (iso8601Show ts) <> "\n\
+      \# Stats from: " <> T.pack (iso8601Show _fromTime) <> "\n\
+      \\n"
+    tokens =
+      "# Tokens\n\
+      \# ------\n\
+      \\n\
+      \# HELP simplex_ntf_tokens_created Created tokens\n\
+      \# TYPE simplex_ntf_tokens_created counter\n\
+      \simplex_ntf_tokens_created " <> mshow _tknCreated <> "\n# tknCreated\n\
+      \\n\
+      \# HELP simplex_ntf_tokens_verified Verified tokens\n\
+      \# TYPE simplex_ntf_tokens_verified counter\n\
+      \simplex_ntf_tokens_verified " <> mshow _tknVerified <> "\n# tknVerified\n\
+      \\n\
+      \# HELP simplex_ntf_tokens_deleted Deleted tokens\n\
+      \# TYPE simplex_ntf_tokens_deleted counter\n\
+      \simplex_ntf_tokens_deleted " <> mshow _tknDeleted <> "\n# tknDeleted\n\
+      \\n\
+      \# HELP simplex_ntf_tokens_replaced Deleted tokens\n\
+      \# TYPE simplex_ntf_tokens_replaced counter\n\
+      \simplex_ntf_tokens_replaced " <> mshow _tknReplaced <> "\n# tknReplaced\n\
+      \\n\
+      \# HELP simplex_ntf_tokens_count_daily Daily active tokens\n\
+      \# TYPE simplex_ntf_tokens_count_daily gauge\n\
+      \simplex_ntf_tokens_count_daily " <> mstr (dayCount psTkns) <> "\n# dayCountTkn\n\
+      \\n\
+      \# HELP simplex_ntf_tokens_count_weekly Weekly active tokens\n\
+      \# TYPE simplex_ntf_tokens_count_weekly gauge\n\
+      \simplex_ntf_tokens_count_weekly " <> mstr (weekCount psTkns) <> "\n# weekCountTkn\n\
+      \\n\
+      \# HELP simplex_ntf_tokens_count_monthly Monthly active tokens\n\
+      \# TYPE simplex_ntf_tokens_count_monthly gauge\n\
+      \simplex_ntf_tokens_count_monthly " <> mstr (monthCount psTkns) <> "\n# monthCountTkn\n\
+      \\n\
+      \# HELP simplex_ntf_tokens_total Total number of tokens stored.\n\
+      \# TYPE simplex_ntf_tokens_total gauge\n\
+      \simplex_ntf_tokens_total " <> mshow tokenCount <> "\n# tokenCount\n\
+      \\n"
+    subscriptions =
+      "# Subscriptions\n\
+      \# -------------\n\
+      \\n\
+      \# HELP simplex_ntf_subscriptions_created Created subscriptions\n\
+      \# TYPE simplex_ntf_subscriptions_created counter\n\
+      \simplex_ntf_subscriptions_created " <> mshow _subCreated <> "\n# subCreated\n\
+      \\n\
+      \# HELP simplex_ntf_subscriptions_deleted Deleted subscriptions\n\
+      \# TYPE simplex_ntf_subscriptions_deleted counter\n\
+      \simplex_ntf_subscriptions_deleted " <> mshow _subDeleted <> "\n# subDeleted\n\
+      \\n\
+      \# HELP simplex_ntf_subscriptions_count_daily Daily subscriptions count\n\
+      \# TYPE simplex_ntf_subscriptions_count_daily gauge\n\
+      \simplex_ntf_subscriptions_count_daily " <> mstr (dayCount psSubs) <> "\n# dayCountSub\n\
+      \\n\
+      \# HELP simplex_ntf_subscriptions_count_weekly Weekly subscriptions count\n\
+      \# TYPE simplex_ntf_subscriptions_count_weekly gauge\n\
+      \simplex_ntf_subscriptions_count_weekly " <> mstr (weekCount psSubs) <> "\n# weekCountSub\n\
+      \\n\
+      \# HELP simplex_ntf_subscriptions_count_monthly Monthly subscriptions count\n\
+      \# TYPE simplex_ntf_subscriptions_count_monthly gauge\n\
+      \simplex_ntf_subscriptions_count_monthly " <> mstr (monthCount psSubs) <> "\n# monthCountSub\n\
+      \\n\
+      \# HELP simplex_ntf_subscriptions_approx_total Approximate total number of subscriptions stored.\n\
+      \# TYPE simplex_ntf_subscriptions_approx_total gauge\n\
+      \simplex_ntf_subscriptions_approx_total " <> mshow approxSubCount <> "\n# approxSubCount\n\
+      \\n"
+      <> showSubMetric ntfActiveServiceSubs "simplex_ntf_smp_service_subscription_active_" "Active"
+      <> showSubMetric ntfActiveQueueSubs "simplex_ntf_smp_subscription_active_" "Active"
+      <> showSubMetric ntfPendingServiceSubs "simplex_ntf_smp_service_subscription_pending_" "Pending"
+      <> showSubMetric ntfPendingQueueSubs "simplex_ntf_smp_subscription_pending_" "Pending"
+    notifications =
+      "# Notifications\n\
+      \# -------------\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_received Received notifications\n\
+      \# TYPE simplex_ntf_notifications_received counter\n\
+      \simplex_ntf_notifications_received " <> mshow _ntfReceived <> "\n# ntfReceived\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_received_auth Received notifications without token or subscription (AUTH error)\n\
+      \# TYPE simplex_ntf_notifications_received_auth counter\n\
+      \simplex_ntf_notifications_received_auth " <> mshow _ntfReceivedAuth <> "\n# ntfReceivedAuth\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_delivered Delivered notifications\n\
+      \# TYPE simplex_ntf_notifications_delivered counter\n\
+      \simplex_ntf_notifications_delivered " <> mshow _ntfDelivered <> "\n# ntfDelivered\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_failed Failed notifications\n\
+      \# TYPE simplex_ntf_notifications_failed counter\n\
+      \simplex_ntf_notifications_failed " <> mshow _ntfFailed <> "\n# ntfFailed\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_periodic_delivered Delivered periodic notifications\n\
+      \# TYPE simplex_ntf_notifications_periodic_delivered counter\n\
+      \simplex_ntf_notifications_periodic_delivered " <> mshow _ntfCronDelivered <> "\n# ntfCronDelivered\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_periodic_failed Failed periodic notifications\n\
+      \# TYPE simplex_ntf_notifications_periodic_failed counter\n\
+      \simplex_ntf_notifications_periodic_failed " <> mshow _ntfCronFailed <> "\n# ntfCronFailed\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_verification_queued Token verifications queued\n\
+      \# TYPE simplex_ntf_notifications_verification_queued counter\n\
+      \simplex_ntf_notifications_verification_queued " <> mshow _ntfVrfQueued <> "\n# ntfVrfQueued\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_verification_delivered Delivered token verifications\n\
+      \# TYPE simplex_ntf_notifications_verification_delivered counter\n\
+      \simplex_ntf_notifications_verification_delivered " <> mshow _ntfVrfDelivered <> "\n# ntfVrfDelivered\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_verification_failed Failed token verification deliveries\n\
+      \# TYPE simplex_ntf_notifications_verification_failed counter\n\
+      \simplex_ntf_notifications_verification_failed " <> mshow _ntfVrfFailed <> "\n# ntfVrfFailed\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_verification_invalid_tkn Invalid token errors while delivering verifications\n\
+      \# TYPE simplex_ntf_notifications_verification_invalid_tkn counter\n\
+      \simplex_ntf_notifications_verification_invalid_tkn " <> mshow _ntfVrfInvalidTkn <> "\n# ntfVrfInvalidTkn\n\
+      \\n\
+      \# HELP simplex_ntf_notifications_total Total number of last notifications stored.\n\
+      \# TYPE simplex_ntf_notifications_total gauge\n\
+      \simplex_ntf_notifications_total " <> mshow lastNtfCount <> "\n# lastNtfCount\n\
+      \\n"
+      <> showNtfsByServer _ntfReceivedOwn "simplex_ntf_notifications_received_own" "Received notifications" "ntfReceivedOwn"
+      <> showNtfsByServer _ntfReceivedAuthOwn "simplex_ntf_notifications_received_auth_own" "Received notifications without token or subscription (AUTH error)" "ntfReceivedAuthOwn"
+      <> showNtfsByServer _ntfDeliveredOwn "simplex_ntf_notifications_delivered_own" "Delivered notifications" "ntfDeliveredOwn"
+      <> showNtfsByServer _ntfFailedOwn "simplex_ntf_notifications_failed_own" "Failed notifications" "ntfFailedOwn"
+    info =
+      "# Info\n\
+      \# ----\n\
+      \\n\
+      \# HELP simplex_ntf_info Server information. RTS options have to be passed via " <> rtsOptionsEnv <> " env var\n\
+      \# TYPE simplex_ntf_info gauge\n\
+      \simplex_ntf_info{version=\"" <> T.pack simplexMQVersion <> "\",rts_options=\"" <> rtsOptions <> "\"} 1\n\
+      \\n\
+      \# HELP simplex_ntf_threads_total Thread count\n\
+      \# TYPE simplex_ntf_threads_total gauge\n\
+      \simplex_ntf_threads_total " <> mshow threadsCount <> "\n# threadsCount\n\
+      \\n"
+      <> showWorkerMetric srvSubscribers "simplex_ntf_smp_subscribers_" "SMP subcscribers"
+      <> showWorkerMetric srvClients "simplex_ntf_smp_agent_clients_" "SMP agent clients"
+      <> showWorkerMetric srvSubWorkers "simplex_ntf_smp_agent_sub_workers_" "SMP agent subscription workers"
+      <> "# HELP simplex_ntf_smp_sessions_count SMP sessions count\n\
+      \# TYPE simplex_ntf_smp_sessions_count gauge\n\
+      \simplex_ntf_smp_sessions_count " <> mshow smpSessionCount <> "\n# smpSessionCount\n\
+      \\n\
+      \# HELP simplex_ntf_apns_push_queue_length Count of notifications in push queue\n\
+      \# TYPE simplex_ntf_apns_push_queue_length gauge\n\
+      \simplex_ntf_apns_push_queue_length " <> mshow apnsPushQLength <> "\n# apnsPushQLength\n\
+      \\n"
+    showSubMetric NtfSMPSubMetrics {ownSrvSubs, otherServers, otherSrvSubCount} mPfx descrPfx =
+      showOwnSrvSubs <> showOtherSrvSubs
+      where
+        showOwnSrvSubs
+          | M.null ownSrvSubs = ""
+          | otherwise =
+              gaugeMetrics (mPfx <> "server_count_own") srvMetrics (descrPfx <> " SMP subscriptions, own server count") "ownSrvSubs server"
+                <> gaugeMetrics (mPfx <> "sub_count_own") subMetrics (descrPfx <> " SMP subscriptions count for own servers") "ownSrvSubs count"
+          where
+            subs = M.assocs ownSrvSubs
+            srvMetrics = map (\(host, _) -> (metricHost host, 1)) subs
+            subMetrics = map (\(host, cnt) -> (metricHost host, cnt)) subs
+        showOtherSrvSubs =
+          gaugeMetrics (mPfx <> "server_count_other") [("", otherServers)] (descrPfx <> " SMP subscriptions, other server count") "otherServers"
+            <> gaugeMetrics (mPfx <> "sub_count_other") [("", otherSrvSubCount)] (descrPfx <> " SMP subscriptions count for other servers") "otherSrvSubCount"
+    showNtfsByServer (StatsByServerData srvNtfs) mName descr varName
+      | null srvNtfs = ""
+      | otherwise =
+          "# HELP " <> mName <> " " <> descr <> "\n\
+          \# TYPE " <> mName <> " counter\n"
+          <> showNtfMetrics
+          <> "# " <> varName <> "\n\n"
+      where
+        showNtfMetrics = T.concat $ map (\(host, value) -> mName <> metricHost host <> " " <> mshow value <> "\n") srvNtfs
+    showWorkerMetric NtfSMPWorkerMetrics {ownServers, otherServers} mPfx descrPfx =
+      showOwnServers <> showOtherServers
+      where
+        showOwnServers
+          | null ownServers = ""
+          | otherwise = gaugeMetrics (mPfx <> "count_own") subMetrics (descrPfx <> " count for own servers") "ownServers"
+          where
+            subMetrics = map (\host -> (metricHost host, 1)) ownServers
+        showOtherServers = gaugeMetrics (mPfx <> "count_other") [("", otherServers)] (descrPfx <> " count for other servers") "otherServers"
+    gaugeMetrics :: Text -> [(Text, Int)] -> Text -> Text -> Text
+    gaugeMetrics name subMetrics descr codeRef =
+      "# HELP " <> name <> " " <> descr <> "\n\
+      \# TYPE " <> name <> " gauge\n"
+      <> T.concat (map (\(param, value) -> name <> param <> " " <> mshow value <> "\n") subMetrics)
+      <> "# " <> codeRef <> "\n\n"
+    metricHost host = "{server=\"" <> host <> "\"}"
+    mstr a = a <> " " <> tsEpoch
+    mshow :: Show a => a -> Text
+    mshow = mstr . tshow
+    tsEpoch = tshow @Int64 $ floor @Double $ realToFrac (ts `diffUTCTime` epoch) * 1000
+    epoch = UTCTime systemEpochDay 0
+{-# FOURMOLU_ENABLE\n#-}
@@ -33,15 +33,19 @@ import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as LB
+import qualified Data.CaseInsensitive as CI
 import Data.Int (Int64)
+import Data.List (find)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Map.Strict (Map)
 import Data.Maybe (isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock.System
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
+import Network.HPACK.Token as HT
 import Network.HTTP.Types (Status)
 import qualified Network.HTTP.Types as N
 import Network.HTTP2.Client (Request)
@@ -50,7 +54,7 @@ import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
-import Simplex.Messaging.Notifications.Server.Store (NtfTknData (..))
+import Simplex.Messaging.Notifications.Server.Store.Types (NtfTknRec (..))
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import Simplex.Messaging.Transport.HTTP2.Client
@@ -263,8 +267,8 @@ disconnectApnsHTTP2Client APNSPushClient {https2Client} =
 ntfCategoryCheckMessage :: Text
 ntfCategoryCheckMessage = "NTF_CAT_CHECK_MESSAGE"

-apnsNotification :: NtfTknData -> C.CbNonce -> Int -> PushNotification -> Either C.CryptoError APNSNotification
-apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
+apnsNotification :: NtfTknRec -> C.CbNonce -> Int -> PushNotification -> Either C.CryptoError APNSNotification
+apnsNotification NtfTknRec {tknDhSecret} nonce paddedLen = \case
  PNVerification (NtfRegCode code) ->
    encrypt code $ \code' ->
      apn APNSBackground {contentAvailable = 1} . Just $ J.object ["nonce" .= nonce, "verification" .= code']
@@ -308,12 +312,12 @@ data PushProviderError
  = PPConnection HTTP2ClientError
  | PPCryptoError C.CryptoError
  | PPResponseError (Maybe Status) Text
-  | PPTokenInvalid
+  | PPTokenInvalid NTInvalidReason
  | PPRetryLater
  | PPPermanentError
  deriving (Show, Exception)

-type PushProviderClient = NtfTknData -> PushNotification -> ExceptT PushProviderError IO ()
+type PushProviderClient = NtfTknRec -> PushNotification -> ExceptT PushProviderError IO ()

 -- this is not a newtype on purpose to have a correct JSON encoding as a record
 data APNSErrorResponse = APNSErrorResponse {reason :: Text}
@@ -321,7 +325,7 @@ data APNSErrorResponse = APNSErrorResponse {reason :: Text}
 $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)

 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
-apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {token = DeviceToken _ tknStr} pn = do
+apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = DeviceToken _ tknStr} pn = do
  http2 <- liftHTTPS2 $ getApnsHTTP2Client c
  nonce <- atomically $ C.randomCbNonce nonceDrg
  apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
@@ -330,26 +334,34 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {toke
  HTTP2Response {response, respBody = HTTP2Body {bodyHead}} <- liftHTTPS2 $ sendRequest http2 req Nothing
  let status = H.responseStatus response
      reason' = maybe "" reason $ J.decodeStrict' bodyHead
-  logDebug $ "APNS response: " <> T.pack (show status) <> " " <> reason'
+  if status == Just N.ok200
+    then logDebug $ "APNS response: ok" <> apnsIds response
+    else logWarn $ "APNS error: " <> T.pack (show status) <> " " <> reason' <> apnsIds response
  result status reason'
  where
+    apnsIds response = headerStr "apns-id" <> headerStr "apns-unique-id"
+      where
+        headerStr name =
+          maybe "" (\(_, v) -> ", " <> name <> ": " <> safeDecodeUtf8 v) $
+            find (\(t, _) -> HT.tokenKey t == CI.mk (encodeUtf8 name)) (fst (H.responseHeaders response))
    result :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
    result status reason'
      | status == Just N.ok200 = pure ()
      | status == Just N.badRequest400 =
-          case reason' of
-            "BadDeviceToken" -> throwE PPTokenInvalid
-            "DeviceTokenNotForTopic" -> throwE PPTokenInvalid
-            "TopicDisallowed" -> throwE PPPermanentError
-            _ -> err status reason'
-      | status == Just N.forbidden403 = case reason' of
-          "ExpiredProviderToken" -> throwE PPPermanentError -- there should be no point retrying it as the token was refreshed
-          "InvalidProviderToken" -> throwE PPPermanentError
-          _ -> err status reason'
-      | status == Just N.gone410 = throwE PPTokenInvalid
+          throwE $ case reason' of
+            "BadDeviceToken" -> PPTokenInvalid NTIRBadToken
+            "DeviceTokenNotForTopic" -> PPTokenInvalid NTIRTokenNotForTopic
+            "TopicDisallowed" -> PPPermanentError
+            _ -> PPResponseError status reason'
+      | status == Just N.forbidden403 = throwE $ case reason' of
+          "ExpiredProviderToken" -> PPPermanentError -- there should be no point retrying it as the token was refreshed
+          "InvalidProviderToken" -> PPPermanentError
+          _ -> PPResponseError status reason'
+      | status == Just N.gone410 = throwE $ case reason' of
+          "ExpiredToken" -> PPTokenInvalid NTIRExpiredToken
+          "Unregistered" -> PPTokenInvalid NTIRUnregistered
+          _ -> PPRetryLater
      | status == Just N.serviceUnavailable503 = liftIO (disconnectApnsHTTP2Client c) >> throwE PPRetryLater
      -- Just tooManyRequests429 -> TooManyRequests - too many requests for the same token
-      | otherwise = err status reason'
-    err :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
-    err s r = throwE $ PPResponseError s r
+      | otherwise = throwE $ PPResponseError status reason'
    liftHTTPS2 a = ExceptT $ first PPConnection <$> a
@@ -4,23 +4,41 @@

 module Simplex.Messaging.Notifications.Server.Stats where

-import Control.Applicative (optional)
+import Control.Applicative (optional, (<|>))
+import Control.Concurrent.STM
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Data.IORef
+import qualified Data.Map.Strict as M
+import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Server.Stats
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM

 data NtfServerStats = NtfServerStats
  { fromTime :: IORef UTCTime,
    tknCreated :: IORef Int,
    tknVerified :: IORef Int,
    tknDeleted :: IORef Int,
+    tknReplaced :: IORef Int,
    subCreated :: IORef Int,
    subDeleted :: IORef Int,
    ntfReceived :: IORef Int,
+    ntfReceivedAuth :: IORef Int,
    ntfDelivered :: IORef Int,
+    ntfFailed :: IORef Int,
+    ntfReceivedOwn :: StatsByServer,
+    ntfReceivedAuthOwn :: StatsByServer,
+    ntfDeliveredOwn :: StatsByServer,
+    ntfFailedOwn :: StatsByServer,
+    ntfCronDelivered :: IORef Int,
+    ntfCronFailed :: IORef Int,
+    ntfVrfQueued :: IORef Int,
+    ntfVrfDelivered :: IORef Int,
+    ntfVrfFailed :: IORef Int,
+    ntfVrfInvalidTkn :: IORef Int,
    activeTokens :: PeriodStats,
    activeSubs :: PeriodStats
  }
@@ -30,10 +48,23 @@ data NtfServerStatsData = NtfServerStatsData
    _tknCreated :: Int,
    _tknVerified :: Int,
    _tknDeleted :: Int,
+    _tknReplaced :: Int,
    _subCreated :: Int,
    _subDeleted :: Int,
    _ntfReceived :: Int,
+    _ntfReceivedAuth :: Int,
    _ntfDelivered :: Int,
+    _ntfFailed :: Int,
+    _ntfReceivedOwn :: StatsByServerData,
+    _ntfReceivedAuthOwn :: StatsByServerData,
+    _ntfDeliveredOwn :: StatsByServerData,
+    _ntfFailedOwn :: StatsByServerData,
+    _ntfCronDelivered :: Int,
+    _ntfCronFailed :: Int,
+    _ntfVrfQueued :: Int,
+    _ntfVrfDelivered :: Int,
+    _ntfVrfFailed :: Int,
+    _ntfVrfInvalidTkn :: Int,
    _activeTokens :: PeriodStatsData,
    _activeSubs :: PeriodStatsData
  }
@@ -44,13 +75,51 @@ newNtfServerStats ts = do
  tknCreated <- newIORef 0
  tknVerified <- newIORef 0
  tknDeleted <- newIORef 0
+  tknReplaced <- newIORef 0
  subCreated <- newIORef 0
  subDeleted <- newIORef 0
  ntfReceived <- newIORef 0
+  ntfReceivedAuth <- newIORef 0
  ntfDelivered <- newIORef 0
+  ntfFailed <- newIORef 0
+  ntfReceivedOwn <- TM.emptyIO
+  ntfReceivedAuthOwn <- TM.emptyIO
+  ntfDeliveredOwn <- TM.emptyIO
+  ntfFailedOwn <- TM.emptyIO
+  ntfCronDelivered <- newIORef 0
+  ntfCronFailed <- newIORef 0
+  ntfVrfQueued <- newIORef 0
+  ntfVrfDelivered <- newIORef 0
+  ntfVrfFailed <- newIORef 0
+  ntfVrfInvalidTkn <- newIORef 0
  activeTokens <- newPeriodStats
  activeSubs <- newPeriodStats
-  pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}
+  pure
+    NtfServerStats
+      { fromTime,
+        tknCreated,
+        tknVerified,
+        tknDeleted,
+        tknReplaced,
+        subCreated,
+        subDeleted,
+        ntfReceived,
+        ntfReceivedAuth,
+        ntfDelivered,
+        ntfFailed,
+        ntfReceivedOwn,
+        ntfReceivedAuthOwn,
+        ntfDeliveredOwn,
+        ntfFailedOwn,
+        ntfCronDelivered,
+        ntfCronFailed,
+        ntfVrfQueued,
+        ntfVrfDelivered,
+        ntfVrfFailed,
+        ntfVrfInvalidTkn,
+        activeTokens,
+        activeSubs
+      }

 getNtfServerStatsData :: NtfServerStats -> IO NtfServerStatsData
 getNtfServerStatsData s@NtfServerStats {fromTime} = do
@@ -58,13 +127,51 @@ getNtfServerStatsData s@NtfServerStats {fromTime} = do
  _tknCreated <- readIORef $ tknCreated s
  _tknVerified <- readIORef $ tknVerified s
  _tknDeleted <- readIORef $ tknDeleted s
+  _tknReplaced <- readIORef $ tknReplaced s
  _subCreated <- readIORef $ subCreated s
  _subDeleted <- readIORef $ subDeleted s
  _ntfReceived <- readIORef $ ntfReceived s
+  _ntfReceivedAuth <- readIORef $ ntfReceivedAuth s
  _ntfDelivered <- readIORef $ ntfDelivered s
+  _ntfFailed <- readIORef $ ntfFailed s
+  _ntfReceivedOwn <- getStatsByServer $ ntfReceivedOwn s
+  _ntfReceivedAuthOwn <- getStatsByServer $ ntfReceivedAuthOwn s
+  _ntfDeliveredOwn <- getStatsByServer $ ntfDeliveredOwn s
+  _ntfFailedOwn <- getStatsByServer $ ntfFailedOwn s
+  _ntfCronDelivered <- readIORef $ ntfCronDelivered s
+  _ntfCronFailed <- readIORef $ ntfCronFailed s
+  _ntfVrfQueued <- readIORef $ ntfVrfQueued s
+  _ntfVrfDelivered <- readIORef $ ntfVrfDelivered s
+  _ntfVrfFailed <- readIORef $ ntfVrfFailed s
+  _ntfVrfInvalidTkn <- readIORef $ ntfVrfInvalidTkn s
  _activeTokens <- getPeriodStatsData $ activeTokens s
  _activeSubs <- getPeriodStatsData $ activeSubs s
-  pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
+  pure
+    NtfServerStatsData
+      { _fromTime,
+        _tknCreated,
+        _tknVerified,
+        _tknDeleted,
+        _tknReplaced,
+        _subCreated,
+        _subDeleted,
+        _ntfReceived,
+        _ntfReceivedAuth,
+        _ntfDelivered,
+        _ntfFailed,
+        _ntfReceivedOwn,
+        _ntfReceivedAuthOwn,
+        _ntfDeliveredOwn,
+        _ntfFailedOwn,
+        _ntfCronDelivered,
+        _ntfCronFailed,
+        _ntfVrfQueued,
+        _ntfVrfDelivered,
+        _ntfVrfFailed,
+        _ntfVrfInvalidTkn,
+        _activeTokens,
+        _activeSubs
+      }

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

 instance StrEncoding NtfServerStatsData where
-  strEncode NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs} =
+  strEncode
+    NtfServerStatsData
+      { _fromTime,
+        _tknCreated,
+        _tknVerified,
+        _tknDeleted,
+        _tknReplaced,
+        _subCreated,
+        _subDeleted,
+        _ntfReceived,
+        _ntfReceivedAuth,
+        _ntfDelivered,
+        _ntfFailed,
+        _ntfReceivedOwn,
+        _ntfReceivedAuthOwn,
+        _ntfDeliveredOwn,
+        _ntfFailedOwn,
+        _ntfCronDelivered,
+        _ntfCronFailed,
+        _ntfVrfQueued,
+        _ntfVrfDelivered,
+        _ntfVrfFailed,
+        _ntfVrfInvalidTkn,
+        _activeTokens,
+        _activeSubs
+      } =
    B.unlines
      [ "fromTime=" <> strEncode _fromTime,
        "tknCreated=" <> strEncode _tknCreated,
        "tknVerified=" <> strEncode _tknVerified,
        "tknDeleted=" <> strEncode _tknDeleted,
+        "tknReplaced=" <> strEncode _tknReplaced,
        "subCreated=" <> strEncode _subCreated,
        "subDeleted=" <> strEncode _subDeleted,
        "ntfReceived=" <> strEncode _ntfReceived,
+        "ntfReceivedAuth=" <> strEncode _ntfReceivedAuth,
        "ntfDelivered=" <> strEncode _ntfDelivered,
+        "ntfFailed=" <> strEncode _ntfFailed,
+        "ntfReceivedOwn=" <> strEncode _ntfReceivedOwn,
+        "ntfReceivedAuthOwn=" <> strEncode _ntfReceivedAuthOwn,
+        "ntfDeliveredOwn=" <> strEncode _ntfDeliveredOwn,
+        "ntfFailedOwn=" <> strEncode _ntfFailedOwn,
+        "ntfCronDelivered=" <> strEncode _ntfCronDelivered,
+        "ntfCronFailed=" <> strEncode _ntfCronFailed,
+        "ntfVrfQueued=" <> strEncode _ntfVrfQueued,
+        "ntfVrfDelivered=" <> strEncode _ntfVrfDelivered,
+        "ntfVrfFailed=" <> strEncode _ntfVrfFailed,
+        "ntfVrfInvalidTkn=" <> strEncode _ntfVrfInvalidTkn,
        "activeTokens:",
        strEncode _activeTokens,
        "activeSubs:",
@@ -101,12 +259,75 @@ instance StrEncoding NtfServerStatsData where
    _tknCreated <- "tknCreated=" *> strP <* A.endOfLine
    _tknVerified <- "tknVerified=" *> strP <* A.endOfLine
    _tknDeleted <- "tknDeleted=" *> strP <* A.endOfLine
+    _tknReplaced <- opt "tknReplaced="
    _subCreated <- "subCreated=" *> strP <* A.endOfLine
    _subDeleted <- "subDeleted=" *> strP <* A.endOfLine
    _ntfReceived <- "ntfReceived=" *> strP <* A.endOfLine
+    _ntfReceivedAuth <- opt "ntfReceivedAuth="
    _ntfDelivered <- "ntfDelivered=" *> strP <* A.endOfLine
+    _ntfFailed <- opt "ntfFailed="
+    _ntfReceivedOwn <- statByServerP "ntfReceivedOwn="
+    _ntfReceivedAuthOwn <- statByServerP "ntfReceivedAuthOwn="
+    _ntfDeliveredOwn <- statByServerP "ntfDeliveredOwn="
+    _ntfFailedOwn <- statByServerP "ntfFailedOwn="
+    _ntfCronDelivered <- opt "ntfCronDelivered="
+    _ntfCronFailed <- opt "ntfCronFailed="
+    _ntfVrfQueued <- opt "ntfVrfQueued="
+    _ntfVrfDelivered <- opt "ntfVrfDelivered="
+    _ntfVrfFailed <- opt "ntfVrfFailed="
+    _ntfVrfInvalidTkn <- opt "ntfVrfInvalidTkn="
    _ <- "activeTokens:" <* A.endOfLine
    _activeTokens <- strP <* A.endOfLine
    _ <- "activeSubs:" <* A.endOfLine
    _activeSubs <- strP <* optional A.endOfLine
-    pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
+    pure
+      NtfServerStatsData
+        { _fromTime,
+          _tknCreated,
+          _tknVerified,
+          _tknDeleted,
+          _tknReplaced,
+          _subCreated,
+          _subDeleted,
+          _ntfReceived,
+          _ntfReceivedAuth,
+          _ntfDelivered,
+          _ntfFailed,
+          _ntfReceivedOwn,
+          _ntfReceivedAuthOwn,
+          _ntfDeliveredOwn,
+          _ntfFailedOwn,
+          _ntfCronDelivered,
+          _ntfCronFailed,
+          _ntfVrfQueued,
+          _ntfVrfDelivered,
+          _ntfVrfFailed,
+          _ntfVrfInvalidTkn,
+          _activeTokens,
+          _activeSubs
+        }
+    where
+      opt s = A.string s *> strP <* A.endOfLine <|> pure 0
+      statByServerP s = A.string s *> strP <* A.endOfLine <|> pure (StatsByServerData [])
+
+type StatsByServer = TMap Text (TVar Int)
+
+newtype StatsByServerData = StatsByServerData [(Text, Int)]
+
+instance StrEncoding StatsByServerData where
+  strEncode (StatsByServerData d) = strEncodeList d
+  strP = StatsByServerData <$> serverP `A.sepBy'` A.char ','
+    where
+      serverP = (,) <$> strP_ <*> A.decimal
+
+getStatsByServer :: TMap Text (TVar Int) -> IO StatsByServerData
+getStatsByServer s = readTVarIO s >>= fmap (StatsByServerData . M.toList) . mapM readTVarIO
+
+setStatsByServer :: TMap Text (TVar Int) -> StatsByServerData -> IO ()
+setStatsByServer s (StatsByServerData d) = mapM newTVarIO (M.fromList d) >>= atomically . writeTVar s
+
+-- double lookup avoids STM transaction with a shared map in most cases
+incServerStat :: Text -> TMap Text (TVar Int) -> IO ()
+incServerStat h s = TM.lookupIO h s >>= atomically . maybe newServerStat (`modifyTVar'` (+ 1))
+  where
+    newServerStat = TM.lookup h s >>= maybe (TM.insertM h (newTVar 1) s) (`modifyTVar'` (+ 1))
@@ -24,71 +24,70 @@ import Data.Word (Word16)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Protocol (NtfPrivateAuthKey, NtfPublicAuthKey, SMPServer)
+import Simplex.Messaging.Protocol (NtfPrivateAuthKey, NtfPublicAuthKey, SMPServer, ServiceId)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (whenM, ($>>=))

-data NtfStore = NtfStore
+data NtfSTMStore = NtfSTMStore
  { tokens :: TMap NtfTokenId NtfTknData,
    -- multiple registrations exist to protect from malicious registrations if token is compromised
    tokenRegistrations :: TMap DeviceToken (TMap ByteString NtfTokenId),
    subscriptions :: TMap NtfSubscriptionId NtfSubData,
    tokenSubscriptions :: TMap NtfTokenId (TVar (Set NtfSubscriptionId)),
    subscriptionLookup :: TMap SMPQueueNtf NtfSubscriptionId,
-    tokenLastNtfs :: TMap NtfTokenId (TVar (NonEmpty PNMessageData))
+    tokenLastNtfs :: TMap NtfTokenId (TVar (NonEmpty PNMessageData)),
+    ntfServices :: TMap SMPServer ServiceId
  }

-newNtfStore :: IO NtfStore
-newNtfStore = do
+newNtfSTMStore :: IO NtfSTMStore
+newNtfSTMStore = do
  tokens <- TM.emptyIO
  tokenRegistrations <- TM.emptyIO
  subscriptions <- TM.emptyIO
  tokenSubscriptions <- TM.emptyIO
  subscriptionLookup <- TM.emptyIO
  tokenLastNtfs <- TM.emptyIO
-  pure NtfStore {tokens, tokenRegistrations, subscriptions, tokenSubscriptions, subscriptionLookup, tokenLastNtfs}
+  ntfServices <- TM.emptyIO
+  pure NtfSTMStore {tokens, tokenRegistrations, subscriptions, tokenSubscriptions, subscriptionLookup, tokenLastNtfs, ntfServices}

 data NtfTknData = NtfTknData
  { ntfTknId :: NtfTokenId,
    token :: DeviceToken,
    tknStatus :: TVar NtfTknStatus,
    tknVerifyKey :: NtfPublicAuthKey,
-    tknDhKeys :: C.KeyPair 'C.X25519,
+    tknDhKeys :: C.KeyPairX25519,
    tknDhSecret :: C.DhSecretX25519,
    tknRegCode :: NtfRegCode,
-    tknCronInterval :: TVar Word16
+    tknCronInterval :: TVar Word16,
+    tknUpdatedAt :: TVar (Maybe RoundedSystemTime)
  }

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

 data NtfSubData = NtfSubData
  { ntfSubId :: NtfSubscriptionId,
    smpQueue :: SMPQueueNtf,
    notifierKey :: NtfPrivateAuthKey,
    tokenId :: NtfTokenId,
-    subStatus :: TVar NtfSubStatus
+    subStatus :: TVar NtfSubStatus,
+    ntfServiceAssoc :: TVar Bool
  }

 ntfSubServer :: NtfSubData -> SMPServer
 ntfSubServer NtfSubData {smpQueue = SMPQueueNtf {smpServer}} = smpServer

-data NtfEntityRec (e :: NtfEntity) where
-  NtfTkn :: NtfTknData -> NtfEntityRec 'Token
-  NtfSub :: NtfSubData -> NtfEntityRec 'Subscription
+stmGetNtfTokenIO :: NtfSTMStore -> NtfTokenId -> IO (Maybe NtfTknData)
+stmGetNtfTokenIO st tknId = TM.lookupIO tknId (tokens st)

-getNtfToken :: NtfStore -> NtfTokenId -> STM (Maybe NtfTknData)
-getNtfToken st tknId = TM.lookup tknId (tokens st)
-
-getNtfTokenIO :: NtfStore -> NtfTokenId -> IO (Maybe NtfTknData)
-getNtfTokenIO st tknId = TM.lookupIO tknId (tokens st)
-
-addNtfToken :: NtfStore -> NtfTokenId -> NtfTknData -> STM ()
-addNtfToken st tknId tkn@NtfTknData {token, tknVerifyKey} = do
+stmAddNtfToken :: NtfSTMStore -> NtfTokenId -> NtfTknData -> STM ()
+stmAddNtfToken st tknId tkn@NtfTknData {token, tknVerifyKey} = do
  TM.insert tknId tkn $ tokens st
  TM.lookup token regs >>= \case
    Just tIds -> TM.insert regKey tknId tIds
@@ -99,16 +98,8 @@ addNtfToken st tknId tkn@NtfTknData {token, tknVerifyKey} = do
    regs = tokenRegistrations st
    regKey = C.toPubKey C.pubKeyBytes tknVerifyKey

-getNtfTokenRegistration :: NtfStore -> NewNtfEntity 'Token -> STM (Maybe NtfTknData)
-getNtfTokenRegistration st (NewNtfTkn token tknVerifyKey _) =
-  TM.lookup token (tokenRegistrations st)
-    $>>= TM.lookup regKey
-    $>>= (`TM.lookup` tokens st)
-  where
-    regKey = C.toPubKey C.pubKeyBytes tknVerifyKey
-
-removeInactiveTokenRegistrations :: NtfStore -> NtfTknData -> STM [NtfTokenId]
-removeInactiveTokenRegistrations st NtfTknData {ntfTknId = tId, token} =
+stmRemoveInactiveTokenRegistrations :: NtfSTMStore -> NtfTknData -> STM [NtfTokenId]
+stmRemoveInactiveTokenRegistrations st NtfTknData {ntfTknId = tId, token} =
  TM.lookup token (tokenRegistrations st)
    >>= maybe (pure []) removeRegs
  where
@@ -122,8 +113,8 @@ removeInactiveTokenRegistrations st NtfTknData {ntfTknId = tId, token} =
        void $ deleteTokenSubs st tId'
      pure $ map snd tIds

-removeTokenRegistration :: NtfStore -> NtfTknData -> STM ()
-removeTokenRegistration st NtfTknData {ntfTknId = tId, token, tknVerifyKey} =
+stmRemoveTokenRegistration :: NtfSTMStore -> NtfTknData -> STM ()
+stmRemoveTokenRegistration st NtfTknData {ntfTknId = tId, token, tknVerifyKey} =
  TM.lookup token (tokenRegistrations st) >>= mapM_ removeReg
  where
    removeReg regs =
@@ -131,8 +122,8 @@ removeTokenRegistration st NtfTknData {ntfTknId = tId, token, tknVerifyKey} =
        >>= mapM_ (\tId' -> when (tId == tId') $ TM.delete k regs)
    k = C.toPubKey C.pubKeyBytes tknVerifyKey

-deleteNtfToken :: NtfStore -> NtfTokenId -> STM [SMPQueueNtf]
-deleteNtfToken st tknId = do
+stmDeleteNtfToken :: NtfSTMStore -> NtfTokenId -> STM [SMPQueueNtf]
+stmDeleteNtfToken st tknId = do
  void $
    TM.lookupDelete tknId (tokens st) $>>= \NtfTknData {token, tknVerifyKey} ->
      TM.lookup token regs $>>= \tIds ->
@@ -144,7 +135,7 @@ deleteNtfToken st tknId = do
    regs = tokenRegistrations st
    regKey = C.toPubKey C.pubKeyBytes

-deleteTokenSubs :: NtfStore -> NtfTokenId -> STM [SMPQueueNtf]
+deleteTokenSubs :: NtfSTMStore -> NtfTokenId -> STM [SMPQueueNtf]
 deleteTokenSubs st tknId = do
  qs <-
    TM.lookupDelete tknId (tokenSubscriptions st)
@@ -156,33 +147,11 @@ deleteTokenSubs st tknId = do
        $>>= \NtfSubData {smpQueue} ->
          TM.delete smpQueue (subscriptionLookup st) $> Just smpQueue

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

-findNtfSubscription :: NtfStore -> SMPQueueNtf -> STM (Maybe NtfSubData)
-findNtfSubscription st smpQueue = do
-  TM.lookup smpQueue (subscriptionLookup st)
-    $>>= \subId -> TM.lookup subId (subscriptions st)
-
-findNtfSubscriptionToken :: NtfStore -> SMPQueueNtf -> STM (Maybe NtfTknData)
-findNtfSubscriptionToken st smpQueue = do
-  findNtfSubscription st smpQueue
-    $>>= \NtfSubData {tokenId} -> getActiveNtfToken st tokenId
-
-getActiveNtfToken :: NtfStore -> NtfTokenId -> STM (Maybe NtfTknData)
-getActiveNtfToken st tknId =
-  getNtfToken st tknId $>>= \tkn@NtfTknData {tknStatus} -> do
-    tStatus <- readTVar tknStatus
-    pure $ if tStatus == NTActive then Just tkn else Nothing
-
-mkNtfSubData :: NtfSubscriptionId -> NewNtfEntity 'Subscription -> STM NtfSubData
-mkNtfSubData ntfSubId (NewNtfSub tokenId smpQueue notifierKey) = do
-  subStatus <- newTVar NSNew
-  pure NtfSubData {ntfSubId, smpQueue, tokenId, subStatus, notifierKey}
-
-addNtfSubscription :: NtfStore -> NtfSubscriptionId -> NtfSubData -> STM (Maybe ())
-addNtfSubscription st subId sub@NtfSubData {smpQueue, tokenId} =
+stmAddNtfSubscription :: NtfSTMStore -> NtfSubscriptionId -> NtfSubData -> STM (Maybe ())
+stmAddNtfSubscription st subId sub@NtfSubData {smpQueue, tokenId} =
  TM.lookup tokenId (tokenSubscriptions st) >>= maybe newTokenSub pure >>= insertSub
  where
    newTokenSub = do
@@ -196,8 +165,8 @@ addNtfSubscription st subId sub@NtfSubData {smpQueue, tokenId} =
      -- return Nothing if subscription existed before
      pure $ Just ()

-deleteNtfSubscription :: NtfStore -> NtfSubscriptionId -> STM ()
-deleteNtfSubscription st subId = do
+stmDeleteNtfSubscription :: NtfSTMStore -> NtfSubscriptionId -> STM ()
+stmDeleteNtfSubscription st subId = do
  TM.lookupDelete subId (subscriptions st)
    >>= mapM_
      ( \NtfSubData {smpQueue, tokenId} -> do
@@ -206,32 +175,10 @@ deleteNtfSubscription st subId = do
          forM_ ts_ $ \ts -> modifyTVar' ts $ S.delete subId
      )

-addTokenLastNtf :: NtfStore -> NtfTokenId -> PNMessageData -> IO (NonEmpty PNMessageData)
-addTokenLastNtf st tknId newNtf =
-  TM.lookupIO tknId (tokenLastNtfs st) >>= maybe (atomically maybeNewTokenLastNtfs) (atomically . addNtf)
-  where
-    maybeNewTokenLastNtfs =
-      TM.lookup tknId (tokenLastNtfs st) >>= maybe newTokenLastNtfs addNtf
-    newTokenLastNtfs = do
-      v <- newTVar [newNtf]
-      TM.insert tknId v $ tokenLastNtfs st
-      pure [newNtf]
-    addNtf v =
-      stateTVar v $ \ntfs -> let !ntfs' = rebuildList ntfs in (ntfs', ntfs')
-      where
-        rebuildList :: NonEmpty PNMessageData -> NonEmpty PNMessageData
-        rebuildList = foldr keepPrevNtf [newNtf]
-          where
-            PNMessageData {smpQueue = newNtfQ} = newNtf
-            keepPrevNtf ntf@PNMessageData {smpQueue} ntfs
-              | smpQueue /= newNtfQ && length ntfs < maxNtfs = ntf <| ntfs
-              | otherwise = ntfs
-        maxNtfs = 6
-
 -- This function is expected to be called after store log is read,
 -- as it checks for token existence when adding last notification.
-storeTokenLastNtf :: NtfStore -> NtfTokenId -> PNMessageData -> IO ()
-storeTokenLastNtf (NtfStore {tokens, tokenLastNtfs}) tknId ntf = do
+stmStoreTokenLastNtf :: NtfSTMStore -> NtfTokenId -> PNMessageData -> IO ()
+stmStoreTokenLastNtf (NtfSTMStore {tokens, tokenLastNtfs}) tknId ntf = do
  TM.lookupIO tknId tokenLastNtfs >>= atomically . maybe newTokenLastNtfs (`modifyTVar'` (ntf <|))
  where
    newTokenLastNtfs = TM.lookup tknId tokenLastNtfs >>= maybe insertForExistingToken (`modifyTVar'` (ntf <|))
@@ -239,6 +186,10 @@ storeTokenLastNtf (NtfStore {tokens, tokenLastNtfs}) tknId ntf = do
      whenM (TM.member tknId tokens) $
        TM.insertM tknId (newTVar [ntf]) tokenLastNtfs

+stmSetNtfService :: NtfSTMStore -> SMPServer -> Maybe ServiceId -> STM ()
+stmSetNtfService (NtfSTMStore {ntfServices}) srv serviceId =
+  maybe (TM.delete srv) (TM.insert srv) serviceId ntfServices
+
 data TokenNtfMessageRecord = TNMRv1 NtfTokenId PNMessageData

 instance StrEncoding TokenNtfMessageRecord where
@@ -0,0 +1,106 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Notifications.Server.Store.Migrations where
+
+import Data.List (sortOn)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Simplex.Messaging.Agent.Store.Shared
+import Text.RawString.QQ (r)
+
+ntfServerSchemaMigrations :: [(String, Text, Maybe Text)]
+ntfServerSchemaMigrations =
+  [ ("20250417_initial", m20250417_initial, Nothing),
+    ("20250517_service_cert", m20250517_service_cert, Just down_m20250517_service_cert)
+  ]
+
+-- | The list of migrations in ascending order by date
+ntfServerMigrations :: [Migration]
+ntfServerMigrations = sortOn name $ map migration ntfServerSchemaMigrations
+  where
+    migration (name, up, down) = Migration {name, up, down = down}
+
+m20250417_initial :: Text
+m20250417_initial =
+  T.pack
+    [r|
+CREATE TABLE tokens(
+  token_id BYTEA NOT NULL,
+  push_provider TEXT NOT NULL,
+  push_provider_token BYTEA NOT NULL,
+  status TEXT NOT NULL,
+  verify_key BYTEA NOT NULL,
+  dh_priv_key BYTEA NOT NULL,
+  dh_secret BYTEA NOT NULL,
+  reg_code BYTEA NOT NULL,
+  cron_interval BIGINT NOT NULL, -- minutes
+  cron_sent_at BIGINT, -- seconds
+  updated_at BIGINT,
+  PRIMARY KEY (token_id)
+);
+
+CREATE UNIQUE INDEX idx_tokens_push_provider_token ON tokens(push_provider, push_provider_token, verify_key);
+CREATE INDEX idx_tokens_status_cron_interval_sent_at ON tokens(status, cron_interval, (cron_sent_at + cron_interval * 60));
+
+CREATE TABLE smp_servers(
+  smp_server_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  smp_host TEXT NOT NULL,
+  smp_port TEXT NOT NULL,
+  smp_keyhash BYTEA NOT NULL
+);
+
+CREATE UNIQUE INDEX idx_smp_servers ON smp_servers(smp_host, smp_port, smp_keyhash);
+
+CREATE TABLE subscriptions(
+  subscription_id BYTEA NOT NULL,
+  token_id BYTEA NOT NULL REFERENCES tokens ON DELETE CASCADE ON UPDATE RESTRICT,
+  smp_server_id BIGINT REFERENCES smp_servers ON DELETE RESTRICT ON UPDATE RESTRICT,
+  smp_notifier_id BYTEA NOT NULL,
+  smp_notifier_key BYTEA NOT NULL,
+  status TEXT NOT NULL,
+  PRIMARY KEY (subscription_id)
+);
+
+CREATE UNIQUE INDEX idx_subscriptions_smp_server_id_notifier_id ON subscriptions(smp_server_id, smp_notifier_id);
+CREATE INDEX idx_subscriptions_smp_server_id_status ON subscriptions(smp_server_id, status);
+CREATE INDEX idx_subscriptions_token_id ON subscriptions(token_id);
+
+CREATE TABLE last_notifications(
+  token_ntf_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  token_id BYTEA NOT NULL REFERENCES tokens ON DELETE CASCADE ON UPDATE RESTRICT,
+  subscription_id BYTEA NOT NULL REFERENCES subscriptions ON DELETE CASCADE ON UPDATE RESTRICT,
+  sent_at TIMESTAMPTZ NOT NULL,
+  nmsg_nonce BYTEA NOT NULL,
+  nmsg_data BYTEA NOT NULL
+);
+
+CREATE INDEX idx_last_notifications_token_id_sent_at ON last_notifications(token_id, sent_at);
+CREATE INDEX idx_last_notifications_subscription_id ON last_notifications(subscription_id);
+
+CREATE UNIQUE INDEX idx_last_notifications_token_subscription ON last_notifications(token_id, subscription_id);
+    |]
+
+m20250517_service_cert :: Text
+m20250517_service_cert =
+  T.pack
+    [r|
+ALTER TABLE smp_servers ADD COLUMN ntf_service_id BYTEA;
+
+ALTER TABLE subscriptions ADD COLUMN ntf_service_assoc BOOLEAN NOT NULL DEFAULT FALSE;
+
+DROP INDEX idx_subscriptions_smp_server_id_status;
+CREATE INDEX idx_subscriptions_smp_server_id_ntf_service_status ON subscriptions(smp_server_id, ntf_service_assoc, status);
+    |]
+
+down_m20250517_service_cert :: Text
+down_m20250517_service_cert =
+  T.pack
+    [r|
+DROP INDEX idx_subscriptions_smp_server_id_ntf_service_status;
+CREATE INDEX idx_subscriptions_smp_server_id_status ON subscriptions(smp_server_id, status);
+
+ALTER TABLE smp_servers DROP COLUMN ntf_service_id;
+
+ALTER TABLE subscriptions DROP COLUMN ntf_service_assoc;
+    |]
@@ -0,0 +1,931 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-ambiguous-fields #-}
+
+module Simplex.Messaging.Notifications.Server.Store.Postgres where
+
+import Control.Concurrent.STM
+import qualified Control.Exception as E
+import Control.Logger.Simple
+import Control.Monad
+import Control.Monad.Except
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
+import Data.Bitraversable (bimapM)
+import qualified Data.ByteString.Base64.URL as B64
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Containers.ListUtils (nubOrd)
+import Data.Either (fromRight)
+import Data.Functor (($>))
+import Data.Int (Int64)
+import Data.List (findIndex, foldl')
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
+import qualified Data.Map.Strict as M
+import Data.Maybe (fromMaybe, isJust, mapMaybe)
+import qualified Data.Set as S
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
+import Data.Time.Clock (UTCTime)
+import Data.Time.Clock.System (SystemTime (..), systemToUTCTime, utcToSystemTime)
+import Data.Word (Word16)
+import Database.PostgreSQL.Simple (Binary (..), In (..), Only (..), Query, ToRow, (:.) (..))
+import qualified Database.PostgreSQL.Simple as DB
+import Database.PostgreSQL.Simple.FromField (FromField (..))
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.ToField (ToField (..))
+import Network.Socket (ServiceName)
+import Simplex.Messaging.Agent.Store.AgentStore ()
+import Simplex.Messaging.Agent.Store.Postgres (closeDBStore, createDBStore)
+import Simplex.Messaging.Agent.Store.Postgres.Common
+import Simplex.Messaging.Agent.Store.Postgres.DB (blobFieldDecoder, fromTextField_)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Store (NtfSTMStore (..), NtfSubData (..), NtfTknData (..), TokenNtfMessageRecord (..), ntfSubServer)
+import Simplex.Messaging.Notifications.Server.Store.Migrations
+import Simplex.Messaging.Notifications.Server.Store.Types
+import Simplex.Messaging.Notifications.Server.StoreLog
+import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Protocol (EntityId (..), EncNMsgMeta, ErrorType (..), NotifierId, NtfPrivateAuthKey, NtfPublicAuthKey, SMPServer, ServiceId, pattern SMPServer)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getSystemDate)
+import Simplex.Messaging.Server.QueueStore.Postgres (handleDuplicate, withLog_)
+import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
+import Simplex.Messaging.Server.StoreLog (openWriteStoreLog)
+import Simplex.Messaging.Transport.Client (TransportHost)
+import Simplex.Messaging.Util (anyM, firstRow, maybeFirstRow, toChunks, tshow)
+import System.Exit (exitFailure)
+import System.IO (IOMode (..), hFlush, stdout, withFile)
+import Text.Hex (decodeHex)
+
+#if !defined(dbPostgres)
+import Simplex.Messaging.Util (eitherToMaybe)
+#endif
+
+data NtfPostgresStore = NtfPostgresStore
+  { dbStore :: DBStore,
+    dbStoreLog :: Maybe (StoreLog 'WriteMode),
+    deletedTTL :: Int64
+  }
+
+mkNtfTknRec :: NtfTokenId -> NewNtfEntity 'Token -> C.PrivateKeyX25519 -> C.DhSecretX25519 -> NtfRegCode -> RoundedSystemTime -> NtfTknRec
+mkNtfTknRec ntfTknId (NewNtfTkn token tknVerifyKey _) tknDhPrivKey tknDhSecret tknRegCode ts =
+  NtfTknRec {ntfTknId, token, tknStatus = NTRegistered, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval = 0, tknUpdatedAt = Just ts}
+
+ntfSubServer' :: NtfSubRec -> SMPServer
+ntfSubServer' NtfSubRec {smpQueue = SMPQueueNtf {smpServer}} = smpServer
+
+data NtfEntityRec (e :: NtfEntity) where
+  NtfTkn :: NtfTknRec -> NtfEntityRec 'Token
+  NtfSub :: NtfSubRec -> NtfEntityRec 'Subscription
+
+newNtfDbStore :: PostgresStoreCfg -> IO NtfPostgresStore
+newNtfDbStore PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations, deletedTTL} = do
+  dbStore <- either err pure =<< createDBStore dbOpts ntfServerMigrations confirmMigrations
+  dbStoreLog <- mapM (openWriteStoreLog True) dbStoreLogPath
+  pure NtfPostgresStore {dbStore, dbStoreLog, deletedTTL}
+  where
+    err e = do
+      logError $ "STORE: newNtfStore, error opening PostgreSQL database, " <> tshow e
+      exitFailure
+
+closeNtfDbStore :: NtfPostgresStore -> IO ()
+closeNtfDbStore NtfPostgresStore {dbStore, dbStoreLog} = do
+  closeDBStore dbStore
+  mapM_ closeStoreLog dbStoreLog
+
+addNtfToken :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
+addNtfToken st tkn =
+  withFastDB "addNtfToken" st $ \db ->
+    E.try (DB.execute db insertNtfTknQuery $ ntfTknToRow tkn)
+      >>= bimapM handleDuplicate (\_ -> withLog "addNtfToken" st (`logCreateToken` tkn))
+
+insertNtfTknQuery :: Query
+insertNtfTknQuery =
+  [sql|
+    INSERT INTO tokens
+      (token_id, push_provider, push_provider_token, status, verify_key, dh_priv_key, dh_secret, reg_code, cron_interval, updated_at)
+    VALUES (?,?,?,?,?,?,?,?,?,?)
+  |]
+
+replaceNtfToken :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
+replaceNtfToken st NtfTknRec {ntfTknId, token = token@(DeviceToken pp ppToken), tknStatus, tknRegCode = code@(NtfRegCode regCode)} =
+  withFastDB "replaceNtfToken" st $ \db -> runExceptT $ do
+    ExceptT $ assertUpdated <$>
+      DB.execute
+        db
+        [sql|
+          UPDATE tokens
+          SET push_provider = ?, push_provider_token = ?, status = ?, reg_code = ?
+          WHERE token_id = ?
+        |]
+        (pp, Binary ppToken, tknStatus, Binary regCode, ntfTknId)
+    withLog "replaceNtfToken" st $ \sl -> logUpdateToken sl ntfTknId token code
+
+ntfTknToRow :: NtfTknRec -> NtfTknRow
+ntfTknToRow NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt} =
+  let DeviceToken pp ppToken = token
+      NtfRegCode regCode = tknRegCode
+   in (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt)
+
+getNtfToken :: NtfPostgresStore -> NtfTokenId -> IO (Either ErrorType NtfTknRec)
+getNtfToken st tknId =
+  (maybe (Left AUTH) Right =<<) <$>
+    getNtfToken_ st " WHERE token_id = ?" (Only tknId)
+
+findNtfTokenRegistration :: NtfPostgresStore -> NewNtfEntity 'Token -> IO (Either ErrorType (Maybe NtfTknRec))
+findNtfTokenRegistration st (NewNtfTkn (DeviceToken pp ppToken) tknVerifyKey _) =
+  getNtfToken_ st " WHERE push_provider = ? AND push_provider_token = ? AND verify_key = ?" (pp, Binary ppToken, tknVerifyKey)
+
+getNtfToken_ :: ToRow q => NtfPostgresStore -> Query -> q -> IO (Either ErrorType (Maybe NtfTknRec))
+getNtfToken_ st cond params =
+  withFastDB' "getNtfToken" st $ \db -> do
+    tkn_ <- maybeFirstRow rowToNtfTkn $ DB.query db (ntfTknQuery <> cond) params
+    mapM_ (updateTokenDate st db) tkn_
+    pure tkn_
+
+updateTokenDate :: NtfPostgresStore -> DB.Connection -> NtfTknRec -> IO ()
+updateTokenDate st db NtfTknRec {ntfTknId, tknUpdatedAt} = do
+  ts <- getSystemDate
+  when (maybe True (ts /=) tknUpdatedAt) $ do
+    void $ DB.execute db "UPDATE tokens SET updated_at = ? WHERE token_id = ?" (ts, ntfTknId)
+    withLog "updateTokenDate" st $ \sl -> logUpdateTokenTime sl ntfTknId ts
+
+type NtfTknRow = (NtfTokenId, PushProvider, Binary ByteString, NtfTknStatus, NtfPublicAuthKey, C.PrivateKeyX25519, C.DhSecretX25519, Binary ByteString, Word16, Maybe RoundedSystemTime)
+
+ntfTknQuery :: Query
+ntfTknQuery =
+  [sql|
+    SELECT token_id, push_provider, push_provider_token, status, verify_key, dh_priv_key, dh_secret, reg_code, cron_interval, updated_at
+    FROM tokens
+  |]
+
+rowToNtfTkn :: NtfTknRow -> NtfTknRec
+rowToNtfTkn (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt)  =
+  let token = DeviceToken pp ppToken
+      tknRegCode = NtfRegCode regCode
+   in NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}
+
+deleteNtfToken :: NtfPostgresStore -> NtfTokenId -> IO (Either ErrorType [(SMPServer, [NotifierId])])
+deleteNtfToken st tknId =
+  withFastDB "deleteNtfToken" st $ \db -> runExceptT $ do
+    -- This SELECT obtains exclusive lock on token row and prevents any inserts
+    -- into other tables for this token ID until the deletion completes.
+    _ <- ExceptT $ firstRow (fromOnly @Int) AUTH $
+      DB.query db "SELECT 1 FROM tokens WHERE token_id = ? FOR UPDATE" (Only tknId)
+    subs <-
+      liftIO $ map toServerSubs <$>
+        DB.query
+          db
+          [sql|
+            SELECT p.smp_host, p.smp_port, p.smp_keyhash,
+              string_agg(s.smp_notifier_id :: TEXT, ',') AS notifier_ids
+            FROM smp_servers p
+            JOIN subscriptions s ON s.smp_server_id = p.smp_server_id
+            WHERE s.token_id = ?
+            GROUP BY p.smp_host, p.smp_port, p.smp_keyhash;
+          |]
+          (Only tknId)
+    liftIO $ void $ DB.execute db "DELETE FROM tokens WHERE token_id = ?" (Only tknId)
+    withLog "deleteNtfToken" st (`logDeleteToken` tknId)
+    pure subs
+  where
+    toServerSubs :: SMPServerRow :. Only Text -> (SMPServer, [NotifierId])
+    toServerSubs (srv :. Only nIdsStr) = (rowToSrv srv, parseByteaString nIdsStr)
+    parseByteaString :: Text -> [NotifierId]
+    parseByteaString s = mapMaybe (fmap EntityId . decodeHex . T.drop 2) $ T.splitOn "," s  -- drop 2 to remove "\\x"
+
+type SMPServerRow = (NonEmpty TransportHost, ServiceName, C.KeyHash)
+
+type SMPQueueNtfRow = (NonEmpty TransportHost, ServiceName, C.KeyHash, NotifierId)
+
+rowToSrv :: SMPServerRow -> SMPServer
+rowToSrv (host, port, kh) = SMPServer host port kh
+
+srvToRow :: SMPServer -> SMPServerRow
+srvToRow (SMPServer host port kh) = (host, port, kh)
+
+smpQueueToRow :: SMPQueueNtf -> SMPQueueNtfRow
+smpQueueToRow (SMPQueueNtf (SMPServer host port kh) nId) = (host, port, kh, nId)
+
+rowToSMPQueue :: SMPQueueNtfRow -> SMPQueueNtf
+rowToSMPQueue (host, port, kh, nId) = SMPQueueNtf (SMPServer host port kh) nId
+
+updateTknCronInterval :: NtfPostgresStore -> NtfTokenId -> Word16 -> IO (Either ErrorType ())
+updateTknCronInterval st tknId cronInt =
+  withFastDB "updateTknCronInterval" st $ \db -> runExceptT $ do
+    ExceptT $ assertUpdated <$>
+      DB.execute db "UPDATE tokens SET cron_interval = ? WHERE token_id = ?" (cronInt, tknId)
+    withLog "updateTknCronInterval" st $ \sl -> logTokenCron sl tknId 0
+
+-- Reads servers that have subscriptions that need subscribing.
+-- It is executed on server start, and it is supposed to crash on database error
+getUsedSMPServers :: NtfPostgresStore -> IO [(SMPServer, Int64, Maybe (ServiceId, Int64))]
+getUsedSMPServers st =
+  withTransaction (dbStore st) $ \db ->
+    map rowToSrvSubs <$>
+      DB.query
+        db
+        [sql|
+          SELECT
+            p.smp_host, p.smp_port, p.smp_keyhash, p.smp_server_id, p.ntf_service_id,
+            SUM(CASE WHEN s.ntf_service_assoc THEN s.subs_count ELSE 0 END) :: BIGINT as service_subs_count
+          FROM smp_servers p
+          JOIN (
+            SELECT
+              smp_server_id,
+              ntf_service_assoc,
+              COUNT(1) as subs_count
+            FROM subscriptions
+            WHERE status IN ?
+            GROUP BY smp_server_id, ntf_service_assoc
+          ) s ON s.smp_server_id = p.smp_server_id
+          GROUP BY p.smp_host, p.smp_port, p.smp_keyhash, p.smp_server_id, p.ntf_service_id
+        |]
+        (Only (In [NSNew, NSPending, NSActive, NSInactive]))
+  where
+    rowToSrvSubs :: SMPServerRow :. (Int64, Maybe ServiceId, Int64) -> (SMPServer, Int64, Maybe (ServiceId, Int64))
+    rowToSrvSubs ((host, port, kh) :. (srvId, serviceId_, subsCount)) =
+      (SMPServer host port kh, srvId, (,subsCount) <$> serviceId_)
+
+getServerNtfSubscriptions :: NtfPostgresStore -> Int64 -> Maybe NtfSubscriptionId -> Int -> IO (Either ErrorType [ServerNtfSub])
+getServerNtfSubscriptions st srvId afterSubId_ count =
+  withDB' "getServerNtfSubscriptions" st $ \db -> do
+    subs <-
+      map toServerNtfSub <$> case afterSubId_ of
+        Nothing ->
+          DB.query db (query <> orderLimit) (srvId, statusIn, count)
+        Just afterSubId ->
+          DB.query db (query <> " AND subscription_id > ?" <> orderLimit) (srvId, statusIn, afterSubId, count)
+    void $
+      DB.executeMany
+        db
+        [sql|
+          UPDATE subscriptions s
+          SET status = upd.status
+          FROM (VALUES(?, ?)) AS upd(status, subscription_id)
+          WHERE s.subscription_id = (upd.subscription_id :: BYTEA)
+            AND s.status != upd.status
+        |]
+        (map ((NSPending,) . fst) subs)
+    pure subs
+  where
+    query =
+      [sql|
+        SELECT subscription_id, smp_notifier_id, smp_notifier_key
+        FROM subscriptions
+        WHERE smp_server_id = ? AND NOT ntf_service_assoc AND status IN ?
+      |]
+    orderLimit = " ORDER BY subscription_id LIMIT ?"
+    statusIn = In [NSNew, NSPending, NSActive, NSInactive]
+    toServerNtfSub (ntfSubId, notifierId, notifierKey) = (ntfSubId, (notifierId, notifierKey))
+
+-- Returns token and subscription.
+-- If subscription exists but belongs to another token, returns Left AUTH
+findNtfSubscription :: NtfPostgresStore -> NtfTokenId -> SMPQueueNtf -> IO (Either ErrorType (NtfTknRec, Maybe NtfSubRec))
+findNtfSubscription st tknId q =
+  withFastDB "findNtfSubscription" st $ \db -> runExceptT $ do
+    tkn@NtfTknRec {ntfTknId, tknStatus} <- ExceptT $ getNtfToken st tknId
+    unless (allowNtfSubCommands tknStatus) $ throwE AUTH
+    liftIO $ updateTokenDate st db tkn
+    sub_ <-
+      liftIO $ maybeFirstRow (rowToNtfSub q) $
+        DB.query
+          db
+          [sql|
+            SELECT s.token_id, s.subscription_id, s.smp_notifier_key, s.status, s.ntf_service_assoc
+            FROM subscriptions s
+            JOIN smp_servers p ON p.smp_server_id = s.smp_server_id
+            WHERE p.smp_host = ? AND p.smp_port = ? AND p.smp_keyhash = ?
+              AND s.smp_notifier_id = ?
+          |]
+          (smpQueueToRow q)
+    forM_ sub_ $ \NtfSubRec {tokenId} -> unless (ntfTknId == tokenId) $ throwE AUTH
+    pure (tkn, sub_)
+
+getNtfSubscription :: NtfPostgresStore -> NtfSubscriptionId -> IO (Either ErrorType (NtfTknRec, NtfSubRec))
+getNtfSubscription st subId =
+  withFastDB "getNtfSubscription" st $ \db -> runExceptT $ do
+    r@(tkn@NtfTknRec {tknStatus}, _) <-
+      ExceptT $ firstRow rowToNtfTknSub AUTH $
+        DB.query
+          db
+          [sql|
+            SELECT t.token_id, t.push_provider, t.push_provider_token, t.status, t.verify_key, t.dh_priv_key, t.dh_secret, t.reg_code, t.cron_interval, t.updated_at,
+              s.subscription_id, s.smp_notifier_key, s.status, s.ntf_service_assoc,
+              p.smp_host, p.smp_port, p.smp_keyhash, s.smp_notifier_id
+            FROM subscriptions s
+            JOIN tokens t ON t.token_id = s.token_id
+            JOIN smp_servers p ON p.smp_server_id = s.smp_server_id
+            WHERE s.subscription_id = ?
+          |]
+          (Only subId)
+    liftIO $ updateTokenDate st db tkn
+    unless (allowNtfSubCommands tknStatus) $ throwE AUTH
+    pure r
+
+type NtfSubRow = (NtfSubscriptionId, NtfPrivateAuthKey, NtfSubStatus, NtfAssociatedService)
+
+rowToNtfTknSub :: NtfTknRow :. NtfSubRow :. SMPQueueNtfRow -> (NtfTknRec, NtfSubRec)
+rowToNtfTknSub (tknRow :. (ntfSubId, notifierKey, subStatus, ntfServiceAssoc) :. qRow)  =
+  let tkn@NtfTknRec {ntfTknId = tokenId} = rowToNtfTkn tknRow
+      smpQueue = rowToSMPQueue qRow
+   in (tkn, NtfSubRec {ntfSubId, tokenId, smpQueue, notifierKey, subStatus, ntfServiceAssoc})
+
+rowToNtfSub :: SMPQueueNtf -> Only NtfTokenId :. NtfSubRow -> NtfSubRec
+rowToNtfSub smpQueue (Only tokenId :. (ntfSubId, notifierKey, subStatus, ntfServiceAssoc)) =
+  NtfSubRec {ntfSubId, tokenId, smpQueue, notifierKey, subStatus, ntfServiceAssoc}
+
+mkNtfSubRec :: NtfSubscriptionId -> NewNtfEntity 'Subscription -> NtfSubRec
+mkNtfSubRec ntfSubId (NewNtfSub tokenId smpQueue notifierKey) =
+  NtfSubRec {ntfSubId, tokenId, smpQueue, subStatus = NSNew, notifierKey, ntfServiceAssoc = False}
+
+updateTknStatus :: NtfPostgresStore -> NtfTknRec -> NtfTknStatus -> IO (Either ErrorType ())
+updateTknStatus st tkn status =
+  withFastDB' "updateTknStatus" st $ \db -> updateTknStatus_ st db tkn status
+
+updateTknStatus_ :: NtfPostgresStore -> DB.Connection -> NtfTknRec -> NtfTknStatus -> IO ()
+updateTknStatus_ st db NtfTknRec {ntfTknId} status = do
+  updated <- DB.execute db "UPDATE tokens SET status = ? WHERE token_id = ? AND status != ?" (status, ntfTknId, status)
+  when (updated > 0) $ withLog "updateTknStatus" st $ \sl -> logTokenStatus sl ntfTknId status
+
+-- unless it was already active
+setTknStatusConfirmed :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
+setTknStatusConfirmed st NtfTknRec {ntfTknId} =
+  withFastDB' "updateTknStatus" st $ \db -> do
+    updated <- DB.execute db "UPDATE tokens SET status = ? WHERE token_id = ? AND status != ? AND status != ?" (NTConfirmed, ntfTknId, NTConfirmed, NTActive)
+    when (updated > 0) $ withLog "updateTknStatus" st $ \sl -> logTokenStatus sl ntfTknId NTConfirmed
+
+setTokenActive :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
+setTokenActive st tkn@NtfTknRec {ntfTknId, token = DeviceToken pp ppToken} =
+  withFastDB' "setTokenActive" st $ \db -> do
+    updateTknStatus_ st db tkn NTActive
+    -- this removes other instances of the same token, e.g. because of repeated token registration attempts
+    tknIds <-
+      liftIO $ map fromOnly <$>
+        DB.query
+          db
+          [sql|
+            DELETE FROM tokens
+            WHERE push_provider = ? AND push_provider_token = ? AND token_id != ?
+            RETURNING token_id
+          |]
+          (pp, Binary ppToken, ntfTknId)
+    withLog "deleteNtfToken" st $ \sl -> mapM_ (logDeleteToken sl) tknIds
+
+withPeriodicNtfTokens :: NtfPostgresStore -> Int64 -> (NtfTknRec -> IO ()) -> IO Int
+withPeriodicNtfTokens st now notify =
+  fmap (fromRight 0) $ withDB' "withPeriodicNtfTokens" st $ \db ->
+    DB.fold db (ntfTknQuery <> " WHERE status = ? AND cron_interval != 0 AND (cron_sent_at + cron_interval * 60) < ?") (NTActive, now) 0 $ \ !n row -> do
+      notify (rowToNtfTkn row) $> (n + 1)
+
+updateTokenCronSentAt :: NtfPostgresStore -> NtfTokenId -> Int64 -> IO (Either ErrorType ())
+updateTokenCronSentAt st tknId now =
+  withDB' "updateTokenCronSentAt" st $ \db ->
+    void $ DB.execute db "UPDATE tokens t SET cron_sent_at = ? WHERE token_id = ?" (now, tknId)
+
+addNtfSubscription :: NtfPostgresStore -> NtfSubRec -> IO (Either ErrorType (Int64, Bool))
+addNtfSubscription st sub =
+  withFastDB "addNtfSubscription" st $ \db -> runExceptT $ do
+    srvId :: Int64 <- ExceptT $ upsertServer db $ ntfSubServer' sub
+    n <- liftIO $ DB.execute db insertNtfSubQuery $ ntfSubToRow srvId sub
+    withLog "addNtfSubscription" st (`logCreateSubscription` sub)
+    pure (srvId, n > 0)
+  where
+    -- It is possible to combine these two statements into one with CTEs,
+    -- to reduce roundtrips in case of `insert`, but it would be making 2 queries in all cases.
+    -- With 2 statements it will succeed on the first `select` in most cases.
+    upsertServer db srv = getServer >>= maybe insertServer (pure . Right)
+      where
+        getServer =
+          maybeFirstRow fromOnly $
+            DB.query
+              db
+              [sql|
+                SELECT smp_server_id
+                FROM smp_servers
+                WHERE smp_host = ? AND smp_port = ? AND smp_keyhash = ?
+              |]
+              (srvToRow srv)
+        insertServer =
+          firstRow fromOnly (STORE "error inserting SMP server when adding subscription") $
+            DB.query
+              db
+              [sql|
+                INSERT INTO smp_servers (smp_host, smp_port, smp_keyhash) VALUES (?, ?, ?)
+                ON CONFLICT (smp_host, smp_port, smp_keyhash)
+                DO UPDATE SET smp_host = EXCLUDED.smp_host
+                RETURNING smp_server_id
+              |]
+              (srvToRow srv)
+
+insertNtfSubQuery :: Query
+insertNtfSubQuery =
+  [sql|
+    INSERT INTO subscriptions (token_id, smp_server_id, smp_notifier_id, subscription_id, smp_notifier_key, status, ntf_service_assoc)
+    VALUES (?,?,?,?,?,?,?)
+  |]
+
+ntfSubToRow :: Int64 -> NtfSubRec -> (NtfTokenId, Int64, NotifierId) :. NtfSubRow
+ntfSubToRow srvId NtfSubRec {ntfSubId, tokenId, smpQueue = SMPQueueNtf _ nId, notifierKey, subStatus, ntfServiceAssoc} =
+  (tokenId, srvId, nId) :. (ntfSubId, notifierKey, subStatus, ntfServiceAssoc)
+
+deleteNtfSubscription :: NtfPostgresStore -> NtfSubscriptionId -> IO (Either ErrorType ())
+deleteNtfSubscription st subId =
+  withFastDB "deleteNtfSubscription" st $ \db -> runExceptT $ do
+    ExceptT $ assertUpdated <$>
+      DB.execute db "DELETE FROM subscriptions WHERE subscription_id = ?" (Only subId)
+    withLog "deleteNtfSubscription" st (`logDeleteSubscription` subId)
+
+updateSubStatus :: NtfPostgresStore -> Int64 -> NotifierId -> NtfSubStatus -> IO (Either ErrorType ())
+updateSubStatus st srvId nId status =
+  withFastDB' "updateSubStatus" st $ \db -> do
+    sub_ :: Maybe (NtfSubscriptionId, NtfAssociatedService) <-
+      maybeFirstRow id $
+        DB.query
+          db
+          [sql|
+            UPDATE subscriptions SET status = ?
+            WHERE smp_server_id = ? AND smp_notifier_id = ? AND status != ?
+            RETURNING subscription_id, ntf_service_assoc
+          |]
+          (status, srvId, nId, status)
+    forM_ sub_ $ \(subId, serviceAssoc) ->
+      withLog "updateSubStatus" st $ \sl -> logSubscriptionStatus sl (subId, status, serviceAssoc)
+
+updateSrvSubStatus :: NtfPostgresStore -> SMPQueueNtf -> NtfSubStatus -> IO (Either ErrorType ())
+updateSrvSubStatus st q status =
+  withFastDB' "updateSrvSubStatus" st $ \db -> do
+    sub_ :: Maybe (NtfSubscriptionId, NtfAssociatedService) <-
+      maybeFirstRow id $
+        DB.query
+          db
+          [sql|
+            UPDATE subscriptions s
+            SET status = ?
+            FROM smp_servers p
+            WHERE p.smp_server_id = s.smp_server_id
+              AND p.smp_host = ? AND p.smp_port = ? AND p.smp_keyhash = ? AND s.smp_notifier_id = ?
+              AND s.status != ?
+            RETURNING s.subscription_id, s.ntf_service_assoc
+          |]
+          (Only status :. smpQueueToRow q :. Only status)
+    forM_ sub_ $ \(subId, serviceAssoc) ->
+      withLog "updateSrvSubStatus" st $ \sl -> logSubscriptionStatus sl (subId, status, serviceAssoc)
+
+batchUpdateSrvSubStatus :: NtfPostgresStore -> SMPServer -> Maybe ServiceId -> NonEmpty NotifierId -> NtfSubStatus -> IO Int
+batchUpdateSrvSubStatus st srv newServiceId nIds status =
+  fmap (fromRight (-1)) $ withDB "batchUpdateSrvSubStatus" st $ \db -> runExceptT $ do
+    (srvId :: Int64, currServiceId) <- ExceptT $ getSMPServerService db
+    unless (currServiceId == newServiceId) $ liftIO $ void $
+      DB.execute db "UPDATE smp_servers SET ntf_service_id = ? WHERE smp_server_id = ?" (newServiceId, srvId)
+    let params = L.toList $ L.map (srvId,isJust newServiceId,status,) nIds
+    liftIO $ fromIntegral <$> DB.executeMany db updateSubStatusQuery params
+  where
+    getSMPServerService db =
+      firstRow id AUTH $
+        DB.query
+          db
+          [sql|
+            SELECT smp_server_id, ntf_service_id
+            FROM smp_servers
+            WHERE smp_host = ? AND smp_port = ? AND smp_keyhash = ?
+            FOR UPDATE
+          |]
+          (srvToRow srv)
+
+batchUpdateSrvSubErrors :: NtfPostgresStore -> SMPServer -> NonEmpty (NotifierId, NtfSubStatus) -> IO Int
+batchUpdateSrvSubErrors st srv subs =
+  fmap (fromRight (-1)) $ withDB "batchUpdateSrvSubErrors" st $ \db -> runExceptT $ do
+    srvId :: Int64 <- ExceptT $ getSMPServerId db
+    let params = map (\(nId, status) -> (srvId, False, status, nId)) $ L.toList subs
+    subs' <- liftIO $ DB.returning db (updateSubStatusQuery <> " RETURNING s.subscription_id, s.status, s.ntf_service_assoc") params
+    withLog "batchUpdateStatus_" st $ forM_ subs' . logSubscriptionStatus
+    pure $ length subs'
+  where
+    getSMPServerId db =
+      firstRow fromOnly AUTH $
+        DB.query
+          db
+          [sql|
+            SELECT smp_server_id
+            FROM smp_servers
+            WHERE smp_host = ? AND smp_port = ? AND smp_keyhash = ?
+          |]
+          (srvToRow srv)
+
+updateSubStatusQuery :: Query
+updateSubStatusQuery =
+  [sql|
+    UPDATE subscriptions s
+    SET status = upd.status, ntf_service_assoc = upd.ntf_service_assoc
+    FROM (VALUES(?, ?, ?, ?)) AS upd(smp_server_id, ntf_service_assoc, status, smp_notifier_id)
+    WHERE s.smp_server_id = upd.smp_server_id
+      AND s.smp_notifier_id = (upd.smp_notifier_id :: BYTEA)
+      AND (s.status != upd.status OR s.ntf_service_assoc != upd.ntf_service_assoc)
+  |]
+
+removeServiceAssociation :: NtfPostgresStore -> SMPServer -> IO (Either ErrorType (Int64, Int))
+removeServiceAssociation st srv = do
+  withDB "removeServiceAssociation" st $ \db -> runExceptT $ do
+    srvId <- ExceptT $ removeServerService db
+    subs <-
+      liftIO $
+        DB.query
+          db
+          [sql|
+            UPDATE subscriptions s
+            SET status = ?, ntf_service_assoc = FALSE
+            WHERE smp_server_id = ?
+              AND (s.status != ? OR s.ntf_service_assoc != FALSE)
+            RETURNING s.subscription_id, s.status, s.ntf_service_assoc
+          |]
+          (NSInactive, srvId, NSInactive)
+    withLog "removeServiceAssociation" st $ forM_ subs . logSubscriptionStatus
+    pure (srvId, length subs)
+  where
+    removeServerService db =
+      firstRow fromOnly AUTH $
+        DB.query
+          db
+          [sql|
+            UPDATE smp_servers
+            SET ntf_service_id = NULL
+            WHERE smp_host = ? AND smp_port = ? AND smp_keyhash = ?
+            RETURNING smp_server_id
+          |]
+          (srvToRow srv)
+
+addTokenLastNtf :: NtfPostgresStore -> PNMessageData -> IO (Either ErrorType (NtfTknRec, NonEmpty PNMessageData))
+addTokenLastNtf st newNtf =
+  withFastDB "addTokenLastNtf" st $ \db -> runExceptT $ do
+    (tkn@NtfTknRec {ntfTknId = tId, tknStatus}, sId) <-
+      ExceptT $ firstRow toTokenSubId AUTH $
+        DB.query
+          db
+          [sql|
+            SELECT t.token_id, t.push_provider, t.push_provider_token, t.status, t.verify_key, t.dh_priv_key, t.dh_secret, t.reg_code, t.cron_interval, t.updated_at,
+              s.subscription_id
+            FROM tokens t
+            JOIN subscriptions s ON s.token_id = t.token_id
+            JOIN smp_servers p ON p.smp_server_id = s.smp_server_id
+            WHERE p.smp_host = ? AND p.smp_port = ? AND p.smp_keyhash = ? AND s.smp_notifier_id = ?
+            FOR UPDATE OF t, s
+          |]
+          (smpQueueToRow q)
+    unless (tknStatus == NTActive) $ throwE AUTH
+    lastNtfs_ <-
+      liftIO $ map toLastNtf <$>
+        DB.query
+          db
+            [sql|
+              WITH new AS (
+                INSERT INTO last_notifications(token_id, subscription_id, sent_at, nmsg_nonce, nmsg_data)
+                VALUES (?,?,?,?,?)
+                ON CONFLICT (token_id, subscription_id)
+                DO UPDATE SET
+                  sent_at = EXCLUDED.sent_at,
+                  nmsg_nonce = EXCLUDED.nmsg_nonce,
+                  nmsg_data = EXCLUDED.nmsg_data
+                RETURNING subscription_id, sent_at, nmsg_nonce, nmsg_data
+              ),
+              last AS (
+                SELECT subscription_id, sent_at, nmsg_nonce, nmsg_data
+                FROM last_notifications
+                WHERE token_id = ? AND subscription_id != (SELECT subscription_id FROM new)
+                UNION
+                SELECT subscription_id, sent_at, nmsg_nonce, nmsg_data
+                FROM new
+                ORDER BY sent_at DESC
+                LIMIT ?
+              ),
+              delete AS (
+                DELETE FROM last_notifications
+                WHERE token_id = ?
+                  AND sent_at < (SELECT min(sent_at) FROM last)
+              )
+              SELECT p.smp_host, p.smp_port, p.smp_keyhash, s.smp_notifier_id,
+                l.sent_at, l.nmsg_nonce, l.nmsg_data
+              FROM last l
+              JOIN subscriptions s ON s.subscription_id = l.subscription_id
+              JOIN smp_servers p ON p.smp_server_id = s.smp_server_id
+              ORDER BY sent_at ASC
+            |]
+            (tId, sId, systemToUTCTime ntfTs, nmsgNonce, Binary encNMsgMeta, tId, maxNtfs, tId)
+    let lastNtfs = fromMaybe (newNtf :| []) (L.nonEmpty lastNtfs_)
+    pure (tkn, lastNtfs)
+  where
+    maxNtfs = 6 :: Int
+    PNMessageData {smpQueue = q, ntfTs, nmsgNonce, encNMsgMeta} = newNtf
+    toTokenSubId :: NtfTknRow :. Only NtfSubscriptionId -> (NtfTknRec, NtfSubscriptionId)
+    toTokenSubId (tknRow :. Only sId) = (rowToNtfTkn tknRow, sId)
+
+toLastNtf :: SMPQueueNtfRow :. (UTCTime, C.CbNonce, Binary EncNMsgMeta) -> PNMessageData
+toLastNtf (qRow :. (ts, nonce, Binary encMeta)) =
+  let ntfTs = MkSystemTime (systemSeconds $ utcToSystemTime ts) 0
+   in PNMessageData {smpQueue = rowToSMPQueue qRow, ntfTs, nmsgNonce = nonce, encNMsgMeta = encMeta}
+
+getEntityCounts :: NtfPostgresStore -> IO (Int64, Int64, Int64)
+getEntityCounts st =
+  fmap (fromRight (0, 0, 0)) $ withDB' "getEntityCounts" st $ \db -> do
+    tCnt <- count <$> DB.query_ db "SELECT count(1) FROM tokens"
+    sCnt <- count <$> DB.query_ db "SELECT reltuples::BIGINT FROM pg_class WHERE relname = 'subscriptions' AND relkind = 'r'"
+    nCnt <- count <$> DB.query_ db "SELECT count(1) FROM last_notifications"
+    pure (tCnt, sCnt, nCnt)
+  where
+    count (Only n : _) = n
+    count [] = 0
+
+importNtfSTMStore :: NtfPostgresStore -> NtfSTMStore -> S.Set NtfTokenId -> IO (Int64, Int64, Int64, Int64)
+importNtfSTMStore NtfPostgresStore {dbStore = s} stmStore skipTokens = do
+  (tIds, tCnt) <- importTokens
+  subLookup <- readTVarIO $ subscriptionLookup stmStore
+  sCnt <- importSubscriptions tIds subLookup
+  nCnt <- importLastNtfs tIds subLookup
+  serviceCnt <- importNtfServiceIds
+  pure (tCnt, sCnt, nCnt, serviceCnt)
+  where
+    importTokens = do
+      allTokens <- M.elems <$> readTVarIO (tokens stmStore)
+      tokens <- filterTokens allTokens
+      let skipped = length allTokens - length tokens
+      when (skipped /= 0) $ putStrLn $ "Total skipped tokens " <> show skipped
+      -- uncomment this line instead of the next two to import tokens one by one.
+      -- tCnt <- withConnection s $ \db -> foldM (importTkn db) 0 tokens
+      -- token interval is reset to 0 to only send notifications to devices with periodic mode,
+      -- and before clients are upgraded - to all active devices.
+      tRows <- mapM (fmap (ntfTknToRow . (\t -> t {tknCronInterval = 0} :: NtfTknRec)) . mkTknRec) tokens
+      tCnt <- withConnection s $ \db -> DB.executeMany db insertNtfTknQuery tRows
+      let tokenIds = S.fromList $ map (\NtfTknData {ntfTknId} -> ntfTknId) tokens
+      (tokenIds,) <$> checkCount "token" (length tokens) tCnt
+      where
+        filterTokens tokens = do
+          let deviceTokens = foldl' (\m t -> M.alter (Just . (t :) . fromMaybe []) (tokenKey t) m) M.empty tokens
+          tokenSubs <- readTVarIO (tokenSubscriptions stmStore)
+          filterM (keepTokenRegistration deviceTokens tokenSubs) tokens
+        tokenKey NtfTknData {token, tknVerifyKey} = strEncode token <> ":" <> C.toPubKey C.pubKeyBytes tknVerifyKey
+        keepTokenRegistration deviceTokens tokenSubs tkn@NtfTknData {ntfTknId, tknStatus} =
+          case M.lookup (tokenKey tkn) deviceTokens of
+            Just ts
+              | length ts < 2 -> pure True
+              | ntfTknId `S.member` skipTokens -> False <$ putStrLn ("Skipped token " <> enc ntfTknId <> " from --skip-tokens")
+              | otherwise ->
+                  readTVarIO tknStatus >>= \case
+                    NTConfirmed -> do
+                      hasSubs <- maybe (pure False) (\v -> not . S.null <$> readTVarIO v) $ M.lookup ntfTknId tokenSubs
+                      if hasSubs
+                        then pure True
+                        else do
+                          anyBetterToken <- anyM $ map (\NtfTknData {tknStatus = tknStatus'} -> activeOrInvalid <$> readTVarIO tknStatus') ts
+                          if anyBetterToken
+                            then False <$ putStrLn ("Skipped duplicate inactive token " <> enc ntfTknId)
+                            else case findIndex (\NtfTknData {ntfTknId = tId} -> tId == ntfTknId) ts of
+                              Just 0 -> pure True -- keeping the first token
+                              Just _ -> False <$ putStrLn ("Skipped duplicate inactive token " <> enc ntfTknId <> " (no active token)")
+                              Nothing -> True <$ putStrLn "Error: no device token in the list"
+                    _ -> pure True
+            Nothing -> True <$ putStrLn "Error: no device token in lookup map"
+        activeOrInvalid = \case
+          NTActive -> True
+          NTInvalid _ -> True
+          _ -> False
+        -- importTkn db !n tkn@NtfTknData {ntfTknId} = do
+        --   tknRow <- ntfTknToRow <$> mkTknRec tkn
+        --   (DB.execute db insertNtfTknQuery tknRow >>= pure . (n + )) `E.catch` \(e :: E.SomeException) ->
+        --     putStrLn ("Error inserting token " <> enc ntfTknId <> " " <> show e) $> n
+    importSubscriptions :: S.Set NtfTokenId -> M.Map SMPQueueNtf NtfSubscriptionId -> IO Int64
+    importSubscriptions tIds subLookup = do
+      subs <- filterSubs . M.elems =<< readTVarIO (subscriptions stmStore)
+      srvIds <- importServers subs
+      putStrLn $ "Importing " <> show (length subs) <> " subscriptions..."
+      -- uncomment this line instead of the next to import subs one by one.
+      -- (sCnt, errTkns) <- withConnection s $ \db -> foldM (importSub db srvIds) (0, M.empty) subs
+      sCnt <- foldM (importSubs srvIds) 0 $ toChunks 500000 subs
+      checkCount "subscription" (length subs) sCnt
+      where
+        filterSubs allSubs = do
+          let subs = filter (\NtfSubData {tokenId} -> S.member tokenId tIds) allSubs
+              skipped = length allSubs - length subs
+          when (skipped /= 0) $ putStrLn $ "Skipped " <> show skipped <> " subscriptions of missing tokens"
+          let (removedSubTokens, removeSubs, dupQueues) = foldl' addSubToken (S.empty, S.empty, S.empty) subs
+          unless (null removeSubs) $ putStrLn $ "Skipped " <> show (S.size removeSubs) <> " duplicate subscriptions of " <> show (S.size removedSubTokens) <> " tokens for " <> show (S.size dupQueues) <> " queues"
+          pure $ filter (\NtfSubData {ntfSubId} -> S.notMember ntfSubId removeSubs) subs
+          where
+            addSubToken acc@(!stIds, !sIds, !qs) NtfSubData {ntfSubId, smpQueue, tokenId} =
+              case M.lookup smpQueue subLookup of
+                Just sId | sId /= ntfSubId ->
+                  (S.insert tokenId stIds, S.insert ntfSubId sIds, S.insert smpQueue qs)
+                _ -> acc
+        importSubs srvIds !n subs = do
+          rows <- mapM (ntfSubRow srvIds) subs
+          cnt <- withConnection s $ \db -> DB.executeMany db insertNtfSubQuery $ L.toList rows
+          let n' = n + cnt
+          putStr $ "Imported " <> show n' <> " subscriptions" <> "\r"
+          hFlush stdout
+          pure n'
+        -- importSub db srvIds (!n, !errTkns) sub@NtfSubData {ntfSubId = sId, tokenId} = do
+        --   subRow <- ntfSubRow srvIds sub
+        --   E.try (DB.execute db insertNtfSubQuery subRow) >>= \case
+        --     Right i -> do
+        --       let n' = n + i
+        --       when (n' `mod` 100000 == 0) $ do
+        --         putStr $ "Imported " <> show n' <> " subscriptions" <> "\r"
+        --         hFlush stdout
+        --       pure (n', errTkns)
+        --     Left (e :: E.SomeException) -> do
+        --       when (n `mod` 100000 == 0) $ putStrLn ""
+        --       putStrLn $ "Error inserting subscription " <> enc sId <> " for token " <> enc tokenId <> " " <> show e
+        --       pure (n, M.alter (Just . maybe [sId] (sId :)) tokenId errTkns)
+        ntfSubRow srvIds sub = case M.lookup srv srvIds of
+          Just sId -> ntfSubToRow sId <$> mkSubRec sub
+          Nothing -> E.throwIO $ userError $ "no matching server ID for server " <> show srv
+          where
+            srv = ntfSubServer sub
+    importServers subs = do
+      sIds <- withConnection s $ \db -> map fromOnly <$> DB.returning db srvQuery (map srvToRow srvs)
+      void $ checkCount "server" (length srvs) (length sIds)
+      pure $ M.fromList $ zip srvs sIds
+      where
+        srvQuery = "INSERT INTO smp_servers (smp_host, smp_port, smp_keyhash) VALUES (?, ?, ?) RETURNING smp_server_id"
+        srvs = nubOrd $ map ntfSubServer subs
+    importLastNtfs :: S.Set NtfTokenId -> M.Map SMPQueueNtf NtfSubscriptionId -> IO Int64
+    importLastNtfs tIds subLookup = do
+      ntfs <- readTVarIO (tokenLastNtfs stmStore)
+      ntfRows <- filterLastNtfRows ntfs
+      nCnt <- withConnection s $ \db -> DB.executeMany db lastNtfQuery ntfRows
+      checkCount "last notification" (length ntfRows) nCnt
+      where
+        lastNtfQuery = "INSERT INTO last_notifications(token_id, subscription_id, sent_at, nmsg_nonce, nmsg_data) VALUES (?,?,?,?,?)"
+        filterLastNtfRows ntfs = do
+          (skippedTkns, ntfCnt, (skippedQueues, ntfRows)) <- foldM lastNtfRows (S.empty, 0, (S.empty, [])) $ M.assocs ntfs
+          let skipped = ntfCnt - length ntfRows
+          when (skipped /= 0) $ putStrLn $ "Skipped last notifications " <> show skipped <> " for " <> show (S.size skippedTkns) <> " missing tokens and " <> show (S.size skippedQueues) <> " missing subscriptions with token present"
+          pure ntfRows
+        lastNtfRows (!stIds, !cnt, !acc) (tId, ntfVar) = do
+          ntfs <- L.toList <$> readTVarIO ntfVar
+          let cnt' = cnt + length ntfs
+          pure $
+            if S.member tId tIds
+              then (stIds, cnt', foldl' ntfRow acc ntfs)
+              else (S.insert tId stIds, cnt', acc)
+          where
+            ntfRow (!qs, !rows) PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} = case M.lookup smpQueue subLookup of
+              Just ntfSubId ->
+                let row = (tId, ntfSubId, systemToUTCTime ntfTs, nmsgNonce, Binary encNMsgMeta)
+                 in (qs, row : rows)
+              Nothing -> (S.insert smpQueue qs, rows)
+    importNtfServiceIds = do
+      ss <- M.assocs <$> readTVarIO (ntfServices stmStore)
+      withConnection s $ \db -> DB.executeMany db serviceQuery $ map serviceToRow ss
+      where
+        serviceQuery =
+          [sql|
+            INSERT INTO smp_servers (smp_host, smp_port, smp_keyhash, ntf_service_id)
+            VALUES (?, ?, ?, ?)
+            ON CONFLICT (smp_host, smp_port, smp_keyhash)
+            DO UPDATE SET ntf_service_id = EXCLUDED.ntf_service_id
+          |]
+        serviceToRow (srv, serviceId) = srvToRow srv :. Only serviceId
+    checkCount name expected inserted
+      | fromIntegral expected == inserted = do
+          putStrLn $ "Imported " <> show inserted <> " " <> name <> "s."
+          pure inserted
+      | otherwise = do
+          putStrLn $ "Incorrect " <> name <> " count: expected " <> show expected <> ", imported " <> show inserted
+          putStrLn "Import aborted, fix data and repeat"
+          exitFailure
+    enc = B.unpack . B64.encode . unEntityId
+
+exportNtfDbStore :: NtfPostgresStore -> FilePath -> IO (Int, Int, Int)
+exportNtfDbStore NtfPostgresStore {dbStoreLog = Nothing} _ =
+  putStrLn "Internal error: export requires store log" >> exitFailure
+exportNtfDbStore NtfPostgresStore {dbStore = s, dbStoreLog = Just sl} lastNtfsFile =
+  (,,) <$> exportTokens <*> exportSubscriptions <*> exportLastNtfs
+  where
+    exportTokens = do
+      tCnt <- withConnection s $ \db -> DB.fold_ db ntfTknQuery 0 $ \ !i tkn ->
+        logCreateToken sl (rowToNtfTkn tkn) $> (i + 1)
+      putStrLn $ "Exported " <> show tCnt <> " tokens"
+      pure tCnt
+    exportSubscriptions = do
+      sCnt <- withConnection s $ \db -> DB.fold_ db ntfSubQuery 0 $ \ !i sub -> do
+        let i' = i + 1
+        logCreateSubscription sl (toNtfSub sub)
+        when (i' `mod` 500000 == 0) $ do
+          putStr $ "Exported " <> show i' <> " subscriptions" <> "\r"
+          hFlush stdout
+        pure i'
+      putStrLn $ "Exported " <> show sCnt <> " subscriptions"
+      pure sCnt
+      where
+        ntfSubQuery =
+          [sql|
+            SELECT s.token_id, s.subscription_id, s.smp_notifier_key, s.status, s.ntf_service_assoc,
+              p.smp_host, p.smp_port, p.smp_keyhash, s.smp_notifier_id
+            FROM subscriptions s
+            JOIN smp_servers p ON p.smp_server_id = s.smp_server_id
+          |]
+        toNtfSub :: Only NtfTokenId :. NtfSubRow :. SMPQueueNtfRow -> NtfSubRec
+        toNtfSub (Only tokenId :. (ntfSubId, notifierKey, subStatus, ntfServiceAssoc) :. qRow)  =
+          let smpQueue = rowToSMPQueue qRow
+           in NtfSubRec {ntfSubId, tokenId, smpQueue, notifierKey, subStatus, ntfServiceAssoc}
+    exportLastNtfs =
+      withFile lastNtfsFile WriteMode $ \h ->
+        withConnection s $ \db -> DB.fold_ db lastNtfsQuery 0 $ \ !i (Only tknId :. ntfRow) ->
+          B.hPutStr h (encodeLastNtf tknId $ toLastNtf ntfRow) $> (i + 1)
+      where
+        -- Note that the order here is ascending, to be compatible with how it is imported
+        lastNtfsQuery =
+          [sql|
+            SELECT s.token_id, p.smp_host, p.smp_port, p.smp_keyhash, s.smp_notifier_id,
+              n.sent_at, n.nmsg_nonce, n.nmsg_data
+            FROM last_notifications n
+            JOIN subscriptions s ON s.subscription_id = n.subscription_id
+            JOIN smp_servers p ON p.smp_server_id = s.smp_server_id
+            ORDER BY token_ntf_id ASC
+          |]
+        encodeLastNtf tknId ntf = strEncode (TNMRv1 tknId ntf) `B.snoc` '\n'
+
+withFastDB' :: Text -> NtfPostgresStore -> (DB.Connection -> IO a) -> IO (Either ErrorType a)
+withFastDB' op st action = withFastDB op st $ fmap Right . action
+{-# INLINE withFastDB' #-}
+
+withDB' :: Text -> NtfPostgresStore -> (DB.Connection -> IO a) -> IO (Either ErrorType a)
+withDB' op st action = withDB op st $ fmap Right . action
+{-# INLINE withDB' #-}
+
+withFastDB :: forall a. Text -> NtfPostgresStore -> (DB.Connection -> IO (Either ErrorType a)) -> IO (Either ErrorType a)
+withFastDB op st = withDB_ op st True
+{-# INLINE withFastDB #-}
+
+withDB :: forall a. Text -> NtfPostgresStore -> (DB.Connection -> IO (Either ErrorType a)) -> IO (Either ErrorType a)
+withDB op st = withDB_ op st False
+{-# INLINE withDB #-}
+
+withDB_ :: forall a. Text -> NtfPostgresStore -> Bool -> (DB.Connection -> IO (Either ErrorType a)) -> IO (Either ErrorType a)
+withDB_ op st priority action =
+  E.uninterruptibleMask_ $ E.try (withTransactionPriority (dbStore st) priority action) >>= either logErr pure
+  where
+    logErr :: E.SomeException -> IO (Either ErrorType a)
+    logErr e = logError ("STORE: " <> err) $> Left (STORE err)
+      where
+        err = op <> ", withDB, " <> tshow e
+
+withLog :: MonadIO m => Text -> NtfPostgresStore -> (StoreLog 'WriteMode -> IO ()) -> m ()
+withLog op NtfPostgresStore {dbStoreLog} = withLog_ op dbStoreLog
+{-# INLINE withLog #-}
+
+assertUpdated :: Int64 -> Either ErrorType ()
+assertUpdated 0 = Left AUTH
+assertUpdated _ = Right ()
+
+instance FromField NtfSubStatus where fromField = fromTextField_ $ either (const Nothing) Just . smpDecode . encodeUtf8
+
+instance ToField NtfSubStatus where toField = toField . decodeLatin1 . smpEncode
+
+#if !defined(dbPostgres)
+instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode
+
+instance FromField NtfTknStatus where fromField = fromTextField_ $ either (const Nothing) Just . smpDecode . encodeUtf8
+
+instance ToField NtfTknStatus where toField = toField . decodeLatin1 . smpEncode
+
+instance FromField (C.PrivateKey 'C.X25519) where fromField = blobFieldDecoder C.decodePrivKey
+
+instance ToField (C.PrivateKey 'C.X25519) where toField = toField . Binary . C.encodePrivKey
+
+instance FromField C.APrivateAuthKey where fromField = blobFieldDecoder C.decodePrivKey
+
+instance ToField C.APrivateAuthKey where toField = toField . Binary . C.encodePrivKey
+
+instance FromField (NonEmpty TransportHost) where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+instance ToField (NonEmpty TransportHost) where toField = toField . decodeLatin1 . strEncode
+
+instance FromField C.KeyHash where fromField = blobFieldDecoder $ parseAll strP
+
+instance ToField C.KeyHash where toField = toField . Binary . strEncode
+
+instance FromField C.CbNonce where fromField = blobFieldDecoder $ parseAll smpP
+
+instance ToField C.CbNonce where toField = toField . Binary . smpEncode
+#endif
@@ -0,0 +1,119 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Notifications.Server.Store.Types where
+
+import Control.Applicative (optional)
+import Control.Concurrent.STM
+import qualified Data.ByteString.Char8 as B
+import Data.Maybe (fromMaybe)
+import Data.Word (Word16)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode, NtfSubStatus, NtfSubscriptionId, NtfTokenId, NtfTknStatus, SMPQueueNtf)
+import Simplex.Messaging.Notifications.Server.Store (NtfSubData (..), NtfTknData (..))
+import Simplex.Messaging.Protocol (NotifierId, NtfPrivateAuthKey, NtfPublicAuthKey)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
+
+data NtfTknRec = NtfTknRec
+  { ntfTknId :: NtfTokenId,
+    token :: DeviceToken,
+    tknStatus :: NtfTknStatus,
+    tknVerifyKey :: NtfPublicAuthKey,
+    tknDhPrivKey :: C.PrivateKeyX25519,
+    tknDhSecret :: C.DhSecretX25519,
+    tknRegCode :: NtfRegCode,
+    tknCronInterval :: Word16,
+    tknUpdatedAt :: Maybe RoundedSystemTime
+  }
+  deriving (Show)
+
+mkTknData :: NtfTknRec -> IO NtfTknData
+mkTknData NtfTknRec {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhPrivKey = pk, tknDhSecret, tknRegCode, tknCronInterval = cronInt, tknUpdatedAt = updatedAt} = do
+  tknStatus <- newTVarIO status
+  tknCronInterval <- newTVarIO cronInt
+  tknUpdatedAt <- newTVarIO updatedAt
+  let tknDhKeys = (C.publicKey pk, pk)
+  pure NtfTknData {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}
+
+mkTknRec :: NtfTknData -> IO NtfTknRec
+mkTknRec NtfTknData {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys = (_, tknDhPrivKey), tknDhSecret, tknRegCode, tknCronInterval = cronInt, tknUpdatedAt = updatedAt} = do
+  tknStatus <- readTVarIO status
+  tknCronInterval <- readTVarIO cronInt
+  tknUpdatedAt <- readTVarIO updatedAt
+  pure NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}
+
+instance StrEncoding NtfTknRec where
+  strEncode NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey = pk, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt} =
+    B.unwords
+      [ "tknId=" <> strEncode ntfTknId,
+        "token=" <> strEncode token,
+        "tokenStatus=" <> strEncode tknStatus,
+        "verifyKey=" <> strEncode tknVerifyKey,
+        "dhKeys=" <> strEncode (C.publicKey pk, pk),
+        "dhSecret=" <> strEncode tknDhSecret,
+        "regCode=" <> strEncode tknRegCode,
+        "cron=" <> strEncode tknCronInterval
+      ]
+      <> maybe "" updatedAtStr tknUpdatedAt
+    where
+      updatedAtStr t = " updatedAt=" <> strEncode t
+  strP = do
+    ntfTknId <- "tknId=" *> strP_
+    token <- "token=" *> strP_
+    tknStatus <- "tokenStatus=" *> strP_
+    tknVerifyKey <- "verifyKey=" *> strP_
+    (_ :: C.PublicKeyX25519, tknDhPrivKey) <- "dhKeys=" *> strP_
+    tknDhSecret <- "dhSecret=" *> strP_
+    tknRegCode <- "regCode=" *> strP_
+    tknCronInterval <- "cron=" *> strP
+    tknUpdatedAt <- optional $ " updatedAt=" *> strP
+    pure NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}
+
+data NtfSubRec = NtfSubRec
+  { ntfSubId :: NtfSubscriptionId,
+    smpQueue :: SMPQueueNtf,
+    notifierKey :: NtfPrivateAuthKey,
+    tokenId :: NtfTokenId,
+    subStatus :: NtfSubStatus,
+    ntfServiceAssoc :: NtfAssociatedService -- Bool
+  }
+  deriving (Show)
+
+type ServerNtfSub = (NtfSubscriptionId, (NotifierId, NtfPrivateAuthKey))
+
+type NtfAssociatedService = Bool
+
+mkSubData :: NtfSubRec -> IO NtfSubData
+mkSubData NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus = status, ntfServiceAssoc = serviceAssoc} = do
+  subStatus <- newTVarIO status
+  ntfServiceAssoc <- newTVarIO serviceAssoc
+  pure NtfSubData {ntfSubId, smpQueue, notifierKey, tokenId, subStatus, ntfServiceAssoc}
+
+mkSubRec :: NtfSubData -> IO NtfSubRec
+mkSubRec NtfSubData {ntfSubId, smpQueue, notifierKey, tokenId, subStatus = status, ntfServiceAssoc = serviceAssoc} = do
+  subStatus <- readTVarIO status
+  ntfServiceAssoc <- readTVarIO serviceAssoc
+  pure NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus, ntfServiceAssoc}
+
+instance StrEncoding NtfSubRec where
+  strEncode NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus, ntfServiceAssoc} =
+    B.unwords
+      [ "subId=" <> strEncode ntfSubId,
+        "smpQueue=" <> strEncode smpQueue,
+        "notifierKey=" <> strEncode notifierKey,
+        "tknId=" <> strEncode tokenId,
+        "subStatus=" <> strEncode subStatus,
+        "serviceAssoc=" <> strEncode ntfServiceAssoc
+      ]
+  strP = do
+    ntfSubId <- "subId=" *> strP_
+    smpQueue <- "smpQueue=" *> strP_
+    notifierKey <- "notifierKey=" *> strP_
+    tokenId <- "tknId=" *> strP_
+    subStatus <- "subStatus=" *> strP
+    ntfServiceAssoc <- fromMaybe False <$> optional (" serviceAssoc=" *> strP)
+    pure NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus, ntfServiceAssoc}
@@ -0,0 +1,180 @@
+
+
+SET statement_timeout = 0;
+SET lock_timeout = 0;
+SET idle_in_transaction_session_timeout = 0;
+SET client_encoding = 'UTF8';
+SET standard_conforming_strings = on;
+SELECT pg_catalog.set_config('search_path', '', false);
+SET check_function_bodies = false;
+SET xmloption = content;
+SET client_min_messages = warning;
+SET row_security = off;
+
+
+CREATE SCHEMA ntf_server;
+
+
+SET default_table_access_method = heap;
+
+
+CREATE TABLE ntf_server.last_notifications (
+    token_ntf_id bigint NOT NULL,
+    token_id bytea NOT NULL,
+    subscription_id bytea NOT NULL,
+    sent_at timestamp with time zone NOT NULL,
+    nmsg_nonce bytea NOT NULL,
+    nmsg_data bytea NOT NULL
+);
+
+
+
+ALTER TABLE ntf_server.last_notifications ALTER COLUMN token_ntf_id ADD GENERATED ALWAYS AS IDENTITY (
+    SEQUENCE NAME ntf_server.last_notifications_token_ntf_id_seq
+    START WITH 1
+    INCREMENT BY 1
+    NO MINVALUE
+    NO MAXVALUE
+    CACHE 1
+);
+
+
+
+CREATE TABLE ntf_server.migrations (
+    name text NOT NULL,
+    ts timestamp without time zone NOT NULL,
+    down text
+);
+
+
+
+CREATE TABLE ntf_server.smp_servers (
+    smp_server_id bigint NOT NULL,
+    smp_host text NOT NULL,
+    smp_port text NOT NULL,
+    smp_keyhash bytea NOT NULL,
+    ntf_service_id bytea
+);
+
+
+
+ALTER TABLE ntf_server.smp_servers ALTER COLUMN smp_server_id ADD GENERATED ALWAYS AS IDENTITY (
+    SEQUENCE NAME ntf_server.smp_servers_smp_server_id_seq
+    START WITH 1
+    INCREMENT BY 1
+    NO MINVALUE
+    NO MAXVALUE
+    CACHE 1
+);
+
+
+
+CREATE TABLE ntf_server.subscriptions (
+    subscription_id bytea NOT NULL,
+    token_id bytea NOT NULL,
+    smp_server_id bigint,
+    smp_notifier_id bytea NOT NULL,
+    smp_notifier_key bytea NOT NULL,
+    status text NOT NULL,
+    ntf_service_assoc boolean DEFAULT false NOT NULL
+);
+
+
+
+CREATE TABLE ntf_server.tokens (
+    token_id bytea NOT NULL,
+    push_provider text NOT NULL,
+    push_provider_token bytea NOT NULL,
+    status text NOT NULL,
+    verify_key bytea NOT NULL,
+    dh_priv_key bytea NOT NULL,
+    dh_secret bytea NOT NULL,
+    reg_code bytea NOT NULL,
+    cron_interval bigint NOT NULL,
+    cron_sent_at bigint,
+    updated_at bigint
+);
+
+
+
+ALTER TABLE ONLY ntf_server.last_notifications
+    ADD CONSTRAINT last_notifications_pkey PRIMARY KEY (token_ntf_id);
+
+
+
+ALTER TABLE ONLY ntf_server.migrations
+    ADD CONSTRAINT migrations_pkey PRIMARY KEY (name);
+
+
+
+ALTER TABLE ONLY ntf_server.smp_servers
+    ADD CONSTRAINT smp_servers_pkey PRIMARY KEY (smp_server_id);
+
+
+
+ALTER TABLE ONLY ntf_server.subscriptions
+    ADD CONSTRAINT subscriptions_pkey PRIMARY KEY (subscription_id);
+
+
+
+ALTER TABLE ONLY ntf_server.tokens
+    ADD CONSTRAINT tokens_pkey PRIMARY KEY (token_id);
+
+
+
+CREATE INDEX idx_last_notifications_subscription_id ON ntf_server.last_notifications USING btree (subscription_id);
+
+
+
+CREATE INDEX idx_last_notifications_token_id_sent_at ON ntf_server.last_notifications USING btree (token_id, sent_at);
+
+
+
+CREATE UNIQUE INDEX idx_last_notifications_token_subscription ON ntf_server.last_notifications USING btree (token_id, subscription_id);
+
+
+
+CREATE UNIQUE INDEX idx_smp_servers ON ntf_server.smp_servers USING btree (smp_host, smp_port, smp_keyhash);
+
+
+
+CREATE UNIQUE INDEX idx_subscriptions_smp_server_id_notifier_id ON ntf_server.subscriptions USING btree (smp_server_id, smp_notifier_id);
+
+
+
+CREATE INDEX idx_subscriptions_smp_server_id_ntf_service_status ON ntf_server.subscriptions USING btree (smp_server_id, ntf_service_assoc, status);
+
+
+
+CREATE INDEX idx_subscriptions_token_id ON ntf_server.subscriptions USING btree (token_id);
+
+
+
+CREATE UNIQUE INDEX idx_tokens_push_provider_token ON ntf_server.tokens USING btree (push_provider, push_provider_token, verify_key);
+
+
+
+CREATE INDEX idx_tokens_status_cron_interval_sent_at ON ntf_server.tokens USING btree (status, cron_interval, ((cron_sent_at + (cron_interval * 60))));
+
+
+
+ALTER TABLE ONLY ntf_server.last_notifications
+    ADD CONSTRAINT last_notifications_subscription_id_fkey FOREIGN KEY (subscription_id) REFERENCES ntf_server.subscriptions(subscription_id) ON UPDATE RESTRICT ON DELETE CASCADE;
+
+
+
+ALTER TABLE ONLY ntf_server.last_notifications
+    ADD CONSTRAINT last_notifications_token_id_fkey FOREIGN KEY (token_id) REFERENCES ntf_server.tokens(token_id) ON UPDATE RESTRICT ON DELETE CASCADE;
+
+
+
+ALTER TABLE ONLY ntf_server.subscriptions
+    ADD CONSTRAINT subscriptions_smp_server_id_fkey FOREIGN KEY (smp_server_id) REFERENCES ntf_server.smp_servers(smp_server_id) ON UPDATE RESTRICT ON DELETE RESTRICT;
+
+
+
+ALTER TABLE ONLY ntf_server.subscriptions
+    ADD CONSTRAINT subscriptions_token_id_fkey FOREIGN KEY (token_id) REFERENCES ntf_server.tokens(token_id) ON UPDATE RESTRICT ON DELETE CASCADE;
+
+
+
@@ -10,12 +10,13 @@
 module Simplex.Messaging.Notifications.Server.StoreLog
  ( StoreLog,
    NtfStoreLogRecord (..),
-    readWriteNtfStore,
+    readWriteNtfSTMStore,
    logCreateToken,
    logTokenStatus,
    logUpdateToken,
    logTokenCron,
    logDeleteToken,
+    logUpdateTokenTime,
    logCreateSubscription,
    logSubscriptionStatus,
    logDeleteSubscription,
@@ -23,21 +24,23 @@ module Simplex.Messaging.Notifications.Server.StoreLog
  )
 where

+import Control.Applicative (optional, (<|>))
 import Control.Concurrent.STM
-import Control.Logger.Simple
 import Control.Monad
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.ByteString.Base64.URL as B64
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
-import qualified Data.Text as T
+import Data.Functor (($>))
+import qualified Data.Map.Strict as M
+import Data.Maybe (fromMaybe)
 import Data.Word (Word16)
-import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Store
-import Simplex.Messaging.Protocol (NtfPrivateAuthKey)
+import Simplex.Messaging.Notifications.Server.Store.Types
+import Simplex.Messaging.Protocol (EntityId (..), SMPServer, ServiceId)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.Util (safeDecodeUtf8)
 import System.IO

 data NtfStoreLogRecord
@@ -46,54 +49,13 @@ data NtfStoreLogRecord
  | UpdateToken NtfTokenId DeviceToken NtfRegCode
  | TokenCron NtfTokenId Word16
  | DeleteToken NtfTokenId
+  | UpdateTokenTime NtfTokenId RoundedSystemTime
  | CreateSubscription NtfSubRec
-  | SubscriptionStatus NtfSubscriptionId NtfSubStatus
+  | SubscriptionStatus NtfSubscriptionId NtfSubStatus NtfAssociatedService
  | DeleteSubscription NtfSubscriptionId
+  | SetNtfService SMPServer (Maybe ServiceId)
  deriving (Show)

-data NtfTknRec = NtfTknRec
-  { ntfTknId :: NtfTokenId,
-    token :: DeviceToken,
-    tknStatus :: NtfTknStatus,
-    tknVerifyKey :: C.APublicAuthKey,
-    tknDhKeys :: C.KeyPair 'C.X25519,
-    tknDhSecret :: C.DhSecretX25519,
-    tknRegCode :: NtfRegCode,
-    tknCronInterval :: Word16
-  }
-  deriving (Show)
-
-mkTknData :: NtfTknRec -> STM NtfTknData
-mkTknData NtfTknRec {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval = cronInt} = do
-  tknStatus <- newTVar status
-  tknCronInterval <- newTVar cronInt
-  pure NtfTknData {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval}
-
-mkTknRec :: NtfTknData -> STM NtfTknRec
-mkTknRec NtfTknData {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval = cronInt} = do
-  tknStatus <- readTVar status
-  tknCronInterval <- readTVar cronInt
-  pure NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval}
-
-data NtfSubRec = NtfSubRec
-  { ntfSubId :: NtfSubscriptionId,
-    smpQueue :: SMPQueueNtf,
-    notifierKey :: NtfPrivateAuthKey,
-    tokenId :: NtfTokenId,
-    subStatus :: NtfSubStatus
-  }
-  deriving (Show)
-
-mkSubData :: NtfSubRec -> STM NtfSubData
-mkSubData NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus = status} = do
-  subStatus <- newTVar status
-  pure NtfSubData {ntfSubId, smpQueue, notifierKey, tokenId, subStatus}
-
-mkSubRec :: NtfSubData -> STM NtfSubRec
-mkSubRec NtfSubData {ntfSubId, smpQueue, notifierKey, tokenId, subStatus = status} = do
-  subStatus <- readTVar status
-  pure NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus}
-
 instance StrEncoding NtfStoreLogRecord where
  strEncode = \case
    CreateToken tknRec -> strEncode (Str "TCREATE", tknRec)
@@ -101,9 +63,13 @@ instance StrEncoding NtfStoreLogRecord where
    UpdateToken tknId token regCode -> strEncode (Str "TUPDATE", tknId, token, regCode)
    TokenCron tknId cronInt -> strEncode (Str "TCRON", tknId, cronInt)
    DeleteToken tknId -> strEncode (Str "TDELETE", tknId)
+    UpdateTokenTime tknId ts -> strEncode (Str "TTIME", tknId, ts)
    CreateSubscription subRec -> strEncode (Str "SCREATE", subRec)
-    SubscriptionStatus subId subStatus -> strEncode (Str "SSTATUS", subId, subStatus)
+    SubscriptionStatus subId subStatus serviceAssoc -> strEncode (Str "SSTATUS", subId, subStatus) <> serviceStr
+      where
+        serviceStr = if serviceAssoc then " service=" <> strEncode True else ""
    DeleteSubscription subId -> strEncode (Str "SDELETE", subId)
+    SetNtfService srv serviceId -> strEncode (Str "SERVICE", srv) <> " service=" <> maybe "off" strEncode serviceId
  strP =
    A.choice
      [ "TCREATE " *> (CreateToken <$> strP),
@@ -111,57 +77,19 @@ instance StrEncoding NtfStoreLogRecord where
        "TUPDATE " *> (UpdateToken <$> strP_ <*> strP_ <*> strP),
        "TCRON " *> (TokenCron <$> strP_ <*> strP),
        "TDELETE " *> (DeleteToken <$> strP),
+        "TTIME " *> (UpdateTokenTime <$> strP_ <*> strP),
        "SCREATE " *> (CreateSubscription <$> strP),
-        "SSTATUS " *> (SubscriptionStatus <$> strP_ <*> strP),
-        "SDELETE " *> (DeleteSubscription <$> strP)
+        "SSTATUS " *> (SubscriptionStatus <$> strP_ <*> strP <*> (fromMaybe False <$> optional (" service=" *> strP))),
+        "SDELETE " *> (DeleteSubscription <$> strP),
+        "SERVICE " *> (SetNtfService <$> strP <* " service=" <*> ("off" $> Nothing <|> strP))
      ]

-instance StrEncoding NtfTknRec where
-  strEncode NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval} =
-    B.unwords
-      [ "tknId=" <> strEncode ntfTknId,
-        "token=" <> strEncode token,
-        "tokenStatus=" <> strEncode tknStatus,
-        "verifyKey=" <> strEncode tknVerifyKey,
-        "dhKeys=" <> strEncode tknDhKeys,
-        "dhSecret=" <> strEncode tknDhSecret,
-        "regCode=" <> strEncode tknRegCode,
-        "cron=" <> strEncode tknCronInterval
-      ]
-  strP = do
-    ntfTknId <- "tknId=" *> strP_
-    token <- "token=" *> strP_
-    tknStatus <- "tokenStatus=" *> strP_
-    tknVerifyKey <- "verifyKey=" *> strP_
-    tknDhKeys <- "dhKeys=" *> strP_
-    tknDhSecret <- "dhSecret=" *> strP_
-    tknRegCode <- "regCode=" *> strP_
-    tknCronInterval <- "cron=" *> strP
-    pure NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval}
-
-instance StrEncoding NtfSubRec where
-  strEncode NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus} =
-    B.unwords
-      [ "subId=" <> strEncode ntfSubId,
-        "smpQueue=" <> strEncode smpQueue,
-        "notifierKey=" <> strEncode notifierKey,
-        "tknId=" <> strEncode tokenId,
-        "subStatus=" <> strEncode subStatus
-      ]
-  strP = do
-    ntfSubId <- "subId=" *> strP_
-    smpQueue <- "smpQueue=" *> strP_
-    notifierKey <- "notifierKey=" *> strP_
-    tokenId <- "tknId=" *> strP_
-    subStatus <- "subStatus=" *> strP
-    pure NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus}
-
 logNtfStoreRecord :: StoreLog 'WriteMode -> NtfStoreLogRecord -> IO ()
 logNtfStoreRecord = writeStoreLogRecord
 {-# INLINE logNtfStoreRecord #-}

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

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

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

-logSubscriptionStatus :: StoreLog 'WriteMode -> NtfSubscriptionId -> NtfSubStatus -> IO ()
-logSubscriptionStatus s subId subStatus = logNtfStoreRecord s $ SubscriptionStatus subId subStatus
+logCreateSubscription :: StoreLog 'WriteMode -> NtfSubRec -> IO ()
+logCreateSubscription s = logNtfStoreRecord s . CreateSubscription
+
+logSubscriptionStatus :: StoreLog 'WriteMode -> (NtfSubscriptionId, NtfSubStatus, NtfAssociatedService) -> IO ()
+logSubscriptionStatus s (subId, subStatus, serviceAssoc) = logNtfStoreRecord s $ SubscriptionStatus subId subStatus serviceAssoc

 logDeleteSubscription :: StoreLog 'WriteMode -> NtfSubscriptionId -> IO ()
 logDeleteSubscription s subId = logNtfStoreRecord s $ DeleteSubscription subId

-readWriteNtfStore :: FilePath -> NtfStore -> IO (StoreLog 'WriteMode)
-readWriteNtfStore = readWriteStoreLog readNtfStore writeNtfStore
+logSetNtfService :: StoreLog 'WriteMode -> SMPServer -> Maybe ServiceId -> IO ()
+logSetNtfService s srv serviceId = logNtfStoreRecord s $ SetNtfService srv serviceId

-readNtfStore :: FilePath -> NtfStore -> IO ()
-readNtfStore f st = mapM_ (addNtfLogRecord . LB.toStrict) . LB.lines =<< LB.readFile f
+readWriteNtfSTMStore :: Bool -> FilePath -> NtfSTMStore -> IO (StoreLog 'WriteMode)
+readWriteNtfSTMStore tty = readWriteStoreLog (readNtfStore tty) writeNtfStore
+
+readNtfStore :: Bool -> FilePath -> NtfSTMStore -> IO ()
+readNtfStore tty f st = readLogLines tty f $ \_ -> processLine
  where
-    addNtfLogRecord s = case strDecode s of
-      Left e -> logError $ "Log parsing error (" <> T.pack e <> "): " <> safeDecodeUtf8 (B.take 100 s)
-      Right lr -> atomically $ case lr of
-        CreateToken r@NtfTknRec {ntfTknId} -> do
-          tkn <- mkTknData r
-          addNtfToken st ntfTknId tkn
-        TokenStatus tknId status -> do
-          tkn_ <- getNtfToken st tknId
-          forM_ tkn_ $ \tkn@NtfTknData {tknStatus} -> do
-            writeTVar tknStatus status
-            when (status == NTActive) $ void $ removeInactiveTokenRegistrations st tkn
-        UpdateToken tknId token' tknRegCode ->
-          getNtfToken st tknId
-            >>= mapM_
-              ( \tkn@NtfTknData {tknStatus} -> do
-                  removeTokenRegistration st tkn
-                  writeTVar tknStatus NTRegistered
-                  addNtfToken st tknId tkn {token = token', tknRegCode}
-              )
-        TokenCron tknId cronInt ->
-          getNtfToken st tknId
-            >>= mapM_ (\NtfTknData {tknCronInterval} -> writeTVar tknCronInterval cronInt)
-        DeleteToken tknId ->
-          void $ deleteNtfToken st tknId
-        CreateSubscription r@NtfSubRec {ntfSubId} -> do
-          sub <- mkSubData r
-          void $ addNtfSubscription st ntfSubId sub
-        SubscriptionStatus subId status ->
-          getNtfSubscription st subId
-            >>= mapM_ (\NtfSubData {subStatus} -> writeTVar subStatus status)
-        DeleteSubscription subId ->
-          deleteNtfSubscription st subId
+    processLine s = either printError procNtfLogRecord (strDecode s)
+      where
+        printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> B.take 100 s
+        procNtfLogRecord = \case
+          CreateToken r@NtfTknRec {ntfTknId} -> do
+            tkn <- mkTknData r
+            atomically $ stmAddNtfToken st ntfTknId tkn
+          TokenStatus tknId status -> do
+            tkn_ <- stmGetNtfTokenIO st tknId
+            forM_ tkn_ $ \tkn@NtfTknData {tknStatus} -> do
+              atomically $ writeTVar tknStatus status
+              when (status == NTActive) $ void $ atomically $ stmRemoveInactiveTokenRegistrations st tkn
+          UpdateToken tknId token' tknRegCode -> do
+            stmGetNtfTokenIO st tknId
+              >>= mapM_
+                ( \tkn@NtfTknData {tknStatus} -> do
+                    atomically $ stmRemoveTokenRegistration st tkn
+                    atomically $ writeTVar tknStatus NTRegistered
+                    atomically $ stmAddNtfToken st tknId tkn {token = token', tknRegCode}
+                )
+          TokenCron tknId cronInt ->
+            stmGetNtfTokenIO st tknId
+              >>= mapM_ (\NtfTknData {tknCronInterval} -> atomically $ writeTVar tknCronInterval cronInt)
+          DeleteToken tknId ->
+            atomically $ void $ stmDeleteNtfToken st tknId
+          UpdateTokenTime tknId t ->
+            stmGetNtfTokenIO st tknId
+              >>= mapM_ (\NtfTknData {tknUpdatedAt} -> atomically $ writeTVar tknUpdatedAt $ Just t)
+          CreateSubscription r@NtfSubRec {tokenId, ntfSubId} -> do
+            sub <- mkSubData r
+            atomically (stmAddNtfSubscription st ntfSubId sub) >>= \case
+              Just () -> pure ()
+              Nothing -> B.putStrLn $ "Warning: no token " <> enc tokenId <> ", subscription " <> enc ntfSubId
+            where
+              enc = B64.encode . unEntityId
+          SubscriptionStatus subId status serviceAssoc -> do
+            stmGetNtfSubscriptionIO st subId >>= mapM_ update
+            where
+              update NtfSubData {subStatus, ntfServiceAssoc} = atomically $ do
+                writeTVar subStatus status
+                writeTVar ntfServiceAssoc serviceAssoc
+          DeleteSubscription subId ->
+            atomically $ stmDeleteNtfSubscription st subId
+          SetNtfService srv serviceId ->
+            atomically $ stmSetNtfService st srv serviceId

-writeNtfStore :: StoreLog 'WriteMode -> NtfStore -> IO ()
-writeNtfStore s NtfStore {tokens, subscriptions} = do
-  mapM_ (logCreateToken s) =<< readTVarIO tokens
-  mapM_ (logCreateSubscription s) =<< readTVarIO subscriptions
+writeNtfStore :: StoreLog 'WriteMode -> NtfSTMStore -> IO ()
+writeNtfStore s NtfSTMStore {tokens, subscriptions, ntfServices} = do
+  mapM_ (logCreateToken s <=< mkTknRec) =<< readTVarIO tokens
+  mapM_ (logCreateSubscription s <=< mkSubRec) =<< readTVarIO subscriptions
+  mapM_ (\(srv, serviceId) -> logSetNtfService s srv $ Just serviceId) . M.assocs =<< readTVarIO ntfServices
@@ -44,11 +44,14 @@ initialNTFVersion = VersionNTF 1
 authBatchCmdsNTFVersion :: VersionNTF
 authBatchCmdsNTFVersion = VersionNTF 2

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

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

 supportedClientNTFVRange :: VersionRangeNTF
 supportedClientNTFVRange = mkVersionRange initialNTFVersion currentClientNTFVersion
@@ -59,8 +62,8 @@ legacyServerNTFVRange = mkVersionRange initialNTFVersion initialNTFVersion
 supportedServerNTFVRange :: VersionRangeNTF
 supportedServerNTFVRange = mkVersionRange initialNTFVersion currentServerNTFVersion

-supportedNTFHandshakes :: [ALPN]
-supportedNTFHandshakes = ["ntf/1"]
+alpnSupportedNTFHandshakes :: [ALPN]
+alpnSupportedNTFHandshakes = ["ntf/1"]

 type THandleNTF c p = THandle NTFVersion c p

@@ -107,7 +110,7 @@ instance Encoding NtfClientHandshake where
    pure NtfClientHandshake {ntfVersion, keyHash}

 -- | Notifcations server transport handshake.
-ntfServerHandshake :: forall c. Transport c => C.APrivateSignKey -> c -> C.KeyPairX25519 -> C.KeyHash -> VersionRangeNTF -> ExceptT TransportError IO (THandleNTF c 'TServer)
+ntfServerHandshake :: forall c. Transport c => C.APrivateSignKey -> c 'TServer -> C.KeyPairX25519 -> C.KeyHash -> VersionRangeNTF -> ExceptT TransportError IO (THandleNTF c 'TServer)
 ntfServerHandshake serverSignKey c (k, pk) kh ntfVRange = do
  let th@THandle {params = THandleParams {sessionId}} = ntfTHandle c
  let sk = C.signX509 serverSignKey $ C.publicToX509 k
@@ -123,8 +126,8 @@ ntfServerHandshake serverSignKey c (k, pk) kh ntfVRange = do
            Nothing -> throwE TEVersion

 -- | Notifcations server client transport handshake.
-ntfClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRangeNTF -> Bool -> ExceptT TransportError IO (THandleNTF c 'TClient)
-ntfClientHandshake c keyHash ntfVRange _proxyServer = do
+ntfClientHandshake :: forall c. Transport c => c 'TClient -> C.KeyHash -> VersionRangeNTF -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandleNTF c 'TClient)
+ntfClientHandshake c keyHash ntfVRange _proxyServer _serviceKeys = do
  let th@THandle {params = THandleParams {sessionId}} = ntfTHandle c
  NtfServerHandshake {sessionId = sessId, ntfVersionRange, authPubKey = sk'} <- getHandshake th
  if sessionId /= sessId
@@ -134,7 +137,7 @@ ntfClientHandshake c keyHash ntfVRange _proxyServer = do
        ck_ <- forM sk' $ \signedKey -> liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
          serverKey <- getServerVerifyKey c
          pubKey <- C.verifyX509 serverKey signedKey
-          (,(getServerCerts c, signedKey)) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey)
+          (,CertChainPubKey (getPeerCertChain c) signedKey) <$> C.x509ToPublic' pubKey
        let v = maxVersion vr
        sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash}
        pure $ ntfThHandleClient th v vr ck_
@@ -142,12 +145,13 @@ ntfClientHandshake c keyHash ntfVRange _proxyServer = do

 ntfThHandleServer :: forall c. THandleNTF c 'TServer -> VersionNTF -> VersionRangeNTF -> C.PrivateKeyX25519 -> THandleNTF c 'TServer
 ntfThHandleServer th v vr pk =
-  let thAuth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
+  let thAuth = THAuthServer {serverPrivKey = pk, peerClientService = Nothing, sessSecret' = Nothing}
   in ntfThHandle_ th v vr (Just thAuth)

-ntfThHandleClient :: forall c. THandleNTF c 'TClient -> VersionNTF -> VersionRangeNTF -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleNTF c 'TClient
+ntfThHandleClient :: forall c. THandleNTF c 'TClient -> VersionNTF -> VersionRangeNTF -> Maybe (C.PublicKeyX25519, CertChainPubKey) -> THandleNTF c 'TClient
 ntfThHandleClient th v vr ck_ =
-  let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = ck, sessSecret = Nothing}) <$> ck_
+  let thAuth = clientTHParams <$> ck_
+      clientTHParams (k, ck) = THAuthClient {peerServerPubKey = k, peerServerCertKey = ck, clientService = Nothing, sessSecret = Nothing}
   in ntfThHandle_ th v vr thAuth

 ntfThHandle_ :: forall c p. THandleNTF c p -> VersionNTF -> VersionRangeNTF -> Maybe (THandleAuth p) -> THandleNTF c p
@@ -157,7 +161,7 @@ ntfThHandle_ th@THandle {params} v vr thAuth =
      params' = params {thVersion = v, thServerVRange = vr, thAuth, implySessId = v3, batch = v3}
   in (th :: THandleNTF c p) {params = params'}

-ntfTHandle :: Transport c => c -> THandleNTF c p
+ntfTHandle :: Transport c => c p -> THandleNTF c p
 ntfTHandle c = THandle {connection = c, params}
  where
    v = VersionNTF 0
@@ -170,5 +174,6 @@ ntfTHandle c = THandle {connection = c, params}
          thAuth = Nothing,
          implySessId = False,
          encryptBlock = Nothing,
-          batch = False
+          batch = False,
+          serviceAuth = False
        }
@@ -10,11 +10,10 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (UTCTime)
 import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..), UserId)
-import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
+import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Parsers (blobFieldDecoder, fromTextField_)
 import Simplex.Messaging.Protocol (NotifierId, NtfServer, SMPServer)

 data NtfTknAction
@@ -53,7 +52,7 @@ data NtfToken = NtfToken
    -- | key used by the ntf client to sign transmissions
    ntfPrivKey :: C.APrivateAuthKey,
    -- | client's DH keys (to repeat registration if necessary)
-    ntfDhKeys :: C.KeyPair 'C.X25519,
+    ntfDhKeys :: C.KeyPairX25519,
    -- | shared DH secret used to encrypt/decrypt notifications e2e
    ntfDhSecret :: Maybe C.DhSecretX25519,
    -- | token status
@@ -64,7 +63,7 @@ data NtfToken = NtfToken
  }
  deriving (Show)

-newNtfToken :: DeviceToken -> NtfServer -> C.AAuthKeyPair -> C.KeyPair 'C.X25519 -> NotificationsMode -> NtfToken
+newNtfToken :: DeviceToken -> NtfServer -> C.AAuthKeyPair -> C.KeyPairX25519 -> NotificationsMode -> NtfToken
 newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys ntfMode =
  NtfToken
    { deviceToken,
@@ -16,24 +16,11 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlphaNum, toLower)
 import Data.String
-import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime)
 import Data.Time.ISO8601 (parseISO8601)
-import Data.Typeable (Typeable)
 import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
 import Text.Read (readMaybe)
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple (ResultError (..))
-import Database.PostgreSQL.Simple.FromField (FromField(..), FieldParser, returnError, Field (..))
-import Database.PostgreSQL.Simple.TypeInfo.Static (textOid, varcharOid)
-import qualified Data.Text.Encoding as TE
-#else
-import Database.SQLite.Simple (ResultError (..), SQLData (..))
-import Database.SQLite.Simple.FromField (FieldParser, returnError)
-import Database.SQLite.Simple.Internal (Field (..))
-import Database.SQLite.Simple.Ok (Ok (Ok))
-#endif

 base64P :: Parser ByteString
 base64P = decode <$?> paddedBase64 rawBase64P
@@ -83,47 +70,6 @@ wordEnd c = c == ' ' || c == '\n'
 parseString :: (ByteString -> Either String a) -> (String -> a)
 parseString p = either error id . p . B.pack

-blobFieldParser :: Typeable k => Parser k -> FieldParser k
-blobFieldParser = blobFieldDecoder . parseAll
-
-#if defined(dbPostgres)
-blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> FieldParser k
-blobFieldDecoder dec f val = do
-  x <- fromField f val
-  case dec x of
-    Right k -> pure k
-    Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
-#else
-blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> FieldParser k
-blobFieldDecoder dec = \case
-  f@(Field (SQLBlob b) _) ->
-    case dec b of
-      Right k -> Ok k
-      Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
-  f -> returnError ConversionFailed f "expecting SQLBlob column type"
-#endif
-
-- TODO [postgres] review
-#if defined(dbPostgres)
-fromTextField_ :: Typeable a => (Text -> Maybe a) -> FieldParser a
-fromTextField_ fromText f val =
-  if typeOid f `elem` [textOid, varcharOid]
-    then case val of
-      Just t -> case fromText (TE.decodeUtf8 t) of
-        Just x -> pure x
-        _ -> returnError ConversionFailed f "invalid text value"
-      Nothing -> returnError UnexpectedNull f "NULL value found for non-NULL field"
-    else returnError Incompatible f "expecting TEXT or VARCHAR column type"
-#else
-fromTextField_ :: Typeable a => (Text -> Maybe a) -> Field -> Ok a
-fromTextField_ fromText = \case
-  f@(Field (SQLText t) _) ->
-    case fromText t of
-      Just x -> Ok x
-      _ -> returnError ConversionFailed f ("invalid text: " <> T.unpack t)
-  f -> returnError ConversionFailed f "expecting SQLText column type"
-#endif
-
 fstToLower :: String -> String
 fstToLower "" = ""
 fstToLower (h : t) = toLower h : t
--- a/Show More
+++ b/Show More